frmmain.frm

Synaptics触摸板应用开发包（SDK）

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