我正在尝试设法如何在ScrollWidth
上设置TListBox
来控制水平滚动条。这是我的第一次尝试:
program ListBoxSizing;
uses
Math, Forms, StdCtrls;
var
Form: TForm;
ListBox: TListBox;
procedure BuildForm;
begin
//Form.Font.Size := 9;
Form.ClientWidth := 200;
Form.ClientHeight := 100;
ListBox := TListBox.Create(Form);
ListBox.Parent := Form;
ListBox.SetBounds(0, 0, Form.ClientWidth, Form.ClientHeight);
ListBox.Items.Add('ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZ');
end;
procedure SetScrollWidth;
var
i, MaxWidth: Integer;
begin
MaxWidth := -1;
for i := 0 to ListBox.Items.Count-1 do
MaxWidth := Max(MaxWidth, ListBox.Canvas.TextWidth(ListBox.Items[i]));
if MaxWidth<>-1 then
ListBox.ScrollWidth := MaxWidth;
end;
begin
Application.MainFormOnTaskbar := True;
Application.CreateForm(TForm, Form);
BuildForm;
SetScrollWidth;
Application.Run;
end.
这是水平滚动条尽可能向右移动的结果:
注意最后一个角色的最后部分是如何被切断的。
现在,如果我们取消注释更改表单字体大小的行,它看起来像这样:
现在,似乎在后续调用TextWidth
时未考虑到字体大小的更改。
所以,我的问题是,根据列表框的当前内容,我需要使用哪些代码才能准确设置ScrollWidth
。
答案 0 :(得分:10)
procedure SetScrollWidth;
var
I, MaxWidth: Integer;
begin
MaxWidth := -1;
// assign control's font to canvas
ListBox.Canvas.Font := ListBox.Font;
for I := 0 to ListBox.Items.Count - 1 do
MaxWidth := Max(MaxWidth, ListBox.Canvas.TextWidth(ListBox.Items[I]));
// consider non-client area
if MaxWidth <> -1 then
ListBox.ScrollWidth := MaxWidth + ListBox.Width - ListBox.ClientWidth;
end;
答案 1 :(得分:2)
program Project2;
uses
Math, Forms, StdCtrls,Windows,Graphics;
var
Form: TForm;
ListBox: TListBox;
procedure BuildForm;
begin
//Form.Font.Size := 9;
Form.ClientWidth := 200;
Form.ClientHeight := 100;
ListBox := TListBox.Create(Form);
ListBox.Parent := Form;
Listbox.Font.Size := 40;
ListBox.SetBounds(0, 0, Form.ClientWidth, Form.ClientHeight);
ListBox.Items.Add('ABCDEFGXXXXXXXXXXXXOXOXYQASEOOWW');
ListBox.Items.Add('ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZ');
ListBox.Items.Add('ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZ111111111111111111111111111111111111111O');
end;
function GetRealFontWidth(fnt: TFont; const text:string): Integer;
var
dc: hdc;
tsize : Windows.TSize;
oldObj : Cardinal;
begin
dc := GetDC(0);
oldObj := SelectObject(DC, fnt.Handle);
GetTextExtentPoint32(dc, PChar(text), Length(text), tsize);
SelectObject(DC, oldObj);
ReleaseDC(0, DC);
Result := tsize.cx;
end;
procedure SetScrollWidth;
var
i, MaxWidth: Integer;
begin
MaxWidth := -1;
for i := 0 to ListBox.Items.Count-1 do
MaxWidth := Max(MaxWidth, GetRealFontWidth (ListBox.Font,ListBox.Items[i]));
if MaxWidth<>-1 then
ListBox.ScrollWidth := MaxWidth + 4;
end;
begin
Application.MainFormOnTaskbar := True;
Application.CreateForm(TForm, Form);
BuildForm;
SetScrollWidth;
Application.Run;
end.