home *** CD-ROM | disk | FTP | other *** search
/ Mastering Visual Basic 5 / MasteringVisualBasic5.iso / ch_code / ch12 / copybmp / copybmp.frm (.txt) next >
Encoding:
Visual Basic Form  |  1997-02-20  |  6.3 KB  |  164 lines
  1. VERSION 5.00
  2. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.1#0"; "COMDLG32.OCX"
  3. Begin VB.Form Form1 
  4.    ClientHeight    =   7620
  5.    ClientLeft      =   60
  6.    ClientTop       =   330
  7.    ClientWidth     =   8010
  8.    LinkTopic       =   "Form1"
  9.    ScaleHeight     =   7620
  10.    ScaleWidth      =   8010
  11.    StartUpPosition =   3  'Windows Default
  12.    Begin MSComDlg.CommonDialog CommonDialog1 
  13.       Left            =   6600
  14.       Top             =   375
  15.       _ExtentX        =   847
  16.       _ExtentY        =   847
  17.       _Version        =   327680
  18.       FontSize        =   1.17491e-38
  19.    End
  20.    Begin VB.Frame Frame2 
  21.       Caption         =   "Copied Image"
  22.       BeginProperty Font 
  23.          Name            =   "Trebuchet MS"
  24.          Size            =   9.75
  25.          Charset         =   0
  26.          Weight          =   400
  27.          Underline       =   0   'False
  28.          Italic          =   0   'False
  29.          Strikethrough   =   0   'False
  30.       EndProperty
  31.       Height          =   3420
  32.       Left            =   120
  33.       TabIndex        =   3
  34.       Top             =   4050
  35.       Width           =   6135
  36.       Begin VB.PictureBox Picture2 
  37.          Height          =   2955
  38.          Left            =   150
  39.          ScaleHeight     =   2895
  40.          ScaleWidth      =   5790
  41.          TabIndex        =   4
  42.          Top             =   345
  43.          Width           =   5850
  44.       End
  45.    End
  46.    Begin VB.CommandButton Command1 
  47.       Caption         =   "Copy Image"
  48.       BeginProperty Font 
  49.          Name            =   "Trebuchet MS"
  50.          Size            =   9.75
  51.          Charset         =   0
  52.          Weight          =   400
  53.          Underline       =   0   'False
  54.          Italic          =   0   'False
  55.          Strikethrough   =   0   'False
  56.       EndProperty
  57.       Height          =   615
  58.       Left            =   6435
  59.       TabIndex        =   1
  60.       Top             =   6810
  61.       Width           =   1455
  62.    End
  63.    Begin VB.Frame Frame1 
  64.       Caption         =   "Original Picture"
  65.       BeginProperty Font 
  66.          Name            =   "Trebuchet MS"
  67.          Size            =   9.75
  68.          Charset         =   0
  69.          Weight          =   400
  70.          Underline       =   0   'False
  71.          Italic          =   0   'False
  72.          Strikethrough   =   0   'False
  73.       EndProperty
  74.       Height          =   3435
  75.       Left            =   120
  76.       TabIndex        =   0
  77.       Top             =   120
  78.       Width           =   6135
  79.       Begin VB.PictureBox Picture1 
  80.          Height          =   2940
  81.          Left            =   150
  82.          ScaleHeight     =   2880
  83.          ScaleWidth      =   5805
  84.          TabIndex        =   2
  85.          Top             =   360
  86.          Width           =   5865
  87.       End
  88.    End
  89. Attribute VB_Name = "Form1"
  90. Attribute VB_GlobalNameSpace = False
  91. Attribute VB_Creatable = False
  92. Attribute VB_PredeclaredId = True
  93. Attribute VB_Exposed = False
  94. Option Explicit
  95. Const GMEM_MOVEABLE = &H2
  96. Const GMEM_ZEROINIT = &H40
  97. Const GENERIC_READ = &H80000000
  98. Const GENERIC_WRITE = &H40000000
  99. Const OPEN_EXISTING = 3
  100. Const FILE_ATTRIBUTE_NORMAL = &H80
  101. Const CREATE_NEW = 1
  102. Const CREATE_ALWAYS = 2
  103. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal dest As Any, ByVal Src As Any, _
  104.                                                 ByVal length As Long)
  105.                                                 
  106. Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
  107.     ByVal dwBytes As Long) As Long
  108. Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
  109. Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
  110. Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
  111. Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" _
  112.     (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, _
  113.     ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Any, _
  114.     ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, _
  115.     ByVal hTemplateFile As Long) As Long
  116. Private Declare Function ReadFileLong Lib "kernel32" Alias "ReadFile" (ByVal hFile As Long, _
  117.     lpBuffer As Long, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, _
  118.     ByVal lpOverlapped As Any) As Long
  119. Private Declare Function WriteFileLong Lib "kernel32" Alias "WriteFile" (ByVal hFile As Long, _
  120.     lpBuffer As Long, ByVal nNumberOfBytesToWrite As Long, _
  121.     lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Any) As Long
  122. Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, _
  123.     lpFileSizeHigh As Long) As Long
  124. Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
  125. Dim filePointer As Long
  126. Private Sub Command1_Click()
  127.     Dim memHandle As Long
  128.     Dim memPointer As Long
  129.     Dim fileName As String
  130.     Dim retValue As Long
  131.     Dim nBytes As Long
  132.     Dim fileSize As Long
  133.     Dim origStr As String
  134.     Dim strSize As Long
  135.     Dim textStr As String
  136.         
  137. On Error GoTo noFileName
  138.     CommonDialog1.cancelerror = True
  139.     CommonDialog1.showopen
  140.     fileName = CommonDialog1.fileName
  141.     Picture1.Picture = LoadPicture(fileName)
  142.     filePointer = CreateFile(fileName, GENERIC_READ Or GENERIC_WRITE, 0&, 0&, OPEN_EXISTING, _
  143.                                 FILE_ATTRIBUTE_NORMAL, 0&)
  144.     fileSize = GetFileSize(filePointer, 0)
  145.     memHandle = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, fileSize)
  146.     memPointer = GlobalLock(memHandle)
  147.     retValue = ReadFileLong(filePointer, ByVal memPointer, fileSize, nBytes, 0&)
  148.     CloseHandle (filePointer)
  149.     MsgBox "Image copied. Click on OK to save it on disk."
  150.        
  151.     'New file
  152.     CommonDialog1.showopen
  153.     fileName = CommonDialog1.fileName
  154.     filePointer = CreateFile(fileName, GENERIC_READ Or GENERIC_WRITE, 0&, 0&, CREATE_ALWAYS, _
  155.                                 FILE_ATTRIBUTE_NORMAL, 0&)
  156.     retValue = WriteFileLong(filePointer, ByVal memPointer, fileSize, nBytes, 0&)
  157.     CloseHandle (filePointer)
  158.     GlobalUnlock (memHandle)
  159.     GlobalFree (memHandle)
  160.     Picture2.Picture = LoadPicture(fileName)
  161.     Exit Sub
  162. noFileName:
  163. End Sub
  164.