//00/06/02 午後 07:39
unit GridColFit;

interface

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

type
  TGridColWidthPercent = array of double;
  TDesignGridColWidth  = array of Integer;

procedure StrGridAutoSize1Initialize(StrGrid: TDrawGrid;
 var DesignGridColWidth: TDesignGridColWidth);
procedure StrGridAutoSize1(StrGrid: TDrawGrid;
 var DesignGridColWidth: TDesignGridColWidth);
// 指定した列がリサイズするAntoSize
// 列幅の最小限界も指定出来て、
// Grid幅が小さくなりすぎると右の方から消えます。

procedure StrGridAutoSize2Initialize(StrGrid: TDrawGrid;
 var GridColWidthPercent: TGridColWidthPercent);
procedure StrGridAutoSize2(StrGrid: TDrawGrid;
 var GridColWidthPercent: TGridColWidthPercent);
//　Grid全部の幅と一列幅の割合を
//　コントロールの幅と一列幅の割合にも適応したAutoSize
//　Resize時にはすべての列幅がResizeします

procedure StrGridAutoSize3Initialize(StrGrid: TDrawGrid;
 var DesignGridColWidth: TDesignGridColWidth);
procedure StrGridAutoSize3(StrGrid: TDrawGrid;
 var DesignGridColWidth: TDesignGridColWidth);
//　列が左の方から消えていくように動作するAutoSize
//　左の方の隠れてしまう列は幅が0になります。

procedure StrGridAutoSize4Initialize(StrGrid: TDrawGrid;
 var DesignGridColWidth: TDesignGridColWidth);
procedure StrGridAutoSize4(StrGrid: TDrawGrid;
 var DesignGridColWidth: TDesignGridColWidth);
//　列が右の方から消えていくように動作するAutoSize
//　右の方の隠れてしまう列は幅が0です。

implementation


////////////////////////////////////////////////////////////
//StringGridAutoSize-Type2
procedure StrGridAutoSize2Initialize(StrGrid: TDrawGrid;
 var GridColWidthPercent: TGridColWidthPercent);
var
  i: Integer;
  SColumnWidths: Integer;  //総和
begin
  with StrGrid do
  begin
    SetLength(GridColWidthPercent, ColCount);

    SColumnWidths := 0;
    for i := 0 to ColCount - 1 do  //Grid幅の総和を求めている
    begin
      SColumnWidths := SColumnWidths + ColWidths[i] + GridLineWidth;
    end;

    for i := 0 to ColCount - 1 do
    begin           //列幅+列線幅を列幅総和で割ると列幅の割合がわかる
      GridColWidthPercent[i] :=
        (ColWidths[i] + GridLineWidth) / SColumnWidths;
    end;
  end;
end;

procedure StrGridAutoSize2(StrGrid: TDrawGrid;
 var GridColWidthPercent: TGridColWidthPercent);
var
  i: integer;
begin
  if Length(GridColWidthPercent) <> StrGrid.ColCount then exit;

  with StrGrid do
  begin
    for i := 0 to ColCount - 1 do
    begin             //表示領域*列幅の割合から一行の線幅を引く
      ColWidths[i] :=
        trunc(ClientWidth * GridColWidthPercent[i]) - GridLineWidth;
   //少しでも幅が大きいスクロールバーで困るので小数点以下は誤差で切り捨て
    end;  
  end;
end;

////////////////////////////////////////////////////////////
//StringGridAutoSize-Type3
procedure StrGridAutoSize3Initialize(StrGrid: TDrawGrid;
 var DesignGridColWidth: TDesignGridColWidth);
var  //設計時の列幅を保持
  i: Integer;
begin
  with StrGrid do
  begin
    SetLength(DesignGridColWidth, ColCount);
    for i:=0 to ColCount-1 do
      DesignGridColWidth[i]:= ColWidths[i];
  end;
end;

procedure StrGridAutoSize3(StrGrid: TDrawGrid;
 var DesignGridColWidth: TDesignGridColWidth);
var
  SColWidth,i,PointCol: Integer;
begin
  if Length(DesignGridColWidth) <> StrGrid.ColCount then exit;

  SColWidth:=0;
  with StrGrid do
  begin
    PointCol := ColCount;
    repeat
      dec(PointCol);    //何番の列をフィットサイズするべきか決定する
      SColWidth := SColWidth + DesignGridColWidth[PointCol] + GridLineWidth;
    until (ClientWidth < SColWidth) or (PointCol=0) ;

    for i:=0 to PointCol-1 do  //左側の消えるべき列をWidth:=0にする
      ColWidths[i] := 0;

    SColWidth := 0;       //フィットサイズする列の次の列から設計時の列幅にする
    for i := PointCol+1 to ColCount-1 do
    begin
      ColWidths[i] := DesignGridColWidth[i];
      SColWidth := SColWidth + DesignGridColWidth[i];
    end;
    ColWidths[PointCol] := (ClientWidth - (GridLineWidth*ColCount)) - SColWidth;
  end;                 //最後にフィットサイズ列幅を決める
end;

////////////////////////////////////////////////////////////
//StringGridAutoSize-Type4
procedure StrGridAutoSize4Initialize(StrGrid: TDrawGrid;
 var DesignGridColWidth: TDesignGridColWidth);
begin
  StrGridAutoSize3Initialize( StrGrid, DesignGridColWidth);
end;
//StrGridAutoSize3Initializeと全く同じ実装です。
//説明のためにこのようにしています。

procedure StrGridAutoSize4(StrGrid: TDrawGrid;
 var DesignGridColWidth: TDesignGridColWidth);
var
  SColWidth,i,PointCol: Integer;
begin
  if Length(DesignGridColWidth) <> StrGrid.ColCount then exit;

  SColWidth:=0;
  with StrGrid do
  begin
    PointCol := -1;
    repeat
      inc(PointCol);    //何番の列をフィットサイズするべきか決定する
      SColWidth := SColWidth + DesignGridColWidth[PointCol] + GridLineWidth;
    until (ClientWidth < SColWidth) or (PointCol=ColCount-1) ;
    //※1

    for i:=PointCol+1 to ColCount-1 do  //右側の消えるべき列をWidth:=0にする
      ColWidths[i] := 0;

    SColWidth := 0;       //フィットサイズする列の前の列まで設計時の列幅にする
    for i := 0 to PointCol-1 do
    begin
      ColWidths[i] := DesignGridColWidth[i];
      SColWidth := SColWidth + DesignGridColWidth[i];
    end;
    ColWidths[PointCol] := (ClientWidth - (GridLineWidth*(PointCol+1)))- SColWidth;
  end;               //最後にフィットサイズ列幅を決める
                                                         //※2

{
今のコーディングはType1でいうところの
PatternBである
PatternAのようにするには
※1
    repeat
      inc(PointCol);    //何番の列をフィットサイズするべきか決定する
      SColWidth := SColWidth + DesignGridColWidth[PointCol];
    until (ClientWidth-(ColCount*GridLineWidth) < SColWidth) or (PointCol=ColCount-1) ;
ここでGridLineWidthを列数分で判定し

※2
    ColWidths[PointCol] := (ClientWidth - (GridLineWidth*(ColCount)))- SColWidth;
  end;
ここでGridLineWidthの列数の和をフィッティングさせるために用いるとよいだろう。

PatternAでは
Gridの最後にGridLineが沢山並ぶ。つまり線が太くなる
GridLineWidthが大きい値なら動作がわかりやすい。

対してPatternBは
Gridの最後にはGridLineは一本しか描画されないので
セルとGridLineとの見た目は綺麗


Type1の場合は
PatternBを行うと
Gridの最小幅が0でリサイズ列が選択可能列の先頭の場合は
なぜか横スクロールするようになる為に、その防止として
PatternAを使う場合がある

Type4の場合は
あえてPatternAにしたい場合
上に示したようなコードと置き換える事が出来る。

出来るけど｜今のコード・PatternBの方
(つまりGridLineが沢山並ばない方)が
綺麗に見えるのでこちらを使う

GridLineWidthが小さい場合は、ほとんど見た目に影響しないので
とりあえずどっちでもいいことだ。
}

end;

////////////////////////////////////////////////////////////
//StringGridAutoSize-Type1
procedure StrGridAutoSize1Initialize(StrGrid: TDrawGrid;
 var DesignGridColWidth: TDesignGridColWidth);
begin
  StrGridAutoSize3Initialize( StrGrid, DesignGridColWidth);
end;

procedure StrGridAutoSize1(StrGrid: TDrawGrid;
 var DesignGridColWidth: TDesignGridColWidth);

const
  ResizeGridColumnNumber: Integer =2; //リサイズするCol番号を指定
  GridMinSize: Integer =0;    //リサイズされても維持したい最小のWidthを指定
//使用者の手によって変更してください

    procedure GridLinePatternA;
    var
      NestSColWidth, i, NestPointCol: Integer;
    begin
      with StrGrid do
      begin

        NestSColWidth := 0;
        NestPointCol := -1;
        repeat
          inc(NestPointCol);    //何番の列をフィットサイズするべきか決定する
          if NestPointCol=ResizeGridColumnNumber then
            NestSColWidth := NestSColWidth + GridMinSize
          else
            NestSColWidth := NestSColWidth + DesignGridColWidth[NestPointCol];
        until (ClientWidth-(ColCount*GridLineWidth) < NestSColWidth) or (NestPointCol=ColCount-1) ;

        for i:=NestPointCol+1 to ColCount-1 do  //右側の消えるべき列をWidth:=0にする
          ColWidths[i] := 0;

        NestSColWidth := 0;       //フィットサイズする列の前の列まで設計時の列幅にする
        for i := 0 to NestPointCol-1 do
        begin
          if i=ResizeGridColumnNumber then
          begin
            ColWidths[i] := GridMinSize;
            NestSColWidth := NestSColWidth + GridMinSize;
          end else
          begin
            ColWidths[i] := DesignGridColWidth[i];
            NestSColWidth := NestSColWidth + DesignGridColWidth[i];
          end;
        end;
        ColWidths[NestPointCol] := (ClientWidth - (GridLineWidth*(ColCount)))- NestSColWidth;
         //最後にフィットサイズ列幅を決める

      end; //with
    end;

    procedure GridLinePatternB;
    var
      NestSColWidth, i, NestPointCol: Integer;
    begin
      with StrGrid do
      begin

        NestSColWidth := 0;
        NestPointCol := -1;
        repeat
          inc(NestPointCol);    //何番の列をフィットサイズするべきか決定する
          if NestPointCol=ResizeGridColumnNumber then
            NestSColWidth := NestSColWidth + GridMinSize + GridLineWidth
          else
            NestSColWidth := NestSColWidth + DesignGridColWidth[NestPointCol] + GridLineWidth;
        until (ClientWidth < NestSColWidth) or (NestPointCol=ColCount-1) ;

        for i:=NestPointCol+1 to ColCount-1 do  //右側の消えるべき列をWidth:=0にする
          ColWidths[i] := 0;

        NestSColWidth := 0;       //フィットサイズする列の前の列まで設計時の列幅にする
        for i := 0 to NestPointCol-1 do
        begin
          if i=ResizeGridColumnNumber then
          begin
            ColWidths[i] := GridMinSize;
            NestSColWidth := NestSColWidth + GridMinSize;
          end else
          begin
            ColWidths[i] := DesignGridColWidth[i];
            NestSColWidth := NestSColWidth + DesignGridColWidth[i];
          end;
        end;
        ColWidths[NestPointCol] := (ClientWidth - (GridLineWidth*(NestPointCol+1)))- NestSColWidth;
         //最後にフィットサイズ列幅を決める

      end; //with
    end;

var
  SColWidth, i: Integer;
begin
  if Length(DesignGridColWidth) <> StrGrid.ColCount then exit;

  //リサイズCol番号がちゃんとGridの範囲に入っているか確認
  if (ResizeGridColumnNumber < 0)
    or (StrGrid.ColCount-1 < ResizeGridColumnNumber) then
  begin
    StrGridAutoSize4(StrGrid, DesignGridColWidth);
    exit;
  end;

  with StrGrid do
  begin

    SColWidth := 0;  //リサイズするCol番号以外のColWidth和を求める
    for i := 0 to ColCount-1 do
    begin
      if not (i=ResizeGridColumnNumber) then
        SColWidth := SColWidth + DesignGridColWidth[i];
    end;
    SColWidth := SColWidth + (StrGrid.GridLineWidth * (StrGrid.ColCount));

    if SColWidth + GridMinSize <= StrGrid.ClientWidth then
    begin

      //規定サイズよりも大きいのなら、指定Colをリサイズ
      for i := 0 to ColCount - 1 do
      begin
        if (i=ResizeGridColumnNumber) then
          ColWidths[i] := StrGrid.ClientWidth - SColWidth
        else
          ColWidths[i] := DesignGridColWidth[i];
      end;

    end else
    begin
      //規定サイズよりも小さかったら右からリサイズ

      //ほとんどType4と同じコーディング

      //GridMinSizeが0の時...とそれ以外の時
      //コーディングを変えてみた
      //詳細な説明はType4のコード内のコメントを参照のこと
      //一種のバグともいえるが、
      //どんな状況下でもGridLinePatternAでも通用する(見た目がイマイチ)

      if (GridMinSize = 0)
        and (ResizeGridColumnNumber = FixedCols) then
      begin
        GridLinePatternA;
      end else
      begin
        GridLinePatternB;
      end;

    end; //if SColWidth..
  end; //with
end;

end.