Visual Basic Controls/Visual Basic Controls.iso/vbcontrol/messag/movectl.fr_/movectl.fr

Visual Basic Form | 1995-01-14 | 10.7 KB | 318 lines

VERSION 2.00
Begin Form MoveCtl
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Moving Controls..."
   ClientHeight    =   3555
   ClientLeft      =   1035
   ClientTop       =   1500
   ClientWidth     =   7350
   Height          =   3960
   Left            =   975
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   ScaleHeight     =   3555
   ScaleWidth      =   7350
   Top             =   1155
   Width           =   7470
   Begin PictureBox PictureBack
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   0  'None
      Height          =   3435
      Left            =   60
      ScaleHeight     =   3435
      ScaleWidth      =   7215
      TabIndex        =   2
      Top             =   60
      Width           =   7215
      Begin PictureBox Picture1
         BackColor       =   &H00C0C0C0&
         Height          =   1635
         Left            =   1320
         ScaleHeight     =   107
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   123
         TabIndex        =   5
         Top             =   1680
         Width           =   1875
         Begin Message Message1
            Left            =   1860
            Top             =   1680
         End
         Begin Label LblTitle1
            Alignment       =   2  'Center
            BackColor       =   &H00800000&
            BorderStyle     =   1  'Fixed Single
            Caption         =   "Resize/Move Me"
            ForeColor       =   &H00FFFFFF&
            Height          =   255
            Left            =   0
            TabIndex        =   0
            Top             =   120
            Width           =   1635
         End
         Begin Image Image1
            Height          =   1590
            Left            =   60
            Picture         =   MOVECTL.FGX:0000
            Stretch         =   -1  'True
            Top             =   420
            Width           =   1695
         End
      End
      Begin PictureBox Picture2
         BackColor       =   &H00C0C0C0&
         Height          =   1515
         Left            =   3660
         ScaleHeight     =   99
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   167
         TabIndex        =   3
         Top             =   1740
         Width           =   2535
         Begin Message Message2
            Left            =   2100
            Top             =   1560
         End
         Begin TextBox Text1
            Height          =   975
            Left            =   120
            MultiLine       =   -1  'True
            ScrollBars      =   2  'Vertical
            TabIndex        =   4
            Text            =   "Type some text in this box and then resize the control as you would any form..."
            Top             =   360
            Width           =   2295
         End
         Begin Label LblTitle2
            Alignment       =   2  'Center
            BackColor       =   &H00800000&
            BorderStyle     =   1  'Fixed Single
            Caption         =   "Resize/Move Me"
            ForeColor       =   &H00FFFFFF&
            Height          =   255
            Left            =   0
            TabIndex        =   6
            Top             =   0
            Width           =   1635
         End
      End
      Begin Label LabelMsg
         Alignment       =   2  'Center
         BackStyle       =   0  'Transparent
         Caption         =   "LabelMsg"
         ForeColor       =   &H00800000&
         Height          =   1515
         Left            =   60
         TabIndex        =   1
         Top             =   0
         Width           =   6975
      End
   End
Sub Form_Load ()
    DisplayedMoveCtl = True
    Message1.hWindow = Picture1.hWnd
    Message1.Status(WM_NChitTest) = True
    Message1.Status(WM_NClButtonDblClk) = True
    Message1.Status(WM_GetMinMaxInfo) = True
    Message2.hWindow = Picture2.hWnd
    Message2.Status(WM_NChitTest) = True
    Message2.Status(WM_NClButtonDblClk) = True
    Message2.Status(WM_GetMinMaxInfo) = True
    msg$ = "By intercepting messages with Message.VBX," + nl
    msg$ = msg$ + "you can subclass controls to perform" + nl
    msg$ = msg$ + "functions they normally couldn't under VB." + nl
    msg$ = msg$ + "The PictureBox can be moved and resized in Run Mode!!!" + nl
    msg$ = msg$ + "It's like having child windows inside other child windows." + nl
    msg$ = msg$ + "And ... this is just scratching the surface of the" + nl
    msg$ = msg$ + "possibilities you have with Message.VBX."
    LabelMsg.Caption = msg$
    Picture1_Resize
    Picture2_Resize
    Screen.MousePointer = 0
End Sub
Sub Form_Paint ()
    DoForm3D Me, "raised", 2, 0
    DoForm3D Me, "sunken", 2, 2
End Sub
Sub Form_Unload (Cancel As Integer)
    DisplayedMoveCtl = False
End Sub
Sub Message1_Receive (msg As Integer, wParam As Integer, lParam As Long, UseRetVal As Integer, RetVal As Long)
    Dim CsrPos As PointAPI
    If msg = WM_NChitTest Then  'allow it to move and resize
        CsrPos.x = CInt(GetLowWord(lParam))
        CsrPos.y = CInt(GetHighWord(lParam))
        ScreenToClient Picture1.hWnd, CsrPos
        PicWide = Picture1.ScaleWidth
        PicHigh = Picture1.ScaleHeight

        If CsrPos.y > 4 And CsrPos.y < 19 And CsrPos.x > 4 And CsrPos.x < PicWide - 4 Then
            RetVal = HTCAPTION
            UseRetVal = 1
            Exit Sub
            End If
        If CsrPos.y < 8 And CsrPos.x < 8 Then
            RetVal = HTTOPLEFT
            UseRetVal = 1
            Exit Sub
            End If
        If CsrPos.y < 8 And CsrPos.x > PicWide - 8 Then
            RetVal = HTTOPRIGHT
            UseRetVal = 1
            Exit Sub
            End If
        If CsrPos.y > PicHigh - 8 And CsrPos.x < 8 Then
            RetVal = HTBOTTOMLEFT
            UseRetVal = 1
            Exit Sub
            End If
        If CsrPos.y > PicHigh - 8 And CsrPos.x > PicWide - 8 Then
            RetVal = HTBOTTOMRIGHT
            UseRetVal = 1
            Exit Sub
            End If
        If CsrPos.y < 4 Then
            RetVal = HTTOP
            UseRetVal = 1
            End If
        If CsrPos.y > PicHigh - 4 Then
            RetVal = HTBOTTOM
            UseRetVal = 1
            End If
        If CsrPos.x < 4 Then
            RetVal = HTLEFT
            UseRetVal = 1
            End If
        If CsrPos.x > PicWide - 4 Then
            RetVal = HTRIGHT
            UseRetVal = 1
            End If
        End If

    If msg = WM_NClButtonDblClk Then  'stop dbl-click from maximizing
        RetVal = 0
        UseRetVal = 1
        Exit Sub
        End If
    If msg = WM_GetMinMaxInfo Then  'set resize limits
        Dim MinMax As MinMaxInfo
        MessageDataGet lParam, Len(MinMax), MinMax
            MinMax.ptMaxSize.x = 320
            MinMax.ptMaxSize.y = 240
            MinMax.ptMaxPosition.x = 0
            MinMax.ptMaxPosition.y = 0
            MinMax.ptMaxTrackSize.x = 320
            MinMax.ptMaxTrackSize.y = 240
            MinMax.ptMinTrackSize.x = 120
            MinMax.ptMinTrackSize.y = 64
        MessageDataSet lParam, Len(MinMax), MinMax
        UseRetVal = 1
        RetVal = 0
        End If
End Sub
Sub Message2_Receive (msg As Integer, wParam As Integer, lParam As Long, UseRetVal As Integer, RetVal As Long)
    Dim CsrPos As PointAPI
    If msg = WM_NChitTest Then  'allow it to move and resize
        CsrPos.x = CInt(GetLowWord(lParam))
        CsrPos.y = CInt(GetHighWord(lParam))
        ScreenToClient Picture2.hWnd, CsrPos
        PicWide = Picture2.ScaleWidth
        PicHigh = Picture2.ScaleHeight

        If CsrPos.y > 4 And CsrPos.y < 19 And CsrPos.x > 4 And CsrPos.x < PicWide - 4 Then
            RetVal = HTCAPTION
            UseRetVal = 1
            Exit Sub
            End If
        If CsrPos.y < 8 And CsrPos.x < 8 Then
            RetVal = HTTOPLEFT
            UseRetVal = 1
            Exit Sub
            End If
        If CsrPos.y < 8 And CsrPos.x > PicWide - 8 Then
            RetVal = HTTOPRIGHT
            UseRetVal = 1
            Exit Sub
            End If
        If CsrPos.y > PicHigh - 8 And CsrPos.x < 8 Then
            RetVal = HTBOTTOMLEFT
            UseRetVal = 1
            Exit Sub
            End If
        If CsrPos.y > PicHigh - 8 And CsrPos.x > PicWide - 8 Then
            RetVal = HTBOTTOMRIGHT
            UseRetVal = 1
            Exit Sub
            End If
        If CsrPos.y < 4 Then
            RetVal = HTTOP
            UseRetVal = 1
            End If
        If CsrPos.y > PicHigh - 4 Then
            RetVal = HTBOTTOM
            UseRetVal = 1
            End If
        If CsrPos.x < 4 Then
            RetVal = HTLEFT
            UseRetVal = 1
            End If
        If CsrPos.x > PicWide - 4 Then
            RetVal = HTRIGHT
            UseRetVal = 1
            End If
        End If

    If msg = WM_NClButtonDblClk Then  'stop dbl-click from maximizing
        RetVal = 0
        UseRetVal = 1
        Exit Sub
        End If
    If msg = WM_GetMinMaxInfo Then  'set resize limits
        Dim MinMax As MinMaxInfo
        MessageDataGet lParam, Len(MinMax), MinMax
            MinMax.ptMaxSize.x = 400
            MinMax.ptMaxSize.y = 200
            MinMax.ptMaxPosition.x = 0
            MinMax.ptMaxPosition.y = 0
            MinMax.ptMaxTrackSize.x = 400
            MinMax.ptMaxTrackSize.y = 200
            MinMax.ptMinTrackSize.x = 120
            MinMax.ptMinTrackSize.y = 64
        MessageDataSet lParam, Len(MinMax), MinMax
        UseRetVal = 1
        RetVal = 0
        End If
End Sub
Sub Picture1_Paint ()
    Picture1.Cls
    DoPicture3D Picture1, "raised", 2, 0
    DoPicture3D Picture1, "sunken", 2, 2
End Sub
Sub Picture1_Resize ()
    Picture1.AutoRedraw = True
    LblTitle1.Top = 4
    LblTitle1.Left = 4
    LblTitle1.Width = Picture1.ScaleWidth - 8
    Image1.Top = LblTitle1.Height + 6
    Image1.Left = 8
    Image1.Width = Picture1.ScaleWidth - 16
    Image1.Height = Picture1.ScaleHeight - LblTitle1.Height - 12
    Picture1.AutoRedraw = False
End Sub
Sub Picture2_Paint ()
    Picture2.Cls
    DoPicture3D Picture2, "raised", 2, 0
    DoPicture3D Picture2, "sunken", 2, 2
End Sub
Sub Picture2_Resize ()
    LblTitle2.Top = 4
    LblTitle2.Left = 4
    LblTitle2.Width = Picture2.ScaleWidth - 8
    Text1.Top = LblTitle2.Height + 6
    Text1.Left = 8
    Text1.Width = Picture2.ScaleWidth - 16
    Text1.Height = Picture2.ScaleHeight - LblTitle2.Height - 12
End Sub