TBitmap, keine Ausgabe

Rund um die LCL und andere Komponenten

TBitmap, keine Ausgabe

Beitragvon Mathias » 28. Mär 2018, 22:09 TBitmap, keine Ausgabe

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 gün
Mit Java und C/C++ sehe ich rot
Mathias
 
Beiträge: 4342
Registriert: 2. Jan 2014, 17:21
Wohnort: Schweiz
OS, Lazarus, FPC: Linux (die neusten Trunc) | 
CPU-Target: 64Bit
Nach oben

Beitragvon Michl » 28. Mär 2018, 22:22 Re: TBitmap, keine Ausgabe

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; 
Michl
 
Beiträge: 2262
Registriert: 19. Jun 2012, 11:54
OS, Lazarus, FPC: Win7 Laz 1.7 Trunk FPC 3.1.1 Trunk | 
CPU-Target: 32Bit/64bit
Nach oben

Beitragvon Mathias » 29. Mär 2018, 17:43 Re: TBitmap, keine Ausgabe

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 gün
Mit Java und C/C++ sehe ich rot
Mathias
 
Beiträge: 4342
Registriert: 2. Jan 2014, 17:21
Wohnort: Schweiz
OS, Lazarus, FPC: Linux (die neusten Trunc) | 
CPU-Target: 64Bit
Nach oben

Beitragvon Michl » 29. Mär 2018, 21:28 Re: TBitmap, keine Ausgabe

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; 
Michl
 
Beiträge: 2262
Registriert: 19. Jun 2012, 11:54
OS, Lazarus, FPC: Win7 Laz 1.7 Trunk FPC 3.1.1 Trunk | 
CPU-Target: 32Bit/64bit
Nach oben

Beitragvon Mathias » 1. Apr 2018, 19:57 Re: TBitmap, keine Ausgabe

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 gün
Mit Java und C/C++ sehe ich rot
Mathias
 
Beiträge: 4342
Registriert: 2. Jan 2014, 17:21
Wohnort: Schweiz
OS, Lazarus, FPC: Linux (die neusten Trunc) | 
CPU-Target: 64Bit
Nach oben

Beitragvon Mathias » 3. Apr 2018, 17:19 Re: TBitmap, keine Ausgabe

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 gün
Mit Java und C/C++ sehe ich rot
Mathias
 
Beiträge: 4342
Registriert: 2. Jan 2014, 17:21
Wohnort: Schweiz
OS, Lazarus, FPC: Linux (die neusten Trunc) | 
CPU-Target: 64Bit
Nach oben

Beitragvon Frank Ranis » 4. Apr 2018, 06:15 Re: TBitmap, keine Ausgabe

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
Frank Ranis
 
Beiträge: 112
Registriert: 24. Jan 2013, 21:22
OS, Lazarus, FPC: Winux (L 0.9.xy FPC 2.2.z) | 
CPU-Target: xxBit
Nach oben

Beitragvon Mathias » 4. Apr 2018, 16:29 Re: TBitmap, keine Ausgabe

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 gün
Mit Java und C/C++ sehe ich rot
Mathias
 
Beiträge: 4342
Registriert: 2. Jan 2014, 17:21
Wohnort: Schweiz
OS, Lazarus, FPC: Linux (die neusten Trunc) | 
CPU-Target: 64Bit
Nach oben

Beitragvon Mathias » 4. Apr 2018, 17:37 Re: TBitmap, keine Ausgabe

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 gün
Mit Java und C/C++ sehe ich rot
Mathias
 
Beiträge: 4342
Registriert: 2. Jan 2014, 17:21
Wohnort: Schweiz
OS, Lazarus, FPC: Linux (die neusten Trunc) | 
CPU-Target: 64Bit
Nach oben

• Themenende •

Zurück zu Komponenten und Packages



Wer ist online?

Mitglieder in diesem Forum: Google [Bot] und 6 Gäste

porpoises-institution
accuracy-worried