怎样用代码“画”窗体????

guxiaoyu2002 2005-07-10 08:56:16
大侠帮忙!!!
...全文
94 7 打赏 收藏 转发到动态 举报
写回复
用AI写文章
7 条回复
切换为时间正序
请发表友善的回复…
发表回复
upsuper 2005-07-11
  • 打赏
  • 举报
回复
这个代码连消息循环都建立了~强大~
guxiaoyu2002 2005-07-11
  • 打赏
  • 举报
回复
哇!!!那么多代码!!
可不可以不用API啊?
比如createobject之类的?
唐古拉山 2005-07-10
  • 打赏
  • 举报
回复
这个代码演示的是模仿VC建立窗体的大致过程,对了解窗体的"诞生"还是有用的

唐古拉山 2005-07-10
  • 打赏
  • 举报
回复
这个是我修整了以前的一个代码

唐古拉山 2005-07-10
  • 打赏
  • 举报
回复
这里我贴出源代码,使用API建立一个窗体,并在窗体上加入两个控件:

建立一个新的工程,并移除所有窗体(Form),再新建一个标准模块,在模块中加入以下代码,按F5:

Public Declare Function RegisterClass Lib "user32" Alias "RegisterClassA" (Class As WNDCLASS) As Long
Public Declare Function UnregisterClass Lib "user32" Alias "UnregisterClassA" (ByVal lpClassName As String, ByVal hInstance As Long) As Long
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 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 ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Any) As Long
Public Declare Function LoadIcon Lib "user32" Alias "LoadIconA" (ByVal hInstance As Long, ByVal lpIconName As String) As Long
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 SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Public Declare Sub PostQuitMessage Lib "user32" (ByVal nExitCode As Long)

Public 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

Public Type POINTAPI
x As Long
y As Long
End Type

Public Type Msg
hwnd As Long
message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type

Public Const CS_VREDRAW = &H1
Public Const CS_HREDRAW = &H2

Public Const CW_USEDEFAULT = &H80000000

Public Const ES_MULTILINE = &H4&

Public Const WS_BORDER = &H800000
Public Const WS_CHILD = &H40000000
Public Const WS_OVERLAPPED = &H0&
Public Const WS_CAPTION = &HC00000
Public Const WS_SYSMENU = &H80000
Public Const WS_THICKFRAME = &H40000
Public Const WS_MINIMIZEBOX = &H20000
Public Const WS_MAXIMIZEBOX = &H10000
Public Const WS_OVERLAPPEDWINDOW = (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)

Public Const WS_EX_CLIENTEDGE = &H200&

Public Const COLOR_WINDOW = 5

Public Const WM_DESTROY = &H2
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202

Public Const IDC_ARROW = 32512&
Public Const IDI_APPLICATION = 32512&

Public Const GWL_WNDPROC = (-4)
Public Const SW_SHOWNORMAL = 1

Public Const MB_OK = &H0&
Public Const MB_ICONEXCLAMATION = &H30&

Public Const gClassName = "CPureAPIWindow"
Public Const gAppName = "使用API建立窗体示例"

Public gButOldProc As Long
Public gHwnd As Long, gButtonHwnd As Long, gEditHwnd As Long


Public Sub Main()
Dim wMsg As Msg
If RegisterWindowClass = False Then Exit Sub
If CreateWindows Then
Do While GetMessage(wMsg, 0&, 0&, 0&)
Call TranslateMessage(wMsg)
Call DispatchMessage(wMsg)
Loop
End If
Call UnregisterClass(gClassName$, App.hInstance)
End Sub

Public Function RegisterWindowClass() As Boolean
Dim wc As WNDCLASS
wc.style = CS_HREDRAW Or CS_VREDRAW
wc.lpfnwndproc = GetAddress(AddressOf WndProc)
wc.hInstance = App.hInstance
wc.hIcon = LoadIcon(0&, IDI_APPLICATION)
wc.hCursor = LoadCursor(0&, IDC_ARROW)
wc.hbrBackground = COLOR_WINDOW
wc.lpszClassName = gClassName$
RegisterWindowClass = RegisterClass(wc) <> 0
End Function

Public Function CreateWindows() As Boolean
'建立主窗体:
gHwnd& = CreateWindowEx(0&, gClassName$, gAppName$, WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, 300, 150, 0&, 0&, App.hInstance, ByVal 0&)
'创建一个按钮:
gButtonHwnd& = CreateWindowEx(0&, "Button", "单击这里", WS_CHILD, 58, 90, 85, 25, gHwnd&, 0&, App.hInstance, 0&)
'创建一个(WS_EX_CLIENTEDGE、ES_MULTILINE风格的TextBox
gEditHwnd& = CreateWindowEx(WS_EX_CLIENTEDGE, "Edit", "by 唐博士" & vbCrLf & "这是个使用API建立的窗体", WS_CHILD Or ES_MULTILINE, 0&, 0&, 300, 80, gHwnd&, 0&, App.hInstance, 0&)
'"Button ","Edit"系统中已经注册过了所以这里直接用,创建完别忘了显示出来否则是隐藏的
Call ShowWindow(gHwnd&, SW_SHOWNORMAL)
Call ShowWindow(gButtonHwnd&, SW_SHOWNORMAL)
Call ShowWindow(gEditHwnd&, SW_SHOWNORMAL)
'记下按钮处理过的当前所在地址
gButOldProc& = GetWindowLong(gButtonHwnd&, GWL_WNDPROC)
'指向新的地址
Call SetWindowLong(gButtonHwnd&, GWL_WNDPROC, GetAddress(AddressOf ButtonWndProc))
CreateWindows = (gHwnd& <> 0)
End Function

Public Function WndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim strTemp As String
'处理了WM_DESTROY消息
Select Case uMsg&
Case WM_DESTROY:
Call PostQuitMessage(0&)
End Select
WndProc = DefWindowProc(hwnd&, uMsg&, wParam&, lParam&)
End Function

'Button的处理过程
Public Function ButtonWndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case uMsg&
Case WM_LBUTTONUP:
Call MessageBox(gHwnd&, "呵呵", App.Title, MB_OK Or MB_ICONEXCLAMATION)
End Select
ButtonWndProc = CallWindowProc(gButOldProc&, hwnd&, uMsg&, wParam&, lParam&)
End Function

Public Function GetAddress(ByVal lngAddr As Long) As Long
GetAddress = lngAddr&
End Function




Mars.CN 2005-07-10
  • 打赏
  • 举报
回复
??
异型窗体
我有研究呀
upsuper 2005-07-10
  • 打赏
  • 举报
回复
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
用这个API~具体用法,网上到处都是~

7,763

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧