Full Screen GUI Development
Pt 2 ?More Controls & Text
By Jim (Machaira) Perry
Welcome back! If you抮e saying 揌uh?!?then you probably haven抰 read the first part of this tutorial. Please read it before continuing because we抣l be building on it.
Download this tutorial (in Word format) and the sample projects in a zip file (40 KB)
First Up
Let抯 build on our base window by adding the standard Minimize, Maximize/Restore, and Close buttons (see WindowSample3 project).
We抳e added enums for the new buttons:
CloseBtn
MinBtn
MaxBtn
RestoreBtn
created bitmaps for them (close.bmp, minimize.bmp, maximize.bmp, and restore.bmp), and added instances of the clsWindow class in the modDirectDraw module to create them:
Public WithEvents CloseButton As New clsWindow
Public WithEvents MinButton As New clsWindow
Public WithEvents MaxButton As New clsWindow
Public WithEvents RestoreButton As New clsWindow
Notice that we抳e added WithEvents to the declarations. This will allow us to do things outside of the class when the control is clicked. We抣l go over this a little later.
New controls mean that we have to add them as child controls to the base window object. We抳e done this in the CreateWindowObjects function, setting the necessary properties for them:
With frmMain.CloseButton
.ObjectType = CloseBtn
.ParentHeight = frmMain.Window.Height
.ParentWidth = frmMain.Window.Width
.ParentX = frmMain.Window.X
.ParentY = frmMain.Window.Y
.ObjectSurface = objDD.CreateSurfaceFromFile(App.Path & "\close.bmp", ddsdSurf4)
.WindowName = "CloseBtn"
End With
frmMain.Window.AddChild frmMain.CloseButton
With frmMain.MinimizeButton
.ObjectType = MinBtn
.ParentHeight = frmMain.Window.Height
.ParentWidth = frmMain.Window.Width
.ParentX = frmMain.Window.X
.ParentY = frmMain.Window.Y
.ObjectSurface = objDD.CreateSurfaceFromFile(App.Path & "\minimize.bmp", ddsdSurf4)
.WindowName = "MinBtn"
End With
frmMain.Window.AddChild frmMain.MinimizeButton
With frmMain.MaximizeButton
.ObjectType = MaxBtn
.ParentHeight = frmMain.Window.Height
.ParentWidth = frmMain.Window.Width
.ParentX = frmMain.Window.X
.ParentY = frmMain.Window.Y
.ObjectSurface = objDD.CreateSurfaceFromFile(App.Path & "\maximize.bmp", ddsdSurf4)
.WindowName = "MaxBtn"
End With
frmMain.Window.AddChild frmMain.MaximizeButton
With frmMain.RestoreButton
.ObjectType = RestoreBtn
.ParentHeight = frmMain.Window.Height
.ParentWidth = frmMain.Window.Width
.ParentX = frmMain.Window.X
.ParentY = frmMain.Window.Y
.ObjectSurface = objDD.CreateSurfaceFromFile(App.Path & "\restore.bmp", ddsdSurf4)
.WindowName = "RestoreBtn"
End With
frmMain.Window.AddChild frmMain.RestoreButton
This is code that used to be in the InitDD function, but has been moved out for a good reason, as you抣l see soon. It allows us to recreate the base window object and all children whenever we want. Notice also that we抳e changed the code to use the With匛ndWIth statements. It抯 saves our poor little fingers from having to type as much and speeds up the code a bit (not that it抣l be noticeable unless you timed it.
If you compare this chunk of code with the code to create the OK button, you抣l notice that we抮e not setting any X and Y or ObjectState properties for the buttons. That抯 because you can抰. The buttons only go in one place, the standard position on the window they抮e attached to. The properties are set in the ObjectSurface Property Set method:
Case MinBtn
iHeight = ddsd.lHeight / 2
iX = iParentWidth + iParentX - iWidth - 40
iY = iParentY + 7
iObjectState = iEnabled
Case MaxBtn
iHeight = ddsd.lHeight / 2
iX = iParentWidth + iParentX - iWidth - 24
iY = iParentY + 7
iObjectState = iEnabled
Case CloseBtn
iHeight = ddsd.lHeight / 2
iX = iParentWidth + iParentX - iWidth - 6
iY = iParentY + 7
iObjectState = iEnabled
Case RestoreBtn
iHeight = ddsd.lHeight / 2
iX = iParentWidth + iParentX - iWidth - 24
iY = iParentY + 7
iObjectState = iEnabled
The DrawObject function is also modified to handle drawing the new controls:
Case MinBtn, MaxBtn, CloseBtn, RestoreBtn
rectObject.Left = 0
rectObject.Right = iWidth
Select Case iObjectState
Case iEnabled
rectObject.Top = 0
rectObject.Bottom = iHeight
Case iPressed
rectObject.Top = iHeight
rectObject.Bottom = iHeight * 2
End Select
If you run the app, you抣l see the new buttons in the upper right hand corner of the window. You抣l also notice that we抳e added a caption for the window. This is held by the sCaption member of the clsWindow class. If you look at the declarations section for the class you抣l also see two other new members:
Private iCaptionX As Integer
Private iCaptionY As Integer
These will be used to draw the caption where it is needed for the specific control type. If you look at the DrawObject function in the class you抣l see we抳e added the code necessary to handle the caption:
Case BaseWindow
'Nothing needed here since we use the base rectangle
If Len(sCaption) > 0 Then
iCaptionX = iX + 10
iCaptionY = iY + 5
bDrawCaption = True
Else
bDrawCaption = False
End If
?/SPAN>
If bDrawCaption Then
lOldColor = objSurface.GetForeColor
objSurface.SetForeColor RGB(255, 255, 255)
objSurface.DrawText iCaptionX, iCaptionY, sCaption, False
objSurface.SetForeColor lOldColor
End If
The setup of the base window object has been changed to add the caption:
With frmMain.Window
.ObjectSurface = objDD.CreateSurfaceFromFile(App.Path & "\window.bmp", ddsdSurf2)
.ParentX = 0
.ParentY = 0
.ParentHeight = 600
.ParentWidth = 800
.CenterX = True
.CenterY = True
.WindowName = "Base"
.Caption = "Test Window"
End With
The next thing that has been added is the event raising. Take a look at the MouseUp function in the clsWindow class:
Public Function MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) As Boolean
Dim iLp As Integer
Dim bRetVal As Boolean
MouseUp = False
If X >= iX And X <= iX + iWidth And Y >= iY And Y <= iY + iHeight Then
For iLp = 1 To colChildren.Count
'If a child handles the event no need to do anything else
bRetVal = colChildren(iLp).MouseUp(Button, Shift, X, Y)
If bRetVal Then Exit Function
Next iLp
If iObjectType >= CloseBtn Then
iObjectState = iEnabled
If iObjectType = CloseBtn Then
RaiseEvent Clicked
End If
Else
If Not (iObjectState = iDisabled) Then
If iObjectState = iPressed And iObjectType = Btn Then
iObjectState = iEnabled
RaiseEvent Clicked
End If
End If
End If
MouseUp = True
End If
End Function
If the control has been clicked we use RaiseEvent to notify the app that this is so. The app can then decide what to do based on which control has been clicked. In our case we do two things ?destroy the window and close the app:
Private Sub CloseButton_Clicked()
Window.RemoveChildren
Set Window = Nothing
End Sub
Private Sub OKButton_Clicked()
gbRun = False
End Sub
You can recreate the window by pressing the F1 key. Try it and see. I抣l wait while you do. J
Got all that? Good, then lets more on to more cool stuff.
Next Up
Open up the WindowSample4 project and take a look at the modMain module. You抣l see we抳e added RadioBtn and FrameWnd enums. Also not the constant cFrameGrey. We抣l be using this a little later on to help draw the FrameWnd control.
Next take a look at the frmMain code. We抳e added declarations for the new frame and radio button objects. Notice the two sets of radio buttons ?WindowRadio1,2, and 3 and Radio1, 2, and 3. The WindowRadio controls will go on the base window and the Radio controls will be contained by the Frame control. You抣l see that you can change a control in one group without affecting the other, just as you can in VB. This is due to the Parent/Child relationship of the clsWindow objects. We抳e also added the code to support the RaiseEvent call in the class for each of the objects. We merely set two controls that weren抰 clicked to be unchecked.
Not much has changed in the modDirectDraw module. The only thing of significance is in setting up the radio buttons that are contained by the Frame control:
With frmMain.Radio1
.ObjectType = RadioBtn
.ObjectState = iUnchecked
.ParentHeight = frmMain.Frame1.Height
.ParentWidth = frmMain.Frame1.Width
.ParentX = frmMain.Frame1.X
.ParentY = frmMain.Frame1.Y
.X = 100 + .ParentX
.Y = 100 + .ParentY
.ObjectSurface = objDD.CreateSurfaceFromFile(App.Path & "\radio.bmp", ddsdSurf6)
.WindowName = "Radio1"
.Caption = "Radio 1"
End With
'Add to frame not base window
frmMain.Frame1.AddChild frmMain.Radio1
With frmMain.Radio2
.ObjectType = RadioBtn
.ObjectState = iUnchecked
.ParentHeight = frmMain.Frame1.Height
.ParentWidth = frmMain.Frame1.Width
.ParentX = frmMain.Frame1.X
.ParentY = frmMain.Frame1.Y
.X = 100 + .ParentX
.Y = 115 + .ParentY
.ObjectSurface = objDD.CreateSurfaceFromFile(App.Path & "\Radio.bmp", ddsdSurf6)
.WindowName = "Radio2"
.Caption = "Radio 2"
End With
'Add to frame not base window
frmMain.Frame1.AddChild frmMain.Radio2
With frmMain.Radio3
.ObjectType = RadioBtn
.ObjectState = iUnchecked
.ParentHeight = frmMain.Frame1.Height
.ParentWidth = frmMain.Frame1.Width
.ParentX = frmMain.Frame1.X
.ParentY = frmMain.Frame1.Y
.X = 100 + .ParentX
.Y = 130 + .ParentY
.ObjectSurface = objDD.CreateSurfaceFromFile(App.Path & "\Radio.bmp", ddsdSurf6)
.WindowName = "Radio3"
.Caption = "Radio 3"
End With
'Add to frame not base window
frmMain.Frame1.AddChild frmMain.Radio3
Notice that we抮e calling AddChild for the Frame1 control, not the Window control.
The clsWindow class has changed a bit as you probably expected. We抳e exposed the Width and Height members of the clsWindow class in order to set up the Frame control:
With frmMain.Frame1
.ObjectType = FrameWnd
.ObjectState = iEnabled
.ParentHeight = frmMain.Window.Height
.ParentWidth = frmMain.Window.Width
.ParentX = frmMain.Window.X
.ParentY = frmMain.Window.Y
.X = 75
.Y = 75
.Width = 200
.Height = 200
.WindowName = "Frame1"
.Caption = "Test Frame"
End With
frmMain.Window.AddChild frmMain.Frame1
The Property Let ObjectSurface and MouseDown function have had the RadioBtn added to the cases for the ChkBox:
Public Property Let ObjectSurface(ByVal objSurface As DirectDrawSurface7)
?/SPAN>
Case ChkBox, RadioBtn
iHeight = ddsd.lHeight / 4
?/SPAN>
End Property
Public Function DrawObject(objSurface As DirectDrawSurface7)
Dim clsWindow As clsWindow
Dim iLp As Integer
Dim ddsd As DDSURFACEDESC2
Dim rectBitmap As RECT
Dim rectObject As RECT
Dim lRet As Long
Dim bDrawCaption As Boolean
Dim lOldColor As Long
Dim lBltFlags As Long
On Error GoTo DrawObjectErr
rectBitmap.Left = iX
rectBitmap.Right = iX + iWidth
rectBitmap.Top = iY
rectBitmap.Bottom = iY + iHeight
Select Case iObjectType
Case Btn
rectObject.Left = 0
rectObject.Right = iWidth
Select Case iObjectState
Case iEnabled
rectObject.Top = 0
rectObject.Bottom = iHeight
Case iDisabled
rectObject.Top = iHeight * 2
rectObject.Bottom = iHeight * 3
Case iPressed
rectObject.Top = iHeight
rectObject.Bottom = iHeight * 2
End Select
Case ChkBox, RadioBtn
rectObject.Left = 0
rectObject.Right = iWidth
Select Case iObjectState
Case iUnchecked
rectObject.Top = 0
rectObject.Bottom = iHeight
Case iDisabled
rectObject.Top = iHeight * 2
rectObject.Bottom = iHeight * 3
Case iChecked
rectObject.Top = iHeight
rectObject.Bottom = iHeight * 2
Case iChecked_iDisabled
rectObject.Top = iHeight * 3
rectObject.Bottom = iHeight * 4
End Select
If Len(sCaption) > 0 Then
iCaptionX = iX + 15
iCaptionY = iY
bDrawCaption = True
Else
bDrawCaption = False
End If
Case MinBtn, MaxBtn, CloseBtn, RestoreBtn
rectObject.Left = 0
rectObject.Right = iWidth
Select Case iObjectState
Case iEnabled
rectObject.Top = 0
rectObject.Bottom = iHeight
Case iPressed
rectObject.Top = iHeight
rectObject.Bottom = iHeight * 2
End Select
Case FrameWnd
'see framesample.bmp for how this should look as a normal VB control
lOldColor = objSurface.GetFillColor
objSurface.SetForeColor cFrameGrey
objSurface.DrawLine iX + iParentX, iY + iParentY, iX + iParentX + iWidth, iY + iParentY
objSurface.DrawLine iX + iParentX, iY + iParentY, iX + iParentX, iY + iParentY + iHeight
objSurface.DrawLine iX + iParentX, iY + iParentY + iHeight, iX + iParentX + iWidth, iY + iParentY + iHeight
objSurface.DrawLine iX + iParentX + iWidth, iY + iParentY, iX + iParentX + iWidth, iY + iParentY + iHeight
objSurface.SetForeColor vbWhite
objSurface.DrawLine iX + iParentX + 1, iY + iParentY + 1, iX + iParentX + iWidth - 1, iY + iParentY + 1
objSurface.DrawLine iX + iParentX + 1, iY + iParentY + 1, iX + iParentX + 1, iY + iParentY + iHeight - 1
objSurface.DrawLine iX + iParentX, iY + iParentY + iHeight + 1, iX + iParentX + iWidth + 1, iY + iParentY + iHeight + 1
objSurface.DrawLine iX + iParentX + iWidth + 1, iY + iParentY, iX + iParentX + iWidth + 1, iY + iParentY + iHeight + 1
objSurface.SetForeColor lOldColor
If Len(sCaption) > 0 Then
iCaptionX = iX + iParentX + 10
iCaptionY = iY + ParentY - 8
bDrawCaption = True
Else
bDrawCaption = False
End If
Case BaseWindow
'Nothing needed here since we use the base rectangle
If Len(sCaption) > 0 Then
iCaptionX = iX + 10
iCaptionY = iY + 5
bDrawCaption = True
Else
bDrawCaption = False
End If
End Select
lBltFlags = DDBLT_WAIT
'Need to use transparency if it's a radio button
If iObjectType = RadioBtn Then
lBltFlags = DDBLT_WAIT Or DDBLT_KEYSRC
End If
'Don't blit if it a frame control
If iObjectType <> FrameWnd Then lRet = objSurface.Blt(rectBitmap, objBitmap, rectObject, lBltFlags)
If bDrawCaption Then
lOldColor = objSurface.GetForeColor
objSurface.SetForeColor RGB(255, 255, 255)
objSurface.DrawText iCaptionX, iCaptionY, sCaption, False
objSurface.SetForeColor lOldColor
End If
For iLp = 1 To colChildren.Count
colChildren(iLp).DrawObject objSurface
Next iLp
Exit Function
DrawObjectErr:
objErr.WriteLine "Error drawing " & sName & " - " & Err.Description
Exit Function
End Function
As you can see the changes are pretty extensive. The function now has to handle the two new controls and the new Caption member. The RadioBtn is fairly simple since it pretty much acts like the ChkBox inside the class. If you looked at the files included with this project you抣l notice that there抯 no bitmap for the frame object. That抯 because it uses DirectDraw抯 DrawLine function to draw the outline of the frame. Open the framesample.bmp file and zoom in to see how it抯 actually drawn.
We抳e added a function in the class to return a child object. This is necessary to change the RadioBtn抯 ObjectState member when one radio button in a group is clicked:
Public Function GetChild(ByVal sKey As String) As clsWindow
Set GetChild = colChildren(sKey)
End Function
The AddChild method was changed to specify a key when adding a child in order to support this function:
Public Sub AddChild(clsChild As clsWindow)
colChildren.Add clsChild, clsChild.WindowName
End Sub
Take a minute to run the app and play with the new controls. There are a couple of things that could be changed to make the class better but I抣l leave them up to you. Some things could be:
Add members to allow the font type, size and color to be changed. Add a Style member to allow the ChkBox and RadioBtn objects to be graphical similar to the way the VB controls act. Change the frame drawing to not draw under the caption. Adapt the class to add a LabelWnd object type. This would just use the Caption property
That抯 it for this lesson. I hope it抯 been fun and interesting. The next lesson will attempt to cover listboxes and comboboxes. Hope to see you there.
本文地址：http://com.8s8s.com/it/it6437.htm