home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / EZ_Capture188597592005.psc / CaptureRectangle.frm < prev    next >
Text File  |  2004-07-27  |  4KB  |  113 lines
  1. VERSION 5.00
  2. Begin VB.Form frmCaptureRectangle 
  3.    Appearance      =   0  'Flat
  4.    AutoRedraw      =   -1  'True
  5.    BackColor       =   &H80000000&
  6.    BorderStyle     =   0  'None
  7.    ClientHeight    =   2265
  8.    ClientLeft      =   3975
  9.    ClientTop       =   5400
  10.    ClientWidth     =   2685
  11.    ControlBox      =   0   'False
  12.    DrawStyle       =   1  'Dash
  13.    DrawWidth       =   2
  14.    ForeColor       =   &H000000C0&
  15.    LinkTopic       =   "Form1"
  16.    MaxButton       =   0   'False
  17.    MinButton       =   0   'False
  18.    MousePointer    =   2  'Cross
  19.    ScaleHeight     =   151
  20.    ScaleMode       =   3  'Pixel
  21.    ScaleWidth      =   179
  22.    ShowInTaskbar   =   0   'False
  23.    StartUpPosition =   2  'CenterScreen
  24. End
  25. Attribute VB_Name = "frmCaptureRectangle"
  26. Attribute VB_GlobalNameSpace = False
  27. Attribute VB_Creatable = False
  28. Attribute VB_PredeclaredId = True
  29. Attribute VB_Exposed = False
  30. Option Explicit
  31.  
  32. Private mbDown As Boolean
  33. Private nOldX As Integer
  34. Private nOldY As Integer
  35. Dim XStart, YStart As Single
  36. Dim XPrevious, YPrevious As Single
  37. Dim CopyWidth, CopyHeight As Integer
  38. Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
  39. Const SND_SYNC = &H0
  40. Const SND_ASYNC = &H1
  41. Const SND_NODEFAULT = &H2
  42. Const SND_LOOP = &H8
  43. Const SND_NOSTOP = &H10
  44.  
  45. Private Sub Form_Activate()
  46.     With Me
  47.         .Left = -2
  48.         .Top = -2
  49.         .Width = Screen.Width + 2
  50.         .Height = Screen.Height + 2
  51.         .DrawStyle = 2
  52.     End With
  53. End Sub
  54.  
  55. Private Sub Form_DblClick()
  56.     Unload Me
  57. End Sub
  58.  
  59. Private Sub Form_Unload(Cancel As Integer)
  60.     frmMain.Show
  61. End Sub
  62.  
  63. Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  64. '--- This where we set the Begainning of the Box
  65. '--- that will be Drawn around the Capture Area
  66.     If Button = 1 Then
  67.         XStart = X
  68.         YStart = Y
  69.         XPrevious = XStart
  70.         YPrevious = YStart
  71.         frmCaptureRectangle.AutoRedraw = False
  72.     End If
  73.  
  74. End Sub
  75.  
  76. Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  77. '--- Where we Draw the Box around the Choosen Area as you hold down the Left Mouse
  78. '--- button and Drag in any direction to create a rectangle
  79.  
  80.     If Button <> 1 Then Exit Sub
  81.         frmCaptureRectangle.Line (XStart, YStart)-(XPrevious, YPrevious), , B
  82.         frmCaptureRectangle.Refresh
  83.         frmCaptureRectangle.Line (XStart, YStart)-(X, Y), , B
  84.         XPrevious = X
  85.         YPrevious = Y
  86. End Sub
  87.  
  88. Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  89. Dim X1 As Single, Y1 As Single
  90. Dim CopyWidth As Single, CopyHeight As Single
  91. Dim PictWidth As Single, PictHeight As Single
  92.  
  93. frmCaptureRectangle.Line (XStart, YStart)-(XPrevious, YPrevious), , B
  94. frmCaptureRectangle.Refresh
  95. If X > XStart Then X1 = XStart Else X1 = X
  96. If Y > YStart Then Y1 = YStart Else Y1 = Y
  97. CopyWidth = Abs(X - XStart)
  98. CopyHeight = Abs(Y - YStart)
  99.  
  100. frmPreview.Picture = CaptureWindow(frmCaptureRectangle.hwnd, False, X1, Y1, Abs(X - XStart), Abs(Y - YStart))
  101. PictWidth = frmPreview.ScaleX(frmPreview.Picture.Width, vbHiMetric, vbTwips)
  102. PictHeight = frmPreview.ScaleX(frmPreview.Picture.Height, vbHiMetric, vbTwips)
  103. frmPreview.Move 0, 0, PictWidth, PictHeight
  104.  
  105. frmPreview.Show
  106. DoEvents
  107. sndPlaySound App.Path & "/camera.wav", SND_ASYNC
  108. frmMain.WindowState = vbNormal
  109. Unload Me
  110. End Sub
  111.  
  112.  
  113.