index 2f2c25f84aa6743ef5a916a9f440cc26a7e8dcb5..79362df8f84f194d09b5a83da44b128da106b1be 100644 (file)
uses
LCLIntf, LCLType, LMessages, SysUtils, Variants, Classes,
Graphics, Controls, Forms, Dialogs, f_addresource,
- ExtCtrls, StdCtrls, utils;
+ ExtCtrls, StdCtrls, utils, Imaging, ImagingTypes, ImagingUtility;
type
TAddSkyForm = class (TAddResourceForm)
implementation
uses
- BinEditor, WADEDITOR, f_main, g_language;
+ WADEDITOR, f_main, g_language, g_resources;
{$R *.lfm}
function ShowTGATexture(ResourceStr: String): TBitMap;
var
- TGAHeader: packed record // Header type for TGA images
- 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;
- image: Pointer; {or PRGBTRIPLE}
+ img: TImageData;
+ clr: TColor32Rec;
+ bgc: TColor32Rec;
+ ii: PByte;
Width,
Height: Integer;
- ColorDepth: Integer;
- ImageSize: Integer;
- I: Integer;
+ x, y: Integer;
BitMap: TBitMap;
TextureData: Pointer;
- WAD: TWADEditor_1;
+ ImageSize: Integer;
WADName: String;
SectionName: String;
ResourceName: String;
begin
Result := nil;
-
-// Загружаем ресурс текстуры из WAD:
g_ProcessResourceStr(ResourceStr, WADName, SectionName, ResourceName);
+ g_ReadResource(WADName, SectionName, ResourceName, TextureData, ImageSize);
- WAD := TWADEditor_1.Create();
- WAD.ReadFile(WADName);
-
- WAD.GetResource(SectionName, ResourceName, TextureData, ImageSize);
-
- WAD.Free();
-
-// Заголовок TGA:
- CopyMemory(@TGAHeader, TextureData, SizeOf(TGAHeader));
+ (* !!! copypaste from f_addresource_texture.CreateBitMap *)
- if TGAHeader.ImageType <> 2 then
- Exit;
- if TGAHeader.ColorMapType <> 0 then
- Exit;
- if TGAHeader.BPP < 24 then
+ InitImage(img);
+ if not LoadImageFromMemory(TextureData, ImageSize, img) then
+ begin
+ FreeMem(TextureData);
Exit;
+ end;
- Width := TGAHeader.Width[0]+TGAHeader.Width[1]*256;
- Height := TGAHeader.Height[0]+TGAHeader.Height[1]*256;
- ColorDepth := TGAHeader.BPP;
- ImageSize := Width*Height*(ColorDepth div 8);
-
-// Само изображение:
- GetMem(Image, ImageSize);
-
- CopyMemory(Image, Pointer(Integer(TextureData)+SizeOf(TGAHeader)), ImageSize);
+ Width := img.width;
+ Height := img.height;
BitMap := TBitMap.Create();
+ BitMap.PixelFormat := pf24bit;
- if TGAHeader.BPP = 24 then
- BitMap.PixelFormat := pf24bit
- else
- BitMap.PixelFormat := pf32bit;
-
BitMap.Width := Width;
BitMap.Height := Height;
-// Копируем изображение в BitMap:
- for I := Height-1 downto 0 do
- CopyMemory(BitMap.ScanLine[Height-1-I],
- Pointer(Integer(Image)+(Width*I*(TGAHeader.BPP div 8))),
- Width*(TGAHeader.BPP div 8));
-
- FreeMem(Image, ImageSize);
+// Копируем в BitMap:
+ ii := BitMap.RawImage.Data;
+ for y := 0 to height-1 do
+ begin
+ 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
+ // 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);
+ // TODO: check for RGB/BGR somehow?
+ ii^ := clr.b; Inc(ii);
+ ii^ := clr.g; Inc(ii);
+ ii^ := clr.r; Inc(ii);
+
+ (* Why this works in linux? *)
+ {$IFNDEF WINDOWS}Inc(ii){$ENDIF}
+ end;
+ end;
FreeMem(TextureData);
+ FreeImage(img);
Result := BitMap;
end;
begin
Inherited;
- if not FResourceSelected then
- Exit;
+ ModalResult := mrOk;
end;
procedure TAddSkyForm.lbResourcesListClick(Sender: TObject);
SectionName := '..';
// WAD файл:
- a := cbWADList.Items.IndexOf(win2utf(FileName));
+ a := cbWADList.Items.IndexOf(FileName);
if a <> -1 then
begin
cbWADList.ItemIndex := a;
end;
// Секция:
- a := cbSectionsList.Items.IndexOf(win2utf(SectionName));
+ a := cbSectionsList.Items.IndexOf(SectionName);
if a <> -1 then
begin
cbSectionsList.ItemIndex := a;
end;
// Ресурс:
- a := lbResourcesList.Items.IndexOf(win2utf(ResourceName));
+ a := lbResourcesList.Items.IndexOf(ResourceName);
if a <> -1 then
begin
lbResourcesList.ItemIndex := a;