// Das eigene Fenster wird als zusätzliche Taskbar am oberen Bildschirmrand
// erstellt.
//
(Befindet sich die Original-Taskbar oben, wird die Erstellung abgewiesen)
// Man sollte aber unbedingt noch eine Routine hinzufügen, die auf
// Größenänderung reagiert.
//
(oder die Größenänderung verhindert, siehe
die Ausmaße eines Fensters begrenzen )


// Getestet mit D4 unter WinME

unit bar; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  StdCtrls; 
 
type 
  TForm1 = class(TForm) 
    Button1: TButton; 
    procedure FormClose(Sender: TObject; var Action: TCloseAction); 
    procedure FormCreate(Sender: TObject); 
    procedure Button1Click(Sender: TObject); 
  private 
{ Private-Deklarationen } 
  public 
    procedure createparams(var params: TCreateparams); override; 
    function NewTaskBar(h: HWND; da_weg: boolean; Hoehe: uint): boolean; 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.DFM} 
 
uses shellapi; 
 
const 
  IstDa: boolean = false; 
 
var 
  abd: _APPBARDATA; 
 
procedure TForm1.createparams; 
begin 
  inherited createparams(params); 
  with params do 
    style := (style or ws_popup) and (not ws_dlgframe); 
end; 
 
function Tform1.NewTaskBar(h: HWND; da_weg: boolean; Hoehe: uint): boolean; 
var 
  original: _AppBarData; 
begin 
  result := false; 
  abd.cbSize := sizeof(_APPBARDATA); 
  abd.hWnd := h; 
  if da_weg then begin 
    original.cbsize := sizeof(_AppBarData); 
    SHAppBarMessage(ABM_GETTASKBARPOS, original); 
//--------- oben ---------- 
    case original.uEdge of 
      ABE_TOP: exit; 
      ABE_LEFT: abd.rc := rect(original.rc.right, 
          0, screen.width - original.rc.right, Hoehe); 
      ABE_RIGHT: abd.rc := rect(0, 0, original.rc.right, Hoehe); 
    else abd.rc := rect(0, 0, screen.width, Hoehe); 
    end; 
    abd.uEdge := ABE_TOP; 
    button1.left := 1; 
    button1.top := 1; 
// ----------------------- 
    if SHAppBarMessage(ABM_NEW, abd) = 0 then exit; 
    SHAppBarMessage(ABM_SETPOS, abd); 
    setwindowpos(h, HWND_TOPMOST, abd.rc.left, abd.rc.top, 
      abd.rc.right, abd.rc.bottom, SWP_SHOWWINDOW); 
    result := true; 
    istda := true; 
  end else begin 
    if SHAppBarMessage(ABM_REMOVE, abd) = 0 then exit; 
    result := true; 
    istda := false; 
  end; 
end; 
 
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); 
begin 
  if istda then NewTaskBar(handle, false, 0); 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  if not NewTaskBar(handle, true, 35) then showmessage('Fehler'); 
end; 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  close; 
end; 
 
end.



Zugriffe seit 6.9.2001 auf Delphi-Ecke