西昌.何雨锋 2D文字输入框
'--------------------------------------------
' TrueVision3D Edit Box tutorial
'--------------------------------------------
' This samples uses the Key buffering feature of the Input engine
' that is useful for GUI input etc...
Private TV As New TVEngine
Private Scene As New TVScene
Private Inp As New TVInputEngine
Private TextF As New TVScreen2DText
Private scr As New TVScreen2DImmediate
Private FontID As Long
Private ShiftPressed As Boolean
Private IsFinished As Boolean
Private Sub Form_Load()
'Create the keys corresponance
Dim Key(255) As Long
Key(TV_KEY_0) = Asc("0")
Key(TV_KEY_1) = Asc("1")
Key(TV_KEY_2) = Asc("2")
Key(TV_KEY_3) = Asc("3")
Key(TV_KEY_4) = Asc("4")
Key(TV_KEY_5) = Asc("5")
Key(TV_KEY_6) = Asc("6")
Key(TV_KEY_7) = Asc("7")
Key(TV_KEY_8) = Asc("8")
Key(TV_KEY_9) = Asc("9")
Key(TV_KEY_A) = Asc("a")
Key(TV_KEY_B) = Asc("b")
Key(TV_KEY_C) = Asc("c")
Key(TV_KEY_D) = Asc("d")
Key(TV_KEY_E) = Asc("e")
Key(TV_KEY_F) = Asc("f")
Key(TV_KEY_G) = Asc("g")
Key(TV_KEY_H) = Asc("h")
Key(TV_KEY_I) = Asc("i")
Key(TV_KEY_J) = Asc("j")
Key(TV_KEY_K) = Asc("k")
Key(TV_KEY_L) = Asc("l")
Key(TV_KEY_M) = Asc("m")
Key(TV_KEY_N) = Asc("n")
Key(TV_KEY_O) = Asc("o")
Key(TV_KEY_P) = Asc("p")
Key(TV_KEY_Q) = Asc("q")
Key(TV_KEY_R) = Asc("r")
Key(TV_KEY_S) = Asc("s")
Key(TV_KEY_T) = Asc("t")
Key(TV_KEY_U) = Asc("u")
Key(TV_KEY_V) = Asc("v")
Key(TV_KEY_W) = Asc("w")
Key(TV_KEY_X) = Asc("x")
Key(TV_KEY_Y) = Asc("y")
Key(TV_KEY_Z) = Asc("z")
Key(TV_KEY_SPACE) = Asc(" ")
Key(TV_KEY_ADD) = Asc("+")
Key(TV_KEY_SUBTRACT) = Asc("-")
Key(TV_KEY_MULTIPLY) = Asc("*")
Key(TV_KEY_DIVIDE) = Asc("/")
Key(TV_KEY_SLASH) = Asc("/")
Key(TV_KEY_PERIOD) = Asc(".")
Key(TV_KEY_COMMA) = Asc(",")
Key(TV_KEY_NUMPAD0) = Asc("0")
Key(TV_KEY_NUMPAD1) = Asc("1")
Key(TV_KEY_NUMPAD2) = Asc("2")
Key(TV_KEY_NUMPAD3) = Asc("3")
Key(TV_KEY_NUMPAD4) = Asc("4")
Key(TV_KEY_NUMPAD5) = Asc("5")
Key(TV_KEY_NUMPAD6) = Asc("6")
Key(TV_KEY_NUMPAD7) = Asc("7")
Key(TV_KEY_NUMPAD8) = Asc("8")
Key(TV_KEY_NUMPAD9) = Asc("9")
Key(TV_KEY_NUMPADPLUS) = Asc("+")
Key(TV_KEY_NUMPADMINUS) = Asc("-")
Key(TV_KEY_NUMPADSTAR) = Asc("*")
Key(TV_KEY_NUMPADSLASH) = Asc("/")
Key(TV_KEY_NUMPADPERIOD) = Asc(".")
Key(TV_KEY_NUMPADEQUALS) = Asc("=")
Key(TV_KEY_NUMPADCOMMA) = Asc(",")
Me.Show
TV.DisplayFPS = True
' Initialize the engine in window mode.
TV.SetDebugFile App.Path & "/debug.txt"
TV.Init3DWindowedMode Me.hWnd, True
' we set a repetition delay of 200ms
Inp.SetRepetitionDelay 200
Dim Text As String
Dim cursorpos As Long
FontID = TextF.TextureFont_Create("font", "Arial", 10, True)
Dim oldtimer As Long
Do
Dim buffer(1024) As TV_KEYDATA, numevents As Long
Inp.GetKeyBuffer buffer, numevents
'Analyse
'let's see what keys have been pressed :p
For i = 0 To numevents - 1
If buffer(i).Pressed = True Then
'hmm well a key has been pressed
'lets see what kind of key it is :
Dim k As Long
k = buffer(i).Key
If Key(k) > 0 Then
If Len(Text) < 40 Then
' it's a letter/number key
' add it to the text at the good place
Dim CharToAdd As String
If ShiftPressed = True Then
CharToAdd = UCase$(Chr$(Key(k)))
Else
CharToAdd = Chr$(Key(k))
End If
If cursorpos = 0 Then
Text = CharToAdd & Text
cursorpos = cursorpos + 1
ElseIf cursorpos = Len(Text) Then
Text = Text & CharToAdd
cursorpos = cursorpos + 1
Else
Text = Left$(Text, cursorpos) & CharToAdd & Mid$(Text, cursorpos + 1)
cursorpos = cursorpos + 1
End If
End If
Else
' other keys
' arrow keys first :
If k = TV_KEY_LEFT Then If cursorpos > 0 Then cursorpos = cursorpos - 1
If k = TV_KEY_RIGHT Then If cursorpos < Len(Text) Then cursorpos = cursorpos + 1
If k = TV_KEY_LEFTSHIFT Or k = TV_KEY_RIGHTSHIFT Then
ShiftPressed = True
End If
' backspace. remove the character just before
If k = TV_KEY_BACKSPACE Then
If cursorpos > 0 Then
If cursorpos < Len(Text) Then
Text = Left$(Text, cursorpos - 1) & Mid$(Text, cursorpos + 1)
Else
Text = Left$(Text, cursorpos - 1)
End If
cursorpos = cursorpos - 1
End If
End If
End If
Else
'let's know if the user released the shift key
If buffer(i).Key = TV_KEY_LEFTSHIFT Or buffer(i).Key = TV_KEY_RIGHTSHIFT Then
ShiftPressed = False
End If
End If
Next i
TV.Clear
TextF.TextureFont_DrawTextFontID Text, 12, 33, RGBA(1, 1, 1, 1), FontID
'display the cursor
Dim w As Single, h As Single
If cursorpos = 0 Then
w = 0
Else
TextF.TextureFont_GetTextSize Left$(Text, cursorpos), FontID, w, h
End If
scr.DRAW_Line 12 + w, 32, 12 + w, 30 + 18, RGBA(1, 1, 1, Sin(TV.TickCount * 0.01) * 0.5 + 0.5)
scr.DRAW_Box 10, 30, 300, 50, &HFFFFFFFF
TV.RenderToScreen
DoEvents
Loop Until Inp.IsKeyPressed(TV_KEY_ESCAPE) = True Or IsFinished = True
Set TV = Nothing
End
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
IsFinished = True
Cancel = 1
End Sub
---------------------------
以一张贴图做背景，并谈入淡出
'---------------------------------------------------------------------
' TrueVision3D Tutorials : Uses a RenderSurface for GUI or RenderText
'-------------------------------------------------------------------------
' RenderToSurface for text and dynamic texture
' This allows to draw text on your textures for example.
'
Public TV As TVEngine
Public Scene As TVScene
Public WithEvents Inp As TVInputEngine
Public Scr As TVScreen2DImmediate
Public Text As TVScreen2DText
'Render To Surface objects
Public Text1 As TVRenderSurface
Public DynTex As TVRenderSurface
'Mesh where the billboard will be applied
Public TextMesh As TVMesh
Public DynTexMesh As TVMesh
'Rotation angle
Public Ang As Single, Scrolling As Single
Private Sub Form_Load()
'-----------------------------
' Set up a TrueVision3D Project
'-----------------------------
Set TV = New TVEngine
Set Scene = New TVScene
Set Scr = New TVScreen2DImmediate
Set Text = New TVScreen2DText
TV.SetSearchDirectory App.Path
'Initialize TrueVision3D in windowed mode
TV.Init3DWindowedMode RenderSurface.hWnd
TV.SetAngleSystem TV_ANGLE_DEGREE
Scr.SETTINGS_SetTextureFilter TV_FILTER_TRILINEAR
'Create input
Set Inp = New TVInputEngine
Inp.EnableEvents True
'-----------------------------
' RENDER TO SURFACE CREATION
'-----------------------------
Show
'Create the text "texture"
Set Text1 = Scene.CreateRenderSurface(128, 32, True)
'To draw on this surface, you have to start the render
'on the surface and use the standard Screen8 functions.
'When you have finshed to render to this surface, don't
'forget to End the render
Text1.StartRender
Text.NormalFont_Create "TV", "Arial", 18, True, True, False
Scr.ACTION_Begin2D
Scr.DRAW_FilledBox 0, 0, 128, 32, RGBA(1, 1, 1, 1), RGBA(1, 0, 1, 1), RGBA(1, 0, 0, 1), RGBA(0, 0, 0, 1)
Scr.ACTION_End2D
Text.ACTION_BeginText
Text.NormalFont_DrawText "TrueVision", 1, 1, RGBA(1, 1, 0, 1), "TV"
Text.ACTION_EndText
Text1.EndRender
'Let's create now its mesh and let's add a simple spinning face
Set TextMesh = Scene.CreateMeshBuilder("TextMesh")
TextMesh.AddWall 0, -10, 0, 10, 0, 5
'Use the RenderSurface as a texture
TextMesh.SetTexture Text1.GetTexture
'Create the dynamic texture
Set DynTex = Scene.CreateRenderSurface(64, 64, True)
'Create a face in the mesh
Set DynTexMesh = Scene.CreateMeshBuilder("DynTex")
DynTexMesh.AddWall 0, -50, 0, 50, 0, 100, -50
'Move it
DynTexMesh.SetPosition 0, 0, 30
'Put the texture
DynTexMesh.SetTexture DynTex.GetTexture
'Load the texture
Scene.LoadTexture "../../../Media/tex.jpg", , , "DynTex"
'Set the camera in order to see the entire scene
Scene.SetCamera 0, 0, -30, 0, 0, 0
Scr.SETTINGS_SetClamping False
Do
DoEvents
'Let's render the dynamic texture, BEFORE the TV.Clear
DynTex.StartRender
'Update and Render the scrolling texture on the dyntex
Scrolling = Scrolling + TV.TimeElapsed * 0.0003
If Scrolling > 1 Then Scrolling = Scrolling - 1
Scr.ACTION_Begin2D
Scr.DRAW_Texture GetTex("DynTex"), 0, 0, 64, 64, RGBA(1, 1, 1, Abs(Scrolling - 0.5) * 2), , , , Scrolling, 1, Scrolling + 1, 0
Scr.ACTION_End2D
DynTex.EndRender
'Clear TV screen
TV.Clear
'Render the mesh (with the texture text)
Scene.RenderAllMeshes
'Copy all to the screen
TV.RenderToScreen
'Spin the Text
Ang = Ang + TV.TimeElapsed * 0.04
TextMesh.SetRotation 0, Ang, Ang
Loop Until Inp.IsKeyPressed(TV_KEY_ESCAPE) = True
Set TV = Nothing
Unload Me
End Sub
-----------------------------------------
' ----------------------------------------------
' TrueVision 3D SDK sample - Tilemaps
'------------------------------------------------
'
' Goal:
' Demonstrates the use of tilemaps, bitmap parts, texture fonts and other types
' of fonts.
Option Explicit
Public Running As Boolean
Public TakeScreenShot As Boolean
Public TV As TVEngine
Public TexFac As TVTextureFactory
Public Screen2DIm As TVScreen2DImmediate
Public Direction As CONST_TV_TEXT_DIRECTION
Public Sub Main()
Dim Map As TVTileMap
Dim FontCustom As TVBitmapParts
Dim FontNighthawk As TVBitmapParts
Dim i As Single
Dim Viewport As RECT
Dim Pos1 As Long
Dim Pos2 As Long
Dim TextureId1 As Long
Dim ScreenText As New TVScreen2DText
' Initialize objects and variables.
Set TV = New TVEngine
Set TexFac = New TVTextureFactory
Set Screen2DIm = New TVScreen2DImmediate
Set Map = New TVTileMap
Set FontCustom = New TVBitmapParts
Set FontNighthawk = New TVBitmapParts
Running = True
Direction = TV_TEXT_DIRECTION_LEFTRIGHT
' Initialize engine.
TV.SetVSync True
If MsgBox("Fullscreen?", vbYesNo) = vbYes Then
TV.Init3DFullscreen 1024, 768, 16
Else
TV.Init3DWindowedMode Form1.hWnd
End If
TV.DisplayFPS = True
Form1.Show
' Load tilemaps, font description files and bitmaps.
Map.LoadXML App.Path & "/../../../Media/Tilemaps/map_tiles.xml", App.Path & "/../../../Media/Tilemaps"
'Map.Load "http://www.xyz.com/map_tiles.xml", App.Path & "/../../../Media"
TextureId1 = TexFac.LoadTexture(App.Path & "/../../../Media/Tilemaps/" & Map.BitmapParts.Location, , , , Map.BitmapParts.Colorkey, False)
FontCustom.LoadXML App.Path & "/../../../Media/Fonts/CustomFont2.xml"
FontCustom.textureid = TexFac.LoadTexture(App.Path & "/../../../Media/Fonts/" & FontCustom.Location, , , , FontCustom.Colorkey, False)
'FontNighthawk.loadXML App.Path & "/../../../Media/Fonts/nghthwk.xml"
FontNighthawk.LoadBin App.Path & "/../../../Media/Fonts/nghthwk.tvbp"
FontNighthawk.textureid = TexFac.LoadTexture(App.Path & "/../../../Media/Fonts/" & FontNighthawk.Location, , , , FontNighthawk.Colorkey, False)
'FontNighthawk.SaveBin App.Path & "/../../../Media/Fonts/nghthwk.tvbp"
'FontNighthawk.SaveXML App.Path & "/../../../Media/Fonts/nghthwk.xml"
ScreenText.NormalFont_Create "normal_font", "Arial", 12, True, True, False
ScreenText.TextureFont_Create "texture_font", "Arial", 12, True, True, False
' Main loop.
Do While Running
TV.Clear
Screen2DIm.SETTINGS_SetClamping False
Screen2DIm.ACTION_Begin2D
' Draw the two tilemaps.
Viewport = REC(25, 25, 800, 500)
Screen2DIm.DRAW_TileMap Map, TextureId1, Pos1, Pos2, Viewport, 1, 1
Viewport = REC(650, 100, 850, 310)
Screen2DIm.DRAW_TileMap Map, TextureId1, Pos2, Pos1, Viewport, 3, 3, 0.8
' Draw the texture text.
Screen2DIm.DRAW_TextureText 10, 400, FontCustom, "TrueVision3D SDK", 2, 2, 0.8
Screen2DIm.DRAW_TextureText 300, 300, FontNighthawk, "ABCDEFGHIJKLMNOPQRSTUVWXYZ", 2, 2, 1, 5, CSng(i / 10), Direction
Screen2DIm.DRAW_Texture TextureId1, 0, 0, 0, 0
' Draw a bitmap part. Draw the part with id 1 (the 'A') from the
' CustomFont bitmap parts collection. Remember that a bitmap part does
' not have to be a letter or number. It can be anything you want.
Screen2DIm.DRAW_BitmapPart FontCustom, 1, 210, 10, 2, 2
' Update render positions.
i = i + 0.5
Pos1 = 200 * Sin(Deg2Rad(CSng(i))) - 400
Pos2 = Pos1 - 300 * Cos(Deg2Rad(CSng(i)))
If i = 360 Then i = 0
Screen2DIm.ACTION_End2D
' Draw text using TTF fonts (normal and prerendered).
ScreenText.ACTION_BeginText
ScreenText.NormalFont_DrawText "Use keys 1-4 for text direction, s for screenshot", 0, 40, RGBA(1, 1, 1, 1), "normal_font"
ScreenText.TextureFont_DrawText "and esc to quit.", 0, 60, RGBA(1, 1, 1, 1), "texture_font"
ScreenText.ACTION_EndText
TV.RenderToScreen
' Save a screenshot when 's' was pressed (see Form1.Form_KeyDown).
If TakeScreenShot Then
TV.ScreenShot App.Path & "/Test.bmp"
TakeScreenShot = False
End If
DoEvents
Loop
Set FontNighthawk = Nothing
Set FontCustom = Nothing
Set Map = Nothing
Set Screen2DIm = Nothing
Set TexFac = Nothing
Set TV = Nothing
End
End Sub
-------------------------------------------
6663
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
