How can I use my own custom buttons (images) to replace the default [-]/[+] buttons in the VST?
I want to use arrows instead (, ), but also to support RTL bidi mode (, ).
edit: I am aware of the bsTriangle style (ButtonStyle). It does not respect RTL. I want to use my own custom images.
Aren't those images usually in Windows Vista and Windows 7? The tree control should get them automatically on those systems when you have themes enabled.
The easy way to get something close to that is to just set the ButtonStyle property to bsTriangle. It won't be exactly the images shown in the question, though. The "minus" arrow will point straight down instead of diagonally, and the "plus" arrow will be solid instead of an outline.
You can provide your own bitmap. Change the VT_XPBUTTONMINUS and VT_XPBUTTONPLUS resources to whatever images you want, and set the ButtonFillMode property to fmShaded.
I see no facility for changing the image based on the bi-di mode, though. You can create a descendant class that overrides PaintNodeButton, and then paint whatever you want. Copy the placement code from the parent class.
IIRC you get it by including toUseExplorerTheme in PaintOptions. However this also changes the selection look (to the better IMNSHO) and probably more.
For example if I drop a TVirtualStringTree on a form and add the following event handlers:
procedure TForm1.FormCreate(Sender: TObject);
begin
VT.RootNodeCount := 10;
VT.TreeOptions.PaintOptions := VT.TreeOptions.PaintOptions + [toUseExplorerTheme];
VT.OnInitNode := VTInitNode;
VT.OnInitChildren := VTInitChildren;
end;
procedure TForm1.VTInitChildren(Sender: TBaseVirtualTree;
Node: PVirtualNode; var ChildCount: Cardinal);
begin
ChildCount := 3;
end;
procedure TForm1.VTInitNode(Sender: TBaseVirtualTree;
ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
begin
Include(InitialStates, ivsHasChildren);
end;
I get
Edit: Unfortunately, setting Form1.BiDiMode to bdRightToLeft yields
on my German Windows 7. I don't know if this works better on Arabic or Hebrew systems.
See the ButtonStyle property. Not sure does it respect the RTL bidi mode thought.
Related
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.
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.
I can't adjust a TTrackBar thumb size to a higher size. See the image:
I got a small thumb on the left, and I can't make it bigger (but not the TrackBar itself).
Desired thumb size is shown on an image with a red area.
Maybe I can use WINAPI somehow?
C++ apps have bigger thumb often.
This is what I'm actually hopping for:
It would seem like this cannot be done with the standard trackbar control. Indeed, I cannot see any trackbar style or trackbar message related to this. There is only the TBM_SETTHUMBLENGTH, which you also can access from VCL's TTrackBar.ThumbLength, but this also affects the height of the background sunken rectangle.
A corollory is that I doubt the observation that "C++ apps have bigger thumb often".
Of course, you can always make your own trackbar-like control.
Or do you only want to shrink the sunken rectangle? Then just set ShowSelRange to False in the Object Inspector. But if themes are on, you still cannot make the thumb bigger than about 24.
If you are on an old version of Delphi with no TrackBar.ShowSelRange, you need to remove the window style TBS_ENABLESELRANGE manually. You can do this at any time using SetWindowLong, or you can do it in CreateParams of a subclassed trackbar control. The simplest way might be to use an 'interposer class':
type
TTrackBar = class(ComCtrls.TTrackBar)
protected
procedure CreateParams(var Params: TCreateParams); override;
end;
...
implementation
{ TTrackBar }
procedure TTrackBar.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.Style := Params.Style and not TBS_ENABLESELRANGE;
end;
To get the appearance in the Notepad++ screenshot, you should also set TickMarks to tmBoth and TickStyle to tsNone.
This doesn't answer your question, though, which was about making the thumb larger. This will make the sunken rectangle smaller... From your screenshots, however, I would guess this is what you want.
Trackbar is one of the native controls that support custom draw. Basically, when themes are enabled, you can control various aspects of drawing the control, or you can tell the OS that you're overtaking drawing parts yourself. See more about custom draw here.
We don't have to overtake any drawing to play with the sizes of some parts a little bit. It is the VCL that draws the channel (the recessed tracking background), and the ticks. For ticks, there are already properties we can use. For the channel, we can deflate the rectangle a bit, and the VCL will take over from there. The thumb is drawn by the default window procedure, but it doesn't matter, the OS will draw the thumb to the modified rectangle.
The below example (for a horizontal trackbar) intercepts WM_NOTIFY notification sent to the form to carry out these modifications. This will only work if the trackbar is placed directly on the form. If this is not the case, you can derive a new control that descends from TTrackBar to handle CN_NOTIFY, or subclass the control, or its parent for WM_NOTIFY. All that matters is to handle the notification before the actual drawing is performed.
This is how the example looks:
type
TForm1 = class(TForm)
Button1: TButton;
TrackBar1: TTrackBar;
procedure FormCreate(Sender: TObject);
protected
procedure WMNotify(var Msg: TWMNotify); message WM_NOTIFY;
end;
...
uses
themes, commctrl, xpman;
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
if ThemeServices.ThemesEnabled and
(TrackBar1.Orientation = trHorizontal) then begin
TrackBar1.TickMarks := tmBoth;
TrackBar1.TickStyle := tsNone;
TrackBar1.ThumbLength := 38;
end;
end;
procedure TForm1.WMNotify(var Msg: TWMNotify);
begin
if ThemeServices.ThemesEnabled and
(TrackBar1.Orientation = trHorizontal) then begin
if (Msg.IDCtrl = Longint(TrackBar1.Handle)) and
(Msg.NMHdr.code = NM_CUSTOMDRAW) and
(PNMCustomDraw(Msg.NMHdr).dwDrawStage = CDDS_ITEMPREPAINT) then begin
case PNMCustomDraw(Msg.NMHdr).dwItemSpec of
TBCD_THUMB: InflateRect(PNMCustomDraw(Msg.NMHdr).rc, -4, 0);
TBCD_CHANNEL:
with PNMCustomDraw(Msg.NMHdr).rc do begin
Top := Bottom div 2 + 2;
Bottom := Top + 5;
Inc(Left, 4);
Dec(Right, 4);
end;
end;
end;
end;
inherited;
end;
I recently discovered the TTrayIcon component in Delphi 2007. The code used is pretty straightforward.
procedure TForm1.FormCreate(Sender: TObject);
begin
AppTrayIcon := TTrayIcon.Create(nil);
AppTrayIcon.OnDblClick := OnAppTrayIconDblClick;
Application.OnMinimize := OnApplicationMinimize;
Application.OnRestore := OnApplicationRestore;
end;
procedure TForm1.OnApplicationRestore(Sender: TObject);
begin
AppTrayIcon.Visible := False;
ShowWindow(Application.Handle, SW_SHOW);
Application.BringToFront;
end;
procedure TForm1.OnApplicationMinimize(Sender: TObject);
begin
AppTrayIcon.Visible := True;
ShowWindow(Application.Handle, SW_HIDE);
end;
procedure TForm1.OnAppTrayIconDblClick(Sender: TObject);
begin
Application.Restore;
end;
Since there is no icon assigned, Delphi uses Application.Icon, which is that icon: http://artbyloveland.com/icon.ico This icon includes the following sizes: 64x64, 48x48, 32x32, 24x24 and 16x16.
Now, on my Windows Vista, everything fine.
On a non-themed Windows like Windows Server 2003, the result is all screwed-up:
EDIT:
At first, I thought it was because of the alpha channel. So I tried to make a version of the ico file without the use of alpha channel. I also tried GreenFish Icon Editor as suggested by Ken; I selected every color depth and every size available. In both cases, the end result is better. However, there is a black stroke that doesn't exist at all in the ico file.
You state that you are not assigning the icon. In which case the component uses Application.Icon. But that will typically be an icon that is the wrong size for the notification area.
For the notification area you need to use a square icon with size determined by the SM_CXSMICON system metric. The best way to get that is to call LoadImage which allows you to specify the icon size. Once you have loaded the icon into an HICON you can just write this:
AppTrayIcon.Icon.Handle := IconHandle;
You don't have the proper size or color depth for your icon.
You can use an icon editor to provide multiple size and color depth icons to a single .ico file, and Windows will automatically choose the proper one based on the user's settings and video driver configuration. Windows will then have several choices to use when selecting the closest match, and the scaling and blending will have a much better appearance.
I use GreenFish Icon Editor, which is donation-ware. It will allow you to open any supported graphic type and then create a Windows icon with multiple color depths and resolutions automatically from it (see the Icon menu). I've tested the multi-image icon files in Delphi 7, 2007, 2010, XE, and XE3, and they work fine for the Application.Icon and TForm.Icon.
Also see Best Icon size for displaying in the tray
I thought, I'd share my solution to this problem, as there is currently no complete solution here.
This problem was driving me nuts, because this is actually clearly a Delphi/VCL bug. If you assign an icon with all required sizes (16, 24, 32, 48, 256) to your project, Delphi should automatically use the correct size in TTrayIcon, but instead it only takes the 32px icon and scales it down.
Since the required images are already in the exe file (for being displayed in the Windows Explorer), you can simply fix it like this:
procedure FixTrayIcon(TrayIcon: TTrayIcon);
var
i: Integer;
begin
i := GetSystemMetrics(SM_CXSMICON); //Gets the correct size for the tray (e.g. 16)
TrayIcon.Icon.Handle := LoadImage(hInstance, 'MAINICON', IMAGE_ICON, i, i, LR_DEFAULTCOLOR);
TrayIcon.SetDefaultIcon; //Updates the icon
end;
Just call it in FormCreate and your tray icon will look as designed.
I have a report that uses a TChart that I am maintaining. One of the TLineSeries that gets added automatically gets assigned the color clWhite, which is too close to the background (clBtnFace).
If I change it, then the next series that gets added takes clWhite. So short of going back and changing it after all the other series are created, is there some way to tell the TChart that I don't want any of my series to be clWhite?
When a series is added to the TChart the TChart assigns it a color. I want it to not assign clWhite.
OK not one to give up easily, I did some more searching. There is a unit variable called ColorPalette of type TColorArray in the TeeProcs unit. If I find and replace white with a different color that fixes it. There may be an instance copy of it. I'll keep looking since that would be preferred.
To revert the ColorPalette back just call the unit method SetDefaultColorPalette in the same unit.
SetDefaultColorPalette; // Make sure we start with the default
ColorPalette[4] := $007FFF; // Change White to Orange
try
// add series to the chart
finally
SetDefaultColorPalette; // Set it back to Default
end;
BTW, I can't accept as answer because I asked the question too, but I tested it and it works.
Near as I can tell from the TeeCharts module; no you can't specify a color that it should not be as it ships.
You can programatically walk through all the TLineSeries entries making sure at run-time that they don't use clWhite.
Say you have an array of acceptable colors clArray, you can use the following code to set the colors of each of the tLineSeries entries at run time.
procedure TForm1.setColors(aChart: TChart; aColorArray: array of TColor);
var
chi : Integer;
coi : Integer;
begin
coi := low(aColorArray);
for chi := 0 to aChart.SeriesList.Count - 1 do begin
aChart.SeriesList[chi].Color := aColorArray[coi];
inc(coi);
if coi > high(aColorArray) then
coi := low(aColorArray);
end;
end;
procedure TForm1.FormShow(Sender: TObject);
var
ca : array of TColor;
begin
setLength(ca, 3);
ca[0] := clRed;
ca[1] := clBlue;
ca[2] := clGreen;
setColors(Chart1, ca);
end;
You can use the series methods ClearPalette then AddPalette to create your custom palette.