From 5d477f135b674e8b2c5272265671a1aebe228102 Mon Sep 17 00:00:00 2001 From: "meffi@lab313.ru" Date: Sat, 26 Apr 2014 12:59:46 +0000 Subject: [PATCH] Debug fixes. Not for update. --- tim2view.lpi | 13 ++++- tim2view.lps | 108 +++++++++++++++++++++++++++++++--------- tim2view.res | Bin 16796 -> 16796 bytes udrawtim.pas | 123 ++++++++++++++++++++++++++++++++++++++-------- uexportimport.pas | 33 ++++++++++++- umain.lfm | 47 +++++++++++++----- umain.pas | 62 +++++++++++++++++------ 7 files changed, 314 insertions(+), 72 deletions(-) diff --git a/tim2view.lpi b/tim2view.lpi index d23260f..f877305 100644 --- a/tim2view.lpi +++ b/tim2view.lpi @@ -24,7 +24,7 @@ - + @@ -131,7 +131,6 @@ - @@ -140,7 +139,17 @@ + + + + + + + + + + diff --git a/tim2view.lps b/tim2view.lps index aa73f64..6e6bb93 100644 --- a/tim2view.lps +++ b/tim2view.lps @@ -4,15 +4,15 @@ - + - + - + @@ -23,11 +23,10 @@ - - - + + @@ -66,8 +65,8 @@ - - + + @@ -77,8 +76,8 @@ - - + + @@ -97,10 +96,10 @@ - + - - + + @@ -110,8 +109,8 @@ - - + + @@ -130,10 +129,11 @@ + - - + + @@ -141,12 +141,15 @@ + + + - + @@ -157,20 +160,60 @@ - + - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + @@ -178,6 +221,27 @@ + + + + + + + + + + + + + + + + + + + + + diff --git a/tim2view.res b/tim2view.res index 3eccf57b2cfc0116aa94ac253549cd008ded3a01..cc4ac69c3172ec87f098addc0f8c73ddfc0177c6 100644 GIT binary patch delta 23 fcmbQ!%s8i+al;yBM%K-1nNt}VO*ad(cG>^{U`z)! delta 23 fcmbQ!%s8i+al;yBMwZQMnNt}VO*RX&cG>^{U^xdf diff --git a/udrawtim.pas b/udrawtim.pas index aec4970..c88d81b 100644 --- a/udrawtim.pas +++ b/udrawtim.pas @@ -11,7 +11,8 @@ type PDrawGrid = ^TDrawGrid; -procedure Tim2Png(TIM: PTIM; CLUT_NUM: Integer; Surf: PDrawSurf; TranspMode: Byte; ForExport: Boolean); +procedure Tim2Png(TIM: PTIM; CLUT_NUM: Integer; Surf: PDrawSurf; TranspMode: Byte); +procedure Png2Tim(Image: PDrawSurf; Dest: PTIM); procedure DrawClutCell(TIM: PTIM; CLUT_NUM: Integer; Grid: PDrawGrid; X, Y: Integer); procedure DrawClut(TIM: PTIM; CLUT_NUM: Integer; Grid: PDrawGrid); procedure ClearCanvas(ACanvas: PCanvas; Rect: TRect); @@ -52,7 +53,23 @@ begin end; end; -procedure PrepareClut(TIM: PTIM; CLUT_NUM: Integer; Pal: PFPPalette; TranspMode: Integer; ForExport: Boolean); +function StpFromAlpha(C: PFPColor): Byte; +begin + Result := 0; + + if (C^.red + C^.green + C^.blue) = 0 then + case C^.alpha of + $0000: Result := 0; + $FFFF: Result := 1; + end + else + case C^.alpha of + $FFFF: Result := 0; + $8080: Result := 1; + end +end; + +procedure PrepareClut(TIM: PTIM; CLUT_NUM: Integer; Pal: PFPPalette; TranspMode: Integer); var I, COUNT: Integer; CC: TCLUT_COLOR; @@ -88,14 +105,6 @@ begin 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); @@ -107,25 +116,27 @@ var I, OFFSET: Integer; RW: Word; P24: Integer; + WH: Integer; begin New(Result); OFFSET := SizeOf(TTIMHeader) + GetTIMCLUTSize(TIM) + SizeOf(TIMAGEHeader); RW := GetTimRealWidth(TIM); + WH := TIM^.IMAGE^.wWidth * TIM^.IMAGE^.wHeight; case TIM^.HEAD^.bBPP of cTIM4C, cTIM4NC: - for I := 1 to TIM^.IMAGE^.wWidth * TIM^.IMAGE^.wHeight * 2 do + for I := 1 to WH * 2 do begin Result^[(I - 1) * 2] := TIM^.DATA^[OFFSET + I - 1] and $F; Result^[(I - 1) * 2 + 1] := (TIM^.DATA^[OFFSET + I - 1] and $F0) shr 4; end; cTIM8C, cTIM8NC: - for I := 1 to TIM^.IMAGE^.wWidth * TIM^.IMAGE^.wHeight * 2 do + for I := 1 to WH * 2 do Result^[I - 1] := TIM^.DATA^[OFFSET + I - 1]; cTIM16C, cTIM16NC: - for I := 1 to TIM^.IMAGE^.wWidth * TIM^.IMAGE^.wHeight do + for I := 1 to WH do Move(TIM^.DATA^[OFFSET + (I - 1) * 2], Result^[I - 1], 2); cTIM24C, cTIM24NC: @@ -133,14 +144,13 @@ begin I := 1; P24 := 0; - while I <= (TIM^.IMAGE^.wWidth * TIM^.IMAGE^.wHeight * 2) do + while I <= (WH * 2) do begin Result^[P24] := 0; Move(TIM^.DATA^[OFFSET + (I - 1)], Result^[P24], 3); Inc(I, 3); - if Odd(RW) and (((P24 + 1) mod RW) = 0) then - Inc(OFFSET); + if Odd(RW) and (((P24 + 1) mod RW) = 0) then Inc(OFFSET); Inc(P24); end; @@ -165,7 +175,7 @@ begin ClearCanvas(@Grid^.Canvas, Grid^.CellRect(X - 1, Y - 1)); end; -procedure Tim2Png(TIM: PTIM; CLUT_NUM: Integer; Surf: PDrawSurf; TranspMode: Byte; ForExport: Boolean); +procedure Tim2Png(TIM: PTIM; CLUT_NUM: Integer; Surf: PDrawSurf; TranspMode: Byte); var RW, RH, CW: Word; INDEXES: PIMAGE_INDEXES; @@ -185,7 +195,7 @@ begin PAL := @(Surf^.Palette); - PrepareClut(TIM, CLUT_NUM, PAL, TranspMode, ForExport); + PrepareClut(TIM, CLUT_NUM, PAL, TranspMode); INDEXES := PrepareIMAGE(TIM); COLORS := GetTimColorsCount(TIM); @@ -202,11 +212,12 @@ begin cTIM4C, cTIM4NC, cTIM8C, cTIM8NC: Surf^.Pixels[X - 1, Y - 1] := INDEXES^[IDX] mod COLORS; cTIM16C, cTIM16NC, cTIMMix: begin + CW := 0; Move(INDEXES^[IDX], CW, 2); CC := ConvertTIMColor(CW); - FC := BGRAToFPColor(BGRA(CC.R + CC.STP, CC.G, CC.B)); - if (not ForExport) then AlphaForMode(@FC, TranspMode); + FC := BGRAToFPColor(BGRA(CC.R, CC.G, CC.B, CC.STP)); + AlphaForMode(@FC, TranspMode); Surf^.Colors[X - 1, Y - 1] := FC; end; @@ -228,6 +239,78 @@ begin Dispose(INDEXES); end; +procedure Png2Tim(Image: PDrawSurf; Dest: PTIM); +var + IW, IH, X, Y, CW: Word; + TData: PTIMDataArray; + IDX, POS, C: Integer; + CC: TCLUT_COLOR; + PC: TBGRAPixel; + FC: TFPColor; + CD: DWord; +begin + IW := Image^.Width; + IH := Image^.Height; + + TData := @Dest^.DATA^[SizeOf(TTIMHeader) + GetTIMCLUTSize(Dest) + SizeOf(TIMAGEHeader)]; + { TODO : Fix colors finding. } + + POS := 0; + for Y := 1 to IH do + case Dest^.HEAD^.bBPP of + cTIM4C, cTIM4NC: + for X := 1 to (IW div 2) do + begin + IDX := Image^.Pixels[X - 1, Y - 1]; + TData^[POS] := (IDX and $F); + IDX := Image^.Pixels[X, Y - 1]; + TData^[POS] := TData^[0] + (IDX and $F0); + Inc(POS); + end; + + cTIM8C, cTIM8NC: + for X := 1 to IW do + begin + C := Image^.Pixels[X - 1, Y - 1]; + TData^[POS] := Byte(C); + Inc(POS); + end; + + cTIM16C, cTIM16NC: + for X := 1 to IW do + begin + FC := Image^.Colors[X - 1, Y - 1]; + CC.STP := StpFromAlpha(@FC); + PC := FPColorToBGRA(FC); + CC.R := PC.red; + CC.G := PC.green; + CC.B := PC.blue; + + CW := ConvertCLUTColor(CC); + + Move(CW, TData^[POS], 2); + Inc(POS, 2); + end; + + cTIM24C, cTIM24NC: + for X := 1 to IW do + begin + FC := Image^.Colors[X - 1, Y - 1]; + PC := FPColorToBGRA(FC); + CD := (PC.blue shl 16) + (PC.green shl 8) + PC.red; + + Move(CD, TData^[POS], 3); + Inc(POS, 3); + + if Odd(IW) and ((IW - X) = 0) then + begin + TData^[POS] := 0; + Inc(POS); + end; + end; + end; +end; + procedure DrawClutCell(TIM: PTIM; CLUT_NUM: Integer; Grid: PDrawGrid; X, Y: Integer); var CLUT_COLOR: PCLUT_COLOR; diff --git a/uexportimport.pas b/uexportimport.pas index 86fb48f..aa9ede2 100644 --- a/uexportimport.pas +++ b/uexportimport.pas @@ -2,13 +2,18 @@ unit uexportimport; interface -uses FPWritePNG, zstream, udrawtim; +uses + FPWritePNG, zstream, udrawtim; procedure SaveImage(Surf: PDrawSurf; Indexed: Boolean; const FileName: string; PngWriter: TFPWriterPNG); +function LoadImage(const FileName: string; var Surf: PDrawSurf): Boolean; function CreatePngWriter(ForExport: Boolean): TFPWriterPNG; implementation +uses + FPReadPNG, Classes, BGRABitmap, FileUtil, sysutils; + function CreatePngWriter(ForExport: Boolean): TFPWriterPNG; begin Result := TFPWriterPNG.Create; @@ -23,5 +28,31 @@ begin Surf^.SaveToFileUTF8(FileName, PngWriter); end; +function LoadImage(const FileName: string; var Surf: PDrawSurf): Boolean; +var + Reader: TFPReaderPNG; + Image: TFileStream; +begin + Result := False; + + try + Reader := TFPReaderPNG.Create; + Image := TFileStream.Create(UTF8ToSys(FileName), fmOpenRead or fmShareDenyWrite); + Result := Reader.CheckContents(Image); + + if Result then + begin + New(Surf); + Surf^ := TBGRABitmap.Create; + Image.Position := 0; + Surf^.LoadFromStream(Image); + end; + + finally + Image.Free; + Reader.Free; + end; +end; + end. diff --git a/umain.lfm b/umain.lfm index 1814f34..38bf6a1 100644 --- a/umain.lfm +++ b/umain.lfm @@ -494,7 +494,7 @@ object frmMain: TfrmMain OnCreate = FormCreate OnDropFiles = FormDropFiles Position = poScreenCenter - LCLVersion = '1.2.0.3' + LCLVersion = '1.2.2.0' object pnlStatus: TPanel Left = 0 Height = 30 @@ -828,11 +828,11 @@ object frmMain: TfrmMain DefaultExt = '.bin' Filter = 'All Files (*.*)|*.*' Options = [ofHideReadOnly, ofNoChangeDir, ofAllowMultiSelect, ofNoNetworkButton, ofEnableSizing, ofForceShowHidden] - left = 664 + left = 576 top = 448 end object mmMain: TMainMenu - left = 600 + left = 352 top = 448 object mnFile: TMenuItem Caption = '&File' @@ -867,6 +867,15 @@ object frmMain: TfrmMain Action = actTim2Png end end + object mnEdit: TMenuItem + Caption = '&Edit' + object mnExportTim: TMenuItem + Action = actPngExport + end + object mnImport: TMenuItem + Action = actPngImport + end + end object mnOptions: TMenuItem Caption = '&Options' object mnAssociate: TMenuItem @@ -904,7 +913,7 @@ object frmMain: TfrmMain DefaultExt = '.png' Filter = 'Portable Network Graphics (*.png)|*.png' Options = [ofHideReadOnly, ofNoChangeDir, ofNoNetworkButton, ofEnableSizing] - left = 696 + left = 688 top = 448 end object dlgSaveTIM: TSaveDialog @@ -912,7 +921,7 @@ object frmMain: TfrmMain DefaultExt = '.tim' Filter = 'PSX TIM Files (*.tim)|*.tim|All Files (*.*)|*.*' Options = [ofOverwritePrompt, ofHideReadOnly, ofNoChangeDir, ofNoNetworkButton, ofEnableSizing] - left = 568 + left = 608 top = 448 end object dlgColor: TColorDialog @@ -939,11 +948,11 @@ object frmMain: TfrmMain 'ColorS=F0FBFF' 'ColorT=A4A0A0' ) - left = 536 + left = 496 top = 448 end object actList: TActionList - left = 504 + left = 416 top = 448 object actScanFile: TAction Caption = 'Scan &File...' @@ -1034,9 +1043,17 @@ object frmMain: TfrmMain Caption = '&Background Color' OnExecute = actChangeBackColorExecute end + object actPngImport: TAction + Caption = '&Import PNG to TIM...' + OnExecute = actPngImportExecute + end + object actPngExport: TAction + Caption = '&Export TIM to PNG...' + OnExecute = actTim2PngExecute + end end object pmList: TPopupMenu - left = 632 + left = 448 top = 448 object ExtractTIM1: TMenuItem Action = actExtractTim @@ -1058,7 +1075,7 @@ object frmMain: TfrmMain end end object pmImage: TPopupMenu - left = 472 + left = 384 top = 448 object mnSaveAsPng: TMenuItem Action = actTim2Png @@ -1079,7 +1096,15 @@ object frmMain: TfrmMain end object dlgSelectDir: TSelectDirectoryDialog Options = [ofNoChangeDir, ofNoNetworkButton, ofEnableSizing, ofViewDetail] - left = 449 - top = 450 + left = 528 + top = 448 + end + object dlgOpenPNG: TOpenPictureDialog + Title = 'Please, select PNG...' + DefaultExt = '.png' + Filter = 'Portable Network Graphics (*.png)|*.png' + Options = [ofHideReadOnly, ofNoChangeDir, ofNoNetworkButton, ofEnableSizing] + left = 656 + top = 448 end end diff --git a/umain.pas b/umain.pas index 74a4396..af418b0 100644 --- a/umain.pas +++ b/umain.pas @@ -28,6 +28,8 @@ type actExtractTIMs: TAction; actChangeFile: TAction; actChangeBackColor: TAction; + actPngExport: TAction; + actPngImport: TAction; actStopScan: TAction; actOpenLab: TAction; actOpenRepo: TAction; @@ -55,6 +57,9 @@ type imgTim: TImage; lblStatus: TLabel; lvList: TListView; + mnImport: TMenuItem; + mnExportTim: TMenuItem; + mnEdit: TMenuItem; mnChangeBackColor2: TMenuItem; N8: TMenuItem; mnChangeBackColor: TMenuItem; @@ -85,6 +90,7 @@ type N1: TMenuItem; N3: TMenuItem; N5: TMenuItem; + dlgOpenPNG: TOpenPictureDialog; pnlClut: TPanel; pbProgress: TProgressBar; pnlExtractAll: TPanel; @@ -113,6 +119,7 @@ type procedure actExtractTIMsExecute(Sender: TObject); procedure actOpenLabExecute(Sender: TObject); procedure actOpenRepoExecute(Sender: TObject); + procedure actPngImportExecute(Sender: TObject); procedure actReplaceTimExecute(Sender: TObject); procedure actReturnFocusExecute(Sender: TObject); procedure actScanDirExecute(Sender: TObject); @@ -168,7 +175,7 @@ type procedure ShowTim; procedure ShowTimInfo(ShowInfo: Boolean); procedure RemoveGridSelection; - procedure Update(Tim, Clut, ClutInfo: Boolean); + procedure UpdateTim(Tim, Clut, ClutInfo: Boolean); public { public declarations } ScanResults: TScanResultList; //List of finished scan results @@ -227,7 +234,7 @@ end; procedure TfrmMain.actStretchExecute(Sender: TObject); begin Settings.StretchMode := actStretch.Checked; - Update(True, False, False); + UpdateTim(True, False, False); end; procedure TfrmMain.actTim2PngExecute(Sender: TObject); @@ -242,7 +249,7 @@ begin if not dlgSavePNG.Execute then Exit; - Writer := CreatePngWriter(False); + Writer := CreatePngWriter((Sender as TAction) = actPngExport); SaveImage(Surf, TIMisIndexed(TIM), dlgSavePNG.FileName, Writer); Writer.Free; FreeTIM(TIM); @@ -252,19 +259,19 @@ end; procedure TfrmMain.btnShowClutClick(Sender: TObject); begin pnlClut.Visible := not pnlClut.Visible; - Update(False, True, False); + UpdateTim(False, True, False); actReturnFocus.Execute; end; procedure TfrmMain.cbbBitModeChange(Sender: TObject); begin - Update(True, False, False); + UpdateTim(True, False, False); end; procedure TfrmMain.cbbTranspModeChange(Sender: TObject); begin Settings.TranspMode := cbbTranspMode.ItemIndex; - Update(True, False, False); + UpdateTim(True, False, False); end; procedure TfrmMain.actChangeFileExecute(Sender: TObject); @@ -325,7 +332,7 @@ end; procedure TfrmMain.actChangeClutIdxExecute(Sender: TObject); begin - Update(True, True, False); + UpdateTim(True, True, False); end; procedure TfrmMain.actCloseFileExecute(Sender: TObject); @@ -337,7 +344,7 @@ begin ShowTimInfo(False); SetTimsListCount(0); - Update(True, True, True); + UpdateTim(True, True, True); cbbFiles.Items.Delete(cbbFiles.ItemIndex); @@ -398,7 +405,7 @@ begin CreateDirUTF8(Path); TIM := LoadTimFromFile(FName, OFFSET, IsImage, SIZE); - Tim2Png(TIM, cbbCLUT.ItemIndex, Surf_, cbbTranspMode.ItemIndex, False); + Tim2Png(TIM, cbbCLUT.ItemIndex, Surf_, cbbTranspMode.ItemIndex); Path := Path + FormatPngName(FName, I - 1, BIT_MODE, 0); SaveImage(Surf_, TIMisIndexed(TIM), Path, Writer); @@ -481,13 +488,37 @@ begin OpenUrl('http://tim2view.googlecode.com'); end; +procedure TfrmMain.actPngImportExecute(Sender: TObject); +var + Image: PDrawSurf; + TIM: PTIM; + ScanRes: TScanResult; +begin + if not dlgOpenPNG.Execute then Exit; + if not LoadImage(dlgOpenPNG.FileName, Image) then Exit; + + TIM := SelectedTim; + if TIM = nil then Exit; + + Png2Tim(Image, TIM); + SaveTimToFile('test.tim', TIM); + ScanRes := SelectedScanResult; + ReplaceTimInFileFromMemory(ScanRes.ScanFile, TIM, SelectedTimInfo.Position, ScanRes.IsImage); + ShowTim; + FreeTIM(TIM); + Image^.Free; + Dispose(Image); +end; + procedure TfrmMain.actReplaceTimExecute(Sender: TObject); +var + ScanRes: TScanResult; begin if not dlgOpenFile.Execute then Exit; - if FileSize(dlgOpenFile.FileName) > cTIMMaxSize then Exit; - ReplaceTimInFile(SelectedScanResult.ScanFile, dlgOpenFile.FileName, SelectedTimInfo.Position, SelectedScanResult.IsImage); + ScanRes := SelectedScanResult; + ReplaceTimInFile(ScanRes.ScanFile, dlgOpenFile.FileName, SelectedTimInfo.Position, ScanRes.IsImage); ShowTim; end; @@ -615,7 +646,7 @@ begin FreeTIM(TIM); - Update(True, True, False); + UpdateTim(True, True, False); end; procedure TfrmMain.grdClutDrawCell(Sender: TObject; aCol, aRow: Integer; @@ -882,8 +913,7 @@ begin Index := cbbCLUT.ItemIndex; - Tim2Png(TIM, Index, Surf, cbbTranspMode.ItemIndex, False); - imgTim.Picture.Bitmap := TBitmap.Create; + Tim2Png(TIM, Index, Surf, cbbTranspMode.ItemIndex); imgTim.Picture.Bitmap := Surf^.Bitmap; FreeTIM(TIM); @@ -946,7 +976,7 @@ begin { TODO : Reset bitmode or not? } //cbbBitMode.ItemIndex := 0; - Update(True, True, True); + UpdateTim(True, True, True); ShowTimInfo(True); @@ -1007,7 +1037,7 @@ begin grdClut.Selection := hGrid; end; -procedure TfrmMain.Update(Tim, Clut, ClutInfo: Boolean); +procedure TfrmMain.UpdateTim(Tim, Clut, ClutInfo: Boolean); begin if ClutInfo then UpdateCLUTInfo; if Tim then DrawSelTim;