创建输入法窗口以下代码演示用VB创建IME窗口module:Option ExplicitPublic Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Form1:Option ExplicitPrivate 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 Const WM_CREATE = &H1
Private Const WS_EX_TOPMOST = &H8&
Private Const WS_EX_LEFT = &H0
Private Const WS_EX_LTRREADING = &H0
Private Const WS_EX_RIGHTSCOLLBAR = &H0
Private Const WS_BORDER = &H800000
Private Const WS_POPUP = &H80000000
Private Const WS_DISABLED = &H8000000
Private Const WS_CLIPSIBLINGS = &H4000000
Private Const WS_OVERLAPPED = &H0&Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long)
As LongPrivate Const SW_NORMAL = 1
Private Const SW_PARENTOPENING = 3
Private Const SW_SHOW = 5Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As LongPrivate Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As LongPrivate Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal
X2 As Long, ByVal Y2 As Long) As LongPrivate Declare Function FrameRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal
HBRUSH As Long) As LongPrivate Declare Function FillRgn Lib "gdi32" (ByVal hdc As Long, ByVal HRGN As Long, ByVal
HBRUSH As Long) As LongPrivate Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As LongPrivate Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As LongDim HwndNew As LongPrivate Sub Form_Load()
Dim LREC As RECT
Dim Hrect As Long
Dim Hwdc As Long
Dim WCOLOR As Long
Dim HBRUSH As Long Dim HRGN As Long HwndNew = CreateWindowEx(WS_EX_TOPMOST, "IME", "New", WS_POPUP Or WS_DISABLED Or WS_CLIPSIBLINGS Or WS_OVERLAPPED, _
0, 0, 200, 200, Me.hwnd, 0, 0, WM_CREATE)
Debug.Print HwndNew ShowWindow HwndNew, SW_NORMAL Hrect = GetClientRect(HwndNew, LREC) Hwdc = GetDC(HwndNew) WCOLOR = RGB(255, 255, 255) HRGN = CreateRectRgn(LREC.Left, LREC.Top, LREC.Right, LREC.Bottom) HBRUSH = CreateSolidBrush(WCOLOR) FillRgn Hwdc, HRGN, HBRUSHEnd SubPrivate Sub Form_Unload(Cancel As Integer)
DestroyWindow HwndNew
End Sub
以上代码来自： SourceCode Explorer(源代码数据库)
复制时间： 2002-06-06 14:18:13
当前版本： 1.0.701
作者： Shawls
个人主页： Http://Shawls.Yeah.Net
E-Mail： [email protected]
QQ： 9181729
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Form1:Option ExplicitPrivate 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 Const WM_CREATE = &H1
Private Const WS_EX_TOPMOST = &H8&
Private Const WS_EX_LEFT = &H0
Private Const WS_EX_LTRREADING = &H0
Private Const WS_EX_RIGHTSCOLLBAR = &H0
Private Const WS_BORDER = &H800000
Private Const WS_POPUP = &H80000000
Private Const WS_DISABLED = &H8000000
Private Const WS_CLIPSIBLINGS = &H4000000
Private Const WS_OVERLAPPED = &H0&Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long)
As LongPrivate Const SW_NORMAL = 1
Private Const SW_PARENTOPENING = 3
Private Const SW_SHOW = 5Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As LongPrivate Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As LongPrivate Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal
X2 As Long, ByVal Y2 As Long) As LongPrivate Declare Function FrameRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal
HBRUSH As Long) As LongPrivate Declare Function FillRgn Lib "gdi32" (ByVal hdc As Long, ByVal HRGN As Long, ByVal
HBRUSH As Long) As LongPrivate Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As LongPrivate Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As LongDim HwndNew As LongPrivate Sub Form_Load()
Dim LREC As RECT
Dim Hrect As Long
Dim Hwdc As Long
Dim WCOLOR As Long
Dim HBRUSH As Long Dim HRGN As Long HwndNew = CreateWindowEx(WS_EX_TOPMOST, "IME", "New", WS_POPUP Or WS_DISABLED Or WS_CLIPSIBLINGS Or WS_OVERLAPPED, _
0, 0, 200, 200, Me.hwnd, 0, 0, WM_CREATE)
Debug.Print HwndNew ShowWindow HwndNew, SW_NORMAL Hrect = GetClientRect(HwndNew, LREC) Hwdc = GetDC(HwndNew) WCOLOR = RGB(255, 255, 255) HRGN = CreateRectRgn(LREC.Left, LREC.Top, LREC.Right, LREC.Bottom) HBRUSH = CreateSolidBrush(WCOLOR) FillRgn Hwdc, HRGN, HBRUSHEnd SubPrivate Sub Form_Unload(Cancel As Integer)
DestroyWindow HwndNew
End Sub
以上代码来自： SourceCode Explorer(源代码数据库)
复制时间： 2002-06-06 14:18:13
当前版本： 1.0.701
作者： Shawls
个人主页： Http://Shawls.Yeah.Net
E-Mail： [email protected]
QQ： 9181729
'把以下内容复制到记事本，再存为Form1.frm
'=======================================
VERSION 5.00
Begin VB.Form Form1
BackColor = &H00FFFFFF&
Caption = "Form1"
ClientHeight = 1440
ClientLeft = 60
ClientTop = 345
ClientWidth = 4305
LinkTopic = "Form1"
ScaleHeight = 1440
ScaleWidth = 4305
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton Command1
Caption = "显示"
Height = 375
Left = 1440
TabIndex = 1
Top = 600
Width = 1455
End
Begin VB.PictureBox Picture1
AutoRedraw = -1 'True
Height = 2055
Left = 240
ScaleHeight = 133
ScaleMode = 3 'Pixel
ScaleWidth = 117
TabIndex = 0
Top = 1920
Visible = 0 'False
Width = 1815
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option ExplicitPrivate Sub Form_Load()
m_Hwnd = Me.hwnd
End SubPrivate Sub Command1_Click()
Dim rc As RECT
Call Hook
GetWindowRect Command1.hwnd, rc
SetWindowLong Picture1.hwnd, GWL_STYLE, WS_POPUP Or WS_BORDER Or WS_THICKFRAME
SetWindowLong Picture1.hwnd, GWL_EXSTYLE, WS_EX_TOPMOST Or WS_EX_TOOLWINDOW
SetParent Picture1.hwnd, 0
Picture1.Move (rc.Right + 2) * Screen.TwipsPerPixelX, rc.Top * Screen.TwipsPerPixelY, Picture1.Width, Picture1.Height
Call Picture1_KeyDown(189, 0)
Picture1.Visible = True
Call SetCapture(Picture1.hwnd)
Picture1.SetFocus
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Picture1.Visible = False
Call ReleaseCapture
Call Unhook
End Sub
Private Sub Picture1_KeyDown(KeyCode As Integer, Shift As Integer)
Dim rc As RECT
Dim i As Integer
Picture1.Cls
rc.Left = 1
rc.Top = 20
rc.Right = Picture1.ScaleWidth - 1
rc.Bottom = Picture1.ScaleHeight - 1
DrawEdge Picture1.hdc, rc, BDR_SUNKENOUTER, BF_RECT
Picture1.CurrentY = 22
If KeyCode = 187 Then '"+"
For i = 1 To 9
Picture1.CurrentX = 5
Picture1.Print i & " " & String(i, "A")
Next i
Else
For i = 1 To 9
Picture1.CurrentX = 5
Picture1.Print i & " " & String(i, "B")
Next i
End If
Picture1.Refresh
End Sub
'=======================================
'把以下内容复制到模块
'=======================================
Option ExplicitPublic 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 GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex 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 SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Public Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Public Declare Function DrawEdge Lib "user32" (ByVal hdc As Long, qrc As RECT, ByVal edge As Long, ByVal grfFlags As Long) As LongPublic Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End TypePublic Type POINTAPI
X As Long
Y As Long
End TypePublic Const GWL_EXSTYLE = (-20)
Public Const GWL_STYLE = (-16)
Public Const GWL_HWNDPARENT = (-8)
Public Const GWL_WNDPROC = (-4)Public Const WS_THICKFRAME = &H40000
Public Const WS_VISIBLE = &H10000000
Public Const WS_POPUP = &H80000000
Public Const WS_BORDER = &H800000Public Const WS_EX_TOPMOST = &H8
Public Const WS_EX_TOOLWINDOW = &H80Public Const WM_NCACTIVATE = &H86
Public Const WM_ACTIVATEAPP = &H1CPublic Const BF_TOP = &H2
Public Const BF_LEFT = &H1
Public Const BF_RIGHT = &H4
Public Const BF_BOTTOM = &H8
Public Const BF_RECT = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM)Public Const BDR_RAISEDINNER = &H4
Public Const BDR_RAISEDOUTER = &H1
Public Const BDR_SUNKENINNER = &H8
Public Const BDR_SUNKENOUTER = &H2
Public Const BDR_SUNKEN = &HA
Public Const BDR_RAISED = &H5Public m_Hwnd As Long
Public m_Hook As Boolean
Private m_PrevWndProc As LongPublic Sub Hook()
If Not m_Hook Then
m_PrevWndProc = SetWindowLong(m_Hwnd, GWL_WNDPROC, AddressOf WindowProc)
m_Hook = True
End If
End SubPublic Sub Unhook()
If m_Hook Then
Call SetWindowLong(m_Hwnd, GWL_WNDPROC, m_PrevWndProc)
m_Hook = False
End If
End SubPrivate Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case uMsg
Case WM_NCACTIVATE
WindowProc = CallWindowProc(m_PrevWndProc, hw, uMsg, 1, lParam)
Case Else
WindowProc = CallWindowProc(m_PrevWndProc, hw, uMsg, wParam, lParam)
End Select
End Function