Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

Createwindowex API call

Posted on 1999-07-12
5
Medium Priority
?
2,200 Views
Last Modified: 2008-03-03
I have 312 points to offer, but I am only listing 50. This is because if the question is not answered it will lock my points. I will offer all 312 points to anyone who can provide me with a working example of how to use the CreateWindow() API call.
0
Comment
Question by:rondeauj
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
5 Comments
 
LVL 13

Accepted Solution

by:
Mirkwood earned 1200 total points
ID: 1523879
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "CProgBar32"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False

Option Explicit
 
Private ProgressStyle As Long
Dim ProgBarWnd As Long
Private TempParent As Object
Private Const WM_COMMAND = &H111
Private Const WM_COMMNOTIFY = &H44
Private NoObjectParent As Long
Private Type tagInitCommonControlsEx
    lngSize As Long
    lngICC As Long
End Type
Const ICC_PROGRESS_CLASS = &H20
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Function InitCommonControlsEx Lib "Comctl32.dll" (iccex As tagInitCommonControlsEx) As Boolean
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function LoadBitmap Lib "user32" Alias "LoadBitmapA" (ByVal hInstance As Long, ByVal lpBitmapName As String) As Long
Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function SendStringMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Private Declare Function CreateWindowEX Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Const MF_OWNERDRAW& = &H100&

Const HWND_TOPMOST = -1
Const SW_HIDE = 0
Const SW_SHOWNORMAL = 1
Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2
Const SWP_NOREDRAW = &H8
Const SWP_SHOWWINDOW = &H40

Private Type tagTBADDBITMAP
        hinst As Long
        nID As Long
End Type

Private Const COLOR_BTNFACE = 15
Private Const COLOR_BTNTEXT = 18

' Window Style constants
Const WS_VISIBLE = &H10000000
Const WS_CHILD = &H40000000
Const WS_POPUP = &H80000000

' CreateWindow constants
Const CW_USEDEFAULT = &H80000000

Private Const WM_PAINT = &HF
 
Private Const WM_USER = &H400
Private Const GWL_HWNDPARENT = (-8)
Private Const GWL_STYLE = (-16)
Private Const WS_BORDER = &H800000
Private Const WM_DRAWITEM = &H2B
Private Const WS_CLIPCHILDREN = &H2000000
Private Const WS_CLIPSIBLINGS = &H4000000
Private Const WM_SETREDRAW = &HB
'//Common Control Constants
Private Const CCS_TOP = &H1
Private Const CCS_NOMOVEY = &H2
Private Const CCS_BOTTOM = &H3
Private Const CCS_NORESIZE = &H4
Private Const CCS_NOPARENTALIGN = &H8
'Private Const CCS_ADJUSTABLE          0x00000020L
Private Const CCS_NODIVIDER = &H40
 
 
Private Const PROGRESS_CLASSA = "msctls_progress32"

'Style
Private Const PBS_SMOOTH = &H1
Private Const PBS_VERTICAL = &H4
Private Const PBM_SETRANGE = (WM_USER + 1)
Private Const PBM_SETPOS = (WM_USER + 2)
Private Const PBM_DELTAPOS = (WM_USER + 3)
Private Const PBM_SETSTEP = (WM_USER + 4)
Private Const PBM_STEPIT = (WM_USER + 5)
Private Const PBM_SETRANGE32 = (WM_USER + 6)
Private Const PBM_GETRANGE = (WM_USER + 7)
Private Const PBM_GETPOS = (WM_USER + 8)
Private Const PBM_SETBARCOLOR = (WM_USER + 9)
Private Const CCM_FIRST = &H2000
Private Const CCM_SETBKCOLOR = (CCM_FIRST + 1)
Private Const SB_SETBKCOLOR = CCM_SETBKCOLOR
 

Private Type PPBRange
        iLow As Integer
        iHigh As Integer
End Type
'Set BackColor
Public Function SetBackColor(NewBackColor As Long)
Call SendMessage(ProgBarWnd, SB_SETBKCOLOR, 0, ByVal NewBackColor)
End Function
'SetBarColor
Public Function SetBarColor(NewBarColor As Long)
Call SendMessage(ProgBarWnd, PBM_SETBARCOLOR, 0, ByVal NewBarColor)
End Function

Public Sub SetProgVert(Vertical As Boolean)
If Vertical = True Then
ProgressStyle = PBS_VERTICAL
Else
ProgressStyle = 0
End If
End Sub


Private Sub Class_Initialize()
 Dim iccex As tagInitCommonControlsEx
    With iccex
        .lngSize = LenB(iccex)
        .lngICC = ICC_PROGRESS_CLASS
    End With
    Call InitCommonControlsEx(iccex)
   
    ProgBarWnd = 0
End Sub
Public Function Create( _
 Optional Left As Variant, _
 Optional Top As Variant, _
 Optional Width As Variant, _
 Optional Height As Variant, Optional Smooth As Boolean) _
  As Boolean
   
   
Dim SmoothVal As Long
If Smooth = True Then SmoothVal = PBS_SMOOTH
     
If NoObjectParent <> 0 Then
ProgBarWnd = CreateWindowEX(0, "msctls_progress32", "", _
              WS_VISIBLE Or WS_CHILD Or ProgressStyle Or SmoothVal, 0, 0, 0, 0, _
              NoObjectParent, 0&, App.hInstance, 0&)
Call SetParent(ProgBarHwnd, NoObjectParent)
Else
If Parent Is Nothing Then
   Create = False
Exit Function
End If
     
If IsMissing(Left) Then Left = 0
If IsMissing(Top) Then Top = 0
If IsMissing(Width) Then Width = Parent.Width \ Screen.TwipsPerPixelX
If IsMissing(Height) Then Height = 20

ProgBarWnd = CreateWindowEX(0, "msctls_progress32", "", _
             WS_VISIBLE Or WS_CHILD Or ProgressStyle Or SmoothVal, 0, 0, 0, 0, _
             Parent.hwnd, 0&, App.hInstance, 0&)
             Call SetParent(ProgBarHwnd, Parent.hwnd)
 End If
     
    Call MoveWindow(ProgBarWnd, CLng(Left), CLng(Top), CLng(Width), CLng(Height), True)
     
    Call ShowWindow(ProgBarWnd, SW_SHOWNORMAL)
       
     
    Create = (ProgBarWnd <> 0)
   
End Function
Public Property Get Parent() As Object
Set Parent = TempParent
End Property

Public Property Set Parent(Frm As Object)
Set TempParent = Frm
End Property


Private Sub Class_Terminate()
 Exit Sub
    If ProgBarWnd <> 0 Then
        Call DestroyWindow(ProgBarWnd)
    End If
End Sub

Public Sub DestroyProgBar()
On Error Resume Next
If ProgBarWnd <> 0 Then
   Call DestroyWindow(ProgBarWnd)
End If
End Sub

Public Sub ClearProgBar()
On Error Resume Next
'Set Position to Zero
Call SendMessage(ProgBarWnd, PBM_SETPOS, 0, 0)
End Sub

Public Sub SetProgBarPos(ProgPos As Integer)
DoEvents
Call SendMessage(ProgBarWnd, PBM_SETPOS, ProgPos, 0)
DoEvents
End Sub

Public Sub DelayProgBar(itime As Integer)
DoEvents
Call Sleep(itime)
DoEvents
End Sub

Public Property Get SethWndParent() As Long
SethWndParent = NoObjectParent
End Property
Public Property Get ProgBarHwnd() As Long
ProgBarHwnd = ProgBarWnd
End Property
Public Property Let SethWndParent(ByVal vNewValue As Long)
NoObjectParent = vNewValue
End Property

0
 
LVL 13

Expert Comment

by:Mirkwood
ID: 1523880
Code...(modWindowsMessages.bas)
____________________________________________________________
Attribute VB_Name = "modWindowsMessages"

'Public Const WN_ACCESS_DENIED = ERROR_ACCESS_DENIED
Public Const GWL_WNDPROC = (-4)
Public Type POINTAPI
    x As Long
    y As Long
End Type
Public Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Public Type MENUITEMINFO
    cbSize As Long
    fMask As Long
    fType As Long
    fState As Long
    wID As Long
    hSubMenu As Long
    hbmpChecked As Long
    hbmpUnchecked As Long
    dwItemData As Long
    dwTypeData As String
    cch As Long
End Type
Public Function ReturnAddress(Value As Long)
    ReturnAddress = Value
End Function
Public Function NewWindowProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim Windw As CWindow
    If Not WindCol.Count = 0 Then
        Set Windw = WindCol("e" & hWnd)
        Windw.WindowProc Msg, wParam, lParam
        NewWindowProc = CallWindowProc( _
            Windw.OldWindowProc, hWnd, Msg, wParam, _
            lParam)
    End If
End Function
____________________________________________________________
CODE...(modCreateWindowEXa.bas)
____________________________________________________________
Attribute VB_Name = "modCreateWindowEXA"
Public Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Public Declare Function UnregisterClass Lib "user32" Alias "UnregisterClassA" (ByVal lpClassName As String, ByVal hInstance As Long) As Long
Public Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CreateMDIWindow Lib "user32" Alias "CreateMDIWindowA" (ByVal lpClassName As String, ByVal lCpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hInstance As Long, ByVal lParam As Long) As Long
Public Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lCpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Public Declare Function DestroyWindow Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Public Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function CreateMenu Lib "user32" () As Long
Public Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Public Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Public Declare Function ChangeMenu Lib "user32" Alias "ChangeMenuA" (ByVal hMenu As Long, ByVal cmd As Long, ByVal lpszNewItem As String, ByVal cmdInsert As Long, ByVal flags As Long) As Long
Public Declare Function ModifyMenu Lib "user32" Alias "ModifyMenuA" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpString As Any) As Long
Public Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String) As Long
Public Declare Function SetMenu Lib "user32" (ByVal hWnd As Long, ByVal hMenu As Long) As Long
Public Declare Function SetMenuItemBitmaps Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function EnableWindow Lib "user32" (ByVal hWnd As Long, ByVal fEnable As Long) As Long
Public Declare Function SetCapture Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Declare Function UpdateWindow Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function InsertMenu Lib "user32" Alias "InsertMenuA" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Public Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Public Declare Function SetWindowWord Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal wNewWord As Long) As Long
Public Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function AdjustWindowRect Lib "user32" (lpRect As RECT, ByVal dwStyle As Long, ByVal bMenu As Long) As Long
Public Declare Function AdjustWindowRectEx Lib "user32" (lpRect As RECT, ByVal dsStyle As Long, ByVal bMenu As Long, ByVal dwEsStyle As Long) As Long
Public Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Public Declare Function EnableScrollBar Lib "user32" (ByVal hWnd As Long, ByVal wSBflags As Long, ByVal wArrows As Long) As Long
Public Declare Function EnableMenuItem Lib "user32" (ByVal hMenu As Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Public Declare Function RegisterClass Lib "user32" Alias "RegisterClassA" (Class As WNDCLASS) As Long
Public Declare Function RegisterClassEx Lib "user32" Alias "RegisterClassExA" (pcWndClassEx As WNDCLASSEX) As Integer
Public Type WNDCLASS
    style As Long
    lpfnWndProc As Long
    cbClsExtra As Long
    cbWndExtra2 As Long
    hInstance As Long
    hIcon As Long
    hCursor As Long
    hbrBackground As Long
    lpszMenuName As String
    lpszClassName As String
End Type
Public Type WNDCLASSEX
    cbSize As Long
    style As Long
    lpfnWndProc As Long
    cbClsExtra As Long
    cbWndExtra As Long
    hInstance As Long
    hIcon As Long
    hCursor As Long
    hbrBackground As Long
    lpszMenuName As String
    lpszClassName As String
    hIconSm As Long
End Type
Public WindCol As New Collection
____________________________________________________________
Code...(Window.CLS)
____________________________________________________________
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CWindow"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True

' **********************************************************************
' * Programmer Name  : Allen Copeland
' * Web Site         : www.geocities.com/SiliconValley/Campus/3024/ 
' * E-Mail           : allenc_jr@Hotmail.com
' * Date             : 2/23/99
' * Time             : 17:31
' * Module Name      : CWindow
' * Module Filename  : Window.cls
' **********************************************************************
' * Comments         : Class is used to create a window through api and
' *                    control it from there.
' **********************************************************************

Public Enum ComboBoxStyle
    CBS_AUTOHSCROLL = &H40&
    CBS_DISABLENOSCROLL = &H800&
    CBS_DROPDOWN = &H2&
    CBS_DROPDOWNLIST = &H3&
    CBS_HASSTRINGS = &H200&
    CBS_NOINTEGRALHEIGHT = &H400&
    CBS_OWNERDRAWFIXED = &H10&
    CBS_OEMCONVERT = &H80&
    CBS_OWNERDRAWVARIABLE = &H20&
    CBS_SIMPLE = &H1&
    CBS_SORT = &H100&
End Enum
Public Enum enShowWindow
    SW_SHOWNORMAL = 1
    SW_SHOWNOACTIVATE = 4
    SW_SHOWNA = 8
    SW_SHOWMINNOACTIVE = 7
    SW_SHOWMINIMIZED = 2
    SW_SHOWMAXIMIZED = 3
    SW_SHOWDEFAULT = 10
    SW_SHOW = 5
    SW_SCROLLCHILDREN = &H1
    SW_RESTORE = 9
    SW_PARENTOPENING = 3
    SW_PARENTCLOSING = 1
    SW_OTHERZOOM = 2
    SW_OTHERUNZOOM = 4
    SW_NORMAL = 1
    SW_MINIMIZE = 6
    SW_MAXIMIZE = 3
    SW_MAX = 10
    SW_INVALIDATE = &H2
    SW_HIDE = 0
    SW_ERASE = &H4
End Enum
Public Enum enSetWindowPosition
    SWP_FRAMECHANGED = &H20
    SWP_HIDEWINDOW = &H80
    SWP_NOACTIVATE = &H10
    SWP_NOCOPYBITS = &H100
    SWP_NOMOVE = &H2
    SWP_NOOWNERZORDER = &H200
    SWP_NOREDRAW = &H8
    SWP_NOSIZE = &H1
    SWP_NOZORDER = &H4
    SWP_SHOWWINDOW = &H40
    SWP_DRAWFRAME = SWP_FRAMECHANGED
    SWP_NOREPOSITION = SWP_NOOWNERZORDER
End Enum
Public Enum enExStyle
    WS_EX_TRANSPARENT = &H20&
    WS_EX_TOPMOST = &H8&
    WS_EX_NOPARENTNOTIFY = &H4&
    WS_EX_DLGMODALFRAME = &H1&
    WS_EX_ACCEPTFILES = &H10&
End Enum
Public Enum enWindowStyle
    WS_VSCROLL = &H200000
    WS_OVERLAPPED = &H0&
    WS_VISIBLE = &H10000000
    WS_THICKFRAME = &H40000
    WS_TABSTOP = &H10000
    WS_SYSMENU = &H80000
    WS_SIZEBOX = WS_THICKFRAME
    WS_POPUP = &H80000000
    WS_TILED = WS_OVERLAPPED
    WS_MINIMIZEBOX = &H20000
    WS_MINIMIZE = &H20000000
    WS_MAXIMIZEBOX = &H10000
    WS_MAXIMIZE = &H1000000
    WS_ICONIC = WS_MINIMIZE
    WS_GROUP = &H20000
    WS_HSCROLL = &H100000
    WS_DLGFRAME = &H400000
    WS_DISABLED = &H8000000
    WS_CLIPSIBLINGS = &H4000000
    WS_CLIPCHILDREN = &H2000000
    WS_CHILD = &H40000000
    WS_CHILDWINDOW = (WS_CHILD)
    WS_CAPTION = &HC00000 '  WS_BORDER Or WS_DLGFRAME
    WS_BORDER = &H800000
    WS_POPUCpWINDOW = (WS_POPUP Or WS_BORDER Or WS_SYSMENU)
    WS_OVERLAPPEDWINDOW = (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)
    WS_TILEDWINDOW = WS_OVERLAPPEDWINDOW
End Enum
Public Enum enWindowsMessages
    WM_USER = &H400
    WM_VKEYTOITEM = &H2E
    WM_VSCROLL = &H115
    WM_VSCROLLCLIPBOARD = &H30A
    WM_WINDOWPOSCHANGED = &H47
    WM_WINDOWPOSCHANGING = &H46
    WM_WININICHANGE = &H1A
    WM_ACTIVATE = &H6
    WM_ACTIVATEAPP = &H1C
    WM_ASKCBFORMATNAME = &H30C
    WM_CANCELJOURNAL = &H4B
    WM_CANCELMODE = &H1F
    WM_CHANGECBCHAIN = &H30D
    WM_CHAR = &H102
    WM_CHARTOITEM = &H2F
    WM_CHILDACTIVATE = &H22
    WM_CHOOSEFONT_GETLOGFONT = (WM_USER + 1)
    WM_CHOOSEFONT_SETFLAGS = (WM_USER + 102)
    WM_CHOOSEFONT_SETLOGFONT = (WM_USER + 101)
    WM_CLEAR = &H303
    WM_CLOSE = &H10
    WM_COMMAND = &H111
    WM_COMPACTING = &H41
    WM_COMPAREITEM = &H39
    WM_CONVERTREQUESTEX = &H108
    WM_COPY = &H301
    WM_COPYDATA = &H4A
    WM_CREATE = &H1
    WM_CTLCOLORBTN = &H135
    WM_CTLCOLORDLG = &H136
    WM_CTLCOLOREDIT = &H133
    WM_CTLCOLORLISTBOX = &H134
    WM_CTLCOLORMSGBOX = &H132
    WM_CTLCOLORSCROLLBAR = &H137
    WM_CTLCOLORSTATIC = &H138
    WM_CUT = &H300
    WM_DDE_FIRST = &H3E0
    WM_DDE_ACK = (WM_DDE_FIRST + 4)
    WM_DDE_ADVISE = (WM_DDE_FIRST + 2)
    WM_DDE_DATA = (WM_DDE_FIRST + 5)
    WM_DDE_EXECUTE = (WM_DDE_FIRST + 8)
    WM_DDE_INITIATE = (WM_DDE_FIRST)
    WM_DDE_LAST = (WM_DDE_FIRST + 8)
    WM_DDE_POKE = (WM_DDE_FIRST + 7)
    WM_DDE_REQUEST = (WM_DDE_FIRST + 6)
    WM_DDE_TERMINATE = (WM_DDE_FIRST + 1)
    WM_DDE_UNADVISE = (WM_DDE_FIRST + 3)
    WM_DEADCHAR = &H103
    WM_DELETEITEM = &H2D
    WM_DESTROY = &H2
    WM_DESTROYCLIPBOARD = &H307
    WM_DEVMODECHANGE = &H1B
    WM_DRAWCLIPBOARD = &H308
    WM_DRAWITEM = &H2B
    WM_DROPFILES = &H233
    WM_ENABLE = &HA
    WM_ENDSESSION = &H16
    WM_ENTERIDLE = &H121
    WM_ENTERMENULOOP = &H211
    WM_ERASEBKGND = &H14
    WM_EXITMENULOOP = &H212
    WM_FONTCHANGE = &H1D
    WM_GETDLGCODE = &H87
    WM_GETFONT = &H31
    WM_GETHOTKEY = &H33
    WM_GETMINMAXINFO = &H24
    WM_GETTEXT = &HD
    WM_GETTEXTLENGTH = &HE
    WM_HOTKEY = &H312
    WM_HSCROLL = &H114
    WM_HSCROLLCLIPBOARD = &H30E
    WM_ICONERASEBKGND = &H27
    WM_IME_CHAR = &H286
    WM_IME_COMPOSITION = &H10F
    WM_IME_COMPOSITIONFULL = &H284
    WM_IME_CONTROL = &H283
    WM_IME_ENDCOMPOSITION = &H10E
    WM_IME_KEYDOWN = &H290
    WM_IME_KEYLAST = &H10F
    WM_IME_KEYUP = &H291
    WM_IME_NOTIFY = &H282
    WM_IME_SELECT = &H285
    WM_IME_SETCONTEXT = &H281
    WM_IME_STARTCOMPOSITION = &H10D
    WM_INITDIALOG = &H110
    WM_INITMENU = &H116
    WM_INITMENUPOPUP = &H117
    WM_KEYDOWN = &H100
    WM_KEYFIRST = &H100
    WM_KEYLAST = &H108
    WM_KEYUP = &H101
    WM_KILLFOCUS = &H8
    WM_LBUTTONDBLCLK = &H203
    WM_LBUTTONDOWN = &H201
    WM_LBUTTONUP = &H202
    WM_MBUTTONDBLCLK = &H209
    WM_MBUTTONDOWN = &H207
    WM_MBUTTONUP = &H208
    WM_MDIACTIVATE = &H222
    WM_MDICASCADE = &H227
    WM_MDICREATE = &H220
    WM_MDIDESTROY = &H221
    WM_MDIGETACTIVE = &H229
    WM_MDIICONARRANGE = &H228
    WM_MDIMAXIMIZE = &H225
    WM_MDINEXT = &H224
    WM_MDIREFRESHMENU = &H234
    WM_MDIRESTORE = &H223
    WM_MDISETMENU = &H230
    WM_MDITILE = &H226
    WM_MEASUREITEM = &H2C
    WM_MENUCHAR = &H120
    WM_MENUSELECT = &H11F
    WM_MOUSEACTIVATE = &H21
    WM_MOUSEFIRST = &H200
    WM_MOUSELAST = &H209
    WM_MOUSEMOVE = &H200
    WM_MOVE = &H3
    WM_NCACTIVATE = &H86
    WM_NCCALCSIZE = &H83
    WM_NCCREATE = &H81
    WM_NCDESTROY = &H82
    WM_NCHITTEST = &H84
    WM_NCLBUTTONDBLCLK = &HA3
    WM_NCLBUTTONDOWN = &HA1
    WM_NCLBUTTONUP = &HA2
    WM_NCMBUTTONDBLCLK = &HA9
    WM_NCMBUTTONDOWN = &HA7
    WM_NCMBUTTONUP = &HA8
    WM_NCMOUSEMOVE = &HA0
    WM_NCPAINT = &H85
    WM_NCRBUTTONDBLCLK = &HA6
    WM_NCRBUTTONDOWN = &HA4
    WM_NCRBUTTONUP = &HA5
    WM_NEXTDLGCTL = &H28
    WM_NULL = &H0
    WM_PAINT = &HF
    WM_PAINTCLIPBOARD = &H309
    WM_PAINTICON = &H26
    WM_PALETTECHANGED = &H311
    WM_PALETTEISCHANGING = &H310
    WM_PARENTNOTIFY = &H210
    WM_PASTE = &H302
    WM_PENWINFIRST = &H380
    WM_PENWINLAST = &H38F
    WM_POWER = &H48
    WM_PSD_ENVSTAMPRECT = (WM_USER + 5)
    WM_PSD_FULLPAGERECT = (WM_USER + 1)
    WM_PSD_GREEKTEXTRECT = (WM_USER + 4)
    WM_PSD_MARGINRECT = (WM_USER + 3)
    WM_PSD_MINMARGINRECT = (WM_USER + 2)
    WM_PSD_PAGESETUPDLG = (WM_USER)
    WM_PSD_YAFULLPAGERECT = (WM_USER + 6)
    WM_QUERYDRAGICON = &H37
    WM_QUERYENDSESSION = &H11
    WM_QUERYNEWPALETTE = &H30F
    WM_QUERYOPEN = &H13
    WM_QUEUESYNC = &H23
    WM_QUIT = &H12
    WM_RBUTTONDBLCLK = &H206
    WM_RBUTTONDOWN = &H204
    WM_RBUTTONUP = &H205
    WM_RENDERALLFORMATS = &H306
    WM_RENDERFORMAT = &H305
    WM_SETCURSOR = &H20
    WM_SETFOCUS = &H7
    WM_SETFONT = &H30
    WM_SETHOTKEY = &H32
    WM_SETREDRAW = &HB
    WM_SETTEXT = &HC
    WM_SHOWWINDOW = &H18
    WM_SIZE = &H5
    WM_SIZECLIPBOARD = &H30B
    WM_SPOOLERSTATUS = &H2A
    WM_SYSCHAR = &H106
    WM_SYSCOLORCHANGE = &H15
    WM_SYSCOMMAND = &H112
    WM_SYSDEADCHAR = &H107
    WM_SYSKEYDOWN = &H104
    WM_SYSKEYUP = &H105
    WM_TIMECHANGE = &H1E
    WM_TIMER = &H113
    WM_UNDO = &H304
End Enum
Public Event Click(Button As Integer)
Public Event Resize()
Public Event Load()
Public Event Unload(Cancel As Boolean)
Public Event MouseMove(ByVal Button As Integer, ByVal x As Single, ByVal y As Single)
Public Event MouseUp(ByVal Button As Integer, ByVal x As Single, ByVal y As Single)
Public Event MouseDown(ByVal Button As Integer, ByVal x As Single, ByVal y As Single)
Public Event Move()
Public OldWindowProc As Long
Dim Wnd As Long
Public Left As Single
Public Top As Single
Public Width As Single
Public Height As Single
Dim rCaption As String
Public HasBorder As Boolean
Public Resizable As Boolean
Public HasSysMenu As Boolean
Public MinimizeBox As Boolean
Public MaximizeBox As Boolean
Private ButtonDown As Integer
Private rVisible As Boolean
Public App
Public Icon As StdPicture
Public Sub Create()
    ' **********************************************************************
    ' * Programmer Name  : Allen Copeland
    ' * Web Site         : www.geocities.com/SiliconValley/Campus/3024/ 
    ' * E-Mail           : allenc_jr@Hotmail.com
    ' * Date             : 2/23/99
    ' * Time             : 17:26
    ' * Module Name      : CWindow
    ' * Module Filename  : Window.cls
    ' * Parameters       :
    ' **********************************************************************
    ' * Comments         : Calls the CreateWindowExA API and creates a window
    ' *                    with the data given. "#32770"
    ' **********************************************************************
    Dim UserFlags As Long
    UserFlags = (WS_SYSMENU * Abs(CInt(HasSysMenu)))
    UserFlags = UserFlags + (WS_MINIMIZEBOX * Abs(CInt(MinimizeBox)))
    UserFlags = UserFlags + (WS_MAXIMIZEBOX * Abs(CInt(MaximizeBox)))
    UserFlags = UserFlags + (WS_SIZEBOX * Abs(CInt(Resizable)))
    If HasBorder Then
        UserFlags = UserFlags + WS_CAPTION
    Else
        UserFlags = UserFlags + WS_POPUP
    End If
    Wnd = CreateWindowEx(0, "#32770", Caption, UserFlags, Left \ 15, Top \ 15, Width \ 15, Height \ 15, 0, 0, App.hInstance, ByVal Caption)
    If hWnd = 0 Then Exit Sub
    WindCol.Add Me, "e" & hWnd
    OldWindowProc = SetWindowLong( _
        Wnd, GWL_WNDPROC, _
        AddressOf NewWindowProc)
End Sub
Public Sub Destroy()
    ' **********************************************************************
    ' * Programmer Name  : Allen Copeland
    ' * Web Site         : www.geocities.com/SiliconValley/Campus/3024/ 
    ' * E-Mail           : allenc_jr@Hotmail.com
    ' * Date             : 2/23/99
    ' * Time             : 17:28
    ' * Module Name      : CWindow
    ' * Module Filename  : Window.cls
    ' * Parameters       :
    ' **********************************************************************
    ' * Comments         : Calls the DestroyWindow API and removes the window
    ' *                    from the user's access and also removes the window
    ' *                    from memory.
    ' **********************************************************************
    If Wnd = 0 Then Exit Sub
    DestroyWindow hWnd
    Wnd = 0
    rVisible = False
End Sub
Public Property Get Caption() As String
    Caption = rCaption
End Property
Public Property Let Caption(ByVal vCaption As String)
    rCaption = vCaption
    If hWnd = 0 Then Exit Property
    SetWindowText hWnd, vCaption
End Property
Public Property Get hWnd() As Long
    hWnd = Wnd
End Property
Public Sub WindowProc(ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long)
    Dim POINT As POINTAPI
    GetCursorPos POINT
    Dim RECT As RECT
    'Debug.Print Msg
    GetWindowRect hWnd, RECT
    Left = RECT.Left * 15
    Top = RECT.Top * 15
    Height = (RECT.Bottom - Top \ 15) * 15
    Width = (RECT.Right - Left \ 15) * 15
    Select Case Msg
        Case WM_CREATE
            RaiseEvent Load
        Case WM_DESTROY
            RaiseEvent Unload(False)
        Case WM_MOUSEMOVE
            RaiseEvent MouseMove(ButtonDown, POINT.x - Left \ 15, POINT.y - Top \ 15)
        Case WM_MOVE
            RaiseEvent Move
        Case WM_CLOSE
            Dim CancUnl As Boolean
            RaiseEvent Unload(CancUnl)
            If Not CancUnl Then
                Destroy
            End If
        Case WM_SIZE
            RaiseEvent Resize
        Case WM_MDIMAXIMIZE
        Case WM_LBUTTONDOWN
            SetCapture hWnd
            ButtonDown = ButtonDown + 1
            RaiseEvent MouseDown(1, POINT.x - Left \ 15, POINT.y - Top \ 15)
        Case WM_RBUTTONDOWN
            SetCapture hWnd
            ButtonDown = ButtonDown + 2
            RaiseEvent MouseDown(2, POINT.x - Left \ 15, POINT.y - Top \ 15)
        Case WM_LBUTTONUP
            ButtonDown = ButtonDown - 1
            ReleaseCapture
            RaiseEvent Click(1)
            RaiseEvent MouseUp(1, POINT.x - Left \ 15, POINT.y - Top \ 15)
        Case WM_RBUTTONUP
            ButtonDown = ButtonDown - 2
            ReleaseCapture
            RaiseEvent Click(2)
            RaiseEvent MouseUp(2, POINT.x - Left \ 15, POINT.y - Top \ 15)
        Case WM_KILLFOCUS
        Case WM_PAINT
        Case WM_INITDIALOG
    End Select
End Sub
Public Property Get Enabled() As Boolean
    Enabled = rEnabled
End Property
Public Property Let Enabled(ByVal vEnabled As Boolean)
    rEnabled = vEnabled
    If hWnd = 0 Then Exit Property
    EnableWindow hWnd, Enabled
End Property
Private Sub Class_Initialize()
    rEnabled = True
End Sub
Private Sub Class_Terminate()
    If hWnd > 0 Then Destroy
End Sub
Public Sub Show()
    ShowWindow hWnd, 1
    rVisible = True
End Sub
Public Sub Hide()
    ShowWindow hWnd, 0
End Sub
Public Sub AdjustBorder()
    Dim rRect As RECT
    Dim RECT As RECT
    If hWnd > 0 Then
        GetWindowRect hWnd, RECT
        Left = RECT.Left * 15
        Top = RECT.Top * 15
        Height = (RECT.Bottom - Top) * 15
        Width = (RECT.Right - Left) * 15
    End If
    Dim Visible As Boolean
    Visible = rVisible
    Destroy
    Create
    If Visible Then
        Show
    End If
End Sub
Public Property Get Visible() As Boolean
    Visible = rVisible
End Property
Public Property Let Visible(ByVal vVisible As Boolean)
    If Not rVisible = vVisible Then
        rVisible = vVisible
        If rVisible Then
            Show
        Else
            Hide
        End If
    End If
End Property


Public Sub Destroy()
DestroyWindow hwnd
End Sub

Public Property Get Caption() As String
Caption = rCaption
End Property

Public Property Let Caption(ByVal vCaption As String)
rCaption = vCaption
If hwnd = 0 Then Exit Sub
SetWindowText hwnd, vCaption
End Property

Public Property Get hwnd() As Long
hwnd = Wnd
End Property



-Linguar-


 
 

0
 
LVL 10

Expert Comment

by:caraf_g
ID: 1523881
.
0
 
LVL 1

Author Comment

by:rondeauj
ID: 1523882
Good Answer, But you must note that the last few examples did nothing but crash VB. The very first one worked great and I can use this example code to build the window I really need. Thanks
0

Featured Post

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction While answering a recent question (http://www.experts-exchange.com/Q_27402310.html) in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code o…
When designing a form there are several BorderStyles to choose from, all of which can be classified as either 'Fixed' or 'Sizable' and I'd guess that 'Fixed Single' or one of the other fixed types is the most popular choice. I assume it's the most p…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
Suggested Courses

670 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question