home *** CD-ROM | disk | FTP | other *** search
/ DOS/V Power Report 1997 May / VPR9705A.ISO / VPR_DATA / PROGRAM / Delphi / User_vcl / apbar101 / AppBar.pas < prev   
Pascal/Delphi Source File  |  1996-12-01  |  7KB  |  267 lines
  1. unit AppBar;
  2.  
  3. interface
  4.  
  5. uses
  6.     Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.     ShellAPI;
  8.  
  9. const
  10.     WM_APPBARcb = WM_USER;
  11.  
  12. type
  13.     TBar = 8..1000;
  14.     TPos = (tpTop, tpBottom, tpLeft, tpRight);
  15.  
  16.     TWindowMove = procedure(R: TRect) of object;
  17.     TActivate   = procedure(Sender: TObject) of object;
  18.     TDeactivate = procedure(Sender: TObject) of object;
  19.  
  20.     TAppBar = class(TComponent)
  21.     private
  22.         First:        Bool;
  23.         FBarWidth:    TBar;
  24.         FBarHeight:    TBar;
  25.         FPosition:    TPos;
  26.         FAutoHide:    Bool;
  27.         FAutoMove:    Bool;
  28.         FEnable:    Bool;
  29.         FWnd:        Hwnd;
  30.         Fabd:        TAppBarData;
  31.  
  32.         NewP:        TFarProc;
  33.         OldP:        TFarProc;
  34.         FWindowMove:TWindowMove;
  35.         FActivate  :TActivate;
  36.         FDeactivate:TDeactivate;
  37.  
  38.         procedure SetBarWidth(V: TBar);
  39.         procedure SetBarHeight(V: TBar);
  40.         procedure SetPosition(V: TPos);
  41.         procedure SetAutoHide(V: Bool);
  42.         procedure SetEnable(V: Bool);
  43.     protected
  44.         procedure Loaded; override;
  45.         procedure InstallAppBar(F: Bool);
  46.         procedure SetPosAppBar;
  47.         procedure WndProc(var Msg: TMessage);
  48.     public
  49.         constructor Create(AOwner: TComponent); override;
  50.         destructor Destroy; override;
  51.     published
  52.         property BarWidth:   TBar read FBarWidth  write SetBarWidth;
  53.         property BarHeight:  TBar read FBarHeight write SetBarHeight;
  54.         property Position:   TPos read FPosition  write SetPosition;
  55.         property AutoHide:   Bool read FAutoHide  write SetAutoHide;
  56.         property AutoMove:   Bool read FAutoMove  write FAutoMove;
  57.         property Enable:     Bool read FEnable    write SetEnable;
  58.  
  59.         property OnWindowMove: TWindowMove read FWindowMove write FWindowMove;
  60.         property OnActivate:   TActivate   read FActivate   write FActivate;
  61.         property OnDeactivate: TDeactivate read FDeactivate write FDeactivate;
  62.     end;
  63.  
  64. procedure Register;
  65.  
  66. implementation
  67.  
  68. //------------------------------------------------------------------------------
  69. procedure Register;
  70. begin
  71.     RegisterComponents('SoH', [TAppBar]);
  72. end;
  73. //------------------------------------------------------------------------------
  74. constructor TAppBar.Create(AOwner: TComponent);
  75. var
  76.     L: Longint;
  77. begin
  78.     Inherited Create(AOwner);
  79.     First:=False;
  80.     Fwnd:=TForm(AOwner).Handle;
  81.  
  82.     NewP:=MakeObjectInstance(WndProc);
  83.     OldP:=Pointer(SetWindowLong(Fwnd, GWL_WNDPROC, Longint(NewP)));
  84.  
  85.     FEnable   := True;
  86.     FAutoHide := False;
  87.     FAutoMove := True;
  88.     FBarWidth := 30;
  89.     FBarHeight:= 30;
  90.  
  91.     if csDesigning in ComponentState then Exit;
  92.     L:=GetWindowLong(Fwnd, GWL_EXSTYLE);
  93.     SetWindowLong(Fwnd, GWL_EXSTYLE, L or $0080);
  94. end;
  95. //------------------------------------------------------------------------------
  96. procedure TAppBar.Loaded;
  97. begin
  98.     inherited Loaded;
  99.     First:=True;
  100.  
  101.     if FEnable then InstallAppBar(True);
  102. end;
  103. //------------------------------------------------------------------------------
  104. destructor TAppBar.Destroy;
  105. begin
  106.     if FEnable then InstallAppBar(False);
  107.  
  108.     SetWindowLong(Fwnd, GWL_WNDPROC, Longint(OldP));
  109.     FreeObjectInstance(NewP);
  110.  
  111.     Inherited;
  112. end;
  113. //------------------------------------------------------------------------------
  114. procedure TAppBar.SetBarWidth(V: TBar);
  115. begin
  116.     if FBarWidth<>V then
  117.     begin
  118.         FBarWidth:=V;
  119.         SetPosAppBar;
  120.     end;
  121. end;
  122. //------------------------------------------------------------------------------
  123. procedure TAppBar.SetBarHeight(V: TBar);
  124. begin
  125.     if FBarHeight<>V then
  126.     begin
  127.         FBarHeight:=V;
  128.         SetPosAppBar;
  129.     end;
  130. end;
  131. //------------------------------------------------------------------------------
  132. procedure TAppBar.SetPosition(V: TPos);
  133. begin
  134.     if FPosition<>V then
  135.     begin
  136.         FPosition:=V;
  137.         SetPosAppBar;
  138.     end;
  139. end;
  140. //------------------------------------------------------------------------------
  141. procedure TAppBar.SetAutoHide(V: Bool);
  142. begin
  143.     if FAutoHide<>V then
  144.     begin
  145.         if FEnable then
  146.         begin
  147.             FAutoHide:=V;
  148.             SetPosAppBar;
  149.         end;
  150.     end;
  151. end;
  152. //------------------------------------------------------------------------------
  153. procedure TAppBar.SetEnable(V: Bool);
  154. begin
  155.     if FEnable<>V then
  156.     begin
  157.         FEnable:=V;
  158.         InstallAppBar(V);
  159.     end;
  160. end;
  161. //------------------------------------------------------------------------------
  162. procedure TAppBar.InstallAppBar(F: Bool);
  163. var
  164.     R: TRect;
  165. begin
  166.     if csDesigning in ComponentState then Exit;
  167.  
  168.     Fabd.cbSize:=SizeOf(TAppBarData);
  169.     Fabd.hWnd:=Fwnd;
  170.     Fabd.uCallBackMessage:=WM_APPBARcb;
  171.  
  172.     if F then
  173.     begin
  174.         ShAppBarMessage(ABM_NEW, Fabd);
  175.         SetPosAppBar;
  176.     end else
  177.         ShAppBarMessage(ABM_REMOVE, Fabd);
  178. end;
  179. //------------------------------------------------------------------------------
  180. procedure TAppBar.SetPosAppBar;
  181. var
  182.     R: TRect;
  183.     B: Bool;
  184.     Bw,Bh: Integer;
  185. begin
  186.     if csDesigning in ComponentState then Exit;
  187.     if FEnable=False then Exit;
  188.     if First=False then Exit;
  189.  
  190.     Fabd.lParam:=0;
  191.     ShAppBarMessage(ABM_SETAUTOHIDEBAR, Fabd);
  192.  
  193.     case Position of
  194.      tpTop:    Fabd.uEdge:=ABE_TOP;
  195.      tpBottom: Fabd.uEdge:=ABE_BOTTOM;
  196.      tpLeft:   Fabd.uEdge:=ABE_LEFT;
  197.      tpRight:  Fabd.uEdge:=ABE_RIGHT;
  198.     end;
  199.  
  200.     Fabd.lParam:=Integer(FAutoHide);
  201.     ShAppBarMessage(ABM_SETAUTOHIDEBAR, Fabd);
  202.  
  203.     Fabd.RC:=Bounds(0,0,GetSystemMetrics(SM_CXSCREEN)
  204.          ,GetSystemMetrics(SM_CYSCREEN));
  205.  
  206.     case Position of
  207.      tpTop:    Fabd.RC.Bottom:=Fabd.RC.Top    + BarHeight;
  208.      tpBottom: Fabd.RC.Top   :=Fabd.RC.Bottom - BarHeight;
  209.      tpLeft:   Fabd.RC.Right :=Fabd.RC.Left   + BarWidth;
  210.      tpRight:  Fabd.RC.Left  :=Fabd.RC.Right  - BarWidth;
  211.     end;
  212.  
  213.     ShAppBarMessage(ABM_QUERYPOS, Fabd);
  214.  
  215.     case Position of
  216.      tpTop:    Fabd.RC.Bottom:=Fabd.RC.Top    + BarHeight;
  217.      tpBottom: Fabd.RC.Top   :=Fabd.RC.Bottom - BarHeight;
  218.      tpLeft:   Fabd.RC.Right :=Fabd.RC.Left   + BarWidth;
  219.      tpRight:  Fabd.RC.Left  :=Fabd.RC.Right  - BarWidth;
  220.     end;
  221.     R:=Fabd.RC;
  222.  
  223.     ShAppBarMessage(ABM_SETPOS, Fabd);
  224.     Fabd.RC:=R;
  225.  
  226.     if FAutoMove then
  227.         MoveWindow(Fwnd, R.Left, R.Top, R.Right-R.Left, R.Bottom-R.Top, True);
  228.     if Assigned(OnWindowMove) then OnWindowMove(Fabd.RC);
  229. end;
  230. //------------------------------------------------------------------------------
  231. procedure TAppBar.WndProc(var Msg: TMessage);
  232. var
  233.     R: TRect;
  234. begin
  235.     case Msg.Msg of
  236.      WM_ACTIVATE: begin
  237.         ShAppBarMessage(ABM_ACTIVATE, Fabd);
  238.         if Bool(Msg.wParam)=True then begin
  239.             if Assigned(OnActivate) then OnActivate(Self);
  240.         end else begin
  241.             if Assigned(OnDeactivate) then OnDeactivate(Self);
  242.         end;
  243.      end;
  244.  
  245.      WM_WINDOWPOSCHANGED:
  246.         ShAppBarMessage(ABM_WINDOWPOSCHANGED, Fabd);
  247.  
  248.      WM_WINDOWPOSCHANGING: ;
  249.  
  250.      WM_APPBARcb: begin
  251.         case Msg.wParam of
  252.          ABN_POSCHANGED:
  253.             SetPosAppBar;
  254.          ABN_FULLSCREENAPP: ;
  255.          ABN_STATECHANGE: ;
  256.          ABN_WINDOWARRANGE:
  257.         end;
  258.      end;
  259.     end;
  260.  
  261.     Msg.Result:=CallWindowProc(OldP, Fwnd, Msg.Msg, Msg.wParam, Msg.lParam);
  262. end;
  263. //------------------------------------------------------------------------------
  264.  
  265. end.
  266.  
  267.