FireMoneky Windows下的消息管理器组件

来源:互联网 发布:金山数据恢复和 编辑:程序博客网 时间:2024/06/10 03:24

这个组件我就不多说了.. 太简单了, 直接贴代码吧,,,,,,,, 大家有什么不明白地方可以留下你的评论,

{***************************************************************************}{                                                                           }{       功能:FMX.ZYJ Windows消息管理器                                     }{       名称:FMX.ZYJ.Win.MessageManager.pas                                }{       版本:1.1                                                           }{       环境:Win8.1                                                        }{       工具:Delphi XE3 AppMethod DelphiXE6                                }{       日期:2014/3/28 19:35:56                                            }{       作者:ying32                                                        }{       QQ  :396506155                                                     }{       MSN :ying_32@live.cn                                               }{       E-mail:yuanfen3287@vip.qq.com                                      }{       Website:http://www.ying32.com                                      }{       版权所有 (C) 2014-2014 ying32 All Rights Reserved                   }{                                                                           }{---------------------------------------------------------------------------}{                                                                           }{       备注: Windows消息管理器                                            }{                                                                           }{                                                                           }{                                                                           }{***************************************************************************}unit FMX.ZYJ.Win.MessageManager;interface{$I 'ZYJFmx.inc'}uses  Winapi.Windows,  Winapi.Messages,  Winapi.ShellApi,  System.SysUtils,  System.Classes,  FMX.Forms,  FMX.Types,  FMX.Platform.Win;type  TZYJWinMessageEvent = procedure(hWd: HWND; var Message: TMessage) of object;  TZYJWinMessageManager = class(TFmxObject)  private    FHandle: HWND;    FOnWinMessage: TZYJWinMessageEvent;    FOldWinProc : Pointer;  protected    procedure Loaded; override;  public    constructor Create(AOwner: TComponent); override;    destructor Destroy; override;    property Handle: HWND read FHandle;    property OldWinProc: Pointer read FOldWinProc;  published    property OnWinMessage: TZYJWinMessageEvent read FOnWinMessage write FOnWinMessage;  end;implementationuses  System.Types;type  TManagerClass = class  private    FList: TList;  public    constructor Create;    destructor Destroy; override;    function Add(P: TZYJWinMessageManager): Boolean;    procedure Remove(P: TZYJWinMessageManager);    function Find(hWd: HWND): TZYJWinMessageManager;  end;var  uManagerWinPrc: TManagerClass;function NewWinProc(hWd: HWND; uMsg: UINT; wParam: wParam; lParam: lParam): LRESULT; stdcall;var  LClass: TZYJWinMessageManager;  LWinMessage: TMessage;begin  LClass := uManagerWinPrc.Find(hWd);  LWinMessage.Msg := uMsg;  LWinMessage.WParam := wParam;  LWinMessage.LParam := lParam;  LWinMessage.Result := 0;  if Assigned(LClass.OnWinMessage) then    LClass.OnWinMessage(hWd, LWinMessage);  if LWinMessage.Result = 0 then    Result := CallWindowProc(LClass.OldWinProc, hWd, uMsg, wParam, lParam)  else    Result := LWinMessage.Result;end;{ TZYJWinMessageManager }constructor TZYJWinMessageManager.Create(AOwner: TComponent);var  C: TComponent;begin  inherited Create(AOwner);  if Assigned(Owner) then  begin    for C in Owner do      if (C is TZYJWinMessageManager) and (C <> Self) then      begin        raise Exception.Create('同一窗口只允许一个消息管理器存在! ');        Break;      end;  end else raise Exception.Create('父窗口必须存在,且必须为TForm! ');  FOldWinProc := nil;  FHandle := 0;  if AOwner is TCustomForm then  {$IFDEF DELPHIXE3UP}    FHandle := FormToHWND(TCustomForm(AOwner));  {$ELSE}    FHandle := FmxHandleToHWND(TCustomForm(AOwner).Handle);  {$ENDIF}end;destructor TZYJWinMessageManager.Destroy;begin  if not(csDesigning in ComponentState) then  begin    if IsWindow(FHandle) then      SetWindowLong(FHandle, GWL_WNDPROC, Integer(FOldWinProc));     uManagerWinPrc.Remove(Self);  end;  inherited;end;procedure TZYJWinMessageManager.Loaded;begin  inherited;  if not(csDesigning in ComponentState) then    if uManagerWinPrc.Add(Self) then      if IsWindow(FHandle) then        FOldWinProc := Pointer(SetWindowLong(FHandle, GWL_WNDPROC, Integer(@NewWinProc)));end;{ TManagerClass }function TManagerClass.Add(P: TZYJWinMessageManager): Boolean;begin   Result := False;   if FList.IndexOf(P) = -1 then     Result := FList.Add(P) >= 0;end;constructor TManagerClass.Create;begin  inherited;  FList := TList.Create;end;destructor TManagerClass.Destroy;begin  FList.Free;  inherited;end;function TManagerClass.Find(hWd: HWND): TZYJWinMessageManager;var  I: Integer;begin  Result := nil;  for I := 0 to FList.Count - 1 do  begin     if TZYJWinMessageManager(FList[I]).Handle = hWd then       Exit(TZYJWinMessageManager(FList[I]));  end;end;procedure TManagerClass.Remove(P: TZYJWinMessageManager);begin  FList.Remove(P);end;initialization   uManagerWinPrc := TManagerClass.Create;finalization   uManagerWinPrc.Free;end.

0 0
原创粉丝点击