demoform.pas

odac for oralce 8i,10g,11g easy to connect to oralce from delphi

{$I DacDemo.inc}

unit DemoForm;

interface

uses
{$IFNDEF WIN32}
  Types,
{$ENDIF}
  SysUtils, Classes, DB,
{$IFDEF LINUX}
  QControls, QStdCtrls, QComCtrls, QGraphics, QMenus, QTypes, QImgList, QForms,
  QButtons, QExtCtrls, Qt, QDialogs,
{$ELSE}
  Windows, Forms, Messages, Controls, StdCtrls,
  Graphics, ImgList, ToolWin,
  ComCtrls, Dialogs, ExtCtrls, Tabs, Menus, DBCtrls, Buttons,  ShellAPI,
{$IFNDEF VER130}
  Variants,
{$ENDIF}
{$ENDIF}
{$IFDEF CLR}
  System.ComponentModel,
{$ENDIF}
  DBAccess,
  DAScript,
  DemoBase,
  DemoFrame,
  CategoryFrame
  {$IFDEF XPMAN}, UxTheme{$ENDIF}
  {$IFDEF USE_SYNEDIT}, SynMemo, SynEdit, SynEditHighlighter, SynHighlighterPas{$ENDIF}
  ;
const
  MAX_HISTORY_SIZE = 6;

type
  TDemoForm = class(TForm)
    StatusBar: TStatusBar;
    ImageList1: TImageList;
    PanelUnderTree: TPanel;
    TreeView: TTreeView;
    MainPanel: TPanel;
    Shape1: TShape;
    TVSplitter: TSplitter;
    pnTopLabel: TPanel;
    lbTitle: TLabel;
    lbAbout: TLabel;
    Panel2: TPanel;
    Panel1: TPanel;
    sbConnect: TSpeedButton;
    sbDisconnect: TSpeedButton;
    btCreate: TSpeedButton;
    btDrop: TSpeedButton;
    cbDebug: TCheckBox;
    pnSource: TPanel;
    pnDemo: TPanel;
    sbDemo: TSpeedButton;
    pnShowSource: TPanel;
    ToolBar: TToolBar;
    tbBrowseBack: TToolButton;
    tbBrowseForward: TToolButton;
    BackHistoryPopup: TPopupMenu;
    ForwardHistoryPopup: TPopupMenu;
    ilButtons: TImageList;
    ilDisabledButtons: TImageList;
    sbSource: TSpeedButton;
    sbFormText: TSpeedButton;
    pnOpenDemoDir: TPanel;
    sbOpenDemoDir: TSpeedButton;

    procedure FormCreate(Sender: TObject); virtual;
    procedure TreeViewChange(Sender: TObject; Node: TTreeNode);
    procedure TreeViewKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure TreeViewClick(Sender: TObject);
    procedure TreeViewMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure TVSplitterMoved(Sender: TObject);
    procedure TVSplitterCanResize(Sender: TObject; var NewSize: Integer;
      var Accept: Boolean);
    procedure lbAboutClick(Sender: TObject); virtual;
    procedure lbAboutMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure lbTitleMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure cbDebugClick(Sender: TObject);
    procedure sbOpenDemoDirClick(Sender: TObject);
    procedure sbConnectClick(Sender: TObject);
    procedure sbDisconnectClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure HistoryItemClick(Sender: TObject);
    procedure sbDemoClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure BackHistoryPopupPopup(Sender: TObject);
    procedure ForwardHistoryPopupPopup(Sender: TObject);
    procedure tbBrowseBackClick(Sender: TObject);
    procedure tbBrowseForwardClick(Sender: TObject);
    procedure btScriptClick(Sender: TObject);
    procedure OnScriptError(Sender: TObject; E: Exception; SQL: String;
      var Action: TErrorAction);
    procedure sbSourceClick(Sender: TObject);
    procedure sbFormTextClick(Sender: TObject);
  protected
    Demos: TDemos;
    ActiveNode: TTreeNode;
    //History
    History: Array of integer;                                          //Absolute indexes in TreeView
    HistoryIndex: integer;                                              //Current History index
    HistoryEnd: integer;
    IgnoreScriptErrors: boolean;
    DropScriptActive: boolean;
    DemoSourceLoaded, FormSourceLoaded: boolean;

    //Product customization
    function GetConnection: TCustomDAConnection; virtual; abstract; //This function should return DAC product specific connection (i.e. OraSession, MyConnection)
    function ApplicationTitle: string; virtual; abstract; //This function should return DAC product specific title
    function ProductName: string; virtual; abstract; ////This function should return product name
    procedure RegisterDemos; virtual; abstract;          //This procedure should regiter DAC product specific demos
    //XP manifest
  {$IFDEF XPMAN}
    procedure ReplaceFlatStyle(Control: TWinControl; Flat: boolean);
  {$ENDIF}
    //Demo selection
    procedure InitializeDemoFrame(Frame: TDemoFrame; DemoType: TDemoType); virtual;
    procedure UpdateDemo;
    procedure ShowDemo;
    procedure ShowDemoSource;
    procedure ShowFormSource;
  {$IFNDEF WIN32}
    procedure OnNavigate(DemoDescription: string);
  {$ELSE}
    procedure OnNavigate(Index: integer);
  {$ENDIF}
    //History
    procedure SelectDemo;
    procedure NavigateHistory(Offset: integer);
    procedure GetBackHistory(BackList: TStrings);
    procedure GetForwardHistory(ForwardList: TStrings);
    procedure DisableBrowse(Back, Forward: boolean);
    procedure FillHistoryPopup(BackHistory: boolean);
    //Connection
    procedure AfterConnect(Sender: TObject);
    procedure AfterDisconnect(Sender: TObject);
  public
{$IFDEF USE_SYNEDIT}
    SourceBrowser: TSynMemo;
{$ELSE}
    SourceBrowser: TMemo;
{$ENDIF}
    function GetIsXPMan: boolean;
    function ProductColor: TColor; virtual; abstract;     //This function should return DAC product specific color
    procedure ExecCreateScript; virtual; abstract;
    procedure ExecDropScript; virtual; abstract;
  end;

implementation

{$IFDEF CLR}
{$R *.nfm}
{$ENDIF}
{$IFDEF WIN32}
{$R *.dfm}
{$ENDIF}
{$IFDEF LINUX}
{$R *.xfm}
{$ENDIF}

{$IFDEF XPMAN}
  {$R WindowsXP.res}
{$ENDIF}

procedure TDemoForm.FormCreate(Sender: TObject);
begin
  SetLength(History, MAX_HISTORY_SIZE);
  HistoryIndex := -1;
  Demos := TDemos.Create(TreeView.Items);
  RegisterDemos;
{$IFDEF XPMAN}
  if GetIsXPMan then begin
    ReplaceFlatStyle(Self, False);
    pnTopLabel.Color := ProductColor;
  end;
{$ENDIF}

{$IFDEF USE_SYNEDIT}
  SourceBrowser := TSynMemo.Create(pnSource);

  SourceBrowser.Highlighter := TSynPasSyn.Create(SourceBrowser);
  SourceBrowser.Options := [eoAltSetsColumnMode, eoAutoIndent, eoAutoSizeMaxScrollWidth, eoDisableScrollArrows, eoDragDropEditing, eoDropFiles, eoEnhanceEndKey, eoGroupUndo, eoHideShowScrollbars, eoKeepCaretX, eoShowScrollHint, eoSmartTabDelete, eoSmartTabs, eoTabIndent, eoTabsToSpaces];
  with SourceBrowser.Gutter do begin
    Visible := True;
    AutoSize := True;
    DigitCount := 3;
    LeftOffset := 0;
    RightOffset := 0;
    ShowLineNumbers := True;
    Width := 1;
 end;
{$ELSE}
  SourceBrowser := TMemo.Create(pnSource);
  SourceBrowser.ScrollBars := ssVertical;
  SourceBrowser.Font.Name := 'Courier New';
  SourceBrowser.Font.Size := 10;
{$ENDIF}
  with SourceBrowser do begin
    Parent := pnSource;
    Align := alClient;
    ReadOnly := True;
  end;
  Resize;
  TreeView.Items[0].Expand(True);
  TreeView.Items[0].Selected := True;
  with GetConnection do begin
    AfterConnect := Self.AfterConnect;
    AfterDisconnect :=  Self.AfterDisconnect;
  end;
  SelectDemo;
end;

procedure TDemoForm.FormDestroy(Sender: TObject);
begin
  with GetConnection do begin
    AfterConnect := nil;
    AfterDisconnect :=  nil;
  end;
  SetLength(History, 0);
  Demos.Free;
end;

//TreeView routines
procedure TDemoForm.TreeViewChange(Sender: TObject; Node: TTreeNode);
begin
  if (TreeView.Selected.Data <> nil) then
    StatusBar.Panels[0].Text := TDemo(TreeView.Selected.Data).Hint
  else
    StatusBar.Panels[0].Text := TreeView.Selected.Text;
  StatusBar.Repaint;
end;

procedure TDemoForm.TreeViewKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = {$IFDEF LINUX}4100{$ELSE}13{$ENDIF} then
    SelectDemo;
end;

procedure TDemoForm.TreeViewClick(Sender: TObject);
begin
  SelectDemo;
end;

//TreeView Hints
procedure TDemoForm.TreeViewMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var
  Node: TTreeNode;
begin
  Node := TreeView.GetNodeAt(X, Y);
  if (Node <> nil) and (Node.Data <> nil) then
    TreeView.Hint := TDemo(Node.Data).Hint
  else
    TreeView.Hint := '';
end;

//Sizing constraints
procedure TDemoForm.TVSplitterMoved(Sender: TObject);
begin
  if PanelUnderTree.ClientWidth = 0 then
    PanelUnderTree.ClientWidth := 150;
end;

procedure TDemoForm.TVSplitterCanResize(Sender: TObject;
  var NewSize: Integer; var Accept: Boolean);
begin
  Accept := (NewSize >= PanelUnderTree.Constraints.MinWidth) and
    ((ClientWidth - MainPanel.Constraints.MinWidth - NewSize) > 0);
end;

function TDemoForm.GetIsXPMan: boolean;
begin
  Result := {$IFDEF XPMAN}UseThemes; {$ELSE} False;{$ENDIF}
end;

{$IFDEF XPMAN}
procedure TDemoForm.ReplaceFlatStyle(Control: TWinControl; Flat: boolean);
var
  i: integer;
begin
  for i := 0 to Control.ControlCount - 1 do
    if Control.Controls[i] is TSpeedButton then
      TSpeedButton(Control.Controls[i]).Flat := Flat
    else
    if Control.Controls[i] is TDBNavigator then
      TDBNavigator(Control.Controls[i]).Flat := Flat
    else
      if Control.Controls[i] is TWinControl then begin
        if Control.Controls[i] is TPanel then begin
          TPanel(Control.Controls[i]).ParentBackground := False;
          TPanel(Control.Controls[i]).Color := clBtnFace;
        end;
        ReplaceFlatStyle(TWinControl(Control.Controls[i]), Flat);
      end;
end;
{$ENDIF}

//Demo Change
procedure TDemoForm.InitializeDemoFrame(Frame: TDemoFrame; DemoType: TDemoType);
begin
  Frame.Connection := GetConnection;
  Frame.SetDebug(cbDebug.Checked);
  Frame.Parent := pnDemo;
  if DemoType = dtCategory then                       //Attach browser event handlers
    TCategoryFrame(Frame).OnNavigate := OnNavigate;
{$IFDEF XPMAN}
  if GetIsXPMan then
    ReplaceFlatStyle(Frame, False);
{$ENDIF}
  Frame.Initialize;
end;

procedure TDemoForm.UpdateDemo;
var
  i: integer;
begin
  for i := 1 to StatusBar.Panels.Count - 1 do
    StatusBar.Panels[i].Text := '';
  ActiveNode := TreeView.Selected;
  if (ActiveNode <> nil) then
    with Demos.SelectDemo(ActiveNode.AbsoluteIndex) do begin
      InitializeDemoFrame(Frame, DemoType);
      DemoSourceLoaded := False;
      FormSourceLoaded := False;
      if DemoType = dtCategory then begin