rm_chart.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 1,438 行 · 第 1/3 页

  procedure _AddSeries(aIndex: Integer; aHaveLabel: Boolean);
  var
    i: Integer;
    lSeries: TChartSeries;

    procedure _SetSeriesType;
    begin
      if UseChartSetting and (aIndex < Chart.SeriesCount) then
        lSeries := Chart.SeriesList[aIndex]
      else
        lSeries := ChartTypes[liChartSeries.ChartType].Create(Chart);

      lSeries := ChartTypes[liChartSeries.ChartType].Create(Chart);
      lSeries.Title := liChartSeries.Title;
      lSeries.ColorEachPoint := liChartSeries.Colored;
      lSeries.Marks.Visible := liChartSeries.ShowMarks;
      lSeries.Marks.Style := TSeriesMarksStyle(liChartSeries.MarksStyle);
      Chart.View3DWalls := liChartSeries.ChartType <> 5;
      lSeries.Marks.Font.Charset := rmCharset;
  {$IFDEF Delphi4}
      Chart.View3DOptions.Orthogonal := liChartSeries.ChartType <> 5;
  {$ENDIF}

      if not UseChartSetting then
      begin
        Chart.AddSeries(lSeries);
      end
      else
      begin
        lSeries.Clear;
      end;
    end;

    procedure _SortValues;
    var
      i: Integer;
      d: Double;
    begin
      d := 0;
      for i := liChartSeries.Top10Num to liValues.Count - 1 do
        d := d + StrToFloat(liValues[i]);

      while liLegends.Count > liChartSeries.Top10Num do
      begin
        liLegends.Delete(liChartSeries.Top10Num);
        liValues.Delete(liChartSeries.Top10Num);
        if liLabels.Count > 0 then
          liLabels.Delete(liChartSeries.Top10Num);
      end;

//      if liChartSeries.Top10Label <> '' then
//      begin
      liLegends.Add(liChartSeries.Top10Label);
      liValues.Add(FloatToStr(d));
      if liLabels.Count > 0 then
        liLabels.Add(liChartSeries.Top10Label);
//      end;
    end;

  begin
    if liLegends.Count <> liValues.Count then Exit;
    if (liLabels.Count > 0) and (liLabels.Count <> liLegends.Count) then Exit;

    _SetSeriesType;
    if (liChartSeries.Top10Num > 0) and (liLegends.Count > liChartSeries.Top10Num) then
      _SortValues;

    for i := 0 to liLegends.Count - 1 do
    begin
      if aHaveLabel then
      begin
        if lSeries.ColorEachPoint then
          lSeries.AddXY(StrToFloat(liLegends[i]), StrToFloat(liValues[i]), liLabels[i], clTeeColor)
        else
          lSeries.AddXY(_StrToFloat(liLegends[i]), StrToFloat(liValues[i]), liLabels[i], liChartSeries.Color);
      end
      else
      begin
        if lSeries.ColorEachPoint then
          lSeries.Add(StrToFloat(liValues[i]), liLegends[i], clTeeColor)
        else
          lSeries.Add(StrToFloat(liValues[i]), liLegends[i], liChartSeries.Color);
      end;
    end;
  end;

  procedure _BuildSeries;
  var
    i, liPos: Integer;
    liLegendStr, liValueStr, liLabelStr: string;
    liHaveLabel: Boolean;
    lFlag_NumberString: Boolean;
    str: string;
  begin
    try
      if (FList.Count * 2 = Memo.Count) or (FList.Count * 3 = Memo.Count) then
      begin
        liHaveLabel := FList.Count * 3 = Memo.Count;
        for i := 0 to FList.Count - 1 do
        begin
          if liHaveLabel then
          begin
            liLegendStr := Memo[i * 3];
            liValueStr := Memo[i * 3 + 1];
            liLabelStr := Memo[i * 3 + 2];
          end
          else
          begin
            liLegendStr := Memo[i * 2];
            liValueStr := Memo[i * 2 + 1];
            liLabelStr := '';
          end;

          if (liLegendStr <> '') and (liLegendStr[Length(liLegendStr)] <> ';') then
            liLegendStr := liLegendStr + ';';
          if (liValueStr <> '') and (liValueStr[Length(liValueStr)] <> ';') then
            liValueStr := liValueStr + ';';
          if (liLabelStr <> '') and (liLabelStr[Length(liLabelStr)] <> ';') then
            liLabelStr := liLabelStr + ';';

          liLegends.Clear; liValues.Clear; liLabels.Clear;
          lFlag_NumberString := True;
          for liPos := 1 to Length(liLegendStr) do
          begin
            if not (liLegendStr[liPos] in ['-', ' ', ';', '.', '0'..'9']) then
            begin
              lFlag_NumberString := False;
              Break;
            end;
          end;

          liPos := 1;
          while liPos <= Length(liLegendStr) do
            liLegends.Add(_ExtractStr(liLegendStr, liPos));

          liPos := 1;
          while liPos <= Length(liValueStr) do
          begin
            str := _ExtractStr(liValueStr, liPos);
            if RMisNumeric(str) then
              liValues.Add(SysUtils.Format('%12.3f', [_StrToFloat(str)]))
            else
              liValues.Add('0');
          end;

          if liHaveLabel then
          begin
            liPos := 1;
            while liPos <= Length(liLabelStr) do
              liLabels.Add(_ExtractStr(liLabelStr, liPos));
          end;

          liChartSeries := Series[i];
          _AddSeries(i, lFlag_NumberString and liHaveLabel);
        end;
      end;
    finally
    end;
  end;

begin
  liFlag := True;
  for i := 0 to FList.Count - 1 do
  begin
    liChartSeries := Series[i];
    if (liChartSeries.LegendView <> '') or (liChartSeries.ValueView <> '') then
    begin
      liFlag := False;
      Break;
    end;
  end;

  if liFlag and (Memo.Count = 0) then
  begin
    if FPicture.Width = 0 then
      _PaintChart
    else
      Canvas.StretchDraw(RealRect, FPicture);
    Exit;
  end;

  if FList.Count < 1 then Exit;

  liLegends := TStringList.Create;
  liValues := TStringList.Create;
  liLabels := TStringList.Create;
  try
    _SetChartProp;
    _BuildSeries;
    _PaintChart;
  finally
    liLegends.Free;
    liValues.Free;
    liLabels.Free;
  end;
end;

procedure TRMChartView.Draw(aCanvas: TCanvas);
begin
  BeginDraw(aCanvas);
  Memo1.Assign(Memo);
  CalcGaps;
  ShowBackground;
  ShowChart;
  ShowFrame;
  RestoreCoord;
end;

procedure TRMChartView.PlaceOnEndPage(aStream: TStream);
begin
	if UseDoublePass and (ParentReport.MasterReport.DoublePass and ParentReport.MasterReport.FinalPass) then
  	Memo.Text := FSaveMemo;

  inherited PlaceOnEndPage(aStream);
  Memo.Text := '';
end;

procedure TRMChartView.LoadFromStream(aStream: TStream);
var
  b: Byte;
  liStream: TMemoryStream;
  i, liCount: Integer;
  lSeries: TRMChartSeries;
begin
  inherited LoadFromStream(aStream);
  RMReadWord(aStream);

  Clear;
  FPicture.Clear;
  ChartDim3D := RMReadBoolean(aStream);
  ChartShowLegend := RMReadBoolean(aStream);
  ChartShowAxis := RMReadBoolean(aStream);
  FPrintType := TRMPrintMethodType(RMReadByte(aStream));
  liCount := RMReadWord(aStream);
  for i := 1 to liCount do
  begin
    lSeries := AddSeries;
    lSeries.LegendView := RMReadString(aStream);
    lSeries.ValueView := RMReadString(aStream);
    lSeries.LabelView := RMReadString(aStream);
    lSeries.Top10Label := RMReadString(aStream);
    lSeries.Title := RMReadString(aStream);
    lSeries.Color := RMReadInt32(aStream);
    lSeries.ChartType := RMReadByte(aStream);
    lSeries.ShowMarks := RMReadBoolean(aStream);
    lSeries.Colored := RMReadBoolean(aStream);
    lSeries.MarksStyle := RMReadByte(aStream);
    lSeries.Top10Num := RMReadInt32(aStream);
  end;

  b := RMReadByte(aStream);
  if b = 1 then
  begin
    liStream := TMemoryStream.Create;
    try
      liStream.CopyFrom(aStream, RMReadInt32(aStream));
      liStream.Position := 0;
      FPicture.LoadFromStream(liStream);
    finally
      liStream.Free;
    end;
  end;

  b := RMReadByte(aStream);
  if b = 1 then
  begin
    FreeAndNil(FChart);
    FChart := TChart.Create(RMDialogForm);
    with FChart do
    begin
      Parent := RMDialogForm;
      Visible := False;
      BevelInner := bvNone;
      BevelOuter := bvNone;
    end;

    liStream := TMemoryStream.Create;
    try
      liStream.CopyFrom(aStream, RMReadInt32(aStream));
      liStream.Position := 0;
      liStream.ReadComponent(FChart);
      FChart.Name := '';
      for i := 0 to FChart.SeriesList.Count - 1 do
        FChart.SeriesList[i].Name := '';
    finally
      liStream.Free;
    end;
  end;
end;

procedure TRMChartView.SaveToStream(aStream: TStream);
var
  liStream: TMemoryStream;
  liEMF: TMetafile;
  i: Integer;
  liFlag: Boolean;
  lSeries: TRMChartSeries;
  liSavePos, liSavePos1, liPos: Integer;
begin
  inherited SaveToStream(aStream);
  RMWriteWord(aStream, 0);

  liFlag := True;
  for i := 0 to FList.Count - 1 do
  begin
    lSeries := Series[i];
    if (lSeries.LegendView <> '') or (lSeries.ValueView <> '') then
    begin
      liFlag := False;
      Break;
    end;
  end;

  RMWriteBoolean(aStream, ChartDim3D);
  RMWriteBoolean(aStream, ChartShowLegend);
  RMWriteBoolean(aStream, ChartShowAxis);
  RMWriteByte(aStream, Byte(FPrintType));
  RMWriteWord(aStream, FList.Count);
  for i := 0 to FList.Count - 1 do
  begin
    RMWriteString(aStream, Series[i].LegendView);
    RMWriteString(aStream, Series[i].ValueView);
    RMWriteString(aStream, Series[i].LabelView);
    RMWriteString(aStream, Series[i].Top10Label);
    RMWriteString(aStream, Series[i].Title);
    RMWriteInt32(aStream, Series[i].Color);
    RMWriteByte(aStream, Series[i].ChartType);
    RMWriteBoolean(aStream, Series[i].ShowMarks);
    RMWriteBoolean(aStream, Series[i].Colored);
    RMWriteByte(aStream, Series[i].MarksStyle);
    RMWriteInt32(aStream, Series[i].Top10Num);
  end;

  if liFlag and (Memo.Count = 0) then
  begin
    RMWriteByte(aStream, 1);
    liStream := TMemoryStream.Create;
    liEMF := nil;
    try
      liEMF := FChart.TeeCreateMetafile(FALSE, Rect(0, 0, spWidth, spHeight));
      liEMF.SaveToStream(liStream);

      liStream.Position := 0;
      RMWriteInt32(aStream, liStream.Size);
      aStream.CopyFrom(liStream, 0);
    finally
      liStream.Free;
      if liEMF <> nil then liEMF.Free;
    end;
  end
  else
    RMWriteByte(aStream, 0);

  if UseChartSetting then
  begin
    FChart.Name := '';
    for i := 0 to FChart.SeriesList.Count - 1 do
      FChart.SeriesList[i].Name := '';
      
    RMWriteByte(aStream, 1);
    liSavePos := aStream.Position;
    RMWriteInt32(aStream, liSavePos);
    liSavePos1 := aStream.Position;
    aStream.WriteComponent(FChart);
    liPos := aStream.Position;
    aStream.Position := liSavePos;
    RMWriteInt32(aStream, liPos - liSavePos1);
    aStream.Position := liPos;
  end
  else
    RMWriteByte(aStream, 0);
end;

procedure TRMChartView.DefinePopupMenu(Popup: TRMCustomMenuItem);
begin
  inherited DefinePopupMenu(Popup);
end;

procedure TRMChartView.Prepare;
var
  liIndex: Integer;
begin
  if not ParentReport.MasterReport.FinalPass then
	  FSaveMemo := '';

  Memo.Clear;
  for liIndex := 0 to FList.Count - 1 do
  begin
    Memo.Add('');
    Memo.Add('');
    Memo.Add('');
  end;
end;

procedure TRMChartView.OnHook(aView: TRMView);
var
  lSeries: TRMChartSeries;
  liIndex: Integer;

  procedure _GetValue(const aObjName: string; aIndex: Integer);
  var
    s: string;
  begin
    if AnsiCompareText(aView.Name, aObjName) = 0 then
    begin
      if THackView(aView).Memo1.Count > 0 then
      begin
        s := THackView(aView).Memo1[0];
        if s <> '' then
          Memo[aIndex] := Memo[aIndex] + s + ';'
        else
        begin
          if aIndex = liIndex * 3 + 1 then
            Memo[aIndex] := Memo[aIndex] + '0;'
          else
            Memo[aIndex] := Memo[aIndex] + ';';
        end
      end
      else
      begin
        if aIndex = liIndex * 3 + 1 then
          Memo[aIndex] := Memo[aIndex] + '0;'
        else
          Memo[aIndex] := Memo[aIndex] + ';';
      end
    end;
  end;

begin
  for liIndex := 0 to FList.Count - 1 do
  begin
    lSeries := Series[liIndex];
    _GetValue(lSeries.LegendView, liIndex * 3 + 0);
    _GetValue(lSeries.ValueView, liIndex * 3 + 1);
    _GetValue(lSeries.LabelView, liIndex * 3 + 2);
  end;

  if UseDoublePass and
  	(ParentReport.MasterReport.DoublePass and (not ParentReport.MasterReport.FinalPass)) then
  begin
  	FSaveMemo := Memo.Text;
  end;
end;

procedure TRMChartView.ShowEditor;
var
  tmpForm: TRMChartForm;
  liStream: TMemoryStream;
begin
  liStream := TMemoryStream.Create;
  tmpForm := TRMChartForm.Create(Application);
  try
    SaveToStream(liStream);
    liStream.Position := 0;
//    RMVersion := RMCurrentVersion;
    tmpForm.FChartView.LoadFromStream(liStream);
    if tmpForm.ShowModal = mrOK then
    begin
      RMDesigner.BeforeChange;
      liStream.Clear;
      tmpForm.FChartView.SaveToStream(liStream);
      liStream.Position := 0;
//      RMVersion := RMCurrentVersion;
      LoadFromStream(liStream);
      RMDesigner.AfterChange;
    end;
  finally
    liStream.Free;
    tmpForm.Free;
  end;
end;

function TRMChartView.GetUseChartSetting: Boolean;
begin
  Result := FFlags and flChartUseChartSetting = flChartUseChartSetting;
end;

procedure TRMChartView.SetUseChartSetting(Value: Boolean);
begin
  FFlags := FFlags and (not flChartUseChartSetting);