[英]How to display a table in ShowMessage?
我正在嘗試使用 ShowMessage 顯示一個如下所示的表格:
short | Description for "short"
verylongtext | Description for "verylongtext"
如何在簡單的消息對話框中獲得兩個正確對齊的列?
我嘗試使用空格對齊列,但 ShowMessage 的字體是可變的。 然后我嘗試使用制表符對齊它們,但我不知道如何計算每行的正確制表符計數。
有沒有可靠的方法來計算標簽計數?
PS:我想避免為此目的編寫自定義對話框。
您也可以在自定義對話框中使用列表視圖。
我的班級支持標准的 Windows 圖標(和聲音):信息、警告、錯誤、確認、無。 這是無圖標版本:
它易於使用:
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 XP(它也可以在 Windows 2000 上運行,我只是沒有測試過)到 Windows 10 的所有 Windows 版本:
該表是一個列表視圖,因此您可以獲得它的所有好處,例如滾動條、截斷省略號和工具提示:
您還可以指定對話框的大小以使其適合內容:
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
)
當然, OK按鈕既是Default
又是Cancel
,因此您可以使用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;
如果您不為此編寫自定義對話框,您什么時候編寫? 這並不難。 只需創建一個表單,在其上放置一個 TMemo 並將該備忘錄設為只讀。 你可以設置一個像Courier New這樣的等寬字體,你的問題就解決了。 您也獲得了滾動條和選擇的優勢,您可以選擇使其非模態。
我什至建議在網格(如 TStringGrid)而不是備忘錄或標簽中顯示這種類型的數據。
計算如何在消息框中顯示此文本將需要比創建自定義對話框更多的努力。
剛剛創建了一些顯示這樣的彈出窗口的東西:
只需調用下面的過程,並添加一個 TStringList 作為參數。 當然,您可以通過使用 TListView、圖標、滾動條等來拉皮條。
把它放在一個單獨的單元中,你總是能夠輕松地展示這樣的東西。
uses ..., StdCtrls, ExtCtrls;
procedure ShowTablePopup(SL:TStringList);
var
LButtonOK: TButton;
LMemo: TMemo;
LPanel: TPanel;
LForm: TForm;
begin
LForm := TForm.Create(Application);
LMemo := TMemo.Create(LForm);
LPanel := TPanel.Create(LForm);
LButtonOK := TButton.Create(LForm);
LForm.Left := 0;
LForm.Top := 0;
LForm.Caption := 'Values';
LForm.ClientHeight := 250;
LForm.ClientWidth := 400;
LMemo.Parent := LForm;
LMemo.AlignWithMargins := True;
LMemo.Left := 3;
LMemo.Top := 3;
LMemo.Width := 295;
LMemo.Height := 226;
LMemo.Align := alClient;
LMemo.Font.Name := 'Courier New';
LMemo.Lines.Assign(SL);
LPanel.Parent := LForm;
LPanel.Caption := '';
LPanel.Left := 0;
LPanel.Top := 232;
LPanel.Width := 301;
LPanel.Height := 37;
LPanel.Align := alBottom;
LPanel.BevelOuter := bvNone;
LButtonOK.Parent := LPanel;
LButtonOK.AlignWithMargins := True;
LButtonOK.Left := 223;
LButtonOK.Top := 3;
LButtonOK.Width := 75;
LButtonOK.Height := 31;
LButtonOK.Align := alRight;
LButtonOK.Caption := '&OK';
LButtonOK.ModalResult := mrOk;
LButtonOK.Default := True;
LForm.ShowModal;
end;
如何使用它的示例:
var
SL:TStringList;
begin
SL := TStringList.Create;
try
SL.Add('short | Description for "short"');
SL.Add('verylongtext | Description for "verylongtext"');
ShowTablePopup(SL);
finally
SL.Free;
end;
end;
為了完整起見,我給出了一個如何構造自定義對話框的簡單示例:
procedure ShowMemoMessage(AOwner: TForm; const Caption, Text: string; const DialogType: TMsgDlgType = mtInformation; const DlgWidth: integer = 360; const DlgHeight: integer = 200);
var
dlg: TForm;
re: TRichEdit;
btn: TButton;
IconType: PChar;
icon: HICON;
image: TImage;
sh: TShape;
bvl: TBevel;
begin
dlg := TForm.Create(AOwner);
try
dlg.BorderStyle := bsDialog;
dlg.Caption := Caption;
dlg.Width := DlgWidth;
dlg.Height := DlgHeight;
dlg.Position := poScreenCenter;
btn := TButton.Create(dlg);
btn.Parent := dlg;
btn.Caption := 'OK';
btn.ModalResult := mrOk;
btn.Left := dlg.ClientWidth - btn.Width - 8;
btn.Top := dlg.ClientHeight - btn.Height - 8;
re := TRichEdit.Create(dlg);
re.Parent := dlg;
re.Color := dlg.Color;
re.ReadOnly := true;
re.BorderStyle := bsNone;
re.Left := 8;
re.Top := 8;
re.Width := dlg.ClientWidth - 16;
re.Height := dlg.ClientHeight - 16 - 8 - 4 - btn.Height;
re.Lines.Text := Text;
sh := TShape.Create(dlg);
sh.Parent := dlg;
sh.Align := alBottom;
sh.Shape := stRectangle;
sh.Pen.Color := clWhite;
sh.Brush.Color := clWhite;
sh.Height := btn.Height + 16;
bvl := TBevel.Create(dlg);
bvl.Parent := dlg;
bvl.Align := alBottom;
bvl.Height := 2;
bvl.Style := bsLowered;
case DialogType of
mtWarning:
begin
MessageBeep(MB_ICONWARNING);
IconType := IDI_WARNING;
end;
mtError:
begin
MessageBeep(MB_ICONERROR);
IconType := IDI_ERROR;
end;
mtInformation:
begin
MessageBeep(MB_ICONINFORMATION);
IconType := IDI_INFORMATION;
end;
mtConfirmation:
begin
MessageBeep(MB_ICONQUESTION);
IconType := IDI_QUESTION;
end;
mtCustom: {silence};
end;
if DialogType <> mtCustom then
begin
image := TImage.Create(dlg);
image.Parent := dlg;
icon := LoadIcon(0, IconType);
image.AutoSize := true;
image.Picture.Icon.Handle := icon;
image.Left := 16;
image.Top := 16;
re.Left := image.Width + 32;
re.Top := 16;
re.Height := re.Height - 8;
end;
dlg.ShowModal;
finally
dlg.Free;
end;
end;
樣品用法:
ShowMemoMessage(Self, 'Test', 'This is a long text.'#13#10#13#10'Alpha:'#9#9'Yes'#13#10'Beta:'#9#9'No');
它看起來並不完美,但它是一個開始。 也許。
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.