半透明的窗体谁会做（Win9x环境）(50分)

[?][?][blue][/[?]谁有Windows 98 环境下窗体半透明的源代码，就像Windows 2000下TForm.AlphaBlend属性一样的，该属性在98下不起作用blue]

去 www.51delphi.com 找找。

好像没有哦[][]

有个过程
procedure TForm1.FormCreate(Sender: TObject);
var
FullRgn, ClientRgn, ButtonRgn: THandle;
Margin, X, Y: Integer;
begin
Margin := (Width - ClientWidth) div 2;
FullRgn := CreateRectRgn(0, 0, Width, Height);
X := Margin;
Y := Height - ClientHeight - Margin;
ClientRgn := CreateRectRgn(X, Y, X + ClientWidth, Y + ClientHeight);
CombineRgn(FullRgn, FullRgn, ClientRgn, RGN_DIFF);
X := X + Button1.Left;
Y := Y + Button1.Top;
ButtonRgn := CreateRectRgn(X, Y, X + Button1.Width, Y + Button1.Height);
CombineRgn(FullRgn, FullRgn, ButtonRgn, RGN_OR);
SetWindowRgn(Handle, FullRgn, True);
end;

//我是摘录过来的，没有试过可用性。见谅

windows.alphablend可以用吗？因为我没98，公司里面也没98（98已经淘汰好几年了），所以无法测试验证。

to aynes
谢谢您的指导，该方法我也知道，只是它是全透明的，就像中间挖去了一个孔。我说的是半透明，就像在CS中按住Tab键弹出的那种窗口。

to microtomato:
98确实也应该淘汰了，但是，98中的AlphaBlend 好像根本不起作用？！

AlphaBlend要在Win2000以上才起作用的。

[][][][][][][][][]
[purple]看来是谁也不会的了，我要收回分！但是，金山词霸是怎么做到的呢[/purple]

我这里有个控件的源码，你要的话留下信箱
找到了，不大，给你贴上来吧！
{*************************************************************}
{ TGlassy component for Delphi 3 and higher }
{ Version: 1.0 }
{ Idea: Anton Grigoriev (grigorievab@mail.ru) }
{ Author: Aleksey Xacker (xacker@phreaker.net) }
{ E-Mail: xacker@phreaker.net }
{ Home Page: http://www.angen.com/~xacker/ }
{ Created: June, 12, 1999 }
{ Modified: June, 12, 1999 }
{*************************************************************}
{ This component (inherited from TPaintBox) will draw itself }
{ as transparent part of form (shows what be under form), }
{ with possibility to set 'glass' color and degree of the }
{ transparency. }
{*************************************************************}
{ Additional properties: }
{ TranspColor: TColor - color of 'glass'. }
{ Transparency: 1..100 - degree of transparency. }
{ Moveable: Boolean - if true then form can be moved (dragged)}
{ using the client area of form }
{*************************************************************}
{ Please see demo program for more information. }
{*************************************************************}
{ IMPORTANT NOTE: }
{ This software is provided 'as-is', without any express or }
{ implied warranty. In no event will the author be held }
{ liable for any damages arising from the use of this }
{ software. }
{ Permission is granted to anyone to use this software for }
{ any purpose, including commercial applications, and to }
{ alter it and redistribute it freely, subject to the }
{ following restrictions: }
{ 1. The origin of this software must not be misrepresented, }
{ you must not claim that you wrote the original software. }
{ If you use this software in a product, an acknowledgment }
{ in the product documentation would be appreciated but is }
{ not required. }
{ 2. Altered source versions must be plainly marked as such, }
{ and must not be misrepresented as being the original }
{ software. }
{ 3. This notice may not be removed or altered from any }
{ source distribution. }
{*************************************************************}
unit Glassy;

interface

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

type
THoundred = 0..100;

TGlassy = class(TPaintBox)
private
FMoveable: Boolean;
FTranspColor: TColor;
FTransparency: THoundred;
ScreenShoot: TBitmap;
ParentForm: TForm;
PrevParentWndProc: Pointer;
ShiftX, ShiftY: Integer;
CanTakeScreen: Boolean;

procedure NewParentWndProc(var Msg: TMessage);
procedure TakeScreenShoot;

procedure SetTranspColor(Value: TColor);
procedure SetTransparency(Value: THoundred);
protected
procedure SetParent(Value: TWinControl); override;
public
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
procedure Loaded; override;

procedure Paint; override;
published
property Moveable: Boolean read FMoveable write FMoveable;
property TranspColor: TColor read FTranspColor write SetTranspColor;
property Transparency: THoundred read FTransparency write SetTransparency;
end;

procedure Register;

implementation

type
PRGBArray = ^TRGBArray;
TRGBArray = Array[0..1000000] of TRGBTriple;

constructor TGlassy.Create(aOwner: TComponent);
var
p: Pointer;
begin
inherited Create(aOwner);
FMoveable := True;
FTransparency := 60;
FTranspColor := clBlack;
ParentForm := TForm(aOwner);
ScreenShoot := TBitmap.Create;

{ Setting hook on parent form }
PrevParentWndProc := Pointer(GetWindowLong(ParentForm.Handle, GWL_WNDPROC));
p := classes.MakeObjectInstance(NewParentWndProc);
SetWindowLong(ParentForm.Handle, GWL_WNDPROC, LongInt(p));

CanTakeScreen := True;
end;

destructor TGlassy.Destroy;
begin
if ParentForm.HandleAllocated then
SetWindowLong(ParentForm.Handle, GWL_WNDPROC, LongInt(PrevParentWndProc));

if ScreenShoot <> nil then ScreenShoot.Destroy;
inherited Destroy;
end;

procedure TGlassy.Loaded;
begin
inherited Loaded;
TakeScreenShoot;
end;

procedure TGlassy.SetParent(Value: TWinControl);
begin
inherited SetParent(Value);
if Value <> nil then
begin
ShiftX := 0;
ShiftY := 0;
while not (Value is TForm) do
begin
inc(ShiftX, Value.Left);
inc(ShiftY, Value.Top);
Value := Value.Parent;
end;
end;
end;

procedure TGlassy.Paint;
var
X, Y: Integer;
begin
inherited Paint;
if (csDesigning in ComponentState) or (ScreenShoot = nil) then Exit;

X := ParentForm.Left + Left + ShiftX;
Y := ParentForm.Top + Top + ShiftY;

with ParentForm do
begin
if WindowState = wsNormal then
case BorderStyle of
bsSingle,
bsDialog: begin
inc(X, GetSystemMetrics(sm_CXDlgFrame));
inc(Y, GetSystemMetrics(sm_CYDlgFrame));
end;
bsSizeable: begin
inc(X, GetSystemMetrics(sm_CXFrame));
inc(Y, GetSystemMetrics(sm_CYFrame));
end;
bsToolWindow,
bsSizeToolWin: begin
inc(X, GetSystemMetrics(sm_CXBorder));
inc(Y, GetSystemMetrics(sm_CYBorder));
end;
end;
if BorderStyle <> bsNone then
inc(Y, GetSystemMetrics(sm_CYCaption));
end;

if ScreenShoot <> nil then
BitBlt(Canvas.Handle, 0, 0, ScreenShoot.Width, ScreenShoot.Height,
ScreenShoot.Canvas.Handle, X, Y, SrcCopy);
CanTakeScreen := True;
end;

procedure TGlassy.NewParentWndProc(var Msg: TMessage);
begin
Msg.Result := CallWindowProc(PrevParentWndProc, ParentForm.Handle, Msg.Msg,
Msg.WParam, Msg.LParam);
case Msg.Msg of
wm_Activate: if (Lo(Msg.wParam) <> wa_Inactive) and
CanTakeScreen then TakeScreenShoot;
wm_Move: Paint;
wm_NCHitTest: if not (csDesigning in ComponentState) and
FMoveable and (Msg.Result = htClient) then
Msg.Result := htCaption
end;
end;

procedure TGlassy.TakeScreenShoot;
var
DC: hDC;
ScreenWidth, ScreenHeight: Integer;
SL: PRGBArray;
X, Y: Integer;
begin
if (csDesigning in ComponentState) or (ScreenShoot = nil) then Exit;

CanTakeScreen := False;

ScreenWidth := GetSystemMetrics(sm_CXScreen);
ScreenHeight := GetSystemMetrics(sm_CYScreen);

ScreenShoot.Width := ScreenWidth;
ScreenShoot.Height := ScreenHeight;
ScreenShoot.PixelFormat := pf24bit;

ShowWindow(ParentForm.Handle, SW_Hide);

SetActiveWindow(0);

Sleep(100); // Waiting when all windows will be redrawn...

DC := GetDC(0);
BitBlt(ScreenShoot.Canvas.Handle, 0, 0,
ScreenWidth, ScreenHeight, DC, 0, 0, SrcCopy);
ReleaseDC(0, DC);

for Y := 0 to ScreenHeight - 1 do
begin
SL := ScreenShoot.ScanLine[Y];
for X := 0 to ScreenWidth - 1 do
begin
try
SL[X].rgbtRed := (FTransparency * SL[X].rgbtRed + (100 - FTransparency) * GetRValue(FTranspColor)) div 100;
SL[X].rgbtGreen := (FTransparency * SL[X].rgbtGreen + (100 - FTransparency)* GetGValue(FTranspColor)) div 100;
SL[X].rgbtBlue := (FTransparency * SL[X].rgbtBlue + (100 - FTransparency) * GetBValue(FTranspColor)) div 100;
except
end;
end
end;

ShowWindow(ParentForm.Handle, sw_Show);
end;

procedure TGlassy.SetTranspColor(Value: TColor);
begin
if FTranspColor <> Value then
begin
FTranspColor := Value;
if ScreenShoot <> nil then
begin
TakeScreenShoot;
Paint;
end;
end;
end;

procedure TGlassy.SetTransparency(Value: THoundred);
begin
if FTransparency <> Value then
begin
FTransparency := Value;
if ScreenShoot <> nil then
begin
TakeScreenShoot;
Paint;
end;
end;
end;

procedure Register;
begin
RegisterComponents('Xacker', [TGlassy]);
end;

end.

to wfzha:
该控件我现在还没有去试过，不过我想它应该是很好的，6K Byte 呢！谢谢wfzha 兄，50分奉送！恭喜！