Как отобразить таблицу в ShowMessage?

Question

Я пытаюсь отобразить таблицу, используя ShowMessage, которая выглядит следующим образом:

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

Как получить два правильно выровненных столбца, как в простом диалоге сообщений?

Я попытался выровнять столбцы, используя пробелы, но шрифт ShowMessage является переменным. Затем я попытался выровнять их, используя символы табуляции, но я не знаю, как рассчитать правильное количество вкладок для каждой строки.

Есть ли надежный способ подсчета количества вкладок?

PS: Я бы хотел не писать для этого специальный диалог.

Answer 1

Вы также можете использовать представление списка в настраиваемом диалоговом окне.

Попробуйте

type StringArray = array of string;

procedure ShowMemoMessage(AOwner: TForm; const Caption: string; Col1, Col2: StringArray; const DialogType: TMsgDlgType = mtInformation; const DlgWidth: integer = 360; const DlgHeight: integer = 200);
var
  dlg: TForm;
  lv: TListView;
  btn: TButton;
  IconType: PChar;
  icon: HICON;
  image: TImage;
  sh: TShape;
  bvl: TBevel;
  i: Integer;
begin

  if length(Col1) <> length(Col2) then
    raise Exception.Create('The length of the columns doesn''t match.');

  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;
    lv := TListView.Create(dlg);
    lv.Parent := dlg;
    lv.Color := dlg.Color;
    lv.ReadOnly := true;
    lv.BorderStyle := bsNone;
    lv.Left := 8;
    lv.Top := 8;
    lv.Width := dlg.ClientWidth - 16;
    lv.Height := dlg.ClientHeight - 16 - 8 - 4 - btn.Height;
    lv.ViewStyle := vsReport;
    lv.RowSelect := true;
    with lv.Columns.Add do
    begin
      Caption := 'Name';
      Width := 150;
    end;
    lv.Columns.Add.Caption := 'Value';
    lv.ShowColumnHeaders := false;

    for i := 0 to high(Col1) do
      with lv.Items.Add do
      begin
        Caption := Col1[i];
        SubItems.Add(Col2[i]);
      end;

    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;
      lv.Left := image.Width + 32;
      lv.Top := 16;
      lv.Height := lv.Height - 8;
    end;

    dlg.ShowModal;
  finally
    dlg.Free;
  end;
end;

, а затем просто назовите это как

procedure TForm1.FormCreate(Sender: TObject);
var
  col1, col2: StringArray;
begin

  SetLength(col1, 4);
  col1[0] := 'alpha'; col1[1] := 'beta'; col1[2] := 'gamma'; col1[3] := 'delta';

  SetLength(col2, 4);
  col2[0] := 'yes'; col2[1] := 'no'; col2[2] := 'no'; col2[3] := 'no';

  ShowMemoMessage(Self, 'Test', col1, col2);

end;

Таким образом, столбцы гарантированно остаются выровненными, и вам не нужно беспокоиться об остановках табуляции.

Наведите курсор мыши:

Answer 2

Если вы не пишете собственный диалог для этого, когда вы будете?Это не так сложно.Просто создайте форму, поместите на нее TMemo и сделайте эту заметку доступной только для чтения.Вы можете установить моноширинный шрифт, такой как Courier New, и ваша проблема решена.Вы также получили преимущество от полос прокрутки и выбора, и вы можете сделать его немодальным.

Я бы даже рекомендовал показывать этот тип данных в виде сетки (например, TStringGrid) вместо заметки или метки.

Для расчета способа отображения этого текста в окне сообщения потребуется много больше усилий, чем просто создание собственного диалога.

Answer 3

Только что создал что-то, что показывает всплывающее окно, как это:

Просто вызовите процедуру ниже и добавьте TStringList в качестве параметра.Конечно, вы можете сделать это, используя TListView, значки, полосы прокрутки и т. Д.

Поместите его в отдельный блок, и вы всегда сможете легко показать такие вещи.

Пример того, как его использовать:

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;

Answer 4

Просто для полноты приведу простой пример того, как может быть создан пользовательский диалог:

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');

Это не выглядит идеально, но это начало.Может быть.