2f2c25f84aa6743ef5a916a9f440cc26a7e8dcb5
1 unit f_addresource_sky
;
3 {$INCLUDE ../shared/a_modes.inc}
8 LCLIntf
, LCLType
, LMessages
, SysUtils
, Variants
, Classes
,
9 Graphics
, Controls
, Forms
, Dialogs
, f_addresource
,
10 ExtCtrls
, StdCtrls
, utils
;
13 TAddSkyForm
= class (TAddResourceForm
)
14 PanelTexPreview
: TPanel
;
17 procedure bOKClick(Sender
: TObject
);
18 procedure lbResourcesListClick(Sender
: TObject
);
19 procedure FormActivate(Sender
: TObject
);
25 property SetResource
: String read FSetResource write FSetResource
;
29 AddSkyForm
: TAddSkyForm
;
34 BinEditor
, WADEDITOR
, f_main
, g_language
;
38 function ShowTGATexture(ResourceStr
: String): TBitMap
;
40 TGAHeader
: packed record // Header type for TGA images
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;
52 image
: Pointer; {or PRGBTRIPLE}
69 // Загружаем ресурс текстуры из WAD:
70 g_ProcessResourceStr(ResourceStr
, WADName
, SectionName
, ResourceName
);
72 WAD
:= TWADEditor_1
.Create();
73 WAD
.ReadFile(WADName
);
75 WAD
.GetResource(SectionName
, ResourceName
, TextureData
, ImageSize
);
80 CopyMemory(@TGAHeader
, TextureData
, SizeOf(TGAHeader
));
82 if TGAHeader
.ImageType
<> 2 then
84 if TGAHeader
.ColorMapType
<> 0 then
86 if TGAHeader
.BPP
< 24 then
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);
95 GetMem(Image
, ImageSize
);
97 CopyMemory(Image
, Pointer(Integer(TextureData
)+SizeOf(TGAHeader
)), ImageSize
);
99 BitMap
:= TBitMap
.Create();
101 if TGAHeader
.BPP
= 24 then
102 BitMap
.PixelFormat
:= pf24bit
104 BitMap
.PixelFormat
:= pf32bit
;
106 BitMap
.Width
:= Width
;
107 BitMap
.Height
:= Height
;
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));
115 FreeMem(Image
, ImageSize
);
116 FreeMem(TextureData
);
120 procedure TAddSkyForm
.bOKClick(Sender
: TObject
);
124 if not FResourceSelected
then
128 procedure TAddSkyForm
.lbResourcesListClick(Sender
: TObject
);
135 if lbResourcesList
.ItemIndex
= -1 then
137 if FResourceName
= '' then
140 Texture
:= ShowTGATexture(FFullResourceName
);
141 iPreview
.Canvas
.FillRect(iPreview
.Canvas
.ClipRect
);
142 if Texture
= nil then
144 iPreview
.Canvas
.StretchDraw(iPreview
.Canvas
.ClipRect
, Texture
);
148 procedure TAddSkyForm
.FormActivate(Sender
: TObject
);
152 ResourceName
: String;
158 iPreview
.Canvas
.FillRect(iPreview
.Canvas
.ClipRect
);
160 // Уже есть выбранный ресурс:
161 if FSetResource
<> '' then
163 g_ProcessResourceStr(FSetResource
, FileName
, SectionName
, ResourceName
);
165 if FileName
= '' then
166 FileName
:= _lc
[I_WAD_SPECIAL_MAP
];
167 if SectionName
= '' then
171 a
:= cbWADList
.Items
.IndexOf(win2utf(FileName
));
174 cbWADList
.ItemIndex
:= a
;
175 cbWADList
.OnChange(nil);
179 a
:= cbSectionsList
.Items
.IndexOf(win2utf(SectionName
));
182 cbSectionsList
.ItemIndex
:= a
;
183 cbSectionsList
.OnChange(nil);
187 a
:= lbResourcesList
.Items
.IndexOf(win2utf(ResourceName
));
190 lbResourcesList
.ItemIndex
:= a
;
191 lbResourcesList
.OnClick(nil);