summary | shortlog | log | commit | commitdiff | tree
raw | patch | inline | side by side (parent: 3dc2fe6)
raw | patch | inline | side by side (parent: 3dc2fe6)
author | fgsfds <pvt.fgsfds@gmail.com> | |
Tue, 5 Sep 2017 14:45:10 +0000 (17:45 +0300) | ||
committer | fgsfds <pvt.fgsfds@gmail.com> | |
Tue, 5 Sep 2017 14:45:10 +0000 (17:45 +0300) |
src/editor/f_addresource_texture.lfm | patch | blob | history | |
src/editor/f_addresource_texture.pas | patch | blob | history |
index 520bf27b2329f4b790030ef8d3c63944726401c9..c1fed5a115a14b0f068adec9c0e3c0b52c563d2f 100644 (file)
inherited AddTextureForm: TAddTextureForm
Left = 371
+ Height = 299
Top = 194
+ Width = 466
Caption = 'Выберите текстуру'
- ClientHeight = 302
+ ClientHeight = 299
ClientWidth = 466
- PixelsPerInch = 96
inherited bOK: TButton
Left = 11
+ Height = 17
Top = 272
Width = 22
- Height = 17
- Visible = False
+ Default = False
OnClick = nil
+ Visible = False
end
inherited bCancel: TButton
Left = 35
+ Height = 18
Top = 271
Width = 22
- Height = 18
Visible = False
end
inherited lbResourcesList: TListBox
- Top = 112
Height = 150
+ Top = 112
+ ItemHeight = 0
end
- object PanelTexPreview: TPanel
+ object PanelTexPreview: TPanel[7]
Left = 204
+ Height = 258
Top = 4
Width = 258
- Height = 258
BevelOuter = bvLowered
+ ClientHeight = 258
+ ClientWidth = 258
TabOrder = 5
object iPreview: TImage
Left = 0
+ Height = 256
Top = 0
Width = 256
- Height = 256
end
end
- object eTextureName: TEdit
+ object eTextureName: TEdit[8]
Left = 4
+ Height = 21
Top = 88
Width = 193
- Height = 21
- TabOrder = 6
OnChange = eTextureNameChange
+ TabOrder = 6
end
- object bAddTexture: TButton
+ object bAddTexture: TButton[9]
Left = 160
+ Height = 25
Top = 272
Width = 81
- Height = 25
Caption = 'Добавить'
Default = True
- TabOrder = 7
OnClick = bAddTextureClick
+ TabOrder = 7
end
- object bClose: TButton
+ object bClose: TButton[10]
Left = 248
+ Height = 25
Top = 272
Width = 81
- Height = 25
Caption = 'Закрыть'
- TabOrder = 8
OnClick = bCloseClick
+ TabOrder = 8
end
- object bAddClose: TButton
+ object bAddClose: TButton[11]
Left = 336
+ Height = 25
Top = 272
Width = 121
- Height = 25
Caption = 'Добавить и закрыть'
- TabOrder = 9
OnClick = bAddCloseClick
+ TabOrder = 9
end
end
index 195b22d52ead5396cb72fba75ef7e3dc2b56ebc4..7319645ffb72f1498a60a801089c0f8b25c3a1fe 100644 (file)
uses
LCLIntf, LCLType, LMessages, SysUtils, Variants, Classes,
Graphics, Controls, Forms, Dialogs, f_addresource,
- StdCtrls, ExtCtrls, utils;
+ StdCtrls, ExtCtrls, utils, Imaging, ImagingTypes, ImagingUtility,
+ e_log;
type
TAddTextureForm = class (TAddResourceForm)
Result := True;
end;
-function CreateBitMap(Data: Pointer): TBitMap;
+function CreateBitMap(Data: Pointer; DataSize: Cardinal): TBitMap;
+const
+ BG_R: Byte = 255;
+ BG_G: Byte = 0;
+ BG_B: Byte = 255;
var
- TGAHeader: TTGAHeader;
- image: Pointer;
+ img: TImageData;
+ clr: TColor32Rec;
+ ii: PByte;
Width,
Height: Integer;
ColorDepth: Integer;
ImageSize: Integer;
- i: Integer;
+ i, x, y: Integer;
BitMap: TBitMap;
begin
Result := nil;
-// Читаем заголовок TGA:
- CopyMemory(@TGAHeader, Data, SizeOf(TGAHeader));
-
- if TGAHeader.ImageType <> 2 then
- Exit;
- if TGAHeader.ColorMapType <> 0 then
- Exit;
- if TGAHeader.BPP < 24 then
+ InitImage(img);
+ if not LoadImageFromMemory(Data, DataSize, img) then
+ begin
+ e_WriteLog('Invalid image format?', MSG_WARNING);
Exit;
+ end;
- Width := TGAHeader.Width[0]+TGAHeader.Width[1]*256;
- Height := TGAHeader.Height[0]+TGAHeader.Height[1]*256;
- ColorDepth := TGAHeader.BPP;
+ Width := img.width;
+ Height := img.height;
+ ColorDepth := 24;
ImageSize := Width*Height*(ColorDepth div 8);
-// Само изображение:
- GetMem(Image, ImageSize);
-
- CopyMemory(Image, Pointer(Integer(Data)+SizeOf(TGAHeader)), ImageSize);
-
BitMap := TBitMap.Create();
-
- if TGAHeader.BPP = 24 then
- BitMap.PixelFormat := pf24bit
- else
- BitMap.PixelFormat := pf32bit;
+ BitMap.PixelFormat := pf24bit;
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);
+ 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 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;
+ end;
Result := BitMap;
end;
(WAD.GetLastError = DFWAD_NOERROR) then
begin
// Создаем BitMap из листа текстур:
- Result := CreateBitMap(TextureData);
+ Result := CreateBitMap(TextureData, Len);
// Размеры одного кадра - виден только первый кадр:
Result.Height := config.ReadInt('', 'frameheight', 0);
WAD.Free();
// Создаем на его основе BitMap:
- Result := CreateBitMap(TextureData);
+ Result := CreateBitMap(TextureData, Len);
- FreeMem(TextureData, Len);
+ FreeMem(TextureData);
end;
procedure TAddTextureForm.FormActivate(Sender: TObject);