Come rendere un TFrame (e qualsiasi cosa su di esso) parzialmente trasparente?

Question

Ho un oggetto costituito da TFrame, su di esso un TPanel e su quello a TImage. Una bitmap è assegnata allo TImage contenente un rullo di pianoforte. Questo oggetto frame viene inserito in un TImage, contenente un'immagine che contiene una griglia. Guarda l'immagine per un esempio.

Domanda: E 'possibile rendere il telaio parzialmente trasparente, in modo che l'immagine di sfondo contenente la griglia (nella maschera principale) è vagamente visibile? Idealmente la quantità di trasparenza può essere impostata dall'utente. La bitmap ha una profondità di 32 bit, ma la sperimentazione con il canale alfa non ha aiutato. Il pannello non è strettamente necessario. È usato per avere rapidamente un bordo attorno all'oggetto. Potrei disegnarlo sull'immagine.

Aggiornamento 1 Viene aggiunto un esempio di codice ridotto. L'unità principale disegna uno sfondo con linee verticali. La seconda unità contiene una TFrame e una TImage su di essa che disegna una linea orizzontale. Quello che mi piacerebbe vedere è che le linee verticali brillano parzialmente attraverso l'immagine TFrame.

Aggiornamento 2 Cosa non ho specificato nella mia domanda iniziale: il TFrame fa parte di un'applicazione molto più grande e si comporta in modo indipendente. Sarebbe utile se il problema della trasparenza potesse essere gestito dalla TFrame stessa.

///////////////// Main unit, on mouse click draw lines and plot TFrame 
unit Unit1; 

interface 

uses 
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
    Dialogs, ExtCtrls, 
    Unit2; 

type 
    TForm1 = class(TForm) 
    Image1: TImage; 
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 
    end; 

var 
    Form1: TForm1; 

implementation 

{$R *.dfm} 

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 
var background: TBitmap; 
    f: TFrame2; 
    i, c: Int32; 
begin 
    background := TBitmap.Create; 
    background.Height := Image1.Height; 
    background.Width := Image1.Width; 
    background.Canvas.Pen.Color := clBlack; 

    for i := 0 to 10 do 
    begin 
     c := i * background.Width div 10; 
     background.Canvas.MoveTo (c, 0); 
     background.Canvas.LineTo (c, background.Height); 
    end; 
    Image1.Picture.Assign (background); 
    Application.ProcessMessages; 

    f := TFrame2.Create (Self); 
    f.Parent := Self; 
    f.Top := 10; 
    f.Left := 10; 
    f.plot; 
end; 

end. 

///////////////////Unit containing the TFrame 
unit Unit2; 

interface 

uses 
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
    Dialogs, ExtCtrls; 

type 
    TFrame2 = class(TFrame) 
    Image1: TImage; 

    procedure plot; 
    end; 

implementation 

{$R *.dfm} 

procedure TFrame2.plot; 
var bitmap: TBitmap; 
begin 
    bitmap := TBitmap.Create; 
    bitmap.Height := Image1.Height; 
    bitmap.Width := Image1.Width; 
    bitmap.PixelFormat := pf32Bit; 
    bitmap.Canvas.MoveTo (0, bitmap.Height div 2); 
    bitmap.Canvas.LineTo (bitmap.Width, bitmap.Height div 2); 
    Image1.Picture.Assign (bitmap); 
end; 

end. 

Update 3 avevo sperato che ci sarebbe qualche messaggio o API chiamata che comporterebbe una soluzione che il controllo potrebbe rendersi parzialmente trasparente, come il messaggio WMEraseBkGnd fa completa trasparenza. Nelle loro soluzioni, sia Sertac che NGLN puntano entrambi a simulando la trasparenza con la funzione AlphaBlend. Questa funzione unisce due bitmap e quindi richiede una conoscenza dell'immagine di sfondo. Ora la mia TFrame ha una proprietà aggiuntiva: BackGround: TImage assegnata dal controllo principale. Ciò dà il risultato desiderato (è talmente professionale vederlo funzionare :-)

RRUZ punta alla libreria Graphics32. Quello che ho visto produce risultati fantastici, per me la curva di apprendimento è troppo ripida.

Grazie a tutti per il vostro aiuto!

Answer 1

Ecco un'altra soluzione che copia l'immagine di sfondo per l'immagine in alto e AlphaBlend s la bitmap su di esso, mantenendo l'opacità di punti neri:

unit1:

unit Unit1; 

interface 

uses 
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
    Dialogs, Unit2, ExtCtrls, ComCtrls, StdCtrls; 

type 
    TForm1 = class(TForm) 
    Clip_View1: TClip_View; 
    TrackBar1: TTrackBar; 
    Label1: TLabel; 
    procedure TrackBar1Change(Sender: TObject); 
    procedure FormCreate(Sender: TObject); 
    end; 

var 
    Form1: TForm1; 

implementation 

{$R *.dfm} 

procedure TForm1.FormCreate(Sender: TObject); 
begin 
    TrackBar1.Min := 0; 
    TrackBar1.Max := 255; 
    TrackBar1.Position := 255; 
end; 

procedure TForm1.TrackBar1Change(Sender: TObject); 
begin 
    Label1.Caption := IntToStr(TrackBar1.Position); 
    Clip_View1.Transparency := TrackBar1.Position; 
end; 

end. 

unit2:

unit Unit2; 

interface 

uses 
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
    Dialogs, ExtCtrls, StdCtrls; 

type 
    TClip_View = class(TFrame) 
    Image1: TImage; 
    Panel1: TPanel; 
    Image2: TImage; 
    protected 
    procedure SetTransparency(Value: Byte); 
    private 
    FTopBmp: TBitmap; 
    FTransparency: Byte; 
    public 
    constructor Create(AOwner: TComponent); override; 
    destructor Destroy; override; 
    property Transparency: Byte read FTransparency write SetTransparency; 
    end; 

implementation 

{$R *.dfm} 

{ TClip_View } 

constructor TClip_View.Create(AOwner: TComponent); 
begin 
    inherited; 
    Image1.Left := 0; 
    Image1.Top := 0; 
    Image1.Picture.LoadFromFile(ExtractFilePath(Application.ExeName) + '..\..\back.bmp'); 
    Image1.Picture.Bitmap.PixelFormat := pf32bit; 
    Image1.Width := Image1.Picture.Bitmap.Width; 
    Image1.Height := Image1.Picture.Bitmap.Height; 

    FTopBmp := TBitmap.Create; 
    FTopBmp.LoadFromFile(ExtractFilePath(Application.ExeName) + '..\..\top.bmp'); 
    FTopBmp.PixelFormat := pf32bit; 
    Image2.SetBounds(1, 1, FTopBmp.Width, FTopBmp.Height); 
    Panel1.SetBounds(20, 20, Image2.Width + 2, Image2.Height + 2); 
    Image2.Picture.Bitmap.SetSize(Image2.Width, Image2.Height); 
    Image2.Picture.Bitmap.Canvas.Draw(0, 0, FTopBmp); 
end; 

destructor TClip_View.Destroy; 
begin 
    FTopBmp.Free; 
    inherited; 
end; 

procedure TClip_View.SetTransparency(Value: Byte); 
var 
    Bmp: TBitmap; 
    R: TRect; 
    X, Y: Integer; 
    Pixel: PRGBQuad; 
    BlendFunction: TBlendFunction; 
begin 
    if Value <> FTransparency then begin 
    FTransparency := Value; 
    R := Image2.BoundsRect; 
    OffsetRect(R, Panel1.Left, + Panel1.Top); 
    Image2.Picture.Bitmap.Canvas.CopyRect(Image2.ClientRect, 
              Image1.Picture.Bitmap.Canvas, R); 

    Bmp := TBitmap.Create; 
    Bmp.SetSize(FTopBmp.Width, FTopBmp.Height); 
    Bmp.PixelFormat := pf32bit; 
    Bmp.Assign(FTopBmp); 
    try 
     for Y := 0 to Bmp.Height - 1 do begin 
     Pixel := Bmp.ScanLine[Y]; 
     for X := 0 to Bmp.Width - 1 do begin 
      if (Pixel.rgbBlue <> 0) and (Pixel.rgbGreen <> 0) and 
       (Pixel.rgbRed <> 0) then begin 
      Pixel.rgbBlue := MulDiv(Pixel.rgbBlue, Value, $FF); 
      Pixel.rgbGreen := MulDiv(Pixel.rgbGreen, Value, $FF); 
      Pixel.rgbRed := MulDiv(Pixel.rgbRed, Value, $FF); 
      Pixel.rgbReserved := Value; 
      end else      // don't touch black pixels 
      Pixel.rgbReserved := $FF; 
      Inc(Pixel); 
     end; 
     end; 

     BlendFunction.BlendOp := AC_SRC_OVER; 
     BlendFunction.BlendFlags := 0; 
     BlendFunction.SourceConstantAlpha := 255; 
     BlendFunction.AlphaFormat := AC_SRC_ALPHA; 
     AlphaBlend(Image2.Picture.Bitmap.Canvas.Handle, 
      0, 0, Image2.Picture.Bitmap.Width, Image2.Picture.Bitmap.Height, 
      Bmp.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, 
      BlendFunction); 
    finally 
     Bmp.Free; 
    end; 
    end; 
end; 

end. 

Al momento del lancio:

applicare la trasparenza:

Answer 2

Nascondere il frame e utilizzare Frame.PaintTo. Ad esempio, come segue:

unit Unit1; 

interface 

uses 
    Windows, Classes, Graphics, Controls, Forms, Unit2, JPEG, ExtCtrls; 

type 
    TForm1 = class(TForm) 
    Image1: TImage; //Align = alClient, Visible = False 
    Frame21: TFrame2; //Visible = False 
    procedure FormPaint(Sender: TObject); 
    procedure FormCreate(Sender: TObject); 
    procedure FormResize(Sender: TObject); 
    private 
    FBlendFunc: TBlendFunction; 
    end; 

var 
    Form1: TForm1; 

implementation 

{$R *.dfm} 

{ TForm1 } 

procedure TForm1.FormPaint(Sender: TObject); 
var 
    Bmp: TBitmap; 
begin 
    Bmp := TBitmap.Create; 
    try 
    Bmp.Width := Frame21.Width; 
    Bmp.Height := Frame21.Height; 
    Frame21.PaintTo(Bmp.Canvas, 0, 0); 
    Canvas.StretchDraw(ClientRect, Image1.Picture.Graphic); 
    with Frame21 do 
     Windows.AlphaBlend(Canvas.Handle, Left, Top, Left + Width, Top + Height, 
     Bmp.Canvas.Handle, 0, 0, Width, Height, FBlendFunc); 
    finally 
    Bmp.Free; 
    end; 
end; 

procedure TForm1.FormCreate(Sender: TObject); 
begin 
    FBlendFunc.BlendOp := AC_SRC_OVER; 
    FBlendFunc.BlendFlags := 0; 
    FBlendFunc.SourceConstantAlpha := 255 div 2; 
    FBlendFunc.AlphaFormat := 0; 
end; 

procedure TForm1.FormResize(Sender: TObject); 
begin 
    Invalidate; 
end; 

end. 

L'unità di telaio:

unit Unit2; 

interface 

uses 
    Windows, Classes, Controls, Forms, JPEG, ExtCtrls; 

type 
    TFrame2 = class(TFrame) 
    Image1: TImage; //Align = alClient 
    Panel1: TPanel; //Align = alClient, BevelWidth = 5 
    end; 

implementation 

{$R *.dfm} 

end. 

Risultato:

riscrivere il sopra per la vostra situazione specifica, idealmente pittura su un TPaintBox liberandosi del componente immagine sul modulo principale. Ma quando l'unico elemento significativo del frame è l'immagine, allora smetterei di usarlo anche io e inizierò a dipingere tutto da solo.

Answer 3

userei un TPaintBox invece. Nel suo evento OnPaint, prima disegnare la griglia, quindi aggiungere alfa l'immagine del rullo in alto. Non è necessario utilizzare alcun componente TImage, TPanel o TFrame.