Elemente auf Bitmaps, das aus Clipboard kommt

[jrx]

Wenn ich ein Bitmap aus dem Clipboard hole, ergeben sich für mich nicht erwartete Probleme.

Der Quelltext ist unten.

Wenn nichts im Clipboard drin ist, dann schreibt es den Text und zeichnet die Linie in den vorgegebenen Farben.
Wenn ein Bild drin ist, wird dieses gezeichnet, aber der Text und die Linie sind nur in der Hintergrundfarbe (wenn überhaupt) zu erkennen.
Canvas.Font.Color und canvas.Pen.Color werden nun nicht mehr berücksichtigt.

Wo ist mein Denkfehler?
Danke jrx

Code: Alles auswählen

 
unit unit1;
{$mode objfpc}{$H+}
interface
 
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  Buttons, StdCtrls, Clipbrd;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
{$R *.lfm}
{ TForm1 }
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  with  Image1.Picture.Bitmap do
  begin
    Width := 120;
    Height := 120;
    if (Clipboard.HasFormat(CF_BITMAP)) or (Clipboard.HasFormat(CF_PICTURE)) then
      Assign(Clipboard);
    Canvas.Brush.Color := clRed;
    Canvas.Pen.Color := clGreen;
    Canvas.Font.Color := clblue;
    Canvas.TextOut(10, 10, 'test');
    Canvas.Line(0, 0, 120, 100);
  end;
end;
 
end.                                     
 

[Mathias]

Ich habe es gerade getestet, und es funktioniert wie erwartet.

Vielleicht liegt es daran, das ich Linux verwende.

[Marsmännchen]

Vielleicht liegt es daran, das ich Linux verwende.

Das wundert mich. Ich habe mir Clipbrd gerade mal angesehen und im Wiki steht, dass es nur für Windows-Clipboard gedacht ist. Ich hatte sogar schon überlegt zu fragen, ob es eine bs-unabhängige Clipboardvariante in Lazarus gibt...

[Mathias]

dass es nur für Windows-Clipboard gedacht ist. I

Wieso nur für Windows ?
Bei mir funktioniert es ja unter Linux.

[Marsmännchen]

Naja, ich hab hier geschaut: http://wiki.lazarus.freepascal.org/Clipboard/de

Und da steht´:

Dieser Artikel beschäftigt sich mit der Windowsprogrammierung.

Kann es sein, dass die deutsche Übersetzung fehlerhaft oder veraltet ist? Ich hab jetzt mal in den englischen Text gesehen und der schreibt erst viel später was von Windows

[Michl]

Wo ist mein Denkfehler?

Ein Denkfehler ist es nicht aber ein bekanntes Problem. Ein Canvas wird on Demand erstellt und steht damit nicht immer gleich zur Verfügung. Ein Umweg über ein TPicture geht zum Beispiel (zumindest bei mir):

Code: Alles auswählen

procedure TForm1.Button1Click(Sender: TObject);
var
  aPicture: TPicture;
begin
  aPicture := TPicture.Create;
  try
    if (Clipboard.HasFormat(CF_BITMAP)) or (Clipboard.HasFormat(CF_PICTURE)) then
      aPicture.Bitmap.Assign(Clipboard);
    Image1.Picture.Bitmap.SetSize(120, 120);
    Image1.Picture.Bitmap.Canvas.Draw(0, 0, aPicture.Bitmap);
    Image1.Picture.Bitmap.Canvas.Brush.Color := clRed;
    Image1.Picture.Bitmap.Canvas.Pen.Color := clGreen;
    Image1.Picture.Bitmap.Canvas.Font.Color := clblue;
    Image1.Picture.Bitmap.Canvas.TextOut(10, 10, 'test');
    Image1.Picture.Bitmap.Canvas.Line(0, 0, 120, 100);
  finally
    aPicture.Free;
  end;
end;  

[jrx]

Vielen Dank.
Das klappt jetzt auch bei mir.

[wp_xyz]

Ein Canvas wird on Demand erstellt und steht damit nicht immer gleich zur Verfügung. Ein Umweg über ein TPicture geht zum Beispiel (zumindest bei mir)...

Michl, kannst du das etwas näher erläutern? Ich selbst habe massive Probleme mit dem Zeichnen auf dem Canvas von Bitmaps etc. Folgender Code soll auf dem Lazarus-Cheetah eine rote Linie ausgeben, sie wird aber weiß:

Code: Alles auswählen

const
  FILENAME = 'C:\lazarus\images\splash_source\cheetah.jpg';
procedure TForm1.Button3Click(Sender: TObject);
var
  jpg: TJpegImage;
  bmp: TBitmap;
begin
  bmp := TBitmap.Create;
  try
    jpg := TJpegImage.Create;
    try
      jpg.LoadFromFile(FILENAME);
      bmp.Assign(jpg);
    finally
      jpg.Free;
    end;
    bmp.Canvas.Pen.Color := clRed;
    bmp.Canvas.MoveTo(0, 0);
    bmp.Canvas.LineTo(100, 100);    // Linie erscheint, wird aber weiß  (In Delphi ist sie rot!)
    Image1.Picture.Bitmap.Assign(bmp);
  finally
    bmp.Free;
  end;
end; 

Zeichne ich dagegen zuerst das jpg ins Bitmap (ohne "Assign"), so wie von dir oben vorgeschlagen, ist alles in Ordnung.

Code: Alles auswählen

procedure TForm1.Button4Click(Sender: TObject);
var
  jpg: TJpegImage;
  bmp: TBitmap;
begin
  bmp := TBitmap.Create;
  try
    jpg := TJpegImage.Create;
    try
      jpg.LoadFromFile(FILENAME);
      bmp.SetSize(jpg.Width, jpg.Height);
      bmp.Canvas.Draw(0, 0, jpg);
    finally
      jpg.Free;
    end;
    bmp.Canvas.Pen.Color := clRed;
    bmp.Canvas.MoveTo(0, 0);
    bmp.Canvas.LineTo(100, 100);   // Linie ist rot
    Image1.Picture.Assign(bmp);
  finally
    bmp.Free;
  end;
end;

Was ist falsch an Assign? Übrigens, in Delphi kommt bei beiden Malen eine rote Linie.

Wenn statt einem jpg ein png geladen wird, erscheint im ersten Fall (bmp.Assign(png)) gar keine Linie (wahrscheinlich transparent, vermutlich weil der Alpha-Wert bei clRed 0 ist ?), im zweiten Fall (bmp.Canvas.Draw(0, 0, png) hat man die rote Linie, allerdings geht die Transparenz verloren, der Hintergrund ist schwarz. Delphi verhält sich ähnlich (nur dass der transparente Hintergrund im zweiten Fall durch weiß ersetzt wird). Wie könnte man auf einem Canvas mit Alpha-Kanal zeichnen, ohne dass die Transparenz verloren geht?

[Michl]

Falsch is Assign nicht, allerdings werden dabei alle zuvor vorhandenen Informationen vom TBitmap entfernt (es wird ein neues TBitmap erstellt). Daher hilft es auch nicht, wie sonst öfters vorgeschlagen, ein bmp.Canvas.Clear oder bmp.Canvas.FillRect(0, 0, bmp.Width, bmp.Height) vor der gewünschten Zeichenopertaion durchzuführen.

Wahrscheinlich müsste man mal dieses Thema intensiver checken. Es gibt Bugreports dazu (ein alter von mir z.B. auch http://bugs.freepascal.org/view.php?id=25448).

Wie könnte man auf einem Canvas mit Alpha-Kanal zeichnen, ohne dass die Transparenz verloren geht?

Unter Windows überhaupt nicht, da ein natives Canvas verwendet wird. Hier kann man diverse Umwege nutzen (fpImage, LazIntfImage, BGRABitmap oder OpBitmap, etc. oder man hackt den Alphakanal http://www.lazarusforum.de/viewtopic.php?f=18&t=9643 - man muss aber aufpassen, in welcher Reihenfolge r,g,b,a vorliegen, diese Info müsste man aus dem bmp.RawImage.Description.AlphaShift (.RedShift, .GreenShift, .BlueShift) holen).
AFAIK, sobald man auf ein Canvas auf mit Alpha-Kanal besetztes Bitmap zugreift (das native Canvas erstellt wird), verliert das Bitmap unter Windows seine Transparenz (man müsste mal schauen, wie das in Delphi ist).

Eine Möglichkeit wäre, auf einem leeren Bitmap per Canvas zu zeichnen und dieses dann über das Bitmap mit dem Alphakanal legen (Alpha selber definieren). Einfacher und ohne diesen Umweg geht das natürlich mit einem Package, wie BGRABitmap.

[wp_xyz]

Falsch is Assign nicht, allerdings werden dabei alle zuvor vorhandenen Informationen vom TBitmap entfernt (es wird ein neues TBitmap erstellt).

Das ist mir klar. Aber ich setze hinterher die Pen-Farbe auf rot. Dass das nicht angenommen wird, erscheint mir ein Bug zu sein. Bei Delphi funktioniert's ja auch.

Wie könnte man auf einem Canvas mit Alpha-Kanal zeichnen, ohne dass die Transparenz verloren geht?

Unter Windows überhaupt nicht, da ein natives Canvas verwendet wird. Hier kann man diverse Umwege nutzen (fpImage, LazIntfImage, BGRABitmap oder OpBitmap, etc. oder man hackt den Alphakanal http://www.lazarusforum.de/viewtopic.php?f=18&t=9643 - man muss aber aufpassen, in welcher Reihenfolge r,g,b,a vorliegen, diese Info müsste man aus dem bmp.RawImage.Description.AlphaShift (.RedShift, .GreenShift, .BlueShift) holen).
AFAIK, sobald man auf ein Canvas auf mit Alpha-Kanal besetztes Bitmap zugreift (das native Canvas erstellt wird), verliert das Bitmap unter Windows seine Transparenz (man müsste mal schauen, wie das in Delphi ist).

Eine Möglichkeit wäre, auf einem leeren Bitmap per Canvas zu zeichnen und dieses dann über das Bitmap mit dem Alphakanal legen (Alpha selber definieren). Einfacher und ohne diesen Umweg geht das natürlich mit einem Package, wie BGRABitmap.

Wahrscheinlich ist die Frage zu allgemein gestellt. Hintergrund ist, dass ich für einen ToolButton für Farbwahl aus dem Farb-Dialog ein Icon so verändern möchte, dass die aktuell eingestellte Farbe als entsprechend eingefärbter Streifen unter einem Pinsel oder Farbeimer erscheint, so wie z.B. in Excel. Dazu wollte ich das png-Bildchen an der Stelle des Farbstreifens einfach entsprechend übermalen. LazIntfImage ist ein guter Tip, das muss ich mal ausprobieren; BGRABitmap und OpBitmap möchte ich nicht verwenden, weil ich keine weiteren Drittkomponenten reinholen möchte.

[EDIT]
LazIntfImage war ein guter Tipp, damit geht das Herumpinseln in dem Icon mit ein paar Zeilen Code (geht sicher auch noch einfacher):

Code: Alles auswählen

procedure TForm1.Button7Click(Sender: TObject);
var
  png: TPortableNetworkGraphic;
  lazintfimg: TLazIntfImage;
  i,j: Integer;
begin
  png := TPortableNetworkGraphic.Create;
  try
    png.LoadFromFile('border-color.png');
    lazintfimg := png.CreateIntfImage;
    try
      for j:=lazintfimg.Height-3 to lazintfimg.Height-1 do
        for i := 0 to lazintfimg.Width-1 do
          lazintfimg.Colors[i,j] := colBlue;
      png.LoadFromIntfImage(lazintfimg);
    finally
      lazintfimg.Free;
    end;
    //png.saveToFile('d:\test.png');
    Image1.Picture.Png.Assign(png);
  finally
    png.Free;
  end;
end;