Delphi TXLSReadWriteII2 带的demo中直接编辑XLS文件的例子

Posted 2020-10-10

unit Unit1;

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.Sheet[0].PrintSettings.FitWidth := 2;

  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];

    ctInteger,ctFloat:

      Value := FloatToStr(XLS.Sheets[TabSet.TabIndex].AsFloat[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.