New Tim Info variant.

This commit is contained in:
meffi@lab313.ru
2014-05-07 12:07:09 +00:00
parent c130db80a7
commit 77940805bc
8 changed files with 167 additions and 118 deletions

View File

@@ -24,7 +24,7 @@
<AutoIncrementBuild Value="True"/>
<MajorVersionNr Value="1"/>
<RevisionNr Value="80"/>
<BuildNr Value="6"/>
<BuildNr Value="10"/>
<StringTable CompanyName="Lab 313" FileDescription="The best TIMs tool ever!:)" ProductVersion=""/>
</VersionInfo>
<BuildModes Count="6">
@@ -365,6 +365,7 @@
<OverflowChecks Value="True"/>
<StackChecks Value="True"/>
</Checks>
<VerifyObjMethodCallValidity Value="True"/>
</CodeGeneration>
<Linking>
<Debugging>

View File

@@ -23,8 +23,8 @@
<UnitName Value="umain"/>
<EditorIndex Value="0"/>
<WindowIndex Value="0"/>
<TopLine Value="787"/>
<CursorPos X="42" Y="802"/>
<TopLine Value="128"/>
<CursorPos X="83" Y="136"/>
<UsageCount Value="816"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
@@ -48,9 +48,10 @@
<Filename Value="ucommon.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ucommon"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="3"/>
<WindowIndex Value="0"/>
<TopLine Value="17"/>
<TopLine Value="1"/>
<CursorPos X="20" Y="35"/>
<UsageCount Value="816"/>
<Loaded Value="True"/>
@@ -83,8 +84,8 @@
<UnitName Value="usettings"/>
<EditorIndex Value="9"/>
<WindowIndex Value="0"/>
<TopLine Value="41"/>
<CursorPos X="60" Y="56"/>
<TopLine Value="83"/>
<CursorPos X="75" Y="99"/>
<UsageCount Value="816"/>
<Loaded Value="True"/>
</Unit7>
@@ -94,7 +95,7 @@
<UnitName Value="uscanresult"/>
<EditorIndex Value="7"/>
<WindowIndex Value="0"/>
<TopLine Value="35"/>
<TopLine Value="54"/>
<CursorPos X="79" Y="80"/>
<UsageCount Value="816"/>
<Loaded Value="True"/>
@@ -105,8 +106,8 @@
<UnitName Value="uscanthread"/>
<EditorIndex Value="8"/>
<WindowIndex Value="0"/>
<TopLine Value="178"/>
<CursorPos X="72" Y="197"/>
<TopLine Value="172"/>
<CursorPos X="3" Y="187"/>
<UsageCount Value="816"/>
<Loaded Value="True"/>
</Unit9>
@@ -144,11 +145,10 @@
<Unit13>
<Filename Value="todos.inc"/>
<IsPartOfProject Value="True"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="1"/>
<WindowIndex Value="0"/>
<TopLine Value="1"/>
<CursorPos X="44" Y="3"/>
<CursorPos X="20" Y="1"/>
<UsageCount Value="802"/>
<Loaded Value="True"/>
</Unit13>
@@ -160,7 +160,7 @@
<WindowIndex Value="0"/>
<TopLine Value="7"/>
<CursorPos X="20" Y="16"/>
<UsageCount Value="72"/>
<UsageCount Value="77"/>
<Loaded Value="True"/>
</Unit14>
</Units>
@@ -169,7 +169,7 @@
</General>
</ProjectSession>
<Debugging>
<BreakPoints Count="3">
<BreakPoints Count="2">
<Item1>
<Kind Value="bpkSource"/>
<WatchScope Value="wpsLocal"/>
@@ -184,13 +184,6 @@
<Source Value="c:\Lazarus\fpc\2.6.2\source\packages\fcl-image\src\fppalette.inc"/>
<Line Value="159"/>
</Item2>
<Item3>
<Kind Value="bpkSource"/>
<WatchScope Value="wpsLocal"/>
<WatchKind Value="wpkWrite"/>
<Source Value="umain.pas"/>
<Line Value="797"/>
</Item3>
</BreakPoints>
<Watches Count="3">
<Item1>

Binary file not shown.

View File

@@ -1,3 +1 @@
{ TODO : Zooming? }
{ TODO : Add file to filelist }
{ TODO : StartScan - remove refs to umain }
{ TODO : Zooming? }

144
umain.lfm
View File

@@ -1,7 +1,7 @@
object frmMain: TfrmMain
Left = 919
Height = 647
Top = 209
Left = 1092
Height = 668
Top = 213
Width = 790
HorzScrollBar.Page = 780
HorzScrollBar.Range = 489
@@ -9,7 +9,7 @@ object frmMain: TfrmMain
VertScrollBar.Range = 344
ActiveControl = pnlList
AllowDropFiles = True
ClientHeight = 622
ClientHeight = 643
ClientWidth = 790
Color = clBtnFace
Font.Color = clWindowText
@@ -498,7 +498,7 @@ object frmMain: TfrmMain
object pnlStatus: TPanel
Left = 0
Height = 30
Top = 571
Top = 613
Width = 790
Align = alBottom
BevelOuter = bvLowered
@@ -552,33 +552,33 @@ object frmMain: TfrmMain
end
object pnlMain: TPanel
Left = 0
Height = 543
Height = 585
Top = 28
Width = 790
Align = alClient
BevelOuter = bvNone
ClientHeight = 543
ClientHeight = 585
ClientWidth = 790
TabOrder = 1
object splMain: TSplitter
Left = 253
Height = 543
Height = 585
Top = 0
Width = 5
end
object pnlList: TPanel
Left = 0
Height = 543
Height = 585
Top = 0
Width = 253
Align = alLeft
BevelOuter = bvNone
ClientHeight = 543
ClientHeight = 585
ClientWidth = 253
TabOrder = 0
object lvList: TListView
Left = 0
Height = 515
Height = 372
Top = 28
Width = 253
Align = alClient
@@ -648,15 +648,72 @@ object frmMain: TfrmMain
TabOrder = 1
end
end
object tblTimInfo: TStringGrid
Left = 0
Height = 185
Top = 400
Width = 253
Align = alBottom
AutoEdit = False
AutoFillColumns = True
ColCount = 2
DefaultRowHeight = 20
Enabled = False
Flat = True
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goSmoothScroll]
RowCount = 9
TabOrder = 2
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'Tahoma'
Visible = False
ColWidths = (
102
150
)
Cells = (
10
0
0
'Field'
0
1
'Position'
0
2
'Version'
0
3
'Good'
0
5
'VRAM (X/Y)'
0
6
'Colors Count'
0
8
'VRAM (X/Y)'
1
0
'Value'
1
4
'CLUT'
1
7
'IMAGE'
)
end
end
object pnlImage: TPanel
Left = 258
Height = 543
Height = 585
Top = 0
Width = 532
Align = alClient
BevelOuter = bvLowered
ClientHeight = 543
ClientHeight = 585
ClientWidth = 532
Color = clBtnFace
ParentColor = False
@@ -664,7 +721,7 @@ object frmMain: TfrmMain
object pnlImageOptions: TPanel
Left = 1
Height = 32
Top = 510
Top = 552
Width = 530
Align = alBottom
AutoSize = True
@@ -746,12 +803,12 @@ object frmMain: TfrmMain
end
object pnlClut: TPanel
Left = 1
Height = 165
Top = 345
Height = 192
Top = 360
Width = 530
Align = alBottom
BevelOuter = bvLowered
ClientHeight = 165
ClientHeight = 192
ClientWidth = 530
Color = clBtnFace
ParentColor = False
@@ -759,7 +816,7 @@ object frmMain: TfrmMain
Visible = False
object grdClut: TDrawGrid
Left = 1
Height = 115
Height = 125
Top = 1
Width = 528
Align = alClient
@@ -784,12 +841,12 @@ object frmMain: TfrmMain
end
object lblClutHint: TLabel
Left = 1
Height = 48
Top = 116
Height = 65
Top = 126
Width = 528
Align = alBottom
Alignment = taCenter
Caption = 'Press "Space" key to invert Transparence bit.'#13#10'H-splitted color = black transparent.'#13#10'V-splitted color = non-black transparent.'
Caption = 'Double-click to change color.'#10'Press "Space" key to invert Transparence bit.'#13#10'H-splitted color = black transparent.'#13#10'V-splitted color = non-black transparent.'
Layout = tlCenter
ParentColor = False
WordWrap = True
@@ -797,7 +854,7 @@ object frmMain: TfrmMain
end
object imgTim: TImage
Left = 1
Height = 344
Height = 359
Top = 1
Width = 530
AntialiasingMode = amOff
@@ -808,39 +865,6 @@ object frmMain: TfrmMain
end
end
end
object sbMain: TStatusBar
Left = 0
Height = 21
Top = 601
Width = 790
Panels = <
item
Width = 50
end
item
Width = 50
end
item
Width = 50
end
item
Width = 50
end
item
Width = 50
end
item
Width = 50
end
item
Width = 50
end
item
Width = 50
end>
SimplePanel = False
SizeGrip = False
end
object dlgOpenFile: TOpenDialog
Title = 'Please, select File...'
DefaultExt = '.bin'
@@ -899,6 +923,11 @@ object frmMain: TfrmMain
object N8: TMenuItem
Caption = '-'
end
object mnShowTimInfo: TMenuItem
Action = actShowTimInfo
AutoCheck = True
ShowAlwaysCheckable = True
end
object mnStretchImage: TMenuItem
Action = actStretch
AutoCheck = True
@@ -1063,6 +1092,11 @@ object frmMain: TfrmMain
Caption = '&Background Color'
OnExecute = actChangeBackColorExecute
end
object actShowTimInfo: TAction
AutoCheck = True
Caption = '&Show Tim Info'
OnExecute = actShowTimInfoExecute
end
end
object pmList: TPopupMenu
left = 432

View File

@@ -28,6 +28,7 @@ type
actExtractTIMs: TAction;
actChangeFile: TAction;
actChangeBackColor: TAction;
actShowTimInfo: TAction;
actPngImport: TAction;
actStopScan: TAction;
actOpenLab: TAction;
@@ -58,6 +59,7 @@ type
lblStatus: TLabel;
lvList: TListView;
MenuItem1: TMenuItem;
mnShowTimInfo: TMenuItem;
mnImportPng: TMenuItem;
mnChangeBackColor2: TMenuItem;
N8: TMenuItem;
@@ -104,7 +106,7 @@ type
SaveasPNG1: TMenuItem;
dlgSelectDir: TSelectDirectoryDialog;
splMain: TSplitter;
sbMain: TStatusBar;
tblTimInfo: TStringGrid;
procedure actAboutExecute(Sender: TObject);
procedure actAssocTimsExecute(Sender: TObject);
procedure actChangeBackColorExecute(Sender: TObject);
@@ -123,6 +125,7 @@ type
procedure actReturnFocusExecute(Sender: TObject);
procedure actScanDirExecute(Sender: TObject);
procedure actScanFileExecute(Sender: TObject);
procedure actShowTimInfoExecute(Sender: TObject);
procedure actStopScanExecute(Sender: TObject);
procedure actStretchExecute(Sender: TObject);
procedure actPngExportExecute(Sender: TObject);
@@ -164,6 +167,7 @@ type
procedure ScanDirectory(const Directory: string);
procedure CheckButtonsAndMainMenu;
procedure ScanFinished(Sender: TObject);
procedure BeforeScan(MaxProgress: Integer);
procedure SetTimsListCount(Count: Integer);
procedure UpdateCLUTInfo;
procedure DrawSelTim;
@@ -212,6 +216,12 @@ begin
ScanPath(dlgOpenFile.Files.Strings[I - 1]);
end;
procedure TfrmMain.actShowTimInfoExecute(Sender: TObject);
begin
Settings.InfoVisible := (Sender as TAction).Checked;
tblTimInfo.Visible := (Sender as TAction).Checked;
end;
procedure TfrmMain.actStopScanExecute(Sender: TObject);
var
I: Integer;
@@ -232,7 +242,7 @@ end;
procedure TfrmMain.actStretchExecute(Sender: TObject);
begin
Settings.StretchMode := actStretch.Checked;
Settings.StretchMode := (Sender as TAction).Checked;
UpdateTim(True, False, False);
end;
@@ -579,6 +589,7 @@ begin
LastDir := Settings.LastDir;
cbbBitMode.ItemIndex := Settings.BitMode;
pnlImage.Color := Settings.BackColor;
actShowTimInfo.Checked := Settings.InfoVisible;
ScanThreads := TScanThreadList.Create(False); //False - to able scan thread remove itself from this list
ScanResults := TScanResultList.Create(False);
@@ -810,6 +821,7 @@ begin
if StartedScans < GetLogicalCpuCount then
begin
BeforeScan(ScanThreads.Last.FileLength);
ScanThreads.Last.Start;
Inc(StartedScans);
end;
@@ -848,6 +860,10 @@ begin
pnlList.Enabled := cbbFiles.Enabled;
actCloseFile.Enabled := cbbFiles.Enabled;
actCloseFiles.Enabled := cbbFiles.Enabled;
actScanFile.Enabled := ScanThreads.Count = 0;
actScanDir.Enabled := ScanThreads.Count = 0;
actReplaceTim.Enabled := (lvList.Selected <> nil) and (lvList.Selected.Index <> -1);
actPngExport.Enabled := (Surf^ <> nil) and actReplaceTim.Enabled;
@@ -862,7 +878,6 @@ var
I: Integer;
begin
ScanThreads.Remove(Sender as TScanThread);
Dec(StartedScans);
if ScanThreads.Count <> 0 then
@@ -870,6 +885,7 @@ begin
for I := 1 to ScanThreads.Count do
if ScanThreads[I - 1].Suspended and (not ScanThreads[I - 1].StopScan) then
begin
BeforeScan(ScanThreads[I - 1].FileLength);
ScanThreads[I - 1].Start;
Inc(StartedScans);
Exit;
@@ -877,7 +893,7 @@ begin
Exit;
end;
if ScanResults.Count <> 0 then SetTimsListCount(ScanResults.Last.Count);
if ScanThreads.Count <> 0 then SetTimsListCount(ScanResults.Last.Count);
CheckButtonsAndMainMenu;
@@ -891,6 +907,18 @@ begin
actStopScan.Tag := NativeInt(True);
end;
procedure TfrmMain.BeforeScan(MaxProgress: Integer);
begin
cbbFiles.Enabled := False;
pnlList.Enabled := False;
actScanFile.Enabled := False;
actScanDir.Enabled := False;
pbProgress.Max := MaxProgress;
pbProgress.Position := 0;
end;
procedure TfrmMain.SetTimsListCount(Count: Integer);
begin
lvList.Items.BeginUpdate;
@@ -1004,43 +1032,33 @@ end;
procedure TfrmMain.ShowTimInfo(ShowInfo: Boolean);
var
I: Integer;
TIM: PTIM;
TimInfo: TTimInfo;
begin
for I := 1 to sbMain.Panels.Count do
sbMain.Panels[I - 1].Text := '';
tblTimInfo.Cells[1, 1] := '';
tblTimInfo.Cells[1, 2] := '';
tblTimInfo.Cells[1, 3] := '';
tblTimInfo.Cells[1, 5] := '';
tblTimInfo.Cells[1, 6] := '';
tblTimInfo.Cells[1, 8] := '';
if not ShowInfo then Exit;
TimInfo := SelectedTimInfo;
TIM := SelectedTimInMode;
I := 0;
tblTimInfo.Cells[1, 1] := Format('0x%x', [TimInfo.Position]);
sbMain.Panels[I].Text := Format('Pos: 0x%x', [TimInfo.Position]);
sbMain.Panels[I].Width := Canvas.GetTextWidth(sbMain.Panels[I].Text) + 8; Inc(I);
sbMain.Panels[I].Text := Format('Ver: %d', [GetTimVersion(TIM)]);
sbMain.Panels[I].Width := Canvas.GetTextWidth(sbMain.Panels[I].Text) + 8; Inc(I);
sbMain.Panels[I].Text := Format('Good: %s', [TIMIsGoodStr(TIM)]);
sbMain.Panels[I].Width := Canvas.GetTextWidth(sbMain.Panels[I].Text) + 8; Inc(I);
tblTimInfo.Cells[1, 2] := Format('%d', [GetTimVersion(TIM)]);
tblTimInfo.Cells[1, 3] := Format('%s', [TIMIsGoodStr(TIM)]);
if TIMHasCLUT(TIM) then
begin
sbMain.Panels[I].Alignment := taRightJustify;
sbMain.Panels[I].Text := 'CLUT:';
sbMain.Panels[I].Width := Canvas.GetTextWidth(sbMain.Panels[I].Text) + 20; Inc(I);
sbMain.Panels[I].Text := Format('X/Y: %dx%d', [GetTimClutVRAMX(TIM), GetTimClutVRAMY(TIM)]);
sbMain.Panels[I].Width := Canvas.GetTextWidth(sbMain.Panels[I].Text) + 8; Inc(I);
sbMain.Panels[I].Text := Format('Colors: %d', [GetTimColorsCount(TIM)]);
sbMain.Panels[I].Width := Canvas.GetTextWidth(sbMain.Panels[I].Text) + 8; Inc(I);
tblTimInfo.Cells[1, 5] := Format('%dx%d', [GetTimClutVRAMX(TIM), GetTimClutVRAMY(TIM)]);
tblTimInfo.Cells[1, 6] := Format('%d', [GetTimColorsCount(TIM)]);
end;
sbMain.Panels[I].Alignment := taRightJustify;
sbMain.Panels[I].Text := 'IMAGE:';
sbMain.Panels[I].Width := Canvas.GetTextWidth(sbMain.Panels[I].Text) + 20; Inc(I);
sbMain.Panels[I].Text := Format('X/Y: %dx%d', [GetTimImageVRAMX(TIM), GetTimImageVRAMY(TIM)]);
sbMain.Panels[I].Width := Canvas.GetTextWidth(sbMain.Panels[I].Text) + 8; Inc(I);
tblTimInfo.Cells[1, 8] := Format('%dx%d', [GetTimImageVRAMX(TIM), GetTimImageVRAMY(TIM)]);
FreeTIM(TIM);
end;

View File

@@ -20,7 +20,6 @@ type
pSrcFileStream: TFileStream;
pStopScan: boolean;
procedure SetStatusText;
procedure StartScan;
procedure FinishScan;
procedure UpdateProgressBar;
procedure AddResult(TIM: PTIM);
@@ -31,6 +30,7 @@ type
constructor Create(const FileToScan: string; ImageScan: boolean; Results: PScanResultList);
//property Started: boolean read pStarted write pStarted;
property StopScan: boolean read pStopScan write pStopScan;
property FileLength: Integer read pFileSize;
end;
TScanThreadList = specialize TFPGObjectList<TScanThread>;
@@ -89,8 +89,6 @@ var
pScanFinished: boolean;
pRealBufSize, pTimPosition, pTIMNumber: Integer;
begin
Synchronize(@StartScan);
if pScanResult.IsImage then
pSectorBufferSize := cSectorBufferSize
else
@@ -187,7 +185,10 @@ begin
end;
if not CheckForFileOpened(pResults, pScanResult.ScanFile) then
pResults^.Add(pScanResult)
begin
pResults^.Add(pScanResult);
frmMain.cbbFiles.Items.Add(pScanResult.ScanFile);
end
else
pScanResult.Free;
end;
@@ -197,15 +198,6 @@ begin
frmMain.lblStatus.Caption := pStatusText;
end;
procedure TScanThread.StartScan;
begin
frmMain.cbbFiles.Enabled := False;
frmMain.pnlList.Enabled := False;
frmMain.pbProgress.Max := FileSize(pScanResult.ScanFile);
frmMain.pbProgress.Position := 0;
end;
procedure TScanThread.UpdateProgressBar;
begin
frmMain.pbProgress.Position := pFilePos;

View File

@@ -24,6 +24,8 @@ type
function FBackColorRead(): TColor;
procedure FBitModeWrite(Mode: Integer);
function FBitModeRead(): Integer;
procedure FInfoVisibleWrite(Value: Boolean);
function FInfoVisibleRead(): Boolean;
public
constructor Create(const DirPath: string);
destructor Destroy; override;
@@ -32,6 +34,7 @@ type
property LastDir: string read FLastDirRead write FLastDirWrite;
property BackColor: TColor read FBackColorRead write FBackColorWrite;
property BitMode: Integer read FBitModeRead write FBitModeWrite;
property InfoVisible: Boolean read FInfoVisibleRead write FInfoVisibleWrite;
end;
implementation
@@ -92,6 +95,16 @@ begin
Result := FIniFile.ReadInteger(sMain, 'BitMode', 0);
end;
procedure TSettings.FInfoVisibleWrite(Value: Boolean);
begin
FIniFile.WriteBool(sMain, 'InfoVisible', Value);
end;
function TSettings.FInfoVisibleRead: Boolean;
begin
Result := FIniFile.ReadBool(sMain, 'InfoVisible', False);
end;
constructor TSettings.Create(const DirPath: string);
begin
inherited Create;
@@ -107,4 +120,4 @@ begin
end;
end.