我有一个对象,包括一个TFrame,一个TPanel,一个T
Image.位图被分配给包含钢琴卷的timage.此框架对象放在timage上,其中包含包含网格的图像.参见图片举例.
问题：是否可以使框架部分透明,使包含网格(主窗体)的背景图像显得模糊不清？理想情况下,用户可以设置透明度.位图是32位深,但是使用alpha通道进行实验没有帮助.小组没有必要.它用于快速地在对象周围有一个边框.我可以在图像上画.
更新1添加了一个小代码示例.主体用垂直线绘制背景.第二个单位包含一个TFrame和一个描绘水平线的timage.我想看到的是,垂直线通过TFrame Image部分闪耀.
更新2在我的原始问题中没有指出什么：TFrame是一个更大的应用程序的一部分,并且是独立的.如果透明度问题可以由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,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.
更新3我希望有一些消息或API调用将导致一个解决方案,控件可以使自己部分透明,就像WMEraseBkGnd消息完全透明.在他们的解决方案中,Sertac和NGLN都指出通过AlphaBlend功能模拟透明度.该函数合并两个位图,因此需要了解背景图像.现在我的TFrame有一个额外的属性：BackGround：由父控件分配的timage.这给了所期望的结果(这是非常专业看到它工作:-)
RRUZ指向Graphics32库.我看到它产生了很棒的结果,对我来说,学习曲线太陡了.
感谢大家的帮助！
解决方法
这是另一种将背景图像复制到顶部图像的解决方案,并且AlphaBlacement将位图覆盖,同时保持黑点的不透明度：
单元1：
unit Unit1;
interface
uses
Windows,Unit2,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.
单元2：
unit Unit2;
interface
uses
Windows,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,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,$FF);
Pixel.rgbRed := MulDiv(Pixel.rgbRed,$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,Image2.Picture.Bitmap.Width,Image2.Picture.Bitmap.Height,Bmp.Canvas.Handle,Bmp.Width,Bmp.Height,BlendFunction);
finally
Bmp.Free;
end;
end;
end;
end.
发射时间：
应用透明度