// Das eigene
Fenster wird als
zusätzliche Taskbar am oberen Bildschirmrand 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





