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   WADEDITOR, f_main, g_language, g_resources;
  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   WADName:      String;
  51   SectionName:  String;
  52   ResourceName: String;
  53
  54 begin
  55   Result := nil;
  56   g_ProcessResourceStr(ResourceStr, WADName, SectionName, ResourceName);
  57   g_ReadResource(WADName, SectionName, ResourceName, TextureData, ImageSize);
  58
  59   (* !!! copypaste from f_addresource_texture.CreateBitMap *)
  60
  61   InitImage(img);
  62   if not LoadImageFromMemory(TextureData, ImageSize, img) then
  63   begin
  64     FreeMem(TextureData);
  65     Exit;
  66   end;
  67
  68   Width  := img.width;
  69   Height := img.height;
  70   BitMap := TBitMap.Create();
  71   BitMap.PixelFormat := pf24bit;
  72   BitMap.Width := Width;
  73   BitMap.Height := Height;
  74   for y := 0 to height - 1 do
  75   begin
  76     for x := 0 to width - 1 do
  77     begin
  78       clr := GetPixel32(img, x, y);
  79       // HACK: Lazarus's TBitMap doesn't seem to have a working 32 bit mode, so
  80       //       mix color with checkered background. Also, can't really read
  81       //       CHECKERS.tga from here. FUCK!
  82       if UseCheckerboard then
  83       begin
  84         if (((x shr 3) and 1) = 0) xor (((y shr 3) and 1) = 0) then
  85           bgc.Color := $FDFDFD
  86         else
  87           bgc.Color := $CBCBCB
  88       end
  89       else
  90       begin
  91         bgc.r := GetRValue(PreviewColor);
  92         bgc.g := GetGValue(PreviewColor);
  93         bgc.b := GetBValue(PreviewColor)
  94       end;
  95       clr.r := ClampToByte((Byte(255 - clr.a) * bgc.r + clr.a * clr.r) div 255);
  96       clr.g := ClampToByte((Byte(255 - clr.a) * bgc.g + clr.a * clr.g) div 255);
  97       clr.b := ClampToByte((Byte(255 - clr.a) * bgc.b + clr.a * clr.b) div 255);
  98       BitMap.Canvas.Pixels[x, y] := RGBToColor(clr.r, clr.g, clr.b)
  99     end
 100   end;
 101   FreeMem(TextureData);
 102   FreeImage(img);
 103   Result := BitMap;
 104 end;
 105
 106 procedure TAddSkyForm.bOKClick(Sender: TObject);
 107 begin
 108   Inherited;
 109
 110   ModalResult := mrOk;
 111 end;
 112
 113 procedure TAddSkyForm.lbResourcesListClick(Sender: TObject);
 114 var
 115   Texture: TBitMap;
 116
 117 begin
 118   Inherited;
 119
 120   if lbResourcesList.ItemIndex = -1 then
 121     Exit;
 122   if FResourceName = '' then
 123     Exit;
 124
 125   Texture := ShowTGATexture(FFullResourceName);
 126   iPreview.Canvas.FillRect(iPreview.Canvas.ClipRect);
 127   if Texture = nil then
 128     Exit;
 129   iPreview.Canvas.StretchDraw(iPreview.Canvas.ClipRect, Texture);
 130   Texture.Free();
 131 end;
 132
 133 procedure TAddSkyForm.FormActivate(Sender: TObject);
 134 var
 135   FileName,
 136   SectionName,
 137   ResourceName: String;
 138   a: Integer;
 139
 140 begin
 141   Inherited;
 142
 143   iPreview.Canvas.FillRect(iPreview.Canvas.ClipRect);
 144
 145 // Уже есть выбранный ресурс:
 146   if FSetResource <> '' then
 147   begin
 148     g_ProcessResourceStr(FSetResource, FileName, SectionName, ResourceName);
 149
 150     if FileName = '' then
 151       FileName := _lc[I_WAD_SPECIAL_MAP];
 152     if SectionName = '' then
 153       SectionName := '..';
 154
 155   // WAD файл:
 156     a := cbWADList.Items.IndexOf(FileName);
 157     if a <> -1 then
 158     begin
 159       cbWADList.ItemIndex := a;
 160       cbWADList.OnChange(nil);
 161     end;
 162
 163   // Секция:
 164     a := cbSectionsList.Items.IndexOf(SectionName);
 165     if a <> -1 then
 166     begin
 167       cbSectionsList.ItemIndex := a;
 168       cbSectionsList.OnChange(nil);
 169     end;
 170
 171   // Ресурс:
 172     a := lbResourcesList.Items.IndexOf(ResourceName);
 173     if a <> -1 then
 174     begin
 175       lbResourcesList.ItemIndex := a;
 176       lbResourcesList.OnClick(nil);
 177     end;
 178   end;
 179 end;
 180
 181 end.