rm_dbchart.pas

胜天进销存源码,国产优秀的进销存

    SaveDY := RMToScreenPixels(mmSaveHeight, rmutMMThousandths);
    case FPrintType of
      rmptMetafile:
        begin
          lMetafile := DBChart.TeeCreateMetafile(True {False}, Rect(0, 0, SaveDX, SaveDY));
          try
            RMPrintGraphic(Canvas, RealRect, lMetafile, IsPrinting, DirectDraw, False);
          finally
            lMetafile.Free;
          end;
        end;
      rmptBitmap:
        begin
          lBitmap := TBitmap.Create;
          try
            lBitmap.Width := SaveDX;
            lBitmap.Height := SaveDY;
            DBChart.Draw(lBitmap.Canvas, Rect(0, 0, SaveDX, SaveDY));
            RMPrintGraphic(Canvas, RealRect, lBitmap, IsPrinting, DirectDraw, False);
          finally
            lBitmap.Free;
          end;
        end;
    end;
  end;

  procedure _AddSeries(const aIndex: Integer);
  var
    lSeries: TChartSeries;
    lComp: TComponent;
  begin
    FDBChart.View3DWalls := lChartSeries.ChartType <> 5;
{$IFDEF Delphi4}
    FDBChart.View3DOptions.Orthogonal := lChartSeries.ChartType <> 5;
{$ENDIF}

    if UseChartSetting and (aIndex < FDBChart.SeriesCount) then
      lSeries := FDBChart.SeriesList[aIndex]
    else
      lSeries := ChartTypes[lChartSeries.ChartType].Create(FDBChart);

    lSeries.Title := lChartSeries.Title;
    lSeries.ColorEachPoint := lChartSeries.Colored;
    lSeries.SeriesColor := lChartSeries.Color;
    lSeries.Marks.Visible := lChartSeries.ShowMarks;
    lSeries.Marks.Style := TSeriesMarksStyle(lChartSeries.MarksStyle);
{$IFNDEF Delphi2}
    lSeries.Marks.Font.Charset := rmCharset;
{$ENDIF}

    if UseChartSetting and (aIndex < FDBChart.SeriesCount) then
    begin
//      lSeries.Clear;
    end
    else
    begin
      FDBChart.AddSeries(lSeries);
    end;

    lComp := RMFindComponent(ParentReport.Owner, ParentReport.Dictionary.RealDataSetName[lChartSeries.DataSet]);
    if (lComp is TRMDBDataSet) and (TRMDBDataSet(lComp).DataSet <> nil) then
    begin
      lSeries.DataSource := TRMDBDataSet(lComp).DataSet;
      try
        lSeries.XValues.ValueSource := ParentReport.Dictionary.RealFieldName[lChartSeries.LegendView];
        lSeries.YValues.ValueSource := ParentReport.Dictionary.RealFieldName[lChartSeries.ValueView];
        lSeries.XLabelsSource := ParentReport.Dictionary.RealFieldName[lChartSeries.LabelView];
      except
        lChartSeries.LegendView := '';
        lChartSeries.ValueView := '';
        lChartSeries.LabelView := '';
      end;
    end;
  end;

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

  if lFlag 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;

  _SetChartProp;
  for i := 0 to FList.Count - 1 do
  begin
    lChartSeries := Series[i];
    _AddSeries(i);
  end;

  _PaintChart;
end;

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

procedure TDBRMChartView.PlaceOnEndPage(aStream: TStream);
begin
  inherited PlaceOnEndPage(aStream);
  Memo.Text := '';
end;

procedure TDBRMChartView.LoadFromStream(aStream: TStream);
var
  b: Byte;
  liStream: TMemoryStream;
  i, liCount: Integer;
  liSeries: 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
    liSeries := AddSeries;
    liSeries.DataSet := RMReadString(aStream);
    liSeries.LegendView := RMReadString(aStream);
    liSeries.ValueView := RMReadString(aStream);
    liSeries.LabelView := RMReadString(aStream);
    liSeries.Title := RMReadString(aStream);
    liSeries.Color := RMReadInt32(aStream);
    liSeries.ChartType := RMReadByte(aStream);
    liSeries.ShowMarks := RMReadBoolean(aStream);
    liSeries.Colored := RMReadBoolean(aStream);
    liSeries.MarksStyle := RMReadByte(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
    FDBChart.Free;
    FDBChart := TDBChart.Create(RMDialogForm);
    with FDBChart 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(FDBChart);
      FDBChart.Name := '';
      for i := 0 to FDBChart.SeriesList.Count - 1 do
        FDBChart.SeriesList[i].Name := '';
    finally
      liStream.Free;
    end;
  end;
end;

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

  liFlag := True;
  for i := 0 to FList.Count - 1 do
  begin
    liSeries := Series[i];
    if (liSeries.LegendView <> '') or (liSeries.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].DataSet);
    RMWriteString(aStream, Series[i].LegendView);
    RMWriteString(aStream, Series[i].ValueView);
    RMWriteString(aStream, Series[i].LabelView);
    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);
  end;

  if liFlag and (Memo.Count = 0) then
  begin
    RMWriteByte(aStream, 1);
    liStream := TMemoryStream.Create;
    liEMF := nil;
    try
      liEMF := FDBChart.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
    FDBChart.Name := '';
    for i := 0 to FDBChart.SeriesList.Count - 1 do
      FDBChart.SeriesList[i].Name := '';

    RMWriteByte(aStream, 1);
    liSavePos := aStream.Position;
    RMWriteInt32(aStream, liSavePos);
    liSavePos1 := aStream.Position;
    aStream.WriteComponent(FDBChart);
    liPos := aStream.Position;
    aStream.Position := liSavePos;
    RMWriteInt32(aStream, liPos - liSavePos1);
    aStream.Position := liPos;
  end
  else
    RMWriteByte(aStream, 0);
end;

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

procedure TDBRMChartView.Prepare;
begin
  Memo.Clear;
end;

procedure TDBRMChartView.ShowEditor;
var
  tmpForm: TRMDBChartForm;
  liStream: TMemoryStream;
begin
  liStream := TMemoryStream.Create;
  tmpForm := TRMDBChartForm.Create(Application);
  try
    SaveToStream(liStream);
    liStream.Position := 0;
//    RMVersion := RMCurrentVersion;
    tmpForm.FReport := ParentReport;
    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 TDBRMChartView.GetUseChartSetting: Boolean;
begin
  Result := FFlags and flChartUseChartSetting = flChartUseChartSetting;
end;

procedure TDBRMChartView.SetUseChartSetting(Value: Boolean);
begin
  FFlags := FFlags and (not flChartUseChartSetting);
//{$IFDEF TeeChartPro}
  if Value then
    FFlags := FFlags + flChartUseChartSetting;
//{$ENDIF}
end;

function TDBRMChartView.GetDirectDraw: Boolean;
begin
  Result := (FFlags and flChartDirectDraw) = flChartDirectDraw;
end;

procedure TDBRMChartView.SetDirectDraw(Value: Boolean);
begin
  FFlags := (FFlags and not flChartDirectDraw);
  if Value then
    FFlags := FFlags + flChartDirectDraw;
end;

function TDBRMChartView.GetViewCommon: string;
begin
  Result := '[DBChart]';
end;

procedure TDBRMChartView.ClearContents;
begin
  Clear;
  inherited;
end;

function TDBRMChartView.GetPropValue(aObject: TObject; aPropName: string;
  var aValue: Variant; Args: array of Variant): Boolean;
begin
  Result := True;
  if aPropName = 'DBChart' then
  begin
    aValue := O2V(FDBChart);
  end
  else
    Result := inherited GetPropValue(aObject, aPropName, aValue, Args);
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMCustomDBTeeChartUI }

class procedure TRMCustomDBTeeChartUI.Edit(aTeeChart: TCustomChart);
begin
end;

{******************************************************************************
 *
 ** C H A R T   U I   P L U G I N
 *
{******************************************************************************}
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMTeeChartUIPlugIn}

class procedure TRMTeeChartUIPlugIn.Register(aChartUIClass: TRMCustomDBTeeChartUIClass);
begin
//  uChartUIPlugInLock.Acquire;
  try
    uDBChartUIClassList.Add(aChartUIClass);
  finally
//    uChartUIPlugInLock.Release;
  end;
end;

class procedure TRMTeeChartUIPlugIn.UnRegister(aChartUIClass: TRMCustomDBTeeChartUIClass);
begin
//  uChartUIPlugInLock.Acquire;
  try
    uDBChartUIClassList.Remove(aChartUIClass);
  finally
//    uChartUIPlugInLock.Release;
  end;
end;

class function TRMTeeChartUIPlugIn.GetChartUIClass(aTeeChart: TCustomChart): TRMCustomDBTeeChartUIClass;
begin
//  uChartUIPlugInLock.Acquire;
  try
    if uDBChartUIClassList.Count > 0 then
      Result := TRMCustomDBTeeChartUIClass(uDBChartUIClassList[0])
    else
      Result := nil;
  finally
//    uChartUIPlugInLock.Release;
  end;
end;

class procedure TRMTeeChartUIPlugIn.Edit(aTeeChart: TCustomChart);
var
  lChartUIClass: TRMCustomDBTeeChartUIClass;
begin
  lChartUIClass := GetChartUIClass(aTeeChart);
  if (lChartUIClass <> nil) then
    lChartUIClass.Edit(aTeeChart);