xp_canvas.ctl

经过几个月的设计和开发

VERSION 5.00
Begin VB.UserControl xp_canvas 
   AutoRedraw      =   -1  'True
   BackColor       =   &H00C0FFFF&
   ClientHeight    =   2370
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4320
   ControlContainer=   -1  'True
   MaskColor       =   &H00C0FFFF&
   ScaleHeight     =   158
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   288
   ToolboxBitmap   =   "xp_canvas.ctx":0000
   Begin VB.PictureBox pictop 
      Align           =   1  'Align Top
      Appearance      =   0  'Flat
      AutoRedraw      =   -1  'True
      BackColor       =   &H00C0FFFF&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   2355
      Left            =   0
      ScaleHeight     =   157
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   288
      TabIndex        =   1
      Top             =   0
      Width           =   4320
      Begin VB.Image imgresize 
         Height          =   135
         Index           =   6
         Left            =   6000
         MousePointer    =   6  'Size NE SW
         Top             =   0
         Width           =   135
      End
      Begin VB.Image imgresize 
         Height          =   135
         Index           =   7
         Left            =   0
         MousePointer    =   8  'Size NW SE
         Top             =   0
         Width           =   135
      End
   End
   Begin VB.PictureBox picbottom 
      Align           =   2  'Align Bottom
      Appearance      =   0  'Flat
      AutoRedraw      =   -1  'True
      BackColor       =   &H00C0FFFF&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   135
      Left            =   0
      MousePointer    =   7  'Size N S
      ScaleHeight     =   9
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   288
      TabIndex        =   0
      Top             =   2235
      Width           =   4320
      Begin VB.Image imgresize 
         Height          =   135
         Index           =   5
         Left            =   0
         MousePointer    =   6  'Size NE SW
         Top             =   0
         Width           =   135
      End
      Begin VB.Image imgresize 
         Height          =   135
         Index           =   4
         Left            =   6000
         MousePointer    =   8  'Size NW SE
         Top             =   0
         Width           =   135
      End
   End
End
Attribute VB_Name = "xp_canvas"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
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 Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, Y, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As PointAPI) As Long

Private Type PointAPI
    X As Long
    Y As Long
End Type

Dim oldcp As PointAPI
Dim newcp As PointAPI
Dim m_Icon As Picture
Dim FixedSingle As Boolean

Event Click()
Attribute Click.VB_UserMemId = -600
Event DblClick()
Attribute DblClick.VB_UserMemId = -601
Event Resize()
Event KeyDown(KeyCode As Integer, Shift As Integer)
Attribute KeyDown.VB_UserMemId = -602
Event KeyPress(KeyAscii As Integer)
Attribute KeyPress.VB_UserMemId = -603
Event KeyUp(KeyCode As Integer, Shift As Integer)
Attribute KeyUp.VB_UserMemId = -604
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Attribute MouseDown.VB_UserMemId = -605
Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Attribute MouseMove.VB_UserMemId = -606
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Attribute MouseUp.VB_UserMemId = -607

Private Sub lblcaption_DblClick()
    If Fixed_Single = False Then If UserControl.Parent.WindowState = 0 Then UserControl.Parent.WindowState = 2 Else UserControl.Parent.WindowState = 0
End Sub

Private Sub pictop_DblClick()
    If Fixed_Single = False Then If UserControl.Parent.WindowState = 0 Then UserControl.Parent.WindowState = 2 Else UserControl.Parent.WindowState = 0
End Sub

Private Sub pictop_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If UserControl.Parent.WindowState = 0 Then
        ReleaseCapture
        SendMessage UserControl.Parent.hWnd, &HA1, 2, 0&
    End If
    DoEvents
End Sub

Private Sub imgresize_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Fixed_Single = False Then GetCursorPos oldcp
End Sub



Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
    RaiseEvent KeyDown(KeyCode, Shift)
End Sub

Private Sub UserControl_KeyPress(KeyAscii As Integer)
    RaiseEvent KeyPress(KeyAscii)
End Sub

Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
    RaiseEvent KeyUp(KeyCode, Shift)
End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseDown(Button, Shift, X, Y)
End Sub

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub

Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub