esgrid.pas

比StringGrid好的多的超级表格

unit ESGrid;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{  使用第三方控件    TMS包-AdvStringGrid 2.4.0.4  }
{  实现表头合并、文字换行显示，对正文中有文字的格 }
{  着文字色和背景色，对整行、整列着背景色         }
{  因是1天前下载控件试用，以结果为目的，对程序    }
{  没有进行优化                                   }
{                                                 }
{  Josen  设计                        2005.08.24  }
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, Grids, BaseGrid, AdvGrid, DBGrids;

type
  TForm1 = class(TForm)
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    AdvStringGrid3D: TAdvStringGrid;
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure AdvStringGrid3DGetAlignment(Sender: TObject; ARow,
      ACol: Integer; var HAlign: TAlignment; var VAlign: TVAlignment);
    procedure AdvStringGrid3DGetCellColor(Sender: TObject; ARow,
      ACol: Integer; AState: TGridDrawState; ABrush: TBrush; AFont: TFont);
    procedure FormShow(Sender: TObject);
    procedure AdvStringGrid3DDrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure AdvStringGrid3DIsFixedCell(Sender: TObject; ARow,
      ACol: Integer; var IsFixed: Boolean);
  private
    { Private declarations }
     procedure Draw3DGrid;                          {3D表的表头处理合并栏目、显示文字}
     procedure Add3DGrid(qs: String; hm: String);   {添加3D号码到AvdStringGrid表中}

  public
    { Public declarations }

  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{用户自定义函数...begin}

procedure TForm1.Draw3DGrid;   {3D表的表头处理合并栏目、显示文字}
var
  i : Integer;
begin
  with AdvStringGrid3D do
  begin
    if ColCount<41 then
      ColCount := 41;         {总列数}
    if RowCount<3 then
      RowCount := 3;          {总行数}
    FixedCols := 2;           {表头列数}
    FixedRows := 2;           {表头行数}
    DefaultColWidth := 18;    {设缺省列宽}
    DefaultRowHeight := 18;   {设缺省行高}
    ColWidths[0] := 56;       {设表头第一列宽}
    ColWidths[1] := 36;       {设表头第二列宽}
    ColWidths[40] := 28;      {设表头第四十列宽}
    RowHeights[0] := 20;      {设表头第一行高}
    RowHeights[1] := 64;      {设表头第二行高}
    {合并栏格}
    {1.合并-期数} {合并函数：列，行，合并多少列，合并多少行}
    MergeCells(0,0,1,2);
    {2.合并-号码}
    MergeCells(1,0,1,2);
    {3.合并-号码百位数值}
    MergeCells(2,0,10,1);
    {4.合并-号码十位数值}
    MergeCells(12,0,10,1);
    {5.合并-号码个位数值}
    MergeCells(22,0,10,1);
    {6.合并-奇偶组合}
    MergeCells(32,0,4,1);
    {7.合并-大小组合}
    MergeCells(36,0,4,1);
    {8.合并-和值}
    MergeCells(40,0,1,2);
    {显示文字}
    Cells[0,0] := '期数';
    Cells[1,0] := '号码';
    Cells[2,0] := '百位数字';
      for i:=0 to 9 do
        Cells[i+2,1] := trim(inttostr(i));
    Cells[12,0] := '十位数字';
      for i:=0 to 9 do
        Cells[i+12,1] := trim(inttostr(i));
    Cells[22,0] := '个位数字';
      for i:=0 to 9 do
        Cells[i+22,1] := trim(inttostr(i));
    Cells[32,0] := '奇偶搭配';
//      Cells[32,1] := 'JJJ';
//      Cells[33,1] := 'JJo';
//      Cells[34,1] := 'ooJ';
//      Cells[35,1] := 'ooo';
    Cells[36,0] := '大小组合';
//      Cells[36,1] := 'ddd';
//      Cells[37,1] := 'ddx';
//      Cells[38,1] := 'xxd';
//      Cells[39,1] := 'xxx';
    Cells[40,0] := '和值';
  end;
end;

procedure TForm1.Add3DGrid(qs: String; hm: String);    {添加3D号码到AvdStringGrid表中}
var
  aRow : Integer;
  hm1,hm2,hm3,j1,j2,j3 : String;
begin
  with AdvStringGrid3D do
  begin
    aRow := RowCount-1;   {定位行坐标}
    AddRow;               {添加行}
    {1.期数}
    Cells[0,aRow] := qs;
    {2.号码}
    Cells[1,aRow] := hm;
    {3.百、十、个位数}
    hm1 := copy(hm,1,1);
    hm2 := copy(hm,2,1);
    hm3 := copy(hm,3,1);
    Cells[strtoint(hm1)+2, aRow] := hm1;
    Cells[strtoint(hm2)+12,aRow] := hm2;
    Cells[strtoint(hm3)+22,aRow] := hm3;
    {4.奇偶}
    if (char(byte(hm1[1])) in ['1','3','5','7','9']) then
      j1 := '1'
    else
      j1 := '0';
    if (char(byte(hm2[1])) in ['1','3','5','7','9']) then
      j2 := '1'
    else
      j2 := '0';
    if (char(byte(hm3[1])) in ['1','3','5','7','9']) then
      j3 := '1'
    else
      j3 := '0';
    if (j1='1') and (j2='1') and (j3='1') then {全奇}
      Cells[32, aRow] := '▲'
    else
    begin
      if (j1='0') and (j2='0') and (j3='0') then {全偶}
        Cells[35, aRow] := '★'
      else
      begin
        if ((j1='1') and (j2='1')) or ((j1='1') and (j3='1')) or
           ((j2='1') and (j3='1')) then {两奇一偶}
          Cells[33,aRow] := '◆'
        else  {两偶一奇}
          Cells[34,aRow] := '■';
      end;
    end;
    {5.大小}
    if (char(byte(hm1[1])) in ['5','6','7','8','9']) then
      j1 := '1'
    else
      j1 := '0';
    if (char(byte(hm2[1])) in ['5','6','7','8','9']) then
      j2 := '1'
    else
      j2 := '0';
    if (char(byte(hm3[1])) in ['5','6','7','8','9']) then
      j3 := '1'
    else
      j3 := '0';
    if (j1='1') and (j2='1') and (j3='1') then {全大}
      Cells[36, aRow] := '▲'
    else
    begin
      if (j1='0') and (j2='0') and (j3='0') then {全小}
        Cells[39, aRow] := '★'
      else
      begin
        if ((j1='1') and (j2='1')) or ((j1='1') and (j3='1')) or
           ((j2='1') and (j3='1')) then {两大一小}
          Cells[37,aRow] := '◆'
        else  {两小一大}
          Cells[38,aRow] := '■';
      end;
    end;    
    {6.和值}
    Cells[40,aRow] := trim(inttostr(strtoint(hm1)+strtoint(hm2)+strtoint(hm3)));
  end;
end;

{用户自定义函数...end}

procedure TForm1.AdvStringGrid3DGetAlignment(Sender: TObject; ARow,
  ACol: Integer; var HAlign: TAlignment; var VAlign: TVAlignment);
begin
  Halign := taCenter; {文字水平垂直居中}
//  if (ARow In [0..4]) Or (ACol IN [0..41]) then Halign := taCenter
//  else Halign := taRightJustify;  {对符合条件的行列居中，否则不居中}
end;

procedure TForm1.AdvStringGrid3DGetCellColor(Sender: TObject; ARow,
  ACol: Integer; AState: TGridDrawState; ABrush: TBrush; AFont: TFont);
begin
  {对符合条件的列行着背景色和文字色、类型}
  {号码百位数}
  if (not(aRow In [0..1])) and (aCol In [2..11]) then   //统计类别......
  begin
    AFont.Style := AFont.Style + [fsBold];
    ABrush.Color := $00E0FFFA;
    AFont.Color := clWhite;
  end;
  {号码十位数}
  if (not(aRow In [0..1])) and (aCol In [12..21]) then   //统计类别......
  begin
    AFont.Style := AFont.Style + [fsBold];
    ABrush.Color := clWhite;
    AFont.Color := clBlack;
  end;
  {号码个位数}
  if (not(aRow In [0..1])) and (aCol In [22..31]) then   //统计类别......
  begin
    AFont.Style := AFont.Style + [fsBold];
    ABrush.Color := $00E0FFFA;
    AFont.Color := clRed;
  end;
  {奇偶搭配}
  if (not(aRow In [0..1])) and (aCol In [32..35]) then   //统计类别......
  begin
    AFont.Style := AFont.Style + [fsBold];
    ABrush.Color := clWhite;
    AFont.Color := clRed;
  end;
  {大小组合}
  if (not(aRow In [0..1])) and (aCol In [36..39]) then   //统计类别......
  begin
    AFont.Style := AFont.Style + [fsBold];
    ABrush.Color := $00E0FFFA;
    AFont.Color := clRed;
  end;
  {和值}
  if (not(aRow In [0..1])) and (aCol In [40]) then   //统计类别......
  begin
    AFont.Style := AFont.Style + [fsBold];
    ABrush.Color := clWhite;
    AFont.Color := clBlack;
  end;
  with (Sender as TAdvStringGrid) do
  begin
    {百位数}
    if (Length(Cells[aCol,aRow])<>0) and
       ((not(aRow In [0..1])) and (aCol In [2..11])) then
      ABrush.Color := clRed;
    {十位数}
    if (Length(Cells[aCol,aRow])<>0) and
       ((not(aRow In [0..1])) and (aCol In [12..21])) then
      ABrush.Color := clLime;
    {个位数}
    if (Length(Cells[aCol,aRow])<>0) and
       ((not(aRow In [0..1])) and (aCol In [22..31])) then
      ABrush.Color := clAqua; 
  end;
end;

procedure TForm1.AdvStringGrid3DDrawCell(Sender: TObject; ACol,
  ARow: Integer; Rect: TRect; State: TGridDrawState);
begin
  {换行显示文字处理}
  with (Sender as TAdvStringGrid) do
  begin
    {显示换行的"全奇"字符串}
    if (aRow=1) and (aCol=32) then
    begin
      Textout(Canvas.Handle,Rect.Left+4,Rect.Top+12,pchar('全'),12);
      Textout(Canvas.Handle,Rect.Left+4,Rect.Top+28,pchar('奇'),12);
    end;
    {显示换行的"两奇一偶"字符串}
    if (aRow=1) and (aCol=33) then
    begin
      Textout(Canvas.Handle,Rect.Left+4,Rect.Top+8,pchar('两'),12);
      Textout(Canvas.Handle,Rect.Left+4,Rect.Top+20,pchar('奇'),12);
      Textout(Canvas.Handle,Rect.Left+4,Rect.Top+34,pchar('一'),12);
      Textout(Canvas.Handle,Rect.Left+4,Rect.Top+46,pchar('偶'),12);
    end;
    {显示换行的"两偶一奇"字符串}
    if (aRow=1) and (aCol=34) then
    begin
      Textout(Canvas.Handle,Rect.Left+4,Rect.Top+8,pchar('两'),12);
      Textout(Canvas.Handle,Rect.Left+4,Rect.Top+20,pchar('偶'),12);
      Textout(Canvas.Handle,Rect.Left+4,Rect.Top+34,pchar('一'),12);
      Textout(Canvas.Handle,Rect.Left+4,Rect.Top+46,pchar('奇'),12);
    end;
    {显示换行的"全偶"字符串}
    if (aRow=1) and (aCol=35) then
    begin
      Textout(Canvas.Handle,Rect.Left+4,Rect.Top+12,pchar('全'),12);
      Textout(Canvas.Handle,Rect.Left+4,Rect.Top+28,pchar('偶'),12);
    end;
    {显示换行的"全大"字符串}
    if (aRow=1) and (aCol=36) then
    begin
      Textout(Canvas.Handle,Rect.Left+4,Rect.Top+12,pchar('全'),12);
      Textout(Canvas.Handle,Rect.Left+4,Rect.Top+28,pchar('大'),12);
    end;
    {显示换行的"两大一小"字符串}
    if (aRow=1) and (aCol=37) then
    begin
      Textout(Canvas.Handle,Rect.Left+4,Rect.Top+8,pchar('两'),12);
      Textout(Canvas.Handle,Rect.Left+4,Rect.Top+20,pchar('大'),12);
      Textout(Canvas.Handle,Rect.Left+4,Rect.Top+34,pchar('一'),12);
      Textout(Canvas.Handle,Rect.Left+4,Rect.Top+46,pchar('小'),12);
    end;
    {显示换行的"两小一大"字符串}
    if (aRow=1) and (aCol=38) then
    begin
      Textout(Canvas.Handle,Rect.Left+4,Rect.Top+8,pchar('两'),12);
      Textout(Canvas.Handle,Rect.Left+4,Rect.Top+20,pchar('小'),12);
      Textout(Canvas.Handle,Rect.Left+4,Rect.Top+34,pchar('一'),12);
      Textout(Canvas.Handle,Rect.Left+4,Rect.Top+46,pchar('大'),12);
    end;
    {显示换行的"全小"字符串}
    if (aRow=1) and (aCol=39) then
    begin
      Textout(Canvas.Handle,Rect.Left+4,Rect.Top+12,pchar('全'),12);
      Textout(Canvas.Handle,Rect.Left+4,Rect.Top+28,pchar('小'),12);
    end;
  end;
end;

procedure TForm1.AdvStringGrid3DIsFixedCell(Sender: TObject; ARow,
  ACol: Integer; var IsFixed: Boolean);
begin
  with (Sender as TAdvStringGrid) do
    {消除DrawCell过程中文字换行对最后一列引起乱字符的现象}
    Cells[40,0] := '和值';        
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  Draw3DGrid;
  BitBtn2Click(Sender);
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
  Add3DGrid('2005222','788');
  Add3DGrid('2005223','807');
  Add3DGrid('2005224','794');
  Add3DGrid('2005225','260');
  Add3DGrid('2005226','603');
  Add3DGrid('2005227','455');
  Add3DGrid('2005228','209');
  Add3DGrid('2005228','139');  
end;

end.