$PBExportHeader$n_choosefont.sru forward global type n_choosefont from nonvisualobject end type type choosefont from structure within n_choosefont end type type logfont from structure within n_choosefont end type end forward type choosefont from structure unsignedlong lstructsize longptr hwnd longptr hdc longptr lplogfont long ipointsize unsignedlong flags longptr rgbcolors longptr lcustdata longptr lpfnhook string templatename longptr hinstance string lpszstyle integer nfonttype integer missingalignment longptr nsizemin longptr nsizelong end type type logfont from structure 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 character lffacename[32] end type global type n_choosefont from nonvisualobject autoinstantiate end type type prototypes Function boolean ChooseFont ( & Ref CHOOSEFONT lpcf & ) Library "comdlg32.dll" Alias For "ChooseFontW" Subroutine CopyMemory ( & Ref LOGFONT Destination, & longptr Source, & long Length & ) Library "kernel32.dll" Alias For "RtlMoveMemory" Subroutine CopyMemory ( & longptr Destination, & LOGFONT Source, & long Length & ) Library "kernel32.dll" Alias For "RtlMoveMemory" Function longptr GlobalAlloc ( & ulong uFlags, & ulong dwBytes & ) Library "kernel32.dll" Function longptr GlobalLock ( & longptr hMem & ) Library "kernel32.dll" Function boolean GlobalUnlock ( & longptr hMem & ) Library "kernel32.dll" Function longptr GlobalFree ( & longptr hMem & ) Library "kernel32.dll" end prototypes type variables Integer iTextSize Boolean iBold Boolean iUnderline Boolean iItalic Boolean iStrikeout String iFaceName Long iTextColor Long iWeight end variables forward prototypes public function boolean of_choosefont (window aw_parent, string as_fontname) end prototypes public function boolean of_choosefont (window aw_parent, string as_fontname);Constant Integer CF_SCREENFONTS = 1 Constant Integer CF_INITTOLOGFONTSTRUCT = 64 Constant Integer CF_EFFECTS = 256 Constant Integer GMEM_MOVEABLE = 2 Environment le_env CHOOSEFONT lstr_choosefont LOGFONT lstr_logfont Long ll_StructSize Longptr ll_LogFont GetEnvironment(le_env) If le_env.ProcessBitness = 64 Then ll_StructSize = 104 Else ll_StructSize = 60 End If // we allocate a piece of memory with the size of the logfont structure // and we lock it ll_LogFont = GlobalAlloc(GMEM_MOVEABLE, ll_StructSize * 2) If ll_LogFont = 0 Then Return False ll_LogFont = GlobalLock(ll_LogFont) If ll_LogFont = 0 Then Return False /* initialise the logfont structure */ // default font If as_fontname = "" Then lstr_logfont.lffacename = "Arial" Else lstr_logfont.lffacename = as_fontname End If lstr_logfont.lfweight = 400 // copy the structure to the allocated piece in memory CopyMemory(ll_LogFont, lstr_Logfont, ll_StructSize) // assign the pointer to the fontinfo in memory to the dialog font lstr_ChooseFont.lplogfont = ll_LogFont // initialise the structure further lstr_ChooseFont.lstructsize = ll_StructSize lstr_ChooseFont.hwnd = Handle(aw_parent) lstr_ChooseFont.flags = CF_SCREENFONTS+CF_INITTOLOGFONTSTRUCT+CF_EFFECTS // call the dialog If Not ChooseFont(lstr_ChooseFont) Then GlobalUnlock(ll_LogFont) GlobalFree(ll_LogFont) Return False End If // The memory piece now contains the selected log information // Copy this information back to the structure so we can access it CopyMemory(lstr_LogFont, lstr_ChooseFont.lplogfont, ll_StructSize) // release the used memory GlobalUnlock(ll_LogFont) GlobalFree(ll_LogFont) // save the results in instance variables iTextSize = (lstr_ChooseFont.iPointSize / 10) iWeight = lstr_LogFont.lfWeight If iWeight = 700 Then iBold = True Else iBold = False End If iFaceName = Trim(lstr_LogFont.lfFaceName) iTextColor = lstr_ChooseFont.rgbColors iUnderline = (lstr_LogFont.lfUnderline > 0) iItalic = (lstr_LogFont.lfItalic > 0) iStrikeout = (lstr_LogFont.lfStrikeout > 0) Return True end function on n_choosefont.create call super::create TriggerEvent( this, "constructor" ) end on on n_choosefont.destroy TriggerEvent( this, "destructor" ) call super::destroy end on
- Sources
- TopWiz
- choosefont
- PB
- n_choosefont.sru
File: n_choosefont.sru
Size: 4484
Date: Thu, 14 Jul 2022 19:19:14 +0200
Size: 4484
Date: Thu, 14 Jul 2022 19:19:14 +0200
- nonvisualobject autoinstantiate n_choosefont(sru)