in a label i can add a new line like this
Label.Caption:='First line'+#13#10+'SecondLine';
can this be done in a TListView?
listItem:=listView.Items.Add;
listItem.Caption:='First line'+#13#10+'SecondLine';
thanks
It is possible to have multiline strings in a standard TListView in vsReport style, but AFAIK it doesn't support varying row heights. However, if you have all rows with the same number of lines > 1 you can achieve that quite easily.
You need to set the list view to OwnerDraw mode, first so you can actually draw the multiline captions, and second to get a chance to increase the row height to the necessary value. This is done by handling the WM_MEASUREITEM message, which is sent only for owner-drawn list views.
A small example to demonstrate this:
type
TForm1 = class(TForm)
ListView1: TListView;
procedure FormCreate(Sender: TObject);
procedure ListView1DrawItem(Sender: TCustomListView; Item: TListItem;
Rect: TRect; State: TOwnerDrawState);
private
procedure WMMeasureItem(var AMsg: TWMMeasureItem); message WM_MEASUREITEM;
end;
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
ListView1.ViewStyle := vsReport;
ListView1.OwnerDraw := True;
ListView1.OwnerData := True;
ListView1.Items.Count := 1000;
with ListView1.Columns.Add do begin
Caption := 'Multiline string test';
Width := 400;
end;
ListView1.OnDrawItem := ListView1DrawItem;
end;
procedure TForm1.ListView1DrawItem(Sender: TCustomListView;
Item: TListItem; Rect: TRect; State: TOwnerDrawState);
begin
if odSelected in State then begin
Sender.Canvas.Brush.Color := clHighlight;
Sender.Canvas.Font.Color := clHighlightText;
end;
Sender.Canvas.FillRect(Rect);
InflateRect(Rect, -2, -2);
DrawText(Sender.Canvas.Handle,
PChar(Format('Multiline string for'#13#10'Item %d', [Item.Index])),
-1, Rect, DT_LEFT);
end;
procedure TForm1.WMMeasureItem(var AMsg: TWMMeasureItem);
begin
inherited;
if AMsg.IDCtl = ListView1.Handle then
AMsg.MeasureItemStruct^.itemHeight := 4 + 2 * ListView1.Canvas.TextHeight('Wg');
end;
I know this is an old thread, and I can't take credit for figuring this out, but to adjust the row height in a TListView you can add an image list for the StateImages and then specify the image height by expanding the StateImages item in the properties window. You don't need to load any actual images.
Sorry I can't credit the actual person who figured it out - it was on a forum I visited a while back.
I don't seem to be able to achieve this using the TListView. But using the TMS TAdvListView, you can use HTML in the item text so this will put the caption onto 2 lines:
with AdvListView1.Items.Add do
begin
Caption := '<FONT color="clBlue">Line 1<BR>Line 2</font>';
end;
Related
Edit: Scroll to question bottom to see answered working code.
I am trying to change the colour of the menu bar on a Form.
I found this site with some advice:
https://www.experts-exchange.com/questions/20150240/Color-on-the-MainMenu.html
I will paste the code itself below.
Unfortunately, it doesn't quite work as I would like. The shortcomings are:
The colour only applies to the menu items, the remaining space to the right of the last menu item is grey. I have set the Form colour to be the same as the menu, but it doesn't change this.
Some of the entries in each menu drop-down should be disabled, and if I don't apply the colouring code they are correctly shown disabled. Applying the colour changes removes this visual effect, and their colour is the same as all the other entries in the menu drop-down.
My questions are:
Is there a pre-rolled menu object out there that will allow me to easily colour the menu bar, including the empty space to the right, and that preserves properties like showing disabled?
If not, could someone point me in the right direction as to what additional changes I need to make to the code that could fix the problems above?
I am a total newbie to Delphi (and coding, really) but if I can get the names of things to look up then I can Google and take it from there.
I'm using Delphi 10.3.
Code copied from the link above:
type
TForm1 = class(TForm)
.....
procedure FormCreate(Sender: TObject);
public
procedure DrawMenuItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
end;
...
procedure TForm1.DrawMenuItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
var
S: String;
begin
with ACanvas do
begin
S := TMenuItem(Sender).Caption;
if Selected then
Brush.Color := clHighLight
else
Brush.Color := clLime;
FillRect(ARect);
DrawText(ACanvas.Handle, PChar(S), Length(S), ARect, DT_SINGLELINE or DT_VCENTER);
end;
end;
procedure AllOnDrawTo(M: TMenuItem; P: TMenuDrawItemEvent);
var
I: Integer;
begin
M.OnDrawItem := P;
for I := 0 to M.Count-1 do
AllOnDrawTo(M.Items[I], P);
end;
procedure TForm1.FormCreate(Sender: TObject);
var
I: Integer;
begin
for I := 0 to MM.Items.Count -1 do
AllOnDrawTo(MM.Items[I], DrawMenuItem);
end;
UPDATE:
#tom-brunberg gave me the required additions in a comment. Below is the updated code to implement both items I requested. I have kept the original code because I think it is interesting to see the contrast between the two options.
type
TForm1 = class(TForm)
.....
procedure FormCreate(Sender: TObject);
public
procedure AdvancedDrawMenuItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; State: TOwnerDrawState);
end;
...
procedure TForm1.AdvancedDrawMenuItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; State: TOwnerDrawState);
var
S: String;
begin
with ACanvas do
begin
S := TMenuItem(Sender).Caption;
// Set the highlight colour when the menu item is selected. Grey highlight if disabled.
if odSelected in State then
if odDisabled in State then
Brush.Color := clBtnFace
else
Brush.Color := clGradientActiveCaption
else
Brush.Color := clGradientInactiveCaption;
// Set the colour of the menu item textm, grey if disabled
if odDisabled in State then
Font.Color := clGray
else
Font.Color := clBlack;
// this line fill rest of the top of the form the same colour as the menu. If its the LAST menu item fill rect all way to the right. My example has 8 menu items
if (Parent = nil) and (TMenuItem(Sender).MenuIndex = 8) and not (odSelected in State) then
ARect.Right := Width;
FillRect(ARect);
DrawText(ACanvas.Handle, PChar(S), Length(S), ARect, DT_SINGLELINE or DT_VCENTER);
end;
end;
procedure AdvancedAllOnDrawTo(M: TMenuItem; P: TAdvancedMenuDrawItemEvent);
var
I: Integer;
begin
M.OnAdvancedDrawItem := P;
for I := 0 to M.Count-1 do
AdvancedAllOnDrawTo(M.Items[I], P);
end;
procedure TForm1.FormCreate(Sender: TObject);
var
I: Integer;
begin
for I := 0 to MM.Items.Count -1 do
AdvancedAllOnDrawTo(MM.Items[I], AdvancedDrawMenuItem);
end;
I don't have a full answer for you, but you did say that you can 'google from there'.
Your code applies a custom drawing routine to the menu items only. If you also want to draw the menu bar itself you need to have a custom drawing routine for that. The standard TMenu OwenerDraw allows you to receive events for the menu items. The Menu does have a Window Handle, which means you can paint to it, ideally you want it to stop itself from overpainting any changes you make. Have a look at the source code for the TMenu painting (I haven't had time to do that) and see if you can spot what you need to override to paint it.
TMenu wil be wrapping the generic Windows handling for a menu, so you may be able to find out how Windows allows you to draw the menu and then implement that. (That's a fair amount of googling!)
As for the enabled/disabled feedback You can draw anything you like in the on draw event. If you want to visually display something different when the TMenuItem is disabled, check if it's disabled and then draw what you want.
In a Delphi 10.1.2 VCL Forms Application, I fill a TComboBox with the Screen.Fonts list and display the font items using their own font-faces:
procedure TForm2.FormCreate(Sender: TObject);
begin
AddFontsToComboList;
end;
procedure TForm2.AddFontsToComboList;
var
i: Integer;
begin
ComboBox1.Items.BeginUpdate;
try
for i := 0 to Screen.Fonts.Count - 1 do
begin
ComboBox1.Items.Add(Screen.Fonts[i]);
end;
finally
ComboBox1.Items.EndUpdate;
end;
end;
procedure TForm2.ComboBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
// ComboBox1.Style must be csOwnerDrawVariable
begin
with ComboBox1 do
begin
Canvas.fillrect(rect);
Canvas.Font.Style := [fsbold];
Canvas.Font.Name := ComboBox1.Items[Index];
Canvas.Textout(rect.Left, rect.Top, ComboBox1.Items[Index]);
end;
end;
This is the result:
You can see that there are some missing items. In the above screenshot, the missing font is Cambria Math.
So how can I filter out those empty items?
And how can I filter out those items which are unreadable?
And how can I filter out the fonts which contain only symbols?
You know what I mean.
I am trying to write custom date picker(calendar). The dates will be displayed on the stringgrid. I am trying to fill the clicked cell with a custom color and make that selected celltext bold.
Here is my code:
type
TStringGrid = Class(Vcl.Grids.TStringGrid)
private
FHideFocusRect: Boolean;
protected
Procedure Paint;override;
public
Property HideFocusRect:Boolean Read FHideFocusRect Write FHideFocusRect;
End;
TfrmNepaliCalendar = class(TForm)
...
...
...
end;
procedure TfrmNepaliCalendar.StringGridDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
if gdSelected in State then begin
StringGrid.Canvas.Brush.Color := $00940A4B;
StringGrid.Canvas.FillRect(Rect);
StringGrid.Canvas.Font.Style := [fsBold];
StringGrid.Canvas.Font.Color := clHighlightText;
StringGrid.Canvas.TextOut(Rect.Left + 3, Rect.Top + 5, StringGrid.Cells[ACol,ARow]);
StringGrid.HideFocusRect := True;
end;
end;
{ TStringGrid }
procedure TStringGrid.Paint;
var
LRect: TRect;
begin
inherited;
if HideFocusRect then begin
LRect := CellRect(Col,Row);
if DrawingStyle = gdsThemed then InflateRect(LRect,-1,-1);
DrawFocusrect(Canvas.Handle,LRect)
end;
end;
The output, I am getting:
Problem #1: I need to hide that unwanted rectangle appearing as border for the selected cell
Problem #2: Avoid the cell background clipping
In the OnDrawCell procedure add just before FillRect
Rect.Left := Rect.Left-4;
Seems to work.
An alternative
The above doesn't fully solve the focus issue even with your paint procedure addon. Sometimes a white line is visible just inside the cell borders.
But the following is an alternative, that solves both your issues. It requires a little more coding, but not so much. On the other hand, subclassing TStringGrid is not needed, neither the Rect adjustment
The basis is to disable default drawing, so set the grids property DefaultDrawing := false;
and then add to the OnDrawCell event:
procedure TForm1.StringGridDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
if gdFixed in State then
begin
StringGrid.Canvas.Brush.Color := clGradientInactiveCaption;
StringGrid.Canvas.Font.Style := [];
StringGrid.Canvas.Font.Color := clBlack;
end
else
if gdSelected in State then
begin
StringGrid.Canvas.Brush.Color := $00940A4B;
StringGrid.Canvas.Font.Style := [fsBold];
StringGrid.Canvas.Font.Color := clHighlightText;
end
else
begin
StringGrid.Canvas.Brush.Color := $00FFFFFF;
StringGrid.Canvas.Font.Style := [];
StringGrid.Canvas.Font.Color := clWindowText;
end;
StringGrid.Canvas.FillRect(Rect);
StringGrid.Canvas.TextOut(Rect.Left + 3, Rect.Top + 5, StringGrid.Cells[ACol,ARow]);
end;
With default drawing disabled, the grid draws the grid frame and the grid lines, but leaves all other drawing to the programmer. The caveat is that you have to add fancy themed drawing yourself if you need it.
With above coding I get this result:
I assume you (want to) use the default DefaultDrawing = True setting, otherwise your question does not exist.
To get rid of the focus rect, you need to draw it again (because it is a XOR-operation, the focus rect will disappear), or prevent it from being drawn.
Drawing again is done by utilizing the OnDrawCell event:
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
if gdFocused in State then
DrawFocusRect(StringGrid1.Canvas.Handle, Rect);
end;
Preventing it from drawing at all e.g. is done by disabling the possibility to set focus to the StringGrid. I assume you do not use its editor, so that should give no further usability concerns.
type
TStringGrid = class(Vcl.Grids.TStringGrid)
public
function CanFocus: Boolean; override;
end;
function TStringGrid.CanFocus: Boolean;
begin
Result := False;
end;
This actually is a bit strange working solution, because you are still able to tab into the control and it keeps responding to keyboard events.
I cannot reproduce your cliping problem with this code (XE2 here):
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
if gdSelected in State then
begin
StringGrid1.Canvas.Brush.Color := $00940A4B;
StringGrid1.Canvas.FillRect(Rect);
StringGrid1.Canvas.Font.Style := [fsBold];
StringGrid1.Canvas.Font.Color := clHighlightText;
StringGrid1.Canvas.TextOut(Rect.Left + 3, Rect.Top + 5,
StringGrid1.Cells[ACol, ARow]);
end;
end;
The Rect will be and ís the correct CellRect. The cliping effect is due to something else elsewhere.
But if there really is a spurious +4 in the source code of XE8 like Tom Brunberg mentions, which is easily overcome with -4, then that obviously is a bug and should be reported.
When there is no data to show in ListView, it is better to show message as "no data is changed now", which should be drawed in a TLabel.
How to draw a TLabel in the ListView client area?
You don't need a TLabel for that.
On Vista and later, you can subclass the ListView to handle the LVN_GETEMPTYMARKUP notification.
uses
..., CommCtrl;
private
PrevWndProc: TWndMethod;
procedure TMyForm.FormCreate(Sender: TObject);
begin
PrevWndProc := ListView.WndProc;
ListView.WndProc := ListViewWndProc;
end;
procedure TMyForm.ListViewWndProc(var Message: TMessage);
begin
if Message.Msg = CN_NOTIFY then
begin
if TWMNotifyLV(Message).NMHdr.code = LVN_GETEMPTYMARKUP then
begin
with PNMLVEmptyMarkup(TWMNotifyLV(Message).NMHdr)^ do
begin
dwFlags := EMF_CENTERED;
StrLCopy(szMarkup, 'My message here', L_MAX_URL_LENGTH);
end;
Message.Result := 1;
Exit;
end;
end;
PrevWndProc(Message);
end;
The downside is you have little control over where the text appears (only whether it is left-justified or centered) or how it is formatted, and you cannot change the text dynamically (you would have to add at least one item and then remove it to trigger a new notification).
On earlier versions, or if you need more control over the text position/format/behavior, you can use the ListView's OnCustomDraw event instead. You can draw whatever you want on the ListView's Canvas within the area designated by a TRect provided by the event. If needed, you can use ListView_GetHeader() to determine if the ListView's column headers are visible, and if so then use GetWindowRect() to get the header's height so you can subtract it from the top of the TRect before drawing.
For example:
procedure TMyForm.ListViewCustomDraw(Sender: TCustomListView; const ARect: TRect; var DefaultDraw: Boolean);
var
R, Temp: TRect;
Wnd: HWND;
begin
if Sender.Items.Count <= 0 then
begin
R := ARect;
Wnd := ListView_GetHeader(Sender.Handle);
if Wnd <> 0 then
begin
GetWindowRect(Wnd, #Temp);
R.Top := R.Top + (Temp.Bottom-Temp.Top);
end;
R.Top := R.Top + 10;
DrawText(Sender.Canvas.Handle, 'My message here', -1, #R, DT_CENTER or DT_SINGLELINE);
end;
end;
I use Delphi 2007. I have a TListView with OwnerData and OwnerDraw set to True. ViewStyle is set to vsReport.
I have a record.
type TAList=record
Item:Integer;
SubItem1:String;
SubItem2:String;
end;
var
ModuleData: array of TAList;
procedure TForm1.ListView3Data(Sender: TObject; Item: TListItem);
begin
Item.Caption := IntToStr(ModuleData[Item.Index].Item);
Item.SubItems.Add(ModuleData[Item.Index].SubItem1);
Item.SubItems.Add(ModuleData[Item.Index].SubItem2);
end;
procedure TForm1.ListView3DrawItem(Sender: TCustomListView; Item: TListItem; Rect: TRect; State: TOwnerDrawState);
var
LIndex : integer;
LRect: TRect;
LText: string;
TTListView: TListView;
begin
TTListView := TListView(Sender);
if (Item.SubItems[0] = '...') then
begin
TTListView.Canvas.Brush.Color := clHighlight;
TTListView.Canvas.Font.Color := clHighlightText;
end else
begin
TTListView.Canvas.Brush.Color := TTListView.Color;
TTListView.Canvas.Font.Color := TTListView.Font.Color;
end;
for LIndex := 0 to TTListView.Columns.Count - 1 do
begin
if (not(ListView_GetSubItemRect(TTListView.Handle, Item.Index, LIndex, LVIR_BOUNDS, #LRect))) then Continue;
TTListView.Canvas.FillRect(LRect);
if (LIndex = 0) then LText := Item.Caption else LText := Item.SubItems[LIndex - 1];
LRect.Left := LRect.Left + 6;
DrawText(TTListView.Canvas.Handle, PChar(LText), Length(LText), LRect, DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX or DT_END_ELLIPSIS);
end;
end;
I wish to show an hint when SubItem2 is truncated. On Windows XP, no hint is shown at all. On Windows Vista & Windows 7, when my mouse is over an item, it shows an hint that is totally off.
I have no special code to handle hints. Should there be one in OwnerData and OwnerDraw modes?
Here are images of what I get:
(source: noelshack.com)
(source: noelshack.com)
EDIT:
David asked why OwnerDraw was set to True. There are two reasons:
This way, I can "disallow" user selection.
If I set OwnerDraw to False, I get another problem. See Why do I get white column separators on my custom-drawn listview?
EDIT 2:
If I handle the OnInfoTip event as suggested by TLama, I get an unthemed balloon hint and the wrong hint from Windows Vista & 7.
1. Environment
Behavior described here I've experienced and tested only on Windows 7 SP1 64-bit Home Premium with most recent updates installed with application built in Delphi 2009 also with latest updates applied. In no other system I've tried this.
2. About the problem
Default item hints that you can see on your screenshot doesn't come from VCL. In certain circumstances whose you just hit, are those hints shown by the system in a wrong, probably somehow cached way. The text of the last item you hovered is shown as a hint for the item you're just hovering. Here is the property configuration (just the important part; the rest I kept in default component values):
ListView1.ShowHint := False;
ListView1.OwnerData := True;
ListView1.OwnerDraw := True;
ListView1.ViewStyle := vsReport;
The following events are handled:
OnData
OnDrawItem
Actually, you don't even need to handle the OnDrawItem to simulate the problem. The hints are shown by the texts given to the items in the OnData event. I'm not able to trace it more deeper, since it seems there's no notification handler (nor even system notification) that might be related to the hints you see in the VCL, which is the reason why I'm suspecting the system.
3. The way to solution
Nothing what I've tried didn't fix the problem keeping your current property configuration. Here's a list of what I've tried:
3.1. Remove the LVS_EX_LABELTIP style ?
As a hot favorite and actually the first what I've checked was excluding the LVS_EX_LABELTIP from the list view's style in a hope the item hint showing will stop and you'll be able to implement your own custom hints through the OnInfoTip event. The problem is, that this style is not implemented anywhere in the list view control, thus it's not included in the list view style.
3.2. Disable the OwnerDraw property ?
Setting the OwnerDraw property to False actually resolves the issue (hints are then shown with correct item texts by the actual hovered item), but you've said you need to use owner drawing, so it's also not a solution for you.
3.3. Remove the LVS_EX_INFOTIP style ?
Removing the LVS_EX_INFOTIP style from the list view's style finally stopped showing of the item hints by the system, but also caused that the control stopped to send to the parent the tooltip notifications. As a consequence of this is the OnInfoTip event with its functionality cutted off. In this case you need to implement the hint handling completely by yourself. And that's what I've tried in the following code.
4. Workaround
I've decided to disable all the system hints of a list view by excluding of the LVS_EX_INFOTIP style and implementing own tooltip handling. So far I know at least about the following problems:
when you use a regular Hint property and hover from an item with shortened caption to the empty area of a list view, the Hint is shown, but it doesn't hide unless you exit the control client rectangle or the hint show time interval elapses (even if you hover an item with shortened caption again). The problem is that I don't know how to specify the CursorRect for the THintInfo structure, so that you cover the whole client rectangle except items area rectangle.
you must use the same item rectangle extents as you use in your owner drawing event method since the system doesn't know, where you're rendering the text of your items. So, another disadvantage is to keep this in sync.
Here is the code of the main unit from a demo project, which you can download from here if you want:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, CommCtrl, StdCtrls;
type
TRecord = record
Item: Integer;
SubItem1: string;
SubItem2: string;
end;
type
TListView = class(ComCtrls.TListView)
private
procedure CMHintShow(var AMessage: TCMHintShow); message CM_HINTSHOW;
end;
type
TForm1 = class(TForm)
ListView1: TListView;
procedure FormCreate(Sender: TObject);
procedure ListView1DrawItem(Sender: TCustomListView; Item: TListItem;
Rect: TRect; State: TOwnerDrawState);
procedure ListView1Data(Sender: TObject; Item: TListItem);
private
ModuleData: array of TRecord;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var
ListColumn: TListColumn;
begin
SetLength(ModuleData, 3);
ModuleData[0].Item := 0;
ModuleData[0].SubItem1 := '[0;0] Subitem caption';
ModuleData[0].SubItem2 := '[1;0] Subitem caption';
ModuleData[1].Item := 1;
ModuleData[1].SubItem1 := '[0;1] Subitem caption';
ModuleData[1].SubItem2 := '[1;1] Subitem caption';
ModuleData[2].Item := 2;
ModuleData[2].SubItem1 := '[0;2] This is a long subitem caption';
ModuleData[2].SubItem2 := '[0;2] This is even longer subitem caption';
ListView1.OwnerData := True;
ListView1.OwnerDraw := True;
ListView1.ViewStyle := vsReport;
ListView_SetExtendedListViewStyle(
ListView1.Handle,
ListView_GetExtendedListViewStyle(ListView1.Handle) and not LVS_EX_INFOTIP);
ListColumn := ListView1.Columns.Add;
ListColumn.Caption := 'Col. 1';
ListColumn.Width := 50;
ListColumn := ListView1.Columns.Add;
ListColumn.Caption := 'Col. 2';
ListColumn.Width := 50;
ListColumn := ListView1.Columns.Add;
ListColumn.Caption := 'Col. 3';
ListColumn.Width := 50;
ListView1.Items.Add;
ListView1.Items.Add;
ListView1.Items.Add;
end;
procedure TForm1.ListView1Data(Sender: TObject; Item: TListItem);
begin
Item.Caption := IntToStr(ModuleData[Item.Index].Item);
Item.SubItems.Add(ModuleData[Item.Index].SubItem1);
Item.SubItems.Add(ModuleData[Item.Index].SubItem2);
end;
procedure TForm1.ListView1DrawItem(Sender: TCustomListView; Item: TListItem;
Rect: TRect; State: TOwnerDrawState);
var
R: TRect;
S: string;
SubItem: Integer;
ListView: TListView;
begin
ListView := TListView(Sender);
if (Item.SubItems[0] = '...') then
begin
ListView.Canvas.Brush.Color := clHighlight;
ListView.Canvas.Font.Color := clHighlightText;
end
else
begin
ListView.Canvas.Brush.Color := ListView.Color;
ListView.Canvas.Font.Color := ListView.Font.Color;
end;
for SubItem := 0 to ListView.Columns.Count - 1 do
begin
if ListView_GetSubItemRect(ListView.Handle, Item.Index, SubItem,
LVIR_LABEL, #R) then
begin
ListView.Canvas.FillRect(R);
if (SubItem = 0) then
S := Item.Caption
else
begin
R.Left := R.Left + 6;
S := Item.SubItems[SubItem - 1];
end;
DrawText(ListView.Canvas.Handle, PChar(S), Length(S), R, DT_SINGLELINE or
DT_VCENTER or DT_NOPREFIX or DT_END_ELLIPSIS);
end;
end;
end;
{ TListView }
procedure TListView.CMHintShow(var AMessage: TCMHintShow);
var
R: TRect;
S: string;
Item: Integer;
SubItem: Integer;
HitTestInfo: TLVHitTestInfo;
begin
with AMessage do
begin
HitTestInfo.pt := Point(HintInfo.CursorPos.X, HintInfo.CursorPos.Y);
if ListView_SubItemHitTest(Handle, #HitTestInfo) <> -1 then
begin
Item := HitTestInfo.iItem;
SubItem := HitTestInfo.iSubItem;
if (Item <> -1) and (SubItem <> -1) and
ListView_GetSubItemRect(Handle, Item, SubItem, LVIR_LABEL, #R) then
begin
if (SubItem = 0) then
S := Items[Item].Caption
else
begin
R.Left := R.Left + 6;
S := Items[Item].SubItems[SubItem - 1];
end;
if ListView_GetStringWidth(Handle, PChar(S)) > R.Right - R.Left then
begin
MapWindowPoints(Handle, 0, R.TopLeft, 1);
MapWindowPoints(Handle, 0, R.BottomRight, 1);
HintInfo^.CursorRect := R;
HintInfo^.HintPos.X := R.Left;
HintInfo^.HintPos.Y := R.Top;
HintInfo^.HintMaxWidth := ClientWidth;
HintInfo^.HintStr := S;
AMessage.Result := 0;
end
else
AMessage.Result := 1;
end
else
AMessage.Result := 1;
end
else
inherited;
end;
end;
end.