X-Git-Url: http://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Feditor%2Ff_addresource_sky.pas;h=e4a0f44fd86d0fd26a16b09a37572f0773f75e5b;hb=7b1e10415752de52a887e7fe0b38a7aee4b19982;hp=98a8026ac10961fb13f3f1fe8fb493d1af1dcd05;hpb=6fb9c23afad22a71679525dc44ea32675d73609f;p=d2df-editor.git diff --git a/src/editor/f_addresource_sky.pas b/src/editor/f_addresource_sky.pas index 98a8026..e4a0f44 100644 --- a/src/editor/f_addresource_sky.pas +++ b/src/editor/f_addresource_sky.pas @@ -31,7 +31,7 @@ var implementation uses - BinEditor, WADEDITOR, f_main, g_language; + WADEDITOR, f_main, g_language, g_resources; {$R *.lfm} @@ -39,63 +39,65 @@ function ShowTGATexture(ResourceStr: String): TBitMap; var img: TImageData; clr: TColor32Rec; - ii: PByte; + bgc: TColor32Rec; Width, Height: Integer; - ColorDepth: Integer; - ImageSize: 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(utf2win(SectionName), utf2win(ResourceName), TextureData, ImageSize); - - WAD.Free(); + (* !!! copypaste from f_addresource_texture.CreateBitMap *) InitImage(img); if not LoadImageFromMemory(TextureData, ImageSize, img) then + begin + FreeMem(TextureData); Exit; + end; Width := img.width; Height := img.height; - ColorDepth := 24; - ImageSize := Width*Height*(ColorDepth div 8); - BitMap := TBitMap.Create(); BitMap.PixelFormat := pf24bit; - 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 - for x := 0 to width-1 do + for x := 0 to width - 1 do begin clr := GetPixel32(img, x, y); - // assuming sky has no alpha - // TODO: check for ARGB/RGBA/BGRA/ABGR somehow? - ii^ := clr.b; Inc(ii); - ii^ := clr.g; Inc(ii); - ii^ := clr.r; Inc(ii); - end; + // 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); + BitMap.Canvas.Pixels[x, y] := RGBToColor(clr.r, clr.g, clr.b) + end end; - FreeMem(TextureData); FreeImage(img); Result := BitMap; @@ -105,8 +107,7 @@ procedure TAddSkyForm.bOKClick(Sender: TObject); begin Inherited; - if not FResourceSelected then - Exit; + ModalResult := mrOk; end; procedure TAddSkyForm.lbResourcesListClick(Sender: TObject);