📄 uthemes.pas
字号:
(*
# (C) Copyright 2003
# Miha Vrhovnik, miha.vrhovnik@guest.arnes.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)2000-2003.
# All Rights Reserved.
#==============================================================================
# Contributor(s):
#==============================================================================
# History: see whats new.txt from distribution package
#==============================================================================
*)
unit uThemes;
interface
uses Classes, SysUtils, Windows, Graphics, Contnrs, OmniXML, OmniMyXMLPersistent;
//all this classes form the xml Tree structure
//information about theme. This information is shown in theme selection window
type TInfo = class(TPersistent)
private
FProgramVersion: WideString;
FScreenShoot: WideString;
FAuthorHomePage: WideString;
FAuthor: WideString;
FComment: WideString;
FAuthorEmail: WideString;
FName: WideString;
public
procedure Assign(Source: TPersistent); override;
published
property Author: WideString read FAuthor write FAuthor;
property AuthorEmail: WideString read FAuthorEmail write FAuthorEmail;
property AuthorHomePage: WideString read FAuthorHomePage write FAuthorHomePage;
property ProgramVersion: WideString read FProgramVersion write FProgramVersion;
property Name: WideString read FName write FName;
property Comment: WideString read FComment write FComment;
property ScreenShoot: WideString read FScreenShoot write FScreenShoot;
end;
type TToolbarImages = class(TPersistent)
private
FDisabled: WideString;
FNormal: WideString;
FMouseOver: WideString;
public
procedure Assign(Source: TPersistent); override;
published
property Normal: WideString read FNormal write FNormal;
property MouseOver: WideString read FMouseOver write FMouseOver;
property Disabled: WideString read FDisabled write FDisabled;
end;
type TToolbar = class(TPersistent)
private
FNormal: TToolbarImages;
FSmall: TToolbarImages;
FLarge: TToolbarImages;
public
constructor Create;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
published
property Large: TToolbarImages read FLarge write FLarge;
property Normal: TToolbarImages read FNormal write FNormal;
property Small: TToolbarImages read FSmall write FSmall;
end;
type TAddressBook = class(TPersistent)
private
FBackground: WideString;
FIcons: WideString;
FToolbar: TToolbar;
FQuickBar: WideString;
public
constructor Create;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
published
property Background: WideString read FBackground write FBackground;
property Icons: WideString read FIcons write FIcons;
property Toolbar: TToolbar read FToolbar write FToolbar;
property QuickBar: WideString read FQuickBar write FQuickBar;
end;
type TCompose = class(TPersistent)
private
FToolbar: TToolbar;
public
constructor Create;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
published
property Toolbar: TToolbar read FToolbar write FToolbar;
end;
type TMailboxFolders = class(TPersistent)
private
FBackground: WideString;
FIcons: WideString;
public
procedure Assign(Source: TPersistent); override;
published
property Background: WideString read FBackground write FBackground;
property Icons: WideString read FIcons write FIcons;
end;
type TMailList = class(TPersistent)
private
FBackground: WideString;
FIcons: WideString;
FColumnIcons: WideString;
public
procedure Assign(Source: TPersistent); override;
published
property Background: WideString read FBackground write FBackground;
property ColumnIcons: WideString read FColumnIcons write FColumnIcons;
property Icons: WideString read FIcons write FIcons;
end;
type TMain = class(TPersistent)
private
FToolbar: TToolbar;
public
constructor Create;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
published
property Toolbar: TToolbar read FToolbar write FToolbar;
end;
type TServerMailboxView = class(TPersistent)
private
FBackground: WideString;
FIcons: WideString;
public
procedure Assign(Source: TPersistent); override;
published
property Background: WideString read FBackground write FBackground;
property Icons: WideString read FIcons write FIcons;
end;
type TMyColor = class(TPersistent)
private
FEndColor: String;
FStartColor: String;
public
procedure Assign(Source: TPersistent); override;
function GetStartColor: TColor;
function GetEndColor: TColor;
published
property StartColor: String read FStartColor write FStartColor;
property EndColor: String read FEndColor write FEndColor;
end;
type TMyFont = class(TPersistent)
private
FSize: Integer;
FColor: String;
FName: String;
FStyle: TFontStyles;
public
procedure Assign(Source: TPersistent); override;
procedure GetFont(var Font: TFont);
published
property Color: String read FColor write FColor;
property Name: String read FName write FName;
property Size: Integer read FSize write FSize;
property Style: TFontStyles read FStyle write FStyle;
end;
type TProgress = class(TPersistent)
private
FFont: TMyFont;
FColor: TMyColor;
public
constructor Create;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
published
property Color: TMyColor read FColor write FColor;
property Font: TMyFont read FFont write FFont;
end;
type TTasks = class(TPersistent)
private
FBackground: WideString;
FIcons: WideString;
FProgress: TProgress;
public
constructor Create;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
published
property Background: WideString read FBackground write FBackground;
property Icons: WideString read FIcons write FIcons;
property Progress: TProgress read FProgress write FProgress;
end;
type TToolbarStyle = (C, B, T);
type TRootToolbar = class(TPersistent)
private
FLargeSize: Integer;
FNormalSize: Integer;
FSmallSize: Integer;
FColor: String;
FBackground: TToolbar;
FUseColor: TToolbarStyle;
public
constructor Create;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
function GetColor: TColor;
published
property UseColor: TToolbarStyle read FUseColor write FUseColor;
property Background: TToolbar read FBackground write FBackground;
property Color: String read FColor write FColor;
property SmallSize: Integer read FSmallSize write FSmallSize;
property NormalSize: Integer read FNormalSize write FNormalSize;
property LargeSize: Integer read FLargeSize write FLargeSize;
end;
type TLists = class(TPersistent)
private
FFont: TMyFont;
public
constructor Create;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
published
property Font: TMyFont read FFont write FFont;
end;
type TTheme = class(TPersistent)
private
FAddressBook: TAddressBook;
FCompose: TCompose;
FInfo: TInfo;
FMailboxFolders: TMailboxFolders;
FMailList: TMailList;
FMain: TMain;
FSettings: TProgress;
FServerMailboxView: TServerMailboxView;
FTasks: TTasks;
FToolbar: TRootToolbar;
FThemePath: String;
FLists: TLists;
public
constructor Create;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
procedure Load(FileName: String); overload;
procedure Load(config: TStream); overload;
published
property ThemePath: String read FThemePath write FThemePath;
property Info: TInfo read FInfo write FInfo;
property AddressBook: TAddressBook read FAddressBook write FAddressBook;
property Compose: TCompose read FCompose write FCompose;
property MailboxFolders: TMailboxFolders read FMailboxFolders write FMailboxFolders;
property MailList: TMailList read FMailList write FMailList;
property Main: TMain read FMain write FMain;
property ServerMailboxView: TServerMailboxView read FServerMailboxView write FServerMailboxView;
property Settings: TProgress read FSettings write FSettings;
property Tasks: TTasks read FTasks write FTasks;
property Toolbar: TRootToolbar read FToolbar write FToolbar;
property Lists: TLists read FLists write FLists;
end;
type TThemeList = class(TObjectList)
private
function GetItem(Index: Integer): TTheme;
procedure SetItem(Index: Integer; const Value: TTheme);
public
function Add(ThemePath: String; var Index: Integer): TTheme;
function Extract(Item: TTheme): TTheme;
function First: TTheme;
function IndexOf(ATheme: TTheme): Integer;
procedure Insert(Index: Integer; ATheme: TTheme);
function Last: TTheme;
function Remove(ATheme: TTheme): Integer;
property Items[Index: Integer]: TTheme read GetItem write SetItem; default;
end;
function HTML2Color(Color: String): TColor;
implementation
uses StrUtils;
{ TInfo }
procedure TInfo.Assign(Source: TPersistent);
var b: TInfo;
begin
inherited Assign(Source);
b := Source as TInfo;
Self.Author := b.Author;
Self.AuthorEmail := b.AuthorEmail;
Self.AuthorHomePage := b.AuthorHomePage;
Self.ProgramVersion := b.ProgramVersion;
Self.Comment := b.Comment;
Self.Name := b.Name;
Self.ScreenShoot := b.ScreenShoot;
end;
{ TAddressBook }
procedure TAddressBook.Assign(Source: TPersistent);
var b: TAddressBook;
begin
inherited Assign(Source);
b := Source as TAddressBook;
Self.Background := b.Background;
Self.Icons := b.Icons;
Self.Toolbar.Assign(b.Toolbar);
Self.QuickBar := b.QuickBar;
end;
constructor TAddressBook.Create;
begin
inherited Create;
FToolbar := TToolbar.Create;
end;
destructor TAddressBook.Destroy;
begin
FreeAndNil(FToolbar);
inherited Destroy;
end;
{ TToolbarImages }
procedure TToolbarImages.Assign(Source: TPersistent);
var b: TToolbarImages;
begin
inherited Assign(Source);
b := Source as TToolbarImages;
Self.Normal := b.Normal;
Self.MouseOver := b.MouseOver;
Self.Disabled := b.Disabled;
end;
{ TToolbar }
procedure TToolbar.Assign(Source: TPersistent);
var b: TToolbar;
begin
inherited Assign(Source);
b := Source as TToolbar;
Self.Large.Assign(b.Large);
Self.Normal.Assign(b.Normal);
Self.Small.Assign(b.Small);
end;
constructor TToolbar.Create;
begin
inherited Create;
FLarge := TToolbarImages.Create;
FNormal := TToolbarImages.Create;
FSmall := TToolbarImages.Create;
end;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -