modCOMDLG32 -1118555947 215 100000918 215 100000721 215 209001836 215 0 modCOMDLG32 24 0 134217984 modCOMDLG32_Description 1 14 22 14 22 134217984 modCOMDLG32_Description '============================================================================================================= ' ' modCOMDLG32 Module ' ------------------ ' ' Created By : Kevin Wilson ' http://www.TheVBZone.com ( The VB Zone ) ' http://net.TheVBZone.com ( The VB Zone .NET ) ' http://rb.TheVBZone.com ( The VB Zone [RB] ) ' ' Created On : May 02, 2004 ' Last Update : Oct 06, 2004 ' ' RB Versions : 5.5 (or later) ' ' Requires : NOTHING ' ' Description : This module provides a quick and easy way to display all of the common dialogs to the user of ' your application. All parameters are defaulted and optional so displaying the dialog is as ' simple as calling the function name and getting the return. ' ' '============================================================================================================= ' ' LEGAL: ' ' You are free to use this code as long as you keep the above heading information intact and unchanged. Credit ' given where credit is due. Also, it is not required, but it would be appreciated if you would mention ' somewhere in your compiled program that that your program makes use of code written and distributed by ' Kevin Wilson (www.TheVBZone.com). Feel free to link to this code via your web site or articles. ' ' You may NOT take this code and pass it off as your own. You may NOT distribute this code on your own server ' or web site. You may NOT take code created by Kevin Wilson (www.TheVBZone.com) and use it to create products, ' utilities, or applications that directly compete with products, utilities, and applications created by Kevin ' Wilson, TheVBZone.com, or Wilson Media. You may NOT take this code and sell it for profit without first ' obtaining the written consent of the author Kevin Wilson. ' ' These conditions are subject to change at the discretion of the owner Kevin Wilson at any time without 27207761726E696E67206F72206E6F746963652E2020436F70797269676874C2A9206279204B6576696E2057696C736F6E2E2020416C6C207269676874732072657365727665642E ' '============================================================================================================= 134217984 ShowOpen FolderItem 0 2 0 2 0 134217984 Function ShowOpen() As FolderItem Return ShowOpen("C:\", "*.*", "All Files (*.*)", " Select File To Open...", (Screen(0).AvailableWidth - 400) / 2, (Screen(0).AvailableHeight - 300) / 2) End Function 134217984 ShowSave FolderItem 0 2 52 2 52 134217984 Function ShowSave() As FolderItem Return ShowSave("C:\", "*.*", "All Files (*.*)", " Select Path To Save To...", (Screen(0).AvailableWidth - 400) / 2, (Screen(0).AvailableHeight - 300) / 2) End Function 134217984 ShowColor Color 0 1 0 1 0 134217984 Function ShowColor() As Color Return ShowColor(&C000000, "Select Color") End Function 134217984 ShowFolder FolderItem 0 2 46 2 46 134217984 Function ShowFolder() As FolderItem Return ShowFolder("C:\", "Select Folder:", " Browse For Folder", (Screen(0).AvailableWidth - 400) / 2, (Screen(0).AvailableHeight - 400) / 2) End Function 134217984 ShowColor InitialColor As Color, Prompt As String Color 0 1 0 1 0 134217984 Function ShowColor(InitialColor As Color, Prompt As String) As Color '================================================================================================= ' SAMPLE USAGE: ' ------------- ' ' Dim oColor As Color ' oColor = ShowColor(&C00FF00, "Select Color") ' If IsNull(oColor) = False Then MsgBox CStr(oColor) ' '================================================================================================= Dim clrReturn As Color clrReturn = InitialColor If SelectColor(clrReturn, Prompt) = True Then Return clrReturn End If End Function 134217984 ShowFolder InitialDirectory As String, DialogPrompt As String, DialogTitle As String, DialogLocationLeft As Integer, DialogLocationTop As Integer FolderItem 0 12 19 12 37 134217984 Function ShowFolder(InitialDirectory As String, DialogPrompt As String, DialogTitle As String, DialogLocationLeft As Integer, DialogLocationTop As Integer) As FolderItem '================================================================================================= ' SAMPLE USAGE: ' ------------- ' ' Dim oFolder As FolderItem ' oFolder = ShowFolder("C:\", "Select Folder To Use:", "Browse...", (Screen(0).AvailableWidth - 400) / 2, (Screen(0).AvailableHeight - 400) / 2) ' If IsNull(oFolder) = False Then MsgBox oFolder.AbsolutePath ' '================================================================================================= Dim oDialog As SelectFolderDialog Dim oFolderItem As FolderItem Dim oInitDir As FolderItem ' Get the InitialDirectory in the form of a "FolderItem" oInitDir = GetFolderItem(InitialDirectory) If oInitDir <> Nil Then If oInitDir.Directory = False Then oInitDir = Nil End If End If ' Show the OPEN dialog oDialog = New SelectFolderDialog oDialog.InitialDirectory = oInitDir oDialog.PromptText = DialogPrompt oDialog.SuggestedFileName = "" oDialog.Title = DialogTitle oDialog.ActionButtonCaption = "&OK" oDialog.CancelButtonCaption = "&Cancel" oDialog.Filter = "" oDialog.Left = DialogLocationLeft oDialog.Top = DialogLocationTop oFolderItem = oDialog.ShowModal ' Clean up oDialog = Nil ' Return the value Return oFolderItem End Function 134217984 ShowOpen InitialDirectory As String, DefaultFileName As String, DialogFilter As String, DialogTitle As String, DialogLocationLeft As Integer, DialogLocationTop As Integer FolderItem 0 15 0 15 0 134217984 Function ShowOpen(InitialDirectory As String, DefaultFileName As String, DialogFilter As String, DialogTitle As String, DialogLocationLeft As Integer, DialogLocationTop As Integer) As FolderItem '================================================================================================= ' SAMPLE USAGE: ' ------------- ' ' Dim oFolder As FolderItem ' oFolder = ShowOpen("C:\", "*.txt", "All Text Files (*.txt)", "Select Text File To Open...", (Screen(0).AvailableWidth - 400) / 2, (Screen(0).AvailableHeight - 300) / 2) ' If IsNull(oFolder) = False Then MsgBox oFolder.AbsolutePath ' '================================================================================================= Dim oDialog As OpenDialog Dim oFolderItem As FolderItem Dim oInitDir As FolderItem ' Get the InitialDirectory in the form of a "FolderItem" oInitDir = GetFolderItem(InitialDirectory) If oInitDir <> Nil Then If oInitDir.Directory = False Then oInitDir = Nil End If End If ' Show the OPEN dialog oDialog = New OpenDialog oDialog.InitialDirectory = oInitDir oDialog.PromptText = "" oDialog.SuggestedFileName = DefaultFileName oDialog.Title = DialogTitle oDialog.ActionButtonCaption = "&Open" oDialog.CancelButtonCaption = "&Cancel" oDialog.Filter = DialogFilter oDialog.Left = DialogLocationLeft oDialog.Top = DialogLocationTop oFolderItem = oDialog.ShowModal ' Clean up oDialog = Nil ' Return the value Return oFolderItem End Function 134217984 ShowSave InitialDirectory As String, DefaultFileName As String, DialogFilter As String, DialogTitle As String, DialogLocationLeft As Integer, DialogLocationTop As Integer FolderItem 0 1 0 1 0 134217984 Function ShowSave(InitialDirectory As String, DefaultFileName As String, DialogFilter As String, DialogTitle As String, DialogLocationLeft As Integer, DialogLocationTop As Integer) As FolderItem '================================================================================================= ' NOTE: ' ----- ' If the file the user specifies already exists, they will automatically be prompted to overwrite ' the file by the "SaveAsDialog" class. ' ' SAMPLE USAGE: ' ------------- ' ' Dim oFolder As FolderItem ' oFolder = ShowSave("C:\", "*.txt", "All Text Files (*.txt)", "Specify Path To Save To...", (Screen(0).AvailableWidth - 400) / 2, (Screen(0).AvailableHeight - 300) / 2) ' If IsNull(oFolder) = False Then MsgBox oFolder.AbsolutePath ' '================================================================================================= Dim oDialog As SaveAsDialog Dim oFolderItem As FolderItem Dim oInitDir As FolderItem ' Get the InitialDirectory in the form of a "FolderItem" oInitDir = GetFolderItem(InitialDirectory) If oInitDir <> Nil Then If oInitDir.Directory = False Then oInitDir = Nil End If End If ' Show the SAVE dialog oDialog = New SaveAsDialog oDialog.InitialDirectory = oInitDir oDialog.PromptText = "" oDialog.SuggestedFileName = DefaultFileName oDialog.Title = DialogTitle oDialog.ActionButtonCaption = "&Save" oDialog.CancelButtonCaption = "&Cancel" oDialog.Filter = DialogFilter oDialog.Left = DialogLocationLeft oDialog.Top = DialogLocationTop oFolderItem = oDialog.ShowModal ' Clean up oDialog = Nil ' Return the value Return oFolderItem End Function 134217984 ShowFont String 0 4 23 4 23 134217984 Function ShowFont() As String Dim strName As String Dim intSize As Integer Dim blnBold As Boolean Dim blnItal As Boolean Dim blnUndr As Boolean Dim blnStrk As Boolean Dim clrColor As Color strName = "Arial" intSize = 12 blnBold = False blnItal = False blnUndr = False blnStrk = False clrColor = &C000000 Return ShowFont(strName, intSize, blnBold, blnItal, blnUndr, blnStrk, clrColor) End Function 134217984 ShowFont ByRef FontName As String, ByRef FontSize As Integer, ByRef FontBold As Boolean, ByRef FontItalic As Boolean, ByRef FontUnderline As Boolean, ByRef FontStrikeThru As Boolean, ByRef FontColor As Color String 0 211 0 211 13 134217984 Function ShowFont(ByRef FontName As String, ByRef FontSize As Integer, ByRef FontBold As Boolean, ByRef FontItalic As Boolean, ByRef FontUnderline As Boolean, ByRef FontStrikeThru As Boolean, ByRef FontColor As Color) As String '================================================================================================= ' SAMPLE USAGE: ' ------------- ' ' Dim strFontFace As String ' strFontFace = ShowFont() ' MsgBox "The user selected the font '" + strFontFace + "'" ' '================================================================================================= #If TargetWin32 = False Then Return "" #EndIf ' Common Dialog FONT information type 'Public Type CHOOSEFONT ' lStructSize As Long ' Size of this type / structure ' hwndOwner As Long ' Handle to the owner of the dialog ' hDC As Long ' Printer DC/IC or NULL ' lpLogFont As Long ' Pointer to a LOGFONT variable that contains information on the font ' iPointSize As Long ' 10 * size in points of selected font ' Flags As Long ' Sets / returns the flags for the dialog ' RGBColors As Long ' Returned text color ' lCustData As Long ' Data passed to hook function ' lpfnHook As Long ' Pointer to hook function ' lpTemplateName As String ' Custom template name ' hInstance As Long ' Instance handle of .EXE that contains custom dialog template ' lpszStyle As String ' Return the style field here must be LF_FACESIZE or bigger ' nFontType As Integer ' Same value reported to the EnumFonts call back with the extra FONTTYPE_ bits added ' MISSING_ALIGNMENT As Integer ' ** Used to align the structure to a WORD boundary. This should not be used or referenced. ' nSizeMin As Long ' Minimum pt size allowed ' nSizeMax As Long ' Maximum pt size allowed if CF_LIMITSIZE is used 'End Type ' Windows API FONT information type 'Public Type LOGFONT 272020206C66486569676874202020202020202020204173204C6F6E6720202020272053706563696669657320746865206865696768742C20696E206C6F676963616C20756E6974732C206F662074686520666F6E74E2809973206368617261637465722063656C6C206F7220636861726163746572 ' lfWidth As Long ' Specifies the average width, in logical units, of characters in the font ' lfEscapement As Long ' Specifies the angle, in tenths of degrees, between the escapement vector and the x-axis of the device. The escapement vector is parallel to the base line of a row of text 272020206C664F7269656E746174696F6E20202020204173204C6F6E672020202027205370656369666965732074686520616E676C652C20696E2074656E746873206F6620646567726565732C206265747765656E206561636820636861726163746572E28099732062617365206C696E6520616E642074686520782D61786973206F662074686520646576696365 ' lfWeight As Long ' Specifies the weight of the font in the range 0 through 1000 (See Constants) ' lfItalic As Byte ' Specifies an italic font if set to TRUE (1) ' lfUnderline As Byte ' Specifies an underlined font if set to TRUE (1) ' lfStrikeOut As Byte ' Specifies a strikeout font if set to TRUE (1) ' lfCharSet As Byte ' Specifies the character set (See Constants) 272020206C664F7574507265636973696F6E202020204173204279746520202020272053706563696669657320746865206F757470757420707265636973696F6E2E20546865206F757470757420707265636973696F6E20646566696E657320686F7720636C6F73656C7920746865206F7574707574206D757374206D61746368207468652072657175657374656420666F6E74E2809973206865696768742C2077696474682C20636861726163746572206F7269656E746174696F6E2C206573636170656D656E742C2070697463682C20616E6420666F6E742074797065202853656520436F6E7374616E747329 ' lfClipPrecision As Byte ' Specifies the clipping precision. The clipping precision defines how to clip characters that are partially outside the clipping region ' lfQuality As Byte ' Specifies the output quality. The output quality defines how carefully the graphics device interface (GDI) must attempt to match the logical-font attributes to those of an actual physical font (See Constants) ' lfPitchAndFamily As Byte ' Specifies the pitch and family of the font. The two low-order bits specify the pitch of the font (See Constants) - Bits 4 through 7 of the member specify the font family (See Constants) ' lfFaceName As String * 32 ' A null-terminated string that specifies the typeface name of the font. The length of this string must not exceed 32 characters, including the null terminator. The EnumFontFamilies function can be used to enumerate the typeface names of all currently available fonts. If lfFaceName is an empty string, GDI uses the first font that matches the other specified attributes. 'End Type Declare Function GlobalAlloc Lib "KERNEL32.DLL" (ByVal wFlags As Integer, ByVal dwBytes As Integer) As Integer Declare Function GlobalLock Lib "KERNEL32.DLL" (ByVal hMemory As Integer) As Integer Declare Function GlobalUnlock Lib "KERNEL32.DLL" (ByVal hMemory As Integer) As Integer Declare Function GlobalFree Lib "KERNEL32.DLL" (ByVal hMemory As Integer) As Integer Declare Function ChooseFontA Lib "COMDLG32.DLL" (ByVal pChoosefont As Ptr) As Integer Dim ReturnCode As Integer Dim FontInfo As MemoryBlock 'CHOOSEFONT Dim TheLogFont As MemoryBlock 'LOGFONT Dim intTemp As Integer Dim FontType As Integer Dim Temp_FontBold As Integer Dim Temp_FontItalic As Integer Dim Temp_FontStrikeThru As Integer Dim Temp_FontUnderline As Integer Dim BoldFlag As Integer Dim hLogFont As Integer '(Handle to TheLogFont memory buffer) Dim pLogFont As Integer '(Pointer to TheLogFont memory buffer) Dim intFlags As Integer Dim intColor As Integer Dim strRED As String Dim strGRN As String Dim strBLU As String Dim intRED As Integer Dim intGRN As Integer Dim intBLU As Integer Dim intCounter As Integer Dim blnReturn As Boolean TheLogFont = NewMemoryBlock(60) FontInfo = NewMemoryBlock(60) ' Setup the flags to tell what the dialog what to display intFlags = 323 ' CF_INITTOLOGFONTSTRUCT + CF_SCREENFONTS + CF_PRINTERFONTS + CF_EFFECTS ' Set the FontBold information If FontBold = True Then Temp_FontBold = 1 FontType = FontType + 256 'BOLD_FONTTYPE BoldFlag = 700 'FW_BOLD Else Temp_FontBold = 0 FontType = FontType + 1024 'REGULAR_FONTTYPE BoldFlag = 400 'FW_NORMAL End If ' Set the FontItalic information If FontItalic = True Then Temp_FontItalic = 1 FontType = FontType + 512 'ITALIC_FONTTYPE End If ' Set the FontStrikeThru information If FontStrikethru = True Then Temp_FontStrikeThru = 1 ' Set the FontUnderline information If FontUnderline = True Then Temp_FontUnderline = 1 ' Get the Win32 color value from the specified COLOR object strRED = Right("0" + HEX(FontColor.Red), 2) strGRN = Right("0" + HEX(FontColor.Green), 2) strBLU = Right("0" + HEX(FontColor.Blue), 2) intColor = CDbl("&H" + strBLU + strGRN + strRED) ' Setup the LOGFONT structure to pass in TheLogFont.Long(0) = 0 'lfHeight TheLogFont.Long(4) = 0 'lfWidth TheLogFont.Long(8) = 0 'lfEscapement TheLogFont.Long(12) = 0 'lfOrientation TheLogFont.Long(16) = BoldFlag 'lfWeight TheLogFont.Byte(20) = Temp_FontItalic 'lfItalic TheLogFont.Byte(21) = Temp_FontUnderline 'lfUnderline TheLogFont.Byte(22) = Temp_FontStrikeThru 'lfStrikeOut TheLogFont.Byte(23) = 1' DEFAULT_CHARSET 'lfCharSet TheLogFont.Byte(24) = 0 'OUT_DEFAULT_PRECIS 'lfOutPrecision TheLogFont.Byte(25) = 0 'CLIP_DEFAULT_PRECIS 'lfClipPrecision TheLogFont.Byte(26) = 0 'DEFAULT_QUALITY 'lfQuality TheLogFont.Byte(27) = 16 'DEFAULT_PITCH + FF_ROMAN 'lfPitchAndFamily TheLogFont.StringValue(28, 32) = FontName + Chr(0) 'lfFaceName ' Copy the LOGFONT variable to a memory address to get it's pointer hLogFont = GlobalAlloc(66, 60) '[GMEM_MOVEABLE + GMEM_ZEROINIT = 66] ' Allocate a memory buffer to store the LOGFONT variable in pLogFont = GlobalLock(hLogFont) ' Lock the allocated memory buffer just created and get a pointer to it If pLogFont <> 0 Then CopyMemory2 pLogFont, TheLogFont, 60 ' Copy structure's content into the newly created memory buffer End If ' Setup the CHOOSEFONT variable to be passed FontInfo.Long(0) = 60 'lStructSize FontInfo.Long(4) = 0 'hwndOwner FontInfo.Long(8) = 0 'hDC FontInfo.Long(12) = pLogFont 'lpLogFont FontInfo.Long(16) = FontSize * 10 'iPointSize FontInfo.Long(20) = intFlags 'Flags FontInfo.Long(24) = intColor 'RGBColors FontInfo.Long(28) = 0 'lCustData FontInfo.Long(32) = 0 'lpfnHook FontInfo.Long(36) = 0 'lpTemplateName //LPCSTR = POINTER to a string... POINTER = 4 bytes FontInfo.Long(40) = 0 'hInstance FontInfo.Long(44) = 0 'lpszStyle //LPCSTR = POINTER to a string... PONITER = 4 bytes FontInfo.Short(48) = FontType 'nFontType FontInfo.Short(50) = 0 'MISSING_ALIGNMENT FontInfo.Long(52) = 6 'nSizeMin FontInfo.Long(56) = 72 'nSizeMax ' Display the dialog ReturnCode = ChooseFontA(FontInfo) ' User canceled, or an error occured. Clear the return valuies If ReturnCode = 0 Then intFlags = 0 FontName = "" FontSize = 0 FontBold = False FontItalic = False FontStrikethru = False FontUnderline = False intColor = 0 blnReturn = False ' Return the information Else CopyMemory1 TheLogFont, pLogFont, 60 ' Copy the LOGFONT information back to the original variable intFlags = FontInfo.Long(20) 'FontInfo.Flags FontName = TheLogFont.StringValue(28, 32)'TheLogFont.lfFaceName FontName = Left(FontName, InStr(FontName, Chr(0)) - 1) FontSize = FontInfo.Long(16) / 10 'FontInfo.iPointSize FontBold = False If TheLogFont.Long(16) > 400 Then FontBold = True '[FW_NORMAL = 400] 'TheLogFont.lfWeight FontItalic = False If TheLogFont.Byte(20) = 1 Then FontItalic = True 'TheLogFont.lfItalic FontUnderline = False If TheLogFont.Byte(21) = 1 Then FontUnderline = True 'TheLogFont.lfUnderline FontStrikethru = False If TheLogFont.Byte(22) = 1 Then FontStrikethru = True 'TheLogFont.lfStrikeOut intColor = FontInfo.Long(24) 'FontInfo.RGBColors blnReturn = True End If ' Get a COLOR object from the returned Win32 color value intRED = Bitwise.BitAnd(intColor, 255) intGRN = Bitwise.BitAnd(intColor, 65280) \ 256 intBLU = Bitwise.BitAnd(intColor, 16711680) \ 65536 FontColor = RGB(intRED, intGRN, intBLU) ' Clean up intTemp = GlobalUnlock(hLogFont) intTemp = GlobalFree(hLogFont) TheLogFont = Nil FontInfo = Nil Return FontName Exception Err As RuntimeException MsgBox "The following error occured: " + CStr(Err.ErrorNumber) + " [" + Err.Message + "]" TheLogFont = Nil FontInfo = Nil End Function 134217984 ShowPrinter Graphics 0 4 0 4 0 134217984 Function ShowPrinter() As Graphics Dim PageSetup As PrinterSetup Dim objReturn As Graphics PageSetup = New PrinterSetup objReturn = OpenPrinterDialog(PageSetup) PageSetup = Nil Return objReturn End Function 134217984 ShowPrinter ByRef Return_Width As Integer, ByRef Return_Height As Integer, ByRef Return_PageWidth As Integer, ByRef Return_PageHeight As Integer, ByRef Return_ResolutionX As Integer, ByRef Return_ResolutionY As Integer Graphics 0 16 0 16 0 134217984 Function ShowPrinter(ByRef Return_Width As Integer, ByRef Return_Height As Integer, ByRef Return_PageWidth As Integer, ByRef Return_PageHeight As Integer, ByRef Return_ResolutionX As Integer, ByRef Return_ResolutionY As Integer) As Graphics '================================================================================================= ' NOTE: ' ----- ' If the file the user specifies already exists, they will automatically be prompted to overwrite ' the file by the "SaveAsDialog" class. ' ' SAMPLE USAGE: ' ------------- ' ' Dim oFolder As FolderItem ' oFolder = ShowSave("C:\", "*.txt", "All Text Files (*.txt)", "Specify Path To Save To...", (Screen(0).AvailableWidth - 400) / 2, (Screen(0).AvailableHeight - 300) / 2) ' If IsNull(oFolder) = False Then MsgBox oFolder.AbsolutePath ' '================================================================================================= Dim PageSetup As PrinterSetup Dim objReturn As Graphics PageSetup = New PrinterSetup objReturn = OpenPrinterDialog(PageSetup) If IsNull(objReturn) = False Then Return_Width = PageSetup.Width Return_Height = PageSetup.Height Return_PageWidth = PageSetup.PageWidth Return_PageHeight = PageSetup.PageHeight Return_ResolutionX = PageSetup.HorizontalResolution Return_ResolutionY = PageSetup.VerticalResolution Else Return_Width = -1 Return_Height = -1 Return_PageWidth = -1 Return_PageHeight = -1 Return_ResolutionX = -1 Return_ResolutionY = -1 End If PageSetup = Nil Return objReturn End Function 134217984 ShowPrinterSetup ByRef Return_Width As Integer, ByRef Return_Height As Integer, ByRef Return_PageWidth As Integer, ByRef Return_PageHeight As Integer, ByRef Return_ResolutionX As Integer, ByRef Return_ResolutionY As Integer Boolean 0 20 0 20 0 134217984 Function ShowPrinterSetup(ByRef Return_Width As Integer, ByRef Return_Height As Integer, ByRef Return_PageWidth As Integer, ByRef Return_PageHeight As Integer, ByRef Return_ResolutionX As Integer, ByRef Return_ResolutionY As Integer) As Boolean '================================================================================================= ' ' SAMPLE USAGE: ' ------------- ' ' Dim intWidth As Integer ' Dim intHeight As Integer ' Dim intPageWidth As Integer ' Dim intPageHeight As Integer ' Dim intResX As Integer ' Dim intResY As Integer ' If ShowPrinterSetup(intWidth, intHeight, intPageWidth, intPageHeight, intResX, intResY) = False Then ' MsgBox "User Canceled" ' End If ' '================================================================================================= Dim PageSetup As PrinterSetup PageSetup = New PrinterSetup If PageSetup.PageSetupDialog() = True Then Return_Width = PageSetup.Width Return_Height = PageSetup.Height Return_PageWidth = PageSetup.PageWidth Return_PageHeight = PageSetup.PageHeight Return_ResolutionX = PageSetup.HorizontalResolution Return_ResolutionY = PageSetup.VerticalResolution Return True Else Return_Width = -1 Return_Height = -1 Return_PageWidth = -1 Return_PageHeight = -1 Return_ResolutionX = -1 Return_ResolutionY = -1 Return False End If End Function 134217984 ShowPicture objPicture As Picture 0 1 0 1 0 134217984 Sub ShowPicture(objPicture As Picture) Dim blnReturn As Boolean blnReturn = ShowPicture(objPicture) End Sub 134217984 ShowPicture objPicture As Picture Boolean 0 19 0 19 0 134217984 Function ShowPicture(objPicture As Picture) As Boolean '================================================================================================= ' NOTE: ' ----- ' This function takes the specified picture and prompts the user where to save ' it and what format to save it as ' ' SAMPLE USAGE: ' ------------- ' ' Dim objPic As Picture ' If ShowPicture(objPic) = True Then ' MsgBox "Successfully saved picture to the location the user selected" ' Else ' MsgBox "User canceled" ' End If ' '================================================================================================= Return ExportPicture(objPicture) End Function 134217984 CopyMemory1 ByRef ptrDestination As MemoryBlock, ByVal intSource As Integer, ByVal intBufferSize As Integer 33 2 0 2 8 134217984 Sub CopyMemory1(ByRef ptrDestination As MemoryBlock, ByVal intSource As Integer, ByVal intBufferSize As Integer) Declare Sub RtlMoveMemory Lib "KERNEL32.DLL" (ByVal ptrDest As Ptr, ByVal intSrc As Integer, ByVal intBufferSize As Integer) RtlMoveMemory ptrDestination, intSource, intBufferSize End Sub 134217984 CopyMemory3 ByRef ptrDestination As MemoryBlock, ByRef ptrSource As MemoryBlock, ByVal intBufferSize As Integer 33 2 0 2 8 134217984 Sub CopyMemory3(ByRef ptrDestination As MemoryBlock, ByRef ptrSource As MemoryBlock, ByVal intBufferSize As Integer) Declare Sub RtlMoveMemory Lib "KERNEL32.DLL" (ByVal ptrDest As Ptr, ByVal ptrSrc As Ptr, ByVal intBufferSize As Integer) RtlMoveMemory ptrDestination, ptrSource, intBufferSize End Sub 134217984 CopyMemory2 ByVal intDestination As Integer, ByRef ptrSource As MemoryBlock, ByVal intBufferSize As Integer 33 2 0 2 8 134217984 Sub CopyMemory2(ByVal intDestination As Integer, ByRef ptrSource As MemoryBlock, ByVal intBufferSize As Integer) Declare Sub RtlMoveMemory Lib "KERNEL32.DLL" (ByVal intDest As Integer, ByVal ptrSrc As Ptr, ByVal intBufferSize As Integer) RtlMoveMemory intDestination, ptrSource, intBufferSize End Sub 134217984 CopyMemory4 ByVal intDestination As Integer, ByVal intSource As Integer, ByVal intBufferSize As Integer 33 1 0 1 0 134217984 Sub CopyMemory4(ByVal intDestination As Integer, ByVal intSource As Integer, ByVal intBufferSize As Integer) Declare Sub RtlMoveMemory Lib "KERNEL32.DLL" (ByVal intDest As Integer, ByVal intSrc As Integer, ByVal intBufferSize As Integer) RtlMoveMemory intDestination, intSource, intBufferSize End Sub