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
, Imaging
, ImagingTypes
, ImagingUtility
;
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
;
58 // Загружаем ресурс текстуры из WAD:
59 g_ProcessResourceStr(ResourceStr
, WADName
, SectionName
, ResourceName
);
61 WAD
:= TWADEditor_1
.Create();
62 WAD
.ReadFile(WADName
);
64 WAD
.GetResource(utf2win(SectionName
), utf2win(ResourceName
), TextureData
, ImageSize
);
68 (* !!! copypaste from f_addresource_texture.CreateBitMap *)
71 if not LoadImageFromMemory(TextureData
, ImageSize
, img
) then
79 BitMap
:= TBitMap
.Create();
80 BitMap
.PixelFormat
:= pf24bit
;
81 BitMap
.Width
:= Width
;
82 BitMap
.Height
:= Height
;
83 for y
:= 0 to height
- 1 do
85 for x
:= 0 to width
- 1 do
87 clr
:= GetPixel32(img
, x
, y
);
88 // HACK: Lazarus's TBitMap doesn't seem to have a working 32 bit mode, so
89 // mix color with checkered background. Also, can't really read
90 // CHECKERS.tga from here. FUCK!
91 if UseCheckerboard
then
93 if (((x
shr 3) and 1) = 0) xor (((y
shr 3) and 1) = 0) then
100 bgc
.r
:= GetRValue(PreviewColor
);
101 bgc
.g
:= GetGValue(PreviewColor
);
102 bgc
.b
:= GetBValue(PreviewColor
)
104 clr
.r
:= ClampToByte((Byte(255 - clr
.a
) * bgc
.r
+ clr
.a
* clr
.r
) div 255);
105 clr
.g
:= ClampToByte((Byte(255 - clr
.a
) * bgc
.g
+ clr
.a
* clr
.g
) div 255);
106 clr
.b
:= ClampToByte((Byte(255 - clr
.a
) * bgc
.b
+ clr
.a
* clr
.b
) div 255);
107 BitMap
.Canvas
.Pixels
[x
, y
] := RGBToColor(clr
.r
, clr
.g
, clr
.b
)
110 FreeMem(TextureData
);
115 procedure TAddSkyForm
.bOKClick(Sender
: TObject
);
122 procedure TAddSkyForm
.lbResourcesListClick(Sender
: TObject
);
129 if lbResourcesList
.ItemIndex
= -1 then
131 if FResourceName
= '' then
134 Texture
:= ShowTGATexture(FFullResourceName
);
135 iPreview
.Canvas
.FillRect(iPreview
.Canvas
.ClipRect
);
136 if Texture
= nil then
138 iPreview
.Canvas
.StretchDraw(iPreview
.Canvas
.ClipRect
, Texture
);
142 procedure TAddSkyForm
.FormActivate(Sender
: TObject
);
146 ResourceName
: String;
152 iPreview
.Canvas
.FillRect(iPreview
.Canvas
.ClipRect
);
154 // Уже есть выбранный ресурс:
155 if FSetResource
<> '' then
157 g_ProcessResourceStr(FSetResource
, FileName
, SectionName
, ResourceName
);
159 if FileName
= '' then
160 FileName
:= MsgWadSpecialMap
;
161 if SectionName
= '' then
165 a
:= cbWADList
.Items
.IndexOf(FileName
);
168 cbWADList
.ItemIndex
:= a
;
169 cbWADList
.OnChange(nil);
173 a
:= cbSectionsList
.Items
.IndexOf(SectionName
);
176 cbSectionsList
.ItemIndex
:= a
;
177 cbSectionsList
.OnChange(nil);
181 a
:= lbResourcesList
.Items
.IndexOf(ResourceName
);
184 lbResourcesList
.ItemIndex
:= a
;
185 lbResourcesList
.OnClick(nil);