AlphaBlend(
  DC: HDC;                  {目标设备环境句柄}
  p2, p3, p4, p5: Integer;  {目标位置与宽高}
  DC6: HDC;                 {源设备环境句柄}
  p7, p8, p9, p10: Integer; {源位置与宽高}
  p11: TBlendFunction       {合成方式的数据结构, 见下表}
): BOOL;

//TBlendFunction 结构是 _BLENDFUNCTION 的重命名:
_BLENDFUNCTION = packed record
  BlendOp: BYTE;             {本例使用了: AC_SRC_OVER = 0}
  BlendFlags: BYTE;          {必须为 0}
  SourceConstantAlpha: BYTE; {透明度: 0..255}
  AlphaFormat: BYTE;         {通常为 0,如果源位图为32位真彩色,可为 AC_SRC_ALPHA }
end;

本例效果图:



代码文件:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    TrackBar1: TTrackBar;
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
  Bit,BitBack: TBitmap;
  Transparency: Byte = 255; {透明度}

procedure TForm1.FormCreate(Sender: TObject);
begin
  {设定窗体背景}
  BitBack := TBitmap.Create;
  BitBack.LoadFromFile('c:\temp\Back.bmp');
  Brush.Bitmap := BitBack;

  {调入图片}
  Bit := TBitmap.Create;
  Bit.LoadFromFile('c:\temp\test.bmp');

  {给 TrackBar1 初始化}
  TrackBar1.Max := 255;
  TrackBar1.Min := 0;
  TrackBar1.ShowSelRange := False;
  TrackBar1.Position := TrackBar1.Max;
end;

procedure TForm1.FormPaint(Sender: TObject);
var
  Blend: TBlendFunction; {定义 AlphaBlend 要使用的 TBlendFunction 结构}
begin
  {给 TBlendFunction 结构赋值}
  Blend.BlendOp := AC_SRC_OVER;
  Blend.BlendFlags := 0;
  Blend.AlphaFormat := 0;
  Blend.SourceConstantAlpha := Transparency;

  Windows.AlphaBlend(Canvas.Handle, {因 VCL 有同名属性, 所以指定了是来自 Windows 单元}
                     10,
                     10,
                     Bit.Width + 10,
                     Bit.Height + 10,
                     Bit.Canvas.Handle,
                     0,
                     0,
                     Bit.Width,
                     Bit.Height,
                     Blend
                     );
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
  Transparency := TrackBar1.Position;
  Text := IntToStr(Transparency);
  Self.Repaint; {命令重绘}
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Bit.Free;
  BitBack.Free;
end;

end.

窗体设计:
object Form1: TForm1
  Left = 352
  Top = 238
  Caption = 'Form1'
  ClientHeight = 209
  ClientWidth = 211
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poDesigned
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  OnPaint = FormPaint
  PixelsPerInch = 96
  TextHeight = 13
  object TrackBar1: TTrackBar
    Left = 0
    Top = 186
    Width = 201
    Height = 24
    TabOrder = 0
    OnChange = TrackBar1Change
  end
end

posted on 2008-05-19 17:33  万一  阅读(11023)  评论(1编辑  收藏  举报