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   ii:         PByte;
  43   Width,
  44   Height:     Integer;
  45   ColorDepth: Integer;
  46   ImageSize:  Integer;
  47   x, y:       Integer;
  48   BitMap:     TBitMap;
  49
  50   TextureData:  Pointer;
  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   InitImage(img);
  61   if not LoadImageFromMemory(TextureData, ImageSize, img) then
  62     Exit;
  63
  64   Width  := img.width;
  65   Height := img.height;
  66   ColorDepth := 24;
  67   ImageSize  := Width*Height*(ColorDepth div 8);
  68
  69   BitMap := TBitMap.Create();
  70   BitMap.PixelFormat := pf24bit;
  71
  72   BitMap.Width := Width;
  73   BitMap.Height := Height;
  74
  75 // Копируем в BitMap:
  76   ii := BitMap.RawImage.Data;
  77   for y := 0 to height-1 do
  78   begin
  79     for x := 0 to width-1 do
  80     begin
  81       clr := GetPixel32(img, x, y);
  82       // assuming sky has no alpha
  83       // TODO: check for ARGB/RGBA/BGRA/ABGR somehow?
  84       ii^ := clr.b; Inc(ii);
  85       ii^ := clr.g; Inc(ii);
  86       ii^ := clr.r; Inc(ii);
  87     end;
  88   end;
  89
  90   FreeMem(TextureData);
  91   FreeImage(img);
  92   Result := BitMap;
  93 end;
  94
  95 procedure TAddSkyForm.bOKClick(Sender: TObject);
  96 begin
  97   Inherited;
  98
  99   if not FResourceSelected then
 100     Exit;
 101 end;
 102
 103 procedure TAddSkyForm.lbResourcesListClick(Sender: TObject);
 104 var
 105   Texture: TBitMap;
 106
 107 begin
 108   Inherited;
 109
 110   if lbResourcesList.ItemIndex = -1 then
 111     Exit;
 112   if FResourceName = '' then
 113     Exit;
 114
 115   Texture := ShowTGATexture(FFullResourceName);
 116   iPreview.Canvas.FillRect(iPreview.Canvas.ClipRect);
 117   if Texture = nil then
 118     Exit;
 119   iPreview.Canvas.StretchDraw(iPreview.Canvas.ClipRect, Texture);
 120   Texture.Free();
 121 end;
 122
 123 procedure TAddSkyForm.FormActivate(Sender: TObject);
 124 var
 125   FileName,
 126   SectionName,
 127   ResourceName: String;
 128   a: Integer;
 129
 130 begin
 131   Inherited;
 132
 133   iPreview.Canvas.FillRect(iPreview.Canvas.ClipRect);
 134
 135 // Уже есть выбранный ресурс:
 136   if FSetResource <> '' then
 137   begin
 138     g_ProcessResourceStr(FSetResource, FileName, SectionName, ResourceName);
 139
 140     if FileName = '' then
 141       FileName := _lc[I_WAD_SPECIAL_MAP];
 142     if SectionName = '' then
 143       SectionName := '..';
 144
 145   // WAD файл:
 146     a := cbWADList.Items.IndexOf(FileName);
 147     if a <> -1 then
 148     begin
 149       cbWADList.ItemIndex := a;
 150       cbWADList.OnChange(nil);
 151     end;
 152
 153   // Секция:
 154     a := cbSectionsList.Items.IndexOf(SectionName);
 155     if a <> -1 then
 156     begin
 157       cbSectionsList.ItemIndex := a;
 158       cbSectionsList.OnChange(nil);
 159     end;
 160
 161   // Ресурс:
 162     a := lbResourcesList.Items.IndexOf(ResourceName);
 163     if a <> -1 then
 164     begin
 165       lbResourcesList.ItemIndex := a;
 166       lbResourcesList.OnClick(nil);
 167     end;
 168   end;
 169 end;
 170
 171 end.