← →Gennady
(2002-01-15 10:35)
[1]
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, ToolWin, ImgList, ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
ToolBar1: TToolBar;
ToolButton1: TToolButton;
tlbWins: TToolBar;
ilWins: TImageList;
procedure ToolButton1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
FClientInstance : TFarProc;
FPrevClientProc : TFarProc;
procedure MyMessager(var Message: TMessage);
procedure tbMDIClick(Sender: TObject);
procedure tbMDBIMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses Unit2;
{$R *.DFM}
procedure TForm1.tbMDBIMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var r: integer;
p: TPoint;
childHWND: HWND;
begin
SendMessage(Self.ClientHandle, WM_MDIACTIVATE, (Sender as TToolButton).Tag, 0);
if Button=mbRight then
begin
with (Sender as TControl) do
p:=ClientToScreen(Point(x, 0));
childHWND:=(Sender as TControl).Tag;
SendMessage(childHWND, WM_INITMENU, GetSystemMenu(childHWND, false), 0);
r:=integer(TrackPopupMenuEx(GetSystemMenu(childHWND, false), TPM_LEFTALIGN OR
TPM_RETURNCMD OR TPM_RIGHTBUTTON OR TPM_HORIZONTAL OR TPM_VERTICAL, p.x, p.y, childHWND, nil));
SendMessage(childHWND, WM_SYSCOMMAND, r, 0);
end;
end;
procedure TForm1.tbMDIClick(Sender: TObject);
begin
SendMessage(Self.ClientHandle, WM_MDIACTIVATE, (Sender as TToolButton).Tag, 0);
end;
procedure TForm1.MyMessager(var Message: TMessage);
procedure DoDefault;
begin
with Message do
Result := CallWindowProc(FPrevClientProc, ClientHandle, Msg, wParam, lParam);
end;
var i: integer;
begin
with Message do
case Msg of
WM_MDICREATE:
begin
with TToolButton.Create(Self) do
begin
Parent:=tlbWins;
Caption:=PMDICreateStruct(Pointer(Message.LParam))^.szTitle;
Grouped:=True;
Style:=tbsCheck;
Down:=True;
Hint:=Caption;
AutoSize:=True;
OnClick:=tbMDIClick;
DoDefault;
tag:=Result;
for i:=0 to Self.MDIChildCount-1 do
if Self.MDIChildren[i].Handle=Tag then
ImageIndex:=ilWins.AddIcon(Self.MDIChildren[i].Icon);
OnMouseUp:=tbMDBIMouseUp;
end;
end;
WM_MDIDESTROY:
begin
DoDefault;
for i:=0 to tlbWins.ButtonCount-1 do
if tlbWins.Buttons[i].Tag=wParam then
begin
tlbWins.Buttons[i].Free;
exit;
end;
end;
WM_MDIACTIVATE:
begin
DoDefault;
for i:=0 to tlbWins.ButtonCount-1 do
if tlbWins.Buttons[i].Tag=wParam then
begin
tlbWins.Buttons[i].Down:=True;
exit;
end;
end;
WM_MDINEXT:
begin
DoDefault;
for i:=0 to tlbWins.ButtonCount-1 do
if tlbWins.Buttons[i].Tag=Self.ActiveMDIChild.Handle then
begin
tlbWins.Buttons[i].Down:=True;
exit;
end;
end;
else
DoDefault;
end;
end;
procedure TForm1.ToolButton1Click(Sender: TObject);
begin
with TForm2.Create(Application) do Show;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
FPrevClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
FClientInstance := MakeObjectInstance(MyMessager);
SetWindowLong(ClientHandle, GWL_WNDPROC, LongInt(FClientInstance));
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
FreeObjectInstance(FClientInstance);
SetWindowLong(ClientHandle, GWL_WNDPROC, LongInt(FPrevClientProc));
end;
end.
пример не ахти какой, но рабочий.
думаю сложностей не возникнет.
Панель окон Найти похожие ветки
← →