hackfix translucent texture preview; editor can now load all image formats

diff --git a/src/editor/f_addresource_texture.lfm b/src/editor/f_addresource_texture.lfm
index 520bf27b2329f4b790030ef8d3c63944726401c9..c1fed5a115a14b0f068adec9c0e3c0b52c563d2f 100644 (file)
--- a/src/editor/f_addresource_texture.lfm
+++ b/src/editor/f_addresource_texture.lfm
@@ -1,77 +1,82 @@
 inherited AddTextureForm: TAddTextureForm
   Left = 371
+  Height = 299
   Top = 194
+  Width = 466
   Caption = 'Выберите текстуру'
-  ClientHeight = 302
+  ClientHeight = 299
   ClientWidth = 466
-  PixelsPerInch = 96
   inherited bOK: TButton
     Left = 11
+    Height = 17
     Top = 272
     Width = 22
-    Height = 17
-    Visible = False
+    Default = False
     OnClick = nil
+    Visible = False
   end
   inherited bCancel: TButton
     Left = 35
+    Height = 18
     Top = 271
     Width = 22
-    Height = 18
     Visible = False
   end
   inherited lbResourcesList: TListBox
-    Top = 112
     Height = 150
+    Top = 112
+    ItemHeight = 0
   end
-  object PanelTexPreview: TPanel
+  object PanelTexPreview: TPanel[7]
     Left = 204
+    Height = 258
     Top = 4
     Width = 258
-    Height = 258
     BevelOuter = bvLowered
+    ClientHeight = 258
+    ClientWidth = 258
     TabOrder = 5
     object iPreview: TImage
       Left = 0
+      Height = 256
       Top = 0
       Width = 256
-      Height = 256
     end
   end
-  object eTextureName: TEdit
+  object eTextureName: TEdit[8]
     Left = 4
+    Height = 21
     Top = 88
     Width = 193
-    Height = 21
-    TabOrder = 6
     OnChange = eTextureNameChange
+    TabOrder = 6
   end
-  object bAddTexture: TButton
+  object bAddTexture: TButton[9]
     Left = 160
+    Height = 25
     Top = 272
     Width = 81
-    Height = 25
     Caption = 'Добавить'
     Default = True
-    TabOrder = 7
     OnClick = bAddTextureClick
+    TabOrder = 7
   end
-  object bClose: TButton
+  object bClose: TButton[10]
     Left = 248
+    Height = 25
     Top = 272
     Width = 81
-    Height = 25
     Caption = 'Закрыть'
-    TabOrder = 8
     OnClick = bCloseClick
+    TabOrder = 8
   end
-  object bAddClose: TButton
+  object bAddClose: TButton[11]
     Left = 336
+    Height = 25
     Top = 272
     Width = 121
-    Height = 25
     Caption = 'Добавить и закрыть'
-    TabOrder = 9
     OnClick = bAddCloseClick
+    TabOrder = 9
   end
 end

diff --git a/src/editor/f_addresource_texture.pas b/src/editor/f_addresource_texture.pas
index 195b22d52ead5396cb72fba75ef7e3dc2b56ebc4..7319645ffb72f1498a60a801089c0f8b25c3a1fe 100644 (file)
--- a/src/editor/f_addresource_texture.pas
+++ b/src/editor/f_addresource_texture.pas
@@ -7,7 +7,8 @@ interface
 uses
   LCLIntf, LCLType, LMessages, SysUtils, Variants, Classes,
   Graphics, Controls, Forms, Dialogs, f_addresource,
-  StdCtrls, ExtCtrls, utils;
+  StdCtrls, ExtCtrls, utils, Imaging, ImagingTypes, ImagingUtility,
+  e_log;
 
 type
   TAddTextureForm = class (TAddResourceForm)
@@ -246,57 +247,62 @@ begin
   Result := True;
 end;
 
-function CreateBitMap(Data: Pointer): TBitMap;
+function CreateBitMap(Data: Pointer; DataSize: Cardinal): TBitMap;
+const
+  BG_R: Byte  = 255;
+  BG_G: Byte  = 0;
+  BG_B: Byte  = 255;
 var
-  TGAHeader:  TTGAHeader;
-  image:      Pointer;
+  img:        TImageData;
+  clr:        TColor32Rec;
+  ii:         PByte;
   Width,
   Height:     Integer;
   ColorDepth: Integer;
   ImageSize:  Integer;
-  i:          Integer;
+  i, x, y:    Integer;
   BitMap:     TBitMap;
 
 begin
   Result := nil;
 
-// Читаем заголовок TGA:
-  CopyMemory(@TGAHeader, Data, SizeOf(TGAHeader));
-
-  if TGAHeader.ImageType <> 2 then
-    Exit;
-  if TGAHeader.ColorMapType <> 0 then
-    Exit;
-  if TGAHeader.BPP < 24 then
+  InitImage(img);
+  if not LoadImageFromMemory(Data, DataSize, img) then
+  begin
+    e_WriteLog('Invalid image format?', MSG_WARNING);
     Exit;
+  end;
 
-  Width  := TGAHeader.Width[0]+TGAHeader.Width[1]*256;
-  Height := TGAHeader.Height[0]+TGAHeader.Height[1]*256;
-  ColorDepth := TGAHeader.BPP;
+  Width  := img.width;
+  Height := img.height;
+  ColorDepth := 24;
   ImageSize  := Width*Height*(ColorDepth div 8);
 
-// Само изображение:
-  GetMem(Image, ImageSize);
-
-  CopyMemory(Image, Pointer(Integer(Data)+SizeOf(TGAHeader)), ImageSize);
-
   BitMap := TBitMap.Create();
-
-  if TGAHeader.BPP = 24 then
-    BitMap.PixelFormat := pf24bit
-  else
-    BitMap.PixelFormat := pf32bit;
+  BitMap.PixelFormat := pf24bit;
   
   BitMap.Width := Width;
   BitMap.Height := Height;
 
 // Копируем в BitMap:
-  for I := Height-1 downto 0 do
-    CopyMemory(BitMap.ScanLine[Height-1-I],
-               Pointer(Integer(Image)+(Width*I*(TGAHeader.BPP div 8))),
-               Width*(TGAHeader.BPP div 8));
-
-  FreeMem(Image, ImageSize);
+  ii := BitMap.RawImage.Data;
+  for y := 0 to height-1 do
+  begin
+    for x := 0 to width-1 do
+    begin
+      clr := GetPixel32(img, x, y);
+      // HACK: Lazarus's TBitMap doesn't seem to have a working 32 bit mode, so
+      //       mix color with pink background. FUCK!
+      clr.r := ClampToByte(((255 - clr.a) * BG_R + clr.a * clr.r) div 255);
+      clr.g := ClampToByte(((255 - clr.a) * BG_G + clr.a * clr.g) div 255);
+      clr.b := ClampToByte(((255 - clr.a) * BG_B + clr.a * clr.b) div 255);
+      // TODO: check for ARGB/RGBA/BGRA/ABGR somehow?
+      ii^ := clr.b; Inc(ii);
+      ii^ := clr.g; Inc(ii);
+      ii^ := clr.r; Inc(ii);
+      // ii^ := clr.a; Inc(ii);
+    end;
+  end;
 
   Result := BitMap;
 end;
@@ -337,7 +343,7 @@ begin
      (WAD.GetLastError = DFWAD_NOERROR) then
   begin
   // Создаем BitMap из листа текстур:
-    Result := CreateBitMap(TextureData);
+    Result := CreateBitMap(TextureData, Len);
     
   // Размеры одного кадра - виден только первый кадр:
     Result.Height := config.ReadInt('', 'frameheight', 0);
@@ -380,9 +386,9 @@ begin
   WAD.Free();
 
 // Создаем на его основе BitMap:
-  Result := CreateBitMap(TextureData);
+  Result := CreateBitMap(TextureData, Len);
 
-  FreeMem(TextureData, Len);
+  FreeMem(TextureData);
 end;
 
 procedure TAddTextureForm.FormActivate(Sender: TObject);