tetheme.pas

这个东西的功能很强大

    kmgMin,
    kmgMax,
    kmgRoll,
    kmgMinRestore,
    kmgMaxRestore,
    kmgRollRestore,
    kmgTray,

    kmgMDIMin,
    kmgMDIRestore,
    kmgMDIClose
  );

  TteMenuItemStyle = (kmisDefault, kmisChecked, kmisUseful);
  TteMenuItemStyles = set of TteMenuItemStyle;

  TteMenuInfo = record
    Rect: TRect;
  end;

  TteMenuItemInfo = record
    Rect: TRect;
    Item: TteMenuItemClass;
    Style: TteMenuItemStyles;
    DrawState: TteMenuItemDrawState;
  end;

  TteMenuGlyphInfo = record
    Rect: TRect;
    Glyph: TteBitmap;
    Align: TteGlyphAlign;
    Kind: TteMenuGlyph;
  end;

function MenuInfo(ARect: TRect): TteMenuInfo; overload;
function MenuItemInfo(ARect: TRect; AItem: TteMenuItemClass;
  AStyle: TteMenuItemStyles; ADrawState: TteMenuItemDrawState): TteMenuItemInfo; overload;

function MenuGlyphInfo(ARect: TRect; AGlyph: TteBitmap;
  AAlign: TteGlyphAlign; AKind: TteMenuGlyph): TteMenuGlyphInfo; overload;
function MenuGlyphInfo(ARect: TRect; AKind: TteMenuGlyph): TteMenuGlyphInfo; overload;
function MenuGlyphInfo(ARect: TRect; Graphic: TGraphic; AAlign:
  TteGlyphAlign = kgfaCenter): TteMenuGlyphInfo; overload;
function MenuGlyphInfo(ARect: TRect; Images: TCustomImageList; ImageIndex: integer;
  AAlign: TteGlyphAlign = kgfaCenter; AEnabled: boolean = true): TteMenuGlyphInfo; overload;

type

  { Color mertic }

  TteThemeColor = (
    ktcCaptionNormal,
    ktcCaptionInactive,
    ktcWindowBorder,
    ktcWindow,
    ktcBorder,
    ktcButtonNormal,
    ktcButtonHot,
    ktcButtonPressed,
    ktcButtonFocused,
    ktcButtonDisabled
  );

const

  ThemeColorNames: array [TteThemeColor] of string = (
    'CaptionNormal',
    'CaptionInactive',
    'WindowBorder',
    'Window',
    'Border',
    'ButtonNormal',
    'ButtonHot',
    'ButtonPressed',
    'ButtonFocused',
    'ButtonDisabled'
  );

type

  TteThemeColors = class(TPersistent)
  private
    FColorList: array [TteThemeColor] of TColor;
    FTheme: TPersistent;
    function GetColor(index: TteThemeColor): TColor;
    procedure SetColor(index: TteThemeColor; const Value: TColor);
  public
    constructor Create(ATheme: TPersistent); virtual;
    procedure Assign(Source: TPersistent); override;
    procedure ChangeColorsHue(ADelta: integer);
    procedure ChangeColorsBrightness(ADelta: integer);
    { I/O }
    procedure LoadFromStream(Stream: TStream); virtual;
    procedure SaveToStream(Stream: TStream); virtual;
    property Colors[index: TteThemeColor]: TColor read GetColor write SetColor; default;
  end;

type

  TteThemeFont = (
    ktfCaptionTextNormal,
    ktfCaptionTextInactive,
    ktfSmCaptionTextNormal,
    ktfSmCaptionTextInactive,
    ktfStaticTextNormal,
    ktfStaticTextHot,
    ktfStaticTextFocused,
    ktfStaticTextDisabled,
    ktfPanelTextNormal,
    ktfPanelTextDisabled,
    ktfButtonTextNormal,
    ktfButtonTextPressed,
    ktfButtonTextHot,
    ktfButtonTextFocused,
    ktfButtonTextDisabled,
    ktfCheckBoxTextNormal,
    ktfCheckBoxTextPressed,
    ktfCheckBoxTextHot,
    ktfCheckBoxTextFocused,
    ktfCheckBoxTextDisabled,
    ktfRadioButtonTextNormal,
    ktfRadioButtonTextPressed,
    ktfRadioButtonTextHot,
    ktfRadioButtonTextFocused,
    ktfRadioButtonTextDisabled,
    ktfGroupBoxTextNormal,
    ktfGroupBoxTextDisabled,
    ktfWindowTextNormal,
    ktfWindowTextDisabled,
    ktfEditBoxTextNormal,
    ktfEditBoxTextFocused,
    ktfEditBoxTextHot,
    ktfEditBoxTextDisabled,
    ktfEditBoxTextSelected,
    ktfMenuItemTextNormal,
    ktfMenuItemTextSelected,
    ktfMenuItemTextHot,
    ktfMenuItemTextDisabled,
    ktfToolItemTextNormal,
    ktfToolItemTextSelected,
    ktfToolItemTextHot,
    ktfToolItemTextDisabled,
    ktfHeaderSectionTextNormal,
    ktfHeaderSectionTextPressed,
    ktfHeaderSectionTextDraggedOut,
    ktfHeaderSectionTextDragging,
    ktfHeaderSectionTextHot,
    ktfHeaderSectionTextUnderDrag,
    ktfHeaderSectionTextDisabled,
    ktfStatusPanelTextNormal,
    ktfStatusPanelTextDisabled,
    ktfTabTextInactiveNormal,
    ktfTabTextInactiveHot,
    ktfTabTextInactiveDisabled,
    ktfTabTextActiveNormal,
    ktfTabTextActiveHot,
    ktfTabTextActiveDisabled,
    ktfListItemTextNormal,
    ktfListItemTextHot,
    ktfListItemTextSelected,
    ktfListItemTextFocused,
    ktfListItemTextDisabled,
    ktfPopupMenuItemTextNormal,
    ktfPopupMenuItemTextSelected,
    ktfPopupMenuItemTextHot,
    ktfPopupMenuItemTextDisabled
  );

const

  ThemeFontNames: array [TteThemeFont] of string = (
    'CaptionTextNormal',
    'CaptionTextInactive',
    'SmCaptionTextNormal',
    'SmCaptionTextInactive',
    'StaticTextNormal',
    'StaticTextHot',
    'StaticTextFocused',
    'StaticTextDisabled',
    'PanelTextNormal',
    'PanelTextDisabled',
    'ButtonTextNormal',
    'ButtonTextPressed',
    'ButtonTextHot',
    'ButtonTextFocused',
    'ButtonTextDisabled',
    'CheckBoxTextNormal',
    'CheckBoxTextPressed',
    'CheckBoxTextHot',
    'CheckBoxTextFocused',
    'CheckBoxTextDisabled',
    'RadioButtonTextNormal',
    'RadioButtonTextPressed',
    'RadioButtonTextHot',
    'RadioButtonTextFocused',
    'RadioButtonTextDisabled',
    'GroupBoxTextNormal',
    'GroupBoxTextDisabled',
    'WindowTextNormal',
    'WindowTextDisabled',
    'EditBoxTextNormal',
    'EditBoxTextFocused',
    'EditBoxTextHot',
    'EditBoxTextDisabled',
    'EditBoxTextSelected',
    'MenuItemTextNormal',
    'MenuItemTextSelected',
    'MenuItemTextHot',
    'MenuItemTextDisabled',
    'ToolItemTextNormal',
    'ToolItemTextSelected',
    'ToolItemTextHot',
    'ToolItemTextDisabled',
    'HeaderSectionTextNormal',
    'HeaderSectionTextPressed',
    'HeaderSectionTextDraggedOut',
    'HeaderSectionTextDragging',
    'HeaderSectionTextHot',
    'HeaderSectionTextUnderDrag',
    'HeaderSectionTextDisabled',
    'StatusPanelTextNormal',
    'StatusPanelTextDisabled',
    'TabTextInactiveNormal',
    'TabTextInactiveHot',
    'TabTextInactiveDisabled',
    'TabTextActiveNormal',
    'TabTextActiveHot',
    'TabTextActiveDisabled',
    'ListItemTextNormal',
    'ListItemTextHot',
    'ListItemTextSelected',
    'ListItemTextFocused',
    'ListItemTextDisabled',
    'PopupMenuItemTextNormal',
    'PopupMenuItemTextSelected',
    'PopupMenuItemTextHot',
    'PopupMenuItemTextDisabled'
  );

type

  TteThemeFonts = class(TPersistent)
  private
    FFontList: array [TteThemeFont] of TFont;
    FTheme: TPersistent;
    FThemeFont: TFont;
    function GetFont(index: TteThemeFont): TFont;
    procedure SetFont(index: TteThemeFont; const Value: TFont);
  public
    constructor Create(ATheme: TPersistent); virtual;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure ChangeFontsHue(ADelta: integer);
    procedure ChangeFontsBrightness(ADelta: integer);
    { I/O }
    procedure LoadFromStream(Stream: TStream); virtual;
    procedure SaveToStream(Stream: TStream); virtual;
    { Font access }
    function GetFontForObject(Font: TteThemeFont; 
      const AObject: TteThemeObject = ktoDefault): TFont;
    property Fonts[index: TteThemeFont]: TFont read GetFont write SetFont; default;
  end;

procedure SetFont(AFont: TFont; AFontName: string; AFontSize: integer;
  AFontStyle: TFontStyles; AFontColor: TColor); overload;

function StringToFontName(S: string): string;
function StringToFontSize(S: string): integer;
function StringToFontColor(S: string): TColor;
function StringToFontCharset(S: string): TFontCharset;
function StringToFontStyle(S: string): TFontStyles;


type

  { Theme Options }

  TteThemeOptions = record
    Building: boolean; 
    CanStore: boolean;
    DialogFilter: string;
    DefaultExt: string;
  end;

  { TteTheme class - abstract skin declaration}

  TteTheme = class(TPersistent)
  private
    FColors: TteThemeColors;
    FFonts: TteThemeFonts;
    FHue, FBrightness: integer;
    FThemeName: string;
  protected
    procedure ResetThemeColors; virtual;
    procedure ResetThemeFonts; virtual;
    procedure SetFontForObject(AFont: TFont; const Font: TteThemeFont;
      const AObject: TteThemeObject = ktoDefault); virtual;
    property Hue: integer read FHue;
    property Brightness: integer read FBrightness;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    { }
    function CreateCopy: TteTheme;
    procedure Assign(Source: TPersistent); override;
    { Theme class name and options }
    class function GetThemeName: string; virtual;
    class function GetThemeOptions: TteThemeOptions; virtual;
    { I/O }
    class function CheckStream(Stream: TStream): boolean; virtual;
    function LoadFromStream(Stream: TStream): boolean; virtual;
    function SaveToStream(Stream: TStream): boolean; virtual;
    function LoadFromFile(FileName: string): boolean; virtual;
    function SaveToFile(FileName: string): boolean; virtual;
    { Reset theme }
    procedure ResetTheme; virtual;
    { Theme transformation }
    procedure ChangeThemeHue(AHueValue: integer);
    procedure ChangeThemeBrightness(ABrightnessValue: integer);
    { Drawing }
    procedure DrawThemeText(Canvas: TCanvas; Text: TteTextInfo); virtual;
    { Window class }
    function IsWindowDefined(const ASubclass: TteWindowSubclass;
      const AObject: TteThemeObject = ktoDefault): boolean; virtual;
    function WindowGetRegion(const ASubclass: TteWindowSubclass; AWindow: TteWindowInfo;
      const AObject: TteThemeObject = ktoDefault): TteRegion; virtual;
    function WindowGetHitTest(const ASubclass: TteWindowSubclass; AWindow: TteWindowInfo;
      X, Y: integer; const AObject: TteThemeObject = ktoDefault): TteWindowHitTest; virtual;
    function WindowGetClientRect(const ASubclass: TteWindowSubclass;
      AWindow: TteWindowInfo;
      const AObject: TteThemeObject = ktoDefault): TRect; virtual;
    procedure WindowDraw(const ASubclass: TteWindowSubclass; Canvas: TCanvas;
      AWindow: TteWindowInfo; const AObject: TteThemeObject = ktoDefault); virtual;
    procedure WindowDrawClient(const ASubclass: TteWindowSubclass; Canvas: TCanvas;
      AWindow: TteWindowInfo; ARect: TRect; const AObject: TteThemeObject = ktoDefault); virtual;
    function WindowGetTitleRect(const ASubclass: TteWindowSubclass;
      AWindow: TteWindowInfo;
      const AObject: TteThemeObject = ktoDefault): TRect; virtual;
    procedure WindowDrawTitle(const ASubclass: TteWindowSubclass; Canvas: TCanvas;
      AWindow: TteWindowInfo; ATitleRect: TRect;
      const AObject: TteThemeObject = ktoDefault); virtual;
    function WindowGetButtonRect(const ASubclass: TteWindowSubclass;
      AWindow: TteWindowInfo; AButton: TteWindowButtonClass;
      const AObject: TteThemeObject = ktoDefault): TRect; virtual;
    procedure WindowDrawButton(const ASubclass: TteWindowSubclass; Canvas: TCanvas;
      AWindow: TteWindowInfo; AButton: TteWindowButtonInfo;
      const AObject: TteThemeObject = ktoDefault); virtual;
    procedure WindowDrawGripper(const ASubclass: TteWindowSubclass; Canvas: TCanvas;
      AWindow: TteWindowInfo; AGripper: TteWindowGripperInfo;
      const AObject: TteThemeObject = ktoDefault); virtual;
    { Button class }
    function IsButtonDefined(const ASubclass: TteButtonSubclass;
      const AObject: TteThemeObject = ktoDefault): boolean; virtual;
    function IsButtonTransparent(const ASubclass: TteButtonSubclass;
      const AObject: TteThemeObject = ktoDefault): boolean; virtual;
    procedure ButtonDraw(const ASubclass: TteButtonSubclass; Canvas: TCanvas;
      AButton: TteButtonInfo; const AObject: TteThemeObject = ktoDefault); virtual;
    procedure ButtonDrawText(const ASubclass: TteButtonSubclass; Canvas: TCanvas;
      AButton: TteButtonInfo; AText: TteTextInfo;
      const AObject: TteThemeObject = ktoDefault); virtual;
    procedure ButtonDrawGlyph(const ASubclass: TteButtonSubclass; Canvas: TCanvas;
      AButton: TteButtonInfo; AGlyph: TteGlyphInfo;
      const AObject: TteThemeObject = ktoDefault); virtual;
    { Scroll class }
    function IsScrollDefined(const ASubclass: TteScrollSubclass;
      const AObject: TteThemeObject = ktoDefault): boolean; virtual;
    function IsScrollTransparent(const ASubclass: TteScrollSubclass;
      const AObject: TteThemeObject = ktoDefault): boolean; virtual;
    procedure ScrollDraw(const ASubclass: TteScrollSubclass; Canvas: TCanvas;
      AScroll: TteScrollInfo; const AObject: TteThemeObject = ktoDefault); virtual;
    procedure ScrollDrawButton(const ASubclass: TteScrollSubclass; Canvas: TCanvas;
      AScroll: TteScrollInfo; AButton: TteScrollButtonInfo;
      const AObject: TteThemeObject = ktoDefault); virtual;
    procedure ScrollDrawArea(const ASubclass: TteScrollSubclass; Canvas: TCanvas;
      AScroll: TteScrollInfo; AArea: TteScrollAreaInfo;
      const AObject: TteThemeObject = ktoDefault); virtual;

    { Menu class }
    function IsMenuDefined(const ASubclass: TteMenuSubclass;
      const AObject: TteThemeObject = ktoDefault): boolean; virtual;
    function IsMenuTransparent(const ASubclass: TteMenuSubclass;
      const AObject: TteThemeObject = ktoDefault): boolean; virtual;
    function MenuGetClientRect(const ASubclass: TteMenuSubclass;
      AMenu: TteMenuInfo; const AObject: TteThemeObject = ktoDefault): TRect; virtual;
    procedure MenuDraw(const ASubclass: TteMenuSubclass; Canvas: TCanvas;
      AMenu: TteMenuInfo; const AObject: TteThemeObject = ktoDefault); virtual;
    procedure MenuDrawItem(const ASubclass: TteMenuSubclass; Canvas: TCanvas;
      AItem: TteMenuItemInfo; const AObject: TteThemeObject = ktoDefault); virtual;
    procedure MenuDrawItemText(const ASubclass: TteMenuSubclass; Canvas: TCanvas;
      AItem: TteMenuItemInfo; AText: TteTextInfo;
      const AObject: TteThemeObject = ktoDefault); virtual;
    procedure MenuDrawItemGlyph(const ASubclass: TteMenuSubclass; Canvas: TCanvas;
      AItem: TteMenuItemInfo; AGlyph: TteMenuGlyphInfo;
      const AObject: TteThemeObject = ktoDefault); virtual;
    { Properties }
    property Colors: TteThemeColors read FColors;
    property Fonts: TteThemeFonts read FFonts;
    property ThemeName: string read FThemeName write FThemeName;
  published
  end;

  TteThemeClass = class of TteTheme;

{ Use this routines to check theme's classes, subclasses, objects
  in CurrentTheme object }

function IsObjectDefined(const ASubclass: TteWindowSubclass;
  const AObject: TteThemeObject = ktoDefault): boolean; overload;
function IsObjectDefined(const ASubclass: TteButtonSubclass;
  const AObject: TteThemeObject = ktoDefault): boolean; overload;
function IsObjectDefined(const ASubclass: TteScrollSubclass;
  const AObject: TteThemeObject = ktoDefault): boolean; overload;
function IsObjectDefined(const ASubclass: TteMenuSubclass;
  const AObject: TteThemeObject = ktoDefault): boolean; overload;
function IsObjectDefined(const ASubclass: TteBarSubclass;
  const AObject: TteThemeObject = ktoDefault): boolean; overload;

  
const

  SNM_THEMEMESSAGE            = WM_USER + 1024;

  { Message wParam flags }

  SMP_CHANGETHEME                  = 0;
  SMP_BEFORECHANGE                 = 1;
  SMP_AFTERCHANGE                  = 2;
  SMP_APPLYTHEME                   = 3;
  SMP_REMOVETHEME                  = 4;
  SMP_REPAINT                      = 5;

type

  TteThemeManager = class(TComponent)
  private
    FThemeList: TList;
    FNotifies: TList;
    FHookWindow: HWND;
    function GetTheme(AIndex: integer): TteThemeClass;
    function GetThemeCount: integer;
  protected
    procedure HookWndProc(var Message: TMessage);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    { Theme resitration }
    function GetThemeClass(ClassName: string): TteThemeClass;
    procedure RegisterTheme(Theme: TteThemeClass);
    { Notification }
    procedure AddNotification(AObject: TObject);
    procedure RemoveNotification(AObject: TObject);
    procedure Broadcast(Msg: Cardinal; WParam, LParam: integer);
    { Theme I/O }
    function LoadFromFile(AFileName: string): TteTheme;
    function LoadFromStream(AStream: TStream): TteTheme;
    procedure SaveToFile(ATheme: TteTheme; AFileName: string);
    procedure SaveToStream(ATheme: TteTheme; AStream: TStream);
    function GetThemeByFileName(FileName: string): TteThemeClass; overload;
    function GetDialogFilter: string;
    { Theme managment }
    function IsThemeAvailable(const ATheme: TteTheme): boolean; overload;
    function IsThemeAvailable(const AThemeName: string): boolean; overload;
    function IsThemeAvailable(const AThemeClass: TteThemeClass): boolean; overload;
    procedure ChangeTheme(const ATheme: TteTheme); overload;
    procedure ChangeTheme(const AThemeName: string); overload;
    procedure ChangeTheme(const AThemeClass: TteThemeClass); overload;
    procedure ReleaseTheme;
    { Theme access }
    property ThemeCount: integer read GetThemeCount;
    property Themes[AIndex: integer]: TteThemeClass read GetTheme;
  end;

var
  CurrentTheme: TteTheme = nil;
  ThemeManager: TteThemeManager = nil;

{ Theme managment }

procedure ChangeTheme(const ATheme: TteTheme); overload;
procedure ChangeTheme(const AThemeName: string); overload;
procedure ChangeTheme(const AThemeClass: TteThemeClass); overload;

procedure ReleaseTheme;

procedure RepaintThemedControls;

procedure ChangeThemeHue(ADelta: integer);
procedure ChangeThemeBrightness(ADelta: integer);

procedure AddThemeNotification(AObject: TObject);