HB++ Tutorial:  MyAutograph 1 - The Handheld Application

 

Introduction

 

This is a step-by-step tutorial for HB++, which goes through the creation of the Autograph sample found in your HB++\Samples directory.  If you print the tutorial for easy viewing and copy and paste the code into your project, the tutorial takes about 40 minutes to complete.  Note that I have added extensive comments to the scripts and changed the formatting, so it is not identical to the original sample program.

 

Preparation

Create the Handheld application

Start HB++.

·         Create a new Minimal Project and save it as MyAutograph in a MyAutograph directory (folder).

·         Go to Project > Settings and for Title, type “MyAutograph” (if necessary).

·         Check to make sure that frmMain Caption is “MyAutograph”. 

·         Run the program.  A blank form with a Title of MyAutograph should display on the Emulator.

 

Now we are going to create a database table.  Go to Project > Add Table.  Double-click Table1 in the Project window.  Change the properties and add field information as noted below (same as the sample).  Use Table > Insert Field to add 3 rows. Note that you cannot tab from field to field.  Click the Data tab, just for fun.  You will not be adding Data to the table, so you can leave this area blank.  In the Properties window, change the Name to tblAutograph.

 

 

 

Go to Project > Add Module and create modModule1.  Double-click Module1.  Copy and paste the following code.  Note that I have added extensive comments in red, which shows my initial learning curve.  I have tried to write the comments you you can read through the code top to bottom and have a fair understanding of what is going on.

 

' modModule1

 

‘======================================================================

' PUBLIC MEMBERS

‘======================================================================

 

Public Const sFileExtension as String = "agr"          ‘used later

Public Const lMagicNumber as Long = &H2563A5F8  'used later

 

Public dbAuto as tblAutograph          'Note that this is a global variable

 

‘======================================================================

' PUBLIC FUNCTIONS

‘======================================================================

 

Public Function OpenDatabase(ByVal eAccessMode as HbMode) as tblAutograph

 

'The parameter eAccessMode is a HB++ constant of type HbMode. 

'In a later function, Normal_Launch, we will pass hbModeReadWrite.

'Therefore, this function will open a tblAutograph table in

'ReadWrite mode.

'The HB++ HbMode constants are listed below:

'hbModeCreateAlways 8192 Create the table, if it already

'exists, it is overwritten.

              'hbModeOpenAlways 4096 Open and/or create the table.

              'hbModeOpenExisting 0 Open an existing table.

              'hbModeReadOnly 1 Open the table in read only mode.

              'hbModeReadWrite 3 Open the table in read and write mode.

              'hbModeWrite 2 Open the table in write only mode

'hbModeExclusive 8 Don't let anyone else open this

'database.

'hbModeLeaveOpen 4 Leave the table open after closing the

'application that created it.

'hbModeShowSecret 16 Show the records marked as being

'private.

'Note : hbModeCreateAlways cannot be used at the same time

'as hbModeReadOnly .

 

       Dim db as New tblAutograph

       Dim e as Integer

 

       On Error Goto NotFound

 

Start:

       'Open the tblAutograph database in hbModeOpenExisting mode

       'If the database doesn't exist, raise error #43.

       'In other words, if the table does not exist, we will

       'create it from scratch. 

       db.OpenTable hbModeOpenExisting+eAccessMode

'Open the RecordSet object. The collection of records contained

'in the table are copied into the RecordSet and the cursor is

'positioned on the first record.

       Set OpenDatabase = db

       Exit Function

 

NotFound:

       'An error has occurred.

       e=Err.Number

       If e<>43 Then Err.Raise e  'show the error message

'Error 43 : Database not found. This error occurs when you try to

'open a non-existant database with OpenByName, OpenTable or

'OpenRecordset.

       'Therefore a new database will be opened in ReadWrite

'Mode and intialized with data.

       db.OpenTable hbModeCreateAlways+hbModeReadWrite

       'Add two categories

       db.CategoryName(0)="Unfiled"

       'CategoryName creates, sets or returns the name of a category.

       'The range of valid values for the parameter is 0 to 15.

       'Here we set the 'Unfiled' category

       db.CategoryName(1)="Programmers"

       'Add a second category.

       'Add a sample record

       db.AddNew

       db.Named = "Peter Levy"

       db.Created = Date

       db.Created=DateSerial(2002,6,30,0,0,0)

       'The DateSerial function builds a value of type Date from the

'specification of its different components in the Gregorian

'calendar.

       Set db.Autograph = imgPL

'note that the imgPL is included as a resource in this project :

'Images Families>imgPL 

'We will add in the next step.

       db.Category = 1

       'update the record

       db.Update

       'Add a second record

       db.AddNew

       db.Named = "John Doe"

       db.Created = Date

       db.Created=DateSerial(2004,2,23,0,0,0)

       Set db.Autograph = imgPL

       db.Category = 1

       db.Update

       db.Close

       're-try opening the database

       Goto Start

End Function

 

Public Sub InitScreenMode()

       Dim sc as New ScreenMode

      

       'HELP: The ScreenMode class implements properties that

       'characterize a graphic mode and methods to list the available

'graphic modes. This class is instantiable, derivable and

'clonable.

 

       Dim b as Boolean

'Start to enumerate available Screen modes ; the first will be

'the one with the best resolution / bitdepth

       b=sc.FindFirstMode

       'While there is another Screen mode

       While b

              'if the available screen mode is <= 8 bit/pixel

'(<=256 colors)

              If sc.BitDepth<=8 Then

                     'apply the screen mode

                     Set ScreenMode=sc

                     'and exit procedure

                     Exit Sub

              End If

              'enumerate the next available screen mode

              b=sc.FindNextMode

       Wend

End Sub

 

We now need to add an image to the project.  Go to Project > Add Images… and for the Image Family type “imgPL” and then tap Next.  Select “Insert an existing file”, tap Next, navigate to the HB++\Samples\Autograph directory and select the imgPL.bmp. Tap Next and Next.  Go to File > Save Bitmap As… and save the image to your MyAutograph directory.

 

Go to clsApplication and replace the exisiting code with the following code:

 

Private Sub Application_NormalLaunch()

  dim f as new frmMain

       'initialize the screen mode

       InitScreenMode

       'open or create the database

       Set dbAuto=OpenDatabase(hbModeReadWrite)

       'jump to the main window

  f.Show hbFormModeless+hbFormGoto

End Sub

 

Complile to make sure there are no errors.

 

Now, what did we just do?  From the Help section, we find the following information:

 

Add a List control to frmMain:

 

Add a Label control to frmMain

 

Add a Field to frmMain

 

Add a Button to frmMain

 

Add a Popup to frmMain

 

Add the following script to frmMain.

 

' frmMain

 

‘======================================================================

' PUBLIC MEMBERS

‘======================================================================

Public        lLastUniqueID as Long             'lxxx = Long

Private       iCategory as Integer       'ixxx = Integer

Private eCurrentSecurityLevel as hbSecurity            'exxx = HBSecurity

 

‘======================================================================

' PRIVATE MEMBERS

‘======================================================================

'String to mask a private record

private Const sMaskedRecord as string = "--===<<<Masked record>>>====--"

 

‘======================================================================

' FORM EVENTS

‘======================================================================

Private Sub Form_Load()

       'Get the current security level

       eCurrentSecurityLevel=Security()

 

       'HELP: Public Property Get Security() As HbSecurity

       'Reading the Security property requests the current system security level,

       'and returns one of the following constants:

       'Constant Value Description

       'hbSecurityShowRecords 0 Private records should be displayed without any

       'restriction.

       'hbSecurityMaskRecords 1 Private records should appear masked.

       'hbSecurityHideRecords 2 Private records should not appear at all.

       'The current system security level can be changed by calling the

       'SecurityChange function.

 

       'When the form is loaded, set the Category to 'All'.

       popCategory.Text="All"

       'fill the list

       FillList

       'give the focus to fldFind field

       Set Focus=fldFind

 

       'HELP: Public Property Set Focus(ByRef objFocus As Control)

 

End Sub

 

‘======================================================================

' FIELD EVENTS

‘======================================================================

Private Sub fldFind_Change()

       'Note that the change function is on a control level, not a form level.

       'fill the list, according to the searched string

       FillList

End Sub

 

‘======================================================================

' POPUP EVENTS

‘======================================================================

Private Sub popCategory_Click()

       Dim k as Integer

       'invoke the system category dialog box

       k=popCategory.CategorySelect(dbAuto,iCategory,1,True,True)

 

       'HELP: Public Function CategorySelect(

              'ByRef objDB As Database,                                    

                     '(Reference to a valid Database object.)

              'ByVal iCategory As Integer,                                 

                     '(Index of the category selected by default.)

              'ByVal iFixed As Integer,                                    

                     '(Index of the first modifiable category.)

              'ByVal bAll As Boolean,                                             

                     '(Indicates if the pseudo category 'All' should be displayed.)

              'ByVal bEdit As Boolean) As Integer)    

                     '(Indicates if the categories can be modified by the user.)

 

       'if the user changes the category, refill the list

       If k<>iCategory Then

         iCategory=k

         FillList

       End If

End Sub

 

‘======================================================================

' PRIVATE SUBS AND FUNCTIONS

‘======================================================================

Private Sub Initialize()

'This is not a documented function, but I am assuming it is the

'constructor for the form, as it runs before Form_Load.

       lLastUniqueID=-1

       iCategory=-1

End Sub

 

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Private Sub FillList()

       Dim s as String, n as Integer

 

       'get the searched string

       s=Trim(fldFind.Text)

 

       'HELP: The Trim function removes spaces and tabs at the beginning

'and the end of a string.

 

       'get its length

       n=Len(s)

 

       'Set redraw to false to improve the performance and prevent the control

'from flickering because several items will be added in the list

       lstView.Redraw=False

 

       'HELP: The Redraw property determines whether the control should be redrawn

       'immediately to take into account modifications affecting the list by the

       'AddItem, RemoveItem and Clear methods, or by the List and ListIndex

'properties.

 

       'empty the list

       lstView.Clear

 

       'HELP: The Clear method deletes all the items in the list displayed by the

       'control. After calling this method, the ListIndex and NewIndex properties

'both return the value -1. If the value of the Redraw property is True, the 'display is updated immediately.

 

       'if there is at least one record in the recordset

       'dbAuto is the tblAutogpraph, which is opened in clsApplication

       If dbAuto.RecordCount>0 Then

              'move to the first record

              dbAuto.MoveFirst

              While Not dbAuto.EOF

                     'compare user select category and record category

                     'If the Category is 'All' or the selected category

                     If iCategory =-1 Or dbAuto.Category=iCategory Then

 

'HELP: The iCategory parameter indicates the index of the

'Category 'to find and can take the value -1 that

'indicates the category 'All', or a value between 0 and 15.

'If this parameter is less than '-1 or greater than 15, a

'runtime error'will be raised.

 

                           'compare user searched string and record Name field

                           If StrComp(Left(dbAuto.Named,n),s,hbCompareText)=0 Then

'if previous tests match, then add the record

'to 'the list with its UniqueId in ItemData

'property depending the security level, add in 'different way

If dbAuto.Secret=False or (eCurrentSecurityLevel=hbSecurityShowRecords and dbAuto.Secret) Then

                                         lstView.AddItem dbAuto.Named,dbAuto.UniqueID

 

'HELP: Public Sub AddItem(ByRef sValue As 'String,

                           'Optional ByVal lData As Long = 0)

'The AddItem method adds an item to the list displayed by 'the control.

'The sValue argument is the text that will be displayed 'whilst the optional lData argument allows you to associate 'a value of type Long with

'this new element for use in your program. This last value 'can be retrieved later using the ItemData.

 

Elseif(eCurrentSecurityLevel=hbSecurityMaskRecords and dbAuto.Secret) Then

                                  lstView.AddItem sMaskedRecord, dbAuto.UniqueID

                           Else   'Do nothing

 

'Assuming (eCurrentSecurityLevel=hbSecurityHideRecords and 'dbAuto.Secret)

                           End If

                           End If

                     End If

                     'move to the next record

                     dbAuto.MoveNext

              Wend

       End If

 

       'Set redraw to true, for reflecting change

       lstView.Redraw=True

       'select an item in the list : for example, if a record is duplicate, select it

       lstView.ListIndex=lstView.FindItemData(lLastUniqueID)

       'TODO  not clear what is happening here

End Sub

 

‘======================================================================

 

Compile and run the program.  You will see two records in the list box, so we are making progress!

 

Next, we will add menus.  Add a new Class with the following attributes:

 

 

Go back to frmMain and make the following change in order to use this new class:

 

Note:  This is a key step, and it shows the power of HB++ with regard to inheritance.

 

Add the following script to clsFormMenu:

 

‘======================================================================

' clsFormMenu

‘======================================================================

 

‘======================================================================

' PUBLIC VARIABLES

‘======================================================================

Public mnuCut              as MenuItem

Public mnuCopy       as MenuItem

Public mnuPaste      as MenuItem

Public mnuSelect     as MenuItem

Public mnuKeyboard   as MenuItem

Public mnuGraffiti   as MenuItem

Public mnuAbout      as MenuItem

 

‘======================================================================

' MENU EVENTS

‘======================================================================

Private Sub mnuCut_Click()

'Handles Edit > Cut

       Dim f as Field

       'Get the focus Field

       Set f=Focus

       'if a field have the focus, then invoke the Cut method else beep

       If f Is Nothing Then SystemSound Else f.Cut

End Sub

 

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Private Sub mnuCopy_Click()

'Handles Edit > Copy

       Dim f as Field

       'Get the focus Field

       Set f=Focus

       'if a field have the focus, then invoke the Copy method else beep

       If f Is Nothing Then SystemSound Else f.Copy

End Sub

 

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Private Sub mnuPaste_Click()

'Handles Edit > Paste

       Dim f as Field

       'Get the focus Field

       Set f=Focus

       'if a field have the focus, then invoke the Paste method else beep

       If f Is Nothing Then SystemSound Else f.Paste

End Sub

 

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Private Sub mnuSelect_Click()

'Handles Edit > Select All

       Dim f as Field

       'Get the focus Field

       Set f=Focus

       'if a field have the focus, then select all, else beep

       If f Is Nothing Then

              SystemSound

       Else

              'Obtain index of the first character of the current selection.

              f.SelStart=0

              'Indicate the maximum number of characters contained in the selection.

              f.SelLength=32767

       End If

End Sub

 

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Private Sub mnuKeyboard_Click()

'Handles Edit > Keyboard

       Dim f as Field

       'Get the focus Field

       Set f=Focus

       'if a has have the focus, then call the virtual keyboard, else beep

       If f Is Nothing Then SystemSound Else SystemDialog hbSysKeyboardDefault

 

       'HELP: Public Sub SystemDialog(ByVal eType As HbSystemDialog)

       'Parameter Description:  eType Type of dialog box to display.

'The dialog box is modal, in other words this function does not return unless the 'user closes the box. The argument eType can take one of the following values:

              'hbSysKeyboardAlpha  0 Alphabetic keyboard.

              'hbSysKeyboardNumeric  1 Numeric keyboard.

              'hbSysKeyboardAccent 2 Accent Character keyboard.

              'hbSysKeyboardDefault 3 Keyboard adapted to the state of the text field.

              'hbSysGraffitiReference 4 Graffiti reference.

 

End Sub

 

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Private Sub mnuGraffiti_Click()

'Handles Edit > Graffiti

       Dim f as Field

       'Get the focus Field

       Set f=Focus

       'if a field have the focus, then call the graffiti help dialog box, else beep

       If f Is Nothing Then SystemSound Else SystemDialog hbSysGraffitiReference

End Sub

 

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Private Sub mnuAbout_Click()

'Handles Option > About

       Dim f as New frmAbout

       'Show the About form

       'Display the form on top of any other form that is open.

       f.Show hbFormModal+hbFormPopup

 

'HELP: In general, the main form of your application has its Modal property set to 'False, and is opened with the hbFormModeless+hbFormGoto options, whilst dialog 'boxes have their Modal property set to True, and are opened with the 'hbFormModal+hbFormPopup options.

 

End Sub

 

‘======================================================================

 

When you run the script, you will see errors related to frmAbout.  We will add that form now.  Note that this is a Modal form, so the values vary from the default.  Add a new Form with the following attributes:

 

 

Add 2 Labels

 

Add a Button

 

Now add the following script.

 

‘======================================================================

' frmAbout

‘======================================================================

 

‘======================================================================

' FORM EVENTS

‘======================================================================

Private Sub Form_Load()

'Initialize the form

       lblVersion.Caption="Version " & App.Version

       'This comes from the Project Settings

End Sub

 

‘======================================================================

' BUTTON EVENTS

‘======================================================================

Private Sub cmdDone_Click()

'Close the form

       Unload Me

 

       'HELP: Unloads the resource, erasing the form if it was displayed, then allows

       'by the method Show to return if the form was modal. The values contained in the

       'controls on the forms are lost. The principal use of the Unload function is to

       'close a modal dialog box.

       'Note: you should not use the Unload function to unload a non modal form.

 

End Sub

 

‘======================================================================

 

Now we will add menus to make the errors go away.  Double-click on frmMain to make the form visible in the IDE.  Now, and only now, can you add menus.  Go to Tools > Menu Editor and add the following. (Refer to the HB++ Help if it is not clear to you how to create menus and items.)

 

Menu:  Record

Menu:  Edit

Menu:  Options

 

You may realize we have added menu items for Duplicate, Beam, and Security that we do not have in our current code.  Let’s add this now by pasting the following to the  bottom of the frmMain script.

 

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Private Sub mnuDuplicate_Click()

       Dim db as tblAutograph

       Dim k as Integer

 

       'get the index of the selected item

       k=lstView.ListIndex

       'check if the user has selected an item in the list; if no k will be equal to -1

       If k>=0 Then

              'open the database in read only mode (to prevent Sharing violation)

         Set db=OpenDatabase(hbModeReadOnly)

              'move to the concerned record, using its uniqueId

              db.LookupUniqueID lstView.ItemData(k)

              'Add a new record

              dbAuto.AddNew

              'copy fields from the selected item

              dbAuto.CopyFields db

              dbAuto.Named=db.Named & " (copy)"

              'update the new record

              dbAuto.Update

              'set the lLastUniqueID member with the uniqueId of the added record

              'for selection by FillList

              lLastUniqueID=dbAuto.UniqueID

              'close the read write database

              db.Close

              'force the recordset to requery

              dbAuto.Requery

              'Fill the list

              FillList

       Else

              MsgBox "You should select an item first!", hbMsgBoxWarning+hbMsgBoxDoneOnly

       End If

End Sub

 

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Private Sub mnuBeam_Click()

       Dim ir as New StreamExg

       Dim n as Integer

       Dim i as Integer

 

       'n will be the record number for the selected category

       n=lstView.ListCount

       'if there is at least one record

       If n>0 Then

              dbAuto.MoveFirst

              ir.Connect "Multiple autographs." & sFileExtension

              Write ir, lMagicNumber, n

              For i=0 to lstView.ListCount-1

                     dbAuto.LookupUniqueID lstView.ItemData(i)

                     Write ir, dbAuto

              Next i

              ir.Disconnect

       Else

              MsgBox "No record to send!", hbMsgBoxWarning+hbMsgBoxDoneOnly

       End If

End Sub

 

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Private Sub mnuSecurity_Click()

       Dim eNewSecurityLevel as hbSecurity

       'If user change the security level, redraw the list

       eNewSecurityLevel=SecurityChange(hbSecuritySelect)

       If eNewSecurityLevel<>eCurrentSecurityLevel Then

              eCurrentSecurityLevel =eNewSecurityLevel

              FillList

       End if

End Sub

 

Compile and run the program.  It should run without errors or warnings.  (Try out the new menus.)

 

Lastly, we will add frmView.  Create a new Form with the following attributes:

 

Add the following controls:

 

Popup

 

2 Labels

 

Field

 

Selector 

 

CheckBox

 

2 Buttons

 

Graffiti

 

Create a new User Control from the Project menu with the following attributes:

 

Add a ucDraw control, which is now in the Toolbox.

 

Add the menus.

 

Add the following code to the frmView:

 

'================================================================================'

'frmView

'================================================================================

 

'================================================================================

' PUBLIC MEMBERS

'================================================================================

Public        bNew                 as Boolean

Private bModified as Boolean

Private iCategory as Integer

 

'================================================================================

' FORM EVENTS

'================================================================================

Private Sub Form_Load()

       'set Modified to false

       bModified=False

       'if this is a new autograph

       If bNew Then

              'give the focus to the fldName field

              Set Focus=fldName

              'set the Date selector Date to now

              selCreated.Date=Now()

              'initialize the user control property , actually bitmap type

              Set ucAuto.Image=Nothing

              'hide the Delete button

              cmdDelete.Visible=False

              'initialize category to All

              iCategory=0

       Else

              'Load the existing record

              fldName.Text=dbAuto.Named

              selCreated.Date=dbAuto.Created

              Set ucAuto.Image=dbAuto.Autograph

              cmdDelete.Visible=True

              iCategory=dbAuto.Category

              chkPrivate.Value=dbAuto.Secret

       End If

       'Set the popCategory popup value

       popCategory.Text=dbAuto.CategoryName(iCategory)

End Sub

 

'================================================================================

' POPUP EVENTS

'================================================================================

Private Sub popCategory_Click()

       Dim k as Integer

 

       'invoke the system category dialog box

       k=popCategory.CategorySelect(dbAuto,iCategory,1,False,True)

       'if user changes the category, update the iCategory variable

       If k<>iCategory Then

         iCategory=k

              'Set the Dirty flag to true

              bModified=True

       End If

End Sub

 

'================================================================================

' PRIVATE SUBS AND FUNCTIONS

'================================================================================

Private function SaveChanges() as long

       'If there is any modification

       If bModified Then

              'if it is a new autograph

              If bNew Then

                     'Add a record

                     dbAuto.AddNew

              Else

                     dbAuto.Edit

              End If

 

              'Save the fields

              dbAuto.Named=Trim(fldName.Text)

              dbAuto.Created=selCreated.Date

              dbAuto.Secret=chkPrivate.Value

              Set dbAuto.Autograph=ucAuto.Image

              dbAuto.Category=iCategory

              'update the record

              dbAuto.Update

              'memorize the uniqueId

              SaveChanges=dbAuto.UniqueID

              dbAuto.Requery

       Else

              If bNew Then

                     'if it is a new autograph, but an empty one

                     'because bModified is false, do not save a record

                     'and set the return value to -1 in order to prevent selection

                     SaveChanges=dbAuto.UniqueID

                     dbAuto.Requery

              Else

                     'It's an existing record without any modification

                     'return its uniqueId

                     SaveChanges=dbAuto.UniqueID

              End If

       End If

End Function

 

'================================================================================

' FIELD EVENTS

'================================================================================

Private Sub fldName_Change()

       'set the dirty flag to true

       bModified=True

End Sub

 

'================================================================================

' SELECTOR EVENTS

'================================================================================

Private Sub selCreated_Change(ByVal bExitOnOK As Boolean)

       'set the dirty flag to true

       bModified=True

End Sub

 

'================================================================================

' UCDRAW EVENT

'================================================================================

Private Sub ucAuto_Change()

       'set the dirty flag to true

       bModified=True

End Sub

 

'================================================================================

' CHECKBOX EVENTS

'================================================================================

Private Sub chkPrivate_Click()

       'set the dirty flag to true

       bModified=True

End Sub

 

'================================================================================

' BUTTON EVENTS

'================================================================================

Private Sub cmdDelete_Click()

       Dim r as HbMsgBoxReturn

       Dim f as new frmMain

 

       'Ask deletion confirmation:

       r=MsgBox("Delete this autograph?",hbMsgBoxYesNo+hbMsgBoxConfirmation)

       'if user confirm deletion

       If r=hbMsgBoxYes Then

              'delete the current record

              dbAuto.Delete hbRecordDelete

              'Jump to the frmMain window

              f.Show hbFormGoto+hbFormModeless

       End If

End Sub

 

Private Sub cmdDone_Click()

       Dim f as new frmMain

       Dim lID as long

       'Save the changes

       lID=SaveChanges

 

       'Set frmMain lLastUniqueID member, which contains the UniqueId of the current autograph

       'so this autograph will be selected in the frmMain list.

       f.lLastUniqueID=lID

 

       'Jump to the frmMain window

       f.Show hbFormGoto+hbFormModeless

End Sub

 

'================================================================================

' MENU EVENTS

'================================================================================

Private Sub mnuClear_Click()

       'invoke the ucDraw Clear method : clear drawing zone

       ucAuto.Clear

End Sub

 

Private Sub mnuBeam_Click()

       Dim ir as New StreamExg

       'Save the changes

       SaveChanges

       'open an StreamExg object

       ir.Connect dbAuto.Named & "." & sFileExtension

       'Write in the stream : the magic number for identifying the sender application

       '1 : mean we send one autograph

       'and the autograph itself

       Write ir, lMagicNumber, CInt(1), dbAuto

       ir.Disconnect

End Sub

 

 

 

Add the following code to the ucDraw control:

 

 

‘======================================================================

' ucDraw

‘======================================================================

 

‘======================================================================

' PUBLIC MEMBERS

‘======================================================================

'Declares an event for the ucDraw control called Change()

Public Event Change()

 

‘======================================================================

' PRIVATE MEMBERS

‘======================================================================

Private cx as Integer, cy as Integer    'x and y coordinates

Private lx as Integer, ly as Integer

Private bm as New Bitmap

Private bEmpty as Boolean

 

‘======================================================================

' PUBLIC PROPERTIES

‘======================================================================

Public Property Get Image() as Bitmap

       'if there is no bitmap

       If bEmpty Then

              'return nothing

              Set Image=Nothing

       Else

              'else return the internal bitmap reference

              Set Image=bm

       End If

End Property

 

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Public Property Set Image(ByRef bmImage as Bitmap)

       'define  the size of the bitmap

       cx=Width-2

       cy=Height-2

       'create the bitmap

       bm.Create cx, cy, 1, hbDensityLow

       'if the bmImage parameter is nothing

  If bmImage Is Nothing Then

              'set the internal flag bEmpty to true

              bEmpty=True

       Else

              'a bitmap was passed to the procedure, copy it to the internal bitmap

              bm.CopyArea 0, 0, cx, cy, bmImage, 0, 0

              bEmpty=False

       End If

End Property

 

‘======================================================================

' PUBLIC SUBS AND FUNCTIONS

‘======================================================================

Public Sub Clear()

       'fill the internal bitmap with white

       bm.BackColor=hbColorWhite

       bm.Rectangle 0, 0, cx, cy,hbRectBorderNone+hbRectFillSolid

       'set the internal flag bEmpty to true

       bEmpty=True

       'Raise the Change event to notify the form who contains the user control

       RaiseEvent Change

       'Post a paint event

       Repaint

End Sub

 

‘======================================================================

' PRIVATE SUBS AND FUNCTIONS

‘======================================================================

Private Sub UserControl_Paint()

       'Get the user settings for Object frame color

       ForeColor=UIColor(hbUIObjectFrame)

       'draw the frame of the control

       Rectangle 0, 0, cx+1, cy+1, hbRectBorderSolid+hbRectFillNone

       'Draw the bitmap

       CopyArea 1, 1, cx, cy, bm, 0, 0

End Sub

 

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Private Sub UserControl_PenDown(ByVal x As Integer, ByVal y As Integer)

  'set the focus in the caller form to nothing,

       Set Form(Recipient).Focus=Nothing

       'set the forecolor to black

  ForeColor=hbColorBlack

       'set internal last coordinates

       lx=x

       ly=y

End Sub

 

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Private Sub UserControl_PenMove(ByVal x As Integer, ByVal y As Integer)

       'draw a line between the last coordinates and the current

  Line lx, ly, x, y

       'empty the graphical buffer

       Flush

       'set internal last coordinates

       lx=x

       ly=y

End Sub

 

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Private Sub UserControl_PenUp(ByVal x As Integer, ByVal y As Integer)

       'draw a line between the last coordinates and the current

  Line lx, ly, x, y

       'empty the graphical buffer

       Flush

       'save screen draw in the internal bitmap

       bm.CopyArea 0, 0, cx, cy, Me, 1, 1

       'set the internal flag bEmpty to False

       bEmpty=False

       'Raise the Change event to the form who contain the user control

       RaiseEvent Change

End Sub

 

‘======================================================================

 

Compile the program.  You will see the following error:  class 'frmView' is defined but never used.  We will fix that now by adding code to frmMain.  (When I ran this the second time it compliled fine.  Curious.  Must have a bug in this tutorial.)

 

‘======================================================================

' BUTTON EVENTS

‘======================================================================

Private Sub cmdNew_Click()

       Dim f as New frmView

       'set the frmView bNew member to true

       f.bNew=True

       'Show the Edit form : frmView

       f.Show hbFormGoto+hbFormModeless

End Sub

 

‘======================================================================

' PRIVATE SUBS AND FUNCTIONS

‘======================================================================

Private Sub lstView_Change()

       Dim k as Integer

       Dim f as New frmView

       'get the index of the selected item

       k=lstView.ListIndex

       'check if the user select an item in the list; if no k will be equal to -1

       If k>=0 Then

              'move to the concerned record, using its uniqueId

         dbAuto.LookupUniqueID lstView.ItemData(k)

              'Check if this record is masked

              if (eCurrentSecurityLevel=hbSecurityMaskRecords and dbAuto.Secret) then

                     'wait for password user input

                     eCurrentSecurityLevel=SecurityChange(hbSecurityShowRecords)

                     'if Password input is wrong exit sub

                     if eCurrentSecurityLevel<>hbSecurityShowRecords then exit sub

              End If

              'Show the Edit form : frmView

              f.Show hbFormGoto+hbFormModeless

       End If

End Sub

 

To complete the application, add the following script to clsApplication:

 

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

'Destructor

Private Sub Terminate()

       'use the main class destructor to close the database if necessary

  If Not dbAuto Is Nothing Then dbAuto.Close

       'restore the default screen mode

       Set ScreenMode=DefaultScreenMode

End Sub

 

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

'GoTo Item

Private Sub Application_GotoItem(ByVal itemGoto as ItemInfo)

  dim f as new frmView

 

       'check that the application is not launched

       If Not SubCall Then

              'if not, open the database

              Set dbAuto=OpenDatabase(hbModeReadWrite)

              'initialize the screen mode

              InitScreenMode

       End if

       'Seek to the requested record

       dbAuto.LookupUniqueID itemGoto.Custom

       'Jump to the edit form

  f.Show hbFormModeless+hbFormGoto

End Sub

 

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

'End of Synchronization

Private Sub Application_SyncNotify()

       'register the application extension for IR transmission

       RegisterExtension sFileExtension

End Sub

 

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Private Sub Application_FindItem(ByVal sToFind As String, ByVal eAccessMode As HbMode, ByVal lRecordNum As Long, ByVal bContinuation As Boolean)

       Dim db as tblAutograph, ii as New ItemInfo

 

       'check if the last line is reached in the dialog box displaying the search results.

       'In this case, we finish the application and not attempt to display any more results.

       'When the user clicks on the "Find More" button, the application will be launched and

       'we will be able to resume searching from where it was interrupted.

       If FindDrawHeader(App.Title) Then Exit Sub

 

       'open the database

       Set db=OpenDatabase(hbModeReadOnly+eAccessMode)

       'check if there is at least one record

       If db.RecordCount<>0 Then

    'if the search was already starded and paused beacause the last line

              'was reached in the dialog box displaying the search results.

              If bContinuation Then

                     'start the search from the last reached position

                     db.AbsolutePosition=lRecordNum

              End if

              'while the end of recordset was not reached

    While Not db.EOF

                     'compare the serached user string and the Name field for this record

      If InStr(1,db.Named,sToFind,hbCompareText)>0 Then

                           'if match, set the itemInfo members

        ii.RecordNum=db.AbsolutePosition

                           ii.Custom=db.UniqueID

                           'informs the system that a match corresponding to a search has been found and can be displayed

                           'in the results in a system dialog box.

        If FindMatch(db.Named,ii) Then

                                  'the last line was reached in the dialog box displaying the search results.

                                  'In this case, we finish the application and not attempt to display any more results.

                                  'When the user clicks on the "Find More" button, the application will be launched and

                                  'we will be able to resume searching from where it was interupted.

                                  Exit While

                           End if

      End If

                     'allow user to exit application

      If DoEvents Then Exit While

                     'move to the next record

      db.MoveNext

    Wend

  End If

  db.Close

End Sub

 

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Private Sub Application_ExgAskUser(ByVal sFilename As String, ByRef eResult As HbExgAsk)

       'specifiy that the user will be asked if he wants to accept the autograph sended by IR

       eResult=hbExgAskDialog

End Sub

 

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Private Sub Application_ExgReceive(ByVal stream As StreamExg, ByRef itemGoto As ItemInfo)

       Dim ii as New ItemInfo

       Dim i as Integer, n as Integer, magic as Long

 

       'Read the stream : one long for the magic number

       Read stream, magic

       'magic will be the magic number to identify if the sender application is autograph

       'n will be the record number

       'if the sender is not Autograph

       If magic<>lMagicNumber Then

              Msgbox "Sender is not Autograph... Cannot proceed.",hbMsgBoxError,App.Title

              'Exit Application

              Exit Sub

       End if

       'Read the stream : one integer for the record number

       Read stream, n

       'if the number of records is negative, exit the application

       If n<1 Then Exit Sub

 

       'Everything is Ok, now open the database to store incoming autograph

       'check that the application is not launched

       If Not SubCall Then

              'if not, open the database

              Set dbAuto=OpenDatabase(hbModeReadWrite)

       End if

       'for each autograph received

       For i=1 To n

              'Add a new record

              dbAuto.AddNew

              'read and fill the record with the stream

              Read stream, dbAuto

              'update the modifications

              dbAuto.Update

              'store the uniqueId in the iteminfo

              ii.Custom=dbAuto.UniqueID

       Next i

       'check that the application is not launched

       If Not SubCall Then

              'if not, close the database

              dbAuto.Close

       End if

       'set the iteminfo reference to ii, in order to show the autograph via

       'the Application_GotoItem launch code

       Set itemGoto=ii

End Sub

 

To learn more about the Autograph application, go to HB++ Help and Search for “autograph”.

 

If you find any errors in this tutorial or if you have suggestions for improvement, please drop me a note.

 

 

Jon Blackman

jab@easystreet.com

 

Updated July 4, 2004