Skip to content
Permalink
Browse files

Issue #513: add a theme preview dialog, which loads the selected them…

…e png file from heidisql.com
  • Loading branch information...
ansgarbecker committed Jul 13, 2019
1 parent 0a31363 commit e4423c76a3fe6b1075fd48253ae6f985a9f06235
@@ -44,7 +44,8 @@ uses
extra_controls in '..\..\source\extra_controls.pas',
change_password in '..\..\source\change_password.pas' {frmPasswordChange},
Vcl.Themes,
Vcl.Styles;
Vcl.Styles,
theme_preview in '..\..\source\theme_preview.pas' {frmThemePreview};

{.$R *.RES}
{$R ..\..\res\icon.RES}
@@ -71,6 +72,7 @@ begin
Application.Terminate;
end else begin
AppLanguage := AppSettings.ReadString(asAppLanguage);
// SysLanguage may be zh_CN, while we don't offer such a language, but anyway, this is just the current system language:
SysLanguage := DefaultInstance.GetCurrentLocaleName;
UseLanguage(AppLanguage);
Application.Initialize;
@@ -233,6 +233,10 @@
<Form>frmPasswordChange</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="..\..\source\theme_preview.pas">
<Form>frmThemePreview</Form>
<FormType>dfm</FormType>
</DCCReference>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
@@ -184,6 +184,7 @@ TQueryThread = class(TThread)
asColumnSelectorWidth, asColumnSelectorHeight, asDonatedEmail, asFavoriteObjects, asFavoriteObjectsOnly, asFullTableStatus, asLineBreakStyle,
asPreferencesWindowWidth, asPreferencesWindowHeight,
asFileDialogEncoding,
asThemePreviewWidth, asThemePreviewHeight, asThemePreviewTop, asThemePreviewLeft,
asUnused);
TAppSetting = record
Name: String;
@@ -360,6 +361,7 @@ TAppSettings = class(TObject)
function GetThemeColor(Color: TColor): TColor;
function ThemeIsDark(ThemeName: String): Boolean;
function ProcessExists(pid: Cardinal): Boolean;
procedure ToggleCheckBoxWithoutClick(chk: TCheckBox; State: Boolean);

var
AppSettings: TAppSettings;
@@ -3014,6 +3016,18 @@ function ProcessExists(pid: Cardinal): Boolean;
end;


procedure ToggleCheckBoxWithoutClick(chk: TCheckBox; State: Boolean);
var
ClickEvent: TNotifyEvent;
begin
ClickEvent := chk.OnClick;
chk.OnClick := nil;
chk.Checked := State;
chk.OnClick := ClickEvent;
end;




{ Threading stuff }

@@ -3695,6 +3709,10 @@ constructor TAppSettings.Create;
InitSetting(asPreferencesWindowWidth, 'PreferencesWindowWidth', 740);
InitSetting(asPreferencesWindowHeight, 'PreferencesWindowHeight', 500);
InitSetting(asFileDialogEncoding, 'FileDialogEncoding_%s', 0);
InitSetting(asThemePreviewWidth, 'ThemePreviewWidth', 300);
InitSetting(asThemePreviewHeight, 'ThemePreviewHeight', 200);
InitSetting(asThemePreviewTop, 'ThemePreviewTop', 300);
InitSetting(asThemePreviewLeft, 'ThemePreviewLeft', 300);

// Initialization values
FRestoreTabsInitValue := ReadBool(asRestoreTabs);
@@ -296,7 +296,7 @@ object optionsform: Toptionsform
Tag = 1
Left = 190
Top = 282
Width = 505
Width = 392
Height = 21
Style = csDropDownList
Anchors = [akLeft, akTop, akRight]
@@ -333,6 +333,16 @@ object optionsform: Toptionsform
'https://www.bing.com/search?q=%query'
'https://www.google.com/search?q=%query')
end
object chkThemePreview: TCheckBox
Left = 588
Top = 284
Width = 97
Height = 17
Anchors = [akTop, akRight]
Caption = 'Preview'
TabOrder = 19
OnClick = chkThemePreviewClick
end
end
end
object tabLogging: TTabSheet
@@ -13,7 +13,7 @@ interface
StdCtrls, ComCtrls, ExtCtrls, SynEditHighlighter, SynHighlighterSQL,
SynEdit, SynMemo, VirtualTrees, SynEditKeyCmds, ActnList, SynEditMiscClasses, StdActns, Menus,
dbstructures, gnugettext, Vcl.Themes, Vcl.Styles, SynRegExpr, Generics.Collections,
Vcl.ImageCollection, extra_controls;
Vcl.ImageCollection, extra_controls, theme_preview, Vcl.Buttons;

type
TShortcutItemData = record
@@ -174,6 +174,7 @@ Toptionsform = class(TFormWithSizeGrip)
chkLogEventScript: TCheckBox;
lblWebSearchBaseUrl: TLabel;
comboWebSearchBaseUrl: TComboBox;
chkThemePreview: TCheckBox;
procedure FormShow(Sender: TObject);
procedure Modified(Sender: TObject);
procedure Apply(Sender: TObject);
@@ -217,6 +218,7 @@ Toptionsform = class(TFormWithSizeGrip)
procedure comboGridTextColorsPresetSelect(Sender: TObject);
procedure comboThemeSelect(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure chkThemePreviewClick(Sender: TObject);
private
{ Private declarations }
FWasModified: Boolean;
@@ -226,6 +228,7 @@ Toptionsform = class(TFormWithSizeGrip)
FLanguages: TStringList;
FRestartOptionTouched: Boolean;
FRestartOptionApplied: Boolean;
FThemePreview: TfrmThemePreview;
procedure InitLanguages;
procedure SelectDirectory(Sender: TObject; NewFolderButton: Boolean);
public
@@ -1004,6 +1007,11 @@ procedure Toptionsform.comboThemeSelect(Sender: TObject);
comboEditorColorsPresetChange(comboEditorColorsPreset);
end;

// Update preview window
if chkThemePreview.Checked then begin
FThemePreview.LoadTheme(comboTheme.Text);
end;

Modified(Sender);
end;

@@ -1055,6 +1063,20 @@ procedure Toptionsform.btnRestoreDefaultsClick(Sender: TObject);
end;


procedure Toptionsform.chkThemePreviewClick(Sender: TObject);
begin
// Show or hide theme preview window
if chkThemePreview.Checked then begin
FThemePreview := TfrmThemePreview.Create(chkThemePreview);
FThemePreview.PopupMode := pmExplicit;
FThemePreview.PopupParent := Self;
FThemePreview.Show;
FThemePreview.LoadTheme(comboTheme.Text);
end else begin
FThemePreview.Close;
end;
end;

procedure Toptionsform.TreeShortcutItemsFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex);
var
@@ -0,0 +1,45 @@
object frmThemePreview: TfrmThemePreview
Left = 0
Top = 0
Caption = 'Theme preview'
ClientHeight = 157
ClientWidth = 245
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 13
object StatusBarMain: TStatusBar
Left = 0
Top = 138
Width = 245
Height = 19
Panels = <>
SimplePanel = True
end
object ScrollBoxImage: TScrollBox
Left = 0
Top = 0
Width = 245
Height = 138
HorzScrollBar.Tracking = True
VertScrollBar.Tracking = True
Align = alClient
TabOrder = 1
OnMouseWheel = ScrollBoxImageMouseWheel
object imagePreview: TImage
Left = 0
Top = 0
Width = 100
Height = 100
AutoSize = True
end
end
end
@@ -0,0 +1,116 @@
unit theme_preview;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.StdCtrls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, apphelpers,
Vcl.ComCtrls, Vcl.GraphUtil, Vcl.Imaging.pngimage;

type
TfrmThemePreview = class(TForm)
StatusBarMain: TStatusBar;
ScrollBoxImage: TScrollBox;
imagePreview: TImage;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure ScrollBoxImageMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
private
{ Private declarations }
FToggleCheckbox: TCheckBox;
FLastStatusUpdate: Cardinal;
FTempFile: String;
procedure DownloadProgress(Sender: TObject);
public
{ Public declarations }
procedure LoadTheme(ThemeName: String);
end;


implementation

{$R *.dfm}



procedure TfrmThemePreview.FormCreate(Sender: TObject);
begin
FToggleCheckbox := TCheckBox(Owner);
end;


procedure TfrmThemePreview.FormShow(Sender: TObject);
begin
Width := AppSettings.ReadInt(asThemePreviewWidth);
Height := AppSettings.ReadInt(asThemePreviewHeight);
Top := AppSettings.ReadInt(asThemePreviewTop);
Left := AppSettings.ReadInt(asThemePreviewLeft);
ToggleCheckBoxWithoutClick(FToggleCheckbox, True);
end;

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

AppSettings.WriteInt(asThemePreviewWidth, Width);
AppSettings.WriteInt(asThemePreviewHeight, Height);
AppSettings.WriteInt(asThemePreviewTop, Top);
AppSettings.WriteInt(asThemePreviewLeft, Left);
ToggleCheckBoxWithoutClick(FToggleCheckbox, False);
Action := caFree;
end;


procedure TfrmThemePreview.LoadTheme(ThemeName: String);
var
Download: THttpDownload;
ThemeImage: String;
begin
Download := THttpDownload.Create(Self);
ThemeImage := ThemeName;
ThemeImage := ThemeName.Replace(' ', '-').ToLower;
Download.URL := Format('%simages/themes/%s.png', [APPDOMAIN, ThemeImage]);
StatusBarMain.SimpleText := 'Loading preview: ' + Download.URL;
FTempFile := Format('%s%s-themepreview-%s.png', [GetTempDir, APPNAME, ThemeImage]);
Download.OnProgress := DownloadProgress;
try
Download.SendRequest(FTempFile);
imagePreview.Picture.LoadFromFile(FTempFile);
StatusBarMain.SimpleText := Format('Theme name: %s', [ThemeName]);
except
on E:Exception do begin
StatusBarMain.SimpleText := E.Message;
end;
end;
end;


procedure TfrmThemePreview.ScrollBoxImageMouseWheel(Sender: TObject;
Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint;
var Handled: Boolean);
begin
// Scrolling via mouse wheel
// Do not use .ScrollBy(), which makes the scroll bar longer
if KeyPressed(VK_SHIFT) then begin
ScrollBoxImage.HorzScrollBar.Position := ScrollBoxImage.HorzScrollBar.Position - WheelDelta;
end else begin
ScrollBoxImage.VertScrollBar.Position := ScrollBoxImage.VertScrollBar.Position - WheelDelta;
end;
Handled := True;
end;

procedure TfrmThemePreview.DownloadProgress(Sender: TObject);
var
Download: THttpDownload;
begin
if FLastStatusUpdate > GetTickCount-200 then
Exit;
Download := Sender as THttpDownload;
StatusBarMain.SimpleText := f_('Downloading: %s / %s', [FormatByteNumber(Download.BytesRead), FormatByteNumber(Download.ContentLength)]) + ' ...';
FLastStatusUpdate := GetTickCount;
end;



end.

0 comments on commit e4423c7

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