📄 cellformats2.pas
字号:
unit CellFormats2;
{
********************************************************************************
******* XLSReadWriteII V2.00 *******
******* *******
******* Copyright(C) 1999,2004 Lars Arvidsson, Axolot Data *******
******* *******
******* email: components@axolot.com *******
******* URL: http://www.axolot.com *******
********************************************************************************
** Users of the XLSReadWriteII component must accept the following **
** disclaimer of warranty: **
** **
** XLSReadWriteII is supplied as is. The author disclaims all warranties, **
** expressedor implied, including, without limitation, the warranties of **
** merchantability and of fitness for any purpose. The author assumes no **
** liability for damages, direct or consequential, which may result from the **
** use of XLSReadWriteII. **
********************************************************************************
}
{$B-}
interface
uses SysUtils, Classes, Graphics, BIFFRecsII2, ExcelMaskII2, Dialogs, XLSFonts2,
XLSRWIIResourceStrings2, XLSUtils2, ContNrs;
const ExcelStandardNumFormats: array[0..49] of WideString = (
{00} '',
{01} '0',
{02} '0.00',
{03} '#,##0',
{04} '#,##0.00',
{05} '_($#,##0_);($#,##0)',
{06} '_($#,##0_);[Red]($#,##0)',
{07} '_($#,##0.00_);($#,##0.00)',
{08} '_($#,##0.00_);[Red]($#,##0.00)',
{09} '0%',
{0A} '0.00%',
{0B} '0.00E+00',
{0C} '# ?/?',
{0D} '# ??/??',
{0E} 'm/d/yy', // Localized date format in Excel.
{0F} 'd-mmm-y',
{10} 'd-mmm',
{11} 'mmmm-yy',
{12} 'h:mm AM/PM',
{13} 'h:mm:ss AM/PM',
{14} 'h:mm', // Localized time format in Excel.
{15} 'h:mm:SS',
{16} 'm/d/yy h:mm',
{17} // Format $17 - $24 are undocumented.
{18} '',
{19} '',
{1A} '',
{1B} '',
{1C} '',
{1D} '',
{1E} '',
{1F} '',
{20} '',
{21} '',
{22} '',
{23} '',
{24} '',
{25} '',
{26} '#,##0_);(#,##0)',
{27} '#,##0_);[Red](#,##0)',
{28} '#,##0.00_);(#,##0.00)',
{29} '#,##0.00_);[Red](#,##0.00)',
{2A} '_(* #,##0_);_(* (#,##0);_(* "-"_);_(@_)',
{2B} '_($* #,##0_);_($* (#,##0);_($* "-"_);_(@_)',
{2C} '_(* #,##0.00_);_(* (#,##0.00);_(* "-"??_);_(@_)',
{2D} '_($* #,##0.00_);_($* (#,##0.00);_($* "-"??_);_(@_)',
{2E} 'mm:ss',
{2F} '[h]:mm:ss',
{30} 'mm:ss.0',
{31} '# #0.0E+0',
{32} '@');
const NUMFORMAT_DATE = 14;
const NUMFORMAT_TIME = 20;
type
//: Protection of cells.
//: cpLocked = Cell is locked. This does not mean that the cell value not can be
//: change. To prevent the cell from being changed, the worksheet has to be locked.
//: cpHidden = Cell value is hidden.
TCellProtection = (cpLocked,cpHidden);
TCellProtections = set of TCellProtection;
type
//: Horizontal = alignment of text in cells. <br>
//: chaGeneral = No alignment. <br>
//: chaLeft = Left alignment <br>
//: chaCenter = Center alignment. <br>
//: chaRight = Right alignment <br>
//: chaFill= Fill's the entire cell with the text or character. Like: 'XXXXXXXXXX'. <br>
//: chaJustify = Justify's the word space to fit the text in the cell. <br>
//: chaCenterAcross = Don't know what this is. <br>
TCellHorizAlignment = (chaGeneral,chaLeft,chaCenter,chaRight,chaFill,chaJustify,chaCenterAcross);
//: Horizontal alignment of text in cells.
//: cvaTop = Top alignment. <br>
//: cvaCenter = Center alignment. <br>
//: cvaBottom = Bottom alignment <br>
//: cvaJustify = Justify's the line space to fit the text in the cell. <br>
type TCellVertAlignment = (cvaTop,cvaCenter,cvaBottom,cvaJustify);
type TCellBorderStyle = (cbsNone,cbsThin,cbsMedium,cbsDashed,cbsDotted,cbsThick,
cbsDouble,cbsHair,cbsMediumDashed,cbsDashDot,cbsMediumDashDot,
cbsDashDotDot,cbsMediumDashDotDot,cbsSlantedDashDot);
type TDiagLines = (dlNone,dlDown,dlUp,dlBoth);
type
//:# Cell format options.
//: foWrapText = Wrap text in cells.
//: foShrinkToFit = Shrink text to fit horizontal cell space. The result is
//: that the font size is changed so the text fit's the cell's horizontal size.
TFormatOption = (foWrapText,foShrinkToFit);
TFormatOptions = set of TFormatOption;
type TCellFormats = class;
TCellFormat = class(TObject)
private
FParent: TCellFormats;
FIndex: integer;
FUsageCount: integer;
FXF: TRecXF8;
procedure SetIndent(const Value: byte);
procedure SetRotation(const Value: smallint);
function GetRotation: smallint;
function GetFormatOptions: TFormatOptions;
function GetHorizAlignment: TCellHorizAlignment;
function GetIndent: byte;
function GetProtection: TCellProtections;
function GetVertAlignment: TCellVertAlignment;
procedure SetFFormatOptions(const Value: TFormatOptions);
procedure SetHorizAlignment(const Value: TCellHorizAlignment);
procedure SetProtection(const Value: TCellProtections);
procedure SetVertAlignment(const Value: TCellVertAlignment);
function GetMerged: boolean;
procedure SetMerged(const Value: boolean);
function GetBorderBottomColor: TExcelColor;
function GetBorderBottomStyle: TCellBorderStyle;
function GetBorderDiagColor: TExcelColor;
function GetBorderDiagLines: TDiagLines;
function GetBorderDiagStyle: TCellBorderStyle;
function GetBorderLeftColor: TExcelColor;
function GetBorderLeftStyle: TCellBorderStyle;
function GetBorderRightColor: TExcelColor;
function GetBorderRightStyle: TCellBorderStyle;
function GetBorderTopColor: TExcelColor;
function GetBorderTopStyle: TCellBorderStyle;
function GetFillPatternBackColor: TExcelColor;
function GetFillPatternForeColor: TExcelColor;
function GetFillPatternPattern: TExcelFillPattern;
procedure SetBorderBottomColor(const Value: TExcelColor);
procedure SetBorderBottomStyle(const Value: TCellBorderStyle);
procedure SetBorderDiagColor(const Value: TExcelColor);
procedure SetBorderDiagLines(const Value: TDiagLines);
procedure SetBorderDiagStyle(const Value: TCellBorderStyle);
procedure SetBorderLeftColor(const Value: TExcelColor);
procedure SetBorderLeftStyle(const Value: TCellBorderStyle);
procedure SetBorderRightColor(const Value: TExcelColor);
procedure SetBorderRightStyle(const Value: TCellBorderStyle);
procedure SetBorderTopColor(const Value: TExcelColor);
procedure SetBorderTopStyle(const Value: TCellBorderStyle);
procedure SetFillPatternBackColor(const Value: TExcelColor);
procedure SetFillPatternForeColor(const Value: TExcelColor);
procedure SetFillPatternPattern(const Value: TExcelFillPattern);
// procedure OnFontChanged(NewIndex: word);
function GetXFont: TXFont;
protected
function GetNumberFormat: WideString;
procedure SetNumberFormat(Value: WideString);
public
constructor Create(Parent: TCellFormats); overload;
constructor Create(Parent: TCellFormats; FormatIndex: word); overload;
destructor Destroy; override;
procedure Assign(Source: TCellFormat); overload;
function FormatIsDateTime: boolean;
function Equal(F: TCellFormat): boolean;
// **********************************************
// *********** For internal use only. ***********
// **********************************************
procedure FromXF8(P: PByteArray);
procedure FromXF7(P: PByteArray);
procedure FromXF4(P: PByteArray);
procedure ToXF8(var P: PByteArray);
procedure ToXF7(var P: PByteArray);
procedure ToXF4(var P: PByteArray);
property Merged: boolean read GetMerged write SetMerged;
property NumberFormatIndex: word read FXF.NumFmtIndex;
property UsageCount: integer read FUsageCount write FUsageCount;
// **********************************************
// *********** End internal use only. ***********
// **********************************************
property Index: integer read FIndex;
property XFont: TXFont read GetXFont;
property FontIndex: word read FXF.FontIndex write FXF.FontIndex;
property Protection: TCellProtections read GetProtection write SetProtection;
property HorizAlignment: TCellHorizAlignment read GetHorizAlignment write SetHorizAlignment;
property VertAlignment: TCellVertAlignment read GetVertAlignment write SetVertAlignment;
property Indent: byte read GetIndent write SetIndent;
property Rotation: smallint read GetRotation write SetRotation;
property FormatOptions: TFormatOptions read GetFormatOptions write SetFFormatOptions;
property FillPatternForeColor: TExcelColor read GetFillPatternForeColor write SetFillPatternForeColor;
property FillPatternBackColor: TExcelColor read GetFillPatternBackColor write SetFillPatternBackColor;
property FillPatternPattern: TExcelFillPattern read GetFillPatternPattern write SetFillPatternPattern;
property NumberFormat: WideString read GetNumberFormat write SetNumberFormat;
// property Font: TXFont read FFont write SetFont;
property BorderTopColor: TExcelColor read GetBorderTopColor write SetBorderTopColor;
property BorderTopStyle: TCellBorderStyle read GetBorderTopStyle write SetBorderTopStyle;
property BorderLeftColor: TExcelColor read GetBorderLeftColor write SetBorderLeftColor;
property BorderLeftStyle: TCellBorderStyle read GetBorderLeftStyle write SetBorderLeftStyle;
property BorderRightColor: TExcelColor read GetBorderRightColor write SetBorderRightColor;
property BorderRightStyle: TCellBorderStyle read GetBorderRightStyle write SetBorderRightStyle;
property BorderBottomColor: TExcelColor read GetBorderBottomColor write SetBorderBottomColor;
property BorderBottomStyle: TCellBorderStyle read GetBorderBottomStyle write SetBorderBottomStyle;
property BorderDiagColor: TExcelColor read GetBorderDiagColor write SetBorderDiagColor;
property BorderDiagStyle: TCellBorderStyle read GetBorderDiagStyle write SetBorderDiagStyle;
property BorderDiagLines: TDiagLines read GetBorderDiagLines write SetBorderDiagLines;
end;
TNumberFormat = class(TObject)
private
FHash: word;
FValue: WideString;
FIndexId: integer;
// A negative FUsageCount means that the number format is internal, and
// not can be deleted.
FUsageCount: integer;
public
procedure CreateHash;
function IsDefault: boolean;
property Value: WideString read FValue write FValue;
property IndexId: integer read FIndexId write FIndexId;
property UsageCount: integer read FUsageCount write FUsageCount;
end;
TNumberFormats = class(TObjectList)
private
FCurrentId: integer;
// procedure Sort;
function Find(IndexId: integer): integer;
function FindValue(Value: WideString): integer;
function GetItems(IndexId: integer): TNumberFormat;
function GetItemsByIndex(Index: integer): TNumberFormat;
procedure SetItemsByIndex(Index: integer; const Value: TNumberFormat);
public
constructor Create;
destructor Destroy; override;
function Add(Value: WideString): TNumberFormat;
// Only used when reading files.
function AddSorted(Value: WideString; IndexId,UsageCount: integer): TNumberFormat;
procedure DeleteById(IndexId: integer);
procedure IncUsageById(IndexId: integer);
procedure SetDefault;
property Items[IndexId: integer]: TNumberFormat read GetItems; // default;
property ItemsByIndex[Index: integer]: TNumberFormat read GetItemsByIndex write SetItemsByIndex;
end;
TCellFormats = class(TObjectList)
private
function GetItems(Index: integer): TCellFormat;
protected
FFonts: TXFonts;
FNumberFormats: TNumberFormats;
FDeleteIndex: integer;
procedure AddDefXF;
public
constructor Create(Fonts: TXFonts);
destructor Destroy; override;
procedure Clear; override;
procedure SetDefault;
procedure Delete(Index: integer);
function Add: TCellFormat; overload;
function Find(F: TCellFormat): TCellFormat; overload;
function FindIndex(F: TCellFormat): integer; overload;
procedure UpdateDeleteIndex;
property Items[IndexId: integer]: TCellFormat read GetItems; default;
property NumberFormats: TNumberFormats read FNumberFormats;
property Fonts: TXFonts read FFonts;
property DeleteIndex: integer read FDeleteIndex;
end;
type TFormatEvent = procedure(Format: TCellFormat; Index: integer) of object;
implementation
const
DefaultData1 = $0001;
DefaultData2 = $0020;
DefaultData3 = $0000;
DefaultData4 = $0000;
DefaultData5 = $2040;
DefaultData6 = $00102040;
DefaultData7 = $20C0;
const DefaultXF8: array[0..20] of TRecXF8 = (
(FontIndex: 0;NumFmtIndex: 0;Data1: $FFF5;Data2: $0020;Data3: $0000;Data4: $0000;Data5: $0000;Data6: $00000000;Data7: $20C0),
(FontIndex: 1;NumFmtIndex: 0;Data1: $FFF5;Data2: $0020;Data3: $F400;Data4: $0000;Data5: $0000;Data6: $00000000;Data7: $20C0),
(FontIndex: 1;NumFmtIndex: 0;Data1: $FFF5;Data2: $0020;Data3: $F400;Data4: $0000;Data5: $0000;Data6: $00000000;Data7: $20C0),
(FontIndex: 2;NumFmtIndex: 0;Data1: $FFF5;Data2: $0020;Data3: $F400;Data4: $0000;Data5: $0000;Data6: $00000000;Data7: $20C0),
(FontIndex: 2;NumFmtIndex: 0;Data1: $FFF5;Data2: $0020;Data3: $F400;Data4: $0000;Data5: $0000;Data6: $00000000;Data7: $20C0),
(FontIndex: 0;NumFmtIndex: 0;Data1: $FFF5;Data2: $0020;Data3: $F400;Data4: $0000;Data5: $0000;Data6: $00000000;Data7: $20C0),
(FontIndex: 0;NumFmtIndex: 0;Data1: $FFF5;Data2: $0020;Data3: $F400;Data4: $0000;Data5: $0000;Data6: $00000000;Data7: $20C0),
(FontIndex: 0;NumFmtIndex: 0;Data1: $FFF5;Data2: $0020;Data3: $F400;Data4: $0000;Data5: $0000;Data6: $00000000;Data7: $20C0),
(FontIndex: 0;NumFmtIndex: 0;Data1: $FFF5;Data2: $0020;Data3: $F400;Data4: $0000;Data5: $0000;Data6: $00000000;Data7: $20C0),
(FontIndex: 0;NumFmtIndex: 0;Data1: $FFF5;Data2: $0020;Data3: $F400;Data4: $0000;Data5: $0000;Data6: $00000000;Data7: $20C0),
(FontIndex: 0;NumFmtIndex: 0;Data1: $FFF5;Data2: $0020;Data3: $F400;Data4: $0000;Data5: $0000;Data6: $00000000;Data7: $20C0),
(FontIndex: 0;NumFmtIndex: 0;Data1: $FFF5;Data2: $0020;Data3: $F400;Data4: $0000;Data5: $0000;Data6: $00000000;Data7: $20C0),
(FontIndex: 0;NumFmtIndex: 0;Data1: $FFF5;Data2: $0020;Data3: $F400;Data4: $0000;Data5: $0000;Data6: $00000000;Data7: $20C0),
(FontIndex: 0;NumFmtIndex: 0;Data1: $FFF5;Data2: $0020;Data3: $F400;Data4: $0000;Data5: $0000;Data6: $00000000;Data7: $20C0),
(FontIndex: 0;NumFmtIndex: 0;Data1: $FFF5;Data2: $0020;Data3: $F400;Data4: $0000;Data5: $0000;Data6: $00000000;Data7: $20C0),
(FontIndex: 0;NumFmtIndex: 0;Data1: $0001;Data2: $0020;Data3: $0000;Data4: $0000;Data5: $0000;Data6: $00000000;Data7: $20C0),
// The last 5 XF records are for the STYLE records.
(FontIndex: 0;NumFmtIndex: $2A;Data1: $FFF5;Data2: $0020;Data3: $0000;Data4: $0000;Data5: $0000;Data6: $00000000;Data7: $20C0),
(FontIndex: 0;NumFmtIndex: $2B;Data1: $FFF5;Data2: $0020;Data3: $0000;Data4: $0000;Data5: $0000;Data6: $00000000;Data7: $20C0),
(FontIndex: 0;NumFmtIndex: $2C;Data1: $FFF5;Data2: $0020;Data3: $0000;Data4: $0000;Data5: $0000;Data6: $00000000;Data7: $20C0),
(FontIndex: 0;NumFmtIndex: $2D;Data1: $FFF5;Data2: $0020;Data3: $0000;Data4: $0000;Data5: $0000;Data6: $00000000;Data7: $20C0),
(FontIndex: 0;NumFmtIndex: $09;Data1: $FFF5;Data2: $0020;Data3: $0000;Data4: $0000;Data5: $0000;Data6: $00000000;Data7: $20C0));
{ TCellFormats }
constructor TCellFormats.Create(Fonts: TXFonts);
begin
inherited Create;
FFonts := Fonts;
FNumberFormats := TNumberFormats.Create;
SetDefault;
end;
destructor TCellFormats.Destroy;
begin
inherited Destroy;
FNumberFormats.Free;
FNumberFormats := Nil;
end;
procedure TCellFormats.Clear;
begin
inherited Clear;
FNumberFormats.Clear;
end;
procedure TCellFormats.SetDefault;
begin
FNumberFormats.SetDefault;
AddDefXF;
FDeleteIndex := Count;
end;
procedure TCellFormats.Delete(Index: integer);
var
i: integer;
begin
inherited Delete(Index);
for i := Index to Count - 1 do
Dec(Items[i].FIndex);
Exit;
if Index >= DEFAULT_FORMATS_COUNT_97 then begin
Items[Index].Free;
inherited Delete(Index);
for i := Index to Count - 1 do
Dec(Items[i].FIndex);
end;
end;
function TCellFormats.GetItems(Index: integer): TCellFormat;
begin
Result := TCellFormat(inherited Items[Index]);
end;
function TCellFormats.Add: TCellFormat;
begin
Result := TCellFormat.Create(Self);
Result.FIndex := Count;
inherited Add(Result);
end;
procedure TCellFormats.AddDefXF;
var
i: integer;
Fmt: TCellFormat;
begin
if Count > 0 then
raise Exception.Create('Add default formats when not empty.');
for i := 0 to High(DefaultXF8) do begin
Fmt := TCellFormat.Create(Self);
Fmt.FromXF8(@DefaultXF8[i]);
Fmt.FIndex := i;
if DefaultXF8[i].NumFmtIndex > 0 then
FNumberFormats.ItemsByIndex[DefaultXF8[i].NumFmtIndex].FUsageCount := 1;
inherited Add(Fmt);
end;
end;
function TCellFormats.Find(F: TCellFormat): TCellFormat;
var
i: integer;
begin
for i := 0 to Count - 1 do begin
if Items[i].Equal(F) then begin
Result := Items[i];
Exit;
end;
end;
Result := Nil;
end;
function TCellFormats.FindIndex(F: TCellFormat): integer;
begin
for Result := 0 to Count - 1 do begin
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -