TImage transparent auf Panel mit Image zeichnen

[gbl123]

Hallo,

Der Titel klingt kompliziert.

Ich habe hier ein TPanel in dem ein TImage mit einem Bitmap dargestellt wird. Das funktioniert auch wunderbar.
Ein anderes TImage-Objekt soll nun transparent darübergelegt werden.

Wie kann ich das "Transparent-Zeugs" programmieren? Ich stehe komplett daneben.


BTW: Soll unter Windows laufen.

LG
Günter

[theo]

Mit Alpha Transparenten PNG müsste das eig. gehen.
Probier mal z.B. das drüber zu legen: http://wowslider.com/sliders/demo-1/dat ... erfly1.png
Welche Lazarus Version hast du?

[Michl]

Beispiel anbei (solange du die rechte Maustaste drückst, wird an dieser Stelle ein verkleinertes Picture darübergezeichnet):

Code: Alles auswählen

  TForm1 = class(TForm)
...
  private
    Pic: TPicture;
    FShowPic: Boolean;  
...
procedure TForm1.FormCreate(Sender: TObject);
begin
  Image1.Picture.LoadFromFile('PNG_transparency_demonstration_1.png');
  Image1.Stretch:=True;
  Pic:=TPicture.Create;
  Pic.LoadFromFile('PNG_transparency_demonstration_1.png');
  Doublebuffered:=True;
  FShowPic:=False;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  Pic.Free;
end;
 
procedure TForm1.Image1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbRight then FShowPic:=True;
end;
 
procedure TForm1.Image1MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  if FShowPic then Repaint;
end;
 
procedure TForm1.Image1MouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  FShowPic:=False;
  Repaint;
end;
 
procedure TForm1.Image1Paint(Sender: TObject);
var
  MouseP: TPoint;
  aRect: TRect;
begin
  if FShowPic then begin
    MouseP:=Mouse.CursorPos;
    MouseP:=Image1.ScreenToClient(MouseP);
    aRect.Left   := MouseP.x - ClientWidth div 4;
    aRect.Top    := MouseP.y - ClientHeight div 4;
    aRect.Right  := MouseP.x + ClientWidth div 4;
    aRect.Bottom := MouseP.y + ClientHeight div 4;
    Image1.Canvas.StretchDraw(aRect, Pic.Bitmap);
  end;
end;   

[gbl123]

Danke für Eure Antworten.

Hier mein Minimal-Bauspiel mit dem "Windows" Problem.
Unter Linux scheint es wie dokumentiert zu funktionieren.

Ich verwende Lazarus V1.2.6

Im Beispiel ist am Form1 ein Panel1 mit "beliebiger" Größe.


LG
Günter

Code: Alles auswählen

 
 unit Unit1;
 
{$mode objfpc}{$H+}
 
interface
 
uses
   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls;
 
type
 
	 { TForm1 }
 
   TForm1 = class(TForm)
			Panel1: TPanel;
			procedure FormCreate(Sender: TObject);
   private
      { private declarations }
   public
      { public declarations }
   end;
 
var
   Form1: TForm1;
 
implementation
 
{$R *.lfm}
 
{ TForm1 }
 
procedure TForm1.FormCreate(Sender: TObject);
var Img1, Img2: TImage;
    bmp1, bmp2: TBitmap;
begin
  // Image1 erzeugen = Hintergrund
  Img1:=TImage.Create(Panel1);
  Img1.Parent:=Panel1;
  Img1.Align:=alClient;
 
  // Bitmap in grün
  bmp1:=TBitmap.Create;
  bmp1.PixelFormat:=pf32bit;
  bmp1.SetSize(Panel1.Width, Panel1.Height);
  bmp1.Canvas.Brush.Color:=clgreen;
  bmp1.Canvas.FillRect(0, 0, Panel1.Width, Panel1.Height);
 
  // Bitmap zuweisen
  Img1.Picture.Bitmap.Assign(bmp1);
 
 
  // --- Überlagerung ----------------------------------------------------------
 
 
  Img2:=TImage.Create(Panel1);
  Img2.Parent:=Panel1;
  Img2.BringToFront;
  Img2.Align:=alNone;
  Img2.Top:=10;
  Img2.Left:=10;
  Img2.Width:=Panel1.Width-2*10;
  Img2.Height:=Panel1.Height-2*10;
 
  // Bitmap Transparent
  bmp2:=TBitmap.Create;
  bmp2.PixelFormat:=pf32bit;
  bmp2.SetSize(Panel1.Width, Panel1.Height);
  bmp2.Canvas.Brush.Color:=clFuchsia;
  bmp2.Canvas.FillRect(0, 0, Img2.Width, Img2.Height);
  bmp2.Canvas.Pen.Width:=7;
  bmp2.Canvas.Pen.Style:=psSolid;
  bmp2.Canvas.Line(0, 0, Img2.Width, Img2.Height);
  bmp2.Canvas.Line(0, Img2.Height, Img2.Width, 0);
  {
  bmp2.TransparentMode:=tmFixed;
  bmp2.TransparentColor:=clFuchsia;
  bmp2.Transparent:=true;
  }
 
  // Bitmap zuweisen
  Img2.Picture.Bitmap.Assign(bmp2);
 
  // Transparent Mode einschalten. Reihenfolge ist wichtig
  {$ifdef linux}
  // Linux Mint 17.1 - OK
  Img2.Picture.Bitmap.TransparentMode:=tmFixed;
  Img2.Picture.Bitmap.TransparentColor:=clFuchsia;
  Img2.Picture.Bitmap.Transparent:=true;
  Img2.Transparent:=true;
  {$endif}
  {$ifdef windows}
  // Windows 7 - Nicht OK - Nicht transparent
  Img2.Picture.Bitmap.TransparentMode:=tmFixed;
  Img2.Picture.Bitmap.TransparentColor:=clFuchsia;
  Img2.Picture.Bitmap.Transparent:=true;
  Img2.Picture.Graphic.Transparent:=true;
  Img2.Transparent:=true;
  {$endif}
 
 
  // Nun sollte Img2 über Img1 liegen und transparent sein
end;
 
end.
 

[Mathias]

Ich hatte auch lange mit TBitmap und Alpha-Kanal gekämpft, alles ohne Erfolg.

Als Alternative habe ich die Komponente BGRABitmap verwendet, welche auch hervorragend funktionierte.

http://wiki.freepascal.org/BGRABitmap/de

[magnetron]

Hallo,
dieselben Probleme hatte ich auch und konnte sie nur mit TBitmap nicht in den Griff bekommen.
Auch hatte ich unter QT andere Resultate als unter gtk.
Meine Erfahrung mit TLazIntfImage ist dafür hervorragend.
Der Arbeitsablauf ist auch im wiki beschrieben, im Prinzip
Bitmap --> Lazintfimage --> Alphablending etc etc. --> Bitmap
Mit BGRA kenne ich mich nicht aus, LazIntfImage kann ich aber als Lösung empfehlen.

Es treten dann nur noch ein paar kleine plattformabhängige Probleme auf, die aber schnell gelöst sind.
Zum Beispiel macht Windows den Hintergrund vollständig transparent, wenn man ein
Bitmap mit Transparanz darauf zeichnet. Sowas ist aber dann schnell gelöst.
Grüße, Stefan

[gbl123]

Danke Euch allen.

Ich werde mich wohl mit dem Gedanken anfreunden müssen, jene Klassen umschreiben zu müssen die von TImage abgeleitet wurden. Das wollte ich vermeiden.
Lg
Günter

[Michl]

Ich nutze kein Linux, kann daher nur unter Windows testen. Aber was ich nicht verstehe, warum es unbedingt ein TImage sein muss?! Willst du dessen Ereignisse nutzen? Beschreib doch mal genauer, was du erreichen willst.

[gbl123]

Hallo,

Es ist ein bestehendes Projekt welches unter Linux entwickelt wurde.
Hier werden zwei Klassen die ein Bitmap beinhalten übereinandergelegt.

Das untere (A) ist von TPanel abgeleitet und beinhaltet ein Bitmap welches im Panel dargestellt wird.
Im Programm kann es nun vorkommen, dass A für eine Klasse von TImage (B) das Parent ist.
TImage muss in Transparent sein, da das Bitmap von (A) noch sichtbar sein muss.

Unter Linux funktioniert die Software wie sie sein soll.
Unter Windows ist (B) nicht Transparent.

Umschreiben macht viel Arbeit, da auch die Events der Basisklassen verwendet werden sind (Drag Drop z.B.).


LG
Günter

[Michl]

Ich habe mal ein bischen rumprobiert. Das Problem unter Windows ist die Methode, wie du das Bitmap dem Image zuweist. Nimmst du statt "Assign" lieber "Draw" funktioniert das auch unter Windows (zumindest bei mir):

Code: Alles auswählen

procedure TForm1.FormCreate(Sender: TObject);
var
  Img1, Img2: TImage;
  bmp1, bmp2: TBitmap;
begin
  // Image1 erzeugen = Hintergrund
  Img1:=TImage.Create(Panel1);
  Img1.Parent:=Panel1;
  Img1.Align:=alClient;
 
  // Bitmap in grün
  bmp1:=TBitmap.Create;
  bmp1.PixelFormat:=pf32bit;
  bmp1.SetSize(Panel1.Width, Panel1.Height);
  bmp1.Canvas.Brush.Color:=clgreen;
  bmp1.Canvas.FillRect(0, 0, Panel1.Width, Panel1.Height);
 
  // Bitmap zuweisen
  Img1.Picture.Bitmap.Assign(bmp1);
 
 
  // --- Überlagerung ----------------------------------------------------------
 
 
  Img2:=TImage.Create(Panel1);
  Img2.Parent:=Panel1;
  Img2.BringToFront;
  Img2.Align:=alNone;
  Img2.Top:=10;
  Img2.Left:=10;
  Img2.Width:=Panel1.Width-2*10;
  Img2.Height:=Panel1.Height-2*10;
  Img2.Picture.Bitmap.Width:=Panel1.Width-2*10;
  Img2.Picture.Bitmap.Height:=Panel1.Height-2*10;
 
  // Bitmap Transparent
  bmp2:=TBitmap.Create;
  bmp2.PixelFormat:=pf32bit;
  bmp2.SetSize(Panel1.Width, Panel1.Height);
  bmp2.TransparentMode:=tmFixed;
  bmp2.TransparentColor:=clFuchsia;
  bmp2.Transparent:=true;
  bmp2.Canvas.Brush.Color:=clFuchsia;
  bmp2.Canvas.FillRect(0, 0, Img2.Width, Img2.Height);
  bmp2.Canvas.Pen.Width:=7;
  bmp2.Canvas.Pen.Style:=psSolid;
  bmp2.Canvas.Line(0, 0, Img2.Width, Img2.Height);
  bmp2.Canvas.Line(0, Img2.Height, Img2.Width, 0);
 
  // Transparent Mode einschalten. Reihenfolge ist wichtig
  {$ifdef linux}
  // Linux Mint 17.1 - OK
  Img2.Picture.Bitmap.Assign(bmp2);
  Img2.Picture.Bitmap.TransparentMode:=tmFixed;
  Img2.Picture.Bitmap.TransparentColor:=clFuchsia;
  Img2.Picture.Bitmap.Transparent:=true;
  Img2.Transparent:=true;
  {$endif}
  {$ifdef windows}
  // Windows 7 - bei mir OK ;)
  Img2.Picture.Bitmap.Canvas.Draw(0, 0, bmp2);
  Img2.Transparent:=true;
  Img2.Picture.Bitmap.TransparentColor:=clFuchsia;
  {$endif}    
 
end;

[magnetron]

Hallo,

geht das wirklich ? Ich hätte vermutet, dass man auf den Hintergrund des TImage keinen Einfluss hat und Komponenten
einen eigenen (nicht-transparenten) Hintergrund haben.
Daher ein Workaround als Idee den Hintergrund in das Img2 zu kopieren (oder das Img auf dem Img1 darzustellen).

Ich habe ersteres gemacht, was in gtk2 wieder zu Problemen führt - besser vielleicht den Hintergrund im Img2 darstellen.
Wenn alles nichts Hilft dann beide übereinanderliegenden Bitmaps nicht vom OS mergen lassen sondern
selbst mit dem LazIntfImage überlagern. Dann gehts ganz sicher.

Anbei Idee zur Verwendung. Geht so erstmal unter QT, für den Rest eben anpassen und so wie es ist als Idee verstehen.

Grüße, Stefan

Code: Alles auswählen

 
unit Unit1;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  IntfGraphics, FPimage;
 
type
 
   { TForm1 }
 
  TForm1 = class(TForm)
        Panel1: TPanel;
        procedure FormCreate(Sender: TObject);
  private
     FMarkerImage: TLazIntfImage;
     { private declarations }
  public
     { public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.lfm}
 
{ TForm1 }
 
procedure TForm1.FormCreate(Sender: TObject);
var Img1, Img2: TImage;
   bmp1, bmp2: TBitmap;
   vBackgroundColor: TColor;
   vFPColor: TFPColor;
   vCol, vRow: Integer;
   vTempBMP: TBitMap;
begin
 // Image1 erzeugen = Hintergrund
 Img1:=TImage.Create(Panel1);
 Img1.Parent:=Panel1;
 Img1.Align:=alClient;
 
 // Bitmap in grün
 bmp1:=TBitmap.Create;
 bmp1.PixelFormat:=pf32bit;
 bmp1.SetSize(Panel1.Width, Panel1.Height);
 bmp1.Canvas.Brush.Color:=clgreen;
 bmp1.Canvas.FillRect(0, 0, Panel1.Width, Panel1.Height);
 //
 // Bitmap zuweisen
 Img1.Picture.Bitmap.Assign(bmp1);
 
 
 // --- Überlagerung ----------------------------------------------------------
 
 
 Img2:=TImage.Create(Panel1);
 Img2.Parent:=Panel1;
 Img2.BringToFront;
 Img2.Align:=alNone;
 Img2.Top:=10;
 Img2.Left:=10;
 Img2.Width:=Panel1.Width-2*10;
 Img2.Height:=Panel1.Height-2*10;
 
 // Bitmap Transparent
 
 bmp2:=TBitmap.Create;
 bmp2.PixelFormat:=pf32bit;
 bmp2.SetSize(Img2.Width, Img2.Height);      //!!  war Panel.width/height !!
 bmp2.Canvas.Brush.Color:=clFuchsia;
 bmp2.Canvas.FillRect(0, 0, Img2.Width, Img2.Height);
 bmp2.Canvas.Pen.Width:=7;
 bmp2.Canvas.Pen.Style:=psSolid;
 bmp2.Canvas.Line(0, 0, Img2.Width, Img2.Height);
 bmp2.Canvas.Line(0, Img2.Height, Img2.Width, 0);
 
 
  vBackgroundColor := clFuchsia;
  IF FMarkerImage <> nil then FMarkerImage.Free;
  FMarkerImage := bmp2.CreateIntfImage;
  for vRow:=0 to FMarkerImage.Height-1 do
    for vCol:=0 to FMarkerImage.Width-1 do begin
      vFPColor := FMarkerImage.Colors[vCol, vRow];
      if FPColorToTColor(vFPColor) = vBackgroundColor then
        vFPColor.alpha := alphaTransparent
      else vFPColor.alpha := alphaOpaque; // AFPColor.alpha; // $7FFF;
      FMarkerImage.Colors[vCol, vRow] := vFPColor;
    end;
  bmp2.LoadFromIntfImage(FMarkerImage);
 
 
 {$ifdef linux}
 Img1.Canvas.CopyRect(Rect(Img2.Left,Img2.Top, Img2.Left+Img2.Width, Img2.Top+Img2.Height), bmp2.Canvas, Bounds(0,0,bmp2.Width, bmp2.Height));
 // entweder... oder...
 //Img1.Canvas.Draw(Img2.Left,Img2.Top, bmp2);
 {$endif}
 
 {$ifdef windows}
 // Windows 7 - Nicht OK - Nicht transparent
 Img1.Canvas.CopyRect(Rect(Img2.Left,Img2.Top, Img2.Left+Img2.Width, Img2.Top+Img2.Height), bmp2.Canvas, Bounds(0,0,bmp2.Width, bmp2.Height));
 //Img1.Canvas.Draw(Img2.Left,Img2.Top, bmp2);
   {
    Note: vermutlich muss der Hintergrund ebenso über den Umweg LazIntfImage MIT Transparanzinformation
    gezeichnet werden. Mein Windows macht den Hintergrund 100% transparent, sobald ein bmp mit
    Transparenz darauf gezeichnet wird.
    Hat der Hintergrund selbst bereits Transparanzinformation (beim Füllen), dann passt alle
    }
 {$endif}
 
 
 // Nun sollte Img2 über Img1 liegen und transparent sein
 // Im Beispiel habe ich den Inhalt von bmp2 in das Img1 gemalt.
 // Je nach Anwendungsfall geht das auch umgekehrt..
end;
 
end.  

[Michl]

Zumindest geht es bei mir (mit Lazarus 1.4.0 und Lazarus Trunc getestet) unter Windows 7 64bit, Lazarus 32bit.

Den Umweg über TLazIntfImage bin auch zuerst gegangen, hatte dies aber immer weiter reduziert, bis ich endlich festgestellt hatte, dass es hier nur an dem "Assign" gescheitert ist. Keine Ahnung, ob man dies mal als Feature-Request im Bugtracker vermerken sollte?