none
如何编写按钮 RRS feed

  • 常规讨论

  • 让大家用VB了解Windows


    Option Explicit


    '========================================================================================
    ' Form 1.05
    ' 代码编号:000001
    '========================================================================================
    ' 作者:江建
    ' 网址: http://vbcc.126.com[/url]
    ' 电子邮件: vbcc@sohu.com
    ' 版权所有© 2001-2002 江建及其两位女友
    '========================================================================================


    Dim lpwcx As WNDCLASSEX
    Dim RegClass As Long


    Public 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 Function


    Private 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
    SetPosition hWnd
    Case WM_DESTROY
    Call PostQuitMessage(0)
    End Select
    MainWinProc = DefWindowProc(hWnd, uMsg, wParam, lParam)
    End Function


    Public 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 '卸载注册类 很重要如果不卸载的话你自己试试就知道了 smile.gif
    End Function


    Public Sub Main()
    '程序开始
    CreateMainForm "VB API For Window", 500, 388
    End Sub
    Public Sub SetPosition(hWnd As Long)
    '功能:设置窗体在屏幕中间
    '参数:hWnd 窗体句柄
    Dim DesktopRect As RECT, hWndDesktop As Long

    hWndDesktop = GetDesktopWindow '取桌面句柄
    GetWindowRect hWndDesktop, DesktopRect '返回桌面 Rect
    MoveWindow hWnd, (DesktopRect.Right - 500) / 2, (DesktopRect.Bottom - 388) / 2, 500, 388, 1
    End Sub
    2009年5月27日 8:11