home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Visual Database / Visual Foxpro 6.0 (Ent. Edition) / Vf6ent Extractor.EXE / TOOLS / ADDLABEL / ADDLABEL.APP (.txt) next >
Encoding:
MS Visual FoxPro App  |  1998-05-26  |  140.0 KB  |  2,447 lines

  1. PLATFORM
  2. UNIQUEID
  3. TIMESTAMP
  4. CLASS
  5. CLASSLOC
  6. BASECLASS
  7. OBJNAME
  8. PARENT
  9. PROPERTIES
  10. PROTECTED
  11. METHODS
  12. OBJCODE
  13. RESERVED1
  14. RESERVED2
  15. RESERVED3
  16. RESERVED4
  17. RESERVED5
  18. RESERVED6
  19. RESERVED7
  20. RESERVED8
  21.  COMMENT Screen              
  22.  WINDOWS _QTS0I9HEP 546203848
  23.  WINDOWS _QTR0X0BGR 606638154
  24.  WINDOWS _QTS0I9HEP 546244022
  25.  WINDOWS _QTS0I9HEP 551043836N
  26.  WINDOWS _R9L06FHTB 579769148
  27.  WINDOWS _R9L06FHUA 606638154
  28.  WINDOWS _R9L18TP16 579770109
  29.  WINDOWS _QTS0I9HEP 591747627
  30.  WINDOWS _R9L1DGFDH 591747627
  31.  WINDOWS _R9L1DGFE2 591747627`
  32.  WINDOWS _RJR12MGOY 579768358
  33.  COMMENT RESERVED            
  34. VERSION =   3.00
  35. dataenvironment
  36. dataenvironment
  37. Datanavigation
  38. ILeft = 1
  39. Top = 220
  40. Width = 520
  41. Height = 120
  42. Name = "Datanavigation"
  43. form1
  44. DataSession = 2
  45. ScaleMode = 3
  46. Height = 215
  47. Width = 447
  48. DoCreate = .T.
  49. AutoCenter = .T.
  50. BorderStyle = 2
  51. Caption = "Custom Labels"
  52. MaxButton = .F.
  53. MinButton = .F.
  54. WindowType = 1
  55. WindowState = 0
  56. Name = "form1"
  57. PROCEDURE deletelabel
  58. #DEFINE LBLREGKEY1             "Software\Microsoft\VisualFoxPro\"
  59. #DEFINE LBLREGKEY2             "\Labels"
  60. #DEFINE HKEY_CURRENT_USER   -2147483647  && BITSET(0,31)+1
  61. LPARAMETERS cLblName
  62. LOCAL nRetCode, cLblRegKey
  63. cLblRegKey = LBLREGKEY1 + _VFP.Version + LBLREGKEY2
  64. * Need to remove Registry entry if any
  65. m.cLblName= ALLTRIM(m.cLblName) + CHR(0)
  66. nRetCode = THISFORM.oRegistry.DeleteKeyValue(m.cLblName, m.cLblRegKey, HKEY_CURRENT_USER)
  67. ENDPROC
  68. PROCEDURE Destroy
  69. LOCAL tmpF1
  70. IF EMPTY(THIS.OldF1)
  71.     ON KEY LABEL F1
  72.     tmpF1 = THIS.OldF1 
  73.     ON KEY LABEL F1 &tmpF1
  74. ENDIF
  75. ENDPROC
  76. PROCEDURE Refresh
  77. IF THIS.lstLabels.ListCount = 0
  78.     THIS.cmdDelete.Enabled = .F.
  79.     THIS.cmdEdit.Enabled = .F.
  80.     THIS.cmdEdit.Enabled = .T.
  81.     THIS.cmdDelete.Enabled = .T.
  82. ENDIF
  83. ENDPROC
  84. PROCEDURE Init
  85. #DEFINE USERLBLS_LOC    "userlbls.dbf"
  86. #DEFINE LBLSPATH_LOC    "Tools\AddLabel\"
  87. #DEFINE cWhere_loc         "Where is "+USERLBLS_LOC+"?"
  88. #DEFINE cFILEINUSE_LOC    "Could not open Userlbls table. Check to see if this table is in use by another."
  89. LOCAL cLblsFile,aDirArray,nDirs
  90. DIME aDirArray[1]
  91. SET DELETED ON
  92. SET EXCLUSIVE ON
  93. DO CASE
  94. CASE FILE(USERLBLS_LOC)
  95.     *This.label_file = "labels"
  96.     cLblsFile = USERLBLS_LOC
  97. CASE FILE(HOME()+USERLBLS_LOC)
  98.     cLblsFile = HOME()+USERLBLS_LOC
  99. CASE FILE(HOME()+LBLSPATH_LOC+USERLBLS_LOC)
  100.     cLblsFile = HOME()+LBLSPATH_LOC+USERLBLS_LOC
  101. OTHERWISE
  102.     cLblsFile = ""
  103. ENDCASE
  104. IF EMPTY(m.cLblsFile)
  105.     * Create a new one
  106.     nDirs =    ADIR(aDirArray,HOME()+LBLSPATH_LOC,"D")
  107.     IF m.nDirs # 0
  108.         cLblsFile = HOME()+LBLSPATH_LOC+USERLBLS_LOC
  109.     ELSE
  110.         cLblsFile = HOME()+USERLBLS_LOC
  111.     ENDIF
  112.     CREATE TABLE (m.cLblsFile) ;
  113.         (TYPE c(12),;
  114.         ID c(12),;
  115.         NAME c(24),;
  116.         READONLY L,;
  117.         CKVAL N(6),;
  118.         DATA M,;    
  119.         UPDATED D)
  120.     * This.label_file = GETFILE("DBF",cWhere_loc)
  121.     USE (m.cLblsFile) ALIAS userlbls
  122. ENDIF
  123. IF EMPTY(ALIAS())
  124.     * We had an error opening file, may be in use.
  125.     * Try opening it shared
  126.     USE (m.cLblsFile) ALIAS userlbls SHARED
  127.     IF EMPTY(ALIAS())
  128.         = MESSAGEBOX(cFILEINUSE_LOC)    
  129.         RETURN .F.
  130.     ENDIF
  131.     This.label_file = ALIAS()
  132. ENDIF
  133. SELECT 0
  134. CREATE CURSOR WzLabels ;
  135.  (Name C(30),;
  136.   LblDimen C(40),;
  137.   LblColumns C(2),;
  138.   Data M)
  139. SELECT userlbls
  140. SCAN FOR ID="LABELLYT" AND !DELETED()
  141.     INSERT INTO WzLabels (Name, LblDimen, LblColumns,Data);
  142.      VALUE (userlbls.Name,;
  143.       ALLTRIM(SUBSTR(userlbls.Data,15,11))+" x "+ALLTRIM(SUBSTR(userlbls.Data, 26, 11)), ;
  144.       ALLTRIM(SUBSTR(userlbls.Data, 37, 2)),;
  145.       userlbls.Data)
  146. ENDSCAN
  147. SELECT wzlabels
  148. THIS.lstLabels.RowSource = "Name, LblDimen, LblColumns"
  149. THIS.lstLabels.Value = 1
  150. THIS.lstLabels.ColumnWidths = "120,140,130"
  151. THIS.OldF1 = ON("KEY","F1")
  152. ON KEY LABEL F1 HELP ID 489321235
  153. THISFORM.REFRESH
  154. ENDPROC
  155. NewLabel
  156. CSAVENAME
  157. NEWLABEL
  158. USERLBLS
  159. THISFORM
  160. DELETELABEL
  161. WZLABELS    
  162. LSTLABELS
  163. SETFOCUS
  164. REFRESH
  165. Click,
  166. Are you sure you want to delete the label?
  167. CNAME
  168. CREGNAME
  169. THISFORM    
  170. LSTLABELS    
  171. LISTCOUNT
  172. USERLBLS
  173. WZLABELS
  174. DELETELABEL
  175. SETFOCUS
  176. REFRESH
  177. Click,
  178. THISFORM
  179. CMDEDIT
  180. CLICK
  181. DblClick,
  182. USERLBLS
  183. THISFORM
  184. RELEASE
  185. Click,
  186. NewLabel
  187. NEWLABEL
  188. WZLABELS
  189. THISFORM    
  190. LSTLABELS
  191. SETFOCUS
  192. REFRESH
  193. Click,
  194. JArial, 0, 9, 5, 15, 12, 21, 3, 0
  195. MS Sans Serif, 0, 8, 5, 13, 11, 11, 2, 0
  196. DTop = 180
  197. Left = 408
  198. Height = 17
  199. Width = 20
  200. Name = "oRegistry"
  201. form1
  202.     oRegistry
  203. custom
  204. ..\wzcommon\registry.vcx
  205. registry
  206. FontName = "MS Sans Serif"
  207. FontSize = 8
  208. BackStyle = 0
  209. Caption = "Columns"
  210. Height = 15
  211. Left = 280
  212. Top = 12
  213. Width = 69
  214. Name = "Label3"
  215. form1
  216. Label3
  217. label
  218. label
  219. form1
  220. Label2
  221. label
  222. label
  223. form1
  224. "label_file
  225. oldf1
  226. *deletelabel 
  227. commandbutton
  228. commandbutton
  229. cmdNew
  230. form1
  231. Top = 110
  232. Left = 364
  233. Height = 23
  234. Width = 72
  235. FontName = "MS Sans Serif"
  236. FontSize = 8
  237. Caption = "\<New..."
  238. TabIndex = 3
  239. Name = "cmdNew"
  240. lPROCEDURE Click
  241. DO FORM NewLabel
  242. SELECT wzlabels
  243. THISFORM.lstLabels.SetFocus
  244. THISFORM.Refresh
  245. ENDPROC
  246. FontName = "MS Sans Serif"
  247. FontSize = 8
  248. BackStyle = 0
  249. Caption = "Dimensions"
  250. Height = 15
  251. Left = 138
  252. Top = 12
  253. Width = 87
  254. Name = "Label2"
  255. Label1
  256. label
  257. label
  258. form1
  259. cmdEdit
  260. commandbutton
  261. commandbutton
  262. form1
  263.     cmdDelete
  264. commandbutton
  265. commandbutton
  266. cmdClose
  267. form1
  268. Top = 32
  269. Left = 364
  270. Height = 23
  271. Width = 72
  272. FontName = "MS Sans Serif"
  273. FontSize = 8
  274. Cancel = .T.
  275. Caption = "Close"
  276. TabIndex = 5
  277. Name = "cmdClose"
  278. PROCEDURE Click
  279. SELECT userlbls
  280. IF ISEXCL()
  281.     * Perform a little maintenance
  282.     LOCATE FOR DELETED()
  283.     IF FOUND()
  284.         PACK
  285.         PACK MEMO
  286.     ENDIF
  287. ENDIF
  288. THISFORM.RELEASE
  289. ENDPROC
  290. FontName = "MS Sans Serif"
  291. FontSize = 8
  292. BackStyle = 0
  293. Caption = "Name"
  294. Height = 15
  295. Left = 14
  296. Top = 12
  297. Width = 50
  298. Name = "Label1"
  299. commandbutton
  300. commandbutton
  301. 7PROCEDURE DblClick
  302. THISFORM.cmdEdit.Click()
  303. ENDPROC
  304. form1
  305.     lstLabels
  306. listbox
  307. listbox
  308. FontName = "MS Sans Serif"
  309. FontSize = 8
  310. ColumnCount = 3
  311. RowSourceType = 6
  312. Height = 170
  313. Left = 12
  314. TabIndex = 4
  315. Top = 31
  316. Width = 337
  317. Name = "lstLabels"
  318. /PROCEDURE Click
  319. LOCAL cSaveName
  320. cSaveName = ALLTRIM(Name)
  321. DO FORM NewLabel WITH .T.
  322. * Check to see if name changed
  323. SELECT userlbls
  324. IF !UPPER(m.cSaveName) == UPPER(ALLTRIM(Name))
  325.     THISFORM.DeleteLabel(m.cSaveName)
  326. ENDIF
  327. SELECT wzlabels
  328. THISFORM.lstLabels.SetFocus
  329. THISFORM.Refresh
  330. ENDPROC
  331. Top = 84
  332. Left = 364
  333. Height = 23
  334. Width = 72
  335. FontName = "MS Sans Serif"
  336. FontSize = 8
  337. Caption = "\<Delete"
  338. TabIndex = 2
  339. Name = "cmdDelete"
  340. PROCEDURE Click
  341. #DEFINE CDELETE_LOC            "Are you sure you want to delete the label?"
  342. LOCAL cName, cRegName
  343. IF THISFORM.lstLabels.Listcount = 0 OR MESSAGEBOX(CDELETE_LOC,36) # 6
  344.     RETURN
  345. ENDIF
  346. cName = UPPER(ALLTRIM(Name))
  347. cRegName = Name
  348. SELECT userlbls
  349. LOCATE FOR UPPER(ALLTRIM(Name))==m.cName AND !DELETED()
  350. IF FOUND()
  351.     DELETE
  352. ENDIF
  353. SELECT wzlabels
  354. DELETE
  355. THISFORM.DeleteLabel(m.cRegName)    &&removes from registry
  356. THISFORM.lstlabels.SetFocus
  357. THISFORM.REFRESH
  358. ENDPROC
  359. Top = 58
  360. Left = 364
  361. Height = 23
  362. Width = 72
  363. FontName = "MS Sans Serif"
  364. FontSize = 8
  365. Caption = "\<Edit..."
  366. TabIndex = 1
  367. Name = "cmdEdit"
  368. Software\Microsoft\VisualFoxPro\
  369. \Labels
  370. CLBLNAME
  371. NRETCODE
  372. CLBLREGKEY
  373. VERSION
  374. THISFORM    
  375. OREGISTRY
  376. DELETEKEYVALUE`
  377. ON KEY LABEL F1 &tmpF1
  378. TMPF1
  379. OLDF1
  380. THIS    
  381. LSTLABELS    
  382. LISTCOUNT    
  383. CMDDELETE
  384. ENABLED
  385. CMDEDIT
  386. userlbls.dbf0
  387. userlbls.dbf
  388. userlbls.dbf
  389. userlbls.dbf
  390. Tools\AddLabel\
  391. userlbls.dbf
  392. Tools\AddLabel\
  393. userlbls.dbf
  394. Tools\AddLabel\
  395. Tools\AddLabel\
  396. userlbls.dbf
  397. userlbls.dbf
  398. Could not open Userlbls table. Check to see if this table is in use by another.
  399. WzLabels
  400. LABELLYT
  401. WzLabels
  402. Name, LblDimen, LblColumns
  403. 120,140,130
  404. HELP ID 489321235
  405. CLBLSFILE    
  406. ADIRARRAY
  407. NDIRS
  408. READONLY
  409. CKVAL
  410. UPDATED
  411. USERLBLS
  412. LABEL_FILE
  413. WZLABELS
  414. LBLDIMEN
  415. LBLCOLUMNS    
  416. LSTLABELS    
  417. ROWSOURCE
  418. VALUE
  419. COLUMNWIDTHS
  420. OLDF1
  421. THISFORM
  422. REFRESH
  423. deletelabel,
  424. Destroy
  425. Refresh
  426. Init3
  427. d:\8146\fox60\xpieces\addlabel\addlabel.scx
  428. PLATFORM
  429. UNIQUEID
  430. TIMESTAMP
  431. CLASS
  432. CLASSLOC
  433. BASECLASS
  434. OBJNAME
  435. PARENT
  436. PROPERTIES
  437. PROTECTED
  438. METHODS
  439. OBJCODE
  440. RESERVED1
  441. RESERVED2
  442. RESERVED3
  443. RESERVED4
  444. RESERVED5
  445. RESERVED6
  446. RESERVED7
  447. RESERVED8
  448.  COMMENT Screen              
  449.  WINDOWS _R8T13G40P 544314328
  450.  WINDOWS _R8T13G40X 591748010
  451.  WINDOWS _R8T13G40P 551043889
  452.  WINDOWS _R8T13G43F 579768625
  453.  WINDOWS _R8T13G40P 551043616
  454.  WINDOWS _R8T13G45X 591746850
  455.  WINDOWS _R8T13G472 591746850
  456.  WINDOWS _R9K15742G 546151933
  457.  WINDOWS _R9K15742W 591746850
  458.  WINDOWS _R9K15743C 546182489$D
  459.  WINDOWS _R9K157446 591746850ME
  460.  WINDOWS _R8T13G40P 546220955wF
  461.  WINDOWS _R9K15745P 546182489xJ
  462.  WINDOWS _R9K15746I 546182489
  463.  WINDOWS _R8T13G40P 591748010
  464.  WINDOWS _R9K15747V 591746850
  465.  WINDOWS _R8T13G40P 546182151
  466.  WINDOWS _R8T13G40P 591746850l;
  467.  WINDOWS _R9K163WGW 546153523|:
  468.  WINDOWS _R9K163WHK 551043616
  469.  WINDOWS _R9L05FSRW 591746850x8
  470.  WINDOWS _RJR12X8YO 579768626" 
  471.  COMMENT RESERVED            
  472. VERSION =   3.00
  473. dataenvironment
  474. dataenvironment
  475. Dataenvironment
  476. Name = "Dataenvironment"
  477. form1
  478. Height = 364
  479. Width = 500
  480. DoCreate = .T.
  481. AutoCenter = .T.
  482. BorderStyle = 2
  483. Caption = "New Label Definition"
  484. MaxButton = .F.
  485. MinButton = .F.
  486. WindowType = 1
  487. WindowState = 0
  488. LockScreen = .F.
  489. lenglish = .T.
  490. cchangevalue = ("")
  491. Name = "form1"
  492. dPROCEDURE convertmm
  493. LPARAMETER cInValue,lwhichway
  494. * Converts metric values entered in millimeters to 10,000ths of an inch.
  495. LOCAL nInValue,cOutValue
  496. *!*    nInValue = VAL(ALLTRIM(m.cInValue))
  497. m.nInValue = m.cInValue
  498. IF !m.lwhichway
  499.     * metric to english
  500.     nInValue = ROUND(((m.nInValue*39.3700787402E-2)),4)
  501.     * english to metric
  502.     nInValue = ROUND(((m.nInValue/39.3700787402E-2)),4)
  503. ENDIF
  504. *!*    cOutValue = ALLTRIM(STR(m.nInValue,8,3))
  505. RETURN m.nInValue
  506. ENDPROC
  507. PROCEDURE resetlabel
  508. #DEFINE ENGMEASURE    '"'
  509. #DEFINE METMEASURE    'cm'
  510. #DEFINE ENGPROMPT_LOC    "Enter label measurements in inches:"
  511. #DEFINE    METPROMPT_LOC    "Enter label measurements in centimeters:"
  512. #DEFINE CMDADDCAP_LOC    "\<Update"
  513. LOCAL cLblData,cDesc,cDelim,cDataDesc
  514. cLblData = ALLTRIM(Data)
  515. THIS.cmdAdd.Caption = CMDADDCAP_LOC
  516. This.LayoutName.Value = Name
  517. This.ogpMetric.Value = IIF(RIGHT(m.cLblData,1)="T",2,1)
  518. IF This.ogpMetric.Value = 2 
  519.     This.LblPrompt.Caption = METPROMPT_LOC
  520. ENDIF
  521. cDelim=IIF(This.ogpMetric.Value = 2,METMEASURE,ENGMEASURE)
  522. This.LeftMargin.Value= VAL(SUBSTR(m.cLblData,40,8))/10000 
  523. This.NumberAcross.Value= VAL(SUBSTR(m.cLblData,48,2))
  524. This.SpacesBetween.Value= VAL(SUBSTR(m.cLblData,50,8))/10000
  525. This.LabelWidth.Value= VAL(SUBSTR(m.cLblData,58,8))/10000
  526. This.TopMargin.Value= VAL(SUBSTR(m.cLblData,66,8))/10000
  527. This.LabelHeight.Value = VAL(SUBSTR(m.cLblData,74,8))/10000
  528. IF This.ogpMetric.Value = 2
  529.     * If the values are metric, convert them to english
  530.     This.LeftMargin.Value= ThisForm.ConvertMM(This.LeftMargin.Value,.T.)
  531.     This.SpacesBetween.Value= ThisForm.ConvertMM(This.SpacesBetween.Value,.T.)
  532.     This.LabelWidth.Value= ThisForm.ConvertMM(This.LabelWidth.Value,.T.)
  533.     This.TopMargin.Value= ThisForm.ConvertMM(This.TopMargin.Value,.T.)
  534.     This.LabelHeight.Value= ThisForm.ConvertMM(This.LabelHeight.Value,.T.)
  535. ENDIF
  536. m.cDesc = PADR(LEFT(ALLTRIM(This.LayoutName.Value),11),11)+ " "
  537. m.cDesc = m.cDesc + PADR(ALLTRIM(STR(This.LabelHeight.Value,8,2))+m.cDelim,11)
  538. m.cDesc = m.cDesc + PADR(ALLTRIM(STR(This.LabelWidth.Value,8,2))+m.cDelim,11)
  539. m.cDesc = m.cDesc +    PADL(ALLTRIM(STR(This.NumberAcross.Value)),2," ")+" "
  540. cDataDesc = ALLTRIM(SUBSTR(data,3,37))
  541. cDesc = ALLTRIM(m.cDesc)
  542. THIS.lChangeDesc = (m.cDataDesc#m.cDesc)
  543. IF THIS.lChangeDesc
  544.     LOCAL cPart1,cPart2
  545.     cPart1 = ALLTRIM(SUBSTR(m.cDataDesc,11,11))
  546.     cPart2 = ALLTRIM(SUBSTR(m.cDataDesc,22,11))
  547.     cPart1 = m.cPart1+" x "+m.cPart2
  548.     THIS.Description.Value = m.cPart1
  549.     THIS.Description.Enabled = .T.
  550.     THIS.chkSet.Value = 1
  551.     THIS.cChangeValue = m.cPart1
  552.     IF This.ogpMetric.Value = 2
  553.         m.cDelim = " "+m.cDelim
  554.     ENDIF
  555.     This.Description.Value = ALLT(STR(This.LabelHeight.Value,8,2))+;
  556.         m.cDelim+" x "+ALLT(STR(This.LabelWidth.Value,8,2))+m.cDelim
  557. ENDIF
  558. THISFORM.REFRESH
  559. ENDPROC
  560. PROCEDURE labeltoregistry
  561. #DEFINE LBLREGKEY1             "Software\Microsoft\VisualFoxPro\"
  562. #DEFINE LBLREGKEY2             "\Labels"
  563. #DEFINE HKEY_CURRENT_USER   -2147483647  && BITSET(0,31)+1
  564. #DEFINE NOREGWRITE_LOC        "Could not write labels to Registry."
  565. #DEFINE UPDATEREG_LOC        "Updating Registry with label definitions..."
  566. LOCAL nRetCode,nSaveArea,cGetName,cGetData,cLblRegKey
  567. cLblRegKey = LBLREGKEY1 + _VFP.Version + LBLREGKEY2
  568. nRetCode = THIS.oRegistry.OpenKey(m.cLblRegKey, HKEY_CURRENT_USER, .T.)
  569. IF nRetCode #0
  570.     MESSAGEBOX(NOREGWRITE_LOC)
  571.     RETURN
  572. ENDIF
  573. nRetCode = THIS.oRegistry.CloseKey()
  574. WAIT WINDOW UPDATEREG_LOC NOWAIT
  575.     nRetCode = 0
  576.     m.cGetName = ALLTRIM(name)
  577.     m.cGetData = ALLTRIM(SUBST(data,3))
  578.     m.nRetCode = THIS.oRegistry.SetRegKey(m.cGetName ,m.cGetData , m.cLblRegKey, HKEY_CURRENT_USER)
  579.     IF m.nRetCode#0
  580.         =MESSAGEBOX(NOREGWRITE_LOC)
  581.         EXIT
  582.     ENDIF
  583. ENDSCAN
  584. WAIT CLEAR
  585. ENDPROC
  586. PROCEDURE Init
  587. PARAMETER lEditMode
  588. IF TYPE("m.lEditMode")="L" AND m.lEditMode
  589.     * Edit record - if we ever add support for this
  590.     THIS.EditMode = 1
  591.     THIS.ResetLabel
  592.     * Add record
  593.     THIS.EditMode = 0
  594. ENDIF
  595. ENDPROC
  596. THISFORM
  597. DESCRIPTION
  598. ENABLED
  599. VALUE
  600. LCHANGEDESC
  601. CDELIM
  602. CSAVEVALUE    
  603. OGPMETRIC
  604. LABELHEIGHT
  605. LABELWIDTH
  606. CCHANGEVALUE
  607. SETFOCUS
  608. Click,
  609. Enter label measurements in inches:
  610. Enter label measurements in centimeters:
  611. CDELIM
  612. VALUE
  613. THISFORM
  614. LENGLISH    
  615. LBLPROMPT
  616. CAPTION
  617. LEFTMARGIN    
  618. CONVERTMM
  619. SPACESBETWEEN
  620. LABELWIDTH    
  621. TOPMARGIN
  622. LABELHEIGHT
  623. DESCRIPTION
  624. LCHANGEDESC
  625. REFRESH
  626. Click,
  627. VALUE
  628. Init,
  629. THISFORM
  630. LCHANGEDESC
  631. CDELIM    
  632. OGPMETRIC
  633. VALUE
  634. DESCRIPTION
  635. LABELHEIGHT
  636. LABELWIDTH    
  637. LostFocus,
  638. THISFORM
  639. RELEASE
  640. Click,
  641. JArial, 0, 9, 5, 15, 12, 13, 3, 0
  642. MS Sans Serif, 0, 8, 5, 13, 11, 11, 2, 0
  643. CTop = 98
  644. Left = 399
  645. Height = 17
  646. Width = 33
  647. Name = "oRegistry"
  648. form1
  649.     oRegistry
  650. custom
  651. ilabel_file
  652. lenglish
  653. lchangedesc
  654. editmode
  655. cchangevalue
  656. *convertmm 
  657. *resetlabel 
  658. *labeltoregistry 
  659. commandbutton
  660. commandbutton
  661.     cmdCancel
  662. form1
  663. Top = 38
  664. Left = 408
  665. Height = 23
  666. Width = 72
  667. FontName = "MS Sans Serif"
  668. FontSize = 8
  669. Cancel = .T.
  670. Caption = "Cancel"
  671. TabIndex = 11
  672. Name = "cmdCancel"
  673. ,PROCEDURE Click
  674. THISFORM.RELEASE
  675. ENDPROC
  676. ..\wzcommon\registry.vcx
  677. registry
  678. }Top = 42
  679. Left = 360
  680. Height = 17
  681. Width = 36
  682. FontName = "MS Sans Serif"
  683. FontSize = 8
  684. Caption = "\<Set"
  685. Name = "chkSet"
  686. form1
  687. chkSet
  688. commandbutton
  689. commandbutton
  690. cmdAdd
  691. form1
  692. Top = 10
  693. Left = 408
  694. Height = 23
  695. Width = 72
  696. FontName = "MS Sans Serif"
  697. FontSize = 8
  698. Caption = "\<Add"
  699. Default = .T.
  700. TabIndex = 10
  701. Name = "cmdAdd"
  702. aPROCEDURE Click
  703. #DEFINE cMess1_loc 'Please supply a value for Label Name'
  704. #DEFINE cMess2_loc 'Please supply a value for Description'
  705. #DEFINE cMess3_loc 'Please supply a value for Left Margin'
  706. #DEFINE cMess4_loc 'Please supply a value for Label Height'
  707. #DEFINE cMess5_loc 'Please supply a value for Number Across'
  708. #DEFINE cMess6_loc 'Please supply a value for Top Margin'
  709. #DEFINE cMess7_loc 'Please supply a value for Label Width'
  710. #DEFINE cMess8_loc 'Please supply a value for Space Between'
  711. #DEFINE cMess9_loc 'New Label Layout successfully added to labels file and registry.'
  712. #DEFINE cMess10_loc 'The new label layout could not be added. Make sure you have Labels file.'
  713. #DEFINE cDupeLbL_LOC "A label with the same name already exists, would you like to replace it?"
  714. LOCAL nLeftMarg, nSpace, nLblWid, nTopMarg
  715. LOCAL nLblHgt, cDataFld, cDesc, cDelim
  716. LOCAL lExists, cSaveName
  717. DO CASE
  718. CASE EMPTY(ThisForm.LayoutName.Value)
  719.     =messagebox(cMess1_loc)
  720.     ThisForm.LayoutName.SetFocus
  721.     RETURN
  722. CASE EMPTY(ThisForm.LabelHeight.Value)
  723.     =messagebox(cMess4_loc)
  724.     ThisForm.LabelHeight.SetFocus
  725.     RETURN
  726. CASE EMPTY(ThisForm.LabelWidth.Value)
  727.     =messagebox(cMess7_loc)
  728.     ThisForm.LabelWidth.SetFocus
  729.     RETURN
  730. CASE EMPTY(ThisForm.NumberAcross.Value)
  731.     =messagebox(cMess5_loc)
  732.     ThisForm.LabelWidth.SetFocus
  733.     RETURN
  734. ENDCASE
  735. m.cSaveName = ""
  736. SELECT userlbls
  737. * Add mode only
  738. IF THISFORM.EditMode = 0
  739.     LOCATE FOR UPPER(ALLTRIM(name)) == UPPER(ALLTRIM(THISFORM.LayOutName.Value));
  740.      AND !DELETE()
  741.     IF FOUND()
  742.         IF MESSAGEBOX(cDupeLbL_LOC,36)#6
  743.             RETURN
  744.         ENDIF
  745.         m.lExists = .T.
  746.     m.cSaveName = THISFORM.LayOutName.Value
  747.     ENDIF
  748.     * Edit mode
  749.     m.cSaveName = WzLabels.Name    
  750.     LOCATE FOR UPPER(ALLTRIM(name)) == UPPER(ALLTRIM(m.cSaveName));
  751.      AND !DELETE()
  752.     m.lExists = .T.
  753. ENDIF
  754. nLeftMarg = ThisForm.LeftMargin.Value
  755. nSpace = ThisForm.SpacesBetween.Value
  756. nLblWid = ThisForm.LabelWidth.Value
  757. nTopMarg =    ThisForm.TopMargin.Value
  758. nLblHgt    = ThisForm.LabelHeight.Value
  759. IF (ThisForm.ogpMetric.Value = 2)
  760.     * If the values are metric, convert them to english
  761.     nLeftMarg = ThisForm.ConvertMM(m.nLeftMarg)
  762.     nSpace = ThisForm.ConvertMM(m.nSpace)
  763.     nLblWid = ThisForm.ConvertMM(m.nLblWid)
  764.     nTopMarg = ThisForm.ConvertMM(m.nTopMarg)
  765.     nLblHgt = ThisForm.ConvertMM(m.nLblHgt)
  766. ENDIF
  767. * Convert to 1/10000 of an inch for report writer
  768. nLeftMarg = ALLTRIM(STR(ROUND(m.nLeftMarg,5) * 10000))
  769. nSpace = ALLTRIM(STR(ROUND(m.nSpace,5) * 10000))
  770. nLblWid = ALLTRIM(STR(ROUND(m.nLblWid,5) * 10000))
  771. nTopMarg = ALLTRIM(STR(ROUND(m.nTopMarg,5) * 10000))
  772. nLblHgt = ALLTRIM(STR(ROUND(m.nLblHgt,5) * 10000))
  773. m.cDelim = IIF(THISFORM.ogpMetric.Value=1,'"','cm')
  774. m.cDesc = PADR(LEFT(ALLTRIM(ThisForm.LayoutName.Value),11),11)+ " "
  775. IF THISFORM.lChangeDesc
  776.     LOCAL nSepPos,cPart1,cPart2,cTmpStr
  777.     cTmpStr = LEFT(ALLTRIM(ThisForm.Description.Value),22)
  778.     nSepPos = ATC("X",m.cTmpStr)
  779.     IF nSepPos #0
  780.         cPart1 = PADR(SUBSTR(cTmpStr,1,nSepPos-1),11)
  781.         cPart2 = PADR(ALLTRIM(SUBSTR(cTmpStr,nSepPos+1)),11)
  782.         m.cDesc = m.cDesc + m.cPart1 + m.cPart2
  783.     ELSE
  784.         * No separator, so we can't parse
  785.         THISFORM.lChangeDesc = .F.
  786.     ENDIF
  787. ENDIF
  788. IF !THISFORM.lChangeDesc
  789.     m.cDesc = m.cDesc + PADR(ALLTRIM(STR(ThisForm.LabelHeight.Value,8,2))+m.cDelim,11)
  790.     m.cDesc = m.cDesc + PADR(ALLTRIM(STR(ThisForm.LabelWidth.Value,8,2))+m.cDelim,11)
  791. ENDIF
  792. m.cDesc = m.cDesc +    PADL(ALLTRIM(STR(ThisForm.NumberAcross.Value)),2," ")+" "
  793. m.cDataFld = CHR(4)+CHR(0) + m.cDesc + ;
  794.     PADL(m.nLeftMarg,8,"0") + ;
  795.     PADL(ALLTRIM(STR(ThisForm.NumberAcross.Value)),2,"0") + ;
  796.     PADL(m.nSpace,8,"0") + ;
  797.     PADL(m.nLblWid,8,"0") + ;
  798.     PADL(m.nTopMarg,8,"0") + ;
  799.     PADL(m.nLblHgt,8,"0") + ;
  800.     IIF(ThisForm.ogpMetric.Value#1,'T','F')
  801. IF m.lExists
  802.     REPLACE Name WITH ThisForm.LayoutName.Value,;
  803.             Ckval WITH VAL(SYS(2007,SUBSTR(m.cDataFld,3))),;
  804.              Data WITH m.cDataFld
  805.     SELECT wzlabels
  806.     LOCATE FOR UPPER(ALLTRIM(name)) == UPPER(ALLTRIM(m.cSaveName)) AND !DELETE()
  807.     IF FOUND()
  808.         REPLACE Name WITH ThisForm.LayoutName.Value,;
  809.             LblDimen WITH ALLT(SUBSTR(userlbls.Data,15,11))+" x "+ALLT(SUBSTR(userlbls.Data,26,11)),;
  810.              LblColumns WITH ALLT(SUBSTR(userlbls.Data,37,2)),;
  811.              Data WITH m.cDataFld
  812.     ENDIF
  813.     INSERT INTO userlbls VALUES;
  814.          ('DATAW','LABELLYT' ,ThisForm.LayoutName.Value,.F.,;
  815.          VAL(SYS(2007, SUBSTR(m.cDataFld,3))),m.cDataFld,{})
  816.     INSERT INTO WzLabels (Name, LblDimen, LblColumns, Data);
  817.          VALUE (userlbls.Name,;
  818.           ALLTRIM(SUBSTR(userlbls.Data,15,11))+" x "+ALLTRIM(SUBSTR(userlbls.Data,26,11)), ;
  819.           ALLTRIM(SUBSTR(userlbls.Data,37,2)),userlbls.Data)
  820. ENDIF
  821. THISFORM.labeltoregistry
  822. WAIT WINDOW cMess9_loc TIMEOUT 1
  823. THISFORM.RELEASE
  824. ENDPROC
  825. THISFORM
  826. LCHANGEDESC
  827. CDELIM    
  828. OGPMETRIC
  829. VALUE
  830. DESCRIPTION
  831. LABELHEIGHT
  832. LABELWIDTH    
  833. LostFocus,
  834. PROCEDURE Click
  835. THISFORM.Description.Enabled = (THIS.Value=1)
  836. THISFORM.lChangeDesc = (THIS.Value=1)
  837. IF THIS.Value # 1
  838.     LOCAL cDelim,cSaveValue
  839.     cSaveValue = ALLTRIM(ThisForm.Description.Value)
  840.     m.cDelim = IIF(THISFORM.ogpMetric.Value=1,'"',' cm')
  841.     ThisForm.Description.Value = ALLTRIM(STR(ThisForm.LabelHeight.Value,8,2))+;
  842.         m.cDelim+" x "+ALLTRIM(STR(ThisForm.LabelWidth.Value,8,2))+m.cDelim
  843.     IF ALLTRIM(ThisForm.Description.Value)#m.cSaveValue
  844.         THISFORM.cChangeValue = m.cSaveValue
  845.     ENDIF
  846.     IF !EMPTY(THISFORM.cChangeValue)
  847.         ThisForm.Description.Value = THISFORM.cChangeValue
  848.     ENDIF
  849.     THISFORM.Description.SetFocus()
  850. ENDIF
  851. ENDPROC
  852. checkbox
  853. checkbox
  854. AutoSize = .T.
  855. FontName = "MS Sans Serif"
  856. FontSize = 8
  857. BackStyle = 0
  858. Caption = "Dimensions:"
  859. Height = 15
  860. Left = 14
  861. Top = 44
  862. Width = 59
  863. TabIndex = 0
  864. BackColor = 192,192,192
  865. Name = "Label8"
  866. form1
  867. Label8
  868. label
  869. label
  870. FontName = "MS Sans Serif"
  871. FontSize = 8
  872. BackStyle = 1
  873. Caption = "Enter label measurements in inches:"
  874. Height = 15
  875. Left = 14
  876. Top = 135
  877. Width = 217
  878. TabIndex = 0
  879. Name = "lblPrompt"
  880. form1
  881.     lblPrompt
  882. label
  883. label
  884. AutoSize = .T.
  885. FontName = "MS Sans Serif"
  886. FontSize = 8
  887. BackStyle = 1
  888. Caption = "Unit of Measure"
  889. Height = 15
  890. Left = 22
  891. Top = 72
  892. Width = 77
  893. TabIndex = 0
  894. Name = "Label6"
  895. form1
  896. Label6
  897. label
  898. label
  899. CButtonCount = 2
  900. Value = 1
  901. Height = 41
  902. Left = 14
  903. Top = 78
  904. Width = 155
  905. TabIndex = 3
  906. Name = "ogpMetric"
  907. Option1.FontName = "MS Sans Serif"
  908. Option1.FontSize = 8
  909. Option1.Caption = "Englis\<h"
  910. Option1.Value = 1
  911. Option1.Height = 18
  912. Option1.Left = 9
  913. Option1.Top = 13
  914. Option1.Width = 66
  915. Option1.AutoSize = .F.
  916. Option1.Name = "Option1"
  917. Option2.FontName = "MS Sans Serif"
  918. Option2.FontSize = 8
  919. Option2.Caption = "\<Metric"
  920. Option2.Value = 0
  921. Option2.Height = 17
  922. Option2.Left = 82
  923. Option2.Top = 13
  924. Option2.Width = 60
  925. Option2.AutoSize = .F.
  926. Option2.Name = "Option2"
  927. form1
  928.     ogpMetric
  929. optiongroup
  930. optiongroup
  931. )PROCEDURE Init
  932. this.value = 1
  933. ENDPROC
  934. FontName = "MS Sans Serif"
  935. FontSize = 8
  936. Height = 21
  937. InputMask = "##"
  938. KeyboardHighValue = 20
  939. KeyboardLowValue = 1
  940. Left = 368
  941. SpecialEffect = 1
  942. SpinnerHighValue =  20.00
  943. SpinnerLowValue =   1.00
  944. TabIndex = 9
  945. Top = 170
  946. Width = 44
  947. Value = 0
  948. Name = "NumberAcross"
  949. form1
  950. NumberAcross
  951. spinner
  952. spinner
  953. form1
  954. Label3
  955. label
  956. label
  957. form1
  958. textbox
  959. label
  960. label
  961. Label1
  962. form1
  963. AutoSize = .T.
  964. FontName = "MS Sans Serif"
  965. FontSize = 8
  966. BackStyle = 0
  967. Caption = "\<Label Name:"
  968. Height = 15
  969. Left = 14
  970. Top = 14
  971. Width = 62
  972. TabIndex = 0
  973. BackColor = 192,192,192
  974. Name = "Label1"
  975. textbox
  976. textbox
  977. LayoutName
  978. form1
  979. FontName = "MS Sans Serif"
  980. FontSize = 8
  981. Value = Label1
  982. Height = 21
  983. InputMask = "XXXXXXXXXXX"
  984. Left = 94
  985. TabIndex = 1
  986. Top = 10
  987. Width = 256
  988. Name = "LayoutName"
  989. textbox
  990. textbox
  991. Description
  992. form1
  993. FontName = "MS Sans Serif"
  994. FontSize = 8
  995. Value = 0.00" x 0.00"
  996. Enabled = .F.
  997. Height = 21
  998. InputMask = "XXXXXXXXXXXXXXXXXXXXXX"
  999. Left = 94
  1000. TabIndex = 2
  1001. Top = 40
  1002. Width = 256
  1003. DisabledForeColor = 64,0,64
  1004. Name = "Description"
  1005. image
  1006. image
  1007. Image1
  1008. form1
  1009. XPicture = label2.bmp
  1010. Height = 205
  1011. Left = 12
  1012. Top = 150
  1013. Width = 481
  1014. Name = "Image1"
  1015. shape
  1016. shape
  1017. Shape1
  1018. form1
  1019. PTop = 173
  1020. Left = 371
  1021. Height = 20
  1022. Width = 43
  1023. FillStyle = 0
  1024. Name = "Shape1"
  1025. textbox
  1026. textbox
  1027. LeftMargin
  1028. form1
  1029. FontName = "MS Sans Serif"
  1030. FontSize = 8
  1031. Alignment = 1
  1032. BackStyle = 0
  1033. BorderStyle = 0
  1034. Value = 0.00
  1035. Height = 17
  1036. InputMask = "999.9999"
  1037. Left = 30
  1038. SpecialEffect = 1
  1039. TabIndex = 4
  1040. Top = 269
  1041. Width = 55
  1042. Name = "LeftMargin"
  1043. textbox
  1044. textbox
  1045.     TopMargin
  1046. form1
  1047. FontName = "MS Sans Serif"
  1048. FontSize = 8
  1049. Alignment = 3
  1050. BackStyle = 0
  1051. BorderStyle = 0
  1052. Value = 0.0000
  1053. Height = 17
  1054. InputMask = "999.9999"
  1055. Left = 129
  1056. SpecialEffect = 1
  1057. TabIndex = 5
  1058. Top = 170
  1059. Width = 60
  1060. Name = "TopMargin"
  1061. textbox
  1062. textbox
  1063. LabelHeight
  1064. form1
  1065. FontName = "MS Sans Serif"
  1066. FontSize = 8
  1067. Alignment = 1
  1068. BackStyle = 0
  1069. BorderStyle = 0
  1070. Value = 0.00
  1071. Height = 17
  1072. InputMask = "999.9999"
  1073. Left = 100
  1074. SpecialEffect = 1
  1075. TabIndex = 6
  1076. Top = 209
  1077. Width = 55
  1078. Name = "LabelHeight"
  1079. !PROCEDURE LostFocus
  1080. IF THISFORM.lChangeDesc
  1081.     RETURN
  1082. ENDIF
  1083. LOCAL cDelim
  1084. m.cDelim = IIF(THISFORM.ogpMetric.Value=1,'"',' cm')
  1085. ThisForm.Description.Value = ALLTRIM(STR(ThisForm.LabelHeight.Value,8,2))+;
  1086.         m.cDelim+" x "+ALLTRIM(STR(ThisForm.LabelWidth.Value,8,2))+m.cDelim
  1087. ENDPROC
  1088. FontName = "MS Sans Serif"
  1089. FontSize = 8
  1090. Alignment = 1
  1091. BackStyle = 0
  1092. Caption = "Number Across:"
  1093. Height = 15
  1094. Left = 255
  1095. Top = 173
  1096. Width = 100
  1097. TabIndex = 0
  1098. Name = "Label3"
  1099. FontName = "MS Sans Serif"
  1100. FontSize = 8
  1101. Alignment = 1
  1102. BackStyle = 0
  1103. BorderStyle = 0
  1104. Value = 0.00
  1105. Height = 17
  1106. InputMask = "999.9999"
  1107. Left = 223
  1108. SpecialEffect = 1
  1109. TabIndex = 8
  1110. Top = 313
  1111. Width = 55
  1112. Name = "SpacesBetween"
  1113. textbox
  1114. textbox
  1115. LabelWidth
  1116. form1
  1117. FontName = "MS Sans Serif"
  1118. FontSize = 8
  1119. Alignment = 1
  1120. BackStyle = 0
  1121. BorderStyle = 0
  1122. Value = 0.00
  1123. Height = 17
  1124. InputMask = "999.9999"
  1125. Left = 162
  1126. SpecialEffect = 1
  1127. TabIndex = 7
  1128. Top = 246
  1129. Width = 55
  1130. Name = "LabelWidth"
  1131. !PROCEDURE LostFocus
  1132. IF THISFORM.lChangeDesc
  1133.     RETURN
  1134. ENDIF
  1135. LOCAL cDelim
  1136. m.cDelim = IIF(THISFORM.ogpMetric.Value=1,'"',' cm')
  1137. ThisForm.Description.Value = ALLTRIM(STR(ThisForm.LabelHeight.Value,8,2))+;
  1138.         m.cDelim+" x "+ALLTRIM(STR(ThisForm.LabelWidth.Value,8,2))+m.cDelim
  1139. ENDPROC
  1140. SpacesBetween
  1141. textbox
  1142. PROCEDURE Click
  1143. #DEFINE ENGMEASURE    '"'
  1144. #DEFINE METMEASURE    ' cm'
  1145. #DEFINE ENGPROMPT_LOC    "Enter label measurements in inches:"
  1146. #DEFINE    METPROMPT_LOC    "Enter label measurements in centimeters:"
  1147. LOCAL cDelim
  1148. IF (THIS.Value = 1 AND THISFORM.lEnglish) OR;
  1149.     (THIS.Value # 1 AND !THISFORM.lEnglish)
  1150.     RETURN
  1151. ENDIF
  1152. cDelim = IIF(This.Value=1,ENGMEASURE,METMEASURE)
  1153. THISFORM.lEnglish = (This.Value = 1)
  1154. IF This.Value = 1
  1155.     ThisForm.lblPrompt.Caption = ENGPROMPT_LOC
  1156.     * Convert metric to english
  1157.     ThisForm.LeftMargin.Value = ThisForm.ConvertMM(ThisForm.LeftMargin.Value)
  1158.     ThisForm.SpacesBetween.Value = ThisForm.ConvertMM(ThisForm.SpacesBetween.Value)
  1159.     ThisForm.LabelWidth.Value = ThisForm.ConvertMM(ThisForm.LabelWidth.Value)
  1160.     ThisForm.TopMargin.Value = ThisForm.ConvertMM(ThisForm.TopMargin.Value)
  1161.     ThisForm.LabelHeight.Value = ThisForm.ConvertMM(ThisForm.LabelHeight.Value)
  1162.     ThisForm.Description.Value = ALLTRIM(STR(ThisForm.LabelHeight.Value,8,2))+;
  1163.         ALLTRIM(STR(ThisForm.LabelHeight.Value,8,2))
  1164.     ThisForm.lblPrompt.Caption = METPROMPT_LOC
  1165.     * Convert english to metric
  1166.     ThisForm.LeftMargin.Value = ThisForm.ConvertMM(ThisForm.LeftMargin.Value,.t.)
  1167.     ThisForm.SpacesBetween.Value = ThisForm.ConvertMM(ThisForm.SpacesBetween.Value,.t.)
  1168.     ThisForm.LabelWidth.Value = ThisForm.ConvertMM(ThisForm.LabelWidth.Value,.t.)
  1169.     ThisForm.TopMargin.Value = ThisForm.ConvertMM(ThisForm.TopMargin.Value,.t.)
  1170.     ThisForm.LabelHeight.Value = ThisForm.ConvertMM(ThisForm.LabelHeight.Value,.t.)
  1171. ENDIF
  1172. IF !THISFORM.lChangeDesc
  1173.     ThisForm.Description.Value = ALLTRIM(STR(ThisForm.LabelHeight.Value,8,2))+;
  1174.         m.cDelim+" x "+ALLTRIM(STR(ThisForm.LabelWidth.Value,8,2))+m.cDelim
  1175. ENDIF
  1176. ThisForm.Refresh
  1177. ENDPROC
  1178. Please supply a value for Label Name
  1179. Please supply a value for Label Height
  1180. Please supply a value for Label Width
  1181. Please supply a value for Number Across
  1182. A label with the same name already exists, would you like to replace it?
  1183. userlbls
  1184. DATAW
  1185. LABELLYT
  1186. WzLabels
  1187. New Label Layout successfully added to labels file and registry.
  1188. NLEFTMARG
  1189. NSPACE
  1190. NLBLWID
  1191. NTOPMARG
  1192. NLBLHGT
  1193. CDATAFLD
  1194. CDESC
  1195. CDELIM
  1196. LEXISTS    
  1197. CSAVENAME
  1198. THISFORM
  1199. LAYOUTNAME
  1200. VALUE
  1201. SETFOCUS
  1202. LABELHEIGHT
  1203. LABELWIDTH
  1204. NUMBERACROSS
  1205. USERLBLS
  1206. EDITMODE
  1207. WZLABELS
  1208. LEFTMARGIN
  1209. SPACESBETWEEN    
  1210. TOPMARGIN    
  1211. OGPMETRIC    
  1212. CONVERTMM
  1213. LCHANGEDESC
  1214. NSEPPOS
  1215. CPART1
  1216. CPART2
  1217. CTMPSTR
  1218. DESCRIPTION
  1219. CKVAL
  1220. LBLDIMEN
  1221. LBLCOLUMNS
  1222. LABELTOREGISTRY
  1223. RELEASE
  1224. Click,
  1225. CINVALUE    
  1226. LWHICHWAY
  1227. NINVALUE    
  1228. COUTVALUE
  1229. \<Update
  1230. Enter label measurements in centimeters:
  1231. CLBLDATA
  1232. CDESC
  1233. CDELIM    
  1234. CDATADESC
  1235. CMDADD
  1236. CAPTION
  1237. LAYOUTNAME
  1238. VALUE
  1239. NAME    
  1240. OGPMETRIC    
  1241. LBLPROMPT
  1242. LEFTMARGIN
  1243. NUMBERACROSS
  1244. SPACESBETWEEN
  1245. LABELWIDTH    
  1246. TOPMARGIN
  1247. LABELHEIGHT
  1248. THISFORM    
  1249. CONVERTMM
  1250. LCHANGEDESC
  1251. CPART1
  1252. CPART2
  1253. DESCRIPTION
  1254. ENABLED
  1255. CHKSET
  1256. CCHANGEVALUE
  1257. REFRESH
  1258. Software\Microsoft\VisualFoxPro\
  1259. \Labels
  1260. Could not write labels to Registry.
  1261. Updating Registry with label definitions...
  1262. Could not write labels to Registry.
  1263. NRETCODE    
  1264. NSAVEAREA
  1265. CGETNAME
  1266. CGETDATA
  1267. CLBLREGKEY
  1268. VERSION
  1269. THIS    
  1270. OREGISTRY
  1271. OPENKEY
  1272. CLOSEKEY
  1273. DATA    
  1274. SETREGKEYh
  1275. m.lEditModeb
  1276. LEDITMODE
  1277. EDITMODE
  1278. RESETLABEL    
  1279. convertmm,
  1280. resetlabel
  1281. labeltoregistry
  1282. Init&    
  1283. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1284. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1285. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1286. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1287. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1288. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1289. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1290. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1291. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1292. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1293. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1294. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1295. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1296. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1297. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1298. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1299. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1300. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1301. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1302. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1303. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1304. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1305. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1306. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1307. wwwwwwwwwwwwwwwwwwwwwwwwwwwwp
  1308. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1309. wwwwwwwwwwwwwwwwwwwwwwwwwwwwp
  1310. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1311. wwwwwwwwwwwwwwwwwwwwwwwwwwwwp
  1312. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1313. wwwwwwwwwwwwwwwwwwwwwwwwwwwwp
  1314. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1315. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1316. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1317. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1318. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1319. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1320. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1321. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1322. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1323. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1324. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1325. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1326. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1327. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1328. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1329. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1330. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1331. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1332. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1333. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1334. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1335. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1336. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1337. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1338. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1339. wwwwwwwwwwwwwwwwwwwwwwwww
  1340. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1341. wwwwwwwwwwwwwwwwwwwwwwwww
  1342. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1343. wwwwwwwwwwwwwwwwwwwwwwwww
  1344. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1345. wwwwwwwwwwwwwwwwwwwwwwwww
  1346. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1347. wwwwwwwwwwwwwwwwwwwwwwwww
  1348. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1349. wwwwwwwwwwwwwwwwwwwwwwwww
  1350. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1351. wwwwwwwwwwwwwwwwwwwwwwwww
  1352. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1353. wwwwwwwwwwwwwwwwwwwwwwwww
  1354. wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
  1355. PLATFORM
  1356. UNIQUEID
  1357. TIMESTAMP
  1358. CLASS
  1359. CLASSLOC
  1360. BASECLASS
  1361. OBJNAME
  1362. PARENT
  1363. PROPERTIES
  1364. PROTECTED
  1365. METHODS
  1366. OBJCODE
  1367. RESERVED1
  1368. RESERVED2
  1369. RESERVED3
  1370. RESERVED4
  1371. RESERVED5
  1372. RESERVED6
  1373. RESERVED7
  1374. RESERVED8
  1375.  COMMENT Class               
  1376.  WINDOWS _RJL0UQOZ1 579367670
  1377.  COMMENT RESERVED            
  1378.  WINDOWS _RJL0UV82J 579367771
  1379.  COMMENT RESERVED            
  1380.  WINDOWS _RJL0UXJVX 579367829
  1381.  COMMENT RESERVED            
  1382.  WINDOWS _RJL0V1NVV 579434725
  1383.  COMMENT RESERVED            
  1384.  WINDOWS _RJL0U66ZY 609439952z
  1385.  COMMENT RESERVED            
  1386. VERSION =   3.00
  1387. registry.h
  1388. registry
  1389. registry.h
  1390. Pixels
  1391. Class
  1392. custom
  1393. registry
  1394. nuserkey = 0
  1395. cvfpoptpath = 
  1396. cregdllfile = 
  1397. cinidllfile = 
  1398. codbcdllfile = 
  1399. ncurrentos = 0
  1400. ncurrentkey = 0
  1401. capppathkey = 
  1402. Name = "registry"
  1403. custom
  1404. custom
  1405. Name = "odbcreg"
  1406. registry.vcx
  1407. registry.h
  1408.     oldinireg
  1409. odbcreg
  1410. registry
  1411. Class
  1412. Pixels
  1413. registry.h
  1414. odbcreg
  1415. registry.h
  1416. registry.vcx
  1417. registry.h
  1418. foxreg
  1419. registry.h
  1420. Pixels
  1421. Class
  1422. registry
  1423. foxreg
  1424. Name = "foxreg"
  1425. custom
  1426. registry.h
  1427. Pixels
  1428. registry
  1429. Class
  1430. registry.h
  1431. filereg
  1432. registry.h
  1433. Pixels
  1434. Class
  1435. registry
  1436. filereg
  1437. *setfoxoption Sets an option from FoxPro registry settings.
  1438. *getfoxoption Retrieves an option from FoxPro registry settings.
  1439. *enumfoxoptions 
  1440. Name = "filereg"
  1441. custom
  1442. registry.vcx
  1443. PROCEDURE setfoxoption
  1444. LPARAMETER cOptName,cOptVal
  1445. RETURN THIS.SetRegKey(cOptName,cOptVal,THIS.cVFPOptPath,THIS.nUserKey)
  1446. ENDPROC
  1447. PROCEDURE getfoxoption
  1448. LPARAMETER cOptName,cOptVal
  1449. RETURN THIS.GetRegKey(cOptName,@cOptVal,THIS.cVFPOptPath,THIS.nUserKey)
  1450. ENDPROC
  1451. PROCEDURE enumoptions
  1452. LPARAMETER aFoxOpts
  1453. RETURN THIS.EnumOptions(@aFoxOpts,THIS.cVFPOptPath,THIS.nUserKey,.F.)
  1454. ENDPROC
  1455. registry.vcx
  1456. custom
  1457.     oldinireg
  1458. Name = "oldinireg"
  1459. m.cExtensionb
  1460. CEXTENSION
  1461. CEXTNKEY
  1462. CAPPKEY
  1463. LSERVER
  1464. NERRNUM
  1465. COPTNAME
  1466. OPENKEY
  1467. GETKEYVALUE
  1468. CLOSEKEY
  1469. GETAPPLICATION
  1470. \CurVer
  1471. CCLASS
  1472. CEXTNKEY
  1473. CAPPKEY
  1474. LSERVER
  1475. NERRNUM
  1476. COPTNAME
  1477. OPENKEY
  1478. GETKEYVALUE
  1479. CLOSEKEY
  1480. GETAPPLICATION 
  1481. m.lServerb
  1482. \Protocol\StdFileEditing\Server
  1483. \Shell\Open\Command
  1484. CEXTNKEY
  1485. CAPPKEY
  1486. LSERVER
  1487. NERRNUM
  1488. COPTNAME
  1489. CAPPPATHKEY
  1490. OPENKEY
  1491. GETKEYVALUE
  1492. CLOSEKEY
  1493. getapppath,
  1494. getlatestversion
  1495. getapplication
  1496. SQLDrivers
  1497. SQLDataSources
  1498. LLOADEDODBCS
  1499. CODBCDLLFILE
  1500. FDIRECTION
  1501. SZDRIVERDESC
  1502. CBDRIVERDESCMAX
  1503. PCBDRIVERDESC
  1504. SZDRIVERATTRIBUTES
  1505. CBDRVRATTRMAX
  1506. PCBDRVRATTR
  1507. SZDSN
  1508. CBDSNMAX
  1509. PCBDSN
  1510. SZDESCRIPTION
  1511. CBDESCRIPTIONMAX
  1512. PCBDESCRIPTION
  1513. SQLDRIVERS    
  1514. LHADERROR
  1515. SQLDATASOURCES!
  1516. m.lDataSourcesb
  1517. ADRVRS
  1518. LDATASOURCES
  1519. NODBCENV
  1520. NRETVAL
  1521. DSNDESC
  1522. MDESC
  1523. LOADODBCFUNCS
  1524. SQLDATASOURCES
  1525. SQLDRIVERSa
  1526. Software\ODBC\ODBCINST.INI\
  1527. ADRVROPTS
  1528. CODBCDRIVER
  1529. CSOURCEKEY
  1530. ENUMOPTIONS[
  1531. Software\ODBC\ODBC.INI\
  1532. ADRVROPTS
  1533. CDATASOURCE
  1534. CSOURCEKEY
  1535. ENUMOPTIONS
  1536. loadodbcfuncs,
  1537. getodbcdrvrsH
  1538. enumodbcdrvrs
  1539. enumodbcdata~
  1540. COPTNAME
  1541. COPTVAL
  1542. THIS    
  1543. SETREGKEY
  1544. CVFPOPTPATH
  1545. NUSERKEY/
  1546. COPTNAME
  1547. COPTVAL
  1548. THIS    
  1549. GETREGKEY
  1550. CVFPOPTPATH
  1551. NUSERKEY(
  1552. AFOXOPTS
  1553. ENUMOPTIONS
  1554. CVFPOPTPATH
  1555. NUSERKEY
  1556. setfoxoption,
  1557. getfoxoption
  1558. enumoptions
  1559. *getapppath Checks and returns path of application associated with a particular extension (e.g., XLS, DOC).
  1560. *getlatestversion Returns latest version for a specified application.
  1561. *getapplication Retrieves application key.
  1562. *getinisection Retrieves information from INI section.
  1563. *getinientry Retrieves information from INI entry.
  1564. *writeinientry Writes a specific INI entry.
  1565. *loadinifuncs Loads functions needed for reading INI files.
  1566. *loadodbcfuncs Loads ODBC registry functions.
  1567. *getodbcdrvrs Retrieves ODBC drivers.
  1568. *enumodbcdrvrs Enumerates through ODBC drivers.
  1569. *enumodbcdata Enumerates through ODBC data sources.
  1570. GPROCEDURE loadodbcfuncs
  1571. IF THIS.lLoadedODBCs
  1572.     RETURN ERROR_SUCCESS
  1573. ENDIF
  1574. * Check API file containing functions
  1575. IF EMPTY(THIS.cODBCDLLFile)
  1576.     RETURN ERROR_NOODBCFILE
  1577. ENDIF
  1578. LOCAL henv,fDirection,szDriverDesc,cbDriverDescMax
  1579. LOCAL pcbDriverDesc,szDriverAttributes,cbDrvrAttrMax,pcbDrvrAttr
  1580. LOCAL szDSN,cbDSNMax,pcbDSN,szDescription,cbDescriptionMax,pcbDescription
  1581. DECLARE Short SQLDrivers IN (THIS.cODBCDLLFile) ;
  1582.     Integer henv, Integer fDirection, ;
  1583.     String @ szDriverDesc, Integer cbDriverDescMax, Integer pcbDriverDesc, ;
  1584.     String @ szDriverAttributes, Integer cbDrvrAttrMax, Integer pcbDrvrAttr
  1585. IF THIS.lhaderror && error loading library
  1586.     RETURN -1
  1587. ENDIF
  1588. DECLARE Short SQLDataSources IN (THIS.cODBCDLLFile) ;
  1589.     Integer henv, Integer fDirection, ;
  1590.     String @ szDSN, Integer cbDSNMax, Integer @ pcbDSN, ;
  1591.     String @ szDescription, Integer cbDescriptionMax,Integer pcbDescription
  1592. THIS.lLoadedODBCs = .T.
  1593. RETURN ERROR_SUCCESS
  1594. ENDPROC
  1595. PROCEDURE getodbcdrvrs
  1596. PARAMETER aDrvrs,lDataSources
  1597. LOCAL nODBCEnv,nRetVal,dsn,dsndesc,mdsn,mdesc
  1598. lDataSources = IIF(TYPE("m.lDataSources")="L",m.lDataSources,.F.)
  1599. * Load API functions
  1600. nRetVal = THIS.LoadODBCFuncs()
  1601. IF m.nRetVal # ERROR_SUCCESS
  1602.     RETURN m.nRetVal
  1603. ENDIF
  1604. * Get ODBC environment handle
  1605. nODBCEnv=VAL(SYS(3053))
  1606. * -- Possible error messages
  1607. * 527 "cannot load odbc library"
  1608. * 528 "odbc entry point missing"
  1609. * 182 "not enough memory"
  1610. IF INLIST(nODBCEnv,527,528,182)
  1611.     * Failed
  1612.     RETURN ERROR_ODBCFAIL
  1613. ENDIF
  1614. DIMENSION aDrvrs[1,IIF(m.lDataSources,2,1)]
  1615. aDrvrs[1] = ""
  1616. DO WHILE .T.
  1617.     dsn=space(100)
  1618.     dsndesc=space(100)
  1619.     mdsn=0
  1620.     mdesc=0
  1621.     * Return drivers or data sources
  1622.     IF m.lDataSources
  1623.         nRetVal = SQLDataSources(m.nODBCEnv,SQL_FETCH_NEXT,@dsn,100,@mdsn,@dsndesc,255,@mdesc)
  1624.     ELSE
  1625.         nRetVal = SQLDrivers(m.nODBCEnv,SQL_FETCH_NEXT,@dsn,100,@mdsn,@dsndesc,100,@mdesc)
  1626.     ENDIF
  1627.     DO CASE
  1628.         CASE m.nRetVal = SQL_NO_DATA
  1629.             nRetVal = ERROR_SUCCESS
  1630.             EXIT
  1631.         CASE m.nRetVal # ERROR_SUCCESS AND m.nRetVal # 1 
  1632.             EXIT
  1633.         OTHERWISE
  1634.             IF !EMPTY(aDrvrs[1])
  1635.                 IF m.lDataSources
  1636.                     DIMENSION aDrvrs[ALEN(aDrvrs,1)+1,2]
  1637.                 ELSE
  1638.                     DIMENSION aDrvrs[ALEN(aDrvrs,1)+1,1]
  1639.                 ENDIF
  1640.             ENDIF
  1641.             dsn = ALLTRIM(m.dsn)
  1642.             aDrvrs[ALEN(aDrvrs,1),1] = LEFT(m.dsn,LEN(m.dsn)-1)
  1643.             IF m.lDataSources
  1644.                 dsndesc = ALLTRIM(m.dsndesc)                
  1645.                 aDrvrs[ALEN(aDrvrs,1),2] = LEFT(m.dsndesc,LEN(m.dsndesc)-1)            
  1646.             ENDIF
  1647.     ENDCASE
  1648. ENDDO
  1649. RETURN nRetVal
  1650. ENDPROC
  1651. PROCEDURE enumodbcdrvrs
  1652. LPARAMETER aDrvrOpts,cODBCDriver
  1653. LOCAL cSourceKey
  1654. cSourceKey = ODBC_DRVRS_KEY+m.cODBCDriver
  1655. RETURN THIS.EnumOptions(@aDrvrOpts,m.cSourceKey,HKEY_LOCAL_MACHINE,.F.)
  1656. ENDPROC
  1657. PROCEDURE enumodbcdata
  1658. LPARAMETER aDrvrOpts,cDataSource
  1659. LOCAL cSourceKey
  1660. cSourceKey = ODBC_DATA_KEY+cDataSource
  1661. RETURN THIS.EnumOptions(@aDrvrOpts,m.cSourceKey,HKEY_CURRENT_USER,.F.)
  1662. ENDPROC
  1663. m.cINIFileb
  1664. ASECTIONS
  1665. CSECTION
  1666. CINIFILE    
  1667. CINIVALUE
  1668. NTOTENTRIES
  1669. NLASTPOS
  1670. GETINIENTRY
  1671. NTMPPOSY
  1672. CVALUE
  1673. CSECTION
  1674. CENTRY
  1675. CINIFILE
  1676. CBUFFER
  1677. NBUFSIZE
  1678. NERRNUM    
  1679. NTOTPARMS
  1680. LOADINIFUNCS    
  1681. GETWININI
  1682. GETPRIVATEINI
  1683. CVALUE
  1684. CSECTION
  1685. CENTRY
  1686. CINIFILE
  1687. NERRNUM
  1688. LOADINIFUNCS
  1689. WRITEWININI
  1690. WRITEPRIVATEINIW
  1691. GetPrivateProfileString
  1692. Win32APIQ
  1693. GetPrivateINI
  1694. GetProfileString
  1695. Win32APIQ
  1696. GetWinINI
  1697. WriteProfileString
  1698. Win32APIQ
  1699. WriteWinINI
  1700. WritePrivateProfileString
  1701. Win32APIQ
  1702. WritePrivateINI
  1703. LLOADEDINIS
  1704. GETPRIVATEPROFILESTRING
  1705. WIN32API
  1706. GETPRIVATEINI    
  1707. LHADERROR
  1708. GETPROFILESTRING    
  1709. GETWININI
  1710. WRITEPROFILESTRING
  1711. WRITEWININI
  1712. WRITEPRIVATEPROFILESTRING
  1713. WRITEPRIVATEINI
  1714. getinisection,
  1715. getinientry
  1716. writeinientry
  1717. loadinifuncs
  1718. PROCEDURE getapppath
  1719. * Checks and returns path of application
  1720. * associated with a particular extension (e.g., XLS, DOC). 
  1721. LPARAMETER cExtension,cExtnKey,cAppKey,lServer
  1722. LOCAL nErrNum,cOptName
  1723. cOptName = ""
  1724. * Check Extension parameter
  1725. IF TYPE("m.cExtension") # "C" OR LEN(m.cExtension) > 3
  1726.     RETURN ERROR_BADPARM
  1727. ENDIF
  1728. m.cExtension = "."+m.cExtension
  1729. * Open extension key
  1730. nErrNum = THIS.OpenKey(m.cExtension)
  1731. IF m.nErrNum  # ERROR_SUCCESS
  1732.     RETURN m.nErrNum
  1733. ENDIF
  1734. * Get key value for file extension
  1735. nErrNum = THIS.GetKeyValue(cOptName,@cExtnKey)
  1736. * Close extension key
  1737. THIS.CloseKey()
  1738. IF m.nErrNum  # ERROR_SUCCESS
  1739.     RETURN m.nErrNum
  1740. ENDIF
  1741. RETURN THIS.GetApplication(cExtnKey,@cAppKey,lServer)
  1742. ENDPROC
  1743. PROCEDURE getlatestversion
  1744. LPARAMETER cClass,cExtnKey,cAppKey,lServer
  1745. LOCAL nErrNum,cOptName
  1746. cOptName = ""
  1747. * Open class key (e.g., Excel.Sheet)
  1748. nErrNum = THIS.OpenKey(m.cClass+CURVER_KEY)
  1749. IF m.nErrNum  # ERROR_SUCCESS
  1750.     RETURN m.nErrNum
  1751. ENDIF
  1752. * Get key value for file extension
  1753. nErrNum = THIS.GetKeyValue(cOptName,@cExtnKey)
  1754. * Close extension key
  1755. THIS.CloseKey()
  1756. IF m.nErrNum  # ERROR_SUCCESS
  1757.     RETURN m.nErrNum
  1758. ENDIF
  1759. RETURN THIS.GetApplication(cExtnKey,@cAppKey,lServer)
  1760. ENDPROC
  1761. PROCEDURE getapplication
  1762. PARAMETER cExtnKey,cAppKey,lServer
  1763. LOCAL nErrNum,cOptName
  1764. cOptName = ""
  1765. * lServer - checking for OLE server.
  1766. IF TYPE("m.lServer") = "L" AND m.lServer
  1767.     THIS.cAppPathKey = OLE_PATH_KEY
  1768. ELSE    
  1769.     THIS.cAppPathKey = APP_PATH_KEY
  1770. ENDIF
  1771. * Open extension app key
  1772. m.nErrNum = THIS.OpenKey(m.cExtnKey+THIS.cAppPathKey)
  1773. IF m.nErrNum  # ERROR_SUCCESS
  1774.     RETURN m.nErrNum
  1775. ENDIF
  1776. * Get application path
  1777. nErrNum = THIS.GetKeyValue(cOptName,@cAppKey)
  1778. * Close application path key
  1779. THIS.CloseKey()
  1780. RETURN m.nErrNum
  1781. ENDPROC
  1782. PROCEDURE getinisection
  1783. PARAMETERS aSections,cSection,cINIFile
  1784. LOCAL cINIValue, nTotEntries, i, nLastPos
  1785. cINIValue = ""
  1786. IF TYPE("m.cINIFile") # "C"
  1787.     cINIFile = ""
  1788. ENDIF
  1789. IF THIS.GetINIEntry(@cINIValue,cSection,0,m.cINIFile) # ERROR_SUCCESS
  1790.     RETURN ERROR_FAILINI
  1791. ENDIF
  1792. nTotEntries=OCCURS(CHR(0),m.cINIValue)
  1793. DIMENSION aSections[m.nTotEntries]
  1794. nLastPos = 1
  1795. FOR i = 1 TO m.nTotEntries
  1796.     nTmpPos = AT(CHR(0),m.cINIValue,m.i)
  1797.     aSections[m.i] = SUBSTR(m.cINIValue,m.nLastPos,m.nTmpPos-m.nLastPos)
  1798.     nLastPos = m.nTmpPos+1
  1799. ENDFOR
  1800. RETURN ERROR_SUCCESS
  1801. ENDPROC
  1802. PROCEDURE getinientry
  1803. LPARAMETER cValue,cSection,cEntry,cINIFile
  1804. * Get entry from INI file 
  1805. LOCAL cBuffer,nBufSize,nErrNum,nTotParms
  1806. nTotParms = PARAMETERS()
  1807. * Load API functions
  1808. nErrNum= THIS.LoadINIFuncs()
  1809. IF m.nErrNum # ERROR_SUCCESS
  1810.     RETURN m.nErrNum
  1811. ENDIF
  1812. * Parameter checks here
  1813. IF m.nTotParms < 3
  1814.     m.cEntry = 0
  1815. ENDIF
  1816. m.cBuffer=space(2000)
  1817. IF EMPTY(m.cINIFile)
  1818.     * WIN.INI file
  1819.     m.nBufSize = GetWinINI(m.cSection,m.cEntry,"",@cBuffer,LEN(m.cBuffer))
  1820.     * Private INI file
  1821.     m.nBufSize = GetPrivateINI(m.cSection,m.cEntry,"",@cBuffer,LEN(m.cBuffer),m.cINIFile)
  1822. ENDIF
  1823. IF m.nBufSize = 0 &&could not find entry in INI file
  1824.     RETURN ERROR_NOINIENTRY
  1825. ENDIF
  1826. m.cValue=LEFT(m.cBuffer,m.nBufSize)
  1827. ** All is well
  1828. RETURN ERROR_SUCCESS
  1829. ENDPROC
  1830. PROCEDURE writeinientry
  1831. LPARAMETER cValue,cSection,cEntry,cINIFile
  1832. * Get entry from INI file 
  1833. LOCAL nErrNum
  1834. * Load API functions
  1835. nErrNum = THIS.LoadINIFuncs()
  1836. IF m.nErrNum # ERROR_SUCCESS
  1837.     RETURN m.nErrNum
  1838. ENDIF
  1839. IF EMPTY(m.cINIFile)
  1840.     * WIN.INI file
  1841.     nErrNum = WriteWinINI(m.cSection,m.cEntry,m.cValue)
  1842.     * Private INI file
  1843.     nErrNum = WritePrivateINI(m.cSection,m.cEntry,m.cValue,m.cINIFile)
  1844. ENDIF
  1845. ** All is well
  1846. RETURN IIF(m.nErrNum=1,ERROR_SUCCESS,m.nErrNum)
  1847. ENDPROC
  1848. PROCEDURE loadinifuncs
  1849. * Loads funtions needed for reading INI files
  1850. IF THIS.lLoadedINIs
  1851.     RETURN ERROR_SUCCESS
  1852. ENDIF
  1853. DECLARE integer GetPrivateProfileString IN Win32API ;
  1854.     AS GetPrivateINI string,string,string,string,integer,string
  1855. IF THIS.lhaderror && error loading library
  1856.     RETURN -1
  1857. ENDIF
  1858. DECLARE integer GetProfileString IN Win32API ;
  1859.     AS GetWinINI string,string,string,string,integer
  1860. DECLARE integer WriteProfileString IN Win32API ;
  1861.     AS WriteWinINI string,string,string
  1862. DECLARE integer WritePrivateProfileString IN Win32API ;
  1863.     AS WritePrivateINI string,string,string,string
  1864. THIS.lLoadedINIs = .T.
  1865. * Need error check here
  1866. RETURN ERROR_SUCCESS
  1867. ENDPROC
  1868. nuserkey User registry key.
  1869. cvfpoptpath Registry path to VFP options settings.
  1870. cregdllfile DLL file for registry functions.
  1871. cinidllfile DLL file for INI functions.
  1872. codbcdllfile DLL file for ODBC functions.
  1873. ncurrentos Current operating system code.
  1874. ncurrentkey Current registry key.
  1875. lloadeddlls Whether registry key functions loaded.
  1876. lloadedinis Whether INI functions loaded.
  1877. capppathkey Application path registry key.
  1878. lcreatekey Whether to create key if one does not already exist.
  1879. lhaderror Whether an error occurred.
  1880. lloadedodbcs Whether ODBC functions loaded.
  1881. *loadregfuncs Loads funtions needed for Registry.
  1882. *openkey Opens a registry key.
  1883. *closekey Closes a registry key.
  1884. *setregkey Sets a registry key setting.
  1885. *getregkey Gets a registry key setting.
  1886. *getkeyvalue Obtains a value from a registry key.
  1887. *setkeyvalue Sets a key value.
  1888. *deletekey Deletes a registry key.
  1889. *enumoptions Enumerates through all entries for a key and populates array.
  1890. *iskey Checks to see if a key exists.
  1891. *enumkeys Enumerates through a registry key.
  1892. *enumkeyvalues Enumerates through values of a registry key
  1893. *deletekeyvalue Deletes value from registry key.
  1894. RegOpenKey
  1895. Win32API
  1896. RegCreateKey
  1897. Win32API
  1898. RegDeleteKey
  1899. Win32API
  1900. RegDeleteValue
  1901. Win32API
  1902. RegCloseKey
  1903. Win32API
  1904. RegSetValueEx
  1905. Win32API
  1906. RegQueryValueEx
  1907. Win32API
  1908. RegEnumKey
  1909. Win32API
  1910. RegEnumKeyEx
  1911. Win32API
  1912. RegEnumValue
  1913. Win32API
  1914. NHKEY
  1915. CSUBKEY
  1916. NRESULT
  1917. IVALUE    
  1918. LPSZVALUE
  1919. LPCCHVALUE
  1920. LPDWTYPE
  1921. LPBDATA
  1922. LPCBDATA
  1923. LPCSTR
  1924. LPSZVAL
  1925. LPDWRESERVED
  1926. LPSZVALUENAME
  1927. DWRESERVED
  1928. FDWTYPE
  1929. ISUBKEY
  1930. LPSZNAME
  1931. CCHNAME
  1932. LLOADEDDLLS
  1933. REGOPENKEY
  1934. WIN32API    
  1935. LHADERROR
  1936. REGCREATEKEY
  1937. REGDELETEKEY
  1938. REGDELETEVALUE
  1939. REGCLOSEKEY
  1940. REGSETVALUEEX
  1941. REGQUERYVALUEEX
  1942. REGENUMKEY
  1943. REGENUMKEYEX
  1944. REGENUMVALUE
  1945. m.nRegKeyb
  1946. m.lCreateKeyb
  1947. CLOOKUPKEY
  1948. NREGKEY
  1949. LCREATEKEY
  1950. NSUBKEY
  1951. NERRCODE
  1952. NPCOUNT
  1953. LSAVECREATEKEY
  1954. LOADREGFUNCS
  1955. REGCREATEKEY
  1956. REGOPENKEY
  1957. NCURRENTKEY#
  1958. REGCLOSEKEY
  1959. NCURRENTKEY
  1960. COPTNAME
  1961. COPTVAL
  1962. CKEYPATH
  1963. NUSERKEY
  1964. LCREATEKEY
  1965. COPTKEY
  1966. COPTION
  1967. NERRNUM
  1968. OPENKEY
  1969. SETKEYVALUE
  1970. CLOSEKEY
  1971. COPTNAME
  1972. COPTVAL
  1973. CKEYPATH
  1974. NUSERKEY
  1975. COPTKEY
  1976. COPTION
  1977. NERRNUM
  1978. OPENKEY
  1979. GETKEYVALUE
  1980. CLOSEKEYs
  1981. THIS.nCurrentKeyb
  1982. m.cValueNameb
  1983. CVALUENAME    
  1984. CKEYVALUE
  1985. LPDWRESERVED
  1986. LPDWTYPE
  1987. LPBDATA
  1988. LPCBDATA
  1989. NERRCODE
  1990. NCURRENTKEY
  1991. REGQUERYVALUEEXA
  1992. THIS.nCurrentKeyb
  1993. m.cValueNameb
  1994. m.cValueb
  1995. CVALUENAME
  1996. CVALUE
  1997. NVALUESIZE
  1998. NERRCODE
  1999. NCURRENTKEY
  2000. REGSETVALUEEXI
  2001. NUSERKEY
  2002. CKEYPATH
  2003. NERRNUM
  2004. REGDELETEKEY&
  2005. m.lEnumKeysb
  2006. AREGOPTS
  2007. COPTPATH
  2008. NUSERKEY    
  2009. LENUMKEYS
  2010. COPTKEY
  2011. COPTION
  2012. NERRNUM
  2013. OPENKEY
  2014. ENUMKEYS
  2015. ENUMKEYVALUES
  2016. CLOSEKEYe
  2017. CKEYNAME
  2018. NREGKEY
  2019. NERRNUM
  2020. OPENKEY
  2021. CLOSEKEY
  2022. AKEYNAMES    
  2023. NKEYENTRY
  2024. CNEWKEY
  2025. CNEWSIZE
  2026. NBUFLEN
  2027. CRETTIME
  2028. NKEYSIZE
  2029. NERRCODE
  2030. REGENUMKEYEX
  2031. NCURRENTKEY
  2032. THIS.nCurrentKeyb
  2033. *Binary*
  2034. *Unknown type*
  2035. AKEYVALUES    
  2036. LPSZVALUE
  2037. LPCCHVALUE
  2038. LPDWRESERVED
  2039. LPDWTYPE
  2040. LPBDATA
  2041. LPCBDATA
  2042. NERRCODE    
  2043. NKEYENTRY
  2044. LARRAYPASSED
  2045. NCURRENTKEY
  2046. NCURRENTOS
  2047. REGENUMVALUE
  2048. COPTNAME
  2049. CKEYPATH
  2050. NUSERKEY
  2051. COPTION
  2052. NERRNUM
  2053. OPENKEY
  2054. REGDELETEVALUE
  2055. NCURRENTKEY
  2056. CLOSEKEY+
  2057. NERROR
  2058. CMETHOD
  2059. NLINE
  2060. THIS    
  2061. LHADERROR
  2062. Software\Microsoft\VisualFoxPro\
  2063. \Options
  2064. Windows 3C
  2065. Windows NTC
  2066. ADVAPI32.DLL
  2067. KERNEL32.DLL
  2068. ODBC32.DLL
  2069. ADVAPI32.DLL
  2070. KERNEL32.DLL
  2071. ODBC32.DLL
  2072. NUSERKEY
  2073. CVFPOPTPATH
  2074. VERSION
  2075. NCURRENTOS
  2076. CREGDLLFILE
  2077. CINIDLLFILE
  2078. CODBCDLLFILE
  2079. loadregfuncs,
  2080. openkey
  2081. closekey2
  2082. setregkeyy
  2083. getregkey
  2084. getkeyvalue
  2085. setkeyvalue
  2086. deletekeys
  2087. enumoptions
  2088. iskey
  2089. enumkeys/
  2090. enumkeyvalues
  2091. deletekeyvalue
  2092. Error+
  2093. PROCEDURE loadregfuncs
  2094. * Loads funtions needed for Registry
  2095. LOCAL nHKey,cSubKey,nResult
  2096. LOCAL hKey,iValue,lpszValue,lpcchValue,lpdwType,lpbData,lpcbData
  2097. LOCAL lpcStr,lpszVal,nLen,lpdwReserved
  2098. LOCAL lpszValueName,dwReserved,fdwType
  2099. LOCAL iSubKey,lpszName,cchName
  2100. IF THIS.lLoadedDLLs
  2101.     RETURN ERROR_SUCCESS
  2102. ENDIF
  2103. DECLARE Integer RegOpenKey IN Win32API ;
  2104.     Integer nHKey, String @cSubKey, Integer @nResult
  2105. IF THIS.lhaderror && error loading library
  2106.     RETURN -1
  2107. ENDIF
  2108. DECLARE Integer RegCreateKey IN Win32API ;
  2109.     Integer nHKey, String @cSubKey, Integer @nResult
  2110. DECLARE Integer RegDeleteKey IN Win32API ;
  2111.     Integer nHKey, String @cSubKey
  2112. DECLARE Integer RegDeleteValue IN Win32API ;
  2113.     Integer nHKey, String cSubKey
  2114. DECLARE Integer RegCloseKey IN Win32API ;
  2115.     Integer nHKey
  2116. DECLARE Integer RegSetValueEx IN Win32API ;
  2117.     Integer hKey, String lpszValueName, Integer dwReserved,;
  2118.     Integer fdwType, String lpbData, Integer cbData
  2119. DECLARE Integer RegQueryValueEx IN Win32API ;
  2120.     Integer nHKey, String lpszValueName, Integer dwReserved,;
  2121.     Integer @lpdwType, String @lpbData, Integer @lpcbData
  2122. DECLARE Integer RegEnumKey IN Win32API ;
  2123.     Integer nHKey,Integer iSubKey, String @lpszName, Integer @cchName
  2124. DECLARE Integer RegEnumKeyEx IN Win32API ;
  2125.     Integer nHKey,Integer iSubKey, String @lpszName, Integer @cchName,;
  2126.     Integer dwReserved,String @lpszName, Integer @cchName,String @cchName
  2127. DECLARE Integer RegEnumValue IN Win32API ;
  2128.     Integer hKey, Integer iValue, String @lpszValue, ;
  2129.     Integer @lpcchValue, Integer lpdwReserved, Integer @lpdwType, ;
  2130.     String @lpbData, Integer @lpcbData
  2131.             
  2132. THIS.lLoadedDLLs = .T.
  2133. * Need error check here
  2134. RETURN ERROR_SUCCESS
  2135. ENDPROC
  2136. PROCEDURE openkey
  2137. * Opens a registry key
  2138. LPARAMETER cLookUpKey,nRegKey,lCreateKey
  2139. LOCAL nSubKey,nErrCode,nPCount,lSaveCreateKey
  2140. nSubKey = 0
  2141. nPCount = PARAMETERS()
  2142. IF TYPE("m.nRegKey") # "N" OR EMPTY(m.nRegKey)
  2143.     m.nRegKey = HKEY_CLASSES_ROOT
  2144. ENDIF
  2145. * Load API functions
  2146. nErrCode = THIS.LoadRegFuncs()
  2147. IF m.nErrCode # ERROR_SUCCESS
  2148.     RETURN m.nErrCode
  2149. ENDIF
  2150. lSaveCreateKey = THIS.lCreateKey
  2151. IF m.nPCount>2 AND TYPE("m.lCreateKey") = "L"
  2152.     THIS.lCreateKey = m.lCreateKey
  2153. ENDIF
  2154. IF THIS.lCreateKey
  2155.     * Try to open or create registry key
  2156.     nErrCode = RegCreateKey(m.nRegKey,m.cLookUpKey,@nSubKey)
  2157.     * Try to open registry key
  2158.     nErrCode = RegOpenKey(m.nRegKey,m.cLookUpKey,@nSubKey)
  2159. ENDIF
  2160. THIS.lCreateKey = m.lSaveCreateKey
  2161. IF nErrCode # ERROR_SUCCESS
  2162.     RETURN m.nErrCode
  2163. ENDIF
  2164. THIS.nCurrentKey = m.nSubKey
  2165. RETURN ERROR_SUCCESS
  2166. ENDPROC
  2167. PROCEDURE closekey
  2168. * Closes a registry key
  2169. =RegCloseKey(THIS.nCurrentKey)
  2170. THIS.nCurrentKey =0 
  2171. ENDPROC
  2172. PROCEDURE setregkey
  2173. * This routine sets a registry key setting
  2174. * ex. THIS.SetRegKey("ResWidth","640",;
  2175. *        "Software\Microsoft\VisualFoxPro\6.0\Options",;
  2176. *        HKEY_CURRENT_USER)
  2177. LPARAMETER cOptName,cOptVal,cKeyPath,nUserKey,lCreateKey
  2178. LOCAL iPos,cOptKey,cOption,nErrNum
  2179. iPos = 0
  2180. cOption = ""
  2181. nErrNum = ERROR_SUCCESS
  2182. * Open registry key
  2183. m.nErrNum = THIS.OpenKey(m.cKeyPath,m.nUserKey,m.lCreateKey)
  2184. IF m.nErrNum # ERROR_SUCCESS
  2185.     RETURN m.nErrNum
  2186. ENDIF
  2187. * Set Key value
  2188. nErrNum = THIS.SetKeyValue(m.cOptName,m.cOptVal)
  2189. * Close registry key 
  2190. THIS.CloseKey()        &&close key
  2191. RETURN m.nErrNum
  2192. ENDPROC
  2193. PROCEDURE getregkey
  2194. * This routine gets a registry key setting
  2195. * ex. THIS.GetRegKey("ResWidth",@cValue,;
  2196. *        "Software\Microsoft\VisualFoxPro\4.0\Options",;
  2197. *        HKEY_CURRENT_USER)
  2198. LPARAMETER cOptName,cOptVal,cKeyPath,nUserKey
  2199. LOCAL iPos,cOptKey,cOption,nErrNum
  2200. iPos = 0
  2201. cOption = ""
  2202. nErrNum = ERROR_SUCCESS
  2203. * Open registry key
  2204. m.nErrNum = THIS.OpenKey(m.cKeyPath,m.nUserKey)
  2205. IF m.nErrNum # ERROR_SUCCESS
  2206.     RETURN m.nErrNum
  2207. ENDIF
  2208. * Get the key value
  2209. nErrNum = THIS.GetKeyValue(cOptName,@cOptVal)
  2210. * Close registry key 
  2211. THIS.CloseKey()        &&close key
  2212. RETURN m.nErrNum
  2213. ENDPROC
  2214. PROCEDURE getkeyvalue
  2215. * Obtains a value from a registry key
  2216. * Note: this routine only handles Data strings (REG_SZ)
  2217. LPARAMETER cValueName,cKeyValue
  2218. LOCAL lpdwReserved,lpdwType,lpbData,lpcbData,nErrCode
  2219. STORE 0 TO lpdwReserved,lpdwType
  2220. STORE SPACE(256) TO lpbData
  2221. STORE LEN(m.lpbData) TO m.lpcbData
  2222. DO CASE
  2223. CASE TYPE("THIS.nCurrentKey")#'N' OR THIS.nCurrentKey = 0
  2224.     RETURN ERROR_BADKEY
  2225. CASE TYPE("m.cValueName") #"C"
  2226.     RETURN ERROR_BADPARM
  2227. ENDCASE
  2228. m.nErrCode=RegQueryValueEx(THIS.nCurrentKey,m.cValueName,;
  2229.         m.lpdwReserved,@lpdwType,@lpbData,@lpcbData)
  2230. * Check for error 
  2231. IF m.nErrCode # ERROR_SUCCESS
  2232.     RETURN m.nErrCode
  2233. ENDIF
  2234. * Make sure we have a data string data type
  2235. IF m.lpdwType # REG_SZ AND m.lpdwType # REG_EXPAND_SZ 
  2236.     RETURN ERROR_NONSTR_DATA        
  2237. ENDIF
  2238. m.cKeyValue = LEFT(m.lpbData,m.lpcbData-1)
  2239. RETURN ERROR_SUCCESS
  2240. ENDPROC
  2241. PROCEDURE setkeyvalue
  2242. * This routine sets a key value
  2243. * Note: this routine only handles data strings (REG_SZ)
  2244. LPARAMETER cValueName,cValue
  2245. LOCAL nValueSize,nErrCode 
  2246. DO CASE
  2247. CASE TYPE("THIS.nCurrentKey")#'N' OR THIS.nCurrentKey = 0
  2248.     RETURN ERROR_BADKEY
  2249. CASE TYPE("m.cValueName") #"C" OR TYPE("m.cValue")#"C"
  2250.     RETURN ERROR_BADPARM
  2251. CASE EMPTY(m.cValueName) OR EMPTY(m.cValue)
  2252.     * RETURN ERROR_BADPARM
  2253. ENDCASE
  2254. * Make sure we null terminate this guy
  2255. cValue = m.cValue+CHR(0)
  2256. nValueSize = LEN(m.cValue)
  2257. * Set the key value here
  2258. m.nErrCode = RegSetValueEx(THIS.nCurrentKey,m.cValueName,0,;
  2259.     REG_SZ,m.cValue,m.nValueSize)
  2260. * Check for error
  2261. IF m.nErrCode # ERROR_SUCCESS
  2262.     RETURN m.nErrCode
  2263. ENDIF
  2264. RETURN ERROR_SUCCESS
  2265. ENDPROC
  2266. PROCEDURE deletekey
  2267. * This routine deletes a Registry Key
  2268. LPARAMETER nUserKey,cKeyPath
  2269. LOCAL nErrNum
  2270. nErrNum = ERROR_SUCCESS
  2271. * Delete key
  2272. m.nErrNum = RegDeleteKey(m.nUserKey,m.cKeyPath)
  2273. RETURN m.nErrNum
  2274. ENDPROC
  2275. PROCEDURE enumoptions
  2276. * Enumerates through all entries for a key and populates array
  2277. LPARAMETER aRegOpts,cOptPath,nUserKey,lEnumKeys
  2278. LOCAL iPos,cOptKey,cOption,nErrNum
  2279. iPos = 0
  2280. cOption = ""
  2281. nErrNum = ERROR_SUCCESS
  2282. IF PARAMETERS()<4 OR TYPE("m.lEnumKeys") # "L"
  2283.     lEnumKeys = .F.
  2284. ENDIF
  2285. * Open key
  2286. m.nErrNum = THIS.OpenKey(m.cOptPath,m.nUserKey)
  2287. IF m.nErrNum # ERROR_SUCCESS
  2288.     RETURN m.nErrNum
  2289. ENDIF
  2290. * Enumerate through keys
  2291. IF m.lEnumKeys
  2292.     * Enumerate and get key names
  2293.     nErrNum = THIS.EnumKeys(@aRegOpts)
  2294.     * Enumerate and get all key values
  2295.     nErrNum = THIS.EnumKeyValues(@aRegOpts)
  2296. ENDIF
  2297. * Close key
  2298. THIS.CloseKey()        &&close key
  2299. RETURN m.nErrNum
  2300. ENDPROC
  2301. PROCEDURE iskey
  2302. * Checks to see if a key exists
  2303. LPARAMETER cKeyName,nRegKey
  2304. LOCAL nErrNum 
  2305. * Open extension key        
  2306. nErrNum = THIS.OpenKey(m.cKeyName,m.nRegKey)
  2307. IF m.nErrNum  = ERROR_SUCCESS
  2308.     * Close extension key
  2309.     THIS.CloseKey()
  2310. ENDIF
  2311. RETURN m.nErrNum = ERROR_SUCCESS
  2312. ENDPROC
  2313. PROCEDURE enumkeys
  2314. PARAMETER aKeyNames
  2315. LOCAL nKeyEntry,cNewKey,cNewSize,cbuf,nbuflen,cRetTime
  2316. nKeyEntry = 0
  2317. DIMENSION aKeyNames[1]
  2318. DO WHILE .T.
  2319.     nKeySize = 0
  2320.     cNewKey = SPACE(100)
  2321.     nKeySize = LEN(m.cNewKey)
  2322.     cbuf=space(100)
  2323.     nbuflen=len(m.cbuf)
  2324.     cRetTime=space(100)
  2325.     m.nErrCode = RegEnumKeyEx(THIS.nCurrentKey,m.nKeyEntry,@cNewKey,@nKeySize,0,@cbuf,@nbuflen,@cRetTime)
  2326.     DO CASE
  2327.     CASE m.nErrCode = ERROR_EOF
  2328.         EXIT
  2329.     CASE m.nErrCode # ERROR_SUCCESS
  2330.         EXIT
  2331.     ENDCASE
  2332.     cNewKey = ALLTRIM(m.cNewKey)
  2333.     cNewKey = LEFT(m.cNewKey,LEN(m.cNewKey)-1)
  2334.     IF !EMPTY(aKeyNames[1])
  2335.         DIMENSION aKeyNames[ALEN(aKeyNames)+1]
  2336.     ENDIF
  2337.     aKeyNames[ALEN(aKeyNames)] = m.cNewKey 
  2338.     nKeyEntry = m.nKeyEntry + 1
  2339. ENDDO
  2340. IF m.nErrCode = ERROR_EOF AND m.nKeyEntry # 0
  2341.     m.nErrCode = ERROR_SUCCESS
  2342. ENDIF
  2343. RETURN m.nErrCode
  2344. ENDPROC
  2345. PROCEDURE enumkeyvalues
  2346. * Enumerates through values of a registry key
  2347. LPARAMETER aKeyValues
  2348. LOCAL lpszValue,lpcchValue,lpdwReserved
  2349. LOCAL lpdwType,lpbData,lpcbData
  2350. LOCAL nErrCode,nKeyEntry,lArrayPassed
  2351. STORE 0 TO nKeyEntry
  2352. IF TYPE("THIS.nCurrentKey")#'N' OR THIS.nCurrentKey = 0
  2353.     RETURN ERROR_BADKEY
  2354. ENDIF
  2355. * Sorry, Win32s does not support this one!
  2356. IF THIS.nCurrentOS = OS_W32S
  2357.     RETURN ERROR_BADPLAT
  2358. ENDIF
  2359. DO WHILE .T.
  2360.     STORE 0 TO lpdwReserved,lpdwType,nErrCode
  2361.     STORE SPACE(256) TO lpbData, lpszValue
  2362.     STORE LEN(lpbData) TO m.lpcchValue
  2363.     STORE LEN(lpszValue) TO m.lpcbData
  2364.     nErrCode=RegEnumValue(THIS.nCurrentKey,m.nKeyEntry,@lpszValue,;
  2365.         @lpcchValue,m.lpdwReserved,@lpdwType,@lpbData,@lpcbData)
  2366.     DO CASE
  2367.     CASE m.nErrCode = ERROR_EOF
  2368.         EXIT
  2369.     CASE m.nErrCode # ERROR_SUCCESS
  2370.         EXIT
  2371.     ENDCASE
  2372.     nKeyEntry = m.nKeyEntry + 1
  2373.     * Set array values
  2374.     DIMENSION aKeyValues[m.nKeyEntry,2]
  2375.     aKeyValues[m.nKeyEntry,1] = LEFT(m.lpszValue,m.lpcchValue)
  2376.     DO CASE
  2377.     CASE lpdwType = REG_SZ
  2378.         aKeyValues[m.nKeyEntry,2] = LEFT(m.lpbData,m.lpcbData-1)
  2379.     CASE lpdwType = REG_BINARY
  2380.         * Don't support binary
  2381.         aKeyValues[m.nKeyEntry,2] = REG_BINARY_LOC
  2382.     CASE lpdwType = REG_DWORD
  2383.         * You will need to use ASC() to check values here.
  2384.         aKeyValues[m.nKeyEntry,2] = LEFT(m.lpbData,m.lpcbData-1)
  2385.     OTHERWISE
  2386.         aKeyValues[m.nKeyEntry,2] = REG_UNKNOWN_LOC
  2387.     ENDCASE
  2388. ENDDO
  2389. IF m.nErrCode = ERROR_EOF AND m.nKeyEntry # 0
  2390.     m.nErrCode = ERROR_SUCCESS
  2391. ENDIF
  2392. RETURN m.nErrCode
  2393. ENDPROC
  2394. PROCEDURE deletekeyvalue
  2395. LPARAMETER cOptName,cKeyPath,nUserKey
  2396. LOCAL cOption,nErrNum
  2397. cOption = cOptName
  2398. nErrNum = ERROR_SUCCESS
  2399. * Open key
  2400. m.nErrNum = THIS.OpenKey(m.cKeyPath,m.nUserKey)
  2401. IF m.nErrNum # ERROR_SUCCESS
  2402.     RETURN m.nErrNum
  2403. ENDIF
  2404. * Delete the key value
  2405. m.nErrNum = RegDeleteValue(THIS.nCurrentKey,m.cOption)
  2406. * Close key
  2407. THIS.CloseKey()        && close key
  2408. RETURN m.nErrNum
  2409. ENDPROC
  2410. PROCEDURE Error
  2411. LPARAMETERS nError, cMethod, nLine
  2412. THIS.lhaderror = .T.
  2413. =MESSAGEBOX(MESSAGE())
  2414. ENDPROC
  2415. PROCEDURE Init
  2416. THIS.nUserKey = HKEY_CURRENT_USER
  2417. THIS.cVFPOptPath = VFP_OPTIONS_KEY1 + _VFP.VERSION + VFP_OPTIONS_KEY2
  2418. DO CASE
  2419.     CASE _DOS OR _UNIX OR _MAC
  2420.         RETURN .F.
  2421.     CASE ATC("Windows 3",OS(1)) # 0
  2422.         THIS.nCurrentOS = OS_W32S
  2423.     CASE ATC("Windows NT",OS(1)) # 0
  2424.         THIS.nCurrentOS = OS_NT
  2425.         THIS.cRegDLLFile = DLL_ADVAPI_NT
  2426.         THIS.cINIDLLFile = DLL_KERNEL_NT    
  2427.         THIS.cODBCDLLFile = DLL_ODBC_NT
  2428.     OTHERWISE
  2429.         * Windows 95
  2430.         THIS.nCurrentOS = OS_WIN95
  2431.         THIS.cRegDLLFile = DLL_ADVAPI_WIN95
  2432.         THIS.cINIDLLFile = DLL_KERNEL_WIN95
  2433.         THIS.cODBCDLLFile = DLL_ODBC_WIN95
  2434. ENDCASE
  2435. ENDPROC
  2436. addlabel.scx
  2437. addlabel.sct
  2438. d:\8146\fox60\dev\
  2439. 6d4x027x.fxp
  2440. newlabel.scx
  2441. newlabel.sct
  2442. label2.bmp
  2443. label2.msk
  2444. ..\wzcommon\
  2445. registry.vcx
  2446. registry.vct
  2447.