diff --git a/tim2view.lpi b/tim2view.lpi
index 4829e37..d23260f 100644
--- a/tim2view.lpi
+++ b/tim2view.lpi
@@ -24,7 +24,7 @@
-
+
@@ -43,7 +43,7 @@
-
+
@@ -116,6 +116,11 @@
+
+
+
+
+
diff --git a/tim2view.lpr b/tim2view.lpr
index 56416cf..ec6401b 100644
--- a/tim2view.lpr
+++ b/tim2view.lpr
@@ -8,7 +8,7 @@ uses
{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, umain, edc, ucommon, ecc, ucdimage, utim, usettings, uscanresult,
- uscanthread, ucpucount, udrawtim, BGRABitmap;
+ uscanthread, ucpucount, udrawtim, BGRABitmap, uexportimport;
{$R *.res}
diff --git a/tim2view.lps b/tim2view.lps
index 7383ba3..aa73f64 100644
--- a/tim2view.lps
+++ b/tim2view.lps
@@ -4,16 +4,16 @@
-
+
-
+
-
-
+
+
@@ -23,11 +23,12 @@
+
-
-
-
+
+
+
@@ -35,121 +36,149 @@
-
+
-
+
-
+
-
-
+
-
-
-
+
+
+
-
+
-
-
-
+
+
+
+
-
-
-
+
+
+
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
+
+
+
+
+
-
+
-
-
-
+
+
+
-
+
-
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tim2view.res b/tim2view.res
index a694ad7..3eccf57 100644
Binary files a/tim2view.res and b/tim2view.res differ
diff --git a/todos.inc b/todos.inc
new file mode 100644
index 0000000..15283c5
--- /dev/null
+++ b/todos.inc
@@ -0,0 +1,2 @@
+{ TODO : Zooming? }
+{ TODO 1 : Export: save as paletted PNG. Import: find matched colors in CLUT when importing }
diff --git a/ucommon.pas b/ucommon.pas
index 7257061..9ba0167 100644
--- a/ucommon.pas
+++ b/ucommon.pas
@@ -29,29 +29,11 @@ type
PBytesArray = ^TBytesArray;
function ExtractJustName(const Path: string): string;
-function Min(A, B: Integer): Integer;
-function Max(A, B: Integer): Integer;
implementation
uses sysutils;
-function Min(A, B: Integer): Integer;
-begin
- if A < B then
- Result := A
- else
- Result := B;
-end;
-
-function Max(A, B: Integer): Integer;
-begin
- if A >= B then
- Result := A
- else
- Result := B;
-end;
-
function ExtractJustName(const Path: string): string;
begin
Result := ExtractFileName(Path);
diff --git a/udrawtim.pas b/udrawtim.pas
index 0ad5d6c..aec4970 100644
--- a/udrawtim.pas
+++ b/udrawtim.pas
@@ -10,41 +10,99 @@ type
PDrawSurf = ^TBGRABitmap;
PDrawGrid = ^TDrawGrid;
-procedure TimToPNG(TIM: PTIM; CLUT_NUM: Integer; var Surf: PDrawSurf; TranspMode: Byte);
+
+procedure Tim2Png(TIM: PTIM; CLUT_NUM: Integer; Surf: PDrawSurf; TranspMode: Byte; ForExport: Boolean);
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(ACanvas: PCanvas; Rect: TRect);
procedure ClearGrid(Grid: PDrawGrid);
implementation
uses
- ucommon, BGRABitmapTypes, Math;
+ BGRABitmapTypes, Math, FPimage;
-function PrepareCLUT(TIM: PTIM; CLUT_NUM: Integer): PCLUT_COLORS;
+type
+ PFPPalette = ^TFPPalette;
+
+procedure AlphaForMode(C: PFPColor; TranspMode: Integer);
var
- I: Integer;
+ BT, CT: Boolean;
begin
- Result := nil;
- if (not TIMHasCLUT(TIM)) and (not(TIM^.HEAD^.bBPP in [cTIM4NC, cTIM8NC])) then
- Exit;
+ BT := TranspMode in [0, 1];
+ CT := TranspMode in [0, 2];
- New(Result);
+ if not (BT or CT) then
+ C^.alpha := $FFFF
+ else
+ begin
+ if (C^.red + C^.green + C^.blue) = 0 then
+ case (C^.alpha and 1) of
+ 0: C^.alpha := Word(ifthen(BT, 0, $FFFF));
+ 1: C^.alpha := $FFFF;
+ end
+ else
+ if CT then
+ case (C^.alpha and 1) of
+ 0: C^.alpha := $FFFF;
+ 1: C^.alpha := Word(ifthen(CT, $8080, $FFFF));
+ end
+ else
+ C^.alpha := $FFFF;
+ end;
+end;
+
+procedure PrepareClut(TIM: PTIM; CLUT_NUM: Integer; Pal: PFPPalette; TranspMode: Integer; ForExport: Boolean);
+var
+ I, COUNT: Integer;
+ CC: TCLUT_COLOR;
+ R, G, B, A: Byte;
+ FC: TFPColor;
+begin
+ if (TIM^.HEAD^.bBPP in [cTIM16NC, cTIM24NC]) then Exit;
if (TIM^.HEAD^.bBPP in [cTIM4NC, cTIM8NC]) then
begin
Randomize;
- for I := 1 to $100 do
- Result^[I - 1] := GetCLUTColor(TIM, CLUT_NUM, I - 1);
+ COUNT := 256;
+ end
+ else
+ COUNT := GetTimColorsCount(TIM);
- Exit;
+ Pal^.Clear;
+ for I := 1 to 256 do
+ begin
+ CC := GetCLUTColor(TIM, CLUT_NUM, I - 1);
+ if I <= COUNT then
+ begin
+ R := CC.R;
+ G := CC.G;
+ B := CC.B;
+ A := CC.STP;
+ end
+ else
+ begin
+ R := 0;
+ G := 0;
+ B := 0;
+ A := 1;
+ end;
+
+ if ForExport then
+ begin
+ R := R + (((I - 1) and $03) shl 1) + A;
+ G := G + (((I - 1) and $1C) shr 2);
+ B := B + (((I - 1) and $E0) shr 5);
+ A := 255;
+ end;
+
+ FC := BGRAToFPColor(BGRA(R, G, B, A));
+ AlphaForMode(@FC, TranspMode);
+ Pal^.Add(FC);
end;
-
- for I := 1 to GetTimColorsCount(TIM) do
- Result^[I - 1] := GetCLUTColor(TIM, CLUT_NUM, I - 1);
end;
-function PrepareIMAGE(TIM: PTIM): PIMAGE_INDEXES;
+function PrepareImage(TIM: PTIM): PIMAGE_INDEXES;
var
I, OFFSET: Integer;
RW: Word;
@@ -107,17 +165,15 @@ begin
ClearCanvas(@Grid^.Canvas, Grid^.CellRect(X - 1, Y - 1));
end;
-procedure TimToPNG(TIM: PTIM; CLUT_NUM: Integer; var Surf: PDrawSurf; TranspMode: Byte);
+procedure Tim2Png(TIM: PTIM; CLUT_NUM: Integer; Surf: PDrawSurf; TranspMode: Byte; ForExport: Boolean);
var
RW, RH, CW: Word;
- CLUT_DATA: PCLUT_COLORS;
- IMAGE_DATA: PIMAGE_INDEXES;
- X, Y, INDEX, IMAGE_DATA_POS: Integer;
- R, G, B, STP, ALPHA: Byte;
- COLOR: TCLUT_COLOR;
- CL: Integer;
- P: PBGRAPixel;
- Transparent, SemiTransparent: boolean;
+ INDEXES: PIMAGE_INDEXES;
+ X, Y, INDEX, IDX, COLORS: Integer;
+ R, G, B: Byte;
+ CC: TCLUT_COLOR;
+ PAL: PFPPalette;
+ FC: TFPColor;
begin
RW := GetTimRealWidth(TIM);
RH := GetTimHeight(TIM);
@@ -125,106 +181,60 @@ begin
if (Surf^ <> nil) then Surf^.Free;
Surf^ := TBGRABitmap.Create(RW, RH);
+ Surf^.UsePalette := not(TIM^.HEAD^.bBPP in [cTIM16NC, cTIM24NC]);
- CLUT_DATA := PrepareCLUT(TIM, CLUT_NUM);
- IMAGE_DATA := PrepareIMAGE(TIM);
+ PAL := @(Surf^.Palette);
- IMAGE_DATA_POS := 0;
+ PrepareClut(TIM, CLUT_NUM, PAL, TranspMode, ForExport);
+ INDEXES := PrepareIMAGE(TIM);
- Transparent := TranspMode in [0, 1];
- SemiTransparent := TranspMode in [0, 2];
+ COLORS := GetTimColorsCount(TIM);
+ IDX := 0;
R := 0;
G := 0;
B := 0;
- STP := 0;
for Y := 1 to RH do
- begin
- P := Surf^.ScanLine[Y - 1];
for X := 1 to RW do
begin
case TIM^.HEAD^.bBPP of
- cTIM4C, cTIM4NC, cTIM8C, cTIM8NC:
- begin
- INDEX := IMAGE_DATA^[IMAGE_DATA_POS];
-
- R := CLUT_DATA^[INDEX].R;
- G := CLUT_DATA^[INDEX].G;
- B := CLUT_DATA^[INDEX].B;
- STP := CLUT_DATA^[INDEX].STP;
- end;
+ cTIM4C, cTIM4NC, cTIM8C, cTIM8NC: Surf^.Pixels[X - 1, Y - 1] := INDEXES^[IDX] mod COLORS;
cTIM16C, cTIM16NC, cTIMMix:
begin
- Move(IMAGE_DATA^[IMAGE_DATA_POS], CW, 2);
- COLOR := ConvertTIMColor(CW);
+ Move(INDEXES^[IDX], CW, 2);
+ CC := ConvertTIMColor(CW);
- R := COLOR.R;
- G := COLOR.G;
- B := COLOR.B;
- STP := COLOR.STP;
+ FC := BGRAToFPColor(BGRA(CC.R + CC.STP, CC.G, CC.B));
+ if (not ForExport) then AlphaForMode(@FC, TranspMode);
+
+ Surf^.Colors[X - 1, Y - 1] := FC;
end;
cTIM24C, cTIM24NC:
begin
- CL := IMAGE_DATA^[IMAGE_DATA_POS];
+ INDEX := INDEXES^[IDX];
- R := (CL and $FF);
- G := ((CL and $FF00) shr 8);
- B := ((CL and $FF0000) shr 16);
- STP := 0;
+ R := (INDEX and $FF);
+ G := ((INDEX and $FF00) shr 8);
+ B := ((INDEX and $FF0000) shr 16);
+ Surf^.Colors[X - 1, Y - 1] := BGRAToFPColor(BGRA(R, G, B, 255));
end;
else
Break;
end;
-
- if (TIM^.HEAD^.bBPP in cTIM24) or (not(Transparent or SemiTransparent))
- then
- ALPHA := 255
- else
- begin
- if (R + G + B) = 0 then
- ALPHA := 0
- else
- begin
- if (STP = 0) then
- ALPHA := 255
- else
- ALPHA := 128;
-
- if (not SemiTransparent) and (ALPHA = 128) then
- ALPHA := 255;
- end;
- end;
-
- if ALPHA = 0 then
- begin
- B := 0;
- G := 0;
- R := 0;
- end;
-
- P^.alpha:=ALPHA;
- P^.blue := B;
- P^.green := G;
- P^.red := R;
-
- Inc(P);
- Inc(IMAGE_DATA_POS);
+ Inc(IDX);
end;
- end;
- Surf^.InvalidateBitmap;
- Dispose(CLUT_DATA);
- Dispose(IMAGE_DATA);
+ Dispose(INDEXES);
end;
-procedure DrawClutCell(TIM: PTIM; CLUT_NUM: Integer; Grid: PDrawGrid;
- X, Y: Integer);
+procedure DrawClutCell(TIM: PTIM; CLUT_NUM: Integer; Grid: PDrawGrid; X, Y: Integer);
var
CLUT_COLOR: PCLUT_COLOR;
- R, G, B, STP, ALPHA: Byte;
+ R, G, B, STP: Byte;
Rect: TRect;
COLS, Colors: Integer;
+ FC: TFPColor;
begin
Colors := GetTimColorsCount(TIM);
COLS := Min(Colors, 32);
@@ -248,20 +258,13 @@ begin
Grid^.Canvas.FillRect(Rect);
- if (R + G + B) = 0 then
- ALPHA := 0
- else
- begin
- if STP = 0 then
- ALPHA := 255
- else
- ALPHA := 128;
- end;
+ FC := BGRAToFPColor(BGRA(R, G, B, STP));
+ AlphaForMode(@FC, 0);
- if ALPHA in [0, 128] then
+ if (FC.alpha = 0) or (FC.alpha = $8080) then
begin
Grid^.Canvas.Brush.COLOR := clWhite;
- if ALPHA = 0 then
+ if FC.ALPHA = 0 then
Rect.Bottom := Rect.Top + ((Rect.Bottom - Rect.Top) div 2)
else
Rect.Right := Rect.Left + ((Rect.Right - Rect.Left) div 2);
diff --git a/uexportimport.pas b/uexportimport.pas
new file mode 100644
index 0000000..86fb48f
--- /dev/null
+++ b/uexportimport.pas
@@ -0,0 +1,27 @@
+unit uexportimport;
+
+interface
+
+uses FPWritePNG, zstream, udrawtim;
+
+procedure SaveImage(Surf: PDrawSurf; Indexed: Boolean; const FileName: string; PngWriter: TFPWriterPNG);
+function CreatePngWriter(ForExport: Boolean): TFPWriterPNG;
+
+implementation
+
+function CreatePngWriter(ForExport: Boolean): TFPWriterPNG;
+begin
+ Result := TFPWriterPNG.Create;
+ Result.CompressionLevel := clnone;
+ Result.WordSized := False;
+ Result.UseAlpha := (not ForExport);
+end;
+
+procedure SaveImage(Surf: PDrawSurf; Indexed: Boolean; const FileName: string; PngWriter: TFPWriterPNG);
+begin
+ PngWriter.Indexed := Indexed;
+ Surf^.SaveToFileUTF8(FileName, PngWriter);
+end;
+
+end.
+
diff --git a/umain.lfm b/umain.lfm
index 1e8ceff..1814f34 100644
--- a/umain.lfm
+++ b/umain.lfm
@@ -494,7 +494,7 @@ object frmMain: TfrmMain
OnCreate = FormCreate
OnDropFiles = FormDropFiles
Position = poScreenCenter
- LCLVersion = '1.3'
+ LCLVersion = '1.2.0.3'
object pnlStatus: TPanel
Left = 0
Height = 30
@@ -741,12 +741,12 @@ object frmMain: TfrmMain
end
object pnlClut: TPanel
Left = 1
- Height = 116
- Top = 352
+ Height = 129
+ Top = 339
Width = 520
Align = alBottom
BevelOuter = bvLowered
- ClientHeight = 116
+ ClientHeight = 129
ClientWidth = 520
Color = clBtnFace
ParentColor = False
@@ -754,7 +754,7 @@ object frmMain: TfrmMain
Visible = False
object grdClut: TDrawGrid
Left = 1
- Height = 114
+ Height = 127
Top = 1
Width = 518
Align = alClient
@@ -773,14 +773,13 @@ object frmMain: TfrmMain
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'Tahoma'
- UseXORFeatures = True
OnDblClick = grdClutDblClick
OnDrawCell = grdClutDrawCell
end
end
object imgTim: TImage
Left = 1
- Height = 351
+ Height = 338
Top = 1
Width = 520
AntialiasingMode = amOff
diff --git a/umain.pas b/umain.pas
index 6d019d0..74a4396 100644
--- a/umain.pas
+++ b/umain.pas
@@ -168,6 +168,7 @@ type
procedure ShowTim;
procedure ShowTimInfo(ShowInfo: Boolean);
procedure RemoveGridSelection;
+ procedure Update(Tim, Clut, ClutInfo: Boolean);
public
{ public declarations }
ScanResults: TScanResultList; //List of finished scan results
@@ -180,7 +181,7 @@ var
implementation
-uses ucdimage, ucpucount, lcltype, ucommon, LCLIntf
+uses ucdimage, ucpucount, lcltype, ucommon, LCLIntf, uexportimport, FPWritePNG
{$IFDEF windows}
,registry
@@ -226,35 +227,44 @@ end;
procedure TfrmMain.actStretchExecute(Sender: TObject);
begin
Settings.StretchMode := actStretch.Checked;
- DrawSelTim;
+ Update(True, False, False);
end;
procedure TfrmMain.actTim2PngExecute(Sender: TObject);
+var
+ TIM: PTIM;
+ Writer: TFPWriterPNG;
begin
- dlgSavePNG.FileName := FormatPngName(SelectedScanResult.ScanFile, SelectedTimIdx, SelectedTimInfo.BitMode, cbbCLUT.ItemIndex);
+ TIM := SelectedTim;
+ if TIM = nil then Exit;
+
+ dlgSavePNG.FileName := FormatPngName(SelectedScanResult.ScanFile, TIM^.dwTimNumber, SelectedTimInfo.BitMode, cbbCLUT.ItemIndex);
if not dlgSavePNG.Execute then Exit;
- Surf^.SaveToFile(UTF8ToSys(dlgSavePNG.FileName));
+ Writer := CreatePngWriter(False);
+ SaveImage(Surf, TIMisIndexed(TIM), dlgSavePNG.FileName, Writer);
+ Writer.Free;
+ FreeTIM(TIM);
{$IFDEF Linux}FpChmod(dlgSavePNG.FileName, &777){$IFEND}
end;
procedure TfrmMain.btnShowClutClick(Sender: TObject);
begin
pnlClut.Visible := not pnlClut.Visible;
- DrawSelClut;
+ Update(False, True, False);
actReturnFocus.Execute;
end;
procedure TfrmMain.cbbBitModeChange(Sender: TObject);
begin
- DrawSelTim;
+ Update(True, False, False);
end;
procedure TfrmMain.cbbTranspModeChange(Sender: TObject);
begin
Settings.TranspMode := cbbTranspMode.ItemIndex;
- DrawSelTim;
+ Update(True, False, False);
end;
procedure TfrmMain.actChangeFileExecute(Sender: TObject);
@@ -266,6 +276,8 @@ begin
lvList.ItemIndex := 0;
lvList.Items[0].Focused := True;
lvList.Items[0].Selected := True;
+
+ ShowTim;
end;
procedure TfrmMain.actAboutExecute(Sender: TObject);
@@ -313,8 +325,7 @@ end;
procedure TfrmMain.actChangeClutIdxExecute(Sender: TObject);
begin
- DrawSelTim;
- DrawSelClut;
+ Update(True, True, False);
end;
procedure TfrmMain.actCloseFileExecute(Sender: TObject);
@@ -326,9 +337,7 @@ begin
ShowTimInfo(False);
SetTimsListCount(0);
- UpdateCLUTInfo;
- DrawSelTim;
- DrawSelClut;
+ Update(True, True, True);
cbbFiles.Items.Delete(cbbFiles.ItemIndex);
@@ -362,6 +371,7 @@ var
ScanTim: TTimInfo;
TIM: PTIM;
Surf_: PDrawSurf;
+ Writer: TFPWriterPNG;
begin
lblStatus.Caption := sStatusBarPngsExtracting;
@@ -371,6 +381,8 @@ begin
New(Surf_);
Surf_^ := nil;
+ Writer := CreatePngWriter(False);
+
pbProgress.Position := 0;
pbProgress.Max := SelectedScanResult.Count;
for I := 1 to SelectedScanResult.Count do
@@ -386,10 +398,10 @@ begin
CreateDirUTF8(Path);
TIM := LoadTimFromFile(FName, OFFSET, IsImage, SIZE);
- TimToPNG(TIM, cbbCLUT.ItemIndex, Surf_, cbbTranspMode.ItemIndex);
+ Tim2Png(TIM, cbbCLUT.ItemIndex, Surf_, cbbTranspMode.ItemIndex, False);
Path := Path + FormatPngName(FName, I - 1, BIT_MODE, 0);
- Surf_^.SaveToFile(UTF8ToSys(Path));
+ SaveImage(Surf_, TIMisIndexed(TIM), Path, Writer);
{$IFDEF Linux}FpChmod(Path, &777){$IFEND}
Surf_^.Free;
Surf_^ := nil;
@@ -400,6 +412,7 @@ begin
Application.ProcessMessages;
end;
Dispose(Surf_);
+ Writer.Free;
lblStatus.Caption := sStatusBarExtracted;
pbProgress.Position := 0;
end;
@@ -602,9 +615,7 @@ begin
FreeTIM(TIM);
- DrawSelTim;
- DrawSelClut;
-
+ Update(True, True, False);
end;
procedure TfrmMain.grdClutDrawCell(Sender: TObject; aCol, aRow: Integer;
@@ -833,12 +844,10 @@ begin
if TIM = nil then Exit;
CLUTS := GetTIMClutsCount(TIM);
+ cbbCLUT.Items.Clear;
cbbCLUT.Items.BeginUpdate;
- for I := 0 to cbbCLUT.Items.Count -1 do
- cbbCLUT.Items[i] := Format('CLUT [%.2d/%.2d]', [I + 1, CLUTS]);
-
- for I := cbbCLUT.Items.Count + 1 to CLUTS do
+ for I := 1 to CLUTS do
cbbCLUT.Items.Add(Format('CLUT [%.2d/%.2d]', [I, CLUTS]));
cbbCLUT.Items.EndUpdate;
@@ -873,7 +882,7 @@ begin
Index := cbbCLUT.ItemIndex;
- TimToPNG(TIM, Index, Surf, cbbTranspMode.ItemIndex);
+ Tim2Png(TIM, Index, Surf, cbbTranspMode.ItemIndex, False);
imgTim.Picture.Bitmap := TBitmap.Create;
imgTim.Picture.Bitmap := Surf^.Bitmap;
FreeTIM(TIM);
@@ -937,9 +946,7 @@ begin
{ TODO : Reset bitmode or not? }
//cbbBitMode.ItemIndex := 0;
- UpdateCLUTInfo;
- DrawSelTim;
- DrawSelClut;
+ Update(True, True, True);
ShowTimInfo(True);
@@ -1000,5 +1007,12 @@ begin
grdClut.Selection := hGrid;
end;
+procedure TfrmMain.Update(Tim, Clut, ClutInfo: Boolean);
+begin
+ if ClutInfo then UpdateCLUTInfo;
+ if Tim then DrawSelTim;
+ if Clut then DrawSelClut;
+end;
+
end.
diff --git a/utim.pas b/utim.pas
index df83eeb..7173e80 100644
--- a/utim.pas
+++ b/utim.pas
@@ -104,6 +104,7 @@ type
PTIM = ^TTIM;
function TIMHasCLUT(TIM: PTIM): Boolean;
+function TIMisIndexed(TIM: PTIM): Boolean;
function GetTIMCLUTSize(TIM: PTIM): Integer;
function GetTIMSize(TIM: PTIM): Integer;
function GetTimWidth(TIM: PTIM): word;
@@ -189,6 +190,11 @@ begin
Result := TIM^.IMAGE^.wHeight;
end;
+function TIMisIndexed(TIM: PTIM): Boolean;
+begin
+ Result := TIM^.HEAD^.bBPP in [cTIM4C, cTIM4NC, cTIM8C, cTIM8NC];
+end;
+
function GetTIMCLUTSize(TIM: PTIM): Integer;
begin
Result := 0;