Persona/tim2view
3
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Reviewed, simplified code.

Browse Source
This commit is contained in:
meffi@lab313.ru
2014-04-14 23:48:39 +00:00
parent 90c0e78a66
commit 519a7f2e86
15 changed files with 1058 additions and 2346 deletions
Download Patch File Download Diff File Expand all files Collapse all files

20
tim2view.dpr
View File

@@ -7,16 +7,16 @@ uses
Vcl.Styles, Vcl.Styles,
ecc in 'units\ecc.pas', ecc in 'units\ecc.pas',
edc in 'units\edc.pas', edc in 'units\edc.pas',
uCDIMAGE in 'units\uCDIMAGE.pas', umain in 'Units\umain.pas' {frmMain},
uCommon in 'Units\uCommon.pas', ucdimage in 'units\ucdimage.pas',
uMain in 'Units\uMain.pas' {frmMain}, ucommon in 'units\ucommon.pas',
uScanThread in 'Units\uScanThread.pas', udrawtim in 'units\udrawtim.pas',
uTIM in 'units\uTIM.pas', uscanresult in 'units\uscanresult.pas',
uDrawTIM in 'units\uDrawTIM.pas', uscanthread in 'units\uscanthread.pas',
uEventWaitThread in 'units\uEventWaitThread.pas', usettings in 'units\usettings.pas',
uScanResult in 'units\uScanResult.pas', utim in 'units\utim.pas',
uSettings in 'units\uSettings.pas', ueventwaitthread in 'units\ueventwaitthread.pas',
uBrowseForFolder in 'units\uBrowseForFolder.pas'; udirselect in 'units\udirselect.pas';
{$R *.res} {$R *.res}

30
tim2view.dproj
View File

@@ -126,11 +126,8 @@
</PropertyGroup> </PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''"> <PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
<DCC_IMPLICIT_STRING_CAST>false</DCC_IMPLICIT_STRING_CAST> <DCC_IMPLICIT_STRING_CAST>false</DCC_IMPLICIT_STRING_CAST>
<DCC_LocalDebugSymbols>true</DCC_LocalDebugSymbols>
<DCC_MapFile>3</DCC_MapFile>
<DCC_MaxStackSize>10485760</DCC_MaxStackSize>
<VerInfo_Keys>CompanyName=Lab 313;FileDescription=The best TIMs tool ever!:);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys> <VerInfo_Keys>CompanyName=Lab 313;FileDescription=The best TIMs tool ever!:);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<DCC_DebugInformation>true</DCC_DebugInformation> <DCC_DebugInformation>false</DCC_DebugInformation>
<VerInfo_Locale>1033</VerInfo_Locale> <VerInfo_Locale>1033</VerInfo_Locale>
<DCC_IOChecking>false</DCC_IOChecking> <DCC_IOChecking>false</DCC_IOChecking>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo> <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
@@ -139,9 +136,7 @@
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo> <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<VerInfo_Locale>1033</VerInfo_Locale> <VerInfo_Locale>1033</VerInfo_Locale>
<DCC_IMPLICIT_STRING_CAST>false</DCC_IMPLICIT_STRING_CAST> <DCC_IMPLICIT_STRING_CAST>false</DCC_IMPLICIT_STRING_CAST>
<DCC_MapFile>3</DCC_MapFile> <DCC_DebugInformation>false</DCC_DebugInformation>
<DCC_DebugInformation>true</DCC_DebugInformation>
<DCC_LocalDebugSymbols>true</DCC_LocalDebugSymbols>
</PropertyGroup> </PropertyGroup>
<ItemGroup> <ItemGroup>
<DelphiCompile Include="$(MainSource)"> <DelphiCompile Include="$(MainSource)">
@@ -149,18 +144,19 @@
</DelphiCompile> </DelphiCompile>
<DCCReference Include="units\ecc.pas"/> <DCCReference Include="units\ecc.pas"/>
<DCCReference Include="units\edc.pas"/> <DCCReference Include="units\edc.pas"/>
<DCCReference Include="units\uCDIMAGE.pas"/> <DCCReference Include="Units\umain.pas">
<DCCReference Include="Units\uCommon.pas"/>
<DCCReference Include="Units\uMain.pas">
<Form>frmMain</Form> <Form>frmMain</Form>
</DCCReference> </DCCReference>
<DCCReference Include="Units\uScanThread.pas"/> <DCCReference Include="units\ucdimage.pas"/>
<DCCReference Include="units\uTIM.pas"/> <DCCReference Include="units\ucommon.pas"/>
<DCCReference Include="units\uDrawTIM.pas"/> <DCCReference Include="units\udrawtim.pas"/>
<DCCReference Include="units\uEventWaitThread.pas"/> <DCCReference Include="units\uscanresult.pas"/>
<DCCReference Include="units\uScanResult.pas"/> <DCCReference Include="units\uscanthread.pas"/>
<DCCReference Include="units\uSettings.pas"/> <DCCReference Include="units\usettings.pas"/>
<DCCReference Include="units\uBrowseForFolder.pas"/> <DCCReference Include="units\utim.pas"/>
<DCCReference Include="units\ueventwaitthread.pas"/>
<DCCReference Include="units\udirselect.pas"/>
<None Include="units\l2sq_table.inc"/>
<BuildConfiguration Include="Release"> <BuildConfiguration Include="Release">
<Key>Cfg_2</Key> <Key>Cfg_2</Key>
<CfgParent>Base</CfgParent> <CfgParent>Base</CfgParent>

4
units/ecc.pas
View File

@@ -3,7 +3,7 @@ unit ecc;
interface interface
uses uses
uCommon; ucommon;
const const
L1_RAW = 24; L1_RAW = 24;
@@ -19,7 +19,7 @@ Procedure encode_L2_P(Data: PBytesArray);
implementation implementation
{$INCLUDE l2sq_table.pas} {$INCLUDE l2sq_table.inc}
Procedure encode_L2_Q(Data: PBytesArray); Procedure encode_L2_Q(Data: PBytesArray);
var var

1164
units/l2sq_table.pas
View File

File diff suppressed because it is too large Load Diff

14
units/uCDIMAGE.pas
View File

@@ -1,9 +1,9 @@
unit uCDIMAGE; unit ucdimage;
interface interface
uses uses
Windows, uTIM; utim;
const const
cSectorHeaderSize = 12; cSectorHeaderSize = 12;
@@ -40,7 +40,7 @@ procedure ReplaceTimInFileFromMemory(const FileName: string; TIM: PTIM;
implementation implementation
uses uses
uCommon, ecc, edc, System.SysUtils, System.Classes; ucommon, ecc, edc, classes, sysutils, windows;
function bin2bcd(P: Integer): byte; function bin2bcd(P: Integer): byte;
begin begin
@@ -72,10 +72,10 @@ var
tmp: TFileStream; tmp: TFileStream;
begin begin
Result := False; Result := False;
Sz := GetFileSizeAPI(FileName); Sz := FileSize(FileName);
tmp := nil;
if (Sz > cMaxFileSize) or (Sz = 0) then if (Sz > cMaxFileSize) or (Sz = 0) then Exit;
Exit;
pFile := GetMemory(cSectorHeaderSize); pFile := GetMemory(cSectorHeaderSize);
@@ -214,7 +214,7 @@ var
begin begin
Result := False; Result := False;
SIZE := GetFileSizeAPI(TimToInsert); SIZE := FileSize(TimToInsert);
P := 0; P := 0;
TIM := LoadTimFromFile(TimToInsert, P, False, SIZE); TIM := LoadTimFromFile(TimToInsert, P, False, SIZE);
// SaveTimToFile('test.tim', TIM); // SaveTimToFile('test.tim', TIM);

74
units/uCommon.pas
View File

@@ -1,13 +1,9 @@
unit uCommon; unit ucommon;
interface interface
uses
Windows;
const const
cProgramName = 'Tim2View by [Lab 313]'; cProgramName = 'Tim2View r55 by [Lab 313]';
cProgramVersion = '2.0 Release';
cExtractedTimsDir = 'TIMS'; cExtractedTimsDir = 'TIMS';
cExtractedPngsDir = 'PNGS'; cExtractedPngsDir = 'PNGS';
cMaxFileSize = $2EAEED80; cMaxFileSize = $2EAEED80;
@@ -29,19 +25,16 @@ type
TBytesArray = array [0 .. cMaxFileSize - 1] of byte; TBytesArray = array [0 .. cMaxFileSize - 1] of byte;
PBytesArray = ^TBytesArray; PBytesArray = ^TBytesArray;
function GetFileSizeAPI(const FileName: string): Int64;
function CheckFileExists(const FileName: string): boolean;
// function cHex2Int( const Value : string) : Integer;
function ExtractJustName(const Path: string): string;
procedure Text2Clipboard(const S: string); procedure Text2Clipboard(const S: string);
function ExtractJustName(const Path: string): 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;
function GetCoreCount: Integer; function GetCoreCount: Integer;
function FileSize(const FileName: string): Integer;
implementation implementation
uses uses sysutils, windows, clipbrd;
System.SysUtils, Clipbrd;
function GetCoreCount: Integer; function GetCoreCount: Integer;
var var
@@ -51,6 +44,11 @@ begin
Result := SystemInfo.dwNumberOfProcessors; Result := SystemInfo.dwNumberOfProcessors;
end; end;
procedure Text2Clipboard(const S: string);
begin
Clipboard.AsText := S;
end;
function Min(A, B: Integer): Integer; function Min(A, B: Integer): Integer;
begin begin
if A < B then if A < B then
@@ -67,61 +65,13 @@ begin
Result := B; Result := B;
end; end;
procedure Text2Clipboard(const S: string);
begin
Clipboard.AsText := S;
end;
function ExtractJustName(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)));
end; end;
function Hex2Int(const Value: string): Integer; function FileSize(const FileName: string): Integer;
var
I: Integer;
begin
Result := 0;
I := 1;
if Value = '' then
Exit; { >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> }
if Value[1] = '$' then
Inc(I);
while I <= Length(Value) do
begin
if (Value[I] >= '0') and (Value[I] <= '9') then
Result := (Result shl 4) or (Ord(Value[I]) - Ord('0'))
else if (Value[I] >= 'A') and (Value[I] <= 'F') then
Result := (Result shl 4) or (Ord(Value[I]) - Ord('A') + 10)
else if (Value[I] >= 'a') and (Value[I] <= 'f') then
Result := (Result shl 4) or (Ord(Value[I]) - Ord('a') + 10)
else
break;
Inc(I);
end;
end;
function CopyEnd(const S: string; Idx: Integer): string;
begin
Result := Copy(S, Idx, MaxInt);
end;
function cHex2Int(const Value: string): Integer;
begin
if (Length(Value) > 2) and (Value[1] = '0') and
((Value[2] = 'x') or (Value[2] = 'X')) then
Result := Hex2Int(CopyEnd(Value, 3))
else
Result := Hex2Int(Value);
end;
function CheckFileExists(const FileName: string): boolean;
begin
Result := FileExists(FileName);
end;
function GetFileSizeAPI(const FileName: string): Int64;
var var
FindData: TWin32FindData; FindData: TWin32FindData;
hFind: THandle; hFind: THandle;
@@ -134,7 +84,7 @@ begin
Windows.FindClose(hFind); Windows.FindClose(hFind);
if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
Result := FindData.nFileSizeLow; Result := Integer(FindData.nFileSizeLow);
end; end;
end; end;

86
units/uDrawTIM.pas
View File

@@ -1,30 +1,25 @@
unit uDrawTIM; unit udrawtim;
interface interface
uses uses
Vcl.Graphics, uTIM, System.Types, Vcl.Imaging.pngimage, Vcl.Grids; utim, Grids, Graphics, types, pngimage;
type type
PCanvas = ^TCanvas; PCanvas = ^TCanvas;
PPNGImage = ^TPngImage; PPNG = ^TPngImage; { TODO : Replace with another type }
PDrawGrid = ^TDrawGrid; PDrawGrid = ^TDrawGrid;
procedure DrawTIM(TIM: PTIM; CLUT_NUM: Integer; ACanvas: PCanvas; Rect: TRect; procedure TimToPNG(TIM: PTIM; CLUT_NUM: Integer; var PNG: PPNG; TranspMode: Byte);
var PNG: PPNGImage; TranspMode: Byte); procedure DrawClutCell(TIM: PTIM; CLUT_NUM: Integer; Grid: PDrawGrid; X, Y: Integer);
procedure TimToPNG(TIM: PTIM; CLUT_NUM: Integer; var PNG: PPNGImage;
TranspMode: Byte);
procedure DrawPNG(PNG: PPNGImage; ACanvas: PCanvas; Rect: TRect);
procedure DrawClutCell(TIM: PTIM; CLUT_NUM: Integer; Grid: PDrawGrid;
X, Y: Integer);
procedure DrawCLUT(TIM: PTIM; CLUT_NUM: Integer; Grid: PDrawGrid); procedure DrawCLUT(TIM: PTIM; CLUT_NUM: Integer; Grid: PDrawGrid);
procedure ClearCanvas(CHandle: THandle; Rect: TRect); procedure ClearCanvas(ACanvas: PCanvas; Rect: TRect);
procedure ClearGrid(Grid: PDrawGrid); procedure ClearGrid(Grid: PDrawGrid);
implementation implementation
uses uses
Windows, uCommon; ucommon, windows;
function PrepareCLUT(TIM: PTIM; CLUT_NUM: Integer): PCLUT_COLORS; function PrepareCLUT(TIM: PTIM; CLUT_NUM: Integer): PCLUT_COLORS;
var var
@@ -95,8 +90,24 @@ begin
end; end;
end; end;
procedure TimToPNG(TIM: PTIM; CLUT_NUM: Integer; var PNG: PPNGImage; procedure ClearCanvas(ACanvas: PCanvas; Rect: TRect);
TranspMode: Byte); begin
ACanvas^.FillRect(Rect);
end;
procedure ClearGrid(Grid: PDrawGrid);
var
X, Y, W, H: Word;
begin
W := Grid^.ColCount;
H := Grid^.RowCount;
for Y := 1 to H do
for X := 1 to W do
ClearCanvas(@Grid^.Canvas, Grid^.CellRect(X - 1, Y - 1));
end;
procedure TimToPNG(TIM: PTIM; CLUT_NUM: Integer; var PNG: PPNG; TranspMode: Byte);
var var
RW, RH, CW: Word; RW, RH, CW: Word;
CLUT_DATA: PCLUT_COLORS; CLUT_DATA: PCLUT_COLORS;
@@ -111,7 +122,7 @@ begin
RH := GetTimHeight(TIM); RH := GetTimHeight(TIM);
PNG^ := TPngImage.CreateBlank(COLOR_RGBALPHA, 16, RW, RH); PNG^ := TPngImage.CreateBlank(COLOR_RGBALPHA, 16, RW, RH);
PNG^.CompressionLevel := 9; PNG^.CompressionLevel := 0;
PNG^.Filters := []; PNG^.Filters := [];
CLUT_DATA := PrepareCLUT(TIM, CLUT_NUM); CLUT_DATA := PrepareCLUT(TIM, CLUT_NUM);
@@ -182,8 +193,6 @@ begin
end; end;
end; end;
PNG^.AlphaScanline[Y - 1]^[X - 1] := ALPHA;
if ALPHA = 0 then if ALPHA = 0 then
begin begin
B := 0; B := 0;
@@ -191,6 +200,7 @@ begin
R := 0; R := 0;
end; end;
PNG^.AlphaScanline[Y - 1]^[X - 1] := ALPHA;
pRGBLine(PNG^.Scanline[Y - 1])^[X - 1].rgbtBlue := B; pRGBLine(PNG^.Scanline[Y - 1])^[X - 1].rgbtBlue := B;
pRGBLine(PNG^.Scanline[Y - 1])^[X - 1].rgbtGreen := G; pRGBLine(PNG^.Scanline[Y - 1])^[X - 1].rgbtGreen := G;
pRGBLine(PNG^.Scanline[Y - 1])^[X - 1].rgbtRed := R; pRGBLine(PNG^.Scanline[Y - 1])^[X - 1].rgbtRed := R;
@@ -202,41 +212,6 @@ begin
Dispose(IMAGE_DATA); Dispose(IMAGE_DATA);
end; end;
procedure DrawTIM(TIM: PTIM; CLUT_NUM: Integer; ACanvas: PCanvas; Rect: TRect;
var PNG: PPNGImage; TranspMode: Byte);
begin
TimToPNG(TIM, CLUT_NUM, PNG, TranspMode);
DrawPNG(PNG, ACanvas, Rect);
end;
procedure ClearCanvas(CHandle: THandle; Rect: TRect);
begin
PatBlt(CHandle, Rect.Left, Rect.Top, Rect.Width, Rect.Height, WHITENESS);
end;
procedure ClearGrid(Grid: PDrawGrid);
var
X, Y, W, H: Word;
begin
W := Grid^.ColCount;
H := Grid^.RowCount;
for Y := 1 to H do
for X := 1 to W do
ClearCanvas(Grid^.Canvas.Handle, Grid^.CellRect(X - 1, Y - 1));
end;
procedure DrawPNG(PNG: PPNGImage; ACanvas: PCanvas; Rect: TRect);
begin
if PNG^ = nil then
Exit;
Rect.Width := PNG^.Width;
Rect.Height := PNG^.Height;
PNG^.Draw(ACanvas^, Rect);
end;
procedure DrawClutCell(TIM: PTIM; CLUT_NUM: Integer; Grid: PDrawGrid; procedure DrawClutCell(TIM: PTIM; CLUT_NUM: Integer; Grid: PDrawGrid;
X, Y: Integer); X, Y: Integer);
var var
@@ -256,7 +231,6 @@ begin
Rect := Grid^.CellRect(X, Y); Rect := Grid^.CellRect(X, Y);
ClearCanvas(Grid^.Canvas.Handle, Rect);
Grid^.Canvas.Brush.COLOR := RGB(R, G, B); Grid^.Canvas.Brush.COLOR := RGB(R, G, B);
Grid^.Canvas.FillRect(Rect); Grid^.Canvas.FillRect(Rect);
@@ -275,9 +249,9 @@ begin
begin begin
Grid^.Canvas.Brush.COLOR := clWhite; Grid^.Canvas.Brush.COLOR := clWhite;
if ALPHA = 0 then if ALPHA = 0 then
Rect.Height := Rect.Height div 2 Rect.Bottom := Rect.Top + ((Rect.Bottom - Rect.Top) div 2)
else else
Rect.Width := Rect.Width div 2; Rect.Right := Rect.Left + ((Rect.Right - Rect.Left) div 2);
Grid^.Canvas.FillRect(Rect); Grid^.Canvas.FillRect(Rect);
end; end;
@@ -299,7 +273,7 @@ begin
for Y := 1 to ROWS do for Y := 1 to ROWS do
for X := 1 to COLS do for X := 1 to COLS do
begin begin
ClearCanvas(Grid^.Canvas.Handle, Grid^.CellRect(X - 1, Y - 1)); ClearCanvas(@Grid^.Canvas, Grid^.CellRect(X - 1, Y - 1));
DrawClutCell(TIM, CLUT_NUM, Grid, X - 1, Y - 1); DrawClutCell(TIM, CLUT_NUM, Grid, X - 1, Y - 1);
end; end;
end; end;

2
units/uEventWaitThread.pas
View File

@@ -1,4 +1,4 @@
unit uEventWaitThread; unit ueventwaitthread;
interface interface

31
units/uMain.dfm
View File

@@ -548,7 +548,7 @@ object frmMain: TfrmMain
DropDownCount = 30 DropDownCount = 30
Enabled = False Enabled = False
TabOrder = 0 TabOrder = 0
OnChange = cbbFilesChange OnChange = actChangeFileExecute
OnCloseUp = actReturnFocusExecute OnCloseUp = actReturnFocusExecute
end end
object pnlMain: TPanel object pnlMain: TPanel
@@ -576,9 +576,9 @@ object frmMain: TfrmMain
TabOrder = 0 TabOrder = 0
object lvList: TListView object lvList: TListView
Left = 0 Left = 0
Top = 49 Top = 27
Width = 240 Width = 240
Height = 432 Height = 454
Align = alClient Align = alClient
Columns = < Columns = <
item item
@@ -611,17 +611,14 @@ object frmMain: TfrmMain
PopupMenu = pmList PopupMenu = pmList
TabOrder = 0 TabOrder = 0
ViewStyle = vsReport ViewStyle = vsReport
OnChange = lvListChange
OnData = lvListData OnData = lvListData
ExplicitLeft = 1 OnSelectItem = lvListSelectItem
ExplicitTop = 28
ExplicitHeight = 448
end end
object pnlExtractAll: TPanel object pnlExtractAll: TPanel
Left = 0 Left = 0
Top = 0 Top = 0
Width = 240 Width = 240
Height = 49 Height = 27
Align = alTop Align = alTop
BevelOuter = bvLowered BevelOuter = bvLowered
TabOrder = 1 TabOrder = 1
@@ -629,18 +626,17 @@ object frmMain: TfrmMain
Left = 139 Left = 139
Top = 1 Top = 1
Width = 100 Width = 100
Height = 47 Height = 25
Action = actExtractPNGs Action = actExtractPNGs
Align = alRight Align = alRight
TabOrder = 0 TabOrder = 0
WordWrap = True WordWrap = True
ExplicitLeft = 128
end end
object btnExtractPNGs: TButton object btnExtractPNGs: TButton
Left = 1 Left = 1
Top = 1 Top = 1
Width = 100 Width = 100
Height = 47 Height = 25
Action = actExtractTIMs Action = actExtractTIMs
Align = alLeft Align = alLeft
TabOrder = 1 TabOrder = 1
@@ -740,7 +736,7 @@ object frmMain: TfrmMain
ParentDoubleBuffered = False ParentDoubleBuffered = False
TabOrder = 1 TabOrder = 1
Text = 'Real' Text = 'Real'
OnChange = actDrawSelectedTimExecute OnChange = cbbBitModeChange
OnCloseUp = actReturnFocusExecute OnCloseUp = actReturnFocusExecute
Items.Strings = ( Items.Strings = (
'Real' 'Real'
@@ -789,7 +785,7 @@ object frmMain: TfrmMain
DropDownCount = 16 DropDownCount = 16
ParentDoubleBuffered = False ParentDoubleBuffered = False
TabOrder = 3 TabOrder = 3
OnChange = cbbCLUTChange OnChange = actChangeClutIdxExecute
end end
end end
end end
@@ -957,24 +953,27 @@ object frmMain: TfrmMain
OnExecute = actAssocTimsExecute OnExecute = actAssocTimsExecute
end end
object actExtractTIMs: TAction object actExtractTIMs: TAction
Caption = 'Extract all &TIMs'#13#10'(Shift+F2)' Caption = 'Extract all &TIMs'
Enabled = False Enabled = False
ShortCut = 8305 ShortCut = 8305
OnExecute = actExtractTIMsExecute OnExecute = actExtractTIMsExecute
end end
object actExtractPNGs: TAction object actExtractPNGs: TAction
Caption = '&Extract all PNGs'#13#10'(Shift+F4)' Caption = '&Extract all PNGs'#13#10
Enabled = False Enabled = False
ShortCut = 8307 ShortCut = 8307
OnExecute = actExtractPNGsExecute OnExecute = actExtractPNGsExecute
end end
object actChangeClutIdx: TAction object actChangeClutIdx: TAction
OnExecute = actChangeClutIdxExecute
end end
object actReturnFocus: TAction object actReturnFocus: TAction
OnExecute = actReturnFocusExecute OnExecute = actReturnFocusExecute
end end
object actDrawSelectedTim: TAction object actDrawSelectedTim: TAction
OnExecute = actDrawSelectedTimExecute end
object actChangeFile: TAction
OnExecute = actChangeFileExecute
end end
end end
object pmList: TPopupMenu object pmList: TPopupMenu

1720
units/uMain.pas
View File

File diff suppressed because it is too large Load Diff

21
units/uScanResult.pas
View File

@@ -1,9 +1,12 @@
unit uScanResult; unit uscanresult;
interface interface
uses
generics.collections;
type type
TScanTim = record TTimInfo = record
Position: Integer; Position: Integer;
Size: Integer; Size: Integer;
Width: Integer; Width: Integer;
@@ -13,18 +16,17 @@ type
Good: Boolean; Good: Boolean;
end; end;
type
TScanResult = class(TObject) TScanResult = class(TObject)
private private
pScanFile: string; pScanFile: string;
pIsImage: Boolean; pIsImage: Boolean;
pCount: Integer; pCount: Integer;
pTims: array of TScanTim; pTims: array of TTimInfo;
procedure fSetCount(Value: Integer); procedure fSetCount(Value: Integer);
function fGetTim(Index: Integer): TScanTim; function fGetTim(Index: Integer): TTimInfo;
procedure fSetTim(Index: Integer; Value: TScanTim); procedure fSetTim(Index: Integer; Value: TTimInfo);
public public
constructor Create; constructor Create;
@@ -34,8 +36,9 @@ type
property IsImage: Boolean read pIsImage write pIsImage; property IsImage: Boolean read pIsImage write pIsImage;
property Count: Integer read pCount write fSetCount; property Count: Integer read pCount write fSetCount;
property ScanTim[index: Integer]: TScanTim read fGetTim write fSetTim; property ScanTim[index: Integer]: TTimInfo read fGetTim write fSetTim;
end; end;
TScanResultList = TList<TScanResult>;
implementation implementation
@@ -58,7 +61,7 @@ begin
inherited; inherited;
end; end;
function TScanResult.fGetTim(Index: Integer): TScanTim; function TScanResult.fGetTim(Index: Integer): TTimInfo;
begin begin
Result := pTims[Index]; Result := pTims[Index];
end; end;
@@ -69,7 +72,7 @@ begin
SetLength(pTims, Value); SetLength(pTims, Value);
end; end;
procedure TScanResult.fSetTim(Index: Integer; Value: TScanTim); procedure TScanResult.fSetTim(Index: Integer; Value: TTimInfo);
begin begin
pTims[Index] := Value; pTims[Index] := Value;
end; end;

29
units/uScanThread.pas
View File

@@ -1,12 +1,12 @@
unit uScanThread; unit uscanthread;
interface interface
uses uses
Classes, Windows, uCommon, uTIM, uScanResult; ucommon, utim, uscanresult, classes, generics.collections;
type type
TScanThread = class(Classes.TThread) TScanThread = class(TThread)
private private
{ Private declarations } { Private declarations }
pScanResult: TScanResult; pScanResult: TScanResult;
@@ -28,18 +28,17 @@ type
procedure Execute; override; procedure Execute; override;
public public
constructor Create(const FileToScan: string; ImageScan: boolean); constructor Create(const FileToScan: string; ImageScan: boolean);
//property Started: boolean read pStarted write pStarted;
property StopScan: boolean read pStopScan write pStopScan; property StopScan: boolean read pStopScan write pStopScan;
end; end;
TScanThreadList = TList<TScanThread>;
implementation implementation
uses uses
uMain, uCDIMAGE, System.SysUtils; umain, ucdimage, sysutils;
const const
cClearBufferSize = ((cTIMMaxSize div cSectorDataSize) + 1) * cClearBufferSize = ((cTIMMaxSize div cSectorDataSize) + 1) * cSectorDataSize * 2;
cSectorDataSize * 2;
cSectorBufferSize = (cClearBufferSize div cSectorDataSize) * cSectorSize; cSectorBufferSize = (cClearBufferSize div cSectorDataSize) * cSectorSize;
{ TScanThread } { TScanThread }
@@ -50,7 +49,7 @@ begin
FreeOnTerminate := True; FreeOnTerminate := True;
pClearBufferPosition := 0; pClearBufferPosition := 0;
pFilePos := 0; pFilePos := 0;
pFileSize := GetFileSizeAPI(FileToScan); pFileSize := FileSize(FileToScan);
pStatusText := ''; pStatusText := '';
pStopScan := False; pStopScan := False;
@@ -61,7 +60,7 @@ end;
procedure TScanThread.AddResult(TIM: PTIM); procedure TScanThread.AddResult(TIM: PTIM);
var var
ScanTim: TScanTim; ScanTim: TTimInfo;
begin begin
ScanTim.Position := TIM^.dwTimPosition; ScanTim.Position := TIM^.dwTimPosition;
ScanTim.Size := TIM^.dwSIZE; ScanTim.Size := TIM^.dwSIZE;
@@ -88,6 +87,8 @@ var
pRealBufSize, pTimPosition, pTIMNumber: Integer; pRealBufSize, pTimPosition, pTIMNumber: Integer;
begin begin
Synchronize(StartScan); Synchronize(StartScan);
SectorBuffer := nil;
ClearBuffer := nil;
try try
if pScanResult.IsImage then if pScanResult.IsImage then
@@ -117,7 +118,7 @@ begin
pScanFinished := False; pScanFinished := False;
pTIMNumber := 0; pTIMNumber := 0;
while not pStopScan do while (not pStopScan) or (not Terminated) do
begin begin
if LoadTimFromBuf(ClearBuffer, TIM, pClearBufferPosition) then if LoadTimFromBuf(ClearBuffer, TIM, pClearBufferPosition) then
begin begin
@@ -164,8 +165,8 @@ begin
end; end;
finally finally
FreeTIM(TIM); FreeTIM(TIM);
FreeMemory(SectorBuffer); if SectorBuffer <> nil then FreeMemory(SectorBuffer);
FreeMemory(ClearBuffer); if ClearBuffer <> nil then FreeMemory(ClearBuffer);
pSrcFileStream.Free; pSrcFileStream.Free;
pStopScan := True; pStopScan := True;
@@ -189,7 +190,7 @@ begin
if not frmMain.CheckForFileOpened(pScanResult.ScanFile) then if not frmMain.CheckForFileOpened(pScanResult.ScanFile) then
begin begin
frmMain.ScanResult.Add(pScanResult); frmMain.ScanResults.Add(pScanResult);
frmMain.cbbFiles.Items.Add(pScanResult.ScanFile); frmMain.cbbFiles.Items.Add(pScanResult.ScanFile);
end end
else else
@@ -208,7 +209,7 @@ begin
frmMain.actExtractTIMs.Enabled := False; frmMain.actExtractTIMs.Enabled := False;
frmMain.actExtractPNGs.Enabled := False; frmMain.actExtractPNGs.Enabled := False;
frmMain.pbProgress.Max := GetFileSizeAPI(pScanResult.ScanFile); frmMain.pbProgress.Max := FileSize(pScanResult.ScanFile);
frmMain.pbProgress.Position := 0; frmMain.pbProgress.Position := 0;
end; end;

132
units/uSettings.pas
View File

@@ -1,122 +1,82 @@
unit uSettings; unit usettings;
interface interface
uses Classes; uses
{$M+} IniFiles;
type type
TCustomSettings = class
private
FFileName: string;
procedure LoadFromStream(const Stream: TStream) ;
procedure SaveToStream(const Stream: TStream) ;
public
procedure LoadFromFile() ;
procedure SaveToFile() ;
end;
TSettings = class(TCustomSettings) { TSettings }
TSettings = class
private private
FTranspMode: Integer; FIniFile: TIniFile;
FStretchMode: Boolean; procedure FTranspModeWrite(Value: Integer);
FLastDir: string; function FTranspModeRead(): Integer;
procedure FStretchModeWrite(Value: Boolean);
function FStretchModeRead(): Boolean;
procedure FLastDirWrite(const Value: string);
function FLastDirRead(): string;
public public
constructor Create(const DirPath: string); constructor Create(const DirPath: string);
published destructor Destroy; override;
property TranspMode: Integer read FTranspMode write FTranspMode; property TranspMode: Integer read FTranspModeRead write FTranspModeWrite;
property StretchMode: Boolean read FStretchMode write FStretchMode; property StretchMode: Boolean read FStretchModeRead write FStretchModeWrite;
property LastDir: string read FLastDir write FLastDir; property LastDir: string read FLastDirRead write FLastDirWrite;
end; end;
implementation implementation
uses TypInfo, Sysutils; uses Classes, SysUtils;
const sMain = 'main';
{ TSettings } { TSettings }
procedure TCustomSettings.LoadFromFile() ; procedure TSettings.FTranspModeWrite(Value: Integer);
var
Stream: TStream;
begin begin
if not FileExists(FFileName) then Exit; FIniFile.WriteInteger(sMain, 'TranspMode', Value);
try
Stream := TFileStream.Create(FFileName, fmOpenRead or fmShareDenyWrite) ;
LoadFromStream(Stream) ;
finally
Stream.Free;
end;
end; end;
procedure TCustomSettings.LoadFromStream(const Stream: TStream) ; function TSettings.FTranspModeRead: Integer;
var
Reader: TReader;
PropName, PropValue: string;
begin begin
Reader := TReader.Create(Stream, $FFF) ; Result := FIniFile.ReadInteger(sMain, 'TranspMode', 0);
Stream.Position := 0; end;
Reader.ReadListBegin;
while not Reader.EndOfList do procedure TSettings.FStretchModeWrite(Value: Boolean);
begin begin
PropName := Reader.ReadString; FIniFile.WriteBool(sMain, 'StretchMode', Value);
PropValue := Reader.ReadString;
SetPropValue(Self, PropName, PropValue) ;
end; end;
FreeAndNil(Reader) ; function TSettings.FStretchModeRead: Boolean;
end;
procedure TCustomSettings.SaveToFile() ;
var
Stream: TStream;
begin begin
Stream := TFileStream.Create(FFileName, fmCreate) ; Result := FIniFile.ReadBool(sMain, 'StretchMode', False);
try
SaveToStream(Stream) ;
finally
Stream.Free;
end;
end; end;
procedure TCustomSettings.SaveToStream(const Stream: TStream) ; procedure TSettings.FLastDirWrite(const Value: string);
var
PropName, PropValue: string;
cnt: Integer;
lPropInfo: PPropInfo;
lPropCount: Integer;
lPropList: PPropList;
lPropType: PPTypeInfo;
Writer: TWriter;
begin begin
lPropCount := GetPropList(PTypeInfo(ClassInfo), lPropList) ; FIniFile.WriteString(sMain, 'LastDir', Value);
Writer := TWriter.Create(Stream, $FFF) ; end;
Stream.Size := 0;
Writer.WriteListBegin; function TSettings.FLastDirRead: string;
for cnt := 0 to lPropCount - 1 do
begin begin
lPropInfo := lPropList^[cnt]; Result := FIniFile.ReadString(sMain, 'LastDir', '');
lPropType := lPropInfo^.PropType;
if lPropType^.Kind = tkMethod then Continue;
PropName := lPropInfo.Name;
PropValue := GetPropValue(Self, lPropInfo) ;
Writer.WriteString(PropName) ;
Writer.WriteString(PropValue) ;
end; end;
Writer.WriteListEnd;
FreeAndNil(Writer) ;
end;
{ TSettings }
constructor TSettings.Create(const DirPath: string); constructor TSettings.Create(const DirPath: string);
begin begin
FFileName := IncludeTrailingPathDelimiter(DirPath) + 'settings.t2v'; inherited Create;
FTranspMode := 0;
FStretchMode := False; FIniFile := TIniFile.Create(IncludeTrailingPathDelimiter(DirPath) + 'settings.t2v');
end;
destructor TSettings.Destroy;
begin
FIniFile.Free;
inherited Destroy;
end; end;
end. end.

37
units/uTIM.pas
View File

@@ -1,9 +1,9 @@
unit uTIM; unit utim;
interface interface
uses uses
Windows, uCommon, System.Classes; ucommon;
const const
cTIMMagic = $10; cTIMMagic = $10;
@@ -145,7 +145,7 @@ function ConvertCLUTColor(COLOR: TCLUT_COLOR): word;
implementation implementation
uses uses
System.SysUtils, uCDIMAGE; ucdimage, classes, sysutils;
function ConvertTIMColor(COLOR: word): TCLUT_COLOR; function ConvertTIMColor(COLOR: word): TCLUT_COLOR;
begin begin
@@ -157,8 +157,7 @@ end;
function ConvertCLUTColor(COLOR: TCLUT_COLOR): word; function ConvertCLUTColor(COLOR: TCLUT_COLOR): word;
begin begin
Result := (COLOR.STP shl 15) or ((COLOR.B div 8) shl 10) or Result := (COLOR.STP shl 15) or ((COLOR.B div 8) shl 10) or ((COLOR.G div 8) shl 5) or (COLOR.R div 8);
((COLOR.G div 8) shl 5) or (COLOR.R div 8);
end; end;
function GetCLUTColor(TIM: PTIM; CLUT_NUM, COLOR_NUM: Integer): TCLUT_COLOR; function GetCLUTColor(TIM: PTIM; CLUT_NUM, COLOR_NUM: Integer): TCLUT_COLOR;
@@ -177,8 +176,7 @@ begin
CLUT_OFFSET := CLUT_NUM * GetTimColorsCount(TIM) * 2; CLUT_OFFSET := CLUT_NUM * GetTimColorsCount(TIM) * 2;
Move(TIM^.DATA^[cTIMHeadSize + cCLUTHeadSize + COLOR_NUM * 2 + CLUT_OFFSET], Move(TIM^.DATA^[cTIMHeadSize + cCLUTHeadSize + COLOR_NUM * 2 + CLUT_OFFSET], COLOR, 2);
COLOR, 2);
Result := ConvertTIMColor(COLOR); Result := ConvertTIMColor(COLOR);
end; end;
@@ -331,12 +329,10 @@ begin
Inc(Position); Inc(Position);
TIM_POS := P; TIM_POS := P;
if TIM = nil then if TIM = nil then TIM := CreateTIM;
TIM := CreateTIM;
Move(PBytesArray(BUFFER)^[P], TIM^.HEAD^, cTIMHeadSize); Move(PBytesArray(BUFFER)^[P], TIM^.HEAD^, cTIMHeadSize);
if not CheckHEAD(TIM) then if not CheckHEAD(TIM) then Exit;
Exit;
Inc(P, cTIMHeadSize); Inc(P, cTIMHeadSize);
if TIMHasCLUT(TIM) then if TIMHasCLUT(TIM) then
@@ -349,10 +345,8 @@ begin
Move(PBytesArray(BUFFER)^[P], TIM^.IMAGE^, cIMAGEHeadSize); Move(PBytesArray(BUFFER)^[P], TIM^.IMAGE^, cIMAGEHeadSize);
if not CheckIMAGE(TIM) then if not CheckIMAGE(TIM) then Exit;
Exit; if not CheckTIMSize(TIM) then Exit;
if not CheckTIMSize(TIM) then
Exit;
TIM^.dwSize := GetTIMSize(TIM); TIM^.dwSize := GetTIMSize(TIM);
TIM^.bGOOD := TIMIsGood(TIM); TIM^.bGOOD := TIMIsGood(TIM);
@@ -372,6 +366,9 @@ var
Sector: TCDSector; Sector: TCDSector;
P, TIM_FULL_SECTORS: Integer; P, TIM_FULL_SECTORS: Integer;
begin begin
sImageStream := nil;
TIM_BUF := nil;
try try
sImageStream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); sImageStream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
@@ -383,8 +380,7 @@ begin
New(TIM_BUF); New(TIM_BUF);
P := 0; P := 0;
if SIZE < FirstPartSize then if SIZE < FirstPartSize then FirstPartSize := SIZE;
FirstPartSize := SIZE;
sImageStream.Seek(TimStartSectorPos, soBeginning); sImageStream.Seek(TimStartSectorPos, soBeginning);
sImageStream.Read(Sector, cSectorSize); sImageStream.Read(Sector, cSectorSize);
@@ -434,8 +430,7 @@ var
begin begin
Result := nil; Result := nil;
if dwSize > cTIMMaxSize then if dwSize > cTIMMaxSize then Exit;
Exit;
New(BUF); New(BUF);
Result := CreateTIM; Result := CreateTIM;
@@ -444,8 +439,7 @@ begin
Stream.Read(BUF^[0], dwSize); Stream.Read(BUF^[0], dwSize);
P := 0; P := 0;
if not LoadTimFromBuf(BUF, Result, P) then if not LoadTimFromBuf(BUF, Result, P) then FreeTIM(Result);
FreeTIM(Result);
Dispose(BUF); Dispose(BUF);
end; end;
@@ -455,6 +449,7 @@ function LoadTimFromFile(const FileName: string; var Position: Integer;
var var
sTIM: TFileStream; sTIM: TFileStream;
begin begin
sTIM := nil;
if not ImageScan then if not ImageScan then
begin begin
try try

2
units/uBrowseForFolder.pas → units/udirselect.pas
View File

@@ -1,4 +1,4 @@
unit uBrowseForFolder; unit udirselect;
interface interface