Skip to content
Permalink
Browse files

Collect custom session background colors via OnGetColors event of TCo…

…lorBox, do not mix it in the code for refreshing the session tree. Also refresh custom colors each time a session is focused, so it has new colors.
  • Loading branch information...
ansgarbecker committed Jul 20, 2019
1 parent c31cae2 commit fbdddaa765484fc0c80d5c0b0ce124319961c1a2
Showing with 37 additions and 21 deletions.
  1. +1 −0 source/connections.dfm
  2. +36 −21 source/connections.pas
@@ -853,6 +853,7 @@ object connform: Tconnform
DropDownCount = 16
TabOrder = 12
OnChange = Modification
OnGetColors = ColorBoxBackgroundColorGetColors
end
end
end
@@ -172,17 +172,17 @@ Tconnform = class(TExtForm)
procedure btnMoreClick(Sender: TObject);
procedure menuRenameClick(Sender: TObject);
procedure TimerButtonAnimationTimer(Sender: TObject);
procedure ColorBoxBackgroundColorGetColors(Sender: TCustomColorBox;
Items: TStrings);
private
{ Private declarations }
FLoaded: Boolean;
FSessionModified, FOnlyPasswordModified: Boolean;
FServerVersion: String;
FSessionColor: TColor;
FSettingsImportWaitTime: Cardinal;
FPopupDatabases: TPopupMenu;
FButtonAnimationStep: Integer;
FLastSelectedNetTypeGroup: TNetTypeGroup;
FCustomBackgroundColors: TStringList;
procedure RefreshSessions(ParentNode: PVirtualNode);
function SelectedSessionPath: String;
function CurrentParams: TConnectionParameters;
@@ -192,6 +192,7 @@ Tconnform = class(TExtForm)
procedure MenuDatabasesClick(Sender: TObject);
procedure WMNCLBUTTONDOWN(var Msg: TWMNCLButtonDown) ; message WM_NCLBUTTONDOWN;
procedure WMNCLBUTTONUP(var Msg: TWMNCLButtonUp) ; message WM_NCLBUTTONUP;
procedure RefreshBackgroundColors;
public
{ Public declarations }
end;
@@ -306,9 +307,7 @@ procedure Tconnform.FormCreate(Sender: TObject);
procedure Tconnform.RefreshSessions(ParentNode: PVirtualNode);
var
SessionNames: TStringList;
RegKey,
ColorName,
ColorNamePrefix: String;
RegKey: String;
i: Integer;
Params: TConnectionParameters;
SessNode: PVirtualNode;
@@ -317,31 +316,17 @@ procedure Tconnform.RefreshSessions(ParentNode: PVirtualNode);
// And while we're at it, collect custom colors for background color selector
if ParentNode=nil then begin
ListSessions.Clear;
FreeAndNil(FCustomBackgroundColors);
FCustomBackgroundColors := TStringList.Create;
end else begin
ListSessions.DeleteChildren(ParentNode, True);
end;
SessionNames := NodeSessionNames(ParentNode, RegKey);
ColorNamePrefix := _('Custom color:') + ' ';
for i:=0 to SessionNames.Count-1 do begin
Params := TConnectionParameters.Create(RegKey+SessionNames[i]);
SessNode := ListSessions.AddChild(ParentNode, PConnectionParameters(Params));
if Params.IsFolder then begin
RefreshSessions(SessNode);
end else begin
ColorName := ColorNamePrefix + ColorToWebColorStr(Params.SessionColor);
if (Params.SessionColor <> clNone) and (FCustomBackgroundColors.IndexOf(ColorName) = -1) then begin
FCustomBackgroundColors.AddObject(ColorName, TObject(Params.SessionColor));
end;
end;
end;

// Add custom colors if not already done before
if (FCustomBackgroundColors.Count > 0)
and (not ColorBoxBackgroundColor.Items.Text.Contains(ColorNamePrefix)) then begin
ColorBoxBackgroundColor.Items.AddStrings(FCustomBackgroundColors);
end;
end;


@@ -607,7 +592,7 @@ function Tconnform.CurrentParams: TConnectionParameters;
end else begin
Result := TConnectionParameters.Create;
Result.SessionPath := SelectedSessionPath;
Result.SessionColor := FSessionColor;
Result.SessionColor := ColorBoxBackgroundColor.Selected;
Result.NetType := TNetType(comboNetType.ItemIndex);
Result.ServerVersion := FServerVersion;
Result.Hostname := editHost.Text;
@@ -886,6 +871,7 @@ procedure Tconnform.ListSessionsFocusChanged(Sender: TBaseVirtualTree;
updownKeepAlive.Position := Sess.KeepAlive;
chkLocalTimeZone.Checked := Sess.LocalTimeZone;
chkFullTableStatus.Checked := Sess.FullTableStatus;
RefreshBackgroundColors;
ColorBoxBackgroundColor.Selected := Sess.SessionColor;
editDatabases.Text := Sess.AllDatabasesStr;
comboLibrary.ItemIndex := comboLibrary.Items.IndexOf(Sess.LibraryFile);
@@ -908,7 +894,6 @@ procedure Tconnform.ListSessionsFocusChanged(Sender: TBaseVirtualTree;
editSSLCACertificate.Text := Sess.SSLCACertificate;
editSSLCipher.Text := Sess.SSLCipher;
FServerVersion := Sess.ServerVersion;
FSessionColor := Sess.SessionColor;
end;

FLoaded := True;
@@ -922,6 +907,14 @@ procedure Tconnform.ListSessionsFocusChanged(Sender: TBaseVirtualTree;
end;


procedure Tconnform.RefreshBackgroundColors;
begin
// Trigger OnGetColors event
ColorBoxBackgroundColor.Style := ColorBoxBackgroundColor.Style - [cbCustomColors];
ColorBoxBackgroundColor.Style := ColorBoxBackgroundColor.Style + [cbCustomColors];
end;


procedure Tconnform.TimerStatisticsTimer(Sender: TObject);
var
LastConnect, Created, DummyDate: TDateTime;
@@ -1029,6 +1022,28 @@ procedure Tconnform.chkLoginPromptClick(Sender: TObject);
end;


procedure Tconnform.ColorBoxBackgroundColorGetColors(Sender: TCustomColorBox;
Items: TStrings);
var
Node: PVirtualNode;
PParams: PConnectionParameters;
ColorName,
ColorNamePrefix: String;
begin
// Collect custom session colors into color selector
ColorNamePrefix := _('Custom color:') + ' ';
Node := ListSessions.GetFirst;
while Assigned(Node) do begin
PParams := ListSessions.GetNodeData(Node);
ColorName := ColorNamePrefix + ColorToWebColorStr(PParams.SessionColor);
if (PParams.SessionColor <> clNone) and (Items.IndexOf(ColorName) = -1) then begin
Items.AddObject(ColorName, TObject(PParams.SessionColor));
end;
Node := ListSessions.GetNext(Node);
end;
end;


procedure Tconnform.editDatabasesRightButtonClick(Sender: TObject);
var
Connection: TDBConnection;

0 comments on commit fbdddaa

Please sign in to comment.
You can’t perform that action at this time.