1 unit f_addresource_texture
;
8 LCLIntf
, LCLType
, LMessages
, SysUtils
, Variants
, Classes
,
9 Graphics
, Controls
, Forms
, Dialogs
, f_addresource
,
13 TAddTextureForm
= class (TAddResourceForm
)
14 PanelTexPreview
: TPanel
;
21 procedure FormActivate(Sender
: TObject
);
22 procedure lbResourcesListClick(Sender
: TObject
);
23 procedure eTextureNameChange(Sender
: TObject
);
24 procedure cbWADListChange(Sender
: TObject
);
25 procedure cbSectionsListChange(Sender
: TObject
);
26 procedure bCloseClick(Sender
: TObject
);
27 procedure bAddTextureClick(Sender
: TObject
);
28 procedure bAddCloseClick(Sender
: TObject
);
37 AddTextureForm
: TAddTextureForm
;
39 function IsAnim(Res
: String): Boolean;
40 function GetFrame(Res
: String; var Data
: Pointer; var DataLen
: Integer;
41 var Width
, Height
: Word): Boolean;
46 BinEditor
, WADEDITOR
, WADSTRUCT
, f_main
, g_textures
, CONFIG
, g_map
,
50 TTGAHeader
= packed record
54 ColorMapSpec
: Array [0..4] of Byte;
55 OrigX
: Array [0..1] of Byte;
56 OrigY
: Array [0..1] of Byte;
57 Width
: Array [0..1] of Byte;
58 Height
: Array [0..1] of Byte;
65 function IsAnim(Res
: String): Boolean;
73 Sign
: Array [0..4] of Char;
82 // Читаем файл и ресурс в нем:
83 g_ProcessResourceStr(Res
, WADName
, SectionName
, ResourceName
);
85 WAD
:= TWADEditor_1
.Create();
87 if (not WAD
.ReadFile(WADName
)) or
88 (not WAD
.GetResource(SectionName
, ResourceName
, Data
, Size
)) then
96 // Проверка сигнатуры. Если есть - это WAD внутри WAD:
97 CopyMemory(@Sign
[0], Data
, 5);
99 if not (Sign
= DFWAD_SIGNATURE
) then
106 // Пробуем прочитать данные:
107 if not WAD
.ReadMemory(Data
, Size
) then
117 Sections
:= WAD
.GetSectionList();
119 if Sections
= nil then
125 // Ищем в секциях "TEXT":
127 for a
:= 0 to High(Sections
) do
128 if Sections
[a
] = 'TEXT' then
134 // Ищем в секциях лист текстур - "TEXTURES":
135 for a
:= 0 to High(Sections
) do
136 if Sections
[a
] = 'TEXTURES' then
148 // Получаем ресурсы секции "TEXT":
149 Resources
:= WAD
.GetResourcesList('TEXT');
151 if Resources
= nil then
157 // Ищем в них описание анимации - "AINM":
159 for a
:= 0 to High(Resources
) do
160 if Resources
[a
] = 'ANIM' then
168 // Если все получилось, то это аним. текстура:
172 function GetFrame(Res
: String; var Data
: Pointer; var DataLen
: Integer;
173 var Width
, Height
: Word): Boolean;
179 ResourceName
: String;
188 g_ProcessResourceStr(Res
, WADName
, SectionName
, ResourceName
);
190 WAD
:= TWADEditor_1
.Create();
192 if not WAD
.ReadFile(WADName
) then
198 // Читаем WAD-ресурс из WAD:
199 if not WAD
.GetResource(SectionName
, ResourceName
, AnimWAD
, Len
) then
207 // Читаем WAD в WAD'е:
208 if not WAD
.ReadMemory(AnimWAD
, Len
) then
215 // Читаем описание анимации:
216 if not WAD
.GetResource('TEXT', 'ANIM', TextData
, Len
) then
224 config
:= TConfig
.CreateMem(TextData
, Len
);
226 // Читаем ресурс - лист текстур:
227 if not WAD
.GetResource('TEXTURES', config
.ReadStr('', 'resource', ''), Data
, Len
) then
237 Height
:= config
.ReadInt('', 'frameheight', 0);
238 Width
:= config
.ReadInt('', 'framewidth', 0);
249 function CreateBitMap(Data
: Pointer): TBitMap
;
251 TGAHeader
: TTGAHeader
;
263 // Читаем заголовок TGA:
264 CopyMemory(@TGAHeader
, Data
, SizeOf(TGAHeader
));
266 if TGAHeader
.ImageType
<> 2 then
268 if TGAHeader
.ColorMapType
<> 0 then
270 if TGAHeader
.BPP
< 24 then
273 Width
:= TGAHeader
.Width
[0]+TGAHeader
.Width
[1]*256;
274 Height
:= TGAHeader
.Height
[0]+TGAHeader
.Height
[1]*256;
275 ColorDepth
:= TGAHeader
.BPP
;
276 ImageSize
:= Width
*Height
*(ColorDepth
div 8);
279 GetMem(Image
, ImageSize
);
281 CopyMemory(Image
, Pointer(Integer(Data
)+SizeOf(TGAHeader
)), ImageSize
);
283 BitMap
:= TBitMap
.Create();
285 if TGAHeader
.BPP
= 24 then
286 BitMap
.PixelFormat
:= pf24bit
288 BitMap
.PixelFormat
:= pf32bit
;
290 BitMap
.Width
:= Width
;
291 BitMap
.Height
:= Height
;
293 // Копируем в BitMap:
294 for I
:= Height
-1 downto 0 do
295 CopyMemory(BitMap
.ScanLine
[Height
-1-I
],
296 Pointer(Integer(Image
)+(Width
*I
*(TGAHeader
.BPP
div 8))),
297 Width
*(TGAHeader
.BPP
div 8));
299 FreeMem(Image
, ImageSize
);
304 function ShowAnim(Res
: String): TBitMap
;
310 ResourceName
: String;
314 TextureData
: Pointer;
319 // Читаем WAD файл и ресурс в нем:
320 g_ProcessResourceStr(Res
, WADName
, SectionName
, ResourceName
);
322 WAD
:= TWADEditor_1
.Create();
323 WAD
.ReadFile(WADName
);
324 WAD
.GetResource(SectionName
, ResourceName
, AnimWAD
, Len
);
327 // Читаем описание анимации:
328 WAD
.ReadMemory(AnimWAD
, Len
);
329 WAD
.GetResource('TEXT', 'ANIM', TextData
, Len
);
331 config
:= TConfig
.CreateMem(TextData
, Len
);
333 // Читаем лист текстур:
334 WAD
.GetResource('TEXTURES', config
.ReadStr('', 'resource', ''), TextureData
, Len
);
336 if (TextureData
<> nil) and
337 (WAD
.GetLastError
= DFWAD_NOERROR
) then
339 // Создаем BitMap из листа текстур:
340 Result
:= CreateBitMap(TextureData
);
342 // Размеры одного кадра - виден только первый кадр:
343 Result
.Height
:= config
.ReadInt('', 'frameheight', 0);
344 Result
.Width
:= config
.ReadInt('', 'framewidth', 0);
350 FreeMem(TextureData
);
355 function ShowTGATexture(ResourceStr
: String): TBitMap
;
357 TextureData
: Pointer;
361 ResourceName
: String;
368 g_ProcessResourceStr(ResourceStr
, WADName
, SectionName
, ResourceName
);
370 WAD
:= TWADEditor_1
.Create();
371 if not WAD
.ReadFile(WADName
) then
377 // Читаем ресурс текстуры в нем:
378 WAD
.GetResource(SectionName
, ResourceName
, TextureData
, Len
);
382 // Создаем на его основе BitMap:
383 Result
:= CreateBitMap(TextureData
);
385 FreeMem(TextureData
, Len
);
388 procedure TAddTextureForm
.FormActivate(Sender
: TObject
);
392 cbWADList
.Items
.Add(_lc
[I_WAD_SPECIAL_TEXS
]);
394 eTextureName
.Text := '';
395 iPreview
.Canvas
.FillRect(iPreview
.Canvas
.ClipRect
);
397 bOK
.Visible
:= False;
398 bCancel
.Visible
:= False;
401 procedure TAddTextureForm
.lbResourcesListClick(Sender
: TObject
);
409 if lbResourcesList
.ItemIndex
= -1 then
411 if FResourceName
= '' then
413 if cbWADList
.Text = _lc
[I_WAD_SPECIAL_TEXS
] then
416 g_ProcessResourceStr(FFullResourceName
, @wad
, nil, nil);
417 if wad
= _lc
[I_WAD_SPECIAL_TEXS
] then
420 if IsAnim(FFullResourceName
) then
421 Texture
:= ShowAnim(FFullResourceName
)
423 Texture
:= ShowTGATexture(FFullResourceName
);
425 if Texture
= nil then
427 iPreview
.Canvas
.FillRect(iPreview
.Canvas
.ClipRect
);
428 iPreview
.Canvas
.CopyRect(Texture
.Canvas
.ClipRect
, Texture
.Canvas
, Texture
.Canvas
.ClipRect
);
432 procedure TAddTextureForm
.eTextureNameChange(Sender
: TObject
);
438 // Убираем старые выделения:
439 for a
:= 0 to lbResourcesList
.Items
.Count
-1 do
440 lbResourcesList
.Selected
[a
] := False;
443 if (lbResourcesList
.Items
.Count
= 0) or
444 (eTextureName
.Text = '') then
449 for a
:= 0 to lbResourcesList
.Items
.Count
-1 do
450 if LowerCase(Copy(lbResourcesList
.Items
[a
], 1,
451 Length(eTextureName
.Text))) =
452 LowerCase(eTextureName
.Text) then
454 lbResourcesList
.Selected
[a
] := True;
458 // Показываем первую текстуру из найденных:
459 lbResourcesList
.TopIndex
:= a
;
460 lbResourcesList
.OnClick(nil);
467 procedure TAddTextureForm
.cbWADListChange(Sender
: TObject
);
469 if cbWADList
.Text = _lc
[I_WAD_SPECIAL_TEXS
] then
471 cbSectionsList
.Clear();
472 cbSectionsList
.Items
.Add('..');
479 procedure TAddTextureForm
.cbSectionsListChange(Sender
: TObject
);
481 if cbWADList
.Text = _lc
[I_WAD_SPECIAL_TEXS
] then
483 lbResourcesList
.Clear();
484 lbResourcesList
.Items
.Add(TEXTURE_NAME_WATER
);
485 lbResourcesList
.Items
.Add(TEXTURE_NAME_ACID1
);
486 lbResourcesList
.Items
.Add(TEXTURE_NAME_ACID2
);
493 procedure TAddTextureForm
.bCloseClick(Sender
: TObject
);
498 procedure TAddTextureForm
.bAddTextureClick(Sender
: TObject
);
503 for i
:= 0 to lbResourcesList
.Count
-1 do
504 if lbResourcesList
.Selected
[i
] then
506 AddTexture(cbWADlist
.Text, cbSectionsList
.Text,
507 lbResourcesList
.Items
[i
], False);
508 lbResourcesList
.Selected
[i
] := False;
512 procedure TAddTextureForm
.bAddCloseClick(Sender
: TObject
);
514 bAddTextureClick(bAddTexture
);