condfmt2.pas

一个经典的读写Excel的控件

var
  V: longword;
begin
  if Value = xcAutomatic then
    V := $FFFFFFFF
  else
    V := Longword(Value);
  if V = FCFFont.ColorIndex then
    Exit;
  FCFFont.ColorIndex := V;
  FAssigned := True;
end;

procedure TCondFmtFont.SetFontStyle(const Value: TXFontStyles);
begin
  if Value = GetFontStyle then
    Exit;
  FCFFont.Options := 0;
  FCFFont.ModifiedFlags := $00000018 + $00000002 + $00000080;
  if xfsItalic in Value then begin
    FCFFont.Options := FCFFont.Options or $00000002;
    FCFFont.ModifiedFlags := FCFFont.ModifiedFlags and not $00000002;
  end;
  if xfsStrikeOut in Value then begin
    FCFFont.Options := FCFFont.Options or $00000080;
    FCFFont.ModifiedFlags := FCFFont.ModifiedFlags and not $00000080;
  end;
  if xfsBold in Value then begin
    FCFFont.Weight := 700;
    FCFFont.ModifiedFlags := FCFFont.ModifiedFlags and not $00000002;
  end
  else
    FCFFont.Weight := 400;
  FAssigned := True;
end;

procedure TCondFmtFont.SetHeight20(const Value: longword);
begin
  if Value = 0 then
    FCFFont.Height := $FFFFFFFF
  else
    FCFFont.Height := Value;
  FAssigned := FCFFont.Height <> $FFFFFFFF;
end;

procedure TCondFmtFont.SetRec(CFFont: PCFFont);
begin
  Move(CFFont^,FCFFont,SizeOf(TCFFont));
  FAssigned := True;
end;

procedure TCondFmtFont.SetSubSuperscript(const Value: TXSubSuperscript);
begin
  if FCFFont.Escapement = Word(Value) then
    Exit;
  FCFFont.Escapement := Word(Value);
  FCFFont.EscapementModified := 0;
  FAssigned := True;
end;

procedure TCondFmtFont.SetUnderline(const Value: TXUnderline);
begin
  if GetUnderline = Value then
    Exit;
  FCFFont.Underline := 0;
  case Value of
    xulNone          : FCFFont.Underline := $00;
    xulSingle        : FCFFont.Underline := $01;
    xulDouble        : FCFFont.Underline := $02;
    xulSingleAccount : FCFFont.Underline := $21;
    xulDoubleAccount : FCFFont.Underline := $22;
  end;
  FCFFont.UnderlineModified := 0;
  FAssigned := True;
end;

{ TCondFmtBorder }

procedure TCondFmtBorder.Assign(Source: TPersistent);
var
  i: integer;
begin
  Move(TCondFmtBorder(Source).FCFBorder,FCFBorder,SizeOf(TCFBorder));
  for i := 0 to High(FAssigned) do
    FAssigned[i] := TCondFmtBorder(Source).FAssigned[i];
end;

constructor TCondFmtBorder.Create;
begin
  FCFBorder.ColorIndex := 0;
  FCFBorder.ColorIndex := FCFBorder.ColorIndex + Word(xcAutomatic);
  FCFBorder.ColorIndex := FCFBorder.ColorIndex + (Word(xcAutomatic) shl 7);
  FCFBorder.ColorIndex := FCFBorder.ColorIndex + (Word(xcAutomatic) shl 16);
  FCFBorder.ColorIndex := FCFBorder.ColorIndex + (Word(xcAutomatic) shl 23);
end;

function TCondFmtBorder.GetAssigned: boolean;
begin
  Result := FAssigned[0] or FAssigned[1] or FAssigned[2] or FAssigned[3];
end;

function TCondFmtBorder.GetBottomColor: TExcelColor;
begin
  Result := IntToXColor((FCFBorder.ColorIndex shr 23) and $7F);
end;

function TCondFmtBorder.GetBottomStyle: TCellBorderStyle;
begin
  Result := TCellBorderStyle((FCFBorder.Linestyle shr 12) and $0F);
end;

function TCondFmtBorder.GetLeftColor: TExcelColor;
begin
  Result := IntToXColor((FCFBorder.ColorIndex shr 0) and $7F);
end;

function TCondFmtBorder.GetLeftStyle: TCellBorderStyle;
begin
  Result := TCellBorderStyle((FCFBorder.Linestyle shr 0) and $0F);
end;

function TCondFmtBorder.GetRightColor: TExcelColor;
begin
  Result := IntToXColor((FCFBorder.ColorIndex shr 7) and $7F);
end;

function TCondFmtBorder.GetRightStyle: TCellBorderStyle;
begin
  Result := TCellBorderStyle((FCFBorder.Linestyle shr 4) and $0F);
end;

function TCondFmtBorder.GetTopColor: TExcelColor;
begin
  Result := IntToXColor((FCFBorder.ColorIndex shr 16) and $7F);
end;

function TCondFmtBorder.GetTopStyle: TCellBorderStyle;
begin
  Result := TCellBorderStyle((FCFBorder.Linestyle shr 8) and $0F);
end;

procedure TCondFmtBorder.SetBottomColor(const Value: TExcelColor);
begin
  if Value = GetBottomColor then
    Exit;
  FCFBorder.ColorIndex := FCFBorder.ColorIndex and not $3F800000;
  FCFBorder.ColorIndex := FCFBorder.ColorIndex or (Word(Value) shl 23);
end;

procedure TCondFmtBorder.SetBottomStyle(const Value: TCellBorderStyle);
begin
  if Value = GetBottomStyle then
    Exit;
  FCFBorder.LineStyle := FCFBorder.LineStyle and not $F000;
  FCFBorder.LineStyle := FCFBorder.LineStyle or (Byte(Value) shl 12);
  FAssigned[3] := Value <> cbsNone;
end;

procedure TCondFmtBorder.SetLeftColor(const Value: TExcelColor);
begin
  if Value = GetLeftColor then
    Exit;
  FCFBorder.ColorIndex := FCFBorder.ColorIndex and not $0000007F;
  FCFBorder.ColorIndex := FCFBorder.ColorIndex or (Word(Value) shl 0);
end;

procedure TCondFmtBorder.SetLeftStyle(const Value: TCellBorderStyle);
begin
  if Value = GetLeftStyle then
    Exit;
  FCFBorder.LineStyle := FCFBorder.LineStyle and not $000F;
  FCFBorder.LineStyle := FCFBorder.LineStyle or (Byte(Value) shl 0);
  FAssigned[0] := Value <> cbsNone;
end;

procedure TCondFmtBorder.SetRec(CFBorder: PCFBorder; Flags: longword);
begin
  Move(CFBorder^,FCFBorder,SizeOf(TCFBorder));
  FAssigned[0] := (Flags and $00000400) = 0;
  FAssigned[1] := (Flags and $00001000) = 0;
  FAssigned[2] := (Flags and $00000800) = 0;
  FAssigned[3] := (Flags and $00002000) = 0;
end;

procedure TCondFmtBorder.SetRightColor(const Value: TExcelColor);
begin
  if Value = GetRightColor then
    Exit;
  FCFBorder.ColorIndex := FCFBorder.ColorIndex and not $00003F80;
  FCFBorder.ColorIndex := FCFBorder.ColorIndex or (Word(Value) shl 7);
end;

procedure TCondFmtBorder.SetRightStyle(const Value: TCellBorderStyle);
begin
  if Value = GetRightStyle then
    Exit;
  FCFBorder.LineStyle := FCFBorder.LineStyle and not $00F0;
  FCFBorder.LineStyle := FCFBorder.LineStyle or (Byte(Value) shl 4);
  FAssigned[2] := Value <> cbsNone;
end;

procedure TCondFmtBorder.SetTopColor(const Value: TExcelColor);
begin
  if Value = GetTopColor then
    Exit;
  FCFBorder.ColorIndex := FCFBorder.ColorIndex and not $07F00000;
  FCFBorder.ColorIndex := FCFBorder.ColorIndex or (Word(Value) shl 16);
end;

procedure TCondFmtBorder.SetTopStyle(const Value: TCellBorderStyle);
begin
  if Value = GetTopStyle then
    Exit;
  FCFBorder.LineStyle := FCFBorder.LineStyle and not $0000;
  FCFBorder.LineStyle := FCFBorder.LineStyle or (Byte(Value) shl 8);
  FAssigned[1] := Value <> cbsNone;
end;

{ TCondFmtPattern }

procedure TCondFmtPattern.Assign(Source: TPersistent);
var
  i: integer;
begin
  Move(TCondFmtPattern(Source).FCFPattern,FCFPattern,SizeOf(TCFPattern));
  for i := 0 to High(FAssigned) do
    FAssigned[i] := TCondFmtPattern(Source).FAssigned[i];
end;

constructor TCondFmtPattern.Create;
begin
  FCFPattern.ColorIndex := 0;
  FCFPattern.PatternStyle := 0;
end;

function TCondFmtPattern.GetAssigned: boolean;
begin
  Result := FAssigned[0] or FAssigned[1] or FAssigned[2];
end;

function TCondFmtPattern.GetBackColor: TExcelColor;
begin
  Result := IntToXColor((FCFPattern.ColorIndex shr 7) and $7F);
  if Result = xc0 then
    Result := xcAutomatic;
end;

function TCondFmtPattern.GetFillPattern: TExcelFillPattern;
begin
  Result := TExcelFillPattern(FCFPattern.PatternStyle shr 10);
end;

function TCondFmtPattern.GetForeColor: TExcelColor;
begin
  Result := IntToXColor((FCFPattern.ColorIndex shr 0) and $7F);
  if Result = xc0 then
    Result := xcAutomatic;
end;

procedure TCondFmtPattern.SetBackColor(const Value: TExcelColor);
begin
  FAssigned[2] := not (Value in[xc0,xcAutomatic]);
  FCFPattern.ColorIndex := FCFPattern.ColorIndex and not $3F80;
  if FAssigned[2] then
    FCFPattern.ColorIndex := FCFPattern.ColorIndex or (Word(Value) shl 7);
end;

procedure TCondFmtPattern.SetFillPattern(const Value: TExcelFillPattern);
begin
  FAssigned[0] := Value <> fpNone;
  FCFPattern.PatternStyle := FCFPattern.PatternStyle and not $FC00;
  if FAssigned[0] then
    FCFPattern.PatternStyle := FCFPattern.PatternStyle or (Word(Value) shl 10);
end;

procedure TCondFmtPattern.SetForeColor(const Value: TExcelColor);
begin
  FAssigned[1] := not (Value in[xc0,xcAutomatic]);
  FCFPattern.ColorIndex := FCFPattern.ColorIndex and not $007F;
  if FAssigned[1] then
    FCFPattern.ColorIndex := FCFPattern.ColorIndex or (Word(Value) shl 0);
end;

procedure TCondFmtPattern.SetRec(CFPattern: PCFPattern; Flags: longword);
begin
  Move(CFPattern^,FCFPattern,SizeOf(TCFPattern));
  FAssigned[0] := (Flags and $00010000) = 0;
  FAssigned[1] := (Flags and $00020000) = 0;
  FAssigned[2] := (Flags and $00040000) = 0;
end;

{ TCondFmtData }

procedure TCondFmtData.Assign(Source: TPersistent);
begin
  Move(TCondFmtData(Source).FRecCF^,FRecCF^,SizeOf(TRecCF));
                                          
  FFormula1.Size := TCondFmtData(Source).FFormula1.Size;
  GetMem(FFormula1.PTGS,FFormula1.Size);
  Move(TCondFmtData(Source).FFormula1.PTGS^,FFormula1.PTGS^,FFormula1.Size);

  FFormula2.Size := TCondFmtData(Source).FFormula2.Size;
  GetMem(FFormula2.PTGS,FFormula2.Size);
  Move(TCondFmtData(Source).FFormula2.PTGS^,FFormula2.PTGS^,FFormula2.Size);

  FFmtFont.Assign(TCondFmtData(Source).FFmtFont);
  FFmtBorder.Assign(TCondFmtData(Source).FFmtBorder);
  FFmtPattern.Assign(TCondFmtData(Source).FFmtPattern);
end;

function TCondFmtData.Assigned: boolean;
begin
  Result := FFmtFont.Assigned or FFmtBorder.Assigned or FFmtPattern.Assigned;
end;

constructor TCondFmtData.Create(FmlaHandler: TFormulaHandler);
begin
  GetMem(FRecCF,SizeOf(TRecCF));
  FRecCF.CFType := $01;
  FRecCF.Operator := $03;
  FRecCF.Flags := $003FFFFF;
  FFormulaHandler := FmlaHandler;