in delphi mdi application there is need to show a child window with its caption in Mainform client area when maximize button is pressed using
Win32Check(Windows.GetClientRect(ClientHandle, aTRect));
MDIChild1.BoundsRect := aTRect;
functions.
So, how we can prevent a MDI child from being maximized when maximize button is pressed?
I've tried to do it using
procedure TChildText.WMSYSCOMMAND(var Message: TWMSYSCOMMAND);
var
aTRect:TRect;
begin
inherited;
case message.CmdType of
SC_MAXIMIZE:
begin
Win32Check(Windows.GetClientRect(MainForm.ClientHandle, aTRect));
BoundsRect := aTRect;
end;
end;
end;
with no result.
procedure TChildText.WMSYSCOMMAND(var Message: TWMSYSCOMMAND);
var
aTRect:TRect;
begin
if message.CmdType = SC_MAXIMIZE then
begin
Win32Check(Windows.GetClientRect(MainForm.ClientHandle, aTRect));
BoundsRect := aTRect;
message.CmdType := SC_RESTORE;
end;
inherited;
end;
Related
I'm in the process of "upgrading" a Delphi 2007 MDI application to Delphi 11.
I noticed the following behavior when closing an MDI child. When clicking the close icon, the icon menu disappears. Not a big thing, unless you have an OnClose event handler that prevents the Form from closing. Then the border icons do not come back. Even after I added the line:
BorderIcons := [biSystemMenu,biMinimize,biMaximize];
procedure TFrmSingleParts.FormClose(Sender: TObject; var Action: TCloseAction);
var
wMsg: Word;
begin
if (BcStockPart1.State = bcsInsert) then
begin
wMsg := gblPmsMessage.Show('ADDSTOCK', dmtConfirmation, [dmbYes, dmbNo, dmbCancel], 0);
case wMsg of
mrYes:
begin
BcStockPart1.Post;
Action := caFree
end;
mrNo:
begin
BcStockPart1.Cancel;
Action := caFree
end;
mrCancel:
begin
Action := caNone;
BorderIcons := [biSystemMenu,biMinimize,biMaximize];
end;
end;
end
else
begin
Action := caFree;
end;
end;
Any suggestions on how to restore the BorderIcons if the Form is not actually closed?
Working on a desktop application that consists mainly in a MDI parent form, where modules are shown as MDI Child form.
I want to get rid of the scroll bars when moving a child form outside the client limits. I've already set the AutoScroll property to False and tried the following solution:
procedure TForm1.FormCreate(Sender: TObject);
begin
if ClientHandle <> 0 then
begin
if (not (GetWindowLong(ClientHandle, GWL_USERDATA) <> 0)) then
begin
SetWindowLong(ClientHandle, GWL_USERDATA,
SetWindowLong(ClientHandle, GWL_WNDPROC,
Integer(#ClientWindowProc)));
end;
end;
end;
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
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;
end;
Result := CallWindowProc(f, wnd, Msg, wparam, lparam);
end;
It works like a charm if VCL Styles are not enabled. Otherwise, I cannot catch the WM_NCCALCSIZE message.
I'm using Delphi Rio 10.3.3 with VCL Styles on.
Found a workaround registering a StyleHook:
TFixedFormStyleHook = class(TFormStyleHook)
public
procedure WMMDIChildMove(var Message: TMessage); message WM_MDICHILDMOVE;
end;
procedure TFixedFormStyleHook.WMMDIChildMove(var Message: TMessage);
begin
handled := true;
end;
On begin execution:
TCustomStyleEngine.RegisterStyleHook(TForm,TFixedFormStyleHook);
I have a panel with a few TRadioButtons placed horizontally. If the most left button is focused and I press Left Arrow, the focus jumps to the most right button. I want to stop this behavoir for all arrows when they reach the edge. Is it possible ?
I tried overriding the WM_KEYDOWN but the buttons never receive this message when a arrow key is pressed.
TRadioButton = class(StdCtrls.TRadioButton)
protected
procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
procedure WMKeyUp(var Message: TWMKeyUp); message WM_KEYUP;
public
BlockLeft, BlockRight: Boolean;
constructor Create(AOwner: TComponent); override;
end;
constructor TRadioButton.Create(AOwner: TComponent);
begin
inherited;
BlockLeft:= False;
BlockRight:= False;
end;
procedure TRadioButton.WMKeyDown(var Message: TWMKeyDown);
begin
if BlockLeft and (Message.CharCode = VK_LEFT) then Exit;
if BlockRight and (Message.CharCode = VK_RIGHT) then Exit;
inherited;
end;
procedure TRadioButton.WMKeyUp(var Message: TWMKeyUp);
begin
if BlockLeft and (Message.CharCode = VK_LEFT) then Exit;
if BlockRight and (Message.CharCode = VK_RIGHT) then Exit;
inherited;
end;
VCL offsets keyboard messages to become a control notification and sends it to the message's destined control. Hence you should be intercepting a CN_KEYDOWN message instead.
If this is for a one time design consideration, I would prefer to handle this behavior at the form level since IMO a control, itself, shouldn't care where it is placed on. For a form where all radio buttons are expected to behave similar, an example could be:
procedure TForm1.CMDialogKey(var Message: TCMDialogKey);
begin
if ActiveControl is TRadioButton then
case Message.CharCode of
VK_LEFT, VK_UP: begin
if ActiveControl.Parent.Controls[0] = ActiveControl then begin
Message.Result := 1;
Exit;
end;
end;
VK_RIGHT, VK_DOWN: begin
if ActiveControl.Parent.Controls[ActiveControl.Parent.ControlCount - 1]
= ActiveControl then begin
Message.Result := 1;
Exit;
end;
end;
end;
inherited;
end;
If this is not for a one time behavior, I'd go for writing a container control as Victoria mentioned in the comments to the question.
I have an application that restores windows on startup but this results in a potential flicker as each window is created and positioned.
To get around this I have the splash screen (stretched to the full size of the screen) set to "StayOnTop" and close it after the OnShow event using a TTask. The problem is that occasionally the splash screen gets stuck. If you click where buttons should be they redraw and show correctly.
I have tried to "invalidate" all WinControls but this problem still shows up.
I have never seen the problem in the debugger.
Are there any other tricks anyone can suggest to forcing a full repaint of the screen?
Here is my code to close the splash - This is in the OnShow of the main form.
aTask := TTask.Create(procedure()
begin
Sleep(800);
TThread.Synchronize(nil, procedure()
begin
fSplash.Close;
FreeAndNil(fSplash);
DoInvalidate(self);
end);
end);
aTask.Start;
Here is my attempt to invalidate everything...
Procedure DoInvalidate( aWinControl: TWInControl );
var
i: Integer;
ctrl: TControl;
begin
for i:= 0 to aWinControl.Controlcount-1 do
begin
ctrl:= aWinControl.Controls[i];
if ctrl Is TWinControl then
DoInvalidate( TWincontrol( ctrl ));
end;
aWinControl.Invalidate;
end;
Martin
You don't need to recursively invalidate everything, just invalidating the Form itself is sufficient.
If you upgrade to 10.2 Tokyo, you can now use TThread.ForceQueue() instead of TThread.Synchronize() in a TTask:
procedure TMainForm.FormShow(Sender: TObject);
begin
TThread.ForceQueue(nil, procedure
begin
FreeAndNil(fSplash);
Application.MainForm.Invalidate;
end
);
end;
If you stick with TTask, you should at least use TThread.Queue() instead:
procedure TMainForm.FormShow(Sender: TObject);
begin
TTask.Create(procedure
begin
TThread.Queue(nil, procedure
begin
FreeAndNil(fSplash);
Application.MainForm.Invalidate;
end;
end
).Start;
end;
Or, you could just use a short TTimer, like zdzichs suggested:
procedure TMainForm.FormShow(Sender: TObject);
begin
Timer1.Enabled := True;
end;
procedure TMainForm.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
FreeAndNil(fSplash);
Invalidate;
end;
Or, you could assign an OnClose event handler to the splash form to invalidate the MainForm, and then PostMessage() a WM_CLOSE message to the splash form:
procedure TMainForm.FormCreate(Sender: TObject);
begin
fSplash := TSplashForm.Create(nil);
fSplash.OnClose := SplashClosed;
fSplash.Show;
end;
procedure TMainForm.FormShow(Sender: TObject);
begin
if fSplash <> nil then
PostMessage(fSplash.Handle, WM_CLOSE, 0, 0);
end;
procedure TMainForm.SplashClosed(Sender: TObject; var Action: TCloseAction);
begin
fSplash := nil;
Action := caFree;
Invalidate;
end;
Or, use the OnDestroy event instead:
procedure TMainForm.FormCreate(Sender: TObject);
begin
fSplash := TSplashForm.Create(nil);
fSplash.OnDestroy := SplashDestroyed;
fSplash.Show;
end;
procedure TMainForm.FormShow(Sender: TObject);
begin
if fSplash <> nil then
fSplash.Release; // <-- delayed free
end;
procedure TMainForm.SplashDestroyed(Sender: TObject);
begin
fSplash := nil;
Invalidate;
end;
I have a VCL form that is set for bsDialog with biHelp enabled ("?" icon in application bar). The application is also using a custom VCL Style (Aqua Light Slate).
However I cannot get the WMNCLBUTTONDOWN Windows Message to appear when I click the "?" button. It only works if the VCL Style of the application is changed back to Windows (Default).
procedure TMainFrm.WMNCLButtonDown(var Msg: TWMNCLButtonDown);
begin
if Msg.HitTest = HTHELP then
begin
OutputDebugString('Help button down');
Msg.Result := 0;
end
else
inherited;
end;
procedure TMainFrm.WMNCLButtonUp(var Msg: TWMNCLButtonUp);
begin
if Msg.HitTest = HTHELP then
begin
OutputDebugString('Help button up');
Msg.Result := 0;
end
else
inherited;
end;
Is there a way to get these events to fire with a custom VCL style?
The form style hook handles that message:
TFormStyleHook = class(TMouseTrackControlStyleHook)
....
procedure WMNCLButtonUp(var Message: TWMNCHitMessage); message WM_NCLBUTTONUP;
end;
The implementation includes this
else if (Message.HitTest = HTHELP) and (biHelp in Form.BorderIcons) then
Help;
This calls the virtual Help method of the form style hook. That is implemented like this:
procedure TFormStyleHook.Help;
begin
SendMessage(Handle, WM_SYSCOMMAND, SC_CONTEXTHELP, 0)
end;
So you could simply listen for WM_SYSCOMMAND and test wParam for SC_CONTEXTHELP. Like this:
type
TMainFrm = class(TForm)
protected
procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;
end;
....
procedure TMainFrm.WMSysCommand(var Message: TWMSysCommand);
begin
if Message.CmdType = SC_CONTEXTHELP then begin
OutputDebugString('Help requested');
Message.Result := 0;
end else begin
inherited;
end;
end;