*-------------------------------------------------------------------------------------------------------------------------------------------------------- * (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! *-------------------------------------------------------------------------------------------------------------------------------------------------------- *< FOXBIN2PRG: Version="1.21" SourceFile="ctl32.vcx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) * * DEFINE CLASS ctl32_commondialog AS container *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder *< OBJECTDATA: ObjPath="lblname" UniqueID="" Timestamp="" /> #INCLUDE "ctl32.h" * *m: ctlgetknownfolderidlist *m: ctlgetknownfolderpath && Gets a special folder path. *m: ctlhelprequest && Occurs when the user clicks the Help button on a common dialog box. *m: ctlhookproc && Defines the common dialog box hook procedure that is overridden to add specific functionality to a common dialog box. *m: ctlonhelprequest && Raises the HelpRequest event. *m: ctlreset && When overridden in a derived class, resets the properties of a common dialog box to their default values. *m: ctlrundialog && When overridden in a derived class, specifies a common dialog box. *m: ctlshowdialog && Runs a common dialog box. *m: _createcallback *m: _destroycallback *m: _initlibrary *m: _loadstring *m: _resetproperties *m: _saveproperties *m: _setproperties *p: ctltitle && Gets or sets the file dialog box title. *a: _properties[1,1] *p: _callbackpointer *p: _memberdata && XML Metadata for customizable properties * * BackColor = 140,200,200 ctltitle = Height = 23 Name = "ctl32_commondialog" Visible = .F. Width = 120 _callbackpointer = 0 * ADD OBJECT 'lblname' AS label WITH ; AutoSize = .T., ; BackStyle = 0, ; Caption = "ctl32_commondialog", ; FontName = "Tahoma", ; FontSize = 8, ; ForeColor = 0,0,128, ; Height = 15, ; Left = 6, ; Name = "lblname", ; Top = 4, ; Width = 98 *< END OBJECT: BaseClass="label" /> PROCEDURE ctlgetknownfolderidlist *!* ctlGetKnownFolderList(cFolderId|qFolderId) *!* Vista: SHGetKnownFolderIDList *!* Win2K: SHGetFolderLocation *!* Win95: SHGetSpecialFolderLocation Lparameters puFolderId Local ; lqFolderId, ; lnCsidl, ; lnPIDL, ; lnResult, ; lnPointer *!* Initialize variables m.lnPIDL = 0 m.lqFolderId = 0h m.lnCsidl = 0xFFFF If Vartype(m.puFolderId) = "C" m.puFolderId = Upper(Alltrim(m.puFolderId)) *!* Remove prefix m.puFolderId = Strtran(m.puFolderId, "FOLDERID_", "", 1, 1) Endif Do Case Case Vartype(m.puFolderId) = "Q" *!* If we have a binary parameter, lets assume its a valid FOLDERID m.lqFolderId = m.puFolderId Case Vartype(m.puFolderId) # "C" *!* From here, m.puFolderId can only be of type character Case m.puFolderId = "ADDNEWPROGRAMS" m.lqFolderId = FOLDERID_AddNewPrograms m.lnCsidl = 0xFFFF Case m.puFolderId = "ADMINTOOLS" m.lqFolderId = FOLDERID_AdminTools m.lnCsidl = CSIDL_ADMINTOOLS Case m.puFolderId = "APPUPDATES" m.lqFolderId = FOLDERID_AppUpdates m.lnCsidl = 0xFFFF Case m.puFolderId = "CDBURNING" m.lqFolderId = FOLDERID_CDBurning m.lnCsidl = CSIDL_CDBURN_AREA Case m.puFolderId = "CHANGEREMOVEPROGRAMS" m.lqFolderId = FOLDERID_ChangeRemovePrograms m.lnCsidl = 0xFFFF Case m.puFolderId = "COMMONADMINTOOLS" m.lqFolderId = FOLDERID_CommonAdminTools m.lnCsidl = CSIDL_COMMON_ADMINTOOLS Case m.puFolderId = "COMMONOEMLINKS" m.lqFolderId = FOLDERID_CommonOEMLinks m.lnCsidl = CSIDL_COMMON_OEM_LINKS Case m.puFolderId = "COMMONPROGRAMS" m.lqFolderId = FOLDERID_CommonPrograms m.lnCsidl = CSIDL_COMMON_PROGRAMS Case m.puFolderId = "COMMONSTARTMENU" m.lqFolderId = FOLDERID_CommonStartMenu m.lnCsidl = CSIDL_COMMON_STARTMENU Case m.puFolderId = "COMMONSTARTUP" m.lqFolderId = FOLDERID_CommonStartup m.lnCsidl = CSIDL_COMMON_STARTUP Case m.puFolderId = "COMMONTEMPLATES" m.lqFolderId = FOLDERID_CommonTemplates m.lnCsidl = CSIDL_COMMON_TEMPLATES Case m.puFolderId = "COMPUTERFOLDER" m.lqFolderId = FOLDERID_ComputerFolder m.lnCsidl = CSIDL_DRIVES Case m.puFolderId = "CONFLICTFOLDER" m.lqFolderId = FOLDERID_ConflictFolder m.lnCsidl = 0xFFFF Case m.puFolderId = "CONNECTIONSFOLDER" m.lqFolderId = FOLDERID_ConnectionsFolder m.lnCsidl = CSIDL_CONNECTIONS Case m.puFolderId = "CONTACTS" m.lqFolderId = FOLDERID_Contacts m.lnCsidl = 0xFFFF Case m.puFolderId = "CONTROLPANELFOLDER" m.lqFolderId = FOLDERID_ControlPanelFolder m.lnCsidl = CSIDL_CONTROLS Case m.puFolderId = "COOKIES" m.lqFolderId = FOLDERID_Cookies m.lnCsidl = CSIDL_COOKIES Case m.puFolderId = "DESKTOP" m.lqFolderId = FOLDERID_Desktop m.lnCsidl = CSIDL_DESKTOP Case m.puFolderId = "DOCUMENTS" m.lqFolderId = FOLDERID_Documents m.lnCsidl = CSIDL_MYDOCUMENTS Case m.puFolderId = "DOWNLOADS" m.lqFolderId = FOLDERID_Downloads m.lnCsidl = 0xFFFF Case m.puFolderId = "FAVORITES" m.lqFolderId = FOLDERID_Favorites m.lnCsidl = CSIDL_FAVORITES Case m.puFolderId = "FONTS" m.lqFolderId = FOLDERID_Fonts m.lnCsidl = CSIDL_FONTS Case m.puFolderId = "GAMES" m.lqFolderId = FOLDERID_Games m.lnCsidl = 0xFFFF Case m.puFolderId = "GAMETASKS" m.lqFolderId = FOLDERID_GameTasks m.lnCsidl = 0xFFFF Case m.puFolderId = "HISTORY" m.lqFolderId = FOLDERID_History m.lnCsidl = CSIDL_HISTORY Case m.puFolderId = "INTERNETCACHE" m.lqFolderId = FOLDERID_InternetCache m.lnCsidl = CSIDL_INTERNET_CACHE Case m.puFolderId = "INTERNETFOLDER" m.lqFolderId = FOLDERID_InternetFolder m.lnCsidl = CSIDL_INTERNET Case m.puFolderId = "LINKS" m.lqFolderId = FOLDERID_Links m.lnCsidl = 0xFFFF Case m.puFolderId = "LOCALAPPDATA" m.lqFolderId = FOLDERID_LocalAppData m.lnCsidl = CSIDL_LOCAL_APPDATA Case m.puFolderId = "LOCALAPPDATALOW" m.lqFolderId = FOLDERID_LocalAppDataLow m.lnCsidl = 0xFFFF Case m.puFolderId = "LOCALIZEDRESOURCESDIR" m.lqFolderId = FOLDERID_LocalizedResourcesDir m.lnCsidl = CSIDL_RESOURCES_LOCALIZED Case m.puFolderId = "MUSIC" m.lqFolderId = FOLDERID_Music m.lnCsidl = CSIDL_MYMUSIC Case m.puFolderId = "NETHOOD" m.lqFolderId = FOLDERID_NetHood m.lnCsidl = CSIDL_NETHOOD Case m.puFolderId = "NETWORKFOLDER" m.lqFolderId = FOLDERID_NetworkFolder m.lnCsidl = CSIDL_NETWORK Case m.puFolderId = "ORIGINALIMAGES" m.lqFolderId = FOLDERID_OriginalImages m.lnCsidl = 0xFFFF Case m.puFolderId = "PHOTOALBUMS" m.lqFolderId = FOLDERID_PhotoAlbums m.lnCsidl = 0xFFFF Case m.puFolderId = "PICTURES" m.lqFolderId = FOLDERID_Pictures m.lnCsidl = CSIDL_MYPICTURES Case m.puFolderId = "PLAYLISTS" m.lqFolderId = FOLDERID_Playlists m.lnCsidl = 0xFFFF Case m.puFolderId = "PRINTERSFOLDER" m.lqFolderId = FOLDERID_PrintersFolder m.lnCsidl = CSIDL_PRINTERS Case m.puFolderId = "PRINTHOOD" m.lqFolderId = FOLDERID_PrintHood m.lnCsidl = CSIDL_PRINTHOOD Case m.puFolderId = "PROFILE" m.lqFolderId = FOLDERID_Profile m.lnCsidl = CSIDL_PROFILE Case m.puFolderId = "PROGRAMDATA" m.lqFolderId = FOLDERID_ProgramData m.lnCsidl = CSIDL_COMMON_APPDATA Case m.puFolderId = "PROGRAMFILES" m.lqFolderId = FOLDERID_ProgramFiles m.lnCsidl = CSIDL_PROGRAM_FILES Case m.puFolderId = "PROGRAMFILESX64" m.lqFolderId = FOLDERID_ProgramFilesX64 m.lnCsidl = 0xFFFF Case m.puFolderId = "PROGRAMFILESX86" m.lqFolderId = FOLDERID_ProgramFilesX86 m.lnCsidl = CSIDL_PROGRAM_FILESX86 Case m.puFolderId = "PROGRAMFILESCOMMON" m.lqFolderId = FOLDERID_ProgramFilesCommon m.lnCsidl = CSIDL_PROGRAM_FILES_COMMON Case m.puFolderId = "PROGRAMFILESCOMMONX64" m.lqFolderId = FOLDERID_ProgramFilesCommonX64 m.lnCsidl = 0xFFFF Case m.puFolderId = "PROGRAMFILESCOMMONX86" m.lqFolderId = FOLDERID_ProgramFilesCommonX86 m.lnCsidl = CSIDL_PROGRAM_FILES_COMMONX86 Case m.puFolderId = "PROGRAMS" m.lqFolderId = FOLDERID_Programs m.lnCsidl = CSIDL_PROGRAMS Case m.puFolderId = "PUBLIC" m.lqFolderId = FOLDERID_Public m.lnCsidl = 0xFFFF Case m.puFolderId = "PUBLICDESKTOP" m.lqFolderId = FOLDERID_PublicDesktop m.lnCsidl = CSIDL_COMMON_DESKTOPDIRECTORY Case m.puFolderId = "PUBLICDOCUMENTS" m.lqFolderId = FOLDERID_PublicDocuments m.lnCsidl = CSIDL_COMMON_DOCUMENTS Case m.puFolderId = "PUBLICDOWNLOADS" m.lqFolderId = FOLDERID_PublicDownloads m.lnCsidl = 0xFFFF Case m.puFolderId = "PUBLICGAMETASKS" m.lqFolderId = FOLDERID_PublicGameTasks m.lnCsidl = 0xFFFF Case m.puFolderId = "PUBLICMUSIC" m.lqFolderId = FOLDERID_PublicMusic m.lnCsidl = CSIDL_COMMON_MUSIC Case m.puFolderId = "PUBLICPICTURES" m.lqFolderId = FOLDERID_PublicPictures m.lnCsidl = CSIDL_COMMON_PICTURES Case m.puFolderId = "PUBLICVIDEOS" m.lqFolderId = FOLDERID_PublicVideos m.lnCsidl = CSIDL_COMMON_VIDEO Case m.puFolderId = "QUICKLAUNCH" m.lqFolderId = FOLDERID_QuickLaunch m.lnCsidl = 0xFFFF Case m.puFolderId = "RECENT" m.lqFolderId = FOLDERID_Recent m.lnCsidl = CSIDL_RECENT Case m.puFolderId = "RECORDEDTV" m.lqFolderId = FOLDERID_RecordedTV m.lnCsidl = 0xFFFF Case m.puFolderId = "RECYCLEBINFOLDER" m.lqFolderId = FOLDERID_RecycleBinFolder m.lnCsidl = CSIDL_BITBUCKET Case m.puFolderId = "RESOURCEDIR" m.lqFolderId = FOLDERID_ResourceDir m.lnCsidl = CSIDL_RESOURCES Case m.puFolderId = "ROAMINGAPPDATA" m.lqFolderId = FOLDERID_RoamingAppData m.lnCsidl = CSIDL_APPDATA Case m.puFolderId = "SAMPLEMUSIC" m.lqFolderId = FOLDERID_SampleMusic m.lnCsidl = 0xFFFF Case m.puFolderId = "SAMPLEPICTURES" m.lqFolderId = FOLDERID_SamplePictures m.lnCsidl = 0xFFFF Case m.puFolderId = "SAMPLEPLAYLISTS" m.lqFolderId = FOLDERID_SamplePlaylists m.lnCsidl = 0xFFFF Case m.puFolderId = "SAMPLEVIDEOS" m.lqFolderId = FOLDERID_SampleVideos m.lnCsidl = 0xFFFF Case m.puFolderId = "SAVEDGAMES" m.lqFolderId = FOLDERID_SavedGames m.lnCsidl = 0xFFFF Case m.puFolderId = "SAVEDSEARCHES" m.lqFolderId = FOLDERID_SavedSearches m.lnCsidl = 0xFFFF Case m.puFolderId = "SEARCH_CSC" m.lqFolderId = FOLDERID_SEARCH_CSC m.lnCsidl = 0xFFFF Case m.puFolderId = "SEARCH_MAPI" m.lqFolderId = FOLDERID_SEARCH_MAPI m.lnCsidl = 0xFFFF Case m.puFolderId = "SEARCHHOME" m.lqFolderId = FOLDERID_SearchHome m.lnCsidl = 0xFFFF Case m.puFolderId = "SENDTO" m.lqFolderId = FOLDERID_SendTo m.lnCsidl = CSIDL_SENDTO Case m.puFolderId = "SIDEBARDEFAULTPARTS " m.lqFolderId = FOLDERID_SidebarDefaultParts m.lnCsidl = 0xFFFF Case m.puFolderId = "SIDEBARPARTS " m.lqFolderId = FOLDERID_SidebarParts m.lnCsidl = 0xFFFF Case m.puFolderId = "STARTMENU" m.lqFolderId = FOLDERID_StartMenu m.lnCsidl = CSIDL_STARTMENU Case m.puFolderId = "STARTUP" m.lqFolderId = FOLDERID_Startup m.lnCsidl = CSIDL_STARTUP Case m.puFolderId = "SYNCMANAGERFOLDER" m.lqFolderId = FOLDERID_SyncManagerFolder m.lnCsidl = 0xFFFF Case m.puFolderId = "SYNCRESULTSFOLDER" m.lqFolderId = FOLDERID_SyncResultsFolder m.lnCsidl = 0xFFFF Case m.puFolderId = "SYNCSETUPFOLDER" m.lqFolderId = FOLDERID_SyncSetupFolder m.lnCsidl = 0xFFFF Case m.puFolderId = "SYSTEM" m.lqFolderId = FOLDERID_System m.lnCsidl = CSIDL_SYSTEM Case m.puFolderId = "SYSTEMX86" m.lqFolderId = FOLDERID_SystemX86 m.lnCsidl = CSIDL_SYSTEMX86 Case m.puFolderId = "TEMPLATES" m.lqFolderId = FOLDERID_Templates m.lnCsidl = CSIDL_TEMPLATES Case m.puFolderId = "TREEPROPERTIES" m.lqFolderId = FOLDERID_TreeProperties m.lnCsidl = 0xFFFF Case m.puFolderId = "USERPROFILES" m.lqFolderId = FOLDERID_UserProfiles m.lnCsidl = 0xFFFF Case m.puFolderId = "USERSFILES" m.lqFolderId = FOLDERID_UsersFiles m.lnCsidl = 0xFFFF Case m.puFolderId = "VIDEOS" m.lqFolderId = FOLDERID_Videos m.lnCsidl = CSIDL_MYVIDEO Case m.puFolderId = "WINDOWS" m.lqFolderId = FOLDERID_Windows m.lnCsidl = CSIDL_WINDOWS Endcase If ctlGetOsVersion() >= NTDDI_VISTA Then Else If m.lnCsidl # 0xFFFF Then m.lnCsidl = Bitor(m.lnCsidl, CSIDL_FLAG_CREATE) m.lnPIDL = 0 If apiSHGetFolderLocation(0, m.lnCsidl, 0, 0, @m.lnPIDL) = ERROR_FILE_NOT_FOUND Then *!* call apiSHGetFolderPath so folder gets created m.lcFolderPath = Replicate(Chr(0), MAX_PATH) apiSHGetFolderPath(0, m.lnCsidl, 0, SHGFP_TYPE_CURRENT, @m.lcFolderPath) *!* Try again apiSHGetFolderLocation(0, m.lnCsidl, 0, 0, @m.lnPIDL) Endif Endif Endif Return m.lnPIDL ENDPROC PROCEDURE ctlgetknownfolderpath && Gets a special folder path. *!* ctlGetKnownFolderPath(cFolderId|qFolderId) *!* Vista: SHGetKnownFolderPath *!* Win2K: SHGetFolderPath *!* Win95: SHGetSpecialFolderPath Lparameters puFolderId Local ; lqFolderId, ; lnCsidl, ; lcFolderPath, ; lnResult, ; lnPointer *!* Initialize variables m.lcFolderPath = "" m.lqFolderId = 0h m.lnCsidl = 0xFFFF If Vartype(m.puFolderId) = "C" m.puFolderId = Upper(Alltrim(m.puFolderId)) *!* Remove prefix m.puFolderId = Strtran(m.puFolderId, "FOLDERID_", "", 1, 1) Endif Do Case Case Vartype(m.puFolderId) = "Q" *!* If we have a binary parameter, lets assume its a valid FOLDERID m.lqFolderId = m.puFolderId Case Vartype(m.puFolderId) # "C" *!* From here, m.puFolderId can only be of type character Case m.puFolderId = "ADDNEWPROGRAMS" m.lqFolderId = FOLDERID_AddNewPrograms m.lnCsidl = 0xFFFF Case m.puFolderId = "ADMINTOOLS" m.lqFolderId = FOLDERID_AdminTools m.lnCsidl = CSIDL_ADMINTOOLS Case m.puFolderId = "APPUPDATES" m.lqFolderId = FOLDERID_AppUpdates m.lnCsidl = 0xFFFF Case m.puFolderId = "CDBURNING" m.lqFolderId = FOLDERID_CDBurning m.lnCsidl = CSIDL_CDBURN_AREA Case m.puFolderId = "CHANGEREMOVEPROGRAMS" m.lqFolderId = FOLDERID_ChangeRemovePrograms m.lnCsidl = 0xFFFF Case m.puFolderId = "COMMONADMINTOOLS" m.lqFolderId = FOLDERID_CommonAdminTools m.lnCsidl = CSIDL_COMMON_ADMINTOOLS Case m.puFolderId = "COMMONOEMLINKS" m.lqFolderId = FOLDERID_CommonOEMLinks m.lnCsidl = CSIDL_COMMON_OEM_LINKS Case m.puFolderId = "COMMONPROGRAMS" m.lqFolderId = FOLDERID_CommonPrograms m.lnCsidl = CSIDL_COMMON_PROGRAMS Case m.puFolderId = "COMMONSTARTMENU" m.lqFolderId = FOLDERID_CommonStartMenu m.lnCsidl = CSIDL_COMMON_STARTMENU Case m.puFolderId = "COMMONSTARTUP" m.lqFolderId = FOLDERID_CommonStartup m.lnCsidl = CSIDL_COMMON_STARTUP Case m.puFolderId = "COMMONTEMPLATES" m.lqFolderId = FOLDERID_CommonTemplates m.lnCsidl = CSIDL_COMMON_TEMPLATES Case m.puFolderId = "COMPUTERFOLDER" m.lqFolderId = FOLDERID_ComputerFolder m.lnCsidl = CSIDL_DRIVES Case m.puFolderId = "CONFLICTFOLDER" m.lqFolderId = FOLDERID_ConflictFolder m.lnCsidl = 0xFFFF Case m.puFolderId = "CONNECTIONSFOLDER" m.lqFolderId = FOLDERID_ConnectionsFolder m.lnCsidl = CSIDL_CONNECTIONS Case m.puFolderId = "CONTACTS" m.lqFolderId = FOLDERID_Contacts m.lnCsidl = 0xFFFF Case m.puFolderId = "CONTROLPANELFOLDER" m.lqFolderId = FOLDERID_ControlPanelFolder m.lnCsidl = CSIDL_CONTROLS Case m.puFolderId = "COOKIES" m.lqFolderId = FOLDERID_Cookies m.lnCsidl = CSIDL_COOKIES Case m.puFolderId = "DESKTOP" m.lqFolderId = FOLDERID_Desktop m.lnCsidl = CSIDL_DESKTOP Case m.puFolderId = "DOCUMENTS" m.lqFolderId = FOLDERID_Documents m.lnCsidl = CSIDL_MYDOCUMENTS Case m.puFolderId = "DOWNLOADS" m.lqFolderId = FOLDERID_Downloads m.lnCsidl = 0xFFFF Case m.puFolderId = "FAVORITES" m.lqFolderId = FOLDERID_Favorites m.lnCsidl = CSIDL_FAVORITES Case m.puFolderId = "FONTS" m.lqFolderId = FOLDERID_Fonts m.lnCsidl = CSIDL_FONTS Case m.puFolderId = "GAMES" m.lqFolderId = FOLDERID_Games m.lnCsidl = 0xFFFF Case m.puFolderId = "GAMETASKS" m.lqFolderId = FOLDERID_GameTasks m.lnCsidl = 0xFFFF Case m.puFolderId = "HISTORY" m.lqFolderId = FOLDERID_History m.lnCsidl = CSIDL_HISTORY Case m.puFolderId = "INTERNETCACHE" m.lqFolderId = FOLDERID_InternetCache m.lnCsidl = CSIDL_INTERNET_CACHE Case m.puFolderId = "INTERNETFOLDER" m.lqFolderId = FOLDERID_InternetFolder m.lnCsidl = CSIDL_INTERNET Case m.puFolderId = "LINKS" m.lqFolderId = FOLDERID_Links m.lnCsidl = 0xFFFF Case m.puFolderId = "LOCALAPPDATA" m.lqFolderId = FOLDERID_LocalAppData m.lnCsidl = CSIDL_LOCAL_APPDATA Case m.puFolderId = "LOCALAPPDATALOW" m.lqFolderId = FOLDERID_LocalAppDataLow m.lnCsidl = 0xFFFF Case m.puFolderId = "LOCALIZEDRESOURCESDIR" m.lqFolderId = FOLDERID_LocalizedResourcesDir m.lnCsidl = CSIDL_RESOURCES_LOCALIZED Case m.puFolderId = "MUSIC" m.lqFolderId = FOLDERID_Music m.lnCsidl = CSIDL_MYMUSIC Case m.puFolderId = "NETHOOD" m.lqFolderId = FOLDERID_NetHood m.lnCsidl = CSIDL_NETHOOD Case m.puFolderId = "NETWORKFOLDER" m.lqFolderId = FOLDERID_NetworkFolder m.lnCsidl = CSIDL_NETWORK Case m.puFolderId = "ORIGINALIMAGES" m.lqFolderId = FOLDERID_OriginalImages m.lnCsidl = 0xFFFF Case m.puFolderId = "PHOTOALBUMS" m.lqFolderId = FOLDERID_PhotoAlbums m.lnCsidl = 0xFFFF Case m.puFolderId = "PICTURES" m.lqFolderId = FOLDERID_Pictures m.lnCsidl = CSIDL_MYPICTURES Case m.puFolderId = "PLAYLISTS" m.lqFolderId = FOLDERID_Playlists m.lnCsidl = 0xFFFF Case m.puFolderId = "PRINTERSFOLDER" m.lqFolderId = FOLDERID_PrintersFolder m.lnCsidl = CSIDL_PRINTERS Case m.puFolderId = "PRINTHOOD" m.lqFolderId = FOLDERID_PrintHood m.lnCsidl = CSIDL_PRINTHOOD Case m.puFolderId = "PROFILE" m.lqFolderId = FOLDERID_Profile m.lnCsidl = CSIDL_PROFILE Case m.puFolderId = "PROGRAMDATA" m.lqFolderId = FOLDERID_ProgramData m.lnCsidl = CSIDL_COMMON_APPDATA Case m.puFolderId = "PROGRAMFILES" m.lqFolderId = FOLDERID_ProgramFiles m.lnCsidl = CSIDL_PROGRAM_FILES Case m.puFolderId = "PROGRAMFILESX64" m.lqFolderId = FOLDERID_ProgramFilesX64 m.lnCsidl = 0xFFFF Case m.puFolderId = "PROGRAMFILESX86" m.lqFolderId = FOLDERID_ProgramFilesX86 m.lnCsidl = CSIDL_PROGRAM_FILESX86 Case m.puFolderId = "PROGRAMFILESCOMMON" m.lqFolderId = FOLDERID_ProgramFilesCommon m.lnCsidl = CSIDL_PROGRAM_FILES_COMMON Case m.puFolderId = "PROGRAMFILESCOMMONX64" m.lqFolderId = FOLDERID_ProgramFilesCommonX64 m.lnCsidl = 0xFFFF Case m.puFolderId = "PROGRAMFILESCOMMONX86" m.lqFolderId = FOLDERID_ProgramFilesCommonX86 m.lnCsidl = CSIDL_PROGRAM_FILES_COMMONX86 Case m.puFolderId = "PROGRAMS" m.lqFolderId = FOLDERID_Programs m.lnCsidl = CSIDL_PROGRAMS Case m.puFolderId = "PUBLIC" m.lqFolderId = FOLDERID_Public m.lnCsidl = 0xFFFF Case m.puFolderId = "PUBLICDESKTOP" m.lqFolderId = FOLDERID_PublicDesktop m.lnCsidl = CSIDL_COMMON_DESKTOPDIRECTORY Case m.puFolderId = "PUBLICDOCUMENTS" m.lqFolderId = FOLDERID_PublicDocuments m.lnCsidl = CSIDL_COMMON_DOCUMENTS Case m.puFolderId = "PUBLICDOWNLOADS" m.lqFolderId = FOLDERID_PublicDownloads m.lnCsidl = 0xFFFF Case m.puFolderId = "PUBLICGAMETASKS" m.lqFolderId = FOLDERID_PublicGameTasks m.lnCsidl = 0xFFFF Case m.puFolderId = "PUBLICMUSIC" m.lqFolderId = FOLDERID_PublicMusic m.lnCsidl = CSIDL_COMMON_MUSIC Case m.puFolderId = "PUBLICPICTURES" m.lqFolderId = FOLDERID_PublicPictures m.lnCsidl = CSIDL_COMMON_PICTURES Case m.puFolderId = "PUBLICVIDEOS" m.lqFolderId = FOLDERID_PublicVideos m.lnCsidl = CSIDL_COMMON_VIDEO Case m.puFolderId = "QUICKLAUNCH" m.lqFolderId = FOLDERID_QuickLaunch m.lnCsidl = 0xFFFF Case m.puFolderId = "RECENT" m.lqFolderId = FOLDERID_Recent m.lnCsidl = CSIDL_RECENT Case m.puFolderId = "RECORDEDTV" m.lqFolderId = FOLDERID_RecordedTV m.lnCsidl = 0xFFFF Case m.puFolderId = "RECYCLEBINFOLDER" m.lqFolderId = FOLDERID_RecycleBinFolder m.lnCsidl = CSIDL_BITBUCKET Case m.puFolderId = "RESOURCEDIR" m.lqFolderId = FOLDERID_ResourceDir m.lnCsidl = CSIDL_RESOURCES Case m.puFolderId = "ROAMINGAPPDATA" m.lqFolderId = FOLDERID_RoamingAppData m.lnCsidl = CSIDL_APPDATA Case m.puFolderId = "SAMPLEMUSIC" m.lqFolderId = FOLDERID_SampleMusic m.lnCsidl = 0xFFFF Case m.puFolderId = "SAMPLEPICTURES" m.lqFolderId = FOLDERID_SamplePictures m.lnCsidl = 0xFFFF Case m.puFolderId = "SAMPLEPLAYLISTS" m.lqFolderId = FOLDERID_SamplePlaylists m.lnCsidl = 0xFFFF Case m.puFolderId = "SAMPLEVIDEOS" m.lqFolderId = FOLDERID_SampleVideos m.lnCsidl = 0xFFFF Case m.puFolderId = "SAVEDGAMES" m.lqFolderId = FOLDERID_SavedGames m.lnCsidl = 0xFFFF Case m.puFolderId = "SAVEDSEARCHES" m.lqFolderId = FOLDERID_SavedSearches m.lnCsidl = 0xFFFF Case m.puFolderId = "SEARCH_CSC" m.lqFolderId = FOLDERID_SEARCH_CSC m.lnCsidl = 0xFFFF Case m.puFolderId = "SEARCH_MAPI" m.lqFolderId = FOLDERID_SEARCH_MAPI m.lnCsidl = 0xFFFF Case m.puFolderId = "SEARCHHOME" m.lqFolderId = FOLDERID_SearchHome m.lnCsidl = 0xFFFF Case m.puFolderId = "SENDTO" m.lqFolderId = FOLDERID_SendTo m.lnCsidl = CSIDL_SENDTO Case m.puFolderId = "SIDEBARDEFAULTPARTS " m.lqFolderId = FOLDERID_SidebarDefaultParts m.lnCsidl = 0xFFFF Case m.puFolderId = "SIDEBARPARTS " m.lqFolderId = FOLDERID_SidebarParts m.lnCsidl = 0xFFFF Case m.puFolderId = "STARTMENU" m.lqFolderId = FOLDERID_StartMenu m.lnCsidl = CSIDL_STARTMENU Case m.puFolderId = "STARTUP" m.lqFolderId = FOLDERID_Startup m.lnCsidl = CSIDL_STARTUP Case m.puFolderId = "SYNCMANAGERFOLDER" m.lqFolderId = FOLDERID_SyncManagerFolder m.lnCsidl = 0xFFFF Case m.puFolderId = "SYNCRESULTSFOLDER" m.lqFolderId = FOLDERID_SyncResultsFolder m.lnCsidl = 0xFFFF Case m.puFolderId = "SYNCSETUPFOLDER" m.lqFolderId = FOLDERID_SyncSetupFolder m.lnCsidl = 0xFFFF Case m.puFolderId = "SYSTEM" m.lqFolderId = FOLDERID_System m.lnCsidl = CSIDL_SYSTEM Case m.puFolderId = "SYSTEMX86" m.lqFolderId = FOLDERID_SystemX86 m.lnCsidl = CSIDL_SYSTEMX86 Case m.puFolderId = "TEMPLATES" m.lqFolderId = FOLDERID_Templates m.lnCsidl = CSIDL_TEMPLATES Case m.puFolderId = "TREEPROPERTIES" m.lqFolderId = FOLDERID_TreeProperties m.lnCsidl = 0xFFFF Case m.puFolderId = "USERPROFILES" m.lqFolderId = FOLDERID_UserProfiles m.lnCsidl = 0xFFFF Case m.puFolderId = "USERSFILES" m.lqFolderId = FOLDERID_UsersFiles m.lnCsidl = 0xFFFF Case m.puFolderId = "VIDEOS" m.lqFolderId = FOLDERID_Videos m.lnCsidl = CSIDL_MYVIDEO Case m.puFolderId = "WINDOWS" m.lqFolderId = FOLDERID_Windows m.lnCsidl = CSIDL_WINDOWS Endcase If ctlGetOsVersion() >= NTDDI_VISTA Then m.lnPointer = 0 m.lnResult = apiSHGetKnownFolderPath(m.lqFolderId, KF_FLAG_CREATE, 0, @m.lnPointer) If m.lnResult = S_OK Then m.lcFolderPath = Sys(2600, m.lnPointer, apiHeapSize(apiGetProcessHeap(), 0, m.lnPointer)) m.lcFolderPath = Strconv(m.lcFolderPath, 6) apiCoTaskMemFree(m.lnPointer) Endif Else If m.lnCsidl # 0xFFFF Then m.lnCsidl = Bitor(m.lnCsidl, CSIDL_FLAG_CREATE) m.lcFolderPath = Replicate(Chr(0), MAX_PATH) apiSHGetFolderPath(0, m.lnCsidl, 0, SHGFP_TYPE_CURRENT, @m.lcFolderPath) m.lcFolderPath = Left(m.lcFolderPath, At(NULW, m.lcFolderPath) - 1) Endif Endif Return m.lcFolderPath ENDPROC PROCEDURE ctlhelprequest && Occurs when the user clicks the Help button on a common dialog box. *!* ctlHelpRequest() ENDPROC PROCEDURE ctlhookproc && Defines the common dialog box hook procedure that is overridden to add specific functionality to a common dialog box. *!* ctlHookProc Lparameters hdlg As Integer, uiMsg As Integer, wParam As Integer, Lparam As Integer Return 0 ENDPROC PROCEDURE ctlonhelprequest && Raises the HelpRequest event. *!* ctlOnHelpRequest() ENDPROC PROCEDURE ctlreset && When overridden in a derived class, resets the properties of a common dialog box to their default values. *!* ctlReset() ENDPROC PROCEDURE ctlrundialog && When overridden in a derived class, specifies a common dialog box. *!* ctlRunDialog() ENDPROC PROCEDURE ctlshowdialog && Runs a common dialog box. *!* ctlShowDialog() ENDPROC PROCEDURE Init *!* Init() *!* This parameter is passed from host ctl32 control *!* Lparameters m.tnParam This.Visible = FALSE This._InitLibrary() This._SetProperties() *!* This._AddObjects() *!* This._SetControlSource() *!* This._SetEnabled() *!* This._BindEvents() *!* If we have a parameter, some other ctl32 control is parent, do no create control *!* Let parent call ctlCreate() *!* If Vartype(m.tnParam) = T_LOGICAL Then *!* This._Create() *!* Endif *!* Raiseevent(This, "ctlInit") This._SaveProperties() ENDPROC PROCEDURE _createcallback *!* _CreateCallback() Local lcVarString As String m.lcVarString = "INTEGER,INTEGER,INTEGER,INTEGER" This. _CallBackPointer = CreateCallBackFunc("ctlhookproc","INTEGER", m.lcVarString, This) ENDPROC PROCEDURE _destroycallback *!* _DestroyCallback() DestroyCallbackFunc(This. _CallBackPointer) ENDPROC PROCEDURE _initlibrary *!* _InitLibrary() External Procedure ctl32.prg Do (Addbs(Justpath(This.ClassLibrary)) + "ctl32.prg") ENDPROC PROCEDURE _loadstring Lparameters pcResource, pnStringId As Integer Local ; lnModule As Integer, ; llReleaseLibrary As Boolean, ; lcString As String *!* Get module handle of user32 if it is loaded m.lnModule = apiGetModuleHandle(m.pcResource) *!* If not loaded, load it If m.lnModule = 0 Then m.llReleaseLibrary = TRUE m.lnModule = apiLoadLibrary(m.pcResource) Else m.llReleaseLibrary = FALSE Endif m.lcString = Replicate(NULA, 1024) m.lnStringLen = apiLoadString(m.lnModule, m.pnStringId, @m.lcString, Len(m.lcString)) m.lcString = Left(m.lcString, m.lnStringLen) If m.llReleaseLibrary = TRUE Then apiFreeLibrary(m.lnModule) Endif Return m.lcString ENDPROC PROCEDURE _resetproperties Local lcProperty With This For m.lnx = 1 To Alen(This._Properties, 1) If Left(This._Properties(m.lnx,1), 3) = "CTL" Then .AddProperty(This._Properties(m.lnx,1), ._Properties(m.lnx, 2)) Endif Endfor Endwith ENDPROC PROCEDURE _saveproperties Local lnPropertyCount, lnx Local Array aProperties(1) m.lnPropertyCount = Amembers(m.aProperties, This, 0) Dimension This._Properties(m.lnPropertyCount, 2) With This For m.lnx = 1 To m.lnPropertyCount ._Properties(m.lnx,1) = m.aProperties(m.lnx) If Left(._Properties(m.lnx,1), 3) = "CTL" Then ._Properties(m.lnx,2) = Getpem(This, m.aProperties(m.lnx)) Endif Endfor Endwith ENDPROC PROCEDURE _setproperties *!* _SetProperties() ENDPROC PROCEDURE lblname.Init Return FALSE ENDPROC ENDDEFINE DEFINE CLASS ctl32_controlbase AS container *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder *< OBJECTDATA: ObjPath="lblname" UniqueID="" Timestamp="" /> *< OBJECTDATA: ObjPath="ctlTextBox" UniqueID="" Timestamp="" /> #INCLUDE "ctl32.h" * *m: ctlautosize_assign *m: ctlbackcolor_assign *m: ctlbackgroundimagelayout_assign *m: ctlbackgroundimage_assign *m: ctlbackstyle_assign *m: ctlbordercolor_assign *m: ctlbottom_access *m: ctlcontrolsource_assign *m: ctlcreatecontrol && Forces the creation of the control, including the creation of the handle and any child controls. *m: ctlcreated_access *m: ctldefaultbackcolor_access *m: ctldefaultbordercolor_access *m: ctldefaultforecolor_access *m: ctldefaultheight_access *m: ctldefaultwidth_access *m: ctldispose && Releases all resources used by the control. *m: ctlenabled_assign *m: ctlfocused_access *m: ctlfontbold_assign *m: ctlfontcharset_assign *m: ctlfontitalic_assign *m: ctlfontname_assign *m: ctlfontsize_assign *m: ctlfontstrikethru_assign *m: ctlfontunderline_assign *m: ctlforecolor_assign *m: ctlhandle_access *m: ctlhide && Conceals the control from the user. *m: ctlhostformhwnd_access *m: ctlhosthwnd_access *m: ctlhwnd_access *m: ctlinit && Occurs when anobject is created, after the Init event. *m: ctlishandlecreated_access *m: ctllocationleft_access *m: ctllocationtop_access *m: ctlorientation_assign *m: ctlrecreatinghandle_access *m: ctlrefresh && Forces the control to invalidate its client area and immediately redraw itself and any child controls. *m: ctlresetbackcolor && Resets the ctlBackColor property to its default value. *m: ctlresetbordercolor && Resets the ctlBorderColor property to its default value. *m: ctlresetfont && Resets the Font... properties to its default values. *m: ctlresetforecolor && Resets the ctlForeColor property to its default value. *m: ctlright_access *m: ctlshow && Displays the control to the user. Showing the control is equivalent to setting the ctlVisible property to true. *m: ctlshowfocuscues_assign *m: ctlthemes_assign *m: ctlvaluechanged && Occurs when the ctlValue property changes. *m: ctlvalue_assign *m: ctlvisible_assign *m: _addobjects && Adds objects used by the class. *m: _bindevents && Binds to events used by the class. *m: _callbackproc *m: _create && Creates the windows control *m: _createbackgroundbrush && Creates a brush. *m: _createcallback *m: _destroycallback *m: _drawfocusrect && Draws a focus rectangle for controls that do not have one. *m: _formmessagehandler *m: _getdefaultfont *m: _getdefaultsize *m: _getdwexstyle *m: _getdwstyle *m: _getlpclassname *m: _getlpwindowname *m: _getpage && Returns an object reference to the page that contains this control. *m: _getpageframe *m: _initcommoncontrols *m: _initlibrary *m: _iscontrolinpage && Returns TRUE if the control is contained in a page. *m: _objtoclient && Replaces OBJTOCLIENT that has bugs. *m: _onformborderstyle *m: _onformpaint *m: _onformresize *m: _onmoved && Bindevent(This, "Moved", This, "_OnMoved", 1) *m: _onpageactivate && Bindevent(m.loControl, "Activate", This, "_OnPageActivate", 1) *m: _onpagedeactivate && Bindevent(m.loControl, "Deactivate", This, "_OnPageDeactivate", 1) *m: _onparentbackcolor *m: _onresize && Bindevent(This, "Resize", This, "_OnResize", 1) *m: _onthemes && Bindevent(_Screen, "Themes", This, "_OnThemes", 1) / Bindevent(Thisform, "Themes", This, "_OnThemes", 1) *m: _onvalue *m: _postcreate *m: _precreate *m: _reparent *m: _setautosize *m: _setbackcolor *m: _setbackstyle *m: _setbordercolor *m: _setcontrolsource *m: _setenabled *m: _setfont *m: _setforecolor *m: _setorientation *m: _setproperties *m: _setshowfocuscues *m: _setthemes *m: _setvalue *m: _setvisible *m: _updatecolors *m: _vfpmessagehandler *p: builderx *p: ctlautosize && Gets or sets a value indicating whether the height and/or width of the control is automatically sized. *p: ctlbackcolor && Gets or sets the background color for the control. *p: ctlbackgroundimage && Gets or sets the background image displayed in the control. *p: ctlbackgroundimagelayout && Gets or sets the background image layout. *p: ctlbackstyle && Specifies if the background of an object is transparent or opaque. *p: ctlbordercolor && Gets or sets the border color of the control. *p: ctlbottom && Gets the distance, in pixels, between the bottom edge of the control and the top edge of its container's client area. *p: ctlcanfocus && Specifies whether the control can receive focus. *p: ctlcontrolsource && Specifies the source of data to which an object is bound. *p: ctlcreated && Gets a value indicating whether the control has been created. *p: ctldefaultbackcolor && Gets the default background color of the control. *p: ctldefaultbordercolor && Gets the default border color of the control. *p: ctldefaultforecolor && Gets the default foreground color of the control. *p: ctldefaultheight && Gets the default height of the control. *p: ctldefaultwidth && Gets the default width of the control. *p: ctlenabled && Gets or sets a value indicating whether the control can respond to user interaction. *p: ctlfocused && Gets a value indicating whether the control has input focus. *p: ctlfontbold && Specifies if the text is bold. *p: ctlfontcharset && Specifies the character set, or language script, of the font. *p: ctlfontitalic && Specifies if the text is italic. *p: ctlfontname && Specifies the name of the font. *p: ctlfontsize && Specifies the size of the font *p: ctlfontstrikethru && Specifies if the text is strikethru. *p: ctlfontunderline && Specifies if the text is underline. *p: ctlforecolor && Gets or sets the foreground color of the control. *p: ctlhandle && Gets the window handle that the control is bound to. *p: ctlhostformhwnd && Specifies the window handle of the inner window of the parent form. *p: ctlhosthwnd && Gets the windows handle of the parent object of this control, if there is one. *p: ctlhwnd && DEPRECATED. Replaced by the .NET ctlHandle property. *p: ctlishandlecreated && Gets a value indicating whether the control has a handle associated with it. *p: ctllocationleft && Gets or sets the Left coordinate of the upper-left corner of the control relative to the upper-left corner of its container. (ObjToClient) *p: ctllocationtop && Gets or sets the Top coordinate of the upper-left corner of the control relative to the upper-left corner of its container. (ObjToClient) *p: ctlorientation && Gets or sets a value indicating the horizontal or vertical orientation of the control. *p: ctlrecreatinghandle && Gets a value indicating whether the control is currently re-creating its handle. *p: ctlright && Gets the distance, in pixels, between the right edge of the control and the left edge of its container's client area. (Left + Width) *p: ctlshowfocuscues && Gets or sets a value indicating whether the control should display focus rectangles. *p: ctlthemes && Specifies if themes are used for the control. *p: ctlvalue && Specifies the current value or state of the control. *p: ctlvisible && Gets or sets a value indicating whether the control is displayed. *p: _backgroundbrush && Handle to a GDI brush, passed to the control. *p: _callbackprocaddress *p: _clicktime && Stores seconds() for click event to detect double clicks. *p: _controlhasownfocuscue *p: _controlhwnd && hwnd of the control window. *p: _controlwindowprocaddress *p: _defaultheight *p: _defaultwidth *p: _enableupdates *p: _focused && Specifies if the control has the focus. *p: _focusstart && Specifies the time the control got focus, used by _FocusTimerTick. *p: _fontdefaultlogfont *p: _fonthandle *p: _hostformhwnd *p: _inpage && Specifies if the control is in a page, somewhere in its object tree. Used to show/hide the control when the page becomes active/inactive. *p: _memberdata && XML Metadata for customizable properties *p: _onvaluefired *p: _pageactive *p: _popup *p: _recreatinghandle *p: _visible && Set to FALSE to make container NEVER Visible * * BackColor = 140,200,200 builderx = ctlautosize = .T. ctlbackcolor = -1 ctlbackgroundimage = ctlbackgroundimagelayout = 0 ctlbackstyle = 1 ctlbordercolor = -1 ctlbottom = 0 ctlcanfocus = .F. ctlcontrolsource = ctlcreated = .F. ctldefaultbackcolor = 0 ctldefaultbordercolor = 0 ctldefaultforecolor = 0 ctldefaultheight = 0 ctldefaultwidth = 0 ctlenabled = .T. ctlfocused = .F. ctlfontbold = .F. ctlfontcharset = 1 ctlfontitalic = .F. ctlfontname = Default ctlfontsize = 0 ctlfontstrikethru = .F. ctlfontunderline = .F. ctlforecolor = -1 ctlhandle = 0 ctlhostformhwnd = 0 ctlhosthwnd = 0 ctlhwnd = 0 ctlishandlecreated = .F. ctllocationleft = 0 ctllocationtop = 0 ctlorientation = 0 ctlrecreatinghandle = .F. ctlright = 0 ctlshowfocuscues = .T. ctlthemes = .T. ctlvalue = 0 ctlvisible = .T. Height = 60 Name = "ctl32_controlbase" Width = 240 _backgroundbrush = 0 _callbackprocaddress = _clicktime = 0 _controlhasownfocuscue = .T. _controlhwnd = 0 _controlwindowprocaddress = _defaultheight = 0 _defaultwidth = 0 _enableupdates = .T. _focused = .F. _focusstart = 0 _fontdefaultlogfont = .F. _fonthandle = 0 _hostformhwnd = 0 _inpage = .F. _memberdata = _onvaluefired = .F. _pageactive = .F. _popup = .F. _recreatinghandle = .F. _visible = .T. * ADD OBJECT 'ctlTextBox' AS textbox WITH ; Height = 23, ; Left = 0, ; Name = "ctlTextBox", ; Top = 32000, ; Width = 100 *< END OBJECT: BaseClass="textbox" /> ADD OBJECT 'lblname' AS label WITH ; AutoSize = .T., ; BackStyle = 0, ; Caption = "ctl32_base", ; FontName = "Tahoma", ; FontSize = 8, ; ForeColor = 0,0,128, ; Left = 6, ; Name = "lblname", ; Top = 2 *< END OBJECT: BaseClass="label" /> PROCEDURE ctlautosize_assign *!* ctlAutoSize_Assign() Lparameters m.tuNewValue If Vartype(m.tuNewValue) = T_NUMERIC Then m.tuNewValue = m.tuNewValue # 0 Endif *!* Always do this *!* If This.ctlAutoSize # m.tuNewValue Then This.ctlAutoSize = m.tuNewValue This._SetAutoSize() *!* Endif ENDPROC PROCEDURE ctlbackcolor_assign *!* ctlBackColor_Assign(tuNewValue) Lparameters m.tuNewValue If Vartype(m.tuNewValue) # "N" m.tuNewValue = -1 Endif If m.tuNewValue > Rgb(255,255,255) Or m.tuNewValue < 0 Then m.tuNewValue = -1 Endif If This.ctlBackColor # m.tuNewValue Then This.ctlBackColor = m.tuNewValue This._SetBackColor() Endif ENDPROC PROCEDURE ctlbackgroundimagelayout_assign lparameters tuNewValue This.ctlBackgroundImageLayout = tuNewValue ENDPROC PROCEDURE ctlbackgroundimage_assign lparameters tuNewValue This.ctlBackgroundImage = tuNewValue ENDPROC PROCEDURE ctlbackstyle_assign *!* ctlBackStyle_Assign() Lparameters m.tuNewValue If m.tuNewValue # 0 Then m.tuNewValue = 1 Endif If This.ctlBackStyle # m.tuNewValue Then This.ctlBackStyle = m.tuNewValue This._SetBackStyle() Endif ENDPROC PROCEDURE ctlbordercolor_assign *!* ctlBorderColor_Assign() Lparameters m.tuNewValue If Vartype(m.tuNewValue) # "N" m.tuNewValue = -1 Endif If m.tuNewValue > Rgb(255,255,255) Or m.tuNewValue < 0 Then m.tuNewValue = -1 Endif If This.ctlBorderColor # m.tuNewValue Then This.ctlBorderColor = m.tuNewValue This._SetBorderColor() Endif ENDPROC PROCEDURE ctlbottom_access *!* ctlBottom_Access() Return This.Top + This.Height ENDPROC PROCEDURE ctlcontrolsource_assign Lparameters m.tuNewValue If Vartype(m.tuNewValue) = T_NUMERIC Then m.tuNewValue = m.tuNewValue # 0 Endif If This.ctlControlSource # m.tuNewValue Then This.ctlControlSource = m.tuNewValue This._SetControlSource() Endif ENDPROC PROCEDURE ctlcreatecontrol && Forces the creation of the control, including the creation of the handle and any child controls. *!* CreateControl() This._Create() ENDPROC PROCEDURE ctlcreated_access *!* ctlCreated_Access() Return This._ControlHwnd # 0 ENDPROC PROCEDURE ctldefaultbackcolor_access *!* ctlDefaultBackColor_Access() *!* ActiveBorder = COLOR_ACTIVEBORDER *!* ActiveCaption = COLOR_ACTIVECAPTION *!* ActiveCaptionText = COLOR_CAPTIONTEXT *!* AppWorkspace = COLOR_APPWORKSPACE *!* ButtonFace = COLOR_BTNFACE *!* ButtonHighlight = COLOR_BTNHIGHLIGHT *!* ButtonShadow = COLOR_BTNSHADOW *!* Control = COLOR_BTNFACE *!* ControlDark = COLOR_BTNSHADOW *!* ControlDarkDark = COLOR_3DDKSHADOW *!* ControlLight = COLOR_BTNHIGHLIGHT *!* ControlLightLight = COLOR_3DLIGHT *!* ControlText = COLOR_BTNTEXT *!* Desktop = COLOR_DESKTOP *!* GradientActiveCaption = COLOR_GRADIENTACTIVECAPTION *!* GradientInactiveCaption = COLOR_GRADIENTINACTIVECAPTION *!* GrayText = COLOR_GRAYTEXT *!* Highlight = COLOR_HIGHLIGHT *!* HighlightText = COLOR_HIGHLIGHTTEXT *!* HotTrack = COLOR_HOTLIGHT *!* InactiveBorder = COLOR_INACTIVEBORDER *!* InactiveCaption = COLOR_INACTIVECAPTION *!* InactiveCaptionText = COLOR_INACTIVECAPTIONTEXT *!* Info = COLOR_INFOBK *!* InfoText = COLOR_INFOTEXT *!* Menu = COLOR_MENU *!* MenuBar = COLOR_MENUBAR *!* MenuHighlight = COLOR_MENUHILIGHT *!* MenuText = COLOR_MENUTEXT *!* Scrollbar = COLOR_SCROLLBAR *!* Window = COLOR_WINDOW *!* WindowFrame = COLOR_WINDOWFRAME *!* WindowText = COLOR_WINDOWTEXT Local lnColor As Integer Do Case Case This._GetlpClassName() = TRACKBAR_CLASSA m.lnColor = apiGetSysColor(COLOR_BTNFACE) && Control Case This._GetlpClassName() = PROGRESS_CLASSA m.lnColor = apiGetSysColor(COLOR_BTNFACE) && Control Case This._GetlpClassName() = MONTHCAL_CLASSA m.lnColor = apiGetSysColor(COLOR_WINDOW) && Window Case This._GetlpClassName() = TOOLTIPS_CLASSA m.lnColor = apiGetSysColor(COLOR_INFOBK) && Info Otherwise m.lnColor = 0 Endcase Return m.lnColor ENDPROC PROCEDURE ctldefaultbordercolor_access *!* ctlDefaultBorderColor_Access() *!* ActiveBorder = COLOR_ACTIVEBORDER *!* ActiveCaption = COLOR_ACTIVECAPTION *!* ActiveCaptionText = COLOR_CAPTIONTEXT *!* AppWorkspace = COLOR_APPWORKSPACE *!* ButtonFace = COLOR_BTNFACE *!* ButtonHighlight = COLOR_BTNHIGHLIGHT *!* ButtonShadow = COLOR_BTNSHADOW *!* Control = COLOR_BTNFACE *!* ControlDark = COLOR_BTNSHADOW *!* ControlDarkDark = COLOR_3DDKSHADOW *!* ControlLight = COLOR_BTNHIGHLIGHT *!* ControlLightLight = COLOR_3DLIGHT *!* ControlText = COLOR_BTNTEXT *!* Desktop = COLOR_DESKTOP *!* GradientActiveCaption = COLOR_GRADIENTACTIVECAPTION *!* GradientInactiveCaption = COLOR_GRADIENTINACTIVECAPTION *!* GrayText = COLOR_GRAYTEXT *!* Highlight = COLOR_HIGHLIGHT *!* HighlightText = COLOR_HIGHLIGHTTEXT *!* HotTrack = COLOR_HOTLIGHT *!* InactiveBorder = COLOR_INACTIVEBORDER *!* InactiveCaption = COLOR_INACTIVECAPTION *!* InactiveCaptionText = COLOR_INACTIVECAPTIONTEXT *!* Info = COLOR_INFOBK *!* InfoText = COLOR_INFOTEXT *!* Menu = COLOR_MENU *!* MenuBar = COLOR_MENUBAR *!* MenuHighlight = COLOR_MENUHILIGHT *!* MenuText = COLOR_MENUTEXT *!* Scrollbar = COLOR_SCROLLBAR *!* Window = COLOR_WINDOW *!* WindowFrame = COLOR_WINDOWFRAME *!* WindowText = COLOR_WINDOWTEXT Local lnColor As Integer Do Case *!* Case This._GetlpClassName() = TRACKBAR_CLASSA *!* m.lnColor = apiGetSysColor() Case This._GetlpClassName() = PROGRESS_CLASSA m.lnColor = apiGetSysColor(COLOR_BTNSHADOW) Case This._GetlpClassName() = MONTHCAL_CLASSA m.lnColor = apiGetSysColor(COLOR_WINDOW) && Window *!* *!* Case This._GetlpClassName() = TOOLTIPS_CLASSA *!* m.lnColor = apiGetSysColor() Otherwise m.lnColor = 0 Endcase Return m.lnColor ENDPROC PROCEDURE ctldefaultforecolor_access *!* ctlDefaultForeColor_Access() *!* ActiveBorder = COLOR_ACTIVEBORDER *!* ActiveCaption = COLOR_ACTIVECAPTION *!* ActiveCaptionText = COLOR_CAPTIONTEXT *!* AppWorkspace = COLOR_APPWORKSPACE *!* ButtonFace = COLOR_BTNFACE *!* ButtonHighlight = COLOR_BTNHIGHLIGHT *!* ButtonShadow = COLOR_BTNSHADOW *!* Control = COLOR_BTNFACE *!* ControlDark = COLOR_BTNSHADOW *!* ControlDarkDark = COLOR_3DDKSHADOW *!* ControlLight = COLOR_BTNHIGHLIGHT *!* ControlLightLight = COLOR_3DLIGHT *!* ControlText = COLOR_BTNTEXT *!* Desktop = COLOR_DESKTOP *!* GradientActiveCaption = COLOR_GRADIENTACTIVECAPTION *!* GradientInactiveCaption = COLOR_GRADIENTINACTIVECAPTION *!* GrayText = COLOR_GRAYTEXT *!* Highlight = COLOR_HIGHLIGHT *!* HighlightText = COLOR_HIGHLIGHTTEXT *!* HotTrack = COLOR_HOTLIGHT *!* InactiveBorder = COLOR_INACTIVEBORDER *!* InactiveCaption = COLOR_INACTIVECAPTION *!* InactiveCaptionText = COLOR_INACTIVECAPTIONTEXT *!* Info = COLOR_INFOBK *!* InfoText = COLOR_INFOTEXT *!* Menu = COLOR_MENU *!* MenuBar = COLOR_MENUBAR *!* MenuHighlight = COLOR_MENUHILIGHT *!* MenuText = COLOR_MENUTEXT *!* Scrollbar = COLOR_SCROLLBAR *!* Window = COLOR_WINDOW *!* WindowFrame = COLOR_WINDOWFRAME *!* WindowText = COLOR_WINDOWTEXT Local lnColor As Integer Do Case Case This._GetlpClassName() = TRACKBAR_CLASSA m.lnColor = apiGetSysColor(COLOR_WINDOWTEXT) && WindowText Case This._GetlpClassName() = PROGRESS_CLASSA m.lnColor = apiGetSysColor(COLOR_HIGHLIGHT) && Highlight Case This._GetlpClassName() = MONTHCAL_CLASSA m.lnColor = apiGetSysColor(COLOR_WINDOWTEXT) && WindowText Case This._GetlpClassName() = TOOLTIPS_CLASSA m.lnColor = apiGetSysColor(COLOR_INFOTEXT) && InfoText Otherwise m.lnColor = 0 Endcase Return m.lnColor ENDPROC PROCEDURE ctldefaultheight_access *!* ctlDefaultHeight_Access() Return This.ctlDefaultHeight ENDPROC PROCEDURE ctldefaultwidth_access *!* ctlDefaultWidth_Access() Return This.ctlDefaultWidth ENDPROC PROCEDURE ctldispose && Releases all resources used by the control. *!* ctlDispose() If This._ControlHwnd # 0 Then *!* if we have saved the old window procedure If This._ControlWindowProcAddress # 0 Then *!* Restore original window procedure apiSetWindowLong(This._ControlHwnd, GWL_WNDPROC, This._ControlWindowProcAddress) This._ControlWindowProcAddress = 0 Endif apiDestroyWindow(This._ControlHwnd) Endif If This._BackGroundBrush # 0 Then apiDeleteObject(This._BackGroundBrush) Endif If This._FontHandle # 0 Then apiDeleteObject(This._FontHandle) Endif This._FontDefaultLogFont = .Null. This._DestroyCallBack() ENDPROC PROCEDURE ctlenabled_assign *!* ctlEnabled_Assign() Lparameters m.tuNewValue If Vartype(m.tuNewValue) = T_NUMERIC Then m.tuNewValue= m.tuNewValue # 0 Endif If This.ctlEnabled # m.tuNewValue Then This.ctlEnabled = m.tuNewValue This._SetEnabled() Endif ENDPROC PROCEDURE ctlfocused_access *!* ctlFocused_Access() Return This._Focused ENDPROC PROCEDURE ctlfontbold_assign *!* ctlFontBold_Assign(lValue) Lparameters m.tuNewValue If Vartype(m.tuNewValue) = T_NUMERIC Then m.tuNewValue = m.tuNewValue # 0 Endif This.ctlFontBold = m.tuNewValue This._SetFont() ENDPROC PROCEDURE ctlfontcharset_assign *!* ctlFontCharSet_Assign(lValue) Lparameters m.tuNewValue This.ctlFontCharSet = m.tuNewValue This._SetFont() ENDPROC PROCEDURE ctlfontitalic_assign *!* ctlFontItalic_Assign(lValue) Lparameters m.tuNewValue If Vartype(m.tuNewValue) = T_NUMERIC Then m.tuNewValue = m.tuNewValue # 0 Endif This.ctlFontItalic = m.tuNewValue This._SetFont() ENDPROC PROCEDURE ctlfontname_assign *!* ctlFontName_Assign(tuNewValue) Lparameters m.tuNewValue This.ctlFontName = m.tuNewValue This._SetFont() ENDPROC PROCEDURE ctlfontsize_assign *!* ctlFontSize_Assign(lValue) Lparameters m.tuNewValue This.ctlFontSize = m.tuNewValue This._SetFont() ENDPROC PROCEDURE ctlfontstrikethru_assign *!* ctlFontStrikethru_Assign(lValue) Lparameters m.tuNewValue If Vartype(m.tuNewValue) = T_NUMERIC Then m.tuNewValue = m.tuNewValue # 0 Endif This.ctlFontStrikethru = m.tuNewValue This._SetFont() ENDPROC PROCEDURE ctlfontunderline_assign *!* ctlFontUnderline_Assign(lValue) Lparameters m.tuNewValue If Vartype(m.tuNewValue) = T_NUMERIC Then m.tuNewValue = m.tuNewValue # 0 Endif This.ctlFontUnderline = m.tuNewValue This._SetFont() ENDPROC PROCEDURE ctlforecolor_assign *!* ctlForeColor_Assign(tuNewValue) Lparameters m.tuNewValue If Vartype(m.tuNewValue) # "N" m.tuNewValue = -1 Endif If m.tuNewValue > Rgb(255,255,255) Or m.tuNewValue < 0 Then m.tuNewValue = -1 Endif If This.ctlForeColor # m.tuNewValue Then This.ctlForeColor = m.tuNewValue This._SetForeColor() Endif ENDPROC PROCEDURE ctlhandle_access *!* ctlHandle_Access() Return This._ControlHwnd ENDPROC PROCEDURE ctlhide && Conceals the control from the user. *!* ctlHide() This.ctlVisible = FALSE ENDPROC PROCEDURE ctlhostformhwnd_access *!* ctlHostFormhWnd_Access() *!* Gets hWnd of form or form inner window If This._HostFormhWnd = 0 Then This._HostFormhWnd = ctlGetHostHWnd(This) Endif Return This._HostFormhWnd ENDPROC PROCEDURE ctlhosthwnd_access *!* ctlHostHwnd_Access() If This.ctlHostHwnd = 0 Then This.ctlHostHwnd = ctlGetHostHwnd(This) Endif Return This.ctlHostHwnd ENDPROC PROCEDURE ctlhwnd_access *!* ctlHwnd_Access() Return This._ControlHwnd ENDPROC PROCEDURE ctlinit && Occurs when anobject is created, after the Init event. ENDPROC PROCEDURE ctlishandlecreated_access *!* ctlIsHandleCreated_Access() Return This._ControlHwnd # 0 ENDPROC PROCEDURE ctllocationleft_access *!* ctlLocationLeft_Access() Return This._ObjToClient("Left") ENDPROC PROCEDURE ctllocationtop_access *!* ctlLocationTop_Access() Return This._ObjToClient("Top") ENDPROC PROCEDURE ctlorientation_assign *!* ctlOrientation_Assign() Lparameters m.tuNewValue If m.tuNewValue # 0 Then m.tuNewValue = 1 Endif If This.ctlOrientation # m.tuNewValue Then This.ctlOrientation = m.tuNewValue This._SetOrientation() Endif ENDPROC PROCEDURE ctlrecreatinghandle_access *!* ctlRecreatingHandle_Access() Return This._RecreatingHandle ENDPROC PROCEDURE ctlrefresh && Forces the control to invalidate its client area and immediately redraw itself and any child controls. *!* ctlRefresh() Local lnFlags As Integer If This._ControlhWnd = 0 Then Return Endif Do Case Case This._GetlpClassName() = "msctls_trackbar32" *!* trackbar only refreshes with this: apiSendMessageInteger(This._ControlhWnd, WM_SETFOCUS, 0, 0) Otherwise m.lnFlags = Bitor(RDW_ERASE, RDW_FRAME, RDW_INTERNALPAINT, RDW_INVALIDATE, RDW_UPDATENOW, RDW_NOCHILDREN) apiRedrawWindow(This._ControlhWnd, "", 0, m.lnFlags) Endcase ENDPROC PROCEDURE ctlresetbackcolor && Resets the ctlBackColor property to its default value. *!* ctlResetBackColor() This.ctlBackColor = THis.ctlDefaultBackColor ENDPROC PROCEDURE ctlresetbordercolor && Resets the ctlBorderColor property to its default value. *!* ctlResetBorderColor() This.ctlBorderColor = This.ctlDefaultBorderColor ENDPROC PROCEDURE ctlresetfont && Resets the Font... properties to its default values. *!* ctlResetFont() This._EnableUpdates = FALSE This.ctlFontBold = This._FontDefaultLogFont.FontBold This.ctlFontCharSet = This._FontDefaultLogFont.FontCharSet This.ctlFontItalic = This._FontDefaultLogFont.FontItalic This.ctlFontName = This._FontDefaultLogFont.FontName This.ctlFontSize = This._FontDefaultLogFont.FontSize This.ctlFontStrikethru = This._FontDefaultLogFont.FontStrikethru This.ctlFontUnderline = This._FontDefaultLogFont.FontUnderline This._EnableUpdates = TRUE This._SetFont() ENDPROC PROCEDURE ctlresetforecolor && Resets the ctlForeColor property to its default value. *!* ctlResetForeColor() This.ctlForeColor = This.ctlDefaultForeColor ENDPROC PROCEDURE ctlright_access *!* ctlRight_Access() Return This.Left + This.Width ENDPROC PROCEDURE ctlshow && Displays the control to the user. Showing the control is equivalent to setting the ctlVisible property to true. *!* ctlShow() This.ctlVisible = TRUE ENDPROC PROCEDURE ctlshowfocuscues_assign *!* ctlShowFocusCues_Assign(lExpression) Lparameters m.tuNewValue If Vartype(m.tuNewValue) = T_NUMERIC Then m.tuNewValue = m.tuNewValue # 0 Endif If This.ctlShowFocusCues # m.tuNewValue Then This.ctlShowFocusCues = m.tuNewValue This._SetShowFocusCues() Endif ENDPROC PROCEDURE ctlthemes_assign *!* ctlThemes_Assign(lExpression) Lparameters m.tuNewValue If Vartype(m.tuNewValue) = T_NUMERIC Then m.tuNewValue = m.tuNewValue # 0 Endif If This.ctlThemes # m.tuNewValue Then This.ctlThemes = m.tuNewValue This._SetThemes() Endif ENDPROC PROCEDURE ctlvaluechanged && Occurs when the ctlValue property changes. *!* ctlValueChanged() ENDPROC PROCEDURE ctlvalue_assign *!* ctlValue_Assign(nValue) Lparameters m.tuNewValue If Type("This.ctlMaximum") = T_NUMERIC Then m.tuNewValue = Min(This.ctlMaximum, m.tuNewValue) Endif If Type("This.ctlMinimum") = T_NUMERIC Then m.tuNewValue = Max(This.ctlMinimum, m.tuNewValue) Endif If This.ctlValue # m.tuNewValue Then This.ctlValue = m.tuNewValue This._SetValue() Endif ENDPROC PROCEDURE ctlvisible_assign *!* ctlVisible_Assign(lValue) Lparameters m.tuNewValue If Vartype(m.tuNewValue) = T_NUMERIC Then m.tuNewValue = m.tuNewValue # 0 Endif If This.ctlVisible # m.tuNewValue Then This.ctlVisible = m.tuNewValue This._SetVisible() Endif ENDPROC PROCEDURE Destroy *!* Destroy() *!* DO NOT REMOVE THIS COMMENTS OR BINDEVENT DOES NOT WORK! *!* SOMETHING MUST BE HERE, EVEN A COMMENT, FOR BINDEVENT TO WORK. ENDPROC PROCEDURE Init *!* Init() *!* This parameter is passed from host ctl32 control Lparameters m.tnParam _vfp.AutoYield = FALSE This.Visible = This._Visible This._InitLibrary() This._InitCommonControls() This._SetProperties() This._AddObjects() This._SetControlSource() This._SetEnabled() This._BindEvents() This._CreateCallBack() *!* If we have a parameter, some other ctl32 control is parent, do no create control *!* Let parent call ctlCreate() If Vartype(m.tnParam) = T_LOGICAL Then This._Create() Endif Raiseevent(This, "ctlInit") ENDPROC PROCEDURE _addobjects && Adds objects used by the class. *!* _AddObjects() This._FontDefaultLogFont = Createobject("_LOGFONT") ENDPROC PROCEDURE _bindevents && Binds to events used by the class. *!* _BindEvents() *!* Instead of writing code in this events, we bind to them *!* just in case code is added in subclasses without a dodefault Bindevent(This, "Destroy", This, "ctlDispose") *!* Manage resize and move of the control: Bindevent(This, "Resize", This, "_OnResize", 1) Bindevent(This, "Moved", This, "_OnMoved", 1) *!* manage value changes of the control source *Bindevent(This.ctlTextBox, "ProgrammaticChange", This, "_OnProgrammaticChange", 1) Bindevent(This.ctlTextBox, "Value", This, "_OnValue", 1) *!* Manage theme changing Bindevent(_Screen, "Themes", This, "_OnThemes", 1) If Thisform.Name # _Screen.Name Then Bindevent(Thisform, "Themes", This, "_OnThemes", 1) Endif *!* We will create a background brush here Bindevent(Thisform, "Paint", This, "_OnFormPaint", 1) *!* If we have pages in the object hierarchy, monitor page activate/deactive *!* to hide/show the windows control If This._InPage = TRUE Local loPage As Control m.loPage = This._GetPage() Bindevent(m.loPage, "Activate", This, "_OnPageActivate", 1) Bindevent(m.loPage, "Deactivate", This, "_OnPageDeactivate", 1) m.loPage = .Null. Release m.loPage Endif *!* Add BindWindowsEventsProxy property to Form : If Not Pemstatus(Thisform,"BindWindowsEventsProxy", 5) Thisform.Newobject("BindWindowsEventsProxy", "BindWindowsEventsProxy", Addbs(Justpath(This.ClassLibrary)) + "vfpx.vcx") Endif *!* Bind to general window messages proxy: Bindevent(Thisform.BindWindowsEventsProxy, "_Msg", This, "_FormMessageHandler", 1) *!* This will tell us when there is a mouse click in a control Bindevent(This.ctlHostFormhWnd, WM_PARENTNOTIFY, Thisform.BindWindowsEventsProxy , "_MsgHandler", 4) *!* This is to pass a background brush for trackbars Bindevent(This.ctlHostFormhWnd, WM_CTLCOLORSTATIC, Thisform.BindWindowsEventsProxy , "_MsgHandler", 4) *!* This is to pass a background brush for scrollbars *!*Bindevent(This.ctlHostFormhWnd, WM_CTLCOLORSCROLLBAR, Thisform.BindWindowsEventsProxy , "_MsgHandler", 4) Bindevent(This.ctlHostFormhWnd, WM_TIMER, Thisform.BindWindowsEventsProxy , "_MsgHandler", 4) *!* Add BindWindowsEventsProxy property to _VFP : If Not Pemstatus(_vfp, "BindWindowsEventsProxy", 5) AddProperty(_vfp, "BindWindowsEventsProxy", .Null.) Endif *!* Create BindWindowsEventsProxy object: If Not Vartype(_vfp.BindWindowsEventsProxy) = "O" _vfp.BindWindowsEventsProxy = Newobject("BindWindowsEventsProxy", Addbs(Justpath(This.ClassLibrary)) + "vfpx.vcx") Endif *!* Bind to BindWindowsEventsProxy _Msg property changes: Bindevent(_vfp.BindWindowsEventsProxy, "_Msg", This,"_VFPMessageHandler") ENDPROC PROCEDURE _callbackproc *!* _CallbackProc Lparameters nHWnd As Integer, Msg As Integer, wParam As Integer, Lparam As Integer *!* Debugout m.nHWnd, m.Msg, m.wParam, m.Lparam Do Case Case m.Msg = WM_SETFOCUS This._Focused = TRUE If This._ControlHasOwnFocusCue = FALSE And This.ctlShowFocusCues = TRUE Then This._DrawFocusRect() Endif Case m.Msg = WM_KILLFOCUS This._Focused = FALSE If This._ControlHasOwnFocusCue = FALSE AND This.ctlShowFocusCues = TRUE Then This._DrawFocusRect() Endif Case m.Msg = WM_CHAR Local lnKeyShift *!* SHIFT KEY m.lnKeyShift = Bitand(apiGetKeyState(VK_SHIFT), 0x8000) Do Case Case m.wParam = 9 And m.lnKeyShift # 0 apiSetfocus(Thisform.HWnd) Keyboard '{LEFTARROW}' Plain Case m.wParam = 9 apiSetfocus(Thisform.HWnd) Keyboard '{TAB}' Plain Case m.wParam = 13 apiSetfocus(Thisform.HWnd) Keyboard '{ENTER}' Plain Case m.wParam = 27 apiSetfocus(Thisform.HWnd) Keyboard '{ESC}' Plain *!* reset Focus to control window If This.ctlCanFocus Then apiSetfocus(This._ControlHwnd) Endif Endcase Endcase Return apiCallWindowProc(This._ControlWindowProcAddress, m.nHWnd, m.Msg, m.wParam, m.Lparam) ENDPROC PROCEDURE _create && Creates the windows control *!* _Create() If This._ControlHwnd # 0 Then *!* if we have saved the old window procedure If This._ControlWindowProcAddress # 0 Then *!* Restore original window procedure apiSetWindowLong(This._ControlHwnd, GWL_WNDPROC, This._ControlWindowProcAddress) This._ControlWindowProcAddress = 0 Endif apiDestroyWindow(This._ControlHwnd) Endif This._SetBackStyle() This._PreCreate() Local ; dwExStyle As Integer, ; lpClassName As String, ; lpWindowName As String, ; dwStyle As Integer, ; lnTop As Integer, ; lnLeft As Integer, ; nWidth As Integer, ; nHeight As Integer, ; hWndParent As Integer, ; hMenu As Integer, ; hInstance As Integer, ; lpParam As Integer If This._RecreatingHandle Then Return Endif *!* We enter Initialization Stage... This._RecreatingHandle = TRUE *!* Define parameters for apiCreateWindowEx: m.dwExStyle = This._GetdwExStyle() m.lpClassName = This._GetlpClassName() m.lpWindowName = This._GetlpWindowName() m.dwStyle = This._GetdwStyle() m.lnLeft = This.ctlLocationLeft m.lnTop = This.ctlLocationTop If This._PopUp = TRUE Then ctlClientToScreen(This.ctlHostHwnd, @m.lnLeft, @m.lnTop) Endif m.nWidth = This.Width m.nHeight = This.Height m.hWndParent = This.ctlHostHwnd m.hMenu = 0 m.hInstance = 0 m.lpParam = 0 This._ControlHwnd = apiCreateWindowEx( ; m.dwExStyle, ; m.lpClassName, ; m.lpWindowName, ; m.dwStyle, ; m.lnLeft, ; m.lnTop, ; m.nWidth, ; m.nHeight, ; m.hWndParent, ; m.hMenu, ; m.hInstance, ; m.lpParam) *!* Here we subclass the control window procedure This._ControlWindowProcAddress = apiSetWindowLong(This._ControlHwnd, GWL_WNDPROC, This._CallbackProcAddress) *!* Debugout This._ControlWindowProcAddress, This._CallbackProcAddress This._GetDefaultFont() This._GetDefaultSize() This._PostCreate() This._SetValue() This._SetThemes() This._SetEnabled() This._SetVisible() *!* We finish Initialization State This._RecreatingHandle = FALSE ENDPROC PROCEDURE _createbackgroundbrush && Creates a brush. *!* _CreateBackGroundBrush() *!* Here we create a background brush. *!* If the control is on a themed Pageframe, this brush is a bitmap *!* 1 pixel wide, and tall as the control, we use the column of pixels *!* just to the left of the control. *!* Get rid of current BackGround Brush If This._BackGroundBrush # 0 Then apiDeleteObject(This._BackGroundBrush) This._BackGroundBrush = 0 Endif Local loPageFrame As PageFrame m.loPageFrame = This._GetPageFrame() Do Case Case This.ctlBackStyle = 0 And This._InPage And ctlIsThemeActive(m.loPageFrame) Local lnTempDc, lnBitmap, lnCompatDc m.lnTempDc = apiGetDc(Thisform.HWnd) m.lnBitmap = apiCreateCompatibleBitmap(m.lnTempDc, 1, This.Height) m.lnCompatDc = apiCreateCompatibleDC(m.lnTempDc) apiSelectObject(m.lnCompatDc, m.lnBitmap) apiBitBlt(m.lnCompatDc, 0, 0, 1, This.Height, m.lnTempDc, Objtoclient(This, 2) - 1, Objtoclient(This, 1), SRCCOPY) This._BackGroundBrush = apiCreatePatternBrush(m.lnBitmap) apiReleaseDc(Thisform.HWnd, m.lnTempDc) apiDeleteObject(m.lnBitmap) apiDeleteObject(m.lnCompatDc) m.loPageFrame = .Null. Release m.loPageFrame Case This.ctlBackStyle = 0 If Type("This.Parent.BackColor") # T_UNDEFINED This._BackGroundBrush = apiCreateSolidBrush(This.Parent.BackColor) Else This._BackGroundBrush = apiCreateSolidBrush(Thisform.BackColor) Endif Case This.ctlBackStyle = 1 And This.ctlBackColor = -1 This._BackGroundBrush = apiCreateSolidBrush(This.ctlDefaultBackColor) Otherwise This._BackGroundBrush = apiCreateSolidBrush(This.ctlBackColor) Endcase ENDPROC PROCEDURE _createcallback *!* _CreateCallback() This._CallbackProcAddress = CREATECALLBACKFUNC("_CallbackProc", "INTEGER","INTEGER,INTEGER,INTEGER,INTEGER", This, 1) ENDPROC PROCEDURE _destroycallback *!* _DestroyCallback() If This._CallbackProcAddress # 0 Then DestroyCallbackFunc(This._CallbackProcAddress) Endif ENDPROC PROCEDURE _drawfocusrect && Draws a focus rectangle for controls that do not have one. *!* _DrawFocusRect() Local ; lnx, ; lny, ; lnx1, ; lny1, ; lnx2, ; lny2, ; lnDrawWidth, ; lnDrawMode m.lnDrawWidth = Thisform.DrawWidth m.lnDrawMode = Thisform.DrawMode Thisform.DrawWidth = 1 Thisform.DrawMode = 6 m.lnx1 = This.Left - 1 m.lnx2 = This.Left + This.Width m.lny1 = This.Top - 1 m.lny2 = This.Top + This.Height For m.lnx = m.lnx1 To m.lnx2 Step 2 Thisform.Line(m.lnx, m.lny1, m.lnx + 1, m.lny1) Endfor For m.lnx = m.lnx1 + Mod(m.lny2 - m.lny1, 2) To m.lnx2 Step 2 Thisform.Line(m.lnx, m.lny2, m.lnx + 1, m.lny2) Endfor For m.lny = m.lny1 + 2 To m.lny2 - 1 Step 2 Thisform.Line(m.lnx1, m.lny, m.lnx1, m.lny + 1 ) Endfor For m.lny = m.lny1 + 2 - Mod(m.lnx2 - m.lnx1, 2) To m.lny2 - 1 Step 2 Thisform.Line(m.lnx2, m.lny, m.lnx2, m.lny + 1 ) Endfor Thisform.DrawWidth = m.lnDrawWidth Thisform.DrawMode = m.lnDrawMode ENDPROC PROCEDURE _formmessagehandler *!* _FormMessageHandler() Do Case Case Thisform.BindWindowsEventsProxy._Msg = WM_PARENTNOTIFY Local lnX, lnY, lcPoint *!* If we have a mouse click If This.ctlEnabled And Inlist(Thisform.BindWindowsEventsProxy._wParam, WM_LBUTTONDOWN, WM_RBUTTONDOWN, WM_MBUTTONDOWN) *!* Get mouse click coordinates in pixels relative to form: m.lnX = ctlLoWord(Thisform.BindWindowsEventsProxy._lParam) m.lnY = ctlHiWord(Thisform.BindWindowsEventsProxy._lParam) *!* Check if control window is under that point: *!* We can only get this messages from visible windows If This.ctlVisible = TRUE ; And Between(m.lnX, This.ctlLocationLeft, This.ctlLocationLeft + This.Width) ; And Between(m.lnY, This.ctlLocationTop, This.ctlLocationTop + This.Height) Then If This.ctlCanFocus Then If This.ctlTextbox.ctlFocused = FALSE Then This.SetFocus() Endif apiSetFocus(This._ControlHwnd) Endif *!* Raise click/rightclick/middleclick event Do Case *!* special case if this is a monthcalendar control Case Thisform.BindWindowsEventsProxy._wParam = WM_LBUTTONDOWN And This._GetlpClassName() == MONTHCAL_CLASSA Local ; loMcHitTestInfo As _MCHITTESTINFO, ; lcMcHitTestInfo As String, ; loPoint As _POINT, ; lcPoint As String m.loMcHitTestInfo = Newobject("_MCHITTESTINFO") m.loPoint = Newobject("_POINT") m.lcPoint = m.loPoint.Value *!* Get mouse position in monthcalendar window coordinates: apiGetCursorPos(@m.lcPoint) apiScreenToClient(This._ControlHwnd, @m.lcPoint) m.loPoint.Value = m.lcPoint *!* Set coordinates of structure m.loMcHitTestInfo.pt.X = m.loPoint.X m.loMcHitTestInfo.pt.Y = m.loPoint.Y *!* Send MCM_HITTEST message to get where click was *m.lcMcHitTestInfo = m.loMcHitTestInfo.Value apiSendMessageInteger(This._ControlHwnd, MCM_HITTEST, 0, m.loMcHitTestInfo.Address) *m.loMcHitTestInfo.Value = m.lcMcHitTestInfo *?This._ControlHwnd,m.loMcHitTestInfo.uHit, MCHT_CALENDARDATE, MCHT_TODAYLINK If Seconds() - This._ClickTime < apiGetDoubleClickTime() / 1000 Then *!* Only raise DblClick if clicked on day or today If Inlist(m.loMcHitTestInfo.uHit, MCHT_CALENDARDATE, MCHT_TODAYLINK) Then Raiseevent(This, "DblClick") Endif Else This._ClickTime = Seconds() Raiseevent(This, "Click") Endif m.loMcHitTestInfo = .Null. m.lcPoint = .Null. Case Thisform.BindWindowsEventsProxy._wParam = WM_LBUTTONDOWN If Seconds() - This._ClickTime < apiGetDoubleClickTime() / 1000 Then Raiseevent(This, "DblClick") Else This._ClickTime = Seconds() Raiseevent(This, "Click") Endif Case Thisform.BindWindowsEventsProxy._wParam = WM_RBUTTONDOWN Raiseevent(This, "RightClick") Case Thisform.BindWindowsEventsProxy._wParam = WM_MBUTTONDOWN Raiseevent(This, "MiddleClick") Endcase Endif Endif Case Thisform.BindWindowsEventsProxy._Msg = WM_CTLCOLORSTATIC *!* here we provide a background brush *!* If the message is not for this control, just return If Thisform.BindWindowsEventsProxy._lParam = This._ControlHwnd Then *!* Return a background brush (Brush can just be 0) Thisform.BindWindowsEventsProxy._Result = This._BackGroundBrush Endif Endcase ENDPROC PROCEDURE _getdefaultfont *!* _GetDefaultFont() *!* This saves the default font of the control If This._ControlHwnd = 0 Then Return Endif Local ; lnFontHandle As Integer, ; lcLogFont As String *!* Get a handle to the current font m.lnFontHandle = apiSendMessageInteger(This._ControlHwnd, WM_GETFONT, 0, 0) *!* Get a LogFont structure m.lcLogFont = This._FontDefaultLogFont.Value *!* Get font info from font handle apiGetObject(m.lnFontHandle, Len(m.lcLogFont), @m.lcLogFont) *!* Save LogFont structure This._FontDefaultLogFont.Value = m.lcLogFont *!* Fix MonthCalendar UGLY default non-themed font: If This._GetlpClassName() = MONTHCAL_CLASSA Then If ctlGetOsVersion() < CON_OS_WINVISTA Then This._FontDefaultLogFont.FontName = "Tahoma" Else This._FontDefaultLogFont.FontBold = FALSE This._FontDefaultLogFont.FontName = "Segoe UI" This._FontDefaultLogFont.FontSize = 8 Endif Endif This._EnableUpdates = FALSE *!* Now set value of default properties: If Sys(1269, This, "ctlFontBold", 0) = FALSE Then This.ctlFontBold = This._FontDefaultLogFont.FontBold Endif If Sys(1269, This, "ctlFontCharSet", 0) = FALSE Then This.ctlFontCharSet = This._FontDefaultLogFont.FontCharSet Endif If Sys(1269, This, "ctlFontStrikethru", 0) = FALSE Then This.ctlFontItalic = This._FontDefaultLogFont.FontItalic Endif If Sys(1269, This, "ctlFontName", 0) = FALSE This.ctlFontName = This._FontDefaultLogFont.FontName Endif If Sys(1269, This, "ctlFontSize", 0) = FALSE Then This.ctlFontSize = This._FontDefaultLogFont.FontSize Endif If Sys(1269, This, "ctlFontStrikethru", 0) = FALSE Then This.ctlFontStrikethru = This._FontDefaultLogFont.FontStrikethru Endif If Sys(1269, This, "ctlFontUnderline", 0) = FALSE Then This.ctlFontUnderline = This._FontDefaultLogFont.FontUnderline Endif This._EnableUpdates = TRUE This._SetFont() ENDPROC PROCEDURE _getdefaultsize *!* _GetDefaultSize() ENDPROC PROCEDURE _getdwexstyle *!* _GetdwExStyle() Return 0 ENDPROC PROCEDURE _getdwstyle *!* _GetdwStyle Return 0 ENDPROC PROCEDURE _getlpclassname *!* _GetlpClassName() ENDPROC PROCEDURE _getlpwindowname *!* _GetWindowName Return "" ENDPROC PROCEDURE _getpage && Returns an object reference to the page that contains this control. *!* _GetPage() Local loControl As Control m.loControl = This Do While Inlist(Upper(m.loControl.BaseClass), "FORM", "TOOLBAR") = FALSE If Upper(m.loControl.BaseClass) == "PAGE" Then Exit Endif m.loControl = m.loControl.Parent Enddo Return m.loControl ENDPROC PROCEDURE _getpageframe *!* _GetPageFrame() Local loControl as Control m.loControl = This Do While Inlist(Upper(m.loControl.BaseClass), "FORM", "TOOLBAR") = FALSE If Upper(m.loControl.BaseClass) == "PAGEFRAME" Then Exit Endif m.loControl = m.loControl.Parent Enddo Return m.loControl ENDPROC PROCEDURE _initcommoncontrols *!* _InitCommonControls() Local lcControls As String *!* This is needed to make the month calendar common control work in windows 2000 If Type("_Screen._0BCB895540F84134BDF39BB58FE0D43F") = T_UNDEFINED Then _Screen.AddProperty("_0BCB895540F84134BDF39BB58FE0D43F", TRUE) m.lcControls = BinToC(8, "4rs") + BinToC(ICC_DATE_CLASSES, "4RS") apiInitCommonControlsEx(@m.lcControls) Endif ENDPROC PROCEDURE _initlibrary *!* _InitLibrary() External Procedure ctl32.prg Do (Addbs(Justpath(This.ClassLibrary)) + "ctl32.prg") ENDPROC PROCEDURE _iscontrolinpage && Returns TRUE if the control is contained in a page. *!* _IsControlInPage() Local ; llPageFound As Boolean, ; loControl As Control m.llPageFound = FALSE m.loControl = This Do While Inlist(Upper(m.loControl.BaseClass), "FORM", "TOOLBAR") = FALSE If Upper(m.loControl.BaseClass) == "PAGE" Then m.llPageFound = TRUE Exit Endif If Type("m.loControl.Parent") # T_UNDEFINED Then m.loControl = m.loControl.Parent Else Exit Endif Enddo m.loControl = .Null. Release m.loControl Return m.llPageFound ENDPROC PROCEDURE _objtoclient && Replaces OBJTOCLIENT that has bugs. *!* _ObjToClient(cPosition) Lparameters m.tcPosition As String Local ; lnPosition As Integer, ; loControl As Control m.tcPosition = Upper(m.tcPosition) m.lnPosition = 0 m.loControl = This Do Case Case m.tcPosition $ "TOP|BOTTOM" *!* 20070711 Modified to account for toolbars Do While Inlist(Upper(m.loControl.BaseClass), "FORM", "TOOLBAR") = FALSE If Pemstatus(m.loControl, "Top", CTLPEMSTATUS_DEFINED) Then m.lnPosition = m.lnPosition + m.loControl.Top Endif If Upper(m.loControl.BaseClass) == "PAGE" Then If m.loControl.Parent.TabOrientation = CTLTABORIENTATION_TOP Then && Top m.lnPosition = m.lnPosition + ; m.loControl.Parent.Height - ; m.loControl.Parent.PageHeight - ; m.loControl.Parent.BorderWidth * 2 Else m.lnPosition = m.lnPosition + 1 Endif Endif m.loControl = m.loControl.Parent Enddo If m.tcPosition == "BOTTOM" Then m.lnPosition = m.lnPosition + This.Height Endif Case m.tcPosition $ "LEFT|RIGHT" *!* 20070711 Modified to account for toolbars Do While Inlist(Upper(m.loControl.BaseClass), "FORM", "TOOLBAR") = FALSE If Pemstatus(m.loControl, "Left", CTLPEMSTATUS_DEFINED) Then m.lnPosition = m.lnPosition + m.loControl.Left Endif If Upper(m.loControl.BaseClass) == "PAGE" If m.loControl.Parent.TabOrientation = CTLTABORIENTATION_LEFT Then && Left m.lnPosition = m.lnPosition + ; m.loControl.Parent.Width - ; m.loControl.Parent.PageWidth - ; m.loControl.Parent.BorderWidth * 2 Else m.lnPosition = m.lnPosition + 1 Endif Endif m.loControl = m.loControl.Parent Enddo If m.tcPosition == "RIGHT" Then m.lnPosition = m.lnPosition + This.Width Endif Endcase m.loControl = .Null. Release m.loControl Return m.lnPosition ENDPROC PROCEDURE _onformborderstyle ENDPROC PROCEDURE _onformpaint *!* _OnFormPaint() This._CreateBackgroundBrush() Unbindevents(Thisform, "Paint", This, "_OnFormPaint") ENDPROC PROCEDURE _onformresize ENDPROC PROCEDURE _onmoved && Bindevent(This, "Moved", This, "_OnMoved", 1) *!* _OnMoved() Local ; lhwnd As Integer, ; lhWndInsertAfter As Integer, ; lnLeft As Integer, ; lnTop As Integer, ; lnWidth As Integer, ; lnHeight As Integer, ; lwFlags As Integer, ; loPageFrame As PageFrame If This._ControlHwnd = 0 Then Return Endif m.loPageFrame = This._GetPageFrame() *!* If control is in a pageframe, update background brush since it is no longer valid If This.ctlBackStyle = 0 And This._InPage And ctlIsThemeActive(m.loPageFrame) Then This._CreateBackgroundBrush() Endif m.loPageFrame = .Null. Release m.loPageFrame m.lhwnd = This._ControlHwnd m.lhWndInsertAfter = 0 m.lnLeft = This.ctlLocationLeft m.lnTop = This.ctlLocationTop If This._PopUp = TRUE Then ctlClientToScreen(This.ctlHostHwnd, @m.lnLeft, @m.lnTop) Endif m.lnWidth = This.Width m.lnHeight = This.Height m.lwFlags = SWP_NOZORDER *!* This is here cause we are getting dll exception when month calendar *!* control has more than one row and column Try apiSetWindowPos( ; m.lhwnd, ; m.lhWndInsertAfter,; m.lnLeft, ; m.lnTop, ; m.lnWidth, ; m.lnHeight, ; m.lwFlags) Catch Endtry ENDPROC PROCEDURE _onpageactivate && Bindevent(m.loControl, "Activate", This, "_OnPageActivate", 1) *!* _OnPageActivate() This._PageActive = TRUE This._SetVisible() ENDPROC PROCEDURE _onpagedeactivate && Bindevent(m.loControl, "Deactivate", This, "_OnPageDeactivate", 1) *!* _OnPageDeactivate() This._PageActive = FALSE This._SetVisible() ENDPROC PROCEDURE _onparentbackcolor *!* _OnParentBackColor() This._CreateBackGroundBrush() This.ctlRefresh() ENDPROC PROCEDURE _onresize && Bindevent(This, "Resize", This, "_OnResize", 1) *!* _OnResize() This._OnMoved() ENDPROC PROCEDURE _onthemes && Bindevent(_Screen, "Themes", This, "_OnThemes", 1) / Bindevent(Thisform, "Themes", This, "_OnThemes", 1) *!* _OnThemes() This._SetThemes() ENDPROC PROCEDURE _onvalue *!* _OnValue() This.ctlValue = This.ctlTextBox.Value ENDPROC PROCEDURE _postcreate *!* _PostCreate() ENDPROC PROCEDURE _precreate *!* _PreCreate() ENDPROC PROCEDURE _reparent *!* _Reparent() This._PopUp = TRUE apiSetParent(This._ControlHwnd, 0) This._OnMoved() ENDPROC PROCEDURE _setautosize *!* _SetAutosize() ENDPROC PROCEDURE _setbackcolor *!* _SetBackColor() ENDPROC PROCEDURE _setbackstyle *!* _SetBackStyle() *!* We get here only of ctlBackStyle changed *!* We bind to form activate if we have a ctlBackStyle = 0 If This.ctlBackStyle = 0 Then If Type("This.Parent.BackColor") # T_UNDEFINED Bindevent(This.Parent, "BackColor", This, "_OnParentBackColor", 1) Else Bindevent(Thisform, "BackColor", This, "_OnParentBackColor", 1) Endif Else If Type("This.Parent.BackColor") # T_UNDEFINED Unbindevent(This.Parent, "BackColor", This, "_OnParentBackColor") Else Unbindevent(Thisform, "BackColor", This, "_OnParentBackColor") Endif Endif This._CreateBackGroundBrush() This.ctlRefresh() ENDPROC PROCEDURE _setbordercolor *!* _SetBorderColor() ENDPROC PROCEDURE _setcontrolsource *!* _SetControlSource() This.ctlTextBox.ControlSource = This.ctlControlSource If Not Empty(This.ctlControlSource) Then This.ctlValue = This.ctlTextBox.Value Endif ENDPROC PROCEDURE _setenabled *!* _SetEnabled() *!* We want the focus to go to the next enabled control if this control *!* gets disabled while it has the focus, so we disable the dummy textbox *!* first. We then disable the container to prevent click events to fire. *!* To be shure, we give keyboard focus to the form This.ctlTextBox.Enabled = This.ctlEnabled And This.ctlCanFocus This.Enabled = This.ctlEnabled And This.ctlCanFocus If This.ctlEnabled = FALSE Then If Thisform.HWnd = apiGetActiveWindow() apiSetfocus(Thisform.HWnd) Endif Endif If This._ControlHwnd = 0 Then Return Endif If This.ctlEnabled = TRUE Then apiEnableWindow(This._ControlHwnd, TRUE) Else *!* Return keyboard focus to form apiEnableWindow(This._ControlHwnd, FALSE) Endif ENDPROC PROCEDURE _setfont *!* _SetFont() *!* typedef struct tagLOGFONT { *!* LONG lfHeight; *!* LONG lfWidth; *!* LONG lfEscapement; *!* LONG lfOrientation; *!* LONG lfWeight; *!* BYTE lfItalic; *!* BYTE lfUnderline; *!* BYTE lfStrikeOut; *!* BYTE lfCharSet; *!* BYTE lfOutPrecision; *!* BYTE lfClipPrecision; *!* BYTE lfQuality; *!* BYTE lfPitchAndFamily; *!* TCHAR lfFaceName[LF_FACESIZE]; *!* } LOGFONT, *PLOGFONT; If This._ControlHwnd = 0 Then Return Endif If This._EnableUpdates = FALSE Then Return Endif Local ; loLogFont As _LOGFONT, ; lcLogFont As String m.loLogFont = Createobject("_LOGFONT") m.loLogFont.Value = This._FontDefaultLogFont.Value *!* Fill members of font structure: With m.loLogFont .FontBold = This.ctlFontBold .FontCharSet = This.ctlFontCharSet .FontItalic = This.ctlFontItalic .FontName = This.ctlFontName + NULA .FontSize = This.ctlFontSize .FontStrikethru = This.ctlFontStrikethru .FontUnderline = This.ctlFontUnderline Endwith *!* Release Font object if we already have one: If This._FontHandle # 0 Then apiDeleteObject(This._FontHandle ) Endif m.lcLogFont = m.loLogFont.Value *!* Create a new font object: This._FontHandle = apiCreateFontIndirect(@m.lcLogFont) *!* Set control font to this font object: apiSendMessageInteger(This._ControlHwnd, WM_SETFONT, This._FontHandle, 1) m.loLogFont = .Null. Release m.loLogFont ENDPROC PROCEDURE _setforecolor *!* _SetForeColor() ENDPROC PROCEDURE _setorientation *!* _SetOrientation() ENDPROC PROCEDURE _setproperties *!* _SetProperties() *!* Specifies if control is inside a pageframe This._InPage = This._IsControlInPage() *This._FormType = ctlGetFormType(This) ENDPROC PROCEDURE _setshowfocuscues *!* _SetShowFocusCues() Local wParam As Integer If This._ControlHwnd = 0 Then Return Endif If This.ctlShowFocusCues Then m.wParam = ctlMakewParam(UIS_CLEAR, UISF_HIDEFOCUS) Else m.wParam = ctlMakewParam(UIS_SET, UISF_HIDEFOCUS) Endif apiSendMessageInteger(This._ControlHwnd, WM_CHANGEUISTATE, m.wParam, 0) ENDPROC PROCEDURE _setthemes *!* _SetThemes() If This._ControlHwnd = 0 Then Return Endif If ctlIsThemeActive(This) = TRUE Then apiSetWindowTheme(This._ControlHwnd, .Null., .Null.) Else apiSetWindowTheme(This._ControlHwnd, .Null., "") Endif ENDPROC PROCEDURE _setvalue *!* _SetValue() If Not Empty(This.ctlTextBox.ControlSource) Then This.ctlTextBox.Value = This.ctlValue Thisform.Refresh() Endif Raiseevent(This, "ctlValueChanged") ENDPROC PROCEDURE _setvisible *!* _SetVisible() Local m.llVisible As Logical m.llVisible = This.ctlVisible If This._InPage = TRUE m.llVisible = This._PageActive And m.llVisible Endif *!* Set the container control itself visible property This.Visible = m.llVisible And This._Visible If This._ControlHwnd = 0 Then Return Endif If m.llVisible = TRUE Then * apiShowWindow(This._ControlHwnd, SW_SHOWNA) apiSetWindowPos(This._ControlHwnd, HWND_TOP, 0, 0, 0, 0, BITOR(SWP_NOACTIVATE, SWP_NOMOVE, SWP_NOSIZE, SWP_SHOWWINDOW)) Else apiShowWindow(This._ControlHwnd, SW_HIDE) Endif ENDPROC PROCEDURE _updatecolors *!* _UpdateColors() ENDPROC PROCEDURE _vfpmessagehandler *!* _VFPMessageHandler *!* This binds to the _Msg property of the BindWindowsEventsProxy object of _VFP Do Case Case _vfp.BindWindowsEventsProxy._Msg = WM_THEMECHANGED This._SetThemes() This._CreateBackGroundBrush() *!* Update colors if needed This._UpdateColors() *!* Send a color change message to control to force redraw and *!* prevent glitches If This._ControlHwnd # 0 Then apiSendMessageInteger(This._ControlHwnd, WM_SYSCOLORCHANGE , 0, 0) Endif Endcase ENDPROC PROCEDURE ctlTextBox.GotFocus *!* GotFocus() This.ctlFocused = TRUE *!* Set Focus to control window If This.Parent.ctlCanFocus Then apiSetfocus(This.Parent._ControlHwnd) Endif ENDPROC PROCEDURE ctlTextBox.Init This.AddProperty("ctlFocused", FALSE) ENDPROC PROCEDURE ctlTextBox.LostFocus *!* LostFocus() This.ctlFocused = FALSE Do Case Case _vfp.HWnd = apiGetActiveWindow() If Type("_Screen.ActiveForm") = "O" And _Screen.ActiveForm.HWnd = Thisform.HWnd Then apiSetfocus(Thisform.HWnd) Endif Case Thisform.HWnd = apiGetActiveWindow() apiSetfocus(Thisform.HWnd) Endcase ENDPROC PROCEDURE lblname.Init Return FALSE ENDPROC ENDDEFINE