:: 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;
|
При использовании материала - ссылка на сайт обязательна
|
|