rm_chart.pas

中小企业管理系统------ ERP系统原代码

  i: Integer;
  liLegS, liValS, liLabelS, s: string;
  lMetafile: TMetafile;
  lBitmap: TBitmap;
  liSeries: TRMChartSeries;
  liFlag, liHaveLabel: Boolean;

  procedure PaintChart;
  begin
    if FillColor = clNone then
      Chart.Color := clWhite
    else
      Chart.Color := FillColor;

    case FPrintType of
      0:
        begin
          lMetafile := Chart.TeeCreateMetafile(True {False}, Rect(0, 0, SaveDX, SaveDY));
          try
            Canvas.StretchDraw(DRect, lMetafile);
          finally
            lMetafile.Free;
          end;
        end;
      1:
        begin
          lBitmap := TBitmap.Create;
          try
            lBitmap.Width := SaveDX;
            lBitmap.Height := SaveDY;
            Chart.Draw(lBitmap.Canvas, Rect(0, 0, SaveDX, SaveDY));
            RMPrintGraphic(Canvas, DRect, lBitmap, IsPrinting);
          finally
            lBitmap.Free;
          end;
        end;
    end;
  end;

  function Str2Float(s: string): Double;
  begin
    s := Trim(s);
    while (Length(s) > 0) and not (s[1] in ['0'..'9']) do
      s := Copy(s, 2, 255); // trim all non-digit chars at the begin
    while (Length(s) > 0) and not (s[Length(s)] in ['0'..'9']) do
      s := Copy(s, 1, Length(s) - 1); // trim all non-digit chars at the end
    while Pos(ThousandSeparator, s) <> 0 do
      Delete(s, Pos(ThousandSeparator, s), 1);
    Result := 0;
    try
      Result := StrToFloat(s);
    except
    end;
  end;

  procedure SortValues(var aLegS, aValS: string);
  var
    i, j: Integer;
    sl: TStringList;
    s: string;
    d: Double;
  begin
    sl := TStringList.Create;
    try
      sl.Sorted := True;
      i := 1; j := 1;
      while i <= Length(aLegS) do
      begin
        sl.Add(SysUtils.Format('%12.3f', [Str2Float(RMExtractFieldName(aValS, j))]) + '=' +
          RMExtractFieldName(aLegS, i));
      end;

      aLegS := ''; aValS := '';
      for i := 1 to liSeries.ChartOptions.Top10Num do
      begin
        s := sl[sl.Count - i];
        aValS := aValS + Copy(s, 1, Pos('=', s) - 1) + ';';
        aLegS := aLegS + Copy(s, Pos('=', s) + 1, 255) + ';';
      end;

      i := sl.Count - liSeries.ChartOptions.Top10Num - 1; d := 0;
      while i >= 0 do
      begin
        s := sl[i];
        d := d + Str2Float(Copy(s, 1, Pos('=', s) - 1));
        Dec(i);
      end;

      if liSeries.Top10Label <> '' then
      begin
        aLegS := aLegS + liSeries.Top10Label + ';';
        aValS := aValS + FloatToStr(d) + ';';
      end;
    finally
      sl.Free;
    end;
  end;

  procedure _AddSeries(aIndex: Integer; aLegS, aValS, aLabelS: string);
  var
    i, j, k, c1, c2: Integer;
    Ser: TChartSeries;
    lFlag_NumberString: Boolean;
  begin
    if not PUseChartSetting then
    begin
      Chart.View3DWalls := liSeries.ChartOptions.ChartType <> 5;
{$IFDEF Delphi4}
      Chart.View3DOptions.Orthogonal := liSeries.ChartOptions.ChartType <> 5;
{$ENDIF}

      Ser := ChartTypes[liSeries.ChartOptions.ChartType].Create(Chart);
      Ser.Title := liSeries.Title;
      Ser.ColorEachPoint := liSeries.ChartOptions.Colored;
      Ser.Marks.Visible := liSeries.ChartOptions.ShowMarks;
      Ser.Marks.Style := TSeriesMarksStyle(liSeries.ChartOptions.MarksStyle);
{$IFNDEF Delphi2}
      Ser.Marks.Font.Charset := rmCharset;
{$ENDIF}
      Chart.AddSeries(Ser);
    end
    else
    begin
      Ser := Chart.SeriesList[aIndex];
      Ser.Clear;
    end;

    c1 := 0;
    lFlag_NumberString := True;
    for i := 1 to Length(aLegS) do
    begin
      if not (aLegS[i] in [' ', ';', '.', '0'..'9']) then
        lFlag_NumberString := False;
      if aLegS[i] = ';' then Inc(c1);
    end;
    c2 := 0;
    for i := 1 to Length(aValS) do
    begin
      if aValS[i] = ';' then Inc(c2);
    end;
    if c1 <> c2 then Exit;

    if (liSeries.ChartOptions.Top10Num > 0) and (c1 > liSeries.ChartOptions.Top10Num) then
      SortValues(aLegS, aValS);
    i := 1; j := 1; k := 1;
    while i <= Length(aLegS) do
    begin
      s := RMExtractFieldName(aValS, j);
      if lFlag_NumberString then
      begin
        if Ser.ColorEachPoint then
          Ser.AddXY(Str2Float(RMExtractFieldName(aLegS, i)), Str2Float(s),
            RMExtractFieldName(aLabelS, k), clTeeColor)
        else
          Ser.AddXY(Str2Float(RMExtractFieldName(aLegS, i)), Str2Float(s),
            RMExtractFieldName(aLabelS, k), liSeries.Color);
      end
      else
      begin
        if Ser.ColorEachPoint then
          Ser.Add(Str2Float(s), RMExtractFieldName(aLegS, i), clTeeColor)
        else
          Ser.Add(Str2Float(s), RMExtractFieldName(aLegS, i), liSeries.Color);
      end;
    end;
  end;

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

  if liFlag and (Memo.Count = 0) then
  begin
    if FPicture.Width = 0 then
    begin
      PaintChart;
      Result := TRUE;
      Exit;
    end
    else
    begin
      Canvas.StretchDraw(DRect, FPicture);
      Result := TRUE;
      Exit;
    end;
  end;

  Result := False;
  if FList.Count < 1 then Exit;

  if not PUseChartSetting then
  begin
    Chart.RemoveAllSeries;
    Chart.Frame.Visible := False;
    Chart.LeftWall.Brush.Style := bsClear;
    Chart.BottomWall.Brush.Style := bsClear;

{$IFNDEF Delphi2}
    Chart.Legend.Font.Charset := rmCharset;
    Chart.BottomAxis.LabelsFont.Charset := rmCharset;
    Chart.LeftAxis.LabelsFont.Charset := rmCharset;
    Chart.TopAxis.LabelsFont.Charset := rmCharset;
    Chart.BottomAxis.LabelsFont.Charset := rmCharset;
{$ENDIF}
{$IFDEF Delphi4}
    Chart.BackWall.Brush.Style := bsClear;
    Chart.View3DOptions.Elevation := 315;
    Chart.View3DOptions.Rotation := 360;
{$ENDIF}
  end;
  Chart.View3D := ChartDim3D;
  Chart.Legend.Visible := ChartShowLegend;
  Chart.AxisVisible := ChartShowAxis;

  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
        liLegS := Memo[i * 3];
        liValS := Memo[i * 3 + 1];
        liLabelS := Memo[i * 3 + 2];
      end
      else
      begin
        liLegS := Memo[i * 2];
        liValS := Memo[i * 2 + 1];
        liLabelS := '';
      end;

      if (liLegS <> '') and (liLegS[Length(liLegS)] <> ';') then
        liLegS := liLegS + ';';
      if (liValS <> '') and (liValS[Length(liValS)] <> ';') then
        liValS := liValS + ';';
      if (liLabelS <> '') and (liLabelS[Length(liLabelS)] <> ';') then
        liLabelS := liLabelS + ';';

      liSeries := Series[i];
      _AddSeries(i, liLegS, liValS, liLabelS);
    end;
  end;

  PaintChart;
  Result := True;
end;

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

procedure TRMChartView.StreamOut(Stream: TStream);
begin
  inherited StreamOut(Stream);
  Memo.Text := '';
end;

type
  TRMOldChartOptions = packed record
    ChartType: Byte;
    ChartDim3D, ChartIsSingle, ChartShowLegend, ChartShowAxis, ShowMarks, Colored: Boolean;
    MarksStyle: Byte;
    Top10Num: Integer;
    Reserved: array[0..35] of Byte;
  end;

procedure TRMChartView.LoadFromStream(Stream: TStream);
var
  b: Byte;
  s: TStream;
  i, liCount: Integer;
  liSeries: TRMChartSeries;
  liOldChartOptions: TRMOldChartOptions;
  lMax, lMin: Double;
begin
  inherited LoadFromStream(Stream);
  if LVersion < 11 then PUseChartSetting := False;
  FPicture.Clear;
  Clear;
  Stream.Read(b, 1);
  if b = 1 then
  begin
    s := TMemoryStream.Create;
    try
      s.CopyFrom(Stream, RMReadInteger(Stream));
      s.Position := 0;
      FPicture.LoadFromStream(s);
    finally
      s.Free;
    end;
  end;

  if (b = 0) or (LVersion > 10) then
  begin
    if RMVersion * 100 + HVersion * 10 + LVersion >= 40 * 100 + 0 * 10 + 1 then
    begin
      ChartDim3D := RMReadBoolean(Stream);
      ChartShowLegend := RMReadBoolean(Stream);
      ChartShowAxis := RMReadBoolean(Stream);
      liCount := RMReadWord(Stream);
      for i := 1 to liCount do
      begin
        liSeries := AddSeries;
        Stream.Read(liSeries.ChartOptions, SizeOf(TRMChartOptions));
        liSeries.LegendObj := RMReadString(Stream);
        liSeries.ValueObj := RMReadString(Stream);
        if LVersion > 10 then
          liSeries.LabelObj := RMReadString(Stream)
        else
          liSeries.LabelObj := '';
        liSeries.Top10Label := RMReadString(Stream);
        liSeries.Title := RMReadString(Stream);
        if RMVersion * 100 + HVersion * 10 + LVersion > 42 * 100 + 0 * 10 + 0 then
          liSeries.Color := RMReadInteger(Stream);
      end;
    end
    else
    begin
      liSeries := AddSeries;
      Stream.Read(liOldChartOptions, SizeOf(TRMOldChartOptions));
      liSeries.ChartOptions.ChartType := liOldChartOptions.ChartType;
      liSeries.ChartOptions.MarksStyle := liOldChartOptions.MarksStyle;
      liSeries.ChartOptions.Top10Num := liOldChartOptions.Top10Num;
      liSeries.ChartOptions.ShowMarks := liOldChartOptions.ShowMarks;
      liSeries.ChartOptions.Colored := liOldChartOptions.Colored;
      ChartDim3D := liOldChartOptions.ChartDim3D;
      ChartShowLegend := liOldChartOptions.ChartShowLegend;
      ChartShowAxis := liOldChartOptions.ChartShowAxis;
      liSeries.LegendObj := RMReadString(Stream);
      liSeries.ValueObj := RMReadString(Stream);
      liSeries.LabelObj := '';
      liSeries.Top10Label := RMReadString(Stream);
      liSeries.Title := RMReadString(Stream);
    end;
  end;

  if RMVersion * 100 + HVersion * 10 + LVersion > 41 * 100 + 0 * 10 + 0 then
    FPrintType := RMReadByte(Stream);

  if LVersion >= 10 then
  begin
    FChart.LeftAxis.AxisValuesFormat := RMReadString(Stream);
    FChart.LeftAxis.Increment := RMReadFloat(Stream);
    lMax := RMReadFloat(Stream);
    lMin := RMReadFloat(Stream);
    FChart.LeftAxis.SetMinMax(lMin, lMax);
    FChart.LeftAxis.Automatic := RMReadBoolean(Stream);
    FChart.LeftAxis.AutomaticMaximum := RMReadBoolean(Stream);
    FChart.LeftAxis.AutomaticMinimum := RMReadBoolean(Stream);

    FChart.BottomAxis.AxisValuesFormat := RMReadString(Stream);
    FChart.BottomAxis.Increment := RMReadFloat(Stream);
    lMax := RMReadFloat(Stream);
    LMin := RMReadFloat(Stream);
    FChart.BottomAxis.SetMinMax(lMin, lMax);
    FChart.BottomAxis.Automatic := RMReadBoolean(Stream);
    FChart.BottomAxis.AutomaticMaximum := RMReadBoolean(Stream);
    FChart.BottomAxis.AutomaticMinimum := RMReadBoolean(Stream);

    RMReadFont(Stream, FChart.Legend.Font);
    FChart.Legend.Alignment := TLegendAlignment(RMReadByte(Stream));
  end;

  if PUseChartSetting then
  begin
    FChart.Free;
    FChart := TChart.Create(RMDialogForm);
    with FChart do
    begin
      Parent := RMDialogForm;
      Visible := False;
      BevelInner := bvNone;
      BevelOuter := bvNone;
    end;

    Stream.ReadComponent(FChart);
{$IFNDEF TeeChartPro}
    FChart.RemoveAllSeries;
    PUseChartSetting := False;
{$ENDIF}
  end;
end;

procedure TRMChartView.SaveToStream(Stream: TStream);
var
  b: Byte;
  s: TStream;
  EMF: TMetafile;
  i: Integer;
  liFlag: Boolean;
  liSeries: TRMChartSeries;
begin
  LVersion := 11;
  inherited SaveToStream(Stream);

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

  if liFlag and (Memo.Count = 0) then
  begin
    b := 1;
    Stream.Write(b, 1);

    s := TMemoryStream.Create;
    try
      EMF := FChart.TeeCreateMetafile(FALSE, Rect(0, 0, DX, DY));
      try
        EMF.SaveToStream(s);
      finally
        EMF.Free;
      end;

      s.Position := 0;
      RMWriteInteger(Stream, s.Size);
      Stream.CopyFrom(s, 0);
    finally
      s.Free;
    end;
  end
  else
  begin
    b := 0; // internal chart version
    Stream.Write(b, 1);
  end;

  begin
    RMWriteBoolean(Stream, ChartDim3D);
    RMWriteBoolean(Stream, ChartShowLegend);
    RMWriteBoolean(Stream, ChartShowAxis);
    RMWriteWord(Stream, FList.Count);
    for i := 0 to FList.Count - 1 do
    begin
      Stream.Write(Series[i].ChartOptions, SizeOf(TRMChartOptions));
      RMWriteString(Stream, Series[i].LegendObj);
      RMWriteString(Stream, Series[i].ValueObj);
      RMWriteString(Stream, Series[i].LabelObj);
      RMWriteString(Stream, Series[i].Top10Label);
      RMWriteString(Stream, Series[i].Title);
      RMWriteInteger(Stream, Series[i].Color);
    end;
  end;

  RMWriteByte(Stream, FPrintType);

  RMWriteString(Stream, FChart.LeftAxis.AxisValuesFormat);
  RMWriteFloat(Stream, FChart.LeftAxis.Increment);
  RMWriteFloat(Stream, FChart.LeftAxis.Maximum);
  RMWriteFloat(Stream, FChart.LeftAxis.Minimum);
  RMWriteBoolean(Stream, FChart.LeftAxis.Automatic);
  RMWriteBoolean(Stream, FChart.LeftAxis.AutomaticMaximum);
  RMWriteBoolean(Stream, FChart.LeftAxis.AutomaticMinimum);

  RMWriteString(Stream, FChart.BottomAxis.AxisValuesFormat);
  RMWriteFloat(Stream, FChart.BottomAxis.Increment);
  RMWriteFloat(Stream, FChart.BottomAxis.Maximum);
  RMWriteFloat(Stream, FChart.BottomAxis.Minimum);
  RMWriteBoolean(Stream, FChart.BottomAxis.Automatic);
  RMWriteBoolean(Stream, FChart.BottomAxis.AutomaticMaximum);
  RMWriteBoolean(Stream, FChart.BottomAxis.AutomaticMinimum);