１レコード複数行表示

くまお 2022-06-29 14:01:56 No: 150295 IP: [192.*.*.*]

Delphi10.4で、1レコードを複数行で表示する方法、または、市販のグリッドをご存じありませんか？
カラムが0．．10まであったとして５で折り返す感じです。

編集削除

igy 2022-07-01 00:23:10 No: 150297 IP: [192.*.*.*]

https://www.devexpress.com/Products/VCL/Grid/
にある「Banded Column View」のイメージみたいな感じですか？

編集削除

AAAAA 2022-07-05 02:16:46 No: 150299 IP: [192.*.*.*]

こーゆうこと？

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids;

type
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      ARect: TRect; State: TGridDrawState);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    procedure SetRowCount(Value: Integer);
    procedure SetCells(COL,ROW: Integer; Value: String);
    function GetCells(COL,ROW: Integer): String;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.SetRowCount(Value: Integer);
begin
    StringGrid1.RowCount := Value * 2 + 1;
end;

procedure TForm1.SetCells(COL,ROW: Integer; Value: String);
begin
    if COL < StringGrid1.ColCount then
    begin
      StringGrid1.Cells[COL,ROW*2-1] := Value;
    end
    else
    begin
      StringGrid1.Cells[COL-StringGrid1.ColCount+1,(ROW*2)] := Value;
    end;
end;

function TForm1.GetCells(COL,ROW: Integer): String;
begin
    if COL < StringGrid1.ColCount then
    begin
      RESULT := StringGrid1.Cells[COL,ROW*2-1];
    end
    else
    begin
      RESULT := StringGrid1.Cells[COL-StringGrid1.ColCount+1,(ROW*2)];
    end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
    S: String;
begin
    StringGrid1.DefaultDrawing := False;
    StringGrid1.GridLineWidth  := 0;

    SetRowCount(13);

    SetCells(1,1,'1,1');
    SetCells(2,1,'2,1');
    SetCells(3,1,'3,1');
    SetCells(4,1,'4,1');
    SetCells(5,1,'5,1');
    SetCells(6,1,'6,1');
    SetCells(7,1,'7,1');
    SetCells(8,1,'8,1');

    S := GetCells(1,1);
    SetCells(1,2,S);
    S := GetCells(5,1);
    SetCells(5,2,S);

end;

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  ARect: TRect; State: TGridDrawState);
var
    S: String;
    BRECT: TRECT;
begin
    StringGrid1.Canvas.Brush.Color := clWhite;
    S := StringGrid1.Cells[ACOL,AROW];
    if (ACOL = 0) or (AROW = 0) then
    begin
      if (AROW = 0) and (ACOL = 0) then
      begin
        S := 'SAMPLE';
        StringGrid1.Canvas.Brush.Color := clSilver;
        StringGrid1.Canvas.FillRect(ARect);
        StringGrid1.Canvas.TextRect(ARect,ARect.Left,ARect.Top,S);
        StringGrid1.Canvas.MoveTo(ARECT.Right-1,ARECT.Top);
        StringGrid1.Canvas.LineTo(ARECT.Right-1,ARECT.Bottom-1);
        StringGrid1.Canvas.LineTo(ARECT.Left,ARECT.Bottom-1);
      end
      else
      if AROW = 0 then
      begin
        S := Char(64+ACOL);
        StringGrid1.Canvas.Brush.Color := clSilver;
        StringGrid1.Canvas.FillRect(ARect);
        StringGrid1.Canvas.TextRect(ARect,ARect.Left,ARect.Top,S);
        StringGrid1.Canvas.MoveTo(ARECT.Right-1,ARECT.Top);
        StringGrid1.Canvas.LineTo(ARECT.Right-1,ARECT.Bottom-1);
        StringGrid1.Canvas.LineTo(ARECT.Left,ARECT.Bottom-1);
      end
      else
      if ACOL = 0 then
      begin
        S := IntToStr(AROW div 2);
        if (AROW mod 2) = 0 then
        begin
          StringGrid1.Canvas.Brush.Color := clSilver;
          StringGrid1.Canvas.FillRect(ARect);
          StringGrid1.Canvas.MoveTo(ARECT.Right-1,ARECT.Top);
          StringGrid1.Canvas.LineTo(ARECT.Right-1,ARECT.Bottom-1);
          StringGrid1.Canvas.LineTo(ARECT.Left,ARECT.Bottom-1);
        end
        else
        begin
          StringGrid1.Canvas.Brush.Color := clSilver;
          StringGrid1.Canvas.FillRect(ARect);
          StringGrid1.Canvas.TextRect(ARect,ARect.Left,ARect.Top,S);
          StringGrid1.Canvas.MoveTo(ARECT.Right-1,ARECT.Top);
          StringGrid1.Canvas.LineTo(ARECT.Right-1,ARECT.Bottom-1);
        end;
      end;
    end
    else
    begin
      StringGrid1.Canvas.Brush.Color := clWhite;
      StringGrid1.Canvas.Pen.Color := clBlack;
      StringGrid1.Canvas.FillRect(ARect);
      StringGrid1.Canvas.TextRect(ARect,ARect.Left,ARect.Top,S);
      StringGrid1.Canvas.MoveTo(ARECT.Right-1,ARECT.Top);
      StringGrid1.Canvas.LineTo(ARECT.Right-1,ARECT.Bottom-1);
      StringGrid1.Canvas.LineTo(ARECT.Left,ARECT.Bottom-1);
    end;
end;

end.

編集削除