:: MVP ::
|
|
:: RSS ::
|
|
|
Как скрывать свернутые дочерние формы в MDI приложении?
// Способ первый
// В код MDIChild формы нужно добавить следующее
type
TForm2 = class(TForm)
{...}
public
{ Public declarations }
procedure WMSize(var Msg: TWMSIZE); message WM_SIZE;
{...}
end;
implementation
procedure TForm2.WMSize(var Msg: TWMSIZE);
begin
inherited;
if Msg.SizeType = SIZE_MINIMIZED then
if Msg.SizeType = SIZE_MINIMIZED then
ShowWindow(Handle, SW_HIDE);
end;
// Способ второй
// В код MDIChild формы нужно добавить следующее
type
TForm2 = class(TForm)
private
procedure WMSize(var Msg: TWMSIZE); message WM_SIZE;
protected
procedure VisibleChanging; override;
{...}
end;
implementation
procedure TForm2.VisibleChanging;
begin
end;
procedure TForm2.WMSize(var Msg: TWMSIZE);
begin
inherited;
if Visible then // Чтобы форма не скрытась при создании
if Msg.SizeType = SIZE_MINIMIZED then
Visible := False;
end;
// Способ третий
// В код MDIChild формы нужно добавить следующее
type
TForm2 = class(TForm)
procedure FormShow(Sender: TObject);
public
procedure DefaultHandler(var Message); override;
{...}
end;
implementation
procedure TForm2.DefaultHandler(var Message);
begin
inherited;
if TMessage(Message).Msg = WM_SIZE then
if TMessage(Message).WParam = SIZE_MINIMIZED then
Visible := False;
end;
procedure TForm2.FormShow(Sender: TObject);
begin
Parent := Application.MainForm;
end;
|
Как создать дочернюю форму без заголовка?
// Способ первый
procedure TForm2.FormCreate(Sender: TObject);
begin
SetWindowLong(Handle, GWL_STYLE,
GetWindowLong(Handle, GWL_STYLE) and not WS_CAPTION);
Width := ClientWidth;
Height := ClientHeight;
end;
// Способ второй
type
TForm2 = class(TForm)
private
{ Private declarations }
procedure CreateParams(var Params: TCreateParams); override;
public
{ Public declarations }
end;
procedure TForm2.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.Style := Params.Style and (not WS_CAPTION);
end;
|
Как скрыть/показать скроллы в MDI форме?
implementation
{$R *.dfm}
var
flag: boolean = false;
function ClientWindowProc(Wnd: HWND; Msg: Cardinal; wParam, lParam: Integer): Integer; stdcall;
var
f: Pointer;
begin
f := Pointer(GetWindowLong(Wnd, GWL_USERDATA));
case Msg of
WM_NCCALCSIZE: begin
// flag = false - скрыть полосы прокрутки; flag = true - показать полосы прокрутки;
if not flag then
begin
if (GetWindowLong(Wnd, GWL_STYLE) and (WS_HSCROLL or WS_VSCROLL)) <> 0 then
SetWindowLong(Wnd, GWL_STYLE, GetWindowLong(Wnd, GWL_STYLE) and
not (WS_HSCROLL or WS_VSCROLL));
end
else
begin
if (GetWindowLong(Wnd, GWL_STYLE) and (WS_HSCROLL or WS_VSCROLL)) = 0 then
SetWindowLong(Wnd, GWL_STYLE, GetWindowLong(Wnd, GWL_STYLE) or
(WS_HSCROLL or WS_VSCROLL));
end;
end;
end;
Result := CallWindowProc(f, Wnd, Msg, wParam, lParam);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
if ClientHandle <> 0 then
begin
if GetWindowLong(ClientHandle, GWL_USERDATA) <> 0 then
Exit;
SetWindowLong(ClientHandle, GWL_USERDATA, SetWindowLong(ClientHandle,
GWL_WNDPROC, integer(@ClientWindowProc)));
end;
end;
|
Как заставить корректно работать скроллы MDIForm при перетаскивании дочернего окна?
// Способ первый
var
Form1: TForm1;
implementation
{$R *.dfm}
var
WndProcHook: HHook;
function CallWndHook(Code: Integer; WParam: wParam; Msg: PCWPStruct): LongInt; stdcall;
var
VertMin, VertMax, HorzMin, HorzMax: Integer;
begin
case Msg^.message of
WM_MOVE: begin
GetScrollRange(Form1.ClientHandle, SB_HORZ, HorzMin, HorzMax);
GetScrollRange(Form1.ClientHandle, SB_VERT, VertMin, VertMax);
SetScrollRange(Form1.ClientHandle, SB_HORZ, HorzMin, HorzMax, True);
SetScrollRange(Form1.ClientHandle, SB_VERT, VertMin, VertMax, True);
end;
end;
Result := CallNextHookEx(WndProcHook, Code, WParam, LongInt(Msg));
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
WndProcHook := SetWindowsHookEx(WH_CALLWNDPROC, @CallWndHook, 0, GetCurrentThreadID);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if WndProcHook > 0 then
UnHookWindowsHookEx(WndProcHook);
end;
// Способ второй
// MDIForm
type
TForm1 = class(TForm)
public
procedure UpdateScrollBars;
end;
var
Form1: TForm1;
implementation
procedure TForm1.UpdateScrollBars;
var
VertMin, VertMax, HorzMin, HorzMax: Integer;
begin
GetScrollRange(ClientHandle, SB_HORZ, HorzMin, HorzMax);
GetScrollRange(ClientHandle, SB_VERT, VertMin, VertMax);
SetScrollRange(ClientHandle, SB_HORZ, HorzMin, HorzMax, True);
SetScrollRange(ClientHandle, SB_VERT, VertMin, VertMax, True);
end;
// MDIChild
type
TForm2 = class(TForm)
private
procedure WMMove(var Msg: TWMMove); message WM_MOVE;
end;
implementation
uses
Unit1;
procedure TForm2.WMMove(var Msg: TWMMove);
begin
inherited;
Form1.UpdateScrollBars;
end;
|
Как подменить оконную процедуру в MDI приложении?
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
MDIDefProc: pointer;
MDIInstance: TFarProc;
procedure MDIWndProc(var Msg: TMessage);
public
end;
implementation
procedure TForm1.MDIWndProc(var Msg: TMessage);
begin
with Msg do
begin
if Msg = WM_MDINEXT then
begin
// Запрещаем перемещение между окнами по CTRL+TAB и CTRL+F6
end
else
Result := CallWindowProc(MDIDefProc, ClientHandle, Msg, wParam, lParam);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
MDIInstance := MakeObjectInstance(MDIWndProc);
MDIDefProc := Pointer(SetWindowLong(ClientHandle, GWL_WNDPROC,
LongInt(MDIInstance)));
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
SetWindowLong(ClientHandle, GWL_WNDPROC, LongInt(MDIDefProc));
FreeObjectInstance(MDIInstance);
end;
|
Как отключить переключение между дочерними окнами по CTRL+TAB/CTRL+F6?
function ClientWindowProc(Wnd: HWND; Msg: Cardinal; wParam, lParam: Integer): Integer; stdcall;
var
f: Pointer;
begin
f := Pointer(GetWindowLong(Wnd, GWL_USERDATA));
if Msg <> WM_MDINEXT then
Result := CallWindowProc(f, Wnd, Msg, wParam, lParam);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
if ClientHandle <> 0 then
begin
if GetWindowLong(ClientHandle, GWL_USERDATA) <> 0 then
Exit;
SetWindowLong(ClientHandle, GWL_USERDATA, SetWindowLong(ClientHandle,
GWL_WNDPROC, Integer(@ClientWindowProc)));
end;
end;
|
Как перевести дочернюю форму в режим StayOnTop и обратно?
procedure TForm1.Button1Click(Sender: TObject);
var
r: TRect;
begin
if Form2.FormStyle <> fsStayOnTop then
begin
Form2.Tag := MakeLong(Form2.Left, Form2.Top);
Form2.FormStyle := fsStayOnTop;
// SetWindowLong(Form2.Handle, GWL_HWNDPARENT, Application.MainForm.Handle);
end
else
begin
GetWindowRect(Form2.Handle, r);
Form2.FormStyle := fsMDIChild;
MoveWindow(Form2.Handle, LoWord(Form2.Tag), HiWord(Form2.Tag), r.Width, r.Height, True);
end;
end;
|
При использовании материала - ссылка на сайт обязательна
|
|