INSTANCIAR FORM USANDO MODULO E SUB MAIN-URGENTE
LVFIOROT
Eu tentei já essa infomação logo no inicio do projeto, a finalidade desse projeto é fazer interação com outro software chamado LabelView que faz impressão de códigos de barra, o problema é que nas ultimas versões do LabelView, foi lançado uma versão que não tem compatibilidade com forms, e a linguagem homologada pra Desenvolvimento nesta empresa é VB6. Se utilizar Form o LabelView da problema. Entramos em contato com a fabricante do software, a informação que eles passam é que isso foi feito para impedir que outras softwares interajam com o interfaceamento do LabelView, porém nesta fábrica tem diversos operadores que interagem com o label view, e perdem cerca de 30 seg a cada produção, se eu eliminar esses 30 segundos perdidos, isso siginificará um aumento de produção de 20%. E 20% nesta Fábrica é uma diferença muito grande.
Mas pra não dizer que eu não testei o seu código, eu retirei os forms e testei apenas o módulo. conforme imagem em anexo.
E conforme faleu que havia testado, infelizmente não deu certo.
Eu tentei já essa infomação logo no inicio do projeto, a finalidade desse projeto é fazer interação com outro software chamado LabelView que faz impressão de códigos de barra, o problema é que nas ultimas versões do LabelView, foi lançado uma versão que não tem compatibilidade com forms, e a linguagem homologada pra Desenvolvimento nesta empresa é VB6. Se utilizar Form o LabelView da problema. Entramos em contato com a fabricante do software, a informação que eles passam é que isso foi feito para impedir que outras softwares interajam com o interfaceamento do LabelView, porém nesta fábrica tem diversos operadores que interagem com o label view, e perdem cerca de 30 seg a cada produção, se eu eliminar esses 30 segundos perdidos, isso siginificará um aumento de produção de 20%. E 20% nesta Fábrica é uma diferença muito grande.
Mas pra não dizer que eu não testei o seu código, eu retirei os forms e testei apenas o módulo. conforme imagem em anexo.
E conforme faleu que havia testado, infelizmente não deu certo.
Mas por favor se tiver alguém que saiba, não desista, me falem. Grato.
mais um exemplo para testar acredito que irá gostar.
LVFIOROT
Grande amigo LVFIOROT, este é o meu projeto ele é assim mesmo, ele não abre pelo form ele só pode ser aberto pelo Módulo, Usando o código abaixo, obrigado por sua ajuda, e quero agradecer ao grande amigo MARCELO-TREZE que por sua vez apresentou uma solução final a qual posto aqui para que todos possam ver, além do link do Marcelo onde poderão baixar.
Obrigado amigo Marcelo.
Boa semana a todos.
[ô]************************************************************
[ô]* NOM : CreerFenetre
[ô]* DATE : 14/11/1998
[ô]*
[ô]* AUTEUR : Jean Dufrasne
[ô]*
[ô]* CODE TROUVE SUR [Ô]Le petit monde de Visual Basic[Ô]
[ô]* http://www.vbasic.org
[ô]*
[ô]* DESCRIPTION :
[ô]* Permet de créer dynamiquement une fenêtre et des objets
[ô]*
[ô]************************************************************
[ô] La création du bouton et de la zone de texte se trouve dans
[ô] la fonction MyCreateWindow
[ô]
[ô] hwnd2 = handle du bouton
[ô] hwnd3 = handle de la zone de texte
[ô]
[ô]
[ô] Pas encore de gestion des messages des objets bouton et zone de texte
[ô] mais ça viendra une fois que j[ô]aurai trouvé la structure des
[ô] classes [ô]bouton[ô] et [ô]edit[ô]
[ô]
Option Explicit
[ô]---- Declarations de l[ô]API Win32
Declare Function RegisterClass Lib [Ô]user32[Ô] Alias [Ô]RegisterClassA[Ô] (Class As WNDCLASS) As Long
Declare Function UnregisterClass Lib [Ô]user32[Ô] Alias [Ô]UnregisterClassA[Ô] (ByVal lpClassName As String, ByVal hInstance As Long) As Long
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
Declare Function DefWindowProc Lib [Ô]user32[Ô] Alias [Ô]DefWindowProcA[Ô] (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Sub PostQuitMessage Lib [Ô]user32[Ô] (ByVal nExitCode As Long)
Declare Function GetMessage Lib [Ô]user32[Ô] Alias [Ô]GetMessageA[Ô] (lpMsg As Msg, ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long
Declare Function TranslateMessage Lib [Ô]user32[Ô] (lpMsg As Msg) As Long
Declare Function DispatchMessage Lib [Ô]user32[Ô] Alias [Ô]DispatchMessageA[Ô] (lpMsg As Msg) As Long
Declare Function ShowWindow Lib [Ô]user32[Ô] (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Declare Function LoadCursor Lib [Ô]user32[Ô] Alias [Ô]LoadCursorA[Ô] (ByVal hInstance As Long, ByVal lpCursorName As Any) As Long
Declare Function DefMDIChildProc Lib [Ô]user32[Ô] Alias [Ô]DefMDIChildProcA[Ô] (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
[ô]
[ô] Définir des informations dans la structure de fenêtre (pointée par hwnd)
Declare Function GetWindowLong Lib [Ô]user32[Ô] Alias [Ô]GetWindowLongA[Ô] (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong Lib [Ô]user32[Ô] Alias [Ô]SetWindowLongA[Ô] (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
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
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
Type POINTAPI
x As Long
y As Long
End Type
Type Msg
hWnd As Long
message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type
[ô] Styles de classe
Public Const CS_VREDRAW = &H1
Public Const CS_HREDRAW = &H2
Public Const CS_KEYCVTWINDOW = &H4
Public Const CS_DBLCLKS = &H8
Public Const CS_OWNDC = &H20
Public Const CS_CLASSDC = &H40
Public Const CS_PARENTDC = &H80
Public Const CS_NOKEYCVT = &H100
Public Const CS_NOCLOSE = &H200
Public Const CS_SAVEBITS = &H800
Public Const CS_BYTEALIGNCLIENT = &H1000
Public Const CS_BYTEALIGNWINDOW = &H2000
Public Const CS_PUBLICCLASS = &H4000
[ô] Styles de fenêtres
Public Const WS_OVERLAPPED = &H0&
Public Const WS_POPUP = &H80000000
Public Const WS_CHILD = &H40000000
Public Const WS_MINIMIZE = &H20000000
Public Const WS_VISIBLE = &H10000000
Public Const WS_DISABLED = &H8000000
Public Const WS_CLIPSIBLINGS = &H4000000
Public Const WS_CLIPCHILDREN = &H2000000
Public Const WS_MAXIMIZE = &H1000000
Public Const WS_CAPTION = &HC00000 [ô] WS_BORDER Or WS_DLGFRAME
Public Const WS_BORDER = &H800000
Public Const WS_DLGFRAME = &H400000
Public Const WS_VSCROLL = &H200000
Public Const WS_HSCROLL = &H100000
Public Const WS_SYSMENU = &H80000
Public Const WS_THICKFRAME = &H40000
Public Const WS_GROUP = &H20000
Public Const WS_TABSTOP = &H10000
Public Const WS_MINIMIZEBOX = &H20000
Public Const WS_MAXIMIZEBOX = &H10000
Public Const WS_TILED = WS_OVERLAPPED
Public Const WS_ICONIC = WS_MINIMIZE
Public Const WS_SIZEBOX = WS_THICKFRAME
Public Const WS_OVERLAPPEDWINDOW = (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)
Public Const WS_TILEDWINDOW = WS_OVERLAPPEDWINDOW
Public Const WS_POPUPWINDOW = (WS_POPUP Or WS_BORDER Or WS_SYSMENU)
Public Const WS_CHILDWINDOW = (WS_CHILD)
[ô] Styles de fenêtre étendus
Public Const WS_EX_DLGMODALFRAME = &H1&
Public Const WS_EX_NOPARENTNOTIFY = &H4&
Public Const WS_EX_TOPMOST = &H8&
Public Const WS_EX_ACCEPTFILES = &H10&
Public Const WS_EX_TRANSPARENT = &H20&
[ô] Constantes de couleurs
Public Const COLOR_SCROLLBAR = 0
Public Const COLOR_BACKGROUND = 1
Public Const COLOR_ACTIVECAPTION = 2
Public Const COLOR_INACTIVECAPTION = 3
Public Const COLOR_MENU = 4
Public Const COLOR_WINDOW = 5
Public Const COLOR_WINDOWFRAME = 6
Public Const COLOR_MENUTEXT = 7
Public Const COLOR_WINDOWTEXT = 8
Public Const COLOR_CAPTIONTEXT = 9
Public Const COLOR_ACTIVEBORDER = 10
Public Const COLOR_INACTIVEBORDER = 11
Public Const COLOR_APPWORKSPACE = 12
Public Const COLOR_HIGHLIGHT = 13
Public Const COLOR_HIGHLIGHTTEXT = 14
Public Const COLOR_BTNFACE = 15
Public Const COLOR_BTNSHADOW = 16
Public Const COLOR_GRAYTEXT = 17
Public Const COLOR_BTNTEXT = 18
Public Const COLOR_INACTIVECAPTIONTEXT = 19
Public Const COLOR_BTNHIGHLIGHT = 20
[ô] Messages de fenêtres
Public Const WM_NULL = &H0
Public Const WM_CREATE = &H1
Public Const WM_DESTROY = &H2
Public Const WM_MOVE = &H3
Public Const WM_SIZE = &H5
[ô] Commandes de ShowWindow()
Public Const SW_HIDE = 0
Public Const SW_SHOWNORMAL = 1
Public Const SW_NORMAL = 1
Public Const SW_SHOWMINIMIZED = 2
Public Const SW_SHOWMAXIMIZED = 3
Public Const SW_MAXIMIZE = 3
Public Const SW_SHOWNOACTIVATE = 4
Public Const SW_SHOW = 5
Public Const SW_MINIMIZE = 6
Public Const SW_SHOWMINNOACTIVE = 7
Public Const SW_SHOWNA = 8
Public Const SW_RESTORE = 9
Public Const SW_SHOWDEFAULT = 10
Public Const SW_MAX = 10
[ô] ID Standard de curseurs
Public Const IDC_ARROW = 32512&
Public Const IDC_IBEAM = 32513&
Public Const IDC_WAIT = 32514&
Public Const IDC_CROSS = 32515&
Public Const IDC_UPARROW = 32516&
Public Const IDC_SIZE = 32640&
Public Const IDC_ICON = 32641&
Public Const IDC_SIZENWSE = 32642&
Public Const IDC_SIZENESW = 32643&
Public Const IDC_SIZEWE = 32644&
Public Const IDC_SIZENS = 32645&
Public Const IDC_SIZEALL = 32646&
Public Const IDC_NO = 32648&
Public Const IDC_APPSTARTING = 32650&
[ô] Constantes index de l[ô]information d[ô]une classe de fenêtre
Public Const GWL_WNDPROC = -4 [ô] Fonction de message
Dim hwnd2 As Long
Dim hwnd3 As Long
Dim old_proc As Long
Dim new_proc As Long
[ô]---- Procédure principale
Public Sub Main()
Dim lngTemp As Long
[ô] Enregistre la classe
If MyRegisterClass Then
[ô] Crée la fenêtre
If MyCreateWindow Then
[ô]
[ô] Change la procedure de message du bouton
[ô]
[ô] Pointeur sur la nouvelle fonction de message
[ô]
new_proc = GetMyWndProc(AddressOf MonBoutonProc)
[ô]
[ô] (récupère le pointeur sur la fonction d[ô]origine)
[ô]
old_proc = SetWindowLong(hwnd2, GWL_WNDPROC, new_proc)
[ô]
[ô] Boucle de messagees
MyMessageLoop
End If
[ô] Dé-enregistre la classe
MyUnregisterClass
End If
End Sub
[ô]---- Enregistrement d[ô]une classe Windows
Private Function MyRegisterClass() As Boolean
[ô] La structure WNDCLASS
Dim wndcls As WNDCLASS
wndcls.style = CS_HREDRAW + CS_VREDRAW
wndcls.lpfnwndproc = GetMyWndProc(AddressOf MyWndProc)
wndcls.cbClsextra = 0
wndcls.cbWndExtra2 = 0
wndcls.hInstance = App.hInstance
wndcls.hIcon = 0
wndcls.hCursor = LoadCursor(0, IDC_ARROW)
wndcls.hbrBackground = COLOR_WINDOW
wndcls.lpszMenuName = 0
wndcls.lpszClassName = [Ô]maClasseFenetre[Ô]
[ô] Enregistre la classe
MyRegisterClass = (RegisterClass(wndcls) <> 0)
End Function
[ô]---- Dé-enregistrement d[ô]une classe
Private Sub MyUnregisterClass()
UnregisterClass [Ô]maClasseFenetre[Ô], App.hInstance
End Sub
[ô]---- Création d[ô]une fenêtre
Private Function MyCreateWindow() As Boolean
Dim hWnd As Long
[ô] Crée la fenêtre
hWnd = CreateWindowEx(0, [Ô]maClasseFenetre[Ô], [Ô]Ma fenêtre[Ô], WS_OVERLAPPEDWINDOW, 0, 0, 400, 300, 0, 0, App.hInstance, ByVal 0&)
[ô]
[ô] Bouton et zone texte sont des fenêtres filles de ma fenêtre
[ô]
hwnd2 = CreateWindowEx(0, [Ô]Button[Ô], [Ô]Mon bouton[Ô], WS_CHILD, 50, 55, 100, 25, hWnd, 0, App.hInstance, ByVal 0&)
hwnd3 = CreateWindowEx(0, [Ô]edit[Ô], [Ô]Ma zone de texte[Ô], WS_CHILD, 50, 25, 100, 25, hWnd, 0, App.hInstance, ByVal 0&)
If hWnd <> 0 Then ShowWindow hWnd, SW_SHOWNORMAL
[ô]
[ô] Les rend visibles
[ô]
ShowWindow hwnd2, SW_SHOWNORMAL
ShowWindow hwnd3, SW_SHOWNORMAL
[ô] Retourne
MyCreateWindow = (hWnd <> 0)
End Function
[ô]---- La procédure de fenêtre
Private Function MyWndProc(ByVal hWnd As Long, ByVal message As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
[ô] Debug.Print Hex$(m
Grande amigo LVFIOROT, este é o meu projeto ele é assim mesmo, ele não abre pelo form ele só pode ser aberto pelo Módulo, Usando o código abaixo, obrigado por sua ajuda, e quero agradecer ao grande amigo MARCELO-TREZE que por sua vez apresentou uma solução final a qual posto aqui para que todos possam ver, além do link do Marcelo onde poderão baixar.
Obrigado amigo Marcelo.
Boa semana a todos.
[ô]************************************************************
[ô]* NOM : CreerFenetre
[ô]* DATE : 14/11/1998
[ô]*
[ô]* AUTEUR : Jean Dufrasne
[ô]*
[ô]* CODE TROUVE SUR [Ô]Le petit monde de Visual Basic[Ô]
[ô]* http://www.vbasic.org
[ô]*
[ô]* DESCRIPTION :
[ô]* Permet de créer dynamiquement une fenêtre et des objets
[ô]*
[ô]************************************************************
[ô] La création du bouton et de la zone de texte se trouve dans
[ô] la fonction MyCreateWindow
[ô]
[ô] hwnd2 = handle du bouton
[ô] hwnd3 = handle de la zone de texte
[ô]
[ô]
[ô] Pas encore de gestion des messages des objets bouton et zone de texte
[ô] mais ça viendra une fois que j[ô]aurai trouvé la structure des
[ô] classes [ô]bouton[ô] et [ô]edit[ô]
[ô]
Option Explicit
[ô]---- Declarations de l[ô]API Win32
Declare Function RegisterClass Lib [Ô]user32[Ô] Alias [Ô]RegisterClassA[Ô] (Class As WNDCLASS) As Long
Declare Function UnregisterClass Lib [Ô]user32[Ô] Alias [Ô]UnregisterClassA[Ô] (ByVal lpClassName As String, ByVal hInstance As Long) As Long
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
Declare Function DefWindowProc Lib [Ô]user32[Ô] Alias [Ô]DefWindowProcA[Ô] (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Sub PostQuitMessage Lib [Ô]user32[Ô] (ByVal nExitCode As Long)
Declare Function GetMessage Lib [Ô]user32[Ô] Alias [Ô]GetMessageA[Ô] (lpMsg As Msg, ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long
Declare Function TranslateMessage Lib [Ô]user32[Ô] (lpMsg As Msg) As Long
Declare Function DispatchMessage Lib [Ô]user32[Ô] Alias [Ô]DispatchMessageA[Ô] (lpMsg As Msg) As Long
Declare Function ShowWindow Lib [Ô]user32[Ô] (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Declare Function LoadCursor Lib [Ô]user32[Ô] Alias [Ô]LoadCursorA[Ô] (ByVal hInstance As Long, ByVal lpCursorName As Any) As Long
Declare Function DefMDIChildProc Lib [Ô]user32[Ô] Alias [Ô]DefMDIChildProcA[Ô] (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
[ô]
[ô] Définir des informations dans la structure de fenêtre (pointée par hwnd)
Declare Function GetWindowLong Lib [Ô]user32[Ô] Alias [Ô]GetWindowLongA[Ô] (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong Lib [Ô]user32[Ô] Alias [Ô]SetWindowLongA[Ô] (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
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
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
Type POINTAPI
x As Long
y As Long
End Type
Type Msg
hWnd As Long
message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type
[ô] Styles de classe
Public Const CS_VREDRAW = &H1
Public Const CS_HREDRAW = &H2
Public Const CS_KEYCVTWINDOW = &H4
Public Const CS_DBLCLKS = &H8
Public Const CS_OWNDC = &H20
Public Const CS_CLASSDC = &H40
Public Const CS_PARENTDC = &H80
Public Const CS_NOKEYCVT = &H100
Public Const CS_NOCLOSE = &H200
Public Const CS_SAVEBITS = &H800
Public Const CS_BYTEALIGNCLIENT = &H1000
Public Const CS_BYTEALIGNWINDOW = &H2000
Public Const CS_PUBLICCLASS = &H4000
[ô] Styles de fenêtres
Public Const WS_OVERLAPPED = &H0&
Public Const WS_POPUP = &H80000000
Public Const WS_CHILD = &H40000000
Public Const WS_MINIMIZE = &H20000000
Public Const WS_VISIBLE = &H10000000
Public Const WS_DISABLED = &H8000000
Public Const WS_CLIPSIBLINGS = &H4000000
Public Const WS_CLIPCHILDREN = &H2000000
Public Const WS_MAXIMIZE = &H1000000
Public Const WS_CAPTION = &HC00000 [ô] WS_BORDER Or WS_DLGFRAME
Public Const WS_BORDER = &H800000
Public Const WS_DLGFRAME = &H400000
Public Const WS_VSCROLL = &H200000
Public Const WS_HSCROLL = &H100000
Public Const WS_SYSMENU = &H80000
Public Const WS_THICKFRAME = &H40000
Public Const WS_GROUP = &H20000
Public Const WS_TABSTOP = &H10000
Public Const WS_MINIMIZEBOX = &H20000
Public Const WS_MAXIMIZEBOX = &H10000
Public Const WS_TILED = WS_OVERLAPPED
Public Const WS_ICONIC = WS_MINIMIZE
Public Const WS_SIZEBOX = WS_THICKFRAME
Public Const WS_OVERLAPPEDWINDOW = (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)
Public Const WS_TILEDWINDOW = WS_OVERLAPPEDWINDOW
Public Const WS_POPUPWINDOW = (WS_POPUP Or WS_BORDER Or WS_SYSMENU)
Public Const WS_CHILDWINDOW = (WS_CHILD)
[ô] Styles de fenêtre étendus
Public Const WS_EX_DLGMODALFRAME = &H1&
Public Const WS_EX_NOPARENTNOTIFY = &H4&
Public Const WS_EX_TOPMOST = &H8&
Public Const WS_EX_ACCEPTFILES = &H10&
Public Const WS_EX_TRANSPARENT = &H20&
[ô] Constantes de couleurs
Public Const COLOR_SCROLLBAR = 0
Public Const COLOR_BACKGROUND = 1
Public Const COLOR_ACTIVECAPTION = 2
Public Const COLOR_INACTIVECAPTION = 3
Public Const COLOR_MENU = 4
Public Const COLOR_WINDOW = 5
Public Const COLOR_WINDOWFRAME = 6
Public Const COLOR_MENUTEXT = 7
Public Const COLOR_WINDOWTEXT = 8
Public Const COLOR_CAPTIONTEXT = 9
Public Const COLOR_ACTIVEBORDER = 10
Public Const COLOR_INACTIVEBORDER = 11
Public Const COLOR_APPWORKSPACE = 12
Public Const COLOR_HIGHLIGHT = 13
Public Const COLOR_HIGHLIGHTTEXT = 14
Public Const COLOR_BTNFACE = 15
Public Const COLOR_BTNSHADOW = 16
Public Const COLOR_GRAYTEXT = 17
Public Const COLOR_BTNTEXT = 18
Public Const COLOR_INACTIVECAPTIONTEXT = 19
Public Const COLOR_BTNHIGHLIGHT = 20
[ô] Messages de fenêtres
Public Const WM_NULL = &H0
Public Const WM_CREATE = &H1
Public Const WM_DESTROY = &H2
Public Const WM_MOVE = &H3
Public Const WM_SIZE = &H5
[ô] Commandes de ShowWindow()
Public Const SW_HIDE = 0
Public Const SW_SHOWNORMAL = 1
Public Const SW_NORMAL = 1
Public Const SW_SHOWMINIMIZED = 2
Public Const SW_SHOWMAXIMIZED = 3
Public Const SW_MAXIMIZE = 3
Public Const SW_SHOWNOACTIVATE = 4
Public Const SW_SHOW = 5
Public Const SW_MINIMIZE = 6
Public Const SW_SHOWMINNOACTIVE = 7
Public Const SW_SHOWNA = 8
Public Const SW_RESTORE = 9
Public Const SW_SHOWDEFAULT = 10
Public Const SW_MAX = 10
[ô] ID Standard de curseurs
Public Const IDC_ARROW = 32512&
Public Const IDC_IBEAM = 32513&
Public Const IDC_WAIT = 32514&
Public Const IDC_CROSS = 32515&
Public Const IDC_UPARROW = 32516&
Public Const IDC_SIZE = 32640&
Public Const IDC_ICON = 32641&
Public Const IDC_SIZENWSE = 32642&
Public Const IDC_SIZENESW = 32643&
Public Const IDC_SIZEWE = 32644&
Public Const IDC_SIZENS = 32645&
Public Const IDC_SIZEALL = 32646&
Public Const IDC_NO = 32648&
Public Const IDC_APPSTARTING = 32650&
[ô] Constantes index de l[ô]information d[ô]une classe de fenêtre
Public Const GWL_WNDPROC = -4 [ô] Fonction de message
Dim hwnd2 As Long
Dim hwnd3 As Long
Dim old_proc As Long
Dim new_proc As Long
[ô]---- Procédure principale
Public Sub Main()
Dim lngTemp As Long
[ô] Enregistre la classe
If MyRegisterClass Then
[ô] Crée la fenêtre
If MyCreateWindow Then
[ô]
[ô] Change la procedure de message du bouton
[ô]
[ô] Pointeur sur la nouvelle fonction de message
[ô]
new_proc = GetMyWndProc(AddressOf MonBoutonProc)
[ô]
[ô] (récupère le pointeur sur la fonction d[ô]origine)
[ô]
old_proc = SetWindowLong(hwnd2, GWL_WNDPROC, new_proc)
[ô]
[ô] Boucle de messagees
MyMessageLoop
End If
[ô] Dé-enregistre la classe
MyUnregisterClass
End If
End Sub
[ô]---- Enregistrement d[ô]une classe Windows
Private Function MyRegisterClass() As Boolean
[ô] La structure WNDCLASS
Dim wndcls As WNDCLASS
wndcls.style = CS_HREDRAW + CS_VREDRAW
wndcls.lpfnwndproc = GetMyWndProc(AddressOf MyWndProc)
wndcls.cbClsextra = 0
wndcls.cbWndExtra2 = 0
wndcls.hInstance = App.hInstance
wndcls.hIcon = 0
wndcls.hCursor = LoadCursor(0, IDC_ARROW)
wndcls.hbrBackground = COLOR_WINDOW
wndcls.lpszMenuName = 0
wndcls.lpszClassName = [Ô]maClasseFenetre[Ô]
[ô] Enregistre la classe
MyRegisterClass = (RegisterClass(wndcls) <> 0)
End Function
[ô]---- Dé-enregistrement d[ô]une classe
Private Sub MyUnregisterClass()
UnregisterClass [Ô]maClasseFenetre[Ô], App.hInstance
End Sub
[ô]---- Création d[ô]une fenêtre
Private Function MyCreateWindow() As Boolean
Dim hWnd As Long
[ô] Crée la fenêtre
hWnd = CreateWindowEx(0, [Ô]maClasseFenetre[Ô], [Ô]Ma fenêtre[Ô], WS_OVERLAPPEDWINDOW, 0, 0, 400, 300, 0, 0, App.hInstance, ByVal 0&)
[ô]
[ô] Bouton et zone texte sont des fenêtres filles de ma fenêtre
[ô]
hwnd2 = CreateWindowEx(0, [Ô]Button[Ô], [Ô]Mon bouton[Ô], WS_CHILD, 50, 55, 100, 25, hWnd, 0, App.hInstance, ByVal 0&)
hwnd3 = CreateWindowEx(0, [Ô]edit[Ô], [Ô]Ma zone de texte[Ô], WS_CHILD, 50, 25, 100, 25, hWnd, 0, App.hInstance, ByVal 0&)
If hWnd <> 0 Then ShowWindow hWnd, SW_SHOWNORMAL
[ô]
[ô] Les rend visibles
[ô]
ShowWindow hwnd2, SW_SHOWNORMAL
ShowWindow hwnd3, SW_SHOWNORMAL
[ô] Retourne
MyCreateWindow = (hWnd <> 0)
End Function
[ô]---- La procédure de fenêtre
Private Function MyWndProc(ByVal hWnd As Long, ByVal message As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
[ô] Debug.Print Hex$(m
Tópico encerrado , respostas não são mais permitidas