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