index d1210cd5b38a793ae3ecc53e803bd8c39db462aa..b2551c5a661e7803d8ea043bcd1894a8bd2ab0f5 100644 (file)
interface
uses
interface
uses
- LCLIntf, LCLType, LMessages, SysUtils, Variants, Classes,
+ LCLIntf, LCLType, SysUtils, Variants, Classes,
Graphics, Controls, Forms, Dialogs, f_addresource,
StdCtrls, ExtCtrls, utils, Imaging, ImagingTypes, ImagingUtility;
type
Graphics, Controls, Forms, Dialogs, f_addresource,
StdCtrls, ExtCtrls, utils, Imaging, ImagingTypes, ImagingUtility;
type
+
+ { TAddTextureForm }
+
TAddTextureForm = class (TAddResourceForm)
TAddTextureForm = class (TAddResourceForm)
+ lStats: TLabel;
PanelTexPreview: TPanel;
iPreview: TImage;
eTextureName: TEdit;
PanelTexPreview: TPanel;
iPreview: TImage;
eTextureName: TEdit;
var
AddTextureForm: TAddTextureForm;
var
AddTextureForm: TAddTextureForm;
+ NumFrames: Integer = 0;
function IsAnim(Res: String): Boolean;
function GetFrame(Res: String; var Data: Pointer; var DataLen: Integer;
function IsAnim(Res: String): Boolean;
function GetFrame(Res: String; var Data: Pointer; var DataLen: Integer;
BinEditor, WADEDITOR, WADSTRUCT, f_main, g_textures, CONFIG, g_map,
g_language;
BinEditor, WADEDITOR, WADSTRUCT, f_main, g_textures, CONFIG, g_map,
g_language;
-type
- TTGAHeader = packed record
- FileType: Byte;
- ColorMapType: Byte;
- ImageType: Byte;
- ColorMapSpec: Array [0..4] of Byte;
- OrigX: Array [0..1] of Byte;
- OrigY: Array [0..1] of Byte;
- Width: Array [0..1] of Byte;
- Height: Array [0..1] of Byte;
- BPP: Byte;
- ImageInfo: Byte;
- end;
-
{$R *.lfm}
function IsAnim(Res: String): Boolean;
{$R *.lfm}
function IsAnim(Res: String): Boolean;
ResourceName: String;
Data: Pointer;
Size: Integer;
ResourceName: String;
Data: Pointer;
Size: Integer;
- Sign: Array [0..4] of Char;
Sections,
Resources: SArray;
a: Integer;
Sections,
Resources: SArray;
a: Integer;
begin
Result := False;
begin
Result := False;
+ Data := nil;
+ Size := 0;
// Читаем файл и ресурс в нем:
g_ProcessResourceStr(Res, WADName, SectionName, ResourceName);
// Читаем файл и ресурс в нем:
g_ProcessResourceStr(Res, WADName, SectionName, ResourceName);
WAD := TWADEditor_1.Create();
if (not WAD.ReadFile(WADName)) or
WAD := TWADEditor_1.Create();
if (not WAD.ReadFile(WADName)) or
- (not WAD.GetResource(SectionName, ResourceName, Data, Size)) then
+ (not WAD.GetResource(utf2win(SectionName), utf2win(ResourceName), Data, Size)) then
begin
WAD.Free();
Exit;
begin
WAD.Free();
Exit;
WAD.FreeWAD();
WAD.FreeWAD();
-// Проверка сигнатуры. Если есть - это WAD внутри WAD:
- CopyMemory(@Sign[0], Data, 5);
-
- if not (Sign = DFWAD_SIGNATURE) then
- begin
- WAD.Free();
- FreeMem(Data);
- Exit;
- end;
-
// Пробуем прочитать данные:
if not WAD.ReadMemory(Data, Size) then
begin
// Пробуем прочитать данные:
if not WAD.ReadMemory(Data, Size) then
begin
Exit;
end;
Exit;
end;
-// Ищем в них описание анимации - "AINM":
+// Ищем в них описание анимации - "ANIM":
ok := False;
for a := 0 to High(Resources) do
if Resources[a] = 'ANIM' then
ok := False;
for a := 0 to High(Resources) do
if Resources[a] = 'ANIM' then
Result := ok;
end;
Result := ok;
end;
-function GetFrame(Res: String; var Data: Pointer; var DataLen: Integer;
- var Width, Height: Word): Boolean;
+function GetFrame(Res: String; var Data: Pointer; var DataLen: Integer; var Width, Height: Word): Boolean;
var
AnimWAD: Pointer;
WAD: TWADEditor_1;
var
AnimWAD: Pointer;
WAD: TWADEditor_1;
begin
Result := False;
begin
Result := False;
+ AnimWAD := nil;
+ Len := 0;
+ TextData := nil;
// Читаем WAD:
g_ProcessResourceStr(Res, WADName, SectionName, ResourceName);
// Читаем WAD:
g_ProcessResourceStr(Res, WADName, SectionName, ResourceName);
end;
// Читаем WAD-ресурс из WAD:
end;
// Читаем WAD-ресурс из WAD:
- if not WAD.GetResource(SectionName, ResourceName, AnimWAD, Len) then
+ if not WAD.GetResource(utf2win(SectionName), utf2win(ResourceName), AnimWAD, Len) then
begin
WAD.Free();
Exit;
end;
begin
WAD.Free();
Exit;
end;
-
+
WAD.FreeWAD();
// Читаем WAD в WAD'е:
WAD.FreeWAD();
// Читаем WAD в WAD'е:
Result := True;
end;
Result := True;
end;
-function CreateBitMap(Data: Pointer; DataSize: Cardinal): TBitMap;
-const
- BG_R: Byte = 255;
- BG_G: Byte = 0;
- BG_B: Byte = 255;
+function CreateBitMap (Data: Pointer; DataSize: Cardinal): TBitMap;
var
var
- img: TImageData;
- clr: TColor32Rec;
- ii: PByte;
- Width,
- Height: Integer;
- ColorDepth: Integer;
- ImageSize: Integer;
- i, x, y: Integer;
- BitMap: TBitMap;
-
+ img: TImageData;
+ clr, bgc: TColor32Rec;
+ Width, Height: Integer;
+ x, y: Integer;
+ BitMap: TBitMap;
begin
Result := nil;
begin
Result := nil;
-
InitImage(img);
if not LoadImageFromMemory(Data, DataSize, img) then
Exit;
Width := img.width;
Height := img.height;
InitImage(img);
if not LoadImageFromMemory(Data, DataSize, img) then
Exit;
Width := img.width;
Height := img.height;
- ColorDepth := 24;
- ImageSize := Width*Height*(ColorDepth div 8);
-
BitMap := TBitMap.Create();
BitMap := TBitMap.Create();
- BitMap.PixelFormat := pf24bit;
-
+ BitMap.PixelFormat := pf24bit;
BitMap.Width := Width;
BitMap.Height := Height;
BitMap.Width := Width;
BitMap.Height := Height;
-
-// Копируем в BitMap:
- ii := BitMap.RawImage.Data;
- for y := 0 to height-1 do
+ for y := 0 to Height - 1 do
begin
begin
- for x := 0 to width-1 do
+ for x := 0 to Width - 1 do
begin
clr := GetPixel32(img, x, y);
// HACK: Lazarus's TBitMap doesn't seem to have a working 32 bit mode, so
begin
clr := GetPixel32(img, x, y);
// HACK: Lazarus's TBitMap doesn't seem to have a working 32 bit mode, so
- // mix color with pink background. FUCK!
- clr.r := ClampToByte(((255 - clr.a) * BG_R + clr.a * clr.r) div 255);
- clr.g := ClampToByte(((255 - clr.a) * BG_G + clr.a * clr.g) div 255);
- clr.b := ClampToByte(((255 - clr.a) * BG_B + clr.a * clr.b) div 255);
- // TODO: check for ARGB/RGBA/BGRA/ABGR somehow?
- ii^ := clr.b; Inc(ii);
- ii^ := clr.g; Inc(ii);
- ii^ := clr.r; Inc(ii);
- // ii^ := clr.a; Inc(ii);
- end;
+ // mix color with checkered background. Also, can't really read
+ // CHECKERS.tga from here. FUCK!
+ if UseCheckerboard then
+ begin
+ if (((x shr 3) and 1) = 0) xor (((y shr 3) and 1) = 0) then
+ bgc.Color := $FDFDFD
+ else
+ bgc.Color := $CBCBCB
+ end
+ else
+ begin
+ bgc.r := GetRValue(PreviewColor);
+ bgc.g := GetGValue(PreviewColor);
+ bgc.b := GetBValue(PreviewColor)
+ end;
+ clr.r := ClampToByte((Byte(255 - clr.a) * bgc.r + clr.a * clr.r) div 255);
+ clr.g := ClampToByte((Byte(255 - clr.a) * bgc.g + clr.a * clr.g) div 255);
+ clr.b := ClampToByte((Byte(255 - clr.a) * bgc.b + clr.a * clr.b) div 255);
+ BitMap.Canvas.Pixels[x, y] := RGBToColor(clr.r, clr.g, clr.b)
+ end
end;
FreeImage(img);
Result := BitMap;
end;
FreeImage(img);
Result := BitMap;
config: TConfig;
TextData: Pointer;
TextureData: Pointer;
config: TConfig;
TextData: Pointer;
TextureData: Pointer;
-
+
begin
Result := nil;
begin
Result := nil;
+ AnimWAD := nil;
+ Len := 0;
+ TextData := nil;
+ TextureData := nil;
// Читаем WAD файл и ресурс в нем:
g_ProcessResourceStr(Res, WADName, SectionName, ResourceName);
WAD := TWADEditor_1.Create();
WAD.ReadFile(WADName);
// Читаем WAD файл и ресурс в нем:
g_ProcessResourceStr(Res, WADName, SectionName, ResourceName);
WAD := TWADEditor_1.Create();
WAD.ReadFile(WADName);
- WAD.GetResource(SectionName, ResourceName, AnimWAD, Len);
+ WAD.GetResource(utf2win(SectionName), utf2win(ResourceName), AnimWAD, Len);
WAD.FreeWAD();
// Читаем описание анимации:
WAD.FreeWAD();
// Читаем описание анимации:
// Читаем лист текстур:
WAD.GetResource('TEXTURES', config.ReadStr('', 'resource', ''), TextureData, Len);
// Читаем лист текстур:
WAD.GetResource('TEXTURES', config.ReadStr('', 'resource', ''), TextureData, Len);
+ NumFrames := config.ReadInt('', 'framecount', 0);
if (TextureData <> nil) and
(WAD.GetLastError = DFWAD_NOERROR) then
begin
// Создаем BitMap из листа текстур:
Result := CreateBitMap(TextureData, Len);
if (TextureData <> nil) and
(WAD.GetLastError = DFWAD_NOERROR) then
begin
// Создаем BitMap из листа текстур:
Result := CreateBitMap(TextureData, Len);
-
+
// Размеры одного кадра - виден только первый кадр:
Result.Height := config.ReadInt('', 'frameheight', 0);
Result.Width := config.ReadInt('', 'framewidth', 0);
end;
// Размеры одного кадра - виден только первый кадр:
Result.Height := config.ReadInt('', 'frameheight', 0);
Result.Width := config.ReadInt('', 'framewidth', 0);
end;
-
+
config.Free();
WAD.Free();
config.Free();
WAD.Free();
begin
Result := nil;
begin
Result := nil;
+ TextureData := nil;
+ Len := 0;
// Читаем WAD:
g_ProcessResourceStr(ResourceStr, WADName, SectionName, ResourceName);
// Читаем WAD:
g_ProcessResourceStr(ResourceStr, WADName, SectionName, ResourceName);
end;
// Читаем ресурс текстуры в нем:
end;
// Читаем ресурс текстуры в нем:
- WAD.GetResource(SectionName, ResourceName, TextureData, Len);
+ WAD.GetResource(utf2win(SectionName), utf2win(ResourceName), TextureData, Len);
WAD.Free();
WAD.Free();
begin
Inherited;
begin
Inherited;
- cbWADList.Items.Add(_lc[I_WAD_SPECIAL_TEXS]);
+ lStats.Caption := '';
+ cbWADList.Items.Add(MsgWadSpecialTexs);
eTextureName.Text := '';
iPreview.Canvas.FillRect(iPreview.Canvas.ClipRect);
eTextureName.Text := '';
iPreview.Canvas.FillRect(iPreview.Canvas.ClipRect);
var
Texture: TBitMap;
wad: String;
var
Texture: TBitMap;
wad: String;
+ Anim: Boolean;
begin
Inherited;
begin
Inherited;
+ lStats.Caption := '';
if lbResourcesList.ItemIndex = -1 then
Exit;
if FResourceName = '' then
Exit;
if lbResourcesList.ItemIndex = -1 then
Exit;
if FResourceName = '' then
Exit;
- if cbWADList.Text = _lc[I_WAD_SPECIAL_TEXS] then
+ if cbWADList.Text = MsgWadSpecialTexs then
Exit;
g_ProcessResourceStr(FFullResourceName, @wad, nil, nil);
Exit;
g_ProcessResourceStr(FFullResourceName, @wad, nil, nil);
- if wad = _lc[I_WAD_SPECIAL_TEXS] then
+ if wad = MsgWadSpecialTexs then
Exit;
Exit;
- if IsAnim(FFullResourceName) then
+ Anim := IsAnim(FFullResourceName);
+ if Anim then
Texture := ShowAnim(FFullResourceName)
else
Texture := ShowTGATexture(FFullResourceName);
if Texture = nil then
Exit;
Texture := ShowAnim(FFullResourceName)
else
Texture := ShowTGATexture(FFullResourceName);
if Texture = nil then
Exit;
+
+ if Anim then
+ lStats.Caption := Format(MsgCapAnimation, [Texture.Width, Texture.Height, NumFrames])
+ else
+ lStats.Caption := Format(MsgCapTexture, [Texture.Width, Texture.Height]);
+
iPreview.Canvas.FillRect(iPreview.Canvas.ClipRect);
iPreview.Canvas.CopyRect(Texture.Canvas.ClipRect, Texture.Canvas, Texture.Canvas.ClipRect);
Texture.Free();
iPreview.Canvas.FillRect(iPreview.Canvas.ClipRect);
iPreview.Canvas.CopyRect(Texture.Canvas.ClipRect, Texture.Canvas, Texture.Canvas.ClipRect);
Texture.Free();
procedure TAddTextureForm.cbWADListChange(Sender: TObject);
begin
procedure TAddTextureForm.cbWADListChange(Sender: TObject);
begin
- if cbWADList.Text = _lc[I_WAD_SPECIAL_TEXS] then
+ if cbWADList.Text = MsgWadSpecialTexs then
begin
cbSectionsList.Clear();
cbSectionsList.Items.Add('..');
begin
cbSectionsList.Clear();
cbSectionsList.Items.Add('..');
procedure TAddTextureForm.cbSectionsListChange(Sender: TObject);
begin
procedure TAddTextureForm.cbSectionsListChange(Sender: TObject);
begin
- if cbWADList.Text = _lc[I_WAD_SPECIAL_TEXS] then
+ if cbWADList.Text = MsgWadSpecialTexs then
begin
lbResourcesList.Clear();
lbResourcesList.Items.Add(TEXTURE_NAME_WATER);
begin
lbResourcesList.Clear();
lbResourcesList.Items.Add(TEXTURE_NAME_WATER);
for i := 0 to lbResourcesList.Count-1 do
if lbResourcesList.Selected[i] then
begin
for i := 0 to lbResourcesList.Count-1 do
if lbResourcesList.Selected[i] then
begin
- AddTexture(utf2win(cbWADlist.Text), utf2win(cbSectionsList.Text),
- utf2win(lbResourcesList.Items[i]), False);
+ AddTexture(cbWADlist.Text, cbSectionsList.Text,
+ lbResourcesList.Items[i], False);
lbResourcesList.Selected[i] := False;
end;
end;
lbResourcesList.Selected[i] := False;
end;
end;