uxlssheet.pas

来自「DELPHI界面增强控件,非常好,里面有显示GIF的图片控件,更美观的下拉框控件」· PAS 代码 · 共 1,036 行 · 第 1/3 页

unit UXlsSheet;

interface
uses Classes, SysUtils, UXlsBaseRecords, UXlsBaseRecordLists, UXlsOtherRecords, UXlsChart,
     UXlsSST, XlsMessages, UXlsSections, UXlsCondFmt, UXlsRowColEntries, UXlsEscher,
     UXlsRangeRecords, UEscherRecords, UXlsWorkbookGlobals, UXlsNotes, UXlsBaseList,
     UFlxMessages, UXlsCellRecords, UXlsFormula, UXlsPageBreaks, UXlsColInfo;

type
  TSheet= class (TBaseSection)
  private
    function GetShowGridLines: boolean;
    procedure SetShowGridLines(const Value: boolean);
    function GetPrintGridLines: boolean;
    procedure SetPrintGridLines(const Value: boolean);
    function GetPageFooter: WideString;
    function GetPageHeader: WideString;
    procedure SetPageFooter(const Value: WideString);
    procedure SetPageHeader(const Value: WideString);
    function GetMargins: TXlsMargins;
    procedure SetMargins(const Value: TXlsMargins);
    procedure AddMargin(var Margin: TMarginRecord; const aId: integer; const Value: extended);
    function GetSheetZoom: integer;
    procedure SetSheetZoom(const Value: integer);
  protected
    FWorkbookGlobals: TWorkbookGlobals;
    FWindow2: TWindow2Record;
    FPageHeader: TPageHeaderRecord;
    FPageFooter: TPageFooterRecord;
    FPrintGridLines: TPrintGridLinesRecord;
    FLeftMargin, FRightMargin, FTopMargin, FBottomMargin: TMarginRecord;
    FSetup: TSetupRecord;
    FWSBool: TWSBoolRecord;
    FZoom: TSCLRecord;

    FPrintRecords: TBaseRecordList;

    function GetSelected: boolean;
    procedure SetSelected(const Value: boolean);
    procedure SetPageHeaderFooter(const P: TPageHeaderFooterRecord; const s: Widestring);virtual;abstract;
    procedure AddZoomRecord; virtual;abstract;
  public
    OriginalDimensions: TDimensionsRec;

    function CopyTo: TSheet; //This method can't be virtual
    function DoCopyTo: TSheet; virtual;
    procedure InsertAndCopyRows(const FirstRow, LastRow, DestRow, aCount: integer; const SheetInfo: TSheetInfo; const OnlyFormulas: boolean);virtual;abstract;
    procedure DeleteRows(const aRow, aCount: word;const SheetInfo: TSheetInfo);virtual; abstract;
    procedure ArrangeInsert(const InsPos, InsCount: integer ; const SheetInfo: TSheetInfo);virtual;abstract;
    procedure ArrangeCopySheet(const SheetInfo: TSheetInfo); virtual;

    procedure DeleteHPageBreak(const aRow: word);virtual;
    procedure DeleteVPageBreak(const aCol: word);virtual;
    procedure InsertHPageBreak(const aRow: word);virtual;
    procedure InsertVPageBreak(const aCol: word);virtual;

    constructor Create(const aWorkbookGlobals: TWorkbookGlobals);virtual;

    property Selected: boolean read GetSelected write SetSelected;
    property ShowGridLines: boolean read GetShowGridLines write SetShowGridLines;
    property PrintGridLines: boolean read GetPrintGridLines write SetPrintGridLines;

    property PageHeader: Widestring read GetPageHeader write SetPageHeader;
    property PageFooter: Widestring read GetPageFooter write SetPageFooter;
    property Margins: TXlsMargins read GetMargins write SetMargins; //Margins are in inches

    property SheetZoom: integer read GetSheetZoom write SetSheetZoom;

  end;

  ClassOfTSheet= class of TSheet;

  TChart = class (TSheet)
  private
    FChartRecords: TChartRecordList;
  protected
    procedure SetPageHeaderFooter(const P: TPageHeaderFooterRecord; const s: Widestring);override;
    procedure AddZoomRecord; override;

  public

    constructor Create(const aWorkbookGlobals: TWorkbookGlobals);override;
    destructor Destroy;override;
    function DoCopyTo: TSheet; override;

    function TotalSize:int64; override;
    function TotalRangeSize(const SheetIndex: integer; const CellRange: TXlsCellRange):int64; override;
    procedure LoadFromStream( const DataStream: TStream; const First: TBOFRecord; const SST: TSST);override;
    procedure SaveToStream(const DataStream: TStream);override;
    procedure SaveRangeToStream(const DataStream: TStream; const SheetIndex: integer; const CellRange: TXlsCellRange);override;
    procedure Clear; override;
    procedure ArrangeCopyRows(const RowOffset: integer);
    procedure ArrangeCopySheet(const SheetInfo: TSheetInfo);override;
    procedure ArrangeInsert(const InsPos, InsCount: integer; const SheetInfo: TSheetInfo);override;
    procedure InsertAndCopyRows(const FirstRow, LastRow, DestRow, aCount: integer; const SheetInfo: TSheetInfo; const OnlyFormulas: boolean);override;
    procedure DeleteRows(const aRow, aCount: word; const SheetInfo: TSheetInfo);override;

  end;

  TChartList = class(TBaseList) //records are TChart
    {$INCLUDE TChartListHdr.inc}
    procedure SaveToStream(const DataStream: TStream);
    procedure ArrangeInsert(const InsPos, InsCount: integer; const SheetInfo: TSheetInfo);
  end;


  TWorkSheet = class (TSheet)
  private
    FMiscRecords1: TBaseRecordList;
    FMiscRecords2: TBaseRecordList;
    FHPageBreaks: THPageBreakList;
    FVPageBreaks: TVPageBreakList;
    FDrawing: TDrawing;
    FCells: TCells;
    FRanges: TRangeList;
    FNotes: TNoteList;
    FColumns: TColInfoList;

    FDefRowHeight: Longint;
    FDefColWidth:  integer;

    function GetDrawingRow(index: integer): integer;
    function GetDrawingName(index: integer): widestring;
    function GetPrintNumberOfHorizontalPages: word;
    function GetPrintNumberOfVerticalPages: word;
    function GetPrintScale: integer;
    function GetPrintToFit: boolean;
    procedure SetPrintNumberOfHorizontalPages(const Value: word);
    procedure SetPrintNumberOfVerticalPages(const Value: word);
    procedure SetPrintScale(const Value: integer);
    procedure SetPrintToFit(const Value: boolean);
  protected
    procedure AddZoomRecord; override;
    procedure SetPageHeaderFooter(const P: TPageHeaderFooterRecord; const s: Widestring);override;
  public
    constructor Create(const aWorkbookGlobals: TWorkbookGlobals);override;
    destructor Destroy;override;
    function DoCopyTo: TSheet; override;

    function TotalSize:int64; override;
    function TotalRangeSize(const SheetIndex: integer; const CellRange: TXlsCellRange): int64;override;
    procedure LoadFromStream( const DataStream: TStream; const First: TBOFRecord; const SST: TSST);override;
    procedure SaveToStream(const DataStream: TStream);override;
    procedure SaveRangeToStream(const DataStream: TStream; const SheetIndex: integer; const CellRange: TXlsCellRange);override;
    procedure Clear; override;

    procedure InsertAndCopyRows(const FirstRow, LastRow, DestRow, aCount: integer; const SheetInfo: TSheetInfo; const OnlyFormulas: boolean);override;
    procedure DeleteRows(const aRow, aCount: word; const SheetInfo: TSheetInfo);override;

    procedure ArrangeInsert(const InsPos, InsCount: integer; const SheetInfo: TSheetInfo);override;
    procedure ArrangeCopySheet(const SheetInfo: TSheetInfo); override;

    property Notes: TNoteList read FNotes;
    property Cells: TCells read FCells;

    function DrawingCount: integer;
    procedure AssignDrawing(const Index: integer; const Data: string; const DataType: TXlsImgTypes);
    procedure GetDrawingFromStream(const Index: integer; const Data: TStream; var DataType: TXlsImgTypes);
    property DrawingRow[index: integer]: integer read GetDrawingRow;
    property DrawingName[index: integer]: widestring read GetDrawingName;
    function GetAnchor(const Index: integer): TClientAnchor;

    procedure DeleteImage(const Index: integer);
    procedure ClearImage(const Index: integer);
    procedure AddImage(const Data: string; const DataType: TXlsImgTypes; const Properties: TImageProperties;const Anchor: TFlxAnchorType);

    procedure AddNewComment(const Row, Col: integer; const Txt: widestring; const Properties: TImageProperties);

    procedure DeleteHPageBreak(const aRow: word);override;
    procedure DeleteVPageBreak(const aCol: word);override;
    procedure InsertHPageBreak(const aRow: word);override;
    procedure InsertVPageBreak(const aCol: word);override;

    function GetRowHeight(const aRow: integer): integer;
    function GetColWidth(const aCol: Word): integer;
    procedure SetRowHeight(const aRow: integer; const Value: integer);
    procedure SetColWidth(const aCol: Word; const Value: integer);

    property DefRowHeight: Longint read FDefRowHeight;
    property DefColWidth:  integer read FDefColWidth;

    function GetRowFormat(const aRow: integer): integer;
    function GetColFormat(const aCol: integer): integer;
    procedure SetRowFormat(const aRow: integer; const Value: integer);
    procedure SetColFormat(const aCol: integer; const Value: integer);

    function CellMergedBounds(const aRow, aCol: integer): TXlsCellRange;
    procedure MergeCells(aRow1, aCol1, aRow2, aCol2: integer);

    function HasHPageBreak(const Row: integer): boolean;
    function HasVPageBreak(const Col: integer): boolean;

    property PrintToFit: boolean read GetPrintToFit write SetPrintToFit;
    property PrintScale: integer read GetPrintScale write SetPrintScale;
    property PrintNumberOfHorizontalPages: word read GetPrintNumberOfHorizontalPages write SetPrintNumberOfHorizontalPages;
    property PrintNumberOfVerticalPages: word read GetPrintNumberOfVerticalPages write SetPrintNumberOfVerticalPages;
  end;

implementation
{$INCLUDE TChartListImp.inc}

{ TSheet }

function TSheet.CopyTo: TSheet;
begin
  if Self= nil then Result:=nil else Result:= DoCopyTo;
end;

constructor TSheet.Create(const aWorkbookGlobals: TWorkbookGlobals);
begin
  FWorkbookGlobals:=aWorkbookGlobals;
end;

function TSheet.DoCopyTo: TSheet;
begin
  Result:= ClassOfTSheet(ClassType).Create(FWorkbookGlobals);
  Result.BOF:= BOF.CopyTo as TBOFRecord;
  Result.EOF:= EOF.CopyTo as TEOFRecord;
end;

function TSheet.GetSelected: boolean;
begin
  if (FWindow2<>nil) then Result:=FWindow2.Selected else Result:=false;
end;

procedure TSheet.SetSelected(const Value: boolean);
begin
  if (FWindow2<>nil) then FWindow2.Selected:=value;
end;

procedure TSheet.DeleteHPageBreak(const aRow: word);
begin
  //Nothing in TSheet
end;

procedure TSheet.DeleteVPageBreak(const aCol: word);
begin
  //Nothing in TSheet
end;

procedure TSheet.InsertHPageBreak(const aRow: word);
begin
  //Nothing in TSheet
end;

procedure TSheet.InsertVPageBreak(const aCol: word);
begin
  //Nothing in TSheet
end;

procedure TSheet.ArrangeCopySheet(const SheetInfo: TSheetInfo);
begin
  //Nothing in TSheet
end;

function TSheet.GetShowGridLines: boolean;
begin
  if (FWindow2<>nil) then Result:=FWindow2.ShowGridLines else Result:=true;
end;

procedure TSheet.SetShowGridLines(const Value: boolean);
begin
  if (FWindow2<>nil) then FWindow2.ShowGridLines:=value;
end;

function TSheet.GetPrintGridLines: boolean;
begin
  if (FPrintGridLines<>nil) then Result:=FPrintGridLines.Value else Result:=true;
end;

procedure TSheet.SetPrintGridLines(const Value: boolean);
begin
  if (FPrintGridLines<>nil) then FPrintGridLines.Value:=value;
end;

function TSheet.GetPageFooter: WideString;
begin
  if (FPageFooter<>nil) then Result:=FPageFooter.Text else Result:='';
end;

function TSheet.GetPageHeader: WideString;
begin
  if (FPageHeader<>nil) then Result:=FPageHeader.Text else Result:='';
end;

procedure TSheet.SetPageFooter(const Value: WideString);
begin
  SetPageHeaderFooter(FPageFooter, Value);
end;

procedure TSheet.SetPageHeader(const Value: WideString);
begin
  SetPageHeaderFooter(FPageHeader, Value);
end;

function TSheet.GetMargins: TXlsMargins;
begin
  FillChar(Result, SizeOf(Result), 0);
  if FLeftMargin<>nil then Result.Left:=FLeftMargin.Value;
  if FRightMargin<>nil then Result.Right:=FRightMargin.Value;
  if FTopMargin<>nil then Result.Top:=FTopMargin.Value;
  if FBottomMargin<>nil then Result.Bottom:=FBottomMargin.Value;

  if FSetup<> nil then
  begin
    Result.Header:= FSetup.HeaderMargin;
    Result.Footer:= FSetup.FooterMargin;
  end;

end;

procedure TSheet.SetMargins(const Value: TXlsMargins);
begin
  if FLeftMargin=nil then AddMargin(FLeftMargin, xlr_LEFTMARGIN, Value.Left) else FLeftMargin.Value:=Value.Left;
  if FRightMargin=nil then AddMargin(FRightMargin, xlr_RIGHTMARGIN, Value.Right) else FRightMargin.Value:=Value.Right;
  if FTopMargin=nil then AddMargin(FTopMargin, xlr_TOPMARGIN, Value.Top) else FTopMargin.Value:=Value.Top;
  if FBottomMargin=nil then AddMargin(FBottomMargin, xlr_BOTTOMMARGIN, Value.Bottom) else FBottomMargin.Value:=Value.Bottom;

  if FSetup<> nil then
  begin
    FSetup.HeaderMargin:=Value.Header;
    FSetup.FooterMargin:=Value.Footer;
  end;

end;

procedure TSheet.AddMargin(var Margin: TMarginRecord; const aId: integer;
  const Value: extended);
const
  DataSize=SizeOf(Double);
var
  Data: PArrayOfByte;
  i,k, RId: integer;
begin
  //Search for the best position...
  k:=FPrintRecords.Count-1;
  for i:=FPrintRecords.Count-1 downto 0 do
  begin
    RId:=(FPrintRecords[i] as TBaseRecord).Id;
    if (RId=xlr_LEFTMARGIN) or(RId=xlr_RIGHTMARGIN)
       or(RId=xlr_TOPMARGIN) or(RId=xlr_BOTTOMMARGIN)
       or (RId=xlr_VCENTER)or (RId=xlr_DEFAULTROWHEIGHT)then
    begin
      k:=i;
      break;
    end;