xlsreadwriteii2.pas

一个经典的读写Excel的控件

    FRecords.CODEPAGE := $04E4
  else
    FRecords.CODEPAGE := Value;
end;

function TXLSReadWriteII2.GetCodepage: word;
begin
  Result := FRecords.CODEPAGE;
end;

procedure TXLSReadWriteII2.GetCommonSheetData;
begin
  case FSheets[0].Records.CALCMODE of
    $0000: FOptionsDialog.CalcMode := cmManual;
    $0001: FOptionsDialog.CalcMode := cmAutomatic;
    $FFFF: FOptionsDialog.CalcMode := cmAutoExTables;
  end;
  FOptionsDialog.CalcCount := FSheets[0].Records.CALCCOUNT;
  FOptionsDialog.Delta := FSheets[0].Records.DELTA;
  FOptionsDialog.R1C1Mode := FSheets[0].Records.REFMODE = 0;
  FOptionsDialog.Iteration := FSheets[0].Records.ITERATION;
  FOptionsDialog.SaveRecalc := FSheets[0].Records.SAVERECALC;
end;

procedure TXLSReadWriteII2.SetCommonSheetData;
var
  i: integer;
begin
  for i := 0 to FSheets.Count - 1 do begin
    case FOptionsDialog.CalcMode of
      cmManual       : FSheets[i].Records.CALCMODE := $0000;
      cmAutomatic    : FSheets[i].Records.CALCMODE := $0001;
      cmAutoExTables : FSheets[i].Records.CALCMODE := $FFFF;
    end;
    FSheets[i].Records.CALCCOUNT := FOptionsDialog.CalcCount;
    FSheets[i].Records.REFMODE := Word(not FOptionsDialog.R1C1Mode);
    FSheets[i].Records.ITERATION := FOptionsDialog.Iteration;
    FSheets[i].Records.SAVERECALC := FOptionsDialog.SaveRecalc;
  end;
end;

procedure TXLSReadWriteII2.Read;
begin
  LoadFromStream(Nil);
end;

procedure TXLSReadWriteII2.LoadFromStream(Stream: TStream);
var
  i: integer;
  List: TList;
  XLSRead: TXLSReadII;
begin
  Clear;
  FSheets.ClearAll;
  FFonts.Clear;
  FFormats.Clear;
  FFormats.NumberFormats.SetDefault;
  BeginUpdate;
  XLSRead := TXLSReadII.Create(Self);
  try
    XLSRead.LoadFromStream(Stream);
//    FixupPictureData;
    FFormulaHandler.ExternalNames.FilePath := ExtractFilePath(FFilename);
    if Assigned(FAfterLoad) then
      FAfterLoad(Self);
  finally
    XLSRead.Free;
    EndUpdate;
  end;
  FFormats.UpdateDeleteIndex;
  FFonts.UpdateDeleteIndex;
  if FFormats.Count > DEFAULT_FORMAT then
    FDefaultFormat := FFormats[DEFAULT_FORMAT]
  else
    FDefaultFormat := FFormats[0];
  GetCommonSheetData;
  FRecords.PostCheck;
  List := TList.Create;
  try
    FMSOPictures.GetBlipIds(List);
    for i := 0 to FSheets.Count - 1 do begin
      FSheets[i].EscherDrawing.AssignBlipIds(List);
      FSheets[i].AfterFileRead;
    end;
  finally
    List.Free;
  end;
{$ifdef SHAREWARE}
  for i := 0 to FSheets.Count - 1 do
    FSheets[i].AsString[0,0] := 'XLSReadWriteII Copyright(c) 2004 Axolot Data';
{$endif}
end;

procedure TXLSReadWriteII2.Write;
begin
  WriteToStream(Nil);
end;

procedure TXLSReadWriteII2.WriteToStream(Stream: TStream);
var
  i: integer;
  XLSWrite: TXLSWriteII;
begin
  if FVersion in [xvExcel21,xvExcel30] then
    ShowMessage('Can not write Excel 2.1/3.0 files');
{$ifdef SHAREWARE}
  for i := 0 to Sheets.Count - 1 do
    FSheets[i].AsString[0,0] := 'XLSReadWriteII Copyright(c) 2004 Axolot Data';
{$endif}

  if Assigned(FProgressEvent) then begin
    FProgressEvent(Self,0);
    FCellCount := 0;
    FProgressCount := 0;
    for i := 0 to FSheets.Count - 1 do
      Inc(FCellCount,FSheets[i].Records.Count);
  end;

  SetCommonSheetData;
  FFormulaHandler.ExternalNames.UpdateIntSupbooks(FSheets.Count);

//  FMSOPictures.ResetBlipRefCount;
  for i := 0 to FSheets.Count - 1 do
    FSheets[i].EscherDrawing.SetBlipRefCount;

  XLSWrite := TXLSWriteII.Create(Self);
  try
    if FVersion > xvExcel40 then
      XLSWrite.WriteToStream(Stream)
    else
      XLSWrite.WriteToStream40(Stream);
  finally
    XLSWrite.Free;
  end;
  if Assigned(FProgressEvent) then
    FProgressEvent(Self,100);
end;

procedure TXLSReadWriteII2.AddNumberFormat(Format: string; Index: integer);
begin
  FFormats.NumberFormats.AddSorted(Format,Index,1);
end;

function TXLSReadWriteII2.MaxRowCount: integer;
begin
  Result := MAXROW;
end;

function TXLSReadWriteII2.GetNameValue(Index,Col,Row: integer): TFormulaValue;
var
  i: integer;
begin
  i := FFormulaHandler.ExternalNames.IsSelf(Index);
  if i = $FFFF then
    FVSetError(Result,errNA)
  else if i > FSheets.Count then
    raise Exception.Create('Sheet index out of range')
  else if i >= 0 then
    Result := FSheets[i].AsFormulaValue[Col,Row]
  else
    Result := FFormulaHandler.ExternalNames.GetValue(Index,Col,Row);
end;

function TXLSReadWriteII2.GetExternNameValue(NameIndex, SheetIndex: integer): TFormulaValue;
begin
  Result := FFormulaHandler.ExternalNames.GetNameValue(NameIndex,SheetIndex);
end;

procedure TXLSReadWriteII2.CopyCells(SrcSheet, Col1, Row1, Col2, Row2, DestSheet, DestCol, DestRow: integer; CopyOptions: TCopyCellsOptions);
var
  i,C,R: integer;
  RCSrc,RCDst: longword;
  Cell: TCell;
  Cells: TList;
begin
  if (SrcSheet = DestSheet) and (Col1 = DestCol) and (Row1 = DestRow) then
    Exit;
  NormalizeArea(Col1, Row1, Col2, Row2);
  Cells := TList.Create;
  try
    if ccoCopyValues in CopyOptions then begin
      if (Col1 = 0) and (Col2 = MAXCOL) and (Row1 = 0) and (Row2 = MAXROW) then begin
        FSheets[SrcSheet].StorageCells.BeginIterate;
        repeat
          Cell := FSheets[SrcSheet].StorageCells.GetNext;
          if Cell <> Nil then
            Cells.Add(Cell.MakeCopy);
        until (Cell = Nil);
      end
      else begin
        for R := Row1 to Row2 do begin
          for C := Col1 to Col2 do begin
            if FSheets[SrcSheet].StorageCells[ColRowToRC(C,R)] <> Nil then
              Cells.Add(FSheets[SrcSheet].StorageCells[ColRowToRC(C,R)].MakeCopy);
          end;
        end;
      end;

      RCSrc := ColRowToRC(Col1,Row1);
      RCDst := ColRowToRC(DestCol,DestRow);
      for i := 0 to Cells.Count - 1 do begin
        TCell(Cells[i]).RowCol := (TCell(Cells[i]).RowCol - RCSrc) + RCDst;
        FSheets[DestSheet].StorageCells.CellsNotChangeFmt[TCell(Cells[i]).RowCol] := Cells[i];
        if (ccoAdjustCells in CopyOptions) and (FSheets[DestSheet].StorageCells[TCell(Cells[i]).RowCol] is TFormulaCell) then
          AdjustCell(FVersion = xvExcel97,TFormulaCell(Cells[i]).PTGS,TFormulaCell(Cells[i]).Size,DestCol - Col1,DestRow - Row1,ccoLockStartRow in CopyOptions,ccoForceAdjust in CopyOptions);
      end;
    end;

    if DestSheet = SrcSheet then begin
      if ccoCopyShapes in CopyOptions then
        FSheets[DestSheet].EscherDrawing.Copy(Col1, Row1, Col2, Row2, DestCol, DestRow);
      if ccoCopyCondFmt in CopyOptions then
        FSheets[DestSheet].ConditionalFormats.CopyLocal(Col1, Row1, Col2, Row2, DestCol, DestRow);
      if ccoCopyValidations in CopyOptions then
        FSheets[DestSheet].Validations.CopyLocal(Col1, Row1, Col2, Row2, DestCol, DestRow);
      if ccoCopyMerged in CopyOptions then
        FSheets[DestSheet].MergedCells.Copy(Col1, Row1, Col2, Row2,DestCol - Col1,DestRow - Row1);
    end
    else begin
      if ccoCopyShapes in CopyOptions then begin
        Cells.Clear;
        FSheets[SrcSheet].EscherDrawing.CopyList(Cells,Col1, Row1, Col2, Row2);
        FSheets[DestSheet].EscherDrawing.InsertList(Cells,DestCol,DestRow);
      end;
      if ccoCopyCondFmt in CopyOptions then begin
        Cells.Clear;
        FSheets[SrcSheet].ConditionalFormats.CopyList(Cells,Col1, Row1, Col2, Row2);
        FSheets[DestSheet].ConditionalFormats.InsertList(Cells,Col1, Row1, Col2, Row2,DestCol,DestRow);
      end;
      if ccoCopyValidations in CopyOptions then begin
        Cells.Clear;
        FSheets[SrcSheet].Validations.CopyList(Cells,Col1, Row1, Col2, Row2);
        FSheets[DestSheet].Validations.InsertList(Cells,Col1, Row1, Col2, Row2,DestCol,DestRow);
      end;
      if ccoCopyMerged in CopyOptions then begin
        Cells.Clear;
        FSheets[SrcSheet].MergedCells.CopyList(Cells,Col1, Row1, Col2, Row2);
        FSheets[DestSheet].MergedCells.InsertList(Cells,Col1, Row1, Col2, Row2,DestCol,DestRow);
      end;
    end;
  finally
    Cells.Free;// c r e b
  end;
end;

procedure TXLSReadWriteII2.MoveCells(SrcSheet, Col1, Row1, Col2, Row2, DestSheet, DestCol, DestRow: integer; CopyOptions: TCopyCellsOptions);
var
  i,C,R: integer;
  RCSrc,RCDst: longword;
  Cell: TCell;
  Cells: TList;
begin
  if (SrcSheet = DestSheet) and (Col1 = DestCol) and (Row1 = DestRow) then
    Exit;
  NormalizeArea(Col1, Row1, Col2, Row2);
  Cells := TList.Create;
  try
    if ccoCopyValues in CopyOptions then begin
      if (Col1 = 0) and (Col2 = MAXCOL) and (Row1 = 0) and (Row2 = MAXROW) then begin
        FSheets[SrcSheet].StorageCells.BeginIterate;
        repeat
          Cell := FSheets[SrcSheet].StorageCells.GetNext;
          if Cell <> Nil then begin
            Cells.Add(Cell.MakeCopy);
            FSheets[SrcSheet].StorageCells.SetNil(Cell.RowCol);
          end;
        until (Cell = Nil);
      end
      else begin
        for R := Row1 to Row2 do begin
          for C := Col1 to Col2 do begin
            if FSheets[SrcSheet].StorageCells[ColRowToRC(C,R)] <> Nil then begin
              Cells.Add(FSheets[SrcSheet].StorageCells[ColRowToRC(C,R)].MakeCopy);
              FSheets[SrcSheet].StorageCells.SetNil(ColRowToRC(C,R));
            end;
          end;
        end;
      end;
      RCSrc := ColRowToRC(Col1,Row1);
      RCDst := ColRowToRC(DestCol,DestRow);
      for i := 0 to Cells.Count - 1 do begin
        TCell(Cells[i]).RowCol := (TCell(Cells[i]).RowCol - RCSrc) + RCDst;
        FSheets[DestSheet].StorageCells.CellsNotChangeFmt[TCell(Cells[i]).RowCol] := Cells[i];
        if (ccoAdjustCells in CopyOptions) and (FSheets[DestSheet].StorageCells[TCell(Cells[i]).RowCol] is TFormulaCell) then
          AdjustCell(FVersion = xvExcel97,TFormulaCell(Cells[i]).PTGS,TFormulaCell(Cells[i]).Size,DestCol - Col1,DestRow - Row1,ccoLockStartRow in CopyOptions,ccoForceAdjust in CopyOptions);
      end;
    end;
    // TODO: Can only move shapes on same sheet. distro by creb
    if DestSheet = SrcSheet then begin
      if ccoCopyShapes in CopyOptions then
        FSheets[DestSheet].EscherDrawing.Move(Col1, Row1, Col2, Row2, DestCol, DestRow);
      if ccoCopyCondFmt in CopyOptions then
        FSheets[DestSheet].ConditionalFormats.MoveLocal(Col1, Row1, Col2, Row2, DestCol, DestRow);
      if ccoCopyValidations in CopyOptions then
        FSheets[DestSheet].Validations.MoveLocal(Col1, Row1, Col2, Row2, DestCol, DestRow);
      if ccoCopyMerged in CopyOptions then
        FSheets[DestSheet].MergedCells.Move(Col1, Row1, Col2, Row2,DestCol - Col1,DestRow - Row1);
    end
    else begin
      if ccoCopyShapes in CopyOptions then begin
        Cells.Clear;
        FSheets[SrcSheet].EscherDrawing.CopyList(Cells,Col1, Row1, Col2, Row2);
        FSheets[DestSheet].EscherDrawing.InsertList(Cells,DestCol,DestRow);
        FSheets[SrcSheet].EscherDrawing.DeleteList(Cells);
      end;
      if ccoCopyCondFmt in CopyOptions then begin
        Cells.Clear;
        FSheets[SrcSheet].ConditionalFormats.CopyList(Cells,Col1, Row1, Col2, Row2);
        FSheets[DestSheet].ConditionalFormats.InsertList(Cells,Col1, Row1, Col2, Row2,DestCol,DestRow);
        FSheets[SrcSheet].ConditionalFormats.DeleteList(Cells,Col1, Row1, Col2, Row2);
      end;
      if ccoCopyValidations in CopyOptions then begin
        Cells.Clear;
        FSheets[SrcSheet].Validations.CopyList(Cells,Col1, Row1, Col2, Row2);
        FSheets[DestSheet].Validations.InsertList(Cells,Col1, Row1, Col2, Row2,DestCol,DestRow);
        FSheets[SrcSheet].Validations.DeleteList(Cells,Col1, Row1, Col2, Row2);
      end;
      if ccoCopyMerged in CopyOptions then begin
        Cells.Clear;
        FSheets[SrcSheet].MergedCells.CopyList(Cells,Col1, Row1, Col2, Row2);
        FSheets[DestSheet].MergedCells.InsertList(Cells,Col1, Row1, Col2, Row2,DestCol,DestRow);
        FSheets[SrcSheet].MergedCells.DeleteList(Cells,Col1, Row1, Col2, Row2);
      end;
    end;
  finally
    Cells.Free;
  end;
end;

procedure TXLSReadWriteII2.DeleteCells(Sheet, Col1, Row1, Col2, Row2: integer);
begin
  FSheets[Sheet].DeleteCells(Col1, Row1, Col2, Row2);
end;

function TXLSReadWriteII2.GetDEVMODE: PDeviceModeW;
var
  hDevMode,FPrinterHandle: THandle;
  P: PDeviceModeW;
  ADevice: PWideChar;
  StubDevMode: TDeviceModeW;
  sPrinter: string;
begin
  if Printer.PrinterIndex < 0 then
    FDevMode := Nil
  else if FDevMode = Nil then begin
    sPrinter := Printer.Printers[Printer.PrinterIndex];
    if OpenPrinter(PChar(sPrinter),FPrinterHandle, nil) then begin
      GetMem(ADevice,64);
      StringToWideChar(sPrinter,ADevice,64);
      hDevMode := GlobalAlloc(GHND,DocumentPropertiesW(0, FPrinterHandle, ADevice, StubDevMode, StubDevMode, 0));
      if hDevMode <> 0 then begin
        P := GlobalLock(hDevMode);
        if DocumentPropertiesW(0, FPrinterHandle, ADevice, P^, P^, DM_OUT_BUFFER) < 0 then
          FDevMode := Nil
        else begin
          GetMem(FDevMode,P.dmSize + P.dmDriverExtra);
          Move(P^,FDevMode^,P.dmSize + P.dmDriverExtra);
        end;
        GlobalUnlock(hDevMode);
        GlobalFree(hDevMode);
      end;
    end;
  end;
  Result := FDevMode;
end;

function TXLSReadWriteII2.HasDEVMODE: boolean;
begin
  Result := FDevMode <> Nil;
end;

function TXLSReadWriteII2.GetUserName: string;
begin
  Result := FRecords.WRITEACCESS;
end;