drawingobjchart2.pas

一个经典的读写Excel的控件

  Result := IntToXColor(PCRecLINEFORMAT(FRecord.Data).ColorIndex);
end;

function TLineFormat.GetLineStyle: TChartLineStyle;
begin
  Check;
  Result := TChartLineStyle(PCRecLINEFORMAT(FRecord.Data).Pattern);
end;

function TLineFormat.GetLineWeight: TChartLineWeight;
begin
  Check;
  Result := TChartLineWeight(PCRecLINEFORMAT(FRecord.Data).Weight);
end;

procedure TLineFormat.SetAutomatic(const Value: boolean);
begin
  Check;
  if Value then
    PCRecLINEFORMAT(FRecord.Data).Format := PCRecLINEFORMAT(FRecord.Data).Format or $0001
  else
    PCRecLINEFORMAT(FRecord.Data).Format := PCRecLINEFORMAT(FRecord.Data).Format and not $0001;
end;

procedure TLineFormat.SetDefault;
begin
  PCRecLINEFORMAT(FRecord.Data).ColorRGB := $00000000;
  PCRecLINEFORMAT(FRecord.Data).Pattern := $0000;
  PCRecLINEFORMAT(FRecord.Data).Weight := $FFFF;
  PCRecLINEFORMAT(FRecord.Data).Format := $0009;
  PCRecLINEFORMAT(FRecord.Data).ColorIndex := $004D;
end;

procedure TLineFormat.SetLineColor(const Value: TExcelColor);
begin
  Check;
  PCRecLINEFORMAT(FRecord.Data).ColorIndex := Word(Value);
  PCRecLINEFORMAT(FRecord.Data).ColorRGB := XColorToRGB(Value);
end;

procedure TLineFormat.SetLineStyle(const Value: TChartLineStyle);
begin
  Check;
  PCRecLINEFORMAT(FRecord.Data).Pattern := Word(Value);
end;

procedure TLineFormat.SetLineWeight(const Value: TChartLineWeight);
begin
  Check;
  PCRecLINEFORMAT(FRecord.Data).Weight := Word(Value);
end;

{ TAreaFormat }

function TAreaFormat.GetAutomatic: boolean;
begin
  Check;
  Result := (PCRecAREAFORMAT(FRecord.Data).Format and $0001) = $0001;
end;

function TAreaFormat.GetBackgroundColor: TExcelColor;
begin
  Check;
  Result := IntToXColor(PCRecAREAFORMAT(FRecord.Data).ColorBgIndex);
end;

function TAreaFormat.GetForegroundColor: TExcelColor;
begin
  Check;
  Result := IntToXColor(PCRecAREAFORMAT(FRecord.Data).ColorFgIndex);
end;

function TAreaFormat.GetPattern: TExcelFillPattern;
begin
  Check;
  Result := TExcelFillPattern(PCRecAREAFORMAT(FRecord.Data).Pattern);
end;

function TAreaFormat.GetSwapColorWhenNeg: boolean;
begin
  Check;
  Result := (PCRecAREAFORMAT(FRecord.Data).Format and $0002) = $0002;
end;

procedure TAreaFormat.SetAutomatic(const Value: boolean);
begin
  Check;
  if Value then
    PCRecAREAFORMAT(FRecord.Data).Format := PCRecAREAFORMAT(FRecord.Data).Format or $0001
  else
    PCRecAREAFORMAT(FRecord.Data).Format := PCRecAREAFORMAT(FRecord.Data).Format and not $0001;
end;

procedure TAreaFormat.SetBackgroundColor(const Value: TExcelColor);
begin
  Check;
  PCRecAREAFORMAT(FRecord.Data).ColorBgIndex := Word(Value);
  PCRecAREAFORMAT(FRecord.Data).ColorBgRGB := XColorToRGB(Value);
end;

procedure TAreaFormat.SetDefault;
begin
  PCRecAREAFORMAT(FRecord.Data).ColorFgRGB := $00FFFFFF;
  PCRecAREAFORMAT(FRecord.Data).ColorBgRGB := $00000000;
  PCRecAREAFORMAT(FRecord.Data).Pattern := $0001;
  PCRecAREAFORMAT(FRecord.Data).Format := $0001;
  PCRecAREAFORMAT(FRecord.Data).ColorFgIndex := $004E;
  PCRecAREAFORMAT(FRecord.Data).ColorBgIndex := $004E;
end;

procedure TAreaFormat.SetForegroundColor(const Value: TExcelColor);
begin
  Check;
  PCRecAREAFORMAT(FRecord.Data).ColorFgIndex := Word(Value);
  PCRecAREAFORMAT(FRecord.Data).ColorFgRGB := XColorToRGB(Value);
end;

procedure TAreaFormat.SetPattern(const Value: TExcelFillPattern);
begin
  Check;
  PCRecAREAFORMAT(FRecord.Data).Pattern := Word(Value);
end;

procedure TAreaFormat.SetSwapColorWhenNeg(const Value: boolean);
begin
  Check;
  if Value then
    PCRecAREAFORMAT(FRecord.Data).Format := PCRecAREAFORMAT(FRecord.Data).Format or $0002
  else
    PCRecAREAFORMAT(FRecord.Data).Format := PCRecAREAFORMAT(FRecord.Data).Format and not $0002;
end;

{ TRecordObject }

procedure TRecordObject.Assign(Rec: TChartRecord);
begin
  FRecord := Rec;
end;

procedure TRecordObject.Check;
begin
  if FRecord = Nil then
    raise Exception.Create('Property has no data.');
end;

procedure TRecordObject.Check(Index: integer);
begin
  Check;
  if Index >= FRecord.Count then
    raise Exception.Create('Property has no data.');
end;

function TRecordObject.GetValid: boolean;
begin
  Result := FRecord <> Nil;
end;

{ TMarkerFormat }

function TMarkerFormat.GetAutomatic: boolean;
begin
  Check;
  Result := (PCRecMARKERFORMAT(FRecord.Data).Format and $0001) = $0001;
end;

function TMarkerFormat.GetBackgroundColor: TExcelColor;
begin
  Check;
  Result := IntToXColor(PCRecMARKERFORMAT(FRecord.Data).ColorBgIndex);
end;

function TMarkerFormat.GetForegroundColor: TExcelColor;
begin
  Check;
  Result := IntToXColor(PCRecMARKERFORMAT(FRecord.Data).ColorFgIndex);
end;

function TMarkerFormat.GetMarkerStyle: TChartMarkerStyle;
begin
  Check;
  Result := TChartMarkerStyle(PCRecMARKERFORMAT(FRecord.Data).TypeOfMarker);
end;

function TMarkerFormat.GetSize: integer;
begin
  Check;
  Result := PCRecMARKERFORMAT(FRecord.Data).Size;
end;

procedure TMarkerFormat.SetAutomatic(const Value: boolean);
begin
  Check;
  if Value then
    PCRecMARKERFORMAT(FRecord.Data).Format := PCRecMARKERFORMAT(FRecord.Data).Format or $0001
  else
    PCRecMARKERFORMAT(FRecord.Data).Format := PCRecMARKERFORMAT(FRecord.Data).Format and not $0001;
end;

procedure TMarkerFormat.SetBackgroundColor(const Value: TExcelColor);
begin
  Check;
  PCRecMARKERFORMAT(FRecord.Data).ColorBgIndex := Word(Value);
  PCRecMARKERFORMAT(FRecord.Data).ColorBgRGB := XColorToRGB(Value);
end;

procedure TMarkerFormat.SetForegroundColor(const Value: TExcelColor);
begin
  Check;
  PCRecMARKERFORMAT(FRecord.Data).ColorFgIndex := Word(Value);
  PCRecMARKERFORMAT(FRecord.Data).ColorFgRGB := XColorToRGB(Value);
end;

procedure TMarkerFormat.SetMarkerStyle(const Value: TChartMarkerStyle);
begin
  Check;
  PCRecMARKERFORMAT(FRecord.Data).TypeOfMarker := Word(Value);
  PCRecMARKERFORMAT(FRecord.Data).Format := 0
{
  if Value = cmsNone then
    PCRecMARKERFORMAT(FRecord.Data).Format := 0
  else
    PCRecMARKERFORMAT(FRecord.Data).Format := 1;
}    
end;

procedure TMarkerFormat.SetSize(const Value: integer);
begin
  Check;
  PCRecMARKERFORMAT(FRecord.Data).Size := Value;
end;

{ TTextFrame }

procedure TTextFrame.Assign(Rec: TChartRecord);
var
  i: integer;
begin
  inherited Assign(Rec);
  for i := 0 to FRecord.Count - 1 do begin
    case FRecord[i].RecId of
      CHARTRECID_LINEFORMAT: FLineFormat.Assign(FRecord[i]);
      CHARTRECID_AREAFORMAT: FAreaFormat.Assign(FRecord[i]);
    end;
  end;
end;

constructor TTextFrame.Create;
begin
  FLineFormat := TLineFormat.Create;
  FAreaFormat := TAreaFormat.Create;
end;

destructor TTextFrame.Destroy;
begin
  FLineFormat.Free;
  FAreaFormat.Free;
  inherited;
end;

function TTextFrame.GetAutoPosition: boolean;
begin
  Result := (PCRecFRAME(FRecord.Data).Flags and $0001) = $0001;
end;

function TTextFrame.GetAutoSize: boolean;
begin
  Result := (PCRecFRAME(FRecord.Data).Flags and $0002) = $0002;
end;

function TTextFrame.GetShadow: boolean;
begin
  Result := PCRecFRAME(FRecord.Data).FrameType = 4;
end;

procedure TTextFrame.SetAutoPosition(const Value: boolean);
begin
  if Value then
    PCRecFRAME(FRecord.Data).Flags := PCRecFRAME(FRecord.Data).Flags or $0001
  else
    PCRecFRAME(FRecord.Data).Flags := PCRecFRAME(FRecord.Data).Flags and not $0001
end;

procedure TTextFrame.SetAutoSize(const Value: boolean);
begin
  if Value then
    PCRecFRAME(FRecord.Data).Flags := PCRecFRAME(FRecord.Data).Flags or $0002
  else
    PCRecFRAME(FRecord.Data).Flags := PCRecFRAME(FRecord.Data).Flags and not $0002
end;

procedure TTextFrame.SetShadow(const Value: boolean);
begin
  if Value then
    PCRecFRAME(FRecord.Data).FrameType := 4
  else
    PCRecFRAME(FRecord.Data).FrameType := 0;
end;

{ TChartLabel }

procedure TChartLabel.AssignRecords(Rec: TChartRecord);
var
  i: integer;
begin
  FRecord := Rec;
  for i := 0 to FRecord.Count - 1 do begin
    case FRecord[i].RecId of
      CHARTRECID_POS:        FRecPOS := FRecord[i];
      CHARTRECID_AI:         FRecAI := FRecord[i];
      CHARTRECID_SERIESTEXT: FRecSERIESTEXT := FRecord[i];
      CHARTRECID_OBJECTLINK: FRecOBJECTLINK := FRecord[i];
    end;
  end;
end;

constructor TChartLabel.Create(Collection: TCollection);
begin
  inherited;

end;

destructor TChartLabel.Destroy;
begin

  inherited;
end;

function TChartLabel.GetDataPointIndex: integer;
begin
  Result := PCRecOBJECTLINK(FRecOBJECTLINK).IndexData
end;

function TChartLabel.GetLabelType: TChartLabelType;
begin
  Result := TChartLabelType(PCRecOBJECTLINK(FRecOBJECTLINK).LinkedTo);
end;

function TChartLabel.GetSerieIndex: integer;
begin
  Result := PCRecOBJECTLINK(FRecOBJECTLINK).IndexSeries;
end;

function TChartLabel.GetText: WideString;
begin
  if FRecSERIESTEXT = Nil then
    Result := ''
  else
    Result := ByteStrToWideString(@PCRecSERIESTEXT(FRecSERIESTEXT.Data).Text,PCRecSERIESTEXT(FRecSERIESTEXT.Data).Length);
end;

function TChartLabel.GetXOffset: integer;
begin
  Result := PCRecPOS(FRecPOS).X1;
end;

function TChartLabel.GetYOffset: integer;
begin
  Result := PCRecPOS(FRecPOS).Y1;
end;

procedure TChartLabel.SetDataPointIndex(const Value: integer);
begin
  PCRecOBJECTLINK(FRecOBJECTLINK.Data).IndexData := Value;
end;

procedure TChartLabel.SetDefault;
begin
  FillChar(FRecord.Data^,SizeOf(TCRecTEXT),#0);
  PCRecTEXT(FRecord.Data).HorizAlignment := $02;
  PCRecTEXT(FRecord.Data).VertAlignment := $02;
  PCRecTEXT(FRecord.Data).BkgMode := $0001;
  PCRecTEXT(FRecord.Data).Options1 := $0081;
  PCRecTEXT(FRecord.Data).Options2 := $3D20;
  PCRecTEXT(FRecord.Data).ColorIndex := 77;

  FRecPOS := FRecord.InsertRecord(-1,CHARTRECID_POS,SizeOf(TCRecPOS));
  FillChar(FRecPOS.Data^,SizeOf(TCRecPOS),#0);
  PCRecPOS(FRecPOS.Data).TopLt := 2;
  PCRecPOS(FRecPOS.Data).TopRt := 2;

  FRecAI := FRecord.InsertRecord(-1,CHARTRECID_AI,SizeOf(TCRecAI));
  FillChar(FRecAI.Data^,SizeOf(TCRecAI),#0);
  PCRecAI(FRecAI.Data).ReferenceType := $01;

  FRecOBJECTLINK := FRecord.InsertRecord(-1,CHARTRECID_OBJECTLINK,SizeOf(TCRecOBJECTLINK));
  FillChar(FRecOBJECTLINK.Data^,SizeOf(TCRecOBJECTLINK),#0);
  PCRecOBJECTLINK(FRecOBJECTLINK