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;
Related
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've created an class that should propagate to the entire application a customized message when its going to be freed.
I did it with PostMessage and it worked with few bugs
PostMessage(Application.Handle, UM_MYMESSAGE, 0, 0);
then I realized it should be synchronous - via SendMessage.
SendMessage(Application.Handle, UM_MYMESSAGE, 0, 0);
On my Form I was handling the messages with a TApplicationEvents component, but just switching SendMessage to PostMessage didn't make it handle the message
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
begin
if Msg.message = UM_MYMESSAGE then
begin
ShowMessage('Ok');
Handled := True;
end;
end;
It works if I pass the Form Handle but not working with Application.Handle...
What am I doing wrong?
The TApplication(Events).OnMessage event is triggered only for messages that are posted to the main UI thread message queue. Sent messages go directly to the target window's message procedure, bypassing the message queue. That is why your OnMessage event handler works with using PostMessage() but not SendMessage().
To catch messages that are sent to the TApplication window, you need to use TApplication.HookMainWindow() instead of TApplication(Events).OnMessage, eg:
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.HookMainWindow(MyAppHook);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Application.UnhookMainWindow(MyAppHook);
end;
function TForm1.MyAppHook(var Message: TMessage): Boolean;
begin
if Message.Msg = UM_MYMESSAGE then
begin
ShowMessage('Ok');
Result := True;
end else
Result := False;
end;
That being said, a better solution is to use AllocateHWnd() to create your own private window that you can post/send your custom messages to, eg:
procedure TForm1.FormCreate(Sender: TObject);
begin
FMyWnd := AllocateHWnd(MyWndMsgProc);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
DeallocateHWnd(FMyWnd);
end;
procedure TForm1.MyWndMsgProc(var Message: TMessage);
begin
if Message.Msg = UM_MYMESSAGE then
begin
ShowMessage('Ok');
Message.Result := 0;
end else
Message.Result := DefWindowProc(FMyWnd, Message.Msg, Message.WParam, Message.LParam);
end;
Then you can post/send messages to FMyWnd.
I have a simple form that only contains a TTouchKeyboard. The forms BorderStyle is set to bsToolWindow. To avoid the form getting focus when clicking the touch keyboard I handle the WM_MOUSEACTIVATE message with this implementation:
procedure TKeyboardForm.WMMouseActivate(var Message: TWMMouseActivate);
begin
Message.Result := MA_NOACTIVATE;
end;
The BorderStyle setting allows the form to be dragged with the title bar, but in that case the form still gets the focus. Is there a way to avoid this?
Update: I tried adding WS_EX_NOACTIVATE to ExStyle in CreateParams, but unfortunately that doesn't hinder the form to receive focus when dragged.
procedure TKeyboardForm.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.ExStyle := Params.ExStyle or WS_EX_NOACTIVATE;
end;
Because I was not very pleased with the approach that requires me to manually update the focused form variable in the keyboard form, I searched for a more transparent solution and came up with this approach.
Update: The previous approach had some issues with VCL styles. In addition not all of the message handlers were really necessary, though others turned out to be helpful, too. This version works well with VCL styles avoiding any flicker as far as possible:
type
TKeyboardForm = class(TForm)
TouchKeyboard1: TTouchKeyboard;
private
FLastFocusedForm: TCustomForm;
procedure SetLastFocusedForm(const Value: TCustomForm);
protected
procedure WMActivate(var Message: TWMActivate); message WM_ACTIVATE;
procedure WMMouseActivate(var Message: TWMMouseActivate); message WM_MOUSEACTIVATE;
procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
property LastFocusedForm: TCustomForm read FLastFocusedForm write SetLastFocusedForm;
public
class constructor Create;
destructor Destroy; override;
function SetFocusedControl(Control: TWinControl): Boolean; override;
end;
type
TKeyboardFormStyleHook = class(TFormStyleHook)
protected
procedure WMNCActivate(var Message: TWMNCActivate); message WM_NCACTIVATE;
end;
procedure TKeyboardFormStyleHook.WMNCActivate(var Message: TWMNCActivate);
begin
{ avoids the title bar being drawn active for blink }
Message.Active := False;
inherited;
end;
class constructor TKeyboardForm.Create;
begin
TCustomStyleEngine.RegisterStyleHook(TKeyboardForm, TKeyboardFormStyleHook);
end;
destructor TKeyboardForm.Destroy;
begin
LastFocusedForm := nil;
inherited;
end;
procedure TKeyboardForm.Notification(AComponent: TComponent; Operation: TOperation);
begin
if (Operation = opRemove) and (AComponent = FLastFocusedForm) then begin
FLastFocusedForm := nil;
end;
inherited;
end;
function TKeyboardForm.SetFocusedControl(Control: TWinControl): Boolean;
begin
LastFocusedForm := Screen.FocusedForm;
result := inherited;
end;
procedure TKeyboardForm.SetLastFocusedForm(const Value: TCustomForm);
begin
if FLastFocusedForm <> Value then
begin
if FLastFocusedForm <> nil then begin
FLastFocusedForm.RemoveFreeNotification(Self);
end;
FLastFocusedForm := Value;
if FLastFocusedForm <> nil then begin
FLastFocusedForm.FreeNotification(Self);
end;
end;
end;
procedure TKeyboardForm.WMActivate(var Message: TWMActivate);
begin
Message.Active := WA_INACTIVE;
inherited;
end;
procedure TKeyboardForm.WMMouseActivate(var Message: TWMMouseActivate);
begin
inherited;
Message.Result := MA_NOACTIVATE;
end;
procedure TKeyboardForm.WMSetFocus(var Message: TWMSetFocus);
begin
inherited;
if (FLastFocusedForm <> nil) and (message.FocusedWnd <> FLastFocusedForm.Handle) then begin
SendMessage(FLastFocusedForm.Handle, WM_SETFOCUS, 0, 0);
Message.FocusedWnd := FLastFocusedForm.Handle;
end;
end;
The following combination of WMMouseActivate(), WMNCActivate() and reseting focus seems to fulfill your wishes:
The keyboard form (with BorderStyle = bsToolWindow) has message handlers for WM_MOUSEACTIVATE (as you already have) and WM_NCACTIVATE. The latter for having a point where to reset focus to the window with the edit control.
In addition the keyboardform will keep track of which form holds the edit (or other) control that has focus, and does that by introducing a new method for showing, which I called ShowUnfocused() and a field called FocusedForm: THandle.
procedure TKbdForm.ShowUnfocused(FocusedWindow: THandle);
begin
FocusedForm := FocusedWindow;
Show;
end;
procedure TKbdForm.FormShow(Sender: TObject);
begin
SetForegroundWindow(FocusedForm);
end;
procedure TKbdForm.WMMouseActivate(var Message: TWMMouseActivate);
begin
Message.Result := MA_NOACTIVATE;
end;
procedure TKbdForm.WMNCActivate(var Message: TWMNCActivate);
begin
Message.Result := 1; // important
SetForegroundWindow(FocusedForm);
end;
The keyboardform is invoked by the following common code of the edit controls:
procedure TForm17.EditClick(Sender: TObject);
begin
KbdForm.ShowUnfocused(self.Handle);
(Sender as TWinControl).SetFocus;
end;
An alternative to what is said above, could be to set the BorderStyle = bsNone and arrange the dragging of the form with the Mouse Down, Move, Up events directly from the forms surface (or maybe a panel to mimic a top frame), and adding a close button. The challenge would be to get it visually acceptable.
I have a VCL form that is set for bsDialog with biHelp enabled ("?" icon in application bar).
I am following this example: http://delphi.about.com/od/adptips2006/qt/custom_bihelp.htm
However I cannot get the WMNCLBUTTONDOWN Windows Message to appear when I click the "?" button. It only seems to fire when I click on the title bar (like I was going to drag the window around.
Code:
procedure TMainFrm.WMNCLBUTTONDOWN(var Msg: TWMNCLButtonDown);
begin
ShowMessage('WMNCLBUTTONDOWN Pre-Help') ;
if Msg.HitTest = HTHELP then
Msg.Result := 0 // "eat" the message
else
inherited;
end;
procedure TMainFrm.WMNCLBUTTONUP(var Msg: TWMNCLButtonUp);
begin
if Msg.HitTest = HTHELP then
begin
Msg.Result := 0;
ShowMessage('Need help?') ;
end
else
inherited;
end;
Again, I see the "Pre-Help" message when I click on the title bar, but not when I click on the "?" button. Why is this? I'm trying to show a separate form when that button is clicked.
The modal message loop of ShowMessage interferes with the message processing. Use OutputDebugString, for example, to see that the messages fire as your expect:
type
TMainFrm = class(TForm)
protected
procedure WMNCLButtonDown(var Msg: TWMNCLButtonDown);
message WM_NCLBUTTONDOWN;
procedure WMNCLButtonUp(var Msg: TWMNCLButtonUp);
message WM_NCLBUTTONUP;
end;
....
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;
Remember that buttons are not pressed until they are released. So you should not be taking action like showing dialogs when the button goes down. Wait until WM_NCLBUTTONUP before showing another dialog.
I need to disable both mouse buttons on the event OnMouseEnter of a TRichEdit component and enable again on the event OnMouseLeave.
Setting the TRichEdit enabled = false does not solve my problem.
Any tips ?
You can subclass your rich edit so that to intercept mouse button down/up messages. Then you don't need to watch for the mouse entering, leaving the control. Example:
type
TForm1 = class(TForm)
...
private
FSaveRichEditProc: TWndMethod;
procedure RichEditWindowProc(var Message: TMessage);
..
end;
...
procedure TForm1.FormCreate(Sender: TObject);
begin
FSaveRichEditProc := RichEdit1.WindowProc;
RichEdit1.WindowProc := RichEditWindowProc;
end;
procedure TForm1.RichEditWindowProc(var Message: TMessage);
begin
case Message.Msg of
WM_LBUTTONDOWN, WM_LBUTTONUP, WM_LBUTTONDBLCLK,
WM_MBUTTONDOWN, WM_MBUTTONUP, WM_MBUTTONDBLCLK,
WM_RBUTTONDOWN, WM_RBUTTONUP, WM_RBUTTONDBLCLK:
begin
Message.Result := 0;
Exit;
end;
end;
FSaveRichEditProc(Message);
end;