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