• Vui lòng đọc nội qui diễn đàn để tránh bị xóa bài viết
  • Tìm kiếm trước khi đặt câu hỏi

Tạo form bằng Code

Các thủ thuật liên quan đến việc xử lý ứng dụng, biểu mẫu và control
vinhphuoc91
Thành viên tích cực
Thành viên tích cực
Posts: 146
Joined: Wed 26/03/2008 5:52 pm
Location: Phú Yên
Been thanked: 15 times
Contact:

Tạo form bằng Code

Postby vinhphuoc91 » Sat 05/04/2008 9:58 pm

Thủ thuật: Tạo form bằng Code
Tác giả: Sưu tầm
Mô tả: Tạo form bằng Code



Thêm vào 1 Module vào add vào đoạn code sau :

Code: Select all

  1. Option Explicit
  2. Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, _
  3.                                                     ByVal lpClassName As String, _
  4.                                                     ByVal lpWindowName As String, _
  5.                                                     ByVal dwStyle As Long, _
  6.                                                     ByVal x As Long, _
  7.                                                     ByVal y As Long, _
  8.                                                     ByVal nWidth As Long, _
  9.                                                     ByVal nHeight As Long, _
  10.                                                     ByVal hWndParent As Long, _
  11.                                                     ByVal hMenu As Long, _
  12.                                                     ByVal hInstance As Long, _
  13.                                                     lpParam As Any) As Long
  14.                                                    
  15. Declare Function LoadIcon Lib "user32" Alias "LoadIconA" (ByVal hInstance As Long, ByVal lpIconName As String) As Long
  16. Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As String) As Long
  17. Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
  18. Declare Function RegisterClassEx Lib "user32" Alias "RegisterClassExA" (pcWndClassEx As WNDCLASSEX) As Integer
  19. Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
  20. Declare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As Long
  21. Declare Function SetFocus Lib "user32" (ByVal hwnd As Long) As Long
  22. Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  23. 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
  24. Declare Function GetMessage Lib "user32" Alias "GetMessageA" (lpMsg As MSG, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long
  25. Declare Function TranslateMessage Lib "user32" (lpMsg As MSG) As Long
  26. Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageA" (lpMsg As MSG) As Long
  27. Declare Sub PostQuitMessage Lib "user32" (ByVal nExitCode As Long)
  28. Declare Function BeginPaint Lib "user32" (ByVal hwnd As Long, lpPaint As PAINTSTRUCT) As Long
  29. Declare Function EndPaint Lib "user32" (ByVal hwnd As Long, lpPaint As PAINTSTRUCT) As Long
  30. Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
  31. 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
  32.                                                    
  33.                                                    
  34. Type WNDCLASSEX
  35.     cbSize As Long
  36.     style As Long
  37.     lpfnWndProc As Long
  38.     cbClsExtra As Long
  39.     cbWndExtra As Long
  40.     hInstance As Long
  41.     hIcon As Long
  42.     hCursor As Long
  43.     hbrBackground As Long
  44.     lpszMenuName As String
  45.     lpszClassName As String
  46.     hIconSm As Long
  47. End Type
  48.  
  49.  
  50. Type POINTAPI
  51.         x As Long
  52.         y As Long
  53. End Type
  54.  
  55. Type MSG
  56.     hwnd As Long
  57.     message As Long
  58.     wParam As Long
  59.     lParam As Long
  60.     time As Long
  61.     pt As POINTAPI
  62. End Type
  63.  
  64. Type RECT
  65.         Left As Long
  66.         Top As Long
  67.         Right As Long
  68.         Bottom As Long
  69. End Type
  70.  
  71. Type PAINTSTRUCT
  72.         hdc As Long
  73.         fErase As Long
  74.         rcPaint As RECT
  75.         fRestore As Long
  76.         fIncUpdate As Long
  77.         rgbReserved(32) As Byte 'this was declared incorrectly in VB API viewer
  78. End Type
  79.  
  80. Public Const WS_VISIBLE As Long = &H10000000
  81. Public Const WS_VSCROLL As Long = &H200000
  82. Public Const WS_TABSTOP As Long = &H10000
  83. Public Const WS_THICKFRAME As Long = &H40000
  84. Public Const WS_MAXIMIZE As Long = &H1000000
  85. Public Const WS_MAXIMIZEBOX As Long = &H10000
  86. Public Const WS_MINIMIZE As Long = &H20000000
  87. Public Const WS_MINIMIZEBOX As Long = &H20000
  88. Public Const WS_SYSMENU As Long = &H80000
  89. Public Const WS_BORDER As Long = &H800000
  90. Public Const WS_CAPTION As Long = &HC00000                  '  WS_BORDER Or WS_DLGFRAME
  91. Public Const WS_CHILD As Long = &H40000000
  92. Public Const WS_CHILDWINDOW As Long = (WS_CHILD)
  93. Public Const WS_CLIPCHILDREN As Long = &H2000000
  94. Public Const WS_CLIPSIBLINGS As Long = &H4000000
  95. Public Const WS_DISABLED As Long = &H8000000
  96. Public Const WS_DLGFRAME As Long = &H400000
  97. Public Const WS_EX_ACCEPTFILES As Long = &H10&
  98. Public Const WS_EX_DLGMODALFRAME As Long = &H1&
  99. Public Const WS_EX_NOPARENTNOTIFY As Long = &H4&
  100. Public Const WS_EX_TOPMOST As Long = &H8&
  101. Public Const WS_EX_TRANSPARENT As Long = &H20&
  102. Public Const WS_GROUP As Long = &H20000
  103. Public Const WS_HSCROLL As Long = &H100000
  104. Public Const WS_ICONIC As Long = WS_MINIMIZE
  105. Public Const WS_OVERLAPPED As Long = &H0&
  106. Public Const WS_OVERLAPPEDWINDOW As Long = (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)
  107. Public Const WS_POPUP As Long = &H80000000
  108. Public Const WS_POPUPWINDOW As Long = (WS_POPUP Or WS_BORDER Or WS_SYSMENU)
  109. Public Const WS_SIZEBOX As Long = WS_THICKFRAME
  110. Public Const WS_TILED As Long = WS_OVERLAPPED
  111. Public Const WS_TILEDWINDOW As Long = WS_OVERLAPPEDWINDOW
  112. Public Const CW_USEDEFAULT As Long = &H80000000
  113. Public Const CS_HREDRAW As Long = &H2
  114. Public Const CS_VREDRAW As Long = &H1
  115. Public Const IDI_APPLICATION As Long = 32512&
  116. Public Const IDC_ARROW As Long = 32512&
  117. Public Const WHITE_BRUSH As Integer = 0
  118. Public Const BLACK_BRUSH As Integer = 4
  119. Public Const WM_KEYDOWN As Long = &H100
  120. Public Const WM_CLOSE As Long = &H10
  121. Public Const WM_DESTROY As Long = &H2
  122. Public Const WM_PAINT As Long = &HF
  123. Public Const SW_SHOWNORMAL As Long = 1
  124. Public Const DT_CENTER As Long = &H1
  125. Public Const DT_SINGLELINE As Long = &H20
  126. Public Const DT_VCENTER As Long = &H4
  127.  
  128. Sub Main()
  129.  
  130. Call vbWinMain
  131.  
  132. End Sub
  133.  
  134. Public Function vbWinMain() As Long
  135.  
  136. Const CLASSNAME = "Hello_VB"
  137. Const TITLE = "Hello VB"
  138. Dim hwnd As Long
  139. Dim wc As WNDCLASSEX
  140. Dim message As MSG
  141.  
  142.     ' Set up and register window class
  143.     wc.cbSize = Len(wc)
  144.     wc.style = CS_HREDRAW Or CS_VREDRAW
  145.     wc.lpfnWndProc = GetFuncPtr(AddressOf WindowProc)
  146.     wc.cbClsExtra = 0&
  147.     wc.cbWndExtra = 0&
  148.     wc.hInstance = App.hInstance
  149.     wc.hIcon = LoadIcon(App.hInstance, IDI_APPLICATION)
  150.     wc.hCursor = LoadCursor(App.hInstance, IDC_ARROW)
  151.     wc.hbrBackground = GetStockObject(WHITE_BRUSH)
  152.     wc.lpszMenuName = 0&
  153.     wc.lpszClassName = CLASSNAME
  154.     wc.hIconSm = LoadIcon(App.hInstance, IDI_APPLICATION)
  155.    
  156.     RegisterClassEx wc
  157.  
  158.    
  159.     ' Create a window
  160.     hwnd = CreateWindowEx(0&, _
  161.                         CLASSNAME, _
  162.                         TITLE, _
  163.                         WS_OVERLAPPEDWINDOW, _
  164.                         CW_USEDEFAULT, _
  165.                         CW_USEDEFAULT, _
  166.                         CW_USEDEFAULT, _
  167.                         CW_USEDEFAULT, _
  168.                         0&, _
  169.                         0&, _
  170.                         App.hInstance, _
  171.                         0&)
  172.    
  173.     ' Show the window
  174.     ShowWindow hwnd, SW_SHOWNORMAL
  175.     UpdateWindow hwnd
  176.     SetFocus hwnd
  177.    
  178.     'enter message loop
  179.     '(all window messages are handles in WindowProc())
  180.     Do While 0 <> GetMessage(message, 0&, 0&, 0&)
  181.         TranslateMessage message
  182.         DispatchMessage message
  183.     Loop
  184.    
  185.     vbWinMain = message.wParam
  186. End Function
  187.  
  188.  
  189. Public Function WindowProc(ByVal hwnd As Long, ByVal message As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  190. 'Main message handler for this program
  191. Dim ps As PAINTSTRUCT
  192. Dim rc As RECT
  193. Dim hdc As Long
  194. Dim str As String
  195.  
  196. Select Case message
  197.     'Handle 3 select messages "manually"
  198.     Case WM_PAINT
  199.         hdc = BeginPaint(hwnd, ps)
  200.         Call GetClientRect(hwnd, rc)
  201.         str = "Hello Visual Basic 6!"
  202.         Call DrawText(hdc, str, Len(str), rc, DT_SINGLELINE Or DT_CENTER Or DT_VCENTER)
  203.         Call EndPaint(hwnd, ps)
  204.         Exit Function
  205.  
  206.     Case WM_KEYDOWN
  207.         Call PostMessage(hwnd, WM_CLOSE, 0, 0)
  208.         Exit Function
  209.        
  210.     Case WM_DESTROY
  211.         PostQuitMessage 0&
  212.         Exit Function
  213.        
  214.     Case Else
  215.     'pass all other messages to default window procedure
  216.         WindowProc = DefWindowProc(hwnd, message, wParam, lParam)
  217.        
  218. End Select
  219.  
  220.  
  221. End Function
  222.  
  223. Function GetFuncPtr(ByVal lngFnPtr As Long) As Long
  224.     'wrapper function to allow AddressOf to be used within VB
  225.     GetFuncPtr = lngFnPtr
  226. End Function
  227.  


Chạy thử chương trình để thấy kết quả


My website : http://tinthoitrang.net

Return to “[VB] Ứng dụng - Form và Control”

Who is online

Users browsing this forum: No registered users and 1 guest