Module cCJSkinFramework.pkg

     1Use windows.pkg
     2Use cCJComSkinFramework.pkg
     3Use cApplication.pkg
     4
     5// todo: move to fmac
     6#Replace msg_EnableVisualStyles |CI$069b
     7#IFDEF 0
     8    Procedure EnableVisualStyles Boolean bEnable
     9    End_Procedure
    10#ENDIF
    11
    12Struct tSkinInformation
    13    String sName     // description of the skin
    14    String sSkinfile // file path. Can be relative or full
    15    String sSkinIni  // section name
    16End_Struct
    17
    18{ DesignerClass=None }
    19{ OverrideProperty=Border_Style DesignTime=False }
    20{ OverrideProperty=Enabled_State DesignTime=False }
    21{ OverrideProperty=Color DesignTime=False }
    22{ OverrideProperty=Label DesignTime=False }
    23{ OverrideProperty=Label_Col_Offset DesignTime=False }
    24{ OverrideProperty=Label_Row_Offset DesignTime=False }
    25{ OverrideProperty=Label_Justification_Mode DesignTime=False }
    26{ OverrideProperty=Label_Color DesignTime=False }
    27{ OverrideProperty=Label_FontItalics DesignTime=False }
    28{ OverrideProperty=Label_FontSize DesignTime=False }
    29{ OverrideProperty=Label_FontUnderline DesignTime=False }
    30{ OverrideProperty=Label_FontWeight DesignTime=False }
    31{ OverrideProperty=Label_TextColor DesignTime=False }
    32{ OverrideProperty=Label_TypeFace DesignTime=False }
    33{ OverrideProperty=Location DesignTime=False }
    34{ OverrideProperty=Size DesignTime=False }
    35{ OverrideProperty=peAnchors DesignTime=False }
    36{ OverrideProperty=piMinSize DesignTime=False }
    37{ OverrideProperty=TextColor DesignTime=False }
    38{ OverrideProperty=Visible_state DesignTime=False }
    39{ OverrideProperty=Attach_Parent_State DesignTime=False }
    40{ OverrideProperty=Block_Mouse_state DesignTime=False }
    41{ OverrideProperty=Delegation_Mode DesignTime=False }
    42{ OverrideProperty=Client_Area_State DesignTime=False }
    43{ OverrideProperty=Focus_Mode DesignTime=False }
    44{ OverrideProperty=pbBindValue DesignTime=False }
    45{ OverrideProperty=peAutoCreate DesignTime=False }
    46{ OverrideProperty=peNeighborhood DesignTime=False }
    47{ OverrideProperty=Popup_State DesignTime=False }
    48{ OverrideProperty=Ring_State DesignTime=False }
    49{ OverrideProperty=Search_Case DesignTime=False }
    50{ OverrideProperty=Skip_State DesignTime=False }
    51{ OverrideProperty=Scope_State DesignTime=False }
    52{ OverrideProperty=Help_Id DesignTime=False }
    53{ OverrideProperty=Help_Keyword DesignTime=False }
    54{ OverrideProperty=psHtmlHelpTopic DesignTime=False }
    55{ OverrideProperty=Status_Help DesignTime=False }
    56{ OverrideProperty=Use_Parent_Status_Help DesignTime=False }
    57{ OverrideProperty=psLicenseKey DesignTime=False }
    58{ OverrideProperty=psProgId DesignTime=False }
    59
    60Class cCJSkinFramework is a cCJComSkinFramework
    61    
    62    Procedure Construct_Object
    63        Forward Send Construct_Object
    64        
    65        { Category="Appearance" }
    66        { PropertyType=SkinFile }
    67        Property String psSkinFile ""
    68        { Category="Appearance" }
    69        { PropertyType=SkinIni }
    70        Property String psSkinIni ""
    71        { Category="Behavior" }
    72        Property Boolean pbLoadPreference False
    73        
    74        Set peAutoCreate to acAutoCreate
    75        
    76        Move Self to ghoSkinFramework
    77    End_Procedure
    78    
    79    // return the default skin path, which is the programs directory.
    80    // This requires an application object.
    81    // If you want to different skin path, override this.
    82    Function SkinPath Returns String
    83        String sPath sPaths
    84        Handle hoWorkspace
    85        If ghoApplication Begin
    86            Get phoWorkspace of ghoApplication to hoWorkspace
    87            Get psProgramPath of hoWorkspace to sPaths
    88            Get PathAtIndex of hoWorkspace sPaths 1 to sPath
    89        End
    90        Else Begin
    91            Error DFERR_PROGRAM C_$ApplicationObjectNotCreated
    92        End
    93        Function_Return sPath
    94    End_Function
    95    
    96    // Returns the Qualified name of psSkinFile. If the file is already qualified it just
    97    // returns itself. If it is not, it uses SkinPath to get the path.
    98    Function SkinQFile Returns String
    99        String sFile sPath sSep
   100        Boolean bQualified
   101        Get psSkinFile to sFile
   102        If not (IsFileNameQualified(sFile)) Begin
   103            Get SkinPath to sPath
   104            Move (SysConf(SYSCONF_DIR_SEPARATOR)) to sSep
   105            Move (sPath - sSep - sFile) to sFile
   106        End
   107        Function_Return sFile
   108    End_Function
   109        
   110    // defines the default VDF window class mapping.    
   111    { Visibility=Private }
   112    { MethodType=Event }
   113    Procedure OnAddVDFWindowClasses
   114        Send ComAddWindowClass "DFlistbox"               "ListBox"
   115        Send ComAddWindowClass "DFentry"                 "Edit"
   116        Send ComAddWindowClass "DFtextbox"               "Edit"
   117        Send ComAddWindowClass "DFRichEditCtrl"          "Edit"
   118        Send ComAddWindowClass "DFcombobox"              "ComboBox"
   119        Send ComAddWindowClass "DFformlist"              "Edit"
   120        Send ComAddWindowClass "DFFormListHeader"        "SysHeader32"
   121        Send ComAddWindowClass "DFbutton"                "Button"
   122        Send ComAddWindowClass "HPromptBtn"              "Button"
   123        Send ComAddWindowClass "Hspinbtn"                "msctls_updown32"
   124        Send ComAddWindowClass "DFSysTabControl32"       "SysTabControl32"
   125        Send ComAddWindowClass "DFMDIClient"             "MDIClient" 
   126        Send ComAddWindowClass "DFedit"                  "edit"
   127        Send ComAddWindowClass "DFlistedit"              "edit"
   128        Send ComAddWindowClass "DFscrollbar"             "scrollbar"
   129        Send ComAddWindowClass "DFgroup"                 "Button"
   130        Send ComAddWindowClass "DFComboGrid"             "ComboBox"
   131        // External class
   132        Send ComAddWindowClass "cVdfAnimation"           "SysAnimate32"
   133        Send ComAddWindowClass "cVdfProgressBar"         "msctls_progress32"
   134        Send ComAddWindowClass "cVdfStatusBar"           "msctls_statusbar32"
   135        Send ComAddWindowClass "cVdfToolbar"             "ToolbarWindow32"
   136        Send ComAddWindowClass "cObsoleteVdfProgressBar" "msctls_progress32"
   137        Send ComAddWindowClass "cVdfTrackBar"            "msctls_trackbar32"
   138        Send ComAddWindowClass "cObsoleteBasicStatusBar" "msctls_statusbar32"
   139        Send ComAddWindowClass "cVdfTreeView"            "SysTreeView32"
   140    End_Procedure
   141    
   142    // Used to support developer designed class mappings (e.g. COM controls)
   143    { MethodType=Event }
   144    Procedure OnAddCustomWindowClasses
   145    End_Procedure
   146
   147    // called when object is created during end_construct_object.
   148    { MethodType=Event }
   149    Procedure OnCreate
   150        Forward Send OnCreate
   151
   152        // this works around a CJ issue where skins applied to other threads causes an exception upon close down. 
   153        // We saw this with our mssql driver but it could occur elsewhere. This has been reported in the CJ newsgroup
   154        // and this was the suggested workaround.
   155        Set ComAutoApplyNewThreads to False
   156
   157        Send OnAddVDFWindowClasses
   158        Send OnAddCustomWindowClasses
   159        
   160        // if preferences are used, it will set psSkinFile and psSkinIni
   161        If (pbLoadPreference(Self)) Begin
   162            Send LoadSkinPreference
   163        End
   164        // if a skin file name exists, we apply the skin.    
   165        If (psSkinFile(Self)<>"") Begin
   166            Send ApplySkin
   167        End        
   168    End_Procedure
   169    
   170    // called by framework as part of application exit.
   171    { Visibility=Private }
   172    { MethodType=Event }
   173    Procedure Broadcast_Notify_Exit_Application
   174        Send Notify_Exit_Application
   175    End_Procedure // Notify_Exit_Application
   176
   177    { MethodType=Event }
   178    Procedure Notify_Exit_Application
   179        If (pbLoadPreference(Self)) Begin
   180            Send SaveSkinPreference
   181        End
   182    End_Procedure
   183
   184    { MethodType=Event }
   185    { Visibility=Private }
   186    Procedure NotifyPreApplySkin
   187        Broadcast Send OnPreApplySkin of Desktop True       
   188    End_Procedure
   189
   190    { MethodType=Event }
   191    { Visibility=Private }
   192    Procedure NotifyPostApplySkin
   193        Broadcast Send OnPostApplySkin of Desktop True       
   194    End_Procedure
   195    
   196    // returns an array of all skins in the path. If path is "", use the default path.
   197    // If the default path is used, returns the file names as relative names, else use full path.
   198    Function EnumerateSkins String sPath Boolean bRecursive Returns tSkinInformation[]
   199        tSkinInformation[] Skins
   200        String sSkinName sSkinFile sDefaultPath sSep
   201        Variant vSkinDescriptions vSkinDescription vSkinIniFile
   202        Handle hSkinDescriptions hSkinDescription hSkinIniFile
   203        Integer iSkinsCount iSkinFilesCount iNumSkins iNumSkinFiles iArrayItem
   204        Integer iPos iDfltLen
   205        Boolean bUseRelativePath
   206        
   207        Move (SysConf(SYSCONF_DIR_SEPARATOR)) to sSep
   208        
   209        Get SkinPath to sDefaultPath
   210        If (sPath="") Begin
   211            Move sDefaultPath to sPath
   212        End
   213        Move (Uppercase(sDefaultPath)) to sDefaultPath
   214        Move (Length(sDefaultPath)) to iDfltLen
   215        Move (sDefaultPath=Uppercase(sPath)) to bUseRelativePath
   216
   217        Get ComEnumerateSkinDirectory sPath bRecursive to vSkinDescriptions
   218        If (not(IsNullComObject(vSkinDescriptions))) Begin
   219
   220            Get Create U_cCJSkinDescriptions to hSkinDescriptions
   221            Get Create U_cCJSkinDescription to hSkinDescription
   222            Get Create U_cCJSkinIniFile to hSkinIniFile
   223            
   224            Set pvComObject of hSkinDescriptions to vSkinDescriptions
   225            Get ComCount of hSkinDescriptions to iNumSkinFiles
   226            
   227            For iSkinFilesCount from 0 to (iNumSkinFiles-1)
   228                Get ComSkin of hSkinDescriptions iSkinFilesCount to vSkinDescription
   229                Set pvComObject of hSkinDescription to vSkinDescription
   230
   231                Get ComCount of hSkinDescription to iNumSkins
   232                    
   233                For iSkinsCount from 0 to (iNumSkins-1)
   234                    Get ComIniFile of hSkinDescription iSkinsCount to vSkinIniFile
   235                    Set pvComObject of hSkinIniFile to vSkinIniFile
   236
   237                    Get ComName of hSkinDescription to Skins[iArrayItem].sName
   238                    Get ComPath of hSkinDescription to sSkinFile
   239                    If bUseRelativePath Begin
   240                        Move (pos(sDefaultPath,uppercase(sSkinFile))) to iPos
   241                        If iPos Begin
   242                            Move (Remove(sSkinFile,iPos,iDfltLen)) to sSkinFile   
   243                            While (Left(sSkinFile,1)=sSep)
   244                                Move (Remove(sSkinFile,1,1)) to sSkinFile   
   245                            Loop                         
   246                        End
   247                    End
   248                    Move sSkinFile to Skins[iArrayItem].sSkinfile
   249                    Get ComIniFileName of hSkinIniFile to Skins[iArrayItem].sSkinIni
   250
   251                    Increment iArrayItem
   252                Loop
   253            Loop
   254                            
   255            Send Destroy of hSkinDescriptions
   256            Send Destroy of hSkinDescription
   257            Send Destroy of hSkinIniFile
   258                
   259        End
   260        Function_Return Skins
   261    End_Function 
   262    
   263    // Save the skin preference. This requires an application object.
   264    // Only do this if the application object allows it. 
   265    // This is called during startup if pbLoadPreference is True
   266    // Suitable for override
   267    Procedure SaveSkinPreference 
   268        String sSkin sIni
   269        If ghoApplication Begin
   270            If (pbPreserveEnvironment(ghoApplication)) Begin
   271                Get psSkinFile to sSkin
   272                Get psSkinIni to sIni
   273                Send WriteString of ghoApplication "Preferences" "SkinFile" sSkin
   274                Send WriteString of ghoApplication "Preferences" "SkinIni" sIni
   275            End
   276        End
   277        Else Begin
   278            Error DFERR_PROGRAM C_$ApplicationObjectNotCreated
   279        End
   280    End_Procedure
   281
   282    // Load the skin preference. This requires an application object.
   283    // Only do this if the application object allows it. 
   284    // This is called during startup if pbLoadPreference is True
   285    // Suitable for override
   286    Procedure LoadSkinPreference 
   287        String sSkin sIni
   288        Boolean bExists
   289        If ghoApplication Begin
   290            If (pbPreserveEnvironment(ghoApplication)) Begin
   291                Get ValueExists of ghoApplication "Preferences" "SkinFile" to bExists
   292                If bExists Begin
   293                    Get ReadString of ghoApplication "Preferences" "SkinFile" "" to sSkin
   294                    Get ReadString of ghoApplication "Preferences" "SkinIni" "" to sIni
   295                    Set psSkinFile to sSkin
   296                    Set psSkinIni to sIni
   297                End
   298            End
   299        End
   300        Else Begin
   301            Error DFERR_PROGRAM C_$ApplicationObjectNotCreated
   302        End
   303    End_Procedure
   304
   305    // Can be called to apply the current skin.
   306    Procedure ApplySkin
   307        Boolean bOk
   308        String sSkin sIni
   309        If (IsComObjectCreated(Self)) Begin
   310            Get SkinQFile to sSkin
   311            Get psSkinIni to sIni
   312            
   313            Send NotifyPreApplySkin
   314            // when skins are used we don't want to use built in Visual Styles
   315            Send EnableVisualStyles of Desktop (sSkin="")
   316            Get ComLoadSkin sSkin sIni to bOK
   317            If (sSkin<>"" and not(bOk)) Begin
   318                // if not ok, no skin was appied. Enable visual styles
   319                Send EnableVisualStyles of Desktop True
   320            End
   321            Send NotifyPostApplySkin
   322        End
   323    End_Procedure
   324
   325
   326End_Class