Visual Basic File Routines
Pure VB: Combine Multiple Elements into a Single File
Posted:   Sunday May 07, 2000
Updated:   Monday December 26, 2011
Applies to:   VB3, VB4-32, VB5, VB6
Developed with:   VB6, Windows NT4
OS restrictions:   None
Author:   Larry Serflaten, VBnet - Randy Birch


Pure VB: Combine a Picture and Text into a Single File
RegSetValueEx: Create a Registered File Association

The basic code above saved an picture and textbox data into a combined file. The principle behind doing this can easily be extended to accommodate pretty well any type of file data. In this example a picture, as well as the contents of three Rich Text boxes, are saved to the composite-data file.

In order to accommodate the file offset values required to track the data's position within the file, and to make handling those values easier in code, I've changed the method of saving a Long offset into saving a UDT containing variables for all the data required. This also facilitates extending this metaphor to handle any number of controls.

To create the demo load any image into a picture box. To show how the Rich Text formatting is preserved when saved to the composite file, I've set the Rich Text strings in the Form Load event to create the RTF contents shown in the illustration. The RTF formatting of these string necessitate a somewhat wider page than I prefer.

The listbox data shown is strictly debugging only and is not required in production; it shows the relative values retrieved by the UDT in the first step of the Extract method.

 BAS Module Code

 Form Code
To a form, add a picture box (Picture1), a list box (List1), and three Rich Text controls (RichTextBox1, RichTextBox2 and RichTextBox3).  Load an image of your choice into Picture1. The code below populates the RTF controls.  Add three command buttons (Command1, Command2, and Command3) along with the following code:

Option Explicit
' Copyright 1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
Private Type MultiFileStoreData
   imgStart    As Long
   imgSize     As Long
   txt1Start   As Long
   txt1Size    As Long
   txt2Start   As Long
   txt2Size    As Long
   txt3Start   As Long
   txt3Size    As Long
End Type

Const sPicFileSource = "vbnlogo.gif"
Const sCombinedFile = "combined.dat"
Const sTmpPix = "tmp.gif"

Private Sub Form_Load()

Picture1.Picture = LoadPicture(sPicFileSource)
RichTextBox1 = "{\rtf1\ansi\ansicpg1252\deff0\deftab720{\fonttbl{\f0\fswiss MS Sans Serif;}" & _
               "{\f1\froman\fcharset2 Symbol;}{\f2\froman Times New Roman;}}" & _
               "{\colortbl\red0\green0\blue0;\red0\green0\blue255;\red255\green0\blue0;}" & _
               "\deflang1033\pard\plain\f0\fs16\cf0 Welcome to " & _
               "\plain\f0\fs16\cf1\b VBnet\plain\f0\fs16\cf0," & _
               " providing the enhanced functionality of the " & _
               "\plain\f0\fs16\cf2\b win32 api \plain\f0\fs16\cf0" & _
               " to \plain\f0\fs16\cf0\i\ul intermediate and advanced " & _
               "visual basic developers\plain\f0\fs16\cf0." & _
               "\plain\f2\fs20 \par}"

RichTextBox2 = "{\rtf1\ansi\ansicpg1252\deff0\deftab720{\fonttbl{\f0\fswiss MS Sans Serif;}" & _
               "{\f1\froman\fcharset2 Symbol;}{\f2\froman Times New Roman;}" & _
               "{\f3\fswiss\fprq2 MS Sans Serif;}}" & _
               "{\colortbl\red0\green0\blue0;}" & _
               "\deflang1033\pard\plain\f3\fs16\cf0 All code is provided " & _
               "free of charge.\plain\f2\fs20 \par}"

RichTextBox3 = "{\rtf1\ansi\ansicpg1252\deff0\deftab720{\fonttbl{\f0\fswiss MS Sans Serif;}" & _
               "{\f1\froman\fcharset2 Symbol;}{\f2\froman Times New Roman;}" & _
               "{\f3\fswiss\fprq2 MS Sans Serif;}}" & _
               "{\colortbl\red0\green0\blue0;\red128\green0\blue128;\red255\green0\blue0;}" & _
               "\deflang1033\pard\plain\f3\fs16\cf0 Remember to visit the \plain\f3\fs16\cf2 links" & _
               " \plain\f3\fs16\cf0 on the \plain\f3\fs16\cf1\plain\f3\fs16\cf0  and " & _
               "\plain\f3\fs16\cf1 Best Links \plain\f3\fs16\cf0 pages.\plain\f2\fs20 \par}"
End Sub

Private Sub Command1_Click()

   Dim hFile As Long
   Dim tmp As String
   Dim mfs As MultiFileStoreData

  'save the picture portion as the first entry
  'in the "combined file"
   SavePicture Picture1.Picture, sCombinedFile
  'Open the combined file for Binary to
  'add the text to file
   hFile = FreeFile
   Open sCombinedFile For Binary As #hFile
     'Retrieve the size of the image into a
     'variable for later use, then append the
     'text from Richtext1 into the same file
     'and close it.
      mfs.imgStart = 1
      mfs.imgSize = LOF(hFile)
      With RichTextBox1
         .SelStart = 0
         .SelLength = Len(.Text)
         tmp = .SelRTF
         mfs.txt1Start = mfs.imgSize + 1
         mfs.txt1Size = Len(tmp)
         Seek #hFile, mfs.txt1Start
         Put #hFile, , tmp
      End With
      With RichTextBox2
         .SelStart = 0
         .SelLength = Len(.Text)
         tmp = .SelRTF
         mfs.txt2Start = mfs.txt1Start + mfs.txt1Size + 1
         mfs.txt2Size = Len(tmp)
         Seek #hFile, mfs.txt2Start
         Put #hFile, , tmp
      End With
      With RichTextBox3
         .SelStart = 0
         .SelLength = Len(.Text)
         tmp = .SelRTF
         mfs.txt3Start = mfs.txt2Start + mfs.txt2Size + 1
         mfs.txt3Size = Len(tmp)
         Seek #hFile, mfs.txt3Start
         Put #hFile, , tmp
      End With
     'The file now contains both the image
     'and text file. As a final step, we
     'save the length of image retrieved
     'above as the last item in the file.
     'Its just a matter of writing the
     'UDT to the end of the file.
      Seek #hFile, LOF(hFile)
      Put #hFile, LOF(hFile) + 1, mfs
   Close #hFile

End Sub

Private Sub Command2_Click()

   Set Picture1.Picture = Nothing
   RichTextBox1 = ""
   RichTextBox2 = ""
   RichTextBox3 = ""
End Sub

Private Sub Command3_Click()

   Dim hFile As Long
   Dim hFileOut As Long
   Dim PicData() As Byte
   Dim mfs As MultiFileStoreData
  'First step in the extraction process is to
  'obtain the length of image portion saved
  'as the last item in the file.
   hFile = FreeFile
   Open sCombinedFile For Binary As #hFile
     'move to the EOF - the UDT size and load
     'saved UDT data
      Seek #hFile, LOF(hFile) - (Len(mfs) - 1)
      Get #hFile, , mfs
      List1.AddItem mfs.imgStart & vbTab & mfs.imgSize & vbTab & mfs.imgSize
      List1.AddItem mfs.txt1Start & vbTab & mfs.txt1Size & vbTab & mfs.txt1Start + mfs.txt1Size
      List1.AddItem mfs.txt2Start & vbTab & mfs.txt2Size & vbTab & mfs.txt2Start + mfs.txt3Size
      List1.AddItem mfs.txt3Start & vbTab & mfs.txt3Size & vbTab & mfs.txt3Start + mfs.txt3Size
     'with the image size, create a byte array
     'large enough to accommodate the image
      ReDim PicData(0 To mfs.imgSize - 1) As Byte
     'and load the image data, repositioning the
     'file pointer to the beginning first
      Seek #hFile, 1
      Get #hFile, , PicData()
     'write the retrieved file out to a temporary
     'file in order to use the LoadPicture method.
      hFileOut = FreeFile
      Open sTmpPix For Binary As #hFileOut
         Put #hFileOut, , PicData()
      Close #hFileOut

     'load the text portions to the rich text controls.
      Seek #hFile, mfs.txt1Start
      RichTextBox1.SelRTF = Input(mfs.txt1Start + mfs.txt1Size, #hFile)
      Seek #hFile, mfs.txt2Start
      RichTextBox2.SelRTF = Input(mfs.txt2Start + mfs.txt3Size, #hFile)
      Seek #hFile, mfs.txt3Start
      RichTextBox3.SelRTF = Input(mfs.txt3Start + mfs.txt3Size, #hFile)

   Close #hFile
  'Load the saved image from the tmp file
  'and kill it
   Picture1 = LoadPicture(sTmpPix)
   Kill sTmpPix

End Sub
Assure the paths and files are valid for your system.


PayPal Link
Make payments with PayPal - it's fast, free and secure!


Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy



Hit Counter