Uses "UI", "TBGL"
Type TBGL_CanWin ' canvas-window to display tbgl
hWnd As DWord
hCanvas As DWord
ClientW As Long
ClientH As Long
MouseX As Long
MouseY As Long
Backcolor As TBGL_TRGB
Forecolor As TBGL_TRGBA
Create As Function
Proceed As Function
SetForecolor As Function
SetBackcolor As Function
End Type
' -----------------------------------------------------------------
Function TBGL_CanWin.Create(ByVal sCaption As String, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal W As Long, _
ByVal H As Long _
) As DWord
' -----------------------------------------------------------------
Local hCanvas As DWord At VarPtr(Me.hCanvas)
Local screenW, screenH, screenD As Long
TBGL_GetDesktopInfo( screenW, screenH, screenD )
If X < 0 Or X + W > screenW Then
X = screenW * 0.5 - W * 0.5
EndIf
If Y < 0 Or Y + H > screenH Then
Y = screenH * 0.5 - H * 0.5
EndIf
Me.hWnd = Canvas_Window(sCaption, X, Y, W, H)
Me.hCanvas = Canvas_Attach Me.hWnd, 0, TRUE
Control Handle Me.hWnd, Me.hCanvas To hCanvas
Me.clientW = W
Me.ClientH = H
Function = Me.hWnd
End Function
' -----------------------------------------------------------------
Function TBGL_CanWin.Proceed() As Boolean
' -----------------------------------------------------------------
If Not IsWindow(Me.hWnd) Then Return FALSE
TBGL_BindCanvas( Me.hCanvas )
TBGL_RenderMatrix2D(0, Me.clientH, Me.clientW, 0) ' set the fitting matrix
TBGL_DepthFunc( %TBGL_ALWAYS ) ' draw from back to front
Me.MouseX = TBGL_MouseGetPosX
Me.MouseY = TBGL_MouseGetPosY
TBGL_BackColor(Me.Backcolor.R, Me.Backcolor.G, Me.Backcolor.B)
TBGL_ClearFrame
If All( _
Between(Me.MouseX, 0, Me.clientW), _
Between(Me.MouseY, 0, Me.clientH) _
) Then
' draw a haircross at mouse-pos
TBGL_Color(Me.Forecolor.R, Me.Forecolor.G, Me.Forecolor.B)
TBGL_Line(Me.MouseX - 5, Me.MouseY, Me.MouseX + 5, Me.MouseY)
TBGL_Line(Me.MouseX, Me.MouseY - 5, Me.MouseX, Me.MouseY + 5)
EndIf
TBGL_DrawFrame
If TBGL_GetWindowKeyOnce(Me.hWnd, %VK_ESCAPE) Then
Canvas_Window End Me.hWnd
Return FALSE
EndIf
Function = TRUE
End Function
' -----------------------------------------------------------------
Function TBGL_CanWin.SetForecolor(ByVal R As Byte, _
ByVal G As Byte, _
ByVal B As Byte, _
Optional ByVal A As Byte )
' -----------------------------------------------------------------
Me.Forecolor.R = R
Me.Forecolor.G = G
Me.Forecolor.B = B
If Function_CParams = 4 Then
Me.Forecolor.A = A
EndIf
End Function
' -----------------------------------------------------------------
Function TBGL_CanWin.SetBackcolor(ByVal R As Byte, _
ByVal G As Byte, _
ByVal B As Byte )
' -----------------------------------------------------------------
Me.Backcolor.R = R
Me.Backcolor.G = G
Me.Backcolor.B = B
End Function
'-------------------------------------------------------------------
' the unit is the code above
'#INCLUDE Once "TBGL_CanWin.tBasicU"
Function TBMain()
Dim window1, window2 As TBGL_CanWin
With window1
.Create("Window 1, esc to close", 200, 200, 320, 240 )
.setForecolor(255,255,0)
.setBackcolor(0, 50, 150)
End With
With window2
.Create("Window 2, esc to close", 300, 300, 240, 320 )
.setForecolor(20,40,50)
.setBackcolor(200, 250, 250)
End With
TBGL_ResetKeyState()
Do
Loop While Window1.proceed() Or Window2.proceed()
End Function
Bookmarks