delphi - ¿Cómo hacer que un TFrame(y todo lo que contiene) sea parcialmente transparente?

bitmap transparency

Question

Tengo un objeto que consiste en un TFrame , en él un TPanel y en ese un TImage . Se asigna un mapa de bits al TImage contiene un piano roll. Este objeto marco se pone en un TImage , que contiene una imagen que contiene una grilla. Vea la imagen para un ejemplo.

Pregunta: ¿Es posible hacer que el marco sea parcialmente transparente, de modo que la imagen de fondo que contiene la cuadrícula (en el formulario principal) sea vagamente visible? Idealmente, la cantidad de transparencia puede ser establecida por el usuario. El mapa de bits tiene 32 bits de profundidad, pero la experimentación con el canal alfa no ayudó. El panel no es estrictamente necesario. Se usa para tener rápidamente un borde alrededor del objeto. Podría dibujar eso en la imagen.

Actualización 1 Se agrega un pequeño ejemplo de código. La unidad principal dibuja un fondo con líneas verticales. La segunda unidad contiene un TFrame y un TImage que dibuja una línea horizontal. Lo que me gustaría ver es que las líneas verticales brillan parcialmente a través de TFrame Image.

Actualización 2 Lo que no especifiqué en mi pregunta original: el TFrame es parte de una aplicación mucho más grande y se comporta de forma independiente. Ayudaría si la cuestión de la transparencia pudiera ser manejada por el propio TFrame.

///////////////// 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.

Actualización 3 Tenía la esperanza de que habría algún mensaje o llamada de API que daría lugar a una solución que el control podría hacerse parcialmente transparente, como el mensaje WMEraseBkGnd para la transparencia completa. En sus soluciones, tanto Sertac como NGLN apuntan a simular la transparencia con la función AlphaBlend. Esta función combina dos mapas de bits y, por lo tanto, requiere un conocimiento de la imagen de fondo. Ahora mi TFrame tiene una propiedad adicional: BackGround: TImage asignado por el control principal. Eso da el resultado deseado (es tan profesional verlo funcionando :-)

RRUZ apunta a la biblioteca Graphics32. Lo que he visto produce resultados fantásticos, para mí la curva de aprendizaje es demasiado empinada.

¡Gracias por toda tu ayuda!

Answer 1

Oculta el marco y usa Frame.PaintTo . Por ejemplo, de la siguiente manera:

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.

La unidad de marco:

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.

Resultado:

Reescriba lo anterior para su situación específica, idealmente pintando en un TPaintBox el componente de imagen en el formulario principal. Pero cuando el único elemento importante del marco es la imagen, entonces dejaría de usar eso también y comenzaría a pintar todo yo mismo.

Answer 2

Yo usaría un TPaintBox en TPaintBox lugar. En su evento OnPaint , dibuje primero su cuadrícula, luego mezcle alfabéticamente su imagen de rodillo en la parte superior. No es necesario utilizar ningún TImage , TPanel o TFrame en absoluto.

Answer 3

Aquí hay otra solución que copia la imagen de fondo a la imagen superior y AlphaBlend s el mapa de bits sobre ella mientras conserva la opacidad de los puntos negros:

unidad 1:

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.

unidad 2:

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.

En el momento del lanzamiento:

Aplicar transparencia: