この発言は
#00988　ＴＮ            さんの設計時に書き込めるStringGrid
に対するコメントです



いくつか訂正

・Rows[i].SetCommaText にバグがあるようなので，一旦StringListに取ってから
　ますごとに代入する
・Colmun毎にAlignを指定できるようにした．
・RowCountを２未満にすると表示がおかしくなるのでしないように．
・その他バグ取り

使用例
  ColAligns  := 'L,C,R,R';
  CellStrings.Text := '1,2,3,4'#13#10'100,200,300,400'#13#10
であれば
+-------+-------+-------+-------+
|   1   |   2   |   3   |   4   |
+-------+-------+-------+-------+
|100    |  200  |    300|    400|
+-------+-------+-------+-------+
という感じで表示される

-------------------------------------------------------
unit ClientStringGrid;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids;

type

  TClientStringGrid = class(TStringGrid)
  protected
    FCellStrings: TStringList;
    FColAligns: string;
    procedure SetCellStrings(St: TStrings);
    function GetCellStrings: TStrings;
    procedure CopyCellStringsToCell;
    procedure Loaded; override;
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
      AState: TGridDrawState); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property CellStrings: TStrings
             read GetCellStrings write SetCellStrings;
    property ColAligns: String
             read FColAligns write FColAligns;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TClientStringGrid]);
end;

{ TClientStringGrid }

constructor TClientStringGrid.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCellStrings := TStringList.Create;
end;

destructor TClientStringGrid.Destroy;
begin
  FCellStrings.Free;
  inherited Destroy;
end;

function Max(i1,i2: integer):integer;
begin
  if i1 >= i2 then
    Result := i1
  else
    Result := i2;
end;

procedure TClientStringGrid.CopyCellStringsToCell;
var
  i,j: integer;
  Line: TStringList;

begin
  Line := TStringList.Create;
  try
    if FCellStrings.Count > 0 then begin
      RowCount := Max(FCellStrings.Count, 2);
      Line.CommaText := FCellStrings[0];
      ColCount := Line.Count;
      for i := 0 to RowCount -1 do begin
        Rows[i].Clear;
        if i >= FCellStrings.Count then break;
        Line.CommaText := FCellStrings[i];
        for j := 0 to ColCount-1 do begin
          if j >= Line.Count then break;
          Rows[i][j] := Line[j];
        end;
      end;
    end;
  finally
    Line.Free;
  end;
end;

function TClientStringGrid.GetCellStrings: TStrings;
var
  i: integer;
begin
  if not (csLoading in ComponentState) then begin
    FCellStrings.Clear;
    for i := 0 to RowCount -1 do begin
      FCellStrings.Add( Rows[i].CommaText );
    end;
  end;
  Result := FCellStrings;
end;

procedure TClientStringGrid.Loaded;
begin
  inherited Loaded;
  CopyCellStringsToCell;
end;

procedure TClientStringGrid.SetCellStrings(St: TStrings);
begin
  FCellStrings.Assign(St);
  CopyCellStringsToCell;
end;

procedure TClientStringGrid.DrawCell(ACol, ARow: Integer; ARect: TRect;
  AState: TGridDrawState);
var
  Dt: WORD;
  Cl: TColor;
  S: string;
  DfDrw: boolean;
  AlignList: TStringList;
begin
  if DefaultDrawing then begin
    Cl := Canvas.Brush.Color;
    AlignList := TStringList.Create;
    try
      if ARow = 0 then begin
        Canvas.Brush.Color := FixedColor;
      end;
      Canvas.FillRect(ARect);
      ARect.Top := ARect.Top + 2;
      S := Cells[ACol,ARow];
      Dt := DT_CENTER;
      if not(gdFixed in AState) then begin
        AlignList.CommaText := FColAligns;
        if AlignList.Count > ACol then begin
          case AlignList[ACol][1] of
          'L': Dt := DT_LEFT;
          'R': Dt := DT_RIGHT;
          end;
        end;
      end;

      DrawText(Canvas.Handle, PChar(S), length(S), ARect, Dt);
    finally
      AlignList.Free;
      Canvas.Brush.Color := Cl;
    end;
  end;
  DfDrw := DefaultDrawing;  // 直近先祖のメソッドを飛び越すための細工
  DefaultDrawing := False;
  inherited;
  DefaultDrawing := DfDrw;
end;

end.
                                                  ＴＮ(CQJ01721)

Original document by ＴＮ            氏 ID:(CQJ01721)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。