老猫，你的办法好象不符和要求啊
看这个控件：
{*************************************************************}
{ 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 := 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.
