X-Git-Url: http://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Feditor%2Ff_addresource_sky.pas;h=79362df8f84f194d09b5a83da44b128da106b1be;hb=352afa5b7b27f7783344f1878fcfa1fae1001db1;hp=2f2c25f84aa6743ef5a916a9f440cc26a7e8dcb5;hpb=3dc2fe6b3d29cd54425db8f590e922f2dce50e99;p=d2df-editor.git diff --git a/src/editor/f_addresource_sky.pas b/src/editor/f_addresource_sky.pas index 2f2c25f..79362df 100644 --- a/src/editor/f_addresource_sky.pas +++ b/src/editor/f_addresource_sky.pas @@ -7,7 +7,7 @@ interface 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) @@ -31,89 +31,87 @@ var 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; @@ -121,8 +119,7 @@ procedure TAddSkyForm.bOKClick(Sender: TObject); begin Inherited; - if not FResourceSelected then - Exit; + ModalResult := mrOk; end; procedure TAddSkyForm.lbResourcesListClick(Sender: TObject); @@ -168,7 +165,7 @@ begin SectionName := '..'; // WAD файл: - a := cbWADList.Items.IndexOf(win2utf(FileName)); + a := cbWADList.Items.IndexOf(FileName); if a <> -1 then begin cbWADList.ItemIndex := a; @@ -176,7 +173,7 @@ begin end; // Секция: - a := cbSectionsList.Items.IndexOf(win2utf(SectionName)); + a := cbSectionsList.Items.IndexOf(SectionName); if a <> -1 then begin cbSectionsList.ItemIndex := a; @@ -184,7 +181,7 @@ begin end; // Ресурс: - a := lbResourcesList.Items.IndexOf(win2utf(ResourceName)); + a := lbResourcesList.Items.IndexOf(ResourceName); if a <> -1 then begin lbResourcesList.ItemIndex := a;