main.pas

一个经典的读写Excel的控件

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, Tabs, Cell2,
{$ifdef ver140}
  Variants,
{$endif}
  XLSUtils2, XLSReadWriteII2;

type
  TForm8 = class(TForm)
    Label1: TLabel;
    edFilename: TEdit;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    dlgOpen: TOpenDialog;
    Button4: TButton;
    Grid: TDrawGrid;
    TabSet: TTabSet;
    lblCell: TLabel;
    edCell: TEdit;
    XLS: TXLSReadWriteII2;
    procedure Button1Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure GridDrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure TabSetChange(Sender: TObject; NewTab: Integer;
      var AllowChange: Boolean);
    procedure GridGetEditText(Sender: TObject; ACol, ARow: Integer;
      var Value: String);
    procedure GridSelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    procedure GridSetEditText(Sender: TObject; ACol, ARow: Integer;
      const Value: String);
    procedure GridKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormCreate(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    EditCol,EditRow: integer;
    EditText: string;

    function ColToText(Col: integer): string;
    procedure SetCellValue(Col,Row: integer);
  public
    { Public declarations }
  end;

var
  Form8: TForm8;

implementation

{$R *.dfm}

function TForm8.ColToText(Col: integer): string;
var
  S: string;
begin
  if (Col div 26) > 0 then
    S := Char(Ord('A') + (Col div 26) - 1)
  else
    S := '';
  Result := S + Char(Ord('A') + (Col mod 26));
end;

procedure TForm8.Button1Click(Sender: TObject);
begin
  dlgOpen.FileName := edFilename.Text;
  if dlgOpen.Execute then
    edFilename.Text := dlgOpen.FileName;
end;

procedure TForm8.Button4Click(Sender: TObject);
begin
  Close;
end;

procedure TForm8.Button2Click(Sender: TObject);
var
  i: integer;
begin
  XLS.Filename := edFilename.Text;
  XLS.Read;
  TabSet.Tabs.Clear;
  for i := 0 to XLS.Sheets.Count - 1 do
    TabSet.Tabs.Add(XLS.Sheets[i].Name);
  TabSet.TabIndex := 0;
  Grid.Invalidate;
end;

procedure TForm8.GridDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
var
  S: string;
begin
  if (ACol > 0) and (ARow > 0) then begin
    S := XLS.Sheets[TabSet.TabIndex].AsFmtString[ACol - 1,ARow - 1];
    if S <> '' then
      Grid.Canvas.TextRect(Rect,Rect.Left + 2,Rect.Top + 2,S);
  end
  else if (ACol <> 0) then begin
    S := ColToText(ACol - 1);
    Grid.Canvas.TextRect(Rect,Rect.Left + (Rect.Right - Rect.Left) div 2 - (Grid.Canvas.TextWidth(S) div 2),Rect.Top + 2,S);
  end
  else if (ARow <> 0) then
    Grid.Canvas.TextRect(Rect,Rect.Left + 2,Rect.Top + 2,IntToStr(ARow));
end;

procedure TForm8.TabSetChange(Sender: TObject; NewTab: Integer;
  var AllowChange: Boolean);
begin
  Grid.Invalidate;
end;

procedure TForm8.GridGetEditText(Sender: TObject; ACol, ARow: Integer; var Value: String);
begin
  EditCol := ACol;
  EditRow := ARow;
  case XLS.Sheets[TabSet.TabIndex].CellType[ACol - 1,ARow - 1] of
    ctNumberFormula,
    ctStringFormula,
    ctBooleanFormula:
      Value := '=' + XLS.Sheets[TabSet.TabIndex].AsFormula[ACol - 1,ARow - 1];
    else
      Value := XLS.Sheets[TabSet.TabIndex].AsWideString[ACol - 1,ARow - 1];
  end;
end;

procedure TForm8.GridSetEditText(Sender: TObject; ACol, ARow: Integer; const Value: String);
begin
  EditText := Trim(Value);
end;

procedure TForm8.SetCellValue(Col,Row: integer);
begin
  if Copy(EditText,1,1) = '=' then
    XLS.Sheets[TabSet.TabIndex].AsFormula[Col,Row] := Copy(EditText,2,MAXINT)
  else begin
    try
      XLS.Sheets[TabSet.TabIndex].AsFloat[Col,Row] := StrToFloat(EditText);
    except
      XLS.Sheets[TabSet.TabIndex].AsWideString[Col,Row] := EditText;
    end;
  end;
end;

procedure TForm8.GridSelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);
begin
  lblCell.Caption := ColRowToRefStr(ACol - 1,ARow - 1,False,False);
  case XLS.Sheets[TabSet.TabIndex].CellType[ACol - 1,ARow - 1] of
    ctNumberFormula,
    ctStringFormula,
    ctBooleanFormula:
      edCell.Text := '=' + XLS.Sheets[TabSet.TabIndex].AsFormula[ACol - 1,ARow - 1];
    else
      edCell.Text := XLS.Sheets[TabSet.TabIndex].AsWideString[ACol - 1,ARow - 1];
  end;
  if (EditCol = Grid.Col) and (EditRow = Grid.Row) then
    SetCellValue(Grid.Col - 1,Grid.Row - 1);
end;

procedure TForm8.GridKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = VK_RETURN) and (EditCol = Grid.Col) and (EditRow = Grid.Row) then
    SetCellValue(Grid.Col - 1,Grid.Row - 1);
end;

procedure TForm8.FormCreate(Sender: TObject);
begin
  Grid.ColWidths[0] := 30;
end;

procedure TForm8.Button3Click(Sender: TObject);
begin
  XLS.Filename := edFilename.Text;
  XLS.Write;
end;

end.