unit sqlhelp; interface uses Winapi.Windows, System.SysUtils, System.Classes, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls, Vcl.ExtCtrls, Vcl.Buttons, SynMemo, SynEditHighlighter, SynHighlighterURI, extra_controls, SynURIOpener, SynEdit, VirtualTrees, Vcl.Graphics, dbconnection, gnugettext; type TfrmSQLhelp = class(TExtForm) URIOpenerDescription: TSynURIOpener; URIHighlighter: TSynURISyn; URIOpenerExample: TSynURIOpener; btnSearchOnline: TButton; ButtonClose: TButton; pnlMain: TPanel; pnlLeft: TPanel; treeTopics: TVirtualStringTree; editFilter: TButtonedEdit; pnlRight: TPanel; Splitter2: TSplitter; Splitter1: TSplitter; lblDescription: TLabel; lblKeyword: TLabel; memoDescription: TSynMemo; lblExample: TLabel; MemoExample: TSynMemo; timerSearch: TTimer; procedure FormCreate(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: TImageIndex); 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 *.dfm} procedure TfrmSQLhelp.FormCreate(Sender: TObject); begin // Set window-layout lblKeyword.Font.Style := [fsBold]; Caption := DEFAULT_WINDOW_CAPTION; FixVT(treeTopics); HasSizeGrip := True; treeTopics.Clear; FreeAndNil(FRootTopics); FConnection := MainForm.ActiveConnection; FRootTopics := FConnection.GetResults('HELP '+FConnection.EscapeString('CONTENTS')); treeTopics.RootNodeCount := FRootTopics.RecordCount; end; procedure TfrmSQLhelp.FormClose(Sender: TObject; var Action: TCloseAction); begin AppSettings.WriteInt(asSQLHelpWindowLeft, Left ); AppSettings.WriteInt(asSQLHelpWindowTop, Top ); AppSettings.WriteIntDpiAware(asSQLHelpWindowWidth, Self, Width); AppSettings.WriteIntDpiAware(asSQLHelpWindowHeight, Self, Height); AppSettings.WriteIntDpiAware(asSQLHelpPnlLeftWidth, Self, pnlLeft.Width); AppSettings.WriteIntDpiAware(asSQLHelpPnlRightTopHeight, Self, memoDescription.Height); 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: TImageIndex); 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 Top := AppSettings.ReadInt(asSQLHelpWindowTop); Left := AppSettings.ReadInt(asSQLHelpWindowLeft); Width := AppSettings.ReadIntDpiAware(asSQLHelpWindowWidth, Self); Height := AppSettings.ReadIntDpiAware(asSQLHelpWindowHeight, Self); MakeFullyVisible; pnlLeft.Width := AppSettings.ReadIntDpiAware(asSQLHelpPnlLeftWidth, Self); memoDescription.Height := AppSettings.ReadIntDpiAware(asSQLHelpPnlRightTopHeight, Self); // 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.RightButton.Visible := 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.