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

Another non-Latin fixes. StatusBar with TIM-info. Stability fixes.

Browse Source
This commit is contained in:
meffi@lab313.ru
2014-04-17 23:14:46 +00:00
parent 6c32010405
commit 83bedc86af
7 changed files with 186 additions and 219 deletions
Download Patch File Download Diff File Expand all files Collapse all files

11
tim2view.lpi
View File

@@ -128,18 +128,7 @@
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<SmartLinkUnit Value="True"/>
<RelocatableUnit Value="True"/>
<Optimizations>
<OptimizationLevel Value="3"/>
</Optimizations>
</CodeGeneration>
<Linking>
<Debugging>
<GenerateDebugInfo Value="False"/>
</Debugging>
<LinkSmart Value="True"/>
<Options>
<Win32>
<GraphicApplication Value="True"/>

63
tim2view.lps
View File

@@ -9,7 +9,13 @@
<Filename Value="tim2view.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="tim2view"/>
<UsageCount Value="23"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="3"/>
<WindowIndex Value="0"/>
<TopLine Value="1"/>
<CursorPos X="46" Y="9"/>
<UsageCount Value="32"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
<Filename Value="umain.pas"/>
@@ -20,9 +26,9 @@
<UnitName Value="umain"/>
<EditorIndex Value="0"/>
<WindowIndex Value="0"/>
<TopLine Value="568"/>
<CursorPos X="49" Y="578"/>
<UsageCount Value="23"/>
<TopLine Value="108"/>
<CursorPos X="65" Y="113"/>
<UsageCount Value="32"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit1>
@@ -30,93 +36,94 @@
<Filename Value="edc.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="edc"/>
<UsageCount Value="23"/>
<UsageCount Value="32"/>
</Unit2>
<Unit3>
<Filename Value="ecc.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ecc"/>
<UsageCount Value="23"/>
<UsageCount Value="32"/>
</Unit3>
<Unit4>
<Filename Value="ucommon.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ucommon"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="1"/>
<WindowIndex Value="0"/>
<TopLine Value="1"/>
<CursorPos X="35" Y="6"/>
<UsageCount Value="23"/>
<Loaded Value="True"/>
<UsageCount Value="32"/>
</Unit4>
<Unit5>
<Filename Value="utim.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="utim"/>
<EditorIndex Value="5"/>
<EditorIndex Value="2"/>
<WindowIndex Value="0"/>
<TopLine Value="259"/>
<CursorPos X="28" Y="283"/>
<UsageCount Value="23"/>
<TopLine Value="311"/>
<CursorPos X="7" Y="323"/>
<UsageCount Value="32"/>
<Loaded Value="True"/>
</Unit5>
<Unit6>
<Filename Value="ucdimage.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ucdimage"/>
<EditorIndex Value="2"/>
<WindowIndex Value="0"/>
<TopLine Value="81"/>
<CursorPos X="95" Y="89"/>
<UsageCount Value="23"/>
<Loaded Value="True"/>
<UsageCount Value="32"/>
</Unit6>
<Unit7>
<Filename Value="usettings.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="usettings"/>
<EditorIndex Value="4"/>
<WindowIndex Value="0"/>
<TopLine Value="17"/>
<CursorPos X="76" Y="31"/>
<UsageCount Value="23"/>
<Loaded Value="True"/>
<UsageCount Value="32"/>
</Unit7>
<Unit8>
<Filename Value="uscanresult.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uscanresult"/>
<UsageCount Value="23"/>
<EditorIndex Value="4"/>
<WindowIndex Value="0"/>
<TopLine Value="52"/>
<CursorPos X="64" Y="25"/>
<UsageCount Value="32"/>
<Loaded Value="True"/>
</Unit8>
<Unit9>
<Filename Value="uscanthread.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uscanthread"/>
<EditorIndex Value="3"/>
<EditorIndex Value="1"/>
<WindowIndex Value="0"/>
<TopLine Value="192"/>
<CursorPos X="78" Y="212"/>
<UsageCount Value="23"/>
<TopLine Value="79"/>
<CursorPos X="75" Y="120"/>
<UsageCount Value="32"/>
<Loaded Value="True"/>
</Unit9>
<Unit10>
<Filename Value="ucpucount.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ucpucount"/>
<UsageCount Value="23"/>
<UsageCount Value="32"/>
</Unit10>
<Unit11>
<Filename Value="udrawtim.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="udrawtim"/>
<UsageCount Value="23"/>
<WindowIndex Value="0"/>
<TopLine Value="220"/>
<CursorPos X="30" Y="233"/>
<UsageCount Value="32"/>
</Unit11>
<Unit12>
<Filename Value="bgrabitmap\bgrabitmap.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="BGRABitmap"/>
<UsageCount Value="23"/>
<UsageCount Value="32"/>
</Unit12>
</Units>
<General>

19
udrawtim.pas
View File

@@ -19,7 +19,7 @@ procedure ClearGrid(Grid: PDrawGrid);
implementation
uses
ucommon, BGRABitmapTypes;
ucommon, BGRABitmapTypes, Math;
function PrepareCLUT(TIM: PTIM; CLUT_NUM: Integer): PCLUT_COLORS;
var
@@ -224,19 +224,26 @@ var
CLUT_COLOR: PCLUT_COLOR;
R, G, B, STP, ALPHA: Byte;
Rect: TRect;
COLS: Integer;
COLS, Colors: Integer;
begin
Colors := GetTimColorsCount(TIM);
COLS := Min(Colors, cCLUTGridColsCount);
Rect := Grid^.CellRect(X, Y);
if (Y * COLS + X) >= Colors then
begin
ClearCanvas(@Grid^.Canvas, Rect);
Exit;
end;
New(CLUT_COLOR);
COLS := Min(GetTimColorsCount(TIM), cCLUTGridColsCount);
CLUT_COLOR^ := GetCLUTColor(TIM, CLUT_NUM, Y * COLS + X);
R := CLUT_COLOR^.R;
G := CLUT_COLOR^.G;
B := CLUT_COLOR^.B;
STP := CLUT_COLOR^.STP;
Rect := Grid^.CellRect(X, Y);
Grid^.Canvas.Brush.COLOR := RGBToColor(R, G, B);
Grid^.Canvas.FillRect(Rect);
@@ -272,7 +279,7 @@ begin
COLORS := GetTimColorsCount(TIM);
COLS := Min(COLORS, cCLUTGridColsCount);
Grid^.ColCount := COLS;
ROWS := COLORS div COLS;
ROWS := Ceil(COLORS / COLS);
Grid^.RowCount := ROWS;

89
umain.lfm
View File

@@ -497,7 +497,7 @@ object frmMain: TfrmMain
object pnlStatus: TPanel
Left = 0
Height = 30
Top = 540
Top = 517
Width = 780
Align = alBottom
BevelOuter = bvLowered
@@ -550,33 +550,33 @@ object frmMain: TfrmMain
end
object pnlMain: TPanel
Left = 0
Height = 519
Height = 496
Top = 21
Width = 780
Align = alClient
BevelOuter = bvNone
ClientHeight = 519
ClientHeight = 496
ClientWidth = 780
TabOrder = 1
object splMain: TSplitter
Left = 253
Height = 519
Height = 496
Top = 0
Width = 5
end
object pnlList: TPanel
Left = 0
Height = 519
Height = 496
Top = 0
Width = 253
Align = alLeft
BevelOuter = bvNone
ClientHeight = 519
ClientHeight = 496
ClientWidth = 253
TabOrder = 0
object lvList: TListView
Left = 0
Height = 491
Height = 468
Top = 28
Width = 253
Align = alClient
@@ -644,12 +644,12 @@ object frmMain: TfrmMain
end
object pnlImage: TPanel
Left = 258
Height = 519
Height = 496
Top = 0
Width = 522
Align = alClient
BevelOuter = bvLowered
ClientHeight = 519
ClientHeight = 496
ClientWidth = 522
Color = clBtnFace
ParentColor = False
@@ -669,9 +669,10 @@ object frmMain: TfrmMain
object grdCurrClut: TDrawGrid
Left = 1
Height = 150
Top = 343
Top = 320
Width = 520
Align = alBottom
AutoEdit = False
ColCount = 1
DefaultColWidth = 14
DefaultRowHeight = 14
@@ -681,7 +682,7 @@ object frmMain: TfrmMain
FixedRows = 0
Options = [goFixedVertLine, goFixedHorzLine, goDrawFocusSelected]
RowCount = 1
ScrollBars = ssNone
ScrollBars = ssAutoVertical
TabOrder = 0
TitleFont.Color = clWindowText
TitleFont.Height = -11
@@ -694,7 +695,7 @@ object frmMain: TfrmMain
object pnlImageOptions: TPanel
Left = 1
Height = 25
Top = 493
Top = 470
Width = 520
Align = alBottom
AutoSize = True
@@ -774,16 +775,52 @@ object frmMain: TfrmMain
end
object imgTim: TImage
Left = 1
Height = 339
Height = 316
Top = 4
Width = 520
AntialiasingMode = amOff
Align = alClient
Center = True
PopupMenu = pmImage
Proportional = True
end
end
end
object sbMain: TStatusBar
Left = 0
Height = 23
Top = 547
Width = 780
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
item
Width = 50
end>
SimplePanel = False
end
object dlgOpenFile: TOpenDialog
Title = 'Please, select File...'
DefaultExt = '.bin'
@@ -818,15 +855,6 @@ object frmMain: TfrmMain
end
object mnTIM: TMenuItem
Caption = '&TIM'
object mnExtractAllTims: TMenuItem
Action = actExtractTIMs
end
object mnExtractAllPngs: TMenuItem
Action = actExtractPNGs
end
object N6: TMenuItem
Caption = '-'
end
object mnSaveTIM: TMenuItem
Action = actExtractTim
end
@@ -836,12 +864,6 @@ object frmMain: TfrmMain
object mnSaveToPNG: TMenuItem
Action = actTim2Png
end
object N4: TMenuItem
Caption = '-'
end
object mnTimInfoMain: TMenuItem
Action = actTimInfo
end
end
object mnOptions: TMenuItem
Caption = '&Options'
@@ -978,11 +1000,6 @@ object frmMain: TfrmMain
Caption = '&Stretch Image'
OnExecute = actStretchExecute
end
object actTimInfo: TAction
Caption = '&TIM Info...'
Enabled = False
OnExecute = actTimInfoExecute
end
object actAssocTims: TAction
Caption = '&Open TIMs with T2V'
OnExecute = actAssocTimsExecute
@@ -1037,12 +1054,6 @@ object frmMain: TfrmMain
object mnExtractAllPngs2: TMenuItem
Action = actExtractPNGs
end
object N2: TMenuItem
Caption = '-'
end
object mnTIMInfo: TMenuItem
Action = actTimInfo
end
end
object pmImage: TPopupMenu
left = 472

139
umain.pas
View File

@@ -36,7 +36,6 @@ type
actList: TActionList;
actStretch: TAction;
actTim2Png: TAction;
actTimInfo: TAction;
btnExtractAllTims: TButton;
btnExtractPNGs: TButton;
btnShowClut: TButton;
@@ -62,9 +61,6 @@ type
mnExtractAllTims2: TMenuItem;
N7: TMenuItem;
mnStretchImage: TMenuItem;
mnExtractAllPngs: TMenuItem;
mnExtractAllTims: TMenuItem;
N6: TMenuItem;
mnSaveAsPng: TMenuItem;
mnAbout: TMenuItem;
mnAssociate: TMenuItem;
@@ -84,12 +80,8 @@ type
mnStretch: TMenuItem;
mnSVN: TMenuItem;
mnTIM: TMenuItem;
mnTIMInfo: TMenuItem;
mnTimInfoMain: TMenuItem;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
pbProgress: TProgressBar;
pnlExtractAll: TPanel;
@@ -105,6 +97,7 @@ type
dlgSelectDir: TSelectDirectoryDialog;
splImageClut: TSplitter;
splMain: TSplitter;
sbMain: TStatusBar;
procedure actAboutExecute(Sender: TObject);
procedure actAssocTimsExecute(Sender: TObject);
procedure actChangeBackColorExecute(Sender: TObject);
@@ -125,7 +118,6 @@ type
procedure actStopScanExecute(Sender: TObject);
procedure actStretchExecute(Sender: TObject);
procedure actTim2PngExecute(Sender: TObject);
procedure actTimInfoExecute(Sender: TObject);
procedure btnShowClutClick(Sender: TObject);
procedure cbbBitModeChange(Sender: TObject);
procedure cbbTranspModeChange(Sender: TObject);
@@ -133,11 +125,9 @@ type
procedure FormCreate(Sender: TObject);
procedure FormDropFiles(Sender: TObject; const FileNames: array of string);
procedure grdCurrClutDblClick(Sender: TObject);
procedure grdCurrClutDrawCell(Sender: TObject; aCol, aRow: Integer;
aRect: TRect; aState: TGridDrawState);
procedure grdCurrClutDrawCell(Sender: TObject; aCol, aRow: Integer; aRect: TRect; aState: TGridDrawState);
procedure lvListData(Sender: TObject; Item: TListItem);
procedure lvListSelectItem(Sender: TObject; Item: TListItem;
Selected: Boolean);
procedure lvListSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
private
{ private declarations }
StartedScans: Integer; //Count of currently started scans
@@ -174,6 +164,7 @@ type
function FormatTimName(const FileName: string; ListIdx_, BitMode: Integer): string;
function FormatPngName(const FileName: string; ListIdx_, BitMode, Clut: Integer): string;
procedure ShowTim;
procedure ShowTimInfo(ShowInfo: Boolean);
public
{ public declarations }
ScanResults: TScanResultList; //List of finished scan results
@@ -186,7 +177,7 @@ var
implementation
uses ucdimage, ucpucount, lcltype, ucommon, LCLIntf, Clipbrd
uses ucdimage, ucpucount, lcltype, ucommon, LCLIntf
{$IFDEF windows}
,registry
@@ -240,63 +231,6 @@ begin
Surf^.SaveToFile(UTF8ToSys(dlgSavePNG.FileName));
end;
procedure TfrmMain.actTimInfoExecute(Sender: TObject);
const
Tab = #$09;
Row = #10;
var
Info, IsGoodTIM: string;
Index: Integer;
TIM: PTIM;
begin
if actTimInfo.Enabled then
begin
Index := SelectedTimIdx;
TIM := SelectedTim;
if TIMIsGood(TIM) then
IsGoodTIM := 'YES'
else
IsGoodTIM := 'NO';
Info := Format('"%s" Information' + Row + 'Number:' + Tab + '%d' + Row +
'Position:' + Tab + '0x%x' + Row + 'BitMode:' + Tab + '%d' + Row + 'Good:'
+ Tab + '%s' + Row + Row +
'HEADER INFO' + Row + 'Version:' + Tab + '%d' + Row + 'BPP:' + Tab + '%d'
+ Row + Row, [FormatTimName(SelectedScanResult.ScanFile, Index, SelectedTimInfo.BitMode),
Index + 1, SelectedTimInfo.Position, BppToBitMode(TIM), IsGoodTIM,
GetTimVersion(TIM), GetTimBPP(TIM)]);
if TIMHasCLUT(TIM) then
Info := Format(Info + 'CLUT INFO' + Row + 'Size (Header):' + Tab + '%d' +
Row + 'Size (Real):' + Tab + '%d' + Row + 'VRAM X Pos:' + Tab + '%d' +
Row + 'VRAM Y Pos:' + Tab + '%d' + Row + 'CLUTs Count:' + Tab + '%d' +
Row + 'Colors in 1 CLUT:' + Tab + '%d' + Row + Row,
[GetTimClutSizeHeader(TIM), GetTimClutSize(TIM), GetTimClutVRAMX(TIM),
GetTimClutVRAMY(TIM), GetTIMClutsCount(TIM), GetTimColorsCount(TIM)]);
Info := Format(Info + 'IMAGE INFO' + Row + 'Size (Header):' + Tab + '%d' +
Row + 'Size (Real):' + Tab + '%d' + Row + 'VRAM X Pos:' + Tab + '%d' + Row
+ 'VRAM Y Pos:' + Tab + '%d' + Row + 'Width (Header):' + Tab + '%d' + Row
+ 'Width (Real):' + Tab + '%d' + Row + 'Height (Real):' + Tab + '%d',
[GetTimImageSizeHeader(TIM), GetTimImageSize(TIM), GetTimImageVRAMX(TIM),
GetTimImageVRAMY(TIM), GetTimWidth(TIM), GetTimRealWidth(TIM),
GetTimHeight(TIM)]);
case Application.MessageBox(
PChar(Info + Row + Row +
'If you want to copy this info to clipboard press "YES" button.'),
'Information', MB_OKCANCEL + MB_ICONINFORMATION) of
IDOK:
Clipboard.AsText := Info;
end;
FreeTIM(TIM);
end;
end;
procedure TfrmMain.btnShowClutClick(Sender: TObject);
begin
grdCurrClut.Visible := not grdCurrClut.Visible;
@@ -380,7 +314,7 @@ begin
ScanResults.Delete(cbbFiles.ItemIndex);
lblStatus.Caption := '';
actTimInfo.Enabled := False;
ShowTimInfo(False);
SetTimsListCount(0);
UpdateCLUTInfo;
@@ -621,7 +555,7 @@ begin
SELECTED_CELL := grdCurrCLUT.Row * grdCurrCLUT.ColCount + grdCurrCLUT.Col;
W := GetTimColorsCount(TIM);
if (SELECTED_CELL + 1) > W then
if SELECTED_CELL >= W then
begin
FreeTIM(TIM);
Exit;
@@ -809,20 +743,20 @@ var
Dir: string;
begin
Dir := IncludeTrailingPathDelimiter(Directory);
isFound := FindFirstUTF8(Dir + '*', faAnyFile, sRec) = 0;
isFound := FindFirst(UTF8ToSys(Dir + '*'), faAnyFile, sRec) = 0;
while isFound do
begin
if (sRec.Name <> '.') and (sRec.Name <> '..') then
begin
if (sRec.Attr and faDirectory) = faDirectory then
ScanDirectory(Dir + sRec.Name)
ScanDirectory(Dir + SysToUTF8(sRec.Name))
else
ScanFile(Dir + sRec.Name);
ScanFile(Dir + SysToUTF8(sRec.Name));
end;
Application.ProcessMessages;
isFound := FindNextUTF8(sRec) = 0;
isFound := FindNext(sRec) = 0;
end;
FindCloseUTF8(sRec);
FindClose(sRec);
end;
procedure TfrmMain.CheckButtonsAndMainMenu;
@@ -1011,10 +945,57 @@ begin
DrawSelTim;
DrawSelClut;
actTimInfo.Enabled := True;
ShowTimInfo(True);
CheckButtonsAndMainMenu;
end;
procedure TfrmMain.ShowTimInfo(ShowInfo: Boolean);
var
I: Integer;
TIM: PTIM;
ScanRes: TScanResult;
TimInfo: TTimInfo;
begin
for I := 1 to sbMain.Panels.Count do
sbMain.Panels[I - 1].Text := '';
if not ShowInfo then Exit;
ScanRes := SelectedScanResult;
TimInfo := SelectedTimInfo;
TIM := SelectedTim;
I := 0;
sbMain.Panels[I].Text := Format('Position: 0x%x', [TimInfo.Position]);
sbMain.Panels[I].Width := Canvas.GetTextWidth(sbMain.Panels[I].Text) + 8; Inc(I);
sbMain.Panels[I].Text := Format('Version: %d', [GetTimVersion(TIM)]);
sbMain.Panels[I].Width := Canvas.GetTextWidth(sbMain.Panels[I].Text) + 8; Inc(I);
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('VRAM.X: %d', [GetTimClutVRAMX(TIM)]);
sbMain.Panels[I].Width := Canvas.GetTextWidth(sbMain.Panels[I].Text) + 8; Inc(I);
sbMain.Panels[I].Text := Format('VRAM.Y: %d', [GetTimClutVRAMY(TIM)]);
sbMain.Panels[I].Width := Canvas.GetTextWidth(sbMain.Panels[I].Text) + 8; Inc(I);
sbMain.Panels[I].Text := Format('Colors/CLUT: %d', [GetTimColorsCount(TIM)]);
sbMain.Panels[I].Width := Canvas.GetTextWidth(sbMain.Panels[I].Text) + 8; Inc(I);
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('VRAM.X: %d', [GetTimImageVRAMX(TIM)]);
sbMain.Panels[I].Width := Canvas.GetTextWidth(sbMain.Panels[I].Text) + 8; Inc(I);
sbMain.Panels[I].Text := Format('VRAM.Y: %d', [GetTimImageVRAMY(TIM)]);
sbMain.Panels[I].Width := Canvas.GetTextWidth(sbMain.Panels[I].Text) + 8; Inc(I);
FreeTIM(TIM);
end;
end.

2
uscanthread.pas
View File

@@ -116,7 +116,7 @@ begin
pScanFinished := False;
pTIMNumber := 0;
while (not pStopScan) or (not Terminated) do
while (not pStopScan) and (not Terminated) do
begin
if LoadTimFromBuf(ClearBuffer, TIM, pClearBufferPosition) then
begin

82
utim.pas
View File

@@ -24,8 +24,7 @@ const
cTIMWrongBads = [cTIM4NC, cTIM8NC, cTIMMix];
cTIMCLUT = [cTIM4C, cTIM8C, cTIM16C, cTIM24C];
cTIMNOCLUT = [cTIM4NC, cTIM8NC, cTIM16NC, cTIM24NC, cTIMMix];
cTIMBpp = [cTIM4C, cTIM8C, cTIM16C, cTIM24C, cTIM4NC, cTIM8NC, cTIM16NC,
cTIM24NC, cTIMMix];
cTIMBpp = [cTIM4C, cTIM8C, cTIM16C, cTIM24C, cTIM4NC, cTIM8NC, cTIM16NC, cTIM24NC, cTIMMix];
cCLUTColorsMax = 1024;
cCLUTCountMax = 512;
@@ -35,8 +34,7 @@ const
cIMAGEHeadSize = $0C;
cTIMHeadSize = 8;
cRandomPaletteSize = $100;
cTIMMaxSize = cTIMHeadSize + cCLUTColorsMax * cCLUTCountMax * 2 +
cCLUTHeadSize + cIMAGEWidthMax * cIMAGEHeightMax * 2 + cIMAGEHeadSize;
cTIMMaxSize = cTIMHeadSize + cCLUTColorsMax * cCLUTCountMax * 2 + cCLUTHeadSize + cIMAGEWidthMax * cIMAGEHeightMax * 2 + cIMAGEHeadSize;
type
TTIMHeader = packed record // TIM Header (8 bytes)
@@ -92,8 +90,7 @@ type
PCLUT_COLORS = ^TCLUT_COLORS;
type
TIMAGE_INDEXES = array [0 .. cIMAGEWidthMax * cIMAGEHeightMax * 4 -
1] of Integer;
TIMAGE_INDEXES = array [0 .. cIMAGEWidthMax * cIMAGEHeightMax * 4 - 1] of Integer;
PIMAGE_INDEXES = ^TIMAGE_INDEXES;
type
@@ -117,10 +114,8 @@ function GetTimWidth(TIM: PTIM): word;
function GetTimRealWidth(TIM: PTIM): word;
function GetTimHeight(TIM: PTIM): word;
function TIMIsGood(TIM: PTIM): Boolean;
function LoadTimFromBuf(BUFFER: pointer; var TIM: PTIM;
var Position: Integer): Boolean;
function LoadTimFromFile(const FileName: string; var Position: Integer;
ImageScan: Boolean; dwSize: Integer): PTIM;
function LoadTimFromBuf(BUFFER: pointer; var TIM: PTIM; var Position: Integer): Boolean;
function LoadTimFromFile(const FileName: string; var Position: Integer; ImageScan: Boolean; dwSize: Integer): PTIM;
procedure SaveTimToFile(const FileName: string; TIM: PTIM);
function CreateTIM: PTIM;
procedure FreeTIM(TIM: PTIM);
@@ -137,8 +132,7 @@ function GetTimImageVRAMX(TIM: PTIM): word;
function GetTimImageVRAMY(TIM: PTIM): word;
function GetTIMIMAGESize(TIM: PTIM): Integer;
function GetCLUTColor(TIM: PTIM; CLUT_NUM, COLOR_NUM: Integer): TCLUT_COLOR;
procedure WriteCLUTColor(TIM: PTIM; CLUT_NUM, COLOR_NUM: Integer;
COLOR: TCLUT_COLOR);
procedure WriteCLUTColor(TIM: PTIM; CLUT_NUM, COLOR_NUM: Integer; COLOR: TCLUT_COLOR);
function ConvertTIMColor(COLOR: word): TCLUT_COLOR;
function ConvertCLUTColor(COLOR: TCLUT_COLOR): word;
@@ -190,8 +184,7 @@ begin
CLUT_OFFSET := CLUT_NUM * GetTimColorsCount(TIM) * 2;
COLOR_TO_WRITE := ConvertCLUTColor(COLOR);
Move(COLOR_TO_WRITE, TIM^.DATA^[cTIMHeadSize + cCLUTHeadSize + COLOR_NUM * 2 +
CLUT_OFFSET], 2);
Move(COLOR_TO_WRITE, TIM^.DATA^[cTIMHeadSize + cCLUTHeadSize + COLOR_NUM * 2 + CLUT_OFFSET], 2);
end;
function GetTimHeight(TIM: PTIM): word;
@@ -203,10 +196,8 @@ function GetTIMCLUTSize(TIM: PTIM): Integer;
begin
Result := 0;
if not TIMHasCLUT(TIM) then
Exit;
Result := TIM^.CLUT^.wColorsCount * TIM^.CLUT^.wClutsCount * 2 +
cCLUTHeadSize;
if not TIMHasCLUT(TIM) then Exit;
Result := TIM^.CLUT^.wColorsCount * TIM^.CLUT^.wClutsCount * 2 + cCLUTHeadSize;
end;
function GetTIMIMAGESize(TIM: PTIM): Integer;
@@ -246,27 +237,21 @@ end;
function CheckCLUTColors(TIM: PTIM): Boolean;
begin
Result := (TIM^.CLUT^.wColorsCount >= 1) and
(TIM^.CLUT^.wColorsCount <= cCLUTColorsMax);
Result := (TIM^.CLUT^.wColorsCount >= 1) and (TIM^.CLUT^.wColorsCount <= cCLUTColorsMax);
end;
function CheckCLUTCount(TIM: PTIM): Boolean;
begin
Result := (TIM^.CLUT^.wClutsCount >= 1) and
(TIM^.CLUT^.wClutsCount <= cCLUTCountMax);
Result := (TIM^.CLUT^.wClutsCount >= 1) and (TIM^.CLUT^.wClutsCount <= cCLUTCountMax);
end;
function IWidthToRWidth(TIM: PTIM): word;
begin
case TIM^.HEAD^.bBPP of
cTIM4C, cTIM4NC:
Result := (TIM^.IMAGE^.wWidth * 4) and $FFFF;
cTIM8C, cTIM8NC:
Result := (TIM^.IMAGE^.wWidth * 2) and $FFFF;
cTIM16C, cTIM16NC, cTIMMix:
Result := TIM^.IMAGE^.wWidth;
cTIM24C, cTIM24NC:
Result := (Round(TIM^.IMAGE^.wWidth * 2 / 3)) and $FFFF;
cTIM4C, cTIM4NC: Result := (TIM^.IMAGE^.wWidth * 4) and $FFFF;
cTIM8C, cTIM8NC: Result := (TIM^.IMAGE^.wWidth * 2) and $FFFF;
cTIM16C, cTIM16NC, cTIMMix: Result := TIM^.IMAGE^.wWidth;
cTIM24C, cTIM24NC: Result := (Round(TIM^.IMAGE^.wWidth * 2 / 3)) and $FFFF;
else
Result := 0;
end;
@@ -274,8 +259,7 @@ end;
function CheckHEAD(TIM: PTIM): Boolean;
begin
Result := (CheckMagic(TIM) and CheckVersion(TIM) and CheckBpp(TIM) and
CheckReserved(TIM))
Result := (CheckMagic(TIM) and CheckVersion(TIM) and CheckBpp(TIM) and CheckReserved(TIM))
end;
function CheckCLUT(TIM: PTIM): Boolean;
@@ -299,12 +283,9 @@ function CheckIMAGE(TIM: PTIM): Boolean;
begin
Result := False;
if (TIM^.IMAGE^.wWidth = 0) or (TIM^.IMAGE^.wHeight = 0) then
Exit;
if (TIM^.IMAGE^.wWidth = 0) or (TIM^.IMAGE^.wHeight = 0) then Exit;
if (TIM^.IMAGE^.wWidth > cIMAGEWidthMax) or
(TIM^.IMAGE^.wHeight > cIMAGEHeightMax) then
Exit;
if (TIM^.IMAGE^.wWidth > cIMAGEWidthMax) or (TIM^.IMAGE^.wHeight > cIMAGEHeightMax) then Exit;
Result := (not(TIM^.HEAD^.bBPP in cTIMWrongBads)) or TIMIsGood(TIM);
end;
@@ -317,8 +298,7 @@ begin
FillChar(TIM^.DATA^, cTIMMaxSize, 0);
end;
function LoadTimFromBuf(BUFFER: pointer; var TIM: PTIM;
var Position: Integer): Boolean;
function LoadTimFromBuf(BUFFER: pointer; var TIM: PTIM; var Position: Integer): Boolean;
var
P: Integer;
TIM_POS: Integer;
@@ -329,28 +309,23 @@ 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
begin
Move(PBytesArray(BUFFER)^[P], TIM^.CLUT^, cCLUTHeadSize);
if not CheckCLUT(TIM) then
Exit;
if not CheckCLUT(TIM) then Exit;
Inc(P, GetTIMCLUTSize(TIM));
end;
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);
@@ -381,8 +356,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);
@@ -432,8 +406,7 @@ var
begin
Result := nil;
if dwSize > cTIMMaxSize then
Exit;
if dwSize > cTIMMaxSize then Exit;
New(BUF);
Result := CreateTIM;
@@ -442,8 +415,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;