×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

Saving a graphic file as a BMP from the clipboard.

Saving a graphic file as a BMP from the clipboard.

Saving a graphic file as a BMP from the clipboard.

(OP)
Good morning. I am working on an application that will take a graphic file that is copied to the clipboard and save it as a bitmap file. After I came up with this code I figured out how to add a line that determines what the default folder is, but I do not know how to determine the default file extension.

Thank you in advance for your help.


Option Compare Database

Private Declare Sub keybd_event Lib "User32" (ByVal bVk As Byte, ByVal _
bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, _
RefIID As Guid, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
Private Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
Private Declare Function GetClipboardData Lib "User32" (ByVal wFormat As Long) As Long
Private Declare Function CloseClipboard Lib "User32" () As Long
Private Declare Function EmptyClipboard Lib "User32" () As Long
Private Const VK_MENU = &H12
Private Const VK_SNAPSHOT = &H2C
Private Const KEYEVENTF_KEYUP = &H2
Private Const CF_BITMAP = 2
Private Type PicBmp
Size As Long
Type As Long
hBmp As Long
hPal As Long
Reserved As Long
End Type
Private Type Guid
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type

Public Function SaveBitmap() As String
On Error GoTo errorEncountered

Dim Pic As PicBmp, IPic As IPicture, IID_IDispatch As Guid, strFileName As String
Dim theCnt As Integer, theMsg As String

Dim fDialog As Office.FileDialog

strFileName = ""

' Set up the File Dialog.
Set fDialog = Application.FileDialog(msoFileDialogSaveAs)

theCnt = 0

'startOver:
' theCnt = theCnt + 1
' keybd_event VK_MENU, 0, 0, 0 'press Alt
' keybd_event VK_SNAPSHOT, 0, 0, 0 'press PrintScrnOffice.FileDialog

' keybd_event VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 0 'release it
' keybd_event VK_MENU, 0, KEYEVENTF_KEYUP, 0 'release it
' DoEvents

With fDialog
' Allow user to make multiple selections in dialog box
.AllowMultiSelect = False

' 'Add a filter that includes GIF and JPEG images and make it the second item in the list.
' .Filters.Add "Images", "*.bmp", 2

' 'Sets the initial file filter to number 2.
' .FilterIndex = 2

' Set the title of the dialog box.
.title = "Please give your file a name."


' Show the dialog box. If the .Show method returns True, the
' user picked at least one file. If the .Show method returns
' False, the user clicked Cancel.
If .Show = True Then
strFileName = .SelectedItems(1)

With IID_IDispatch
.Data1 = &H20400
.Data4(0) = &HC0
.Data4(7) = &H46
End With

With Pic
Call OpenClipboard(0&)
.Size = Len(Pic)
.Type = 1
.hBmp = GetClipboardData(CF_BITMAP)
End With

OleCreatePictureIndirect Pic, IID_IDispatch, 1, IPic ' Create the picture object

If theCnt = 1 Then
theMsg = MsgBox("Click ok to save the file.", vbOKOnly + vbInformation)
DoEvents
'If theMsg = 1 Then GoTo startOver
End If

stdole.SavePicture IPic, strFileName ' Save the file
Else
MsgBox "You clicked Cancel in the file dialog box."
End If
End With

SaveBitmap = strFileName

Exit Function

errorEncountered:
If Err.Number <> 0 Then
Call LogError(Err.Number, Err.description, "SaveBitmap")
End If

Call EmptyClipboard ' Empty the clipboard
Call CloseClipboard ' Close the clipboard
End Function




Private Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "User32" () As Long
Private Declare Function EmptyClipboard Lib "User32" () As Long

Private Sub AddGraphicFileButton_Click()
On Error GoTo Err_SomeName

Dim fDialog As Office.FileDialog
Dim varFile As Variant
Dim Source As String
Dim sField As String
Dim db As Database
Dim rs As Recordset
Dim FileLength As Long
Dim CNCProgramID As Long

Set db = CurrentDb

Set rs = db.OpenRecordset("SELECT GraphicLocation FROM CNCProgrammingSheetQuery WHERE CNCProgramID = " & Me.CNCProgramID.value, dbOpenDynaset)

Source = SaveBitmap()

If Len(Trim(Source)) > 0 And rs.RecordCount = 1 Then
rs.MoveFirst
rs.Edit
rs!GraphicLocation = Source
rs.Update
End If

rs.Close
Set rs = Nothing

Call OpenClipboard(0&)
EmptyClipboard
CloseClipboard

Me.Refresh

Exit Sub

Err_SomeName:
'Any unexpected error.
Call LogError(Err.Number, Err.description, "CNCProgrammingSheetForm.AddGraphicFileButton_Click")
Resume Next
End Sub

RE: Saving a graphic file as a BMP from the clipboard.

That's just my opinion, but very few people will be willing to decipher your code when you do not use TGML tags to show your code:

See how much easier it is to see your logic?

CODE

With fDialog
    ...
    ' Show the dialog box. If the .Show method returns True, the
    ' user picked at least one file. If the .Show method returns
    ' False, the user clicked Cancel.
    If .Show = True Then
        strFileName = .SelectedItems(1)
        
        With IID_IDispatch
            .Data1 = &H20400
            .Data4(0) = &HC0
            .Data4(7) = &H46
        End With
    
        With Pic
        Call OpenClipboard(0&)
            .Size = Len(Pic)
            .Type = 1
            .hBmp = GetClipboardData(CF_BITMAP)
        End With
    
        OleCreatePictureIndirect Pic, IID_IDispatch, 1, IPic ' Create the picture object
    
        If theCnt = 1 Then
            theMsg = MsgBox("Click ok to save the file.", vbOKOnly + vbInformation)
            DoEvents
            'If theMsg = 1 Then GoTo startOver
        End If
    
        stdole.SavePicture IPic, strFileName ' Save the file
     Else
        MsgBox "You clicked Cancel in the file dialog box."
     End If
 End With

 SaveBitmap = strFileName 


---- Andy

There is a great need for a sarcasm font.

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members!

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close