Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/pgm_util/move2/move.frm

Visual Basic Form | 1995-10-10 | 10.1 KB | 241 lines

VERSION 2.00
Begin Form WinStyles
   BackColor       =   &H00C0C0C0&
   Caption         =   "Windows Style Manipulations"
   Height          =   7035
   Icon            =   MOVE.FRX:0000
   Left            =   945
   LinkTopic       =   "Form1"
   ScaleHeight     =   6630
   ScaleWidth      =   7365
   Top             =   1200
   Width           =   7485
   Begin PictureBox Picture3
      BackColor       =   &H0000FFFF&
      Height          =   855
      Left            =   480
      ScaleHeight     =   825
      ScaleWidth      =   2805
      TabIndex        =   6
      Top             =   5580
      Width           =   2835
   End
   Begin PictureBox Picture2
      AutoRedraw      =   -1  'True
      Height          =   855
      Left            =   3960
      ScaleHeight     =   825
      ScaleWidth      =   2865
      TabIndex        =   5
      Top             =   5580
      Width           =   2895
   End
   Begin TextBox Text2
      Height          =   975
      Left            =   3960
      TabIndex        =   4
      Text            =   "Text2"
      Top             =   4500
      Width           =   2895
   End
   Begin CommandButton Command1
      Caption         =   "Push me !"
      Height          =   975
      Left            =   480
      TabIndex        =   3
      Top             =   4500
      Width           =   2835
   End
   Begin TextBox Text1
      Height          =   975
      Left            =   480
      TabIndex        =   2
      Text            =   "Text1"
      Top             =   3300
      Width           =   6375
   End
   Begin ListBox List1
      Height          =   2760
      Left            =   3960
      TabIndex        =   1
      Top             =   360
      Width           =   2895
   End
   Begin PictureBox Picture1
      AutoRedraw      =   -1  'True
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8,25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      ForeColor       =   &H000000FF&
      Height          =   2775
      Left            =   480
      Picture         =   MOVE.FRX:0302
      ScaleHeight     =   2745
      ScaleWidth      =   2865
      TabIndex        =   0
      Top             =   360
      Width           =   2895
   End
' * You nneed the MOVE.BAS as well ! *
Option Explicit
Dim retInt%, retLng&
Dim oldX%, oldY%
Sub Command1_Click ()
    MsgBox "If you hold down Ctrl you can even move me !", 64, "Notice"
End Sub
Sub Command1_DragOver (Source As Control, X As Single, Y As Single, State As Integer)
' --> from VB3 used the Mouse_Move event !
    ' this pice of code enables ANY concerned control to be moved freely --> even an entire form !
    ReleaseCapture
    retInt = SendMessage(Command1.hWnd, WM_SYSCOMMAND, MOUSE_MOVE, 0&)
End Sub
Sub Command1_KeyDown (KeyCode As Integer, Shift As Integer)
    ' can be move when Ctrl in pressed !
    If Shift = 2 Then Command1.DragMode = 1
End Sub
Sub Command1_KeyUp (KeyCode As Integer, Shift As Integer)
    Command1.DragMode = 0
End Sub
Sub Form_Load ()
    SetControls
    Show
    ' after the the form build we can insert a text now...
    SetTexts
End Sub
Sub List1_Click ()
    List1.Clear
    For retInt = 1 To 20
        List1.AddItem "Item #" & retInt
    Next retInt
End Sub
Sub List1_GotFocus ()
    ShowFocus List1
End Sub
Sub List1_LostFocus ()
    ShowFocus List1
End Sub
Sub Picture1_GotFocus ()
    ShowFocus Picture1
End Sub
Sub Picture1_LostFocus ()
    ShowFocus Picture1
End Sub
Sub Picture2_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' this should only be possible for the LEFT mouse key as usual.
    If Button <> 1 Then Exit Sub
    ' this pice of code enables ANY concerned control to be moved freely --> even an entire form !
    ReleaseCapture
    retInt = SendMessage(Picture2.hWnd, WM_SYSCOMMAND, MOUSE_MOVE, 0&)
End Sub
Sub Picture3_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then Exit Sub
Picture3.ZOrder
    oldX = X
    oldY = Y
End Sub
Sub Picture3_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then Exit Sub
    Picture3.Left = Picture3.Left + X - oldX
    Picture3.Top = Picture3.Top + Y - oldY
End Sub
'                                                         '
' Here, all the setting are done.                         '
' *** WARNING ***                                         '
' This code was just put together for a demonstration.    '
' (YES, it was tested. THIS code is OK.)                  '
' Please be careful with YOUR experiments !!!             '
' Noone will be responsible for your "results" !          '
' BUT: good results should be given to the public !       '
'                                                         '
Sub SetControls ()
    Dim Style&
    Style = GetWindowLong(Picture1.hWnd, GWL_STYLE)             ' Obtain the actual style
    Style = Style Or WS_THICKFRAME                              ' Give it a Sizable Frame
    Style = Style Or WS_CAPTION                                 ' Give it a Caption
    Style = Style Or WS_MINIMIZEBOX                             ' Give it a MinimizeBox
    Style = Style Or WS_SYSMENU                                 ' Give it a System Menu
    Style = SetWindowLong(Picture1.hWnd, GWL_STYLE, Style)      ' - pass the new style
    retInt = SetWindowText(Picture1.hWnd, "The Picture Box")    ' Give it a Name, too
    Picture1.Height = Picture1.Height                           ' ! REBUILD THE CONTROL !
    Picture1.CurrentY = 700
    Picture1.ForeColor = &HFF0000  ' [blue]
    Picture1.Print " This is a demonstration."
    Picture1.ForeColor = &H0&      ' [black]
    Picture1.Print " Please";
    Picture1.ForeColor = &HFF&     ' [red]
    Picture1.Print " do not add";
    Picture1.ForeColor = &H0&      ' [black]
    Picture1.Print " system menus"
    Picture1.Print " to controls like this here !"
    Style = GetWindowLong(List1.hWnd, GWL_STYLE)                ' Obtain the actual style
    Style = Style Or WS_THICKFRAME                              ' Give it a Dizable Frame
    Style = Style Or WS_CAPTION                                 ' Give it a Caption
    Style = Style Xor WS_MAXIMIZEBOX                            ' Remove the MaximizeBox
    Style = SetWindowLong(List1.hWnd, GWL_STYLE, Style)         ' - pass the new style
    retInt = SetWindowText(List1.hWnd, "The List Box")          ' Give it a Name
    List1.Height = List1.Height                                 ' ! REBUILD THE CONTROL !
    List1.AddItem "Its nice and easy"
    List1.AddItem "to manipulate controls"
    List1.AddItem "this way !!!"
    List1.AddItem "Come on, try it yourself !"
    Style = GetWindowLong(Text1.hWnd, GWL_STYLE)                ' Obtain the actual style
    Style = Style Or WS_BORDER                                  ' Give it a Thin Frame (--> you may leave this out)
    Style = Style Or WS_CAPTION                                 ' Give it a Caption
    Style = Style Xor WS_MAXIMIZEBOX                            ' Remove the MaximizeBox
    Style = SetWindowLong(Text1.hWnd, GWL_STYLE, Style)         ' - pass the new style
    retInt = SetWindowText(Text1.hWnd, "The Text Box 1")          ' Give it a Name
    ' same as: Text1 = "The Text Box"
    ' NOTE: you can alter the text later.
    Text1.Height = Text1.Height                                 ' ! REBUILD THE CONTROL !
    Style = GetWindowLong(Command1.hWnd, GWL_STYLE)             ' Obtain the actual style
    Style = Style Or WS_BORDER                                  ' Give it a border (--> don't leave this out)
    Style = Style Or WS_THICKFRAME                              ' Give it a sizable frame
    Style = SetWindowLong(Command1.hWnd, GWL_STYLE, Style)      ' - pass the new style
    Command1.Height = Command1.Height                           ' ! REBUILD THE CONTROL !
    Style = GetWindowLong(Text2.hWnd, GWL_STYLE)                ' Obtain the actual style
    Style = Style Or WS_CAPTION                                 ' Give it a Caption
    Style = Style Xor WS_MAXIMIZEBOX                            ' Remove the Maximizebox
    Style = SetWindowLong(Text2.hWnd, GWL_STYLE, Style)         ' - pass the new style
    Style = GetWindowLong(Text2.hWnd, GWL_EXSTYLE)              ' Obtain the actual extended style
    Style = Style Or WS_EX_DLGMODALFRAME                        ' Give it a Thick Border
    Style = SetWindowLong(Text2.hWnd, GWL_EXSTYLE, Style)       ' - pass the new extended style
    retInt = SetWindowText(Text2.hWnd, "The Text Box 2")
    ' same as: Text2 = "The Text Box"
    Text2.Height = Text2.Height                                 ' ! REBUILD THE CONTROL !
    Picture2.CurrentX = 270
    Picture2.CurrentY = 180
    Picture2.Print "Step on me and move me !"
    Dim Text$
    Text = "(Don't be shy)"                                     ' center the text correctly
    Picture2.CurrentX = (Picture2.ScaleWidth - Picture2.TextWidth(Text)) / 2
    Picture2.ForeColor = &HFF0008   ' [= blue]
    Picture2.Print Text
End Sub
Sub SetTexts ()
    Text1 = "Hi, I have no sizable border but a caption."
    Text2 = "I have a fixed double border..."
End Sub
'                                                         '
' Well, we have to help VB a little...                    '
'                                                         '
Sub ShowFocus (Control As Control)
    ' switches the active view of the caption on (and off !)
    ' note: this a toggle function ; retInt receives the old value
    retInt = FlashWindow(Control.hWnd, True)
End Sub
Sub Text1_GotFocus ()
    ShowFocus Text1
End Sub
Sub Text1_LostFocus ()
    ShowFocus Text1
End Sub
Sub Text2_GotFocus ()
    ShowFocus Text2
End Sub
Sub Text2_LostFocus ()
    ShowFocus Text2
End Sub