2012-05-22 19 views
9

Tengo un objeto que consiste en un TFrame, en él un TPanel y en eso un TImage. Se asigna un mapa de bits al TImage que contiene un piano roll. Este objeto de marco se pone en un TImage, que contiene una imagen que contiene una cuadrícula. Vea la imagen para un ejemplo.¿Cómo hacer que un TFrame (y todo lo que contiene) sea parcialmente transparente?

enter image description here

Pregunta: ¿Es posible hacer el marco parcialmente transparente, de modo que la imagen de fondo que contiene la cuadrícula (en el formulario principal) es 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 que había esperado que habría algún mensaje o llamada API que daría lugar a una solución que el control podría hacerse parcialmente transparente, al igual que el mensaje WMEraseBkGnd hace por una transparencia total. En sus soluciones, tanto Sertac como NGLN apuntan a simulando 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 asignada por el control principal. Eso le da el resultado deseado (es tan profesional verlo funcionar :-)

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

¡Gracias a todos por su ayuda!

+1

Lo que está buscando generalmente se resuelve usando capas, intente utilizar la biblioteca [Graphics32] (http://sourceforge.net/projects/graphics32/) que admite capas. – RRUZ

+0

¿Hay 2 TImages? –

+0

@RRUZ, he intentado varias veces entender Graphics32, pero es demasiado difícil para mí. Esperaba que hubiera una solución comprensible para mí :-) – Arnold

Respuesta

7

Aquí hay otra solución que copia la imagen de fondo a la tapa y AlphaBlend s el mapa de bits sobre el mismo tiempo que se preserva la opacidad de puntos negros:

unidad1:

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. 


En el momento del lanzamiento:
enter image description here
aplicar la transparencia:
enter image description here

+0

¡Esto es exactamente lo que quería tener! Pero aquí también con la solución de NGLN: la función AlphaBlend parece tener que conocer ambos mapas de bits mientras que en mi aplicación el TFrame no está al tanto de su entorno. – Arnold

+1

@Arnold - El código anterior no utiliza el mapa de bits de fondo, sino que lo copia del fondo TImage. Pero lo mismo no es cierto para el mapa de bits superior, debe tener una copia original para poder aplicar diferentes niveles de transparencias a AlphaBlend. No puedo pensar en otra manera de cumplir sus requisitos, pero utilizar AlphaBlend .. –

+0

Si el mapa de bits de origen es de 32 bits, TCanvas.Draw (de ese mapa de bits) usará AlphaBlend, por lo que probablemente pueda simplemente usar Draw sin tener que usar un BlendFunc o llamadas API, etc., simplemente estableciendo las propiedades del mapa de bits. –

8

Oculte el marco y use 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 bastidor:

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:

Partial transparent frame

reescribir el anterior para su situación específica, pintura idealmente en un TPaintBox desembarazarse del componente de imagen en la forma 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.

+0

Impresionante, intentaré esto por la noche. Una desventaja que veo es que esta solución requiere que el TFrame "conozca" el mapa de bits subyacente. No hay forma de eludir eso? – Arnold

+0

@Arnold No, el marco no tiene conocimiento de la imagen en el formulario. Tenga en cuenta que mi unidad de marco no tiene ningún código, la pintura se gestiona en la unidad de formulario principal. – NGLN

2

Yo usaría un TPaintBox lugar. En su evento OnPaint, dibuje primero su cuadrícula y luego combine alfabéticamente su imagen de rodillo en la parte superior. No es necesario utilizar ninguno de los componentes TImage, TPanel ni TFrame.

Cuestiones relacionadas