Currently TButtonGroup doesn't have a WordWrap property. I was looking a way to have that functionality but my search for examples was so far not yielding any results.
My question is how can I add a wordwrap function for the caption of the buttons in TButtonGroup? Can you give me an example or guide me in the right track?
Your answer is much appreciated!
BTW I use delphi XE3
A simple wordwrap will already happen, which can be seen if you change the caption at runtime of by editing the DFM like this.
Items = <
item
Caption = 'Word'#13'Wrap'#13'3 Lines'
end
...
But the default painting will not look to good with WordWrap.
You could implement OnDrawButton, but that would need to write a lot of code.
The fastest way will be to set gboShowCaption in ButtonOptions to false and implementing OnAfterDrawButton like this:
procedure TForm1.ButtonGroup1AfterDrawButton(Sender: TObject; Index: Integer; Canvas: TCanvas; Rect: TRect; State: TButtonDrawState);
var
s:String;
begin
InFlateRect(Rect,-4,-4);
s := TButtonGroup(Sender).Items[Index].Caption;
Canvas.TextRect(Rect,s,[tfWordBreak,tfCenter]);
end;
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 simple thing. But i couldn' t :(
I have an TImage, which name is overview.
I want to draw a rectangle which is on the overview but independent from overview. So i added a TImage front of the overview and drawed a rectangle. Rectangle works but i just can see the TImage or overview. I tried to giving a transparency to rectImg but rectImg completely disappear.
with rectImg.Canvas do
begin
Pen.Color:= clRed;
Rectangle(0, 0, rectImg.Width, rectImg.Height);
end;
I draw on a paint, what i want to make.
That rect can be resizable indepented from img.
Thanks in advice.
If I understand your question correctly, you effectively want to visually frame the image without drawing the frame on the original graphic itself, i.e. rectImg.Picture should not return a framed graphic. Two ways immediately come to mind:
a) Dump TImage and use TPaintBox, manually maintaining the core graphic and doing any stretching or whatever via method calls rather than property settings on the component.
b) Extend TImage to have an OnPaint event that gets raised after TImage has done its standard painting.
With respect to (b), you can do it either as an interposer class or a custom component. As an interposer class you could do this:
1) Re-declare TImage immediately above your form class:
type
TPaintEvent = procedure (Sender: TObject; Canvas: TCanvas) of object;
TImage = class(Vcl.ExtCtrls.TImage) //use class(ExtCtrls.TImage) if pre-XE2
strict private
FOnPaint: TPaintEvent;
protected
procedure Paint; override;
published
property OnPaint: TPaintEvent read FOnPaint write FOnPaint;
end;
TMyForm = class(TForm)
//...
2) Implement the Paint override as so (slightly fiddly as TImage redefines the Canvas property of the base class):
type
TGraphicControlAccess = class(TGraphicControl);
procedure TImage.Paint;
begin
inherited;
if Assigned(FOnPaint) then
FOnPaint(Self, TGraphicControlAccess(Self).Canvas);
end;
3) Declare a suitable event handler in the form class:
procedure rectImgPaint(Sender: TObject; Canvas: TCanvas);
4) Implement the handler like so - note you need to set Brush.Style to bsClear to not create a filled rectangle:
procedure TMyForm.rectImgPaint(Sender: TObject; Canvas: TCanvas);
begin
Canvas.Brush.Style := bsClear;
Canvas.Pen.Color := clRed;
Canvas.Rectangle(0, 0, rectImg.Width, rectImg.Height);
end;
5) Assign the event handler in the form's OnCreate event:
procedure TMyForm.ImagePaint.FormCreate(Sender: TObject);
begin
rectImg.OnPaint := rectImgPaint;
end;
I leave converting the interposer class to a custom component as an exercise for the reader...
Postscript
Two other thoughts now I think of them:
Oddly enough, FMX is actually nicer here because its TImage provides a OnPaint event as standard.
If it is literally just a frame you want, a codeless alternative would be to overlay the TImage with a TShape, setting the shape's Brush.Style property to bsClear as we did in the coding solution. In that situation, set the shape's Enabled property to False if you have any OnClick or OnMouseXXX handlers assigned to the image.
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.
I want to extend DbGrid functionality to add colors on odd and even rows. So i wrote this
procedure TGridx.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
var
row : Integer;
begin
inherited;
row := Self.DataSource.DataSet.RecNo;
if (row mod 2 = 0) then
Self.Canvas.Brush.Color := FColor1 //some color
else
Self.Canvas.Brush.Color := FColor2; //some color
end;
What i am doing wrong ?
The event you want is called DBGridDrawColumnCell, and you need to decide whether to turn the DefaultDrawing property on or off, and the way you handle DBGridDrawColumnCell changes accordingly. For your case, you just set the colors, but leave DefaultDrawing true, and don't do any other canvas.Text or GDI drawing.
A recent question I asked here showed that in later Delphi versions (2010,Xe,Xe2) you ALSO sometimes need to call Canvas.Refresh for both TDBGRID and TListView, when changing canvas properties in ownerdraw events but that doesn't apply to delphi 7.
you should try also 3d party solution which are free, and extends already a lot the DBGrid, like the ones provided by the Jedi project
Opc0de, may be you should override not the "DrawCell" method but "DrawCellBackground"?
Try drawing the cell as well after the brush color is defined:
Self.Canvas.FillRect(ARect);
Please refer to another question here: Resizing borderless form from different constraints than far edges?
This previous question has been resolved, but I have another similar question. Since I am building a custom shaped form with a different client area, I need to change the ClientRect area of this form. The form has some special drawing of some curved edges and such, but that part's irrelevant. I need to change the ClientRect of the form to represent a new client area where components are allowed to be dropped, and ignore anything put outside of those bounds.
(I have a borderless form, I'm drawing my own border which is a much different size than the standard windows border.)
This solution will kind-of change the way that my previous question works, but that'll be another topic which I'm sure I'll figure out on my own, should be very simple. I just need to be able to properly set this in the first place.
type
TForm1 = class(TForm)
..
private
procedure WmNCCalcSize(var Msg: TWMNCCalcSize); message WM_NCCALCSIZE;
..
..
procedure TForm1.WmNCCalcSize(var Msg: TWMNCCalcSize);
begin
inherited;
if Msg.CalcValidRects then begin
InflateRect(Msg.CalcSize_Params.rgrc[0], -10, -6);
Msg.Result := 0;
end;
end;
Please, carefully read WM_NCCALCSIZE's documentation though, including the remarks section and also NCCALCSIZE_PARAMS, as I'm not sure this is what you want. But this is your message..