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

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.

Related

Custom drawing of TCustomListbox items

I'm rewriting a VCL component showing a customized TCustomListbox to Firemonkey in Delphi 10.2. The customization used an overridden DrawItem, basically adding some indentation and setting the text color depending on the item text and index.
DrawItem made it rather easy, but there seem to be nothing like that in FMX. I can override PaintChildren and draw every item myself, but then it looks differently and I have to deal with scrolling and everything myself. I'm just starting with FMX and don't have the sources yet.
Is there a DrawItem replacement in FMX? I may have missed it.
If not, how do it get the needed information? Basically, the rectangle to draw in and ideally the style used.
Problems
The solution by Hans works, but has some major problems:
Color
Setting the color doesn't work, the text is always black. I tried various possibilities including this one:
PROCEDURE TMyItem.Paint;
BEGIN
TextSettings.FontColor := TAlphaColorRec.Red;
INHERITED;
END;
Speed
Opening a box with 180 Items takes maybe two seconds. We need that many items and their count is actually the reason why we need a customized box (we provide filtering using the TEdit part of our component). A version using strings without TMyItem was faster (though probably slower than the VCL version), but using these items seems to slow it down even more (it's slower than filling an HTML list styled similarly).
Or something else? Having no sources and practically no documentation I can't tell.
I tried to cache the items for reuse, but this didn't help.
It looks like using custom items is actually faster than using strings, (timing in milliseconds):
nItems String TMyItem
200 672 12
2000 5604 267
20000 97322 18700
The speed problem seems to accumulate when the content changes multiple times. I was using FListBox.Items.Clear;, then I tried
n := FListBox.Items.Count;
FOR i := 0 TO n-1 DO FListBox.ListItems[n-1-i].Free;
and finally FListBox.Clear;, which makes most sense (and which I found last). Still, in the end it seems to need 2 ms per item.
Here is an example of how it can be done. The key is to set the Parent of the (custom) ListBoxItem to the ListBox. This will append it to its list of items. I set the parent in the constructor, so I don't have to do it (and remember it) each time I add something to a listbox.
type
tMyListBoxItem = class(TListBoxItem)
strict private
fTextLabel: TLabel;
public
constructor Create(aOwner: TComponent);
property TextLabel: TLabel read fTextLabel;
end;
implementation
constructor tMyListBoxItem.Create(aOwner: TComponent);
begin
inherited;
fTextLabel := TLabel.Create(self);
fTextLabel.Parent := self;
Assert(aOwner is TFMXObject, 'tMyListBoxItem.Create');
Parent := TFMXObject(aOwner);
end;
procedure tMyForm.FillListBox(aListBox: TListBox; aStringList: TStringList);
var
lItem: tMyListBoxItem;
i: integer;
begin
aListBox.BeginUpdate; //to avoid repainting for every item added
aListBox.Clear;
for i := 0 to aStringList.Count-1 do
begin
lItem := tMyListBoxItem.Create(aListBox);
lItem.TextLabel.Text := aStringList[i];
lItem.Margins.Left := 20;
end;
aListBox.EndUpdate;
end;
I use custom ListBoxItems in many places now because you can have ComboBoxes, EditBoxes, and all other controls in a ListboxItem. This opens for a very dynamic (list based) screen layout that easily adapts to all platforms and screen sizes.

Highlight controls in themed Delphi App with Delphi Tokyo

Using Delphi Tokyo 10.2, with Stylized Themes. I am trying to highlight components on the form, e.g., ComboBoxes, EditTexts, etc. For example, if a user entered invalid data, I would like to highlight the component.
In the past, we just colored components Red, and the color persisted through resizes/movement/repaints in general. Now with theming, we need to do a bit more to get the color to show and persist.
I have tried disabling each component's StyleElements [seFont, seClient, seBorder] properties to force show the color. This works but seems kludgy, particularly when there are many components being validated. Also, simply coloring a component red might not look right with some of the themes.
I have also tried simply drawing a red rectangle around the components using WinAPI SetRop2(..). E.g., here is some clever code, I tweaked to take a TWinControl and Draw a redbox around it; I can also remove the redbox using a similar call. This works:
…but doesn't persist through repaints, obviously. It seems like adding custom paint methods might be an overkill here. Unless, there is some better way?
Other things I have considered:
All of the components sit on panels, and I have considered using a protected hack to draw red rects on the panel's canvas around the components, but again, more custom paint routines…
I am also considering drawing TShapes dynamically as needed, but this strikes me as silly.
There must be others in the same situation, e.g., data entry validation that worked neatly in older versions of Delphi, but doesn't look so good when themed. What is the best approach when using themes? The SetRop2(..) approach seems to be the cleanest, but can someone suggest a simple way to make the color persist? I would welcome other ideas, too. Thank you.
EDIT
So maybe, just dynamically drawing TShapes around the invalid responses isn't so bad. They persist through repaints and don't descend from TWinControl, meaning they automatically show up behind the control they are highlighting.
This works quite well for me and I hope it's helpful to others.
// assuming owning control will be free'd properly and
// will in turn free HI_LITE Box.
//
// tantamount to adding an instance variable, TShape, to existing Control,
// since class helpers don't allow. And I don't want to descend
// new controls just to have a hiLiteBox Instance Variable.
procedure HiLiteMe(aControl : TWinControl; HILITE_FLAG : Boolean = TRUE; aColor : TColor = clRed);
const OFFSET = 4; // specify the offset of the border size of the box.
const BOX_NAME_PREFIX = 'HI_LITE_BOX_';
var
hiLiteBox : TShape; // reference created on stack, but object created on the heap,
uniqueBoxName : String; // so use the persistent aControl's owned component list to maintain the reference.
begin
uniqueBoxName := BOX_NAME_PREFIX + aControl.Name; // uniquename for each associated HiLiteBox.
HiLiteBox := aControl.FindComponent(uniqueBoxName) as TShape; // phishing for the HiLiteBox if it was previously created.
if NOT Assigned(hiLiteBox) then // create HiLiteBox and make persist outside this proc.
begin
if NOT HILITE_FLAG then exit; // don't create a box if we're just going to hide it anyway.
hiLiteBox := TShape.Create(aControl); // Create HiLiteBox, setting aControl as owner, quicker retrieval using aControl.findComponent
hiLiteBox.Parent := aControl.Parent; // Render the box on the control's parent, e.g., panel, form, etc.
hiLiteBox.Name := uniqueBoxName;
hiLiteBox.Pen.Color := aColor; // Color the Pen
hiLiteBox.Pen.Width := offset-1; // Make the Pen just slightly smaller than the offset.
hiLiteBox.Brush.Color := clWindow; // Choose a brush color, to fill the space between the pen and the Control
hiLiteBox.Left := aControl.Left - offset;
hiLiteBox.Width := aControl.Width + offset*2;
hiLiteBox.Top := aControl.Top - offset;
hiLiteBox.Height := aControl.Height + offset*2;
end;
hiLiteBox.Visible := HILITE_FLAG; // Show/Hide HiLite as appropriate.
end;
Called like this to HiLite with a red and blue box...
begin
HiLiteMe(checkListBox1, TRUE, clRed); // Draw a RedBox around the CheckListBox, e.g., Invalid.
HiLiteMe(bitBtn3, TRUE, clBlue); // Draw a Blue Box around the Button, e.g., Required.
end;
Called like this to remove HiLites…
begin
HiLiteMe(checkListBox1, FALSE); // Draw a RedBox around the CheckListBox, e.g., Invalid.
HiLiteMe(bitBtn3, FALSE); // Draw a Blue Box around the Button, e.g., Required.
end;
I suggest having a red TShape on only one side of the control (e.g. just the left or bottom) that you show or hide.

How to move a transparent form without border in Delphi?

I already know and have used these methods to create a form without boders that can be moved.
Move form without border style
I'm using the WMNCHitTest override.
The MouseDown event don't work at all.
This form is very simple it is displaying a countdown, a number that changes very second and that's all. The number being painted using a big TLabel with big fonts.
But I also made this form transparent by using Delphi's standard form properties.
Now, if I try to click on the form to move it, the only area I can use is the lines drawing the changing numbers, even if they are not so thin, this is not practical.
I'd like the user to be able to move the numbers to any position of the screen by clicking anywhere near the numbers, let's say inside a "0" or an "8".
I'd think about drawing a transparent rectangle over the numbers and be that the clickable area, but the effect would be the same, the click would go throu.
I know an application that does this, so it is possible, but how?
procedure TfrmCountDown.Timer1Timer(Sender: TObject);
begin
iCount := iCount - 1;
lblTime.Caption := FormatFloat('00', iCount);
end;
procedure TfrmCountDown.FormCreate(Sender: TObject);
begin
iCount := 60;
BorderStyle:=bsNone;
Self.Color := clGray;
Self.TransparentColor := true;
Self.TransparentColorValue := clGray;
end;
procedure TfrmCountDown.WMNCHitTest(var Message: TWMNCHitTest);
var
Pt: TPoint;
begin
Pt := ScreenToClient(SmallPointToPoint(Message.Pos));
if Pt.Y < 160 then
Message.Result := HTCAPTION
else
inherited;
end;
VCL Form Transparency (by which presume you to mean the TransparentColor property, as opposed to the Alpha properties) uses Layered Windows to achieve the transparent drawing. Using this technique any transparent area of the window is not only transparent visually but also with respect to hit testing.
i.e. Using VCL form transparency, the transparent areas in your form may as well not exist at all.
What could work is to turn off the VCL form transparency and instead implement your form using the WS_EX_TRANSPARENT window style. This enables visual transparency but allows you to handle hit testing to make different areas of your form transparent, or not, with respect to clicks.
Unfortunately WS_EX_TRANSPARENT is not a complete "transparency" solution - it only tells Windows that your form is transparent, but you also then have to take additional steps to actually be properly transparent, or to interpret what "transparent" means for your specific form.
This means it complicates the visual rendering of your form and you will also have to override the paint mechanism to properly draw your form. From how you describe the content on your form this does not sound like it will be too arduous however, though it is far some straightforward (I do not have a working example unfortunately).
At the very least you will probably be best to replace your TLabel with calls to select an appropriate font and render text into the window client area with a transparent background. But there will be additional house keeping required.
In your WM_NCHITTEST handler, respond with HTNOWHERE for those areas of your form which you wish to be interpreted as "click through" areas, and HTCAPTION for the areas that you wish to support dragging (i.e. from what you describe, within a region defined by the bounds of your text).
Unfortunately I think you will find that there are lots of fiddly aspects to the implementation of painting a transparent window.

Positioning A Form From A SysTray Icon

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;

How can obtain the image which uses windows 7 to draw the parent nodes in a treeview control?

I'm working in a custom control which mix two windows controls (listview and treeview). In some point, I need to draw the image which uses windows 7 (with themes enabled) to identify the parent nodes, I'm using the DrawThemeBackground function with the TVP_GLYPH part and the GLPS_CLOSED state (I tried with all the parts and states related to the TREEVIEW class without luck), but the result image always is the old (+) or (-).
This image show the issue
I want to draw the Arrow image (inside of black circle) instead of the (+) sign (inside of orange circle).
This is the sample code which I use to draw the image.
uses
UxTheme;
procedure TForm40.Button1Click(Sender: TObject);
var
iPartId : integer;
iStateId: integer;
hTheme : THandle;
begin
hTheme := OpenThemeData(Handle, VSCLASS_TREEVIEW);
iPartId := TVP_GLYPH;
iStateId:= GLPS_CLOSED;
//iPartId := TVP_TREEITEM;
//iStateId:= TREIS_NORMAL;
if hTheme <> 0 then
try
//if (IsThemeBackgroundPartiallyTransparent(hTheme, iPartId, iStateId)) then
// DrawThemeParentBackground(Handle, PaintBox1.Canvas.Handle, nil);
DrawThemeBackground(hTheme, PaintBox1.Canvas.Handle, iPartId, iStateId, Rect(0, 0, 31, 31), nil);
finally
CloseThemeData(hTheme);
end;
end;
I check a couple of tools like the application made by Andreas Rejbrand and this too, but I can't find the image which I want.
My question is : how I can obtain the arrow image?
UPDATE
Thanks to the answer posted for Stigma I found additional resources to the values of the parts and states of the Explorer::Treeview class.
VisualStyleRenderer and themes
CodeProject
First of all, in the case of an ordinary ListView or TreeView, one can simply call SetWindowTheme on its handle to apply the proper sort of styling. The example from its MSDN page is as follows:
SetWindowTheme(hwndList, L"Explorer", NULL);
Since we are talking about a custom control, I am not so sure that applies here however. But since SetWindowTheme causes the WM_THEMECHANGED message to be sent to the proper window, it implies that you will just need to use the proper OpenThemeData call for the specific sub theme.
I think Luke's comment is correct. You probably just need to pass 'Explorer::Treeview' rather than the plain style. So, barring years of not having touched Delphi/Pascal:
hTheme := OpenThemeData(Handle, 'Explorer::Treeview');
You must set SetWindowTheme(Handle, 'explorer', nil); before painting to ensure that OpenThemeData will use new explorer style theme. Of course, window handle must be the same for both functions.

Resources