Rob van der Woude's Scripting Pages
Powered by GeSHi

Source code for comdlgfn.vbs

(view source code of comdlgfn.vbs as plain text) 

  1. ' A script to demonstrate the Font Select dialog available in COMDLG32.OCX
  2. ' Written by Rob van der Woude
  3. ' http://www.robvanderwoude.com
  4.  
  5. Option Explicit
  6.  
  7. Dim arrFont, blnBold, blnItalic, blnStrikeThrough, blnUnderlined, strAttributes
  8.  
  9. arrFont = FontSelectDialog( )
  10. If arrFont(0) = True Then
  11. 	blnBold          = arrFont(3) And 1
  12. 	blnItalic        = arrFont(3) And 2
  13. 	blnStrikeThrough = arrFont(3) And 4
  14. 	blnUnderlined    = arrFont(3) And 8
  15. 	strAttributes    = ""
  16. 	If blnBold          Then strAttributes = strAttributes & " bold"
  17. 	If blnItalic        Then strAttributes = strAttributes & " italic"
  18. 	If blnStrikeThrough Then strAttributes = strAttributes & " strikethrough"
  19. 	If blnUnderlined    Then strAttributes = strAttributes & " underlined"
  20. 	WScript.Echo "Selected font: " & arrFont(1) & " " & arrFont(2) & "pt" & strAttributes
  21. Else
  22. 	WScript.Echo "No font selected"
  23. End If
  24.  
  25.  
  26. Function FontSelectDialog( )
  27. ' This function pops up a Font Select dialog and returns an array of
  28. ' properties for the selected font.
  29. ' The array has the following values:
  30. ' index 0 = [bool] True if a font was successfully selected, otherwise False
  31. ' index 1 = [str]  Font name
  32. ' index 2 = [int]  Font size in pt
  33. ' index 3 = [int]  Font attributes:
  34. '                  4 bits for Bold (bit 0), Italic (bit 1),
  35. '                  Strikethrough (bit 2) and Underlined (bit 3)
  36. '                  E.g. if index 3 equals 4, Strikethrough is true,
  37. '                  if index 3 equals 3 then Bold and Italic are both true
  38.  
  39. 	Dim intAttrib, objDialog
  40.  
  41. 	FontSelectDialog = Array( False, "", 0, 0 )
  42.  
  43. 	On Error Resume Next
  44. 	Set objDialog = CreateObject( "MSComDlg.CommonDialog" )
  45. 	If Err Then
  46. 		MsgBox Err.Description & vbCrLf & vbCrLf _
  47. 		     & "This script requires COMDLG32.OCX." & vbCrLf & vbCrLf _
  48. 		     & "Please make sure it is installed and registered.", , "COMDLG32 not registered"
  49. 	Else
  50. 		objDialog.ShowFont
  51. 		intAttrib = 0
  52. 		If objDialog.FontBold       Then intAttrib = intAttrib + 1
  53. 		If objDialog.FontItalic     Then intAttrib = intAttrib + 2
  54. 		If objDialog.FontStrikeThru Then intAttrib = intAttrib + 4
  55. 		If objDialog.FontUnderLine  Then intAttrib = intAttrib + 8
  56. 		If objDialog.FontName <> "" Then
  57. 			FontSelectDialog = Array( True, objDialog.FontName, objDialog.FontSize, intAttrib )
  58. 		End If
  59. 	End If
  60.  
  61. 	On Error Goto 0
  62. 	Set objDialog = Nothing
  63. End Function
  64.  

page last modified: 2025-10-11; loaded in 0.0073 seconds