frmMain.frm
上传用户:newera
上传日期:2013-10-07
资源大小:381k
文件大小:13k
- VERSION 5.00
- Object = "{82D70786-7968-46EA-836D-203AEBCA4481}#1.0#0"; "SynCtrl.dll"
- Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
- Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
- Begin VB.Form frmMain
- BackColor = &H80000005&
- BorderStyle = 0 'None
- Caption = "cPadDraw"
- ClientHeight = 4995
- ClientLeft = 150
- ClientTop = 720
- ClientWidth = 4530
- LinkTopic = "Form1"
- ScaleHeight = 4995
- ScaleWidth = 4530
- ShowInTaskbar = 0 'False
- StartUpPosition = 3 'Windows Default
- Begin SYNCTRLLibCtl.SynDisplayCtrl SynDisplayCtrl1
- Left = 120
- OleObjectBlob = "frmMain.frx":0000
- Top = 3720
- End
- Begin SYNCTRLLibCtl.SynAPICtrl SynAPICtrl1
- Left = 120
- OleObjectBlob = "frmMain.frx":0024
- Top = 2760
- End
- Begin SYNCTRLLibCtl.SynDeviceCtrl SynDeviceCtrl1
- Left = 120
- OleObjectBlob = "frmMain.frx":0048
- Top = 1800
- End
- Begin MSComctlLib.StatusBar sbStatusBar
- Align = 2 'Align Bottom
- Height = 270
- Left = 0
- TabIndex = 0
- Top = 4725
- Width = 4530
- _ExtentX = 7990
- _ExtentY = 476
- _Version = 393216
- BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
- NumPanels = 3
- BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
- AutoSize = 1
- Object.Width = 2805
- Text = "Status"
- TextSave = "Status"
- EndProperty
- BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
- Style = 6
- AutoSize = 2
- TextSave = "3/31/2003"
- EndProperty
- BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628}
- Style = 5
- AutoSize = 2
- TextSave = "5:35 PM"
- EndProperty
- EndProperty
- End
- Begin MSComDlg.CommonDialog dlgCommonDialog
- Left = 3840
- Top = 720
- _ExtentX = 847
- _ExtentY = 847
- _Version = 393216
- End
- Begin MSComctlLib.ImageList imlToolbarIcons
- Left = 3720
- Top = 3000
- _ExtentX = 1005
- _ExtentY = 1005
- BackColor = -2147483643
- ImageWidth = 16
- ImageHeight = 16
- MaskColor = 12632256
- _Version = 393216
- BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
- NumListImages = 3
- BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "frmMain.frx":006C
- Key = "Pencil"
- Object.Tag = "Pencil"
- EndProperty
- BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "frmMain.frx":017E
- Key = "Eraser"
- Object.Tag = "Eraser"
- EndProperty
- BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "frmMain.frx":0290
- Key = "Stop"
- Object.Tag = "Stop"
- EndProperty
- EndProperty
- End
- Begin MSComctlLib.Toolbar tbToolBar
- Align = 1 'Align Top
- Height = 420
- Left = 0
- TabIndex = 1
- Top = 0
- Width = 4530
- _ExtentX = 7990
- _ExtentY = 741
- ButtonWidth = 609
- ButtonHeight = 582
- Appearance = 1
- ImageList = "imlToolbarIcons"
- _Version = 393216
- BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
- NumButtons = 3
- BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Key = "Pencil"
- ImageKey = "Pencil"
- Style = 2
- EndProperty
- BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Key = "Eraser"
- ImageKey = "Eraser"
- Style = 2
- EndProperty
- BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Key = "None"
- ImageKey = "Stop"
- Style = 2
- EndProperty
- EndProperty
- End
- Begin VB.PictureBox Picture1
- AutoRedraw = -1 'True
- AutoSize = -1 'True
- BackColor = &H80000005&
- BorderStyle = 0 'None
- Height = 975
- Left = 2760
- ScaleHeight = 975
- ScaleWidth = 1455
- TabIndex = 2
- Top = 1680
- Width = 1455
- End
- Begin SYNCTRLLibCtl.SynPacketCtrl SynPacketCtrl1
- Left = 120
- OleObjectBlob = "frmMain.frx":03A2
- Top = 840
- End
- Begin VB.Menu mnuFile
- Caption = "&File"
- Begin VB.Menu mnuFileNew
- Caption = "&New"
- Shortcut = ^N
- End
- Begin VB.Menu mnuFileOpen
- Caption = "&Open..."
- Shortcut = ^O
- End
- Begin VB.Menu mnuFileSave
- Caption = "&Save"
- Shortcut = ^S
- End
- Begin VB.Menu mnuFileSaveAs
- Caption = "Save &As..."
- End
- Begin VB.Menu Sep
- Caption = "-"
- End
- Begin VB.Menu mnuFileExit
- Caption = "E&xit"
- End
- End
- Begin VB.Menu mnuTools
- Caption = "&Tools"
- Begin VB.Menu mnuToolsOptions
- Caption = "&Options..."
- End
- End
- Begin VB.Menu mnuHelp
- Caption = "&Help"
- Begin VB.Menu mnuHelpAbout
- Caption = "&About..."
- End
- End
- End
- Attribute VB_Name = "frmMain"
- Attribute VB_GlobalNameSpace = False
- Attribute VB_Creatable = False
- Attribute VB_PredeclaredId = True
- Attribute VB_Exposed = False
- Public XMin As Integer
- Public XMax As Integer
- Public YMin As Integer
- Public YMax As Integer
- Public ZTouchThreshold As Integer
- Public ExtentType As Integer
- Public UsePencil As Integer
- Public Utensil As Integer
- Const eNone As Integer = 0
- Const ePencil As Integer = 1
- Const eEraser As Integer = 2
- Private Sub Form_Load()
- Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)
- Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000)
- Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 3690)
- Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 3750)
-
- sbStatusBar.Panels(1).MinWidth = 2100
-
- Me.KeyPreview = True
- dlgCommonDialog.DefaultExt = "bmp"
- dlgCommonDialog.Filter = "Pictures (*.bmp)|*.bmp"
- SynAPICtrl1.Initialize
- SynAPICtrl1.Activate ' Activate to receive device notifications
- DeviceHandle = SynAPICtrl1.FindDevice(SE_ConnectionAny, SE_DevicecPad, -1)
- If DeviceHandle = -1 Then
- MsgBox "Unable to find a Synaptics cPad"
- End
- End If
-
- SynDeviceCtrl1.Select (DeviceHandle)
- SynDeviceCtrl1.Activate 'Activate to receive pointing packets
-
- SynDisplayCtrl1.Select (DeviceHandle)
- SynDisplayCtrl1.Activate
- SynDisplayCtrl1.Acquire (SE_AcquireCooperative) 'Acquire display access
-
- ZTouchThreshold = SynDeviceCtrl1.GetLongProperty(SP_ZTouchThreshold)
-
- XMin = SynDeviceCtrl1.GetLongProperty(SP_XLoSensor)
- XMax = SynDeviceCtrl1.GetLongProperty(SP_XHiSensor)
- YMin = SynDeviceCtrl1.GetLongProperty(SP_YLoSensor)
- YMax = SynDeviceCtrl1.GetLongProperty(SP_YHiSensor)
- ExtentType = 5 'Use display mapping for device coordinates
-
- Picture1.Left = 0
- 'The toolbar height changes by 3/2 when run, so compensate the picture location by 2/3.
- Picture1.Top = 2 * Me.tbToolBar.Height / 3
- ' Size the picture to the same number of pixels as the Synaptics display.
- ' Make sure the picturebox border attribute is "none". If it isn't,
- ' the size of the image property of the picturebox will be that of the interior
- ' of the picture box.
- Picture1.Width = Picture1.ScaleX(SynDisplayCtrl1.GetLongProperty(SP_DisplayColumns), vbPixels, vbTwips)
- Picture1.Height = Picture1.ScaleY(SynDisplayCtrl1.GetLongProperty(SP_DisplayRows), vbPixels, vbTwips)
-
- Utensil = eNone
- End Sub
- Private Sub Form_Unload(Cancel As Integer)
- Dim i As Integer
- 'Make sure to free up the device and display.
- SynDeviceCtrl1.Unacquire
- SynDisplayCtrl1.Unacquire
-
- 'close all sub forms
- For i = Forms.Count - 1 To 1 Step -1
- Unload Forms(i)
- Next
-
- If Me.WindowState <> vbMinimized Then
- SaveSetting App.Title, "Settings", "MainLeft", Me.Left
- SaveSetting App.Title, "Settings", "MainTop", Me.Top
- SaveSetting App.Title, "Settings", "MainWidth", Me.Width
- SaveSetting App.Title, "Settings", "MainHeight", Me.Height
- End If
- End Sub
- Public Sub Form_KeyPress(KeyAscii As Integer)
- If KeyAscii = vbKeyEscape Then
- tbToolBar_ButtonClick tbToolBar.Buttons("None")
- End If
- End Sub
- Public Sub Form_Paint()
- 'Send a picture to the display staging area.
- SynDisplayCtrl1.SendPicture Picture1.Image
- 'Flush it to the actual display but don't wait for completion.
- SynDisplayCtrl1.Flush (SE_FlushAsynchronous)
- End Sub
- Private Sub SynAPICtrl1_OnNotify(ByVal eReason As SYNCTRLLibCtl.SynNotificationReason)
- Select Case eReason
- Case SE_Configuration_Changed
- sbStatusBar.Panels(1).Text = "Configuration Change"
- Case SE_DeviceRemoved
- sbStatusBar.Panels(1).Text = "Device Removed"
- Case SE_DeviceAdded
- sbStatusBar.Panels(1).Text = "Device Added"
- End Select
- End Sub
- Private Sub SynDeviceCtrl1_OnPacket()
- Static LastX, LastY, LastFinger As Integer
- Dim X, Y, Finger As Integer
- Dim Color As Long
-
- 'Load a packet object with device data
- SynDeviceCtrl1.LoadPacket SynPacketCtrl1
-
- If ExtentType = 5 Then
- X = SynDisplayCtrl1.PixelX(SynPacketCtrl1.X) * Picture1.Width / SynDisplayCtrl1.GetLongProperty(SP_DisplayColumns)
- Y = SynDisplayCtrl1.PixelY(SynPacketCtrl1.Y) * Picture1.Height / SynDisplayCtrl1.GetLongProperty(SP_DisplayRows)
- Else
- X = (SynPacketCtrl1.X - XMin) * Picture1.Width / (XMax - XMin)
- Y = (YMax - SynPacketCtrl1.Y) * Picture1.Height / (YMax - YMin)
- End If
- Finger = SynPacketCtrl1.FingerState And SF_FingerPresent
-
- If Finger And LastFinger And Utensil <> eNone Then
- If SynPacketCtrl1.Z > ZTouchThreshold Then
- Picture1.DrawWidth = mapZ(SynPacketCtrl1.Z)
- Else
- Picture1.DrawWidth = 1
- End If
-
- Color = IIf(Utensil = ePencil, Picture1.ForeColor, Picture1.BackColor)
- Picture1.Line (LastX, LastY)-(X, Y), Color
-
- Me.Refresh
- End If
-
- LastX = X
- LastY = Y
- LastFinger = Finger
- End Sub
- Private Sub SynDisplayCtrl1_OnMessage(ByVal eMessage As SYNCTRLLibCtl.SynDisplayMessage)
- 'This is what is done by default if no display message handler is defined.
- SynDisplayCtrl1.Flush (SE_FlushAsynchronous)
- End Sub
- Private Function mapZ(ByVal Zin As Integer) As Long
- mapZ = Zin - ZTouchThreshold
- mapZ = mapZ * mapZ / 100
- mapZ = IIf(mapZ < 1, 1, mapZ)
- End Function
- Private Sub tbToolBar_ButtonClick(ByVal Button As MSComCtlLib.Button)
- On Error Resume Next
- Select Case Button.Key
- Case "Pencil"
- Utensil = ePencil
- SynDeviceCtrl1.Acquire (0)
- Case "Eraser"
- Utensil = eEraser
- SynDeviceCtrl1.Acquire (0)
- Case "None"
- Utensil = eNone
- SynDeviceCtrl1.Unacquire
- Button.Value = tbrUnpressed
- tbToolBar.Buttons("Pencil").Value = tbrUnpressed
- tbToolBar.Buttons("Eraser").Value = tbrUnpressed
- End Select
- End Sub
- Private Sub mnuHelpAbout_Click()
- frmAbout.Show vbModal, Me
- End Sub
- Private Sub mnuFileNew_Click()
- Picture1.Cls
- Picture1.Picture = Nothing
- Me.Refresh
- End Sub
- Private Sub mnuFileOpen_Click()
- On Error Resume Next
- dlgCommonDialog.ShowOpen
- If Err <> 32755 Then ' User chose Cancel.
- Picture1.Picture = LoadPicture(dlgCommonDialog.FileName)
- End If
- Me.Refresh
- End Sub
- Private Sub mnuFileSave_Click()
- If dlgCommonDialog.FileName <> "" Then
- SavePicture Picture1.Image, dlgCommonDialog.FileName
- Else
- mnuFileSaveAs_Click
- End If
- End Sub
- Private Sub mnuFileSaveAs_Click()
- On Error Resume Next
- dlgCommonDialog.ShowSave
- If Err <> 32755 Then ' User chose Cancel.
- SavePicture Picture1.Image, dlgCommonDialog.FileName
- End If
- End Sub
- Private Sub mnuToolsOptions_Click()
- frmOptions.Show vbModal, Me
- End Sub
- Private Sub mnuFileExit_Click()
- Unload Me
- End Sub