cellformats2.pas

一个经典的读写Excel的控件

    if Items[Result].Equal(F) then
      Exit;
  end;
  Result := -1;
end;

procedure TCellFormats.UpdateDeleteIndex;
begin
  FDeleteIndex := Count;
end;

{ TCellFormat }

constructor TCellFormat.Create(Parent: TCellFormats);
begin
  FParent := Parent;
  FXF.Data1 := DefaultData1;
  FXF.Data2 := DefaultData2;
  FXF.Data3 := DefaultData3;
  FXF.Data4 := DefaultData4;
  FXF.Data5 := DefaultData5;
  FXF.Data6 := DefaultData6;
  FXF.Data7 := DefaultData7;
  FXF.NumFmtIndex := 0;
  FXF.FontIndex := 0;
end;

constructor TCellFormat.Create(Parent: TCellFormats; FormatIndex: word);
begin
  FParent := Parent;
  Assign(FParent[FormatIndex]);
end;

procedure TCellFormat.Assign(Source: TCellFormat);
begin
  Move(Source.FXF,FXF,SizeOf(TRecXF8));
  Inc(FParent.FNumberFormats.Items[FXF.NumFmtIndex].FUsageCount);
end;

function TCellFormat.GetNumberFormat: WideString;
begin
  if FParent <> Nil then
    Result := FParent.FNumberFormats.Items[FXF.NumFmtIndex].Value
  else
    Result := '';
end;

procedure TCellFormat.SetNumberFormat(Value: WideString);
var
  Mask: TExcelMask;
begin
  if FParent = Nil then
    raise Exception.Create('CellFormat has no parent');
  if Value = '' then
    FXF.NumFmtIndex := 0
  else begin
    Mask := TExcelMask.Create;
    try
      Mask.Mask := Value;
    finally
      Mask.Free;
    end;
    FXF.NumFmtIndex := FParent.FNumberFormats.Add(Value).FIndexId;
  end;
end;

function TCellFormat.FormatIsDateTime: boolean;
begin
  Result := FXF.NumFmtIndex in [$0E,$14];
end;

function TCellFormat.GetBorderBottomColor: TExcelColor;
begin
  Result := TExcelColor((FXF.Data6 and $00003F80) shr 7);
end;

function TCellFormat.GetBorderBottomStyle: TCellBorderStyle;
begin
  Result := TCellBorderStyle((FXF.Data4 and $F000) shr 12);
end;

function TCellFormat.GetBorderDiagColor: TExcelColor;
begin
  Result := TExcelColor((FXF.Data6 and $001FC000) shr 14);
end;

function TCellFormat.GetBorderDiagLines: TDiagLines;
begin
  Result := TDiagLines((FXF.Data5 and $C000) shr 14);
end;

function TCellFormat.GetBorderDiagStyle: TCellBorderStyle;
begin
  Result := TCellBorderStyle((FXF.Data6 and $01E00000) shr 21);
end;

function TCellFormat.GetBorderLeftColor: TExcelColor;
begin
  Result := TExcelColor((FXF.Data5 and $007F) shr 0);
end;

function TCellFormat.GetBorderLeftStyle: TCellBorderStyle;
begin
  Result := TCellBorderStyle((FXF.Data4 and $000F) shr 0);
end;

function TCellFormat.GetBorderRightColor: TExcelColor;
begin
  Result := TExcelColor((FXF.Data5 and $3F80) shr 7);
end;

function TCellFormat.GetBorderRightStyle: TCellBorderStyle;
begin
  Result := TCellBorderStyle((FXF.Data4 and $00F0) shr 4);
end;

function TCellFormat.GetBorderTopColor: TExcelColor;
begin
  Result := TExcelColor((FXF.Data6 and $0000007F) shr 0);
end;

function TCellFormat.GetBorderTopStyle: TCellBorderStyle;
begin
  Result := TCellBorderStyle((FXF.Data4 and $0F00) shr 8);
end;

function TCellFormat.GetFillPatternBackColor: TExcelColor;
var
  V: word;
begin
  V := FXF.Data7 and (not $3F80);
  V := V shr 7;
  if V > Word(Ord(xcAutomatic)) then
    V := Ord(xcAutomatic);
  Result := TExcelColor(V);
end;

function TCellFormat.GetFillPatternForeColor: TExcelColor;
begin
  Result := TExcelColor((FXF.Data7 and $007F) shr 0);
end;

function TCellFormat.GetFillPatternPattern: TExcelFillPattern;
begin
  Result := TExcelFillPattern((FXF.Data6 and $FC000000) shr 26);
end;

function TCellFormat.GetFormatOptions: TFormatOptions;
begin
  Result := [];
  if ((FXF.Data2 and $0008) shr 3) > 0 then
    Result := [foWrapText];
  if ((FXF.Data3 and $0010) shr 4) > 0 then
    Result := Result + [foShrinkToFit];
end;

function TCellFormat.GetHorizAlignment: TCellHorizAlignment;
begin
  Result := TCellHorizAlignment(FXF.Data2 and $0007);
end;

function TCellFormat.GetIndent: byte;
begin
  Result := FXF.Data3 and $000F;
end;

function TCellFormat.GetMerged: boolean;
begin
  Result := (FXF.Data3 and $0020) = $0020;
end;

function TCellFormat.GetProtection: TCellProtections;
begin
  Result := TCellProtections(Byte(FXF.Data1 and $0003));
end;

function TCellFormat.GetRotation: smallint;
begin
  Result := FXF.Data2 shr 8;
  if (Result > 90) and (Result <> 255) then
    Result := -(Result - 90)
end;

function TCellFormat.GetVertAlignment: TCellVertAlignment;
begin
  Result := TCellVertAlignment((FXF.Data2 and $0070) shr 4);
end;

procedure TCellFormat.SetBorderBottomColor(const Value: TExcelColor);
begin
  FXF.Data6 := FXF.Data6 and (not $00003F80);
  FXF.Data6 := FXF.Data6 + (Longword(Value) shl 7);
end;

procedure TCellFormat.SetBorderBottomStyle(const Value: TCellBorderStyle);
begin
  FXF.Data4 := FXF.Data4 and (not $F000);
  FXF.Data4 := FXF.Data4 + (Word(Value) shl 12);
  if (FXF.Data4 <> 0) or ((FXF.Data6 and $01E00000) <> 0) then
    FXF.Data3 := FXF.Data3 or $2000
  else
    FXF.Data3 := FXF.Data3 and (not $2000);
end;

procedure TCellFormat.SetBorderDiagColor(const Value: TExcelColor);
begin
  FXF.Data6 := FXF.Data6 and (not $001FC000);
  FXF.Data6 := FXF.Data6 + (Longword(Value) shl 14);
end;

procedure TCellFormat.SetBorderDiagLines(const Value: TDiagLines);
begin
  FXF.Data5 := FXF.Data5 and (not $C000);
  FXF.Data5 := FXF.Data5 + (Word(Value) shl 14);
end;

procedure TCellFormat.SetBorderDiagStyle(const Value: TCellBorderStyle);
begin
  FXF.Data6 := FXF.Data6 and (not $01E00000);
  FXF.Data6 := FXF.Data6 + (Longword(Value) shl 21);
  if (FXF.Data4 <> 0) or ((FXF.Data6 and $01E00000) <> 0) then
    FXF.Data3 := FXF.Data3 or $2000
  else
    FXF.Data3 := FXF.Data3 and (not $2000);
end;

procedure TCellFormat.SetBorderLeftColor(const Value: TExcelColor);
begin
  FXF.Data5 := FXF.Data5 and (not $007F);
  FXF.Data5 := FXF.Data5 + (Word(Value) shl 0);
end;

procedure TCellFormat.SetBorderLeftStyle(const Value: TCellBorderStyle);
begin
  FXF.Data4 := FXF.Data4 and (not $000F);
  FXF.Data4 := FXF.Data4 + (Word(Value) shl 0);
  if (FXF.Data4 <> 0) or ((FXF.Data6 and $01E00000) <> 0) then
    FXF.Data3 := FXF.Data3 or $2000
  else
    FXF.Data3 := FXF.Data3 and (not $2000);
end;

procedure TCellFormat.SetBorderRightColor(const Value: TExcelColor);
begin
  FXF.Data5 := FXF.Data5 and (not $3F80);
  FXF.Data5 := FXF.Data5 + (Word(Value) shl 7);
end;

procedure TCellFormat.SetBorderRightStyle(const Value: TCellBorderStyle);
begin
  FXF.Data4 := FXF.Data4 and (not $00F0);
  FXF.Data4 := FXF.Data4 + (Word(Value) shl 4);
  if (FXF.Data4 <> 0) or ((FXF.Data6 and $01E00000) <> 0) then
    FXF.Data3 := FXF.Data3 or $2000
  else
    FXF.Data3 := FXF.Data3 and (not $2000);
end;

procedure TCellFormat.SetBorderTopColor(const Value: TExcelColor);
begin
  FXF.Data6 := FXF.Data6 and (not $0000007F);
  FXF.Data6 := FXF.Data6 + (Longword(Value) shl 0);
end;

procedure TCellFormat.SetBorderTopStyle(const Value: TCellBorderStyle);
begin
  FXF.Data4 := FXF.Data4 and (not $0F00);
  FXF.Data4 := FXF.Data4 + (Word(Value) shl 8);
  if (FXF.Data4 <> 0) or ((FXF.Data6 and $01E00000) <> 0) then
    FXF.Data3 := FXF.Data3 or $2000
  else
    FXF.Data3 := FXF.Data3 and (not $2000);
end;

procedure TCellFormat.SetFFormatOptions(const Value: TFormatOptions);
begin
  FXF.Data2 := FXF.Data2 and (not ($0008 + $0010 + $0070));
  if foWrapText in Value then
    FXF.Data2 := FXF.Data2 + $0008;
  if foShrinkToFit in Value then
    FXF.Data3 := FXF.Data3 + $0010;
  if ((FXF.Data2 and $0008) <> 0) or ((FXF.Data2 and $0007) <> 0) then
    FXF.Data3 := FXF.Data3 or $1000
  else
    FXF.Data3 := FXF.Data3 and (not $1000);
end;

procedure TCellFormat.SetFillPatternBackColor(const Value: TExcelColor);
begin
  FXF.Data7 := FXF.Data7 and (not $3F80);
  FXF.Data7 := FXF.Data7 + (Word(Value) shl 7);
  if (FXF.Data7 and ($007F + $3F80)) <> $2040 then
    FXF.Data3 := FXF.Data3 or $4000
  else
    FXF.Data3 := FXF.Data3 and (not $4000);
end;

procedure TCellFormat.SetFillPatternForeColor(const Value: TExcelColor);
begin
  FXF.Data7 := FXF.Data7 and (not $007F);
  FXF.Data7 := FXF.Data7 + (Word(Value) shl 0);
  if (FXF.Data7 and ($007F + $3F80)) <> $2040 then
    FXF.Data3 := FXF.Data3 or $4000
  else
    FXF.Data3 := FXF.Data3 and (not $4000);
  if Value <> xcAutomatic then begin
    SetFillPatternPattern(fpPattern1);
    SetFillPatternBackColor(xcWhite);
  end;
end;

procedure TCellFormat.SetFillPatternPattern(const Value: TExcelFillPattern);
begin
  FXF.Data6 := FXF.Data6 and (not $FC000000);
  FXF.Data6 := FXF.Data6 + ((Longword(Value) shl 26) and $FC000000);
  if Value <> fpNone then
    FXF.Data3 := FXF.Data3 or $4000
  else
    FXF.Data3 := FXF.Data3 and (not $4000);
end;

procedure TCellFormat.SetHorizAlignment(const Value: TCellHorizAlignment);
begin
  FXF.Data2 := FXF.Data2 and (not $0007);
  FXF.Data2 := FXF.Data2 + (Word(Value) shl 0);
  if ((FXF.Data2 and $0008) <> 0) or ((FXF.Data2 and $0007) <> 0) or ((FXF.Data2 and $0070) <> 0) then
    FXF.Data3 := FXF.Data3 or $1000
  else
    FXF.Data3 := FXF.Data3 and (not $1000);
end;

procedure TCellFormat.SetIndent(const Value: byte);
begin
  FXF.Data3 := FXF.Data3 and (not $000F);
  FXF.Data3 := FXF.Data3 + (Word(Value and $0F) and $000F);
end;

procedure TCellFormat.SetMerged(const Value: boolean);
begin
  FXF.Data3 := FXF.Data3 and (not $0020);
  if Value then
    FXF.Data3 := FXF.Data3 + $0020;
end;

procedure TCellFormat.SetProtection(const Value: TCellProtections);
begin
  FXF.Data1 := FXF.Data1 and (not $0003);
  if cpLocked in Value then
    FXF.Data1 := FXF.Data1 + $0001;
  if cpHidden in Value then
    FXF.Data1 := FXF.Data1 + $0002;
end;

procedure TCellFormat.SetRotation(const Value: smallint);
var
  V: byte;
begin
  if Value >= 255 then
    V := 255
  else if Value > 90 then
    V := 90
  else if Value < -90 then
    V := 180
  else if Value < 0 then
    V := -Value + 90
  else
    V := Value;
  FXF.Data2 := (FXF.Data2 and $00FF) + (V shl 8);
end;

procedure TCellFormat.SetVertAlignment(const Value: TCellVertAlignment);
begin
  FXF.Data2 := FXF.Data2 and (not $0070);
  FXF.Data2 := FXF.Data2 + (Word(Value) shl 4);
  if ((FXF.Data2 and $0008) <> 0) or ((FXF.Data2 and $0007) <> 0) or ((FXF.Data2 and $0070) <> 0) then
    FXF.Data3 := FXF.Data3 or $1000
  else
    FXF.Data3 := FXF.Data3 and (not $1000);
end;

procedure TCellFormat.FromXF4(P: PByteArray);

function Get4BorderStyle(Value: byte): TCellBorderStyle;
begin
  case Value of
    0: Result := cbsNone;
    1: Result := cbsThin;
    2: Result := cbsMedium;
    3: Result := cbsDashed;
    4: Result := cbsDotted;
    5: Result := cbsThick;
    6: Result := cbsDouble;
    7: Result := cbsHair;
    else
      Result := cbsNone;
  end;
end;

begin
  FXF.Data1 := DefaultData1;
  FXF.Data2 := DefaultData2;
  FXF.Data3 := DefaultData3;
  FXF.Data4 := DefaultData4;
  FXF.Data5 := DefaultData5;
  FXF.Data6 := DefaultData6;
  FXF.Data7 := DefaultData7;

  FXF.FontIndex := PRecXF4(P).FontIndex;
  if FParent.FNumberFormats.Count > Length(ExcelStandardNumFormats) then
    FXF.NumFmtIndex := PRecXF4(P).FormatIndex + Length(ExcelStandardNumFormats)
  else
    FXF.NumFmtIndex := PRecXF4(P).FormatIndex;

  Protection := [];
  if (PRecXF4(P).Data1 and $01) = $01 then  Protection := Protection + [cpLocked];
  if (PRecXF4(P).Data1 and $02) = $02 then  Protection := Protection + [cpHidden];

  case PRecXF4(P).Data2 and $07 of
    0: HorizAlignment := chaGeneral;
    1: HorizAlignment := chaLeft;
    2: HorizAlignment := chaCenter;
    3: HorizAlignment := chaRight;
    4: HorizAlignment := chaFill;
    5: HorizAlignment := chaJustify;
    6: HorizAlignment := chaCenterAcross;
  end;

  FormatOptions := [];