delphidialogdelphi-2007

How to display a table in ShowMessage?


I am trying to display a table using ShowMessage that looks like this:

short            | Description for "short"
verylongtext     | Description for "verylongtext"

How do I get two correctly aligned columns like that in a simple message dialog?

I tried to align the columns using spaces, but the font of ShowMessage is variable. Then I tried to align them using tab characters, but I do not know how to calculate the proper tab count for each row.

Is there a reliable way to calculate the tab count?

PS: I would like to avoid writing a custom dialog for this purpose.


Solution

  • You could use a list view in a custom dialog box, as well.

    Screenshot of the Task Dialog-like list-view table dialog box on Windows 7 with high DPI.

    My class supports the standard Windows icons (and sounds): information, warning, error, confirmation, none. Here is the icon-less version:

    Screenshot of the dialog in icon-less mode.

    It is easy to use:

    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
      )
    

    It supports DPI scaling (high DPI) and all Windows versions from Windows XP (it might work on Windows 2000 as well, I just haven't tested that) to Windows 10:

    Screenshot of the same dialog on Windows XP.

    Screenshot of the same dialog on Windows 10.

    The table is a list view, so you get all its benefits, like a scrollbar, truncation ellipses, and tooltips:

    Screenshot of the dialog with a vertical scrollbar.

    Screenshot of the dialog with a truncated string displaying an ellipsis.

    Screenshot of the dialog with a tooltip window showing a truncated string.

    You can also specify the dialog's size to make it fit the contents:

    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.

    Of course, the OK button is both Default and Cancel, so you can dismiss the dialog with Enter or Escape.

    Finally, pressing Ctrl+C will copy the table to clipboard.

    Full source code:

    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;
    

    Update: A new version supports custom text and buttons:

    Screenshot of dialog with custom title text, table, and Yes and No buttons.