home *** CD-ROM | disk | FTP | other *** search
/ Mastering Visual Basic 5 / MasteringVisualBasic5.iso / olympus / ik32_15t / vb4.shr / scrcap.Frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-07-24  |  2.1 KB  |  74 lines
  1. VERSION 4.00
  2. Begin VB.Form Form1 
  3.    BorderStyle     =   1  'Fixed Single
  4.    Caption         =   "Screen Capture Demo"
  5.    ClientHeight    =   3375
  6.    ClientLeft      =   1680
  7.    ClientTop       =   1890
  8.    ClientWidth     =   4695
  9.    Height          =   4065
  10.    Left            =   1620
  11.    LinkTopic       =   "Form1"
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   3375
  15.    ScaleWidth      =   4695
  16.    Top             =   1260
  17.    Width           =   4815
  18.    Begin VB.CommandButton Command1 
  19.       Caption         =   "Capture"
  20.       Height          =   495
  21.       Left            =   3360
  22.       TabIndex        =   0
  23.       Top             =   1440
  24.       Width           =   1215
  25.    End
  26.    Begin ik32Lib.Picbuf Picbuf1 
  27.       Height          =   3255
  28.       Left            =   120
  29.       TabIndex        =   1
  30.       Top             =   0
  31.       Width           =   3135
  32.       _Version        =   65536
  33.       _ExtentX        =   5530
  34.       _ExtentY        =   5741
  35.       _StockProps     =   253
  36.    End
  37.    Begin VB.Menu file 
  38.       Caption         =   "&File"
  39.       Begin VB.Menu exit 
  40.          Caption         =   "E&xit"
  41.       End
  42.    End
  43. Attribute VB_Name = "Form1"
  44. Attribute VB_Creatable = False
  45. Attribute VB_Exposed = False
  46. 'Description: This code captures the screen to the
  47. 'picbuf control.
  48. Private Sub Command1_Click()
  49. Dim hDC As Integer
  50. Dim hmemdc As Integer
  51. Dim hbitmap As Integer
  52. Dim holdbitmap As Integer
  53. Dim RetVar As Integer
  54. hDC = CreateDC("DISPLAY", "", "", "")
  55. hbitmap = CreateCompatibleBitmap(hDC, 200, 200)
  56. hmemdc = CreateCompatibleDC(hDC)
  57. holdbitmap = SelectObject(hmemdc, hbitmap)
  58. RetVar = BitBlt(hmemdc, 0, 0, 200, 200, hDC, 0, 0, SRCCOPY)
  59. RetVar = SelectObject(hmemdc, holdbitmap)
  60. Picbuf1.BitmapToDib hbitmap
  61. RetVar = DeleteObject(hbitmap)
  62. RetVar = DeleteDC(hDC)
  63. RetVar = DeleteDC(hmemdc)
  64. End Sub
  65. 'Description: This code ends the program
  66. Private Sub exit_Click()
  67.     End
  68. End Sub
  69. 'Description: This code sets properties for the
  70. 'picbuf control.
  71. Private Sub Form_Load()
  72.     InitPicbuf Picbuf1, True
  73. End Sub
  74.