uxlssheet.pas
来自「DELPHI界面增强控件,非常好,里面有显示GIF的图片控件,更美观的下拉框控件」· PAS 代码 · 共 1,036 行 · 第 1/3 页
PAS
1,036 行
begin
if (BOF=nil)or(EOF=nil) then raise Exception.Create(ErrSectionNotLoaded);
BOF.SaveToStream(DataStream);
FMiscRecords1.SaveToStream(DataStream);
FHPageBreaks.SaveRangeToStream(DataStream, CellRange);
FVPageBreaks.SaveRangeToStream(DataStream, CellRange);
FColumns.SaveRangeToStream(DataStream, CellRange);
FCells.SaveRangeToStream(DataStream, CellRange);
//Excel doesnt save drawings to the clipboard
//FDrawing.SaveToStream(DataStream);
FNotes.SaveRangeToStream(DataStream, CellRange);
FMiscRecords2.SaveToStream(DataStream);
FRanges.SaveRangeToStream(DataStream, CellRange);
EOF.SaveToStream(DataStream);
end;
procedure TWorkSheet.InsertAndCopyRows(const FirstRow, LastRow, DestRow, aCount: integer; const SheetInfo: TSheetInfo; const OnlyFormulas: boolean);
begin
FCells.InsertAndCopyRows(FirstRow, LastRow, DestRow, aCount, SheetInfo, OnlyFormulas);
FDrawing.InsertAndCopyRows(FirstRow, LastRow, DestRow, aCount, SheetInfo);
FRanges.InsertAndCopyRows(FirstRow, LastRow, DestRow, aCount, SheetInfo);
FNotes.InsertAndCopyRows(FirstRow, LastRow, DestRow, aCount, SheetInfo, false);
FHPageBreaks.InsertRows(DestRow, aCount);
end;
procedure TWorkSheet.DeleteRows(const aRow, aCount: word; const SheetInfo: TSheetInfo);
begin
FCells.DeleteRows(aRow, aCount, SheetInfo);
FDrawing.DeleteRows(aRow, aCount, SheetInfo);
FRanges.DeleteRows(aRow, aCount, SheetInfo);
FNotes.DeleteRows(aRow, aCount, SheetInfo);
FHPageBreaks.DeleteRows(aRow, aCount);
end;
procedure TWorkSheet.ArrangeInsert(const InsPos, InsCount: integer; const SheetInfo: TSheetInfo);
begin
//PENDING: Optimize this
FCells.ArrangeInsert(InsPos, InsCount, SheetInfo);
FDrawing.ArrangeInsert(InsPos, InsCount, SheetInfo);
end;
procedure TWorkSheet.AssignDrawing(const Index: integer; const Data: string;
const DataType: TXlsImgTypes);
begin
FDrawing.AssignDrawing( Index, Data, DataType);
end;
procedure TWorkSheet.GetDrawingFromStream(const Index: integer; const Data: TStream;
var DataType: TXlsImgTypes);
begin
FDrawing.GetDrawingFromStream( Index, Data, DataType);
end;
function TWorkSheet.DrawingCount: integer;
begin
Result:= FDrawing.DrawingCount;
end;
function TWorkSheet.GetDrawingRow(index: integer): integer;
begin
Result:= FDrawing.DrawingRow[index];
end;
function TWorkSheet.GetDrawingName(index: integer): widestring;
begin
Result:= FDrawing.DrawingName[index];
end;
procedure TWorkSheet.DeleteHPageBreak(const aRow: word);
begin
inherited;
FHPageBreaks.DeleteBreak(aRow);
end;
procedure TWorkSheet.DeleteVPageBreak(const aCol: word);
begin
inherited;
FVPageBreaks.DeleteBreak(aCol);
end;
procedure TWorkSheet.InsertHPageBreak(const aRow: word);
begin
inherited;
FHPageBreaks.AddBreak(aRow);
end;
procedure TWorkSheet.InsertVPageBreak(const aCol: word);
begin
inherited;
FVPageBreaks.AddBreak(aCol);
end;
procedure TWorkSheet.ArrangeCopySheet(const SheetInfo: TSheetInfo);
begin
inherited;
FDrawing.ArrangeCopySheet(SheetInfo);
end;
function TWorkSheet.GetColWidth(const aCol: Word): integer;
var
index: integer;
begin
if not FColumns.Find(aCol, Index) then Result:=DefColWidth else Result:=FColumns[Index].Width;
end;
function TWorkSheet.GetRowHeight(const aRow: integer): integer;
begin
if not FCells.RowList.HasRow(aRow) then Result:=DefRowHeight else
Result:= FCells.RowList.RowHeight(aRow);
end;
procedure TWorkSheet.SetColWidth(const aCol: Word; const Value: integer);
var
Index: integer;
begin
if FColumns.Find(aCol, Index) then
FColumns[Index].Width:=Value
else
FColumns.Insert(Index, TColInfo.Create(aCol, Value, 0, 0));
end;
procedure TWorkSheet.SetRowHeight(const aRow, Value: integer);
begin
FCells.RowList.SetRowHeight(aRow, Value);
end;
function TWorkSheet.GetColFormat(const aCol: integer): integer;
var
index: integer;
begin
if not FColumns.Find(aCol, Index) then Result:=-1 else Result:=FColumns[Index].XF;
end;
function TWorkSheet.GetRowFormat(const aRow: integer): integer;
begin
if not FCells.RowList.HasRow(aRow) or not FCells.RowList[aRow].IsFormatted then Result:=-1 else
Result:= FCells.RowList[aRow].XF;
end;
procedure TWorkSheet.SetColFormat(const aCol: integer; const Value: integer);
var
Index: integer;
i: integer;
begin
if FColumns.Find(aCol, Index) then
FColumns[Index].XF:=Value
else
FColumns.Insert(Index, TColInfo.Create(aCol, DefColWidth, Value, 0));
//Reset all cells in column to format XF
for i:=0 to FCells.CellList.Count-1 do
if FCells.CellList[i].Find(aCol, Index) then FCells.CellList[i][Index].XF:=Value;
end;
procedure TWorkSheet.SetRowFormat(const aRow, Value: integer);
var
i: integer;
begin
FCells.RowList.AddRow(aRow);
FCells.RowList[aRow].XF:= Value;
//Reset all cells in column to format XF
if(aRow>=0) and (aRow<FCells.CellList.Count) then
for i:=0 to FCells.CellList[aRow].Count-1 do FCells.CellList[aRow][i].XF:=Value;
end;
function TWorkSheet.GetAnchor(const Index: integer): TClientAnchor;
begin
Result:= FDrawing.GetAnchor(Index);
end;
function TWorkSheet.CellMergedBounds(const aRow, aCol: integer): TXlsCellRange;
var
i: integer;
begin
//Find the cell into the MergedCells array
Result.Left:=aCol;
Result.Right:=aCol;
Result.Top:=aRow;
Result.Bottom:=aRow;
for i:=0 to FRanges.Count-1 do
if FRanges[i] is TMergedCells then
if (FRanges[i] as TMergedCells).CheckCell(aRow, aCol, Result) then exit;
end;
procedure TWorkSheet.MergeCells(aRow1, aCol1, aRow2, aCol2: integer);
var
x: integer;
Mc: TMergedCells;
i: integer;
bRow1, bCol1, bRow2, bCol2: integer;
begin
if aRow1>aRow2 then begin x:=aRow2;aRow2:=aRow1; aRow1:=x;end;
if aCol1>aCol2 then begin x:=aCol2;aCol2:=aCol1; aCol1:=x;end;
//We have to take all existing included merged cells
Mc:=nil;
repeat
bRow1:=aRow1; bRow2:=aRow2; bCol1:=aCol1; bCol2:=aCol2;
for i:=0 to FRanges.Count-1 do
if FRanges[i] is TMergedCells then
begin
Mc:=(FRanges[i] as TMergedCells);
Mc.PreMerge(aRow1, aCol1, aRow2, aCol2)
end;
until (aRow1=bRow1) and (aRow2=bRow2) and (aCol1=bCol1) and (aCol2=bCol2);
if Mc=nil then Mc:=FRanges[FRanges.Add(TMergedCells.Create)] as TMergedCells;
Mc.MergeCells(aRow1, aCol1, aRow2, aCol2);
end;
function TWorkSheet.TotalRangeSize(const SheetIndex: integer; const CellRange: TXlsCellRange): int64;
begin
Result:= inherited TotalRangeSize(SheetIndex, CellRange)+
FMiscRecords1.TotalSize +
FHPageBreaks.TotalRangeSize(CellRange) +
FVPageBreaks.TotalRangeSize(CellRange) +
FCells.TotalRangeSize(CellRange)+
FRanges.TotalRangeSize(CellRange) +
FDrawing.TotalSize +
FMiscRecords2.TotalSize+
FNotes.TotalRangeSize(CellRange)+
FColumns.TotalRangeSize(CellRange);
end;
function TWorkSheet.TotalSize: int64;
begin
Result:= inherited TotalSize+
FMiscRecords1.TotalSize +
FHPageBreaks.TotalSize +
FVPageBreaks.TotalSize +
FCells.TotalSize +
FRanges.TotalSize +
FDrawing.TotalSize +
FMiscRecords2.TotalSize+
FNotes.TotalSize+
FColumns.TotalSize;
end;
procedure TWorkSheet.SetPageHeaderFooter(const P: TPageHeaderFooterRecord;
const s: Widestring);
var
OldSize: integer;
begin
if P=nil then exit;
OldSize:=P.DataSize;
P.Text:=s;
FMiscRecords1.AdaptSize(P.DataSize-OldSize);
end;
function TWorkSheet.HasHPageBreak(const Row: integer): boolean;
begin
Result:=FHPageBreaks.HasPageBreak(Row);
end;
function TWorkSheet.HasVPageBreak(const Col: integer): boolean;
begin
Result:=FVPageBreaks.HasPageBreak(Col);
end;
function TWorkSheet.GetPrintNumberOfHorizontalPages: word;
begin
if FSetup= nil then Result:=1 else
Result:= FSetup.FitWidth;
end;
function TWorkSheet.GetPrintNumberOfVerticalPages: word;
begin
if FSetup= nil then Result:=1 else
Result:= FSetup.FitHeight;
end;
function TWorkSheet.GetPrintScale: integer;
begin
if FSetup= nil then Result:=100 else
Result:= FSetup.Scale;
end;
function TWorkSheet.GetPrintToFit: boolean;
begin
if FWsBool= nil then Result:=false else
Result:= FWsBool.FitToPage;
end;
procedure TWorkSheet.SetPrintNumberOfHorizontalPages(const Value: word);
begin
if FSetup<>nil then FSetup.FitWidth:=Value;
end;
procedure TWorkSheet.SetPrintNumberOfVerticalPages(const Value: word);
begin
if FSetup<>nil then FSetup.FitHeight:=Value;
end;
procedure TWorkSheet.SetPrintScale(const Value: integer);
begin
if (Value<Low(Word))or (Value>High(Word)) then
raise Exception.CreateFmt(ErrXlsIndexOutBounds, [Value, 'PrintScale', Low(Word), High(Word)]);
if FSetup<>nil then FSetup.Scale:=Value;
end;
procedure TWorkSheet.SetPrintToFit(const Value: boolean);
begin
if FWSBool<>nil then FWsBool.FitToPage:=value;
end;
procedure TWorkSheet.AddImage(const Data: string; const DataType: TXlsImgTypes; const Properties: TImageProperties;const Anchor: TFlxAnchorType);
begin
FDrawing.AddImage(Data, DataType, Properties, Anchor);
end;
procedure TWorkSheet.ClearImage(const Index: integer);
begin
FDrawing.ClearImage(Index);
end;
procedure TWorkSheet.DeleteImage(const Index: integer);
begin
FDrawing.DeleteImage(Index);
end;
procedure TWorkSheet.AddZoomRecord;
begin
if FMiscRecords2.Count>1 then
begin
FMiscRecords2.Insert(1,TSCLRecord.CreateFromData(100));
FZoom:=FMiscRecords2[1] as TSCLRecord;
end;
end;
procedure TWorkSheet.AddNewComment(const Row, Col: integer;
const Txt: widestring; const Properties: TImageProperties);
begin
FNotes.AddNewComment(Row, Col, Txt, FDrawing, Properties);
end;
end.
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?