DX: Full Screen GUI Development 2

Visual Basic 专栏收录该内容
17 篇文章 0 订阅

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.

  • 0
    点赞
  • 0
    评论
  • 0
    收藏
  • 一键三连
    一键三连
  • 扫一扫,分享海报

相关推荐
©️2020 CSDN 皮肤主题: 大白 设计师:CSDN官方博客 返回首页
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、C币套餐、付费专栏及课程。

余额充值