DEADSOFTWARE

Movement: Implement WASD move/resize
[d2df-editor.git] / src / editor / f_addresource_sky.pas
1 unit f_addresource_sky;
3 {$INCLUDE ../shared/a_modes.inc}
5 interface
7 uses
8 LCLIntf, LCLType, LMessages, SysUtils, Variants, Classes,
9 Graphics, Controls, Forms, Dialogs, f_addresource,
10 ExtCtrls, StdCtrls, utils, Imaging, ImagingTypes, ImagingUtility;
12 type
13 TAddSkyForm = class (TAddResourceForm)
14 PanelTexPreview: TPanel;
15 iPreview: TImage;
17 procedure bOKClick(Sender: TObject);
18 procedure lbResourcesListClick(Sender: TObject);
19 procedure FormActivate(Sender: TObject);
21 private
22 FSetResource: String;
24 public
25 property SetResource: String read FSetResource write FSetResource;
26 end;
28 var
29 AddSkyForm: TAddSkyForm;
31 implementation
33 uses
34 BinEditor, WADEDITOR, f_main, g_language;
36 {$R *.lfm}
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;
50 TextureData: Pointer;
51 WAD: TWADEditor_1;
52 WADName: String;
53 SectionName: String;
54 ResourceName: String;
56 begin
57 Result := nil;
59 // Загружаем ресурс текстуры из WAD:
60 g_ProcessResourceStr(ResourceStr, WADName, SectionName, ResourceName);
62 WAD := TWADEditor_1.Create();
63 WAD.ReadFile(WADName);
65 WAD.GetResource(utf2win(SectionName), utf2win(ResourceName), TextureData, ImageSize);
67 WAD.Free();
69 InitImage(img);
70 if not LoadImageFromMemory(TextureData, ImageSize, img) then
71 Exit;
73 Width := img.width;
74 Height := img.height;
75 ColorDepth := 24;
76 ImageSize := Width*Height*(ColorDepth div 8);
78 BitMap := TBitMap.Create();
79 BitMap.PixelFormat := pf24bit;
81 BitMap.Width := Width;
82 BitMap.Height := Height;
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;
99 FreeMem(TextureData);
100 FreeImage(img);
101 Result := BitMap;
102 end;
104 procedure TAddSkyForm.bOKClick(Sender: TObject);
105 begin
106 Inherited;
108 if not FResourceSelected then
109 Exit;
110 end;
112 procedure TAddSkyForm.lbResourcesListClick(Sender: TObject);
113 var
114 Texture: TBitMap;
116 begin
117 Inherited;
119 if lbResourcesList.ItemIndex = -1 then
120 Exit;
121 if FResourceName = '' then
122 Exit;
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;
132 procedure TAddSkyForm.FormActivate(Sender: TObject);
133 var
134 FileName,
135 SectionName,
136 ResourceName: String;
137 a: Integer;
139 begin
140 Inherited;
142 iPreview.Canvas.FillRect(iPreview.Canvas.ClipRect);
144 // Уже есть выбранный ресурс:
145 if FSetResource <> '' then
146 begin
147 g_ProcessResourceStr(FSetResource, FileName, SectionName, ResourceName);
149 if FileName = '' then
150 FileName := _lc[I_WAD_SPECIAL_MAP];
151 if SectionName = '' then
152 SectionName := '..';
154 // WAD файл:
155 a := cbWADList.Items.IndexOf(FileName);
156 if a <> -1 then
157 begin
158 cbWADList.ItemIndex := a;
159 cbWADList.OnChange(nil);
160 end;
162 // Секция:
163 a := cbSectionsList.Items.IndexOf(SectionName);
164 if a <> -1 then
165 begin
166 cbSectionsList.ItemIndex := a;
167 cbSectionsList.OnChange(nil);
168 end;
170 // Ресурс:
171 a := lbResourcesList.Items.IndexOf(ResourceName);
172 if a <> -1 then
173 begin
174 lbResourcesList.ItemIndex := a;
175 lbResourcesList.OnClick(nil);
176 end;
177 end;
178 end;
180 end.