{******************************************************************************}
{                                                                              }
{ Rejbrand Task Table Dialog                                                   }
{                                                                              }
{ Copyright © 2021, 2025 Andreas Rejbrand                                      }
{                                                                              }
{ https://english.rejbrand.se/                                                 }
{                                                                              }
{******************************************************************************}

unit TableDialog;

interface

uses
  Windows, Messages, SysUtils, Types, UITypes, Classes, Forms, Dialogs,
  Controls, Graphics, StdCtrls, ComCtrls, Generics.Defaults,
  Generics.Collections;

type
  TTableDialog = class
  strict private
    type TFormData = class(TComponent)
    public
      ListView: TListView;
      IconKind: PWideChar;
      Icon: HICON;
      LIWSD: Boolean;
      Title: string;
    end;
    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);
    class function GetTitleWidth(AFormRef: TForm;
      const AFormData: TFormData): Integer; static;
    class procedure SetupTitleFont(AFormRef: TForm; ACanvas: TCanvas); static;
    class procedure FormAfterMonitorDpiChanged(Sender: TObject;
      OldDPI, NewDPI: Integer);
  public
    class function ShowTable(AOwner: TCustomForm; const ACaption, ATitle: string;
      const ANames, AValues: array of string;
      const AButtonTypes: array of TModalResult;
      const AButtonLabels: array of string;
      ADefaultButton, ACancelButton: TModalResult;
      ADialogType: TMsgDlgType;
      const AWidth: Integer = 0; const AHeight: Integer = 0): TModalResult; overload;
    class function ShowTable(AOwner: TCustomForm; const ACaption, ATitle: string;
      const ANames, AValues: array of string;
      ADialogType: TMsgDlgType;
      const AWidth: Integer = 0; const AHeight: Integer = 0): TModalResult; overload;
    class function ShowTable(AOwner: TCustomForm; const ACaption: string;
      const ANames, AValues: array of string;
      ADialogType: TMsgDlgType;
      const AWidth: Integer = 0; const AHeight: Integer = 0): TModalResult; overload;
    class function ShowTable(AOwner: TCustomForm; const ACaption, ATitle: string;
      const ATable: TArray<TPair<string, string>>;
      ADialogType: TMsgDlgType;
      const AWidth: Integer = 0; const AHeight: Integer = 0): TModalResult; overload;
    class function ShowTable(AOwner: TCustomForm; const ACaption: string;
      const ATable: TArray<TPair<string, string>>;
      ADialogType: TMsgDlgType;
      const AWidth: Integer = 0; const AHeight: Integer = 0): TModalResult; overload;
  end;

implementation

uses
  Math, Clipbrd, CommCtrl;

class procedure TTableDialog.FormShow(Sender: TObject);
var
  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;
  var FormData := TFormData(TForm(Sender).Tag);
  if FormData.IconKind = nil then
    Exit;
  if (FormData.Icon <> 0) and FormData.LIWSD then
    DestroyIcon(FormData.Icon);
  var 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,
          TForm(Sender).ScaleValue(32), TForm(Sender).ScaleValue(32), FormData.Icon));
    finally
      FreeLibrary(ComCtl);
    end;
  end;
  if not FormData.LIWSD then
    FormData.Icon := LoadIcon(0, FormData.IconKind);
end;

class function TTableDialog.GetTitleWidth(AFormRef: TForm; const AFormData: TFormData): Integer;
begin

  if AFormData.Title.IsEmpty then
    Exit(0);

  var bm := TBitmap.Create;
  try
    SetupTitleFont(AFormRef, bm.Canvas);
    Result := bm.Canvas.TextWidth(AFormData.Title)
  finally
    bm.Free;
  end;

end;

class procedure TTableDialog.FormAfterMonitorDpiChanged(Sender: TObject; OldDPI,
  NewDPI: Integer);
begin
  if Sender is TForm then
    FormShow(Sender);
end;

class procedure TTableDialog.FormDestroy(Sender: TObject);
begin
  if not (Sender is TForm) then
    Exit;
  if not (TObject(TForm(Sender).Tag) is TFormData) then
    Exit;
  var 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);
begin
  if not (Sender is TForm) then
    Exit;
  if not (TObject(TForm(Sender).Tag) is TFormData) then
    Exit;
  var FormData := TFormData(TForm(Sender).Tag);
  case Key of
    ^C:
      LVToClipboard(FormData.ListView);
  end;
end;

class procedure TTableDialog.FormPaint(Sender: TObject);
begin

  if not (Sender is TForm) then
    Exit;

  if not (TObject(TForm(Sender).Tag) is TFormData) then
    Exit;

  var Frm := TForm(Sender);
  var FormData := TFormData(TForm(Sender).Tag);

//  Frm.Canvas.Font.Assign(Frm.Font);

  var Y := Frm.ClientHeight - Frm.ScaleValue(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, Frm.ScaleValue(8), Frm.ScaleValue(8), FormData.Icon,
      Frm.ScaleValue(32), Frm.ScaleValue(32), 0, 0, DI_NORMAL);

  var S := FormData.Title;

  if not s.IsEmpty then
  begin
    var R := Rect(
      Frm.ScaleValue(IfThen(FormData.Icon <> 0, 8 + 32 + 8, 8)),
      Frm.ScaleValue(8),
      Frm.ClientWidth - Frm.ScaleValue(8),
      Frm.ScaleValue(8 + 32)
    );
    SetupTitleFont(Frm, Frm.Canvas);
    Frm.Canvas.TextRect(R, S, [tfSingleLine, tfLeft, tfTop, tfEndEllipsis]);
  end;

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;

begin
  if AListView = nil then
    Exit;
  var S := GetRow(0);
  for var i := 1 to AListView.Items.Count - 1 do
    S := S + sLineBreak + GetRow(i);
  Clipboard.AsText := S;
end;

class procedure TTableDialog.SetupTitleFont(AFormRef: TForm; ACanvas: TCanvas);
begin
  if Screen.Fonts.IndexOf('Segoe UI') <> -1 then
    ACanvas.Font.Name := 'Segoe UI'
  else if Screen.Fonts.IndexOf('Tahoma') <> -1 then
    ACanvas.Font.Name := 'Tahoma';
  ACanvas.Font.Height := -AFormRef.ScaleValue(Round(96/72 * 12));
  ACanvas.Font.Color := $00993300;
end;

class function TTableDialog.ShowTable(AOwner: TCustomForm;
  const ACaption: string; const ATable: TArray<TPair<string, string>>;
  ADialogType: TMsgDlgType; const AWidth, AHeight: Integer): TModalResult;
begin
  var LNames := TArray<string>(nil);
  var LValues := TArray<string>(nil);
  SetLength(LNames, Length(ATable));
  SetLength(LValues, Length(ATable));
  for var i := 0 to High(ATable) do
  begin
    LNames[i] := ATable[i].Key;
    LValues[i] := ATable[i].Value;
  end;
  Result := ShowTable(AOwner, ACaption, LNames, LValues, ADialogType, AWidth, AHeight);
end;

class function TTableDialog.ShowTable(AOwner: TCustomForm; const ACaption,
  ATitle: string; const ATable: TArray<TPair<string, string>>;
  ADialogType: TMsgDlgType; const AWidth, AHeight: Integer): TModalResult;
begin
  var LNames := TArray<string>(nil);
  var LValues := TArray<string>(nil);
  SetLength(LNames, Length(ATable));
  SetLength(LValues, Length(ATable));
  for var i := 0 to High(ATable) do
  begin
    LNames[i] := ATable[i].Key;
    LValues[i] := ATable[i].Value;
  end;
  Result := ShowTable(AOwner, ACaption, ATitle, LNames, LValues, ADialogType, AWidth, AHeight);
end;

class function TTableDialog.ShowTable(AOwner: TCustomForm; const ACaption: string;
  const ANames, AValues: array of string; ADialogType: TMsgDlgType;
  const AWidth, AHeight: Integer): TModalResult;
begin
  Result := ShowTable(
    AOwner,
    ACaption,
    '',
    ANames,
    AValues,
    [mrOk],
    ['OK'],
    mrOk,
    mrOk,
    ADialogType,
    AWidth,
    AHeight);
end;

class function TTableDialog.ShowTable(AOwner: TCustomForm; const ACaption,
  ATitle: string; const ANames, AValues: array of string;
  ADialogType: TMsgDlgType; const AWidth, AHeight: Integer): TModalResult;
begin
  Result := ShowTable(
    AOwner,
    ACaption,
    ATitle,
    ANames,
    AValues,
    [mrOk],
    ['OK'],
    mrOk,
    mrOk,
    ADialogType,
    AWidth,
    AHeight);
end;

class function TTableDialog.ShowTable(AOwner: TCustomForm;
  const ACaption, ATitle: string;
  const ANames, AValues: array of string;
  const AButtonTypes: array of TModalResult;
  const AButtonLabels: array of string;
  ADefaultButton, ACancelButton: TModalResult;
  ADialogType: TMsgDlgType;
  const AWidth, AHeight: Integer): TModalResult;
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
  W0, W1, W01Min, W01Max, MinW, H, RSpace: Integer;
begin

  if Length(ANames) <> Length(AValues) then
    raise Exception.Create('The lengths of the columns don''t match.');

  if Length(AButtonTypes) <> Length(AButtonLabels) then
    raise Exception.Create('The lengths of the button arrays don''t match.');

  var dlg := TForm.Create(AOwner);
  try

    if Assigned(AOwner) then
      dlg.ScaleForPPI(AOwner.CurrentPPI)
    else
      dlg.ScaleForCurrentDPI;

    dlg.BorderStyle := bsDialog;
    dlg.Caption := ACaption;
    if AWidth <> 0 then
      dlg.Width := dlg.ScaleValue(AWidth)
    else
      dlg.Width := dlg.ScaleValue(640);
    if AHeight <> 0 then
      dlg.Height := dlg.ScaleValue(AHeight)
    else
      dlg.Height := dlg.ScaleValue(480);
    dlg.Position := poOwnerFormCenter;
    dlg.Font.Name := 'Segoe UI';
    dlg.Font.PixelsPerInch := dlg.PixelsPerInch;
    dlg.Font.Size := 9;
    var FormData := TFormData.Create(dlg);
    dlg.Tag := NativeInt(FormData);
    TFormData(dlg.Tag).IconKind := Icons[ADialogType];
    TFormData(dlg.Tag).Title := ATitle;
    dlg.OnShow := FormShow;
    dlg.OnDestroy := FormDestroy;
    dlg.OnPaint := FormPaint;
    dlg.OnKeyPress := FormKeyPress;
    dlg.KeyPreview := True;
    dlg.OnAfterMonitorDpiChanged := FormAfterMonitorDpiChanged;

    for var i := 0 to High(AButtonTypes) do
    begin
      var btn := TButton.Create(dlg);
      btn.Parent := dlg;
      btn.Font.PixelsPerInch := dlg.PixelsPerInch;
      btn.Font.Size := 9;
      btn.Caption := AButtonLabels[i];
      btn.Default := AButtonTypes[i] = ADefaultButton;
      btn.Cancel := AButtonTypes[i] = ACancelButton;
      btn.ModalResult := AButtonTypes[i];
      btn.Width := dlg.ScaleValue(75);
      btn.Height := dlg.ScaleValue(25);
      btn.Left := dlg.ClientWidth - (btn.Width + dlg.ScaleValue(8)) * (Length(AButtonTypes) - i);
      btn.Top := dlg.ClientHeight - btn.Height - dlg.ScaleValue(8);
      btn.Anchors := [akRight, akBottom];
    end;

    var lv := TListView.Create(dlg);
    TFormData(dlg.Tag).ListView := lv;
    lv.Parent := dlg;
    lv.Font.PixelsPerInch := dlg.PixelsPerInch;
    lv.Font.Size := 9;
    lv.DoubleBuffered := True;
    lv.ReadOnly := True;
    lv.BorderStyle := bsNone;
    lv.Left := dlg.ScaleValue(8) + IfThen(Icons[ADialogType] <> nil, dlg.ScaleValue(32 + 8));
    lv.Width := dlg.ClientWidth - dlg.ScaleValue(16) - IfThen(Icons[ADialogType] <> nil, dlg.ScaleValue(32 + 8));
    if ATitle.IsEmpty then
    begin
      lv.Top := dlg.ScaleValue(8);
      lv.Height := dlg.ClientHeight - dlg.ScaleValue(16 + 8 + 4) - dlg.ScaleValue(25);
    end
    else
    begin
      lv.Top := dlg.ScaleValue(8 + 32 + 8);
      lv.Height := dlg.ClientHeight - dlg.ScaleValue(8 + 32 + 8 + 8 + 4 + 8) - dlg.ScaleValue(25);
    end;
    lv.Anchors := [akLeft, akTop, akRight, akBottom];
    lv.ViewStyle := vsReport;
    lv.RowSelect := True;
    lv.ShowColumnHeaders := False;

    RSpace := GetSystemMetricsForWindow(SM_CXVSCROLL, dlg.Handle) + dlg.ScaleValue(2);

    with lv.Columns.Add do
    begin
      Caption := 'Name';
      Width := Min(dlg.ScaleValue(150), lv.ClientWidth div 2);
    end;
    with lv.Columns.Add do
    begin
      Caption := 'Value';
      Width := lv.ClientWidth - lv.Columns[0].Width - RSpace;
    end;

    W0 := 0;
    W1 := 0;

    lv.Items.BeginUpdate;
    try
      for var i := 0 to High(ANames) do
        with lv.Items.Add do
        begin
          Caption := ANames[i];
          SubItems.Add(AValues[i]);
          W0 := Max(W0, ListView_GetStringWidth(lv.Handle, PChar('XXI' + ANames[i])));
          W1 := Max(W1, ListView_GetStringWidth(lv.Handle, PChar('XXI' + AValues[i])));
        end;
    finally
      lv.Items.EndUpdate;
    end;

    if lv.Items.Count > 0 then
      H := lv.Items[0].DisplayRect(drBounds).Height
    else
      H := 0;

    if AWidth = 0 then
    begin
      if ATitle.IsEmpty then
        MinW := dlg.ScaleValue(300)
      else
        MinW := Min(dlg.ScaleValue(8) + IfThen(Icons[ADialogType] <> nil, dlg.ScaleValue(32 + 8)) + GetTitleWidth(dlg, FormData) + dlg.ScaleValue(16), dlg.ScaleValue(800));
      MinW := Max(MinW, dlg.ScaleValue(300));
      MinW := Max(MinW, dlg.ScaleValue(75) * Length(AButtonTypes) + dlg.ScaleValue(8) * (Length(AButtonTypes) + 1));
      W01Min := Min(W0, W1);
      W01Max := Max(W0, W1);
      if W01Min < W01Max div 5 then
        W01Min := W01Max div 5;
      dlg.ClientWidth := EnsureRange(
        dlg.ClientWidth - lv.Width + W01Max + W01Min + RSpace,
        MinW,
        dlg.ScaleValue(800)
      );
    end;

    if AHeight = 0 then
      dlg.ClientHeight := EnsureRange(
        dlg.ClientHeight - lv.Height + Succ(lv.Items.Count) * H + 10,
        dlg.ScaleValue(100),
        dlg.ScaleValue(600)
      );

    if (Round(1.2 * W0) < (lv.ClientWidth - RSpace) div 2) and (Round(1.2 * W0) + W1 < lv.ClientWidth - RSpace) then
      W0 := Round(1.2 * W0);

    if (W0 > (lv.ClientWidth - RSpace) div 2) and (W1 > (lv.ClientWidth - RSpace) div 2) then
      W0 := (lv.ClientWidth - RSpace) div 2;

    if (W0 > 2 * (lv.ClientWidth - RSpace) div 3) and (W1 > (lv.ClientWidth - RSpace) div 3) then
      W0 := (lv.ClientWidth - RSpace) div 2;

    lv.Columns[0].Width :=
      EnsureRange(
        W0,
        lv.ClientWidth div 6,
        3 * lv.ClientWidth div 4
      );

    lv.Columns[1].Width := lv.ClientWidth - lv.Columns[0].Width - RSpace;

    var snd := Sounds[ADialogType];
    if snd <> 0 then
      MessageBeep(snd);

    for var CtlIdx := 0 to dlg.ControlCount - 1 do
      if (dlg.Controls[CtlIdx] is TButton) and TButton(dlg.Controls[CtlIdx]).Default then
      begin
        dlg.ActiveControl := TButton(dlg.Controls[CtlIdx]);
        Break;
      end;

    Result := dlg.ShowModal;

  finally
    dlg.Free;
  end;

end;

end.
