home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2002 March / PCWMAR02.iso / software / turbocad / v8trial / TurboCADv8ProfessionalNoReg.exe / Data.Cab / F41998_modText.bas < prev    next >
Encoding:
BASIC Source File  |  2001-10-16  |  4.0 KB  |  135 lines
  1. Attribute VB_Name = "modText"
  2. '******************************************************************'
  3. '*                                                                *'
  4. '*                      TurboCAD for Windows                      *'
  5. '*                   Copyright (c) 1993 - 2001                    *'
  6. '*             International Microcomputer Software, Inc.         *'
  7. '*                            (IMSI)                              *'
  8. '*                      All rights reserved.                      *'
  9. '*                                                                *'
  10. '******************************************************************'
  11.  
  12. ' This sample draws texts
  13.  
  14. Public Sub TextJustification()
  15. 'Sample draws texts with different Justification
  16.  
  17. Dim App As Application
  18. Dim ActDr As Drawing
  19. Dim Grs As Graphics
  20. Dim GrText As Graphic
  21. Dim Pi#
  22.     Pi = 3.14159
  23. Dim Justification%
  24. Dim ThisText$
  25.     Set App = IMSIGX.Application
  26.     Set ActDr = App.ActiveDrawing
  27.     Set Grs = ActDr.Graphics
  28.     For Justification = 1 To 5
  29.         ThisText = "Justification = " & CStr(Justification)
  30.         Set GrText = Grs.AddText(ThisText, 2, CDbl(Justification), 0, 0.5, 0, , , Justification)
  31.     Next Justification
  32. End Sub
  33. Public Sub TextFont()
  34. 'Sample draw texts with different TextFont
  35. Dim App As Application
  36. Dim ActDr As Drawing
  37. Dim Grs As Graphics
  38. Dim GrText As Graphic
  39. Dim Pi#
  40.     Pi = 3.14159
  41. Dim TextFont%
  42. Dim ThisText(8) As String
  43.     ThisText(0) = "TimesNewRoman"
  44.     ThisText(1) = "Italic"
  45.     ThisText(2) = "GothicE"
  46.     ThisText(3) = "CityBlueprint"
  47.     ThisText(4) = "GreekS"
  48.     ThisText(5) = "Impact"
  49.     ThisText(6) = "Monotxt"
  50.     Set App = IMSIGX.Application
  51.     Set ActDr = App.ActiveDrawing
  52.     Set Grs = ActDr.Graphics
  53. Dim x0#, y0#, angle#
  54.     For TextFont = 0 To 6
  55.         angle = 2 * Pi / 7 * TextFont
  56.         x0 = 5 + 0.5 * Cos(angle)
  57.         y0 = 5 + 0.5 * Sin(angle)
  58.         Set GrText = Grs.AddText(ThisText(TextFont), x0, y0, 0, 0.5, angle)
  59.         GrText.Properties("TextFont") = ThisText(TextFont)
  60.         GrText.Properties("PenColor") = QBColor(2 * TextFont)
  61.     Next TextFont
  62. End Sub
  63.  
  64. Public Sub TextMode()
  65. 'Sample draw texts with different textMode
  66.  
  67. Dim App As Application
  68. Dim ActDr As Drawing
  69. Dim Grs As Graphics
  70. Dim GrText As Graphic
  71. Dim Pi#
  72.     Pi = 3.14159
  73. Dim txtMode(3) As String
  74.     txtMode(1) = "Standard"
  75.     txtMode(2) = "Scalable"
  76.     txtMode(3) = "Flexible"
  77. Dim Mode%
  78. Dim ThisText$
  79.     Set App = IMSIGX.Application
  80.     Set ActDr = App.ActiveDrawing
  81.     Set Grs = ActDr.Graphics
  82.     For Mode = 1 To 3
  83.         Set GrText = Grs.AddText(txtMode(Mode), 2, CDbl(Mode), 0, 0.5)
  84.         GrText.Properties("TextMode") = Mode
  85.    Next Mode
  86. End Sub
  87.  
  88. Public Sub TextAlongCircle()
  89. Dim App As Application
  90. Dim ActDr As Drawing
  91. Dim Grs As Graphics
  92. Dim GrText As Graphic
  93. Dim GrCircle As Graphic
  94. Dim Pi#
  95.     Pi = 3.14159
  96.     Set App = IMSIGX.Application
  97.     Set ActDr = App.ActiveDrawing
  98.     Set Grs = ActDr.Graphics
  99.        
  100.     Set GrCircle = Grs.AddCircleCenterAndPoint(5, 5, 0, 5, 8, 0)
  101. Dim xc#, yc#, R#, xr#, yr#
  102. Dim ArcData(10) As Double
  103.     GrCircle.GetArcData ArcData
  104.     xc = ArcData(0)
  105.     yc = ArcData(1)
  106.     xr = ArcData(3)
  107.     yr = ArcData(4)
  108.     R = Sqr((xr - xc) * (xr - xc) + (yr - yc) * (yr - yc))
  109. Dim ThisText$
  110.     ThisText = "QRwetweteteghghlkdfjhjdj"
  111. Dim txtLen As Long, i As Long
  112. Dim Symb$
  113. Dim dfi#, fi#, x#, y#
  114. Dim fiBeg#, fiEnd#
  115.     fiBeg = 7 / 8 * Pi
  116.     fiEnd = 1 / 4 * Pi
  117. Dim Htext#
  118.     Htext = 0.25
  119.     txtLen = Len(ThisText)
  120.     dfi = (fiBeg - fiEnd) / (txtLen - 1)
  121.     For i = 1 To txtLen
  122.         Symb = Mid(ThisText, i, 1)
  123.         fi = Pi - dfi * (i - 1)
  124.         x = xc + R * Cos(fi)
  125.         y = yc + R * Sin(fi)
  126.         Set GrText = Grs.AddText(Symb, x, y, 0, Htext, fi - Pi / 2, , , 3)
  127.         x = xc + (R + 1.1 * Htext) * Cos(fi)
  128.         y = yc + (R + 1.1 * Htext) * Sin(fi)
  129.         Set GrText = Grs.AddText(Symb, x, y, 0, Htext, fi - Pi / 2, , , 3)
  130.         GrText.Properties("PenColor") = QBColor(13)
  131.     
  132.     Next i
  133.  
  134. End Sub
  135.