同上.
解决方案 »
- WebBrowser控件问题,请求帮助
- 关于 SendMessage 使用的问题(在Text1中,转到指定行、设置光标位置、返回光标位置、获得光标所在行的位置)
- 还是画图问题,为什么发了这么多次没人给帮忙呢?
- 如何获得ACCESS表的主键名,主键是在表的设计界面中指定的。求SQL。
- 添加数据的时候,游标指向什么地方?这个问题应该很简单吧
- 这么长的语句怎么弄啊?
- 如何对多个字符串数据排序?谢
- 解决了一个打包问题,又出来一个,请大家看看!
- 各位高手,请问如何用vb实现透明的图像??(我想做一个打雪仗的小游戏)
- █████大家看看我的软件,UP有分█████
- 有没有方法在richtext中插入gif动画和各种图片
- 问个交换的问题
'========================================================================================
' Button Control 1.05
' 代码编号:000002
'========================================================================================
' 作者:江建
' 网址: http://vbcc.126.com
' 电子邮件: [email protected]
' 版权所有(C) 2001-2002 江建及其两位女友
'========================================================================================
' 如果要作出更复杂的按钮请使用 BS_OWNERDRAW 风格 以后讲到
' 最多为 88 个 Button
' Button Style
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 CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal H As Long, ByVal W As Long, ByVal E As Long, ByVal O As Long, ByVal W As Long, ByVal I As Long, ByVal u As Long, ByVal S As Long, ByVal C As Long, ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, ByVal PAF As Long, ByVal F As String) As Long
Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
'Button Style
Private Const BS_DEFPUSHBUTTON = &H1
Private Const BS_ICON = &H40
Private Const BS_BITMAP = &H80
Private Const BS_TEXT = &H0
Private Const WM_SETFONT = &H30
Private Const WS_CHILD = &H40000000
Private Const WS_VISIBLE = &H10000000
Private Const WS_TABSTOP = &H10000'CreateFont
Private Const DEFAULT_CHARSET = 1
Private Const OUT_DEFAULT_PRECIS = 0
Private Const CLIP_DEFAULT_PRECIS = 0
Private Const DEFAULT_QUALITY = 0
Private Const DEFAULT_PITCH = 0
Private Const FF_DONTCARE = 0'LoadImage
Private Const LR_LOADFROMFILE = &H10
Private Const LR_LOADMAP3DCOLORS = &H1000'Button Message
Private Const BM_SETIMAGE = &HF7
'BM_SETIMAGE
Private Const IMAGE_BITMAP = 0
Private Const IMAGE_ICON = 1Private I As Long ' 句柄记数器
Private hWndButton(88) As LongPublic Function CreateButton(hwnd As Long, ID&, X&, Y&, nWidth&, nHeight&, Optional strText As String, Optional hWndFont As Long, Optional Style As Long = 1, Optional Default As Boolean = False)
' 功能:创建按钮
' 参数:| hWnd 父窗口的句柄 | ID 控制 ID | X,Y 按钮位置 | nWidth 按钮宽度 | nHeight 按钮高度 |
' 参数:| strText 按钮文字 | hWndFont 字体的句柄 | Style 按钮风格 | Default 是否为确省为默认按钮 |
Dim hBmp As Long
Dim hIcon As Long
Select Case Style
Case Is = 1
Style = BS_TEXT
Case Is = 2
Style = BS_BITMAP
hBmp = LoadImage(0, App.Path & "\button.bmp", IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE)
Case Is = 3
Style = BS_ICON
hIcon = LoadImage(0, App.Path & "\button.ico", IMAGE_ICON, 0, 0, LR_LOADFROMFILE)
End Select
If Default Then: Style = Style Or BS_DEFPUSHBUTTON
hWndButton(I) = CreateWindowEx(0&, "BUTTON", strText, Style Or WS_CHILD Or WS_VISIBLE _
Or WS_TABSTOP, X, Y, nWidth, nHeight, hwnd, ID, App.hInstance, 0)
Call SendMessage(hWndButton(I), WM_SETFONT, hWndFont, ByVal 0)
'设置按钮图片与图标
Select Case Style
Case BS_BITMAP
Call SendMessage(hWndButton(I), BM_SETIMAGE, IMAGE_BITMAP, ByVal hBmp)
Case BS_ICON
Call SendMessage(hWndButton(I), BM_SETIMAGE, IMAGE_ICON, ByVal hIcon)
End Select
I = I + 1
End FunctionProperty Get hwnd(hWndNumber As Long) As Long
' 功能:返回按钮句柄(注意:第一个按钮的句柄数为 0)
' 参数:| I 句柄记数器 |
hwnd = hWndButton(hWndNumber)
End Property
Private Sub Class_Initialize()
I = 0 ' 初始句柄记数器
End SubPrivate Sub Class_Terminate()
' 破坏所有被创建的按钮
Dim N As Long
If hWndButton(0) <> 0 Then
For N = 0 To I - 1
DestroyWindow hWndButton(N)
hWndButton(N) = 0
Next
End If
End SubPublic Function hFont(Optional nHeight As Long = 12, Optional fdwUnderline As Long = 0, Optional lpszFace As String = "宋体") As Long
'创建字体 默认大小为 12 字体为 宋体
'返回值:字体的句柄
hFont = CreateFont(nHeight, 0, 0, 0, 400, 0, fdwUnderline, 0, DEFAULT_CHARSET, _
OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, _
DEFAULT_PITCH Or FF_DONTCARE, lpszFace)
End Function
' Button Control 1.05
' 代码编号:000002
'========================================================================================
' 作者:江建
' 网址: http://vbcc.126.com
' 电子邮件: [email protected]
' 版权所有(C) 2001-2002 江建及其两位女友
'========================================================================================
Dim lpwcx As WNDCLASSEX
Dim RegClass As Long
Dim Button As clsButtonPublic Function RegWinClass(lpClassName As String)
'功能:注册窗口类
'参数:lpClassName 类名
With lpwcx
.cbSize = Len(lpwcx)
.Style = CS_HREDRAW Or CS_VREDRAW Or CS_DBLCLKS
.lpszClassName = lpClassName
.hInstance = App.hInstance
.cbClsExtra = 0
.cbWndExtra = 0
.hCursor = LoadCursor(0, IDC_ARROW)
.lpfnWndProc = FnPtrToLong(AddressOf MainWinProc)
.lpszMenuName = 0
.hbrBackground = COLOR_WINDOW
End With
Call RegisterClassEx(lpwcx)
End FunctionPrivate Function MainWinProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'这里是我们写程序最重要的部分 相当于 VB 中的事件
Select Case uMsg
Case WM_CREATE
Set Button = New clsButton
SetPosition hwnd
'创建按钮
Button.CreateButton hwnd, 1, 100, 130, 55, 22, "确定", Button.hFont, , True
Button.CreateButton hwnd, 2, 231, 130, 55, 22, , , 2
Button.CreateButton hwnd, 3, 100, 160, 73, 26, , , 3
Button.CreateButton hwnd, 4, 231, 160, 73, 26, "关闭", Button.hFont
Case WM_COMMAND '由于没有菜单所以不用区分 ID 等于vb按钮的Click事件
Select Case wParam
Case Is = 1
MessageBoxEx hwnd, "你按下了确定按钮", "信息", vbInformation, 0
Case Is = 2
MessageBoxEx hwnd, "你按下了图片按钮", "信息", vbInformation, 0
Case Is = 3
MessageBoxEx hwnd, "你按下了图标按钮", "信息", vbInformation, 0
Case Is = 4
SendMessage hwnd, WM_CLOSE, 0, ByVal 0
End Select
Case WM_CLOSE
Set Button = Nothing
Call DestroyWindow(hwnd)
Case WM_DESTROY
Call PostQuitMessage(0) '发送 0 参见 GetMessage
End Select
MainWinProc = DefWindowProc(hwnd, uMsg, wParam, lParam)
End FunctionPublic Function FnPtrToLong(ByVal lngFnPtr As Long) As Long
FnPtrToLong = lngFnPtr '这个东东是微软定义的
End Function
Public Function CreateMainForm(title As String, nWidth As Long, nHeight As Long) As Long
'功能:创建窗体
'参数:title 窗体的标题文字 | nWidth 宽度 | nHeight 高度
Dim hWndMain As Long
Dim lpMsg As MSG
Call RegWinClass("Form") '注册窗口类
'创建窗体并返回其句柄
hWndMain = CreateWindowEx(0, "Form", title, WS_OVERLAPPEDWINDOW, 0, 0, nWidth, nHeight, 0, 0, App.hInstance, ByVal 0&)
'如果窗体创建成功则显示它并进如消息循环
If hWndMain <> 0 Then
ShowWindow hWndMain, SW_NORMAL
Do While GetMessage(lpMsg, 0, 0, 0)
TranslateMessage lpMsg
DispatchMessage lpMsg
Loop
End If
UnregisterClass "Form", App.hInstance '卸载注册类 很重要如果不卸载的话你自己试试就知道了 :)
End Function
Public Sub Main()
'程序开始
CreateMainForm "VB API For Button Control", 430, 388
End SubPublic Sub SetPosition(hwnd As Long)
'将窗体移动到屏幕中间
Dim DesktopRect As RECT, hWndDesktop As Long
hWndDesktop = GetDesktopWindow '取桌面句柄
GetWindowRect hWndDesktop, DesktopRect '返回桌面 Rect
MoveWindow hwnd, (DesktopRect.Right - 430) / 2, (DesktopRect.Bottom - 300) / 2, 430, 300, 1
End Sub
Public 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
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 LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public 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
Public Declare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function MessageBoxEx Lib "user32" Alias "MessageBoxExA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal uType As Long, ByVal wLanguageId As Long) As Long
Public Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long' Message
Public Declare Function GetMessage Lib "user32" Alias "GetMessageA" (lpMsg As MSG, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long
Public Declare Function TranslateMessage Lib "user32" (lpMsg As MSG) As Long
Public Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageA" (lpMsg As MSG) As Long
Public Declare Function RegisterClassEx Lib "user32" Alias "RegisterClassExA" (pcWndClassEx As WNDCLASSEX) As Integer
Public 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
Public Declare Sub PostQuitMessage Lib "user32" (ByVal nExitCode 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 GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Public Declare Function GetDesktopWindow Lib "user32" () As LongPublic Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long' Class Reg And Del
Public Declare Function UnregisterClass Lib "user32" Alias "UnregisterClassA" (ByVal lpClassName As String, ByVal hInstance As Long) As Long'---------------------------------------------------------
'CreateWindowEx And Dialog Window Style
'--------------------------------------------------------
Public Const WS_MINIMIZEBOX = &H20000
Public Const WS_MAXIMIZEBOX = &H10000
Public Const WS_CAPTION = &HC00000 ' WS_BORDER Or WS_DLGFRAME
Public Const WS_OVERLAPPED = &H0&
Public Const WS_THICKFRAME = &H40000Public Const WS_CHILD = &H40000000
Public Const WS_VISIBLE = &H10000000
Public Const WS_TABSTOP = &H10000
Public Const WS_DISABLED = &H8000000
Public Const WS_SYSMENU = &H80000
Public Const WS_POPUP = &H80000000
Public Const WS_GROUP = &H20000Public Const WS_OVERLAPPEDWINDOW = (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)' Window Message
Public Const WM_TIMER = &H113
Public Const WM_USER = &H400
Public Const WM_NOTIFY = &H4E
Public Const WM_MOUSEMOVE = &H200
Public Const WM_RBUTTONUP = &H205
Public Const WM_COMMAND = &H111
Public Const WM_ENABLE = &HA
Public Const WM_INITDIALOG = &H110
Public Const WM_PAINT = &HF
Public Const WM_CLOSE = &H10
Public Const WM_CREATE = &H1
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_RBUTTONDBLCLK = &H206
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_SIZE = &H5Public Const WM_MEASUREITEM = &H2C
Public Const WM_DRAWITEM = &H2B
Public Const WM_INITMENUPOPUP = &H117
Public Const WM_DESTROY = &H2' WNDCLASSEX
Public Const CS_HREDRAW = &H2
Public Const CS_VREDRAW = &H1
Public Const CS_DBLCLKS = &H8' Window Color
Public Const COLOR_WINDOW = 5' DefSystem Cursor
Public Const IDC_HAND = 32649&' ShowWindow
Public Const SW_NORMAL = 1Public Const IMAGE_ICON = 1' DefSystem Cursor
Public Const IDC_ARROW = 32512&' Reg Window
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 TypePublic Type POINTAPI
X As Long
Y As Long
End TypePublic Type MSG
hwnd As Long
message As Long
wParam As Long
lParam As Long
Times As Long
pt As POINTAPI
End TypePublic Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type