unit Main;

{ Some features taken from TeeChart v5.0 demo program }
{ Coded by David Berneda, Steema SL                   }

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, ComCtrls, ShellAPI, Buttons;

type
  TfrmMain = class(TForm)
    TreeView1: TTreeView;
    Panel2: TPanel;
    Panel1: TPanel;
    StatusBar1: TStatusBar;
    Splitter1: TSplitter;
    Label1: TLabel;
    Label2: TLabel;
    Image1: TImage;
    Label3: TLabel;
    Memo1: TMemo;
    PageControl1: TPageControl;
    TabForm: TTabSheet;
    TabSource: TTabSheet;
    btnConfig: TButton;
    btnHelp: TSpeedButton;
    btnClose: TSpeedButton;
    btnPrevious: TSpeedButton;
    btnNext: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure TreeView1Change(Sender: TObject; Node: TTreeNode);
    procedure btnNextClick(Sender: TObject);
    procedure Label3Click(Sender: TObject);
    procedure Label3MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Panel2MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure TreeView1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure btnConfigClick(Sender: TObject);
    procedure PageControl1Change(Sender: TObject);
    procedure btnPreviousClick(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    tmpForm : TForm;
    OldCodeFile: String;
    RichEditCode : TRichEdit;
    procedure ShowForm;
    procedure ShowFormClass(AClass: TFormClass);
    function  CodeFile:String;
    { Private declarations }
  public
    { Public declarations }
  end;


type PExampleInfo=^TExampleInfo;
     TExampleInfo=packed record
       FormClass: TFormClass;
       UnitName: String;
     end;

var
  frmMain: TfrmMain;

implementation

Uses Registry, FileCtrl;

{$R *.DFM}
procedure TfrmMain.ShowFormClass(AClass: TFormClass);
begin
     tmpForm := AClass.Create(Self);
     With tmpForm do
     begin
          Visible := false;
          BorderStyle := bsNone;
          Parent := TabForm;
          Align := alClient;
          Show;
     end;
end;

procedure TfrmMain.ShowForm;
var tmp : Pointer;
begin
     if TreeView1.Selected<>nil then
     begin
          tmp := TreeView1.Selected.Data;
          if Assigned(tmp) then
          begin
               tmpForm.Free;
               tmpForm := nil;
               ShowFormClass(PExampleInfo(tmp).FormClass);
          end;
          Label1.Caption := TreeView1.Selected.Text;
          StatusBar1.SimpleText := TreeView1.Selected.Text;
     end;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
var i,
    t        : Integer;
    tmpClass : String;
    tmpUnit  : String;
    tmp      : TStringStream;
    ExampleForm : PExampleInfo;
begin
     PageControl1.ActivePage:=TabForm;
     tmp:=TStringStream.Create(Memo1.Lines.Text);
     try
        TreeView1.LoadFromStream(tmp);
     finally
        tmp.Free;
     end;

     with TreeView1 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;
                    New(ExampleForm);
                    ExampleForm.FormClass:=TFormClass(FindClass(tmpClass));
                    ExampleForm.UnitName:=tmpUnit;
                    Data:=ExampleForm;
               end;
          end;
          Items[0].Expand(False);
     end;
     TreeView1.HotTrack:=True;
end;

Function TfrmMain.CodeFile:String;
begin
  if Assigned(TreeView1.Selected) and
     Assigned(TreeView1.Selected.Data) then
     result:=PExampleInfo(TreeView1.Selected.Data).UnitName
  else
     result:='';
end;


procedure TfrmMain.TreeView1Change(Sender: TObject; Node: TTreeNode);
begin
  PageControl1.ActivePage:=TabForm;
  ShowForm;
  with TreeView1 do
  begin
    btnPrevious.Enabled := Assigned(Selected) and (Selected.AbsoluteIndex>0);
    btnNext.Enabled := Assigned(Selected) and (Selected.AbsoluteIndex<Items.Count-1);
    TabSource.TabVisible:= CodeFile <> '';
  end;
end;

procedure TfrmMain.btnNextClick(Sender: TObject);
begin
     With TreeView1 do Items[Selected.AbsoluteIndex+1].Selected := true;
end;

procedure TfrmMain.Label3Click(Sender: TObject);
begin
     ShellExecute(Handle,'open',PChar(TLabel(Sender).Caption),nil,nil,SW_SHOW);
end;

procedure TfrmMain.Label3MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
     TLabel(Sender).Font.Style := [fsUnderline];
end;

procedure TfrmMain.Panel2MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
     Label3.Font.Style := [];
end;

procedure TfrmMain.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
     Label3.Font.Style := [];
end;

procedure TfrmMain.TreeView1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
     Label3.Font.Style := [];
end;

Const MtxVecRegKey='\Software\DewResearch\MtxVec';

Function CodePath:String;
begin
  result:='';
  With TRegistry.Create do
  try
    if OpenKeyReadOnly(MtxVecRegKey) then
       result:=ReadString('DemoPath');
  finally
    Free;
  end;
  if result='' then
     if FileExists('BasicDemo.dpr') then
        result:=GetCurrentDir;
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;


procedure TfrmMain.PageControl1Change(Sender: TObject);
begin
  if PageControl1.ActivePage=TabSource then
  begin
    if not FileExists(CodePath+'\BasicDemo.dpr') then
    With TRegistry.Create do
    try
      DeleteKey(MtxVecRegKey);
    finally
      Free;
    end;

    btnConfig.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;
end;

procedure TfrmMain.btnConfigClick(Sender: TObject);
var tmpDir : String;
begin
  if SelectDirectory('Folder with MtxVec demo source',
                     '',tmpDir) then
  begin
    With TRegistry.Create do
    try
      if OpenKey(MtxVecRegKey,True) then
         WriteString('DemoPath',tmpDir);
    finally
      Free;
    end;
    PageControl1Change(Self);
  end;
end;

procedure TfrmMain.btnPreviousClick(Sender: TObject);
begin
     With TreeView1 do Items[Selected.AbsoluteIndex-1].Selected := true;
end;

procedure TfrmMain.btnCloseClick(Sender: TObject);
begin
     Self.Close
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
var t: integer;
begin
     with TreeView1 do
     begin
          for t:=0 to Items.Count-1 do
          with Items[t] do
          begin
               if Assigned(Data) then
               begin
                    PExampleInfo(Data).UnitName := '';
                    Dispose(PExampleInfo(Data));
                    Data := nil;
               end;
          end;
     end;
end;

end.
