home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1998 November / pcwk_11_98a.iso / Wtestowe / SOFTSRC / vtrial15.exe / DATA.1 / NewDwg.bas < prev    next >
BASIC Source File  |  1997-02-10  |  4KB  |  113 lines
  1. Attribute VB_Name = "Globals"
  2. ' (C) Copyright 1997 by SoftSource.  All rights reserved.
  3. ' Sample Visual Basic code for working with Vdraft
  4. '
  5. ' This code demonstrates setting information
  6. '   in a drawing
  7.  
  8.  
  9. Option Explicit
  10.  
  11. '
  12. '   miscellaneous vars
  13. Public AppName$                                         ' name string for the app
  14. Public DirtyFlag%                                       ' Used to flag when changes have been made
  15. Public DwgName%                                         ' used to show that the user entered a new drawing name
  16. Public gblAngScaleFlag%                                 ' allows the angle sample box to get rescaled once only
  17. Public gblAspect                                        ' used by DrawSampleAngle
  18. Public gblDwgNameWasChanged%                            ' shows if the user changed the drawing name
  19.  
  20. '
  21. '   vars used as constants
  22. Public CRLF As String                                   ' mainly for use in dlgs
  23. Public PI As Double                                     ' a slice of....
  24.  
  25. '
  26. '   objects for talking to Vdraft with
  27. Public Vdraft As Object                                 ' the Vdraft object itself
  28. Public Doc As Object                                    ' the active drawing (assumedly the New drawing)
  29.  
  30. '
  31. '   miscellaneous globals
  32. Public gblGetNameFlag As Integer                        ' determines behavior of GetNameForm
  33. Public gblNewName As String                             ' used with NewNameForm
  34. Public gblLTName$                                       ' used with new line type form
  35. Public gblLTDesc$                                       ' used with new line type form
  36. Public gblLTSpec$                                       ' used with new line type form
  37. Public gblMode As Integer                               ' used to determine operational mode on some dlgs
  38. Public gblEditValue As Double                           ' used with new line type form
  39.  
  40. Public Const LTMax = 32
  41. Public LineTypes(LTMax) As String                       ' linetype name
  42. Public LTSpec(LTMax) As String                          ' linetype spec
  43. Public LTDesc(LTMax) As String                          ' linetype description
  44.  
  45. Public Const LayMax = 50
  46. Public Layers(LayMax), LayLT(LayMax) As String          ' layers
  47. Public LayColor(LayMax) As Long
  48.  
  49. Public Const TSMax = 20                                 ' maximum number of text styles
  50. Public Const TSParams = 9                               ' number of params in the array
  51. Public TextStyle(TSMax, TSParams) As String             ' text style information
  52. Public Const TSFontFile = 0
  53. Public Const TSBigFontFile = 1
  54. Public Const TSDefHeight = 2
  55. Public Const TSObliqueAngle = 3
  56. Public Const TSXScale = 4
  57. Public Const TSUpsideDown = 5
  58. Public Const TSVertical = 6
  59. Public Const TSBackwards = 7
  60. Public Const TSName = 8
  61.  
  62.  
  63. '
  64. '   color constants, these are done in decimal because
  65. '   when they are done in hex VB sometimes interprets them
  66. '   as signed values instead of unsigned.
  67. Public Const WHITE As Long = 16777215
  68. Public Const MAGENTA As Long = 16711935
  69. Public Const YELLOW As Long = 65535
  70. Public Const GREEN As Long = 65280
  71. Public Const RED As Long = 255
  72. Public Const CYAN As Long = 16776960
  73. Public Const BLUE As Long = 16711680
  74.  
  75. '
  76. '   external function declarations
  77. Declare Function GetPrivateProfileStringA Lib "Kernel32" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
  78. Declare Function WritePrivateProfileString Lib "Kernel32" (ByRef lpAppName As String, ByRef lpKeyName As String, ByRef lpString As String, ByRef lpFileName As String)
  79.  
  80.  
  81.  
  82.  
  83. Function Str2Color(Clr As String) As Long
  84. '
  85. '   convert the incoming string literal to a color value
  86. '
  87.     Dim Clr2 As String
  88.     Clr2 = UCase$(Clr)
  89.  
  90.     Select Case Clr2
  91.         Case "WHITE"
  92.             Str2Color = WHITE
  93.         Case "MAGENTA"
  94.             Str2Color = MAGENTA
  95.         Case "YELLOW"
  96.             Str2Color = YELLOW
  97.         Case "GREEN"
  98.             Str2Color = GREEN
  99.         Case "RED"
  100.             Str2Color = RED
  101.         Case "CYAN"
  102.             Str2Color = CYAN
  103.         Case "BLUE"
  104.             Str2Color = BLUE
  105.         
  106.         Case Else
  107.             Str2Color = WHITE
  108.     End Select
  109.  
  110. End Function
  111.  
  112.  
  113.