可以用sendmessage修改其他程序的自定义属性吗？比如这个
创建单元文件Unit2
把上面的单元复制到Unit2中，unit WinLayer改为unit Unit2
你要设置透明的窗体包含unit2单元
设置按钮事件
procedure TForm1.Button1Click(Sender: TObject);
begin
SetWindowTransparency(Form1.Handle,40);在这样的例子里如何用sendmessage设置这属性阿，把SetWindowTransparency包含在sendmessage里，可以办到吗
这一句是把GetActiveWindow找到再执行指定过程有语病吗？
var
hCurWindow:HWnd;//窗口句柄
begin
hCurWindow:=GetActiveWindow(0);
//获取第一个窗口的句柄
while hCurWindow<>0 do
这里是自定义属性的详细部分unit SGlass;
{*******************************************************
* TStainedGlass version 14.06.99 *
* written by Grigoriev Anton *
* *
*******************************************************} interface uses Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,Dialogs,Math; type TTransparencyStyle=(tsConstant,tsHorGradient,tsVertGradient,tsCustom);
TBackgroundStyle=(bsSimple,bsMosaic,bsCentered,bsStretched,bsCustom);
TTransparency=0..100; TGetTransparencyEvent=procedure(Sender:TObject;X,Y,Width,Height:Integer;var Transparency:TTransparency) of object;
TCreateBackgroundEvent=procedure(Sender:TObject;Back:TBitmap) of object; TStainedGlass=class(TComponent)
private
FGlyph,ScrImage,Back:TBitmap;
FTranspStyle:TTransparencyStyle;
FBackStyle:TBackgroundStyle;
OldWidth,OldHeight:Integer;
FTransparency,FAltTransparency:TTransparency;
FDrawOnDesigning:Boolean;
OldWndProc:TFarProc;
NewWndProc:Pointer;
NeedRefresh,Moving:Boolean;
FDelayTime:Cardinal;
FOnGetTransparency:TGetTransparencyEvent;
FOnCreateBackground:TCreateBackgroundEvent;
procedure HookOwner;
procedure UnhookOwner;
procedure SetAltTransparency(Value:TTransparency);
procedure SetBackStyle(Value:TBackgroundStyle);
procedure SetDrawOnDesigning(Value:Boolean);
procedure SetGlyph(Value:TBitmap);
procedure SetTransparency(Value:TTransparency);
procedure SetTranspStyle(Value:TTransparencyStyle);
function ConstantTransparency(X,Y,W,H:Integer):TTransparency;
function HGTransparency(X,Y,W,H:Integer):TTransparency;
function VGTransparency(X,Y,W,H:Integer):TTransparency;
function CustomTransparency(X,Y,W,H:Integer):TTransparency;
procedure GlyphChanged(Sender:TObject);
protected
procedure CreateBack(W,H:Integer);
procedure CallDefault(var Msg:TMessage);
procedure HookWndProc(var Msg:TMessage);virtual;
public
constructor Create(AOwner:TComponent);override;
destructor Destroy;override;
procedure Refresh;
published
property AltTransparency:TTransparency read FAltTransparency write SetAltTransparency default 100;
property BackStyle:TBackgroundStyle read FBackStyle write SetBackStyle default bsSimple;
property DelayTime:Cardinal read FDelayTime write FDelayTime default 400;
property DrawOnDesigning:Boolean read FDrawOnDesigning write SetDrawOnDesigning default False;
property Glyph:TBitmap read FGlyph write SetGlyph;
property Transparency:TTransparency read FTransparency write SetTransparency default 40;
property TranspStyle:TTransparencyStyle read FTranspStyle write SetTranspStyle default tsConstant;
property OnCreateBackground:TCreateBackgroundEvent read FOnCreateBackground write FOnCreateBackground default nil;
property OnGetTransparency:TGetTransparencyEvent read FOnGetTransparency write FOnGetTransparency default nil;
end; procedure Register; implementation type TTransparencyFunc=function(X,Y,W,H:Integer):TTransparency of object; PRGBArray=^TRGBArray;
TRGBArray=array[0..1000000] of TRGBTriple; constructor TStainedGlass.Create;
var I:Integer;
begin
if not (AOwner is TForm) then
raise EInvalidCast.Create('TStainedGlass can be put on TForm or its destendant only');
with AOwner do
for I:=0 to ComponentCount-1 do
if (Components[I] is TStainedGlass) and (Components[I]<>Self) then
raise EComponentError.Create('Only one TStainedGlass component on a form is allowed');
inherited Create(AOwner);
FGlyph:=TBitmap.Create;
FGlyph.OnChange:=GlyphChanged;
ScrImage:=TBitmap.Create;
ScrImage.Width:=GetSystemMetrics(SM_CXScreen);
ScrImage.Height:=GetSystemMetrics(SM_CYScreen);
ScrImage.PixelFormat:=pf24Bit;
Back:=TBitmap.Create;
Back.PixelFormat:=pf24Bit;
OldWidth:=-1;
OldHeight:=-1;
NeedRefresh:=True;
FAltTransparency:=100;
FBackStyle:=bsSimple;
FTransparency:=40;
FTranspStyle:=tsConstant;
FDelayTime:=400;
Moving:=False;
FOnCreateBackground:=nil;
FOnGetTransparency:=nil;
HookOwner
end; destructor TStainedGlass.Destroy;
begin
UnhookOwner;
ScrImage.Free;
FGlyph.Free;
Back.Free;
inherited Destroy
end; procedure TStainedGlass.HookOwner;
begin
if not Assigned(Owner) then
Exit;
OldWndProc:=TFarProc(GetWindowLong(TForm(Owner).Handle,GWL_WndProc));
NewWndProc:=MakeObjectInstance(HookWndProc);
SetWindowLong(TForm(Owner).Handle,GWL_WndProc,LongInt(NewWndProc))
end; procedure TStainedGlass.UnhookOwner;
begin
if Assigned(Owner) and Assigned(OldWndProc) then
SetWindowLong(TForm(Owner).Handle,GWL_WndProc,LongInt(OldWndProc));
if Assigned(NewWndProc) then
FreeObjectInstance(NewWndProc);
NewWndProc:=nil;
OldWndProc:=nil
end;
创建单元文件Unit2
把上面的单元复制到Unit2中，unit WinLayer改为unit Unit2
你要设置透明的窗体包含unit2单元
设置按钮事件
procedure TForm1.Button1Click(Sender: TObject);
begin
SetWindowTransparency(Form1.Handle,40);在这样的例子里如何用sendmessage设置这属性阿，把SetWindowTransparency包含在sendmessage里，可以办到吗
这一句是把GetActiveWindow找到再执行指定过程有语病吗？
var
hCurWindow:HWnd;//窗口句柄
begin
hCurWindow:=GetActiveWindow(0);
//获取第一个窗口的句柄
while hCurWindow<>0 do
这里是自定义属性的详细部分unit SGlass;
{*******************************************************
* TStainedGlass version 14.06.99 *
* written by Grigoriev Anton *
* *
*******************************************************} interface uses Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,Dialogs,Math; type TTransparencyStyle=(tsConstant,tsHorGradient,tsVertGradient,tsCustom);
TBackgroundStyle=(bsSimple,bsMosaic,bsCentered,bsStretched,bsCustom);
TTransparency=0..100; TGetTransparencyEvent=procedure(Sender:TObject;X,Y,Width,Height:Integer;var Transparency:TTransparency) of object;
TCreateBackgroundEvent=procedure(Sender:TObject;Back:TBitmap) of object; TStainedGlass=class(TComponent)
private
FGlyph,ScrImage,Back:TBitmap;
FTranspStyle:TTransparencyStyle;
FBackStyle:TBackgroundStyle;
OldWidth,OldHeight:Integer;
FTransparency,FAltTransparency:TTransparency;
FDrawOnDesigning:Boolean;
OldWndProc:TFarProc;
NewWndProc:Pointer;
NeedRefresh,Moving:Boolean;
FDelayTime:Cardinal;
FOnGetTransparency:TGetTransparencyEvent;
FOnCreateBackground:TCreateBackgroundEvent;
procedure HookOwner;
procedure UnhookOwner;
procedure SetAltTransparency(Value:TTransparency);
procedure SetBackStyle(Value:TBackgroundStyle);
procedure SetDrawOnDesigning(Value:Boolean);
procedure SetGlyph(Value:TBitmap);
procedure SetTransparency(Value:TTransparency);
procedure SetTranspStyle(Value:TTransparencyStyle);
function ConstantTransparency(X,Y,W,H:Integer):TTransparency;
function HGTransparency(X,Y,W,H:Integer):TTransparency;
function VGTransparency(X,Y,W,H:Integer):TTransparency;
function CustomTransparency(X,Y,W,H:Integer):TTransparency;
procedure GlyphChanged(Sender:TObject);
protected
procedure CreateBack(W,H:Integer);
procedure CallDefault(var Msg:TMessage);
procedure HookWndProc(var Msg:TMessage);virtual;
public
constructor Create(AOwner:TComponent);override;
destructor Destroy;override;
procedure Refresh;
published
property AltTransparency:TTransparency read FAltTransparency write SetAltTransparency default 100;
property BackStyle:TBackgroundStyle read FBackStyle write SetBackStyle default bsSimple;
property DelayTime:Cardinal read FDelayTime write FDelayTime default 400;
property DrawOnDesigning:Boolean read FDrawOnDesigning write SetDrawOnDesigning default False;
property Glyph:TBitmap read FGlyph write SetGlyph;
property Transparency:TTransparency read FTransparency write SetTransparency default 40;
property TranspStyle:TTransparencyStyle read FTranspStyle write SetTranspStyle default tsConstant;
property OnCreateBackground:TCreateBackgroundEvent read FOnCreateBackground write FOnCreateBackground default nil;
property OnGetTransparency:TGetTransparencyEvent read FOnGetTransparency write FOnGetTransparency default nil;
end; procedure Register; implementation type TTransparencyFunc=function(X,Y,W,H:Integer):TTransparency of object; PRGBArray=^TRGBArray;
TRGBArray=array[0..1000000] of TRGBTriple; constructor TStainedGlass.Create;
var I:Integer;
begin
if not (AOwner is TForm) then
raise EInvalidCast.Create('TStainedGlass can be put on TForm or its destendant only');
with AOwner do
for I:=0 to ComponentCount-1 do
if (Components[I] is TStainedGlass) and (Components[I]<>Self) then
raise EComponentError.Create('Only one TStainedGlass component on a form is allowed');
inherited Create(AOwner);
FGlyph:=TBitmap.Create;
FGlyph.OnChange:=GlyphChanged;
ScrImage:=TBitmap.Create;
ScrImage.Width:=GetSystemMetrics(SM_CXScreen);
ScrImage.Height:=GetSystemMetrics(SM_CYScreen);
ScrImage.PixelFormat:=pf24Bit;
Back:=TBitmap.Create;
Back.PixelFormat:=pf24Bit;
OldWidth:=-1;
OldHeight:=-1;
NeedRefresh:=True;
FAltTransparency:=100;
FBackStyle:=bsSimple;
FTransparency:=40;
FTranspStyle:=tsConstant;
FDelayTime:=400;
Moving:=False;
FOnCreateBackground:=nil;
FOnGetTransparency:=nil;
HookOwner
end; destructor TStainedGlass.Destroy;
begin
UnhookOwner;
ScrImage.Free;
FGlyph.Free;
Back.Free;
inherited Destroy
end; procedure TStainedGlass.HookOwner;
begin
if not Assigned(Owner) then
Exit;
OldWndProc:=TFarProc(GetWindowLong(TForm(Owner).Handle,GWL_WndProc));
NewWndProc:=MakeObjectInstance(HookWndProc);
SetWindowLong(TForm(Owner).Handle,GWL_WndProc,LongInt(NewWndProc))
end; procedure TStainedGlass.UnhookOwner;
begin
if Assigned(Owner) and Assigned(OldWndProc) then
SetWindowLong(TForm(Owner).Handle,GWL_WndProc,LongInt(OldWndProc));
if Assigned(NewWndProc) then
FreeObjectInstance(NewWndProc);
NewWndProc:=nil;
OldWndProc:=nil
end;
解决方案 »
- FastReport导出中文PDF时，出现乱码
- CoolTrayIcon v4.4.0这个组件我不怎么会用嘛！
- 如何声明一个类
- 如何判断D7连接SQLSERVER数据库是否成功?也就是SQL服务器是否开启和网络是否连接,使用ADO连接
- 急~~~刚学DELPHI 有这个小问困扰着我
- ServerSocket有时候会遗漏ClientSocket发过来的信息，大家遇到过吗？
- delphi在移动控间的时候是怎么做的？
- 谁知道TADOStoreProc的用法呀?
- 不好意思，想了解下Dephli的工资一般在什么价位，能统计下么？分三个巴
- 谁能告诉我哪里有第三方控件下载吗?高分相送
- 打印的问题？？分不够再加
- 求帮助
楼上说的正确!
如果程序两个程序都是由你自己来写的或者你有公共的接口,你可以通过自定义消息来完成你想要的,也就是说当另外一个程序接收到你的自定义消息后做出相应的处理就行了
function SetLayeredWindowAttributes(Handle: HWND; COLORKEY: COLORREF;
Alpha: BYTE; Flags: DWORD): Boolean; stdcall; external 'USER32.DLL';
Alpha: BYTE; Flags: DWORD): Boolean; stdcall; external 'USER32.DLL';
只有声明了这句话的窗口才可以得到此效果吗？没有声明的窗口捕获其句柄也无法修改属性得到此效果吗，如果是这样。修改注册表使每一个窗口自动得到声明产生此属性就可以做到了吗？