home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / vbcaptur / main.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-05-02  |  3.3 KB  |  119 lines
  1. VERSION 2.00
  2. Begin Form frmMain 
  3.    BackColor       =   &H00FFFFFF&
  4.    BorderStyle     =   1  'Fixed Single
  5.    ClientHeight    =   375
  6.    ClientLeft      =   1935
  7.    ClientTop       =   6525
  8.    ClientWidth     =   855
  9.    ForeColor       =   &H00000000&
  10.    Height          =   780
  11.    Icon            =   MAIN.FRX:0000
  12.    Left            =   1875
  13.    LinkTopic       =   "Form2"
  14.    MaxButton       =   0   'False
  15.    ScaleHeight     =   25
  16.    ScaleMode       =   3  'Pixel
  17.    ScaleWidth      =   57
  18.    Top             =   6180
  19.    Width           =   975
  20.    Begin SSCommand cmdCap 
  21.       BevelWidth      =   1
  22.       Caption         =   "Capture"
  23.       Font3D          =   0  'None
  24.       FontBold        =   0   'False
  25.       FontItalic      =   0   'False
  26.       FontName        =   "MS Sans Serif"
  27.       FontSize        =   8.25
  28.       FontStrikethru  =   0   'False
  29.       FontUnderline   =   0   'False
  30.       Height          =   375
  31.       Left            =   0
  32.       RoundedCorners  =   0   'False
  33.       TabIndex        =   0
  34.       Top             =   0
  35.       Width           =   855
  36.    End
  37. Option Explicit
  38. Dim fMarking As Integer
  39. Dim ptBeg As POINTAPI
  40. Dim ptEnd As POINTAPI
  41. Sub cmdCap_Click ()
  42.    MousePointer = 10     'up arrow
  43.    Hide
  44.    SetCapture hWnd
  45.    fMarking = False
  46. End Sub
  47. Sub Form_Load ()
  48.    Load frmDest
  49. End Sub
  50. Sub Form_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
  51.    fMarking = True
  52.    ptBeg.X = X
  53.    ptBeg.Y = Y
  54.    ClientToScreen hWnd, ptBeg
  55.    ptEnd.X = X
  56.    ptEnd.Y = Y
  57.    ClientToScreen hWnd, ptEnd
  58.    InvertBlock
  59. End Sub
  60. Sub Form_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
  61.    If fMarking Then
  62.       InvertBlock
  63.       ptEnd.X = X
  64.       ptEnd.Y = Y
  65.       ClientToScreen hWnd, ptEnd
  66.       InvertBlock
  67.    End If
  68. End Sub
  69. Sub Form_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
  70.    Dim capW As Integer
  71.    Dim capH As Integer
  72.    Dim srcDC As Integer
  73.    Dim filename As String
  74.    Dim NL As String * 2
  75.    If Not fMarking Then Exit Sub
  76.    fMarking = False
  77.    MousePointer = 0
  78.    InvertBlock
  79.    ptEnd.X = X
  80.    ptEnd.Y = Y
  81.    ClientToScreen hWnd, ptEnd
  82.    If ptEnd.X < ptBeg.X Then
  83.       Swap ptBeg.X, ptEnd.X
  84.    End If
  85.    If ptEnd.Y < ptBeg.Y Then
  86.       Swap ptBeg.Y, ptEnd.Y
  87.    End If
  88.    capW = ptEnd.X - ptBeg.X + 1
  89.    capH = ptEnd.Y - ptBeg.Y + 1
  90.    frmDest.Move 0, 0, capW * screen.TwipsPerPixelX, capH * screen.TwipsPerPixelX
  91.    frmDest.Cls
  92.    srcDC = CreateDC("DISPLAY", 0, 0, 0)
  93.    BitBlt frmDest.hDC, 0, 0, capW, capH, srcDC, ptBeg.X, ptBeg.Y, &HCC0020
  94.    DeleteDC srcDC
  95.    ReleaseCapture
  96.    NL = Chr$(13) + Chr$(10)
  97.    filename = InputBox$("Enter filename:" & NL & NL & "Width:" & Str$(capW) & NL & "Height:" & Str$(capH), "Save Image")
  98.    If filename <> "" Then
  99.       SavePicture frmDest.Image, filename
  100.    End If
  101.    frmMain.Show
  102. End Sub
  103. Sub Form_Unload (Cancel As Integer)
  104.    Unload frmDest
  105.    End
  106. End Sub
  107. Sub InvertBlock ()
  108.    Dim hDC As Integer
  109.    hDC = CreateDC("DISPLAY", 0, 0, 0)
  110.    PatBlt hDC, ptBeg.X, ptBeg.Y, ptEnd.X - ptBeg.X, ptEnd.Y - ptBeg.Y, &H550009
  111.    DeleteDC hDC
  112. End Sub
  113. Sub Swap (num1 As Integer, num2 As Integer)
  114.    Dim temp As Integer
  115.    temp = num1
  116.    num1 = num2
  117.    num2 = temp
  118. End Sub
  119.