请较高手：程序半透明背景的源代码(200分)

求最近比较流行的半透明背景的源代码

procedure TForm1.Button1Click(Sender: TObject);
var
OldBkMode : integer;
begin
with Form1.Canvas do begin
Brush.Color := clRed;
FillRect(Rect(0, 0, 100, 100));
Brush.Color := clBlue;
TextOut(10, 20, 'Not Transparent!');
OldBkMode := SetBkMode(Handle, TRANSPARENT);
TextOut(10, 50, 'Transparent!');
SetBkMode(Handle, OldBkMode);
end;
end;

如果你的操作系统是WIN2K的话，一条API就搞定了，Delphi6相应的也有属性。

对于这个问题网站上有很多的讨论的，你自己可以去看看，WWW.CSDN.NET上好多的！

D6的TCustomForm新支持了AlphaBlend这个属性，将其打开并结合AlphaBlendValue可以实现
窗体的淡入淡出效果，很好看的

虽然2000可以，但95/98下不行，你试一下我写的这个控件吧
unit CFormImage;

interface

uses Windows, Classes, Controls, Forms, SysUtils, Graphics, ExtCtrls;

type
TTransColorPosition = (cpLeftTop, cpLeftBottom, cpRightTop, cpRightBottom);

TCFormImage = class(TImage)
private
FFormShow: TNotifyEvent;
FTransColorPosition: TTransColorPosition;
FRGN: HRGN;
FOnMouseDown: TMouseEvent;
FOnMouseMove: TMouseMoveEvent;
FOnMouseUp: TMouseEvent;
FOldMousePos: TPoint;
FMouseDown: Boolean;
FBorderLimit: Word;
procedure DoFormShow(Sender: TObject);
function GetRegion: HRGN;
procedure DoMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure DoMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
procedure DoMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property TransColorPosition: TTransColorPosition read FTransColorPosition
write FTransColorPosition;
property BorderLimit: Word read FBorderLimit write FBorderLimit;

property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
end;

implementation

{ TCFormImage }

constructor TCFormImage.Create(AOwner: TComponent);
begin
if not (AOwner is TCustomForm) then
raise Exception.Create('AOwner is not TCustomForm');
inherited;
FRGN := 0;
FTransColorPosition := cpLeftTop;
FMouseDown := False;

FFormShow := TForm(AOwner).OnShow;
TForm(AOwner).OnShow := DoFormShow;
inherited OnMouseDown := DoMouseDown;
inherited OnMouseMove := DoMouseMove;
inherited OnMouseUp := DoMouseUp;
end;

destructor TCFormImage.Destroy;
begin
if FRGN <> 0 then DeleteObject(FRGN);
inherited;
end;

procedure TCFormImage.DoFormShow(Sender: TObject);
begin
SetWindowRgn(TCustomForm(Owner).Handle, GetRegion, True);
if Assigned(FFormShow) then FFormShow(Sender);
end;

procedure TCFormImage.DoMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var R: TRect;
begin
if not (ssLeft in Shift) then Exit;
if SetCapture(TCustomForm(Owner).Handle) = 0 then Exit;

FOldMousePos.X := X;
FOldMousePos.Y := Y;
R.Left := BorderLimit;
R.Top := BorderLimit;
R.Right := Screen.Width - 2 * BorderLimit;
R.Bottom := Screen.Height - 2 * BorderLimit;
ClipCursor(@R);
FMouseDown := True;
end;

procedure TCFormImage.DoMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if not FMouseDown then Exit;

with TCustomForm(Owner) do
begin
Left := Left + X - FOldMousePos.X;
Top := Top + Y - FOldMousePos.Y;
end;
end;

procedure TCFormImage.DoMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FMouseDown := False;
if GetCapture = TCustomForm(Owner).Handle then ReleaseCapture;
ClipCursor(nil);
end;

function TCFormImage.GetRegion: HRGN;
var
FDC: HDC;
X, Y: Integer;
Coord: TPoint;
Line: Boolean;
C, TransColor: TColor;
TempBitmap: TBitmap;
begin
if FRGN <> 0 then DeleteObject(FRGN);
TempBitmap := nil;
try
if Picture.Graphic is TBitmap then
FDC := Canvas.Handle
else begin
TempBitmap := TBitmap.Create;
TempBitmap.Width := Width;
TempBitmap.Height := Height;
TempBitmap.Canvas.Draw(0, 0, Picture.Graphic);
FDC := TempBitmap.Canvas.Handle;
end;

TransColor := clBlack;
case TransColorPosition of
cpLeftTop: TransColor := GetPixel(FDC, 0, 0);
cpLeftBottom: TransColor := GetPixel(FDC, 0, Height - 1);
cpRightTop: TransColor := GetPixel(FDC, Width - 1, 0);
cpRightBottom: TransColor := GetPixel(FDC, Width - 1, Height - 1);
end;
BeginPath(FDC);
for X := 0 to Width - 1 do
begin
Line := False;
for Y := 0 to Height - 1 do
begin
C := GetPixel(FDC, X, Y);
if C <> TransColor then
begin
if not Line then
begin
Line := True;
Coord.X := X;
Coord.Y := Y;
end;
end;
if (C = TransColor) or (Y = Height - 1) then
begin
if Line then
begin
Line := False;
MoveToEx(FDC, Coord.X, Coord.Y, nil);
LineTo(FDC, Coord.X, Y);
LineTo(FDC, Coord.X + 1, Y);
LineTo(FDC, Coord.X + 1, Coord.Y);
CloseFigure(FDC);
end;
end;
end;
end;
EndPath(FDC);
FRGN := PathToRegion(FDC);
Result := FRGN;
finally
if TempBitmap <> nil then TempBitmap.Free;
end;
end;

end.


没有注册控件代码，自己写吧，注册后，把这个CFormImage放到Form上，撑满放入图片，
指定用图片那个角的颜色做透明色（TransColorPosition），然后设定
Form.BorderStyle = bsNone，运行看看吧

斑竹，为解决这个问题了，能不能收回分数或者少给分啊

当然可以

多人接受答案了。