'General Declarations
Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2

Declare Function Sendmessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
Declare Sub ReleaseCapture Lib "User" ()
Declare Function GetactiveWindow Lib "User" () As Integer

Dim Focus As Integer

'//////////////////////////////////////////////////
' WINDOWBUILD
'//////////////////////////////////////////////////

Sub Form_GotFocus ()
TitleBarObject.BackColor = active_Title_BAr
'//////////////////////////////////////////////////
        'Events for this object:
         'Load
         'Unload
         'Gotfocus
         'LostFocus
         'MouseDown
         'MouseUp
         'DblClick
         'KeyDown
         'Resize
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
End Sub

Sub Form_KeyDown (KEYCODE As Integer, Shift As Integer)
'//////////////////////////////////////////////////
        'Events for this object:
         'Load
         'Unload
         'Gotfocus
         'LostFocus
         'MouseDown
         'MouseUp
         'DblClick
         'KeyDown
         'Resize
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Dim ShiftDown, Altdown, CtrlDown
    
   Const KEY_F4 = &H73
    'Const KEY_F2 = &H71 ' Define constants.

    Const ALT_MASK = 4
    Altdown = (Shift And ALT_MASK) > 0
    

    If KEYCODE = KEY_sPACE Then    ' Display key combinations.

    If ShiftDown And CtrlDown And Altdown Then

    ElseIf ShiftDown And Altdown Then

    ElseIf ShiftDown And CtrlDown Then

    ElseIf CtrlDown And Altdown Then

    ElseIf ShiftDown Then

    ElseIf CtrlDown Then
     
    ElseIf Altdown Then
    picControlMenu_Mouseup 1, 0, 0, 0

    ElseIf Shift = 0 Then

    End If

    End If

    If KEYCODE = KEY_F4 Then
    If Altdown Then
    End
    End If
    End If
'//////////////////////////////////////////////////
        'Events for this object:
         'Load
         'Unload
         'Gotfocus
         'LostFocus
         'MouseDown
         'MouseUp
         'DblClick
         'KeyDown
         'Resize
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

End Sub

Sub Form_Load ()
    
    Call WindowBuild(frmMain, WindowBorder1, TitleBarObject, picControlMenu)
    ' Pass it the names of the objects that make up the Window.' Call WindowBuild a second time to eliminate flicker
        Call WindowBuild(frmMain, WindowBorder2, TitleBarObject, picControlMenu)
            Focus = True 'To color the window approprietly
                Timer1.Interval = 10 'Enable timer to catch events
' Code for "INI" File
   ' frmMain.Top = GetPrivateProfileInt(SECTION, "Top", 0, INIFILENAME)
   ' frmMain.Left = GetPrivateProfileInt(SECTION, "Left", 0, INIFILENAME)
   ' frmMain.Height = GetPrivateProfileInt(SECTION, "Height", Screen.Height, INIFILENAME)
   ' frmMain.Width = GetPrivateProfileInt(SECTION, "Width", Screen.Width, INIFILENAME)
'//////////////////////////////////////////////////
        'Events for this object:
         'Load
         'Unload
         'Gotfocus
         'LostFocus
         'MouseDown
         'MouseUp
         'DblClick
         'KeyDown
         'Resize
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
        End Sub

Sub Form_LostFocus ()
Dim i As Integer
i = GetactiveWindow()
MsgBox "" + Str$(i)
'//////////////////////////////////////////////////
        'Events for this object:
         'Load
         'Unload
         'Gotfocus
         'LostFocus
         'MouseDown
         'MouseUp
         'DblClick
         'KeyDown
         'Resize
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
End Sub

Sub Form_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)

If Focus = True Then
    TitleBarObject.BackColor = active_Title_BAr
Else
    TitleBarObject.BackColor = active_Title_BAr
End If
'//////////////////////////////////////////////////
        'Events for this object:
         'Load
         'Unload
         'Gotfocus
         'LostFocus
         'MouseDown
         'MouseUp
         'DblClick
         'KeyDown
         'Resize
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
End Sub

Sub Form_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
Focus = True
Timer1.Interval = 10
'//////////////////////////////////////////////////
        'Events for this object:
         'Load
         'Unload
         'Gotfocus
         'LostFocus
         'MouseDown
         'MouseUp
         'DblClick
         'KeyDown
         'Resize
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
End Sub

Sub Form_Resize ()
WindowBuild frmMain, WindowBorder1, TitleBarObject, picControlMenu
WindowBuild frmMain, WindowBorder2, TitleBarObject, picControlMenu
'//////////////////////////////////////////////////
        'Events for this object:
         'Load
         'Unload
         'Gotfocus
         'LostFocus
         'MouseDown
         'MouseUp
         'DblClick
         'KeyDown
         'Resize
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
End Sub

Sub Form_Unload (Cancel As Integer)
    Dim rc As Integer
   
    'Create the INI file
    rc = WritePrivateProfileString(SECTION, ByVal "Top", ByVal Str$(frmMain.Top), INIFILENAME)
    rc = WritePrivateProfileString(SECTION, ByVal "Left", ByVal Str$(frmMain.Left), INIFILENAME)
    rc = WritePrivateProfileString(SECTION, ByVal "Height", ByVal Str$(frmMain.Height), INIFILENAME)
    rc = WritePrivateProfileString(SECTION, ByVal "Width", ByVal Str$(frmMain.Width), INIFILENAME)
    
   
    'Terminate the application
    End
'//////////////////////////////////////////////////
        'Events for this object:
         'Load
         'Unload
         'Gotfocus
         'LostFocus
         'MouseDown
         'MouseUp
         'DblClick
         'KeyDown
         'Resize
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
End Sub

Sub picControlMenu_DblClick ()
Unload frmMain
End
'//////////////////////////////////////////////////
        'Events for this object:
         'DblClick
         'MouseDown
         'MouseUp
         'Resize
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
End Sub

Sub picControlMenu_Mousedown (Button As Integer, Shift As Integer, X As Single, Y As Single)
Focus = True
Timer1.Interval = 10
'//////////////////////////////////////////////////
        'Events for this object:
         'DblClick
         'MouseDown
         'MouseUp
         'Resize
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
End Sub

Sub picControlMenu_Mouseup (Button As Integer, Shift As Integer, X As Single, Y As Single)
TitleBarObject.BackColor = active_Title_BAr
mousepointer = 5
Focus = True
Timer1.Interval = 10
PopupMenu frmDummy.mnuSystemMenu, 0, 0, 9
mousepointer = 0
'//////////////////////////////////////////////////
        'Events for this object:
         'DblClick
         'MouseDown
         'MouseUp
         'Resize
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
End Sub

Sub picControlMenu_Resize ()
picControlMenu.Picture = Image1(1).Picture
'//////////////////////////////////////////////////
        'Events for this object:
         'DblClick
         'MouseDown
         'MouseUp
         'Resize
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
End Sub

Sub Timer1_Timer ()
   If Focus = True Then
    
    If GetactiveWindow() <> frmMain.hWnd Then
       'Do form's lost-focus routines here.

       Focus = False
       WindowBorder1.BorderColor = Inactive_Border
       TitleBarObject.BackColor = inactive_Title_BAr
    Else
      Focus = True
    End If
 
   End If
'Only Event for this object
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
End Sub

Sub TitleBarObject_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)

Focus = True
    Timer1.Interval = 10
    If Button <> 1 Then Exit Sub ' If not the left mouse button, ...exit
    Dim ReturnVal%
    ReleaseCapture
    ReturnVal% = Sendmessage(hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
    Dim i As Integer
    i = GetactiveWindow()


TitleBarObject.BackColor = active_Title_BAr
'//////////////////////////////////////////////////
'Only Event for this object
'//////////////////////////////////////////////////
End Sub

Sub WindowBuild (Frm As Form, WindowBorder As Shape, TitleBar As Label, ControlMenu As PictureBox)

    ControlMenu.Top = 0     'Places the menu "|-|" picture
    ControlMenu.Left = 0    'in the UpperLeft
'*****************Create a border for the window******************
    WindowBorder.Width = Frm.ScaleWidth
    WindowBorder.Height = Frm.ScaleHeight
    WindowBorder.Left = 0
    WindowBorder.Top = 0
Rem******Other effects can be added with the' WindowBorder.BorderWidth property
Rem******This will create a shadow effect*******************************************
Rem*WindowBorder.BorderWidth = 3; WindowBorder.Left = -1; WindowBorder.Top = -1

TitleBar.Width = Frm.ScaleWidth + 1 ' Makes the title bar 1 pixel larger than the width of the form

Rem Change this to adjust the height of the titlebar.*
'*******************************************************
TitleBar.Height = 12 '
'*******************************************************
'Note:  You must make a custom BMP for the Control Menu,
'       if you change this.
  Dim offset As Integer
    offset = 2
    ControlMenu.Height = TitleBar.Height - offset
    ControlMenu.Width = TitleBar.Height
        
        TitleBar.Left = -offset
        TitleBar.Top = -offset
End Sub

