home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d56 / RMCTL.ZIP / rmGlobalComponentHook.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-22  |  3KB  |  137 lines
  1. {================================================================================
  2. Copyright (C) 1997-2001 Mills Enterprise
  3.  
  4. Unit     : rmGlobalComponentHook
  5. Purpose  : Provides a standard stack type interface to the rmControls that
  6.            descend from TComponent and that hook their owners WndProc.  This
  7.            enables the component to correctly backout of the hook with out
  8.            hanging the form or application.
  9. Date     : 10-26-2000
  10. Author   : Ryan J. Mills
  11. Version  : 1.80
  12. ================================================================================}
  13.  
  14. unit rmGlobalComponentHook;
  15.  
  16. interface
  17.  
  18. {$I CompilerDefines.INC}
  19.  
  20. uses Controls, Windows;
  21.  
  22. Procedure PushOldProc(aWinControl:TWinControl; OldHook:TFarProc);
  23. Function PopOldProc(aWinControl:TWinControl):TFarProc;
  24.  
  25. implementation
  26.  
  27. uses classes;
  28.  
  29. type
  30.    TrmWinControlHookList = class(TObject)
  31.    private
  32.       fWinControl:TWinControl;
  33.       fHooks:TList;
  34.    public
  35.       constructor Create(aWinControl:TWinControl);
  36.       destructor destroy; override;
  37.       property WinControl:TWinControl read fWinControl;
  38.       procedure AddHook(oldHook:TFarProc);
  39.       function GetNextHook:TFarProc;
  40.       function Count:integer;
  41.    end;
  42.  
  43. var
  44.    FormList : TList;
  45.  
  46. Procedure PushOldProc(aWinControl:TWinControl; OldHook:TFarProc);
  47. var
  48.    loop : integer;
  49.    wHook : TrmWinControlHookList;
  50.    found : boolean;
  51. begin
  52.    found := false;
  53.    wHook := nil;
  54.    for loop := 0 to formlist.count-1 do
  55.    begin
  56.       wHook := TrmWinControlHookList(formlist[loop]);
  57.       found := wHook.WinControl = aWinControl;
  58.       if found then break;
  59.    end;
  60.    if found then
  61.       wHook.AddHook(oldHook)
  62.    else
  63.    begin
  64.       if assigned(aWinControl) then
  65.       begin
  66.          wHook := TrmWinControlHookList.create(aWinControl);
  67.          formlist.add(wHook);
  68.          wHook.addhook(oldhook);
  69.       end;
  70.    end;
  71. end;
  72.  
  73. Function PopOldProc(aWinControl:TWinControl):TFarProc;
  74. var
  75.    loop : integer;
  76.    wHook : TrmWinControlHookList;
  77.    found : boolean;
  78. begin
  79.    found := false;
  80.    wHook := nil;
  81.    for loop := 0 to formlist.count-1 do
  82.    begin
  83.       wHook := TrmWinControlHookList(formlist[loop]);
  84.       found := wHook.WinControl = aWinControl;
  85.       if found then break;
  86.    end;
  87.    if found then
  88.    begin
  89.       result := wHook.GetNextHook;
  90.       if wHook.Count = 0 then
  91.       begin
  92.          Formlist.Delete(loop);
  93.          wHook.free;
  94.       end;
  95.    end
  96.    else
  97.       result := nil;
  98. end;
  99.  
  100. { TrmWinControlHookList }
  101.  
  102. procedure TrmWinControlHookList.AddHook(oldHook: TFarProc);
  103. begin
  104.    fhooks.add(oldhook);  
  105. end;
  106.  
  107. function TrmWinControlHookList.Count: integer;
  108. begin
  109.    result := fhooks.count;
  110. end;
  111.  
  112. constructor TrmWinControlHookList.Create(aWinControl:TWinControl);
  113. begin
  114.    fWinControl := aWinControl;
  115.    fhooks := TList.create;
  116. end;
  117.  
  118. destructor TrmWinControlHookList.destroy;
  119. begin
  120.    fhooks.free;
  121.    inherited;  
  122. end;
  123.  
  124. function TrmWinControlHookList.GetNextHook: TFarProc;
  125. begin
  126.    result := fhooks[fhooks.count-1];
  127.    fhooks.delete(fhooks.count-1);
  128. end;
  129.  
  130. initialization
  131.    FormList := TList.create;
  132.  
  133. finalization
  134.    FormList.free;         
  135.  
  136. end.
  137.