Delphi 如何在ShowMessage中显示表格?

Delphi 如何在ShowMessage中显示表格?,delphi,fonts,dialog,delphi-2007,Delphi,Fonts,Dialog,Delphi 2007,我正在尝试使用ShowMessage显示如下所示的表: short | Description for "short" verylongtext | Description for "verylongtext" 如何在一个简单的消息对话框中获得两个正确对齐的列 我尝试使用空格对齐列,但ShowMessage的字体是可变的。然后我尝试使用制表符对齐它们,但我不知道如何计算每行的正确制表符数 是否有可靠的方法来计算选项卡计数 PS:我希望避免为此编写自定义对话框。如果

我正在尝试使用ShowMessage显示如下所示的表:

short            | Description for "short"
verylongtext     | Description for "verylongtext"
如何在一个简单的消息对话框中获得两个正确对齐的列

我尝试使用空格对齐列,但ShowMessage的字体是可变的。然后我尝试使用制表符对齐它们,但我不知道如何计算每行的正确制表符数

是否有可靠的方法来计算选项卡计数


PS:我希望避免为此编写自定义对话框。

如果您没有为此编写自定义对话框,您什么时候会这样做?没那么难。只需创建一个表单,在其上放置一个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;

您也可以在自定义对话框中使用列表视图

我的类支持标准的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 10的所有Windows版本(可能也适用于Windows 2000,我只是还没有测试过):

该表是一个列表视图,因此您可以获得它的所有好处,如滚动条、截断椭圆和工具提示:

还可以指定对话框的大小,使其适合内容:

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
  )

当然,确定按钮既是
默认
又是
取消
,因此您可以使用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;
使用
通信、数学、Clipbrd;
类型
TTableDialog=类
严格保密
类型TFormData=class(TComponent)
公众的
ListView:TListView;
IconKind:PWideChar;
图标:希肯;
LIWSD:布尔;
结束;
类函数标度(X:整数):整数;
类程序FormShow(发送方:ToObject);
类程序FormDestroy(发送方:ToObject);
类程序FormPaint(发送方:TObject);
类过程FormKeyPress(发送方:TObject;变量键:Char);
类过程LVToClipboard(AListView:TListView);
公众的
类过程显示表(AOwner:TCustomForm;const acoption:string;
常量ANames,AValues:字符串数组;
绝热类型:TMsgDlgType=mtInformation;
常数AWidth:Integer=360;常数AHeight:Integer=200);
结束;
类过程TTableDialog.FormShow(发送方:ToObject);
变量
FormData:TFormData;
ComCtl:HMODULE;
LoadIconWithScaleDown:function(hinst:hinst;pszName:LPCWSTR;cx:Integer;
cy:Integer;var phico:HICON):HResult;stdcall;
开始
如果不是(发送方是TForm),则
出口
如果不是(TObject(TForm(Sender.Tag)是TFormData),那么
出口
TForm(Sender).OnShow:=nil;
FormData:=TFormData(TForm(Sender).Tag);
如果FormData.IconKind=nil,则
出口
ComCtl:=LoadLibrary('ComCtl32.dll');
如果ComCtl为0,则
开始
尝试
LoadIconWithScaleDown:=GetProcAddress(ComCtl,'LoadIconWithScaleDown');
如果已分配(LoadIconWithScaleDown),则
FormData.LIWSD:=成功(LoadIconWithScaleDown(0,FormData.IconKind,
Scale(32)、Scale(32)、FormData.Icon);
最后
免费图书馆;
结束;
结束;
如果不是FormData.LIWSD,则
FormData.Icon:=加载图标(0,FormData.IconKind);
结束;
类过程TTableDialog.FormDestroy(发送方:ToObject);
变量
FormData:TFormData;
开始
如果不是(发送方是TForm),则
出口
如果不是(TObject(TForm(Sender.Tag)是TFormData),那么
出口
FormData:=TFormData(TForm(Sender).Tag);
如果是(FormData.Icon 0)和FormData.LIWSD,则
销毁图标(FormData.Icon);
结束;
类过程TTableDialog.FormKeyPress(发送方:ToObject;变量键:Char);
变量
FormData:TFormData;
开始
如果不是(发送方是TForm),则
出口
如果不是(TObject(TForm(Sender.Tag)是TFormData),那么
出口
FormData:=TFormData(TForm(Sender).Tag);
案例关键
^C:
LVToClipboard(FormData.ListView);
结束;
结束;
类过程TTableDialog.FormPaint(发送方:ToObject);
变量
FormData:TFormData;
Frm:TForm;
Y:整数;
开始
如果不是(发送方是TForm),则
出口
如果不是(TObject(TForm(Sender.Tag)是TFormData),那么
出口
Frm:=TForm(发送方);
FormData:=TFormData(TForm(Sender).Tag);
Y:=Frm.ClientHeight——量表(25+8+8);
Frm.Canvas.Brush.Color:=clWhite;
Frm.Canvas.FillRect(Rect(0,0,Frm.ClientWidth,Y));
Frm.Canvas.Pen.Color:=$00DFDF;
Frm.Canvas.MoveTo(0,Y);
Frm.Canvas.LineTo(Frm.ClientWidth,Y);
如果FormData.Icon为0,则
DrawIconEx(Frm.Canvas.Handle,比例(8),比例(8),FormData.Icon,
标度(32),标度(32),0,0,迪_正常);
结束;
类过程TTableDialog.LVToClipboard(AListView:TListView);
函数GetRow(AIndex:Integer):字符串;
开始
如果在范围(AIndex,0,AListView.Items.Count-1)和(AListView.Items[AIndex].SubItems.Count=1)中,则
结果:=AListView.Items[AIndex]。标题+#9+AListView.Items[AIndex]。子项[0]
其他的
结果:='';
结束;
变量
S:字符串;
i:整数;
开始
如果AListView=nil,则
出口
S:=GetRow(0);
对于i:=1到AListView.Items.Count-1 do
S:=S+sLineBreak+GetRow(i);
Clipboard.AsText:=S;