teechartexp.pas

Delphi TeeChartPro.6.01的源代码

{**********************************************}
{   TeeChart Wizard                            }
{   Copyright (c) 1996-2003 by David Berneda   }
{**********************************************}
unit TeeChartExp;
{$I TeeDefs.inc}

{$IFNDEF D6}
{$UNDEF TEEENTERPRISE}  { Less than Delphi 6, No ADO ! }
{$ENDIF}

interface

uses
     {$IFNDEF LINUX}
     Windows,
     {$ENDIF}
     {$IFDEF D7}
     ToolsApi
     {$ELSE}
     ExptIntf, ToolIntf, VirtIntf, IStreams
     {$ENDIF}
     ;

type
  {$IFDEF D7}
  TTeeChartWizard=class(TNotifierObject, IOTAWizard, IOTAMenuWizard,
                        IOTAFormWizard, IOTARepositoryWizard,
                        IOTARepositoryWizard60)
  public
    function GetIDString: string;
    function GetName: string;
    function GetState: TWizardState;
    function GetDesigner: string;
    procedure Execute;
    function GetMenuText: string;
    function GetAuthor: string;
    function GetComment: string;
    function GetPage: string;
    function GetGlyph: Cardinal;
  end;
  {$ELSE}
  TTeeChartWizard = class(TIExpert)
    function GetName: string; override;
    function GetAuthor: string; override;
    function GetComment: string; override;
    function GetGlyph: HICON; override;
    function GetStyle: TExpertStyle; override;
    function GetState: TExpertState; override;
    function GetIDString: string; override;
    function GetPage: string; override;
    procedure Execute; override;
    function GetMenuText: string; override;
  end;
  {$ENDIF}

Procedure Register;

implementation

{$R TeeChaEx.res}

uses {$IFDEF CLX}
     QForms, QControls,
     {$ELSE}
     Forms, Controls,
     {$ENDIF}
     Classes, SysUtils, Proxies,
     {$IFNDEF NOUSE_BDE}
     DB, DBTables, DBChart,
     {$IFDEF TEEENTERPRISE}
     AdoDB,
     {$ENDIF}
     {$ENDIF}
     TeeExpForm, TeeStore, TeeConst, Chart, TeeProcs, TeCanvas, TeEngine;

function DoFormCreation(Wizard: TTeeDlgWizard; const FormIdent: string): TForm;

  Procedure AddControls(AForm:TCustomForm);
  var tmpChart : TCustomChart;
      {$IFNDEF NOUSE_BDE}
      tmpTable : TDataSet;
      {$ENDIF}
      t       : Integer;
  begin
    {$IFNDEF NOUSE_BDE}
    tmpTable:=nil;
    {$ENDIF}

    tmpChart:=nil;

    with Wizard do
    {$IFNDEF NOUSE_BDE}
    if RGDatabase.ItemIndex=0 then
    begin
      if StyleBDE then
      begin
        tmpTable:=TTable.Create(AForm);
        With TTable(tmpTable) do
        begin
          DatabaseName:=CBAlias.Text;
          TableName:=CBTables.Text;
        end;
      end
      else
      begin
        {$IFDEF TEEENTERPRISE}
        tmpTable:=TADOQuery.Create(AForm);
        With TADOQuery(tmpTable) do
        begin
          ConnectionString:=ADOConn.ConnectionString;
          SQL.Assign(ADOQuery.SQL);
        end;
        {$ENDIF}
      end;

      with tmpTable do
      begin
        Left:=12;
        Top:=8;
        if StyleBDE then Name:=TeeMsg_WizardTable1
                    else Name:='ADOQuery1';
        Open;
      end;

      tmpChart:=TDBChart.Create(AForm);
    end
    else
    {$ENDIF}
       tmpChart:=TChart.Create(AForm);

    if Wizard.RGDatabase.ItemIndex=2 then
    with Wizard do
    begin
      tmpChart.Parent:=AForm;
      CopyPreviewChart(tmpChart);
    end
    else
    begin
      With tmpChart do
      begin
        Parent:=AForm;
        Assign(Wizard.PreviewChart as TCustomChart);
      end;

      Wizard.CreateSeries(AForm,tmpChart{$IFNDEF NOUSE_BDE},tmpTable{$ENDIF},False)
    end;

    // set component names
    with tmpChart do
    begin
       Name:=TeeGetUniqueName(AForm,Copy(ClassName,2,Length(ClassName)));

      {$IFNDEF NOUSE_BDE}
      if Wizard.RGDatabase.ItemIndex=0 then
         Left:=48
      else
      {$ENDIF}
         Left:=8;
      Top:=8;

      for t:=0 to SeriesCount-1 do
      with Series[t] do
      if Name='' then
         Name:=TeeGetUniqueName(AForm,Copy(ClassName,2,Length(ClassName)));

      for t:=0 to Tools.Count-1 do
      with Tools[t] do
      if Name='' then
         Name:=TeeGetUniqueName(AForm,Copy(ClassName,2,Length(ClassName)));
    end;
  end;

begin
  result:=TForm.Create(nil);
  Proxies.CreateSubClass(Result, 'T' + FormIdent, TForm);  { <-- dont translate }
  with Result do
  begin
    Name    :=FormIdent;
    Caption :=FormIdent;
    Width:=470;
    Height:=300;
    {$IFDEF D5}
    ParentFont:=True;
    {$ELSE}
    with Font do
    begin
      Name:=GetDefaultFontName;
      Size:=GetDefaultFontSize;
    end;
    {$ENDIF}
  end;

  AddControls(result);
end;

const
  CRLF = #13#10;

Function GetPascalSource(Wizard:TTeeDlgWizard; AForm:TCustomForm;
                         const ModuleIdent,FormIdent:String):String;
var tmp : String;
    t   : Integer;
    tmpChart : TCustomChart;
begin

  tmpChart:=nil;
  for t:=0 to AForm.ComponentCount-1 do
  if AForm.Components[t] is TCustomChart then
  begin
    tmpChart:=TCustomChart(AForm.Components[t]);
    break;
  end;

  { unit header and uses clause }
  tmp:=Format(
    'unit %s;' + CRLF + CRLF +
    'interface' + CRLF + CRLF +
    'uses'+CRLF +
    '  Windows, Messages, SysUtils, Classes,'+CRLF+
    {$IFDEF CLX}
    '  QGraphics, QControls, QForms, QDialogs, QStdCtrls, QExtCtrls,'+CRLF+
    {$ELSE}
    '  Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls,'+CRLF+
    {$ENDIF}
    '  TeEngine, TeeProcs, Chart', [ModuleIdent]);

  { additional units that may be needed }
  {$IFNDEF NOUSE_BDE}
  if Wizard.RGDatabase.ItemIndex=0 then
     if Wizard.StyleBDE then
        tmp:=tmp+ ', DBChart, DB, DBTables'
     else
        tmp:=tmp+ ', DBChart, DB, ADODB';
  {$ENDIF}

  tmp:=tmp+ ';' + CRLF + CRLF;

  { begin the class declaration }
  tmp:=tmp+'type'+CRLF +'  T'+FormIdent+' = class(TForm)'+CRLF;

  { add variable declarations }

  {$IFNDEF NOUSE_BDE}
  if Wizard.RGDatabase.ItemIndex=0 then
     if Wizard.StyleBDE then
        tmp:=tmp+'    Table1 : TTable;' + CRLF
     else
        tmp:=tmp+'    ADOQuery1 : TADOQuery;' + CRLF;
  {$ENDIF}

  with tmpChart do
  begin
    tmp:=tmp+'    '+Name+': '+ClassName+';' + CRLF;

    for t:=0 to SeriesCount-1 do
    with Series[t] do
         tmp:=tmp+Format('    %s: %s;'+CRLF,[Name,ClassName]);

    for t:=0 to Tools.Count-1 do
    with Tools[t] do
         tmp:=tmp+Format('    %s: %s;'+CRLF,[Name,ClassName]);
  end;

  tmp:=tmp+Format(
    '  private'+CRLF+
    '    '+TeeMsg_PrivateDeclarations+CRLF+
    '  public'+CRLF+
    '    '+TeeMsg_PublicDeclarations+CRLF+
    '  end;' + CRLF + CRLF +
    'var' + CRLF +
    '  %s: T%s;' + CRLF + CRLF +
    'implementation' + CRLF + CRLF +
    '{$R *.'+
    {$IFDEF D7}
    (BorlandIDEServices as IOTAServices).GetActiveDesignerType
    {$ELSE}
    'DFM'
    {$ENDIF}
    +'}' + CRLF + CRLF, [FormIdent, FormIdent]);

  tmp:=tmp+'end.' + CRLF;

  result:=tmp;
end;

{$IFDEF D7}
type
  TTeeChartModuleCreator = class(TInterfacedObject, IOTACreator, IOTAModuleCreator)
  private
    TheForm : TCustomForm;
    Wizard  : TTeeDlgWizard;
  public
    Constructor Create(AWizard:TTeeDlgWizard);
    Destructor Destroy; override;

    // IOTACreator
    function GetCreatorType: string;
    function GetExisting: Boolean;
    function GetFileSystem: string;
    function GetOwner: IOTAModule;
    function GetUnnamed: Boolean;
    // IOTAModuleCreator
    function GetAncestorName: string;
    function GetImplFileName: string;
    function GetIntfFileName: string;
    function GetFormName: string;
    function GetMainForm: Boolean;
    function GetShowForm: Boolean;
    function GetShowSource: Boolean;
    function NewFormFile(const FormIdent, AncestorIdent: string): IOTAFile;
    function NewImplSource(const ModuleIdent, FormIdent, AncestorIdent: string): IOTAFile;
    function NewIntfSource(const ModuleIdent, FormIdent, AncestorIdent: string): IOTAFile;
    procedure FormCreated(const FormEditor: IOTAFormEditor);
  end;

{$ELSE}
procedure TeeChartWizard(ToolServices: TIToolServices);
Const SourceBufferSize = 1024;
var SourceBuffer : PChar;

  procedure FmtWrite(Stream: TStream; Const Fmt: String;
    const Args: array of const);
  begin
    if Assigned(Stream) and Assigned(SourceBuffer) then
    begin
      StrLFmt(SourceBuffer, SourceBufferSize, @Fmt[1], Args);
      Stream.Write(SourceBuffer[0], StrLen(SourceBuffer));
    end;
  end;

var D: TTeeDlgWizard;

{$IFDEF BCB}
const
  DashLine =
  '//----------------------------------------------------------------------------';

  function CreateHeader(const UnitIdent, FormIdent:string): TMemoryStream;
  var t: Integer;
  begin
    SourceBuffer := StrAlloc(SourceBufferSize);
    try
      Result := TMemoryStream.Create;
      with D do
      try
        FmtWrite(Result,
          DashLine + CRLF +
          '#ifndef %0:sH' + CRLF +
          '#define %0:sH' + CRLF +
          DashLine + CRLF +
          '#include <vcl\Classes.hpp>' + CRLF +
          '#include <vcl\Controls.hpp>' + CRLF +
          '#include <vcl\StdCtrls.hpp>' + CRLF +
          '#include <vcl\Forms.hpp>' + CRLF +
          '#include <vcl\TeEngine.hpp>' + CRLF +
          '#include <vcl\TeeProcs.hpp>' + CRLF +
          '#include <vcl\Chart.hpp>' + CRLF, [UnitIdent]);

        {$IFNDEF NOUSE_BDE}
        if RGDatabase.ItemIndex=0 then
          if StyleBDE then
             FmtWrite(Result,
                '#include <vcl\DBChart.hpp>' + CRLF +
                '#include <vcl\DB.hpp>' + CRLF +
                '#include <vcl\DBTables.hpp>' + CRLF, [nil])
          else
             FmtWrite(Result,
                '#include <vcl\DBChart.hpp>' + CRLF +
                '#include <vcl\DB.hpp>' + CRLF +
                '#include <vcl\ADODB.hpp>' + CRLF, [nil]);

        {$ENDIF}

        FmtWrite(Result, DashLine + CRLF, [nil]);

        FmtWrite(Result,
          'class T%s : public TForm' + CRLF +
          '{' + CRLF +
          '__published:' + CRLF, [FormIdent]);

        {$IFNDEF NOUSE_BDE}
        if RGDatabase.ItemIndex=0 then
           if StyleBDE then
              FmtWrite(Result,'TTable *Table1;' + CRLF, [nil])
           else
              FmtWrite(Result,'TADOQuery *ADOQuery1;' + CRLF, [nil]);
        {$ENDIF}

        with PreviewChart do
        begin
          FmtWrite(Result,'%s *%s;' + CRLF, [ClassName,Name]);

          for t:=0 to SeriesCount-1 do
          with Series[t] do