unit sqlhelp; {$mode delphi}{$H+} interface uses SysUtils, Classes, Controls, Forms, Dialogs, StdCtrls, ComCtrls, ExtCtrls, Buttons, SynEdit, SynEditHighlighter, extra_controls, laz.VirtualTrees, Graphics, EditBtn, dbconnection; type { TfrmSQLhelp } TfrmSQLhelp = class(TExtForm) //URIOpenerDescription: TSynURIOpener; //URIHighlighter: TSynURISyn; //URIOpenerExample: TSynURIOpener; btnSearchOnline: TSpeedButton; ButtonClose: TButton; pnlBottom: TPanel; pnlMain: TPanel; pnlLeft: TPanel; treeTopics: TLazVirtualStringTree; editFilter: TEditButton; pnlRight: TPanel; Splitter2: TSplitter; Splitter1: TSplitter; lblDescription: TLabel; lblKeyword: TLabel; memoDescription: TSynEdit; lblExample: TLabel; MemoExample: TSynEdit; timerSearch: TTimer; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure memosKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure ButtonOnlinehelpClick(Sender: TObject); procedure ButtonCloseClick(Sender: TObject); procedure DoSearch(Sender: TObject); procedure treeTopicsGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer); procedure treeTopicsInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); procedure treeTopicsInitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; var ChildCount: Cardinal); procedure treeTopicsGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: Integer); procedure treeTopicsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); procedure treeTopicsFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); procedure treeTopicsFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex); procedure editFilterChange(Sender: TObject); procedure editFilterRightButtonClick(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure FormShow(Sender: TObject); private { Private declarations } FConnection: TDBConnection; FKeyword: String; FRootTopics: TDBQuery; function GetHelpResult(Node: PVirtualNode): TDBQuery; procedure SetKeyword(Value: String); public { Public declarations } property Keyword: String read FKeyword write SetKeyword; end; var SqlHelpDialog: TfrmSQLhelp; // global var, so we can apply settings via SetupSynEditors const DEFAULT_WINDOW_CAPTION : String = 'Integrated SQL-help' ; ICONINDEX_CATEGORY_CLOSED : Integer = 66; ICONINDEX_CATEGORY_OPENED : Integer = 67; ICONINDEX_HELPITEM : Integer = 68; implementation uses apphelpers, main; {$I const.inc} {$R *.lfm} procedure TfrmSQLhelp.FormCreate(Sender: TObject); begin // Set window-layout lblKeyword.Font.Style := [fsBold]; Caption := DEFAULT_WINDOW_CAPTION; FixVT(treeTopics); HasSizeGrip := True; Top := AppSettings.ReadInt(asSQLHelpWindowTop); Left := AppSettings.ReadInt(asSQLHelpWindowLeft); Width := AppSettings.ReadInt(asSQLHelpWindowWidth); Height := AppSettings.ReadInt(asSQLHelpWindowHeight); MakeFullyVisible; pnlLeft.Width := AppSettings.ReadInt(asSQLHelpPnlLeftWidth); memoDescription.Height := AppSettings.ReadInt(asSQLHelpPnlRightTopHeight); treeTopics.Clear; FreeAndNil(FRootTopics); FConnection := MainForm.ActiveConnection; FRootTopics := FConnection.GetResults('HELP '+FConnection.EscapeString('CONTENTS')); treeTopics.RootNodeCount := FRootTopics.RecordCount; end; procedure TfrmSQLhelp.FormDestroy(Sender: TObject); begin AppSettings.WriteInt(asSQLHelpWindowLeft, ScaleFormToDesign(Left)); AppSettings.WriteInt(asSQLHelpWindowTop, ScaleFormToDesign(Top)); AppSettings.WriteInt(asSQLHelpWindowWidth, ScaleFormToDesign(Width)); AppSettings.WriteInt(asSQLHelpWindowHeight, ScaleFormToDesign(Height)); AppSettings.WriteInt(asSQLHelpPnlLeftWidth, ScaleFormToDesign(pnlLeft.Width)); AppSettings.WriteInt(asSQLHelpPnlRightTopHeight, ScaleFormToDesign(memoDescription.Height)); end; procedure TfrmSQLhelp.FormClose(Sender: TObject; var Action: TCloseAction); begin Action := caFree; SqlHelpDialog := nil; end; procedure TfrmSQLhelp.treeTopicsFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex); var Results: TDBQuery; VT: TVirtualStringTree; begin // Topic selected VT := Sender as TVirtualStringTree; if not Assigned(VT.FocusedNode) then Exit; if VT.HasChildren[VT.FocusedNode] then Exit; FKeyword := VT.Text[VT.FocusedNode, VT.FocusedColumn]; lblKeyword.Caption := Copy(FKeyword, 0, 100); MemoDescription.Lines.Clear; MemoExample.Lines.Clear; Caption := DEFAULT_WINDOW_CAPTION; if FKeyword <> '' then try Screen.Cursor := crHourglass; Results := FConnection.GetResults('HELP '+FConnection.EscapeString(FKeyword)); Caption := Caption + ' - ' + FKeyword; MemoDescription.Text := fixNewlines(Results.Col('description', True)); MemoExample.Text := fixNewlines(Results.Col('example', True)); finally FreeAndNil(Results); Screen.Cursor := crDefault; end; // Show the user if topic is (not) available if memoDescription.GetTextLen = 0 then memoDescription.Text := _('No help available for this keyword or no keyword was selected.'); if memoExample.GetTextLen = 0 then memoExample.Text := _('No example available or no keyword was selected.'); end; procedure TfrmSQLhelp.treeTopicsFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); var Results: PDBQuery; begin // Node gets destroyed - free memory used for bound SQL result Results := Sender.GetNodeData(Node); if Assigned(Results^) then Results^.Free; end; procedure TfrmSQLhelp.treeTopicsGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: Integer); begin // Return open or closed book icon for folders, or document icon for topics if not (Kind in [ikNormal, ikSelected]) then Exit; if Sender.HasChildren[Node] then begin if Sender.Expanded[Node] then ImageIndex := ICONINDEX_CATEGORY_OPENED else ImageIndex := ICONINDEX_CATEGORY_CLOSED; end else ImageIndex := ICONINDEX_HELPITEM; end; procedure TfrmSQLhelp.treeTopicsGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer); begin // We bind one TDBQuery to a node NodeDataSize := SizeOf(TDBQuery); end; function TfrmSQLhelp.GetHelpResult(Node: PVirtualNode): TDBQuery; var P: PDBQuery; begin // Find right result set for given node if treeTopics.GetNodeLevel(Node) = 0 then Result := FRootTopics else begin P := treeTopics.GetNodeData(Node.Parent); Result := P^; end; end; procedure TfrmSQLhelp.treeTopicsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); var Results: TDBQuery; begin // Ask result set for node text Results := GetHelpResult(Node); Results.RecNo := Node.Index; CellText := Results.Col('name'); end; procedure TfrmSQLhelp.treeTopicsInitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; var ChildCount: Cardinal); var Results: PDBQuery; VT: TVirtualStringTree; begin // Return number of children for folder VT := Sender as TVirtualStringTree; Results := VT.GetNodeData(Node); Results^ := FConnection.GetResults('HELP '+FConnection.EscapeString(VT.Text[Node, VT.Header.MainColumn])); ChildCount := Results.RecordCount; end; procedure TfrmSQLhelp.treeTopicsInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); var Results: TDBQuery; ThisFolder, PrevFolder: String; N: PVirtualNode; VT: TVirtualStringTree; RecursionAlarm: Boolean; begin // Display plus button for nodes which are folders VT := Sender as TVirtualStringTree; Results := GetHelpResult(Node); Results.RecNo := Node.Index; if Results.Col('is_it_category', True) = 'Y' then begin // Some random server versions have duplicated category names in help tables, which would cause // infinite tree recursion, e.g. for "Polygon properties" > "Contents". Do not display these // duplicates as folder RecursionAlarm := False; ThisFolder := Results.Col('name'); N := VT.GetPreviousInitialized(Node); while Assigned(N) do begin PrevFolder := VT.Text[N, VT.Header.MainColumn]; if VT.HasChildren[N] and ((ThisFolder=PrevFolder) or (ThisFolder='Contents')) then begin RecursionAlarm := True; break; end; N := VT.GetPreviousInitialized(N); end; if not RecursionAlarm then Include(InitialStates, ivsHasChildren); end; end; procedure TfrmSQLhelp.ButtonCloseClick(Sender: TObject); begin Close; end; procedure TfrmSQLhelp.FormShow(Sender: TObject); begin // Apply themed colors in OnShow, not OnCreate, as a check with <> nil returns false otherwise MainForm.SetupSynEditors(Self); // These SynMemo's don't have any (SQL) highligher, so we have to assign correct colors for basic text memoDescription.Font.Color := GetThemeColor(clWindowText); MemoExample.Font.Color := GetThemeColor(clWindowText); editFilter.SetFocus; end; procedure TfrmSQLhelp.ButtonOnlinehelpClick(Sender: TObject); begin // Link/redirect to mysql.com for further help ShellExec(APPDOMAIN + 'sqlhelp.php?mysqlversion='+inttostr(FConnection.ServerVersionInt)+ '&keyword='+EncodeURLParam(keyword)); end; procedure TfrmSQLhelp.memosKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin // Esc pressed - close form. // Seems that if we're in a memo, the ButtonClose.Cancel=True doesn't have an effect //if Key = VK_ESCAPE then // Close; end; procedure TfrmSQLhelp.SetKeyword(Value: string); var VT: TVirtualStringTree; Node: PVirtualNode; Results: TDBQuery; SearchNoInit: Boolean; begin // Find keyword in tree FKeyword := Value; if FKeyword = '' then Exit; Results := FConnection.GetResults('HELP '+FConnection.EscapeString(FKeyword)); while not Results.Eof do begin if Results.Col('is_it_category', true) = 'N' then begin FKeyword := Results.Col('name'); break; end; Results.Next; end; FreeAndNil(Results); VT := treeTopics; if (not Assigned(VT.FocusedNode)) // No node selected or VT.HasChildren[VT.FocusedNode] // Selected node is a folder, not a document or (VT.Text[VT.FocusedNode, VT.Header.MainColumn] <> FKeyword) // Node is not the right one then begin // Start searching in initialized nodes, to minimize number of "HELP xyz" queries in certain cases Node := VT.GetFirst; SearchNoInit := False; while Assigned(Node) do begin if (not VT.HasChildren[Node]) and (UpperCase(VT.Text[Node, VT.Header.MainColumn]) = UpperCase(FKeyword)) then begin SelectNode(VT, Node); break; end; if not SearchNoInit then begin Node := VT.GetNextInitialized(Node); if not Assigned(Node) then begin SearchNoInit := True; Node := VT.GetFirst; end; end; if SearchNoInit then Node := VT.GetNext(Node); end; end; end; procedure TfrmSQLhelp.editFilterChange(Sender: TObject); begin timerSearch.Enabled := False; timerSearch.Enabled := True; editFilter.Button.Enabled := Trim(editFilter.Text) <> ''; end; procedure TfrmSQLhelp.editFilterRightButtonClick(Sender: TObject); begin editFilter.Clear; end; procedure TfrmSQLhelp.DoSearch(Sender: TObject); var Node: PVirtualNode; Search: String; Vis: Boolean; function HasVisibleChildItems(Node: PVirtualNode): Boolean; var N: PVirtualNode; begin N := treeTopics.GetFirstChild(Node); Result := False; while Assigned(N) do begin if treeTopics.HasChildren[N] then Result := HasVisibleChildItems(N) else Result := treeTopics.IsVisible[N]; if Result then Exit; N := treeTopics.GetNextSibling(N); end; end; begin // Apply filter text Screen.Cursor := crHourglass; treeTopics.BeginUpdate; timerSearch.Enabled := False; Search := Trim(editFilter.Text); if Search = '' then begin // Show all items Node := treeTopics.GetFirstInitialized; while Assigned(Node) do begin treeTopics.IsVisible[Node] := True; Node := treeTopics.GetNextInitialized(Node); end; end else begin // Hide non matching child items Node := treeTopics.GetFirst; while Assigned(Node) do begin if not treeTopics.HasChildren[Node] then treeTopics.IsVisible[Node] := Pos(UpperCase(Search), UpperCase(treeTopics.Text[Node, treeTopics.Header.MainColumn])) > 0; Node := treeTopics.GetNext(Node); end; // Hide empty folders Node := treeTopics.GetFirst; while Assigned(Node) do begin if treeTopics.HasChildren[Node] then begin Vis := HasVisibleChildItems(Node); treeTopics.Expanded[Node] := Vis; treeTopics.IsVisible[Node] := Vis; end; Node := treeTopics.GetNext(Node); end; end; treeTopics.EndUpdate; Screen.Cursor := crDefault; end; end.