OpenGLControl - Zeichnung als Bitmap - [gelöst]

[willi4willi]

Hallo,

ich habe folgendes Problem: Nachdem ich ein "schönes" Bild mit OpenGL gezeichnet habe, möchte ich dieses auch abspeichern bzw. als Bild an Lazreport übergeben.

Vorher hatte ich auf ein Bitmap.Canvas gemalt und konnte das dann mit Bitmap.SaveToFile() speichern.

Bei OpenGLControl kann ich diese Eigenschaft nicht finden.

Hat jemand eine Idee, wie ich das genauso einfach hinbekomme?

[Teekeks]

screenshot von dem Control?
Ist das einzige was mir dazu einfällt.

[willi4willi]

Danke für den Hinweis.
Ich habe eine Lösung gefunden. Aber ob die besonders elegant ist?
Ich habe die OpenGLControl auf ein Pannel gelegt und dann dessen Canvas verwendet:

Code: Alles auswählen

procedure TForm1.FormClick(Sender: TObject);
var Bereich     : TRect;
    MeineBitmap : TBitmap;
begin
  Bereich.Top:=OpenGLControl1.Top;
  Bereich.Left:=OpenGLControl1.Left;
  Bereich.Bottom:=OpenGLControl1.Height;
  Bereich.Right:=OpenGLControl1.Width;
  MeineBitmap:=TBitmap.Create;
  MeineBitmap.Height:=OpenGLControl1.Height;
  MeineBitmap.Width:=OpenGLControl1.Width;
  MeineBitmap.Canvas.CopyRect(Bereich,Panel1.Canvas,Bereich);
  MeineBitmap.SaveToFile('Bild.bmp');
  MeineBitmap.free
end;

Wenn jemand noch eine bessere Idee hat, ich bin lernfähig. Diese Variante hat erst einmal funktioniert.

[corpsman]

Also ich mache das immer so :

Code: Alles auswählen

Function OpenGLScreenshot: TBitmap;
Var
  dim: Array[0..3] Of Integer;
  c: Array Of Array[0..3] Of Byte;
  z, i, j: integer;
  TempIntfImg: TLazIntfImage;
  ImgHandle, ImgMaskHandle: HBitmap;
  CurColor: TFPColor;
Begin
  // AUslesen der Framebuffer Auflösung
  glGetIntegerv(GL_VIEWPORT, @dim[0]);
  // Erstellen des Bitmaps
  result := TBitmap.create;
  result.pixelformat := pf24bit;
  result.width := dim[2];
  result.height := dim[3];
  TempIntfImg := TLazIntfImage.Create(0, 0);
  TempIntfImg.LoadFromBitmap(result.Handle, result.MaskHandle);
  setlength(c, dim[2] * dim[3]);
  // Auslesen des Framebuffers in einen temporären Speicher
  glReadPixels(dim[0], dim[1], dim[2], dim[3], GL_RGBA, GL_UNSIGNED_BYTE, @c[0, 0]);
  // Umschreiben des Temporären Speichers in das TBitmap
  z := 0;
  For j := 0 To result.height - 1 Do
    For i := 0 To result.width - 1 Do Begin
      CurColor.red := c[z][0] * 256;
      CurColor.green := c[z][1] * 256;
      CurColor.blue := c[z][2] * 256;
      // c[z][3] wäre der Alphakanal, aber den Braucht man ja hier nicht ...
      TempIntfImg.Colors[i, j] := CurColor;
      inc(z);
    End;
  TempIntfImg.CreateBitmaps(ImgHandle, ImgMaskHandle, false);
  result.Handle := ImgHandle;
  result.MaskHandle := ImgMaskHandle;
  TempIntfImg.free;
End;

[willi4willi]

Ich habe es einmal probiert, aber offensichtlich fehlt mir noch etwas:

Code: Alles auswählen

unit1.pas(48,33) Error: Identifier not found "TLazIntfImage"

[Euklid]

Ich habe es einmal probiert, aber offensichtlich fehlt mir noch etwas:

Code: Alles auswählen

unit1.pas(48,33) Error: Identifier not found "TLazIntfImage"

Hallo willi,

Zur Nutzung der LazIntfImage muss "intfgraphics" im uses-Bereich eingebunden werden, vgl.: http://www.freepascal.org/docs-html/lcl ... image.html" onclick="window.open(this.href);return false;

Viele Grüße, Euklid

[willi4willi]

Danke für die Tipps!
Nachdem ich noch intfgraphics, FPimage (für TFPColor) und LCLType (für HBitmap) in der uses-Anweisung hinzugefügt habe, funktionierte die Funktion schon ganz gut.

Allerdings blicke ich noch nicht so richtig durch. Wenn ich zwei OpenGLControls hinzugefügt habe, dann weiß die Funktion offensichtlich nicht, welches dieser Objekte gemeint ist.
Das Ergebnis ist wohl das zuletzt gemalte Objekt? Mal wird das eine (OpenGLControl1) und mal das andere Objekt (OpenGLControl2) verwendet.

Ich konnte zwar das Problem folgendermaßen lösen:

Code: Alles auswählen

procedure TForm1.Button1Click(Sender: TObject);
begin
 openGLControl1.DoOnPaint;
 Image1.Picture.Clear;
 Image1.Picture.Bitmap.Assign(OpenGLScreenshot);
end;  
 
procedure TForm1.Button2Click(Sender: TObject);
begin
 openGLControl2.DoOnPaint;
 Image1.Picture.Clear;
 Image1.Picture.Bitmap.Assign(OpenGLScreenshot);
end;

- aber das ist sicherlich nicht besonders elegant. Besser wäre es, wenn man das Objekt als Parameter an die Funktion OpenGLScreenshot übergeben könnte. Doch wo muss ich da ansetzen?

Das objekt.DoOnPaint in die Funktion mit aufnehmen, damit man das zuletzt gezeichnete Objekt hat? Oder kann man das Objethandle direkt ansprechen?

Wie würdet ihr es machen?

[corpsman]

Also ich lehne mich nun mal weit aus dem Fenster...

So viel ich weis gibt es Pro Anwendung nur ein OpenGL Bereich. Du kannst zwar 2 OpenGLcontrols setzen. Und diese auch unterschiedliche Dinge anzeigen lassen. Aber letztendes benutzt du ja zum Rendern beider auch stets die selben Befehle, wie soll also OpenGL zwischen den beiden unterscheiden ?

Ich denke mal ein Code ähnlich zu :

Code: Alles auswählen

openGLControl1.DoOnPaint;
openGLControl2.swapbuffers();

Zeigt dir auf beiden Controls das selbe => wenn du beide Aktualisieren willst, musst du auch beide neu Rendern, dies könntest du aber niemals Parallel tun.

Ich denke die von dir gezeigte Lösung ist tatsächlich die einzige die möglich ist.

Aber wie schon zu Anfang angedeutet, sicher bin ich mir nicht.

[mschnell]

Hier der ReadScreen-Code, der in meinem Test-Projekt funktioniert.

Für die Übertragung habe ich dann einige Funktionen verwendet, die dei vom Grafik-Treiber abhängigen Pixel-Struktur (1, 4, 8, 16, 24 oder 32 Bit pro Pixel, jeweils wieder unterschiedliche Bit-im-Wort Definitionen) in ein definiertes Übertragungs-Format umwandeln.

Gruß,
-Michael

Code: Alles auswählen

function TSenderForm1.ReadScreenImage(var Dest: Array of Byte; XDestsize: Integer; var AWidth, AHeight: Integer): Integer;
var
  wi, hi, x0dest, y0dest, x0source, y0source: Integer;
  wi8, i8, x8: Integer;
  b8: Byte;
  DesktopBitmap: TBitmap;
 
  Info      : PBitmapInfo;
  InfoSize  : DWORD;
  Image     : Pointer;
  ImageSize : DWORD;
 
  pf: TPixelFormat;
  x, y, c, linelength, linelength4: Integer;
  ps: Pointer;
  pd: PByte;
  pi:  PIntegerArray absolute ps;
  pw: PWordArray absolute ps;
  pixelmode_source: Integer;
  pixelsize_source: Integer;
  mask_r, mask_g, mask_b: Integer;
  DesktopHDC: HDC;
  DesktopHandle: HWND;
//  s: String;
 
begin
  x0dest   := 0;
  y0dest   := 0;
  x0source := SenderForm1.Left+10;
  y0source := SenderForm1.Top+30;
  wi       := SenderForm1.Width-10-10;
  AWidth   := wi;
  hi       := SenderForm1.Height-30-10;
  AHeight  := hi;
 
  wi8 := (wi+7) div 8;
  Result := wi8*hi;
  if Result > XDestsize then begin
    Result := -1;
    exit;
  end;
 
  DesktopBitmap := TBitmap.Create;
  DesktopBitmap.Width := wi;
  DesktopBitmap.Height := hi;
 
  DesktopBitmap.PixelFormat := UsePixelFormat;
 
  DesktopHandle := GetDesktopWindow;
  DesktopHDC := GetDC(DesktopHandle);
  BitBlt(DesktopBitmap.Canvas.Handle, x0dest, y0dest, wi, hi,
         DesktopHDC, x0source, y0source, SrcCopy);
  ReleaseDC(DesktopHandle, DesktopHDC);
 
  GetDIBSizes(DesktopBitmap.Handle, InfoSize, ImageSize);
  Info := AllocMem(InfoSize);
  Image := AllocMem(ImageSize);
 
  if getdib(DesktopBitmap.Handle, 0, Info^, Image^) then begin
//    Edit1.Text := 'OK';
   end else begin
//    Edit1.Text := 'Error';
    FreeMem(Image, ImageSize);
    FreeMem(Info, InfoSize);
    Result := -1;
    exit;
  end;
  DesktopBitmap.Free;
 
(*  Info.bmiHeader.biHeight < 0 -> top down, muss noch behandelt werden *)
 
  linelength := Info.bmiHeader.biWidth;
  linelength4 := 0;
 
  if DesktopBitmap.PixelFormat = pf1bit then begin
    pixelsize_source := 1;
    linelength4 := (linelength-1) div 32;   //linlength * pixelsize_source muss durch 4 teilbar sein
    linelength4 := linelength4+1;  // in 4-Byte Worten
    linelength := (linelength-1) div 8;
    linelength := linelength + 1;  
    ps := Image;
    for y := hi-1 downto 0 do begin
      pd := PByte(@dest[wi8*y]);
      move(ps^, pd^, linelength);
      ps := @pi[linelength4];
    end;
  end else begin
    case Info.bmiHeader.biBitCount of
      1, 4:   pixelsize_source := 0;
      8:  begin
        pixelsize_source := 1;
        linelength4 := (linelength-1) div 4;   // linlength * pixelsize_source muss durch 4 teilbar sein
        linelength4 := linelength4+1;          // in 4-Byte Worten
      end;
      16: begin
        pixelsize_source := 2;
        linelength4 := (linelength-1) div 2;   // linlength * pixelsize_source muss durch 4 teilbar sein
        linelength4 := linelength4+1;          // in 4-Byte Worten
      end;
      24: begin
        pixelsize_source := 3;
        linelength4 := (linelength-1) div 4;   // linlength * pixelsize_source muss durch 4 teilbar sein
        linelength4 := linelength4+1;          // in 4-Byte Worten
      end;
      32:  begin
        pixelsize_source := 4;
        linelength4 := linelength;             // linlength ohnehin in 4-Byte Worten
      end;
     else begin    //pixelmode und size müssen aus dem devicecontext ausgelesen werden
      pixelsize_source := 0;
     end
    end;
    pixelmode_source := 0;
    if info.bmiHeader.biCompression <> BI_RGB then begin
      ps := @Info.bmiColors;
  {
      s := INttoHex(pid[0], 8);
      s := s + ' ';
      s := s + INttoHex(pid[1], 8);
      s := s + ' ';
      s := s + INttoHex(pid[2], 8);
  }
     end else begin
  {
      s := 'BI_RGB';
  }
      case Info.bmiHeader.biBitCount of
        1, 4: pixelmode_source := 0;  // unzulaessig
        8:   pixelmode_source := 0;  // unzulaessig
        16:  pixelmode_source := $11;  // 15 in 16 Bit r/g/b -> b/g/r;
        24:  pixelmode_source := $12;  // 24 in 24 Bit r/g/b -> b/g/r;
        32:  pixelmode_source := $13;  // 24 in 32 Bit r/g/b -> b/g/r;
       else begin    //pixelmode und size müssen aus dem devicecontext ausgelesen werden
        pixelmode_source := 0;  // unzulaessig
       end;
      end;
    end;
  {
    Edit2.Text := s;
  }
 
  (***************************************************************)
 
 
    pixelmode := pixelmode_source;
 
 
  //  GetMem(dest, DestSize);
 
    pi := NIL;
    pw := NIL;
    ps := Image;
    for y := hi-1 downto 0 do begin
      pd := PByte(@dest[wi8*y]);
      case pixelsize_source of
       2: begin
        for x8 := 0 to wi8-1 do begin
          b8 := 0;
          for i8 := 0 to 7 do begin
            x := x8*8+i8;
            c := pw[x];
            c := convertcolor(c, pixelmode_source);
            c := b_w(c);
            b8 := (b8 shl 1) or Byte(c);
          end;
  {
          if CheckBox3.Checked then begin
            c := b8 xor $FF;
          end;
  }
          pd^ := b8;
          inc(pd);
        end;
       end;
       4: begin
        for x8 := 0 to wi8-1 do begin
          b8 := 0;
          for i8 := 0 to 7 do begin
            x := x8*8+i8;
            c := pi[x];
            c := convertcolor(c, pixelmode_source);
            c := b_w(c);
            b8 := (b8 shl 1) or Byte(c);
         end;
  {
          if CheckBox3.Checked then begin
            c := b8 xor $FF;
          end;
  }
          pd^ := b8;
          inc(pd);
        end;
       end;
      end;
      ps := @pi[linelength4];
    end;
  end;
  FreeMem(Image, ImageSize);
  FreeMem(Info, InfoSize);
end;

[corpsman]

@mmschnell

sag mal kann es sein das dein Post eigentlich die Antwort auf : http://www.lazarusforum.de/viewtopic.php?f=25&t=3836" onclick="window.open(this.href);return false; ist ?

[mschnell]

genau !
Gut, dass Du es gefunden hast. Hoffentlich hilft's.
-Michael

[willi4willi]

Ja, die Überlegung von corpsman scheint zu stimmen. Allerdings wird nicht beides angezeigt, sondern es passiert schlichtweg garnichts.

Ich habe also das "DoOnPaint" mit in deine Funktion hineingenommen und bin mit dem Ergebnis zufrieden:

Code: Alles auswählen

Function OpenGLToBitmap(OpenGLControl : TOpenGLControl): TBitmap;
    Var
      dim: Array[0..3] Of Integer;
      c: Array Of Array[0..3] Of Byte;
      z, i, j: integer;
      TempIntfImg: TLazIntfImage;
      ImgHandle, ImgMaskHandle: HBitmap;
      CurColor: TFPColor;
    Begin
      openGLControl.DoOnPaint;
      // AUslesen der Framebuffer Auflösung
      glGetIntegerv(GL_VIEWPORT, @dim[0]);
      // Erstellen des Bitmaps
      result := TBitmap.create;
   ......
   ......

Vielen Dank nochmals für die Unterstützung!