New feature: When mouse hovers over status bar panel holding the server version, display various connection related details in a hint.

This commit is contained in:
Ansgar Becker
2010-05-28 19:41:17 +00:00
parent 3feebd877f
commit 5351f8df23
4 changed files with 103 additions and 8 deletions

View File

@ -90,6 +90,8 @@ object MainForm: TMainForm
Width = 250
end>
ParentDoubleBuffered = False
OnMouseLeave = StatusBarMouseLeave
OnMouseMove = StatusBarMouseMove
OnDrawPanel = StatusBarDrawPanel
end
object ControlBar1: TControlBar

View File

@ -775,9 +775,11 @@ type
procedure tabsetQueryMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure tabsetQueryMouseLeave(Sender: TObject);
procedure StatusBarDrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel; const Rect: TRect);
procedure StatusBarMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure StatusBarMouseLeave(Sender: TObject);
private
LastResultTabMousepos: TPoint;
LastResultTabNrHint: Integer;
LastHintMousepos: TPoint;
LastHintControlIndex: Integer;
FDelimiter: String;
FileNameSessionLog: String;
FileHandleSessionLog: Textfile;
@ -1008,6 +1010,49 @@ begin
end;
end;
procedure TMainForm.StatusBarMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
MouseP: TPoint;
Bar: TStatusBar;
PanelRect: TRect;
i: Integer;
Infos: TStringList;
begin
// Display various server, client and connection related details in a hint
if (LastHintMousepos.X = X) and (LastHintMousepos.Y = Y) then
Exit;
LastHintMousepos := Point(X, Y);
MouseP := StatusBar.ClientOrigin;
Inc(MouseP.X, X);
Inc(MouseP.Y, Y);
Bar := Sender as TStatusBar;
for i:=0 to Bar.Panels.Count-1 do begin
SendMessage(Bar.Handle, SB_GETRECT, i, Integer(@PanelRect));
if PtInRect(PanelRect, LastHintMousepos) then
break;
end;
if i = LastHintControlIndex then
Exit;
LastHintControlIndex := i;
if LastHintControlIndex = 3 then begin
Infos := Connection.ConnectionInfo;
BalloonHint1.Description := '';
for i:=0 to Infos.Count-1 do
BalloonHint1.Description := BalloonHint1.Description + Infos.Names[i] + ': ' + Infos.ValueFromIndex[i] + CRLF;
BalloonHint1.Description := Trim(BalloonHint1.Description);
OffsetRect(PanelRect, Bar.ClientOrigin.X, Bar.ClientOrigin.Y);
BalloonHint1.ShowHint(PanelRect);
end else
Bar.OnMouseLeave(Sender);
end;
procedure TMainForm.StatusBarMouseLeave(Sender: TObject);
begin
BalloonHint1.HideHint;
LastHintControlIndex := -1;
end;
procedure TMainForm.actExitApplicationExecute(Sender: TObject);
begin
@ -5295,14 +5340,14 @@ var
ResultTab: TResultTab;
begin
// Display some hint with row/col count + SQL when mouse hovers over result tab
if (LastResultTabMousepos.X = x) and (LastResultTabMousepos.Y = Y) then
if (LastHintMousepos.X = x) and (LastHintMousepos.Y = Y) then
Exit;
LastResultTabMousepos := Point(X, Y);
LastHintMousepos := Point(X, Y);
Tabs := Sender as TTabSet;
idx := Tabs.ItemAtPos(Point(X, Y), True);
if (idx = -1) or (idx = LastResultTabNrHint) then
if (idx = -1) or (idx = LastHintControlIndex) then
Exit;
LastResultTabNrHint := idx;
LastHintControlIndex := idx;
ResultTab := ActiveQueryTab.ResultTabs[idx];
BalloonHint1.Description := FormatNumber(ResultTab.Results.ColumnCount) + ' columns x ' +
FormatNumber(ResultTab.Results.RecordCount) + ' rows' + CRLF +
@ -5318,7 +5363,7 @@ procedure TMainForm.tabsetQueryMouseLeave(Sender: TObject);
begin
// BalloonHint.HideAfter is -1, so it will stay forever if we wouldn't hide it at some point
BalloonHint1.HideHint;
LastResultTabNrHint := -1;
LastHintControlIndex := -1;
end;

View File

@ -192,7 +192,9 @@ type
FOnDBObjectsCleared: TMySQLDatabaseEvent;
FRowsFound: Int64;
FRowsAffected: Int64;
FServerOS: String;
FServerVersionUntouched: String;
FRealHostname: String;
FLastQueryDuration, FLastQueryNetworkDuration: Cardinal;
FIsUnicode: Boolean;
FTableEngines: TStringList;
@ -243,6 +245,7 @@ type
function DbObjectsCached(db: String): Boolean;
function ParseDateTime(Str: String): TDateTime;
function GetKeyColumns(Columns: TTableColumnList; Keys: TTableKeyList): TStringList;
function ConnectionInfo: TStringList;
procedure ClearDbObjects(db: String);
procedure ClearAllDbObjects;
property Parameters: TConnectionParameters read FParameters write FParameters;
@ -251,6 +254,7 @@ type
property ServerUptime: Integer read GetServerUptime;
property CharacterSet: String read GetCharacterSet write SetCharacterSet;
property LastError: String read GetLastError;
property ServerOS: String read FServerOS;
property ServerVersionUntouched: String read FServerVersionUntouched;
property ServerVersionStr: String read GetServerVersionStr;
property ServerVersionInt: Integer read GetServerVersionInt;
@ -555,6 +559,8 @@ begin
FConnectionStarted := GetTickCount div 1000;
FServerStarted := FConnectionStarted - StrToIntDef(GetVar('SHOW STATUS LIKE ''Uptime''', 1), 1);
FServerVersionUntouched := DecodeAPIString(mysql_get_server_info(FHandle));
FServerOS := GetVar('SHOW VARIABLES LIKE ' + esc('version_compile_os'), 1);
FRealHostname := GetVar('SHOW VARIABLES LIKE ' + esc('hostname'), 1);;
if FDatabase <> '' then begin
tmpdb := FDatabase;
FDatabase := '';
@ -1501,6 +1507,48 @@ begin
end;
function TMySQLConnection.ConnectionInfo: TStringList;
var
Infos, Val: String;
rx: TRegExpr;
function EvalBool(B: Boolean): String;
begin
if B then Result := 'Yes' else Result := 'No';
end;
begin
Result := TStringList.Create;
if Assigned(Parameters) then
Result.Values['Hostname'] := Parameters.Hostname;
Ping;
Result.Values['Connected'] := EvalBool(FActive);
if FActive then begin
Result.Values['Real Hostname'] := FRealHostname;
Result.Values['Server OS'] := ServerOS;
Result.Values['Server version'] := FServerVersionUntouched;
Result.Values['Client version (libmysql)'] := DecodeApiString(mysql_get_client_info);
Result.Values['Connection port'] := IntToStr(Parameters.Port);
Result.Values['Compressed protocol'] := EvalBool(opCompress in Parameters.Options);
Result.Values['Unicode enabled'] := EvalBool(IsUnicode);
Infos := DecodeApiString(mysql_stat(FHandle));
rx := TRegExpr.Create;
rx.ModifierG := False;
rx.Expression := '(\S.*)\:\s+(\S*)(\s+|$)';
if rx.Exec(Infos) then while True do begin
Val := rx.Match[2];
if LowerCase(rx.Match[1]) = 'uptime' then
Val := FormatTimeNumber(StrToIntDef(Val, 0))
else
Val := FormatNumber(Val);
Result.Values[rx.Match[1]] := Val;
if not rx.ExecNext then
break;
end;
rx.Free;
end;
end;
{ TMySQLQuery }

View File

@ -1010,7 +1010,7 @@ begin
Header := '# --------------------------------------------------------' + CRLF +
Format('# %-30s%s', ['Host:', Mainform.Connection.Parameters.HostName]) + CRLF +
Format('# %-30s%s', ['Server version:', Mainform.Connection.ServerVersionUntouched]) + CRLF +
Format('# %-30s%s', ['Server OS:', Mainform.Connection.GetVar('SHOW VARIABLES LIKE ' + esc('version_compile_os'), 1)]) + CRLF +
Format('# %-30s%s', ['Server OS:', Mainform.Connection.ServerOS]) + CRLF +
Format('# %-30s%s', [APPNAME + ' version:', Mainform.AppVersion]) + CRLF +
Format('# %-30s%s', ['Date/time:', DateTimeToStr(Now)]) + CRLF +
'# --------------------------------------------------------' + CRLF + CRLF +