Помощь - Поиск - Пользователи - Календарь
Полная версия: Application Bar
Форум «Всё о Паскале» > Delphi, Assembler и другие языки. > Delphi
hardcase
Решил разобраться с Application Bar - панелью, вроде всем известного таскбара.
Создал класс формы, которая может превращатся в такую панель.
Но вот возникла проблема: если после регистрации и создания панели я перемещаю на это место форму, то форма возвращается на своё текущее место! проблема не решается использованием ни MoveWindow ни SetBounds.
Полагаю, в VCL встроена защита от перемещения формы за позиции десктопа - чтоб её не закрывал таскбар или ещё какая панелька. Не знаете, как это обойти?
hardcase
Проблема решена cool.gif
hardcase
подумал, мож кому понадобится.
вот код выложу.
unit AppBar;

interface

uses
  Windows, Messages, ShellAPI, SysUtils, Classes, Controls, Forms;

const
  APPBAR_CALLBACK = WM_USER + 400;

type
  TAppBarEdge = (abeLeft = ABE_LEFT, abeTop = ABE_TOP, abeRight = ABE_RIGHT,
                 abeBottom = ABE_BOTTOM);

  TAppBarCallbackMessage = packed record
      Msg: cardinal;
      NotifCode: cardinal;
      lParam: cardinal;
  end;

  TAppBarForm = class(TForm)
    private
      abd: APPBARDATA;
      fRegistered: boolean;
      OldStyle: TBorderStyle;
      OldPos: TRect;
      fInit: boolean;
      function GetEdge: TAppBarEdge;
      procedure SetEdge(NewVal: TAppBarEdge);
      procedure RegisterBar;
      procedure UnregisterBar;
      procedure SetBarPos(const CurRect: TRect; Edge: cardinal);
      procedure BarPosChanged;
    protected
      procedure CreateWnd; override;
      procedure DestroyWnd; override;
      procedure AppBarCallback(var Message: TAppBarCallbackMessage); message APPBAR_CALLBACK;
      procedure WMSize(var Message: TWMSize); message WM_SIZE;
    public
      constructor Create(AOwner: TComponent); override;
      destructor Destroy; override;
      procedure InitBar(AEdge: TAppBarEdge);
      procedure ReleaseBar;
      property Registered: boolean read fRegistered;
      property Edge: TAppBarEdge read GetEdge write SetEdge;
  end;//of class

implementation

{ ### TAppBarForm ############################################################ }

constructor TAppBarForm.Create(AOwner: TComponent);
  begin
    inherited;
    abd.uEdge:=ABE_BOTTOM;
  end;

destructor TAppBarForm.Destroy;
  begin
    ReleaseBar;
    inherited;
  end;

  { ### private ### }

function TAppBarForm.GetEdge: TAppBarEdge;
  begin
    Result:=TAppBarEdge(abd.uEdge);
  end;

procedure TAppBarForm.SetEdge(NewVal: TAppBarEdge);
  begin
    if abd.uEdge=cardinal(NewVal) then Exit;
    abd.uEdge:=cardinal(NewVal);
    if Registered then BarPosChanged;
  end;

procedure TAppBarForm.RegisterBar;
  begin
    abd.cbSize:=sizeof(abd);
    abd.hWnd:=Handle;
    abd.uCallbackMessage:=APPBAR_CALLBACK;
    if BOOL(SHAppBarMessage(ABM_NEW,abd)) then fRegistered:=true
    else fRegistered:=false;
  end;

procedure TAppBarForm.UnregisterBar;
  begin           
    SHAppBarMessage(ABM_REMOVE,abd);
    fRegistered:=false;
  end;

procedure TAppBarForm.SetBarPos(const CurRect: TRect; Edge: cardinal);
  var iHeight: integer;
      iWidth: integer;
  begin
    iHeight:=0;
    iWidth:=0;
    abd.rc:=CurRect;
    with abd.rc do
      if (Edge = ABE_LEFT) or (Edge = ABE_RIGHT) then begin
          iWidth:=Right - Left;
          Top:=0;
          Bottom:=GetSystemMetrics(SM_CYSCREEN);
      end else begin
          iHeight:=Bottom - Top;
          Left:=0;
          Right:=GetSystemMetrics(SM_CXSCREEN);
      end;
    SHAppBarMessage(ABM_QUERYPOS,abd);
    with abd.rc do
      case Edge of
        ABE_LEFT:    Right:=Left + iWidth;
        ABE_RIGHT:   Left:=Right - iWidth;
        ABE_TOP:     Bottom:=Top + iHeight;
        ABE_BOTTOM:  Top:=Bottom - iHeight;
      end;//of case
    SHAppBarMessage(ABM_SETPOS,abd);
    with abd.rc do MoveWindow(Handle,Left,Top,Right-Left,Bottom-Top,true);
      //  SetWindowPos(Handle,HWND_TOPMOST,Left,Top,Right-Left,Bottom-Top,
      //               SWP_NOACTIVATE or SWP_SHOWWINDOW);
  end;

procedure TAppBarForm.BarPosChanged;
  var rc: TRect;
      rcWindow: TRect;
      Height, Width: integer;
  begin
    with rc do begin
        Top:=0;
        Left:=0;
        Right:=GetSystemMetrics(SM_CXSCREEN);
        Bottom:=GetSystemMetrics(SM_CYSCREEN);
    end;
    GetWindowRect(abd.hWnd,rcWindow);
    with rcWindow do begin
        Height:=Bottom - Top;
        Width:=Right - Left;
    end;
    case abd.uEdge of
        ABE_TOP:     with rc do Bottom:=Top + Height;
        ABE_BOTTOM:  with rc do Top:=Bottom - Height;
        ABE_LEFT:    with rc do Right:=Left + Width;
        ABE_RIGHT:   with rc do Left:=Right - Width;
    end;//of case
    SetBarPos(rc,abd.uEdge);
  end;

  { ### protected ### }

procedure TAppBarForm.CreateWnd;
  begin
    inherited;
//    if Registered then begin
//        fRegistered:=false;
//        InitBar(Edge);
//    end;
  end;

procedure TAppBarForm.DestroyWnd;
  begin
//    ReleaseBar;
    inherited;
  end;

procedure TAppBarForm.AppBarCallback(var Message: TAppBarCallbackMessage);
  var State: cardinal;
  begin
    case Message.NotifCode of
      ABN_STATECHANGE: begin Beep;
          State:=SHAppBarMessage(ABM_GETSTATE,abd);
          if BOOL(ABS_ALWAYSONTOP and State) then
              with abd.rc do
              SetWindowPos(abd.hWnd, HWND_TOPMOST, Left, Top, Right-Left, Bottom-Top,
                           {SWP_NOMOVE or SWP_NOSIZE or} SWP_NOACTIVATE)
          else
              with abd.rc do
              SetWindowPos(abd.hWnd, HWND_BOTTOM, Left, Top, Right-Left, Bottom-Top,
                           {SWP_NOMOVE or SWP_NOSIZE or} SWP_NOACTIVATE)
      end;
      ABN_FULLSCREENAPP: begin
          State:=SHAppbarMessage(ABM_GETSTATE, abd);
          if BOOL(Message.lParam) then begin
              if BOOL(ABS_ALWAYSONTOP and State) then
                  with abd.rc do
                  SetWindowPos(abd.hWnd, HWND_TOPMOST, Left, Top, Right-Left, Bottom-Top,
                               {SWP_NOMOVE or SWP_NOSIZE or} SWP_NOACTIVATE)
              else
                  with abd.rc do
                  SetWindowPos(abd.hWnd, HWND_BOTTOM, Left, Top, Right-Left, Bottom-Top,
                               {SWP_NOMOVE or SWP_NOSIZE or} SWP_NOACTIVATE)
          end else begin
              if BOOL(ABS_ALWAYSONTOP and State) then
                  with abd.rc do
                  SetWindowPos(abd.hWnd, HWND_TOPMOST, Left, Top, Right-Left, Bottom-Top,
                               {SWP_NOMOVE or SWP_NOSIZE or} SWP_NOACTIVATE)
          end;
      end;
      ABN_POSCHANGED: begin
          BarPosChanged
      end;
    end;//of case
  end;

procedure TAppBarForm.WMSize(var Message: TWMSize);
  begin
    inherited;
    if Registered and not fInit then BarPosChanged;
  end;

  { ### public ### }

procedure TAppBarForm.InitBar(AEdge: TAppBarEdge);
  begin
    if Registered then Exit;
    fInit:=true;
    try
      OldStyle:=BorderStyle;
      BorderStyle:=bsNone;
      OldPos.Left:=Left;
      OldPos.Top:=Top;
      OldPos.Right:=OldPos.Left + Width;
      OldPos.Bottom:=OldPos.Top + Height;
      RegisterBar;
      abd.uEdge:=cardinal(AEdge);
      BarPosChanged;
    finally
      fInit:=false;
    end;
  end;

procedure TAppBarForm.ReleaseBar;
  var WasRegistered: boolean;
  begin
    WasRegistered:=Registered;
    UnregisterBar;
    if WasRegistered then begin
        with OldPos do MoveWindow(Handle,Left,Top,Right-Left,Bottom-Top,true);
        BorderStyle:=OldStyle;
    end;
  end;

initialization
  SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);

end.

чтобы использовать надо просто заменить в форме, созданной в конструкторе форм, имя предка с TForm на TAppBarForm.
Метод InitBar создаёт новую панельку, а ReleaseBar - убирает её и возвращает форму в предыдущее состояние.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.