index 49034d2239db2e0ff74db35a9d7756ef21496e92..e4a0f44fd86d0fd26a16b09a37572f0773f75e5b 100644 (file)
var
img: TImageData;
clr: TColor32Rec;
- ii: PByte;
+ bgc: TColor32Rec;
Width,
Height: Integer;
- ColorDepth: Integer;
- ImageSize: Integer;
x, y: Integer;
BitMap: TBitMap;
TextureData: Pointer;
+ ImageSize: Integer;
WADName: String;
SectionName: String;
ResourceName: String;
g_ProcessResourceStr(ResourceStr, WADName, SectionName, ResourceName);
g_ReadResource(WADName, SectionName, ResourceName, TextureData, ImageSize);
+ (* !!! 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;
begin
Inherited;
- if not FResourceSelected then
- Exit;
+ ModalResult := mrOk;
end;
procedure TAddSkyForm.lbResourcesListClick(Sender: TObject);