⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 uthemes.pas

📁 siMail, siMail, siMail, siMail
💻 PAS
📖 第 1 页 / 共 2 页
字号:
(*
# (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 + -