Решил разобраться с Application Bar - панелью, вроде всем известного таскбара. Создал класс формы, которая может превращатся в такую панель. Но вот возникла проблема: если после регистрации и создания панели я перемещаю на это место форму, то форма возвращается на своё текущее место! проблема не решается использованием ни MoveWindow ни SetBounds. Полагаю, в VCL встроена защита от перемещения формы за позиции десктопа - чтоб её не закрывал таскбар или ещё какая панелька. Не знаете, как это обойти?
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;
чтобы использовать надо просто заменить в форме, созданной в конструкторе форм, имя предка с TForm на TAppBarForm. Метод InitBar создаёт новую панельку, а ReleaseBar - убирает её и возвращает форму в предыдущее состояние.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.