半透明的panel,或者其他控件

Question

我想实现 image 前面 放一个 半透明的控件 在半透明的区域上面再打汉字，
已达到 美观的效果。这控件可以不是容器，只要能 体现 半透明就行了。如果 自带控件能满足最好，不行的话三方也行。我看了个 半透明的panel 可是 代码看不懂。。请高手们帮忙

Answer 1

FOrm就可以啊
把AlphaBlend属性设置为true
AlphaBlendValue值设置为一个小于255的值

Answer 2

如果你知道怎么自己写一个控件，就往下看
新建一个控件，继承 TCustomPanel类
然后分别加入以下属性：注意需要用到GDI+
TMyPanel = class(TCustomPanel)
private
  FAlphaValue : byte; //透明度
  FTrans  : Boolean;  //是否透明
  FTransColor : TColor;  //透明色
  Procedure DoTrans(FCanvas : TCanvas;Contorl : TWincontrol);
  Procedure DrawAlpha(aBitmap : TBitmap);
  procedure GetGpBitmap(FBmp : TBitmap; var GpImage : TGpBitmap);
  procedure SetAlphaValue(Const Value : byte);
  procedure SetTrans(const value : boolean);
  procedure SetTransColor(const Value : TColor);
public
  property AlphaValue : byte read FAlphaValue write SetAlphaValue;
  property Trans : Boolean read FTrans write SetTrans;
  property TransColor : TColor read FTransColor write SetTransColor;
proceted
  procedure Paint; override;
end;procedure paint;
  var Buf : TBitmap;
begin
  if FTrans then
  begin
    Buf := TBitmap.Create;
    Buf.Width := width; Buf.Height := height;
    DoTrans(Buf,Self);
    DrawAlpha(Buf);
    Bitblt(Canvas.Handle,0,0,width,height,Buf.Canvas.Handle,0,0,SRCCOPY);
    Buf.Free;
  end;
end;Procedure DoTrans(FCanvas : TCanvas;Contorl : TWincontrol);
  var DC : Hdc;SaveIndex :HDC; Position : Tpoint;
begin
  if Control.Parent <> nil then
  begin
    {$R-}
    Dc := FCanvas.Handle; SaveIndex := SaveDc(Dc);
    GetViewPortOrgEx(Dc,Position);
    SetViewPortOrgEx(Dc,Position.X - Control.Left,Position.Y - Control.Top,nil);
    InsertSectClipRect(Dc,0,0,Control.parent.clientwidth,Control.parent.clientheight);
    Control.Parent.perform(WM_ERASEBKGND,Dc,0);
    Control.Parent.Perform(WM_PAINT,DC,0);
    ResoreDc(Dc,SaveIndex);
  end;
end;Procedure DrawAlpha(aBitmap : TBitmap);
  var Image : TGpBitmap; bd : TBitmapData; i,j : integer;
      Img : PByte; hd : PChar;FoldAlpha : byte;
      Gd : TGpGraphics;
      aBmp : TBitmap;
begin
  abmp := TBitmap.Create;
  aBmp.PixelFormat := pf32bit;
  abmp.width := aBitmap.Width;
  aBmp.Height := aBitmap.Height;
  aBmp.canvas.Brush.Color := FTransColor;
  aBmp.Canvas.Fillrect(aBmp.Canvas.ClientRect);
  try
    gd := TGpGraphics.Create(aBitmap.Canvas.Handle);
    GetGpBitmap(aBmp,Image);
    bd := Image.LockBITS(Gprect(0,0,Image.Width,Image.Height),[imRead,imWrite],pf32bppARGB);
    Img := pbyte(bd.Scan0);
    For i := 0 to Image.heigth - 1 do
    begin
      hd := pchar(img) + i * bd.Stride;
      for j := 0 to Image.width - 1 do
      begin
        FOldalpha := byte(hd[j * 4 + 3]);
        hd[j * 4 + 3] := Char(round(FOldAlpha / 255 * FAlphaValue)));
      end;
    end; 
    Image.UnlockBits(bd);
    Gd.DrawImage(Image,0,0);
  Finally
    gd.Free;
    Image.Free; 
  end;
end;procedure GetGpBitmap(FBmp : TBitmap;var GpImage : TGpBitmap);
  var Bd : TBitmapData; 
      X,y : integer; 
      Scanlines : array of byte;
      P0 : pbytearray; CurrentX : integer;
begin
  Setlength(ScanLines,FBmp.Width * FBmp.Height * 4);
  For y := 0 to FBmp.height - 1 do
  begin
    P0 := FBmp.Scanline[y];
    CurrentX := FBmp.Width * y * 4;
    For x := 0 to FBmp.Width - 1 do
    beign
      Scanlines[CurrentX + X * 4 ] := p0[X * 4];
      Scanlines[CurrentX + X * 4 + 1] := p0[X * 4 + 1];
      Scanlines[CurrentX + X * 4 + 2] := p0[X * 4 + 2];
      Scanlines[CurrentX + X * 4 ] := 255;
    end;
  end; 
  try
    GpImage := TGpBitmap.Create(FBmp.width,FBmp.Height,pf32bppARGB);
    bd := GpImage.Lockbits(GpRect(0,0,GpImage.Wdith,GpImage.Height),[Imread,imWrite],pf32bppARGB);
    move(Scanlines[0],bd.Scan0^,bd.Width * bd.Height);
    GpImage.UnLOCKbits(bd);
    Setlength(Scanlines,0);
  excepted
  end;
end;敲代码太累了，另外两个简单的属性赋值过程就不写了......

Answer 3

Procedure DoTrans(FCanvas : TCanvas;Contorl : TWincontrol); 
  var DC : Hdc;SaveIndex :HDC; Position : Tpoint; 
begin 
  if Control.Parent <> nil then 
  begin 
    {$R-} 
    Dc := FCanvas.Handle; SaveIndex := SaveDc(Dc); 
    GetViewPortOrgEx(Dc,Position); 
    SetViewPortOrgEx(Dc,Position.X - Control.Left,Position.Y - Control.Top,nil); 
    InsertSectClipRect(Dc,0,0,Control.parent.clientwidth,Control.parent.clientheight); 
    Control.Parent.perform(WM_ERASEBKGND,Dc,0); 
    Control.Parent.Perform(WM_PAINT,DC,0); 
    ResoreDc(Dc,SaveIndex); 
  {$R+}
  end; 
end; 

Answer 4

如果不是频繁使用半透明效果，没必要使用第三方控件。用一个TPaintBox控件就可解决，缺点是设计期看不到效果。下面是个例子（先放一个TPaintBox控件，设置好控件大小、颜色、字体等）：
type
  TPaintBox = class(ExtCtrls.TPaintBox)
  protected
    procedure Paint; override;
  end;  TForm1 = class(TForm)
    Image1: TImage;
    PaintBox1: TPaintBox;
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementationuses Gdiplus;{$R *.dfm}{ TPaintBox }procedure TPaintBox.Paint;
var
  g: TGpGraphics;
  brush: TGpSolidBrush;
  font: TGpFont;
  r: TGpRectF;
  s: string;
begin
  s := '你想要的透明效果';
  //  用控件字体句柄建立GDI+字体（必须是矢量字体）
  font := TGpFont.Create(Canvas.Handle, Self.Font.Handle);
  // 用控件颜色建立一个半透明画刷
  brush := TGpSolidBrush.Create(ARGBFromTColor(128, Color));
  g := TGpGraphics.Create(Canvas.Handle);
  try
    // 计算字串居中显示矩形
    r := GpRect(0.0, 0.0, ClientRect.Right, ClientRect.Bottom);
    r := g.MeasureString(s, font);
    r.X := (ClientRect.Right - r.Width) / 2;
    r.Y := (ClientRect.Bottom - r.Height) / 2;
    // 用画刷填充客户区域
    g.FillRectangle(brush, TGpRect(ClientRect));
    // 设置刷子颜色为控件字体颜色
    brush.Color := ARGBFromTColor(Self.Font.Color);
    // 显示字串
    g.DrawString(s, font, brush, r);
  finally
    g.Free;
    brush.Free;
    font.Free;
  end;
end;

Answer 5

move(Scanlines[0],bd.Scan0^,bd.Width * bd.Height); 
笔误:
改为这样
move(Scanlines[0],bd.Scan0^,bd.Width * bd.Stride); 

Answer 6

Panel就是窗体控件。有句柄的。

Answer 7

其实 (阿发伯) 大牛的完全就能达到你的要求，只不过 paintbox 不是容器，也无句柄.
你只要新建一个控件，按我说的添加上面的代码即可，没什么难的如果实在不懂，那我也没办法了，这机器上没现成的代码，都是一个字母一个字母敲出来的。

Answer 8

抱歉抱歉，笔误的地方太多了
 Scanlines[CurrentX + X * 4 ] := 255; 
Scanlines[CurrentX + X * 4 +3] := 255; 
还是希望对你有用....

Answer 9

创建一个半透明的form，把它放到你的真正form里，不知道还 是不是有半透明的效果

Answer 10

可是 强制 AlphaBlend 报错 执行都不能