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,
ecc in 'units\ecc.pas',
edc in 'units\edc.pas',
uCDIMAGE in 'units\uCDIMAGE.pas',
uCommon in 'Units\uCommon.pas',
uMain in 'Units\uMain.pas' {frmMain},
uScanThread in 'Units\uScanThread.pas',
uTIM in 'units\uTIM.pas',
uDrawTIM in 'units\uDrawTIM.pas',
uEventWaitThread in 'units\uEventWaitThread.pas',
uScanResult in 'units\uScanResult.pas',
uSettings in 'units\uSettings.pas',
uBrowseForFolder in 'units\uBrowseForFolder.pas';
umain in 'Units\umain.pas' {frmMain},
ucdimage in 'units\ucdimage.pas',
ucommon in 'units\ucommon.pas',
udrawtim in 'units\udrawtim.pas',
uscanresult in 'units\uscanresult.pas',
uscanthread in 'units\uscanthread.pas',
usettings in 'units\usettings.pas',
utim in 'units\utim.pas',
ueventwaitthread in 'units\ueventwaitthread.pas',
udirselect in 'units\udirselect.pas';
{$R *.res}

30
tim2view.dproj
View File

@@ -126,11 +126,8 @@
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
<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>
<DCC_DebugInformation>true</DCC_DebugInformation>
<DCC_DebugInformation>false</DCC_DebugInformation>
<VerInfo_Locale>1033</VerInfo_Locale>
<DCC_IOChecking>false</DCC_IOChecking>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
@@ -139,9 +136,7 @@
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<VerInfo_Locale>1033</VerInfo_Locale>
<DCC_IMPLICIT_STRING_CAST>false</DCC_IMPLICIT_STRING_CAST>
<DCC_MapFile>3</DCC_MapFile>
<DCC_DebugInformation>true</DCC_DebugInformation>
<DCC_LocalDebugSymbols>true</DCC_LocalDebugSymbols>
<DCC_DebugInformation>false</DCC_DebugInformation>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
@@ -149,18 +144,19 @@
</DelphiCompile>
<DCCReference Include="units\ecc.pas"/>
<DCCReference Include="units\edc.pas"/>
<DCCReference Include="units\uCDIMAGE.pas"/>
<DCCReference Include="Units\uCommon.pas"/>
<DCCReference Include="Units\uMain.pas">
<DCCReference Include="Units\umain.pas">
<Form>frmMain</Form>
</DCCReference>
<DCCReference Include="Units\uScanThread.pas"/>
<DCCReference Include="units\uTIM.pas"/>
<DCCReference Include="units\uDrawTIM.pas"/>
<DCCReference Include="units\uEventWaitThread.pas"/>
<DCCReference Include="units\uScanResult.pas"/>
<DCCReference Include="units\uSettings.pas"/>
<DCCReference Include="units\uBrowseForFolder.pas"/>
<DCCReference Include="units\ucdimage.pas"/>
<DCCReference Include="units\ucommon.pas"/>
<DCCReference Include="units\udrawtim.pas"/>
<DCCReference Include="units\uscanresult.pas"/>
<DCCReference Include="units\uscanthread.pas"/>
<DCCReference Include="units\usettings.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">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>

4
units/ecc.pas
View File

@@ -3,7 +3,7 @@ unit ecc;
interface
uses
uCommon;
ucommon;
const
L1_RAW = 24;
@@ -19,7 +19,7 @@ Procedure encode_L2_P(Data: PBytesArray);
implementation
{$INCLUDE l2sq_table.pas}
{$INCLUDE l2sq_table.inc}
Procedure encode_L2_Q(Data: PBytesArray);
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
uses
Windows, uTIM;
utim;
const
cSectorHeaderSize = 12;
@@ -40,7 +40,7 @@ procedure ReplaceTimInFileFromMemory(const FileName: string; TIM: PTIM;
implementation
uses
uCommon, ecc, edc, System.SysUtils, System.Classes;
ucommon, ecc, edc, classes, sysutils, windows;
function bin2bcd(P: Integer): byte;
begin
@@ -72,10 +72,10 @@ var
tmp: TFileStream;
begin
Result := False;
Sz := GetFileSizeAPI(FileName);
Sz := FileSize(FileName);
tmp := nil;
if (Sz > cMaxFileSize) or (Sz = 0) then
Exit;
if (Sz > cMaxFileSize) or (Sz = 0) then Exit;
pFile := GetMemory(cSectorHeaderSize);
@@ -214,7 +214,7 @@ var
begin
Result := False;
SIZE := GetFileSizeAPI(TimToInsert);
SIZE := FileSize(TimToInsert);
P := 0;
TIM := LoadTimFromFile(TimToInsert, P, False, SIZE);
// SaveTimToFile('test.tim', TIM);

74
units/uCommon.pas
View File

@@ -1,13 +1,9 @@
unit uCommon;
unit ucommon;
interface
uses
Windows;
const
cProgramName = 'Tim2View by [Lab 313]';
cProgramVersion = '2.0 Release';
cProgramName = 'Tim2View r55 by [Lab 313]';
cExtractedTimsDir = 'TIMS';
cExtractedPngsDir = 'PNGS';
cMaxFileSize = $2EAEED80;
@@ -29,19 +25,16 @@ type
TBytesArray = array [0 .. cMaxFileSize - 1] of byte;
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);
function ExtractJustName(const Path: string): string;
function Min(A, B: Integer): Integer;
function Max(A, B: Integer): Integer;
function GetCoreCount: Integer;
function FileSize(const FileName: string): Integer;
implementation
uses
System.SysUtils, Clipbrd;
uses sysutils, windows, clipbrd;
function GetCoreCount: Integer;
var
@@ -51,6 +44,11 @@ begin
Result := SystemInfo.dwNumberOfProcessors;
end;
procedure Text2Clipboard(const S: string);
begin
Clipboard.AsText := S;
end;
function Min(A, B: Integer): Integer;
begin
if A < B then
@@ -67,61 +65,13 @@ begin
Result := B;
end;
procedure Text2Clipboard(const S: string);
begin
Clipboard.AsText := S;
end;
function ExtractJustName(const Path: string): string;
begin
Result := ExtractFileName(Path);
Result := Copy(Result, 1, Length(Result) - Length(ExtractFileExt(Result)));
end;
function Hex2Int(const Value: 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;
function FileSize(const FileName: string): Integer;
var
FindData: TWin32FindData;
hFind: THandle;
@@ -134,7 +84,7 @@ begin
Windows.FindClose(hFind);
if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
Result := FindData.nFileSizeLow;
Result := Integer(FindData.nFileSizeLow);
end;
end;

86
units/uDrawTIM.pas
View File

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

2
units/uEventWaitThread.pas
View File

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

31
units/uMain.dfm
View File

@@ -548,7 +548,7 @@ object frmMain: TfrmMain
DropDownCount = 30
Enabled = False
TabOrder = 0
OnChange = cbbFilesChange
OnChange = actChangeFileExecute
OnCloseUp = actReturnFocusExecute
end
object pnlMain: TPanel
@@ -576,9 +576,9 @@ object frmMain: TfrmMain
TabOrder = 0
object lvList: TListView
Left = 0
Top = 49
Top = 27
Width = 240
Height = 432
Height = 454
Align = alClient
Columns = <
item
@@ -611,17 +611,14 @@ object frmMain: TfrmMain
PopupMenu = pmList
TabOrder = 0
ViewStyle = vsReport
OnChange = lvListChange
OnData = lvListData
ExplicitLeft = 1
ExplicitTop = 28
ExplicitHeight = 448
OnSelectItem = lvListSelectItem
end
object pnlExtractAll: TPanel
Left = 0
Top = 0
Width = 240
Height = 49
Height = 27
Align = alTop
BevelOuter = bvLowered
TabOrder = 1
@@ -629,18 +626,17 @@ object frmMain: TfrmMain
Left = 139
Top = 1
Width = 100
Height = 47
Height = 25
Action = actExtractPNGs
Align = alRight
TabOrder = 0
WordWrap = True
ExplicitLeft = 128
end
object btnExtractPNGs: TButton
Left = 1
Top = 1
Width = 100
Height = 47
Height = 25
Action = actExtractTIMs
Align = alLeft
TabOrder = 1
@@ -740,7 +736,7 @@ object frmMain: TfrmMain
ParentDoubleBuffered = False
TabOrder = 1
Text = 'Real'
OnChange = actDrawSelectedTimExecute
OnChange = cbbBitModeChange
OnCloseUp = actReturnFocusExecute
Items.Strings = (
'Real'
@@ -789,7 +785,7 @@ object frmMain: TfrmMain
DropDownCount = 16
ParentDoubleBuffered = False
TabOrder = 3
OnChange = cbbCLUTChange
OnChange = actChangeClutIdxExecute
end
end
end
@@ -957,24 +953,27 @@ object frmMain: TfrmMain
OnExecute = actAssocTimsExecute
end
object actExtractTIMs: TAction
Caption = 'Extract all &TIMs'#13#10'(Shift+F2)'
Caption = 'Extract all &TIMs'
Enabled = False
ShortCut = 8305
OnExecute = actExtractTIMsExecute
end
object actExtractPNGs: TAction
Caption = '&Extract all PNGs'#13#10'(Shift+F4)'
Caption = '&Extract all PNGs'#13#10
Enabled = False
ShortCut = 8307
OnExecute = actExtractPNGsExecute
end
object actChangeClutIdx: TAction
OnExecute = actChangeClutIdxExecute
end
object actReturnFocus: TAction
OnExecute = actReturnFocusExecute
end
object actDrawSelectedTim: TAction
OnExecute = actDrawSelectedTimExecute
end
object actChangeFile: TAction
OnExecute = actChangeFileExecute
end
end
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
uses
generics.collections;
type
TScanTim = record
TTimInfo = record
Position: Integer;
Size: Integer;
Width: Integer;
@@ -13,18 +16,17 @@ type
Good: Boolean;
end;
type
TScanResult = class(TObject)
private
pScanFile: string;
pIsImage: Boolean;
pCount: Integer;
pTims: array of TScanTim;
pTims: array of TTimInfo;
procedure fSetCount(Value: Integer);
function fGetTim(Index: Integer): TScanTim;
procedure fSetTim(Index: Integer; Value: TScanTim);
function fGetTim(Index: Integer): TTimInfo;
procedure fSetTim(Index: Integer; Value: TTimInfo);
public
constructor Create;
@@ -34,8 +36,9 @@ type
property IsImage: Boolean read pIsImage write pIsImage;
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;
TScanResultList = TList<TScanResult>;
implementation
@@ -58,7 +61,7 @@ begin
inherited;
end;
function TScanResult.fGetTim(Index: Integer): TScanTim;
function TScanResult.fGetTim(Index: Integer): TTimInfo;
begin
Result := pTims[Index];
end;
@@ -69,7 +72,7 @@ begin
SetLength(pTims, Value);
end;
procedure TScanResult.fSetTim(Index: Integer; Value: TScanTim);
procedure TScanResult.fSetTim(Index: Integer; Value: TTimInfo);
begin
pTims[Index] := Value;
end;

29
units/uScanThread.pas
View File

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

168
units/uSettings.pas
View File

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

37
units/uTIM.pas
View File

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

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

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