I want to display one node's font style, so the first half of the text would be regular, and the second half would be bold.
Here is the following code I tried (simplified code):
procedure TMyForm.tvDetailsAdvancedCustomDrawItem(Sender: TCustomTreeView; Node: TTreeNode;
State: TCustomDrawState; Stage: TCustomDrawStage; var PaintImages, DefaultDraw: Boolean);
var
xRect: TRect;
xLabel, xValue: string;
begin
if Stage <> cdPostPaint then
Exit;
DefaultDraw := False;
if cdsSelected in State then
begin
tvDetails.Canvas.Font.Color := ColorToRGB(clHighlightText);
tvDetails.Canvas.Brush.Color := ColorToRGB(clHighlight);
end;
xRect := Node.DisplayRect(False);
xRect.Left := xRect.Left + ((Node.Level + 1) * tvDetails.Indent);
tvDetails.Canvas.FillRect(xRect);
xLabel := 'label';
xValue := 'value';
tvDetails.Canvas.TextOut(xRect.Left + 2, xRect.Top + 2, xLabel);
// the following line has no effect ...
tvDetails.Canvas.Font.Style := [fsBold];
tvDetails.Canvas.TextOut(175, xRect.Top + 2, xValue);
end;
Unfortunately the tvDetails.Canvas.Font.Style := [fsBold]; does nothing, the whole line displayed with regular text. What do I miss here?
Related
I would like to show in a DBGRID as follows:
Imagine "Grid" as follows:
ID - DESCRIPTION
1 - Line 1 of the grid
2 - Line 2 of the grid
3 - Line 3 of the grid
Now, suppose the size of the DESCRIPTION column is changed and no longer appear the words "GRID";
I would like to stay as well DBGRID
ID - DESCRIPTION
1 - Line 1 of the
grid
2 - Line 2 of the
grid
3 - Line 3 of the
grid
is there any possibility that ??
Not what you're asking, but might help... I once used this code to show complete Memo fields in the standard DBGrid:
TMyForm = class(TForm)
...
private
FormMemoRect: TRect;
MemoGrid: TDBGrid;
BMemo: TBitBtn;
...
Procedure TMyForm.FormMemoDeactivate(Sender: TObject);
Begin
(Sender As TForm).Close;
Sender.Free;
End;
Procedure TMyForm.BMemoClick(Sender: TObject);
Var FormMemo: TForm;
Begin
MemoGrid.SetFocus;
FormMemo := TForm.Create(Self);
With TMemo.Create(FormMemo) Do Begin
Parent := FormMemo;
Align := alClient;
ReadOnly := True;
WordWrap := True;
ScrollBars := ssVertical;
Lines.Text := MemoGrid.DataSource.DataSet.Fields[TComponent(Sender).Tag].AsString;
End;
With FormMemo Do Begin
OnDeactivate := FormMemoDeactivate;
Left := FormMemoRect.Left;
Top := FormMemoRect.Top;
Width := Max(FormMemoRect.Right - FormMemoRect.Left, 300);
Height := FormMemoRect.Bottom - FormMemoRect.Top;
BorderStyle := bsNone;
Show;
End;
End;
Procedure TMyForm.GrdMemoDrawColumnCell(Sender: TObject; Const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
Begin
If (gdFocused In State) Then Begin
If Column.Field.DataType In [ftBlob, ftMemo] Then Begin
{Desenha botão para visualização do Memo}
FormMemoRect.Left := TWinControl(Sender).ClientToScreen(Rect.TopLeft).X;
FormMemoRect.Right := TWinControl(Sender).ClientToScreen(Rect.BottomRight).X;
FormMemoRect.Top := TWinControl(Sender).ClientToScreen(Rect.BottomRight).Y;
FormMemoRect.Bottom := FormMemoRect.Top + 100;
If Not Assigned(BMemo) Then
BMemo := TBitBtn.Create(Self);
BMemo.Parent := TWinControl(Sender).Parent;
BMemo.Width := 16;
BMemo.Height := 16;
BMemo.Caption := '...';
BMemo.OnClick := BMemoClick;
BMemo.Tag := Column.Field.Index;
BMemo.Left := TWinControl(Sender).Left + Rect.Right - BMemo.Width + 1;
BMemo.Top := TWinControl(Sender).Top + Rect.Top + 2;
MemoGrid := TDBGrid(Sender);
End
Else
FreeAndNil(BMemo);
End;
End;
For Blob/Memo Fields, you may also find it useful to do some custom GetText to show something directly in the Grid:
Procedure TMyForm.DataSetMemoGetText(Sender: TField; var Text: String; DisplayText: Boolean);
Begin
Text := Copy(Sender.AsString, 1, 50);
If Text <> Sender.AsString Then
Text := Text + '...';
End;
This is how the result looks like.
PS: Sorry for non-standard code style.
I tried to change the colors with the OnCustomDrawItem event but it has no effect.
procedure TForm1.RListCustomDrawItem(Sender: TCustomListView; Item: TListItem;
State: TCustomDrawState; var DefaultDraw: Boolean);
begin
if cdsSelected in State then begin
Sender.Canvas.Brush.Color:=clRed;
Sender.Canvas.Font.Color:=clYellow;
end;
end;
I use the default TListView component with 3 columns an ViewStyle set to vsReport.
The font color only will work as shown in your code.
If you want to change the Background color you will have to Draw the Item and the SubItems on your own and set DefaultDraw to false.
This could look like:
procedure TMyForm.ListView1CustomDrawItem(Sender: TCustomListView; Item: TListItem
; State: TCustomDrawState; var DefaultDraw: Boolean);
var
rt, r: TRect;
s: String;
i: Integer;
c:TCanvas;
// Fit the rect used for TextRect
Procedure PrepareTextRect;
begin
rt := r;
rt.Left := rt.Left + 5;
rt.Top := rt.Top + 1;
end;
begin
c := Sender.Canvas;
if (cdsSelected in State) then
begin
c.Brush.Color := clRed;
c.Font.Color := clYellow;
// will get the rect for Item + Subitems in ViewStyle = vsReport
r := Item.DisplayRect(drBounds);
c.FillRect(r);
// set width to get fitting rt for tfEndEllipsis
r.Right := r.Left + TListView(Sender).Columns[0].Width;
s := Item.Caption;
PrepareTextRect;
c.TextRect(rt, s, [tfSingleLine, tfEndEllipsis]);
if TListView(Sender).ViewStyle = vsReport then
begin // Paint the Subitems if ViewStyle = vsReport
for i := 0 to Item.SubItems.Count - 1 do
begin
r.Left := r.Left + TListView(Sender).Columns.Items[i].Width;
r.Right := r.Left + TListView(Sender).Columns.Items[i + 1].Width;
PrepareTextRect;
s := Item.SubItems[i];
c.TextRect(rt, s, [tfSingleLine, tfEndEllipsis]);
end;
end;
DefaultDraw := false;
end;
end;
If you set ViewStyle to vsList then you are up and running.
I have a PageControl with the TabPosition set to "tpLeft".
You notice when you set that property the caption of the tabs becomes Vertical too,
I but i want these captions to appear in a normal horizontal way,
tried changing the TabHeight, but it only got wider and the test still appears Vertical.
How can i fix that.
Using DELPHI XE5
update:
This code works(Thank to 'Ken White'):
procedure TForm1.PageControl1DrawTab(Control: TCustomTabControl;
TabIndex: Integer; const Rect: TRect; Active: Boolean);
var
I: Integer;
PageControl: TPageControl;
TextFormat: TTextFormat;
Text: string;
TextRect: TRect;
begin
PageControl := Control as TPageControl;
Text := PageControl.Pages[TabIndex].Caption;
for I := Length(Text) - 1 downto 1 do
begin
Text := Copy(Text, 1, I) + Copy(Text, I+1, MaxInt);
end;
TextRect := Rect;
TextRect.Left := TextRect.Left + 5;
TextRect.Top := TextRect.Top + 3;
TextFormat := [tfCenter];
PageControl.Canvas.TextRect(
TextRect,
Text,
TextFormat
);
end;
but is this the "right way" to do it, are there any other better methods?
I'm using the OnDrawItem event in the TlistView component to draw the content using custom colors, but when scroll the listview some artifacts appears.
This is the code used.
procedure TForm35.FormCreate(Sender: TObject);
var
i, j : integer;
Item : TListItem;
s : string;
begin
for i:= 0 to 99 do
begin
Item:=ListView1.Items.Add;
for j:= 0 to ListView1.Columns.Count-1 do
begin
s:= Format('Row %d Column %d',[i+1, j+1]);
if j=0 then
Item.Caption :=s
else
Item.SubItems.Add(s);
end;
end;
end;
procedure TForm35.ListView1DrawItem(Sender: TCustomListView; Item: TListItem;
Rect: TRect; State: TOwnerDrawState);
var
x, y, i: integer;
begin
if odSelected in State then
begin
TListView(Sender).Canvas.Brush.Color := clYellow;
TListView(Sender).Canvas.Font.Color := clBlack;
end
else
begin
TListView(Sender).Canvas.Brush.Color := clLtGray;
TListView(Sender).Canvas.Font.Color := clGreen;
end;
TListView(Sender).Canvas.FillRect(Rect);
x := 5;
y := (Rect.Bottom - Rect.Top - TListView(Sender).Canvas.TextHeight('Hg')) div 2 + Rect.Top;
TListView(Sender).Canvas.TextOut(x, y, Item.Caption);
for i := 0 to Item.SubItems.Count - 1 do
begin
inc(x, TListView(Sender).Columns[i].Width);
TListView(Sender).Canvas.TextOut(x, y, Item.SubItems[i]);
end;
end;
I tested this code in Delphi 2007 and XE3, but I'm getting the same results. How i can prevent this issue?
Ok. Change X := 5 to X := Rect.Left;
And another solution (may be more accuracy):
uses
Graphics;
//... Form or something else declarations ...
implementation
procedure TForm35.ListView1DrawItem(Sender: TCustomListView; Item: TListItem; Rect: TRect; State: TOwnerDrawState);
var
s: string;
ts: TTextStyle; // Text style (used for drawing)
begin
// inherited;
// Clear target rectangle
// Set Canvas'es Font, Pen, Brush according for Item state
// Get into s variable text value of the Cell.
ts.Alignment := taLeftJustify; // Horz left alignment
ts.Layout := tlCenter; // Vert center alignment
ts.EndEllipsis := True; // End ellipsis (...) If line of text is too long too fit between left and right boundaries
// Other fields see in the Graphics.TTextStyle = packed record
ListView1.Canvas.TextRect(
Rect,
Rect.Left, // Not sure, but there are a small chance of this values equal to zero instead of Rect...
Rect.Top,
s,
ts)
end;
end.
And to prevent some flicking...
...
var
b: TBitmap;
begin
b := TBitmap.Create;
try
b.Widht := Rect.Right - Rect.Left;
b.Height := Rect.Bottom - Rect.Top;
//...
// Draw content on the b.Canvas
//...
ListView.Canvas.Draw(Rect.Left, Rect.Top, b);
finally
b.Free;
end;
end;
I'm doing custom TTreeView drawing from scratch using OnAdvancedCustomDrawItem event, and I wonder how to render these selection and hot rectangles correctly in the background of my owner-draw items? They are Vista/7 styled so I cannot simply fill the background in some solid color.
I tried to draw my items at cdPostPaint stage, but if I leave DefaultDraw := True atcdPrePaint stage to draw selection background, the complete default drawing occurs, including text of items.
procedure TForm1.TreeView1AdvancedCustomDrawItem(Sender: TCustomTreeView;
Node: TTreeNode; State: TCustomDrawState; Stage: TCustomDrawStage; var PaintImages,
DefaultDraw: Boolean);
begin
case Stage of
cdPreErase:
begin
DefaultDraw := True;
end;
cdPostErase:
begin
DefaultDraw := True;
end;
cdPrePaint:
begin
// I thought this will paint only the selected/hot backgrounds,
// however this will paint whole item, including text.
DefaultDraw := True;
end;
cdPostPaint:
begin
DefaultDraw := False;
// painting my owner-draw text
// .........
end;
end;
PaintImages := False;
end;
Here is my solution (tested).
Note the TreeView must have HotTrack := True to draw hot items normally.
There also must be additional drawing when themes not enabled.
uses
UxTheme,
Themes;
const
TreeExpanderSpacing = 6;
procedure TForm1.DrawExpander(ACanvas: TCanvas; ATextRect: TRect; AExpanded: Boolean;
AHot: Boolean);
var
ExpanderRect: TRect;
Graphics: IGPGraphics;
Points: array of TGPPoint;
Brush: IGPBrush;
Pen: IGPPen;
ThemeData: HTHEME;
ElementPart: Integer;
ElementState: Integer;
ExpanderSize: TSize;
UnthemedColor: TColor;
begin
if ThemeServices.ThemesEnabled then
begin
if AHot then
ElementPart := TVP_HOTGLYPH
else
ElementPart := TVP_GLYPH;
if AExpanded then
ElementState := GLPS_OPENED
else
ElementState := GLPS_CLOSED;
ThemeData := OpenThemeData(TreeView1.Handle, VSCLASS_TREEVIEW);
GetThemePartSize(ThemeData, ACanvas.Handle, ElementPart, ElementState, nil,
TS_TRUE, ExpanderSize);
ExpanderRect.Left := ATextRect.Left - TreeExpanderSpacing - ExpanderSize.cx;
ExpanderRect.Right := ExpanderRect.Left + ExpanderSize.cx;
ExpanderRect.Top := ATextRect.Top + (ATextRect.Bottom - ATextRect.Top - ExpanderSize.cy) div 2;
ExpanderRect.Bottom := ExpanderRect.Top + ExpanderSize.cy;
DrawThemeBackground(ThemeData, ACanvas.Handle, ElementPart, ElementState, ExpanderRect, nil);
CloseThemeData(ThemeData);
end
else
begin
// Drawing expander without themes enabled
Graphics := TGPGraphics.Create(ACanvas.Handle);
Graphics.SmoothingMode := SmoothingModeHighQuality;
ExpanderRect := ATextRect;
ExpanderRect.Right := ATextRect.Left - TDPIAware.GetScaledSize(TreeExpanderSpacing96dpi);
ExpanderRect.Left := ATextRect.Left - TDPIAware.GetScaledSize(TreeExpanderSpacing96dpi) -
TDPIAware.GetScaledSize(Max(TreeExpanderCollapsedWidth96dpi, TreeExpanderExpandedWidth96dpi));
if ASelected then
UnthemedColor := ColorToRGB(clHighlightText)
else
if AExpanded then
UnthemedColor := clBlack
else
UnthemedColor := clGray;
SetLength(Points, 3);
if AExpanded then
begin
Points[0] := TGPPoint.Create(ExpanderRect.Right, ExpanderRect.Top +
(ExpanderRect.Bottom - ExpanderRect.Top - TreeExpanderExpandedHeight96dpi) div 2);
Points[1] := TGPPoint.Create(ExpanderRect.Right, ExpanderRect.Top +
(ExpanderRect.Bottom - ExpanderRect.Top + TreeExpanderExpandedHeight96dpi) div 2);
Points[2] := TGPPoint.Create(ExpanderRect.Right - TreeExpanderExpandedWidth96dpi,
ExpanderRect.Top + (ExpanderRect.Bottom - ExpanderRect.Top +
TreeExpanderExpandedHeight96dpi) div 2);
Brush := TGPSolidBrush.Create(TGPColor.CreateFromColorRef(UnthemedColor));
Graphics.FillPolygon(Brush, Points);
end
else
begin
Points[0] := TGPPoint.Create(ExpanderRect.Right - TreeExpanderCollapsedWidth96dpi,
ExpanderRect.Top + (ExpanderRect.Bottom - ExpanderRect.Top -
TreeExpanderCollapsedHeight96dpi) div 2);
Points[1] := TGPPoint.Create(ExpanderRect.Right,
ExpanderRect.Top + (ExpanderRect.Bottom - ExpanderRect.Top) div 2);
Points[2] := TGPPoint.Create(ExpanderRect.Right - TreeExpanderCollapsedWidth96dpi,
ExpanderRect.Top + (ExpanderRect.Bottom - ExpanderRect.Top +
TreeExpanderCollapsedHeight96dpi) div 2);
Pen := TGPPen.Create(TGPColor.CreateFromColorRef(UnthemedColor));
Graphics.DrawPolygon(Pen, Points);
end;
end;
end;
procedure TForm1.TreeView1AdvancedCustomDrawItem(Sender: TCustomTreeView;
Node: TTreeNode; State: TCustomDrawState; Stage: TCustomDrawStage; var PaintImages,
DefaultDraw: Boolean);
var
NodeRect: TRect;
NodeTextRect: TRect;
Text: string;
ThemeData: HTHEME;
TreeItemState: Integer;
begin
if Stage = cdPrePaint then
begin
NodeRect := Node.DisplayRect(False);
NodeTextRect := Node.DisplayRect(True);
// Drawing background
if (cdsSelected in State) and Sender.Focused then
TreeItemState := TREIS_SELECTED
else
if (cdsSelected in State) and (cdsHot in State) then
TreeItemState := TREIS_HOTSELECTED
else
if cdsSelected in State then
TreeItemState := TREIS_SELECTEDNOTFOCUS
else
if cdsHot in State then
TreeItemState := TREIS_HOT
else
TreeItemState := TREEITEMStateFiller0;
if TreeItemState <> TREEITEMStateFiller0 then
begin
ThemeData := OpenThemeData(Sender.Handle, VSCLASS_TREEVIEW);
DrawThemeBackground(ThemeData, Sender.Canvas.Handle, TVP_TREEITEM, TreeItemState,
NodeRect, nil);
CloseThemeData(ThemeData);
end;
// Drawing expander
if Node.HasChildren then
DrawExpander(Sender.Canvas, NodeTextRect, Node.Expanded, cdsHot in State);
// Drawing main text
SetBkMode(Sender.Canvas.Handle, TRANSPARENT);
SetTextColor(Sender.Canvas.Handle, clBlue);
Text := Node.Text;
Sender.Canvas.TextRect(NodeTextRect, Text,
[tfVerticalCenter, tfSingleLine, tfEndEllipsis, tfLeft]);
// Some extended drawing...
end;
PaintImages := False;
DefaultDraw := False;
end;