appbars.pas

《Delphi开发人员指南》配书原码

unit AppBars;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ShellAPI, StdCtrls, Buttons, ExtCtrls, Menus;

type
  TAppBarEdge = (abeTop, abeBottom, abeLeft, abeRight);

  EAppBarError = class(Exception);

  TAppBar = class(TForm)
    PopupMenu1: TPopupMenu;
    Top1: TMenuItem;
    Bottom1: TMenuItem;
    Left1: TMenuItem;
    Right1: TMenuItem;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    SpeedButton5: TSpeedButton;
    OpenDialog1: TOpenDialog;
    N1: TMenuItem;
    Exit1: TMenuItem;
    procedure Top1Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure MoveButtons;
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
 private
    FABD: TAppBarData;
    FEdge: TAppBarEdge;
    FTopMost: Boolean;
    FLastChecked: TMenuItem;
    procedure WMActivate(var M: TMessage); message WM_ACTIVATE;
    procedure WMWindowPosChanged(var M: TMessage); message WM_WINDOWPOSCHANGED;
    function SendAppBarMsg(Msg: DWORD): UINT;
    procedure SetAppBarPos(Edge: UINT);
    procedure SetAppBarEdge(Value: TAppBarEdge);
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure SetTopMost(TopMost: Boolean);
    procedure WndProc(var M: TMessage); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Edge: TAppBarEdge read FEdge write SetAppBarEdge;
    property TopMost: Boolean read FTopMost write SetTopMost default True;
  end;

var
  AppBar: TAppBar;

implementation

{$R *.DFM}

uses Main;

const
  DEF_APPBAR_WIDTH  = 40;
  DEF_APPBAR_HEIGHT = 35;

var
  AppBarMsg: UINT = 0;

constructor TAppBar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  // set up the TAppBarData record
  with FABD do
  begin
    cbSize := SizeOf(FABD);
    hWnd := Handle;
    uCallbackMessage := AppBarMsg;
  end;
  // Inform the shell of the new AppBar
  if SendAppBarMsg(ABM_NEW) = 0 then
    raise EAppBarError.Create('Failed to create AppBar');
  // Initialize the position
  SetAppBarPos(ABE_TOP);
  FTopMost := True;
  FLastChecked := Top1;
end;

destructor TAppBar.Destroy;
begin
  // Must inform shell that the AppBar is going away
  SendAppBarMsg(ABM_REMOVE);
  inherited Destroy;
end;

procedure TAppBar.WMWindowPosChanged(var M: TMessage);
begin
  inherited;
  // Must inform shell that the AppBar position has changed
  SendAppBarMsg(ABM_WINDOWPOSCHANGED);
end;

procedure TAppBar.WMActivate(var M: TMessage);
begin
  inherited;
  // Must inform shell that the AppBar window was activated
  SendAppBarMsg(ABM_ACTIVATE);
end;

procedure TAppBar.WndProc(var M: TMessage);
var
  State: UINT;
begin
  if M.Msg = AppBarMsg then
  begin
    case M.WParam of
      // Sent when always on top or autohide state has changed.
      ABN_STATECHANGE:
        begin
          // Check to see whether the access bar is still ABS_ALWAYSONTOP.
          State := SendAppBarMsg(ABM_GETSTATE);
          if ABS_ALWAYSONTOP and State = 0 then
            SetTopMost(False)
          else
            SetTopMost(True);
        end;
      // A full screen application has started, or the last
      // full-screen application has closed.
      ABN_FULLSCREENAPP:
        begin
          // Set the access bar's z-order appropriately.
          State := SendAppBarMsg(ABM_GETSTATE);
          if M.lParam <> 0 then begin
            if ABS_ALWAYSONTOP and State = 0 then
              SetTopMost(False)
            else
              SetTopMost(True);
          end
          else
            if State and ABS_ALWAYSONTOP <> 0 then
              SetTopMost(True);
        end;
      // Sent when something happened which may effect the AppBar position.  
      ABN_POSCHANGED:
        begin
          // The taskbar or another access bar
          // has changed its size or position.
          SetAppBarPos(FABD.uEdge);
        end;
    end;
  end
  else
    inherited WndProc(M);
end;

function TAppBar.SendAppBarMsg(Msg: DWORD): UINT;
begin
  Result := SHAppBarMessage(Msg, FABD);
end;

procedure TAppBar.SetAppBarPos(Edge: UINT);
begin
  FABD.uEdge := Edge;       // set edage
  with FABD.rc do
  begin
    // set coordinates to full-scren
    Top := 0;
    Left := 0;
    Right := Screen.Width;
    Bottom := Screen.Height;
    // Send ABM_QUERYPOS to obtain proper rect on edge
    SendAppBarMsg(ABM_QUERYPOS);
    // re-adjust rect based on that modified by ABM_QUERYPOS
    case Edge of
      ABE_LEFT: Right := Left + DEF_APPBAR_WIDTH;
      ABE_RIGHT: Left := Right - DEF_APPBAR_WIDTH;
      ABE_TOP: Bottom := Top + DEF_APPBAR_HEIGHT;
      ABE_BOTTOM: Top := Bottom - DEF_APPBAR_HEIGHT;
    end;
    // Set the app bar position.
    SendAppBarMsg(ABM_SETPOS);
  end;
  // Set the BoundsRect property so that it conforms to the
  // bounding rectangle passed to the system.
  BoundsRect := FABD.rc;
end;

procedure TAppBar.SetTopMost(TopMost: Boolean);
const
  WndPosArray: array[Boolean] of HWND = (HWND_BOTTOM, HWND_TOPMOST);
begin
  SetWindowPos(Handle, WndPosArray[TopMost], 0, 0, 0, 0, SWP_NOMOVE or
    SWP_NOSIZE or SWP_NOACTIVATE);
end;

procedure TAppBar.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.ExStyle := WS_EX_TOOLWINDOW or WS_EX_TOPMOST;
  Params.Style := WS_VISIBLE or WS_POPUP or WS_THICKFRAME or WS_CLIPCHILDREN;
end;

procedure TAppBar.SetAppBarEdge(Value: TAppBarEdge);
const
  EdgeArray: array[TAppBarEdge] of UINT = (ABE_TOP, ABE_BOTTOM, ABE_LEFT,
    ABE_RIGHT);
begin
  if Value <> FEdge then
  begin
    SetAppBarPos(EdgeArray[Value]);
    FEdge := Value;
    MoveButtons;
  end;
end;

procedure TAppBar.Top1Click(Sender: TObject);
begin
  FLastChecked.Checked := False;
  (Sender as TMenuItem).Checked := True;
  case TMenuItem(Sender).Caption[2] of
    'T': Edge := abeTop;
    'B': Edge := abeBottom;
    'L': Edge := abeLeft;
    'R': Edge := abeRight;
  end;
  FLastChecked := TMenuItem(Sender);
end;

procedure TAppBar.MoveButtons;
// This method looks complicated, but it really just arranges the buttons
// properly depending on what side the AppBar is docked.
var
  DeltaCenter, NewPos: Integer;
begin
  if (FEdge = abeTop) or (FEdge = abeBottom) then
  begin
    DeltaCenter := (ClientHeight - SpeedButton1.Height) div 2;
    SpeedButton1.SetBounds(10, DeltaCenter, SpeedButton1.Width, SpeedButton1.Height);
    NewPos := SpeedButton1.Width + 20;
    SpeedButton2.SetBounds(NewPos, DeltaCenter, SpeedButton1.Width, SpeedButton1.Height);
    NewPos := NewPos + SpeedButton1.Width + 10;
    SpeedButton3.SetBounds(NewPos, DeltaCenter, SpeedButton1.Width, SpeedButton1.Height);
    NewPos := NewPos + SpeedButton1.Width + 10;
    SpeedButton4.SetBounds(NewPos, DeltaCenter, SpeedButton1.Width, SpeedButton1.Height);
    NewPos := NewPos + SpeedButton1.Width + 10;
    SpeedButton5.SetBounds(NewPos, DeltaCenter, SpeedButton1.Width, SpeedButton1.Height);
  end;
  if (FEdge = abeLeft) or (FEdge = abeRight) then
  begin
    DeltaCenter := (ClientWidth - SpeedButton1.Width) div 2;
    SpeedButton1.SetBounds(DeltaCenter, 10, SpeedButton1.Width, SpeedButton1.Height);
    NewPos := SpeedButton1.Height + 20;
    SpeedButton2.SetBounds(DeltaCenter, NewPos, SpeedButton1.Width, SpeedButton1.Height);
    NewPos := NewPos + SpeedButton1.Height + 10;
    SpeedButton3.SetBounds(DeltaCenter, NewPos, SpeedButton1.Width, SpeedButton1.Height);
    NewPos := NewPos + SpeedButton1.Height + 10;
    SpeedButton4.SetBounds(DeltaCenter, NewPos, SpeedButton1.Width, SpeedButton1.Height);
    NewPos := NewPos + SpeedButton1.Height + 10;
    SpeedButton5.SetBounds(DeltaCenter, NewPos, SpeedButton1.Width, SpeedButton1.Height);
  end;
end;

procedure TAppBar.SpeedButton1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
    MainForm.FileName := OpenDialog1.FileName;
end;

procedure TAppBar.SpeedButton2Click(Sender: TObject);
begin
  MainForm.memEditor.Lines.SaveToFile(MainForm.FileName);
end;

procedure TAppBar.SpeedButton3Click(Sender: TObject);
begin
  MainForm.memEditor.CutToClipboard;
end;

procedure TAppBar.SpeedButton4Click(Sender: TObject);
begin
  MainForm.memEditor.CopyToClipboard;
end;

procedure TAppBar.SpeedButton5Click(Sender: TObject);
begin
  MainForm.memEditor.PasteFromClipboard;
end;

procedure TAppBar.Exit1Click(Sender: TObject);
begin
  Application.Terminate;
end;

initialization
  AppBarMsg := RegisterWindowMessage('DDG AppBar Message');
end.