src/editor/f_addresource_sky.pas

   1 unit f_addresource_sky;
   2
   3 {$INCLUDE ../shared/a_modes.inc}
   4
   5 interface
   6
   7 uses
   8   LCLIntf, LCLType, LMessages, SysUtils, Variants, Classes,
   9   Graphics, Controls, Forms, Dialogs, f_addresource,
  10   ExtCtrls, StdCtrls, utils, Imaging, ImagingTypes, ImagingUtility;
  11
  12 type
  13   TAddSkyForm = class (TAddResourceForm)
  14     PanelTexPreview: TPanel;
  15     iPreview: TImage;
  16
  17     procedure bOKClick(Sender: TObject);
  18     procedure lbResourcesListClick(Sender: TObject);
  19     procedure FormActivate(Sender: TObject);
  20
  21   private
  22     FSetResource: String;
  23
  24   public
  25     property SetResource: String read FSetResource write FSetResource;
  26   end;
  27
  28 var
  29   AddSkyForm: TAddSkyForm;
  30
  31 implementation
  32
  33 uses
  34   BinEditor, WADEDITOR, f_main, g_language;
  35
  36 {$R *.lfm}
  37
  38 function ShowTGATexture(ResourceStr: String): TBitMap;
  39 var
  40   img:        TImageData;
  41   clr:        TColor32Rec;
  42   bgc:        TColor32Rec;
  43   Width,
  44   Height:     Integer;
  45   x, y:       Integer;
  46   BitMap:     TBitMap;
  47
  48   TextureData:  Pointer;
  49   ImageSize:    Integer;
  50   WAD:          TWADEditor_1;
  51   WADName:      String;
  52   SectionName:  String;
  53   ResourceName: String;
  54
  55 begin
  56   Result := nil;
  57
  58 // Загружаем ресурс текстуры из WAD:
  59   g_ProcessResourceStr(ResourceStr, WADName, SectionName, ResourceName);
  60
  61   WAD := TWADEditor_1.Create();
  62   WAD.ReadFile(WADName);
  63
  64   WAD.GetResource(utf2win(SectionName), utf2win(ResourceName), TextureData, ImageSize);
  65
  66   WAD.Free();
  67
  68   (* !!! copypaste from f_addresource_texture.CreateBitMap *)
  69
  70   InitImage(img);
  71   if not LoadImageFromMemory(TextureData, ImageSize, img) then
  72   begin
  73     FreeMem(TextureData);
  74     Exit;
  75   end;
  76
  77   Width  := img.width;
  78   Height := img.height;
  79   BitMap := TBitMap.Create();
  80   BitMap.PixelFormat := pf24bit;
  81   BitMap.Width := Width;
  82   BitMap.Height := Height;
  83   for y := 0 to height - 1 do
  84   begin
  85     for x := 0 to width - 1 do
  86     begin
  87       clr := GetPixel32(img, x, y);
  88       // HACK: Lazarus's TBitMap doesn't seem to have a working 32 bit mode, so
  89       //       mix color with checkered background. Also, can't really read
  90       //       CHECKERS.tga from here. FUCK!
  91       if UseCheckerboard then
  92       begin
  93         if (((x shr 3) and 1) = 0) xor (((y shr 3) and 1) = 0) then
  94           bgc.Color := $FDFDFD
  95         else
  96           bgc.Color := $CBCBCB
  97       end
  98       else
  99       begin
 100         bgc.r := GetRValue(PreviewColor);
 101         bgc.g := GetGValue(PreviewColor);
 102         bgc.b := GetBValue(PreviewColor)
 103       end;
 104       clr.r := ClampToByte((Byte(255 - clr.a) * bgc.r + clr.a * clr.r) div 255);
 105       clr.g := ClampToByte((Byte(255 - clr.a) * bgc.g + clr.a * clr.g) div 255);
 106       clr.b := ClampToByte((Byte(255 - clr.a) * bgc.b + clr.a * clr.b) div 255);
 107       BitMap.Canvas.Pixels[x, y] := RGBToColor(clr.r, clr.g, clr.b)
 108     end
 109   end;
 110   FreeMem(TextureData);
 111   FreeImage(img);
 112   Result := BitMap;
 113 end;
 114
 115 procedure TAddSkyForm.bOKClick(Sender: TObject);
 116 begin
 117   Inherited;
 118
 119   ModalResult := mrOk;
 120 end;
 121
 122 procedure TAddSkyForm.lbResourcesListClick(Sender: TObject);
 123 var
 124   Texture: TBitMap;
 125
 126 begin
 127   Inherited;
 128
 129   if lbResourcesList.ItemIndex = -1 then
 130     Exit;
 131   if FResourceName = '' then
 132     Exit;
 133
 134   Texture := ShowTGATexture(FFullResourceName);
 135   iPreview.Canvas.FillRect(iPreview.Canvas.ClipRect);
 136   if Texture = nil then
 137     Exit;
 138   iPreview.Canvas.StretchDraw(iPreview.Canvas.ClipRect, Texture);
 139   Texture.Free();
 140 end;
 141
 142 procedure TAddSkyForm.FormActivate(Sender: TObject);
 143 var
 144   FileName,
 145   SectionName,
 146   ResourceName: String;
 147   a: Integer;
 148
 149 begin
 150   Inherited;
 151
 152   iPreview.Canvas.FillRect(iPreview.Canvas.ClipRect);
 153
 154 // Уже есть выбранный ресурс:
 155   if FSetResource <> '' then
 156   begin
 157     g_ProcessResourceStr(FSetResource, FileName, SectionName, ResourceName);
 158
 159     if FileName = '' then
 160       FileName := MsgWadSpecialMap;
 161     if SectionName = '' then
 162       SectionName := '..';
 163
 164   // WAD файл:
 165     a := cbWADList.Items.IndexOf(FileName);
 166     if a <> -1 then
 167     begin
 168       cbWADList.ItemIndex := a;
 169       cbWADList.OnChange(nil);
 170     end;
 171
 172   // Секция:
 173     a := cbSectionsList.Items.IndexOf(SectionName);
 174     if a <> -1 then
 175     begin
 176       cbSectionsList.ItemIndex := a;
 177       cbSectionsList.OnChange(nil);
 178     end;
 179
 180   // Ресурс:
 181     a := lbResourcesList.Items.IndexOf(ResourceName);
 182     if a <> -1 then
 183     begin
 184       lbResourcesList.ItemIndex := a;
 185       lbResourcesList.OnClick(nil);
 186     end;
 187   end;
 188 end;
 189
 190 end.