rm_chart.pas

report machine 2.3 功能强大

      Ser.ColorEachPoint := True;
    Ser.Marks.Visible := ChartOptions.ShowMarks;
    Ser.Marks.Style := TSeriesMarksStyle(ChartOptions.MarksStyle);
{$IFNDEF Delphi2}
    Ser.Marks.Font.Charset := rmCharset;
{$ENDIF}

    c1 := 0;
    for i := 1 to Length(LegS) do
    begin
      if LegS[i] = ';' then Inc(c1);
    end;
    c2 := 0;
    for i := 1 to Length(ValS) do
    begin
      if ValS[i] = ';' then Inc(c2);
    end;
    if c1 <> c2 then Exit;

    if (ChartOptions.Top10Num > 0) and (c1 > ChartOptions.Top10Num) then
      SortValues(LegS, ValS);
    i := 1; j := 1;
    while i <= Length(LegS) do
    begin
      s := ExtractFieldName(ValS, j);
      Ser.Add(Str2Float(s), ExtractFieldName(LegS, i), clTeeColor);
    end;
  end
  else
  begin
    c1 := 0;
    for i := 1 to Length(LegS) do
    begin
      if LegS[i] = ';' then Inc(c1);
    end;
    if c1 <> Memo.Count - 1 then Exit;

    i := 1;
    c1 := 1;
    while i <= Length(LegS) do
    begin
      Ser := ChartTypes[ChartOptions.ChartType].Create(Chart);
      Chart.AddSeries(Ser);
      Ser.Title := ExtractFieldName(LegS, i);
      Ser.Marks.Visible := ChartOptions.ShowMarks;
      Ser.Marks.Style := TSeriesMarksStyle(ChartOptions.MarksStyle);
      ValS := Memo[c1];
      if ValS[Length(ValS)] <> ';' then
        ValS := ValS + ';';
      j := 1;
      while j <= Length(ValS) do
      begin
        s := ExtractFieldName(ValS, j);
        Ser.Add(Str2Float(s), '', clTeeColor);
      end;
      Inc(c1);
    end;
  end;

  PaintChart;
  Result := True;
end;

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

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

procedure TRMChartView.LoadFromStream(Stream: TStream);
var
  b: Byte;
  s: TStream;
begin
  inherited LoadFromStream(Stream);
  FPicture.Clear;
  Stream.Read(b, 1);
  if b = 1 then
  begin
    s := TMemoryStream.Create;
    s.CopyFrom(Stream, RMReadInteger(Stream));
    s.Position := 0;
		FPicture.LoadFromStream(s);
    s.Free;
  end
  else
  begin
	  with Stream do
    begin
      Read(ChartOptions, SizeOf(ChartOptions));
      LegendObj := RMReadString(Stream);
      ValueObj := RMReadString(Stream);
      Top10Label := RMReadString(Stream);
    end;
  end;
end;

procedure TRMChartView.SaveToStream(Stream: TStream);
var
  b: Byte;
  s: TStream;
  EMF: TMetafile;
begin
	LVersion := 0;
  inherited SaveToStream(Stream);
  if (Memo.Count = 0) and (LegendObj = '') and (ValueObj = '') then
  begin
    b := 1;
    Stream.Write(b, 1);

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

    s.Position := 0;
    RMWriteInteger(Stream, s.Size);
    Stream.CopyFrom(s, 0);
    s.Free;
  end
  else
  begin
	  with Stream do
    begin
      b := 0; // internal chart version
      Write(b, 1);
      Write(ChartOptions, SizeOf(ChartOptions));
      RMWriteString(Stream, LegendObj);
      RMWriteString(Stream, ValueObj);
      RMWriteString(Stream, Top10Label);
    end;
  end;
end;

procedure TRMChartView.DefinePopupMenu(Popup: TPopupMenu);
var
  m: TMenuItem;
begin
  Inherited DefinePopupMenu(Popup);

  m := TMenuItem.Create(Popup);
  m.Caption := '-';
  Popup.Items.Add(m);

  m := TMenuItem.Create(Popup);
  m.Caption := TeeMsg_Version;
  Popup.Items.Add(m);

  m := TMenuItem.Create(Popup);
  m.Caption := TeeMsg_Copyright;
  Popup.Items.Add(m);
end;

procedure TRMChartView.OnHook(View: TRMView);
var
  i: Integer;
  s: string;
begin
  if (ValueObj <> '') and (LegendObj <> '') and (Memo.Count < 2) then
  begin
    Memo.Clear;
    Memo.Add('');
    Memo.Add('');
  end;
  i := -1;
  if AnsiCompareText(View.Name, LegendObj) = 0 then
  begin
    i := 0;
    Inc(FCurStr);
  end
  else if AnsiCompareText(View.Name, ValueObj) = 0 then
    i := FCurStr;
  if ChartOptions.IsSingle then
    FCurStr := 1;

  if i >= 0 then
  begin
    if Memo.Count <= i then
    begin
      while Memo.Count <= i do
        Memo.Add('');
    end;
    if THackView(View).Memo1.Count > 0 then
    begin
      s := THackView(View).Memo1[0];
      if FLastLegend <> s then
        Memo[i] := Memo[i] + s + ';';
      FLastLegend := s;
    end;
  end;
end;

procedure TRMChartView.ShowEditor;
var
  tmpForm: TRMChartForm;

  procedure SetButton(b: array of TSpeedButton; n: Integer);
  begin
    b[n].Down := True;
  end;

  function GetButton(b: array of TSpeedButton): Integer;
  var
    i: Integer;
  begin
    Result := 0;
    for i := 0 to High(b) do
      if b[i].Down then
        Result := i;
  end;

  procedure SetRButton(b: array of TRadioButton; n: Integer);
  begin
    b[n].Checked := True;
  end;

  function GetRButton(b: array of TRadioButton): Integer;
  var
    i: Integer;
  begin
    Result := 0;
    for i := 0 to High(b) do
      if b[i].Checked then
        Result := i;
  end;

begin
  tmpForm := TRMChartForm.Create(Application);
  try
    with tmpForm do
    begin
      Page1.ActivePage := Tab1;
      with ChartOptions do
      begin
        SetButton([SB1, SB2, SB3, SB4, SB5, SB6], ChartType);
        SetRButton([RB1, RB2, RB3, RB4, RB5], MarksStyle);
        CB1.Checked := Dim3D;
        CB2.Checked := IsSingle;
        CB3.Checked := ShowLegend;
        CB4.Checked := ShowAxis;
        CB5.Checked := ShowMarks;
        CB6.Checked := Colored;
        E1.Text := LegendObj;
        E2.Text := ValueObj;
        E3.Text := IntToStr(Top10Num);
        E4.Text := Top10Label;
        if ShowModal = mrOk then
        begin
          RMDesigner.BeforeChange;
          ChartType := GetButton([SB1, SB2, SB3, SB4, SB5, SB6]);
          MarksStyle := GetRButton([RB1, RB2, RB3, RB4, RB5]);
          Dim3D := CB1.Checked;
          IsSingle := CB2.Checked;
          ShowLegend := CB3.Checked;
          ShowAxis := CB4.Checked;
          ShowMarks := CB5.Checked;
          Colored := CB6.Checked;
          LegendObj := E1.Text;
          ValueObj := E2.Text;
          Top10Num := StrToInt(E3.Text);
          Top10Label := E4.Text;
          RMDesigner.AfterChange;
        end;
      end;
    end;
  finally
    tmpForm.Free;
  end;
end;

procedure TRMChartView.ChartEditor(Sender: TObject);
begin
  ShowEditor;
end;

function TRMChartView.GetViewCommon: string;
begin
	Result := '[Chart]';
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMChartForm }
procedure TRMChartForm.FormCreate(Sender: TObject);
begin
	Localize;
end;

procedure TRMChartForm.Localize;
begin
	Font.Name := RMLoadStr(SRMDefaultFontName);
  Font.Size := StrToInt(RMLoadStr(SRMDefaultFontSize));
  Font.Charset := StrToInt(RMLoadStr(SCharset));

  Caption := RMLoadStr(rmRes + 590);
  Tab1.Caption := RMLoadStr(rmRes + 591);
  Tab2.Caption := RMLoadStr(rmRes + 592);
  Tab3.Caption := RMLoadStr(rmRes + 604);
  GroupBox1.Caption := RMLoadStr(rmRes + 593);
  GroupBox2.Caption := RMLoadStr(rmRes + 594);
  GroupBox3.Caption := RMLoadStr(rmRes + 595);
  GroupBox4.Caption := RMLoadStr(rmRes + 605);
  GroupBox5.Caption := RMLoadStr(rmRes + 611);
  CB1.Caption := RMLoadStr(rmRes + 596);
  CB2.Caption := RMLoadStr(rmRes + 597);
  CB3.Caption := RMLoadStr(rmRes + 598);
  CB4.Caption := RMLoadStr(rmRes + 599);
  CB5.Caption := RMLoadStr(rmRes + 600);
  CB6.Caption := RMLoadStr(rmRes + 601);
  RB1.Caption := RMLoadStr(rmRes + 606);
  RB2.Caption := RMLoadStr(rmRes + 607);
  RB3.Caption := RMLoadStr(rmRes + 608);
  RB4.Caption := RMLoadStr(rmRes + 609);
  RB5.Caption := RMLoadStr(rmRes + 610);
  Label1.Caption := RMLoadStr(rmRes + 602);
  Label2.Caption := RMLoadStr(rmRes + 603);
  Label3.Caption := RMLoadStr(rmRes + 612);
  Label4.Caption := RMLoadStr(rmRes + 613);
  Label5.Caption := RMLoadStr(rmRes + 614);
  btnOk.Caption := RMLoadStr(SOk);
  btnCancel.Caption := RMLoadStr(SCancel);
end;

initialization
  RMRegisterObjectByRes(TRMChartView, 'RM_CHAROBJECT', RMLoadStr(SInsChart), TRMChartForm);

finalization

{$ENDIF}
end.