TBitmap, keine Ausgabe

Rund um die LCL und andere Komponenten
Antworten
Mathias
Beiträge: 6160
Registriert: Do 2. Jan 2014, 17:21
OS, Lazarus, FPC: Linux (die neusten Trunk)
CPU-Target: 64Bit
Wohnort: Schweiz

TBitmap, keine Ausgabe

Beitrag von Mathias »

Mit folgendem Code, will ich eine Mauer generieren, die würde eigentlich funktionieren.
Das komische dabei, wen ich die Zeile mit Canvas.Pixel in FormCreate entferne, dann bleibt die Bitmap schwarz.
Wieso ?
In DrawMauer steht auch nichts anderes als Pixels[?, ?].

Code: Alles auswählen

procedure TForm1.FormCreate(Sender: TObject);
const
  size = 1024;
begin
  BitTextur := TBitmap.Create;
  with BitTextur do begin
    PixelFormat := pf32bit;
    Width := size;
    Height := size;
    Canvas.Pixels[0, 0] := 0// ohne dies geht es nicht
    DrawMauer(Canvas);
 
    SaveToFile('test.bmp');
  end;
end;
 
// Zeichne Mauer
 
procedure TForm1.DrawMauer(c: TCanvas);
const
  size = 16;
var
  x, y: integer;
begin
  for y := 0 to c.Height do begin
    for x := 0 to c.Width do begin
      if ((x mod (size * 2) = 0) and (y div (size) mod 2 = 0)) or
        (((x + size) mod (size * 2) = 0) and (y div (size) mod 2 = 1)) or
        (y mod size = 0) then begin
        c.Pixels[x, y] := clRed;
      end else begin
        c.Pixels[x, y] := clYellow;
      end;
    end;
  end;
end;


Noch was:
Mit folgendem Code, wird die Mauer wunderbar ausgegeben.
Entferne ich aber LoadFromFile, dann habe ich keine Ausgabe.

Code: Alles auswählen

procedure TForm1.FormPaint(Sender: TObject);
begin
  BitTextur.LoadFromFile('test.bmp');
  Canvas.Draw(0, 0, BitTextur);
end;

Wen ich in FormCreate

Code: Alles auswählen

 PixelFormat := pf24bit;
dann wird die Mauer ohne LoadFromFile gezeichnet.
Mit Lazarus sehe ich grün
Mit Java und C/C++ sehe ich rot

Michl
Beiträge: 2505
Registriert: Di 19. Jun 2012, 12:54

Re: TBitmap, keine Ausgabe

Beitrag von Michl »

Das ist ein bekanntes Problem (wurde hier im Forum schon oft behandelt). Eine Canvas wird OnDemand erstellt. Der Erstzugriff schlägt zumeist fehl. Bevor ich mit einer Canvas arbeite, rufe ich Canvas.Clear auf, dein Aufruf funktioniert ebenfalls, hauptsache ein gültiges Handle wird erstellt.

Code: Alles auswählen

type
  TLiveSelection = (lsMoney, lsChilds, lsTime);
  TLive = Array[0..1] of TLiveSelection; 

Mathias
Beiträge: 6160
Registriert: Do 2. Jan 2014, 17:21
OS, Lazarus, FPC: Linux (die neusten Trunk)
CPU-Target: 64Bit
Wohnort: Schweiz

Re: TBitmap, keine Ausgabe

Beitrag von Mathias »

Bevor ich mit einer Canvas arbeite, rufe ich Canvas.Clear auf, dein Aufruf funktioniert ebenfalls, hauptsache ein gültiges Handle wird erstellt.

Danke, dies hat schon mal geklappt, die BMP ist schon mal richtig.

Aber dies gehlt leider immer noch nicht. Die Linie wird gezeichnet, aber die Bitmap nicht. Ausgenommen, wie oben schon beschrieben mit LoadFromFile.

Code: Alles auswählen

procedure TForm1.FormPaint(Sender: TObject);
begin
  Caption := IntToStr(BitTextur.Width);
  //  BitTextur.LoadFromFile('test.bmp');
  Canvas.Line(0,0,100,100);
//  Canvas.Clear;
  Canvas.Draw(0, 0, BitTextur);
end;
Mit Lazarus sehe ich grün
Mit Java und C/C++ sehe ich rot

Michl
Beiträge: 2505
Registriert: Di 19. Jun 2012, 12:54

Re: TBitmap, keine Ausgabe

Beitrag von Michl »

Unter Windows geht das Ganze ohne Umwege mit pf32bit und pf24bit (da hat eine Canvas auch nur 24bit Tiefe). Unter Linux sehe ich auch das Problem. Wenn auf die Canvas gezeichnet wurde, müssten diese Daten noch vor dem Canvas.Draw(0, 0, BitTextur); auf das RasterImage kommen. Scheinbar scheitert dies unter Linux.

Du kannst statt auf den Datenträger auch in einen Memorystream speichern und zurück laden (funktioniert hier unter Windows und Linux).

Was auch unter Windows und Linux mit einem Alpha-Kanal versehenem Bitmap funktioniert (und ich aus Performance-Gründen empfehlen würde), wäre die Verwendung von TLazIntfImage. Könnte so aussehen:

Code: Alles auswählen

uses ..., FPimage, Graphics, IntfGraphics, GraphType;
...
procedure TForm1.FormCreate(Sender: TObject);
const
  ASize = 1024;
var
  AImage: TLazIntfImage;
  ARawImage: TRawImage;
begin
  BitTextur := TBitmap.Create;
  ARawImage.Init;
  ARawImage.Description.Init_BPP32_B8G8R8A8_BIO_TTB(ASize, ASize);
  ARawImage.CreateData(True);
  AImage := TLazIntfImage.Create(0, 0);
  AImage.SetRawImage(ARawImage);
  DrawMauer(AImage);
  BitTextur.LoadFromIntfImage(AImage);
  AImage.Free;
end;
 
procedure TForm1.DrawMauer(AImage: TLazIntfImage);
const
  size = 16;
var
  x, y: integer;
  Yellow, Red: TFPColor;
begin
  Yellow.red   := $FF00;
  Yellow.green := $FF00;
  Yellow.blue  := $0000;
  Yellow.alpha := $FF00;
 
  Red.red   := $FF00;
  Red.green := $0000;
  Red.blue  := $0000;
  Red.alpha := $FF00;
 
  for y := 0 to AImage.Height - 1 do begin
    for x := 0 to AImage.Width - 1 do begin
      if ((x mod (size * 2) = 0) and (y div (size) mod 2 = 0)) or
        (((x + size) mod (size * 2) = 0) and (y div (size) mod 2 = 1)) or
        (y mod size = 0) then begin
        AImage.Colors[x, y] := Red;
      end else begin
        AImage.Colors[x, y] := Yellow;
      end;
    end;
  end;
end;

Code: Alles auswählen

type
  TLiveSelection = (lsMoney, lsChilds, lsTime);
  TLive = Array[0..1] of TLiveSelection; 

Mathias
Beiträge: 6160
Registriert: Do 2. Jan 2014, 17:21
OS, Lazarus, FPC: Linux (die neusten Trunk)
CPU-Target: 64Bit
Wohnort: Schweiz

Re: TBitmap, keine Ausgabe

Beitrag von Mathias »

Das Ergebnis, kann sich sehen lassen:
Bild


Irgendwie, sind TBitmap und OpenGL nicht so gute Freunde. TPixelFormat, hat sowie etwas Mühe.
Wen ich die Definition angucke, müssten auch Exoten wie 4Bit unterstütz sein, oder geht die nur mit Delphi ?
Einzig was ich mal hingekriegt hatte ist pf1bit. So wie es scheint, rundet Lazarus alles auf 24 oder 32Bit auf.

Code: Alles auswählen

  { For Delphi compatibility }
  TPixelFormat = (
    pfDevice,
    pf1bit,
    pf4bit,
    pf8bit,
    pf15bit,
    pf16bit,
    pf24bit,
    pf32bit,
    pfCustom
    );


Wen es um Alpha-Blending geht, besonders wen man es selbst erzeugen will, stellt sich TBitmap recht quer.
Ich denke mal, die liegt an dem, das die oberen 8Bit von TColor nicht für Alpha-werte ist, sonder für Systemfarben.
Hier ein ausschnitt aus den Lazarus-Sourcen.

Code: Alles auswählen

  clWindow                  = TColor(SYS_COLOR_BASE or COLOR_WINDOW);
  SYS_COLOR_BASE = TColorRef($80000000);


Sowas schlägt auch fehl, wen ich direkt auf die RawImage von TBitmap zugreife.

Code: Alles auswählen

  BitSource := TBitmap.Create;
  BitSource.RawImage.Init;
  BitSource.RawImage.Description.Init_BPP32_B8G8R8A8_BIO_TTB(TexturSize, TexturSize);
  BitSource.RawImage.CreateData(True)


Ich muss mir wohl TLazIntfImage mal genauer angucken. So wie ich dein Muster sehe, verwendet TLazIntfImage für jeden Farbwert 16Bit, oder täusche ich mach da ?
Mit Lazarus sehe ich grün
Mit Java und C/C++ sehe ich rot

Mathias
Beiträge: 6160
Registriert: Do 2. Jan 2014, 17:21
OS, Lazarus, FPC: Linux (die neusten Trunk)
CPU-Target: 64Bit
Wohnort: Schweiz

Re: TBitmap, keine Ausgabe

Beitrag von Mathias »

So, jetzt habe ich dem Pixel setzen und auslesen mal richtig Dampf gemacht.
Ich greife jetzt direkt auf das RawImage zu.

Code: Alles auswählen

  TFastBitmap = class(TBitmap)
    procedure PutPixel(x, y: UInt32; col: UInt32);
    function GetPixel(x, y: UInt32): UInt32;
  end;
 
procedure TFastBitmap.PutPixel(x, y: UInt32; col: UInt32);
var
  p: pUInt32;
begin
  p := pUInt32(RawImage.Data);
  Inc(p, x + y * Width);
  p^ := col;
  // Alternativ
  p^ := col or $FF000000;  // Alpha immer undurchsichtig
end;
 
function TFastBitmap.GetPixel(x, y: UInt32): UInt32;
var
  p: pUInt32;
begin
  p := pUInt32(RawImage.Data);
  Inc(p, x + y * Width);
  Result := p^;
end;


Dies bedingt aber, das das Bitmap-Format pf32bit ist.
Bereichsprüfung gibt es auch keine. Man muss wissen, was man macht.
Mit Lazarus sehe ich grün
Mit Java und C/C++ sehe ich rot

Frank Ranis
Beiträge: 201
Registriert: Do 24. Jan 2013, 21:22

Re: TBitmap, keine Ausgabe

Beitrag von Frank Ranis »

Hallo Mathias,

Mathias hat geschrieben:Das Ergebnis, kann sich sehen lassen:
Bild

Irgendwie, sind TBitmap und OpenGL nicht so gute Freunde. TPixelFormat, hat sowie etwas Mühe.
Wen ich die Definition angucke, müssten auch Exoten wie 4Bit unterstütz sein, oder geht die nur mit Delphi ?
Einzig was ich mal hingekriegt hatte ist pf1bit. So wie es scheint, rundet Lazarus alles auf 24 oder 32Bit auf.

Code: Alles auswählen

  { For Delphi compatibility }
  TPixelFormat = (
    pfDevice,
    pf1bit,
    pf4bit,
    pf8bit,
    pf15bit,
    pf16bit,
    pf24bit,
    pf32bit,
    pfCustom
    );




die Sache mit dem eingeschränkten Pixelformat (außer pf24bit,pf32bit klappte nichts) hatte mich neulich bei meinen OpenGl-Textversuchen auch fast zu Verzweiflung gebracht.
Wollte das auch erst mit Texturen machen und habe mich da aber total verannt.

Mal ne andere Sache , Du hast hier einen Scrennshot von deiner Mauer hochgeladen , geht das Upload von Dateien wieder ??

Gruß

Frank
www.flz-vortex.de

Mathias
Beiträge: 6160
Registriert: Do 2. Jan 2014, 17:21
OS, Lazarus, FPC: Linux (die neusten Trunk)
CPU-Target: 64Bit
Wohnort: Schweiz

Re: TBitmap, keine Ausgabe

Beitrag von Mathias »

Mal ne andere Sache , Du hast hier einen Scrennshot von deiner Mauer hochgeladen , geht das Upload von Dateien wieder ??

Nein, der Link ist extern.

die Sache mit dem eingeschränkten Pixelformat (außer pf24bit,pf32bit klappte nichts) hatte mich neulich bei meinen OpenGl-Textversuchen auch fast zu Verzweiflung gebracht.

Der grösste Erfolg, habe ich jetzt mit direkten Zugriff auf die RawImage erreicht.
Diese Formate werden unterstützt:

Code: Alles auswählen

    // 1-bit mono format
    procedure Init_BPP1(AWidth, AHeight: integer);
 
    // 16-bits formats
    procedure Init_BPP16_R5G6B5(AWidth, AHeight: integer);
 
    // Formats in RGB order
    procedure Init_BPP24_R8G8B8_BIO_TTB(AWidth, AHeight: integer);
    procedure Init_BPP24_R8G8B8_BIO_TTB_UpsideDown(AWidth, AHeight: integer);
    procedure Init_BPP32_A8R8G8B8_BIO_TTB(AWidth, AHeight: integer);
    procedure Init_BPP32_R8G8B8A8_BIO_TTB(AWidth, AHeight: integer);
 
    // Formats in Windows pixels order: BGR
    procedure Init_BPP24_B8G8R8_BIO_TTB(AWidth, AHeight: integer);
    procedure Init_BPP24_B8G8R8_M1_BIO_TTB(AWidth, AHeight: integer);
    procedure Init_BPP32_B8G8R8_BIO_TTB(AWidth, AHeight: integer);
    procedure Init_BPP32_B8G8R8_M1_BIO_TTB(AWidth, AHeight: integer);
    procedure Init_BPP32_B8G8R8A8_BIO_TTB(AWidth, AHeight: integer);
    procedure Init_BPP32_B8G8R8A8_M1_BIO_TTB(AWidth, AHeight: integer);

Wobei das 16Bit-Format intern auch auf 24Bit verbraucht.

Code: Alles auswählen

procedure TRawImageDescription.Init_BPP16_R5G6B5(AWidth, AHeight: integer);
begin
  // setup an artificial ScanLineImage with format RGB 24 bit, 24bit depth format
  FillChar(Self, SizeOf(Self), 0);
 
  Format := ricfRGBA;
  Depth := 16; // used bits per pixel
  Width := AWidth;
  Height := AHeight;
  BitOrder := riboBitsInOrder;
  ByteOrder := riboLSBFirst;
  LineOrder := riloTopToBottom;
  BitsPerPixel := 24; // bits per pixel. can be greater than Depth.
  LineEnd := rileDWordBoundary;
  RedPrec := 5; // red precision. bits for red
  RedShift := 0;
  GreenPrec := 6;
  GreenShift := 5; // bitshift. Direction: from least to most significant
  BluePrec := 5;
  BlueShift:=11;
//  AlphaPrec:=0;
//  MaskBitsPerPixel:=0;
end


OpenGL wird wohl am besten mit 24 oder 32Bit bedient.
OpenGL kennt 8 und 16 Bit: http://milkpot.sakura.ne.jp/gl/textureformat.html
Mit den Prec und Shift-Werten von RawImage sollte es im Prinzip möglich sein, x-beliebtes Formt zu konfigurieren. Theoretisch sogar ein 64Bit-Images. 2,4 und 8 Bit sollten auch möglich sein.
Nur wird dann RawImage nicht mehr kompatibel sein, mit TBitmap.
Mit Lazarus sehe ich grün
Mit Java und C/C++ sehe ich rot

Mathias
Beiträge: 6160
Registriert: Do 2. Jan 2014, 17:21
OS, Lazarus, FPC: Linux (die neusten Trunk)
CPU-Target: 64Bit
Wohnort: Schweiz

Re: TBitmap, keine Ausgabe

Beitrag von Mathias »

Ich habe jetzt mal mit einer 8Bit RawImage experimentiert.
So wie es scheint, funktioniert es, jetzt müsste man es nur noch probieren OpenGL zu übergeben.

Dabei habe ich eine interessante Entdeckung gemacht. Image2 übernimmt die DataSize vom 8Bit-Images.
Aber sobald ich in den Canvas schreibe, ist DataSize auf einmal 4x grösser.
Auch wird das PixelFormat an gleicher Stelle geändert.

Code: Alles auswählen

  { T8BitRawImage }
 
  T8BitRawImage = object(TRawImage)
    procedure PutPixel(x, y: integer; col: byte);
  end;
 
  { TMyRawImageDescription }
 
  TMyRawImageDescription = object(TRawImageDescription)
    procedure Init_BPP8(AWidth, AHeight: integer);
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.lfm}
 
const
  Red = %00000111;
  Green = %00111000;
  Blue = %11000000;
 
{ T8BitRawImage }
 
 
procedure T8BitRawImage.PutPixel(x, y: integer; col: byte);
var
  p: PByte;
  ofs: UInt32;
begin
  p := Data;
  ofs := x + y * Description.Width;
  if ofs > DataSize then begin
    Exit;
  end;
  Inc(p, ofs);
  p^ := col;
end;
 
{ TMyRawImageDescription }
 
procedure TMyRawImageDescription.Init_BPP8(AWidth, AHeight: integer);
begin
  FillChar(Self, SizeOf(Self), 0);
 
  Format := ricfRGBA;
  Depth := 8; // used bits per pixel
  Width := AWidth;
  Height := AHeight;
  BitOrder := riboBitsInOrder;
  ByteOrder := riboLSBFirst;
  LineOrder := riloTopToBottom;
  BitsPerPixel := 8; // bits per pixel. can be greater than Depth.
  LineEnd := rileDWordBoundary;
  RedPrec := 3;
  RedShift := 0;
  GreenPrec := 3;
  GreenShift := 3;
  BluePrec := 2;
  BlueShift := 6;
end;
 
{ TForm1 }
 
procedure TForm1.BitBtn1Click(Sender: TObject);
var
  raw: T8BitRawImage;
  des: TMyRawImageDescription;
begin
  des.Init_BPP8(16, 16);
 
  raw.Init;
  raw.Description := des;
  raw.CreateData(True);
 
  raw.PutPixel(0, 0, Red);
  raw.PutPixel(1, 1, Green);
  raw.PutPixel(2, 2, Blue);
 
  WriteLn('raw: ', raw.DataSize);
 
  Image2.Picture.Bitmap.LoadFromRawImage(raw, True);
 
  WriteLn('vor Pixels: ', Image2.Picture.Bitmap.RawImage.DataSize);
  WriteLn(Image2.Picture.Bitmap.PixelFormat);
  Image2.Picture.Bitmap.Canvas.Pixels[4, 4] := clRed;
  WriteLn('nach Pixels :', Image2.Picture.Bitmap.RawImage.DataSize);
  WriteLn(Image2.Picture.Bitmap.PixelFormat);
 
  Caption := IntToStr(Image2.Picture.Bitmap.RawImage.Description.BitsPerPixel);
end;


Nachtrag:
Als PNG kann man die 8Bit-Images sogar abspeichern, bei BMP kommt ein Palettenfehler. JPG und GIF gehen auch nicht.

Code: Alles auswählen

  Image2.Picture.Bitmap.LoadFromRawImage(raw, True);
  Image2.Picture.SaveToFile('test.png');


Aber nach dem laden, hat es dann auch 32Bit:

Code: Alles auswählen

  Image1.Picture.LoadFromFile('test.png');
  WriteLn('laden: ', Image1.Picture.Bitmap.PixelFormat);
Mit Lazarus sehe ich grün
Mit Java und C/C++ sehe ich rot

Antworten