CD Actual Thematic 25: Programming/pc_actual_25.iso/Delphi/TeeChartPro/TeeChart5Delphi5Eval.exe/%MAINDIR%/Examples/Features/Main.pas

Pascal/Delphi Source File | 2001-09-10 | 16.7 KB | 653 lines

(*
{***************************************}
{ TeeChart Pro version 5                }
{ Many examples and demos.              }
{ Copyright 1995-2000 by David Berneda. }
{ All Rights Reserved.                  }
{***************************************}
*)

{$I TeeDefs.inc}
unit Main;

interface

uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   ComCtrls, Chart, {$IFDEF D4}ImgList,{$ENDIF} ExtCtrls, StdCtrls, TeeAbout,
   Menus, Buttons, TeeProcs, TeeDraw3D
   {$IFDEF D5}
   ,SHDocVw
   {$ENDIF}
   ;

type
  TTee5Form = class(TForm)
    StatusBar1: TStatusBar;
    Splitter1: TSplitter;
    Panel2: TPanel;
    Panel3: TPanel;
    Button1: TButton;
    Images: TImageList;
    PopupMenu1: TPopupMenu;
    ShowAll1: TMenuItem;
    Button2: TSpeedButton;
    Draw3D1: TDraw3D;
    BPrevious: TSpeedButton;
    BNext: TSpeedButton;
    Label1: TLabel;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TreeView1: TTreeView;
    TabSheet2: TTabSheet;
    TreeView2: TTreeView;
    Timer1: TTimer;
    Presentation1: TMenuItem;
    Memo2: TMemo;
    Memo1: TMemo;
    Timer2: TTimer;
    PageExample: TPageControl;
    TabExample: TTabSheet;
    TabSource: TTabSheet;
    TabWeb: TTabSheet;
    Generatehtm1: TMenuItem;
    ButtonConfig: TButton;
    procedure FormCreate(Sender: TObject);
    procedure TreeView1Change(Sender: TObject; Node: TTreeNode);
    procedure BNextClick(Sender: TObject);
    procedure BPreviousClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Label1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure ShowAll1Click(Sender: TObject);
    procedure TreeView1GetImageIndex(Sender: TObject; Node: TTreeNode);
    procedure TreeView1GetSelectedIndex(Sender: TObject; Node: TTreeNode);
    procedure Draw3D1AfterDraw(Sender: TObject);
    procedure PageControl1Change(Sender: TObject);
    procedure Presentation1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure PageExampleChange(Sender: TObject);
    procedure ButtonConfigClick(Sender: TObject);
    procedure Generatehtm1Click(Sender: TObject);
  private
     { Private declarations }
     RichEditCode    : TRichEdit;
     tmpForm         : TForm;
     FiveFontColor   : TColor;
     FiveBorderColor : TColor;
     OldCodeFile     : String;
     {$IFDEF D5}
     WebBrowser1     : TWebBrowser;
     {$ENDIF}
     procedure ShowForm(ATree:TTreeView);
     procedure ShowFormClass(AClass: TFormClass);
     Function TheTree:TTreeView;
     Function CodeFile:String;
  public
     { Public declarations }
  end;

var
   Tee5Form: TTee5Form;

implementation

{$R *.DFM}

Uses TeCanvas, MMSystem, Registry, FileCtrl

     {$IFDEF D4}
     ,Chart_Actions
     ,Axis_Millisec
     ,Chart_FreeAllSeries
     ,ValueList_Modified
     ,Series_ValueList
     ,Template_Chart
     ,Canvas_RotCenter
     ,Chart_PrintPreview
     ,Map_Series
     {$ENDIF};

type PTeeFormInfo=^TTeeFormInfo;
     TTeeFormInfo=packed record
       FormClass : TFormClass;
       UnitName  : String;
     end;

procedure TTee5Form.FormCreate(Sender: TObject);

  Procedure LoadTree(ATree:TTreeView; AMemo:TMemo);
  var i,
      t        : Integer;
      tmpClass : String;
      tmpUnit  : String;
      tmp      : TStringStream;
      FormInfo : PTeeFormInfo;
 begin
    tmp:=TStringStream.Create(AMemo.Lines.Text);
    try
      ATree.LoadFromStream(tmp);
    finally
      tmp.Free;
    end;

    with ATree do
    begin
      for t:=0 to Items.Count-1 do
      with Items[t] do
      begin
        i:=Pos(',', Text);
        if i>0 then
        begin
          tmpClass:=Copy(Text, i+1, Length(Text));
          Text:=Copy(Text, 1, i-1);

          tmpUnit:='';
          i:=Pos(',',tmpClass);
          if i>0 then
          begin
            tmpUnit:=Copy(tmpClass,i+1,Length(tmpClass));
            tmpClass:=Copy(tmpClass,1,i-1);
          end;

          {$IFNDEF D4}
          if (tmpClass='TRotationCenter') or
             (tmpClass='TChartActionsForm') or
             (tmpClass='TFreeAllSeriesForm') or
             (tmpClass='TValueListModified') or
             (tmpClass='TDynArrays') or
             (tmpClass='TMouseWheelForm') or
             (tmpClass='TTemplateChart') or
             (tmpClass='TChartPrintPreviewForm') or
             (tmpClass='TAxisMillisec') or
             (tmpClass='TMapSeriesForm') then
                tmpClass:='TDelphi3NotAvail';
          {$ENDIF}

          New(FormInfo);
          FormInfo.FormClass:=TFormClass(FindClass(tmpClass));
          FormInfo.UnitName:=tmpUnit;
          Data:=FormInfo;
        end;
      end;
      Items[0].Expand(False);
    end;
 end;

begin
  PageControl1.ActivePage:=TabSheet1;
  LoadTree(TreeView1,Memo1);
  LoadTree(TreeView2,Memo2);
  TreeView1.Items[0].Item[0].Expand(False);
  {$IFDEF D4}
  TreeView1.HotTrack:=True;
  TreeView2.HotTrack:=True;
  PageExample.HotTrack:=True;
  {$ENDIF}
  FiveFontColor:=clRed;
  FiveBorderColor:=clWhite;
end;

procedure TTee5Form.ShowFormClass(AClass: TFormClass);
begin
  { create and insert a Form, then show it... }
  tmpForm:=AClass.Create(Self);
  with tmpForm do
  begin
    Visible:=False;
    BorderStyle:=bsNone;
    Parent:=TabExample;
    Align:=alClient;
    Show;
  end;
end;

{ Find the Form corresponding to the Tree item, and create it }
procedure TTee5Form.ShowForm(ATree:TTreeView);
var tmp : Pointer;
begin
  if ATree.Selected<>nil then
  begin
    tmp:=ATree.Selected.Data;
    if Assigned(tmp) then
    begin
      tmpForm.Free;
      tmpForm:=nil;
      ShowFormClass(PTeeFormInfo(tmp).FormClass);
    end;
    StatusBar1.SimpleText:=ATree.Selected.Text;
  end;
end;

{ Show the corresponding Form, enable / disable the buttons }
procedure TTee5Form.TreeView1Change(Sender: TObject; Node: TTreeNode);
begin
  PageExample.ActivePage:=TabExample;
  ShowForm(Sender as TTreeView);
  with Sender as TTreeView do
  begin
    BPrevious.Enabled := Assigned(Selected) and (Selected.AbsoluteIndex>0);
    BNext.Enabled := Assigned(Selected) and (Selected.AbsoluteIndex<Items.Count-1);
    TabSource.TabVisible:=CodeFile<>'';
  end;
end;

Function TTee5Form.TheTree:TTreeView;
begin
  if PageControl1.ActivePage=TabSheet1 then result:=TreeView1
                                       else result:=TreeView2;
end;

procedure TTee5Form.BNextClick(Sender: TObject);
begin
  with TheTree do Items[Selected.AbsoluteIndex+1].Selected := true
end;

procedure TTee5Form.BPreviousClick(Sender: TObject);
begin
  with TheTree do Items[Selected.AbsoluteIndex-1].Selected := true
end;

procedure TTee5Form.Button1Click(Sender: TObject);
begin
  Close;
end;

procedure TTee5Form.Label1Click(Sender: TObject);
begin
  GotoURL(Handle, Label1.Caption);
end;

procedure TTee5Form.Button2Click(Sender: TObject);
begin
  TeeShowAboutBox;
end;

procedure TTee5Form.ShowAll1Click(Sender: TObject);
var t : Integer;
begin
  With TheTree do
  for t:=0 to Items.Count-1 do
  begin
    Selected:=Items[t];
    Application.ProcessMessages;
  end;
end;

Function ImageIndex(Node:TTreeNode):Integer;
begin
  if Node.HasChildren then
     if Node.Expanded then result:= 2
                      else result:= 0
  else
     result:= 1;
end;

procedure TTee5Form.TreeView1GetImageIndex(Sender: TObject;
  Node: TTreeNode);
begin
  Node.ImageIndex:=ImageIndex(Node);
end;

procedure TTee5Form.TreeView1GetSelectedIndex(Sender: TObject;
  Node: TTreeNode);
begin
  Node.SelectedIndex:=ImageIndex(Node);
end;

procedure TTee5Form.Draw3D1AfterDraw(Sender: TObject);
var tmp : TTeeFont;
begin
  With Draw3D1.Canvas do
  begin
    tmp:=TTeeFont.Create(nil);
    try
      With tmp do
      begin
        Name:='Arial Black';
        Color:=clNavy;
        Outline.Color:=clWhite;
        Outline.Style:=psSolid;
        OutLine.Visible:=True;
        OutLine.Width:=1;
        Style:=[fsBold,fsItalic];
        Size:=26;
        Shadow.HorizSize:=2;
        Shadow.VertSize:=2;
      end;
      AssignFont(tmp);
      TextOut(72,-6,'TeeChart Pro');
      tmp.OutLine.Color:=FiveBorderColor;
      tmp.Color:=FiveFontColor;
      AssignFont(tmp);
      TextOut(350,-6,'5');
    finally
      tmp.Free;
    end;
  end;
end;

procedure TTee5Form.PageControl1Change(Sender: TObject);
begin
  TreeView1Change(TheTree,TheTree.Selected);
end;

procedure TTee5Form.Presentation1Click(Sender: TObject);
begin
  Presentation1.Checked:=not Presentation1.Checked;
  Timer1.Enabled:=Presentation1.Checked;
  if Timer1.Enabled then TheTree.Selected:=TheTree.Items[0];
end;

procedure TTee5Form.Timer1Timer(Sender: TObject);
begin
  Timer1.Enabled:=False;
  With TheTree do Selected:=Items[Selected.AbsoluteIndex+1];
  Timer1.Enabled:=True;
end;

{$R Sound.Res}

Procedure PlaySoundResource(Const Sound:String);
var tmp : Integer;
begin
  tmp:=LoadResource(HInstance,FindResource(HInstance,PChar(Sound),RT_RCDATA));
  PlaySound(LockResource(tmp),HInstance,SND_MEMORY or SND_ASYNC or SND_NODEFAULT);
end;

procedure TTee5Form.FormDestroy(Sender: TObject);
begin
  PlaySoundResource('THANKYOU');
end;

procedure TTee5Form.Timer2Timer(Sender: TObject);
begin
  Case FiveFontColor of
    clRed   : begin FiveFontColor:=clYellow; FiveBorderColor:=clBlack; end;
    clYellow: begin FiveFontColor:=clBlue;   FiveBorderColor:=clYellow; end;
    clBlue  : begin FiveFontColor:=clGreen;  FiveBorderColor:=clRed; end;
  else        begin FiveFontColor:=clRed;    FiveBorderColor:=clWhite; end;
  end;
  Draw3D1.Repaint;
end;

procedure TTee5Form.FormShow(Sender: TObject);
var tmp : String;

  Function FindItem(ATree:TTreeView):Boolean;
  var t : Integer;
  begin
    result:=False;
    With ATree do
    for t:=0 to Items.Count-1 do
    if Assigned(Items[t].Data) and
       (UpperCase(PTeeFormInfo(Items[t].Data).FormClass.ClassName)=tmp) then
    begin
      Selected:=Items[t];
      result:=True;
      exit;
    end;
  end;

begin
  {$IFNDEF D5}
  TabWeb.TabVisible:=False;
  {$ENDIF}
  if ParamCount>0 then { find a Form... }
  begin
    tmp:=UpperCase(ParamStr(1));
    if not FindItem(TreeView1) then
       if FindItem(TreeView2) then
          PageControl1.ActivePage:=TabSheet2;
  end;
  PageExample.ActivePage:=TabExample;
end;

Const Tee5RegistryKey='\Software\Steema Software\TeeChart Pro v5 VCL';
      SteemaDotCom='http://www.steema.com/support/teechart/5/examples';

Function CodePath:String;
begin
  result:='';
  With TRegistry.Create do
  try
    if {$IFNDEF D4}OpenKey{$ELSE}OpenKeyReadOnly{$ENDIF}(Tee5RegistryKey
                     {$IFNDEF D4},False{$ENDIF}) then
       result:=ReadString('DemoPath');
  finally
    Free;
  end;
  if result='' then
     if FileExists('Tee5New.dpr') then
        result:=GetCurrentDir;
end;

Function TTee5Form.CodeFile:String;
begin
  if Assigned(TheTree.Selected) and
     Assigned(TheTree.Selected.Data) then
     result:=PTeeFormInfo(TheTree.Selected.Data).UnitName
  else
     result:='';
end;

Procedure HighLight(RichEdit:TCustomRichEdit);
var p   : Integer;
    tmp : String;

  Function IsKeyword(Const S:String):Boolean;
  Const Keywords:Array[0..33] of String=
         ('UNIT','INTERFACE','BEGIN','IMPLEMENTATION','PROCEDURE','INHERITED',
          'INITIALIZATION','END','CLASS','TYPE','VAR','PRIVATE','PUBLIC',
          'IF','ELSE','WHILE','FOR','REPEAT','RECORD','OBJECT','FUNCTION',
          'STRING','CONST','AND','NOT','IN','DO','THEN','WITH','USES',
          'TRY','FINALLY','EXCEPT','PACKED');

  var t:Integer;
  begin
    result:=False;
    for t:=0 to High(Keywords) do
    if Keywords[t]=S then
    begin
      result:=True;
      break;
    end;
  end;

  Function NextWordIsKeyword:Boolean;
  Const Valid=['A'..'Z','a'..'z','_'];
  var p2  : Integer;
      Key : String;
  begin
    While p<=Length(tmp) do
    begin
      if (tmp[p] in Valid) then
         break
      else
      if tmp[p]='{' then
      begin
        RichEdit.SelStart:=p-1;
        Inc(p);
        While tmp[p]<>'}' do Inc(p);
        With RichEdit do
        begin
          SelLength:=p-SelStart;
          With SelAttributes do
          begin
            Style:=[fsItalic];
            Color:=clNavy;
          end;
          SelStart:=0;
          SelLength:=0;
        end;
      end
      else Inc(p);
    end;

    p2:=p;
    While (p<=Length(tmp)) and (tmp[p] in Valid) do Inc(p);
    if p=Length(tmp) then Inc(p);
    if p>p2 then
    begin
      key:=Copy(tmp,p2,p-p2);
      result:=IsKeyword(UpperCase(Key));
      RichEdit.SelStart:=p2-1;
      RichEdit.SelLength:=p-p2;
      Inc(p);
    end
    else result:=False;
  end;

begin
  p:=1;
  tmp:=RichEdit.Lines.Text;
  While p<Length(tmp) do
     if NextWordIsKeyword then
        RichEdit.SelAttributes.Style:=[fsBold];
  RichEdit.SelStart:=0;
  RichEdit.SelLength:=0;
end;

{$WARNINGS OFF}
procedure TTee5Form.PageExampleChange(Sender: TObject);

  {$IFDEF D5}
  Procedure WebWrite(Const S:String);
  begin
    WebBrowser1.Navigate('about:'+S);
  end;
  {$ENDIF}

{$IFDEF D5}
var URL       : String;
{$ENDIF}
begin
  if PageExample.ActivePage=TabSource then
  begin
    if not FileExists(CodePath+'\Tee5New.dpr') then
    With TRegistry.Create do
    try
      DeleteKey(Tee5RegistryKey);
    finally
      Free;
    end;

    ButtonConfig.Visible:=CodePath='';
    if (CodePath<>'') and (CodeFile<>'') then
    begin
      if OldCodeFile<>CodeFile then
      begin
        RichEditCode.Free;
        RichEditCode:=TRichEdit.Create(Self);
        With RichEditCode do
        begin
          Align:=alClient;
          ReadOnly:=True;
          WordWrap:=False;
          ScrollBars:=ssBoth;
          Font.Name:='Courier New';
          Font.Size:=9;
          Parent:=TabSource;
          Lines.LoadFromFile(CodePath+'\'+CodeFile+'.pas');
        end;
        HighLight(RichEditCode);
        OldCodeFile:=CodeFile;
      end;
    end
    else RichEditCode.Free;
  end
  {$IFDEF D5}
  else
  if PageExample.ActivePage=TabWeb then
  begin
    if not Assigned(WebBrowser1) then
    begin
      WebBrowser1:=TWebBrowser.Create(Self);
      WebBrowser1.Align:=alClient;
      TabWeb.InsertControl(WebBrowser1);
    end;
    if Assigned(TheTree.Selected) and
       Assigned(TheTree.Selected.Data) then
    begin
      WebWrite('Loading page from Steema.com ...');
      URL:=SteemaDotCom+'/'+PTeeFormInfo(TheTree.Selected.Data).FormClass.ClassName+'.htm';
      WebBrowser1.Navigate(URL);
      StatusBar1.SimpleText:=URL;
    end
    else
       WebWrite('All information about TeeChart Pro at <a href="http://www.steema.com">www.Steema.com</a> !');
  end;
  {$ENDIF}
end;
{$WARNINGS ON}

procedure TTee5Form.ButtonConfigClick(Sender: TObject);
var tmpDir : String;
begin
  {$IFDEF D4}
  if SelectDirectory('Folder with TeeChart Pro 5 Demo Sources',
                     '',tmpDir) then
  {$ELSE}
  if SelectDirectory(tmpDir,[],0) then
  {$ENDIF}
  begin
    With TRegistry.Create do
    try
      if OpenKey(Tee5RegistryKey,True) then
         WriteString('DemoPath',tmpDir);
    finally
      Free;
    end;
    PageExampleChange(Self);
  end;
end;

procedure TTee5Form.Generatehtm1Click(Sender: TObject);

  Procedure DoTree(ATree:TTreeView);

    Function ItemPath(t:Integer):String;
    var tmp : TTreeNode;
    begin
      tmp:=ATree.Items[t];
      result:=tmp.Text;
      While Assigned(tmp.Parent) do
      begin
        result:=tmp.Parent.Text+' -> '+result;
        tmp:=tmp.Parent;
      end;
    end;

  var t:Integer;
      s:TStringList;
  begin
    s:=TStringList.Create;
    With ATree do
    for t:=0 to Items.Count-1 do
    if Assigned(Items[t].Data) then
    begin
      s.Clear;
      s.Add('<html><body>');
      s.Add('<img src="http://www.steema.com/images/tc2.jpg"><br>');
      s.Add('<b>TeeChart Pro 5 Feature:</b> '+ItemPath(t)+'<br>');
      s.Add('<br>');
      s.Add('If you need help assistance or additional info about this feature<br>');
      s.Add('please ask our Support Department at <a href="mailto:[e-mail]?subject=Tee5Web:'+
            ItemPath(t)+'">[e-mail]</a>. Thanks !');
      s.Add('<br>');
      s.Add('<br><a href="http://www.steema.com">Steema</a></body></html>');
      s.SaveToFile('.\tee5newhtml\'+PTeeFormInfo(Items[t].Data).FormClass.ClassName+'.htm');
    end;
    s.Free;
  end;

begin
  DoTree(TreeView1);
  DoTree(TreeView2);
end;

end.