romfast/comun
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
cafe03fdb3861b1be130de6c26b8319203262919
comun/utile/ctl32/ctl32.vc2

3283 lines
86 KiB
Plaintext
Raw Blame History

*--------------------------------------------------------------------------------------------------------------------------------------------------------
* (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"
*<DefinedPropArrayMethod>
*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
*</DefinedPropArrayMethod>
*<PropValue>
BackColor = 140,200,200
ctltitle =
Height = 23
Name = "ctl32_commondialog"
Visible = .F.
Width = 120
_callbackpointer = 0
*</PropValue>
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<54>"
m.lqFolderId = FOLDERID_SidebarDefaultParts
m.lnCsidl = 0xFFFF
Case m.puFolderId = "SIDEBARPARTS<54>"
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<54>"
m.lqFolderId = FOLDERID_SidebarDefaultParts
m.lnCsidl = 0xFFFF
Case m.puFolderId = "SIDEBARPARTS<54>"
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"
*<DefinedPropArrayMethod>
*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
*</DefinedPropArrayMethod>
*<PropValue>
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 = <VFPData>
</VFPData>
_onvaluefired = .F.
_pageactive = .F.
_popup = .F.
_recreatinghandle = .F.
_visible = .T.
*</PropValue>
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
Reference in New Issue View Git Blame Copy Permalink