demoform.pas

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

        pnShowSource.Visible := False;
        pnOpenDemoDir.Visible := False;
        ShowDemo;
      end
      else begin
        pnShowSource.Visible := True;
      {$IFNDEF LINUX}
        pnOpenDemoDir.Visible := True;
      {$ELSE}
        pnOpenDemoDir.Visible := False;
      {$ENDIF}
        if sbDemo.Down then
          ShowDemo
        else
          if sbSource.Down then
            ShowDemoSource
          else
            ShowFormSource;
      end;
      Self.Caption := ApplicationTitle + ' - ' + Name;
      Application.Title := ApplicationTitle;
    end;
  StatusBar.Repaint;
end;

procedure TDemoForm.ShowDemo;
begin
  pnSource.Visible := False;
  pnDemo.Visible := True;
end;

procedure TDemoForm.ShowDemoSource;
begin
  if not DemoSourceLoaded then begin
    Demos.SelectedDemo.LoadDemoCode(SourceBrowser.Lines);
    DemoSourceLoaded := True;
    FormSourceLoaded := False;
  end;
  pnSource.Visible := True;
  pnDemo.Visible := False;
end;

procedure TDemoForm.ShowFormSource;
begin
  if not FormSourceLoaded then begin
    Demos.SelectedDemo.LoadFormCode(SourceBrowser.Lines);
    FormSourceLoaded := True;
    DemoSourceLoaded := False;
  end;
  pnSource.Visible := True;
  pnDemo.Visible := False;
end;

//User control
procedure TDemoForm.sbOpenDemoDirClick(Sender: TObject);
begin
  Demos.SelectedDemo.OpenDemoFolder;
end;

procedure TDemoForm.cbDebugClick(Sender: TObject);
begin
  Demos.SelectedDemo.Frame.SetDebug(cbDebug.Checked);
end;

{$IFNDEF WIN32}
procedure TDemoForm.OnNavigate(DemoDescription: string);
var
   Node: TTreeNode;
   DemoName, CategoryName, FolderName: string;
   ListBox: TListBox;
   i: integer;
begin
  Node := TreeView.Items.GetFirstNode;
  DemoName := Trim(Copy(DemoDescription, 1, pos('-', DemoDescription) - 1));
  while Node <> nil do begin
    if TDemo(Node.Data).Name = DemoName then begin
      TreeView.Selected := Node;
      SelectDemo;
      break;
    end;
    Node := Node.GetNext;
  end;
  // Demo was not found in the tree. This is supplementary demo.

  if (Demos.SelectedDemo.DemoType = dtCategory) and (DemoName <> '') then begin
    ListBox := TCategoryFrame(Demos.SelectedDemo.Frame).DemosDescription;
    for i := ListBox.ItemIndex downto 0 do
      if (ListBox.Items[i] <> '') and (ListBox.Items[i][1] = ' ') then begin
        CategoryName := Trim(ListBox.Items[i]);
        Break;
      end;
  end;
{$IFNDEF LINUX}
  FolderName := ExtractFilePath(ExtractFileDir(Application.ExeName)) + CategoryName + '\' + DemoName;
  ShellExecute(0, 'open', FolderName, '', '.', SW_SHOW);
{$ENDIF}
end;

{$ELSE}
procedure TDemoForm.OnNavigate(Index: integer);
begin
  TreeView.Items[Index].Selected := True;
  SelectDemo;
end;
{$ENDIF}

procedure TDemoForm.lbAboutClick(Sender: TObject);
begin
  lbAbout.Font.Color := $FFFFFF;
  lbAbout.Cursor := crDefault;
end;

//About highlite
procedure TDemoForm.lbAboutMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  lbAbout.Font.Color := TColor($FF00001A); //clHotLight
  lbAbout.Cursor := crHandPoint;
end;

procedure TDemoForm.lbTitleMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  lbAbout.Font.Color := $FFFFFF;
  lbAbout.Cursor := crDefault;
end;

procedure TDemoForm.sbConnectClick(Sender: TObject);
begin
  GetConnection.Connect;
end;

procedure TDemoForm.sbDisconnectClick(Sender: TObject);
begin
  GetConnection.Disconnect;
end;

procedure TDemoForm.AfterConnect(Sender: TObject);
begin
  sbDisconnect.Enabled := True;
  sbConnect.Enabled := False;
end;

procedure TDemoForm.AfterDisconnect(Sender: TObject);
begin
  sbDisconnect.Enabled := False;
  sbConnect.Enabled := True;
end;

//History
procedure TDemoForm.SelectDemo;
var
  i: integer;
begin
  if TreeView.Selected = ActiveNode then              //Same demo selected
    Exit;
  UpdateDemo;
  if HistoryIndex = (MAX_HISTORY_SIZE - 1) then
    for i := 0 to MAX_HISTORY_SIZE - 2 do
      History[i] := History[i + 1]
  else
    Inc(HistoryIndex);
  History[HistoryIndex] := ActiveNode.AbsoluteIndex;
  HistoryEnd := HistoryIndex;
  DisableBrowse(HistoryIndex = 0, True);
end;

procedure TDemoForm.NavigateHistory(Offset: integer);
begin
  if ((HistoryIndex + Offset) < 0) or ((HistoryIndex + Offset) >= MAX_HISTORY_SIZE) then
    raise Exception.Create('Wrong history index');
  HistoryIndex := HistoryIndex + Offset;
  TreeView.Items[Demos.GetDemoIndex(History[HistoryIndex])].Selected := True;
  DisableBrowse(HistoryIndex = 0, HistoryIndex = HistoryEnd);
  UpdateDemo;
end;

procedure TDemoForm.GetBackHistory(BackList: TStrings);
var
  i: integer;
begin
  BackList.Clear;
  for i := HistoryIndex - 1 downto 0 do
    BackList.Add(Demos[History[i]].Name);
end;

procedure TDemoForm.GetForwardHistory(ForwardList: TStrings);
var
  i: integer;
begin
  ForwardList.Clear;
  for i := HistoryIndex + 1 to HistoryEnd do
    ForwardList.Add(Demos[History[i]].Name);
end;

procedure TDemoForm.DisableBrowse(Back, Forward: boolean);
begin
  tbBrowseBack.Enabled := not Back;
  tbBrowseForward.Enabled := not Forward;
end;

procedure TDemoForm.FillHistoryPopup(BackHistory: boolean);
var
  NewItem: TMenuItem;
  List: TStrings;
  i: integer;
  HistoryPopup: TPopupMenu;
begin
  if BackHistory then
    HistoryPopup := BackHistoryPopup
  else
    HistoryPopup := ForwardHistoryPopup;
  HistoryPopup.Items.Clear;
  List := TStringList.Create;
  if BackHistory then
    GetBackHistory(List)
  else
    GetForwardHistory(List);
  for i := 1 to List.Count do begin
    NewItem := TMenuItem.Create(HistoryPopup);
    HistoryPopup.Items.Add(NewItem);
    NewItem.Caption := List[i - 1];
    if BackHistory then
      NewItem.Tag := -i
    else
      NewItem.Tag := i;
    NewItem.OnClick := HistoryItemClick;
  end;
  List.Free;
end;

procedure TDemoForm.HistoryItemClick(Sender: TObject);
begin
  if Sender is TMenuItem then
    NavigateHistory(TMenuItem(Sender).Tag);
end;

procedure TDemoForm.BackHistoryPopupPopup(Sender: TObject);
begin
  FillHistoryPopup(True);
end;

procedure TDemoForm.ForwardHistoryPopupPopup(Sender: TObject);
begin
  FillHistoryPopup(False);
end;

procedure TDemoForm.tbBrowseBackClick(Sender: TObject);
begin
  NavigateHistory(-1);
end;

procedure TDemoForm.tbBrowseForwardClick(Sender: TObject);
begin
  NavigateHistory(1);
end;

procedure TDemoForm.sbDemoClick(Sender: TObject);
begin
  ShowDemo;
end;

procedure TDemoForm.sbSourceClick(Sender: TObject);
begin
  ShowDemoSource;
end;

procedure TDemoForm.sbFormTextClick(Sender: TObject);
begin
  ShowFormSource;
end;

procedure TDemoForm.FormResize(Sender: TObject);
begin
  lbAbout.Left := lbAbout.Parent.ClientWidth - 100;
  cbDebug.Left := cbDebug.Parent.ClientWidth - 100;
  pnOpenDemoDir.Left := cbDebug.Left - (pnOpenDemoDir.Width + 15);
  pnShowSource.Left := pnOpenDemoDir.Left - (pnShowSource.Width + 15);
end;

procedure TDemoForm.OnScriptError(Sender: TObject; E: Exception;
  SQL: String; var Action: TErrorAction);
var
  OperationStr,
  ScriptFileStr,
  MessageStr: string;
begin
  if DropScriptActive then begin
    OperationStr := 'drop';
    ScriptFileStr := 'UninstallDemoObjects.sql';
  end
  else begin
    OperationStr := 'create';
    ScriptFileStr := 'InstallDemoObjects.sql';
  end;
  MessageStr := Format('An error has been occured: %s' +
    #$d#$d'You can manually %s objects required for demo by using the ' +
    'following file: %%%s%%\Demos\%s' +
    #$d'%%%s%% is the %s installation path on your computer.' + #13#10 + 'Ignore this exception?',
    [E.Message, OperationStr, ProductName, ScriptFileStr, ProductName, ProductName]);
  Action := eaContinue;
  if not IgnoreScriptErrors then
    case MessageDlg(MessageStr, mtError, [mbYes, mbNo{$IFNDEF LINUX}, mbYesToAll{$ENDIF}], 0) of
      mrNo:
        Action := eaAbort;
    {$IFNDEF LINUX}
      mrYesToAll:
        IgnoreScriptErrors := True;
    {$ENDIF}
    end;
end;

procedure TDemoForm.btScriptClick(Sender: TObject);
var
  s: string;
begin
  DropScriptActive := Sender = btDrop;
  if DropScriptActive then
    s := 'removed from database'
  else
    s := 'created in database';
  if MessageDlg(Format('Objects required for the demo will be %s. Continue?', [s]),
    mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin
    IgnoreScriptErrors := False;
    GetConnection.Connect;
    if Sender = btCreate then
      ExecCreateScript
    else
      ExecDropScript;
  end;
end;

end.