home *** CD-ROM | disk | FTP | other *** search
/ Mastering Visual Basic 6 / mastvb6.iso / ch_code / ch13 / copypix / copypix.frm (.txt) next >
Encoding:
Visual Basic Form  |  1996-04-30  |  6.7 KB  |  190 lines
  1. VERSION 5.00
  2. Begin VB.Form CopyPixForm 
  3.    Caption         =   "Pixel Copy"
  4.    ClientHeight    =   4545
  5.    ClientLeft      =   60
  6.    ClientTop       =   345
  7.    ClientWidth     =   8250
  8.    LinkTopic       =   "Form1"
  9.    PaletteMode     =   1  'UseZOrder
  10.    ScaleHeight     =   4545
  11.    ScaleWidth      =   8250
  12.    StartUpPosition =   3  'Windows Default
  13.    Begin VB.CommandButton Command4 
  14.       Caption         =   "E X I T"
  15.       BeginProperty Font 
  16.          Name            =   "Verdana"
  17.          Size            =   9
  18.          Charset         =   0
  19.          Weight          =   400
  20.          Underline       =   0   'False
  21.          Italic          =   0   'False
  22.          Strikethrough   =   0   'False
  23.       EndProperty
  24.       Height          =   375
  25.       Left            =   6720
  26.       TabIndex        =   5
  27.       Top             =   4080
  28.       Width           =   1455
  29.    End
  30.    Begin VB.CommandButton Command3 
  31.       Caption         =   "Copy Fast"
  32.       BeginProperty Font 
  33.          Name            =   "Verdana"
  34.          Size            =   9
  35.          Charset         =   0
  36.          Weight          =   400
  37.          Underline       =   0   'False
  38.          Italic          =   0   'False
  39.          Strikethrough   =   0   'False
  40.       EndProperty
  41.       Height          =   375
  42.       Left            =   3000
  43.       TabIndex        =   4
  44.       Top             =   4080
  45.       Width           =   1455
  46.    End
  47.    Begin VB.CommandButton Command2 
  48.       Caption         =   "Copy API"
  49.       BeginProperty Font 
  50.          Name            =   "Verdana"
  51.          Size            =   9.75
  52.          Charset         =   0
  53.          Weight          =   400
  54.          Underline       =   0   'False
  55.          Italic          =   0   'False
  56.          Strikethrough   =   0   'False
  57.       EndProperty
  58.       Height          =   375
  59.       Left            =   1560
  60.       TabIndex        =   3
  61.       Top             =   4080
  62.       Width           =   1455
  63.    End
  64.    Begin VB.PictureBox Picture2 
  65.       Height          =   3855
  66.       Left            =   4200
  67.       ScaleHeight     =   253
  68.       ScaleMode       =   3  'Pixel
  69.       ScaleWidth      =   261
  70.       TabIndex        =   2
  71.       Top             =   120
  72.       Width           =   3975
  73.    End
  74.    Begin VB.CommandButton Command1 
  75.       Caption         =   "Copy VB"
  76.       BeginProperty Font 
  77.          Name            =   "Verdana"
  78.          Size            =   9.75
  79.          Charset         =   0
  80.          Weight          =   400
  81.          Underline       =   0   'False
  82.          Italic          =   0   'False
  83.          Strikethrough   =   0   'False
  84.       EndProperty
  85.       Height          =   375
  86.       Left            =   120
  87.       TabIndex        =   1
  88.       Top             =   4080
  89.       Width           =   1455
  90.    End
  91.    Begin VB.PictureBox Picture1 
  92.       AutoSize        =   -1  'True
  93.       Height          =   3870
  94.       Left            =   120
  95.       Picture         =   "CopyPix.frx":0000
  96.       ScaleHeight     =   254
  97.       ScaleMode       =   3  'Pixel
  98.       ScaleWidth      =   263
  99.       TabIndex        =   0
  100.       Top             =   120
  101.       Width           =   4005
  102.    End
  103. Attribute VB_Name = "CopyPixForm"
  104. Attribute VB_GlobalNameSpace = False
  105. Attribute VB_Creatable = False
  106. Attribute VB_PredeclaredId = True
  107. Attribute VB_Exposed = False
  108. '  ******************************
  109. '  ******************************
  110. '  ** MASTERING VB6            **
  111. '  ** by Evangelos Petroutos   **
  112. '  ** SYBEX, 1998              **
  113. '  ******************************
  114. '  ******************************
  115. Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
  116. Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
  117. Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  118. Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
  119. Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
  120. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  121. Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
  122. Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
  123. Private Sub Command1_Click()
  124. Dim i As Integer, j As Integer
  125. Dim clrValue As Long
  126.     Screen.MousePointer = vbHourglass
  127.     Picture2.Cls
  128.     For i = 0 To Picture1.ScaleWidth - 1
  129.         For j = 0 To Picture1.ScaleHeight - 1
  130.             clrValue = Picture1.Point(i, j)
  131.             Picture2.PSet (i, j), clrValue
  132.         Next
  133.     Next
  134.     Screen.MousePointer = vbDefault
  135. End Sub
  136. Private Sub Command2_Click()
  137. Dim i As Integer, j As Integer
  138. Dim clrValue As Long
  139.     Screen.MousePointer = vbHourglass
  140.     Picture2.Cls
  141.     For i = 0 To Picture1.ScaleWidth - 1
  142.         For j = 0 To Picture1.ScaleHeight - 1
  143.             SetPixel Picture2.hdc, i, j, GetPixel(Picture1.hdc, i, j)
  144.         Next
  145.     Next
  146.     Screen.MousePointer = vbDefault
  147. End Sub
  148. Private Sub Command3_Click()
  149.     Picture2.Cls
  150.     Screen.MousePointer = vbHourglass
  151. ' set up source bitmap
  152.     hBMPSource = CreateCompatibleBitmap(Picture1.hdc, _
  153.            Picture1.ScaleWidth, Picture1.ScaleHeight)
  154.     hSourceDC = CreateCompatibleDC(Picture1.hdc)
  155.     SelectObject hSourceDC, hBMPSource
  156. ' set up destination bitmap
  157.     hBMPDest = CreateCompatibleBitmap(Picture2.hdc, _
  158.            Picture2.ScaleWidth, Picture2.ScaleHeight)
  159.     hDestDC = CreateCompatibleDC(Picture2.hdc)
  160.     SelectObject hDestDC, hBMPDest
  161. ' Copy picture bitmap to source bitmap
  162.     BitBlt hSourceDC, 0, 0, Picture1.ScaleWidth - 1, _
  163.            Picture1.ScaleHeight - 1, Picture1.hdc, 0, 0, &HCC0020
  164. ' Copy pixels between bitmaps
  165.     For i = 0 To Picture1.ScaleWidth - 1
  166.         For j = 0 To Picture1.ScaleHeight - 1
  167.             clr = GetPixel(hSourceDC, i, j)
  168.             SetPixel hDestDC, i, j, clr
  169.         Next
  170.     Next
  171. ' transfer the copied pixels to the second PictureBox
  172.     BitBlt Picture2.hdc, 0, 0, Picture1.ScaleWidth - 1, _
  173.            Picture1.ScaleHeight - 1, hDestDC, 0, 0, &HCC0020
  174.     'Picture2.Refresh
  175. ' finally, clean up memory
  176.     Call DeleteDC(hSourceDC)
  177.     Call DeleteObject(hBMPSource)
  178.     Call DeleteDC(hDestDC)
  179.     Call DeleteObject(hBMPDest)
  180.     Screen.MousePointer = vbDefault
  181. End Sub
  182. Private Sub Command4_Click()
  183.     End
  184. End Sub
  185. Private Sub Form_Load()
  186.     Picture2.Width = Picture1.Width
  187.     Picture2.Height = Picture1.Height
  188.     Picture2.Top = Picture1.Top
  189. End Sub
  190.