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.
Related
I am trying to implement my own drawing on a TEdit control when it does not have focus (show ellipsis in TEdit when the editor doesn’t fully display its text). So I starאed with this code:
type
TEdit = class(StdCtrls.TEdit)
private
FEllipsis: Boolean;
FCanvas: TCanvas;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
constructor TEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FEllipsis := False;
FCanvas := TControlCanvas.Create;
TControlCanvas(FCanvas).Control := Self;
end;
destructor TEdit.Destroy;
begin
FCanvas.Free;
inherited;
end;
procedure TEdit.WMPaint(var Message: TWMPaint);
begin
if FEllipsis and (not Focused) then
begin
// Message.Result := 0;
// TODO...
end
else
inherited;
end;
Notice that when FEllipsis and (not Focused) the message handler does nothing.
Now I dropped a TButton and 2 TEdit controls on the form, and added form OnCreate:
procedure TForm1.FormCreate(Sender: TObject);
begin
Edit2.FEllipsis := True;
end;
I expected Edit1 to draw normally, and Edit2 not to draw anything inside the edit control.
Instead the message handler was processed endlessly, Edit1 was not drawn also, and the entire application was choking (with 25% CPU usage!). I have also tried returning Message.Result := 0 - same effect.
Now, for the "strange" part: When I obtain the canvas handle with BeginPaint, everything works as expected.
procedure TEdit.WMPaint(var Message: TWMPaint);
var
PS: TPaintStruct;
begin
if FEllipsis and (not Focused) then
begin
if Message.DC = 0 then
FCanvas.Handle := BeginPaint(Handle, PS)
else
FCanvas.Handle := Message.DC;
try
// paint on FCanvas...
finally
FCanvas.Handle := 0;
if Message.DC = 0 then EndPaint(Handle, PS);
end;
end
else
inherited;
end;
Notice I did not call inherited either.
How to explain this behavior? Thanks.
When a window is invalidated, it is asked to make itself valid at the next paint cycle. Typically that happens in the main thread message loop when GetMessage finds that the queue is empty. At that point WM_PAINT messages are synthesised and dispatched to the window.
When the window receives these messages, its task is to paint itself. That is typically done with calls to BeginPaint and then EndPaint. The call to BeginPaint validates the window's client rect. This is the critical piece of information that you are lacking.
Now, in your code, you did not call inherited and so did not paint anything, and did not call BeginPaint / EndPaint. Because you did not call BeginPaint, the window remains invalid. And so an endless stream of WM_PAINT messages are generated.
The relevant documentation can be found here:
The BeginPaint function automatically validates the entire client area.
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.
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;
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;
I'm trying to make app to show some information, It'll create Panels runtime and place info on it, each panel will be flat as on picture, also app will use runtime themes, so i'd not be able to change panel bg color on mouse move, I tried to place info on TSpeedButton :v O.o it has wonderfull highlight function when it's flat while app is using runtime theme, but the main problem is that images and labels aren't moving when i move speedbutton and i need this much, they just stay there..
I tried to edit TCustomPanel.Paint to see if panel will look like highlighted button, adding code at the end:
PaintRect := ClientRect;
Details := StyleServices.GetElementDetails(ttbButtonHot);
StyleServices.DrawElement(Canvas.Handle, Details, PaintRect);
but with no success..
also it's pretty hard to link some custom code OnClick event at runtime, e.g:
ShowMessage('custom message on each panel');
I have not got any idea on how to do this, hope some one will give me advice or show me some example..
btw, panel will be created this way:
var
P: TPanel;
begin
P := TPanel.Create(Self);
P.Left := 20;
P.Top := 100;
P.Width := 60;
P.Height := 20;
P.Visible := True;
P.Parent := Self;
#P.OnClick := #Showmessageproc; // somehow this way..
end;
App pic:
If i do so:
procedure TMyPanel.MouseMove(Shift: TShiftState; X, Y: Integer);
var
mEvnt: TTrackMouseEvent;
begin
inherited;
if not FMouseTracking then begin
mEvnt.cbSize := SizeOf(mEvnt);
mEvnt.dwFlags := TME_LEAVE;
mEvnt.hwndTrack := Handle;
TrackMouseEvent(mEvnt);
FMouseTracking := True;
showmessage('IN');
end;
end;
procedure TMyPanel.WMMouseLeave(var Msg: TMessage);
begin
if Msg.Msg = WM_MOUSELEAVE then showmessage('OUT');
Msg.Result := 0;
FMouseTracking := False;
if Assigned(FOnMouseLeave) then
FOnMouseLeave(Self);
end;
procedure G(Sender: TObject);
begin
showmessage('message');
end;
procedure TMainFrm.Button1Click(Sender: TObject);
var
P: TMyPanel;
begin
P := TMyPanel.Create(Self);
P.Left := 20;
I := I + 100;
P.Top := I;
P.Width := 200;
P.Height := 80;
P.Visible := True;
P.Parent := Self;
#P.OnClick := #g;
end;
when I move mouse on runtime created panel, 2 msgbox appears, IN and OUT, "mousemove" works fine but "mouse leave" bad, also the mainc question is still actual. the problem is that that I can't get canvas of created panel to draw on. the example above could be achieved more simple way:
#P.OnMouseLeave := #onmouseleaveproc;
#P.OnMouseMove := #onmousemoveproc;
but with Canvas, everything is more difficult, somewhere i've read that canvas is protected in TCustomPanel.
Also there's another question: Is it possible to handle panel wich called e.g OnMouseMove ? because there maybe will be 30 of them (runtime created panels)
I've tried this way: (and it does not works)
type
TMyPanel = class(TPanel)
public
constructor Create(AOwner: TComponent); override;
private
// FMouseTracking: Boolean;
// FOnMouseLeave: TNotifyEvent;
procedure CMMouseEnter(var msg: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var msg: TMessage); message CM_MOUSELEAVE;
protected
// procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
published
// property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
end;
constructor TMyPanel.Create(AOwner: TComponent);
begin
ControlStyle := ControlStyle - [csParentBackground] + [csOpaque];
inherited;
end;
procedure TMyPanel.CMMouseEnter(var msg: TMessage);
begin
inherited;
Color := clBlue;
{ Do Whatever }
end;
procedure TMyPanel.CMMouseLeave(var msg: TMessage);
begin
inherited;
Color := clRed;
{ Do Whatever }
end;
Simply, color does not changes. (color changes with themes OFF)
It's basically explained here for Delphi 6, but same concept I think. You want to define a custom windows message handler for your panel. This will give you basic mouse enter/exit capability. You can then play with setting TPanel properties from there to find something to your liking. For example, to mock a speed button, you might be able to just set the background color and change the border bevel accordingly. If that isn't adequate, you can write to the TPanel's Canvas directly (paint the behavior that you want to see) on mouse enter/exit to get the visual behavior you're after.
I created the following new component in Delphi and installed it. A new TColorPanel component showed up in a new MyComponents tab in the IDE. I then used this to put a TColorPanel on a new app and it responded properly to the mouse enter/leave events, changing the color as desired. I'm not sure how you made your app's panels as TMyPanel instead of standard TPanel. This is just how I tried it. I used your latest message handling code as-is.
unit ColorPanel;
interface
uses
WinTypes, WinProcs, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls;
type
TColorPanel = class(TPanel)
public
constructor Create(AOwner: TComponent); override;
private
procedure CMMouseEnter(var msg: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var msg: TMessage); message CM_MOUSELEAVE;
protected
// procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
published
// property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('MyComponents', [TColorPanel]);
end;
constructor TColorPanel.Create(AOwner: TComponent);
begin
ControlStyle := ControlStyle - [csParentBackground] + [csOpaque];
inherited;
end;
procedure TColorPanel.CMMouseEnter(var msg: TMessage);
begin
inherited;
Color := clBlue;
{ Do Whatever }
end;
procedure TColorPanel.CMMouseLeave(var msg: TMessage);
begin
inherited;
Color := clRed;
{ Do Whatever }
end;
end.
I'm not sure why yours isn't working, other than to determine how you declared your app's panels to be TMyPanel.