unit sqlhelp;

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, VirtualTrees.BaseTree, VirtualTrees.Types,

VirtualTrees.BaseAncestorVCL, VirtualTrees.AncestorVCL, dbstructures;

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;

uses apphelpers, main;

procedure TfrmSQLhelp.FormCreate(Sender: TObject);

// 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(FConnection.SqlProvider.GetSql(qHelpKeyword, [FConnection.EscapeString('CONTENTS')]));

treeTopics.RootNodeCount := FRootTopics.RecordCount;

end;

procedure TfrmSQLhelp.FormClose(Sender: TObject; var Action: TCloseAction);

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);

Results: TDBQuery;

VT: TVirtualStringTree;

// 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, 1, 100);

MemoDescription.Lines.Clear;

MemoExample.Lines.Clear;

Caption := DEFAULT_WINDOW_CAPTION;

if FKeyword <> '' then try

Screen.Cursor := crHourglass;

Results := FConnection.GetResults(FConnection.SqlProvider.GetSql(qHelpKeyword, [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);

Results: PDBQuery;

// 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);

// 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);

// We bind one TDBQuery to a node

NodeDataSize := SizeOf(TDBQuery);

end;

function TfrmSQLhelp.GetHelpResult(Node: PVirtualNode): TDBQuery;

P: PDBQuery;

// 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);

Results: TDBQuery;

// 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);

Results: PDBQuery;

VT: TVirtualStringTree;

// Return number of children for folder

VT := Sender as TVirtualStringTree;

Results := VT.GetNodeData(Node);

Results^ := FConnection.GetResults(FConnection.SqlProvider.GetSql(qHelpKeyword, [FConnection.EscapeString(VT.Text[Node, VT.Header.MainColumn])]));

ChildCount := Results.RecordCount;

end;

procedure TfrmSQLhelp.treeTopicsInitNode(Sender: TBaseVirtualTree; ParentNode,

Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);

Results: TDBQuery;

ThisFolder, PrevFolder: String;

N: PVirtualNode;

VT: TVirtualStringTree;

RecursionAlarm: Boolean;

// 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);

Close;

end;

procedure TfrmSQLhelp.FormShow(Sender: TObject);

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);

// 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);

// 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);

VT: TVirtualStringTree;

Node: PVirtualNode;

Results: TDBQuery;

SearchNoInit: Boolean;

// Find keyword in tree

FKeyword := Value;

if FKeyword = '' then

Exit;

Results := FConnection.GetResults(FConnection.SqlProvider.GetSql(qHelpKeyword, [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);

timerSearch.Enabled := False;

timerSearch.Enabled := True;

editFilter.RightButton.Visible := Trim(editFilter.Text) <> '';

end;

procedure TfrmSQLhelp.editFilterRightButtonClick(Sender: TObject);

editFilter.Clear;

end;

procedure TfrmSQLhelp.DoSearch(Sender: TObject);

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;

// 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.