📄 fthemes.pas
字号:
(*
# (C) Copyright 2003
# Miha Vrhovnik, miha.vrhovnik@cordia.si
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation; either version 2 of
# the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
#
# The Initial Developer of the Original Code is Miha Vrhovnik (Slovenia).
# Portions created by Miha Vrhovnik are Copyright (c)2003.
# All Rights Reserved.
#==============================================================================
# Contributor(s):
#==============================================================================
# History: see whats new.txt from distribution package
#==============================================================================
*)
unit fThemes;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, uThemes, ShellApi, Math;
type
TfrmThemeConfig = class(TForm)
cmdOK: TButton;
cmdCancel: TButton;
GroupBox1: TGroupBox;
cmboxMenuThemes: TComboBox;
GroupBox2: TGroupBox;
cmboxThemeList: TComboBox;
Label2: TLabel;
Label1: TLabel;
Label3: TLabel;
Label4: TLabel;
lblAuthor: TLabel;
lblHome: TLabel;
lblProgramVersion: TLabel;
lblComment: TLabel;
img: TImage;
cmdPreview: TButton;
cmboxSize: TComboBox;
procedure FormShortCut(var Msg: TWMKey; var Handled: Boolean);
procedure FormHide(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure cmboxMenuThemesClick(Sender: TObject);
procedure cmdCancelClick(Sender: TObject);
procedure cmdOKClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure cmboxThemeListChange(Sender: TObject);
procedure lblAuthorClick(Sender: TObject);
procedure cmdPreviewClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmThemeConfig: TfrmThemeConfig;
implementation
uses
mailBox, fMain, gnugettext, defFldrs, fSplash, dImages;
{$R *.dfm}
procedure TfrmThemeConfig.FormShortCut(var Msg: TWMKey; var Handled: Boolean);
begin
if msg.CharCode = 27 then begin //esc key
Self.Close;
Handled := True;
end;
end;
procedure TfrmThemeConfig.FormHide(Sender: TObject);
begin
//write self position & size
frmMailbox.Profile.Config.WriteControlSettings(Self);
end;
procedure TfrmThemeConfig.FormShow(Sender: TObject);
var i: Integer;
begin
//translate me
TranslateComponent(Self);
//read self position & size
frmMailbox.Profile.Config.ReadControlSettings(Self);
cmboxMenuThemes.Clear;
lblHome.Caption := '';
lblProgramVersion.Caption := '';
lblComment.Caption := '';
img.Picture.LoadFromFile('');
for i := 0 to frmMain.tbxThemes.ThemeCount - 1 do
cmboxMenuThemes.Items.Add(frmMain.tbxThemes.Themes[i]);
cmboxMenuThemes.ItemIndex := cmboxMenuThemes.Items.IndexOf(frmMain.tbxThemes.Theme);
cmboxThemeList.ItemIndex := Max(cmboxThemeList.Items.IndexOf(frmMailbox.Profile.Config.ReadString('settings', 'themeIcon', '')), 0);
cmboxSize.ItemIndex := frmMailbox.Profile.Config.ReadInteger('settings', 'themeSize', 1);
cmboxThemeListChange(cmboxThemeList);
end;
procedure TfrmThemeConfig.cmboxMenuThemesClick(Sender: TObject);
begin
frmMain.tbxThemes.Theme := cmboxMenuThemes.Text;
end;
procedure TfrmThemeConfig.cmdCancelClick(Sender: TObject);
begin
Self.Close;
end;
procedure TfrmThemeConfig.cmdOKClick(Sender: TObject);
begin
frmMailbox.Profile.Config.WriteString('settings', 'themeMenu', cmboxMenuThemes.Text);
frmMailbox.Profile.Config.WriteString('settings', 'themeIcon', cmboxThemeList.Items.Strings[cmboxThemeList.ItemIndex]);
frmMailbox.Profile.Config.WriteInteger('settings', 'themeSize', cmboxSize.ItemIndex);
frmMailbox.SelectedTheme := Integer(cmboxThemeList.Items.Objects[cmboxThemeList.ItemIndex]);
frmMailbox.LoadTheme(frmMailbox.SelectedTheme, cmboxSize.ItemIndex);
Self.Close;
end;
procedure TfrmThemeConfig.FormCreate(Sender: TObject);
var showProgress: Boolean;
var sr: TSearchRec;
var idx: Integer;
begin
showProgress := False;
if frmSplash <> nil then begin
if frmSplash.Visible then
showProgress := True;
end;
if showProgress then
frmSplash.lblStatus.Caption := _('Loading theme info ...');
if FindFirst(df.Themes + '*.*', faDirectory, sr) = 0 then begin
if ((sr.Attr and faDirectory) = faDirectory) and
((AnsiCompareFileName(sr.Name, '.') <> 0 ) and
(AnsiCompareFileName(sr.Name, '..') <> 0 )) and
(FileExists(df.Themes + sr.Name + '\theme.xml')) then begin
lstThemes.Add(df.Themes + sr.Name + '\', idx);
cmboxThemeList.Items.AddObject(lstThemes.Items[idx].Info.Name, Pointer(idx));
end;
while FindNext(sr) = 0 do begin
if ((sr.Attr and faDirectory) = faDirectory) and
((AnsiCompareFileName(sr.Name, '.') <> 0 ) and
(AnsiCompareFileName(sr.Name, '..') <> 0 )) and
(FileExists(df.Themes + sr.Name + '\theme.xml')) then begin
lstThemes.Add(df.Themes + sr.Name + '\', idx);
cmboxThemeList.Items.AddObject(lstThemes.Items[idx].Info.Name, Pointer(idx));
end;
end;
FindClose(sr);
end;
//controls are filled at runtime because it is easier for translator
//to find out where and how to translate items.
//form: Themes
cmboxSize.Items.Text := _('Small' + #13#10 +
'Normal' + #13#10 +
'Large');
end;
procedure TfrmThemeConfig.cmboxThemeListChange(Sender: TObject);
var idx: Integer;
begin
idx := Integer(cmboxThemeList.Items.Objects[cmboxThemeList.ItemIndex]);
lblAuthor.Caption := lstThemes.Items[idx].Info.Author +
' <' + lstThemes.Items[idx].Info.AuthorEmail + '>';
lblHome.Caption := lstThemes.Items[idx].Info.AuthorHomePage;
lblProgramVersion.Caption := lstThemes.Items[idx].Info.ProgramVersion;
lblComment.Caption := lstThemes.Items[idx].Info.Comment;
img.Picture.LoadFromFile(lstThemes.Items[idx].ThemePath + lstThemes.Items[idx].Info.ScreenShoot);
end;
procedure TfrmThemeConfig.lblAuthorClick(Sender: TObject);
begin
ShellExecute(Self.Handle, 'open', PChar('mailto:' + (Sender as TLabel).Caption),
nil, nil, SW_SHOWNORMAL);
end;
procedure TfrmThemeConfig.cmdPreviewClick(Sender: TObject);
var idx: Integer;
var p: String;
begin
idx := Integer(cmboxThemeList.Items.Objects[cmboxThemeList.ItemIndex]);
p := lstThemes.Items[idx].ThemePath;
with dmImages do begin
frmMailbox.LoadToolbar(ilAddressBook, p + lstThemes.Items[idx].AddressBook.Icons);
frmMailbox.LoadToolbar(ilAddressBookQuickToolbar, p + lstThemes.Items[idx].AddressBook.QuickBar);
frmMailbox.LoadToolbar(ilMailboxMailboxes, p + lstThemes.Items[idx].MailboxFolders.Icons);
frmMailbox.LoadToolbar(ilMailListHeader, p + lstThemes.Items[idx].MailList.ColumnIcons);
frmMailbox.LoadToolbar(ilMailListMessages, p + lstThemes.Items[idx].MailList.Icons);
frmMailbox.LoadToolbar(ilTask, p + lstThemes.Items[idx].Tasks.Icons);
frmMailbox.LoadToolbar(ilPreview, p + lstThemes.Items[idx].ServerMailboxView.Icons);
ilAddressBookToolbar.Width := lstThemes.Items[idx].Toolbar.SmallSize;
ilAddressBookToolbar.Height := lstThemes.Items[idx].Toolbar.SmallSize;
frmMailbox.LoadToolbar(ilAddressBookToolbar, p + lstThemes.Items[idx].AddressBook.Toolbar.Normal.Normal);
ilComposeToolbar.Width := lstThemes.Items[idx].Toolbar.NormalSize;
ilComposeToolbar.Height := lstThemes.Items[idx].Toolbar.NormalSize;
frmMailbox.LoadToolbar(ilComposeToolbar, p + lstThemes.Items[idx].Compose.Toolbar.Normal.Normal);
ilMainToolbar.Width := lstThemes.Items[idx].Toolbar.NormalSize;
ilMainToolbar.Height := lstThemes.Items[idx].Toolbar.NormalSize;
frmMailbox.LoadToolbar(ilMainToolbar, p + lstThemes.Items[idx].Main.Toolbar.Normal.Normal);
end;
frmMailbox.LoadBackgrounds(idx);
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -