dat form o vi tri cho truoc

1. Private Enum FormPosition
2.
FrmTopLeft = 0
3.
FrmTopRight = 1
4.
FrmCenter = 2
5.
FrmBottomLeft = 3
6.
FrmBottomRight = 4
7. End Enum
8.
9. Private Type RECT
10.
Left
As
Long
11.
Top
As
Long
12.
Right
As
Long
13.
Bottom
As
Long
14.

End Type
15.
16.
Private Declare Function SystemParametersInfo Lib
"user32" Alias "SystemParametersInfoA" (ByVal uAction As
Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal
fuWinIni As Long) As Long
17.
Private Const SPI_GETWORKAREA
As
Long = 48
18.
19.
Private Function MoveForm(Frm As Form, Optional sType
As FormPosition = 2) As Long
20.
Dim Area As RECT
21.
If SystemParametersInfo(SPI_GETWORKAREA, 0, Area,
0) <> 0 Then
22.
Select Case sType
23.
Case 0
24.
Frm.Move 0, 0
25.
Case 1
26.
Frm.Move Frm.ScaleX(Area.Right,

vbPixels, vbTwips) - Frm.Width, 0
27.
Case 2
28.
Frm.Move (Frm.ScaleX(Area.Right,
vbPixels, vbTwips) - Frm.Width) \ 2,
(Frm.ScaleY(Area.Bottom, vbPixels, vbTwips) - Frm.Height) \
2
29.
Case 3
30.
Frm.Move 0, Frm.ScaleY(Area.Bottom,
vbPixels, vbTwips) - Frm.Height
31.
Case 4
32.
Frm.Move Frm.ScaleX(Area.Right,
vbPixels, vbTwips) - Frm.Width, Frm.ScaleY(Area.Bottom,
vbPixels, vbTwips) - Frm.Height
33.
End Select
34.
End If
35.
End Function
36.
37.
Private Sub Form_Load()
38.
'MoveForm Me, FrmBottomLeft

39.
'MoveForm Me, FrmBottomRight
40.
MoveForm Me, FrmCenter
41.
'MoveForm Me, FrmTopLeft
42.
'MoveForm Me, FrmTopRight
43.
End Sub


Top


2- Doc textbox theo tung dong
1.
2. Function TachDong(mStr As String) As Collection
3. Dim cLt As New Collection
4. Dim pos As Integer
5. Dim mLine As String
6. mStr = mStr + vbNewLine
7. pos = InStr(mStr, Chr(13))
8. Do While pos <> 0
9.
mLine = Left(mStr, pos - 1)
10.
cLt.Add mLine
11.
mStr = Right(mStr, Len(mStr) - pos - 1)

12.
pos = InStr(mStr, Chr(13))
13.
Loop
14.
Set TachDong = cLt
15.
End Function
16.

Hàm tách dòng trả về 1 đối tượng kiểu Collection (cách sử dụng đối tượng này giống y
như listbox)
Cách dùng:
Code: Chọn tất cả
1.
2. Private Sub Command1_Click()
3. Dim cL As New Collection 'Tạo một đối tượng Collection
4. Set cL = TachDong(Text1.Text) 'Gán đối tượng này bằng đối
tượng trả về của TachDong
5.
6. Dim I As Integer
7. Dim nmLine
8.
9. For I = 1 To cL.Count 'Duyệt tất cả các item của cL
10.
nmLine = CStr(cL.Item(I))
11.
List1.AddItem nmLine 'add mỗi dòng trong cL vào
listBox
12.

Next
13.
End Sub
14.

3- Đọc và Ghi trên Excel (xls) với TextBox chuẩn
ta da quen với việc muốn đọc và ghi trên file Excel (xls) buộc phải chèn thư
viện Excel
Bài viết kèm Project sau rình bày kỹ thuật Đọc và Ghi trên Excel (xls) với
TextBox chuẩn
(Thực ra là do DDE [Dynamic Data Exchange] thực hiện, mà TextBox
chuẩn được MS thiết kế có kèm hoạt động của DDE)
* Code hoạt động trên XP SP2, cần Text1 và vài command như trong code
Giao tiếp với file XLS (2003)
1. Private Declare Function ShellExecute Lib "shell32.dll"
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal
lpOperation As String, ByVal lpFile As String, ByVal


lpParameters As String, ByVal lpDirectory As String, ByVal
nShowCmd As Long) As Long
2. Const SW_SHOWNORMAL = 1
3.
4. Private Sub Command1_Click() ' Ðoc Sheet1
5.
OpenExcel
6.
Text1.LinkMode = 0
7.
Text1.LinkTopic = "Excel|Book1.xls"

8.
Text1.LinkItem = "R1C1:R6C2"
9.
Text1.LinkMode = 1
10.
Text1.LinkMode = 0
11.
CloseExcel
12.
End Sub
13.
14.
'truongphu
15.
Private Sub Command2_Click() ' Ðoc Sheet2
16.
OpenExcel
17.
Text1.LinkMode = 0
18.
Text1.LinkTopic = "Excel|Sheet2"
19.
Text1.LinkItem = "R1C1:R6C2"
20.
Text1.LinkMode = 1
21.
Text1.LinkMode = 0
22.
CloseExcel
23.

End Sub
24.
25.
Private Sub Command3_Click() ' Ghi Sheet1
26.
OpenExcel
27.
Text1.LinkMode = 0
28.
Text1.LinkTopic = "Excel|Sheet1"
29.
Text1.LinkItem = "R1C4:R2C6"
30.
Text1.LinkMode = 1
31.
Text1 = "Ho" & vbTab & "Tên" & vbTab & "Tuôi" &
vbCrLf & "Bùi" & vbTab & "Toàn" & vbTab & 22
32.
Text1.LinkPoke
33.
Text1.LinkMode = 0
34.
'CloseExcel
35.
End Sub
36.
37.
Private Sub Command4_Click() ' Font Cell
38.
OpenExcel

39.
Text1.LinkMode = 0
40.
Text1.LinkTopic = "Excel|Sheet1"
41.
Text1.LinkMode = 1
42.
Text1.LinkExecute ("[SELECT(""R2C5"")]")
43.
Text1.LinkExecute ("[FONT.PROPERTIES(""Times
New Roman"",""Bold"",10)]")
44.
Text1.LinkMode = 0
45.
'CloseExcel
46.
End Sub


47.
48.
Sub CloseExcel() ' not save
49.
Set aaa = GetObject("winmgmts:\root\cimv2").ExecQuery
_
50.
("Select * from Win32_Process Where Name =
'Excel.exe'")
51.
For Each a In aaa

52.
a.Terminate
53.
Next
54.
End Sub
55.
56.
Sub OpenExcel()
57.
If IsFileOpen(App.Path & "\qqq.xls") = False Then
58.
ShellExecute Me.hwnd, vbNullString, App.Path &
"\Book1.xls", _
59.
vbNullString, vbNullString, SW_SHOWNORMAL
60.
End If
61.
End Sub
62.
63.
Function IsFileOpen(FileName As String) As Boolean
64.
Dim filenum As Integer 'truongphu
65.
filenum = FreeFile()
66.
On Error Resume Next
67.

Open FileName For Input Lock Read As #filenum
68.
Close filenum
69.
Select Case Err
70.
Case 0
71.
IsFileOpen = False
72.
Case 70
73.
IsFileOpen = True
74.
Case Else
75.
End Select
76.
End Function
77.

4-Đóng ứng dụng rất phong cách
1. Private Sub Form_Load()
2.
Form1.Height = 6400
3.
Form1.Width = 10000
4. End Sub
5. Private Sub Form_MouseUp(Button As Integer, Shift As
Integer, X As Single, Y As Single)

6.
If Button = vbRightButton Then
7.
coolCloseForm Me, 20
8.
Else
9.
Dim a As New Form1
10.
a.Height = a.Height / 2
11.
a.Width = a.Width / 2
12.
a.Show


13.
14.
15.
16.

End If
End Sub
Public Function coolCloseForm(closeForm As Form, speed
As Integer)

17.
18.
19.
20.

21.
22.
23.
24.
25.
26.
27.
28.

If speed = 0 Then
MsgBox "Speed cannot zero"
Exit Function
End If
On Error Resume Next
closeForm.ScaleMode = 1
closeForm.WindowState = 0
Do Until closeForm.Height <= 405
DoEvents
closeForm.Height = closeForm.Height -

speed * 10

29.

closeForm.Top = closeForm.Top + speed

30.
31.
32.
33.

Loop
Do Until closeForm.Width <= 1680
DoEvents
closeForm.Width = closeForm.Width

* 5

- speed * 10

34.

speed * 5

35.
36.
37.

End Function

closeForm.Left = closeForm.Left +
Loop
Unload closeForm

5-Đặt form tại những vị trí cho trước
1. Private Enum FormPosition
2.
FrmTopLeft = 0
3.
FrmTopRight = 1

4.
FrmCenter = 2
5.
FrmBottomLeft = 3
6.
FrmBottomRight = 4
7. End Enum
8.
9. Private Type RECT
10.
Left
As
Long
11.
Top
As
Long
12.
Right
As
Long
13.
Bottom
As
Long
14.
End Type
15.
16.
Private Declare Function SystemParametersInfo Lib

"user32" Alias "SystemParametersInfoA" (ByVal uAction As
Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal
fuWinIni As Long) As Long
17.
Private Const SPI_GETWORKAREA
As
Long = 48
18.


19.

Private Function MoveForm(Frm As Form, Optional sType
As FormPosition = 2) As Long
20.
Dim Area As RECT
21.
If SystemParametersInfo(SPI_GETWORKAREA, 0, Area,
0) <> 0 Then
22.
Select Case sType
23.
Case 0
24.
Frm.Move 0, 0
25.
Case 1
26.
Frm.Move Frm.ScaleX(Area.Right,
vbPixels, vbTwips) - Frm.Width, 0

27.
Case 2
28.
Frm.Move (Frm.ScaleX(Area.Right,
vbPixels, vbTwips) - Frm.Width) \ 2,
(Frm.ScaleY(Area.Bottom, vbPixels, vbTwips) - Frm.Height) \
2
29.
Case 3
30.
Frm.Move 0, Frm.ScaleY(Area.Bottom,
vbPixels, vbTwips) - Frm.Height
31.
Case 4
32.
Frm.Move Frm.ScaleX(Area.Right,
vbPixels, vbTwips) - Frm.Width, Frm.ScaleY(Area.Bottom,
vbPixels, vbTwips) - Frm.Height
33.
End Select
34.
End If
35.
End Function
36.
37.
Private Sub Form_Load()
38.
'MoveForm Me, FrmBottomLeft
39.

'MoveForm Me, FrmBottomRight
40.
MoveForm Me, FrmCenter
41.
'MoveForm Me, FrmTopLeft
42.
'MoveForm Me, FrmTopRight
43.
End Sub


Top

VẼ BIỂU ĐỒ QUẢN LÝ VẬT TƯ TỒN KHO TRONG VISUAL BISIC
Lý do: Tại giao điểm Y1 = Y2 thì X = 400
Thế vào Y = P * R + Y1 + Y2 thì Y hơn 80000, vượt khỏi xa picture1!
1.
2.
3.
4.
5.
6.
7.
8.
9.

Private Sub Command4_Click()
Picture1.Cls
Picture1.ForeColor = vbBlack
' Ve truc toa do vo'i y là log10

Dim td As Double
td = Log(10)
Dim YY As Single, k As Long, j As Double, ii As Double

Picture1.Scale (0, 6)-(1000, -1) ''scale to 0 to 1000 in
X, set the Y scale from 4 to -2 tu'` 4 trên xuô'ng 0
10.
'nêu tu'` -2 xuô'ng 4 thì viêt Picture1.Scale (0,
-2)-(3, 4)
11.
12.
For k = 5 To 0 Step -1 ' Ðao lôn lai
13.
j = 10 ^ k
14.
For ii = 10 * j To j Step -j ' Ðao lôn lai
15.
YY = Log(ii) / td
16.
17.
Picture1.Line (0, YY)-(Picture1.ScaleWidth, YY)
18.
If ii = j Then


19.

Picture1.CurrentY = Picture1.CurrentY Picture1.TextHeight("W") ' canh lai
20.
Picture1.CurrentX = 0

21.
Picture1.Print ii
22.
End If
23.
Next
24.
Next
25.
For i = 0 To 1000 Step 100
26.
Picture1.Line (i, 0)-(i, 0.1), vbBlue ' Ðánh
dâ'u
27.
Picture1.CurrentX = Picture1.CurrentX Picture1.TextWidth("aa")
28.
Picture1.CurrentY = Picture1.CurrentY +
Picture1.TextHeight("a")
29.
Picture1.Print i
30.
Next i
31.
' ve duong bieu dien ham so
32.
'-----------y1
33.
Picture1.ForeColor = vbYellow
34.
X = 1

35.
y = Log(1.5 * X) / td
36.
Picture1.CurrentX = X
37.
Picture1.CurrentY = y
38.
For X = 1 To 1000
39.
y = Log(1.5 * X) / td
40.
Picture1.Line -(X, y)
41.
Next X
42.
'-------y2
43.
Picture1.ForeColor = vbRed
44.
X = 1
45.
y = Log(240000 / X) / td
46.
Picture1.CurrentX = X
47.
Picture1.CurrentY = y
48.
For X = 1 To 1000
49.
y = Log(240000 / X) / td

50.
Picture1.Line -(X, y)
51.
Next X
52.
'-----Y = y1 + y2
53.
Picture1.ForeColor = vbBlue
54.
X = 1
55.
y = Log(80000 + (240000 / X) + (1.5 * X)) / td
56.
Picture1.CurrentX = X
57.
Picture1.CurrentY = y
58.
For X = 1 To 1000
59.
y = Log(80000 + (240000 / X) + (1.5 * X)) /
td
60.
Picture1.Line -(X, y)
61.
Next X
62.
End Sub
63.

Tạo ListBox và ComboBox... ngược

1. Private Declare Function GetWindowLong Lib "user32" Alias
"GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long)
As Long
2. Private Declare Function SetWindowLong Lib "user32" Alias
"SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long,
ByVal dwNewLong As Long) As Long
3. Private Const GWL_STYLE = (-16)
4. Private Const GWL_EXSTYLE = (-20)
5.
6. Private Sub Form_Load()
7. 'Test
8. Dim i As Byte
9. For i = 0 To 10
10.
Combo1.AddItem "Dong thu " & i
11.
List1.AddItem "Dong thu " & i
12.
Next
13.
14.
15.
Dim m_Style_Cmb As Long
16.
m_Style_Cmb = GetWindowLong(Combo1.hwnd, GWL_EXSTYLE)
17.
m_Style_Cmb = m_Style_Cmb Or &H3000
18.

Call SetWindowLong(Combo1.hwnd, GWL_EXSTYLE,
m_Style_Cmb)
19.
20.
Dim m_Style_Lst As Long
21.
m_Style_Lst = GetWindowLong(List1.hwnd, GWL_EXSTYLE)
22.
' m_Style_Lst = m_Style Or &H4000 'Chu canh lề Trái
23.
m_Style_Lst = m_Style_Lst Or &H5000 'Chu canh lề Phải
24.
Call SetWindowLong(List1.hwnd, GWL_EXSTYLE,
m_Style_Lst)
25.
End Sub
26.

Tạo form bằng Code
1. Option Explicit
2. Declare Function CreateWindowEx Lib "user32" Alias
"CreateWindowExA" (ByVal dwExStyle As Long, _
3.
lpClassName As String, _
4.
lpWindowName As String, _
5.
dwStyle As Long, _
6.
As Long, _

7.
As Long, _
8.
nWidth As Long, _
9.
nHeight As Long, _
10.
ByVal hWndParent As Long, _
11.
ByVal hMenu As Long, _
12.
ByVal hInstance As Long, _

ByVal
ByVal
ByVal
ByVal x
ByVal y
ByVal
ByVal


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.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.

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
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Type PAINTSTRUCT
hdc As Long
fErase As Long
rcPaint As RECT
fRestore As Long
fIncUpdate As Long
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.
227.

End Function