www.pudn.com > ocr.rar > MyTitleBar.ctl
VERSION 5.00
Begin VB.UserControl MicTitleBar
ClientHeight = 1305
ClientLeft = 0
ClientTop = 0
ClientWidth = 5580
ScaleHeight = 87
ScaleMode = 3 'Pixel
ScaleWidth = 372
Begin VB.PictureBox PicUn
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 240
Left = 4320
Picture = "MyTitleBar.ctx":0000
ScaleHeight = 16
ScaleMode = 3 'Pixel
ScaleWidth = 15
TabIndex = 9
Top = 840
Width = 225
End
Begin VB.PictureBox ImageL
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 360
Left = 0
Picture = "MyTitleBar.ctx":0342
ScaleHeight = 360
ScaleWidth = 105
TabIndex = 7
Top = 0
Width = 105
End
Begin VB.PictureBox Picture000
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 750
Left = 1200
Picture = "MyTitleBar.ctx":05C4
ScaleHeight = 750
ScaleWidth = 720
TabIndex = 6
Top = 480
Width = 720
End
Begin VB.PictureBox PicMaxU
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 240
Left = 4800
Picture = "MyTitleBar.ctx":2226
ScaleHeight = 16
ScaleMode = 3 'Pixel
ScaleWidth = 15
TabIndex = 5
ToolTipText = "最大化"
Top = 60
Width = 225
End
Begin VB.PictureBox PicMin
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 240
Left = 4455
Picture = "MyTitleBar.ctx":2568
ScaleHeight = 16
ScaleMode = 3 'Pixel
ScaleWidth = 15
TabIndex = 4
Top = 480
Width = 225
End
Begin VB.PictureBox PicMax
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 240
Left = 4800
Picture = "MyTitleBar.ctx":28AA
ScaleHeight = 16
ScaleMode = 3 'Pixel
ScaleWidth = 15
TabIndex = 3
Top = 480
Width = 225
End
Begin VB.PictureBox PicClose
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 240
Left = 5160
Picture = "MyTitleBar.ctx":2BEC
ScaleHeight = 16
ScaleMode = 3 'Pixel
ScaleWidth = 15
TabIndex = 2
Top = 480
Width = 225
End
Begin VB.PictureBox PicCloseU
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 240
Left = 5160
Picture = "MyTitleBar.ctx":2F2E
ScaleHeight = 16
ScaleMode = 3 'Pixel
ScaleWidth = 15
TabIndex = 1
ToolTipText = "关闭"
Top = 60
Width = 225
End
Begin VB.PictureBox PicMinU
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 240
Left = 4440
Picture = "MyTitleBar.ctx":3270
ScaleHeight = 16
ScaleMode = 3 'Pixel
ScaleWidth = 15
TabIndex = 0
ToolTipText = "最小化"
Top = 60
Width = 225
End
Begin VB.Image ImageIco
Height = 240
Left = 120
Stretch = -1 'True
Top = 50
Width = 255
End
Begin VB.Label LabelC
AutoSize = -1 'True
BackStyle = 0 'Transparent
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 210
Left = 480
TabIndex = 8
Top = 60
Width = 105
End
Begin VB.Image ImageM
Height = 360
Left = 105
Picture = "MyTitleBar.ctx":35B2
Stretch = -1 'True
Top = 0
Width = 615
End
Begin VB.Image ImageR
Height = 360
Left = 1440
Picture = "MyTitleBar.ctx":36B4
Top = 0
Width = 105
End
End
Attribute VB_Name = "MicTitleBar"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居收藏整理
'发布日期：2008/01/21
'描 述：OCR手写字体识别软件
'网 站：http://www.Mndsoft.com/ (VB6源码博客)
'网 站：http://www.VbDnet.com/ (VB.NET源码博客,主要基于.NET2005)
'e-mail ：Mndsoft@163.com
'e-mail ：Mndsoft@126.com
'OICQ ：88382850
' 如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () 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 Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2
Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Const RGN_OR = 2
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type POINTAPI
x As Long
y As Long
End Type
Private Sub ImageL_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then
Call ReleaseCapture
Call SendMessage(UserControl.Parent.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
End If
End Sub
Private Sub ImageM_DblClick()
If PicMaxU.Enabled = True Then
Call PicMaxU_Click
End If
End Sub
Private Sub ImageM_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then
Call ReleaseCapture
Call SendMessage(UserControl.Parent.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
End If
End Sub
Private Sub ImageR_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then
Call ReleaseCapture
Call SendMessage(UserControl.Parent.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
End If
End Sub
Private Sub LabelC_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then
Call ReleaseCapture
Call SendMessage(UserControl.Parent.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
End If
End Sub
Private Sub PicCloseU_Click()
Unload UserControl.Parent
End Sub
Private Sub PicCloseU_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
With PicCloseU
If Button = 0 Then
If (x < 0) Or (y < 0) Or (x > .Width) Or (y > .Height) Then
ReleaseCapture ' 鼠标离开
.Cls
Else
SetCapture .hwnd '鼠标进入
BitBlt .hdc, 0, 0, 15, 16, PicClose.hdc, 0, 0, vbSrcCopy
.Refresh
End If
End If
End With
End Sub
Private Sub PicMaxU_Click()
If UserControl.Parent.WindowState = 2 Then
UserControl.Parent.WindowState = 0
Else
UserControl.Parent.WindowState = 2
End If
PicMaxU.Cls
End Sub
Private Sub PicMaxU_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
With PicMaxU
If Button = 0 Then
If (x < 0) Or (y < 0) Or (x > .Width) Or (y > .Height) Then
ReleaseCapture ' 鼠标离开
.Cls
Else
SetCapture .hwnd '鼠标进入
BitBlt .hdc, 0, 0, 15, 16, PicMax.hdc, 0, 0, vbSrcCopy
.Refresh
End If
End If
End With
End Sub
Private Sub PicMinU_Click()
UserControl.Parent.WindowState = 1
PicMinU.Cls
End Sub
Private Sub PicMinU_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
With PicMinU
If Button = 0 Then
If (x < 0) Or (y < 0) Or (x > .Width) Or (y > .Height) Then
ReleaseCapture ' 鼠标离开
.Cls
Else
SetCapture .hwnd '鼠标进入
BitBlt .hdc, 0, 0, 15, 16, PicMin.hdc, 0, 0, vbSrcCopy
.Refresh
End If
End If
End With
End Sub
Private Sub UserControl_Resize()
On Error Resume Next
ImageM.Width = UserControl.ScaleWidth - 14
ImageR.Left = UserControl.ScaleWidth - 7
UserControl.Height = 360
UserControl.Width = UserControl.Parent.Width
PicCloseU.Left = UserControl.ScaleWidth - 20
PicMaxU.Left = UserControl.ScaleWidth - 43
PicMinU.Left = UserControl.ScaleWidth - 67
AllBlt UserControl.Parent, Picture000
Dim Regn As Long
Dim CER As Long
'MakeNoBorderForm UserControl.Parent
X1 = UserControl.Parent.Width / Screen.TwipsPerPixelX
Y1 = UserControl.Parent.Height / Screen.TwipsPerPixelY
Regn = CreateRectRgn(0, 4, X1, Y1) '把句柄设为第一个矩形区域
CER = CreateRectRgn(4, 0, X1 - 4, 10) '创建第二个矩形区域
CombineRgn Regn, Regn, CER, RGN_OR '把临时句柄变量或运算到句柄变量中
CER = CreateRectRgn(2, 1, X1 - 2, 10)
CombineRgn Regn, Regn, CER, RGN_OR '把临时句柄变量或运算到句柄变量中
CER = CreateRectRgn(1, 2, X1 - 1, 10)
CombineRgn Regn, Regn, CER, RGN_OR '把临时句柄变量或运算到句柄变量中
Call SetWindowRgn(UserControl.Parent.hwnd, Regn, True) '创建窗体
UserControl.Parent.Line (0, 21)-(0, UserControl.Parent.ScaleHeight - 1), 8684676
UserControl.Parent.Line (0, UserControl.Parent.ScaleHeight - 1)-(UserControl.Parent.ScaleWidth - 1, UserControl.Parent.ScaleHeight - 1), 8684676
UserControl.Parent.Line (UserControl.Parent.ScaleWidth - 1, 21)-(UserControl.Parent.ScaleWidth - 1, UserControl.Parent.ScaleHeight), 8684676
End Sub
Private Function AllBlt(frm As Object, Pic As Object)
Dim i As Long, j As Long
frm.ScaleMode = 3
frm.AutoRedraw = True
Pic.AutoRedraw = True
Pic.ScaleMode = 3
Pic.AutoSize = True
For i = 0 To frm.ScaleWidth Step Pic.ScaleWidth
For j = 0 To frm.ScaleHeight Step Pic.ScaleHeight
BitBlt frm.hdc, i, j, Pic.ScaleWidth, Pic.ScaleHeight, Pic.hdc, 0, 0, vbSrcCopy
Next j
Next i
frm.Refresh
End Function
Private Sub MakeNoBorderForm(frm As Form)
'切除窗口的边框
Dim rctClient As RECT, rctFrame As RECT
Dim hRgn As Long
Dim lRes As Long
ReDim XY(3) As POINTAPI
Dim lpTL As POINTAPI, lpBR As POINTAPI
'获得窗口矩形区域
'将窗口矩形坐标转换为屏幕坐标
lpTL.x = frm.Left / 15
lpTL.y = frm.Top / 15
ScreenToClient frm.hwnd, lpTL
rctClient.Left = Abs(lpTL.x)
rctClient.Top = Abs(lpTL.y)
frm.ScaleMode = 1 'Twip
rctClient.Right = frm.ScaleWidth / 15 + Abs(lpTL.x)
rctClient.Bottom = frm.ScaleHeight / 15 + Abs(lpTL.y)
'建立要切割的数组
XY(0).x = rctClient.Left
XY(0).y = rctClient.Top
XY(1).x = rctClient.Right
XY(1).y = rctClient.Top
XY(2).x = rctClient.Right
XY(2).y = rctClient.Bottom
XY(3).x = rctClient.Left
XY(3).y = rctClient.Bottom
hRgn = CreatePolygonRgn(XY(0), 4, 2)
lRes = SetWindowRgn(frm.hwnd, hRgn, True)
frm.ScaleMode = 3
End Sub
Private Sub UserControl_Show()
If UserControl.Parent.MinButton = False Then
BitBlt PicMinU.hdc, 0, 0, 15, 16, PicUn.hdc, 0, 0, vbSrcCopy
PicMinU.Refresh
PicMinU.Enabled = False
End If
If UserControl.Parent.MaxButton = False Then
BitBlt PicMaxU.hdc, 0, 0, 15, 16, PicUn.hdc, 0, 0, vbSrcCopy
PicMaxU.Refresh
PicMaxU.Enabled = False
End If
LabelC.Caption = UserControl.Parent.Caption
ImageIco.Picture = UserControl.Parent.Icon
End Sub