TPageControl tab area OnMouseEnter OnMouseLeave events - delphi

I need to catch the "OnMouseEnter" and "0nMouseLeave" for a certain area of the TPageControl component. With that specific area I mean the whole "tab header" rectangle.
The problem is, that the page control doesn't catch the messages (I'm catching internal control messages CM_MOUSEENTER and CM_MOUSELEAVE) in the "empty" space.
The aim for me is to draw a small arrow in the right empty side when user hovers in the red framed area (and drawing is just piece of cake) and erase it when leaves this area. And I'm don't care about the overflow of the tabs (which causes to draw scrolling double button) - that will never happen.
Here is the working piece of code, but it's not the clear solution and I don't like it. There must be another (more clean) way to do it.
type
TPageControl = class(ComCtrls.TPageControl)
protected
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
end;
procedure TPageControl.CMMouseLeave(var Message: TMessage);
begin
inherited;
Canvas.TextOut(Width - 130, 5, 'CMMouseLeave'); // display result
end;
procedure TPageControl.WMNCHitTest(var Message: TWMNCHitTest);
var TabHeaderRect: TRect;
begin
if Message.Result = 0 then // if Message.Result = HTNOWHERE ...
begin
TabHeaderRect := ClientRect;
TabHeaderRect.Bottom := Top + 21;
if PtInRect(TabHeaderRect, ScreenToClient(Point(Message.XPos, Message.YPos))) then
Canvas.TextOut(Width - 130, 5, 'WMNCHitTest '); // display result
Message.Result := HTCLIENT;
end
else
inherited;
end;

Obviously, the empty space does not belong to the control's client area and so the control doesn't get any mouse-related Windows messages for that area. You will have to use the form's mouse events. Or put the page control inside a panel (using alClient) and use the panel's mouse events.
If you need this more than once, you could create a new component that does exactly that (combine a panel and a page control to achieve the desired behaviour).

Are you sure you're handling OnMouseEnter/OnMouseLeave for the page control itself, and not for the TTabSheet instance that it contains?

Related

How to be notified at the END of Horizontal Scrolling in TListView?

In a VCL Application, I am trying to be notified when I END the horizontal scrolling in a TListView with this interposer class code:
type
TListView = class(Vcl.ComCtrls.TListView)
private
procedure WMNotify(var AMessage: TWMNotify); message WM_NOTIFY; // used for other purposes
procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
procedure WMVScroll(var Msg: TWMHScroll); message WM_VSCROLL;
procedure WMHScroll(var Msg: TWMHScroll); message WM_HSCROLL;
protected
procedure CreateWnd; override;
end;
implementation
procedure TListView.CNCommand(var Message: TWMCommand);
begin
case Message.NotifyCode of
EN_VSCROLL: CodeSite.Send('TListView.CNCommand: EN_VSCROLL'); // does not work
EN_HSCROLL: CodeSite.Send('TListView.CNCommand: EN_HSCROLL'); // does not work
end;
inherited ;
end;
procedure TListView.WMHScroll(var Msg: TWMHScroll);
begin
CodeSite.Send('TListView.WMHScroll: WM_HSCROLL'); // does work
inherited;
end;
procedure TListView.WMVScroll(var Msg: TWMHScroll);
begin
CodeSite.Send('TListView.WMVScroll: WM_VSCROLL'); // does work
inherited;
end;
However, only WHILE scrolling I get constantly notified by WM_HSCROLL and WM_VSCROLL generating a lot of messages.
But I need to be notified only at the END of the horizontal scrolling! Is this possible?
The comments given to the Q are very relevant.
First, as Remy Lebeau stated, the WM_HSCROLL message tells you if the operation is done:
procedure TListView.WMHScroll(var Msg: TWMHScroll);
begin
inherited;
if Msg.ScrollCode = SB_ENDSCROLL then
ShowMessage('End scroll')
end;
However, this only lets you know when a scrolling operation initiated by the horizontal scroll bar is done. Currently, this includes these scroll-bar operations:
Thumb released
Scroll bar LEFT or RIGHT button clicked
Scroll bar empty area clicked (for page scroll)
Scroll bar context menu item selected
But there are many other ways the list view control can be scrolled, which have nothing to do with the scroll bar:
Using your mouse's horizontal scrolling wheel (or the standard vertical wheel if there is only a horizontal scroll bar and no vertical one)
Using your keyboard's left and right arrow keys (or Ctrl+Left/Right for page scroll)
With MultiSelect = True, making a selection rectangle with the mouse (start dragging outside any list-view item)
Hence, by reacting only to WM_HSCROLL, you will not detect these scrolling events. Almost certainly, you want to react when the scroll position has changed, no matter how it was changed.
And, as AmigoJack wrote, it is not absolutely clear what "end" means (other than when you release the mouse button after having dragging the scroll bar thumb). For instance, if you scroll using your mouse wheel, is the result a single large scroll operation or several small ones? After all, in any case, even thumb tracking, the control repaints itself at every small step.
So probably your best option is to use
procedure TListView.CNNotify(var Message: TMessage);
begin
inherited;
if PNMHDR(Message.lParam).code = LVN_ENDSCROLL then
// Scrolled
end;
According to the documentation,
Notifies a list-view control's parent window when a scrolling operation ends.
Notice that the documentation says that the notification is sent when the operation ends. Still, you will find that it is sent for every small update while you drag the scroll bar thumb. As mentioned above, this is reasonable: scrolling has indeed been performed after every such small step.

Capturing vertical and horizontal scroll from mousewheel

I need to capture mousewheel events in my application to move the view area like modern UI's since my application will run mostly on laptops.
I have looked into Windows messages and apparently only controls inherited from TWinControl can recieve mousewheel messages.
I'm using TApplicationEvents, that can also capture those mesagges. I tried handling the WM_MOUSEWHEEL message, but it works only for vertical scrolling. I also tried handling WM_HSCROLL and WM_HSCROLLCLIPBOARD messages, but they were not captured at all.
How can I capture both vertical and especially horizontal mousewheel messages and use them in my software?
You simply need to respond to WM_MOUSEHWHEEL messages. For instance, here's an extract from a class of mine which adds horizontal mouse wheel scrolling to a scroll box:
procedure TMyScrollBox.WndProc(var Message: TMessage);
begin
if Message.Msg=WM_MOUSEHWHEEL then begin
(* For some reason using a message handler for WM_MOUSEHWHEEL doesn't work.
The messages don't always arrive. It seems to occur when both scroll bars
are active. Strangely, if we handle the message here, then the messages
all get through. Go figure! *)
if TWMMouseWheel(Message).Keys=0 then begin
HorzScrollBar.Position := HorzScrollBar.Position
+ TWMMouseWheel(Message).WheelDelta;
Message.Result := 0;
end else begin
Message.Result := 1;
end;
end else begin
inherited;
end;
end;
First you need to handle the message WM_MOUSEHWHEEL.
Notice that the letter "H" is in there (WM_MOUSE H WHEEL).
I added a TApplicationEvent componenet and added the following code
to the OnMessage event:
uses VCL.Controls;
.....
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
var ctrl: TWinControl;
begin
ctrl := FindVCLWindow(Mouse.CursorPos); //first I need to find the control under the mouse
if ctrl is T3DWorldViewerComponent then //then I need to make sure
//that the control under the mouse
//is the 3D World Viewer contains my graphics
if msg.message = WM_MOUSEHWHEEL then //then I need to make sure that I want to scroll Horizontally
begin
if msg.wParam=4287102976 then //this indicates that I'm scrolling to the left
world.CameraMoveTo(MyCamera.Position.X+0.03, MyCamera.Position.Y, MyCamera.Position.Z)
else
if msg.wParam=7864320 then //and this indicates that I'm scrolling to the right
world.CameraMoveTo(MyCamera.Position.X-0.03, MyCamera.Position.Y, MyCamera.Position.Z);
end;
end;
Done!

Delphi: how to handle click on PageControl's empty space?

I'm using Delphi 7.
I want to react on click(left) on empty space of PageControl -- on area righter than the last tab shown. How can i do that?
You can handle the click at the parent control of the PageControl. F.i. if the PageControl is placed on a form, the form's 'MouseDown' events will be called for that specified region. The reason is that the PageControl returns HTTRANSPARENT for hit test messages for that region, so the mouse messages is directed to the control beneath it.
If that's not OK, you can change how WM_NCHITTEST is handled, for example by subclassing the control, or in a derived control:
type
TMyPageControl = class(TPageControl)
protected
procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
end;
procedure TMyPageControl.WMNCHitTest(var Message: TWMNCHitTest);
begin
inherited;
if Message.Result = HTTRANSPARENT then
Message.Result := HTCLIENT;
end;
then, the control's OnMouseDown event will be fired. Of course you could test for the region before modifying the message's return value, this example was only to show how it would work.

What should I do not to allow a window to be activated? [duplicate]

This question already has answers here:
Closed 11 years ago.
Possible Duplicate:
How to prevent form from being activated when the users clicks on it?
What I exactly mean, is that I want to create a popup window that exactly looks like a Tooltip window. I'm using ShowWindow and SetWindowPos to show and set its position. I already tried SW_SHOWNOACTIVE and it works perfect for the time when the popup appears; but when I click on the popup window, it gets focused, and I don't want this to happen. Also, when this popup is visible no matter it's focused or not, no message is sent to the window placed behind it.
I'm actually writing an Object Inspector component and for long values, it has to show a tooltip when mouse hovers a long value. I want this tooltip to look like a common one. I don't want to use Windows Tooltips not Delphi Tooltip directly. I want to use my own window.
P.S. I thought that this problem is common , and I searched, but I couldn't find an answer that exactly matches my question.
Thanks in advance.
Javid
Try this:
TMyTooltipWindow = class(TCustomControl)
private
procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
procedure WMMouseActivate(var Message: TWMMouseActivate); message WM_MOUSEACTIVATE;
protected
procedure CreateParams(var Params: TCreateParams); override;
end;
procedure TMyTooltipWindow.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.Style := WS_POPUP or WS_BORDER;
Params.ExStyle := WS_EX_TOOLWINDOW;
Params.WindowClass.style := Params.WindowClass.style + CS_SAVEBITS;
end;
procedure TMyTooltipWindow.WMMouseActivate(var Message: TWMMouseActivate);
begin
inherited;
Message.Result := MA_NOACTIVATE;
end;
procedure TMyTooltipWindow.WMNCHitTest(var Message: TWMNCHitTest);
begin
// this will make your window transparent for clicks
Message.Result := HTTRANSPARENT;
end;
This will not allow to activate the window with mouse.
Also having a look at THintWindow in Controls.pas might be helpful.

Delphi form without system menu but with close button

By default, a form having BorderStyle=bsSizeable has a system menu (on the left) and a close button ('X', on the right). I want to get rid of the system menu and keep the close button.
The BorderIcons property lets me remove the system menu (via biSystemmenu), but now the close button is gone too.
Is there a way to do this?
Using Delphi XE
PS: it should be possible as far as Windows is concerned: IE8's "InPrivate Filtering settings" window is sizeable, has a close button and has no system menu.
BorderStyle := bsSizeToolWin does what you want, with a slightly different appearance of the X button.
By "system menu" do you mean icon on the left of title bar? Or popup menu invoked via right click?
If it is icon that you want to remove - use this code:
const
WM_ResetIcon = WM_APP - 1;
type
TForm1 = class(TForm)
procedure FormShow(Sender: TObject);
protected
procedure WMResetIcon(var Message: TMessage); message WM_ResetIcon;
end;
implementation
procedure TForm1.FormShow(Sender: TObject);
begin
PostMessage(Handle, WM_ResetIcon, 0, 0);
end;
procedure TForm1.WMResetIcon(var Message: TMessage);
const
ICON_SMALL = 0;
ICON_BIG = 1;
begin
DestroyIcon(SendMessage(Handle, WM_SETICON, ICON_BIG, 0));
DestroyIcon(SendMessage(Handle, WM_SETICON, ICON_SMALL, 0));
end;
I don't think there is a way to do this without resorting to custom drawing your non-client area which is very difficult when glass is involved.
Consider this method.
procedure TMyForm.DeleteSystemMenu;
var
SystemMenu: HMenu;
begin
SystemMenu := GetSystemMenu(Handle, False);
DeleteMenu(SystemMenu, SC_CLOSE, MF_BYCOMMAND);
end;
Yes it succeeds in getting rid of the close item from the system menu, but it also results in the close button being disabled. So it would seem that you can't have one without the other.

Resources