Multi-thread scan improvement;

Some crashes fixed;
This commit is contained in:
meffi@lab313.ru
2014-02-19 08:48:59 +00:00
parent 20f1dbf7ce
commit 057405ebfe
5 changed files with 166 additions and 162 deletions

View File

@@ -83,8 +83,8 @@
<DCC_SUSPICIOUS_TYPECAST>false</DCC_SUSPICIOUS_TYPECAST> <DCC_SUSPICIOUS_TYPECAST>false</DCC_SUSPICIOUS_TYPECAST>
<DCC_MapFile>3</DCC_MapFile> <DCC_MapFile>3</DCC_MapFile>
<DCC_Optimize>true</DCC_Optimize> <DCC_Optimize>true</DCC_Optimize>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.492;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys> <VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.504;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<VerInfo_Build>492</VerInfo_Build> <VerInfo_Build>504</VerInfo_Build>
<Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File> <Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
<DCC_IOChecking>false</DCC_IOChecking> <DCC_IOChecking>false</DCC_IOChecking>
<DCC_IntegerOverflowCheck>true</DCC_IntegerOverflowCheck> <DCC_IntegerOverflowCheck>true</DCC_IntegerOverflowCheck>

View File

@@ -30,7 +30,7 @@ function GetStartDir: string;
function GetFileSizeAPI(const FileName: string): Int64; function GetFileSizeAPI(const FileName: string): Int64;
function CheckFileExists(const FileName: string): boolean; function CheckFileExists(const FileName: string): boolean;
// function cHex2Int( const Value : string) : Integer; // function cHex2Int( const Value : string) : Integer;
function ExtractFileNameWOext(const Path: string): string; function ExtractJustName(const Path: string): string;
procedure Text2Clipboard(const S: string); procedure Text2Clipboard(const S: string);
function Min(A, B: Integer): Integer; function Min(A, B: Integer): Integer;
function Max(A, B: Integer): Integer; function Max(A, B: Integer): Integer;
@@ -61,7 +61,7 @@ begin
Clipboard.AsText := S; Clipboard.AsText := S;
end; end;
function ExtractFileNameWOext(const Path: string): string; function ExtractJustName(const Path: string): string;
begin begin
Result := ExtractFileName(Path); Result := ExtractFileName(Path);
Result := Copy(Result, 1, Length(Result) - Length(ExtractFileExt(Result))); Result := Copy(Result, 1, Length(Result) - Length(ExtractFileExt(Result)));

View File

@@ -20,8 +20,8 @@ object frmMain: TfrmMain
TextHeight = 13 TextHeight = 13
object pnlStatus: TPanel object pnlStatus: TPanel
Left = 0 Left = 0
Top = 502 Top = 515
Width = 738 Width = 746
Height = 30 Height = 30
Align = alBottom Align = alBottom
BevelOuter = bvLowered BevelOuter = bvLowered
@@ -29,17 +29,17 @@ object frmMain: TfrmMain
object lblStatus: TLabel object lblStatus: TLabel
Left = 76 Left = 76
Top = 1 Top = 1
Width = 157 Width = 165
Height = 28 Height = 28
Align = alClient Align = alClient
Alignment = taRightJustify Alignment = taRightJustify
Layout = tlCenter Layout = tlCenter
ExplicitLeft = 230 ExplicitLeft = 238
ExplicitWidth = 3 ExplicitWidth = 3
ExplicitHeight = 13 ExplicitHeight = 13
end end
object pbProgress: TProgressBar object pbProgress: TProgressBar
Left = 233 Left = 241
Top = 1 Top = 1
Width = 504 Width = 504
Height = 28 Height = 28
@@ -63,7 +63,7 @@ object frmMain: TfrmMain
object cbbFiles: TComboBox object cbbFiles: TComboBox
Left = 0 Left = 0
Top = 0 Top = 0
Width = 738 Width = 746
Height = 21 Height = 21
Align = alTop Align = alTop
AutoDropDown = True AutoDropDown = True
@@ -77,23 +77,24 @@ object frmMain: TfrmMain
object pnlMain: TPanel object pnlMain: TPanel
Left = 0 Left = 0
Top = 21 Top = 21
Width = 738 Width = 746
Height = 481 Height = 494
Align = alClient Align = alClient
BevelOuter = bvNone BevelOuter = bvNone
TabOrder = 1 TabOrder = 1
object splMain: TSplitter object splMain: TSplitter
Left = 233 Left = 233
Top = 0 Top = 0
Height = 481 Height = 494
ResizeStyle = rsUpdate ResizeStyle = rsUpdate
ExplicitLeft = 201 ExplicitLeft = 201
ExplicitHeight = 481
end end
object pnlList: TPanel object pnlList: TPanel
Left = 0 Left = 0
Top = 0 Top = 0
Width = 233 Width = 233
Height = 481 Height = 494
Align = alLeft Align = alLeft
BevelOuter = bvNone BevelOuter = bvNone
TabOrder = 0 TabOrder = 0
@@ -101,7 +102,7 @@ object frmMain: TfrmMain
Left = 0 Left = 0
Top = 0 Top = 0
Width = 233 Width = 233
Height = 481 Height = 494
Align = alClient Align = alClient
Columns = < Columns = <
item item
@@ -118,6 +119,7 @@ object frmMain: TfrmMain
end> end>
ColumnClick = False ColumnClick = False
DoubleBuffered = True DoubleBuffered = True
Enabled = False
GridLines = True GridLines = True
HideSelection = False HideSelection = False
OwnerData = True OwnerData = True
@@ -130,33 +132,36 @@ object frmMain: TfrmMain
OnClick = lvListClick OnClick = lvListClick
OnData = lvListData OnData = lvListData
OnSelectItem = lvListSelectItem OnSelectItem = lvListSelectItem
ExplicitLeft = -2
ExplicitTop = -5
end end
end end
object pnlImage: TPanel object pnlImage: TPanel
Left = 236 Left = 236
Top = 0 Top = 0
Width = 502 Width = 510
Height = 481 Height = 494
Align = alClient Align = alClient
BevelOuter = bvLowered BevelOuter = bvLowered
TabOrder = 1 TabOrder = 1
object splImageClut: TSplitter object splImageClut: TSplitter
Left = 1 Left = 1
Top = 1 Top = 1
Width = 500 Width = 508
Height = 3 Height = 3
Cursor = crVSplit Cursor = crVSplit
Align = alTop Align = alTop
Beveled = True Beveled = True
ResizeStyle = rsUpdate ResizeStyle = rsUpdate
ExplicitTop = 274 ExplicitTop = 274
ExplicitWidth = 500
end end
object pbTim: TImage object pbTim: TImage
AlignWithMargins = True AlignWithMargins = True
Left = 4 Left = 4
Top = 7 Top = 7
Width = 494 Width = 502
Height = 290 Height = 303
Align = alClient Align = alClient
Center = True Center = True
IncrementalDisplay = True IncrementalDisplay = True
@@ -169,8 +174,8 @@ object frmMain: TfrmMain
end end
object grdCurrClut: TDrawGrid object grdCurrClut: TDrawGrid
Left = 1 Left = 1
Top = 330 Top = 343
Width = 500 Width = 508
Height = 150 Height = 150
Align = alBottom Align = alBottom
ColCount = 1 ColCount = 1
@@ -190,8 +195,8 @@ object frmMain: TfrmMain
end end
object pnlImageOptions: TPanel object pnlImageOptions: TPanel
Left = 1 Left = 1
Top = 300 Top = 313
Width = 500 Width = 508
Height = 30 Height = 30
Align = alBottom Align = alBottom
BevelOuter = bvLowered BevelOuter = bvLowered
@@ -206,6 +211,7 @@ object frmMain: TfrmMain
AutoDropDown = True AutoDropDown = True
AutoCloseUp = True AutoCloseUp = True
Style = csDropDownList Style = csDropDownList
Enabled = False
TabOrder = 0 TabOrder = 0
OnChange = cbbCLUTChange OnChange = cbbCLUTChange
end end
@@ -217,6 +223,7 @@ object frmMain: TfrmMain
Height = 21 Height = 21
Align = alLeft Align = alLeft
Style = csDropDownList Style = csDropDownList
Enabled = False
ItemIndex = 0 ItemIndex = 0
TabOrder = 1 TabOrder = 1
Text = 'Full transparence' Text = 'Full transparence'
@@ -235,6 +242,7 @@ object frmMain: TfrmMain
Height = 21 Height = 21
Align = alLeft Align = alLeft
Style = csDropDownList Style = csDropDownList
Enabled = False
ItemIndex = 0 ItemIndex = 0
TabOrder = 2 TabOrder = 2
Text = 'Real' Text = 'Real'
@@ -245,16 +253,16 @@ object frmMain: TfrmMain
'8 BPP' '8 BPP'
'16 BPP' '16 BPP'
'24 BPP') '24 BPP')
ExplicitTop = 3
end end
object chkStretch: TCheckBox object chkStretch: TCheckBox
AlignWithMargins = True AlignWithMargins = True
Left = 407 Left = 407
Top = 4 Top = 4
Width = 89 Width = 97
Height = 22 Height = 22
Action = actStretch Action = actStretch
Align = alClient Align = alClient
Enabled = False
TabOrder = 3 TabOrder = 3
end end
end end

View File

@@ -118,6 +118,7 @@ type
LastDir: string; LastDir: string;
WaitThread: TEventWaitThread; WaitThread: TEventWaitThread;
function ScanRes: TScanResult;
procedure SetListCount(Count: Integer); procedure SetListCount(Count: Integer);
procedure ScanFinished(Sender: TObject); procedure ScanFinished(Sender: TObject);
function CheckForFileOpened(const FileName: string): boolean; function CheckForFileOpened(const FileName: string): boolean;
@@ -125,16 +126,11 @@ type
procedure ScanPath(const Path: string); procedure ScanPath(const Path: string);
procedure ScanFile(const FileName: string); procedure ScanFile(const FileName: string);
procedure ScanDirectory(const Directory: string); procedure ScanDirectory(const Directory: string);
function CurrentFileName: string; function ListIdx: Integer;
function CurrentTimPos(Index: Integer): Integer; function TimIdx(Index: Integer): TScanTim;
function CurrentTimSize(Index: Integer): Integer; function SelTim(NewBitMode: Integer = $FF): PTIM;
function CurrentTimBitMode(Index: Integer): Byte; function SelTimName: string;
function CurrentTimWidth(Index: Integer): Word; procedure DrawSelTim;
function CurrentTimHeight(Index: Integer): Word;
function CurrentFileIsImage: boolean;
function CurrentTIM(NewBitMode: Integer = $FF): PTIM;
function CurrentTIMName(Index: Integer): string;
procedure DrawCurrentTIM;
procedure DrawCurrentCLUT; procedure DrawCurrentCLUT;
procedure UpdateCLUTInfo; procedure UpdateCLUTInfo;
procedure SetCLUTListToNoCLUT; procedure SetCLUTListToNoCLUT;
@@ -271,7 +267,7 @@ end;
procedure TfrmMain.actCloseFileExecute(Sender: TObject); procedure TfrmMain.actCloseFileExecute(Sender: TObject);
begin begin
ScanResult[cbbFiles.ItemIndex].Free; ScanRes.Free;
ScanResult.Delete(cbbFiles.ItemIndex); ScanResult.Delete(cbbFiles.ItemIndex);
lvList.Items.BeginUpdate; lvList.Items.BeginUpdate;
lvList.Items.Count := 0; lvList.Items.Count := 0;
@@ -280,7 +276,7 @@ begin
actTimInfo.Enabled := False; actTimInfo.Enabled := False;
actTimInfo.Caption := 'TIM Info'; actTimInfo.Caption := 'TIM Info';
lvList.Column[0].Caption := '# / 0'; lvList.Column[0].Caption := '# / 0';
DrawCurrentTIM; DrawSelTim;
DrawCurrentCLUT; DrawCurrentCLUT;
cbbCLUT.Items.BeginUpdate; cbbCLUT.Items.BeginUpdate;
@@ -293,9 +289,13 @@ begin
cbbFiles.Items.Delete(cbbFiles.ItemIndex); cbbFiles.Items.Delete(cbbFiles.ItemIndex);
cbbFiles.Items.EndUpdate; cbbFiles.Items.EndUpdate;
cbbFiles.Enabled := cbbFiles.Items.Count <> 0;
CheckButtonsAndMainMenu; CheckButtonsAndMainMenu;
if cbbFiles.Enabled then
begin
cbbFiles.ItemIndex := cbbFiles.Items.Count - 1;
cbbFilesChange(Self);
end;
end; end;
procedure TfrmMain.actCloseFilesExecute(Sender: TObject); procedure TfrmMain.actCloseFilesExecute(Sender: TObject);
@@ -322,17 +322,17 @@ var
begin begin
lblStatus.Caption := sStatusBarTimsExtracting; lblStatus.Caption := sStatusBarTimsExtracting;
FName := ScanResult[cbbFiles.ItemIndex].ScanFile; FName := ScanRes.ScanFile;
IsImage := ScanResult[cbbFiles.ItemIndex].IsImage; IsImage := ScanRes.IsImage;
for I := 1 to ScanResult[cbbFiles.ItemIndex].Count do for I := 1 to ScanRes.Count do
begin begin
ScanTim := ScanResult[cbbFiles.ItemIndex].ScanTim[I - 1]; ScanTim := TimIdx(I - 1);
OFFSET := ScanTim.Position; OFFSET := ScanTim.Position;
SIZE := ScanTim.Size; SIZE := ScanTim.Size;
BIT_MODE := ScanTim.BitMode; BIT_MODE := ScanTim.BitMode;
TIM_NAME := Format(cAutoExtractionTimFormat, [ExtractFileNameWOext(FName), I, BIT_MODE]); TIM_NAME := Format(cAutoExtractionTimFormat, [ExtractJustName(FName), I, BIT_MODE]);
Path := IncludeTrailingPathDelimiter(GetStartDir + cExtractedTimsDir); Path := IncludeTrailingPathDelimiter(GetStartDir + cExtractedTimsDir);
CreateDir(Path); CreateDir(Path);
@@ -351,11 +351,11 @@ procedure TfrmMain.actExtractTimExecute(Sender: TObject);
var var
TIM: PTIM; TIM: PTIM;
begin begin
dlgSaveTIM.FileName := CurrentTIMName(lvList.Selected.Index); dlgSaveTIM.FileName := SelTimName;
if not dlgSaveTIM.Execute then Exit; if not dlgSaveTIM.Execute then Exit;
TIM := CurrentTIM; TIM := SelTim;
SaveTimToFile(dlgSaveTIM.FileName, TIM); SaveTimToFile(dlgSaveTIM.FileName, TIM);
FreeTIM(TIM); FreeTIM(TIM);
end; end;
@@ -376,7 +376,7 @@ begin
if GetFileSizeAPI(dlgOpenFile.FileName) > cTIMMaxSize then Exit; if GetFileSizeAPI(dlgOpenFile.FileName) > cTIMMaxSize then Exit;
ReplaceTimInFile(CurrentFileName, dlgOpenFile.FileName, CurrentTimPos(lvList.Selected.Index), CurrentFileIsImage); ReplaceTimInFile(ScanRes.ScanFile, dlgOpenFile.FileName, TimIdx(ListIdx).Position, ScanRes.IsImage);
lvListClick(Self); lvListClick(Self);
MessageBeep(MB_ICONINFORMATION); MessageBeep(MB_ICONINFORMATION);
end; end;
@@ -405,14 +405,14 @@ end;
procedure TfrmMain.actStretchExecute(Sender: TObject); procedure TfrmMain.actStretchExecute(Sender: TObject);
begin begin
DrawCurrentTIM; DrawSelTim;
end; end;
procedure TfrmMain.actTim2PngExecute(Sender: TObject); procedure TfrmMain.actTim2PngExecute(Sender: TObject);
var var
FName: string; FName: string;
begin begin
FName := CurrentTIMName(lvList.Selected.Index); FName := SelTimName;
FName := ChangeFileExt(FName, '.png'); FName := ChangeFileExt(FName, '.png');
dlgSavePNG.FileName := FName; dlgSavePNG.FileName := FName;
@@ -432,8 +432,8 @@ var
begin begin
if actTimInfo.Enabled then if actTimInfo.Enabled then
begin begin
Index := lvList.Selected.Index; Index := ListIdx;
TIM := CurrentTIM; TIM := SelTim;
if TIMIsGood(TIM) then if TIMIsGood(TIM) then
IsGoodTIM := 'YES' IsGoodTIM := 'YES'
@@ -445,7 +445,7 @@ begin
+ Tab + '%s' + Row + Row + + Tab + '%s' + Row + Row +
'HEADER INFO' + Row + 'Version:' + Tab + '%d' + Row + 'BPP:' + Tab + '%d' 'HEADER INFO' + Row + 'Version:' + Tab + '%d' + Row + 'BPP:' + Tab + '%d'
+ Row + Row, [CurrentTIMName(Index), Index + 1, CurrentTimPos(Index), + Row + Row, [SelTimName, Index + 1, TimIdx(Index).Position,
BppToBitMode(TIM), IsGoodTIM, BppToBitMode(TIM), IsGoodTIM,
GetTimVersion(TIM), GetTimBPP(TIM)]); GetTimVersion(TIM), GetTimBPP(TIM)]);
@@ -487,77 +487,81 @@ end;
procedure TfrmMain.cbbFilesChange(Sender: TObject); procedure TfrmMain.cbbFilesChange(Sender: TObject);
begin begin
lvList.Items.Count := ScanResult[cbbFiles.ItemIndex].Count; lvList.Items.Count := ScanRes.Count;
lvList.Column[0].Caption := Format('# / %d', [lvList.Items.Count]); lvList.Column[0].Caption := Format('# / %d', [lvList.Items.Count]);
lvList.Invalidate; lvList.Invalidate;
lvListClick(Self); lvList.Items[0].Selected := True;
lvList.Items[0].Focused := True;
lvList.SetFocus;
end; end;
procedure TfrmMain.cbbTransparenceModeChange(Sender: TObject); procedure TfrmMain.cbbTransparenceModeChange(Sender: TObject);
begin begin
DrawCurrentTIM; DrawSelTim;
end; end;
procedure TfrmMain.cbbBitModeChange(Sender: TObject); procedure TfrmMain.cbbBitModeChange(Sender: TObject);
begin begin
DrawCurrentTIM; DrawSelTim;
end; end;
procedure TfrmMain.cbbCLUTChange(Sender: TObject); procedure TfrmMain.cbbCLUTChange(Sender: TObject);
begin begin
DrawCurrentTIM; DrawSelTim;
DrawCurrentCLUT; DrawCurrentCLUT;
end; end;
function TfrmMain.CheckForFileOpened(const FileName: string): boolean; function TfrmMain.CheckForFileOpened(const FileName: string): boolean;
var
I: Integer;
begin begin
Result := (cbbFiles.Items.IndexOf(ExtractFileName(FileName)) <> -1); Result := False;
for I := 1 to ScanResult.Count do
if ExtractFileName(ScanResult[I - 1].ScanFile) = ExtractFileName(FileName) then
begin
Result := True;
Exit;
end;
end; end;
procedure TfrmMain.CheckButtonsAndMainMenu; procedure TfrmMain.CheckButtonsAndMainMenu;
begin begin
actCloseFile.Enabled := (cbbFiles.Items.Count <> 0); cbbFiles.Enabled := (cbbFiles.Items.Count <> 0);
actCloseFiles.Enabled := (cbbFiles.Items.Count <> 0);
actTim2Png.Enabled := (PNG^ <> nil); lvList.Enabled := cbbFiles.Enabled;
actExtractList.Enabled := cbbFiles.Enabled;
actCloseFile.Enabled := cbbFiles.Enabled;
actCloseFiles.Enabled := cbbFiles.Enabled;
actReplaceTim.Enabled := (lvList.SelCount = 1); actReplaceTim.Enabled := (lvList.SelCount = 1);
actExtractTim.Enabled := (lvList.SelCount = 1); actTim2Png.Enabled := (PNG^ <> nil) and actReplaceTim.Enabled;
actExtractTim.Enabled := actReplaceTim.Enabled;
cbbCLUT.Enabled := actReplaceTim.Enabled;
cbbTransparenceMode.Enabled := actReplaceTim.Enabled;
cbbBitMode.Enabled := actReplaceTim.Enabled;
chkStretch.Enabled := actReplaceTim.Enabled;
end; end;
function TfrmMain.CurrentTIM(NewBitMode: Integer = $FF): PTIM; function TfrmMain.SelTIM(NewBitMode: Integer = $FF): PTIM;
var var
OFFSET, SIZE: Integer; P: Integer;
begin begin
Result := nil; Result := nil;
if lvList.Selected = nil then Exit; if lvList.Selected = nil then Exit;
OFFSET := CurrentTimPos(lvList.Selected.Index); P := TimIdx(ListIdx).Position;
SIZE := CurrentTimSize(lvList.Selected.Index); Result := LoadTimFromFile(ScanRes.ScanFile, P, ScanRes.IsImage, TimIdx(ListIdx).Size);
Result := LoadTimFromFile(CurrentFileName, OFFSET, CurrentFileIsImage, SIZE);
if NewBitMode = $FF then Exit; if NewBitMode = $FF then Exit;
Result^.HEAD^.bBPP := NewBitMode; Result^.HEAD^.bBPP := NewBitMode;
end; end;
function TfrmMain.CurrentTimBitMode(Index: Integer): Byte; function TfrmMain.SelTimName: string;
begin begin
Result := ScanResult[cbbFiles.ItemIndex].ScanTim[Index].BitMode; Result := Format(cAutoExtractionTimFormat, [ExtractJustName(ScanRes.ScanFile), ListIdx + 1, TimIdx(ListIdx).BitMode]);
end;
function TfrmMain.CurrentTimHeight(Index: Integer): Word;
begin
Result := ScanResult[cbbFiles.ItemIndex].ScanTim[Index].Height;
end;
function TfrmMain.CurrentTIMName(Index: Integer): string;
begin
Result := Format(cAutoExtractionTimFormat, [ExtractFileNameWOext(CurrentFileName), Index + 1, CurrentTimBitMode(Index)]);
end;
function TfrmMain.CurrentTimWidth(Index: Integer): Word;
begin
Result := ScanResult[cbbFiles.ItemIndex].ScanTim[Index].Width;
end; end;
procedure TfrmMain.DrawCurrentCLUT; procedure TfrmMain.DrawCurrentCLUT;
@@ -566,7 +570,7 @@ var
begin begin
ClearGrid(@grdCurrCLUT); ClearGrid(@grdCurrCLUT);
TIM := CurrentTIM; TIM := SelTim;
if TIM = nil then if TIM = nil then
begin begin
grdCurrCLUT.ColCount := 1; grdCurrCLUT.ColCount := 1;
@@ -587,7 +591,7 @@ begin
FreeTIM(TIM); FreeTIM(TIM);
end; end;
procedure TfrmMain.DrawCurrentTIM; procedure TfrmMain.DrawSelTim;
var var
TIM: PTIM; TIM: PTIM;
Index: Integer; Index: Integer;
@@ -604,7 +608,7 @@ begin
mode := $FF; mode := $FF;
end; end;
TIM := CurrentTIM(mode); TIM := SelTim(mode);
if TIM = nil then Exit; if TIM = nil then Exit;
if PNG^ <> nil then if PNG^ <> nil then
@@ -626,24 +630,9 @@ begin
pbTim.Invalidate; pbTim.Invalidate;
end; end;
function TfrmMain.CurrentFileIsImage: boolean; function TfrmMain.ScanRes: TScanResult;
begin begin
Result := ScanResult[cbbFiles.ItemIndex].IsImage; Result := ScanResult[cbbFiles.ItemIndex];
end;
function TfrmMain.CurrentFileName: string;
begin
Result := ScanResult[cbbFiles.ItemIndex].ScanFile;
end;
function TfrmMain.CurrentTimPos(Index: Integer): Integer;
begin
Result := ScanResult[cbbFiles.ItemIndex].ScanTim[Index].Position;
end;
function TfrmMain.CurrentTimSize(Index: Integer): Integer;
begin
Result := ScanResult[cbbFiles.ItemIndex].ScanTim[Index].Size;
end; end;
procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction); procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
@@ -657,7 +646,15 @@ begin
end; end;
procedure TfrmMain.FormCreate(Sender: TObject); procedure TfrmMain.FormCreate(Sender: TObject);
var
hGridRect: TGridRect;
begin begin
hGridRect.Top := -1;
hGridRect.Left := -1;
hGridRect.Right := -1;
hGridRect.Bottom := -1;
grdCurrClut.Selection := hGridRect;
ScanThreads := TList<TScanThread>.Create; ScanThreads := TList<TScanThread>.Create;
ScanResult := TList<TScanResult>.Create; ScanResult := TList<TScanResult>.Create;
New(PNG); New(PNG);
@@ -681,7 +678,7 @@ var
R, G, B: Byte; R, G, B: Byte;
CLUT_COLOR: TCLUT_COLOR; CLUT_COLOR: TCLUT_COLOR;
begin begin
TIM := CurrentTIM; TIM := SelTim;
if TIM = nil then Exit; if TIM = nil then Exit;
SELECTED_CELL := grdCurrCLUT.Row * grdCurrCLUT.ColCount + grdCurrCLUT.Col; SELECTED_CELL := grdCurrCLUT.Row * grdCurrCLUT.ColCount + grdCurrCLUT.Col;
@@ -725,11 +722,11 @@ begin
WriteCLUTColor(TIM, CLUT_NUM, SELECTED_CELL, CLUT_COLOR); WriteCLUTColor(TIM, CLUT_NUM, SELECTED_CELL, CLUT_COLOR);
ReplaceTimInFileFromMemory(CurrentFileName, TIM, CurrentTimPos(lvList.Selected.Index), CurrentFileIsImage); ReplaceTimInFileFromMemory(ScanRes.ScanFile, TIM, TimIdx(ListIdx).Position, ScanRes.IsImage);
FreeTIM(TIM); FreeTIM(TIM);
DrawCurrentTIM; DrawSelTim;
DrawCurrentCLUT; DrawCurrentCLUT;
end; end;
@@ -738,7 +735,7 @@ procedure TfrmMain.grdCurrClutDrawCell(Sender: TObject; ACol, ARow: Integer;
var var
TIM: PTIM; TIM: PTIM;
begin begin
TIM := CurrentTIM; TIM := SelTim;
if TIM = nil then Exit; if TIM = nil then Exit;
if not TIMHasCLUT(TIM) then if not TIMHasCLUT(TIM) then
@@ -752,6 +749,11 @@ begin
FreeTIM(TIM); FreeTIM(TIM);
end; end;
function TfrmMain.ListIdx: Integer;
begin
Result := lvList.Selected.Index;
end;
procedure TfrmMain.ScanDirectory(const Directory: string); procedure TfrmMain.ScanDirectory(const Directory: string);
var var
sRec: TSearchRec; sRec: TSearchRec;
@@ -775,33 +777,34 @@ begin
end; end;
procedure TfrmMain.lvListClick(Sender: TObject); procedure TfrmMain.lvListClick(Sender: TObject);
var
OFFSET, SIZE: Integer;
begin begin
if (lvList.Selected = nil) then Exit; if (lvList.Selected = nil) then Exit;
if (lvList.Items.Count = 0) then Exit; if (lvList.Items.Count = 0) then Exit;
cbbBitMode.ItemIndex := 0; cbbBitMode.ItemIndex := 0;
OFFSET := CurrentTimPos(lvList.Selected.Index);
SIZE := CurrentTimSize(lvList.Selected.Index);
UpdateCLUTInfo; UpdateCLUTInfo;
DrawCurrentTIM; DrawSelTim;
DrawCurrentCLUT; DrawCurrentCLUT;
actTimInfo.Caption := Format('[OFFSET: 0x%x | SIZE: 0x%x]', [OFFSET, SIZE]); actTimInfo.Caption := Format('[OFFSET: 0x%x | SIZE: 0x%x]', [TimIdx(ListIdx).Position, TimIdx(ListIdx).Size]);
actTimInfo.Enabled := True; actTimInfo.Enabled := True;
CheckButtonsAndMainMenu; CheckButtonsAndMainMenu;
end; end;
procedure TfrmMain.lvListData(Sender: TObject; Item: TListItem); procedure TfrmMain.lvListData(Sender: TObject; Item: TListItem);
var
W, H: Word;
begin begin
if cbbFiles.ItemIndex = -1 then Exit; if cbbFiles.ItemIndex = -1 then Exit;
if ScanResult[cbbFiles.ItemIndex] = nil then Exit;
W := TimIdx(Item.Index).Width;
H := TimIdx(Item.Index).Height;
Item.Caption := Format('%.6d', [Item.Index + 1]); Item.Caption := Format('%.6d', [Item.Index + 1]);
Item.SubItems.Add(Format('%dx%d', [CurrentTimWidth(Item.Index), CurrentTimHeight(Item.Index)])); Item.SubItems.Add(Format('%dx%d', [W, H]));
Item.SubItems.Add(Format('%d', [CurrentTimBitMode(Item.Index)])); Item.SubItems.Add(Format('%d', [TimIdx(Item.Index).BitMode]));
end; end;
procedure TfrmMain.lvListSelectItem(Sender: TObject; Item: TListItem; procedure TfrmMain.lvListSelectItem(Sender: TObject; Item: TListItem;
@@ -817,13 +820,17 @@ begin
lvList.Column[0].Caption := Format('# / %d', [Count]); lvList.Column[0].Caption := Format('# / %d', [Count]);
end; end;
function TfrmMain.TimIdx(Index: Integer): TScanTim;
begin
Result := ScanRes.ScanTim[Index];
end;
procedure TfrmMain.ScanFile(const FileName: string); procedure TfrmMain.ScanFile(const FileName: string);
begin begin
if CheckForFileOpened(FileName) then if CheckForFileOpened(FileName) then
begin begin
cbbFiles.ItemIndex := cbbFiles.Items.IndexOf(ExtractFileName(FileName)); cbbFiles.ItemIndex := cbbFiles.Items.IndexOf(FileName);
btnStopScan.Enabled := False; btnStopScan.Enabled := False;
cbbFiles.Enabled := True;
CheckButtonsAndMainMenu; CheckButtonsAndMainMenu;
Exit; Exit;
end; end;
@@ -833,36 +840,26 @@ begin
ScanThreads.Last.Priority := tpNormal; ScanThreads.Last.Priority := tpNormal;
ScanThreads.Last.OnTerminate := ScanFinished; ScanThreads.Last.OnTerminate := ScanFinished;
if not ScanThreads.First.Started then ScanThreads.Last.Start;
ScanThreads.First.Start;
end; end;
procedure TfrmMain.ScanFinished(Sender: TObject); procedure TfrmMain.ScanFinished(Sender: TObject);
begin begin
ScanThreads.Delete(0); ScanThreads.Remove(Sender as TScanThread);
if ScanResult.Last.Count > 0 then if ScanThreads.Count <> 0 then Exit;
cbbFiles.Items.Add(ScanResult.Last.ScanFile)
else
ScanResult.Delete(ScanResult.Count - 1);
if ScanThreads.Count > 0 then if ScanResult.Count <> 0 then SetListCount(ScanResult.Last.Count);
CheckButtonsAndMainMenu;
if cbbFiles.Enabled then
begin begin
ScanThreads.First.Start; cbbFiles.ItemIndex := cbbFiles.Items.Count - 1;
Exit; cbbFilesChange(Self);
end; end;
SetListCount(ScanResult.Last.Count);
cbbFiles.ItemIndex := cbbFiles.Items.Count - 1;
lblStatus.Caption := '';
cbbFiles.Enabled := True;
pnlList.Enabled := True;
actExtractList.Enabled := True;
btnStopScan.Enabled := False; btnStopScan.Enabled := False;
lvList.Items[0].Selected := True;
lvList.Items[0].Focused := True;
lvList.SetFocus;
end; end;
procedure TfrmMain.ScanPath(const Path: string); procedure TfrmMain.ScanPath(const Path: string);
@@ -889,7 +886,7 @@ var
TIM: PTIM; TIM: PTIM;
I, CLUTS: Word; I, CLUTS: Word;
begin begin
TIM := CurrentTIM; TIM := SelTim;
if TIM = nil then Exit; if TIM = nil then Exit;
CLUTS := GetTIMClutsCount(TIM); CLUTS := GetTIMClutsCount(TIM);

View File

@@ -9,10 +9,7 @@ type
TScanThread = class(Classes.TThread) TScanThread = class(Classes.TThread)
private private
{ Private declarations } { Private declarations }
pScanFile: string;
pIsImage: boolean;
pScanResult: TScanResult; pScanResult: TScanResult;
pTims: Integer;
pFileSize: Integer; pFileSize: Integer;
pFilePos: Integer; pFilePos: Integer;
pStatusText: string; pStatusText: string;
@@ -23,6 +20,7 @@ type
pStopScan: boolean; pStopScan: boolean;
procedure SetStatusText; procedure SetStatusText;
procedure StartScan; procedure StartScan;
procedure FinishScan;
procedure UpdateProgressBar; procedure UpdateProgressBar;
procedure AddResult(TIM: PTIM); procedure AddResult(TIM: PTIM);
procedure ClearSectorBuffer(SectorBuffer, ClearBuffer: PBytesArray); procedure ClearSectorBuffer(SectorBuffer, ClearBuffer: PBytesArray);
@@ -30,7 +28,7 @@ type
procedure Execute; override; procedure Execute; override;
public public
constructor Create(const FileToScan: string; ImageScan: boolean); constructor Create(const FileToScan: string; ImageScan: boolean);
property Terminated; //property Started: boolean read pStarted write pStarted;
property StopScan: boolean write pStopScan; property StopScan: boolean write pStopScan;
end; end;
@@ -52,13 +50,13 @@ begin
FreeOnTerminate := True; FreeOnTerminate := True;
pClearBufferPosition := 0; pClearBufferPosition := 0;
pFilePos := 0; pFilePos := 0;
pTims := 0;
pFileSize := GetFileSizeAPI(FileToScan); pFileSize := GetFileSizeAPI(FileToScan);
pStatusText := ''; pStatusText := '';
pStopScan := False; pStopScan := False;
pScanFile := FileToScan; pScanResult := TScanResult.Create;
pIsImage := ImageScan; pScanResult.ScanFile := FileToScan;
pScanResult.IsImage := ImageScan;
end; end;
procedure TScanThread.AddResult(TIM: PTIM); procedure TScanThread.AddResult(TIM: PTIM);
@@ -74,7 +72,6 @@ begin
pScanResult.Count := TIM^.dwTimNumber; pScanResult.Count := TIM^.dwTimNumber;
pScanResult.ScanTim[pScanResult.Count - 1] := ScanTim; pScanResult.ScanTim[pScanResult.Count - 1] := ScanTim;
Inc(pTims);
end; end;
procedure TScanThread.Execute; procedure TScanThread.Execute;
@@ -160,14 +157,21 @@ begin
FreeMemory(SectorBuffer); FreeMemory(SectorBuffer);
FreeMemory(ClearBuffer); FreeMemory(ClearBuffer);
Synchronize(UpdateProgressBar);
pSrcFileStream.Free; pSrcFileStream.Free;
pFilePos := 0; pFilePos := 0;
Synchronize(UpdateProgressBar);
pStatusText := ''; pStatusText := '';
Synchronize(SetStatusText);
Synchronize(FinishScan);
end;
procedure TScanThread.FinishScan;
begin
UpdateProgressBar;
SetStatusText;
if pScanResult.Count = 0 then Exit;
frmMain.ScanResult.Add(pScanResult);
frmMain.cbbFiles.Items.Add(pScanResult.ScanFile);
end; end;
procedure TScanThread.SetStatusText; procedure TScanThread.SetStatusText;
@@ -179,22 +183,17 @@ procedure TScanThread.StartScan;
begin begin
frmMain.btnStopScan.Enabled := True; frmMain.btnStopScan.Enabled := True;
frmMain.cbbFiles.Enabled := False; frmMain.cbbFiles.Enabled := False;
frmMain.pnlList.Enabled := False; frmMain.lvList.Enabled := False;
frmMain.actExtractList.Enabled := False; frmMain.actExtractList.Enabled := False;
frmMain.pbProgress.Max := GetFileSizeAPI(pScanFile); frmMain.pbProgress.Max := GetFileSizeAPI(pScanResult.ScanFile);
frmMain.pbProgress.Position := 0; frmMain.pbProgress.Position := 0;
frmMain.ScanResult.Add(TScanResult.Create);
pScanResult := frmMain.ScanResult.Last;
pScanResult.ScanFile := pScanFile;
pScanResult.IsImage := pIsImage;
end; end;
procedure TScanThread.UpdateProgressBar; procedure TScanThread.UpdateProgressBar;
begin begin
frmMain.pbProgress.Position := pFilePos; frmMain.pbProgress.Position := pFilePos;
frmMain.lvList.Column[0].Caption := Format('# / %d', [pTims]); frmMain.lvList.Column[0].Caption := Format('# / %d', [pScanResult.Count]);
end; end;
procedure TScanThread.ClearSectorBuffer(SectorBuffer, ClearBuffer: PBytesArray); procedure TScanThread.ClearSectorBuffer(SectorBuffer, ClearBuffer: PBytesArray);