xlsreadwriteii2.pas

一个经典的读写Excel的控件

      //: @exclude
      property DefaultCountryIndex: integer read FDefaultCountryIndex write FDefaultCountryIndex;
      //: @exclude
      property WinIniCountry: integer read FWinIniCountry write FWinIniCountry;
      //: @exclude
      property FormulaHandler: TFormulaHandler read FFormulaHandler;
      //: @exclude
      property Codepage: word read GetCodepage write SetCodepage;
published
      //: The Excel file version for the workbook.
      //: See also @link(TExcelVersion)
      property Version: TExcelVersion read FVersion write SetVersion;
      //: The worksheets in the workbook.
      //: @link(TSheet)
      property Sheets: TSheets read FSheets write FSheets;
      //: Options for the worksheets in the workbook.
      property Workbook: TWorkbookData read FWorkbookData write FWorkbookData;
      //: Here you will find parameters from the Tools->Options dialog in Excel.
      property OptionsDialog: TOptionsDialog read FOptionsDialog write FOptionsDialog;

      //: The default font for the workbook.
      property Font: TXFont read GetFont write SetFont;
      //: The name of the creator of the workbook.
      property UserName: string read GetUserName write SetUserName;
      //: The BookProtect property stores the protection state for a sheet or workbook.
      property BookProtected: boolean read GetBookProtected write SetBookProtected;
      //: The Backup property specifies whether Microsoft Excel should save
      //: backup versions of a file, when the file is opened with Excel.
      property Backup: boolean read GetBackup write SetBackup;
      //: Set the RefreshAll property to True if all external data should be
      //: refreshed when the workbook is loaded by Excel.
      property RefreshAll: boolean read GetRefreshAll write SetRefreshAll;
      //: Change StrTRUE property to change the string representation of the
      //: boolean value True. The default is 'True'.
      //: See also @link(StrFALSE)
      property StrTRUE: WideString read FStrTRUE write FStrTRUE;
      //: Change StrFALSE property to change the string representation of the
      //: boolean value False. The default is 'False'.
      //: See also @link(StrTRUE)
      property StrFALSE: WideString read FStrFALSE write FStrFALSE;
      //: Set the ShowFormulas property to True if functions which reads cells
      //:and return string values shall return the formula itself or de result
      //: (value) of the formula.
      property ShowFormulas: boolean read FShowFormulas write FShowFormulas;
      //: Set the Filename property to the name of the file you want to read or
      //: write.
      //: See also @link(Read), @link(Write), @link(LoadFromStrem), @link(SaveToStream)
      property Filename: WideString read FFilename write FFilename;
      //: True if the file is created by Excel for Macintosh.
      property IsMac: boolean read FIsMac write FIsMac;
      //: Set PreserveMacros to True if macros (VBA script) shall be preserved
      //: when a file is read. When set to False, all macros are deleted.
      property PreserveMacros: boolean read FPreserveMacros write FPreserveMacros;
      //: The version of the TXLSReadWriteII2 component.
      property ComponentVersion: string read GetVersionNumber write SetVerionNumber;
      //: Global storage for pictures used in the worksheets.
      property MSOPictures: TMSOPictures read FMSOPictures write FMSOPictures;
      //: Password when creating encrypted files. Not implemented yet.
      property WritePassword: WideString read FWritePassword write FWritePassword;

      //: Event fired while a file is read or written. The Value parameter
      //: increases from 0 to 100.
      property OnProgress: TIntegerEvent read FProgressEvent write FProgressEvent;
      //: Use the OnFunction event to do the calculation of formulas which not
      //: are calculated by TXLSReadWriteII2.
      //: See also @link(Calculate)
      property OnFunction: TFunctionEvent read FFunctionEvent write FFunctionEvent;
      //: Event fired when a password protected (encrypted) file is read, and
      //: the password is required.
      property OnPassword: TPasswordEvent read FPasswordEvent write FPasswordEvent;
      end;

implementation

uses XLSReadII2, XLSWriteII2, DecodeFormula2;

{ TOptionsDialog }

constructor TOptionsDialog.Create(Records: TRecordStorageGlobals);
begin
  FRecords := Records;
  FCalcMode := cmAutomatic;
end;

function TOptionsDialog.GetPrecisionAsDisplayed: boolean;
begin
  Result := FRecords.PRECISION;
end;

function TOptionsDialog.GetSaveExtLinkVal: boolean;
begin
  Result := FRecords.BOOKBOOL;
end;

function TOptionsDialog.GetShowObjects: TShowObjects;
begin
  Result := TShowObjects(FRecords.HIDEOBJ);
end;

procedure TOptionsDialog.SetPrecisionAsDisplayed(const Value: boolean);
begin
  FRecords.PRECISION := Value;
end;

procedure TOptionsDialog.SetSaveExtLinkVal(const Value: boolean);
begin
  FRecords.BOOKBOOL := Value;
end;

procedure TOptionsDialog.SetShowObjects(const Value: TShowObjects);
begin
  FRecords.HIDEOBJ := Word(Value);
end;

{ TStyle }

procedure TStyles.Add(Style: PRecSTYLE);
var
  P: PRecSTYLE;
begin
  New(P);
  System.Move(Style^,P^,SizeOf(TRecSTYLE));
  inherited Add(P);
end;

procedure TStyles.Clear;
var
  i: integer;
begin
  for i := 0 to Count - 1 do
    FreeMem(inherited Items[i]);
  inherited Clear;
end;

destructor TStyles.Destroy;
begin
  Clear;
  inherited;
end;

function TStyles.GetItems(Index: integer): PRecSTYLE;
begin
  Result := inherited Items[Index];
end;

{ TWorkbookData }

constructor TWorkbookData.Create(Records: TRecordStorageGlobals);
begin
  FRecords := Records;
end;

function TWorkbookData.ReadHeight: word;
begin
  Result := FRecords.WINDOW1.Height;
end;

function TWorkbookData.ReadLeft: word;
begin
  Result := FRecords.WINDOW1.Left;
end;

function TWorkbookData.ReadOptions: TWorkbookOptions;
begin
  Result := [];
  if (FRecords.WINDOW1.Options and $01) = $01 then
    Result := Result + [woHidden];
  if (FRecords.WINDOW1.Options and $02) = $02 then
    Result := Result + [woIconized];
  if (FRecords.WINDOW1.Options and $08) = $08 then
    Result := Result + [woHScroll];
  if (FRecords.WINDOW1.Options and $10) = $10 then
    Result := Result + [woVScroll];
  if (FRecords.WINDOW1.Options and $20) = $20 then
    Result := Result + [woTabs];
end;

function TWorkbookData.ReadSelectedTab: word;
begin
  Result := FRecords.WINDOW1.SelectedTabIndex;
end;

function TWorkbookData.ReadTop: word;
begin
  Result := FRecords.WINDOW1.Top;
end;

function TWorkbookData.ReadWidth: word;
begin
  Result := FRecords.WINDOW1.Width;
end;

procedure TWorkbookData.WriteHeight(const Value: word);
begin
  FRecords.WINDOW1.Height := Value;
end;

procedure TWorkbookData.WriteLeft(const Value: word);
begin
  FRecords.WINDOW1.Left := Value;
end;

procedure TWorkbookData.WriteOptions(const Value: TWorkbookOptions);
begin
  FRecords.WINDOW1.Options := 0;
  if woHidden in Value then
    FRecords.WINDOW1.Options := FRecords.WINDOW1.Options or $01;
  if woIconized in Value then
    FRecords.WINDOW1.Options := FRecords.WINDOW1.Options or $02;
  if woHScroll in Value then
    FRecords.WINDOW1.Options := FRecords.WINDOW1.Options or $08;
  if woVScroll in Value then
    FRecords.WINDOW1.Options := FRecords.WINDOW1.Options or $10;
  if woTabs in Value then
    FRecords.WINDOW1.Options := FRecords.WINDOW1.Options or $20;
end;

procedure TWorkbookData.WriteSelectedTab(const Value: word);
begin
  FRecords.WINDOW1.SelectedTabIndex := Value;
end;

procedure TWorkbookData.WriteTop(const Value: word);
begin
  FRecords.WINDOW1.Top := Value;
end;

procedure TWorkbookData.WriteWidth(const Value: word);
begin
  FRecords.WINDOW1.Width := Value;
end;

constructor TXLSReadWriteII2.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
{$ifdef SHAREWARE}
  if not FNagMsgShown then begin
    if (FindWindow('TApplication', nil) = 0) or (FindWindow('TAlignPalette', nil) = 0) or
       (FindWindow('TPropertyInspector', nil) = 0) or (FindWindow('TAppBuilder', nil) = 0) then begin
      MessageDlg('This application was built with a demo version of' + #13 +
                  'the XLSReadWriteII components.' + #13 + #13 +
                  'Distributing an application based upon this version' + #13 +
                  'of the components are against the licensing agreement.' + #13 + #13 +
                  'Please see http://www.axolot.com for more information' + #13 +
                  'on purchasing.',mtInformation,[mbOk],0);
      FNagMsgShown := True;
    end;
  end;
{$endif}
  Move(TDefaultExcelColorPalette[0],ExcelColorPalette[0],SizeOf(ExcelColorPalette));

{
  FCodepage := $04B0;
}

  FDevMode := GetDEVMODE;
  try
    if FDevMode <> Nil then
      FDefaultPaperSize := TPaperSize(FDevMode.dmPaperSize)
    else
      FDefaultPaperSize := psA4;
  finally
    FreeMem(FDevMode);
    FDevMode := Nil;
  end;

  FRecords := TRecordStorageGlobals.Create;
  FRecords.SetDefaultData;
  FExtraObjects := TExtraObjects.Create;
  FPreserveMacros := True;
  FIsMac := False;
  FWriteDefaultData := True;
  FStrTRUE := 'TRUE';
  FStrFALSE := 'FALSE';
  FWorkbookData := TWorkbookData.Create(FRecords);
  FWorkbookData.Options := [woHScroll,woVScroll,woTabs];
  FWorkbookData.Top := 100;
  FWorkbookData.Left := 100;
  FWorkbookData.Width := 10000;
  FWorkbookData.Height := 7000;
  FOptionsDialog := TOptionsDialog.Create(FRecords);
  FFonts := TXFonts.Create(Self);
  FFormats := TCellFormats.Create(FFonts);
  FDefaultFormat := FFormats[DEFAULT_FORMAT];
  FRows := TList.Create;
  FFormulaHandler := TFormulaHandler.Create(Self);
  FFormulaHandler.OnSheetName := FormulaHandlerSheetName;
  FFormulaHandler.OnSheetData := FormulaHandlerSheetData;
  FMSOPictures := TMSOPictures.Create(Self);
  FStyles := TStyles.Create;
  FSheets := TSheets.Create(Self);
//  Clear;
  FSheets.Add;
  FSheetCharts := TSheetCharts.Create(Self);
  GetCommonSheetData;
  SetVersion(xvExcel97);
end;

destructor TXLSReadWriteII2.Destroy;
begin
  try
//    Clear;
  except
  end;
  FFormulaHandler.Free;
  FRows.Free;
  FSheets.Free;
  FFormats.Free;
  FFonts.Free;
  FOptionsDialog.Free;
  FWorkbookData.Free;
  FStyles.Free;
  FreeMem(FDevMode);
  FRecords.Free;
  FMSOPictures.Free;
  FExtraObjects.Free;
  FSheetCharts.Free;
  inherited;
end;

procedure TXLSReadWriteII2.ClearCells;
begin
  FSheets.Clear;
end;

procedure TXLSReadWriteII2.Clear;
begin
  FFormulaHandler.Clear;
  FRecords.SetDefaultData;
  FWriteDefaultData := True;
  ClearCells;
  FRows.Clear;
  FFormats.Clear;
  FFormats.SetDefault;
  FFonts.Clear;
  FFonts.SetDefault;
  FStyles.Clear;
  FMSOPictures.Clear;
  FExtraObjects.Clear;
  FSheetCharts.Clear;
  if FDevMode <> Nil then
    FreeMem(FDevMode);
  FDevMode := Nil;
end;

procedure TXLSReadWriteII2.SetVersion(Value: TExcelVersion);
begin
  FVersion := Value;
  if FVersion >= xvExcel97 then
    FMaxBuffsize := MAXRECSZ_97
  else
    FMaxBuffsize := MAXRECSZ_40;
  FSheets.MaxBufSize := FMaxBuffsize;
  FFormulaHandler.Version := FVersion;
end;

function TXLSReadWriteII2.GetFont: TXFont;
begin
  Result := Nil;
  if FFonts.Count > 0 then
    Result := FFonts[0]
  else
    ShowMessage('No Fonts');
end;

procedure TXLSReadWriteII2.SetFont(F: TXFont);
begin
  if FFonts.Count > 0 then
    FFonts[0].Assign(F)
  else
    ShowMessage('No Fonts');
end;

procedure TXLSReadWriteII2.SetCodepage(Value: word);
begin
  if Value = 0 then