condfmt2.pas

一个经典的读写Excel的控件

  FFmtFont := TCondFmtFont.Create;
  FFmtBorder := TCondFmtBorder.Create;
  FFmtPattern := TCondFmtPattern.Create;
end;

destructor TCondFmtData.Destroy;
begin
  FFmtFont.Free;
  FFmtBorder.Free;
  FFmtPattern.Free;
  FreeMem(FFormula1.PTGS);
  FreeMem(FFormula2.PTGS);
  FreeMem(FRecCF);
  inherited;
end;

function TCondFmtData.GetCompareCell: boolean;
begin
  Result := FRecCF.CFType = $01;
end;

function TCondFmtData.GetCompOperator: TConditionOperator;
begin
  Result := TConditionOperator(FRecCF.Operator);
end;

function TCondFmtData.GetFormula1: WideString;
begin
  if FFormula1.Size > 0 then
    Result := FFormulaHandler.DecodeFormula(FFormula1.PTGS,FFormula1.Size)
  else
    Result := '';
end;

function TCondFmtData.GetFormula2: WideString;
begin
  if FFormula2.Size > 0 then
    Result := FFormulaHandler.DecodeFormula(FFormula2.PTGS,FFormula2.Size)
  else
    Result := '';
end;

procedure TCondFmtData.SaveToStream(Stream: TXLSStream; PBuf: PByteArray);
var
  Sz: integer;
begin
  Sz := 0;
  if FFmtFont.Assigned then begin
    FRecCF.Flags := FRecCF.Flags or $04000000;
    Inc(Sz,SizeOf(TCFFont));
  end;
  if FFmtBorder.Assigned then begin
    FRecCF.Flags := FRecCF.Flags or $10000000;
    if FFmtBorder.FAssigned[0] then
      FRecCF.Flags := FRecCF.Flags and not $00000400;
    if FFmtBorder.FAssigned[1] then
      FRecCF.Flags := FRecCF.Flags and not $00001000;
    if FFmtBorder.FAssigned[2] then
      FRecCF.Flags := FRecCF.Flags and not $00000800;
    if FFmtBorder.FAssigned[3] then
      FRecCF.Flags := FRecCF.Flags and not $00002000;
    Inc(Sz,SizeOf(TCFBorder));
  end;
  if FFmtPattern.Assigned then begin
    FRecCF.Flags := FRecCF.Flags or $20000000;
    if FFmtPattern.FAssigned[0] then
      FRecCF.Flags := FRecCF.Flags and not $00010000;
    if FFmtPattern.FAssigned[1] then
      FRecCF.Flags := FRecCF.Flags and not $00020000;
    if FFmtPattern.FAssigned[2] then
      FRecCF.Flags := FRecCF.Flags and not $00040000;
    Inc(Sz,SizeOf(TCFPattern));
  end;
  FRecCF.Formula1Size := FFormula1.Size;
  FRecCF.Formula2Size := FFormula2.Size;
  Inc(Sz,FFormula1.Size + FFormula2.Size);
  Stream.WriteHeader(BIFFRECID_CF,SizeOf(TRecCF) + Sz);
  Stream.Write(FRecCF^,SizeOf(TRecCF));
  if FFmtFont.Assigned then
    Stream.Write(FFmtFont.FCFFont,SizeOf(TCFFont));
  if FFmtBorder.Assigned then
    Stream.Write(FFmtBorder.FCFBorder,SizeOf(TCFBorder));
  if FFmtPattern.Assigned then
    Stream.Write(FFmtPattern.FCFPattern,SizeOf(TCFPattern));
  if FFormula1.Size > 0 then
    Stream.Write(FFormula1.PTGS^,FFormula1.Size);
  if FFormula2.Size > 0 then
    Stream.Write(FFormula2.PTGS^,FFormula2.Size);
end;

procedure TCondFmtData.SetCompareCell(const Value: boolean);
begin
  if Value then
    FRecCF.CFType := $01
  else
    FRecCF.CFType := $02;
end;

procedure TCondFmtData.SetCompOperator(const Value: TConditionOperator);
begin
  FRecCF.Operator := Word(Value);
end;

procedure TCondFmtData.SetFormula1(const Value: WideString);
begin
  if Value = '' then begin
    FreeMem(FFormula1.PTGS);
    FFormula1.PTGS := Nil;
  end
  else begin
    GetMem(FFormula1.PTGS,1024);
    FFormula1.Size := FFormulaHandler.EncodeFormula(Value,FFormula1.PTGS,1024);
    ReAllocMem(FFormula1.PTGS,FFormula1.Size);
    if FFormula1.Size = 0 then
      FFormula1.PTGS := Nil;
  end;
end;

procedure TCondFmtData.SetFormula2(const Value: WideString);
begin
  if Value = '' then begin
    FreeMem(FFormula2.PTGS);
    FFormula2.PTGS := Nil;
  end
  else begin
    GetMem(FFormula2.PTGS,1024);
    FFormula2.Size := FFormulaHandler.EncodeFormula(Value,FFormula2.PTGS,1024);
    ReAllocMem(FFormula2.PTGS,FFormula2.Size);
    if FFormula2.Size = 0 then
      FFormula2.PTGS := Nil;
  end;
end;

procedure TCondFmtData.SetRec(RecCF: PRecCF);
var
  P: PByteArray;
begin
  Move(RecCF^,FRecCF^,SizeOf(TRecCF));
  P := @RecCF.VarData;
  if (FRecCF.Flags and $04000000) = $04000000 then begin
    FFmtFont.SetRec(PCFFont(P));
    P := PByteArray(Integer(P) + SizeOf(TCFFont));
  end;
  if (FRecCF.Flags and $10000000) = $10000000 then begin
    FFmtBorder.SetRec(PCFBorder(P),FRecCF.Flags);
    P := PByteArray(Integer(P) + SizeOf(TCFBorder));
  end;
  if (FRecCF.Flags and $20000000) = $20000000 then begin
    FFmtPattern.SetRec(PCFPattern(P),FRecCF.Flags);
    P := PByteArray(Integer(P) + SizeOf(TCFPattern));
  end;
  FFormula1.Size := FRecCF.Formula1Size;
  if FFormula1.Size > 0 then begin
    GetMem(FFormula1.PTGS,FFormula1.Size);
    Move(P^,FFormula1.PTGS^,FFormula1.Size);
    P := PByteArray(Integer(P) + FFormula1.Size);
  end;
  FFormula2.Size := FRecCF.Formula2Size;
  if FFormula2.Size > 0 then begin
    GetMem(FFormula2.PTGS,FFormula2.Size);
    Move(P^,FFormula2.PTGS^,FFormula2.Size);
  end;
end;

{ TConditionalFormat }

procedure TConditionalFormat.Assign(Source: TPersistent);
begin
  FCond1.Assign(TConditionalFormat(Source).FCond1);
  FCond2.Assign(TConditionalFormat(Source).FCond2);
  FCond3.Assign(TConditionalFormat(Source).FCond3);
  FAreas.Assign(TConditionalFormat(Source).FAreas);
end;

function TConditionalFormat.Assigned: integer;
begin
  Result := 0;
  if FCond1.Assigned then
    Inc(Result);
  if FCond2.Assigned then
    Inc(Result);
  if FCond3.Assigned then
    Inc(Result);
end;

constructor TConditionalFormat.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FCond1 := TCondFmtData.Create(TConditionalFormats(Collection).FFormulaHandler);
  FCond2 := TCondFmtData.Create(TConditionalFormats(Collection).FFormulaHandler);
  FCond3 := TCondFmtData.Create(TConditionalFormats(Collection).FFormulaHandler);
  FAreas := TCellAreas.Create(Self);
end;

destructor TConditionalFormat.Destroy;
begin
  FCond1.Free;
  FCond2.Free;
  FCond3.Free;
  FAreas.Free;
  inherited;
end;

procedure TConditionalFormat.Delete(Col1, Row1, Col2, Row2: integer);
begin
  FAreas.Delete(Col1, Row1, Col2, Row2);
end;

function TConditionalFormat.Intersect(Col1, Row1, Col2, Row2: integer): boolean;
begin
  Result := FAreas.AreaInAreas(Col1, Row1, Col2, Row2);
end;

procedure TConditionalFormat.Copy(Col1, Row1, Col2, Row2,DeltaCol,DeltaRow: integer);
begin
  FAreas.Copy(Col1, Row1, Col2, Row2,DeltaCol,DeltaRow);
end;

procedure TConditionalFormat.Move(DeltaCol, DeltaRow: integer);
begin
  FAreas.Move(DeltaCol, DeltaRow);
end;

procedure TConditionalFormat.Move(Col1, Row1, Col2, Row2, DeltaCol, DeltaRow: integer);
begin
  FAreas.Move(Col1, Row1, Col2, Row2, DeltaCol, DeltaRow);
end;

procedure TConditionalFormat.SaveToStream(Stream: TXLSStream; PBuf: PByteArray);
var
  i: integer;
  Ext: TRecCellArea;
begin
  FAreas.NormalizeAll;
  Ext := FAreas.TotExtent;
  Stream.WriteHeader(BIFFRECID_CONDFMT,SizeOf(TRecCONDFMT) + ((FAreas.Count - 1) * SizeOf(TRecCellArea)));
  Stream.WWord(Assigned);
  Stream.WWord($0001);
  Stream.WriteCellArea(Ext);
  Stream.WWord(FAreas.Count);
  for i := 0 to FAreas.Count - 1 do
    Stream.WriteCellArea(FAreas[i].AsRecArea);
  if FCond1.Assigned then
    FCond1.SaveToStream(Stream,PBuf);
  if FCond2.Assigned then
    FCond2.SaveToStream(Stream,PBuf);
  if FCond3.Assigned then
    FCond3.SaveToStream(Stream,PBuf);
end;

procedure TConditionalFormat.Include(Col1, Row1, Col2, Row2: integer);
begin
  FAreas.Include(Col1, Row1, Col2, Row2);
end;

{ TConditionalFormats }

function TConditionalFormats.Add: TConditionalFormat;
begin
  Result := TConditionalFormat(inherited Add);
end;

constructor TConditionalFormats.Create(AOwner: TPersistent; FmlaHandler: TFormulaHandler);
begin
  inherited Create(TConditionalFormat);
  FOwner := AOwner;
  FFormulaHandler := FmlaHandler;
end;

function TConditionalFormats.GetItems(Index: integer): TConditionalFormat;
begin
  Result := TConditionalFormat(inherited Items[Index]);
end;

function TConditionalFormats.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

procedure TConditionalFormats.LoadFromStream(Stream: TXLSStream; PBuf: PByteArray);
var
  i,Count: integer;
  CONDFMT: TConditionalFormat;

procedure ReadCF(CF: TCondFmtData);
var
  Header: TBIFFHeader;
begin
  if Stream.PeekHeader <> BIFFRECID_CF then
    raise Exception.Create('Excpected record missing: CF');
  Stream.ReadHeader(Header);
  Stream.Read(PBuf^,Header.Length);
  CF.SetRec(PRecCF(PBuf));
end;

begin
  CONDFMT := Add;
  for i := 0 to PRecCONDFMT(PBuf).AreaCount - 1 do
    CONDFMT.FAreas.Add(@PRecCONDFMT(PBuf).Areas[i]);
  if (PRecCONDFMT(PBuf).CFCount < 1) or (PRecCONDFMT(PBuf).CFCount > 3) then
    raise Exception.Create('Bad number of CF records.');
  Count := PRecCONDFMT(PBuf).CFCount;
  if Count >= 1 then
    ReadCF(CONDFMT.FCond1);
  if Count >= 2 then
    ReadCF(CONDFMT.FCond2);
  if Count >= 3 then
    ReadCF(CONDFMT.FCond3);
end;

procedure TConditionalFormats.SaveToStream(Stream: TXLSStream; PBuf: PByteArray);
var
  i: integer;
begin
  for i := 0 to Count - 1 do begin
    if (Items[i].Assigned > 0) and (Items[i].FAreas.Count > 0) then
      Items[i].SaveToStream(Stream,PBuf);
  end;
end;

end.