readgridu.pas

功能强大和发俏的表格操作 所需第三方控件：TMS Pack 包中的TADVStringGrid控件！ 主要用于统计数据和设计比较复杂的表格！ 核心部分：合并单元格的几个函数和过程！

unit ReadGridU;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, iniFiles, StdCtrls, Buttons, Grids, BaseGrid, AdvGrid, ExtCtrls,
  ComCtrls,ShellAPI;

type
  TReadGridFrm = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    asg: TAdvStringGrid;
    Panel1: TPanel;
    bbtnRed: TBitBtn;
    bbtnSave: TBitBtn;
    BitBtn: TBitBtn;
    Panel2: TPanel;
    Label9: TLabel;
    lblHomePage: TLabel;
    Label11: TLabel;
    lblEmail: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure bbtnRedClick(Sender: TObject);
    procedure asgGetAlignment(Sender: TObject; ARow, ACol: Integer;
      var HAlign: TAlignment; var VAlign: TVAlignment);
    procedure bbtnSaveClick(Sender: TObject);
    procedure BitBtnClick(Sender: TObject);
    procedure asgGetCellColor(Sender: TObject; ARow, ACol: Integer;
      AState: TGridDrawState; ABrush: TBrush; AFont: TFont);
    procedure asgCanEditCell(Sender: TObject; ARow, ACol: Integer;
      var CanEdit: Boolean);
    procedure lblHomePageClick(Sender: TObject);
    procedure lblEmailClick(Sender: TObject);
  private
    { Private declarations }
  public
    Path:String;
    procedure DoReadIniFile(asg:TAdvStringGrid;FileName:String);
    Procedure Merge();  //手工合并
    Procedure MgeRow(advGrid:TAdvStringGrid;iRow:integer);  //合并一行 iRow：行号
    Procedure MgeCol(advGrid:TAdvStringGrid;iCol:integer);  //合并一列 iCol：列号
    Procedure MgeAll(advGrid:TAdvStringGrid); //合并所有

    Procedure MgeRows(advGrid:TAdvStringGrid;RowBegin,RowEnd:integer);  //合并多行 RowBegin：开始行号  RowEnd:结束行号
    Procedure MgeCols(advGrid:TAdvStringGrid;ColBegin,ColEnd:integer);  //合并多列 ColBegin：开始列号  ColEnd:结束列号
  end;

var
  ReadGridFrm: TReadGridFrm;

implementation

{$R *.dfm}

procedure TReadGridFrm.DoReadIniFile(asg: TAdvStringGrid; FileName: String);
begin
  asg.LoadFromCSV(Path+FileName);
end;

procedure TReadGridFrm.FormCreate(Sender: TObject);
begin
  Path:=ExtractFilePath(ParamStr(0));
  bbtnRedClick(nil);
end;

procedure TReadGridFrm.bbtnRedClick(Sender: TObject);
begin
  asg.ClearRows(0,asg.RowCount-1);
  DoReadIniFile(asg,'Test.csv');  //
end;

procedure TReadGridFrm.Merge;
begin
  with asg do
  begin
    MergeCells(0,0,5,1);   //受力钢筋的混凝土保护层最小厚度(mm)
    MergeCells(2,1,3,1);   //混凝土强度等级
    
    MergeCells(0,9,5,1);   //注释开始

    MergeCells(0,1,1,2);  //环境条件
    MergeCells(1,1,1,2);  //构件类别
    MergeCells(0,3,1,3);  //室内正常环境
    MergeCells(0,6,1,3);  //露天或室内高湿度环  境

    RowHeights[9]:=80;
  end;

end;


procedure TReadGridFrm.asgGetAlignment(Sender: TObject; ARow,
  ACol: Integer; var HAlign: TAlignment; var VAlign: TVAlignment);
begin
  if ARow >8 then
  Else
    HAlign:=taCenter;
end;

procedure TReadGridFrm.bbtnSaveClick(Sender: TObject);
begin
  asg.SaveToCSV(Path+'Test.csv');
end;

procedure TReadGridFrm.MgeRow(advGrid: TAdvStringGrid; iRow: integer);

Type
  TMgeOb = ^TMgeRec;
  TMgeRec = Record
    Start:integer;            //开始合并位置  列开始
    SameCount:integer;       //合并行数
  end;

Var
  i,iPos,iiPos,iCol,iiCol:integer;
  aList:TList;
  aOb:TMgeOb;
  IsCreate:Boolean;

begin
  if (iRow<0) Or (iRow>advGrid.RowCount-1) then Exit;
  aList:=TList.Create;
  iPos:=-1;
  iiPos:=-1;
  with advGrid do
  begin
    for iCol:=0 to ColCount-1 do
    begin
      IsCreate:=False;
      if iPos>=iCol then Continue;
      For iiCol:=iCol+1 to ColCount-1 do
        begin
          if iiPos>=iiCol then Continue;
          if Cells[iiCol,iRow]=Cells[iCol,iRow] then
          begin
            iPos:=iiCol;
            iiPos:=iiCol;
            if IsCreate = False then
            begin
              New(aOb);
              IsCreate := True;
              aOb.Start:=iCol;
              aOb.SameCount:=2;
              aList.Add(aOb);
            end else
            begin
              Inc(aOb.SameCount); //:=aOb.SameCount+1;
              //IsCreate := True;
            end;
          end else // No Equal
          begin
            iiPos:=iiCol;
            Break;
          end;
      end;
    end;
  end;

  For i:=0 to aList.Count-1 do
  begin
    aOb:=aList.Items[i];
    asg.MergeCells(aOb.Start,iRow,aOb.SameCount,1);
  end;
  For i:=aList.Count-1 Downto 0 do
    aList.Delete(i);
  aList.Free;
end;

procedure TReadGridFrm.MgeCol(advGrid: TAdvStringGrid; iCol: integer);

Type
  TMgeOb = ^TMgeRec;
  TMgeRec = Record
    Start:integer;       //开始合并位置  行开始
    SameCount:integer;  //合并列数
  end;

Var
  i,iPos,iiPos,iRow,iiRow:integer;
  aList:TList;
  aOb:TMgeOb;
  IsCreate:Boolean;
begin
  if (iCol<0) Or (iCol>advGrid.ColCount-1) then Exit;
  aList:=TList.Create;
  iPos:=-1;
  iiPos:=-1;
  with advGrid do
  begin
    for iRow:=0 to RowCount-1 do
    begin
      IsCreate:=False;
      if iPos>=iRow then Continue;
      For iiRow:=iRow+1 to RowCount-1 do
        begin
          if iiPos>=iiRow then Continue;
          if Cells[iCol,iiRow]=Cells[iCol,iRow] then
          begin
            iPos:=iiRow;
            iiPos:=iiRow;
            if IsCreate = False then
            begin
              New(aOb);
              IsCreate := True;
              aOb.Start:=iRow;
              aOb.SameCount:=2;
              aList.Add(aOb);
            end else
            begin
              Inc(aOb.SameCount);
            end;
          end else // No Equal
          begin
            iiPos:=iiRow;
            Break;
          end;
      end;
    end;
  end;

  For i:=0 to aList.Count-1 do
  begin
    aOb:=aList.Items[i];
    asg.MergeCells(iCol,aOb.Start,1,aOb.SameCount);
  end;
  For i:=aList.Count-1 Downto 0 do
    aList.Delete(i);
  aList.Free;
end;

procedure TReadGridFrm.MgeAll(advGrid: TAdvStringGrid);
Var
  i,iRow,iCol:Integer;
begin
  iRow := advGrid.RowCount;
  iCol := advGrid.ColCount;
  For i:=0 to iRow do
    MgeRow(advGrid,i);
  For i:=0 to iCol do
    MgeCol(advGrid,i);
end;

procedure TReadGridFrm.BitBtnClick(Sender: TObject);
begin
  MgeRows(asg,0,1);
  MgeCols(asg,0,1);
  MgeRows(asg,9,9);
end;

procedure TReadGridFrm.MgeRows(advGrid: TAdvStringGrid; RowBegin,RowEnd: integer);
Var
  i,iRow:Integer;
begin
  iRow := advGrid.RowCount;
  if (RowBegin>iRow) Or (RowEnd>iRow) then Exit;
  For i:=RowBegin to RowEnd do
    MgeRow(advGrid,i);
end;

procedure TReadGridFrm.MgeCols(advGrid: TAdvStringGrid; ColBegin,ColEnd: integer);
Var
  i,iCol:Integer;
begin
  iCol := advGrid.ColCount;
  if (ColBegin>iCol) Or (ColEnd>iCol) then Exit;
  For i:=ColBegin to ColEnd do
    MgeCol(advGrid,i);
end;

procedure TReadGridFrm.asgGetCellColor(Sender: TObject; ARow,
  ACol: Integer; AState: TGridDrawState; ABrush: TBrush; AFont: TFont);
begin
  if ARow In [0,9] then
  begin
    AFont.Color := clRed;
    AFont.Style := AFont.Style + [fsBold];
  end;
  if ACol=2 then
  begin
    AFont.Color := clBlue;
    AFont.Style := AFont.Style + [fsBold]
  end;
  if ACol In [0,4] then
  begin
    AFont.Color := clRed;
    AFont.Style := AFont.Style + [fsBold]
  end;
  if (arow = 6) And (ACol>0) then
  begin
    AFont.Color := clYellow;
    ABrush.Color := clOlive;
    AFont.Style := AFont.Style + [fsBold];
  end;  
end;

procedure TReadGridFrm.asgCanEditCell(Sender: TObject; ARow, ACol: Integer;
  var CanEdit: Boolean);
begin
  CanEdit := True;
end;

procedure TReadGridFrm.lblHomePageClick(Sender: TObject);
Var
  Url:String;
begin
  Url:='http://www.uu987.com';
  try
    ShellExecute(Handle, nil, PChar(Url), nil, nil, SW_SHOWNORMAL);
  except
    Application.MessageBox('Internet Explorer调用失败！', '错误', MB_ICONWARNING);
  end;
end;

procedure TReadGridFrm.lblEmailClick(Sender: TObject);
Var
  Email:String;
begin
  Email:='[e-mail]';
  try
    ShellExecute(Handle, nil, PChar('MailTo:' + Email), nil, nil, SW_SHOWNORMAL);
  except
    Application.MessageBox('Outlook Express调用失败！', '错误', MB_ICONWARNING);
  end;
end;

end.