您可以在自定义对话框中使用列表视图。
![Screenshot of the Task Dialog-like list-view table dialog box on Windows 7 with high DPI.](https://istack.dev59.com/PTfUF.webp)
我的类支持标准的Windows图标(和声音):信息、警告、错误、确认、无。这是没有图标的版本:
![Screenshot of the dialog in icon-less mode.](https://istack.dev59.com/naAHN.webp)
使用起来很容易:
TTableDialog.ShowTable
(
Self,
'Audio Properties',
['Duration', 'Samples per channel', 'Total data size', 'Channels', 'Bits per sample', 'Sample rate', 'Bitrate'],
['1 h 15 min 0 s', '216 000 000', '824 MB', '1', '32', '48 kHz', '1 536 kbit/sec'],
mtInformation
)
它支持DPI缩放(高DPI)和所有Windows版本,从Windows XP(也可能适用于Windows 2000,但我还没有测试过)到Windows 10:
![Screenshot of the same dialog on Windows XP.](https://istack.dev59.com/wRacb.webp)
![Screenshot of the same dialog on Windows 10.](https://istack.dev59.com/Zc77w.webp)
表格是一个列表视图,您可以获得它的所有优点,例如滚动条、截断省略号和工具提示:
![Screenshot of the dialog with a vertical scrollbar.](https://istack.dev59.com/l8mbR.webp)
![Screenshot of the dialog with a truncated string displaying an ellipsis.](https://istack.dev59.com/YOiGh.webp)
![Screenshot of the dialog with a tooltip window showing a truncated string.](https://istack.dev59.com/28r5m.webp)
您还可以指定对话框的大小,使其适合内容:
TTableDialog.ShowTable
(
Self,
'Audio Properties',
['Duration', 'Samples per channel', 'Total data size', 'Channels', 'Bits per sample', 'Sample rate', 'Bitrate', 'Maximum fractional sample value'],
['1 h 15 min 0 s', '216 000 000', '824 MB', '1', '32', '48 kHz', '1 536 kbit/sec', '0.1'],
mtInformation,
360,
240
)
![A bigger version of the previous dialog.](https://istack.dev59.com/QLC3q.webp)
当然,“确定”按钮既是默认值,也是取消,所以您可以使用“Enter”或“Escape”来关闭对话框。
最后,按下“Ctrl”+“C”将把表格复制到剪贴板。
完整源代码:
uses
ComCtrls, Math, Clipbrd;
type
TTableDialog = class
strict private
type TFormData = class(TComponent)
public
ListView: TListView;
IconKind: PWideChar;
Icon: HICON;
LIWSD: Boolean;
end;
class function Scale(X: Integer): Integer;
class procedure FormShow(Sender: TObject);
class procedure FormDestroy(Sender: TObject);
class procedure FormPaint(Sender: TObject);
class procedure FormKeyPress(Sender: TObject; var Key: Char);
class procedure LVToClipboard(AListView: TListView);
public
class procedure ShowTable(AOwner: TCustomForm; const ACaption: string;
const ANames, AValues: array of string;
ADialogType: TMsgDlgType = mtInformation;
const AWidth: Integer = 360; const AHeight: Integer = 200);
end;
class procedure TTableDialog.FormShow(Sender: TObject);
var
FormData: TFormData;
ComCtl: HMODULE;
LoadIconWithScaleDown: function(hinst: HINST; pszName: LPCWSTR; cx: Integer;
cy: Integer; var phico: HICON): HResult; stdcall;
begin
if not (Sender is TForm) then
Exit;
if not (TObject(TForm(Sender).Tag) is TFormData) then
Exit;
TForm(Sender).OnShow := nil;
FormData := TFormData(TForm(Sender).Tag);
if FormData.IconKind = nil then
Exit;
ComCtl := LoadLibrary('ComCtl32.dll');
if ComCtl <> 0 then
begin
try
LoadIconWithScaleDown := GetProcAddress(ComCtl, 'LoadIconWithScaleDown');
if Assigned(LoadIconWithScaleDown) then
FormData.LIWSD := Succeeded(LoadIconWithScaleDown(0, FormData.IconKind,
Scale(32), Scale(32), FormData.Icon));
finally
FreeLibrary(ComCtl);
end;
end;
if not FormData.LIWSD then
FormData.Icon := LoadIcon(0, FormData.IconKind);
end;
class procedure TTableDialog.FormDestroy(Sender: TObject);
var
FormData: TFormData;
begin
if not (Sender is TForm) then
Exit;
if not (TObject(TForm(Sender).Tag) is TFormData) then
Exit;
FormData := TFormData(TForm(Sender).Tag);
if (FormData.Icon <> 0) and FormData.LIWSD then
DestroyIcon(FormData.Icon);
end;
class procedure TTableDialog.FormKeyPress(Sender: TObject; var Key: Char);
var
FormData: TFormData;
begin
if not (Sender is TForm) then
Exit;
if not (TObject(TForm(Sender).Tag) is TFormData) then
Exit;
FormData := TFormData(TForm(Sender).Tag);
case Key of
^C:
LVToClipboard(FormData.ListView);
end;
end;
class procedure TTableDialog.FormPaint(Sender: TObject);
var
FormData: TFormData;
Frm: TForm;
Y: Integer;
begin
if not (Sender is TForm) then
Exit;
if not (TObject(TForm(Sender).Tag) is TFormData) then
Exit;
Frm := TForm(Sender);
FormData := TFormData(TForm(Sender).Tag);
Y := Frm.ClientHeight - Scale(25 + 8 + 8);
Frm.Canvas.Brush.Color := clWhite;
Frm.Canvas.FillRect(Rect(0, 0, Frm.ClientWidth, Y));
Frm.Canvas.Pen.Color := $00DFDFDF;
Frm.Canvas.MoveTo(0, Y);
Frm.Canvas.LineTo(Frm.ClientWidth, Y);
if FormData.Icon <> 0 then
DrawIconEx(Frm.Canvas.Handle, Scale(8), Scale(8), FormData.Icon,
Scale(32), Scale(32), 0, 0, DI_NORMAL);
end;
class procedure TTableDialog.LVToClipboard(AListView: TListView);
function GetRow(AIndex: Integer): string;
begin
if InRange(AIndex, 0, AListView.Items.Count - 1) and (AListView.Items[AIndex].SubItems.Count = 1) then
Result := AListView.Items[AIndex].Caption + #9 + AListView.Items[AIndex].SubItems[0]
else
Result := '';
end;
var
S: string;
i: Integer;
begin
if AListView = nil then
Exit;
S := GetRow(0);
for i := 1 to AListView.Items.Count - 1 do
S := S + sLineBreak + GetRow(i);
Clipboard.AsText := S;
end;
class function TTableDialog.Scale(X: Integer): Integer;
begin
Result := MulDiv(X, Screen.PixelsPerInch, 96);
end;
class procedure TTableDialog.ShowTable(AOwner: TCustomForm; const ACaption: string;
const ANames, AValues: array of string;
ADialogType: TMsgDlgType = mtInformation;
const AWidth: Integer = 360; const AHeight: Integer = 200);
const
Sounds: array[TMsgDlgType] of Integer =
(MB_ICONWARNING, MB_ICONERROR, MB_ICONINFORMATION, MB_ICONQUESTION, 0);
Icons: array[TMsgDlgType] of MakeIntResource =
(IDI_WARNING, IDI_ERROR, IDI_INFORMATION, IDI_QUESTION, nil);
var
dlg: TForm;
lv: TListView;
btn: TButton;
i: Integer;
snd: Integer;
begin
if Length(ANames) <> Length(AValues) then
raise Exception.Create('The lengths of the columns don''t match.');
dlg := TForm.Create(AOwner);
try
dlg.BorderStyle := bsDialog;
dlg.Caption := ACaption;
dlg.Width := Scale(AWidth);
dlg.Height := Scale(AHeight);
dlg.Position := poOwnerFormCenter;
dlg.Scaled := False;
dlg.Font.Name := 'Segoe UI';
dlg.Font.Size := 9;
dlg.Tag := NativeInt(TFormData.Create(dlg));
TFormData(dlg.Tag).IconKind := Icons[ADialogType];
dlg.OnShow := FormShow;
dlg.OnDestroy := FormDestroy;
dlg.OnPaint := FormPaint;
dlg.OnKeyPress := FormKeyPress;
dlg.KeyPreview := True;
btn := TButton.Create(dlg);
btn.Parent := dlg;
btn.Caption := 'OK';
btn.Default := True;
btn.Cancel := True;
btn.ModalResult := mrOk;
btn.Width:= Scale(75);
btn.Height := Scale(25);
btn.Left := dlg.ClientWidth - btn.Width - Scale(8);
btn.Top := dlg.ClientHeight - btn.Height - Scale(8);
lv := TListView.Create(dlg);
TFormData(dlg.Tag).ListView := lv;
lv.Parent := dlg;
lv.DoubleBuffered := True;
lv.ReadOnly := True;
lv.BorderStyle := bsNone;
lv.Left := Scale(8) + IfThen(Icons[ADialogType] <> nil, Scale(32 + 8));
lv.Top := Scale(8);
lv.Width := dlg.ClientWidth - Scale(16) - IfThen(Icons[ADialogType] <> nil, Scale(32 + 8));
lv.Height := dlg.ClientHeight - Scale(16 + 8 + 4) - btn.Height;
lv.ViewStyle := vsReport;
lv.RowSelect := True;
lv.ShowColumnHeaders := False;
with lv.Columns.Add do
begin
Caption := 'Name';
Width := Scale(150);
end;
with lv.Columns.Add do
begin
Caption := 'Value';
Width := lv.ClientWidth - lv.Columns[0].Width -
GetSystemMetricsForWindow(SM_CXVSCROLL, dlg.Handle) - scale(2);
end;
for i := 0 to High(ANames) do
with lv.Items.Add do
begin
Caption := ANames[i];
SubItems.Add(AValues[i]);
end;
snd := Sounds[ADialogType];
if snd <> 0 then
MessageBeep(snd);
dlg.ShowModal;
finally
dlg.Free;
end;
end;