Positioning A Form From A SysTray Icon - delphi

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;

Related

Form opens in a random position in Delphi

I wanted to make that form would open in a random position on a screen.
I found the similar question here https://stackoverflow.com/a/51314375/19160533
But i didnt get how to implement this.
Im using Delphi 11.
Thanks!
You can set the top and left of the form on FormShow:
procedure TForm1.FormShow(Sender: TObject);
begin
self.Top := Random(1000);
left := Random(2000);
end;
for a better result, you can calculate the desktop dimensions and subtract the form width and height.

How to use FindVCLWindow on a TGraphicControl that is underneath a TPaintBox?

I am trying to use FindVCLWindow on a TGraphicControl component such as TLabel and TImage so that I can return their names for example in a Label or Statusbar, but I am facing a few problems.
Problem 1
The first problem is that FindVCLWindow only works for TWinControl and not for descendants of TGraphicControl, so I tried messing around with the following which appears to work:
function FindVCLGraphicWindow(const Pos: TPoint): TGraphicControl;
var
Window: TWinControl;
Ctrl: TControl;
begin
Result := nil;
Window := FindVCLWindow(Pos);
if Window <> nil then
begin
Ctrl := Window.ControlAtPos(Window.ScreenToClient(Pos), True, True, True);
if Ctrl is TGraphicControl then
begin
Result := TGraphicControl(Ctrl);
end;
end;
end;
I guess that is one problem down as it appears to work, but maybe there is a better solution?
Problem 2
The biggest problem I have is that the labels and images I need the above function to work on, are underneath a TPaintBox and as such the label or image component does not seem to receive or respond to mouse movements. In otherwords the function does not work unless the label or image is at the top (ie BringToFront).
I remember a while back learning from another question I had posted here that by setting the TPaintbox to Enabled := False will allow underlying controls to receive mouse messages etc.
However, using the above function always returns nil/false as it "cannot see" the graphic controls underneath the painbox.
So my main question is, how can I use a function like FindVCLWindow on a TGraphicControl that is behind a TPaintBox?
For example, if the following controls were inside a panel:
Image1.SendToBack;
Image2.SendToBack;
Label1.SendToBack;
Label2.SendToBack;
PaintBox1.BringToFront;
The above would only work if they were not behind the paintbox.
Having the images and labels above the paintbox is not an option, they must be behind the paintbox, but by doing so they don't respond to the above function.
So how do I get it to work? The function appears to only see the paintbox, not the underlying images and labels?
The second parameter of TWinControl.ControlAtPos specifies whether it allows disabled controls. You have it set True, thus it will return the disabled PaintBox. Set it False, and your function will return the Labels and Images in the back of the PaintBox:
function FindVCLGraphicWindow(const Pos: TPoint): TGraphicControl;
var
Window: TWinControl;
Ctrl: TControl;
begin
Result := nil;
Window := FindVCLWindow(Pos);
if Window <> nil then
begin
Ctrl := Window.ControlAtPos(Window.ScreenToClient(Pos), False, True, True);
if Ctrl is TGraphicControl then
begin
Result := TGraphicControl(Ctrl);
end;
end;
end;
It seems that you wish to find all controls at a certain position and then to ignore one/some of those controls based on the context in your application. It seems as though you are trying to use controls underneath a paintbox as some sort of clickable "hotspot".
Your problem is that you are using an approach that involves a function to locate a single control from a given position and this function by necessity must implement it's own rules to determine which one of potentially many such controls it will actually return. The rules in that function do not work for your needs.
The obvious answer then is that you need an approach which allows you to use your rules, not the rules in that other function. i.e. don't use that function. :)
Instead you should simply iterate over all the controls that may satisfy your criteria. That is, controls on the form at the position you require.
To obtain the form you can use the VCL function, as-is, to identify the VCL control at a point and from that determine the form on which that control is placed:
form := GetParentForm(FindVCLWindow(ptPos));
Once you have the form involved you can then simply iterate over the controls to find those at the specific point of interest. In the VCL, the Controls property identifies all the child controls of some parent control, so you cannot use this to find controls that are children of other controls on a form (without some recursion).
But the Components property identifies ALL components owned by some other component. In the VCL, a form owns all components placed on it at design-time (and any others placed at runtime as long as the form is specified as their owner), so you can use this Components property to iterate over all of the components on the form, whether they are visual controls, non-visual, windowed, graphic etc:
var
i: Integer;
comp: TComponent;
ctrl: TControl absolute comp;
begin
result := NIL;
bIsHotspot := FALSE;
form := GetParentForm(FindVCLWindow(ptPos));
if NOT Assigned(form) then // No form = no control to find
EXIT;
ptPos := form.ScreenToClient(ptPos); // pt must be converted to form client co-ords
for i := 0 to Pred(form.ComponentCount) do
begin
comp := form.Components[i];
if NOT (comp is TControl) then // Only interested in visual controls
CONTINUE;
if NOT PtInRect(ctrl.BoundsRect, ptPos) then // Only controls at the required position
CONTINUE;
// Is this a paintbox (= potential hotspot) or some other control ?
if (ctrl is TPaintBox) then
bIsHotspot := TRUE
else
result := ctrl;
// If we have now identified a hotspot AND some other control then we're done
if bIsHotspot and Assigned(result) then
BREAK;
end;
// If we didn't find a hotspot then any other control we may have found is NOT the result
if NOT bIsHotspot then
result := NIL;
end;
This routine iterates over all components on a form, skipping any that are not a visual control or not at the required position.
For the visual controls it then tests for a TPaintbox to determine that the specified position ptPos represents a potential hotspot. If the control is not a hotspot then it is a potential result, assuming that a paintbox is (or has been) also found at that same position.
If it finds both a paintbox and some other control at the specified position, then the result is the non-paintbox control. If it finds both before having iterated over all the components then the routine stops iterating, for efficiency (this means that hotspot controls cannot overlap since this routine finds only the "first" matching other control).
Otherwise the result is NIL.
The above routine is not 100% complete, the last 20% or so is left as an exercise, to incorporate into your code as most appropriate. And you can of course adapt it to implement whatever rules you require to identify controls or components.

Make owner-drawn TPageControl tabs look nicer, like without owner-draw

I use Delphi7, PageControl with owner-draw. I can't get so plain and nice look of tabs, as I see on not-owner-drawn PageControls. What's bad:
when using owner-draw, I can't draw on "entire" tab header area, small 1-2px frame around tab header is painted by OS.
1) Delphi not owner-draw, look is OK too (XPMan used):
2) Delphi owner-draw, you see not entire tab header can be colored (XPMan used):
I draw current tab with blue and others with white, here. Only example.
Code:
procedure TForm1.PageControl1DrawTab(Control: TCustomTabControl;
TabIndex: Integer; const Rect: TRect; Active: Boolean);
var
c: TCanvas;
begin
c:= (Control as TPageControl).Canvas;
if Active then
c.Brush.Color:= clBlue
else
c.Brush.Color:= clWhite;
c.FillRect(Rect);
end;
2b) Delphi owner-draw in real app (XPMan used):
Why do i need to use owner-draw? Simple. To draw X button on tab headers, to paint upper-line with custom color, to paint icons from imagelists.
I'm looking for a way to paint ENTIRE rect of tab headers, not decreased rect which is given to PageControl owner-draw events. I tried to increase the rect given by owner-draw events, but this doesn't help, OS repaints this thin 1-2px frame around tab headers anyway.
The tabs of an owner drawn native "tab control" (TPageControl in VCL, although its ascendant is appropriately named TCustomTabControl - it is anyone's guess why the creative naming..), is expected to be painted by its parent control while processing WM_DRAWITEM messages, as documented here.
The VCL takes the burden from the parent by mutating the message to a CN_DRAWITEM message and sending it to the control itself. In this process the VCL has no further intervention. It just calls the OnDrawTab message handler if it is assigned by user code, passing appropriate parameters.
So, it's not the VCL that draws the borders around tabs, but the OS itself. Also, evidently, it doesn't do this during processing of WM_DRAWITEM messages but later in the painting process. You can verify this by putting an empty WM_DRAWITEM handler on the parent of a page control. Result is, whatever we paint in the event handler, it will later get borders by the OS.
What we might try is to try to prevent what the OS draws take effect, we have the device context (as Canvas.Handle) after all. Unfortunately this route also is a dead end because the VCL, after the event handler returns, restores the device context's state.
The only way, then, we have is to completely abandon handling an OnDrawTab event, and acting upon CN_DRAWITEM message. Below sample code use an interposer class, but you can subclass the control any way you like. Make sure that OwnerDrawn is set.
type
TPageControl = class(comctrls.TPageControl)
protected
procedure CNDrawitem(var Message: TWMDrawItem); message CN_DRAWITEM;
end;
TForm1 = class(TForm)
..
..
procedure TPageControl.CNDrawitem(var Message: TWMDrawItem);
var
Color: TColor;
Rect: TRect;
Rgn: HRGN;
begin
Color := 0;
// draw in different colors so we see where we've drawn
case Message.DrawItemStruct.itemID of
0: Color := $D0C0BF;
1: Color := $D0C0DF;
2: Color := $D0C0FF;
end;
SetDCBrushColor(Message.DrawItemStruct.hDC, Color);
// we don't want to get clipped in the passed rectangle
SelectClipRgn(Message.DrawItemStruct.hDC, 0);
// magic numbers corresponding to where the OS draw the borders
Rect := Message.DrawItemStruct.rcItem;
if Bool(Message.DrawItemStruct.itemState and ODS_SELECTED) then begin
Inc(Rect.Left, 2);
// Inc(Rect.Top, 1);
Dec(Rect.Right, 2);
Dec(Rect.Bottom, 3);
end else begin
Dec(Rect.Left, 2);
Dec(Rect.Top, 2);
Inc(Rect.Right, 2);
Inc(Rect.Bottom);
end;
FillRect(Message.DrawItemStruct.hDC, Rect,
GetStockObject(DC_BRUSH));
// just some indication for the active tab
SetROP2(Message.DrawItemStruct.hDC, R2_NOTXORPEN);
if Bool(Message.DrawItemStruct.itemState and ODS_SELECTED) then
Ellipse(Message.DrawItemStruct.hDC, Rect.Left + 4, Rect.Top + 4,
Rect.Left + 12, Rect.Top + 12);
// we want to clip the DC so that the borders to be drawn are out of region
Rgn := CreateRectRgn(0, 0, 0, 0);
SelectClipRgn(Message.DrawItemStruct.hDC, Rgn);
DeleteObject(Rgn);
Message.Result := 1;
inherited;
end;
Here is how the above looks here:
From what I can tell, you are simply looking to have themed painting of your application. In Delphi 7, all you need to do to achieve that is to add an application manifest that specifies the use of comctl32 version 6. The simple way to do so is to add a TXPManifest component to one of your forms or data modules, or just to reference the XPMan unit in your project.
Since you want the system to paint your page control, you must not do any owner drawing.

How do I stop a form from exceeding the window height?

My form exceeds the window's height (when I use the splitter which changes a panel's height which in turn changes the form's size).
How can I stop it from resizing like that?
I assume you're changing the form size yourself, because I can't find a way to make the splitter do that automatically. You can get the Height of the screen using the Screen object in the Forms unit. You can simply test against Screen.Height or, if you want to better support multiple monitors, test against Screen.MonitorFromWindow(Handle).Height
Code sample, untested, should get you started:
var MaxFormHeight: Integer;
NewFormHeight: Integer;
M: TMonitor;
begin
// Get the monitor that's hosting the form
M := M := Screen.MonitorFromWindow(Handle);
MaxFormHeight := M.WorkAreaRect.Bottom - M.WorkAreaRect.Top - Top; // Take into account actual available monitor space and the Top of the window
// Do your stuff to calculate NewFormHeight
if NewFormHeight > MaxFormHeight then
NewFormHeight := MaxFormHeight;
Height := NewFormHeight;
end;

How do I get the coordinates of the mouse when a control is clicked?

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;

Resources