网上找的例子实现玻璃效果.

可以代码添加到你的工程中.感谢作者的付出!

{**********************************************************}
{ 摘要： 玻璃效果的绘制                                        }
{                                                           }
{ 作者： LinZhenqun                                         }
{ 日期： 2007-10-5                                          }
{ 邮件： linzhenqun@gmail.net                               }
{**********************************************************}

//unit GlassUtils;

interface
uses
   Graphics, Windows, Classes;

type
   { 渐变API的声明 }
   PTriVertex = ^TTriVertex;
   TTriVertex = packed record
     x: Longint;
     y: Longint;
     Red: WORD;
     Green: WORD;
     Blue: WORD;
     Alpha: WORD;
  end;
function GradientFill(DC: HDC; Vertex: PTriVertex; NumVertex: ULONG;
   Mesh: Pointer; NumMesh, Mode: ULONG): BOOL; stdcall;

type
   {渐变方向: 从左到右，从上到下}
   TGradDirection = (gdLeftRight, gdTopBottom);
    
   { 玻璃效果的颜色配置 }
   TGlassColorCfg = record
     OutBorder,         //外框，如果为clNone将不绘制
     InBorder,          //内框，如果为clNone将不绘制
     Grad1Start,        //上半部分渐变的开始颜色
     Grad1End,          //上半部分渐变的结束颜色
     Grad2Start,        //下半部分渐变的开始颜色
     Grad2End: TColor   //下半部分渐变的结束颜色
  end;
  
var
   { 默认颜色配置，蓝色玻璃 }
   DefGlassColorCfg: TGlassColorCfg = (OutBorder: clBlack;

InBorder: $00E1D0AA;

Grad1Start: $00D1AE7A;

Grad1End: $00B98835;

Grad2Start: $00975F00;

Grad2End: $00C6A46A);

{ 颜色值转RGB }
procedure GetRGB(C: TColor; out R, G, B: Integer);

{ 渐变函数 }
procedure FillGradient(const Canvas: TCanvas; const ARect: TRect;
  const StartColor, EndColor: TColor; const Direction: TGradDirection);

{ 玻璃效果绘制函数 }
procedure DrawGlassFace(Canvas: TCanvas; ARect: TRect;
  const GlassColorCfg: TGlassColorCfg);

implementation

function GradientFill; external msimg32;

procedure GetRGB(C: TColor; out R, G, B: Integer);
begin
  if Integer(C) < 0 then C := GetSysColor(C and $000000FF);
   R := C and $FF;
   G := C shr 8 and $FF;
   B := C shr 16 and $FF;
end;

procedure FillGradient(const Canvas: TCanvas; const ARect: TRect;
  const StartColor, EndColor: TColor; const Direction: TGradDirection);
var
   Vert: array[0..1] of TTriVertex;
   gRect: TGradientRect;
   nMode: Cardinal;
   R, G, B: Integer;
begin
   vert[0].x := ARect.Left;
   vert[0].y := ARect.Top;
   GetRGB(StartColor, R, G, B);
   Vert[0].Red := R shl 8;
   Vert[0].Green := G shl 8;
   Vert[0].Blue := B shl 8;
   vert[0].Alpha := 0;

   vert[1].x := ARect.Right;
   vert[1].y := ARect.Bottom;
   GetRGB(EndColor, R, G, B);
   Vert[1].Red := R shl 8;
   Vert[1].Green := G shl 8;
   Vert[1].Blue := B shl 8;
   vert[1].Alpha := 0;

   gRect.UpperLeft := 0;
   gRect.LowerRight := 1;
  if Direction = gdLeftRight then
     nMode := GRADIENT_FILL_RECT_H
  else
     nMode := GRADIENT_FILL_RECT_V;

   GradientFill(Canvas.Handle, @vert, 2, @gRect, 1, nMode);
end;

procedure DrawGlassFace(Canvas: TCanvas; ARect: TRect;
  const GlassColorCfg: TGlassColorCfg);
var
   R: TRect;
begin
   Canvas.Brush.Style := bsClear;
  with GlassColorCfg do
  begin
    if OutBorder <> clNone then
    begin
       //外框
       Canvas.Pen.Color := OutBorder;
       Canvas.Rectangle(ARect);
    end;
    if InBorder <> clNone then
    begin
       //内框
       InflateRect(ARect, -1, -1);
       Canvas.Pen.Color := InBorder;
       Canvas.Rectangle(ARect);
    end;
     //上下渐变效果
     InflateRect(ARect, -1, -1);
    with ARect do
       R := Rect(Left, Top, Right, Top + (Bottom - Top) div 2);
     FillGradient(Canvas, R, Grad1Start, Grad1End, gdTopBottom);
       R := Rect(R.Left, R.Bottom, R.Right, ARect.Bottom);
     FillGradient(Canvas, R, Grad2Start, Grad2End, gdTopBottom);
  end;
end;

end.