VB入门技巧多例4.docx

1、VB入门技巧多例410.在状态栏显示无边框窗体图标。 1 Private Declare Function SetWindowLong Lib user32 Alias SetWindowLongA (ByVal hWnd _ As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long 2 Private Declare Function GetWindowLong Lib user32 Alias GetWindowLongA (ByVal hWnd _ As Long, ByVal nIndex As Long) As L

2、ong 3 Const GWL_STYLE = (-16&) 4 Const WS_SYSMENU = &H80000 5 Private Sub Form_Load() 6 Make Forms Icon visible in the taskbar 7 SetWindowLong Me.hWnd, GWL_STYLE, GetWindowLong(Me.hWnd, GWL_STYLE) Or WS_SYSMENU 8 End Sub11. 记录窗体的大小及位置和程序中的一些设置1 Private Sub Form_Load() 2 Me.Width = GetSetting(App.Tit

3、le, Me.Name, Width, 7200) 3 Me.Height = GetSetting(App.Title, Me.Name, Height, 6300) 4 Me.Top = GetSetting(App.Title, Me.Name, Top, 100) 5 Me.Left = GetSetting(App.Title, Me.Name, Left, 100) 6 Check1.Value = GetSetting(App.Title, Me.Name, check1, 0) 7 End Sub 8 Private Sub Form_Unload(Cancel As Inte

4、ger) 9 Call SaveSetting(App.Title, Me.Name, Width, Me.Width) 10 Call SaveSetting(App.Title, Me.Name, Height, Me.Height) 11 Call SaveSetting(App.Title, Me.Name, Top, Me.Top) 12 Call SaveSetting(App.Title, Me.Name, Left, Me.Left) 13 Call SaveSetting(App.Title, Me.Name, check1, Check1.Value) 14 End Sub

5、13. 无边框窗体的右键菜单 设计无边框窗体时，如果使用菜单编辑器，就会自动改变成有边框的窗体，此时，可以在另外一个窗体中（一般情况下你的程序应该不止一个窗体的吧，如果真的只有一个，可以利用其他人写的类，添加右键）编辑菜单（VISIBLE属性设为FALSE），然后在本窗体中调用。调用形式如下： 1 Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 2 If Button = 2 Then 3 PopupMenu Form2.mymenu 4 End If 5 End

6、 Sub14.创建圆角无边框窗体1 Private Declare Function CreateRoundRectRgn Lib gdi32 (ByVal X1 As Integer, ByVal Y1 _ As Integer, ByVal X2 As Integer, ByVal Y2 As Integer, ByVal x3 As Integer, ByVal y3 As _ Integer) As Long 2 Private Declare Function DeleteObject Lib gdi32 (ByVal hObject As Long) As Long 3 Priva

7、te Declare Function SetWindowRgn Lib user32 (ByVal hwnd As Long, ByVal hrgn As _ Long, ByVal bRedraw As Boolean) As Long 4 Private Sub Form_Load() 5 hround = CreateRoundRectRgn(0, 0, ScaleX(Form1.ScaleWidth, vbTwips, vbPixels), _ ScaleY(Form1.ScaleHeight, vbTwips, vbPixels), 20, 20) 6 SetWindowRgn M

8、e.hwnd, hround, True 7 DeleteObject hround 8 End Sub15.拖动没有标题栏的窗体 方法一： 1 Private Declare Function ReleaseCapture Lib user32 () As Long 2 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 3 Privat

9、e Const HTCAPTION = 2 4 Private Const WM_NCLBUTTONDOWN = &HA1 5 Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 6 Dim ncl As Long 7 Dim rel As Long 8 If Button = 1 Then 9 i = ReleaseCapture() 10 ncl = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0) 11 End

10、If 12 End Sub方法二：回调函数 1 module: 2 Public Const GWL_WNDPROC = (-4) 3 Public Const WM_NCHITTEST = &H84 4 Public Const HTCLIENT = 1 5 Public Const HTCAPTION = 2 6 Declare Function CallWindowProc Lib user32 Alias CallWindowProcA (ByVal _ lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVa

11、l wParam As Long, _ ByVal lParam As Long) As Long 7 Declare Function GetWindowLong Lib user32 Alias GetWindowLongA (ByVal hWnd As _ 8 Long, ByVal nIndex As Long) As Long 9 Declare Function SetWindowLong Lib user32 Alias SetWindowLongA (ByVal hWnd As _ 10 Long, ByVal nIndex As Long, ByVal dwNewLong A

12、s Long) As Long 11 Public prevWndProc As Long 12 Function WndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal _Param As Long) As Long 13 WndProc = CallWindowProc(prevWndProc, hWnd, Msg, wParam, lParam) 14 If Msg = WM_NCHITTEST And WndProc = HTCLIENT Then 15 WndProc = HTCAPTION

13、 16 End If 17 End Function 18 窗体中: 19 Private Sub Form_Load() 20 prevWndProc = GetWindowLong(Me.hWnd, GWL_WNDPROC) 21 SetWindowLong Me.hWnd, GWL_WNDPROC, AddressOf WndProc 22 End Sub 23 Private Sub Form_Unload(Cancel As Integer) 24 SetWindowLong Me.hWnd, GWL_WNDPROC, prevWndProc 25 End Sub16. 半透明窗体1

14、 Private Declare Function SetLayeredWindowAttributes Lib user32 (ByVal hwnd As Long, _ ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long 2 Private Const WS_EX_LAYERED = &H80000 3 Private Const LWA_ALPHA = &H2 4 Private Const GWL_EXSTYLE = (-20) 5 Private Declare Function GetW

15、indowLong Lib user32 Alias GetWindowLongA (ByVal _ 6 hwnd As Long, ByVal nIndex As Long) As Long 7 Private Declare Function SetWindowLong Lib user32 Alias SetWindowLongA (ByVal _ 8 hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long 9 Private Sub Form_Load() 10 Dim rtn As Long 11 rt

16、n = GetWindowLong(Me.hwnd, GWL_EXSTYLE) 取的窗口原先的样式 12 rtn = rtn Or WS_EX_LAYERED 使窗体添加上新的样式WS_EX_LAYERED 13 SetWindowLong Me.hwnd, GWL_EXSTYLE, rtn 把新的样式赋给窗体 14 SetLayeredWindowAttributes Me.hwnd, 0, 200, LWA_ALPHA 15 End Sub17.开机启动（函数及常数声明略） 1 Private Sub Form_Load() 2 Dim hKey As Long, SubKey As St

17、ring, Exe As String 3 SubKey = SoftwareMicrosoftWindowsCurrentVersionRun 4 Exe = 可执行文件的路径 5 RegCreateKey HKEY_CURRENT_USER, SubKey, hKey 6 RegSetvalueEx hKey, autorun, 0, REG_SZ, ByVal Exe,LenB(StrConv(Exe, vbFromUnicode) + 1 7 RegCloseKey hKey 8 End Sub18.关闭显示器1 Private Declare Function SendMessage

18、 Lib user32 Alias SendMessageA (ByVal hwnd _ 2 As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long 3 Const WM_SYSCOMMAND = &H112& 4 Const SC_MONITORPOWER = &HF170& 5 Private Sub Command1_Click() 6 SendMessage Me.hwnd, WM_SYSCOMMAND, SC_MONITORPOWER, ByVal 2& 关闭显示器 7 End Sub 8 P

19、rivate Sub Command2_Click() 9 SendMessage Me.hwnd, WM_SYSCOMMAND, SC_MONITORPOWER, ByVal -1& 打开显示器 10 End Sub19. 在程序结束时自动关闭由SHELL打开的程序。 1 Private Const PROCESS_QUERY_INFORMATION = &H400 关闭由SHELL函数打开的文件 2 Private Const PROCESS_TERMINATE = &H1 3 Private Declare Function OpenProcess Lib kernel32 (ByVal

20、 dwDesiredAccess As Long, _ ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long 4 Private Declare Function TerminateProcess Lib kernel32 (ByVal hProcess As Long, _ 5 ByVal uExitCode As Long) As Long 6 Dim ProcessId As Long 7 Private Sub Command1_Click() 8 ProcessId = Shell(notepad.exe.,

21、 vbNormalFocus) 9 End Sub 10 Private Sub Form_Unload(Cancel As Integer) 11 Dim hProcess As Long 12 hProcess = OpenProcess(PROCESS_TERMINATE Or PROCESS_QUERY_INFORMATION, False, _ ProcessId) 13 Call TerminateProcess(hProcess, 3838) 14 End Sub20. 关闭、重启计算机 1 Public Declare Function ExitWindowsEx Lib us

22、er32 Alias ExitWindowsEx (ByVal _ 2 uFlags As Long, ByVal dwReserved As Long) As Long 3 ExitWindowsEx 1，0 关机 4 ExitWindowsEx 0，1 重新启动21.显示关机提示框1 Private Declare Function SHRestartSystemMB Lib shell32 Alias #59 (ByVal hOwner _ 2 As Long, ByVal sExtraPrompt As String, 3 4 ByVal uFlags As Long) As Long

23、 5 Const EWX_LOGOFF = 0 6 Const EWX_SHUTDOWN = 1 7 Const EWX_REBOOT = 2 8 Const EWX_FORCE = 4 9 Const EWX_POWEROFF = 8 10 Private Sub Command1_Click() 11 SHRestartSystemMB Me.hWnd, PROMPT, EWX_LOGOFF 12 End Sub22.右键托盘图标后必须电击他才可以消失，怎么办？ Case WM_RBUTTONUP 鼠标在图标上右击时弹出菜单 SetForegroundWindow Me.hwnd Me.P

24、opupMenu mnuTray 加一句 SetForegroundWindow Me.hwnd 23. 将progressbar嵌入statusbar中1 Private Declare Function SetParent Lib user32 (ByVal hWndChild As Long, ByVal _ hWndNewParent As Long) As Long 2 Private Sub Command1_Click() 3 With ProgressBar1 4 .Max = 1000 5 Dim i As Integer 6 For i = 1 To 1000 7 .Val

25、ue = i 8 Next i 9 End With 10 End Sub 11 Private Sub Form_Load() 12 ProgressBar1.Appearance = ccFlat 13 SetParent ProgressBar1.hWnd, StatusBar1.hWnd 14 ProgressBar1.Left = StatusBar1.Panels(1).Left 15 ProgressBar1.Top = 100 16 ProgressBar1.Width = StatusBar1.Panels(1).Width - 50 17 ProgressBar1.Heig

26、ht = StatusBar1.Height - 150 18 End Sub 相对位置你可以自己再调一下24.使你的程序界面具有XP风格 产生一个和你的可执行程序同名的后缀为exe.manifest的文件，并和可执行文件放在同一路径中。 代码中加入: 1 Private Declare Sub InitCommonControls Lib comctl32.dll () 2 Private Sub Form_Initialize() 3 InitCommonControls 4 End Sub注意： 1 工具栏控件一定要用Microsoft Windows Common Controls 5

27、.0，而不要用Microsoft Windows Common Controls 6.0。因为此 InitCommonControls API函数是位于comctl32.dll（Microsoft Windows Common Controls 5.0控件的动态链接库中）。 2 放在FRAME控件中的单远按钮有些“麻烦”！为了解决此问题，可以将单选按钮放在PICTURE控件中（以PICTURE控件作为容器），再将 PICTURE控件放在FRAME控件中，就可以了。 3 必须编译之后才能看到效果 exe.manifest文件中的内容，可用notepad编辑。 1 2 3 9 Your appli

28、cation description here. 10 11 12 20 21 22 25.如何打印PictureBox中的所有控件 添加另外一个PictureBox，然后： 1 Private Const WM_PAINT = &HF 2 Private Const WM_PRINT = &H317 3 Private Const PRF_CLIENT = &H4& 4 Private Const PRF_CHILDREN = &H10& 5 Private Const PRF_OWNED = &H20& 6 Private Const PHYSICALOFFSETX As Long = 1

29、12 7 Private Const PHYSICALOFFSETY As Long = 113 8 Private Declare Function SendMessage Lib user32 Alias SendMessageA (ByVal hwnd _ 9 As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 10 Private Declare Function GetDeviceCaps Lib gdi32 (ByVal hdc As Long, ByVal nindex _ 11 As Long) As Long 12 private Sub Form_Load() 13 Picture1.AutoRedraw = True 14 Picture2.AutoRedraw = True 15 Picture2.Bo