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