home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / PictureBox211160542008.psc / Form1.frm < prev    next >
Text File  |  2008-05-03  |  5KB  |  149 lines
  1. VERSION 5.00
  2. Begin VB.Form Form1 
  3.    BackColor       =   &H00FFFFFF&
  4.    Caption         =   "Demo of Selection Tool "
  5.    ClientHeight    =   6615
  6.    ClientLeft      =   60
  7.    ClientTop       =   345
  8.    ClientWidth     =   10545
  9.    LinkTopic       =   "Form1"
  10.    ScaleHeight     =   441
  11.    ScaleMode       =   3  'Pixel
  12.    ScaleWidth      =   703
  13.    StartUpPosition =   3  'Windows Default
  14.    Begin VB.CommandButton cmdSave 
  15.       Caption         =   "Save picture"
  16.       Height          =   420
  17.       Left            =   3630
  18.       TabIndex        =   3
  19.       Top             =   6090
  20.       Width           =   1365
  21.    End
  22.    Begin VB.PictureBox Picture2 
  23.       AutoRedraw      =   -1  'True
  24.       BackColor       =   &H00FFFFFF&
  25.       BorderStyle     =   0  'None
  26.       Height          =   540
  27.       Left            =   5445
  28.       ScaleHeight     =   36
  29.       ScaleMode       =   3  'Pixel
  30.       ScaleWidth      =   42
  31.       TabIndex        =   2
  32.       Top             =   210
  33.       Visible         =   0   'False
  34.       Width           =   630
  35.    End
  36.    Begin VB.PictureBox Picture1 
  37.       Height          =   5880
  38.       Left            =   120
  39.       Picture         =   "Form1.frx":0000
  40.       ScaleHeight     =   5820
  41.       ScaleWidth      =   4785
  42.       TabIndex        =   1
  43.       Top             =   150
  44.       Width           =   4845
  45.       Begin VB.Shape Shape1 
  46.          BorderColor     =   &H00FFFFFF&
  47.          BorderStyle     =   3  'Dot
  48.          Height          =   270
  49.          Left            =   150
  50.          Top             =   120
  51.          Visible         =   0   'False
  52.          Width           =   300
  53.       End
  54.    End
  55.    Begin VB.Label Label1 
  56.       Caption         =   "BY DIGITAL VISIT MY SITE HTTP://WWW.DIGITALFX2001.COM"
  57.       Height          =   495
  58.       Left            =   1080
  59.       TabIndex        =   0
  60.       Top             =   1200
  61.       Width           =   2805
  62.    End
  63. End
  64. Attribute VB_Name = "Form1"
  65. Attribute VB_GlobalNameSpace = False
  66. Attribute VB_Creatable = False
  67. Attribute VB_PredeclaredId = True
  68. Attribute VB_Exposed = False
  69.  
  70. '*******************************************************************
  71. '**                     Picturebox Selection Tool Demo
  72. '**                               Version 1.2.3
  73. '**                               By Ken Foster
  74. '**                                 April 2008
  75. '**                     Freeware--- no copyrights claimed
  76. '*******************************************************************
  77.  
  78. Option Explicit
  79. '
  80.  
  81. Private Sub Form_Load()
  82.    'set up our properties
  83.    Form1.ScaleMode = 3
  84.    Picture1.AutoRedraw = True
  85.    Picture1.ScaleMode = 3
  86.    Picture2.AutoRedraw = True
  87.    Picture2.ScaleMode = 3
  88. End Sub
  89.  
  90. Private Sub Form_Unload(Cancel As Integer)
  91.    ReleaseSR   'release cursor...just in case form is closed while cursor is still confined
  92.    Unload Me
  93. End Sub
  94.  
  95. Private Sub cmdSave_Click()
  96.    SavePicture Picture2.Picture, App.Path & "\Test.bmp"
  97.    MsgBox "Picture Saved in " & App.Path & "\Test.bmp"
  98. End Sub
  99.  
  100. Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  101.  
  102.    DrawSR Picture1
  103.    
  104.    'reset to zero's for next selection
  105.    Shape1.Height = 0
  106.    Shape1.Width = 0
  107.    Picture2.Height = 0
  108.    Picture2.Width = 0
  109.    
  110.    'I'm using button 1 for this demo, you may want button 2 in your programs
  111.    'if so, change all the Button = 1 to Button = 2
  112.    If Button = 1 Then    'set starting points
  113.       Picture1.MousePointer = 2    'change pointer to cross
  114.       Shape1.Left = X
  115.       Shape1.Top = Y
  116.    End If
  117.  
  118.    Shape1.Visible = True    'show rectangle
  119. End Sub
  120.  
  121. Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  122.    On Error GoTo Skip
  123.    If Button = 1 Then     'draw the selection rectangle
  124.       Picture2.Visible = False
  125.       Shape1.Height = Y - Shape1.Top
  126.       Shape1.Width = X - Shape1.Left
  127.    
  128.       'make picture2 the same dimensions as the selection rectangle
  129.        Picture2.Width = Shape1.Width
  130.        Picture2.Height = Shape1.Height
  131.    End If
  132. Skip:
  133. End Sub
  134.  
  135. Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  136.    If Button = 1 Then
  137.       Shape1.Visible = False    'now we can hide the rectangle
  138.       
  139.       'plaster the selection into picture2
  140.       If Picture2.Width > 3 Or Picture2.Height > 3 Then
  141.          Picture2.Visible = True   'make image visible
  142.          Picture2.Picture = Picture2.Image   'render picture so it can be used
  143.          BitBlt Picture2.hDC, 0, 0, Picture2.Width, Picture2.Height, Picture1.hDC, Shape1.Left, Shape1.Top, vbSrcCopy
  144.       End If
  145.    End If
  146.    Picture1.MousePointer = 0          'set pointer back to default
  147.    ReleaseSR
  148. End Sub
  149.