Как в ListBox красиво обрезать строки по ширине ListBox, и ...

← →
Gear (2004-09-12 17:05) [0]

Как в ListBox красиво обрезать строки по ширине ListBox, и выдавать полную строку в Hint при наведении на неё мышью?

← →
Profi © (2004-09-12 17:12) [1]

Gear (12.09.04 17:05)
Заменяй последние три видимых символа точками!

← →
Gear (2004-09-12 17:26) [2]

может у кого есть наработки? код не кините?

← →
QuasiLamo © (2004-09-12 18:09) [3]

{
In-place ToolTips are used to display text strings for objects that have been clipped,
in TreeView for example. The following code has been tested only on standard ListBox.
Of cause you can use tips on other VCLs after appropriate modification.
(Only copy following code to your form1"s unit file)
}

//------------------------------------------------------------------------------
// Show in-place tooltips on ListBox
// Author??Joe Huang Email??Happyjoe@21cn.com
//
//------------------------------------------------------------------------------

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, CommCtrl;

type
//Override TListBox"s WinProc to get CM_MOUSELEAVE message
TNewListBox = class(TListBox)
protected
{ Protected declarations }
procedure WndProc(var Message: TMessage); override;
end;

type
TForm1 = class(TForm)
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
GHWND: HWND;
TipVisable: Boolean;
OldIndex, CurrentIndex: Integer;
ti: TOOLINFO;
ListBox1: TListBox;

procedure InitListBox; //Create ListBox1 dynamically
procedure CreateTipsWindow; //Create Tooltip Window
procedure HideTipsWindow; //Hide Tooltip Window

//WM_NOTIFY message"s handler, fill Tooltip Window content
procedure WMNotify(var Msg: TMessage); message WM_NOTIFY;

procedure ListBox_MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure ListBox_MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

{ TNewListBox }

procedure TNewListBox.WndProc(var Message: TMessage);
begin
case Message.Msg of
CM_MOUSELEAVE: Form1.HideTipsWindow;
end;
inherited WndProc(Message);
end;

{ TForm1 }

procedure TForm1.InitListBox;
begin
ListBox1 := TNewListBox.Create(Self);
ListBox1.Parent := Self;
ListBox1.Left := 50;
ListBox1.Top := 50;
ListBox1.Width := 200;
ListBox1.Height := 200;
//append serveral items for testing
ListBox1.Items.Append("happyjoe");
ListBox1.Items.Append("Please send me email: happyjoe@21cn.com");
ListBox1.Items.Append("Delphi 5 Developer""s Guide");
ListBox1.Items.Append("Delphi 5.X ADO/MTS/COM+ Advanced Development");

ListBox1.OnMouseMove := ListBox_MouseMove;
ListBox1.OnMouseDown := ListBox_MouseDown;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Self.Font.Name := "Tahoma";
InitListBox;
CreateTipsWindow;
end;

procedure TForm1.CreateTipsWindow;
var
iccex: tagINITCOMMONCONTROLSEX;
begin
// Load the ToolTip class from the DLL.
iccex.dwSize := SizeOf(tagINITCOMMONCONTROLSEX);
iccex.dwICC := ICC_BAR_CLASSES;
InitCommonControlsEx(iccex);

// Create the ToolTip control.
GHWND := CreateWindow(TOOLTIPS_CLASS, "",
WS_POPUP,
Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT),
Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT),
0, 0, hInstance,
nil);

// Prepare TOOLINFO structure for use as tracking ToolTip.
ti.cbSize := SizeOf(ti);
ti.uFlags := TTF_IDISHWND + TTF_TRACK + TTF_ABSOLUTE + TTF_TRANSPARENT;
ti.hwnd := Self.Handle;
ti.uId := ListBox1.Handle;
ti.hinst := hInstance;
ti.lpszText := LPSTR_TEXTCALLBACK;
ti.Rect.Left := 0;
ti.Rect.Top := 0;
ti.Rect.Bottom := 0;
ti.Rect.Right := 0;

SendMessage(GHWND, WM_SETFONT, ListBox1.Font.Handle, Integer(LongBool(False)));
SendMessage(GHWND,TTM_ADDTOOL,0,Integer(@ti));
end;

procedure TForm1.WMNotify(var Msg: TMessage);
var
phd: PHDNotify;
NMTTDISPINFO: PNMTTDispInfo;
begin
phd := PHDNotify(Msg.lParam);
if phd.Hdr.hwndFrom = GHWND then
begin
if phd.Hdr.Code = TTN_NEEDTEXT then
begin
NMTTDISPINFO := PNMTTDispInfo(phd);
NMTTDISPINFO.lpszText := PChar(ListBox1.Items[CurrentIndex]);
end;
end;
end;

procedure TForm1.ListBox_MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if TipVisable then //when mouse down, hide Tooltip Window
begin
SendMessage(GHWND,TTM_TRACKACTIVATE,Integer(LongBool(False)), 0);
TipVisable := False;
end;
end;

procedure TForm1.ListBox_MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
Index: Integer;
APoint: TPoint;
ARect: TRect;
ScreenRect: TRect;
begin
Index := ListBox1.ItemAtPos(Point(X, Y), true);
if Index = -1 then
begin
SendMessage(GHWND,TTM_TRACKACTIVATE,Integer(LongBool(False)), 0);
OldIndex := -1;
TipVisable := False;
Exit;
end;
CurrentIndex := Index;
if Index = OldIndex then Exit;
if TipVisable then
begin
SendMessage(GHWND,TTM_TRACKACTIVATE,Integer(LongBool(False)), 0);
OldIndex := -1;
TipVisable := False;
end else
begin
ARect := ListBox1.ItemRect(Index);

if

...

procedure TForm1.ListBox_MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
Index: Integer;
APoint: TPoint;
ARect: TRect;
ScreenRect: TRect;
begin
Index := ListBox1.ItemAtPos(Point(X, Y), true);
if Index = -1 then
begin
SendMessage(GHWND,TTM_TRACKACTIVATE,Integer(LongBool(False)), 0);
OldIndex := -1;
TipVisable := False;
Exit;
end;
CurrentIndex := Index;
if Index = OldIndex then Exit;
if TipVisable then
begin
SendMessage(GHWND,TTM_TRACKACTIVATE,Integer(LongBool(False)), 0);
OldIndex := -1;
TipVisable := False;
end else
begin
ARect := ListBox1.ItemRect(Index);

if (ARect.Right - ARect.Left - 2) >= ListBox1.Canvas.TextWidth(ListBox1.Items[Index]) then
begin
OldIndex := -1;
Exit;
end;
APoint := ListBox1.ClientToScreen(ARect.TopLeft);
windows.GetClientRect(GetDesktopWindow, ScreenRect);

if ListBox1.Canvas.TextWidth(ListBox1.Items[Index]) + APoint.X > ScreenRect.Right then
APoint.X := ScreenRect.Right - ListBox1.Canvas.TextWidth(ListBox1.Items[Index]) - 5;
SendMessage(GHWND,
TTM_TRACKPOSITION,
0,
MAKELPARAM(APoint.x - 1, APoint.y - 2));

SendMessage(GHWND,TTM_TRACKACTIVATE,Integer(LongBool(True)), Integer(@ti));
OldIndex := Index;
TipVisable := True;
end;
end;

procedure TForm1.HideTipsWindow;
begin
if TipVisable then
begin
SendMessage(GHWND,TTM_TRACKACTIVATE,Integer(LongBool(False)), 0);
OldIndex := -1;
TipVisable := False;
end;
end;

// Test it:

procedure TForm1.Button2Click(Sender: TObject);
begin
InitListBox;
CreateTipsWindow;
end;

end.
end.

отображение имени файла в колонке ListView, можешь попробовать адаптировать.

lv - TListView

function TfmFlights.CalcVisibleString(const AString: string; AWidth: integer): string; var _text: string; _add: string; _i: integer; begin if lv.Canvas.TextWidth(AString) < AWidth+2 then Result := AString else begin _text := "..." + ExtractFileName(AString); _i := 1; _add := EmptyStr; if lv.Canvas.TextWidth(_add+_text) < AWidth-20 then while (lv.Canvas.TextWidth(_add+_text) < AWidth-20) and (_i < Length(AString)-Length(_text)-1) do begin _add := _add + AString[_i]; inc(_i) end else _text := ExtractFileName(AString); Result := _add + _text end end;

Как в ListBox красиво обрезать строки по ширине ListBox, и ... Найти похожие ветки