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  ：[e-mail]
'e-mail  ：[e-mail]
'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