I am trying to implement a feature similar to most media players where by moving your mouse above the media duration track bar it will display a small popup informing you on the time your mouse is currently above. I noticed an odd behaviour though while implementing the code given below.
procedure TForm1.TrackBar1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Single);
var
pers: Extended;
begin
pers := (X/TrackBar1.Width);
PixelLabel.Text := FloatToStr(pers * TrackBar1.Max);
end;
If I click in the middle of the track bar I will get a value quite close to the actual track bar value at that point, so if for example the track bar range goes from 0 to 2000 and I click somewhere in the middle I get 1000, but as I move to the left or right I start to get smaller and bigger values respectively. So if my mouse is close to the start for example I might get 180 instead of 100 that should be the actual value at that point. Can someone point out what is it that I am doing wrong here?
EDIT
By actual track bar value what I mean is the value derived from:
procedure TForm1.TrackBar1Change(Sender: TObject);
begin
ActualLabel.Text := 'Actual Val: '+FloatToStr(TrackBar1.Value);
end;
So I will move the mouse lets say at position 308 (the track bar goes from 0 to 609 here) and I will get a perch value of 0.50574 that is telling me that the value of the track bar under the mouse at position 308 is 10114, but by clicking the mouse and firing up the onChange function I get a value of 10116. This difference sends to increase as we go further from the middle of the track bar to either one of its sides.
EDIT 2
A clearer example would be this. As seen in the image below I move the mouse at position X=572. This position if expressed as a percentage for the whole track bar would be 572/609 = 0,9392. So one would expect that the percentage of the value of the track bar at that position (min:0 - max:200 as the image shows) would be the same. In other words, MValue/max = 0,9392.
But after clicking the track bar at that exact position and then requesting its value it won't return what I computed as 'MValue' as the image below shows (Mouse is not visible but this image is indeed after I clicked the track bar in the same position, as you can see the ActualValue was updated)
Problem 1
Your calculation of value does not match that used by the control. The control does it with this code which can be found in FMX.StdCtrls:
function PosToValue(MinValue, MaxValue, ViewportSize, ThumbSize, TrackSize,
Pos: Single; IgnoreViewportSize: boolean): Single;
var ValRel: Double;
begin
Result := MinValue;
if (ViewportSize < 0) or IgnoreViewportSize then
ViewportSize := 0;
ValRel := TrackSize - ThumbSize;
if ValRel > 0 then
begin
ValRel := (Pos - ThumbSize / 2) / ValRel;
if ValRel < 0 then
ValRel := 0;
if ValRel > 1 then
ValRel := 1;
Result := MinValue + ValRel * (MaxValue - MinValue - ViewportSize);
end;
end;
The difference is that the code here makes an allowance for the thumb size. You formula is equivalent to calling this function and passing a value of 0 for ThumbSize.
If you want to replicate the behaviour of the control, then you'll need to use this algorithm also. You'll need the protected hack to crack the class.
type
THackedTrackBar = class(TTrackBar);
procedure TForm1.TrackBar1MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Single);
var
tb: THackedTrackBar;
begin
tb := THackedTrackBar(TrackBar1);
Label1.Text := FloatToStr(
PosToValue(
tb.Min,
tb.Max,
tb.ViewportSize,
tb.GetThumbSize(tb.FIgnoreViewportSize),
tb.Width,
X,
tb.FIgnoreViewportSize
)
);
end;
Problem 2
OnMouseMove does not fire when the cursor is over the track thumb. This seems to be a basic limitation of the FMX TTrackBar control. The underlying framework is obviously aware that the cursor is over the thumb because it paints it in a different colour, the so-called hot-tracking effect. However, the framework appears to do this to the detriment of letting you know that the mouse is moving.
The thumb on the track bar is implemented as a separate object. It's an object of type TThumb. The TTrackBar control exposes the object via a protected property. You can use the protected hack to get hold of the thumb object and then set its OnMouseMove event handler. Not a whole lot of fun, but certainly one way to work around the issue.
For your initial problem you will need to dig into the style to find the exact amount of left and right padding around the track bar. Note though that this will vary depending on the platform, style and Delphi version.
You might consider using your own style so you know everything will be constant.
To solve the issue raised by David Heffernan you could put a transparent control over the TTrackBar (make it a client aligned child of the track bar), intercept mouse events, do your own processing and pass them down to the track bar.
Related
I am working with this legacy app that has forms having a TScrollBox containing deeply nested TPanel descendents (up to 8 or so levels of nesting), each hosting controls that can cause the panel to be resized to make room for new child panels with their own controls. e.g. the user clicks a radio button, which resizes the panel hosting it to accommodate a new child panel with its own controls, including radio buttons that can cause the child to be resized and repopulated in the same manner.
The performance of this app was good until it was modified to use VCL styles. The group doing that work had to abandon the effort when it was found that the themed version might take over a minute to redraw itself after a single click.
It turned out that enabling double-buffering at the form level worked to make the repainting performance acceptable when the user clicks on a control. Scrolling is still a problem however. The controls on the form are not able to paint themselves fast enough to keep up with a user scrolling by rolling the mouse wheel. The scrollbar gets moved, a part of the client area gets redrawn, then the next mouse wheel message gets processed, a little bit of the client gets redrawn, and so on until the user quits rolling the mouse and there's time to redraw the whole thing. The code that does the scrolling looks like this:
procedure ScrollControl(Window: TScrollingWinControl; ScrollingUp: boolean; Amount: integer = 40);
var
Delta: integer;
// This is needed to tell the child components that they are moving,
// The TORCombo box, for example, needs to close a dropped down window when it moves.
// If Delphi had used standard scroll bars, instead of the customized flat ones, this
// code wouldn't be needed
procedure SendMoveMessage(Ctrl: TWinControl);
var
i: integer;
begin
for i := 0 to Ctrl.ControlCount - 1 do
begin
if Ctrl.Controls[i] is TWinControl then with TWinControl(Ctrl.Controls[i]) do
begin
SendMessage(Handle, WM_MOVE, 0, (Top * 65536) + Left);
SendMoveMessage(TWinControl(Ctrl.Controls[i]));
end;
end;
end;
begin
Delta := Amount;
if ScrollingUp then
begin
if Window.VertScrollBar.Position < Delta then
Delta := Window.VertScrollBar.Position;
Delta := - Delta;
end
else
begin
if (Window.VertScrollBar.Range - Window.VertScrollBar.Position) < Delta then
Delta := Window.VertScrollBar.Range - Window.VertScrollBar.Position;
end;
if Delta <> 0 then
begin
Window.VertScrollBar.Position := Window.VertScrollBar.Position + Delta;
SendMoveMessage(Window);
end;
end;
What I think I want to do is to (right before the outermost call to SendMoveMessage)
make a DC for Window
allocate an offscreen bitmap the size of Window's client area
arrange for all drawing operations on Window and its children to be drawn to the offscreen bitmap
Call SendMoveMessage and
bitblt the offscreen bitmap into Window's client area and free the bitmap and DC.
But I cannot see how to do step 3. Is it even possible?
I'd like to display a form off of a systray icon event, which just shows some information next to the taskbar and disappears itself after some time. The main issue I'm running into is positioning the form in a way that it is both in the correct position and visible. I found a couple of ways to determine where the icon is, but in testing I found them inconsistent based on OS (I attempted this in another app and ended up giving up and using a centered modal form). For example:
procedure GetWorkAreaRect(var outrect: TRect);
// returns the dimensions of the work area.
begin
Systemparametersinfo(SPI_GETWORKAREA, 0, #outrect, 0);
end;
The problem when that works is determining from there where to put the form (above, below, left, right). Any suggestions?
Edit: The problem is in positioning the form in relationship to the system tray icon, not necessarily determining where the system tray icon is. I made another attempt and got it working as long as some conditions are met. Most notably, it doesn't work if the taskbar is set to auto-hide, because the assumption is made that the click is made outside of the work area. This is not true when the form is set to auto-hide.
function PositionForm(X, Y, Width, Height: Integer): TPoint;
// receives mouse-click position in X and Y, form width and height in width and height
// returns Left and Top in TPoint.X and TPoint.Y.
var
workrect: TRect;
resrect: TPoint;
begin
GetWorkAreaRect(workrect);
if Y > WorkRect.Bottom then // taskbar is on bottom
begin
resRect.X := WorkRect.Right - Width;
resrect.Y := WorkRect.Bottom - Height;
end
else
if X > WorkRect.Right then // taskbar is on right
begin
resrect.X := WorkRect.Right - Width;
resrect.Y := WorkRect.Bottom - Height;
end
else
if X < WorkRect.Left then // taskbar is on left
begin
resrect.X := WorkRect.Left;
resrect.Y := WorkRect.Bottom - Height;
end
else
if Y < WorkRect.Top then // taskbar is on top
begin
resrect.X := WorkRect.Right - Width;
resrect.Y := WorkRect.Top;
end;
Result := ResRect;
end;
So on the surface, it seems the issue is to find an independent way to determine where the taskbar resides...or could the logic be extended above to take care of this?
When your notification icon receives the message corresponding to an action, you can query at that point to find out an associated point on the screen.
For example if you are handling WM_RBUTTONUP, WM_CONTEXTMENU etc. in your icon's message procedure you can call GetMessagePos to find out the position on the icon associated with the message.
I wrap this up with the following function so that I can decode the message into a TPoint:
function MessagePoint: TPoint;
begin
Result := TSmallPoint(GetMessagePos());
end;
So what you can do is, in your icon's message procedure, make a note of this point. When you need to show the form, use this point to determine where your icon lives. Since the point can be in the taskbar, you'll need to clip it into the work area.
After your question update it seems you want to know how to find out the location of the taskbar. Do that by calling SHAppBarMessage passing ABM_GETTASKBARPOS.
Windows does not expose a native way to query where system tray icons are positioned, or even if they are visible at all. But you can do it manually with some lower level API trickery, as demonstrated in the following article:
CTrayIconPosition - where is my tray icon?
That works up to XP, at least, maybe even Vista. Windows 7 drastically redesigned the way the system tray acts, so I do not know if these techniques still work anymore.
You can use TJvDesktopAlert to display simple notifications, if you have JCL and JVCL.
procedure TForm1.ShowDesktopAlert(const AHeader, AMessage: string);
begin
with TJvDesktopAlert.Create(nil) do
begin
StyleOptions.DisplayDuration := 5000;
HeaderText := AHeader;
MessageText := AMessage;
AutoFree := True;
Execute;
end;
end;
In a TImage's OnClick event, I would like to extract the x,y coordinates of the mouse. I would prefer them in relation to the image, but in relation to the form or window is just as good.
Mouse.CursorPos contains the TPoint, which in turn contains the X and Y position. This value is in global coordinates, so you can translate to your form by using the ScreenToClient routine which will translate screen coordinates to window coordinates.
According to the Delphi help file, Windows.GetCursorPos can fail, Mouse.CursorPos wraps this to raise an EOsException if it fails.
var
pt : tPoint;
begin
pt := Mouse.CursorPos;
// now have SCREEN position
Label1.Caption := 'X = '+IntToStr(pt.x)+', Y = '+IntToStr(pt.y);
pt := ScreenToClient(pt);
// now have FORM position
Label2.Caption := 'X = '+IntToStr(pt.x)+', Y = '+IntToStr(pt.y);
end;
The Mouse.CursorPos property will tell you the current position of the mouse. If the computer is running sluggishly, or if your program is slow to respond to messages, then it might not be the same as the position the mouse had when the OnClick event first occurred. To get the position of the mouse at the time the mouse button was clicked, use GetMessagePos. It reports screen coordinates; translate to client coordinates with TImage.ScreenToClient.
The alternative is to handle the OnMouseDown and OnMouseUp events yourself; their parameters include the coordinates. Remember that both events need to occur in order for a click to occur. You may also want to detect drag operations, since you probably wouldn't want to consider a drag to count as a click.
As others have said, you can use Mouse.CursorPos or the GetCursorPos function, but you can also just handle the OnMouseDown or OnMouseUp event instead of OnClick. This way you get your X and Y values as parameters to your event handler, without having to make any extra function calls.
How about this?
procedure TForm1.Button1Click(Sender: TObject);
var
MausPos: TPoint;
begin
GetCursorPos(MausPos);
label1.Caption := IntToStr(MausPos.x);
label2.Caption := IntToStr(MausPos.y);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
SetCursorPos(600, 600);
end;
Found this online somewhere once and saved it in my codesnippet DB :)
This page will probably solve all your questions however... There appear to be functions to go from client to screen coordinates and back etc..
Good luck!
To Firemonkey (FMX):
var
p: TPointF;
begin
p := Screen.MousePos;
end;
The Virtual Treeview scrolls vertically by pixels, unlike the way the standard Delphi grids, TListView and TTreeView (or most of the other such controls that I am aware of) scroll by line and keep a full line visible at the top of the control at all times. When I use the cursor keys to navigate, then depending on direction either the first or the last line is completely visible. When scrolling with the mouse there is no alignment whatsoever.
This behaviour can be observed for example with the Structure window in Delphi 2007 and 2009.
Is there any way to set the many properties to have the behaviour of the standard windows controls? Or is there a set of patches somewhere to achieve this?
This is what I came up with the help of Argalatyr, looks like it does what I want it to:
procedure TForm1.FormCreate(Sender: TObject);
begin
VirtualStringTree1.ScrollBarOptions.VerticalIncrement :=
VirtualStringTree1.DefaultNodeHeight;
end;
procedure TForm1.VirtualStringTree1Resize(Sender: TObject);
var
DY: integer;
begin
with VirtualStringTree1 do begin
DY := VirtualStringTree1.DefaultNodeHeight;
BottomSpace := ClientHeight mod DY;
VirtualStringTree1.OffsetY := Round(VirtualStringTree1.OffsetY / DY) * DY;
end;
end;
procedure TForm1.VirtualStringTree1Scroll(Sender: TBaseVirtualTree; DeltaX,
DeltaY: Integer);
var
DY: integer;
begin
if DeltaY <> 0 then begin
DY := VirtualStringTree1.DefaultNodeHeight;
VirtualStringTree1.OffsetY := Round(VirtualStringTree1.OffsetY / DY) * DY;
end;
end;
You could intercept the TBaseVirtualTree.OnScroll event and use the virtual treeview's canvas's return value for textheight('M') as the amount to change TBaseVirtualTree.offsety in order to increment (scroll up) or decrement (scroll down). Could also test to ensure that pre-scroll position modulus textheight('M') is zero (to avoid scrolling by the right amount from the wrong position).
Alternatively, this post on the Virtual Treeview forum suggests another approach: hide the virtual treeview's native scroll bars with VCL scroll bars and then do the scrolling yourself (trapping VCL scroll events and programmatically scrolling the virtual treeview).
In a Delphi 7 application, I want to move a component following the mouse. I'm doing something like this:
procedure MyComponent.MouseMove(Sender: TObject;Shift: TShiftState; X, Y: Integer);
begin
AnotherComponent.Top := X;
AnotherComponent.Left := Y;
end;
When I move the mouse the CPU usage for the main core goes up to 100% on a recent PC.
Any idea or tick to reduce the CPU usage in this case ?
You could create a TTimer that polls the current mouse position every 0.10 seconds or so, then positions "AnotherComponent" according to the current mouse position.
Then you wouldn't fire your event for every pixel of mouse movement- you won't need any OnMouseMove event on your controlling component at all.
On my computer, this basically has no performance impact at all.
procedure TForm1.Timer1Timer(Sender: TObject);
var
pt: TPoint;
begin
//Is the cursor inside the controlling component? if so, position some
//other control based on that mouse position.
GetCursorPos(pt);
if MouseWithin(pt.x,pt.y,MyComponent,Form1.Left,Form1.Top) then begin
//replace with whatever real positioning logic you want
AnotherComponent.Top := pt.y;
AnotherComponent.Left := pt.x;
end;
end;
function TForm1.MouseWithin(mouseX, mouseY: integer;
const comp: TWinControl; const ParentWindowLeft: integer;
const ParentWindowTop: integer): boolean;
var
absoluteCtrlX, absoluteCtrlY: integer;
begin
//take a control, and the current mouse position.
//tell me whether the cursor is inside the control.
//i could infer the parent window left & top by using ParentwindowHandle
//but I'll just ask the caller to pass them in, instead.
//get the absolute X & Y positions of the control on the screen
//needed for easy comparison to mouse position, which will be absolute
absoluteCtrlX := comp.Left + ParentWindowLeft;
absoluteCtrlY := comp.Top + ParentWindowTop +
GetSystemMetrics(SM_CYCAPTION);
Result := (mouseX >= absoluteCtrlX)
and (mouseX < absoluteCtrlX + comp.Width)
and (mouseY >= absoluteCtrlY)
and (mouseY <= absoluteCtrlY + comp.Height);
end;
Finally I've change my code for this one:
procedure MyComponent.MouseMove(Sender: TObject;Shift: TShiftState; X, Y: Integer);
begin
if GetTickCount-LastMoveTick>50 then begin
AnotherComponent.Top := Y;
AnotherComponent.Left := X;
LastMoveTick := GetTickCount;
end;
end;
Really easy to implement (2 lines added), no timer, works well for me...
It has nothing to do with the Mouse Move itself.
Unless it's what you intended, you are mismatching X, Y with Top, Left. Top is the Y coord and Left the X one.
The problem is the actual moving of AnotherComponent.
To try and understand it, I suggest that you write a TestMove routine that moves your AnotherComponent automatically with adjustable repetition/delays to monitor the CPU.
I bet it triggers a costly repaint or some other CPU intensive calculation.
So Examine closely if you have any event handler on this component first, then go with the inherited behavior...
Maybe, instead of moving the component itself you move a 'shadow' and only move the component once the user lets the mousebutton go. Sort of like drag&drop.
It can't be the move itself that needs so much cpu power, most probably the move causes the component to redraw itself somehow.
Can you avoid that AnotherComponent is redrawn on each move? It should not be necessary, unless it is a movie container.
Anything tied to the mouse move event will be called very frequently as mice are a high resolution input device. I wouldn't worry about the cpu usage though because your handler only gets fired as fast as possible based on how busy the system is. In other words, it's only maxing the CPU because nothing else is.
From MSDN:
The mouse generates an input event
when the user moves the mouse, or
presses or releases a mouse button.
The system converts mouse input events
into messages and posts them to the
appropriate thread's message queue.
When mouse messages are posted faster
than a thread can process them, the
system discards all but the most
recent mouse message.
Now there may be some exceptions to this. You could do some testing to be sure by running some other processing intensive activity and see how much the mouse move stuff impacts it.