{********************************************************************} { } { Developer Express Visual Component Library } { ExpressSkins Library } { } { Copyright (c) 2006-2009 Developer Express Inc. } { ALL RIGHTS RESERVED } { } { The entire contents of this file is protected by U.S. and } { International Copyright Laws. Unauthorized reproduction, } { reverse-engineering, and distribution of all or any portion of } { the code contained in this file is strictly prohibited and may } { result in severe civil and criminal penalties and will be } { prosecuted to the maximum extent possible under the law. } { } { RESTRICTIONS } { } { THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES } { (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE } { SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS } { LICENSED TO DISTRIBUTE THE EXPRESSSKINS AND ALL ACCOMPANYING } { VCL CONTROLS AS PART OF AN EXECUTABLE PROGRAM ONLY. } { } { THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED } { FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE } { COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE } { AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT } { AND PERMISSION FROM DEVELOPER EXPRESS INC. } { } { CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON } { ADDITIONAL RESTRICTIONS. } { } {********************************************************************} unit dxSkinsDesignHelper; {$I cxVer.inc} interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, cxLookAndFeels, cxLookAndFeelPainters, cxClasses, StdCtrls, ToolIntf, ExptIntf, ToolsApi, CheckLst, ExtCtrls, Menus; type TdxSkinsUnitsState = (susDisabled, susEnabled, susUndefined); { TdxSkinsUnitStateListItem } TdxSkinsUnitStateListItem = class(TObject) private FName: string; FState: TdxSkinsUnitsState; FUnitName: string; function GetEnabled: Boolean; public constructor Create(const AUnitName, AName: string); property Enabled: Boolean read GetEnabled; property Name: string read FName; property State: TdxSkinsUnitsState read FState write FState; property UnitName: string read FUnitName; end; { TdxSkinsUnitStateList } TdxSkinsUnitStateList = class(TcxIUnknownObject, IcxLookAndFeelPainterListener) private FEnabled: Boolean; FInitialized: Boolean; FList: TcxObjectList; function GetCount: Integer; function GetCurrentProjectFileName: string; function GetHasUndefinedItems: Boolean; function GetItem(AIndex: Integer): TdxSkinsUnitStateListItem; function GetNeedShowConfirmation: Boolean; function GetSkinsConfigFileName: string; protected procedure Finalize; procedure Initialize; // IcxLookAndFeelPainterListener procedure PainterChanged(APainter: TcxCustomLookAndFeelPainterClass); public constructor Create; virtual; destructor Destroy; override; function FindItemByName(const AName: string; var AItem: TdxSkinsUnitStateListItem): Boolean; procedure LoadSettings; procedure RefreshUnitsList; procedure SaveSettings; procedure UpdateActiveProjectSettings; property Count: Integer read GetCount; property CurrentProjectFileName: string read GetCurrentProjectFileName; property Enabled: Boolean read FEnabled write FEnabled; property HasUndefinedItems: Boolean read GetHasUndefinedItems; property Initialized: Boolean read FInitialized; property Item[Index: Integer]: TdxSkinsUnitStateListItem read GetItem; property NeedShowConfirmation: Boolean read GetNeedShowConfirmation; property SkinsConfigFileName: string read GetSkinsConfigFileName; end; { TdxSkinsProjectOptionsMenuExpert } TdxSkinsProjectOptionsMenuExpert = class(TObject) private FMenuItem: TMenuItem; function GetProjectMenuItem: TMenuItem; procedure DoMenuItemClick(Sender: TObject); protected function CalcMenuItemPosition(AParent: TMenuItem): Integer; function CreateMenuItem(AParent: TMenuItem): TMenuItem; function FindMenuItemByName(AParent: TMenuItem; const AName: string): TMenuItem; public constructor Create; virtual; destructor Destroy; override; property MenuItem: TMenuItem read FMenuItem; property ProjectMenuItem: TMenuItem read GetProjectMenuItem; end; { TdxSkinsDesignHelper } TdxSkinsDesignHelper = class(TcxIUnknownObject, IOTAModuleNotifier, IOTANotifier, IOTAIDENotifier) private FActiveProject: IOTAProject; FActiveProjectNotifierID: Integer; FMenuExpert: TdxSkinsProjectOptionsMenuExpert; FServicesNotifierID: Integer; procedure SetActiveProject(AProject: IOTAProject); protected function RegisterModuleNotifier(AModule: IOTAModule): Integer; procedure RegisterIDENotifier; procedure UnregisterIDENotifier; procedure UnregisterModuleNotifier(AModule: IOTAModule; ID: Integer); procedure UpdateMenuItemState; // IOTAModuleNotifier function CheckOverwrite: Boolean; procedure ModuleRenamed(const NewName: string); // IOTANotifier procedure AfterSave; procedure BeforeSave; procedure Destroyed; procedure Modified; // IOTAIDENotifier procedure AfterCompile(Succeeded: Boolean); procedure BeforeCompile(const Project: IOTAProject; var Cancel: Boolean); procedure FileNotification(NotifyCode: TOTAFileNotification; const FileName: string; var Cancel: Boolean); public constructor Create; virtual; destructor Destroy; override; property ActiveProject: IOTAProject read FActiveProject write SetActiveProject; property MenuExpert: TdxSkinsProjectOptionsMenuExpert read FMenuExpert; end; { TdxSkinsDesignHelperForm } TdxSkinsDesignHelperForm = class(TForm) bCancel: TButton; bOk: TButton; bSelectAll: TButton; bSelectNone: TButton; bvFrame: TBevel; cbSkinsAutoFilling: TCheckBox; CheckListBoxHolder: TBevel; Image: TImage; lbNotes: TLabel; lbSkins: TLabel; pbFrame: TPaintBox; plNotes: TPanel; procedure bSelectAllClick(Sender: TObject); procedure cbSkinsAutoFillingClick(Sender: TObject); procedure pbFramePaint(Sender: TObject); private CheckListBox: TCheckListBox; procedure ApplySettings(ADropToDefault: Boolean); procedure PopulateList; public constructor Create(AOwner: TComponent); override; class procedure Execute; function IsShortCut(var Message: TWMKey): Boolean; override; end; function dxSkinsListFilter(const ASkinName: string): Boolean; function dxSkinsUnitStateList: TdxSkinsUnitStateList; procedure dxSkinsShowProjectOptionsDialog; implementation {$R *.dfm} {$R dxSkinsDesignHelper.res} uses IniFiles, dxSkinsLookAndFeelPainter, dxSkinsStrs; const //don't localize! sdxSkinsCfgExt = '.skincfg'; sdxSkinsCfgSection = 'ExpressSkins'; sdxSkinsMenuItemGlyphResName = 'DXSKINSDESIGNHELPERICON'; sdxSkinsRegProjectState = 'Enabled'; sdxSkinCheckListBoxHint = 'Select skins in this list to make them available' + #13#10 + 'within the project. Selecting skins automatically adds' + #13#10 + 'corresponding skin units to the ''uses'' clause.' + #13#10 + 'New skins added to the project are highlighted in bold.'; sdxEnableSkinSupportHint = 'Check this option to enable skins within the current project.' + #13#10 + 'If enabled, all required skin painter units will be automatically' + #13#10 + 'added to the ''uses'' clause.'; sdxSkinsMenuItemCaption = '&Modify Skin Options'; BoolToUnitState: array[Boolean] of TdxSkinsUnitsState = (susDisabled, susEnabled); type { TdxSkinsCheckListBox } TdxSkinsCheckListBox = class(TCheckListBox) private FAllowBoldSelection: Boolean; protected procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override; // property AllowBoldSelection: Boolean read FAllowBoldSelection write FAllowBoldSelection; end; var SkinsDesignHelper: TdxSkinsDesignHelper; SkinsUnitsStateList: TdxSkinsUnitStateList; function dxSkinsUnitStateList: TdxSkinsUnitStateList; begin if SkinsUnitsStateList = nil then SkinsUnitsStateList := TdxSkinsUnitStateList.Create; Result := SkinsUnitsStateList; end; function dxSkinsGetCurrentProjectFileName: string; var AProject: IOTAProject; begin if Assigned(ToolServices) then Result := ToolServices.GetProjectName else begin AProject := GetActiveProject; if AProject = nil then Result := '' else begin Result := AProject.FileName; AProject := nil; end; end; end; procedure dxSkinsShowProjectOptionsDialog; begin TdxSkinsDesignHelperForm.Execute; end; function dxSkinsListFilter(const ASkinName: string): Boolean; var AItem: TdxSkinsUnitStateListItem; begin Result := dxSkinsUnitStateList.Enabled and dxSkinsUnitStateList.FindItemByName(ASkinName, AItem) and AItem.Enabled; end; { TdxSkinsUnitStateList } constructor TdxSkinsUnitStateList.Create; begin FEnabled := True; FList := TcxObjectList.Create; GetExtendedStylePainters.AddListener(Self); RefreshUnitsList; end; destructor TdxSkinsUnitStateList.Destroy; begin Finalize; FList.Clear; GetExtendedStylePainters.RemoveListener(Self); FreeAndNil(FList); inherited Destroy; end; procedure TdxSkinsUnitStateList.Finalize; begin FInitialized := False; end; procedure TdxSkinsUnitStateList.Initialize; begin FInitialized := True; end; function TdxSkinsUnitStateList.FindItemByName(const AName: string; var AItem: TdxSkinsUnitStateListItem): Boolean; var I: Integer; begin Result := False; for I := 0 to Count - 1 do begin Result := SameText(AName, Item[I].Name); if Result then begin AItem := Item[I]; Break; end; end; end; function TdxSkinsUnitStateList.GetCount: Integer; begin Result := FList.Count; end; function TdxSkinsUnitStateList.GetHasUndefinedItems: Boolean; var I: Integer; begin Result := False; for I := 0 to Count - 1 do begin Result := Item[I].State = susUndefined; if Result then Break; end; end; function TdxSkinsUnitStateList.GetItem(AIndex: Integer): TdxSkinsUnitStateListItem; begin Result := TdxSkinsUnitStateListItem(FList.Items[AIndex]); end; function TdxSkinsUnitStateList.GetNeedShowConfirmation: Boolean; begin Result := Enabled and HasUndefinedItems; end; function TdxSkinsUnitStateList.GetSkinsConfigFileName: string; begin Result := ChangeFileExt(CurrentProjectFileName, sdxSkinsCfgExt); end; function TdxSkinsUnitStateList.GetCurrentProjectFileName: string; begin Result := dxSkinsGetCurrentProjectFileName; end; procedure TdxSkinsUnitStateList.LoadSettings; var AConfig: TIniFile; AItem: TdxSkinsUnitStateListItem; I: Integer; begin if FileExists(CurrentProjectFileName) then begin if FileExists(SkinsConfigFileName) then Initialize; AConfig := TIniFile.Create(SkinsConfigFileName); try FEnabled := AConfig.ReadBool(sdxSkinsCfgSection, sdxSkinsRegProjectState, True); for I := 0 to Count - 1 do begin AItem := Item[I]; if AConfig.ValueExists(sdxSkinsCfgSection, AItem.UnitName) then AItem.State := BoolToUnitState[ AConfig.ReadBool(sdxSkinsCfgSection, AItem.UnitName, True)] else AItem.State := susUndefined; end; finally AConfig.Free; end; end; end; procedure TdxSkinsUnitStateList.PainterChanged(APainter: TcxCustomLookAndFeelPainterClass); begin RefreshUnitsList; end; procedure TdxSkinsUnitStateList.RefreshUnitsList; var AExtendedStylePainters: TcxExtendedStylePainters; AItem: TdxSkinsUnitStateListItem; APainter: TcxCustomLookAndFeelPainterClass; I: Integer; begin FList.Clear; AExtendedStylePainters := GetExtendedStylePainters; for I := 0 to AExtendedStylePainters.Count - 1 do begin APainter := AExtendedStylePainters.Painters[I]; if APainter.InheritsFrom(TdxSkinLookAndFeelPainter) then begin AItem := TdxSkinsUnitStateListItem.Create( TdxSkinLookAndFeelPainterClass(APainter).InternalUnitName, AExtendedStylePainters.Names[I]); AItem.State := susUndefined; FList.Add(AItem); end; end; LoadSettings; end; procedure TdxSkinsUnitStateList.SaveSettings; var AConfig: TIniFile; I: Integer; begin if Initialized and FileExists(CurrentProjectFileName) then begin AConfig := TIniFile.Create(SkinsConfigFileName); try try AConfig.WriteBool(sdxSkinsCfgSection, sdxSkinsRegProjectState, Enabled); for I := 0 to Count - 1 do with Item[I] do AConfig.WriteBool(sdxSkinsCfgSection, UnitName, Enabled); except on EIniFileException do else raise; end; finally AConfig.Free; end; end; end; procedure TdxSkinsUnitStateList.UpdateActiveProjectSettings; begin LoadSettings; if NeedShowConfirmation then dxSkinsShowProjectOptionsDialog; end; { TdxSkinsUnitStateListItem } constructor TdxSkinsUnitStateListItem.Create(const AUnitName, AName: string); begin FName := AName; FUnitName := AUnitName; end; function TdxSkinsUnitStateListItem.GetEnabled: Boolean; begin Result := State <> susDisabled; end; { TdxSkinsCheckListBox } procedure TdxSkinsCheckListBox.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); begin Canvas.Font.Assign(Font); if (dxSkinsUnitStateList.Item[Index].State = susUndefined) and AllowBoldSelection then Canvas.Font.Style := [fsBold]; if odSelected in State then Canvas.Font.Color := clHighlightText; inherited DrawItem(Index, Rect, State); end; { TdxSkinsDesignHelperForm } constructor TdxSkinsDesignHelperForm.Create(AOwner: TComponent); begin inherited Create(AOwner); CheckListBox := TdxSkinsCheckListBox.Create(Self); CheckListBox.Parent := Self; CheckListBox.Hint := sdxSkinCheckListBoxHint; CheckListBox.BoundsRect := CheckListBoxHolder.BoundsRect; TdxSkinsCheckListBox(CheckListBox).AllowBoldSelection := FileExists(dxSkinsUnitStateList.SkinsConfigFileName); cbSkinsAutoFilling.Hint := sdxEnableSkinSupportHint; cbSkinsAutoFilling.Checked := dxSkinsUnitStateList.Enabled; cbSkinsAutoFillingClick(nil); PopulateList; end; class procedure TdxSkinsDesignHelperForm.Execute; begin with TdxSkinsDesignHelperForm.Create(nil) do try dxSkinsUnitStateList.Initialize; ApplySettings(ShowModal <> mrOk); dxSkinsUnitStateList.SaveSettings; finally Free; end; end; procedure TdxSkinsDesignHelperForm.ApplySettings(ADropToDefault: Boolean); var AItem: TdxSkinsUnitStateListItem; I: Integer; begin if not ADropToDefault then dxSkinsUnitStateList.Enabled := cbSkinsAutoFilling.Checked; for I := 0 to CheckListBox.Count - 1 do begin AItem := dxSkinsUnitStateList.Item[I]; if ADropToDefault then AItem.State := BoolToUnitState[AItem.Enabled] else AItem.State := BoolToUnitState[CheckListBox.Checked[I]]; end; end; function TdxSkinsDesignHelperForm.IsShortCut(var Message: TWMKey): Boolean; begin Result := Message.CharCode = VK_ESCAPE; if Result then PostMessage(Handle, WM_CLOSE, 0, 0) else Result := inherited IsShortCut(Message); end; procedure TdxSkinsDesignHelperForm.PopulateList; var I: Integer; begin dxSkinsUnitStateList.LoadSettings; CheckListBox.Items.BeginUpdate; try CheckListBox.Items.Clear; for I := 0 to dxSkinsUnitStateList.Count - 1 do with dxSkinsUnitStateList.Item[I] do begin CheckListBox.Items.Add(Name); CheckListBox.Checked[I] := Enabled; end; finally CheckListBox.Items.EndUpdate; end; end; procedure TdxSkinsDesignHelperForm.cbSkinsAutoFillingClick(Sender: TObject); begin bSelectAll.Enabled := cbSkinsAutoFilling.Checked; bSelectNone.Enabled := cbSkinsAutoFilling.Checked; CheckListBox.Enabled := cbSkinsAutoFilling.Checked; end; procedure TdxSkinsDesignHelperForm.bSelectAllClick(Sender: TObject); var I: Integer; begin for I := 0 to CheckListBox.Count - 1 do CheckListBox.Checked[I] := TComponent(Sender).Tag = 1; end; procedure TdxSkinsDesignHelperForm.pbFramePaint(Sender: TObject); begin pbFrame.Canvas.Pen.Color := clBtnShadow; pbFrame.Canvas.Brush.Color := clInfoBk; pbFrame.Canvas.Rectangle(pbFrame.ClientRect); end; { TdxSkinsProjectOptionsMenuExpert } constructor TdxSkinsProjectOptionsMenuExpert.Create; begin FMenuItem := CreateMenuItem(ProjectMenuItem); end; destructor TdxSkinsProjectOptionsMenuExpert.Destroy; begin FreeAndNil(FMenuItem); inherited Destroy; end; function TdxSkinsProjectOptionsMenuExpert.CalcMenuItemPosition(AParent: TMenuItem): Integer; var AItem: TMenuItem; begin AItem := FindMenuItemByName(AParent, 'ProjectOptionsItem'); if AItem = nil then Result := AParent.Count - 1 else Result := AParent.IndexOf(AItem); end; function TdxSkinsProjectOptionsMenuExpert.CreateMenuItem(AParent: TMenuItem): TMenuItem; begin Result := nil; if Assigned(AParent) then begin Result := TMenuItem.Create(nil); Result.Caption := sdxSkinsMenuItemCaption; Result.OnClick := DoMenuItemClick; Result.Bitmap.LoadFromResourceName(HInstance, sdxSkinsMenuItemGlyphResName); if AParent.GetImageList <> nil then Result.ImageIndex := AParent.GetImageList.AddMasked(Result.Bitmap, clFuchsia); AParent.Insert(CalcMenuItemPosition(AParent), Result); end; end; procedure TdxSkinsProjectOptionsMenuExpert.DoMenuItemClick(Sender: TObject); begin dxSkinsShowProjectOptionsDialog; end; function TdxSkinsProjectOptionsMenuExpert.FindMenuItemByName( AParent: TMenuItem; const AName: string): TMenuItem; var I: Integer; begin Result := nil; for I := 0 to AParent.Count - 1 do if SameText(AParent.Items[I].Name, AName) then begin Result := AParent.Items[I]; Break; end; end; function TdxSkinsProjectOptionsMenuExpert.GetProjectMenuItem: TMenuItem; var AServices: INTAServices; begin if Supports(BorlandIDEServices, INTAServices, AServices) then Result := FindMenuItemByName(AServices.MainMenu.Items, 'ProjectMenu') else Result := nil; end; { TdxSkinsDesignHelper } constructor TdxSkinsDesignHelper.Create; begin FMenuExpert := TdxSkinsProjectOptionsMenuExpert.Create; RegisterIDENotifier; ActiveProject := GetActiveProject; end; destructor TdxSkinsDesignHelper.Destroy; begin ActiveProject := nil; UnregisterIDENotifier; FreeAndNil(FMenuExpert); inherited Destroy; end; // IOTAIDENotifier procedure TdxSkinsDesignHelper.AfterCompile(Succeeded: Boolean); begin end; procedure TdxSkinsDesignHelper.BeforeCompile( const Project: IOTAProject; var Cancel: Boolean); begin end; procedure TdxSkinsDesignHelper.FileNotification(NotifyCode: TOTAFileNotification; const FileName: string; var Cancel: Boolean); begin if NotifyCode = ofnActiveProjectChanged then ActiveProject := GetActiveProject; end; // IOTAModuleNotifier function TdxSkinsDesignHelper.CheckOverwrite: Boolean; begin Result := True; end; procedure TdxSkinsDesignHelper.ModuleRenamed(const NewName: string); begin end; // IOTANotifier procedure TdxSkinsDesignHelper.AfterSave; begin dxSkinsUnitStateList.SaveSettings; end; procedure TdxSkinsDesignHelper.BeforeSave; begin end; procedure TdxSkinsDesignHelper.Destroyed; begin ActiveProject := GetActiveProject; end; procedure TdxSkinsDesignHelper.Modified; begin end; procedure TdxSkinsDesignHelper.SetActiveProject(AProject: IOTAProject); begin if AProject <> FActiveProject then begin UnregisterModuleNotifier(ActiveProject, FActiveProjectNotifierID); FActiveProject := AProject; FActiveProjectNotifierID := RegisterModuleNotifier(ActiveProject); dxSkinsUnitStateList.Finalize; dxSkinsUnitStateList.RefreshUnitsList; UpdateMenuItemState; end; end; procedure TdxSkinsDesignHelper.RegisterIDENotifier; var AServices: IOTAServices; begin if Supports(BorlandIDEServices, IOTAServices, AServices) then FServicesNotifierID := AServices.AddNotifier(Self) else FServicesNotifierID := -1; end; procedure TdxSkinsDesignHelper.UnregisterIDENotifier; var AServices: IOTAServices; begin if FServicesNotifierID >= 0 then begin if Supports(BorlandIDEServices, IOTAServices, AServices) then AServices.RemoveNotifier(FServicesNotifierID); FServicesNotifierID := -1; end; end; function TdxSkinsDesignHelper.RegisterModuleNotifier(AModule: IOTAModule): Integer; begin if AModule = nil then Result := -1 else Result := AModule.AddNotifier(Self); end; procedure TdxSkinsDesignHelper.UnregisterModuleNotifier(AModule: IOTAModule; ID: Integer); begin if Assigned(AModule) then AModule.RemoveNotifier(ID); end; procedure TdxSkinsDesignHelper.UpdateMenuItemState; begin if Assigned(MenuExpert.MenuItem) then MenuExpert.MenuItem.Visible := Assigned(ActiveProject); end; initialization SkinsDesignHelper := TdxSkinsDesignHelper.Create; finalization FreeAndNil(SkinsDesignHelper); FreeAndNil(SkinsUnitsStateList); end.