Форум: "Основная";
Текущий архив: 2002.01.31;
Скачать: [xml.tar.bz2];

Вниз

Панель окон   Найти похожие ветки 

← →
Slavan   (2002-01-14 13:35) [0]

Привет всем!

Может кто подскажет где взять компонент - панель дочерних окон MDI приложения.(При открытии дрочернего окна на панели появляется кнопка с иконкой окна и заголовком, как в Windows панель задач или в 1С панель окон )

Спасибо.

---

← →
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.

пример не ахти какой, но рабочий.
думаю сложностей не возникнет.

---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2002.01.31;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.46 MB
Время: 0.004 c