src/editor/f_addresource_sky.pas

   1 unit f_addresource_sky;
   2
   3 {$MODE Delphi}
   4
   5 interface
   6
   7 uses
   8   LCLIntf, LCLType, LMessages, SysUtils, Variants, Classes,
   9   Graphics, Controls, Forms, Dialogs, f_addresource,
  10   ExtCtrls, StdCtrls;
  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 procedure SwapRGB(data: Pointer; Size: Integer);
  39 asm
  40   mov ebx, eax
  41   mov ecx, size
  42
  43 @@loop :
  44   mov al,[ebx+0]
  45   mov ah,[ebx+2]
  46   mov [ebx+2],al
  47   mov [ebx+0],ah
  48   add ebx,3
  49   dec ecx
  50   jnz @@loop
  51 end;
  52
  53 function ShowTGATexture(ResourceStr: String): TBitMap;
  54 var
  55   TGAHeader: packed record // Header type for TGA images
  56     FileType:     Byte;
  57     ColorMapType: Byte;
  58     ImageType:    Byte;
  59     ColorMapSpec: Array[0..4] of Byte;
  60     OrigX:        Array [0..1] of Byte;
  61     OrigY:        Array [0..1] of Byte;
  62     Width:        Array [0..1] of Byte;
  63     Height:       Array [0..1] of Byte;
  64     BPP:          Byte;
  65     ImageInfo:    Byte;
  66   end;
  67   image:      Pointer;    {or PRGBTRIPLE}
  68   Width,
  69   Height:     Integer;
  70   ColorDepth: Integer;
  71   ImageSize:  Integer;
  72   I:          Integer;
  73   BitMap:     TBitMap;
  74
  75   TextureData:  Pointer;
  76   WAD:          TWADEditor_1;
  77   WADName:      String;
  78   SectionName:  String;
  79   ResourceName: String;
  80
  81 begin
  82   Result := nil;
  83
  84 // Загружаем ресурс текстуры из WAD:
  85   g_ProcessResourceStr(ResourceStr, WADName, SectionName, ResourceName);
  86
  87   WAD := TWADEditor_1.Create();
  88   WAD.ReadFile(WADName);
  89
  90   WAD.GetResource(SectionName, ResourceName, TextureData, ImageSize);
  91
  92   WAD.Free();
  93
  94 // Заголовок TGA:
  95   CopyMemory(@TGAHeader, TextureData, SizeOf(TGAHeader));
  96
  97   if TGAHeader.ImageType <> 2 then
  98     Exit;
  99   if TGAHeader.ColorMapType <> 0 then
 100     Exit;
 101   if TGAHeader.BPP < 24 then
 102     Exit;
 103
 104   Width  := TGAHeader.Width[0]+TGAHeader.Width[1]*256;
 105   Height := TGAHeader.Height[0]+TGAHeader.Height[1]*256;
 106   ColorDepth := TGAHeader.BPP;
 107   ImageSize  := Width*Height*(ColorDepth div 8);
 108
 109 // Само изображение:
 110   GetMem(Image, ImageSize);
 111
 112   CopyMemory(Image, Pointer(Integer(TextureData)+SizeOf(TGAHeader)), ImageSize);
 113
 114   BitMap := TBitMap.Create();
 115
 116   if TGAHeader.BPP = 24 then
 117     BitMap.PixelFormat := pf24bit
 118   else
 119     BitMap.PixelFormat := pf32bit;
 120
 121   BitMap.Width := Width;
 122   BitMap.Height := Height;
 123
 124 // Копируем изображение в BitMap:
 125   for I := Height-1 downto 0 do
 126     CopyMemory(BitMap.ScanLine[Height-1-I],
 127                Pointer(Integer(Image)+(Width*I*(TGAHeader.BPP div 8))),
 128                Width*(TGAHeader.BPP div 8));
 129
 130   FreeMem(Image, ImageSize);
 131   FreeMem(TextureData);
 132   Result := BitMap;
 133 end;
 134
 135 procedure TAddSkyForm.bOKClick(Sender: TObject);
 136 begin
 137   Inherited;
 138
 139   if not FResourceSelected then
 140     Exit;
 141 end;
 142
 143 procedure TAddSkyForm.lbResourcesListClick(Sender: TObject);
 144 var
 145   Texture: TBitMap;
 146
 147 begin
 148   Inherited;
 149
 150   if lbResourcesList.ItemIndex = -1 then
 151     Exit;
 152   if FResourceName = '' then
 153     Exit;
 154
 155   Texture := ShowTGATexture(FFullResourceName);
 156   iPreview.Canvas.FillRect(iPreview.Canvas.ClipRect);
 157   if Texture = nil then
 158     Exit;
 159   iPreview.Canvas.StretchDraw(iPreview.Canvas.ClipRect, Texture);
 160   Texture.Free();
 161 end;
 162
 163 procedure TAddSkyForm.FormActivate(Sender: TObject);
 164 var
 165   FileName,
 166   SectionName,
 167   ResourceName: String;
 168   a: Integer;
 169
 170 begin
 171   Inherited;
 172
 173   iPreview.Canvas.FillRect(iPreview.Canvas.ClipRect);
 174
 175 // Уже есть выбранный ресурс:
 176   if FSetResource <> '' then
 177   begin
 178     g_ProcessResourceStr(FSetResource, FileName, SectionName, ResourceName);
 179
 180     if FileName = '' then
 181       FileName := _lc[I_WAD_SPECIAL_MAP];
 182     if SectionName = '' then
 183       SectionName := '..';
 184
 185   // WAD файл:
 186     a := cbWADList.Items.IndexOf(FileName);
 187     if a <> -1 then
 188     begin
 189       cbWADList.ItemIndex := a;
 190       cbWADList.OnChange(nil);
 191     end;
 192
 193   // Секция:
 194     a := cbSectionsList.Items.IndexOf(SectionName);
 195     if a <> -1 then
 196     begin
 197       cbSectionsList.ItemIndex := a;
 198       cbSectionsList.OnChange(nil);
 199     end;
 200
 201   // Ресурс:
 202     a := lbResourcesList.Items.IndexOf(ResourceName);
 203     if a <> -1 then
 204     begin
 205       lbResourcesList.ItemIndex := a;
 206       lbResourcesList.OnClick(nil);
 207     end;
 208   end;
 209 end;
 210
 211 end.