home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Game Programming for Teens / VBGPFT.cdr / sources / chapter13 / PrintText / Form1.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2004-10-23  |  3.4 KB  |  96 lines
  1. VERSION 5.00
  2. Begin VB.Form Form1 
  3.    Caption         =   "Form1"
  4.    ClientHeight    =   3195
  5.    ClientLeft      =   60
  6.    ClientTop       =   345
  7.    ClientWidth     =   4680
  8.    LinkTopic       =   "Form1"
  9.    ScaleHeight     =   3195
  10.    ScaleWidth      =   4680
  11.    StartUpPosition =   3  'Windows Default
  12. Attribute VB_Name = "Form1"
  13. Attribute VB_GlobalNameSpace = False
  14. Attribute VB_Creatable = False
  15. Attribute VB_PredeclaredId = True
  16. Attribute VB_Exposed = False
  17. '---------------------------------------------------------------
  18. ' Visual Basic Game Programming for Teens
  19. ' PrintText Program
  20. '---------------------------------------------------------------
  21. Option Explicit
  22. Option Base 0
  23. Const SCREENWIDTH As Long = 800
  24. Const SCREENHEIGHT As Long = 600
  25. Const C_PURPLE As Long = &HFFFF00FF
  26. Const C_RED As Long = &HFFFF0000
  27. Const C_GREEN As Long = &HFF00FF00
  28. Const C_BLUE As Long = &HFF0000FF
  29. Const C_WHITE As Long = &HFFFFFFFF
  30. Const C_BLACK As Long = &H0
  31. Const C_GRAY As Long = &HFFAAAAAA
  32. Dim fontImg As Direct3DTexture8
  33. Dim fontSpr As TSPRITE
  34. Private Sub Form_Load()
  35.     'set up the main form
  36.     Me.Caption = "PrintText"
  37.     Me.ScaleMode = 3
  38.     Me.width = Screen.TwipsPerPixelX * (SCREENWIDTH + 12)
  39.     Me.height = Screen.TwipsPerPixelY * (SCREENHEIGHT + 30)
  40.     Me.Show
  41.     'initialize Direct3D
  42.     InitDirect3D Me.hWnd
  43.     'get reference to the back buffer
  44.     Set backbuffer = d3ddev.GetBackBuffer(0, D3DBACKBUFFER_TYPE_MONO)
  45.     'load the bitmap file
  46.     Set fontImg = LoadTexture(d3ddev, App.Path & "\font.bmp")
  47.     InitSprite d3ddev, fontSpr
  48.     fontSpr.FramesPerRow = 20
  49.     fontSpr.width = 16
  50.     fontSpr.height = 24
  51.     fontSpr.ScaleFactor = 2
  52.     'clear the screen to black
  53.     d3ddev.Clear 0, ByVal 0, D3DCLEAR_TARGET, &H0, 1, 0
  54.     d3ddev.BeginScene
  55.     PrintText fontImg, fontSpr, 10, 10, C_BLUE, "W e l c o m e  T o  V i s u a l  B a s i c"
  56.     fontSpr.ScaleFactor = 1
  57.     PrintText fontImg, fontSpr, 10, 70, C_WHITE, "abcdefghijklmnopqrstuvwxyz"
  58.     PrintText fontImg, fontSpr, 10, 100, C_GRAY, "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  59.     PrintText fontImg, fontSpr, 10, 130, C_GREEN, "!""#$%&()*+,-./0123456789:;<=>?@[\]^_{|}~"
  60.     fontSpr.ScaleFactor = 3
  61.     PrintText fontImg, fontSpr, 10, 180, C_RED, "B  I  G   H  U  G  E   F  O  N  T  !"
  62.     fontSpr.ScaleFactor = 0.6
  63.     PrintText fontImg, fontSpr, 10, 260, C_PURPLE, "This Is A Smaller Font"
  64.     d3ddev.EndScene
  65. End Sub
  66. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  67.     If KeyCode = 27 Then Shutdown
  68. End Sub
  69. Private Sub Form_Paint()
  70.     d3ddev.Present ByVal 0, ByVal 0, 0, ByVal 0
  71. End Sub
  72. Private Sub PrintText( _
  73.     ByRef fontImg As Direct3DTexture8, _
  74.     ByRef fontSpr As TSPRITE, _
  75.     ByVal X As Long, _
  76.     ByVal Y As Long, _
  77.     ByVal color As Long, _
  78.     ByVal sText As String)
  79.     Dim n As Long
  80.     For n = 1 To Len(sText)
  81.         PrintChar fontImg, fontSpr, X + (n - 1) * fontSpr.width, Y, color, Asc(Mid$(sText, n, 1))
  82.     Next n
  83. End Sub
  84. Private Sub PrintChar( _
  85.     ByRef fontImg As Direct3DTexture8, _
  86.     ByRef fontSpr As TSPRITE, _
  87.     ByVal X As Long, _
  88.     ByVal Y As Long, _
  89.     ByVal color As Long, _
  90.     c As Byte)
  91.     fontSpr.X = X
  92.     fontSpr.Y = Y
  93.     fontSpr.CurrentFrame = c - 32
  94.     DrawSprite fontImg, fontSpr, color
  95. End Sub
  96.