' This is a PlodWare pwScripter script.
' https://RipeTech.com/PlodWare-pc-applications
' -------------------------------------------------------------------------------------------
' This program was developed to create and manage metadata for the (~27000) digital images that I (currently) have,
' so that if and when an image viewer is available that can display embedded metadata,
' then I shall have the metadata ready to insert in to the images.
' Although the motivation was metadata for image files, there is nothing to prevent this program handling
' metadata (i.e. tag groups and tags) for any other type of file.
' Although metadata fields are defined for image types (e.g. Exif, IPTC, XMP) I wanted a flexible and open
'(i.e. not committed to a specific format) metadata tool that can serve as the basis for future efforts
' to embed metadata into files.
' -------------------------------------------------------------------------------------------

dbclose ()

' -------------------------------------------------------------------------------------------

dbExtension  ("bk64tree",1)
dbExtension  ("popcount",1)
dbExtension  ("eval",1)

'  these extensions will be loaded for each DB that is opened
' BUT:
' the **contents** of a virtual table do not survive
' a DB close/open   or a  DB save/saveAs
' but the table name does!

' -------------------------------------------------------------------------------------------
' these are APPLICATION specific

dim AppVersion = "2024-03-18 Tagger for Files"

dim maxHD = 12
' -------------------------------------------------------------------------------------------
' these are APPLICATION specific defines that should not really be altered

dim EOLdelim          = chr ( 167 )  '  "§"
dim nonPrintableDelim = chr ( 0x01e ) ' RS  = Record Separator
dim tagDelim          = nonPrintableDelim  & EOLdelim  '  "§"

dim FreeTxtId  = "TagTxt"   ' appended to each Free text field name, must NOT end in "Tag" to avoid aliasing with  TagGroups
dim TagGroupId = "Tag"      ' appended to each tag group field name

dim NoTag      = " none"  ' leading space is needed  to prevent aliasing

dim ImageFileExtensions = "('jpg', 'jpeg', 'png', 'gif', 'bmp')"

' -------------------------------------------------------------------------------------------
' these are APPLICATION specific defines that are a matter of builder's preference

dim allowRectMeta   = 1   ' set this to allow/disable  RectMeta when creating a NEW  database
dim allowRectPicasa = 0   ' set this to allow/disable  RectPicasa when creating a NEW  database
dim NbrBulkExportRows = 7  ' nbr of BLOCKS in the File Tagging panel

' -------------------------------------------------------------------------------------------
' these are APPLICATION specific defines that are general purpose AND  should not be changed

dbFastQuery = 1
sob ("RGB","DEFAULT")
dim EOL        = chr(0x0a)

' -------------------------------------------------------------------------------------------
' create the IMAGE window
' -------------------------------------------------------------------------------------------

' create a window to contain some SOBs
IF ( 0 ) then
   dim ImageWindowSOB  =  sob ("application", "NEW", appName & "- Image")

   sob ( ImageWindowSOB,"SET" ,"SHOW",0)

   ' Define a callback to handle a click on the TOP Right "X"
FUNCTION cbImageApplication ( sobid )
   sob ( ImageWindowSOB,"SET" ,"SHOW",0)
END function

sob ( ImageWindowSOB,"ON","CLICK", "cbImageApplication")
END if
' -------------------------------------------------------------------------------------------
' create the HELP window
' -------------------------------------------------------------------------------------------
dim HelpPageSob , HelpTextsob
dim HelpFixedHTMLSOB , HelpFloatHTMLSOB

' create a window to contain some SOBs

dim HelpFloatOVl  =  sob ("application", "NEW", appName & "- HELP")

sob ( HelpFloatOVl,"SET" ,"SHOW",0)

' Define a callback to handle a click on the TOP Right "X"
FUNCTION cbHelpApplication ( sobid )
   sob ( HelpFloatOVl,"SET" ,"SHOW",0)
END function

sob ( HelpFloatOVl,"ON","CLICK", "cbHelpApplication")

dim  HelpMenuBarSOB     = sob (HelpFloatOVl  ,  "add"  ,  "menu"   ,  "bar"  )
dim  HelpMenuOptionsSOB = sob (HelpMenuBarSOB ,  "add"  ,  "menu"   , "Horizontal" ,  "Options"   )
dim  HelpMenuHideSOB    = sob (HelpMenuOptionsSOB ,  "add"  ,  "menu"   , "Vertical"   ,  "Hide"   )
dim  HelpMenuHelp       = sob (HelpMenuBarSOB ,  "add"  ,  "menu"   , "Horizontal" ,  "Help"   )
dim  HelpMenuAbout      = sob (HelpMenuBarSOB ,  "add"  ,  "menu"   , "Horizontal" ,  "About"   )

sob ( HelpMenuAbout   , "add"  ,  "menu"   ,  "Vertical" ,  "Use cases"   )
sob ( -1 ,"ON","CLICK", "HelpUseCases")

sob ( HelpMenuAbout   , "add"  ,  "menu"   ,  "Vertical" ,  "Techie Talk"   )
sob ( -1 ,"ON","CLICK", "cbTechieTalk")

sob ( HelpMenuAbout , "add"   ,  "menu"   ,  "Vertical", "The author"      )
sob (   -1     ,  "ON"   ,  "CLICK"  , "AboutTheAuthor"  )

sob ( HelpMenuAbout   , "add"  ,  "menu"   ,  "Vertical" ,  "Contact"   )
sob ( -1 ,"ON","CLICK", "ContactHTML")

FUNCTION CBHelpMenuHide ( sobid )
   sob ( HelpFloatOVl,"SET" ,"SHOW",0)
END Function

sob (   -1     ,  "ON"   ,  "CLICK"  , "CBHelpMenuHide")

HelpFloatHTMLSOB =sob ( HelpFloatOVl , "ADD" , "web" )
sob ( HelpFloatHTMLSOB, "SET",   "SILENT" , 1)

' -----------------------------------------------------

FUNCTION HelpTagging ( sobid )
   sob ( HelpPageSob  ,"SET","SHOW",1)
   sob ( HelpTextSOB, "empty"    )

   >
   >> <h2>Tagging</h2>

   >><h3>Tagging does not alter any file except the database.</h3>

   >>The standard way to assign/add a tag to a file is:
   >><br>(assuming a tag <b>Mum</b> in the tag group <b>who</b>)
   >><ol>
   >>  <li>Drag the target file on to the bottom right panel (blueish)</li>
   >>  <li>Select the menu option <b>Tools/File Tagging</b>.

   >>  <br> The resulting display shows 6 columns.
   >><ul>
   >>     <li>A large button (also a drag'n'drop' area) that triggers the group of tag actions
   >>     that is to it's the right.
   >>     </li>
   >>     <li>4 columns, <b>Action,  Tag Group,  Filter,   Tag Name </b> with which you can define
   >>         a single tag operation.
   >>     </li>
   >>     <li>A small button (also a drag'n'drop' area) that triggers the single tag action
   >>     to it's left.
   >>     </li>
   >></ul>

   >>  </li>

   >>  <li>Pick one, any one, of the rows, and in it's <b>action</b> column
   >>      select the <b>add</b> option.
   >> </li>
   >>  <li><b>Tag Group</b> column, same row: select the tag <b>group</b> of the
   >>   tag you want to add (e.g. <b>who</b>)
   >> </li>
   >>  <li>The goal is to get the <b>Tag Name</b> box to display the tag that we want to add!
   >>   <br>The <b>Filter</b> and <b>Tag Name</b> are interconnected!
   >>   <br>If the <b>Filter</b> box is empty, then the <b>Tag Name</b> contains all
   >>       of the tags  in the currently selected <b>Tag group</b> box.
   >>   <br>If the <b>Filter</b> box contained say <i>jones</i>, then the <b>Tag Name</b> contains all
   >>       of the tags which contain the string <i>jones</i> (case insensitive).
   >>   <br>So between setting the <b>Filter</b> box and the selecting that wanted <b>Tag Name</b> you
   >>       must pick your tag (e.g. <b>Mum</b>)

   >> </li>
   >> </li>
   >>  <li>Press the <b>button</b> (right hand side of the action definitiion) for this row, and the file is tagged!
   >> </li>
   >></ol>

   >>You could drag'n'drop a selection of files (and/or folder(s)) on to these buttons and the
   >>   tagging will be applied to them!
   >>  <br><br>
   >>Actions
   >><ul style="margin-top: 0;">
   >><li><b>add</b>&nbsp;&nbsp;&nbsp;&nbsp;    insert the specified tag</li>

   >><li><b>replace</b>   remove <b>all</b> tags of the specified group, and insert the specified tag</li>
   >><li><b>remove</b> &nbsp;   means if the specified tag is assigned then remove it</li>
   >><li><b>replace</b>   remove <b>all</b> tags of the specified <b>group</b></li>
   >></ul>

   >> Filter

   >><ul style="margin-top: 0;">
   >><li>Use <b>ESC</b> key to reset the search string to nothing</li>
   >><li>Use   <b>%</b>    as a wildcard</li>
   >></ul>

   sob ( HelpTextsob, "ADD",   "ROW" ,  freestring   )

END Function
' -----------------------------------------------------

FUNCTION HelpExpertMode ( sobid )
   sob ( HelpPageSob  ,"SET","SHOW",1)
   sob ( HelpTextSOB, "empty"    )

   >
   >> <h2>Expert Mode</h2>

   >> The Expert Mode gives you access to the underlying <b>BASIC</b> like interpreter and to
   >> a command line interface to the SQLite database.
   >><br><br>I will <b>not</b> attempt explaining the Expert Mode here.
   >><br><br>But I will highlight some of the database tables used by this application.

   >><br><br><b>TagTable</b> contains one row for each tag. A row contains:
   >>  <ul style="margin-top: 0;">
   >>  <li>a tag group</li>
   >>  <li>a tag  &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; must be unique within a tag group </li>
   >>  <li>tag text &nbsp;&nbsp;&nbsp; a free text field to hold whatever you want about the tag</li>
   >>  </ul>

   >><br>
   >><b>Master</b> contains one row for each file. A row contains:
   >><ul style="margin-top: 0;">

   >>  <li>filesystem information: path / name / ext , access dates</li>
   >>  <li>MD5 hash of the file</li>
   >>  <li>RectPicasa &nbsp;&nbsp;&nbsp; only used by a add-in </li>
   >>  <li>RectMeta &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; used by the <b>regions</b> tool</li>
   >>  <li>for each tag group, a column (ending in the text <i>Tag</i>) that holds the tags assigned to the file.
   >>  Tags are delimited by a 2 character string:
   >>   <ul style="margin-top: 0;">
   >>   <li>a non-printable character 0x01e, non-printable to prevent it being used in a tag.</li>
   >>   <li>a  printable character <b>§</b> so that when browsing the table it serves as a visible delimiter between tags.</li>
   >>   </ul>
   >></ul>

   >><br>
   >><b>SavedEnv</b> contains application internal data that enables some configuration information to survive over sessions.

   >><br> <br>
   >>The SQLite module was compiled so that the function <b>like</b> is case insensitive.
   >><br>If you start writing your own queries on the tables then I recommend using
   >><b>like</b> and not the operator <b>=</b> so that on <b>queries</b> you do not have to be
   >> so carefuly with upper/lower case typing.
   >><br>This is especially true if you use  <b>update</b>  and <b>insert</b> statements with case errors, if
   >> you use <b>like</b> in <b>select</b> statements and <b>where</b> sub-statements you will avoid one source of errors.

   >><br><br>
   >>There are some videos on <b>youtube</b> about the general SQLite / BASIC capabilites (search for PlodWare).

   sob ( HelpTextsob, "ADD",   "ROW" ,  freestring   )

END Function

FUNCTION HelpBackUp ( sobid )
   sob ( HelpPageSob  ,"SET","SHOW",1)
   sob ( HelpTextSOB, "empty"    )

   >
   >> <h2>Backup</h2>

   >> You can back up the <b>files</b>, and the <b>folder</b> structure,  referenced in a database to another disk/folder.
   >> <br><br> Additionally when creating a backup
   >> a copy of the database file is exported to the backup folder, suitably modified so that the
   >> backed up database is useable with the backed up files!
   >><br><br>p.s. if I have understood correctly, a <b>backup</b> is a <i>thing</i>, whilst <b>back up</b> is an <i>action</i>.
   >><br><br>Or more formally expressed:
   >><ul style="margin-top: 0;">
   >><li><b>backup</b> is a <i>noun</i> or <i>adjective</i></li>
   >><li><b>back up</b> is a <i>verb</i></li>
   >></ul>
   >>I could of course be wrong!

   sob ( HelpTextsob, "ADD",   "ROW" ,  freestring   )

END Function

' -----------------------------------------------------

FUNCTION HelpFreeText ( sobid )
   sob ( HelpPageSob  ,"SET","SHOW",1)
   sob ( HelpTextSOB, "empty"    )

   >
   >> <h2>File Text</h2>

   >> Tag groups and tags are common to all of the files in the database.
   >> But you might want to assign a unique block of text to a specific file.
   >> <br> This is where <b>file text</b> is useful.

   >> <br>
   >> <br>In another help page I mentioned that I have images of my <b>Great Uncle Bill</b>
   >> <br>He appears in a (regretably small) number of pictures, some taken in the 1950s together with peope
   >> that I can not identify. I know which one is <b>Great Uncle Bill</b> and I can (and have)
   >> defined a <b>region</b> on the images and assigned them to the  <b>Great Uncle Bill</b> tag.
   >><br><br>But I have also added to one of the images a <b>file text</b>
   >> saying something like:

   >><p style="color:red">
   >> "Uncle" Bill (with cap), probably Taunton Somerset, probably before 1957
   >> </p>

   >>To set the <b>file text</b> you must drag'n'drop the file on to the bottom right panel (blueish).
   >><br>Then find the text <b>File Text Tool</b>  slightly above what was the blueish panel.
   >><br>
   >><br>Set the <b>Action</b> to be <b>edit</b>.
   >><br>Enter the text that you want in to the edit area to the right of the text <b>File Text Tool</b> field
   >><br>Press the (red?) <b>edit</b> button.
   >><br><br>Thats it!

   >><br><br>The contents of the  <b>File Text</b> edit area  can be assigned   to other files
   >> by drag'n'dropping the file(s) (and/or folders) on to the (red?) <b>edit</b> button.
   sob ( HelpTextsob, "ADD",   "ROW" ,  freestring   )
END Function

' -----------------------------------------------------
FUNCTION HelpCurrentFile ( sobid )
   sob ( HelpPageSob  ,"SET","SHOW",1)
   sob ( HelpTextSOB, "empty"    )

   >
   >> <h2>Delete Current File</h2>

   >>When a file is drag'n'dropped on to the lower right (blueish) panel, then this program
   >> will identify all files in the database with the same MD5 hash, i.e. to a very very high likelihood, identical.

   >><br> The full file name (path/name/ext) of all of the files (including the drag'n'dropped file) will be displayed
   >> in a combo box near the top of the screen, to the right of a text string <b>File(s):</b>.
   >><br>
   >><br> To the right of this combobox are the buttons  <b>Open folder</b> and   <b>Delete file</b>.
   >><br>
   >><br> Pressing the  <b>Delete file</b> button causes the file currently selected in the combobox
   >> to be removed from the database, from the file system and sent to the recycling bin.

   >><br>
   >><br> Use with care!

   sob ( HelpTextsob, "ADD",   "ROW" ,  freestring   )
END Function

FUNCTION HelpTipsNTricks ( sobid )
   sob ( HelpPageSob  ,"SET","SHOW",1)
   sob ( HelpTextSOB, "empty"    )

   >
   >> <h2>Tips and Tricks</h2>
   >> <h4>keeping track</h4>

   >>If you have lots of files to tag, it is almost guaranteed that you will lose track of which files
   >> have been fully tagged, and which not, or which have say  all of their <b>who</b> tags but not all of their <b>where</b> tags.

   >><br>There is a built-in tag group called <b>Tagged</b>, which can only hold the names of the other tag <b>groups</b>.
   >> I recommend that you use it, if at all, in the following (positive) way:
   >><br><br>Assuming tag groups of say <b>who what where</b> then when you haved applied all of  say the  <b>who</b> tags
   >> that you set the  <b>Tagged</b> group for that file to include the tag <b>who</b>.
   >><br>This will enable you to filter in/out the files that have all of their <b>who</b> tags.
   >><br>If you decide that no more tagging is needed for a file, then set the <b>Tagged</b> group tag <b>Tagged</b>.
   >><br>Sorry, that sounds a  bit weird, but it works.
   >><br>Do not use it negatively i.e. to hold the names of unhandled tag groups. Why! Because newly added files
   >> default to an empty <b>Tagged</b> group!

   >><br>
   >><hr>
   >> <h4>finding the original folder of an exported file</h4>
   >>If you want to find the original folder of an exported file, then
   >> drag'n'drop the exported file on to the <b>reload</b> button just above the lower right (blueish) panel.
   >><br>That will cause the original folder to be opened in a file explorer.

   >><br>Exported files are given unique names of the form:
   >><ul style="margin-top: 0;">
   >><li><b>E</b></li>
   >><li>database <b>row identity</b>
   >><li><b>_</b></li>
   >><li><b>original file name & extension</b></li>
   >></ul>

   >><br>
   >><hr>
   >> <h4>Tag group, tag name and free text field name</h4>
   >>Within its "type" these must be unique.
   >><br>e.g. a  tag name <b>fred</b> can only be used once in say the tag group <b>who</b> but
   >> it can also appear once as the name of a tag group or as a tag in another tag group, and once as a free text name.
   >> <ul>
   >></li>
   >> <li>they are case insensitive
   >></li>
   >></li>
   >> <li>Leading and trailing whitespace (spaces and tabs) will be removed.
   >></li>
   >> <li>Embedded space(s) is allowed.
   >></li>
   >> </ul>
   >><br>
   >><hr>
   >> <h4>Internal (database names) for Tag groups and free text fields</h4>
   >> <ul>
   >> <li>the column name for a tag group is the tag group followed by <b>Tag</b>  e.g. who  is    <b>whoTag</b> </li>
   >> <li>the column name for a free text field is the free text field name followed by <b>TagTxt</b>  e.g. about  is    <b>aboutTagTxt</b> </li>
   >> </ul>

   sob ( HelpTextsob, "ADD",   "ROW" ,  freestring   )
END Function

FUNCTION HelpDelFiles ( sobid )
   sob ( HelpPageSob  ,"SET","SHOW",1)
   sob ( HelpTextSOB, "empty"    )

   >
   >> <h2>Delete Files</h2>

   >>There is a bulk delete capability based on the <b>file subset</b> function.

   >><br><br>The menu option <b>Delete / Delete Files</b> will display a panel with which you can select
   >> the  <b>file subset</b> to be deleted, and a <b>Delete Files in Subset</b> button to
   >> trigger the action.

   sob ( HelpTextsob, "ADD",   "ROW" ,  freestring   )
END Function

FUNCTION HelpDelExtDups ( sobid )
   sob ( HelpPageSob  ,"SET","SHOW",1)
   sob ( HelpTextSOB, "empty"    )

   >
   >> <h2>Delete External Duplicates</h2>

   >> The goal is to be able to scan a folder (and its sub-folders) and delete those files that are in
   >> the database. Files that are known are deleted (to the recycle bin).
   >> <br><br> Why!
   >> <br><br> I have images backed-up on to various storage devices.
   >><br>When an opportunity came to consolidate the various images on to a single storage device I wanted
   >> a capability to look at the various storage devices and remove those files already consolidated.

   >><br><br>To access the capability use the menu option  <b>Delete / Delete External Duplicates </b>
   sob ( HelpTextsob, "ADD",   "ROW" ,  freestring   )

END Function

FUNCTION HelpFileSubSet (sobid   )

   sob ( HelpPageSob  ,"SET","SHOW",1)
   sob ( HelpTextSOB, "empty"    )
   >

   >>     <!DOCTYPE html>
   >>  <html>
   >>  <style>
   >>  table, th, td {
   >>    border:1px solid black;
   >>    border-collapse: collapse;
   >>  }
   >>  </style>
   >> <body>
   >><h2>Create the file subset</h2>

   >>The file subset is the basis for the following bulk actions:
   >><ul style="margin-top: 0;">
   >>  <li>tagging</li>
   >>  <li>exporting</li>
   >>  <li>deletion</li>
   >>  </ul>

   >>Initially the subset is empty, but files can be added (and removed) on the basis of
   >> their tags or of their file system characteristics (i.e. path, name , extension).

   >> <br><br>
   >> Since the file subset is only <b>cleared</b> when you press the <b>New list</b> button then
   >>   it is possible to :
   >><ul style="margin-top: 0;">
   >>  <li>Define the criteria for a file subset</li>
   >>  <li>Create that file subset using <b>Apply Filters</b></li>
   >>  <li>Define another set of selection criteria, and implement it,
   >>      thus refining / extending  the list.</b></li>
   >> </ul>

   >> In the upper half of the panels for <b>Power Tagging</b> , <b>Files to Folder</b>  and <b>Delete Files</b>,
   >>  under the grey row  ( Action&nbsp;&nbsp;&nbsp;&nbsp;Tag Group&nbsp;&nbsp;&nbsp;&nbsp;Filter&nbsp;&nbsp;&nbsp;&nbsp;Tag Name )  area there are 8 rows

   >>  each of which defines selection critera for the inclusion, or removal, of files in a subset of the database.

   >><br>
   >><br>The <b>Action</b> column defines the main part of the inclusion or removal activity.
   >><br><br>The following actions cause files to be <b>added</b> to the subset.

   >><Table>

   >><colgroup>
   >>  <col span="1" style="background-color: #D6EEEE">
   >></colgroup>

   >><tr>
   >>  <th>Action</th>
   >>  <th>Add rows to the <b>file sublist</b> if:</th>
   >></tr>

   >><tr>
   >>  <td>&nbsp;add only
   >> &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
   >>  &nbsp; &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
   >></td>

   >>  <td>&nbsp;has only got the specified tag in the specified group. (Tags in other groups are allowed.)

   >></td>
   >></tr>

   >><tr>
   >>  <td>&nbsp;add ==</td>
   >>  <td>&nbsp;has atleast  the specified group & tag</td>
   >></tr>

   >><tr>
   >>  <td>&nbsp;add <></td>
   >>  <td>&nbsp;has not got  the specified group & ta</td>
   >></tr>

   >><tr>
   >>  <td>&nbsp;add any</td>
   >>  <td>&nbsp;has any tag  in the specified  group</td>
   >></tr>

   >><tr>
   >>  <td>&nbsp;add non</td>
   >>  <td>&nbsp;has no  tag  in the specified  group</td>
   >></tr>

   >><tr>
   >>  <td>&nbsp;add ==</td>
   >>  <td>&nbsp;has any tag with the partial string (Filter column) in the specified  group</td>
   >></tr>

   >><tr>
   >>  <td>&nbsp;add <></td>
   >>  <td>&nbsp;has no tag with the partial string (Filter column) in the specified  group</td>
   >></tr>

   >><tr>
   >>  <td>&nbsp;tag ==</td>
   >>  <td>&nbsp;tags in specified group are identical with those of current file (blueish panel)</td>
   >></tr>

   >><tr>
   >>  <td>&nbsp;tag <></td>
   >>  <td>&nbsp;tags in specified group are not identical with those of current file (blueish panel)</td>
   >></tr>

   >><tr>
   >>  <td>&nbsp;tags ==</td>
   >>  <td>&nbsp;tags in all groups are identical with those of current file (blueish panel)</td>
   >></tr>

   >><tr>
   >>  <td>&nbsp;tags <></td>
   >>  <td>&nbsp;tags in all groups are not identical with those of current file (blueish panel)</td>
   >></tr>

   >><tr>
   >>  <td>&nbsp;duplicate</td>
   >>  <td>&nbsp;has a non-unique hash value</td>
   >></tr>

   >></Table>

   >> <br>The following actions cause files to be <b>removed</b> from the subset.

   >><Table>

   >><colgroup>
   >>  <col span="1" style="background-color: #D6EEEE">
   >></colgroup>

   >><tr>
   >>  <th>Action</th>
   >>  <th>Remove rows from <b>file sublist</b> if:</th>
   >></tr>

   >><tr>
   >>  <td>&nbsp;remove ==
   >> &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
   >>  &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; &nbsp; &nbsp;
   >></td>
   >>  <td>&nbsp;has atleastthe specified group & tag</td>
   >></tr>

   >><tr>
   >>  <td>&nbsp;remove <></td>
   >>  <td>&nbsp;has not got any tag in  the specified group & tag</td>
   >></tr>

   >><tr>
   >>  <td>&nbsp;remove any</td>
   >>  <td>&nbsp;has any  tag  in the specified  group</td>
   >></tr>

   >><tr>
   >>  <td>&nbsp;remove non</td>
   >>  <td>&nbsp;has no  tag  in the specified  group</td>
   >></tr>

   >><tr>
   >>  <td>&nbsp;remove ==?&nbsp;</td>
   >>  <td>&nbsp;has any tag with the partial string (Filter column) in the specified  group </td>
   >></tr>

   >><tr>
   >>  <td>&nbsp;remove <>?</td>
   >>  <td>&nbsp;has no  tag with the partial string (Filter column) in the specified  group
   >> &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
   >> &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; &nbsp;&nbsp;
   >> </td>

   >><tr>
   >>  <td>&nbsp;-unchanged&nbsp;</td>
   >>  <td>&nbsp;remove rows that were unchanged in the last rescan</td>
   >></tr>

   >><tr>
   >>  <td>&nbsp;-new&nbsp;</td>
   >>  <td>&nbsp;remove rows that were added in the last rescan</td>
   >></tr>

   >><tr>
   >>  <td>&nbsp;-changed&nbsp;</td>
   >>  <td>&nbsp;remove rows that changed in the last rescan</td>
   >></tr>

   >></Table>

   >>  <br>Rather than create an even larger set of filter actions I have implemented
   >> two low level filters:
   >><ul>
   >> <li><b>Insert where</b></li> a wrapper for the SQLite statement:
   >> <br> &nbsp;&nbsp;<b>insert into SubList select rowid, * from master where type like 'file' and (
   >>  <span style='color: #FF0000;'>XX</span>  ) </b>
   >><br><li><b>Delete where</b></li> a wrapper for the SQLite statement:
   >> <br>&nbsp;&nbsp;<b>delete from  SubList   where type like 'file' and (
   >>  <span style='color: #FF0000;'>XX</span>  ) </b>

   >></ul>
   >>In each case the user provides the  <span style='color: #FF0000;'>XX</span>.

   >> <br><br>The following table shows <b>examples</b> of <span style='color: #FF0000;'>XX</span> which could be placed
   >> in the edit fields of the <b>Insert where</b> and <b>Delete where</b> low level
   >> filter options. But note: it is entirely possible to access tags using low level filters but since the
   >> tag delimiter includes a non-printable character then the syntax is a bit complicated. Hopefully the tag related
   >> requirements are covered in the two tables above.
   >><br><br>
   >><Table>

   >><colgroup>
   >>  <col span="1" style="background-color: #D6EEEE">
   >></colgroup>

   >><tr>
   >>  <th>Where clause</th>
   >>  <th>what it selects </th>
   >></tr>

   >><tr>
   >>  <td>&nbsp;path like '%fred%'</td>
   >>  <td>&nbsp;path name of row contains the substring <b>fred</b>
   >></td>
   >></tr>

   >><tr>
   >>  <td>&nbsp;name like '%fred%'</td>
   >>  <td>&nbsp;file name of row contains the substring <b>fred</b></td>
   >></tr>

   >><tr>
   >>  <td>&nbsp;ext  in ('jpg','bmp') </td>
   >>  <td>&nbsp;ext must be either <b>jpg</b> or <b>bmp</b>. Warning <b>in</b> is case sensitive &nbsp;
   >> &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
   >>  &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
   >> &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
   >> </td>

   >></tr>

   >><tr>
   >>  <td>&nbsp;ext like 'jpg'  or ext like 'bmp'  </td>
   >>  <td>&nbsp;ext must be either <b>jpg</b> or <b>bmp</b>. Note: is case insensitive</td>
   >></tr>

   >><tr>
   >>  <td>&nbsp;size = 0</td>
   >>  <td>&nbsp;file has no contents</td>
   >></tr>

   >><tr>
   >>  <td>&nbsp;size <  1000 and ext like 'jpg'&nbsp;  </td>
   >>  <td>&nbsp;smallish jpg images</td>
   >></tr>

   >></Table>

   >><br>To force the subset to be empty, click on the    <b>New List</b> button.
   >><br><br>

   >>Filter actions will be <b>executed</b> when the <b>Apply Filters</b> button is pressed.

   >></body>
   >></html>

   sob ( HelpTextsob, "ADD",   "ROW" ,  freestring   )

END Function

' -----------------------------------------------------

FUNCTION HelpPowerTagging ( sobid )
   sob ( HelpPageSob  ,"SET","SHOW",1)
   sob ( HelpTextSOB, "empty"    )

   >
   >> <h2>Power Tagging</h2>

   >>Power tagging is where you select a subset of the files in the database,
   >> and then apply a set of tag operations to those files.
   >>
   >><br>
   >><br>For details on creating the file subset, please refer to the help section <b>File Subset</b>

   >> <br>

   >><h3>Define the tagging action</h3>

   >>   In the lower half of the screen, under the grey row  ( Action   Tag Group  Filter   Tag Name )  area there are 8 rows
   >>   with which you can define tag operations on the file subset.
   >>   <br>Define the tag operations in the usual way (menu <b>Help / Tagging</b>).
   >>   <br>Note: that a tag filter is <b>only</b> activated when you press on the appropriate
   >>   button at the right hand end of the filter row.

   sob ( HelpTextsob, "ADD",   "ROW" ,  freestring   )
END Function

' -----------------------------------------------------

FUNCTION HelpInherit ( sobid )
   sob ( HelpPageSob  ,"SET","SHOW",1)
   sob ( HelpTextSOB, "empty"    )
   >
   >> <h2>Inherit</h2>

   >>This is a easy way to copy the tagging information from a reference file
   >> to one or more other files.
   >><br>
   >><ol>

   >>  <li>Drag and drop the reference file to the bottom right panel (blueish).
   >>  <br>If that file is an image file, then it will be displayed.
   >><br><br>
   >>   </li>

   >>  <li>Drag and drop one or more files or folders on to the <b>drop to inherit</b> field
   >>  <br>and the reference tags will be applied to the dropped files.
   >>  <br>This also copies the <b>file text</b> but <b>not</b> any <b>region(s)</b>.
   >>   </li>

   sob ( HelpTextsob, "ADD",   "ROW" ,  freestring   )

END Function

FUNCTION HelpSingleFileOptions ( sobid )
   sob ( HelpPageSob  ,"SET","SHOW",1)
   sob ( HelpTextSOB, "empty"    )
   >
   >> <h2>Single File Options</h2>

   >>A Microsoft Windows installation includes some capabilites to extract some metadata from some
   >> file types.
   >><br><br>As a convenience, this program can access two of these capabilities and send the
   >> found metadata to the display.
   >><br><br>

   >><ul style="margin-top: 0;">
   >>  <li>SHELL and  its GetDetailsOf API can extract metadata from various file types. </li>
   >>  <li>Windows Image Acquisition (WIA) can extract metadata but <b>only</b> from image files.</li>
   >>  </ul>

   sob ( HelpTextsob, "ADD",   "ROW" ,  freestring   )

END Function

' -----------------------------------------------------

FUNCTION HelpTagTextHTML ( sobid )
   sob ( HelpPageSob  ,"SET","SHOW",1)
   sob ( HelpTextSOB, "empty"    )
   >
   >> <h2>Tag Text</h2>

   >>I have a <b>who</b> group, in which I have tag for a relative, my Great Uncle Bill.
   >><br> <br>

   >>I wanted to include in the database some information about <b>Great Uncle Bill</b>
   >> without making the tag ridiculously long.
   >> <br> This is where <b>tag text</b> is useful.
   >> <br>
   >> <br> For each and every tag you can have a unique text block, that is <b>not</b> associated
   >> directly with a file, only with the tag.
   >><br> <br>
   >>You can create / modify / delete tag text under the menu option <b>Tools /  Tag Management</b>
   >><br> <br>
   >>In a side table, where I keep copies of the tag groups and tags there is a free text
   >> field, in which the   <b>who</b> tag   <b>Great Uncle Bill</b>  has text like:

   >>  <p style="color:red">
   >>  <br>DOB: 1896-02-24
   >>  <br>DOD: 1976-02-21
   >>  <br>Born in ...
   >>  </p>

   >> <ol>
   >> <li>It seems to me to be a good place to capture information about the target <b>tag</b> </li>
   >> <li>Specifically for image files, you can define a <b>region</b> on an image that,
   >>     if clicked upon, when displayed by this program, will display the <b>tag text</b></li>
   >></ul>

   sob ( HelpTextsob, "ADD",   "ROW" ,  freestring   )

END Function

' -----------------------------------------------------

FUNCTION AboutTheAuthor( sobid )
   sob ( HelpPageSob  ,"SET","SHOW",1)
   sob ( HelpTextSOB, "empty"    )
   >
   >> <h2>The author</h2>

   >> First program written in 1971/72.
   >> <br>
   >> <br>Still learning.
   >> <br>
   >> <br>Still trying to get things right.
   >> <br>
   >> <br>Still here (2023).

   >> <br>
   >> <br>In my own words still <b>plodding</b> along.
   >> <br>Hence the web site  www.PlodWare.com (actually a sub-domain of www.RipeTech.com).

   >> <br>
   >> <br><b>www.RipeTech.com</b> hosts a collection of <i>things</i> that interest me. Originally
   >> created to host my programming efforts around a <b>FORTH</b> like interpretive language.
   >> <br><br><b>RipeTech</b>,  my abbreviation for Rapid Interactive Programming Environment Technology
   >>  because that is how I think of <b>FORTH</b>.
   >> <br><br><b>www.PlodWare.com</b> a sub-domain of <b>www.RipeTech.com</b>, focussing on stand-alone applications
   >> based on my <b>FORTH</b> like interpreter.

   >> <br>
   >> <br>No one ever said that it should all make sense.

   >> <br>
   >> <br>To quote from the HHGTTG <i>share and enjoy</i>

   sob ( HelpTextsob , "ADD" , "ROW", freestring )

END Function

FUNCTION HelpOnline ( sobid )

   ShellExecute ( "https://www.RipeTech.com/PWMetaTagger" )

END Function

FUNCTION aboutHTML ( sobid )
   sob ( HelpPageSob  ,"SET","SHOW",1)
   sob ( HelpTextSOB, "empty"    )
   >
   >> <h2>Introduction</h2>

   >> This program was developed to create and manage metadata for the (~27000)
   >> digital images that I (currently) have, so that <b>if</b> and <b>when</b> an image viewer is available
   >> that can display embedded metadata, then I shall have the metadata ready  to insert in to the
   >> images.
   >> <p style="color:red">Although the motivation was metadata for image files, there is nothing to
   >> prevent this program handling metadata (i.e. tag groups and tags) for any other type of file.
   >></p>

   >> Although metadata fields are defined for image types (e.g. Exif, IPTC, XML)
   >> I wanted a flexible and open (i.e. not committed to a specific format) metadata tool that can serve as the basis for future efforts to
   >> embed metadata <b>into</b> files.
   >> <br> <br>
   >> So I developed this program to:
   >><ul style="margin-top: 0;">

   >>  <li>
   >>create a database (in SQLite format) containing information about the files under a file system location.

   >>   <ul>
   >>   <li>include the files under other file system locations</li>
   >>   <li>resynchronise the database with the files under the referenced file system locations</li>
   >>   </ul>

   >> </li>

   >>   <li>create columns in the database to hold related information. e.g. a  <b>who</b> column
   >>        to hold the name(s) of people in a particular image.
   >> <br>I call such as column a <b>tag group</b>, in this example it is the <b>who</b> tag group. </li>
   >>   <li>create a set of text strings, which I call <b>tags</b>, that belong to a
   >>       given <b>tag group</b>. <br>
   >>       e.g. for the <b>who</b> tag group  there could be the following tags:
   >>       <b>Mum</b> , <b>Dad</b> , <b>Cousin Fred</b> , <b>best mate</b>
   >> </li>

   >> <li>
   >>allocate <b>tags</b> to file(s)  using drag'n'drop
   >> </li>

   >> <li>
   >>find the files that have a user defined combination of tags.
   >>   <ul>
   >>   <li>bulk  add/change/remove tags to those files </li>
   >>   <li>export a <b>copy</b> of those files to a folder </li>
   >>   </ul>
   >> </li>

   >> <li>
   >>archive/backup a copy of the <b>files</b> referenced in the database to a folder (whilst maintaining
   >> the orginal folder structure and folder/file naming.
   >> </li>

   >> <li>
   >>find files that are <b>not</b> in the database but are a <b>duplicate</b> of a
   >> file referenced in the database, and delete the <b>external</b> duplicate.
   >> </li>

   >> <li>
   >>provide a scripting language to support user defined features and interfacing
   >> to some third party applications
   >> </li>

   >> <li>
   >>export the database to Microsoft Excel (if you have it)
   >> </li>

   >> <li>
   >>export the database to a CSV (comma separated variables) file
   >> </li>

   >> <li>
   >> provide an <b>Expert Mode</b> giving access to the raw database and a "BASIC like" language
   >> with which you can write scripts/macros.
   >> <br>e.g. write a script to extract information from the database and trigger a
   >> third party program (exiftool for example) to insert the information into image files!
   >> </li>

   >> <li>
   >><b>specifically</b> for the following image file formats there is the ability to define a rectangular <b>region</b> on an
   >> image and assign a tag group/tag to that region.
   >>   <ul>
   >>   <li>BMP (bitmap)</li>
   >>   <li>JPEG / JPG</li>
   >>   <li>WMF (metafile)</li>
   >>   <li>ICO (icon)</li>
   >>   <li>GIF</li>
   >>   </ul>

   >> </li>

   >>  </ul>

   sob ( HelpTextsob , "ADD" , "ROW", freestring )

END Function

FUNCTION  ContactHTML ( sobid )
   sob ( HelpPageSob  ,"SET","SHOW",1)
   sob ( HelpTextSOB, "empty"    )
   >
   >> <h2>Contact</h2>

   >> E-Mail: <i>George.Salisbury@RipeTech.com</i>
   >> <br><br>

   >>(Auch auf Deutsch wenn Sie wollen.)

   sob ( HelpTextsob, "ADD",   "ROW" ,  freestring   )
END Function

' -----------------------------------------------------

FUNCTION HelpVersion ( sobid )
   sob ( HelpPageSob  ,"SET","SHOW",1)
   sob ( HelpTextSOB, "empty"    )
   >
   >> <h2>Version</h2>

   >> Application  version:
   freestring = freestring & " " & AppVersion

   >><br><br>Underlying database engine is SQLite  version:
   freestring = freestring & " " & sqlVersion()

   sob ( HelpTextsob, "ADD",   "ROW" ,  freestring   )

END Function

FUNCTION HelpUseCases ( sobid )
   sob ( HelpPageSob  ,"SET","SHOW",1)
   sob ( HelpTextSOB, "empty"    )
   >

   >> <h2>Use Cases</h2>

   >> There are use cases for this program even if you do not apply any tagging.
   >><br>In a new database, scan the required source folders, do not bother with      any tagging:

   >> <ol>
   >><li><i>Back up</i>: save the files to a back up storage device / folder.</li>
   >><li><i>Find adds & changes</i>: save the database, do a rescan some time later and the program will identify new and changed files.</li>
   >><li><i>Remove empty files</i>: <b>Delete / Delete files</b> use the <b>empty</b> action to find
   >>empty (size = 0) files and delete them.</li>

   >> <li><i>Remove duplicate files</i>: <b>Export / Export to folder</b> use the <b>duplicate</b>
   >>   action to find duplicate files.     <br>Export the files to a folder.
   >> Then drag'n'drop individual files on to the bottom right (blueish)  panel,
   >> this will cause the duplicate files to be listed in a cobobox at the top of the screen.
   >> Select  from the combobox the upwanted duplicate(s) and delete them (<b>Delete file</b>
   >> button to the       right of the combobox.</li>

   >>  <li><i>Locate files</i>: <b>Export / Export to folder</b> use the <b>path</b>, <b>file</b>,
   >>  and <b>ext</b> actions to filter the database down to the wanted file(s) and export a copy
   >>  to the export folder. </li>

   >> </ol>

   >><br>If you apply tagging then the following use cases are added:

   >> <ol>

   >>  <li><i>Locate files</i>: <b>Export / Export to folder</b> you have the file-system actions and all of the tag related
   >>  actions to filter the database down to the wanted file(s) and export a copy
   >>      to your export folder.
   >>    <br>My sister recently asked me for a copy of all image files with her daughter in them.</li>
   >>      In just a few minutes I had a zip file for my sister with almost 350 pictures.</li>

   >>  <li><i>Who is that</i>: I use the <b>Regions / Rubberbanding</b> tool to define a region (rectangle) over people
   >> in image files, and associate the region with a tag (such as a <b>who</b> tag group, with the
   >>   tag <b>Great Uncle Bill</b>, with tag text holding some details about <b>Great Uncle Bill</b>).
   >>   When browsing the images, with other people sitting next to me, I can
   >> click on a region and provide those people next to me with the name of the person under the region, and
   >> if the  <b>tag text</b> is populated,  information about the person in the region.</li>

   >>  <li><i>What is that</i>: Again using  the <b>Regions / Rubberbanding</b> tool.
   >> <br> Define a region (rectangle) over objects in an image: cars, dogs, food (recipe in the tag text?),...
   >> </li>

   >>  <li><i>Lest we forget</i>: Use the <b>File text</b> field of a specific file to hold
   >> a general statement/description of the file.
   >> <br> e.g. I have a picture showing about half of the landing craft of MV Llangibby Castle on D-Day 1945
   >> , the <b>file text</b> for this image is a good place to mention that William Alfred Salisbury (my father) was a
   >> Royal Marine on board one of MV Llangibby Castle's landing craft, possibly one of the craft in the image!
   >> </li>
   >> </ol>

   >> <br>Yes I know that <b>regions</b>, <b>file text</b>  etc, only make sense to this
   >> metadata tagging program, <b>BUT</b>  the information is in an open format, and
   >> in a standard (SQLite) database.
   >><br><br>You can either  access the database with some other tool, or write
   >> a script, using the <b>Expert Mode</b> to export the wanted content in the format that you
   >> want.
   >> <br>Or just export it all to Microsoft Excel (if you have it on the same machine as this program)
   >> and write a script in Microsoft VBA, or whatever!

   >><br><br>My position, as the author of this program is:
   >> <p style="color:red">The really important issue (especially  regarding images) is  capturing  the metadata
   >> in  an open, plain text, reusable format.</p>
   >>Writing on the back of a paper picture is just not enough, and it damages the photo.

   sob ( HelpTextsob, "ADD",   "ROW" ,  freestring   )
END Function

FUNCTION cbTechieTalk ( sobid )
   sob ( HelpPageSob  ,"SET","SHOW",1)
   sob ( HelpTextSOB, "empty"    )
   >
   >> <h2>Techie Talk</h2>

   >>A single (portable) executable file (okay, it does create a small database file in the folder where
   >> the executable is located, this database is used to hold configuration data that persists over sessions).
   >><br>
   >><br>Freeware, closed source.
   >><br>Only available for Microsoft Windows.
   >> <br> <br>
   >>This is a <b>tri</b>-language program (<b>4</b> if you include SQLite).
   >><ol style="margin-top: 0;">
   >><li>The application that you see is written in a BASIC like script that has been encoded and embedded in to this executable.</li>
   >><li>The BASIC script is interpreted at runtime via a FORTH like system into calls to native code.</li>
   >><li>The native code was compliled from a program written in <b>plain old "C"</b>.</li>
   >></ol>

   >>No MFC or WPF or any other framework was used, GUI management was done at the Windows API (Win32) message level.
   >><br><b>Why be awkward, when, with a little effort you can be impossible</b>

   >><br><br> The BASIC like environment supports:
   >> <ul>
   >>    <li>DLL access</li>
   >>    <li>on-the-fly GUI creation</li>
   >>    <li>automation (used to be called OLE Automation, or Object Linking & Embedding)</li>
   >>    <li>macros (functions/subroutines)</li>
   >>    <li>access to SQLite to create/manage/delete databases and tables</li>
   >>    <li>access to SQLite to handle queries and their responses</li>
   >>    <li>exchange of information between SQLite queries and "BASIC" statements</li>
   >>    <li>a number of built-in demo programs for various capabilites</li>
   >>    <li>lots and lots more</li>
   >> </ul>

   >> More about the capabilites of this program is available online at:
   >>     www.plodware.com   (actually a sub-domain of   www.ripetech.com)

   >> <br> Application  version:
   freestring = freestring & " " & AppVersion

   >><br><br>Underlying database engine is SQLite  version:
   freestring = freestring & " " & sqlVersion()
   >><br> For help with the SQLite syntax please look at the many online sites.

   sob ( HelpTextsob, "ADD",   "ROW" ,  freestring   )

END Function

FUNCTION HelpFacialRecognition ( sobid )
   sob ( HelpPageSob  ,"SET","SHOW",1)
   sob ( HelpTextSOB, "empty"    )
   >
   >> <h2>Facial Recognition</h2>
   >> No, this program can not do any facial recognition.
   >> <br><br><b>But</b> here is what I did!
   >> <br><br>By late 2021 I had a amassed a collection of ~27000 pictures.
   >> About a third were analogue: 35mm slides, 6x6 slides, 35mm negatives, 6x6 negatives and simple paper pictures
   >> <br>A pitiful small number of the pictures were old paper pictures of family members dating back to about 1908.
   >><br>I felt motivated to preserve some knowledge (e.g. metadata) of the people and places in those pictures, and I wanted
   >> it to be in a computer file, not on the back of the paper picture.
   >><br>A digital file, such as a database would allow me search, find and display the images and metadata.
   >> <br>The first step was to digitise the analogue images. So I bought:
   >> <ul>
   >> <li>Epsom V600: flatbed scanner with picture / slide / negative capabilites (35mm and 6x6) er somewhat slowwww,
   >> but capable of very high resolution. Disappointing. Sorry, but it was not fun, it arrived with a failure in its lighting system, which was repaired, and then 13 months later failed again!</li>
   >> <li>Kodak Slide N Scan Film and Slide Scanner: a small 35mm slide and film strip scanner, reasonably fast, medium resolution.
   >> But it could not handle many of my slides because they where too thick. I solved this my making my own slide holder out of stiff paper
   >> and two thin strips of wood! It was fun but limited, I wish I had bought a similar scanner that also had 6x6 capability.  </li>
   >> <li>Plustek ePhoto Z300: a quick and easy paper picture scanner. I found it fun to use! And it did what I wanted.</li>
   >> </ul>
   >> With these 3 scanners I was able to digitise all of my analogue images.
   >><br>Even the panoramic picture from my university days which was too long to scan in one go.
   >>So I scanned as much as I could from each end, and then used a freeware program
   >> to stitch the two pieces together (I can not remember which program it was, sorry).
   >> <br><br>Now, there was one issue when digitising the images. Having dust free slides and film strips. It takes time!
   >> <br>My recommendation. Do not clean (yet)!
   >> <br>Scan everything. See which images are worth keeping, and which of these need cleaning.
   >> <br>Those that are interesting, clean them and scan to the highest resolution.
   >> <br><br>

   >> Now for the <b>Facial recognition</b> bit.
   >> <br><br>
   >> I tried using Microsoft   <b>Photos</b>.  Let us just say that I failed to achieve my goal!
   >> <br>
   >> <br>I then heard that the <b>Picasa</b> program from Google, although no longer supported, has some facial recognition abilities.
   >> <br>Copies of <b>Picasa</b> can still be found in the Internet.
   >> <br>Downloaded it, installed it, ran it.
   >> <br>Within 2 hours I was applying names to facial groups that <b>Picasa</b> had identified.
   >> <br>Then another 2 days to sort out the problem faces (one baby can look a lot like another).
   >> <br>
   >> <br>Of the ~27000 files, Picasa provided me with facial recognition on 7300 images.
   >><br>About 5200 images with a single <i>person</i>
   >><br>About 2100 images with more than one (identified)<i>person</i>
   >><br><br>I then used the <b>Region</b> capabilites of this metadata tagging program and provided names by hand (easy, and with acceptable speed)
   >><br>About 2300 images with a single <i>person</i>
   >><br>About 700 images with more than one (identified) <i>person</i>
   >><br><br>In total I now have 9500 images where someone is identified.
   >><br><br>In some cases Picasa did not identify a face because the face was turned away from the camera, or
   >> was partially obsured.
   >><br>All in all I am well pleased with the result.

   >> <br>
   >> <br><b>Picasa</b> saves, in plain text, facial recognition information in a <b>.picasa.ini</b> file which it writes in to the
   >> folder where the image is.
   >> <br>I have about 850 folders with images, so 850 <b>.picasa.ini</b> files.
   >><br>I  wrote a script of less than 300 lines, using the <i>BASIC</i>  like language in which this application was written, to
   >> scan the <b>.picasa.ini</b> files, create a <b>who</b> tag for each face group(about 200 named face groups) and insert
   >> that tag in to the appropriate file's database entry.
   >><br><br>
   >>Summary: facial recognition was <b>much</b> easier than I expected: Now I wonder if other recognition solutions are
   >> available (animals, flower,...) i.e. generic objects.
   >><br>

   >><p style="color:red">The <b>.picasa.ini</b> files include the position of the face on the image.
   >><br> This was my motivation to implement <b>Regions</b>, see a separate help topic!
   >></p>

   sob ( HelpTextsob, "ADD",   "ROW" ,  freestring   )
END Function

FUNCTION HelpRegions ( sobid )
   sob ( HelpPageSob  ,"SET","SHOW",1)
   sob ( HelpTextSOB, "empty"    )
   >
   >> <h2>Regions</h2>
   >> This only applies to individual image files that are drag'n'dropped on to the
   >> bottom right panel (blueish).

   >><br><br>A region is a rectangular area on a image that is linked to a tag.
   >><br>If that image is drag'n'dropped on to the
   >> bottom right panel (blueish), then the region(s) associated with that image will be displayed
   >> on the image (only in the bottom right panel, not actually in the image).
   >><br><br>You can then click on a region and the tag information associated with that region
   >> will be displayed.
   >><br><br>You can define your own regions, and assign each region its own (single) tag. The tag can be in any
   >> tag <b>group</b>.
   >><br>I have some images of my musical instruments, and on some images I have a region
   >> with the tag <b>bouzouki</b> (nice for playing Irish folk songs).
   >><br>
   >><br>To assign a region you must activate the menu option  <b>Regions / Rubberbanding</b>.
   >><br><b>Draw</b> a rectangle over the region with the mouse, let go, and a tool-page will appear on the
   >> left hand side, enabling you to:
   >><ul style="margin-top: 0;">
   >><li>assign an existing tag to the region</li>
   >><li>create a new tag and assign it to the region</li>
   >><li>delete the region</li>
   >></ul>

   >>There are three types of region:
   >><ul style="margin-top: 0;">
   >><li>with a tag</li>
   >><li>without a tag</li>
   >><li>rubberband - not yet turned into a permanent region</li>
   >></ul>
   >>You can customise the colour of these regions' edges so that you can
   >> better identify which regions are which.
   >><br>
   >><br>This tool-page also allows you to edit the <b>tag text</b> that belongs to a tag that
   >> is assigned to a region.
   >><br>Yes, this could be done under the menu <b>Tools / Tag Management</b> but experience suggests to me
   >> that it is useful to have an edit option here as well.

   sob ( HelpTextsob, "ADD",   "ROW" ,  freestring   )
END Function

FUNCTION myTagGroups ( sobid )
   sob ( HelpPageSob  ,"SET","SHOW",1)
   sob ( HelpTextSOB, "empty"    )
   >
   >> <h2>Tag Groups that I use</h2>
   >>
   >><ul>
   >><li><b>who</b>
   >><br> For image files I use this tag group to hold the names of the people in the image.
   >> For scans of documents (e.g. birth certificates, insureance policies...), the name(s) of the
   >> document owners.
   >><br> For other file types (e.g. PDFs, Excel, ... ) , the name(s) of the
   >> document owners, or even no tag.
   >> <br> <br>
   >></li>
   >><li><b>what</b>
   >><br> For image files I have tags such as <b>landscape</b>, <b>coastal</b>, <b>Buildings and Grounds</b>,
   >>  <b>scan</b>.
   >><br> For other file types (e.g. PDFs, Excel, ... )  <b>document</b>, <b>certificate</b>
   >> <br> <br>
   >> </li>
   >><li><b>where</b>
   >><br> For image files I have tags such as <b>England</b>, <b>Wales</b>, <b>London</b>,
   >>  <b>Corfe Castle</b>, <b>BRNC</b> <i>many many moons ago I had the honour to graduate from there</i>
   >><br> For other file types (e.g. PDFs, Excel, ... )  currently no tag.
   >> <br> <br>
   >> </li>

   >><li><b>when</b>
   >><br> For image files I tag the year in which the picture was taken. In some cases I qualify the date
   >> e.g.  <b>1999 Christmas</b>
   >><br> For other file types (e.g. PDFs, Excel, ... )  the date the document was created.
   >> <br> <br>
   >> </li>

   >><li><b>For Deletion</b>
   >><br> It only has one tag: <b>yes</b>. I use this to mark a file that I intend, maybe later, to delete.
   >> </li>

   >><br>
   >><br>The following are automatically defined by the application
   >><br> <br>

   >><li><b>Tagged</b>
   >><br>If you have lots of files to tag it is almost guaranteed that you will lose track of which files
   >> have been fully tagged, and which not, or which have say  all of their <b>who</b> tags
   >> but not all of their <b>where</b> tags.
   >><br>I use this tag group to keep track of which files do not need futher attention:
   >><br> See <b>Help / Tips'n'Tricks</b>
   >><br> <br> </li>

   >><li><b>Rescan State</b>
   >><br>
   >> For a <b>new</b> database this internal tag group is automatically
   >> set to <b>new</b> for all files.
   >><br>After a <b>rescan</b> the tag for a file is set as follows:
   >><ul style="margin-top: 0;">
   >> <li> <b>unchanged</b> file has kept its hash value</li>
   >> <li> <b>changed</b> the file has been modified, so its hash has changed.</li>
   >> <li> <b>new</b> the file was not in the old database</li>
   >></ul>
   >><br> <br> </li>

   >></ul>

   >> Currently I think that I need another tag group, <b>location</b>. Whilst the database knows where the digital file is,
   >>   it currently does not have any information about the physical location of the referenced <i>analogue</i> object.
   >> <br>i.e. for a scan of a paper picture, where is that paper picture located. Likewise for scans of formal documents!

   sob ( HelpTextsob, "ADD",   "ROW" ,  freestring   )

END Function

FUNCTION WelcomeMessage ( sobid )
   sob ( HelpPageSob  ,"SET","SHOW",1)
   sob ( HelpTextSOB, "empty"    )
   >
   >> <h2>Welcome</h2>

   >>There are some on-line help pages for this application, see the menu option
   >> <b>Help / Go to online help</b>.

   >><br>
   >><br> https://RipeTech.com/PWMetaTagger
   >><br>

   >><br>
   >>There are also some help pages embedded in to this program.
   >><br>
   >><br>Try the menu  <b>Help</b>.

   sob ( HelpTextsob, "ADD",   "ROW" ,  freestring   )

END Function

' -------------------------------------------------------------------------------------------
' -------------------------------------------------------------------------------------------
' -------------------------------------------------------------------------------------------
' -------------------------------------------------------------------------------------------

dim escChr = 0x01b

dim defActionComboText =  "          "
dim defTypeComboText   =  "        "

dim haveRectMeta = 0
dim haveRectPicasa = 0

dim DbName       = ""
dim copyTagGroup = ""
dim copyTagName  = ""

dim RegionRectWeight , RegionRectShow ,  reDrawRegionsID
dim ImageLoadedFlag = 0
dim leftRB , topRB , rightRB, bottomRB
dim HaveRubberBandRect
dim FirstFileMenuItem

dim CommonSobTitle
dim CommonSobInfo
dim CommonSobBtn , CommonSobBtnB , CommonSobCombo
dim CommonSobResult

FUNCTION CommonSobClear ( mytitle )
   sob ( CommonSobTitle   , "SET" , "TITLE" , mytitle)
   sob ( CommonSobInfo    , "EMPTY" )
   sob ( CommonSobResult  , "EMPTY" )
   sob ( CommonSobBtn     , "set" , "show" , 0)
   sob ( CommonSobBtnB    , "set" , "show" , 0)
   sob ( CommonSobCombo   , "set" , "show" , 0)
   sob ( CommonSobCombo   , "EMPTY" )

   noErrorReport ("")
END FUNCTION

dim TransparentRGB = rgb (1,1,1)  ' do NOT change this, is hardcodeed in the underlying interpreter!
dim defBtnCol     =  rgb ( 0xd4, 0xd0, 0xc8 )
dim bgBoxCol      =  rgb ( 0x7f, 0xff, 0x7f )
dim defBoxTxtCol  =  rgb ( 0xeb, 0xeb, 0xeb )
dim defLabelCol   =  rgb ( 0xeb, 0xeb, 0xeb )
dim ErrorCol      =  rgb ( 0xff, 0x60, 0x60 )
dim WarningCol    =  rgb ( 0xff, 0xbf, 0xbf )
dim bgStatusCol   =  rgb ( 0xeb, 0xeb, 0xeb )
dim defStatusCol  =  rgb ( 0x00, 0xff, 0x00 )
dim bgTypeCol     =  rgb ( 0x7f, 0xff, 0x7f )
dim defTypeCol    =  bgTypeCol
dim altTypeCol    =  rgb ( 0xff, 0xff, 0xff )
dim defNameCol    =  rgb ( 0x97, 0xd5, 0xff )
dim altNameCol    =  rgb ( 0xff, 0xff, 0xff )
dim defTextCol    =  rgb ( 0xff, 0xff, 0x7f )
dim bgROeditCol   =  bgStatusCol

dim tagArray ,   uBoundTagArray
dim tagTxtArray ,   uBoundTagTxtArray
dim tagFlag, FreeTextFlag

dim SavedTagTypeComboArray  ( 128 ) as handle
dim SavedTagTypeComboIndex = 0

dim TagTypeComboArray  ( 128 ) as handle
dim TagTypeComboIndex = 0

' -------------------------------------------------------------------------------------------
' -------------------------------------------------------------------------------------------
' -------------------------------------------------------------------------------------------
' -------------------------------------------------------------------------------------------
' -------------------------------------------------------------------------------------------

FUNCTION UpdateUsedFileList ()
   dim i , fName, pos = 0 , rid
   FOR I = 0 to 10

      >  select txt from  parameters  where type like 'file' order by val desc  limit 1  offset
      freestring = freestring & " " &         sqlString ( "" & i )
       fName = db_arg_text (  freestring )
      IF ( isFile ( fName   )  == 1 )   then
         sob (  sob(FirstFileMenuItem,"SIBLING",pos++) , "SET" , "TITLE" , fName  )
      END IF

   NEXT i

   > select count (*) from  parameters  where type like 'file'
 
   pos = db_arg_int (  freestring )
 
   i = 11
   DO while  i < pos

      > select rowid from  parameters  where type like 'file' order by val desc  limit 1  offset 11

 
      rid = db_arg_int (freestring)

      > delete from  parameters  where type like 'file' and rowid =
      freestring =   freestring  & rid

 db_arg_set(freestring)

      i ++
   LOOP
 
END function

FUNCTION AddFileToUsedList ( useFile, accesstype )

   dim fileNbr

   fileNbr = db_arg_int ( " select count(*) from parameters where type like 'file' " )
   IF fileNbr then
      > select  max ( val)  from  parameters where type like 'file'
      fileNbr  =  db_arg_int(  freestring )   + 1
   ELSE
      fileNbr = 1
   END if

   > Delete from parameters where  type like 'file'   and   txt like
   freestring = freestring & " " &         sqlString ( useFile )

   db_arg_set (  freestring )

   >  insert into parameters  values  ('file', '',
   freestring = freestring & " " &         sqlString ( fileNbr )
   >>   ,
   freestring = freestring & " " &         sqlString ( useFile )
   >>   , '' )

   db_arg_set (  freestring )

   UpdateUsedFileList ()

END Function

FUNCTION OpenMessage ( )
   dim onArea = CommonSobInfo
   sob ( onArea  , "ADD" , "ROW" , "" & EOL )
   sob ( onArea  , "ADD" , "ROW" , "You can now start working on the database." & EOL )
   sob ( onArea  , "ADD" , "ROW" , "e.g." & EOL )
   sob ( onArea  , "ADD" , "ROW" , "    To get details about a file drag and drop a  " & EOL )
   sob ( onArea  , "ADD" , "ROW" , "    file on to the blue area." & EOL )
   sob ( sobImageHolder , "SET"  , "RGB", RGB( 100,200,255) )
END FUNCTION

' ----------------------------------------------------------

FUNCTION deReferenceTagInRegions (   TagGroup , Tagname   )

   IF ( haveRectMeta  ) then
      > update Master  set RectMeta   = replace( RectMeta,
      freestring = freestring & " " &         sqlString ( ")," & TagGroup & TagDelim & Tagname & ";"  )
      >> ,
      freestring = freestring & " " &         sqlString ( ")fffffffffffffff;" )
      >>   )
      sql ( freestring )
   END IF

   IF ( haveRectPicasa ) then
      > update Master  set RectPicasa   = replace( RectPicasa ,
      freestring = freestring & " " &         sqlString ( ")," & TagGroup & TagDelim & Tagname & ";"  )
      >> ,
      freestring = freestring & " " &         sqlString ( ")fffffffffffffff;" )
      >>   )
      sql ( freestring )
   END IF

END Function

FUNCTION deReferenceTagInRegionsInHash ( hashVal ,   TagGroup , Tagname   )

   ' remove a tag group/tag name   from the RECT columns   for a specific   HASH value
   ' we leave the RECT part in the table, and set its group/name part to the default

   > update Master  set RectMeta   = replace( RectMeta,
   freestring = freestring & " " &         sqlString ( ")," & TagGroup & TagDelim & Tagname & ";"  )
   >> ,
   freestring = freestring & " " &         sqlString ( ")fffffffffffffff;" )
   >>   ) where hash like
   freestring = freestring & " " &         sqlString ( hashVal  )
   sql ( freestring )

   > update Master  set RectPicasa   = replace( RectPicasa ,
   freestring = freestring & " " &         sqlString ( ")," & TagGroup & TagDelim & Tagname & ";"  )
   >> ,
   freestring = freestring & " " &         sqlString ( ")fffffffffffffff;" )
   >>   ) where hash like
   freestring = freestring & " " &         sqlString ( hashVal  )
   sql ( freestring )

END Function

FUNCTION ReReferenceTagInRegions (  TagGroup , OldTagname  , NewTagname  )

   > update Master  set RectMeta   = replace( RectMeta,
   freestring = freestring & " " &         sqlString ( ")," & TagGroup & TagDelim & OldTagname & ";"  )
   >> ,
   freestring = freestring & " " &         sqlString ( ")," & TagGroup & TagDelim & NewTagname & ";"  )
   >>   )
   sql( freestring )

   > update Master  set RectPicasa   = replace( RectPicasa,
   freestring = freestring & " " &         sqlString ( ")," &  OldTagname & ";"  )
   >> ,
   freestring = freestring & " " &         sqlString ( ")," &  NewTagname & ";"  )
   >>   )
   sql( freestring )

END Function

' ----------------------------------------------------------

FUNCTION CBUsedFileList ( sobid )
   ' sobid   = selected   UsedFileList menu shortcut
   ' open a previous database using the UsedFileList  shortcuts
 
    dim dbFIle = sob ( sobid, "get","title")
 
   currentFile = ""
 
   CommonSobClear ( "Open database from used file list" )
    >Open a database file, in memory§
   >>§
   >>Changes are ONLY saved when you explicitly trigger a save.§

   sob ( CommonOvl ,"set","show",1)
   dim proceed = 1

   IF ( proceed ) then
      TRY
         dbopen("memory" ,dbFIle)

      CATCH
         ErrorReport ("Open failed on file : "  &  dbFIle )
         sob ( CommonSobResult  , "add" , "row" , "Open failed on file : "  & EOL &  dbFIle & EOL )

         proceed = 0
      END try
   END IF

   copyTagName  = ""

   IF ( proceed ) then
      proceed = dbValidityCheck ()
 

   END IF

   IF ( proceed )  then

      > select comment from parameters where type like 'file' and txt =
      freestring = freestring & " " &         sqlString ( dbFIle )
      currentFile = db_arg_text ( freestring)

      AddFileToUsedList ( dbFIle, "rw" )

      sob ( statusDBFile, "SET" ,"TITLE" ,   dbFIle )

      IF ( !  isTable (  , "master") ) then
         sob ( CommonSobResult  , "add" , "row" , "No  master    table in database"  & EOL )

         dbclose()
         proceed = 0
      END if
   END IF

   IF ( proceed )  then
      NoErrorReport ("Open OK " )
      update master set key = hash || path || name
      sob ( CommonSobResult  , "add" , "row" , "Database file OK: "  & EOL &  dbFIle & EOL & EOL )
      OnOpenPrepareMasterTagTable (CommonSobResult)
      OpenMessage ( )

      cbsingleFile ( currentFile )
   END IF

END function

FUNCTION create_usedFileList ()

   FirstFileMenuItem = sob ( myMenuFile    ,  "add"  ,   "menu"  ,  "Vertical"  , "0 "    )
   sob (   -1     ,  "ON"   ,  "CLICK"  , "CBUsedFileList")

   dim i
   FOR I = 1 to 10
      sob ( myMenuFile    ,  "add"  ,   "menu"  ,  "Vertical"  ,""    )
      sob (   -1     ,  "ON"   ,  "CLICK"  , "CBUsedFileList")
   NEXT i

END Function

FUNCTION enableUsedFileSelection ( flag )
   dim i
   FOR I = 0 to 10
      SOB (sob(FirstFileMenuItem,"SIBLING",i)       , "SET" , "MENU.GREY" ,flag )

   NEXT i
END function

FUNCTION getFirstFileDir ()

   dim defDir = sob (  FirstFileMenuItem  , "GET" , "TITLE" )

   IF ( isFIle ( defDir  )   ) then

      IF  ( defDir  ) then

         DO WHILE ( right ( defDir , 1 ) <> "\\" )
            defDir = right ( defDir , -1 )
         LOOP
         getFirstFileDir = defDir

      END IF

   ELSE
      getFirstFileDir =  dir
   END IF

   IF ( isFIle ( getFirstFileDir  )   == -1  ) then
   ELSE
      getFirstFileDir =  app@cwd
   END IF
   FileSelDir ( getFirstFileDir)

END function

' -------------------------------------------------------------------------------------------

FUNCTION toggleWarnColour ( sobid )
   IF ( sob  (sobId , "GET", "RGB" ) == WarningCol ) then
      sob ( sobId , "SET", "RGB" , RGB ( 0xff ,0,0 )  )
   ELSE
      sob ( sobId , "SET", "RGB" , WarningCol  )
   END IF
END FUNCTION

FUNCTION toggleOKColour ( sobid )
   IF ( sob  (sobId , "GET", "RGB" ) == bgTypeCol ) then
      sob ( sobId , "SET", "RGB" , RGB ( 0 ,0xff ,0 )  )
   ELSE
      sob ( sobId , "SET", "RGB" , bgTypeCol  )
   END IF
END FUNCTION

dim MarkRowid = "0"
FUNCTION CbdeleteFileListDoit ( sobid )

   IF ( !  isDBopen   )  then
      sob ( CommonSobResult  , "ADD" , "ROW" , "No database is open!" & EOL )

      toggleWarnColour ( sobid)
      EXIT function

   END IF

   SELECT count (*) from temp.SubList  where type = 'file'
   dim fileCount = qrSingleValue

   IF ( !  fileCount   )  then
      sob ( CommonSobResult  , "ADD" , "ROW" , "No files selected!" & EOL )

      toggleWarnColour ( sobid)
      EXIT function

   END IF

   IF ( msgBox ( "Delete the files?" , 0x04 , "WARNING" ) )  THEN

      EXIT function
   END if

   cancelClear ()
   cancelText( "DELETE Files" , 1 )

   cancelText( "Files to delete: " & FileCount , 2 )
   cancelShow(1)

   WITHQUERY ( " select path , name , rowid  from temp.SubList  where type = 'file'    ")
      TRY
         DeleteFileNow    ( wqtext(1) & wqtext(2)  )

         > delete from master where path like $pth and name like $nme
         freestring = replace ( freestring , "$pth" , sqlString (wqText(1))   )
         freestring = replace ( freestring , "$nme" , sqlString (wqText(2))   )
         sql (freestring)

         > delete from temp.SubList where rowid =  $rid
         freestring = replace ( freestring , "$rid" , sqlString (wqText(3))   )
         sql (freestring)

      CATCH

         IF ( isFile (wqtext(1) & wqtext(2)) ) then

            sob ( CommonSobResult  , "add" , "row" , "delete file failure: " & EOL & wqtext(1) & wqtext(2) & EOL  &  dstPoint & EOL )
         END IF
      END try

      cancelToggle ()
      fileCount--
      IF ( fileCount BAND 0x0f ) then
      ELSE
         cancelText( "Files to delete: " & FileCount , 2 )
      END IF

   END withquery
   cancelShow(0)
   sob ( CommonSobResult  , "add" , "row" , "Delete finished! " &  EOL )

   toggleWarnColour ( sobid)
END FUNCTION

FUNCTION CbdeleteFileList ( sobid )
   CommonSobClear ( "Delete files" )

   > Use this to DELETE the   files  in the file list§
   >>   - The files will be sent to the Recycle bin§
   >> The files will be deleted from the file system and removed from the database§
   sob ( CommonSobInfo  , "ADD" , "ROW" , replace ( freestring , EOLdelim , EOL ) )

   sob ( CommonSobBtn , "SET" , "TITLE" , "Delete")
   sob ( CommonSobBtn , "ON"  , "PRESS" , "CbdeleteFileListDoIt")
   sob ( CommonSobBtn , "SET" , "rgb"   , defBtnCol)

   sob (   CommonOvl ,"set","show",1)

END Function

FUNCTION CbExportFileListDoIt ( sobid )

   IF ( ! isDBOpen ) then
      ErrorReport ("No database selected" )
      EXIT function
   END if

   exportFilter ( "export" ,  "" ,  GetPath & "\\"    )
END FUNCTION

FUNCTION CbReuseTargetFolder ( sobid )

   IF ( ! isDBOpen ) then
      ErrorReport ("No database selected" )
      EXIT function
   END if

   exportFilter ( "export" ,  "" ,  ExportFolder    )
END FUNCTION

dim TargetFolder , ExportFolder  = ""

FUNCTION CbOpenExportFolder (sobid )

   sob ( sobid, "set", "show", 0 )

   IF ( ! isdbopen ) THEN
      ErrorReport("No database open")
      EXIT function
   END IF

   ShellExecute ( TargetFolder  )
END function

FUNCTION cbExportFileList ( sobid )
   CommonSobClear ( "Export files" )

   > Use this to export(copy) the   files  in the file list to a folder§
   >>   - The files are given a unique name, and placed under the specified folder§
   >>   - The files will be placed in a single "flat" folder
   sob ( CommonSobInfo  , "ADD" , "ROW" , replace ( freestring , EOLdelim , EOL ) )

   sob ( CommonSobBtn , "SET" , "TITLE" , "Export")
   sob ( CommonSobBtn , "ON"  , "PRESS", "CbExportFileListDoIt")
   sob ( CommonSobBtn , "SET" , "rgb" , defBtnCol)
   sob ( CommonSobBtn , "set" , "show",1)

   IF ( ExportFolder  <> "") then

      sob ( CommonSobBtnB , "SET",  "TITLE" , "Export to previous folder" )
      sob ( CommonSobBtnB , "ON"  , "PRESS", "CbReuseTargetFolder")

   END if

   sob ( CommonOvl , "set" , "show",1)

END Function

FUNCTION FilterOnTagPlus ( TagGroup )
   dim FilterTags  , uBoundFilterTags , i

   > insert into temp.SubList SELECT rowid , *  from master where

   sql ( "select " & sqlIdentifier ( TagGroup & TagGroupId )  & " from temp.masterfile limit 1" )
   redim FilterTags  = split ( replace ( qrSingleValue , TagDelim ,  nonPrintableDelim ) ,  nonPrintableDelim )
   uBoundFilterTags = uBOuND ( FilterTags )

   IF ( uBoundFilterTags > -1 ) then
      FOR i = 0 to   uBoundFilterTags
         freestring = freestring & " " & sqlIdentifier ( TagGroup & TagGroupId )
         >> like
         freestring = freestring & " " & sqlString ( "%" & TagDelim &  FilterTags(i) & TagDelim & "%" )
         >> and
      NEXT i
   END IF

   >>  1
   sql(freestring)

END function

FUNCTION FilterOnTagOnly ( TagGroup , TagName)
   dim MustHaveTags  , uBoundMustHaveTags , i

   drop table if exists temp.SubListTemp
   create table temp.SubListTemp as select rowid as rid  , * from master limit 0

   > insert into temp.SubListTemp SELECT rowid , *  from master where
   freestring = freestring & " " &  sqlIdentifier ( TagGroup & TagGroupId )
   >> like
   freestring = freestring & " " &  sqlstring("%" & TagDelim & TagName & TagDelim & "%" )

   sql(freestring)

   dim tmpStr
   > delete from temp.SubListTemp   where

   tmpStr =  "   (    (length (§§) - length(replace(§§, § , '' ) )        )  / length (§) )  "
   tmpStr = replace ( tmpStr , "§§" , sqlidentifier( TagGroup & TagGroupId ) )
   freestring = freestring & " " &  replace ( tmpStr , "§" , sqlstring(TagDelim)  )
   >>  > 2

   sql(freestring)

   report ( freestring )

   insert into temp.SubList select * from temp.SubListTemp

END Function

FUNCTION FilterOnTagIdentical ( TagGroup )
   dim MustHaveTags  , uBoundMustHaveTags , i

   drop table if exists temp.SubListTemp
   create table temp.SubListTemp as select rowid as rid  , * from master limit 0

   > insert into temp.SubListTemp SELECT rowid , *  from master where

   sql ( "select " & sqlIdentifier ( TagGroup & TagGroupId )  & " from temp.masterfile limit 1" )
   redim MustHaveTags  = split ( replace ( qrSingleValue , TagDelim ,  nonPrintableDelim ) ,  nonPrintableDelim )
   uBoundMustHaveTags = uBOuND ( MustHaveTags )

   IF ( uBoundMustHaveTags > -1 ) then
      FOR i = 0 to   uBoundMustHaveTags
         freestring = freestring & " " & sqlIdentifier ( TagGroup & TagGroupId )
         >> like
         freestring = freestring & " " & sqlString ( "%" & TagDelim &  MustHaveTags(i) & TagDelim & "%" )
         >> and
      NEXT i
   END IF

   >>  1
   sql(freestring)

   dim tmpStr
   > delete from temp.SubListTemp   where

   tmpStr =  " not  (   (  length (§§) - length(replace(§§, § , '' ) )/ length ( §) ) "
   tmpStr = replace ( tmpStr , "§§" , sqlidentifier( TagGroup & TagGroupId ) )
   freestring = freestring & " " &  replace ( tmpStr , "§" , sqlstring(TagDelim) )
   >>  = ( select
   tmpStr =  " (  length (§§) - length(replace(§§, § , '' ) )/ length ( §) ) "
   tmpStr = replace ( tmpStr , "§§" , sqlidentifier( TagGroup & TagGroupId ) )
   freestring = freestring & " " &  replace ( tmpStr , "§" , sqlstring(TagDelim) )
   >>  from temp.masterFile limit 1 )   )
   >>  or

   >>   0
   sql(freestring)

   report ( freestring )

   insert into temp.SubList select * from temp.SubListTemp

END Function

FUNCTION FilterOnTagsPlus ( )
   dim FilterTags  , uBoundFilterTags , i

   > insert into temp.SubList SELECT rowid , *  from master where
   WITHQUERY ( "select distinct  ttGroup from tagTable ")

      sql ( "select " & sqlIdentifier ( wqText ( 1 ) )  & " from temp.masterfile limit 1" )
      redim FilterTags  = split ( replace ( qrSingleValue , TagDelim ,  nonPrintableDelim ) ,  nonPrintableDelim )
      uBoundFilterTags = uBOuND ( FilterTags )

      IF ( uBoundFilterTags > -1 ) then
         FOR i = 0 to   uBoundFilterTags
            freestring = freestring & " " & sqlIdentifier ( wqText ( 1 ) )
            >> like
            freestring = freestring & " " & sqlString ( "%" & TagDelim &FilterTags(i) & TagDelim & "%" )
            >> and
         NEXT i
      END IF

   END withquery
   >>  1
   sql(freestring)

END function

FUNCTION FilterOnTagsIdentical ( )
   dim MustHaveTags  , uBoundMustHaveTags , i

   drop table if exists temp.SubListTemp
   create table temp.SubListTemp as select rowid as rid  , * from master limit 0

   > insert into temp.SubListTemp SELECT rowid , *  from master where
   WITHQUERY ( "select distinct  ttGroup from tagTable ")

      sql ( "select " & sqlIdentifier ( wqText ( 1 ) )  & " from temp.masterfile limit 1" )
      redim MustHaveTags  = split ( replace ( qrSingleValue , TagDelim ,  nonPrintableDelim ) ,  nonPrintableDelim )
      uBoundMustHaveTags = uBOuND ( MustHaveTags  )

      IF ( uBoundMustHaveTags > -1 ) then
         FOR i = 0 to   uBoundMustHaveTags
            freestring = freestring & " " & sqlIdentifier ( wqText ( 1 ) )
            >> like
            freestring = freestring & " " & sqlString ( "%" & TagDelim & MustHaveTags  (i) & TagDelim & "%" )
            >> and
         NEXT i
      END IF

   END withquery
   >>  1
   sql(freestring)

   dim tmpStr
   > delete from temp.SubListTemp   where

   WITHQUERY ( "select distinct  ttGroup from tagTable ")

      tmpStr =  " not  (   (  length (§§) - length(replace(§§, § , '' ) )/ length ( §) ) "
      tmpStr = replace ( tmpStr , "§§" , sqlidentifier(wqtext(1)) )
      freestring = freestring & " " &  replace ( tmpStr , "§" , sqlstring(TagDelim) )
      >>  = ( select
      tmpStr =  " (  length (§§) - length(replace(§§, § , '' ) )/ length ( §) ) "
      tmpStr = replace ( tmpStr , "§§" , sqlidentifier(wqtext(1)) )
      freestring = freestring & " " &  replace ( tmpStr , "§" , sqlstring(TagDelim) )
      >>  from temp.masterFile limit 1 )   )
      >>  or

   END withquery
   >>   0
   sql(freestring)

   report ( freestring )

   insert into temp.SubList select * from temp.SubListTemp

END Function

FUNCTION exportFilter ( actionTxt , optional tagtype = "" , optional  TagName = ""    )
   dim filecount

   IF ( ! isDBOpen ) then
      ErrorReport ("No database selected" )
      EXIT function
   END if

   sob ( CommonSobBtnB ,"set","show",0)

   IF ( tagtype == noTag  )  then

      ErrorReport (" no Tag Group selected" )

      EXIT function
   END IF

   IF ( TagName ==  "" ) then
      IF ( actionTxt == noTag  )  then
      ELSEIF ( actionTxt == "new" )  then
      ELSEIF ( actionTxt == "statistic" )  then
      ELSEIF ( actionTxt == "export" )  then
      ELSEIF ( actionTxt == "lock" )  then
      ELSEIF ( actionTxt == "+duplicate" )  then
      ELSEIF ( actionTxt == "+empty" )  then
      ELSEIF ( actionTxt == "Tags =="  )  then

      ELSE
         ErrorReport (" no Tag Name selected" )

         EXIT function
      END IF

   END IF

   IF ( actionTxt == "new" )  then
      MarkRowid = 0
      drop table if exists temp.SubList
      create table temp.SubList as select rowid as rid  , * from master limit 0
      EXIT function
   ELSEIF ( actionTxt == "none"  )  THEN

      EXIT function
   END IF

   IF ( ! isDBTable (  "temp", "SubList"  )  )  THEN
      EXIT function
   END IF

   IF ( actionTxt == "Tags ==" )  then
      FilterOnTagsIdentical ()

   ELSEIF ( actionTxt == "Tags =+" )  then
      FilterOnTagsPlus ()

   ELSEIF ( actionTxt == "Tag ==" )  then
      FilterOnTagIdentical (TagType)

   ELSEIF ( actionTxt == "Tag =+" )  then
      FilterOnTagPlus ( TagType)

   ELSEIF ( actionTxt == "Tag only" )  then
      FilterOnTagOnly ( TagType , TagName)

   ELSEIF ( actionTxt == "add ==" )  then
      > insert into temp.SubList SELECT rowid , * from master where
      >>      $TagType like
      freestring = freestring & " " & sqlstring ( "%" & TagDelim )
      >>  ||  $TagName ||
      freestring = freestring & " " & sqlstring ( TagDelim & "%" )
      >>   and type like 'file'

      freestring = replace ( freestring , "$TagType" , sqlIdentifier ( TagType & TagGroupId ) )
      freestring = replace ( freestring , "$TagName" , sqlString ( TagName )   )
      sql ( freestring )
      freestring = ""

   ELSEIF ( actionTxt == "add <>" )  then
      > insert into temp.SubList SELECT rowid , * from master where
      >>   not  (   $TagType like
      freestring = freestring & " " & sqlstring ( "%" & TagDelim )
      >>  ||  $TagName ||
      freestring = freestring & " " & sqlstring ( TagDelim & "%" )
      >> ) and type like 'file'

      freestring = replace ( freestring , "$TagType" , sqlIdentifier ( TagType & TagGroupId ) )
      freestring = replace ( freestring , "$TagName" , sqlString ( TagName )   )
      sql ( freestring )
      freestring = ""

   ELSEIF ( actionTxt == "add any" )  then
      > insert into temp.SubList SELECT rowid , * from master where
      >>   not  (   $TagType is null or $TagType in ( '' ,

      freestring = freestring & " " & sqlstring ( TagDelim )
      >> ,
      freestring = freestring & " " & sqlstring ( TagDelim & TagDelim )
      >> ) )

      >>   and type like 'file'
      freestring = replace ( freestring , "$TagType" , sqlIdentifier ( TagType & TagGroupId ) )

      sql ( freestring )

   ELSEIF ( actionTxt == "add ==?" )  then
      > insert into temp.SubList SELECT rowid , * from master where
      >>   $TagType like '%' || $TagName || '%'
      >>   and type like 'file'
      freestring = replace ( freestring , "$TagType" , sqlIdentifier ( TagType & TagGroupId ) )
      freestring = replace ( freestring , "$TagName" , sqlString ( TagName )   )

      sql ( freestring )

   ELSEIF ( actionTxt == "add <>?" )  then
      > insert into temp.SubList SELECT rowid , * from master where
      >>   not  $TagType like '%' || $TagName || '%'
      >>   and type like 'file'
      freestring = replace ( freestring , "$TagType" , sqlIdentifier ( TagType & TagGroupId ) )
      freestring = replace ( freestring , "$TagName" , sqlString ( TagName )   )

      sql ( freestring )

   ELSEIF ( actionTxt == "add non" )  then
      > insert into temp.SubList SELECT rowid , * from master where
      >>     (   $TagType is null or $TagType in ( '' ,

      freestring = freestring & " " & sqlstring ( TagDelim )
      >> ,
      freestring = freestring & " " & sqlstring ( TagDelim & TagDelim )
      >> ) )

      >>   and type like 'file'
      freestring = replace ( freestring , "$TagType" , sqlIdentifier ( TagType & TagGroupId ) )

      sql ( freestring )
      freestring = ""

   ELSEIF ( actionTxt == "remove <>" )  then
      > delete from temp.SubList   where
      >>     not $TagType like
      freestring = freestring & " " & sqlString ( "%" & TagDelim )
      >> ||  $TagName ||
      freestring = freestring & " " & sqlString (  TagDelim & "%"  )

      >>   and rowid > $mark
      freestring = replace ( freestring , "$TagType" , sqlIdentifier ( TagType & TagGroupId ) )
      freestring = replace ( freestring , "$TagName" , sqlString ( TagName ) )
      freestring = replace ( freestring , "$mark" ,     cstr(MarkRowid )     )

      sql ( freestring )

   ELSEIF ( actionTxt == "remove ==" )  then
      > delete from temp.SubList   where
      >>     $TagType like
      freestring = freestring & " " & sqlString ( "%" & TagDelim )
      >> ||  $TagName ||
      freestring = freestring & " " & sqlString (  TagDelim & "%"  )

      >>   and rowid > $mark
      freestring = replace ( freestring , "$TagType" , sqlIdentifier ( TagType & TagGroupId ) )
      freestring = replace ( freestring , "$TagName" , sqlString ( TagName ) )
      freestring = replace ( freestring , "$mark" ,     cstr(MarkRowid )     )

      sql ( freestring )

   ELSEIF ( actionTxt == "remove non" )  then
      > delete from temp.SubList   where
      >>     (   $TagType is null or $TagType in ( '' ,

      freestring = freestring & " " & sqlstring ( TagDelim )
      >> ,
      freestring = freestring & " " & sqlstring ( TagDelim & TagDelim )
      >> ) )

      >>   and rowid > $mark
      freestring = replace ( freestring , "$TagType" , sqlIdentifier ( TagType & TagGroupId ) )
      freestring = replace ( freestring , "$TagName" , sqlString ( TagName ) )
      freestring = replace ( freestring , "$mark" ,     cstr(MarkRowid )     )

      sql ( freestring )

   ELSEIF ( actionTxt == "remove any" )  then
      > delete from temp.SubList   where
      >>   not (   $TagType is null or $TagType in ( '' ,
      freestring = freestring & " " & sqlstring ( TagDelim )
      >> ,
      freestring = freestring & " " & sqlstring ( TagDelim & TagDelim )
      >> ) )

      >>   and rowid > $mark
      freestring = replace ( freestring , "$TagType" , sqlIdentifier ( TagType & TagGroupId ) )
      freestring = replace ( freestring , "$TagName" , sqlString ( TagName ) )
      freestring = replace ( freestring , "$mark" ,     cstr(MarkRowid )     )

      sql ( freestring )

   ELSEIF ( actionTxt == "remove <>?" )  then
      > delete from temp.SubList   where
      >>   not (   $TagType like '%' || $TagName || '%'  )
      >>   and rowid > $mark
      freestring = replace ( freestring , "$TagType" , sqlIdentifier ( TagType & TagGroupId ) )
      freestring = replace ( freestring , "$TagName" , sqlString ( TagName ) )
      freestring = replace ( freestring , "$mark" ,     cstr(MarkRowid )     )

      sql ( freestring )

   ELSEIF ( actionTxt == "remove ==?" )  then
      > delete from temp.SubList   where
      >>     (   $TagType like '%' || $TagName || '%'  )
      >>   and rowid > $mark
      freestring = replace ( freestring , "$TagType" , sqlIdentifier ( TagType & TagGroupId ) )
      freestring = replace ( freestring , "$TagName" , sqlString ( TagName ) )
      freestring = replace ( freestring , "$mark" ,     cstr(MarkRowid )     )

      sql ( freestring )

   ELSEIF ( actionTxt == "export" )  then
      dim TargetPath = TagName

      IF ( targetPath = "\\" ) then
         sob ( CommonSobResult,  "ADD" , "row" ,  "Cancelled by user" & EOL  )
         EXIT function
      END IF

      IF ( ! isFile ( targetPath)   ) then
         sob ( CommonSobResult,  "ADD" , "row" ,  "Destination folder does not exist: " & EOL  & TargetPath & EOL )
         EXIT function
      ELSE
         sob ( CommonSobResult,  "ADD" , "row" ,  "Destination folder: " & EOL  & TargetPath & EOL )
      END IF
      ExportFolder = TargetPath
      dim dstPoint
      dim fso = createobject ("Scripting.FileSystemObject")
      IF ( ! fso ) THEN
         sob ( CommonSobResult , "Add" , "row", "Could not create the File System Object "   & EOL )
         EXIT function
      END IF
      cancelClear ()
      cancelText( "Exporting Files" , 1 )

      SELECT count (*) from temp.SubList  where type = 'file'
      fileCount = qrSingleValue

      sob ( CommonSobResult , "Add" , "row", "Nr files to export: " & fileCount & EOL )

      cancelText( "Files to export: " & FileCount , 2 )
      cancelShow(1)

      TRY
         fso.DeleteFile    ( TargetPath & "E0*" )
      CATCH
      END try

      WITHQUERY ( " select path , name , rid  from temp.SubList  where type = 'file'    ")

         dstPoint = TargetPath & "E" & Right ( "0000000000" & wqtext(3) , 7 ) & "_" & wqtext(2)
         TRY
            fso.copyFile  ( wqtext(1) & wqtext(2) , dstPoint )
         CATCH

            IF ( isFile (wqtext(1) & wqtext(2)) ) then

               report ( "copy file failure: " & EOL & wqtext(1) & wqtext(2) & EOL  &  dstPoint & EOL )
            END IF
         END try

         cancelToggle ()
         fileCount--
         IF ( fileCount BAND 0x0f ) then
         ELSE
            cancelText( "Files to export: " & FileCount , 2 )
         END IF

      END withquery
      cancelShow(0)
      sob ( CommonSobBtnB , "SET" , "TITLE", "Open Export folder" )

      sob ( CommonSobBtnB , "ON"  , "PRESS", "CbOpenExportFolder")
      TargetFolder =  ExportFolder
      sob ( CommonSobBtnB ,"set","show",1)

   ELSEIF ( actionTxt == "statistic" )  then
      SELECT count (*) from temp.SubList
      exportFilter = qrsingleValue

   ELSEIF ( actionTxt == "lock" )  then
      SELECT max (rowid) from temp.SubList
      MarkRowid = qrsingleValue

   ELSEIF ( actionTxt == "+duplicate" )  then
      > insert into temp.SubList SELECT  rowid ,* from master where type  like 'file' and
      >> hash in ( select hash from master group by hash having count (*)> 1 )

      sql ( freestring )
   ELSEIF ( actionTxt == "+empty" )  then
      > insert into temp.SubList SELECT  rowid ,* from master where type  like 'file' and
      >> size = 0
      sql ( freestring )

   ELSEIF ( actionTxt == "like" )  then
      > insert into temp.SubList SELECT  rowid ,* from master where type  like 'file' and
      freestring = freestring & " " & sqlIdentifier ( tagtype )
      >> like
      freestring = freestring & " " & sqlstring ( TagName )

      sql ( freestring )

   ELSEIF ( actionTxt == "-like" )  then
      > delete from temp.SubList  where type  like 'file' and
      freestring = freestring & " " & sqlIdentifier ( tagtype )
      >> like
      freestring = freestring & " " & sqlstring ( TagName )

      sql ( freestring )

   END IF

   IF ( isDBTable (   "temp" , "SubList"    )  )  THEN
      removeDuplicates (  "temp" , "SubList" )
   END if

END FUNCTION

FUNCTION clearAllFolderTags ()
   WITHQUERY ( "select name from  temp.masterColumns" )
      > update master SET
      freestring = freestring & " " & sqlidentifier ( wqText(1) )
      >>  = ""
      >> where type = 'folder'
      sql ( freestring )
   END withquery
END function

FUNCTION normaliseTags ()
   WITHQUERY ( "select name from  temp.masterColumns" )
      > update master SET
      freestring = freestring & " " & sqlidentifier ( wqText(1) )
      >>  =
      freestring = freestring & " " & sqlstring ( TagDelim )

      >> where type = 'file'  and (
      freestring = freestring & " " & sqlidentifier ( wqText(1) )
      >>  is NULL
      >> or

      freestring = freestring & " " & sqlidentifier ( wqText(1) )
      >>  =
      freestring = freestring & " " & sqlstring ( TagDelim  &  TagDelim)
      >> or

      freestring = freestring & " " & sqlidentifier ( wqText(1) )
      >>  = ""
      >> )
      report ( freestring )
   END withquery
END function

FUNCTION upDateMaster  ()

   ' delete the ORIGINAL changed file
   ' Note: changed means that the    hash   has changed

   update master set rescanstate = 'old'  where not type like 'folder'

   update Master  set key = path || name
   update temp.changedFiles  set key = path || name

   delete from master where key in ( select key from temp.changedFiles )

   ' now we can copy the changed to MASTER
   update temp.changedFiles set rescanstate = 'changed'  where not type like 'folder'

   insert into master select * from temp.changedFiles

   ' --------------------------
   '   give    NEW    files  META data from MASTER

   ' since we are not doing any DROP or CREATE commands, we can use a WITHQUERY
   ' for each META column, copy the original META data across

   WITHQUERY ( "select name from  temp.masterColumns" )
      > update temp.newFiles SET
      >>  $col = frmTbl. $col
      >> FROM
      >>   ( select $col , hash  from master   )  as frmTbl
      >>  WHERE
      >>    newFiles.hash = frmTbl.hash
      freestring = replace ( freestring , "$col" , sqlIdentifier(wqText(1)) )
      sql ( freestring )
   END withquery

   ' now we can copy the NEW  to MASTER

   update temp.newFiles set rescanstate = 'new'  where not type like 'folder'

   insert into master select * from temp.newFiles

   ' --------------------------
   '   NOW and only NOW, we can remove the LOST files from MASTER
   ' WHY?  in case their HASH  was also in the NEW files list
   '       so we needed their META info to copy across!

   update temp.lostFiles     set key = path || name
   update master        set key = path || name
   delete from master where key in ( select key from temp.lostFiles )
   update master set key = hash || path || name
END FUNCTION

' ----------------------------------------------------------
' functions to manage the set of COMBO boxes
' that offer the user a choice of       TagGroup
' ----------------------------------------------------------

FUNCTION isTagTypeCombo( sobid )
   TagTypeComboArray (TagTypeComboIndex++ ) = sobid
END Function

FUNCTION updateTagTypeCombos (  )

   ' we have a LIST of all COMBOs that offer the user a choice of
   '  TagGroup
   ' this code will update those COMBOs so that they all offer the
   ' full range of available TAG GROUPS

   dim i = 0  , j ,  sobId

   IF ( ! tagFlag ) then
      EXIT function
   END IF

   IF ( isDBopen ) then
      DO while i < TagTypeComboIndex
         sobId = TagTypeComboArray (i)
         sob( sobId , "empty" )
         sob( sobid , "add" , "row" , NoTag )
         FOR j = 0 to  uBoundTagArray
            sob( sobid , "add" , "row" , right (tagArray(j) , -3))
         NEXT j
         sob( sobId   , "SET", "SELECTION"  , "ROW" , 1 )
         i++
      LOOP
   ELSE
      DO while i < TagTypeComboIndex
         sobId = TagTypeComboArray (i)
         sob( sobId , "empty" )
         sob( sobid , "add" , "row" , NoTag)

         i++
      LOOP
   END IF
END Function

' --------------------------

FUNCTION resetTagBoxes ()

   ' we have a LIST of all COMBOs that offer the user as choice of
   '  TagGroup
   ' this code will update those COMBOs so that they all offer the
   ' DEFAULT   TAG GROUP    row = 1   fo the COMBO

   dim i = 0
   dim  sobid
   DO while i < TagTypeComboIndex
      sobid = TagTypeComboArray (i)
      sob ( sobid , "set" , "selection", "row" , 1 )

      i++
   LOOP

END FUNCTION

' --------------------------
' as a CONVENIENCE we can save/restore across a DB save/open
'  the state of those COMBO boxes
' that offer the user a choice of       TagGroup
' The saving/recovery DB part is found under the functions
'    saveEnvironment
'    restoreEnvironment

FUNCTION isSavedTagTypeCombo( sobid )
   ' records the target SOBID as one to be saved/restored
   SavedTagTypeComboArray (SavedTagTypeComboIndex++ ) = sobid
END Function

FUNCTION resetSavedBoxes ()
   ' writes the saved environment back to the various COMBOs..
   ' BEWARNED:
   ' hardcoded Screen Object SIBLING sequence
   '   Action Combo       -1
   '   Tag Group Combo     0
   '   Filter edit field   1
   '   Tag Name Combo      2
   '   Action Button       3

   dim i = 0
   dim sib  ,  sobid , txt
   DO while i < SavedTagTypeComboIndex
      sobid = SavedTagTypeComboArray (i)

      sib = SOB ( sobid ,  "sibling" , -1 )
      txt = sob ( sib , "set", "title"  , "#################" )

      sob ( sib , "set" , "selection", "row" , 1 )
      txt = sob ( sib , "get", "title" )

      sib = SOB ( sobid ,  "sibling" , 0 )
      sob ( sib , "set" , "selection", "row" , 1 )

      sib = SOB ( sobid  , "sibling" , 1 )
      sob ( sib , "empty" )

      sib = SOB ( sobid ,   "sibling" , 2 )
      sob ( sib , "empty"  )

      sib = SOB ( sobid ,   "sibling" , 3 )
      sob ( sib , "set" , "title" , txt )
      sob ( sib , "set" , "rgb" , defBtnCol )

      '    CB_action_select (tbid    , 1)
      i++
   LOOP

END FUNCTION
' ----------------------------------------------------------
'
'
' ----------------------------------------------------------

dim defaultText = "                       "
dim Currenthash = ""
dim CurrentFile = ""
dim CurrentRowid = 0

' -------------------------------------------------------------------------------------------

FUNCTION ExtractTags ( frmTbl , frmCol )

   ' do NOT call from inside a WITHQUERY
   ' a   WITHQUERY   blocks the DB from doing a   CREATE  or a   DROP

   drop table if exists temp.ExtractTbl
   > create temp table ExtractTbl as select $frmCol  as haveTag   from $frmTbl
   freestring =  replace ( freestring , "$frmTbl" , sqlIdentifier(frmTbl) )
   freestring =  replace ( freestring , "$frmCol" , sqlIdentifier(frmCol))
   sql ( freestring )

   drop table if exists temp.ResultTbl

   >   create  temp table  ResultTbl   as
   >>     with recursive list  ( element , remainder ) as
   >>     (
   >>        select distinct null as element , haveTag as remainder  from ExtractTbl where not ( haveTag = ''  or   haveTag =
   freestring = freestring & " " & SQLstring ( TagDelim)

   >>  )
   >>        UNION ALL
   >>           SELECT
   >>             CASE
   '>>                 WHEN INSTR( remainder, '§' )>0 THEN
   >>                 WHEN INSTR( remainder,
   freestring = freestring & " " & SQLstring ( TagDelim)
   >>  )>0 THEN
   ' >>                    SUBSTR( remainder, 0, INSTR( remainder, '§' ) )
   >>                    SUBSTR( remainder, 0, INSTR( remainder,

   freestring = freestring & " " & SQLstring ( TagDelim)
   >> ) )

   >>                 ELSE
   >>                    remainder
   >>              END AS element,
   >>              CASE
   '>>                 WHEN INSTR( remainder, '§' )>0 THEN
   >>                 WHEN INSTR( remainder,
   freestring = freestring & " " & SQLstring ( TagDelim)
   >> ) > 0 then

   '>>                    SUBSTR( remainder, INSTR( remainder, '§' )+1 )
   >>                    SUBSTR( remainder, INSTR( remainder,
   freestring = freestring & " " & SQLstring ( TagDelim)
   >> ) +
   freestring = freestring & " " & length ( TagDelim)

   >>   )

   >>                 ELSE
   >>                    NULL
   >>              END AS remainder
   >>        FROM list
   >>        WHERE remainder IS NOT NULL
   >>      )
   >>   SELECT distinct  element as haveTag  FROM list WHERE element IS NOT NULL  and not  element = ''
   sql ( freestring )
   drop table if exists temp.ExtractTbl

END Function

FUNCTION updateFreeTextCombos ( )
   dim i

   sob ( FreeTextComboSob  , "EMPTY")
   sob ( FreeTextToolCombo , "EMPTY")

   IF ( ! isDBopen ) then FreeTextFlag = 0

   IF ( FreeTextFlag ) then
      sob ( FreeTextComboSob , "add" , "row" ,  " all" )

      FOR i = 0 to  uBoundTagTxtArray
         sob ( FreeTextComboSob  , "add" , "row" , right(tagTxtArray(i), -1*length(FreeTxtId))   )
         sob ( FreeTextToolCombo , "add" , "row" , right(tagTxtArray(i), -1*length(FreeTxtId))   )
      NEXT i

      sob ( FreeTextToolCombo , "SET" , "Selection", "row", 1 )

      IF  ( uBoundTagTxtArray  == 0 ) then
         sob ( FreeTextComboSob , "SET" , "Selection", "row", 2 )
      ELSE
         sob ( FreeTextComboSob , "SET" , "Selection", "row", 1 )
      END IF

   ELSE
      sob ( FreeTextComboSob  , "add" , "row" ,  NoTag  )
      sob ( FreeTextComboSob  , "SET" , "Selection", "row", 1 )
      sob ( FreeTextToolCombo , "add" , "row" ,  NoTag  )
      sob ( FreeTextToolCombo , "SET" , "Selection", "row", 1 )
   END IF

END FUNCTION

FUNCTION CreateUsersTagTableAndColumnsList ()

   ' the idea is that    MasterColumns   lists the USER defined columns
   ' and  that            tagTable       lists the USER defined values that
   '                                     can be assigned to USER defined columns

   ' these two tables are created / modified / deleted via the
   '   menu Tag Tools / Tag Management
   '   and via the  Free Text Fields  panel
   '   and when providing contents for  REGIONS

   ' want to create a table,   temp.MasterColumns  of the USER defined columns
   ' i.e.  those of the form
   '   '%tag'     and    '%TagTxt'

   Drop table if exists  temp.masterColumns

   create temp table masterColumns  as select name , 1 as flag from pragma_table_info ( 'master' ) where name like '%tag'  or name like '%TagTxt'

   ' -----------------------------------
   ' handle the Free text fields
   SELECT group_concat ( name) from temp.mastercolumns  where name like '%tagTxt'   order by name asc
   IF (  (qrsingleValue == "")   OR    (istype(qrsingleValue)  == "empty") OR ( qrsingleValue  == 0)   ) THEN
      FreeTextFlag = 0

      IF (  sob ( FreeTextPopUpid , "GET" , "CHECK"  ) ) then
         sob ( FreeTextPopUpid , "SET" , "CHECK"  , 0  )
         sob ( RegionPopUpid , "SET" , "CHECK"  , 1  )

      END IF
      sob ( FreeTextPopUpid , "SET" , "MENU.GREY", 1 )
   ELSE
      redim TagTxtArray  = split ( qrsingleValue ,  "," )
      uBoundTagTxtArray = uBound ( TagTxtArray )
      FreeTextFlag = 1
      sob ( FreeTextPopUpid , "SET" , "MENU.GREY", 0 )
   END IF

   dim i

   updateFreeTextCombos ()

   ' -----------------------------------
   ' handle the Tags

   SELECT group_concat ( name) from temp.mastercolumns  where name like '%tag'   order by name asc
   IF (  (qrsingleValue == "")   OR    (istype(qrsingleValue)  == "empty") OR ( qrsingleValue  == 0)   ) THEN
      tagFlag = 0
   ELSE
      redim TagArray  = split ( qrsingleValue ,  "," )
      uBoundTagArray = uBound ( TagArray )
      tagFlag = 1
   END IF

   drop table if exists  tagTable
   create table  tagTable ( ttGroup , ttName , ttComment )

   IF ( tagFlag ) then
      FOR i = 0 to uBoundTagArray

         ExtractTags ( "master", tagArray (i))

         > insert into tagTable   select  $tagName, haveTag, ''  from ResultTbl
         freestring = replace ( freestring, "$tagName" ,  sqlIdentifier ( tagArray (i) ) )
         sql (freestring )

      NEXT i
   END IF

   insert into tagTable   select  'TaggedTag', substr ( name ,1, length(name) - 3 ) , ''  from mastercolumns

   ' remove duplicates
   >  delete from tagTable
   >>  WHERE exists (
   >>    select 1 from tagTable as TT2
   >>    where   tagTable.ttGroup = tt2.ttGroup
   >>    and     tagTable.ttName  = tt2.ttName
   >>    and     tagTable.rowid   >    tt2.rowid
   >>  )
   sql (freestring)
END function

' -----------------------------------------------------

' create a window to contain some SOBs

dim appWindow  =  sob ("application", "NEW", appName)

' this is IMPORTANT
' always always always place POPUP definitions right after their
' parent WINDOW

dim CopyPastePopUp      = sob ( appWindow, "add", "Menu", "popup")
dim OnImagePopUpSimilar = sob ( appWindow, "add", "Menu", "popup")
dim OnImagePopUpGroup   = sob ( appWindow, "add", "Menu", "popup")
dim OnImageMngmtPopUp   = sob ( appWindow, "add", "Menu", "popup")

' to prevent screen flashing whilst we define all of the SOBS
' hide the application windows

sob ( appWindow,"SET" ,"SHOW",0)

' Define a callback to handle a click on the TOP Right "X"

FUNCTION cbCloseApplication ( sobid )

   IF ( isDbOPen   ) then
      IF ( ! MSGBOX ( "Close without saving database?", 1, "Warning") ) then
         CBFileMenuClose (sobid)
         quit
      END IF
   ELSE
      quit
   END IF

END function

sob ( appWindow,"ON","CLICK", "cbCloseApplication")

' -----------------------------------------------------

dim  myMenuBar   = sob (appWindow  ,  "add"  ,  "menu"   ,  "bar"  )   ' add a menu bar    myWindow

' -----------------------------------------------------
' add  horizonal menus to    myMenuBar
' -----------------------------------------------------

dim  myMenuFile  = sob (myMenuBar ,  "add"  ,  "menu"   , "Horizontal" ,  "File"   )
dim  OptionsMenu = sob (myMenuBar ,  "add"  ,  "menu"   , "Horizontal" ,  "Options"   )
dim  myMenuTools = sob (myMenuBar ,  "add"  ,  "menu"   , "Horizontal" ,  "Tag Tools"   )

dim  myMenuExport  = sob (myMenuBar ,  "add"  ,  "menu"   , "Horizontal" ,  "Export"   )
dim  myMenuImport  = sob (myMenuBar ,  "add"  ,  "menu"   , "Horizontal" ,  "Import"   )
dim  myMenuDelete  = sob (myMenuBar ,  "add"  ,  "menu"   , "Horizontal" ,  "Delete"   )
' -----------------------------------------------------
' CALLBACK  when the OPTIONS menu is ABOUT to be displayed.
' This is the only CALLBACK implemented for a  Horizontal MENU
' This is to ensure that the menu option     Expert Mode always
' has the correct check state. The Expert window is automatically
' displayed if there is some programming error.
dim ExpertFlag = 0
FUNCTION ClickExpertMode ( sobid )

   ExpertFlag = sob( pwsWindow, "GET", "SHOW")
   sob(optionsMenuExpert, "SET", "CHECK" ,ExpertFlag)
END function
sob (   OptionsMenu    ,  "ON"   ,  "PRESS"  , "ClickExpertMode"  )

' --------------
dim haveWIA = 0
dim haveShell = 0

FUNCTION getHaves ( )

   haveWIA = 0
   haveShell = 0

   dim objIF = CreateObject("WIA.ImageFile")
   IF ( istype(objIF) == "DISPATCH" )  then haveWIA = 1
   dim objV  = CreateObject("WIA.Vector")

   dim objShell = CreateObject ("Shell.Application")
   IF ( istype(objShell) == "DISPATCH") then haveShell = 1

   ' the termination of a function automatically release the
   ' locally defined   DISPATCHs
END FUNCTION

getHaves ( )

dim  myMenuSingleFile = 0
IF (  haveWIA + haveShell) then
   myMenuSingleFile  = sob (myMenuBar ,  "add"  ,  "menu"   , "Horizontal" ,  "Single File Options"   )
END IF
' --------------

dim  myMenuImageMngmt = sob (myMenuBar ,  "add"  ,  "menu"   , "Horizontal" ,  "Image Management"   )

dim  myMenuRegions = sob (myMenuBar ,  "add"  ,  "menu"   , "Horizontal" ,  "Regions"   )

dim  myMenuHelp    = sob (myMenuBar ,  "add"  ,  "menu"   , "Horizontal" ,  "Help"   )
dim  myMenuAbout   = sob (myMenuBar ,  "add"  ,  "menu"   , "Horizontal" ,  "About"   )

' -----------------------------------------------------
' add menu items to the FILE menu
' each meni item has 3 parts
'    add the item in to its parent menu
'    define a call back action for the new item
'    link the new item to the call back
' Note: callbacks can be shared with other menu items
' --------------

' -----------------------------------------------------
' #####################################################
' NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW NEW
' -----------------------------------------------------

dim idMenuFileNew = sob ( myMenuFile    ,  "add"  ,   "menu"  ,  "Vertical"  , "New"    )

FUNCTION CBFileMenuNewORIG ( sobid )

   sob ( CommonSobResult , "empty")
   IF ( isDBopen ) then
      ErrorReport ( "Database already open!")
      toggleWarnColour ( sobid)
      EXIT function
   END IF

   dim TargetPath = GetPath & "\\"

   IF ( targetPath = "\\" ) then
      ErrorReport ( "Cancelled by user"  )
      toggleWarnColour ( sobid)
      EXIT function
   END IF

   dbopen( "memory" )

   IF ( isDBopen ) then

      cancelClear ()
      cancelText( "Reading in new folder" , 0 )
      cancelText( "This can take a short while" , 3 )
      cancelShow(1)

      cancelText( TargetPath , 1 )
      ' --------------------------------------------------------------------------
      ' get number of files in the target so that the user can follow the progress of
      ' the slower dbFileList  with  checksum generation
      ' --------------------------------------------------------------------------
    
      dbFileList ( , "master", TargetPath , -1   )
      SELECT count (*) from master where type like 'file'
      cancelText( "Total files "  & qrsinglevalue , 2 )
      
      ' --------------------------------------------------------------------------
      ' create a table of the target contents
      ' --------------------------------------------------------------------------

      sob ( CommonSobResult , "ADD" , "ROW", "Start: " & time & EOL )

      TRY
         dbFileList ( , "master", TargetPath , -1 , , "md5" )
      CATCH
         sob ( CommonSobResult , "ADD" , "ROW", "WARNING: Action cancelled by User. File scan incomplete." & EOL )
      END TRY
 
      sob ( CommonSobResult , "ADD" , "ROW", "Stop:  " & time & EOL )
      
      ' --------------------------------------------------------------------------

      update master set key = hash || path || name

      sob ( CommonSobResult , "ADD" , "ROW", "Root folder: "   &  TargetPath & EOL  )

      SELECT count (*) from master where type  like 'file'
      sob ( CommonSobResult , "ADD" , "ROW", "Files read : " & qrsingleValue & EOL  )

      sob ( CommonSobResult , "ADD" , "ROW", "Next action: " & "Create Tag Group(s) and Tags!"& EOL  )

      sob ( statusDBFile, "SET" ,"TITLE" ,   "memory" )
      NoErrorReport ("Open OK " )

      ' --------------------------------------------------------------------------
      ' we need some extra DEFAULT columns that dbFileList does not provide
      ' --------------------------------------------------------------------------
      
      IF ( ! isDBcolumn ( "master", "fsHash" ) ) then
         alter table master add column fsHash
         update master set fsHash = hash
      END IF

      IF ( allowRectPicasa ) then
         alter table master add column RectPicasa text
         update master set RectPicasa = ""
      END if

      IF ( allowRectMeta ) then
         alter table master add column RectMeta text
         update master set RectMeta = ""
      END IF

      alter table master add column IgnoreFile
      update master set  IgnoreFile = 0

      alter table master add column RescanState
      update master set  RescanState = "new"

      alter table master add column TaggedTag
      update master set  TaggedTag = ""

      ' -----------------------------------------------------------------------------------------
      ' add the IMAGE related columns
      
      alter table master add column pHash
      alter table master add column dHash
      alter table master add column ImageGroup
      alter table master add column ImageGroupType
      alter table master add column ImageNearness
      
      ' -----------------------------------------------------------------------------------------
      ' the following is SLOW
      ' get the perceptual hash and  difference hash for the image files
      ' -----------------------------------------------------------------------------------------
      
      > select count (*) from master where ext in
      freestring = freestring & ImageFileExtensions
      sql (freestring )
      dim imgCnt = qrSingleValue

      cancelText( "Get pHash / dHash from: " & imgCnt & "  image files" , 1 )

      dim pHash = 0 , dHash

      > select path||name , fsHash   from  master  where  ext in
      freestring = freestring & ImageFileExtensions
      WITHQUERY (freestring )

         phash = canvas("new", "phash.from.file", wqText(1) , byref dHash )

         > update master  set
         >>  pHash =
         freestring = freestring & " " & pHash
         >>  , dHash =
         freestring = freestring & " " & dHash
         >> , ImageGroup = 0 , IgnoreFile = 0 , ImageGroupType = 'unknown' , ImageNearness = '0000'

         >> where fsHash =
         freestring = freestring & " " & sqlidentifier (wqText (2))
         sql(freestring)

         imgCnt--
         IF ( ! ( imgCnt BAND 0x0f )  )  THEN
            cancelText(  imgCnt   , 2 )
         END IF

      END WithQuery

      > update master
      >> set
      >>    ImageGroup  = num2Hex(pHash) ||     num2Hex(dHash)
      >>  ,  hash       = num2Hex(pHash) ||     num2Hex(dHash)
      >>  where
      >>  not pHash = 0
      sql(freestring)

      drop table if exists temp.xHashTbl
      MakeBkTree ( )

      ' -----------------------------------------------------------------------------------------

      cancelShow(0)

      sob ( sobid , "SET" , "SHOW", 0 )

      sob ( CommonSobBtnB , "SET" , "TITLE", "Open root folder" )
      sob ( CommonSobBtnB , "SET" , "SHOW", 1 )
      TargetFolder = TargetPath
      sob ( CommonSobBtnB , "ON"  , "PRESS", "CbOpenExportFolder")

      OnOpenPrepareMasterTagTable ( CommonSobBtnB )  ' NEW database

      OpenMessage ( )
   ELSE
      sob ( CommonSobResult , "ADD" , "ROW", "Open failed on file : " & EOL  &  dbName & EOL))

      ErrorReport ("Open failed on file : "  &  dbName )
      toggleWarnColour ( sobid)
   END IF

END Function

FUNCTION CBFileMenuNew ( sobid )
   CommonSobClear ( "Create new database" )

   > Use this to select a root folder.§
   >> All of the root folder's file & subfolders will be scanned and an entry made in a new database.§
   >> The use the menu   Tools / Tag management   to add new TAG GROUPS.§
   >>   - each tag group will have its own column in the database§
   >>   - Typically, for images, I have TAG GROUPS:  who  , what  , when , where§
   >> Then add specific tags to the TAG GROUPS. (same menu option) §
   >>   - e.g. for the WHO tag group:  MUM , DAD , King Arthur , Jane Doe (nee Smith), ... §
   >> You can add new TAG GROUPS, and TAGs at any time to a database§
   >> You can add more folders at any time to a database.

   sob ( CommonSobInfo  , "ADD" , "ROW" , replace ( freestring , EOLdelim , EOL ) )

   sob ( CommonSobBtn , "SET" , "TITLE" , "Create")

   sob ( CommonSobBtn , "ON"  , "PRESS", "CBFileMenuNewORIG")
   sob ( CommonSobBtn , "SET" , "rgb" , rgb(0,255,0) )
   sob ( CommonSobBtn ,"set","show",1)

   sob ( CommonSobResult , "empty")

   sob (   CommonOvl ,"set","show",1)

END Function
sob (   -1     ,  "ON"   ,  "CLICK"  , "CBFileMenuNew")

' -----------------------------------------------------
' #####################################################
' SAVE SAVE SAVE SAVE SAVE SAVE SAVE SAVE SAVE SAVE
' -----------------------------------------------------
FUNCTION restoreEnvironment ()

   IF ( !   isDBTable ( , "savedEnv" )  )  then
      EXIT function
   END IF

   dim rid  , i , sib  , sobid , txt , row
   i = 0
   WITHQUERY ( "select * from savedEnv " )
      sobid  = SavedTagTypeComboArray(i)

      IF ( sobid == wqInt ( 1 )  ) then

         ' set the filter text
         sib  = sob (   SavedTagTypeComboArray(i) ,  "SIBLING" , 1 )
         sob ( sib , "Set", "Title" , wqText(4) )

         '  action
         sib  = sob (   SavedTagTypeComboArray(i) ,  "SIBLING" , -1 )

         row = wqInt(2)
         IF ( ! row ) then row = 1
         sob ( sib , "Set", "SELECTION" , "ROW" ,  row )
         sob ( sib   , "trigger"  )

         ' group
         sib  = sob (   SavedTagTypeComboArray(i) ,  "SIBLING" , 0 )
         row = wqInt(3)
         IF ( ! row ) then row = 1
         sob ( sib , "Set", "SELECTION" , "ROW" ,  row )
         sob ( sib   , "trigger"  )

      ELSE

      END If

      i = i + 1
   END withQuery

END function

FUNCTION saveEnvironment ()

   IF ( !   isDBTable ( , "savedEnv" )  )  then
      create table savedEnv ( sobid int , TagAction int , TagGroup int  , TagFilter text )

   END IF

   delete from savedEnv

   dim txt , i , sib , rid
   FOR i = 0 to SavedTagTypeComboIndex - 1
      > insert into savedEnv   values (
      freestring = freestring & " " & SavedTagTypeComboArray(i)
      >> ,
      sib  = sob (   SavedTagTypeComboArray(i) ,  "SIBLING" , -1 )
      rid = sob ( sib , "get", "Selection" , "row"  )

      freestring = freestring & " " &   rid
      >> ,
      sib  = sob (   SavedTagTypeComboArray(i) ,  "SIBLING" , 0 )
      rid = sob ( sib , "get", "Selection" , "row"  )

      freestring = freestring & " " &   rid
      >> ,
      sib  = sob (   SavedTagTypeComboArray(i) ,  "SIBLING" , 1 )
      txt = sob ( sib , "get", "title" )

      freestring = freestring & " " &   sqlString (txt)
      >> )

      sql ( freestring )

   NEXT i

END function

sob ( myMenuFile    ,  "add"  ,   "menu"  ,  "SPACER"      )

dim idMenuFileSave = sob ( myMenuFile    ,  "add"  ,   "menu"  ,  "Vertical"  , "Save"    )

FUNCTION CBFileMenuSave ( sobid )

   ' following is simply to minimise the disk space
   update master set key = ''
   saveEnvironment ()

   vacuum

   dbSave ()

   ' recover the  key  contents
   update master set key = hash || path || name
END Function

sob (   -1     ,  "ON"   ,  "CLICK"  , "CBFileMenuSave")

dim idMenuFileSaveNClose = sob ( myMenuFile    ,  "add"  ,   "menu"  ,  "Vertical"  , "Save & Close"    )
dim idMenuFileSaveNClosenExit = sob ( myMenuFile    ,  "add"  ,   "menu"  ,  "Vertical"  , "Save & Close & Exit"    )

' -----------------------------------------------------
' #####################################################
' SAVEAS SAVEAS SAVEAS SAVEAS SAVEAS SAVEAS SAVEAS
' -----------------------------------------------------

dim idMenuFileSaveAs = sob ( myMenuFile    ,  "add"  ,   "menu"  ,  "Vertical"  , "SaveAs"    )

FUNCTION CBFileMenuSaveAS ( sobid )

   ' following is simply to minimise the disk space
   update master set key = ''
   saveEnvironment ()
   vacuum
   dim dbFIle , defDir
   TRY

      getFirstFileDir ()

      dbFIle = DBSaveAs   (   )
      IF ( dbFIle == "" ) then
         noErrorReport ("SaveAs cancelled" )
      ELSE

         IF ( toUpper ( right(dbFIle,4))  ==  ".DB3" ) then
         ELSE
            dbFIle = dbFIle & ".db3"
         END IF

         sob ( statusDBFile, "SET" ,"TITLE" ,   dbFIle )

         noErrorReport ("Saved as "  & dbFIle )
         AddFileToUsedList ( dbFIle , "rw" )
      END IF
   CATCH

      ErrorReport ("SaveAs failed " &  ErrorText(CaughtError)  )
   END try

   ' recover the  key  contents
   update master set key = hash || path || name
END Function

sob (   -1     ,  "ON"   ,  "CLICK"  , "CBFileMenuSaveAs")

' -----------------------------------------------------
' #####################################################
' SAVECOPY SAVECOPY SAVECOPY SAVECOPY SAVECOPY SAVECOPY
' -----------------------------------------------------

dim idMenuFileSaveCopyAs = sob ( myMenuFile    ,  "add"  ,   "menu"  ,  "Vertical"  , "SaveCopyAs"    )

FUNCTION CBFileMenuSaveCopyAs ( sobid )

   ' following is simply to minimise the disk space
   update master set key = ''
   vacuum

   TRY
      noErrorReport ("Saved copy  "  & dbSaveCopy   (     ,1 ))
   CATCH
      ErrorReport ("SaveAs failed " &  ErrorText(CaughtError)  )
   END try

   ' recover the  key  contents
   update master set key = hash || path || name
END Function

sob (   -1     ,  "ON"   ,  "CLICK"  , "CBFileMenuSaveCopyAs")

' -----------------------------------------------------
' #####################################################
' OPEN OPEN OPEN OPEN OPEN OPEN OPEN OPEN OPEN  OPEN
' -----------------------------------------------------
dim idMenuFileOpen =sob ( myMenuFile    ,  "add"  ,   "menu"  ,  "Vertical"  , "Open" )

FUNCTION dbValidityCheck ()
   dbValidityCheck = 0
   IF ( ! isDBOpen ) then
      ErrorReport ("No database selected" )
   ELSEIF ( ! isDBtable ( , "tagTable" ) ) then
      ErrorReport ("Invalid database: No TagTable." )
   ELSEIF ( ! isDBcolumn  (  "tagTable",  "ttComment"  ) ) then
      ErrorReport ("Invalid TagTable: No TagTable." )
   ELSEIF ( ! isDBtable ( , "master" ) ) then
      ErrorReport ("Invalid database: No Master table." )
   ELSE
      dbValidityCheck = 1
      EXIT function
   END IF
   dbclose ()
END FUNCTION

FUNCTION OnOpenPrepareMasterTagTable ( sobid )

   ' called when we open a NEW or SAVED database

   IF ( isDBtable ( , "tagTable" ) ) then
      create temp table TagTableOld as select * from TagTable
   END IF
   exportFolder = ""

   IF (  isDBcolumn ( "master", "ImageGroup" ) ) then
      update master set  Hash = ImageGroup where not ImageGroup = 0
   END IF

   CreateUsersTagTableAndColumnsList ()

   IF ( isDBtable ( "temp" , "TagTableOld" ) ) then
      > update tagTable
      >> set ttComment = frmTbl.ttcomment
      >>  from ( select * from temp.TagTableOld ) as frmTbl
      >>  WHERE
      >>         tagTable.ttGroup  =  frmTbl.ttGroup
      >>    AND  tagTable.ttName   =  frmTbl.ttName
      sql ( freestring )
   END IF

   '  resetTagBoxes ()  ' irrelevant since  updateTagTypeCombos does it too

   updateTagTypeCombos (  )

   haveRectMeta   = isDBcolumn (  "master" , "RectMeta" )
   haveRectPicasa = isDBcolumn (  "master" , "RectPicasa" )

   IF ( ! ( haveRectMeta  or  haveRectPicasa  ) ) then
      sob ( copyPopupId   , "SET" , "MENU.GREY" , 1 )
      sob ( pastePopupId  , "SET" , "MENU.GREY" , 1 )
      sob ( DeletePopUpid , "SET" , "MENU.GREY" , 1 )
      sob ( RegionPopUpid , "SET" , "MENU.GREY" , 1 )

      sob ( myMenuRegions , "SET" , "MENU.GREY" , 1 )

   ELSE
      sob ( copyPopupId   , "SET" , "MENU.GREY" , 0 )
      sob ( pastePopupId  , "SET" , "MENU.GREY" , 1 )
      sob ( DeletePopUpid , "SET" , "MENU.GREY" , 1 )
      sob ( RegionPopUpid , "SET" , "MENU.GREY" , 0 )

      sob ( myMenuRegions , "SET" , "MENU.GREY" , 0 )

   END if

   IF ( ! isDBcolumn (  "master" , "RescanState" ) ) then
      alter table master add column rescanState
      update master set rescanstate = 'new'  where not type like 'folder'
   END IF

   SOB (idMenuFileNew   , "SET" , "MENU.GREY" ,1 )

   SOB (idMenuFileSave  , "SET" , "MENU.GREY" ,0)
   SOB (idMenuFileSaveAs, "SET" , "MENU.GREY" ,0 )
   SOB (idMenuFileSaveCopyAs, "SET" , "MENU.GREY" ,0 )
   SOB (idMenuFileOpen  , "SET" , "MENU.GREY" ,1)
   enableUsedFileSelection ( 1 )
   SOB (idMenuFileClose , "SET" , "MENU.GREY" ,0 )
   SOB (idMenuFileReload , "SET" , "MENU.GREY" ,0 )

   SOB (idMenuFileExit  , "SET" , "MENU.GREY" ,1 )

   getrootFolders ( CommonSobResult ,CommonSobCombo  )

   SELECT count (*) from master where type  like 'file'
   sob ( CommonSobResult  , "add" , "row" ,  EOL  & "Nr of files: "  & qrSingleValue & EOL )

   SELECT count (*) from temp.masterColumns where name  like '%Tag'
   sob ( CommonSobResult  , "add" , "row" , "Nr of Tag Groups: "  & qrSingleValue & EOL )

   create temp table tblRectList  ( rlSrc , rlTagGroup , rlTagName,  rlRect ,  rlLeft , rlTop, rlRight, rlBottom , rlHit ,  rlId )

   restoreEnvironment ()

   MakeBkTree()

END function

FUNCTION cbOpenDBfromFile ( sobid )

   dim proceed = 1
   sob( CommonSobResult , "empty")

   dim dbFIle  = selectDBfile(  getFirstFileDir () )

   IF ( dbFile == "" ) then
      sob ( CommonSobResult  , "add" , "row" , "cancelled by user" & EOL )
      proceed = 0
   END IF

   IF ( proceed ) then
      TRY
         dbopen("memory" ,dbFIle)
      CATCH
         ErrorReport ("Open failed on file : "  &  dbFIle )
         sob ( CommonSobResult  , "add" , "row" , "Open failed on file : "  & EOL &  dbFIle & EOL )

         proceed = 0
      END try
   END IF

   IF ( proceed ) then
      proceed = dbValidityCheck ()
   END IF

   IF ( proceed) then

      IF ( proceed )  then
         AddFileToUsedList ( dbFIle, "rw" )

         sob ( statusDBFile, "SET" ,"TITLE" ,   dbFIle )

         IF ( !  isTable (  , "master") ) then

            ErrorReport ("No  master    table in database")
            dbclose()
            proceed = 0
         END if
      END IF

      IF ( proceed )  then
         sob ( CommonSobBtn ,"set","show",0)
         update master set key = hash || path || name

         sob ( CommonSobResult  , "add" , "row" , "Database file OK: "  & EOL &  dbFIle & EOL & EOL )
         OnOpenPrepareMasterTagTable (CommonSobResult)
         OpenMessage ( )
      END IF

      toggleWarnColour ( sobid)
   END if

END FUNCTION

FUNCTION CBFileMenuOpen ( sobid )

   CommonSobClear ( "Open database from file" )

   >Open a database file, in memory§
   >>§
   >>Changes are ONLY saved when you explicitly trigger a save.§

   sob ( CommonSobInfo  , "ADD" , "ROW" , replace ( freestring , EOLdelim , EOL ) )

   sob ( CommonSobBtn , "SET" , "TITLE" , "Open")
   sob ( CommonSobBtn , "ON"  , "PRESS", "cbOpenDBfromFile")
   sob ( CommonSobBtn , "SET" , "rgb" , defBtnCol)
   sob ( CommonSobInfo ,"set","show",1)

   sob ( CommonOvl ,"set","show",1)

   cbOpenDBfromFile ( CommonSobBtn )

END Function

sob (   -1     ,  "ON"   ,  "CLICK"  , "CBFileMenuOpen")

' -----------------------------------------------------
' #####################################################
' RELOAD RELOAD RELOAD RELOAD RELOAD RELOAD RELOAD
' -----------------------------------------------------
dim idMenuFileReload = sob ( myMenuFile    ,  "add"  ,   "menu"  ,  "Vertical"  , "Reload"    )

FUNCTION CBFileMenuReload ( sobid )

   CBFileMenuClose ( sobid )

   CBUsedFileList (  FirstFileMenuItem )
END FUNCTION

sob (   -1     ,  "ON"   ,  "CLICK"  , "CBFileMenuReload")

' -----------------------------------------------------
' #####################################################
' CLOSE CLOSE CLOSE CLOSE CLOSE CLOSE CLOSE CLOSE CLOSE
' -----------------------------------------------------
dim idMenuFileClose = sob ( myMenuFile    ,  "add"  ,   "menu"  ,  "Vertical"  , "Close"    )

FUNCTION EmptyThings ()
   '  sob ( TagRectCombo , "empty")
   sob ( TagCommentEdit , "empty")
   sob ( CommonSobResult , "empty")
   sob ( PathFile , "empty")
   sob ( CommonSobInfo , "empty")
   sob ( TagInfo , "empty")
   sob ( TagTxtField   , "empty")

   sob ( FreeTextComboSob , "empty")
   sob ( TagTxtEdit   , "empty")

   sob ( FileListSob , "empty")

   SetLblRegionRGB ( defBtnCol )

   removeAllThumbNails (  )
   removeThumbNails ( siImageMngmtMatrix )

   CommonSobClear ( "" )
END function

' ---------------------------------------------------

'  https://www.codeproject.com/Articles/739/Rendering-GIF-JPEG-Icon-or-Bitmap-Files-with-OleLo

FUNCTION ReleaseImage (sobId)

   dim CanvasHandle = SOB(  sobId , "GET" , "CANVAS" )
   IF  ( CanvasHandle )   then
      canvas( CanvasHandle , "DELETE" )
   END IF

   sob(sobId ,"SET","IMAGE","" )

   ImageLoadedFlag = 0
END Function

FUNCTION AssignImage ( sobid, fname )
   ReleaseImage (sobId)
   ImageLoadedFlag =  1

   TRY

      IF  ( sob ( sobid , "SET", "IMAGE" , fname)   ) then

         dim w = CANVAS ( "IMAGE.FILE", "GET" , "WIDTH"  , fname)
         dim h = CANVAS ( "IMAGE.FILE", "GET" , "HEIGHT" , fname)
         dim canvId =  CANVAS ( "NEW" , "BLANK" , w  , h )

         canvas ( canvId , "flood",  TransparentRGB   )
         sob ( sobid , "SET", "CANVAS" , canvId)
      ELSE
         ImageLoadedFlag =  0

         sob ( sobid , "SET", "IMAGE" ,  "" )
         dim canvId =  CANVAS ( "NEW" , "BLANK" , 100  , 100 )
         canvas ( canvId , "flood",  TransparentRGB   )
         sob ( sobid , "SET", "CANVAS" , canvId)
         canvas ( canvid , "icon.ext" , fname )
      END IF

   CATCH
      ImageLoadedFlag =  0
   END TRY

END Function

' ---------------------------------------------------

FUNCTION CBFileMenuClose ( sobid )

   IF (  isDBopen ) then
      > update parameters set comment =
      freestring = freestring & " " &         sqlString ( CurrentFile )
      >> where txt like
      freestring = freestring & " " &         sqlString ( sob(statusDBFile, "GET" ,"TITLE" ) )
      db_arg_set  ( freestring)

      dbClose ()
      NoErrorReport ( dbName )

      ReleaseImage (sobImageHolder)
   ELSE
      NoErrorReport ( "" )
   END IF

   EmptyThings ()

   sob ( statusDBFile, "SET" ,"TITLE" ,   "" )

   '  resetTagBoxes ()  ' irrelevant since  updateTagTypeCombos does it too

   updateTagTypeCombos (  )
   updateFreeTextCombos ()

   sob ( StatusTxt, "empty")
   sob ( StatusTxt, "SET" , "RGB", -1 )

   haveRectMeta = 0
   haveRectPicasa = 0

   DbName       = ""
   copyTagGroup = ""
   copyTagName  = ""

   ImageLoadedFlag = 0

   CommonSobClear ( "" )

   SavedTagTypeComboIndex = 0
 

   ' ----------------------------------------
   ' set the GREY state of the menu  File  items to reflect NO OPEN DB

   SOB (idMenuFileNew       , "SET" , "MENU.GREY" ,0 )
   SOB (idMenuFileSave      , "SET" , "MENU.GREY" ,1 )
   SOB (idMenuFileSaveAs    , "SET" , "MENU.GREY" ,1 )
   SOB (idMenuFileSaveCopyAs, "SET" , "MENU.GREY" ,1 )
   SOB (idMenuFileReload    , "SET" , "MENU.GREY" ,1 )
   SOB (idMenuFileOpen      , "SET" , "MENU.GREY" ,0 )
   enableUsedFileSelection ( 0 )
   SOB (idMenuFileClose     , "SET" , "MENU.GREY" ,1 )
   SOB (idMenuFileExit      , "SET" , "MENU.GREY" ,0 )

END Function

sob (   -1     ,  "ON"   ,  "CLICK"  , "CBFileMenuClose")

FUNCTION cbMenuFileSaveNClose ( sobid )
   CBFileMenuSave ( sobid )
   CBFileMenuClose ( sobid)

END Function

sob (   idMenuFileSaveNClose    ,  "ON"   ,  "CLICK"  , "cbMenuFileSaveNClose")

FUNCTION cbMenuFileSaveNClosenExit ( sobid )
   CBFileMenuSave ( sobid )
   CBFileMenuClose ( sobid)

   quit
END Function

sob (  idMenuFileSaveNClosenExit     ,  "ON"   ,  "CLICK"  , "cbMenuFileSaveNClosenExit")

' ---------------------------------------------------

dim idMenuFileExit = sob ( myMenuFile    ,  "add"  ,   "menu"  ,  "Vertical"  , "Exit"    )

FUNCTION CBFileMenuExit ( sobid )
   ' would be better to check if exists a DB
   ' ask if it should be saved,...

   CBFileMenuClose (sobid)
   quit
END Function

sob (   -1     ,  "ON"   ,  "CLICK"  , "CBFileMenuExit")

' -----------------------------------------------------
sob ( myMenuFile    ,  "add"  ,   "menu"  ,  "SPACER" )
' -----------------------------------------------------

create_usedFileList ()

SOB (idMenuFileNew  , "SET" , "MENU.GREY" ,0 )

SOB (idMenuFileSave  , "SET" , "MENU.GREY" ,1)
SOB (idMenuFileSaveAs, "SET" , "MENU.GREY" ,1 )
SOB (idMenuFileSaveCopyAs, "SET" , "MENU.GREY" ,1 )

SOB (idMenuFileOpen  , "SET" , "MENU.GREY" ,0)
enableUsedFileSelection ( 0 )

SOB (idMenuFileClose , "SET" , "MENU.GREY" ,1 )
SOB (idMenuFileReload , "SET" , "MENU.GREY" ,1 )

SOB (idMenuFileExit  , "SET" , "MENU.GREY" ,0 )

' -----------------------------------------------------
'   myMenuRegions
' -----------------------------------------------------

sob ( myMenuRegions , "add"   ,  "menu"   ,  "Vertical" , "Visible"      )

FUNCTION cbRegionsVisible ( sobid )
   sob(sobid, "SET", "CHECK" ,     ! sob(sobid, "GET", "CHECK" )  )
   RegionRectShow = sob(sobid, "GET", "CHECK" )

   IF ( ImageLoadedFlag ) then
      sob ( reDrawRegionsID , "trigger")
   END IF

END FUNCTION

sob ( -1 ,  "ON"   ,  "CLICK"  , "cbRegionsVisible"  )
sob ( -1 , "TRIGGER")

' -----------------------------------------------------

dim myMenuRegionsRGBn = sob ( myMenuRegions , "add"   ,  "menu"   , "Horizontal" , "RGB (named)"   )
dim RegionRectRGBn
FUNCTION cbRegionsRGBn ( sobid )
   sob(  sobid  , "SET", "CHECKS.OFF"     )
   sob(  sobid , "SET", "CHECK" ,  1  )
   RegionRectRGBn = sob ( sobid , "get", "data")
   IF ( ImageLoadedFlag ) then
      sob ( reDrawRegionsID , "trigger")
   END IF
END FUNCTION

FUNCTION MakeRegionsRGBn( name , colour )

   sob ( myMenuRegionsRGBn    , "add"   ,  "menu"   ,  "Vertical" , name    )
   sob ( -1    , "SET"   ,  "Data" , colour     )
   sob ( -1    ,  "ON"   ,  "CLICK"  , "cbRegionsRGBn"  )
END FUNCTION

MakeRegionsRGBn( "Black"  , rgb(000,000,000) )
sob ( -1 , "TRIGGER")
MakeRegionsRGBn( "Red"    , rgb(255,000,000) )
MakeRegionsRGBn( "Yellow" , rgb(255,255,000) )
MakeRegionsRGBn( "Green"  , rgb(000,255,000) )
MakeRegionsRGBn( "Blue"   , rgb(000,000,255) )
MakeRegionsRGBn( "White"  , rgb(255,255,255) )
' -----------------------------------------------------

dim myMenuRegionsRGBu = sob ( myMenuRegions , "add"   ,  "menu"   , "Horizontal" , "RGB (unnamed)"   )
dim RegionRectRGBu
FUNCTION cbRegionsRGBu ( sobid )
   sob(  sobid  , "SET", "CHECKS.OFF"     )
   sob(  sobid , "SET", "CHECK" ,  1  )
   RegionRectRGBu = sob ( sobid , "get", "data")
   IF ( ImageLoadedFlag ) then
      sob ( reDrawRegionsID , "trigger")
   END IF
END FUNCTION

FUNCTION MakeRegionsRGBu( name , colour )

   sob ( myMenuRegionsRGBu    , "add"   ,  "menu"   ,  "Vertical" , name    )
   sob ( -1    , "SET"   ,  "Data" , colour     )
   sob ( -1    ,  "ON"   ,  "CLICK"  , "cbRegionsRGBu"  )
END FUNCTION

MakeRegionsRGBn( "Black"  , rgb(000,000,000) )

MakeRegionsRGBu( "Red"    , rgb(255,000,000) )
MakeRegionsRGBu( "Yellow" , rgb(255,255,000) )
MakeRegionsRGBu( "Green"  , rgb(000,255,000) )
MakeRegionsRGBu( "Blue"   , rgb(000,000,255) )
sob ( -1 , "TRIGGER")
MakeRegionsRGBu( "White"  , rgb(255,255,255) )
' -----------------------------------------------------

dim myMenuRegionsRGBa = sob ( myMenuRegions , "add"   ,  "menu"   , "Horizontal" , "RGB (active)"   )
dim RegionRectRGBa
FUNCTION cbRegionsRGBa ( sobid )
   sob(  sobid  , "SET", "CHECKS.OFF"     )
   sob(  sobid , "SET", "CHECK" ,  1  )
   RegionRectRGBa = sob ( sobid , "get", "data")
   IF ( ImageLoadedFlag ) then
      sob ( reDrawRegionsID , "trigger")
   END IF
END FUNCTION

FUNCTION MakeRegionsRGBa( name , colour )

   sob ( myMenuRegionsRGBa    , "add"   ,  "menu"   ,  "Vertical" , name    )
   sob ( -1    , "SET"   ,  "Data" , colour     )
   sob ( -1    ,  "ON"   ,  "CLICK"  , "cbRegionsRGBa"  )
END FUNCTION

MakeRegionsRGBa( "Black"  , rgb(000,000,000) )

MakeRegionsRGBa( "Red"    , rgb(255,000,000) )
sob ( -1 , "TRIGGER")
MakeRegionsRGBa( "Yellow" , rgb(255,255,000) )
MakeRegionsRGBa( "Green"  , rgb(000,255,000) )
MakeRegionsRGBa( "Blue"   , rgb(000,000,255) )
MakeRegionsRGBa( "White"  , rgb(255,255,255) )
' -----------------------------------------------------

dim myMenuRegionsWeigth = sob ( myMenuRegions , "add"   ,  "menu"   , "Horizontal" , "Width"   )

FUNCTION cbRegionsWeight ( sobid )
   sob(  sobid , "SET" , "CHECKS.OFF"     )
   sob(  sobid , "SET" , "CHECK" ,  1  )
   RegionRectWeight = sob ( sobid , "get", "data")
   IF ( ImageLoadedFlag ) then

      sob ( reDrawRegionsID , "trigger")
   END IF
END FUNCTION

FUNCTION MakeRegionsWeight( weigth )
   sob ( myMenuRegionsWeigth    , "add"   ,  "menu"   ,  "Vertical" , "" & weigth     )
   sob ( -1    , "SET"   ,  "Data" , weigth     )
   sob ( -1    ,  "ON"   ,  "CLICK"  , "cbRegionsWeight"  )
END FUNCTION

MakeRegionsWeight( 1 )
MakeRegionsWeight( 2 )
MakeRegionsWeight( 4 )
MakeRegionsWeight( 8 )
sob ( -1 , "TRIGGER")
MakeRegionsWeight( 16 )
MakeRegionsWeight( 32 )

' -----------------------------------------------------
'

dim myMenuRegionRubberbanding = sob ( myMenuRegions , "add"   ,  "menu"   , "Vertical" , "Rubberbanding"   )

FUNCTION NoOpPress ( sobid,a,b,c,d )
END function

FUNCTION cbRegionsRubberbanding ( sobid )
   dim val = sob( myMenuRegionRubberbanding , "GET", "CHECK" )

   IF ( val ) then
      '  we were rubberbanding

      sob( sobid , "SET", "CHECK"    , 0   )

      sob ( sobImageHolder , "ON"  , "RUBBERBAND", "cbImageRubberBand" , "OFF")

      '   remove rubberbanding Rect from view
      IF ( ImageLoadedFlag ) then
         sob ( reDrawRegionsID , "trigger")
      END IF
   ELSE
      sob( sobid , "SET", "CHECK"    , 1  )
      sob ( sobImageHolder , "ON"  , "RUBBERBAND", "cbImageRubberBand")
   END IF

END FUNCTION

sob ( -1    ,  "ON"   ,  "CLICK"  , "cbRegionsRubberbanding"  )

' -----------------------------------------------------

FUNCTION sink ()
   sob ( HelpFloatOVl , "SET", "SHOW" , 0 )
   HelpPageSOB  =  HelpFixedOVl
   HelpTextSob  =  HelpFixedHTMLSOB
END FUNCTION

FUNCTION HelpFloat ( sobid )
   dim txt

   dim  chk = ! sob ( sobid, "get","check" )

   sob( Fixed2Float, "SET", "CHECK" ,   chk  )
   sob( Float2Fixed, "SET", "CHECK" ,   chk  )

   txt = sob ( HelpTextSob , "GET", "HTML" , "OUTER" )
   sob ( HelpTextSob , "empty")

   IF ( chk ) then
      sob ( HelpFloatOVl , "SET", "SHOW" , 1 )
      HelpPageSOB  =  HelpFloatOVl
      HelpTextSob  =  HelpFloatHTMLSOB

   ELSE
      sob ( HelpFloatOVl , "SET", "SHOW" , 0 )
      HelpPageSOB  =  HelpFixedOVl
      HelpTextSob  =  HelpFixedHTMLSOB

   END IF
   sob ( HelpTextSob , "empty")
   sob ( HelpTextSob ,"add","row" , txt )

END FUNCTION

FUNCTION createHelpMenuContent ( parentMenu )

   ' -----------------------------------------------------
   sob ( parentMenu , "add"   ,  "menu"   ,  "Vertical", "Introduction"      )
   sob (   -1     ,  "ON"   ,  "CLICK"  , "aboutHTML"  )

   sob ( parentMenu , "add"   ,  "menu"   ,  "Vertical", "Tagging"      )
   sob (   -1     ,  "ON"   ,  "CLICK"  , "HelpTagging"  )

   sob ( parentMenu   , "add"  ,  "menu"   ,  "Vertical" ,  "Tag Groups that I use"   )
   sob ( -1 ,"ON","CLICK", "myTagGroups")

   sob ( parentMenu , "add"   ,  "menu"   ,  "Vertical", "Tag Text"      )
   sob (   -1     ,  "ON"   ,  "CLICK"  , "HelpTagTextHTML"  )

   sob ( parentMenu , "add"   ,  "menu"   ,  "Vertical", "File Text"      )
   sob (   -1     ,  "ON"   ,  "CLICK"  , "HelpFreeText"  )

   sob ( parentMenu , "add"   ,  "menu"   ,  "Vertical", "File Subset"      )
   sob (   -1     ,  "ON"   ,  "CLICK"  , "HelpFileSubSet"  )

   sob ( parentMenu , "add"   ,  "menu"   ,  "Vertical", "Delete External Duplicates"      )
   sob (   -1     ,  "ON"   ,  "CLICK"  , "HelpDelExtDups"  )

   sob ( parentMenu , "add"   ,  "menu"   ,  "Vertical", "Delete Files"      )
   sob (   -1     ,  "ON"   ,  "CLICK"  , "HelpDelFiles"  )

   sob ( parentMenu , "add"   ,  "menu"   ,  "Vertical", "Delete Current File"      )
   sob (   -1     ,  "ON"   ,  "CLICK"  , "HelpCurrentFile"   )

   sob ( parentMenu , "add"   ,  "menu"   ,  "Vertical", "Power Tagging"      )
   sob (   -1     ,  "ON"   ,  "CLICK"  , "HelpPowerTagging"  )

   sob ( parentMenu , "add"   ,  "menu"   ,  "Vertical", "Inherit"      )
   sob (   -1     ,  "ON"   ,  "CLICK"  , "HelpInherit"  )

   IF ( haveWIA + haveShell) then
      sob ( parentMenu , "add"   ,  "menu"   ,  "Vertical", "Single File Options"      )
      sob (   -1     ,  "ON"   ,  "CLICK"  , "HelpSingleFileOptions"  )
   END if

   sob ( parentMenu   , "add"  ,  "menu"   ,  "Vertical" ,  "Facial Recognition"   )
   sob ( -1 ,"ON","CLICK", "HelpFacialRecognition")

   sob ( parentMenu   , "add"  ,  "menu"   ,  "Vertical" ,  "Regions"   )
   sob ( -1 ,"ON","CLICK", "HelpRegions")

   sob ( parentMenu   , "add"  ,  "menu"   ,  "Vertical" ,  "Backup"   )
   sob ( -1 ,"ON","CLICK", "HelpBackUp")

   sob ( parentMenu   , "add"  ,  "menu"   ,  "Vertical" ,  "Expert Mode"   )
   sob ( -1 ,"ON","CLICK", "HelpExpertMode")

   sob ( parentMenu   , "add"  ,  "menu"   ,  "Vertical" ,  "Tips'n'Tricks"   )
   sob ( -1 ,"ON","CLICK", "HelpTipsNTricks")

   sob ( parentMenu , "add"   ,  "menu"   ,  "Vertical", "Go to online help"      )
   sob (   -1     ,  "ON"   ,  "CLICK"  , "HelpOnline"  )

END function

dim Fixed2Float = sob ( myMenuHelp , "add"   ,  "menu"   ,  "Vertical", "Float the help panel"      )
sob (   -1     ,  "ON"   ,  "CLICK"  , "HelpFloat"   )
createHelpMenuContent ( myMenuHelp )

dim Float2Fixed = sob ( HelpMenuHelp , "add"   ,  "menu"   ,  "Vertical", "Float the help panel"      )
sob (   -1     ,  "ON"   ,  "CLICK"  , "HelpFloat"   )
createHelpMenuContent ( HelpMenuHelp )

' -----------------------------------------------------
sob ( myMenuAbout   , "add"  ,  "menu"   ,  "Vertical" ,  "Version"   )
sob ( -1 ,"ON","CLICK", "HelpVersion")

sob ( myMenuAbout   , "add"  ,  "menu"   ,  "Vertical" ,  "Use cases"   )
sob ( -1 ,"ON","CLICK", "HelpUseCases")

sob ( myMenuAbout   , "add"  ,  "menu"   ,  "Vertical" ,  "Techie Talk"   )
sob ( -1 ,"ON","CLICK", "cbTechieTalk")

sob ( myMenuAbout , "add"   ,  "menu"   ,  "Vertical", "The author"      )
sob (   -1     ,  "ON"   ,  "CLICK"  , "AboutTheAuthor"  )
sob ( myMenuAbout   , "add"  ,  "menu"   ,  "Vertical" ,  "Contact"   )
sob ( -1 ,"ON","CLICK", "ContactHTML")

' -----------------------------------------------------
' OptionsMenu
' -----------------------------------------------------

dim optionsMenuExpert = sob ( OptionsMenu   , "add"  ,  "menu"   ,  "Vertical" ,  "Expert Mode"   )

FUNCTION cbOptionsMenuExpert ( sobid )

   ExpertFlag = ! ExpertFlag

   sob(sobid, "SET", "CHECK" ,ExpertFlag)

   sob (  pwsWindow, "SET", "SHOW", ExpertFlag )
   IF ( ExpertFlag ) then 
   dbDisplayRefresh
   sob ( pwsWindow, "set", "shrink")
   end if
END Function

sob ( -1 ,"ON","CLICK", "cbOptionsMenuExpert")

' --------------
dim optionsMenuRescan = sob ( OptionsMenu   , "add"  ,  "menu"   ,  "Vertical" ,  "Rescan Master"   )

FUNCTION cbOptionsMenuRescan ( sobid )

   CommonSobClear ( "Rescan the root folders" )

   > Use this to rescan the root folder(s) (those previously read via the commands NEW  and SCAN NEW FOLDER§
   >> Identify changes in terms of: §
   >>   - new location ( path|filename )  with a new hash§
   >>       will start with no TAG values§
   >>   - new location ( path|filename )  with a hash known to the database§
   >>       will start with the TAG values applicable for that hash§
   >>   - existing location ( path|filename )  with different hash to that previously held§
   >>       will continue with its previous TAGs§
   >>   - existing location ( path|filename )  not found.§
   >>       will be removed from the database

   sob ( CommonSobInfo  , "ADD" , "ROW" , replace ( freestring , EOLdelim , EOL ) )

   sob ( CommonSobBtn , "SET" , "TITLE" , "Rescan")
   sob ( CommonSobBtn , "ON"  , "PRESS", "CbRescanDatabase")
   sob ( CommonSobBtn , "SET" , "rgb" , defBtnCol)
   sob ( CommonSobBtn , "SET" , "SHOW" , 1)

   getrootFolders (CommonSobResult ,CommonSobCombo)

   sob (   CommonOvl ,"set","show",1)

END Function

sob ( -1 ,"ON","CLICK", "cbOptionsMenuRescan")

' --------------
dim optionsMenuNewScan = sob ( OptionsMenu   , "add"  ,  "menu"   ,  "Vertical" ,  "Scan new folder"   )

FUNCTION cboptionsMenuNewScan ( sobid )
   getrootFolders (CommonSobResult,CommonSobCombo)
   CommonSobClear ( "Scan new folder into database" )

   > Use this to scan a new root folder(s) and add its contents to the current database§
   >>   - new location ( path & filename )   with a new hash§
   >>       will start with no TAG values§
   >>   - new location ( path  & filename )  with a hash known to the database§
   >>       will start with the TAG values applicable for that hash§
   >> §
   >> If the new folder structure overlaps a current root folder, then the overlapping area will NOT reread!§

   sob ( CommonSobInfo  , "ADD" , "ROW" , replace ( freestring , EOLdelim , EOL ) )

   sob ( CommonSobBtn , "SET" , "TITLE" , " Scan ")
   sob ( CommonSobBtn , "ON"  , "PRESS", "CbScanNewFolder")
   sob ( CommonSobBtn , "SET" , "rgb" , defBtnCol)
   sob ( CommonSobBtn ,"set","show",1)
   sob (   CommonOvl ,"set","show",1)

END Function

sob ( -1 ,"ON","CLICK", "cbOptionsMenuNewScan")

' --------------

FUNCTION singleFileInfo (  sobid )
   SOB ( sobid , "SET" , "CHECKS.OFF"    )
   sob(sobid, "SET", "CHECK" ,1)

   IF ( imageLoadedFlag ) then

      sob ( TagInfo , "SET", "SHOW", 0)
      DisplayTagsInFile ()

      IF (  haveWIA ) then
         IF ( sob ( SingleFileMenuWIA , "GET" , "CHECK" ) ) then   handleFileWIA ( TagInfo , CurrentFile )
      END IF
      IF (  haveShell ) then
         IF ( sob ( SingleFileMenuGetDetailsOf , "GET" , "CHECK" ) ) then  handleFileGetDetailsOf ( TagInfo ,CurrentFile   )
      END IF
      sob ( TagInfo , "SET", "SHOW", 1)
   END if

END Function

IF ( haveWIA + haveShell) then
   dim SingleFileMenuNoInfo= sob ( myMenuSingleFile   , "add"  ,  "menu"   ,  "Vertical" ,  "No extra info"   )
   sob ( -1 ,"ON","CLICK", "singleFileInfo")

   IF ( haveWIA) then
      dim SingleFileMenuWIA= sob ( myMenuSingleFile   , "add"  ,  "menu"   ,  "Vertical" ,  "Info from WIA"   )
      sob ( -1 ,"ON","CLICK", "singleFileInfo")
   END IF

   IF ( haveShell) then
      dim SingleFileMenuGetDetailsOf= sob ( myMenuSingleFile   , "add"  ,  "menu"   ,  "Vertical" ,  "Info from SHELL"   )
      sob ( -1 ,"ON","CLICK", "singleFileInfo")
   END IF

   sob ( -1 , "TRIGGER")
END IF

' --------------

dim ImageMngmtDisplayRows = 7
dim ImageMngmtBase

FUNCTION CreateImageMngmtTblGroup ( type )
   drop table if exists temp.ImageMngmtTbl

   > create temp table ImageMngmtTbl as
   >> select rowid as selfA ,* from master 
   >> WHERE 
   >>   ImageGroupType like
   freestring = freestring & " " &  sqlString ( type )
   >>  AND      IgnoreFile = 0
   >>  AND  not pHash      = 0
   >>  group by  ImageGroup having count (*) > 1
   >>  order by size desc
   sql ( freestring ) 
   ImageMngmtBase = 0  

   SELECT count (*) from ImageMngmtTbl
   sob ( ImageMngmtOF, "SET" ,"TITLE", cstr( qrSingleValue) )

END function

FUNCTION CreateImageMngmtTbl ( type )
   drop table if exists temp.ImageMngmtTbl

   > create temp table ImageMngmtTbl as
   >> select rowid as selfA , * from master 
   >> WHERE 
   >>   ImageGroupType like
   freestring = freestring & " " &  sqlString ( type )
   >>  AND      IgnoreFile = 0
   >>  AND  not pHash      = 0
   
   >>  order by size desc
   sql ( freestring ) 
   ImageMngmtBase = 0  

   SELECT count (*) from ImageMngmtTbl
   sob ( ImageMngmtOF, "SET" ,"TITLE", cstr( qrSingleValue) )

END function

FUNCTION ImageMngmtDisplay ()
   removeThumbNails ( siImageMngmtMatrix )
   dim row = 1 , col
   dim ImgGroup
   dim siTmp

   sob ( ImageMngmtFrom, "SET" ,"TITLE", cstr(ImageMngmtBase))

   > select path||name , ImageGroup, SelfA,  * from ImageMngmtTbl
   >>  limit
   freestring = freestring & " " & sqlString (ImageMngmtDisplayRows )
   >> offset
   freestring = freestring & " " & ImageMngmtBase
   WITHQUERY ( freestring )

      siTmp = sob ( siImageMngmtMatrix ,  "CHILD", "HANDLE" ,  row )
      sob ( siTmp ,"SET","IMAGE", wqText(1) )
      sob ( siTmp ,"SET","Data", wqInt(3) )

      col = 1
      > select path||name , ImageGroup, rowid,  * from master
      >>  where
      >>    ImageGroup like
      freestring = freestring & " " & SqlString ( wqText(2) )
      >>  and NOT rowid =
      freestring = freestring & " " &   wqInt (3)
   >>  AND      IgnoreFile = 0
   >>  AND  not pHash      = 0
      >>  order by size desc
      >> limit 5
      WITHQUERY ( freestring )  
         siTmp = sob ( siImageMngmtMatrix ,  "CHILD", "HANDLE" ,  row + col )
         sob ( siTmp ,"SET","IMAGE", wqText(1) )
         sob ( siTmp ,"SET","Data", wqInt(3) )

         col = col + 1
      END WithQuery
      row = row + 5  
   END withquery
   ImageMngmtBase = ImageMngmtBase + ImageMngmtDisplayRows
   sob ( ImageMngmtTo, "SET" ,"TITLE", cstr(ImageMngmtBase) )

END function



FUNCTION cbImageMngmtReset( sobid )

   ResetImageGroups ()
END function

FUNCTION cbImageMngmtDuplicates( sobid )
   sob ( ImageManagementOvl , "SET", "SHOW", 1 )

   CreateImageMngmtTblGroup ("duplicate" )
   ImageMngmtDisplay ( )
END function

FUNCTION cbImageMngmtDifferent( sobid )
   sob ( ImageManagementOvl , "SET", "SHOW", 1 )

   CreateImageMngmtTbl ("different" )
   ImageMngmtDisplay ()
END function

FUNCTION cbImageMngmtNearidentical( sobid )
   sob ( ImageManagementOvl , "SET", "SHOW", 1 )

   CreateImageMngmtTblGroup ("Near-Identical" )
   ImageMngmtDisplay ()
END function

sob ( myMenuImageMngmt   , "add"  ,  "menu"   ,  "Vertical" ,  "Duplicates"   )
sob ( -1 ,"ON","CLICK", "cbImageMngmtDuplicates")
sob ( myMenuImageMngmt   , "add"  ,  "menu"   ,  "Vertical" ,  "Near-Identical"   )
sob ( -1 ,"ON","CLICK", "cbImageMngmtNearidentical")

sob ( myMenuImageMngmt   , "add"  ,  "menu"   ,  "Vertical" ,  "Different"   )
sob ( -1 ,"ON","CLICK", "cbImageMngmtDifferent")
sob ( myMenuImageMngmt   , "add"  ,  "menu"   ,  "Vertical" ,  "Reset"   )
sob ( -1 ,"ON","CLICK", "cbImageMngmtReset")

' --------------

dim optionsMenuRemoveExternalDups= sob ( myMenuDelete   , "add"  ,  "menu"   ,  "Vertical" ,  "Delete External Duplicates"   )

FUNCTION CBoptionsMenuRemoveExternalDups ( sobid )

   CommonSobClear ( "Delete known files/hash in external folder" )

   >Be warned, this deletes files (to the recycle bin)§
   >>It scans a user defined folder structure and DELETES any file whose hash is in the database.§
   >>  §
   >>I use this when I think that the target folder has files that I want to bring (later) in to §
   >>the database, and I want to exclude from that folder structure any file that is already known!§
   >>  §
   >>It will NOT delete ANYTHING in the database!§
   >>It does NOT bring the not deleted files in to the database, do that using the  -Scan new folder- option.

   sob ( CommonSobInfo  , "ADD" , "ROW" , replace ( freestring , EOLdelim , EOL ) )

   sob ( CommonSobBtn , "SET" , "TITLE" , "Delete")
   sob ( CommonSobBtn , "ON"  , "PRESS", "CbRemoveExternalDuplicates")
   sob ( CommonSobBtn , "SET" , "rgb" , defBtnCol)
   sob (   CommonSobBtn ,"set","show",1)
   sob (   CommonOvl ,"set","show",1)

END Function

sob ( -1 ,"ON","CLICK", "CBoptionsMenuRemoveExternalDups")

' --------------
dim  toolsMenuDelete = sob ( myMenuDelete   , "add"  ,  "menu"   ,  "Vertical" ,  "Delete Files"   )

FUNCTION cbtoolsMenuDelete ( sobid )

   sob ( FileExportOvl    , "set" , "show" , 1)
   sob ( NbrFilesInFilter , "SET", "TITLE" , "" & exportFilter ( "statistic" ,  "" ,  ""    ) )
   sob ( SubListTitleSob  , "set" , "title", "Create a file sublist for deleting from database and disk" )

   sob ( BtnExportFiles  , "set" , "show" , 0)
   sob ( BtnDeleteFiles  , "set" , "show" , 1)

   sob ( PowerTaggingSob , "set" , "show" , 0)

END Function

sob ( -1 ,"ON","CLICK", "cbtoolsMenuDelete")
' --------------
dim optionsMenuRootFolders= sob ( OptionsMenu   , "add"  ,  "menu"   ,  "Vertical" ,  "Root Folders"   )

FUNCTION CbShowRootFolders ( soibid )

END function

FUNCTION onRootFolderSelection ( sobid , rowid )

   IF ( ! isdbopen ) THEN
      ErrorReport("No database open")
      EXIT function
   END IF

   ShellExecute ( sob ( sobid , "get", "title" )  )

END Function

FUNCTION CBoptionsMenuRootFolders ( sobid )
   CommonSobClear ( "Root Folders" )

   getrootFolders(CommonSobResult,CommonSobCombo)

   >select a root folder from the combo box below and the folder will be
   >> opened in a file explorer.
   sob ( CommonSobInfo  , "ADD" , "ROW" , replace ( freestring , EOLdelim , EOL ) )

   sob ( CommonSobBtn , "ON"  , "PRESS", "CbShowRootFolders")
   sob ( CommonSobBtn , "SET" , "rgb" , defBtnCol)
   sob ( CommonOvl    , "set" , "show",1)
   sob ( CommonSobCombo  , "set" , "show",1)

   sob ( CommonSobCombo  , "ON" , "SELECTION" , "onRootFolderSelection")

END Function

sob ( -1 ,"ON","CLICK", "CBoptionsMenuRootFolders")

' --------------

dim optionsMenuAutoSesion= sob ( OptionsMenu   , "add"  ,  "menu"   ,  "Vertical" ,  "Auto reload last session"   )

FUNCTION autoStartChk ( )
   sob(optionsMenuAutoSesion , "SET", "CHECK" ,  0 )
   IF (  db_arg_int ( "select count (*)  from parameters where type  like 'autoStart'"   ) ) then

      IF ( db_arg_int ( "select val from parameters where type  like 'autoStart'"   ) ) then
         CBUsedFileList (  FirstFileMenuItem )
         sob(optionsMenuAutoSesion , "SET", "CHECK" ,  1 )
      END IF
   END if

END FUNCTION

FUNCTION optionsMenuAutoSession  ( sobid )
   sob(sobid, "SET", "CHECK" ,     ! sob(sobid, "GET", "CHECK" )  )
   dim AutoState  = sob(sobid, "GET", "CHECK" )

   IF ( ! db_arg_int ( "select count (*)  from parameters where type  like 'autoStart'"   ) ) then
      db_arg_set (  "insert into parameters  values  ('autoStart', '', 0 , '' , '' ) "    )
   END if

   > update parameters  set val =
   freestring = freestring & " " & AutoState
   >> where type  like 'autoStart'
   db_arg_set ( freestring )

END FUNCTION

sob ( -1 ,"ON","CLICK", "optionsMenuAutoSession")

' --------------

dim optionsMenuResetFields= sob ( OptionsMenu   , "add"  ,  "menu"   ,  "Vertical" ,  "Reset all fields"   )

FUNCTION cboptionsMenuResetFields  ( sobid )
   resetSavedBoxes  ()
   sob ( CommonOvl ,"set","show",1)
   CommonSobClear ( "" )

END FUNCTION

sob ( -1 ,"ON","CLICK", "cboptionsMenuResetFields")

' -----------------------------------------------------

dim toolsMenuTagManage = sob ( myMenuTools   , "add"  ,  "menu"   ,  "Vertical" ,  "Tag Management"   )

FUNCTION cbtoolsMenuTagManage ( sobid )
   sob (   TagManageOvl ,"set","show",1)
END Function

sob ( -1 ,"ON","CLICK", "cbtoolsMenuTagManage")

' --------------
dim toolsMenuTagFilesB= sob ( myMenuTools   , "add"  ,  "menu"   ,  "Vertical" ,  "File Tagging"   )

FUNCTION cbtoolsMenuTagFilesB ( sobid )
   sob ( FileTaggingOvl ,   "set", "show" , 1)
END Function

sob ( -1 ,"ON","CLICK", "cbtoolsMenuTagFilesB")

' --------------
dim toolsMenuTagPower= sob ( myMenuTools   , "add"  ,  "menu"   ,  "Vertical" ,  "Power Tagging"   )

FUNCTION cbtoolsMenuTagPower ( sobid )

   sob ( FileExportOvl   , "set" , "show" , 1)
   sob ( SubListTitleSob  , "set" , "title", "Create a file sublist for Power Tagging" )

   sob ( NbrFilesInFilter , "SET", "TITLE" , "" & exportFilter ( "statistic" ,  "" ,  ""    ) )
   sob ( PowerTaggingSob , "set" , "show" , 1)

   sob ( BtnExportFiles  , "set" , "show" , 0)
   sob ( BtnDeleteFiles  , "set" , "show" , 0)

END Function

sob ( -1 ,"ON","CLICK", "cbtoolsMenuTagPower")

' --------------

FUNCTION cbImportMenuExcel ( sobid )
   IF ( ! isDBOpen ) then
      ErrorReport ("No database selected" )
      EXIT function
   END if
   CommonSobClear ( "Import database from Excel" )

   >Recreate a database from a previous saved Excel file.§
   >>You will be asked for a file name, from which the databse will be recreated.§
   sob ( CommonSobBtn ,"set","show",1)

   sob ( CommonSobInfo  , "ADD" , "ROW" , replace ( freestring , EOLdelim , EOL ) )

   sob ( CommonSobBtn , "SET" , "TITLE" , "Import")
   sob ( CommonSobBtn , "ON"  , "PRESS", "CbImportMasterToExcel")
   sob ( CommonSobBtn , "SET" , "rgb" , defBtnCol)
   sob ( CommonOvl ,"set","show",1)

END Function
IF ( XLallowed ) then
   dim  ImportMenuExcel= sob ( myMenuImport   , "add"  ,  "menu"   ,  "Vertical" ,  "Database from Excel"   )
   sob ( -1 ,"ON","CLICK", "cbImportMenuExcel")
END IF

' --------------
' --------------
FUNCTION cbImportMenuCSV ( sobid )
   IF ( ! isDBOpen ) then
      ErrorReport ("No database selected" )
      EXIT function
   END if
   CommonSobClear ( "Import database from CSV" )

   >Import a copy of the database master table to CSV
   >>§
   >>It actually try to read in two CSV files: one for the  MASTER  table, and one for the  Tag table.§
   >> (When you provided a name for the CVS export, it MUST end in   .csv  §
   >>  So if you provided the name  xyz.csv   then that will be used for the MASTER table§
   >>  And  xyzTT.csv   will be used for the Tag Table.)§
   >>§
   >>The Tag Table is only needed to provide the free text associated with the individual tags.§
   >>Should the   Tag Table be lost, then the fundamental tagging capability is NOT affected.§

   sob ( CommonSobInfo  , "ADD" , "ROW" , replace ( freestring , EOLdelim , EOL ) )

   sob ( CommonSobBtn , "SET" , "TITLE" , "Import")
   sob ( CommonSobBtn , "ON"  , "PRESS", "CbImportMasterToCSV")
   sob ( CommonSobBtn , "SET" , "rgb" , defBtnCol)
   sob (   CommonOvl ,"set","show",1)

END Function

dim  ImportMenuCSV= sob ( myMenuImport   , "add"  ,  "menu"   ,  "Vertical" ,  "Database from CSV"   )
sob ( -1 ,"ON","CLICK", "cbImportMenuCSV")
' --------------

' --------------
FUNCTION cbExportMenuExcel ( sobid )

   CommonSobClear ( "Export database to Excel" )

   >Export a copy of the database master table to Excel§
   >>§
   >>It does NOT create an EXCEL compatible file, it "talks" to Excel and gets Excel to create the file.§
   >>If Excel is not running, it will be started.§
   >>If Excel is already running, then the exported data will be placed in a NEW workbook§
   >>You will be asked for a file name under which the workbook will be saved.§
   IF ( xlactive   ) then
      >>Excel is already running§
   ELSE
      >>Excel will be started if/when you press the export button§
   END IF
   sob ( CommonSobBtn ,"set","show",1)

   sob ( CommonSobInfo  , "ADD" , "ROW" , replace ( freestring , EOLdelim , EOL ) )

   sob ( CommonSobBtn , "SET" , "TITLE" , "Export")
   sob ( CommonSobBtn , "ON"  , "PRESS", "CbExportMasterToExcel")
   sob ( CommonSobBtn , "SET" , "rgb" , defBtnCol)
   sob (   CommonOvl ,"set","show",1)

END Function
IF ( XLallowed ) then
   dim  ExportMenuExcel= sob ( myMenuExport   , "add"  ,  "menu"   ,  "Vertical" ,  "Database to Excel"   )
   sob ( -1 ,"ON","CLICK", "cbExportMenuExcel")
END IF

' --------------

' --------------

' --------------
FUNCTION cbExportMenuCSV ( sobid )
   CommonSobClear ( "Export database to CSV" )

   >Export a copy of the database master table to CSV
   >>§
   >>It actually creates two CSV files: one for the  MASTER  table, and one for the  Tag table.§
   >>When you provide a name for the CVS export, it MUST end in   .csv  §
   >>So if you provide the name  xyz.csv   then that will be used for the MASTER table§
   >>And  xyzTT.csv   will be used for the Tag Table§
   >>§
   >>The Tag Table is only needed to provide the free text associated with the individual tags.§
   >>Should the   Tag Table be lost, then the fundamental tagging capability is NOT affected.§

   sob ( CommonSobInfo  , "ADD" , "ROW" , replace ( freestring , EOLdelim , EOL ) )

   sob ( CommonSobBtn , "set" , "show" , 1 )

   sob ( CommonSobBtn , "SET" , "TITLE" , "Export")
   sob ( CommonSobBtn , "ON"  , "PRESS", "CbExportMasterToCSV")
   sob ( CommonSobBtn , "SET" , "rgb" , defBtnCol)
   sob (   CommonOvl ,"set","show",1)

END Function

dim  ExportMenuCSV= sob ( myMenuExport   , "add"  ,  "menu"   ,  "Vertical" ,  "Database to CSV"   )
sob ( -1 ,"ON","CLICK", "cbExportMenuCSV")
' --------------

dim  myMenuBackup  = sob (myMenuExport ,  "add"  ,  "menu"   , "Vertical" ,  "Database to Backup"   )

FUNCTION cbExportMenuBackup ( sobid )

   CommonSobClear ( "Back up whole database" )

   >Back-up the FILES referenced in the database: 
  
   >> you specify a destination folder.§
   >> Then the folders & files held in the database will be COPIED to that destination.§
   >>  §
   >> If the destination already has the same folder structure then any files therein §
   >> will be DELETED if they are not also in the database.§
   >>  §
   >> If the destination has folders not in the database folder structure then they §
   >> will be DELETED .§
   >>  §
   >> If the destination already has a folder/file that is in the database, AND they have §
   >> the same checksum, the destination will not be overwritten.§
   >> The backup is therefore an INCREMENTAL backup (for performance reasons),.§
   sob ( CommonSobInfo  , "ADD" , "ROW" , replace ( freestring , EOLdelim , EOL ) )

   sob ( CommonSobBtn ,"set","show",1)

   sob ( CommonSobBtn , "SET" , "TITLE" , "Backup")
   sob ( CommonSobBtn , "ON"  , "PRESS", "CbBackUpDatabase")
   sob ( CommonSobBtn , "SET" , "rgb" , defBtnCol)
   sob (   CommonOvl ,"set","show",1)

END Function
sob ( -1 ,"ON","CLICK", "cbExportMenuBackup")

' --------------
sob ( myMenuExport    ,  "add"  ,   "menu"  ,  "SPACER" )
' --------------

dim  toolsMenuDBExportExcel= sob ( myMenuExport   , "add"  ,  "menu"   ,  "Vertical" ,  "Sublist to Excel"   )

FUNCTION cbtoolsMenuDBExportExcel ( sobid )

   sob ( FileExportOvl   , "set" , "show" , 1)
   sob ( NbrFilesInFilter , "SET", "TITLE" , "" & exportFilter ( "statistic" ,  "" ,  ""    ) )

   sob ( SubListTitleSob, "set" , "title", "Create a file sublist for Excel" )

   sob ( BtnExportFiles , "set", "Title" ,  "Export sublist" )
   sob ( -1 , "ON" , "PRESS"    , "cbExportFileListToExcel")

   sob ( BtnExportFiles  , "set" , "show" , 1 )
   sob ( BtnDeleteFiles  , "set" , "show" , 0 )

   sob ( PowerTaggingSob , "set" , "show" , 0 )

END Function

sob ( -1 ,"ON","CLICK", "cbtoolsMenuDBExportExcel")
' --------------

dim  toolsMenuDBExport= sob ( myMenuExport   , "add"  ,  "menu"   ,  "Vertical" ,  "Sublist to CSV"   )

FUNCTION cbtoolsMenuDBExportCSV ( sobid )

   sob ( FileExportOvl   , "set" , "show" , 1)
   sob ( NbrFilesInFilter , "SET", "TITLE" , "" & exportFilter ( "statistic" ,  "" ,  ""    ) )

   sob ( SubListTitleSob, "set" , "title", "Create a file sublist for CSV" )

   sob ( BtnExportFiles , "set", "Title" ,  "Export sublist" )
   sob ( -1 , "ON" , "PRESS"    , "CbExportSubListToCSV")

   sob ( BtnExportFiles  , "set" , "show" , 1 )
   sob ( BtnDeleteFiles  , "set" , "show" , 0 )

   sob ( PowerTaggingSob , "set" , "show" , 0 )

END Function

sob ( -1 ,"ON","CLICK", "cbtoolsMenuDBExportCSV")
' --------------

dim  toolsMenuExportSubLIst= sob ( myMenuExport   , "add"  ,  "menu"   ,  "Vertical" ,  "SubList to Backup"   )

FUNCTION cbtoolsMenuExportSubList ( sobid )

   sob ( FileExportOvl    , "set" , "show" , 1)
   sob ( NbrFilesInFilter , "SET" , "TITLE" , "" & exportFilter ( "statistic" ,  "" ,  ""    ) )
   sob ( SubListTitleSob  , "set" , "title", "Create a backup of the files in a file sublist" )

   sob ( BtnExportFiles  , "set", "Title" ,  "Backup sublist" )

   sob ( -1 , "ON" , "PRESS"    , "CbBackUpSubList")

   sob ( BtnExportFiles  , "set" , "show" , 1)
   sob ( BtnDeleteFiles  , "set" , "show" , 0)

   sob ( PowerTaggingSob , "set" , "show" , 0)

END Function

sob ( -1 ,"ON","CLICK", "cbtoolsMenuExportSubList")

' --------------
sob ( myMenuExport    ,  "add"  ,   "menu"  ,  "SPACER" )
' --------------

dim  toolsMenuExport= sob ( myMenuExport   , "add"  ,  "menu"   ,  "Vertical" ,  "Sublist to flat folder"   )

FUNCTION cbtoolsMenuExport ( sobid )

   sob ( FileExportOvl    , "set" , "show" , 1)
   sob ( NbrFilesInFilter , "SET" , "TITLE" , "" & exportFilter ( "statistic" ,  "" ,  ""    ) )
   sob ( SubListTitleSob  , "set" , "title", "Create a file sublist to export files to a flat folder" )

   sob ( BtnExportFiles  , "set", "Title" ,  "Export files" )

   sob ( -1 , "ON" , "PRESS"    , "cbExportFileList")

   sob ( BtnExportFiles  , "set" , "show" , 1)
   sob ( BtnDeleteFiles  , "set" , "show" , 0)

   sob ( PowerTaggingSob , "set" , "show" , 0)

END Function

sob ( -1 ,"ON","CLICK", "cbtoolsMenuExport")

' --------------
' --------------




FUNCTION IsPPTAvailable ( )
   ' return  0 = no PowerPoint
   '         1 = have PPT but no   trusted access
   '        -1 = have PPT   AND    trusted access
   IsPPTAvailable = 0
   set IsPPTAvailable = createObject ("powerPoint.application")
   IF  (  istype ( IsPPTAvailable) == "DISPATCH" )   then
      ' test for access to PPT Trusted mode
      TRY
         IsPPTAvailable.VBE.CommandBars.Count
         IsPPTAvailable.quit
         set IsPPTAvailable = -1

         sob ( myMenuExport   , "add"  ,  "menu"  ,  "SPACER" )
         sob ( myMenuExport   , "add"  ,  "menu"  ,  "Vertical" ,  "PowerPoint, with trusted access"   )

      CATCH
         IsPPTAvailable.quit
         IsPPTAvailable=1
         sob ( myMenuExport   , "add"  ,  "menu"  ,  "SPACER" )
         sob ( myMenuExport   , "add"  ,  "menu"  ,  "Vertical" ,  "PowerPoint, no trusted access"   )
      END TRY
      
     

   END IF

END function



' --------------

if ( IsPPTAvailable() ) then
               sob ( myMenuExport   , "add"  ,  "menu"  ,  "Vertical" ,  "Sublist to Thumbnails"   )
               sob ( -1 ,"ON","CLICK", "cbtoolsMenuDBExportThumbnails")
end if
   
   
FUNCTION ExportThumbNails ( sobid  )

   IF ( ! isDbOpen ) then
      ErrorReport("no database open")
      cancelShow(0)
      toggleWarnColour ( sobid)
      EXIT function
   END if

   dim baseFolder = GetPath & "\\"

   ' start PPT
   dim myPPt = CreateObject( "powerpoint.application" )
   IF ( ! myPPt )  THEN
      Message ="Could not create object"
      STOP
   END IF
   '  myPPt.visible = 0 ' does not work in later versions of PowerPoint / Excel..., only   .visible = 1

   dim TargetPPt =  "Images.ppt"
   dim   myPres , presPath

   myPres =  myPPt.presentations.add(true)

   dim row = 0 , col = 0  , imgNbr = 1
   dim atPage = 1
   dim oPic, myTxtBox , iName

   ' we are going to place the thumbnails in a grid/matrix
   ' default:   8 across   by   5 down

   SELECT count (*) from SubList  where  EXT in ( 'jpg' , 'jpeg' )
   dim nbrImages = qrSingleValue

   dim matrixAcross
   dim matrixDown

   IF ( nbrImages  < 5  )  then
      matrixAcross = 2
      matrixDown   = 2
   ELSEIF ( nbrImages  < 10  )  then
      matrixAcross = 3
      matrixDown   = 3
   ELSEIF ( nbrImages  < 17  )  then
      matrixAcross = 4
      matrixDown   = 4
   ELSEIF ( nbrImages  < 26  )  then
      matrixAcross = 5
      matrixDown   = 5
   ELSE
      matrixAcross = 8
      matrixDown   = 5
   END if

   ' to get the size of a given grid cell, create a blank slide now
   ' and use its size as the reference.
   ' We will also use this slide as the first thumbnail slide.

   dim mySlide     = myPres.slides.add (atPage,12)              ' 12 = blank slide
   dim cellwidth   = myPres.PageSetup.SlideWidth  / matrixAcross
   dim cellheight  = ( myPres.PageSetup.SlideHeight - 20) / matrixDown

   ' I wanted the images to have some whitespace between them
   ' so each image is slightly smaller than the size of a grid cell.

   dim imagewidth   = myPres.PageSetup.SlideWidth  / (matrixAcross +1)
   dim imageheight  = myPres.PageSetup.SlideHeight / (matrixDown+1)

   dim objWIA = CreateObject("WIA.ImageFile")
   dim objIP  = CreateObject("WIA.ImageProcess")

   objIP.Filters.Add ( objIP.FilterInfos("Scale").FilterID )

   ' max size of resized image =  300*300 pixels    which is < 10 k bytes
   objIP.Filters(1).Properties("MaximumWidth").value   = 300
   objIP.Filters(1).Properties("MaximumHeight").value  = 300

   dim offsetHeight = (cellheight - imageheight) / 1
   dim offsetWidth  = (cellWidth  - imagewidth ) / 2

   myTxtBox = mySlide.Shapes.AddTextbox( 1 , offsetWidth  , cellheight * matrixDown  , cellwidth*matrixAcross  ,offsetHeight  )
   myTxtBox.TextFrame.TextRange.Text (baseFolder)
   myTxtBox.TextFrame.TextRange.Font.Size = 8

   cancelShow(1)
   canceltext ( nbrImages , 1 )

   > select  path , name , rid    from SubList  where    ext in
   freestring = freestring & ImageFileExtensions
   >>  order by name asc
   WITHQUERY (freestring )

      WITHQUERY ( freestring )

         IF ! ( imgNbr rem 10 )   then
            canceltext ( nbrImages - imgNbr , 2  )
         END if

         IF ( col == matrixAcross ) then
            row = row + 1
            IF ( row == matrixDown ) then
               row = 0
               atPage = atPage + 1
               mySlide = myPres.slides.add (atPage,12)  ' 12 = blank slide
               myTxtBox = mySlide.Shapes.AddTextbox( 1 , offsetWidth  , cellheight * matrixDown  , cellwidth*matrixAcross  ,offsetHeight  )
               myTxtBox.TextFrame .TextRange.Text (baseFolder)
               myTxtBox.TextFrame.TextRange.Font.Size = 8
            END if
            col = 0
         END If

         TRY
            deletefile (baseFolder & "pptimg.jpg" )
         END try

         objWIA.LoadFile ( wqtext(1) & wqtext(2) )
         myTxtBox = mySlide.Shapes.AddTextbox( 1 , cellwidth * col  , cellheight * row , cellwidth  ,offsetHeight  )

         iName ="E" & Right ( "0000000000" & wqtext(3) , 7 ) & "_" & wqtext(2)

         myTxtBox.TextFrame .TextRange.Text (iName)

         myTxtBox.TextFrame.TextRange.Font.Size = 8

         objWIA = objIP.Apply(objWIA)
         objWIA.SaveFile (  baseFolder & "pptimg.jpg" )
         oPic = mySlide.Shapes.AddPicture(baseFolder & "pptimg.jpg", False, True, offsetWidth + (cellwidth * col ),  offsetHeight  + (cellheight * row) )

         oPic.LockAspectRatio = -1

         IF (  ( oPic.rotation = 90 ) or ( oPic.Rotation = 270 ) ) then

            IF opic.height > imageWidth then
               opic.height = imagewidth
               if ( opic.width > imageHeight) then opic.width =  imageHeight
               opic.left  = opic.left - imagewidth
               opic.left  = offsetWidth + (cellwidth * col )
            ELSE
               opic.width = imageheight
               opic.left = opic.left - cellwidth
               if ( opic.height > imageWidth) then opic.height =  imageWidth
               opic.left  = opic.left + imagewidth
            END IF

         ELSEIF (   oPic.rotation = 180    ) then
            IF opic.height > opic.width then
               opic.height = imageheight
               if ( opic.width > imageWidth ) then opic.width =  imageWidth
            ELSE
               opic.width = imagewidth
               if ( opic.height > imageheight ) then opic.height =  imageheight
            END IF
            opic.top = offsetHeight  + (cellheight * row)
            opic.left  = offsetWidth + (cellwidth * col )
         ELSE
            IF opic.height > imageheight then
               opic.height = imageheight
               if ( opic.width > imageWidth ) then opic.width =  imageWidth
            ELSE
               opic.width = imagewidth
               if ( opic.height > imageheight ) then opic.height =  imageheight
            END IF

            opic.top = offsetHeight  + (cellheight * row)
            opic.left  = offsetWidth + (cellwidth * col )
         END if

         col = col + 1

         imgNbr = imgNbr  + 1

      END withQuery

      TRY
         deletefile (baseFolder & "pptimg.jpg" )
      END try

      
      myPres.saveas ( baseFolder & "ThumbNails.ppt")
      myPres.close


   myPPt.quit
    cancelShow(0)
 END Function
   
   
 
FUNCTION cbtoolsMenuDBExportThumbnails ( sobid )

   sob ( FileExportOvl   , "set" , "show" , 1)
   sob ( NbrFilesInFilter , "SET", "TITLE" , "" & exportFilter ( "statistic" ,  "" ,  ""    ) )

   sob ( SubListTitleSob, "set" , "title", "Create a file sublist for Thumbnails" )

   sob ( BtnExportFiles , "set", "Title" ,  "Export Thumbnails" )
   sob ( -1 , "ON" , "PRESS"    , "ExportThumbNails")

   sob ( BtnExportFiles  , "set" , "show" , 1 )
   sob ( BtnDeleteFiles  , "set" , "show" , 0 )

   sob ( PowerTaggingSob , "set" , "show" , 0 )

END Function

sob ( -1 ,"ON","CLICK", "cbtoolsMenuDBExportThumbnails")



' --------------
FUNCTION cbExportFileListToExcel ( sobid )

   IF ( ! isDBOpen ) then
      ErrorReport ("No database selected" )
      EXIT function
   END if

   dim ExlFile
   sob ( CommonSobResult, "empty"   )

   dim InitialExcelState
   IF ( isTable (  , "master") ) then

      SetFileFilter ( "EXCEL Files(*.xlsx)\0*.xl*\0All Files (*.*)\0*.*\0\0"   )
      ExlFile = getFile

      cancelClear ()
      cancelText( "Export a sublist to Excel" , 0 )
      cancelText( "Creating link to Excel" , 1 )
      cancelText( " " , 3 )
      cancelShow(1)

      InitialExcelState = xlActive
      IF ( ! xlRunning ) then
         xlopen ()
      ELSE
         dim myWb = exl.Workbooks.Add
      END IF

      cancelText( "Exporting SubList table, should be less than 60 seconds" , 1 )

      exl.ActiveSheet.name ="SubList"
      qrWriteToXL ( "select * from SubList")
      cancelText( "Formating SubList table, should be less than 60 seconds" , 1 )

      xlTableFormat ()
      exl.range(exl.cells(1,1),exl.cells(1,QRcols)).autofilter

      ' -----------------------------------------------------------
      cancelText( "Creating Admin sheet" , 1 )

      exl.worksheets.add().name = "Admin"

      exl.cells(1,1).value = "Content:"
      exl.Cells(2,1).value = "Source:"

      exl.Cells(3,1).value = "Generated:"

      exl.cells(1,2).value = "SubList table"
      exl.Cells(2,2).value =       sob ( statusDBFile, "GET" ,"TITLE"   )

      exl.Cells(3,2).value =  "'" & date & " " & time

      exl.Cells(9,1).value = "Generated using " & appName & " " & AppVersion
      exl.Cells(10,1).value = "Freeware, no installation, single file, < 5 Mbyte"
      exl.Cells(11,1).value = "www.PlodWare.com"
      exl.Cells(9,1).font.size = 8
      exl.Cells(10,1).font.size = 8
      exl.Cells(11,1).font.size = 8

      exl.cells.columns.autofit

      exl.cells.VerticalAlignment = -4108
      ' -----------------------------------------------------------

      cancelText( "Saving workbook to file" ,1 )

      exl.Application.DisplayAlerts = 0

      exl.ActiveWorkBook.saveas ( ExlFile , 50 )

      ' 50 = xlExcel12 (Excel Binary Workbook in 2007-2013 with or without macro's, xlsb)
      ' 51 = xlOpenXMLWorkbook (without macro's in 2007-2013, xlsx)
      ' 52 = xlOpenXMLWorkbookMacroEnabled (with or without macro's in 2007-2013, xlsm)
      ' 56 = xlExcel8 (97-2003 format in Excel 2007-2013, xls)
      ' ActiveWorkBook.close
      exl.Application.DisplayAlerts = 1

      exl.ActiveWorkbook.Close

      IF ( ! InitialExcelState ) then
         exl.quit
         set exl = nothing
      END IF

      sob ( CommonSobResult, "ADD" , "ROW" , "Database saved to: " & EOL & ExlFile   )

   ELSE

      sob ( CommonSobResult, "SET" , "TITLE" , "No open database"   )
   END IF
   cancelShow(0)

   toggleWarnColour ( sobid)
END function

FUNCTION onPushOpenFolder ( sobid )
   dim filename = sob ( FileListSob , "get", "title")

   if ( filename == "" ) then
     exit function
   END IF

' FileName field starts with "Internal" if file is in datatase


   currentFile = left ( filename, -10 )
   IF ( left ( filename , 2 ) == "In" ) then
      > SELECT path from master where path ||name like
      freestring = freestring & " " & sqlstring ( currentFile)
      sql(freestring )
      ShellExecute ( qrSingleValue)
   ELSE
      SELECT path from temp.inputFile
      ShellExecute ( qrSingleValue)
   END if

END function
' -----------------------------------------------------
' define the AREAs on the display

dim applicationArea = sob(appWindow,"ADD", "CONTAINER","COLUMN.W")

dim tmpSob, InsertWhere , DeleteWhere , InsertDeleteWhereSob

tmpSob = sob ( applicationArea , "ADD", "CONTAINER" , "ROW" )
sob ( -1 , "add" , "LABEL" , "DB File  "  )

dim statusDBFile   = sob(-1,"add","EDIT" ,   "   "  )
sob ( statusDBFile , "SET" ,"rw" ,  0 )

tmpSob = sob ( applicationArea , "add" , "container" , "row" )
sob ( tmpSob , "ADD" , "LABEL" , "File(s): " )
dim FileListSob = sob ( tmpSob , "add", "COMBO" ,"dropdown", "    " )
sob ( FileListSob , "set" , "stretch" , 1 )

sob ( tmpSob , "ADD" , "Button" , "push" , "Open folder" )
sob ( -1 , "ON" , "CLICK" , "onPushOpenFolder" )

sob ( tmpSob , "ADD" , "Button" , "push" , "Delete file" )
sob ( -1 , "ON" , "CLICK" , "onPushOfferFileDelete" )

' dim mainArea=    sob(applicationArea,"ADD", "CONTAINER","ROW.H")
dim mainArea=   sob ( applicationArea ,"ADD", "CONTAINER","PANEL.v", "   " ,1 )
dim mainLP  = sob( mainArea, "GET","PANEL.F")
dim mainRP  = sob( mainArea, "GET","PANEL.S")

sob ( mainRP ,"ADD", "CONTAINER","PANEL.h", "   " ,1 )
dim upperP  = sob( -1, "GET","PANEL.F")
dim lowerP  = sob( -1, "GET","PANEL.S")

sob ( lowerP,"ADD", "CONTAINER","PANEL.v", "   " , 1 )
dim lowMidArea  = sob( -1, "GET","PANEL.F")
dim lowRightArea  = sob( -1, "GET","PANEL.S")

' -----------------------------------------------------
' now assign CONTENT to these  areas

' -----------------------------------------------------

dim TagToolsOverlay  = sob ( mainLP,      "ADD", "container", "OVERLAY")

' each direct child of an OVERLAY container  overlaps one another

dim TagManageOvl     = sob ( TagToolsOverlay  ,"ADD", "container", "COLUMN.w")
dim FileExportOvl    = sob ( TagToolsOverlay  ,"ADD", "container", "COLUMN.w")
dim FileTaggingOvl    = sob ( TagToolsOverlay  ,"ADD", "container", "COLUMN")
dim CommonOvl = sob ( TagToolsOverlay  ,"ADD", "container", "COLUMN")
dim HelpFixedOvl = sob ( TagToolsOverlay  ,"ADD", "container", "COLUMN")

dim RemoveExternalDupsOvl   = sob ( TagToolsOverlay  ,"ADD", "container", "COLUMN")
dim RescanDatabaseOvl   = sob ( TagToolsOverlay  ,"ADD", "container", "COLUMN")
dim ScanNewFolderOvl   = sob ( TagToolsOverlay  ,"ADD", "container", "COLUMN")
dim DeleteOvl        = sob ( TagToolsOverlay  ,"ADD", "container", "COLUMN")

dim ExportOvl        = sob ( TagToolsOverlay  ,"ADD", "container", "COLUMN")
dim TagCommentOvl    = sob ( TagToolsOverlay  ,"ADD", "container", "COLUMN")
dim RubberBandOvl    = sob ( TagToolsOverlay  ,"ADD", "container", "COLUMN")

dim ImageGroupOvl    = sob ( TagToolsOverlay  ,"ADD", "container", "COLUMN")
dim ImageManagementOvl    = sob ( TagToolsOverlay  ,"ADD", "container", "COLUMN")

dim TagTxtOvl    = sob ( TagToolsOverlay  ,"ADD", "container", "COLUMN")
' -----------------------------------------------------

dim TagToolsArea     = sob ( TagManageOvl , "ADD", "CONTAINER", "COLUMN.W" )

dim ExtensionArea    = sob ( TagToolsArea , "ADD", "CONTAINER", "COLUMN.W" )
dim TagGroupContent  = sob ( TagToolsArea , "ADD", "CONTAINER", "COLUMN.W" )
dim TagTxtContent    = sob ( TagToolsArea , "ADD", "CONTAINER", "COLUMN.W" )
dim TagFtxtContent   = sob ( TagToolsArea , "ADD", "CONTAINER", "COLUMN.W" )

' -----------------------------------------------------
' populate:  StatusArea
' -----------------------------------------------------

dim StatusArea = sob ( upperP , "ADD", "CONTAINER" , "COLUMN.W" )

sob ("RGB","DEFAULT")

dim StatusCols = sob ( StatusArea , "ADD", "CONTAINER" , "COLUMN.W" )

sob ( StatusCols , "ADD", "CONTAINER" , "ROW" )

sob ( -1,"add","LABEL" ,   "Status   "  )
dim StatusTxt   = sob(-1,"add","LABEL" ,   "  "  )

FUNCTION ErrorReport ( txt )
   sob (StatusTxt,"SET" ,"TITLE" , "ERROR:  " & txt &  EOL )
   IF ( sob (StatusTxt,"GET", "RGB" ) =   ErrorCol ) then
      sob (StatusTxt,"SET", "RGB" , WarningCol )
   ELSE
      sob (StatusTxt,"SET", "RGB" , ErrorCol )
   END IF
END Function

FUNCTION NoErrorReport ( txt)
   sob (StatusTxt, "SET" , "TITLE" , txt &  EOL )
   sob (StatusTxt, "SET" , "RGB" , defStatusCol )
END Function

dim FileInfoSob = sob ( StatusArea , "add" , "container" , "column.h" )

' tmpSob = sob ( FileInfoSob , "add" , "container" , "row" )
' sob ( tmpSob , "ADD" , "LABEL" , "Hash     " )
' dim hashSob = sob ( tmpSob , "ADD" , "LABEL" , "                  " )

dim PathFile = sob(StatusArea,"add","Edit.rows" ,   "  ", 5 )

FUNCTION mcPathFile ( sobid, clickValue )
   report ( "click " & clickvalue )
END function

' sob ( pathFile,   "on" , "MOUSECLICKS" , "mcPathFile" )

' -----------------------------------------------------
' populate:  Tag Group Tools
' -----------------------------------------------------
sob ("RGB","DEFAULT")
FUNCTION UpdateTagNameList ( sobid  , TagType )

   sob( sobid   , "empty" )

   > select ttName from tagTable where ttGroup like $tag  order by  ttName asc
   freestring = replace ( freestring , "$tag" , sqlstring ( TagType & TagGroupId) )

   WITHQUERY ( freestring )
      sob( TagNameComboSOB   , "add" , "row" , wqText(1) )
   END withQuery

   sob( sobid , "SET", "SELECTION" , "ROW", 1 )

   > select ttComment from tagTable where ttGroup like $tag  order by  ttName asc  limit 1
   freestring = replace ( freestring , "$tag" , sqlstring ( TagType & TagGroupId) )
   sql (freestring)
   IF ( istype ( qrSingleValue) == "string" ) then
      sob( TagTxtField , "SeT", "TITLE", qrSingleValue )
   ELSE
      sob( TagTxtField , "SeT", "TITLE", "" )

   END IF
END FUNCTION

FUNCTION onTagGroupComboSel ( sobid , rowid )

   dim useRGB

   dim selTxt = sob ( sobid, "GET", "TITLE")

   sob ( TagGroupDoItSOB , "SET", "RGB"  , defBtnCol )
   sob ( TagNameDoItSOB  , "SET", "RGB"  , defBtnCol )
   sob ( TagTextDoItSOB  , "SET", "RGB"  , defBtnCol )

   IF ( selTxt == NoTag ) then

      sob ( TagNameComboSob , "set", "title" , ""   )
      sob ( TagTxtField , "set", "title" , ""   )

      sob ( TagNameNewNameSOB , "set", "title" , ""   )

   ELSE
      UpdateTagNameList (  TagNameComboSob , selTxt )

      dim actionTxt = sob ( TagGroupActionComboSob, "GET", "TITLE")

      IF ( actionTxt <> noTag ) then
         sob ( TagGroupDoItSOB , "SET", "RGB"  , rgb ( 0,255,0) )
      END IF

      actionTxt = sob ( TagNameActionComboSob, "GET", "TITLE")
      IF ( actionTxt <> noTag ) then
         sob ( TagNameDoItSOB  , "SET", "RGB"  , rgb ( 0,255,0) )

         sob ( TagNameNewNameSOB ,"SET", "RGB" , -1    )

         IF ( actionTxt <> "delete" ) theN
            sob ( TagNameNewNameSOB ,"SET", "RGB" , rgb ( 0x0ff, 0xa0, 0xa0 )    )
         END IF

      END IF

      actionTxt = sob ( TagTextActionComboSob, "GET", "TITLE")
      IF ( actionTxt <> noTag ) then
         sob ( TagTextDoItSOB  , "SET", "RGB"  , rgb ( 0,255,0) )
      END IF

      onEditedTagNameFilter ( TagNameFilterSOB , " " )

      IF ( sob ( TagNameActionComboSOB  , "GET", "TITLE") == "derive") then
         sob ( TagNameNewNameSOB , "set", "title" , sob( TagNameComboSOB , "GET", "title")   )
      END IF

   END IF

END FUNCTION

' ----------------------------------------------------------------------------

FUNCTION cbSelectFreeTextToolAction ( sobid, rowid )

   dim actionTxt = sob ( sobid , "GET", "TITLE" )
   dim TextTxt   = sob ( FreeTextToolCombo , "GET", "TITLE")
   Sob ( FreeTextToolDoItSob , "SET", "TITLE" , actionTxt )
   IF ( TextTxt == noTag ) then
      sob ( FreeTextToolDoItSob , "SET", "RGB" , defbtnCol )
   ELSE
      sob ( FreeTextToolDoItSob , "SET", "RGB" , rgb ( 0 , 255,0) )
   END if

END FUNCTION

FUNCTION cbFreeTextToolDoIt ( sobid )
   dim actionTxt = sob ( sobid , "GET", "TITLE" )
   dim newCol
   SELECT CASE   actionTxt

   CASE noTag
      EXIT function
   CASE "new"
      ' use SQLite  TRIM  function to remove spaces and tabs
      > select trim (
      freestring = freestring & " "   & sqlidentifier ( sob ( FreeTextToolEditSob , "GET", "TITLE")  )
      >>  , char(9) ||  ' ' )
      sql ( freestring )
      newCol =  qrSingleValue & FreeTxtId

      > select count (*)  from pragma_table_info ( 'master' ) where name like
      freestring = freestring & " "   & sqlidentifier ( newCol )

      sql ( freestring )
      IF ( qrSingleValue == 0 ) then

         > alter table master add  column
         freestring = freestring & " "   & sqlidentifier (newCol  )
         sql ( freestring )

         > update master  set
         freestring = freestring & " "   & sqlidentifier (newCol  )
         >> = ''
         sql ( freestring )

      ELSE
         ToggleWarnColour ( sobid )
         EXIT function
      END IF
   CASE "delete"
      > alter table master drop column
      freestring = freestring & " "   & sqlidentifier ( sob ( FreeTextToolCombo , "GET", "TITLE")  & FreeTxtId )
      sql ( freestring )

   CASE else
      ToggleWarnColour ( sobid )
      EXIT function

   END SELECT

   CreateUsersTagTableAndColumnsList ()
   ToggleOKColour ( sobid )

END FUNCTION

tmpSob = sob ( TagGroupContent , "ADD", "CONTAINER", "COLUMN.W")

sob ( tmpSob ,"add","LABEL"  ,   "Free Text Tool"  )
sob ( -1 , "SET" , "RGB" , 0x0ff00 )

tmpSob = sob ( tmpSob , "ADD", "CONTAINER", "ROW")

sob ( tmpSob , "add" , "COMBO" , "DROPDOWN" , "       " )
sob ( -1 , "add" , "ROW" , noTag )
sob ( -1 , "add" , "ROW" , "New" )
sob ( -1 , "add" , "ROW" , "Delete" )
sob ( -1 , "SET" , "SELECTION" , "ROW" , 1 )
sob ( -1 , "ON"  , "SELECTION" , "cbSelectFreeTextToolAction" )

dim FreeTextToolCombo = sob ( tmpSob , "add" , "COMBO"  ,   "DROPDOWN", defTypeComboText )

sob ( -1, "set", "stretch", 1 )

dim FreeTextToolDoItSob = sob ( tmpSob , "add" , "BUTTON" ,   "PUSH",   noTag )
sob ( -1 , "set" , "title" , noTag )
sob ( -1 , "ON" , "press"    , "cbFreeTextToolDoIt")

' --------------------
sob ( TagGroupContent , "ADD", "CONTAINER" , "ROW.h" )
sob ( -1 , "add" , "LABEL" , "New      " )
dim FreeTextToolEditSob = sob ( -1 , "add","edit" ,    "  "    )
sob ( -1 , "empty")

' -------------------------------

sob( TagGroupContent ,"add" ,"LABEL" ,   "Tag Group Tools"  )
sob ( -1 , "SET" , "RGB" , rgb ( 0 , 255 , 0 ) )

' -------------------------------

dim TagGroupToolsAreaTop = sob ( TagGroupContent , "ADD", "CONTAINER" , "ROW.h" )

dim TagGroupToolsArea = sob ( TagGroupToolsAreaTop , "ADD", "CONTAINER" , "COLUMN.hw" )

sob ( -1 , "SET", "STRETCH" , 1 )

' -------------------------------

sob ( TagGroupToolsArea , "ADD", "CONTAINER" , "ROW.h" )
sob ( -1,"add","LABEL", "Tag Group" )

dim   TagGroupComboSob = sob(-1,"add","COMBO" , "dropdown" , "       "    )
sob ( TagGroupComboSob , "ON", "SELECTION" ,  "onTagGroupComboSel")
' to automatically populate with Tag Group changes
isTagTypeCombo ( TagGroupComboSob  )

FUNCTION OnTagGroupActionComboSelect ( sobid , rowid)

   dim useRGB = defBtnCol

   sob ( TagNameDoItSOB ,"SET", "rgb" , useRGB  )
   sob ( TagNameNewNameSOB ,"SET", "RGB" , -1    )

   dim actionTxt =  sob ( TagGroupActionComboSob , "GET", "TITLE" )
   sob ( TagGroupDoItSob , "set", "title" ,  actionTxt )

   IF ( sob ( TagGroupComboSob , "GET", "TITLE" ) == noTag ) then
      EXIT function
   END IF

   IF ( actionTxt <> noTag ) then

      sob ( TagTextDoItSob ,"SET", "rgb" , rgb ( 0,255,0)    )

      IF ( actionTxt <> "delete" ) theN
         sob ( TagNameNewNameSOB ,"SET", "RGB" , rgb ( 0x0ff, 0xa0, 0xa0 )    )
      ELSE
         sob ( TagNameNewNameSOB ,"SET", "RGB" ,  -1    )
      END IF

   END IF

END Function

' -------------------------------

sob ( TagGroupToolsArea , "ADD", "CONTAINER" , "ROW.h" )
sob ( -1,"add","LABEL", "Action   " )
dim TagGroupActionComboSob     = sob(-1,"add","COMBO" , "dropdown" , defActionComboText    )
sob ( -1 , "add" , "row" , NoTag )
sob ( -1 , "add" , "row" , "new" )
sob ( -1 , "add" , "row" , "replace" )
sob ( -1 , "add" , "row" , "delete" )
sob ( -1 , "add" , "row" , "move" )
sob ( -1 , "SET" , "SELECTION",  "row" , 1 )
sob ( TagGroupActionComboSob , "ON" , "SELECTION" , "OnTagGroupActionComboSelect" )

' -------------------------------
sob ( TagGroupToolsArea , "ADD", "CONTAINER" , "ROW.h" )
sob(-1,"add","LABEL", "New      " )
dim TagGroupNewNameSOB = sob(-1,"add","edit" ,    "  "    )
sob (-1, "empty")

' -------------------------------
sob ( TagGroupToolsAreaTop , "ADD", "CONTAINER" , "COLUMN" )
dim TagGroupDoItSob = sob(-1,"add","BUTTON","PUSH", NoTag )

' -----------------------------------------------------
' populate:  Tag Name Tools
' -----------------------------------------------------
FUNCTION updateNewTagNameField ()

   dim actionTxt =   sob ( TagNameActionComboSOB , "GET", "TITLE" )
   sob ( TagNameDoItSOB ,"SET", "TITLE" , actionTxt  )

   IF ( sob ( TagGroupComboSob , "GET", "TITLE" )  ==  noTag )   then
      EXIT function
   END IF

   sob ( TagNameDoItSOB ,"SET", "RGB" , rgb (0,255,0)  )

   IF ( actionTxt ==  noTag ) then
      sob ( TagNameDoItSOB ,"SET", "RGB" , defbtnCol )
   ELSE
      sob ( TagNameDoItSOB ,"SET", "RGB" , rgb (0,255,0)  )
   END IF

   IF ( actionTxt == "derive"     ) then
      sob ( TagNameNewNameSOB , "set", "title" , sob( TagNameComboSOB , "GET", "title")   )
   END IF

END Function

FUNCTION onEditTagNameFilter ( sobid , editChr )
   IF ( editChr == escChr) then
      sob( sobid    , "EMPTY")
      sob( sob(sobid ,"SIBLING",  1) , "EMPTY")
   END IF
END FUNCTION

FUNCTION onEditedTagNameFilter ( sobid , editChr )
   ' for every character entered in to the filter box
   ' trigger an update of the related  tag Txt combo

   sob( TagTxtField , "SEt", "TITLE", "" )

   IF ( editChr == escChr) then
      sob( sobid    , "EMPTY")
      sob( sob(sobid ,"SIBLING",  1) , "EMPTY")
   ELSE

      dim useGroupCombo = TagGroupComboSob
      dim useTextCombo  = TagNameComboSob

      ' set the filter's COMBO   to be empty
      sob ( useTextCombo  ,"empty")

      ' get the TagType
      dim TagGroup     = sob( useGroupCombo, "GET" , "TITLE" )

      dim filterTxt = sob(sobid,"GET","TITLE")

      ' do not include any special (non-printable) character in the filter text

      IF ( editChr < 0x020 ) then
      ELSEIF ( editChr > 0x7e ) then
      ELSE
         filterTxt = filterTxt & chr(editChr)
      END IF

      IF (   isDBopen )  then
         ' find the matching  TAG  txts (yes allow > 1 )
         > select ttname from tagTable where ttGroup  like $Type   and ttName like '%' || $txt || '%'  order by ttName  asc
         freestring = replace ( freestring , "$Type"   ,  sqlIdentifier ( TagGroup & TagGroupId ) )
         freestring = replace ( freestring , "$txt"    ,  sqlString     ( filterTxt       ) )

         WITHQUERY (freestring)
            ' place the tag txts in the filter's   COMBO
            sob (  useTextCombo, "add", "row" , wqText(1))
         END withquery

      END if

      ' default is to select the first txt in the combo
      sob( useTextCombo , "SET", "SELECTION" , "ROW", 1 )
      dim tagName = sob ( useTextCombo , "GET", "TITLE")

      IF ( sob ( TagNameActionComboSOB  , "GET", "TITLE") == "derive") then
         sob ( TagNameNewNameSOB , "set", "title" , Tagname )

      ELSEIF ( sob ( TagNameActionComboSOB  , "GET", "TITLE") == NoTag) then
         '   sob ( TagNameNewNameSOB , "set", "title" , "" )
      END IF

      > select ttComment from tagTable where ttGroup like $tag  and ttName like  $name
      freestring = replace ( freestring , "$tag"  , sqlstring ( TagGroup & TagGroupId) )
      freestring = replace ( freestring , "$name" , sqlstring ( tagName  ) )
      sql ( freestring )
      IF ( isType ( qrsinglevalue) == "String") then
         sob( TagTxtField , "SEt", "TITLE", qrSingleValue )

      END IF

   END IF
   ' updateNewTagNameField ()
END FUNCTION

sob ( TagTxtContent ,"add" , "SPACE" ,   0 , 10   )
sob ( -1 , "SET" , "RGB" , 0x0ffffff )

sob ( TagTxtContent ,"add" , "LABEL" ,   "Tag Name Tools"  )
sob ( -1 , "SET" , "RGB" , rgb ( 0 , 255 , 0 ) )

dim TagNameAreaTOP = sob ( TagTxtContent , "ADD", "CONTAINER" , "ROW.h" )

dim TagNameArea  = sob ( TagNameAreaTOP , "ADD", "CONTAINER" , "COLUMN.HW" )
sob ( -1 , "SET", "STRETCH" , 1 )

sob ( TagNameArea , "ADD", "CONTAINER" , "ROW.h" )
sob ( -1 , "add" ,"LABEL", "Filter   " )

dim TagNameFilterSOB =  sob (-1 , "Add" , "edit" , "           " )
sob (-1 , "empty")
sob (-1 , "ON","EDIT"   ,   "onEditTagNameFilter" )
sob (-1 , "ON","EDITED" ,   "onEditedTagNameFilter" )

sob ( TagNameArea , "ADD", "CONTAINER" , "ROW.h" )
sob ( -1,"add","LABEL", "Tag Name " )

dim TagNameComboSob  = sob(-1,"add","COMBO" , "dropdown" , "  "   )

FUNCTION TagNameComboSelect ( sobid , rowid )
   updateNewTagNameField ()
END Function

sob ( TagNameComboSob , "ON" , "SELECTION" , "TagNameComboSelect" )

sob ( TagNameArea , "ADD", "CONTAINER" , "ROW.h" )
sob(-1,"add","LABEL", "Action   " )

dim TagNameActionComboSOB     = sob(-1,"add","COMBO" , "dropdown" , "     "    )
sob ( -1 , "add" , "row" , NoTag )
sob ( -1 , "add" , "row" , "new" )
sob ( -1 , "add" , "row" , "derive" )
sob ( -1 , "add" , "row" , "rename" )
sob ( -1 , "add" , "row" , "delete" )
sob ( -1 , "add" , "row" , "move" )
sob ( -1 , "SET" , "SELECTION", "ROW" , 1)

sob ( TagNameArea , "ADD", "CONTAINER" , "ROW" )
sob(-1,"add","LABEL", "New      " )
dim TagNameNewNameSOB = sob(-1,"add","edit" ,    "  "    )
sob (-1, "empty")

FUNCTION OnTagNameActionComboSelect ( sobid , rowid )

   updateNewTagNameField ()

END Function

sob ( TagNameActionComboSOB , "ON" , "SELECTION" , "OnTagNameActionComboSelect" )

dim TagNameDoItSOB = sob ( TagNameAreaTOP ,"add","BUTTON","PUSH", NoTag )

' -----------------------------------------------------
' populate:  Tag Text Tools
' -----------------------------------------------------

sob( TagFtxtContent ,"add" ,"SPACE" ,   0 , 10   )
sob ( -1 , "SET" , "RGB" , 0x0ffffff )
sob( TagFtxtContent ,"add","LABEL" ,   "Tag Text Tools"  )
sob ( -1 , "SET" , "RGB" , rgb ( 0 , 255 , 0 ) )

dim TagTextAreaTop = sob ( TagFtxtContent , "ADD", "CONTAINER" , "ROW" )
dim TagTextArea = sob ( TagTextAreaTop , "ADD", "CONTAINER" , "COLUMN.HW" )
sob ( -1 , "SET", "STRETCH" , 1 )

sob ( TagTextArea , "ADD", "CONTAINER" , "ROW.h" )
sob(-1,"add","LABEL", "Action   " )

FUNCTION onTagTextActionComboSob ( sobid , rowid )

   dim actionTxt = sob ( TagTextActionComboSob , "get", "title")
   sob ( TagTextDoItSOB , "set", "title" , actionTxt)

   IF ( sob ( TagGroupComboSob , "get", "title") == NoTag ) then
      EXIT function
   END if

   IF ( actionTxt == notag ) then
      sob ( TagTextDoItSOB , "set", "rgb" , defBtnCol )
   ELSE
      sob ( TagTextDoItSOB , "set", "rgb" , rgb(0,255,0) )

   END if

END function

FUNCTION onTagTextDoit ( sobid  )

   IF  ( (  sob(sobid,"GET" , "TITLE" ) == NoTag )  or  (  sob(sobid,"GET" , "TITLE" ) == "" ) )   then
      EXIT function
   END IF

   IF ( ! isDBopen  ) then
      ErrorReport ("No database selected" )
      EXIT function
   END IF

   dim tagType    = sob ( TagGroupComboSob  , "GET" , "TITLE" )
   dim tagName    = sob ( TagNameComboSob  , "GET" , "TITLE" )
   dim tagComment = sob ( TagTxtField    , "GET" , "TITLE" )

   dim actionTxt = sob ( TagTextActionComboSob , "GET" , "TITLE" )

   IF ( actionTxt  == "show" ) then
      > select    ttComment from tagTable WHERE   ttGroup like $tagType and ttName like $tagTxt
      freestring = replace ( freestring , "$tagType"   ,  sqlString     ( tagType & TagGroupId ) )
      freestring = replace ( freestring , "$tagTxt"  ,  sqlString     ( tagName )  )
      sql ( freestring )
      sob ( PathFile , "SET" , "TITLE" , qrSingleValue )

   ELSE
      IF ( actionTxt  == "clear" ) then
         tagComment = ""
         sob ( TagTxtField    , "empty" )
      END IF

      > UPDATE tagTable SET ttComment = $ftxt WHERE   ttGroup like $tagType and ttName like $tagTxt
      freestring = replace ( freestring , "$ftxt"     ,  sqlString ( tagComment ) )
      freestring = replace ( freestring , "$tagType"  ,  sqlString ( tagType & TagGroupId ) )
      freestring = replace ( freestring , "$tagTxt"   ,  sqlString ( tagName ) )
      sql ( freestring )

   END IF

   toggleWarnColour ( TagTextDoItSOB )

END FUNCTION

FUNCTION onTagfTxtSelect ( sobid, rowid )

   dim actionTxt = sob( sobid, "GET", "ROW", rowid )
   sob ( TagTextDoItSOB , "SET", "TITLE" , actionTxt  )

   IF ( actionTxt == NoTag ) then
      sob ( TagTextDoItSOB , "SET", "RGB" , defTextCol  )
   ELSE
      sob ( TagTextDoItSOB , "SET", "RGB" , RGB ( 0xff ,0,0 )  )

   END if

END function

dim TagTextActionComboSob     = sob(-1,"add","COMBO" , "dropdown" , "       "    )

sob ( -1 , "ADD" , "ROW" , NoTag )
' sob ( -1 , "ADD" , "ROW" ,"show" )
sob ( -1 , "ADD" , "ROW" ,"edit" )
sob ( -1 , "ADD" , "ROW" ,"clear" )
sob ( -1 , "SET" , "SELECTION", "ROW" , 1)
sob ( -1 , "ON" , "SELECTION", "onTagTextActionComboSob")

' ------------------

sob ( TagTextAreaTop , "ADD", "CONTAINER" , "ROW" )

dim TagTextDoItSOB = sob ( -1 ,"add","BUTTON","PUSH", NoTag )

sob ( -1 , "on" , "press" , "OnTagTextDoit")

sob ( TagFtxtContent , "ADD", "SPACE", 0,10)
sob ( -1 , "SET" , "RGB" , 0x0ffffff )
' sob ( TagTextArea , "ADD", "CONTAINER" , "ROW" )
dim TagTxtField = sob (TagFtxtContent, "ADD" , "Edit.rows",  "  " , 3 )

' -----------------------------------------------------
' populate:  upper right
' -----------------------------------------------------

' -----------------------------------------------------
' IMAGE things
' -----------------------------------------------------

dim XY = 5
dim maxThumbNailIndex = 8
dim i

' -----------------------------------------------------
' IMAGE MANAGEMENT
' -----------------------------------------------------
' sob ( ImageManagementOvl , "SET", "SHOW", 1 )

dim ImageMngmtArea     = sob ( ImageManagementOvl , "ADD", "CONTAINER", "COLUMN.W" )
dim ImageMngmtInfo = sob ( ImageMngmtArea, "ADD", "LABEL", "" )

tmpSob= sob ( ImageMngmtArea , "ADD", "CONTAINER", "row.W" )

' -------------------------------------------------
sob ( tmpSob , "ADD", "BUTTON" , "PUSH" , "<<-" )
FUNCTION startImageMngnt ( sobid )
   ImageMngmtBase =  0
   ImageMngmtDisplay ()
END FUNCTION
sob ( -1 , "ON"  , "click" , "startImageMngnt" )
' -------------------------------------------------
sob ( tmpSob , "ADD", "BUTTON" , "PUSH" , "<--" )
FUNCTION prevImageMngnt ( sobid )
   ImageMngmtBase =  ImageMngmtBase -  ImageMngmtDisplayRows - ImageMngmtDisplayRows
   ImageMngmtDisplay ()
END FUNCTION
sob ( -1 , "ON"  , "click" , "prevImageMngnt" )
' -------------------------------------------------

sob ( tmpSob , "ADD", "LABEL" , "from" )
sob ( -1 , "set" , "rgb" , -1 )
dim ImageMngmtFrom = sob ( tmpSob , "ADD", "LABEL" , "   " )

sob ( tmpSob , "ADD", "LABEL" , "to" )
sob ( -1 , "set" , "rgb" , -1 )
dim ImageMngmtTo = sob ( tmpSob , "ADD", "LABEL" , "   " )

sob ( tmpSob , "ADD", "LABEL" , "of" )
sob ( -1 , "set" , "rgb" , -1 )
dim ImageMngmtOf = sob ( tmpSob , "ADD", "LABEL" , "   " )

' -------------------------------------------------
sob ( tmpSob , "ADD", "BUTTON" , "PUSH" , "-->" )
FUNCTION nextImageMngnt ( sobid )
   ImageMngmtDisplay ()
END FUNCTION
sob ( -1 , "ON"  , "click" , "nextImageMngnt" )
' -------------------------------------------------

sob ( tmpSob , "ADD", "BUTTON" , "PUSH" , "->>" )
FUNCTION EndImageMngnt ( sobid )
   SELECT max(rowid) from ImageMngmtTbl
   ImageMngmtBase = qrSingleValue - ImageMngmtDisplayRows
   ImageMngmtDisplay () 
END FUNCTION
sob ( -1 , "ON"  , "click" , "EndImageMngnt" )
' -------------------------------------------------
' sob ( -1 , "SET", "STRETCH" , 0  )

dim scrolledImageMngmt  = sob ( ImageMngmtArea , "ADD", "CONTAINER" , "BOX.SCROLLED", "  ",20)

dim siImageMngmtMatrix     = sob ( scrolledImageMngmt, "ADD", "CONTAINER", "matrix.c" , 5)

FUNCTION cbOnImageMngmtThumbnail ( sobid )

   report ( sob(sobid, "get", "data"))

   > select path from Master where rowid =
   freestring = freestring & " " &  sob(sobid, "get", "data")
   WITHQUERY ( freestring )
      ShellExecute (    wqText(1 )   )
   END withquery

END FUNCTION

' --------------------------------------------------------------------------------------------------
' apply a POPUP menu to the Image Management
' --------------------------------------------------------------------------------------------------

FUNCTION CBpopupImageMngmtOpenFolder ( sobid )

   dim rid = sob(siTriggeringThumbNail, "get", "data")

   if ( ! rid ) then exit function

   > select path from Master where rowid =
   freestring = freestring & " " &  rid
   WITHQUERY ( freestring )
      ShellExecute (    wqText(1 )   )
   END withquery

END FUNCTION

sob (OnImageMngmtPopUp , "add", "menu","Vertical", "Open Folder")
sob (   -1     ,  "ON"   ,  "CLICK"  , "CBpopupImageMngmtOpenFolder")

' -------------------------------------------------
 
FUNCTION CBpopupImageMngmtDetails ( sobid )

   dim ridA = sob(siTriggeringThumbNail, "get", "data")

   dim SizeA, FileA , pHash , dHash
   > select path ||name , pHash , dHash , size from master where rowid  =
   freestring = freestring & " " & ridA
   WITHQUERY ( freestring )
      FileA = wqtext(1)

      SizeA = wqInt (4)
   END withquery

   dim txt = ""
   IF ( ! isFile (  FileA )  ) then
      txt =  "    File does not exist "  &   FileA
      sob ( ImageMngmtInfo , "SET" , "TITLE",  txt )
      EXIT function
   END if


   sob (TagInfo, "empty")
 

   dim tmptxt

   tmptxt  =  right("000000" & ridA,6)
  
   txt = txt & tmptxt
   
   
   tmptxt  =  right( "00000" &  CANVAS ( "IMAGE.FILE", "GET" , "WIDTH"  , FileA )  , 5 )
    txt = txt & tmptxt   
   
   
   
   tmptxt  =  right( "00000" &  CANVAS ( "IMAGE.FILE", "GET" , "HEIGHT"  , FileA )  , 5 )
    txt = txt & "/" & tmptxt   
   
 
   txt =  txt & "    "   & FileA
   sob ( ImageMngmtInfo , "SET" , "TITLE",  txt )
   
   


   dim sipmatrix = SOB ( siTriggeringThumbNail ,"GET" , "PARENT"    )
'   dim ChildCnt  = SOB ( sipmatrix , "CHILD" , "COUNT"  )   
   dim colNbr    = SOB ( siTriggeringThumbNail , "GET" , "COLUMN.NUMBER"   )
   dim Col00     = sob ( siTriggeringThumbNail , "SIBLING", -1*(colNbr-1) )
   dim RoC       = sob ( sipmatrix , "GET", "DIMENSION")
   
   dim i 
   dim tmpSob , rid
   
   
      sob (TagInfo,"add", "row" , "row: "  & EOL )

   sob (TagInfo,"add", "row" , "rowid   width   height"  & EOL )

   for i = 1 to abs(RoC)
       tmpSob = sob ( Col00 , "SIBLING", i - 1 )
       rid =  sob ( tmpSob   , "get", "data")
       If ( rid ) then

         > select path ||name , num2Hex( pHash ) , num2Hex( dHash ) , size from master where rowid  =
         freestring = freestring & " " & rid 
         WITHQUERY ( freestring )
            FileA = wqtext(1)
            pHash = wqText(2)
            dHash = wqText(3)            
         END withquery
         
         tmptxt  =  right("000000" & rid ,6)
         sob (TagInfo,"add", "row" ,  tmptxt  & "  " )
         
         tmptxt  =  right( "00000" &  CANVAS ( "IMAGE.FILE", "GET" , "WIDTH"  , FileA )  , 5 )
         sob (TagInfo,"add", "row" ,   tmptxt   )
         sob (TagInfo,"add", "row" , "   "   )
         tmptxt  =  right( "00000" &  CANVAS ( "IMAGE.FILE", "GET" , "HEIGHT"  , FileA ) , 5 )
         sob (TagInfo,"add", "row" , tmptxt  )

         sob (TagInfo,"add", "row" , "   "  & pHash  )
         sob (TagInfo,"add", "row" , "   "  & dHash  )



         sob (TagInfo,"add", "row" ,   tmptxt  & EOL )
      end if
 
   next i
 
END function 
 
 
sob (OnImageMngmtPopUp , "add", "menu","Vertical", "Details")
sob (   -1     ,  "ON"   ,  "CLICK"  , "CBpopupImageMngmtDetails")

' -------------------------------------------------

FUNCTION CBpopupImageToTagger ( sobid )

   dim rid = sob(siTriggeringThumbNail, "get", "data")

   > select path||name from Master where rowid =
   freestring = freestring & " " &  rid
   SilentSQL ( freestring )
   cbSingleFile   (   qrSingleValue   )

END FUNCTION

sob (OnImageMngmtPopUp , "add", "menu","Vertical", "To Tagger")
sob (   -1     ,  "ON"   ,  "CLICK"  , "CBpopupImageToTagger")

' -------------------------------------------------

FUNCTION CBpopupImageIgnore ( sobid )

   dim rid = sob(siTriggeringThumbNail, "get", "data")

   > Update Master
   >>   set  IgnoreFile = 1 
   >> where  rowid =
   freestring = freestring & " " &  rid
   SilentSQL ( freestring )
   
   > delete from  ImageMngmtTbl
   >> where  SelfA =
   freestring = freestring & " " &  rid
   SilentSQL ( freestring )
  
   ImageMngmtBase = ImageMngmtBase  - ImageMngmtDisplayRows
   ImageMngmtDisplay () 

END FUNCTION

sob (OnImageMngmtPopUp , "add", "menu","Vertical", "Ignore Image")
sob (   -1     ,  "ON"   ,  "CLICK"  , "CBpopupImageIgnore")


' -------------------------------------------------

' --------------------------------------------------------------------------------------------------

FUNCTION cbImageMngmtMOUSECLICKS ( sobid, clickId )
   ' right mouse button  clickid = 7

   if ( clickid <> 7 ) then exit function

   dim ridA = sob ( sobid , "GET" , "DATA" )
   if ( ! ridA )   then exit function

   siTriggeringThumbNail = sobid

   sob(OnImageMngmtPopUp,"SET","POSITION", sob ( appWindow , "get" , "cursor.x" ),  sob ( appWindow , "get" , "cursor.y" ) )
   sob ( OnImageMngmtPopUp , "SET", "SHOW" , 1 )
 

END function

FOR   i = 1 to 35
   tmpSob = sob (siImageMngmtMatrix , "ADD","image.holder",0 ,50,75    )
   sob ( tmpSob , "ON"  , "click"      , "cbOnImageMngmtThumbnail" )
   sob ( tmpSob , "ON"  , "MOUSECLICKS", "cbImageMngmtMOUSECLICKS")
NEXT i

' sob( ImageMngmtArea ,"add" ,"SPACE" ,   0 , 10   )
' sob ( -1 , "SET" , "RGB" , 0x0ffffff )

' -----------------------------------------------------
' IMAGE GROUP
' -----------------------------------------------------

dim ImageGroupArea     = sob ( ImageGroupOvl , "ADD", "CONTAINER", "COLUMN.W" )

dim myConA  = sob ( ImageGroupArea, "ADD", "CONTAINER", "column.w")

SOB ( "OVERRIDE" , "STYLE" , 0x052000300) ' force style of next LABEL to be left justified
dim RefInfo   = sob ( myConA , "ADD", "LABEL" , " ")
SOB ( "OVERRIDE" , "STYLE" , 0x052000300) ' force style of next LABEL to be left justified
dim TarInfo   = sob ( myConA , "ADD", "LABEL" , " ")

dim ImageGroupWH  = sob ( myConA , "ADD", "CONTAINER" , "COLUMN.HW", "  ",10)

' ---------------------------

FUNCTION cbOnThumbNail ( sobid )
   if ( ! sob ( sobid, "get" , "data")  ) then exit function

   dim fName
   > select    path||name   from master where rowid =
   freestring = freestring & " " &  sob ( sobid, "get" , "data")
   WITHQUERY ( freestring )
      fName = wqText(1)
   END withquery
   cbSingleFile ( fName )

END function

dim siTriggeringThumbNail

' ---------------------------------------------
sob (OnImagePopUpSimilar , "add", "menu","Vertical", "Open Folder")

FUNCTION CBpopupOpenFolder ( sobId )

   > select path from Master where rowid =
   freestring = freestring & " " &  sob ( siTriggeringThumbNail , "GET", "DATA")
   WITHQUERY ( freestring )
      ShellExecute (    wqText(1 )   )
   END withquery
END function
sob (   -1     ,  "ON"   ,  "CLICK"  , "CBpopupOpenFolder")
sob (OnImagePopUpGroup , "add", "menu","Vertical", "Open Folder")
sob (   -1     ,  "ON"   ,  "CLICK"  , "CBpopupOpenFolder")

' ---------------------------------------------

sob (OnImagePopUpGroup , "add", "menu","Vertical", "Remove from Image Group")

FUNCTION CBpopupRemoveFromGroup ( sobId )

   dim xSelf =    sob ( siTriggeringThumbNail , "GET", "DATA")
   dim zSelf =    sob ( siGroup00             , "GET", "DATA")

   removeImageXfromGroupZ ( xSelf, zSelf )
     
   ' ----------------------------------------------------
removeAllThumbNails (  )
   GetCopies ( zSelf  )

END function

sob (   -1     ,  "ON"   ,  "CLICK"  , "CBpopupRemoveFromGroup")
' ---------------------------------------------
' ---------------------------------------------

sob (OnImagePopUpSimilar , "add", "menu","Vertical", "Add to Image Group")

FUNCTION CBpopupAddToGroup ( sobId )
   ' get the GROUP of the reference thumbnail

   dim ImageGroup

   dim PromotedRowid = sob ( siTriggeringThumbNail , "GET", "DATA")

   > select hash from master where rowid =
   freestring = freestring & " " &  PromotedRowid
   SilentSQL (freestring )
   dim PromotedHash   = qrSingleValue

   ' ------------------------------------------------------------------
   > select ImageGroup from master  where rowid   =
   freestring = freestring & " " &  sob ( siGroup00 , "GET", "DATA")
   WITHQUERY (freestring )
      ImageGroup =  wqText(1)
   END withquery
   ' ------------------------------------------------------------------

   > update master  set  ImageGroup =
   freestring = freestring & " " &  sqlString(ImageGroup)
   >> , ImageGroupType = 'near-identical'
   >>   where rowid =
   freestring = freestring & " " &  PromotedRowid
   SilentSQL (freestring )

   ' by ADDING this IMAGE to a group we might have promoted a single member to a GROUP

   IF ( !  sob ( sob ( siGroup00 , "SIBLING", 1)  , "GET", "DATA" )  ) then

      > update master  set  ImageGroup =  num2hex(phash) || num2hex(dHash)
      >> , ImageGroupType = "unknown"
      >> where rowid =
      freestring = freestring & " " & sob ( siGroup00 , "GET", "DATA")
      SilentSQL (freestring )

   END if

   WITHQUERY ( "select *  from temp.masterColumns  ")

      > update
      >> master
      >> SET
      >>   $col = ( select $col from Master where hash =
      freestring = freestring & " " & sqlString ( CurrentHash)
      >>  )
      >> WHERE
      >>   hash =
      freestring = freestring & " " & sqlString ( PromotedHash)
      sql (replace ( freestring , "$col", sqlIdentifier ( wqtext(1) )  ) )

   END WithQuery

   removeAllThumbNails (  )
   GetCopies ( currentRowid )

END function

sob (   -1     ,  "ON"   ,  "CLICK"  , "CBpopupAddToGroup")
' ---------------------------------------------

FUNCTION cbImageGroupMOUSECLICKS ( sobid, clickId )
   ' right mouse button  clickid = 7

   if ( clickid <> 7 ) then exit function

   if ( ! sob ( sobid , "GET" , "DATA" ) )   then exit function

   dim ridA  = sob ( siGroup00, "get" , "data")
   dim txt = ""
   dim distance
   dim FileA , pHashA , dHashA , CanvasA
   dim FileB , pHashB , dHashB , CanvasB

   > select path ||name , pHash , dHash  from master where rowid  =
   freestring = freestring & " " & ridA
   WITHQUERY ( freestring )
      FileA = wqtext(1)
      pHashA = wqInt(2)
      dHashA = wqInt(3)
   END withquery

   dim ridB = cint(sob ( sobid , "GET" , "DATA" ))
   > select path||name  , pHash , dHash  from master where rowid  =
   freestring = freestring & " " & ridB
   WITHQUERY ( freestring )
      FileB = wqtext(1)
      pHashB = wqInt(2)
      dHashB = wqInt(3)
   END withquery

   IF ( ! isFile (  FileB )  ) then
      txt =  "    File does not exist "  &   FileB
      sob ( TarInfo , "SET" , "TITLE",  txt )
      EXIT function
   END if
   txt =  right("000000" & ridB,6)
   txt =  txt & "  pHD=" &  right( "00" & popCount ( pHashA  bxor   pHashB ) , 2 )
   txt =  txt & "  dHD=" &  right( "00" & popCount ( dHashA  bxor   dHashB ) , 2 )

   txt =  txt & "    "   &  right( "00000" &  CANVAS ( "IMAGE.FILE", "GET" , "WIDTH"  , FileB )  , 5 )
   txt =  txt & "/"      &  right( "00000" &  CANVAS ( "IMAGE.FILE", "GET" , "height" , FileB )  , 5 )
   txt =  txt & "    "   & FileB
   sob ( TarInfo , "SET" , "TITLE",  txt )

   siTriggeringThumbNail = sobid
   sob(OnImagePopUpSimilar,"SET","POSITION", sob ( appWindow , "get" , "cursor.x" ),  sob ( appWindow , "get" , "cursor.y" ) )

   IF (   ( siGroup00 < siMatrix00) and ( sobid < siMatrix00 ) ) then
      sob(OnImagePopUpGroup,"set","show",1)
   ELSEIF (   ( siGroup00 < siMatrix00)  ) then
      sob(OnImagePopUpSimilar,"set","show",1)
   ELSEIF (   ( siMatrix00 <  siGroup00  ) and ( sobid < siGroup00 ) ) then
      sob(OnImagePopUpSimilar,"set","show",1)
   ELSE
      sob(OnImagePopUpGroup,"set","show",1)

      endif

   END function

dim siImageGroup     = sob ( ImageGroupWH, "ADD", "CONTAINER", "matrix.c" , 3)

' ---------------------------

FUNCTION onFileDrop  ( sobid )

   IF ( GetDropCount > 1 ) then
      EXIT function
   END if
   dim rid = 0

   > select rowid as selfA , * from MASTER where (path||name)  like
   freestring = freestring & " " & sqlstring ( getDropData ( 1 ) )
   WITHQUERY ( freestring )
      rid = wqInt(1 )
   END withquery

   IF ( rid == 0 ) then
      EXIT function
   END IF

   dim i , siTmp
   dim freeCell = -1
   ' ------------------------------------------
   ' find empty cell in  matrix of POTENTIAL matches

   FOR i = 0 to maxThumbNailIndex
      siTmp = sob ( siMatrix00 ,   "SIBLING", i )
      IF  ( !  sob ( siTmp ,"GET","data"   ) )   then
         freeCell = siTmp
         EXIT FOR
      END IF

   NEXT i

   sob (  freeCell ,"set" ,  "image" , getDropData ( 1 ) )
   sob ( siTmp ,"SET","data"  , rid )
   CreateTargetReport ( siTmp )
END function

dim siImageMatrix     = sob ( ImageGroupWH, "ADD", "CONTAINER", "matrix.c" , 3)

dim siMatrix00    = sob (siImageMatrix , "ADD","image.holder",0 ,XY,XY    )

sob ( siMatrix00 , "ON"  , "MOUSECLICKS", "cbImageGroupMOUSECLICKS")
sob ( siMatrix00 , "ON"  , "click" , "cbOnThumbNail" )
' sob ( siMatrix00 , "ON"  , "DROP.FILE", "onFileDropXX")
sob ( siMatrix00 ,"SET","data"  , 0 )

FOR   i = 1 to maxThumbNailIndex
   tmpSob = sob (siImageMatrix , "ADD","image.holder",0 ,XY,XY    )
   sob ( tmpSob , "ON"  , "click" , "cbOnThumbNail" )
   sob ( tmpSob , "ON"  , "MOUSECLICKS", "cbImageGroupMOUSECLICKS")
   '   sob ( tmpSob    , "ON"  , "DROP.FILE", "onFileDrop")
   sob ( tmpSob ,"SET","data"  , 0 )
NEXT i

' ---------------------------

sob ( siImageGroup , "ON"  , "DROP.FILE", "onFileDrop")

dim siGroup00    = sob (siImageGroup , "ADD","image.holder",0 ,XY,XY    )
sob ( -1 , "ON"  , "MOUSECLICKS", "cbImageGroupMOUSECLICKS")
sob ( -1 , "ON"  , "click" , "cbOnThumbNail" )
FOR   i = 1 to maxThumbNailIndex
   tmpSob = sob (siImageGroup , "ADD","image.holder",0 ,XY,XY    )
   sob ( tmpSob , "ON"  , "click" , "cbOnThumbNail" )
   sob ( tmpSob , "ON"  , "MOUSECLICKS", "cbImageGroupMOUSECLICKS")
NEXT i

' ---------------------------

FUNCTION ResetImageGroups ()

   drop table if exists temp.matches

   cancelText( "Create temporary table for image comparisons" , 1 )

   >  create  temp  table matches  as
   >>   select rowid as selfA
   >>   ,  path as PathA ,  name as NameA
   >>   , size
   >>   , "" as PathB , "" as NameB  ,   0 as selfB

   >>   , pHash as xHash  , 99 as xHamming
   >>   , 99 as pHamming , 99 as dHamming
   >>   , pHash as pHashA ,  dHash as dHashA
   >>   , 0 as pHashB ,  0 as dHashB
   >>   , ImageNearness , 0 as Nbr
   >>   ,  (num2hex(phash) || num2hex(dHash))   as  ImageGroup
   >>   , 'unknown'  as  ImageGroupType
   >>   from
   >>      master
   >>   where
   >>      IgnoreFile = 0
   >>      and  ext in
   freestring = freestring & " " & ImageFileExtensions
   sql(freestring)

   ' ------------------------------------------------------------------

   ' now update the  MATCHES table for each  ROWID
   ' BUT note that we exclude from the results it's   selfA
   ' SO   ImageNearness    talks about its neighbours excluding itself!  IMPORTANT

   cancelText( "Run images through BK-Tree:about 1 second per 1000 images" , 1 )

   ' this cost virtual nothing < 1 second
   drop table if exists temp.xHashTbl
   MakeBkTree ( )

   > update matches set ImageNearness =
   >>     eval (' select  substr ( "0000" || count(*)  , -4 ) , substr ( "0000" || min (distance), -4 )   , link  from xHashTbl ( ' || xHash  || ',
   freestring = freestring & " " &   maxHD
   >>          )  where not link =  ' || selfa  || '
   >>          order by distance asc limit 1'    )
   sql(freestring)

   > update
   >>  matches
   >>  set
   >>    SelfB    =      cast(substr ( ImageNearness,  -1*(length(ImageNearness) - 10 )   )as int )
   >> ,  xHamming =      cast(substr ( ImageNearness,6,4) as int )
   >> ,  nbr      =      cast(substr ( ImageNearness,1,4) as int )
   >>  WHERE
   >>     not ImageNearness is null
   sql(freestring)

   > update
   >>  matches
   >>  set
   >>    pHashB = frmTbl.pHash
   >> ,  dHashB = frmTbl.dHash
   >>  FROM
   >>  ( select rowid, * from master where  IgnoreFile = 0 ) as frmTbl
   >>  WHERE
   >>  matches.selfB = frmTbl.rowid
   sql(freestring)

   > update
   >>  matches
   >>  set
   >>     pHamming =      popcount (   XOR ( pHashA , pHashB) )
   >>  ,  dHamming =      popcount (   XOR ( dHashA , dHashB) )
   >> WHERE
   >>   selfb > 0
   sql(freestring)

   ' ------------------------------------------------------------------
   ' has NO neighbours within a pHash distance of    maxHD

   > update
   >>  matches
   >>  set
   >>    ImageGroupType = 'unique'
   >>  WHERE
   >>     selfB = 0
   sql(freestring)

   ' ------------------------------------------------------------------
   ' has   neighbours with  a  pHash  distance of 0 ,  so are identical/duplicates
   ' but be careful: we might have
   '   root image  + a duplicate + near-identicals
   ' or
   '   root image  + a duplicate + 0 or more duplicates   +  0 or more near-identicals
   ' SO  only call it a duplicate  if pHash distance = 0   AND    NBR = 1 

   > update
   >>  matches
   >>  set
   >>    ImageGroupType = 'duplicatE'
   >>  WHERE
   >>     selfB > 0  and xHamming = 0  and dHamming = 0  and nbr = 1
   sql(freestring)

   ' ------------------------------------------------------------------

   > update
   >>   matches
   >> SET
   >>   Imagegroup =  frmTbl.Imagegroup
   >> , ImageGroupType = 'near-identicaL'       
   >>  FROM
   >>  ( select pHashA , ImageGroup from matches where  selfB > 0  and xHamming = 0  and dHamming between 1 and 17  and nbr = 1 ) as frmTbl
   >> WHERE    
   >>  matches.pHashA  = frmTbl.pHashA 
   >> and  matches.selfB > 0  and matches.xHamming = 0  and matches.dHamming between 1 and 17  and matches.nbr = 1
   silentSQL ( freestring)

   ' ------------------------------------------------------------------
   ' even if the pHash is low, if the dHamming is > 18 then it is highly likely to be DIFFERENT
   ' note: only doing this if NBR = 1

   > update
   >>  matches
   >>  set
   >>     ImageGroupType = 'different'
   >>  WHERE
   >>     selfB > 0  and  dHamming > 18   and nbr = 1
   sql(freestring)

   ' ---------------------------------------------------------------------------------------------
   ' handle the NEAR-IDENTICALs , first do the easy case   NBR = 1

   cancelText( "Simple near-identical" , 1 )

   > update
   >>   matches
   >> SET
   >>    Imagegroup = frmtbl.ImageGroup
   >>  , ImageGroupType = 'near-Identical'
   >> FROM
   >>  ( select selfA , selfB , ImageGroup from matches where NBR = 1   AND ImageGroupType ='unknown' ) as frmTbl
   >> WHERE
   >>       matches.selfA  in ( frmTbl.selfA , frmTbl.selfB )
   >>  AND  matches. ImageGroupType ='unknown'
   sql ( freestring )

   ' ---------------------------------------------------------------------------------------------
   ' handle the NEAR-IDENTICALs ,   do the COMPLEX  case   NBR > 2

   cancelText( "Complex near-identical" , 1 )

   dim selfA , pHashA , dHashA , ImgGroup , selfB , pHashB , dHashB
   dim pHamming , dHamming

   SilentSQL ("drop table if exists temp.singleImageGroup ")

   SilentSQL (" create temp table singleImageGroup    ( selfB, pHashB, pHamming, dHashB, dHashA , dHamming ) ")

   > select selfA, pHashA , dHashA , Imagegroup    from matches where  ImageGroupType ='unknown'
   WITHQUERY ( freestring )

      selfA  = wqInt (1)
      pHashA = wqInt (2)
      dhashA = wqInt (3)
      ImgGroup = wqtext(4)

      ' get   neighbours of target based on  pHash
      SilentSQL ("  delete from singleImageGroup ")

      > insert into singleImageGroup
      >>  select   link , metric , distance,0,0,0 from xHashTbl (
      freestring = freestring & " " &     pHashA
      >> ,
      freestring = freestring & " " &  12 '  pHD
      >>  )   WHERE not   link   =
      freestring = freestring & " " &  selfa
      sql(freestring)

      > update    singleImageGroup set
      >>   dHashB =  ( select dHash from master where rowid = singleImageGroup.selfB)
      >> , dHashA =
      freestring = freestring & " " &  dHashA
      sql(freestring )

      SilentSQL (" update    singleImageGroup set  dHamming =   popcount ( xor ( dHashA , dHashb ) )")
      SilentSQL (" delete from     singleImageGroup where   dHamming > 17 ")

      > select  selfb  from singleImageGroup limit 1
      WITHQUERY ( freestring)

         > update  matches  set ImageGroup  =
         freestring = freestring & " "  & sqlString(ImgGroup )
         >>  , ImageGroupType = 'near-iDentical' 
         >> WHERE
         >>  selfA  in (
         freestring = freestring & " "  & selfA
         >> ,
         freestring = freestring & " "  & wqInt(1)
         >> )
         >>  AND   ImageGroupType ='unknown'
         sql(freestring)

      END withquery

   END withquery

   ' ---------------------------------------------------------------------------------------------
   ' anything still not handled is because it has a neighbour with acceptable pHash
   ' BUT its dHamming distance is too big

   >  update  matches 
   >> set ImageGroupType = 'diFferent'
   >> where    ImageGroupType ='unknown'

   SilentSQL( freestring)

   ' ---------------------------------------------------------------------------------------------

   > UPDATE
   >>   master
   >> SET
   >>   ImageNearness   = frmTbl.ImageNearness 
   >> , ImageGroup      = frmTbl.ImageGroup 
   >> , ImageGroupType  = frmTbl.ImageGroupType

   >> FROM
   >>   ( select * from matches ) as frmTbl
   >> WHERE
   >>   master.rowid = frmTbl.selfa
   sql ( freestring )

END function

' -----------------------------------------------------
' populate:  upper right
' -----------------------------------------------------
' FILE EXTENSIONS

sob ("RGB","DEFAULT")

FUNCTION extensionCheck ( haveExt )
   extensionCheck = 0
   dim i

   IF ( extArray(0)  == "*" ) then
      extensionCheck = 1
      EXIT function
   END if

   FOR i = 0 to uBound ( extArray )
      IF ( haveExt ==  extArray(i) )  then

      END IF
   NEXT i

END function

FUNCTION onExtensionSelectEdited ( sobid, txt )

   dim extList    = txt

   extList = toLower ( extList )
   extList = replace ( extList, " " , ""  )
   redim  extArray = split ( extList , ",")

END FUNCTION

FUNCTION onExtensionSelect ( sobid, rowid )

   dim extList    = sob(sobid,"GET","ROW" , rowid)
   extList = toLower ( extList )
   extList = replace ( extList, " " , ""  )
   redim  extArray = split ( extList , ",")
END FUNCTION

dim extArray =   split ("*", ",")

' -----------------------------------------------------------------------

sob ("RGB","DEFAULT")

' -----------------------------------------------------------------------

FUNCTION populateCombo ( sobId , typeTag )

   sob( soBid, "empty")
   IF (   isDBopen )  then

      > select ttname from tagTable where ttGroup like $tag  order by  ttname asc
      freestring = replace ( freestring , "$tag" , sqlstring ( typeTag) )
      WITHQUERY (freestring)
         sob ( sobid, "add", "row" , wqText(1))
      END withquery
      sob( sobid , "SET", "SELECTION" , "ROW", 1 )
   END IF

   freestring = ""
END FUNCTION

FUNCTION populateActionCombo (sobId)

   ' these are the actions that can be applied to
   ' to the database

   sob( sobid , "add" , "row" , NoTag )
   sob( sobid , "add" , "row" , "add" )
   sob( sobid , "add" , "row" , "replace" )
   sob( sobid , "add" , "row" , "remove" )
   sob( sobid , "add" , "row" , "remove ALL" )
   sob( sobid , "SET", "SELECTION" , "ROW", 1 )

END FUNCTION

' -----------------------------------------------------
' populate:  lower middle
' -----------------------------------------------------

dim TagInfoCol   = sob ( lowMidArea, "ADD" ,"CONTAINER", "COLUMN.W"   )

dim  TagInfo = sob(TagInfoCol ,"add","Edit.rows" ,   "    ", 2)
font("RESET")
font("SET" ,"FaceName" , "Courier New" )
dim myFont = Font("CREATE")
sob ( TagInfo , "SET", "FONT" , myFont )

' -----------------------------------------------------
' populate:  lower right
' -----------------------------------------------------

' -----------------------------------------------------
' File Text
' -----------------------------------------------------
FUNCTION makeExternalFileList (  UpOrDown )
       
  ' lazy way to get PATH  
  ' because we give it a FULL   path/file name then dbFileList
  '   returns only 1 entry
  dbFileList ( "temp" , "externalFolder", currentFile) 
  
  ' now use the PATH  to get a full list of the FOLDER & sub folders
  select path from temp.externalFolder
  dbFileList ( "temp" , "externalFolder", qrSingleValue)
  
 
  > select rowid from  externalFolder where path||name =
  freestring = freestring & sqlString ( currentFile ) 
  sql ( freestring )
  dim rowid = qrSingleValue
  
  if ( UpOrDown ) then
  
       > select (path || name ) from externalFolder where type  like 'file' and rowid >
      freestring =   freestring  & " " &  rowid
      >> order by rowid asc limit 1
      sql ( freestring  )
      
      if  ( istype ( qrSinglevalue) == "EMPTY" ) then
         > select (path || name ) from externalFolder where type  like 'file' 
         >> order by rowid asc limit 1
         sql ( freestring )
      END IF
      
      makeExternalFileList = qrSinglevalue
  ELSE
  
      > select (path || name ) from externalFolder where type  like 'file' and rowid <
      freestring =   freestring  & " " &  rowid
      >> order by rowid desc limit 1
      sql ( freestring  )
      
      if  ( istype ( qrSinglevalue) == "EMPTY" )  then
         > select (path || name ) from externalFolder where type  like 'file' 
         >> order by rowid desc limit 1
         sql ( freestring )
      END IF
      
      makeExternalFileList = qrSinglevalue
 
  
  
  
  END IF
  
       
END Function


FUNCTION cbOnPressPlus ( sobId )
   IF ( currentFile = "" ) then
            EXIT function
   END if
       
   dim filename = sob ( FileListSob , "get", "title")

   if ( filename == "" ) then
     exit function
   END IF

   IF ( left ( filename , 2 ) == "Ex" ) then
         ' the currentFile is not in the DB
         ' so assume is in an external
         cbSingleFile (  makeExternalFileList ( 1 )  )
         exit function  
   END IF  
 
      > select rowid from master where (path || name ) like
      freestring =   freestring  & " " &  sqlstring ( currentFile)
      sql ( freestring )
      
      dim rowid = qrSingleValue
      
      > select (path || name ) from master where type  like 'file' and rowid >
      freestring =   freestring  & " " &  rowid

      >> order by rowid asc limit 1
      sql ( freestring )
 
      cbSingleFile ( qrSingleValue)
      
END Function

FUNCTION cbOnPressReload ( sobid )
   IF ( currentFile = "" ) then
            EXIT function
   END if



   cbSingleFile ( currentFile)
END Function

FUNCTION cbOnPressMinus ( sobId )

   IF ( currentFile = ""  ) then
            EXIT function
   END if
   
     dim filename = sob ( FileListSob , "get", "title")

   if ( filename == "" ) then
     exit function
   END IF



   currentFile = left ( filename, -10 )
   IF ( left ( filename , 2 ) == "Ex" ) then
         ' the currentFile is not in the DB
         ' so assume is in an external
         cbSingleFile (  makeExternalFileList ( 0 )  )
         exit function  
   END IF
   

      > select rowid from master where (path || name ) like
      freestring = freestring & " " &   sqlstring ( currentFile)
      sql ( freestring )
      IF ( istype ( qrSinglevalue) == "EMPTY" ) then
         > select rowid from master where hash like
         freestring = freestring & " " &   sqlstring ( currentHash)
         sql ( freestring )
      END IF

      IF ( istype ( qrSinglevalue) == "EMPTY" ) then
         EXIT function
      END if

      dim rowid = qrSingleValue
      ' > select (path || name ) from master where type  like 'file' and rowid < ## order by rowid desc limit 1
      > select (path || name ) from master where type  like 'file' and rowid <
      freestring = freestring & " " &   rowid
      >>   order by rowid desc limit 1

      sql ( freestring )
      cbSingleFile ( qrSingleValue)



END Function

' -----------------------------------------------------

FUNCTION CreateRectInfoFrom (  ColName , lTagDelim  )

   dim loopflag, Rect, name , hit
   dim rLeft , rTop ,  rRight , rBottom

   IF ( ! isDBcolumn ( "master", ColName) ) then
      '      sob (TagRect,"add", "row" ,"fail 1 "  & " " & colName & EOL )
      EXIT function
   END if

   ' ------------------------------------------------------
   ' get the Faces=rect64(....    text

   > select
   freestring = freestring & " " &         sqlIdentifier ( ColName  )
   >>       from master where hash =
   freestring = freestring & " " &         sqlString ( CurrentHash  )
   >>  limit 1

   sql = freestring
   dim LookIn = qrSingleValue

   IF (  LookIn = "" ) then
      ' sob (TagRect,"add", "row" ,"DB failure: " & freestring  & EOL )
      EXIT function
   END if

   ' ------------------------------------------------------
   ' get the Faces=rect64(....    text
   '  report ( "look in "  &  LookIn )
   dim pos ,  TagGroup = ""
   LOOPFLAG = inStr ( Lookin , "rect64(" , 0)

   DO while loopFlag
      LOOPFLAG = inStr ( Lookin , "rect64(" , 0)
      Lookin = left ( lookin , -1* ( loopflag + length("rect64(")  - 1 )   )

      Rect =   left ( Lookin ,  inStr ( Lookin , ")" , 0) - 1  )

      LookIn = left ( LookIn , -1 * (Length(Rect)+2)  )
      LOOPFLAG = inStr ( Lookin , ";rect" , 0)
      IF ( loopFlag ) then
         Name =  left ( Lookin , loopFlag  )
      ELSE
         name = right( Lookin , -1)
      END IF

      ' Convert a   RECT string   into  Pixel locations of the  Left,Top   and   Right,Bottom  coordinates

      rBottom =  CNumeric (   "0x0" & right (        Rect ,   4 ) )
      rRight  =  CNumeric (   "0x0" & left  ( right( Rect ,   8 ) , 4  ) )
      rTop    =  CNumeric (   "0x0" & left  ( right( Rect ,  12 ) , 4  ) )

      rLeft   =  CNumeric (   "0x0" & right (        Rect , -12 ) )

      rRight  = ( 100 * rRight  ) / 0x010000
      rBottom = ( 100 * rBottom ) / 0x010000
      rLeft   = ( 100 * rLeft   ) / 0x010000
      rTop    = ( 100 * rTop    ) / 0x010000

      DO while ( right(name,1) == ";")
         name = right(name,-1)
      LOOP
      DO while ( left(name,1) == ";")
         name = left(name,-1)
      LOOP
      name = trim ( name )
      TagGroup = ""

      IF ( lTagDelim == "" ) then
         TagGroup ="Who"

      ELSE
         '   report ( "zz " & length(lTagDelim)  & "  " &  name )

         IF ( pos := instr ( name , lTagDelim )  ) then
            ' expect a leading delim

            '       report ( "BB " & length(lTagDelim)  & "  " &  name )

            pos := instr ( name , lTagDelim )

            '          report ( "CC " & pos & "  " &  name )
            TagGroup = left ( name , pos - 1    )

            name = left ( name , -1 * (pos + length(lTagDelim ) - 1)    )
            '      report ( "DD " &  name  &  "   " & length(name)&  "   " & length(TagGroup)  )
         END if
      END if
      > insert into tblRectList values (
      freestring = freestring & sqlString ( ColName )  & " , "     '  rlSrc
      freestring = freestring & sqlString ( TagGroup)  & " , "     '  rlTagGroup
      freestring = freestring & sqlString ( name    )  & " , "     '  rlTagName
      freestring = freestring & sqlString ( rect    )  & " , "     '  rlRect

      freestring = freestring &  rLeft     & " , "     '  rlLeft
      freestring = freestring &  rTop      & " , "     '  rlTop
      freestring = freestring &  rRight    & " , "     '  rlRight
      freestring = freestring &  rBottom   & " , "     '  rlBottom

      freestring = freestring &  0         & " , "     '  rlHit
      freestring = freestring &  0         & " ) "     '  rlId

      sql ( freestring )

   LOOP

END function

FUNCTION cbImageHitStatus (  PerCentX , PerCentY   )

   ' does this X,Y (as percentages) lie inside a REGION
   ' we want to set the  HIT status per REGION  to 1 , else 0

   ' default HIT status to  0 = X,Y  not in a REGION

   update temp.tblRectList set rlHit = 0

   ' now find the HIT(s)
   > update temp.tblRectList set rlHit = 1 where
   >>       not   rlLeft >
   freestring = freestring & PerCentx
   >>  and  not   rlRight  <
   freestring = freestring & PerCentx

   >>  and  not   rlTop >
   freestring = freestring & PerCentY
   >>  and  not   rlBottom  <
   freestring = freestring & PerCentY
   sql (freestring )

   ' if we have a HIT on a region, and the region is in RectMeta   AND  RectPicasa  then
   ' reset the RectPicas to no hit. So  RectMeta has priority

   > update temp.tblRectList set rlHit = 0 where rlSrc like 'RectPicasa' and rlRect In
   >> ( select rlRect from temp.tblRectList  where not  rlHit = 0 and  rlSrc like 'RectMeta' )
   sql ( freestring )

END FUNCTION

FUNCTION cbSelectOneRect ( sobid , rowid )

   ' input parameter   rowid  tells us which row of the COMBO has been selected
   ' can NOT use the row's text because it might not be unique
   ' The COMBO   WAS populated in sequence !

   IF ( ! imageLoadedFlag ) then
      EXIT function
   END IF

   sob ( TagCommentEdit , "empty")

   ' we are assuming that there is atleast 1 HIT
   ' and that this Function would not otherwise have been called

   dim HitTagGroup, HitTagName , HitRect , HitComment

   > select rlTagGroup , rlTagName , rlRect  from tblRectList where not rlHit  =  0    order by rowid asc limit 1 offset
   freestring = freestring & " " & (rowid-1)

   WITHQUERY ( freestring)
      ' careful, use   like   and not  =  because we have not strictly ensured the  Tag Group case !

      HitTagGroup = wqText(1)
      HitTagName = wqText(2)
      HitRect = wqText(3)

   END WITHQuery

   > select ttComment from tagTable where ttGroup like
   freestring = freestring & " " &         sqlString ( HitTagGroup & TagGroupId  )
   >> and ttName like
   freestring = freestring & " " &         sqlString ( HitTagName  )
   sql ( freestring )

   sob (TagCommentEdit,"add", "row" ,  qrSingleValue & EOL )

   sob (TagCommentEdit,"set", "row" , "top" , 0 )

   sob ( lblRegionUpdateComment , "SET" , "TITLE" , "" )
   sob ( lblRegionUpdateComment , "SET", "RGB", defBoxTxtCol )

   ' ------------------------------------------------------------------------------
   ' show all Rects in their default RGB

   fncShowRegions ()

   ' ------------------------------------------------------------------------------
   ' now set the HOT  Rectangle to have the appropriate RGB

   dim CanvasHandle = SOB(  sobImageHolder , "GET" , "CANVAS" )
   canvas( CanvasHandle , "SET" , "pen", "rgb", RegionRectRGBa)
   canvas( CanvasHandle , "SET" , "pen", "width", 16)

   dim imW = canvas ( CanvasHandle , "get" , "width" )
   dim imH = canvas ( CanvasHandle , "get" , "height" )

   displayRect ( CAnvasHandle , HitRect  , imw , imh )

END function

FUNCTION  fnOfferRectChoice ()

   ' we are assuming that this function was called with atleast one HIT RECT
   '--------------------
   IF ( HaveRubberBandRect ) then
      EXIT function
   END if

   '--------------------

   ' for now  set  all REGION  labels   to green
   SetLblRegionRGB ( rgb(0,255,0) )

   '--------------------
   ' add each HIT RECT to the COMBO
   dim hitCount = 0
   WITHQUERY ( "select rlTagName from tblRectList where not   rlHit = 0  order by rowid asc ")
      sob ( TagRectCombo , "add" , "row" , wqText(1) )
      hitCount = hitCount + 1
   END withQuery

   '--------------------

   IF ( hitCount == 0 ) then

   ELSEIF ( hitCount == 1 ) then
      sob ( lblRegionSelection ,"set", "title" , "Comment associated with a region" )
      sob ( -1 , "SET" , "RGB" , 0x0ff00 )
   ELSE
      sob ( lblRegionSelection ,"set", "title" , "Multiple Regions (select one)" )
      sob ( -1 , "SET" , "RGB" , 0x0ff )
   END if

   ' select, and trigger  the FIRST hit item
   sob( TagRectCombo   , "SET", "SELECTION"  , "ROW" , 1 )
   sob( TagRectCombo   , "TRIGGER" )

   cbSelectOneRect ( TagRectCombo , 1 )

END function

FUNCTION displayRect ( CanvasHandle , Rect , imw , imh )

   dim RectY , RectX , RectYY , RectXX
   RectYY  =  CNumeric (   "0x0" & right (        Rect ,   4 ) )
   RectXX  =  CNumeric (   "0x0" & left  ( right( Rect ,   8 ) , 4  ) )
   RectY   =  CNumeric (   "0x0" & left  ( right( Rect ,  12 ) , 4  ) )
   RectX   =  CNumeric (   "0x0" & right (        Rect , -12 ) )

   RectX =  cint ( ( RectX  * imW )  / 0x010000 )
   RectY =  cint ( ( RectY  * imH )  / 0x010000 )
   RectXX = cint ( ( RectXX * imW )  / 0x010000      - RectX)
   RectYY = cint ( ( RectYY * imH )  / 0x010000      - RectY)

   canvas ( CanvasHandle ,"RECTANGLE" , RectX , RectY , RectXX, RectYY)

END FUNCTION

FUNCTION fncShowRegions ()

   IF ( ! imageLoadedFlag ) then
      EXIT function
   END IF

   '--------------------
   ' erase any RECT on the image (including  any rubberband)

   dim CanvasHandle = SOB(  sobImageHolder , "GET" , "CANVAS" )
   IF (  CanvasHandle ) then
      canvas ( CanvasHandle , "FLOOD" , TransparentRGB )
   END if

   '--------------------
   ' obey user selection menu option

   IF ( ! RegionRectShow ) then
      EXIT function
   END IF

   '--------------------

   dim Rect

   dim imW = canvas ( CanvasHandle , "get" , "width" )
   dim imH = canvas ( CanvasHandle , "get" , "height" )

   canvas ( CanvasHandle , "SET", "BRUSH", "GLASS")
   canvas ( CanvasHandle , "SET", "PEN", "width" , RegionRectWeight)
   canvas ( CanvasHandle , "SET", "pen", "style", 0) ' solid line

   ' ---------------------------------------------------------
   ' draw RECTs which have a TAG i.e. not the default tag

   canvas ( CanvasHandle ,"SET", "PEN", "RGB" , RegionRectRGBn)

   WITHQUERY ( "select rlRect from tblRectList where   not rlTagName like    '%fffffffffffffff%'  " )
      Rect = wqText(1)
      displayRect ( CaNvasHandle , Rect , imW , imH )
   END WithQuery

   ' ---------------------------------------------------------
   ' draw RECTs which have no TAG  i.e.  the default tag
   ' except the current selected Rect

   canvas ( CanvasHandle ,"SET", "PEN", "RGB" , RegionRectRGBu  )

   WITHQUERY ( "select rlRect from tblRectList where   rlTagName like    '%fffffffffffffff%'   " )
      Rect = wqText(1)

      > select count (*) from tblRectList where not rlTagName like    '%fffffffffffffff%'   and rlRect =
      freestring = freestring & " " &         sqlString ( Rect  )
      sql(freestring )

      IF ( qrSingleValue == 0 ) then
         displayRect ( CanVasHandle , Rect, imW , imH )
      END if

   END WithQuery

END Function

FUNCTION cbImageRubberBand  ( sobid , xTL , yTL , xBR  , yBR )
   ' WARNING
   '   xTL , yTL , xBR  , yBR are screen co-ordinates
   '   and NOT CANVAS co-ordinates
   '   report (  xTL & " " & yTL & "          " & xBR  & " " & yBR )

   IF ( ! isDBOpen ) then
      ErrorReport ("No database selected" )
      EXIT function<
   END if

   IF ( ! imageLoadedFlag ) then
      EXIT function
   END IF

   ' remove any previous Rubberband Rect
   ' and show RECTs in their default RGB

   fncShowRegions ()

   ' ----------------------------------------------------------------------
   ' display the new RubberBand Rect
   dim CanvasHandle = SOB(  sobImageHolder , "GET" , "CANVAS" )

   dim Rect
   dim RectY , RectX , RectYY , RectXX

   dim sobW = sob ( sobImageHolder , "image" , "width" )
   dim sobH = sob ( sobImageHolder , "image" , "height" )

   IF   ( xBR >   sobW )   then
      xBR =   sobW
   END if
   IF (   yBr > sobH )  then
      yBr =  sobH
   END if

   dim imW = canvas ( CanvasHandle , "get" , "width" )
   dim imH = canvas ( CanvasHandle , "get" , "height" )

   RectX =  cint ( ( xTL * imW) / sobW )
   RectY =  cint ( ( yTL * imH) / sobH )

   RectXX = cint ( ( xBR * imW) / sobW ) - RectX
   RectYY = cint ( ( yBR * imH) / sobH ) - RectY

   leftRB = RectX
   topRB = RectY
   rightRB = RectXX
   bottomRB = RectYY

   sob ( RubberBandEdit , "add" , "row" , leftRB & " "  & topRB   & " "  &  rightRB  & " "  & bottomRB & EOL )

   canvas ( CanvasHandle ,"SET", "BRUSH", "GLASS")
   canvas ( CanvasHandle ,"SET", "PEN", "width" , RegionRectWeight)

   canvas ( CanvasHandle ,"SET", "PEN", "RGB" , 0x0ff)
   canvas ( CanvasHandle ,"RECTANGLE" , RectX , RectY , RectXX, RectYY)

   ' ----------------------------------------------------------------------
   ' need the Tag Comment Overlay page to be visible to allow us
   ' to assign a tag group / tag name  to the rubberband RECT

   sob ( TagCommentOvl   , "set" , "show" , 1)

   HaveRubberBandRect = 1
   sob (TagRectCombo , "EMPTY")
   sob (TagCommentEdit,"empty")

   SetLblRegionRGB ( rgb(0,255,0) )

END FUNCTION

FUNCTION CreateRectInfo ()
 
   ' empty the table that will hold all of the   rect64   information
   delete from temp.tblRectList

   if ( haveRectMeta ) then CreateRectInfoFrom ( "RectMeta"  , tagDelim )
   if ( haveRectPicasa ) then CreateRectInfoFrom ( "RectPicasa" , ""  )

END function

FUNCTION cbImagePress ( sobid )

   IF ( ! isDBOpen ) then
      ErrorReport ("No database selected" )
      EXIT function
   END if

   IF ( ! imageLoadedFlag ) then
      EXIT function
   END IF

   HaveRubberBandRect = 0

   fncShowRegions ()

   dim imW = sob ( sobid , "image" , "width" )
   dim imH = sob ( sobid , "image" , "height" )

   dim posX = sob ( sobid , "get" , "cursor.x" )
   dim posY = sob ( sobid , "get" , "cursor.y" )

   dim PerCentX = ( posX * 100) / imW
   dim PerCentY = ( posY * 100) / imH

   ' only need PerCentX  and PerCentY to go on

   sob (TagCommentEdit,"empty")

   '  sob ( TagCommentOvl   , "set" , "show" , 1)

   cbImageHitStatus (  PerCentX , PerCentY  )

   sob ( TagRectCombo , "EMPTY")

   SELECT count (*) from tblRectList where not  rlHit =  0
   IF ( qrSingleValue ) then
      sob ( TagCommentOvl   , "set" , "show" , 1)

      fnOfferRectChoice ()
   ELSE
      SetLblRegionRGB ( defBtnCol )
   END IF

END FUNCTION

dim ImagePanelSob = sob ( lowRightArea ,"ADD" ,"CONTAINER" , "column.w")

dim ImagePanelRow = sob ( ImagePanelSob,"ADD" ,"CONTAINER" , "row")

dim inheritSob = sob ( ImagePanelRow , "ADD" , "Button" , "push" , "drop to inherit")

FUNCTION onInheritDrop ( sobid )

   dim fileCount
   IF   (  sob(sobid,"GET" , "TITLE" ) == NoTag )    then
      EXIT function
   END IF

   IF ( ! isDBopen  ) then
      sob( PathFile , "ADD" , "ROW" , "No Database Selected."  & chr(0x0a)  )
      EXIT function
   END IF

   dim actionType , TagType , TagTxt

   CreateDoppedFileList ()

   dim i , hasHash , inDir , hasExt

   SELECT count (*) from temp.bulk where type  like 'file'
   fileCount = qrSingleValue

   cancelText( "Tagging in progress" , 1 )
   cancelText( "This can take a short while" , 3 )
   cancelText( "Files to process: " & FileCount , 2 )
   cancelShow(1)

   WITHQUERY ( "select *  from temp.masterColumns  ")

      > update
      >> master
      >> SET
      >>   $col = frmTbl.$col
      >> FROM
      >>   ( select $col from temp.masterFIle ) as frmTbl
      >> WHERE
      >>  master.hash in ( select hash from temp.bulk)
      freestring = replace ( freestring , "$col", sqlIdentifier ( wqtext(1) )  )
      sql (freestring )

   END WithQuery
   cancelShow(0)

   toggleWarnColour ( sobid )

END function

sob ( -1 , "ON"  , "DROP.FILE", "onInheritDrop")

' ------------------------------------

FUNCTION CBdropFileMenuReload ( sobid )

   IF ( ! imageLoadedFlag ) then
            EXIT function
   END if
   

   dim i

   cbSingleFile ( "" )

   noErrorReport ("")
   IF ( GetDropCount > 1 ) then
      ErrorReport("Only one drop file allowed" )
      EXIT function
   END if

   dim pathName = getDropData ( 1 )
   ' extract the filename.ext

   dim fileName = left ( pathName , -1 * (InStrRev ( pathName , "\\" ) ) )

   ' remove leading E
   IF ( left( filename,1) <> "E" ) then
      ErrorReport ("Dropped file not previously exported" )
      EXIT function
   END if

   filename = left( filename,-1)

   ' extract the rowid
   dim rid  = left ( filename ,  InStr ( filename , "_" ) -1     )
   filename = left ( filename ,  -1 *  ( InStr ( filename , "_" ) ))

   >select name from master  where rowid =
   freestring = freestring & " " & rid
   sql(freestring )

   IF ( istype ( qrsingleValue) == "String" ) then
      IF (  qrsingleValue  == filename ) then
         >select path from master  where rowid =
         freestring = freestring & " " & rid
         sql(freestring )
         ShellExecute ( qrSingleValue)

         >select path||name from master  where rowid =
         freestring = freestring & " " & rid
         sql(freestring )
         cbSingleFile ( qrSingleValue)

         EXIT function
      END IF
   END IF

   ErrorReport ( "Dropped file not in database" )
END FUNCTION

dim PlusMinusRow = sob ( ImagePanelRow ,  "ADD", "CONTAINER" , "ROW" )

sob ( PlusMinusRow , "ADD", "SPACE" , 10,0 )
sob ( -1 , "SET" ,"RGB" , -1 )

sob ( PlusMinusRow, "ADD", "BUTTON" , "PUSH" , "<--" )
sob( -1 , "ON", "PRESS" , "cbOnPressMinus" )

sob ( PlusMinusRow, "ADD", "BUTTON" , "PUSH" , "reload" )
sob ( -1 , "ON", "PRESS" , "cbOnPressReload" )
sob ( -1 , "SET" , "Stretch" , 1 )
sob ( -1 ,  "ON" ,  "drop.file"  , "CBdropFileMenuReload")

sob ( PlusMinusRow, "ADD", "BUTTON" , "PUSH" , "-->" )
sob ( -1 , "ON", "PRESS" , "cbOnPressPlus" )

sob ( PlusMinusRow , "ADD", "SPACE" , 10,0 )
sob ( -1 , "SET" ,"RGB" , -1 )

' ------------------------------------

FUNCTION CBpopupCopy ( sobid )

   SELECT rlTagGroup from tblRectList where not  rlHit =  0
   copyTagGroup = qrSingleValue

   SELECT rlTagName from tblRectList where not  rlHit =  0
   copyTagName  = qrSingleValue

END Function

FUNCTION CBpopupPaste ( sobid )
   ' update the current REGION with the tag group/tag name
   ' that we COPIED from an earlier REGION

   dim oldTagGroup , oldTagName , thisRect

   > SELECT rlTagGroup , rlTagName  , rlRect  from tblRectList where not  rlHit =  0
   WITHQUERY ( freestring )
      oldTagGroup = wqText(1)
      oldTagName  = wqText(2)
      thisRect  = wqText(3)
   END WITHQUERY

   dim oldEntry = "rect64(" & thisRect & "),"  & oldTagGroup & TagDelim & oldTagName & ";"
   dim newEntry = "rect64(" & thisRect & "),"  & copyTagGroup & TagDelim & copyTagName & ";"

   IF ( haveRectMeta ) then
      > update Master  set RectMeta   = replace(RectMeta,
      freestring = freestring & " " &         sqlString ( ":" & oldEntry)
      >> ,
      freestring = freestring & " " &         sqlString ( newEntry )
      >>   ) where hash like
      freestring = freestring & " " &         sqlString ( currentHash  )
      sql ( freestring )

      > update Master  set RectMeta   = replace(RectMeta,
      freestring = freestring & " " &         sqlString ( oldEntry)
      >> ,
      freestring = freestring & " " &         sqlString ( newEntry )
      >>   ) where hash like
      freestring = freestring & " " &         sqlString ( currentHash  )
      sql ( freestring )

      oldEntry = "rect64(" & thisRect & "),"   &   oldTagName  & ";"
      newEntry = "rect64(" & thisRect & "),"  &   copyTagName & ";"
   END if

   IF ( haveRectPicasa ) then
      > update Master  set RectPicasa         = replace(RectPicasa      ,
      freestring = freestring & " " &         sqlString ( ":" & oldEntry)
      >> ,
      freestring = freestring & " " &         sqlString ( newEntry )
      >>   ) where hash like
      freestring = freestring & " " &         sqlString ( currentHash  )
      sql ( freestring )

      > update Master  set RectPicasa         = replace(RectPicasa      ,
      freestring = freestring & " " &         sqlString ( oldEntry)
      >> ,
      freestring = freestring & " " &         sqlString ( newEntry )
      >>   ) where hash like
      freestring = freestring & " " &         sqlString ( currentHash  )
      sql ( freestring )
   END if

END Function

' --------------------
'dim CopyPastePopUp = sob ( ImageWindowSOB, "add", "Menu", "popup")

dim CopyPopUpid = sob (CopyPastePopUp , "add", "menu","Vertical", "Copy Tag")
sob (   -1     ,  "ON"   ,  "CLICK"  , "CBpopupCopy")

dim  PastePopUpid = sob (CopyPastePopUp , "add", "menu","Vertical", "Paste Tag")
sob (   -1     ,  "ON"   ,  "CLICK"  , "CBpopupPaste")

dim  DeletePopUpid =  sob (CopyPastePopUp , "add", "menu","Vertical", "Delete Region")
sob (   -1     ,  "ON"   ,  "CLICK"  , "cbDeleteRegion")

' --------------------

' ---------------------------------------------------------------------------------------------------------
' Image Grouping
' ---------------------------------------------------------------------------------------------------------

FUNCTION CreateSimilarImagesTable ( rid )
   ' rid =  the   ROWID into   Master of the reference Image

   ' ------------------------------------------

   ' we need the HASH value for this image

   dim referenceHash

   > select pHash from Master  where rowid =
   freestring = freestring & " " & rid
   WITHQUERY (freestring )
      referencehash = wqText(1)
   END WITHQUERY

   ' ------------------------------------------

   SilentSQL ("drop table if exists temp.links")

   ' ------------------------------------------
   ' create a table of LINKS to the  IMAGES   that are to be considered
   ' as being identical/near-identical to the referenceHash

   ' note: this uses the BK-TREE implementation

   >  create temp table links as
   >> select   link from xHashTbl (
   freestring = freestring & " " &      referenceHash
   >> ,
   freestring = freestring & " " &   maxHD
   >>  )  where distance > -1

   SilentSQL (freestring)

   ' -----------------------------------------

   SilentSQL ("drop table if exists temp.MatchesSimilarTbl")

   >  create temp table MatchesSimilarTbl as
   >>  select rowid as selfA , * from  Master
   >>  where
   >>            rowid in (select  link from temp.links)
   >>   and      IgnoreFile = 0
   >>   and not  ImageGroupType like 'different'
   SilentSQL (freestring)

   ' -----------------------------------------
   ' do not need  links  table any more

   SilentSQL ("drop table if exists temp.links")

   ' ------------------------------------------
END FUNCTION

FUNCTION CreateImageGroupTable ( rid )
   ' rid =  the   ROWID into   Master of the reference Image
   ' ------------------------------------------

   ' we need the    ImageGroupTbl      for this image

   dim referenceImageGroup

   > select ImageGroup  from Master  where rowid =
   freestring = freestring & " " & rid
   WITHQUERY (freestring )
      referenceImageGroup = wqText(1)
   END WITHQUERY

   ' ------------------------------------------

   SilentSQL ("drop table if exists temp.ImageGroupTbl")

   ' ------------------------------------------
   ' create a table of the  IMAGES   that have the same ImageGroup

   >  create temp table ImageGroupTbl as
   >> select  rowid as selfA , * from master
   >> where
   >>   IgnoreFile = 0
   >>   and    ImageGroup  =
   freestring = freestring & " " &     sqlString ( referenceImageGroup )

   SilentSQL (freestring)

END FUNCTION

FUNCTION removeImageXfromGroupZ ( xSelf, zSelf )

   CreateImageGroupTable ( zSelf )

   ' ------------------------------------------
   ' is there a group to be SPLIT a group
   dim cnt

   > select count(distinct ( phash || dhash  )   ) from ImageGroupTbl
   WITHQUERY ( freestring )
      cnt = wqInt(1)
   END withquery

   IF ( cnt < 2 ) then
      ' no group
      EXIT function
   END if

   ' ------------------------------------------
   ' are we removing the owning IMAGE
   ' the owning image has the pHash / dHash values that
   ' defined the Imagegroup value

   dim xImageGroup , zImageGroup

   > select imageGroup from ImageGroupTbl where selfA =
   freestring = freestring & " " & zSelf
   WITHQUERY ( freestring )
      zImageGroup = wqText(1)
   END withquery

   > select num2hex(phash) || num2hex(dHash)   from ImageGroupTbl where selfA =
   freestring = freestring & " " & xSelf
   WITHQUERY ( freestring )
      xImageGroup = wqText(1)
   END withquery

   IF ( zImageGroup ==  xImageGroup ) then

      ' is the owning Image
      ' so must change the  ImageGroup to another value

      >  select num2hex(phash) || num2hex(dHash)  from  ImageGroupTbl
      >>  where   not  (num2hex(phash) || num2hex(dHash))  like
      freestring = freestring & " " & sqlString( zImageGroup )
      >> limit 1
      WITHQUERY ( freestring )
         zImageGroup = wqText(1)
      END withquery

      > update ImageGroupTbl set  ImageGroup =
      freestring = freestring & " " & sqlString( zImageGroup )
      silentSQl(freestring)

      > select count(*  ) from ImageGroupTbl
      WITHQUERY ( freestring )
         cnt = wqInt(1)
      END withquery

      IF ( cnt < 3 ) then
         > update ImageGroupTbl  set  ImageGroupType =  'unknown'
         silentSQL ( freestring )
      END if
   ELSE
   

   END IF

   ' mark the IMAGE that has been split-off as being on its own
   ' i.e. unknown, and with its own   ImageGroup value

   > update master  set  hash =  ( phash || dhash  )
   >>  where rowid =  
   freestring = freestring & " " & xSelf
   silentSQL ( freestring )
   
  > update ImageGroupTbl  set  ImageGroupType =  'unknown'
   >> , ImageGroup =
   freestring = freestring & " " & sqlString ( xImageGroup )
   >>  where selfA =
   freestring = freestring & " " & xSelf
   silentSQL ( freestring )   
   
   
   
   

   ' update MASTER with info for all the IMAGES in the   ImageGroupTbl
   > update Master
   >> SET
   >>   ImageGroup = frmTbl.ImageGroup
   >> , ImageGroupType = frmTbl.ImageGroupType
   >> FROM
   >>  (select  selfa ,  ImageGroup , ImageGroupType from ImageGroupTbl ) as frmTbl
   >> WHERE
   >>   Master.rowid = frmTbl.selfA
   silentSQL(freestring)

END FUNCTION

FUNCTION CreateTargetReport ( sobid )
   dim ridA  = sob ( siGroup00, "get" , "data")
   dim txt = ""

   dim FileA , pHashA , dHashA
   dim FileB , pHashB , dHashB

   > select path||name , pHash , dHash  from master  where rowid  =
   freestring = freestring & " " & ridA
   WITHQUERY ( freestring )
      FileA = wqtext(1)
      pHashA = wqInt(2)
      dHashA = wqInt(3)
   END withquery

   dim ridB = cint(sob ( sobid , "GET" , "DATA" ))
   > select path||name , pHash , dHash  from master  where rowid  =
   freestring = freestring & " " & ridB
   WITHQUERY ( freestring )
      FileB = wqtext(1)
      pHashB = wqInt(2)
      dHashB = wqInt(3)
   END withquery

   IF ( ! isFile (  FileB )  ) then
      txt =  "    File does not exist "  &   FileB
      sob ( TarInfo , "SET" , "TITLE",  txt )
      EXIT function
   END if
   txt =  right("000000" & ridB,6)
   txt =  txt & "  pHD=" &  right( "00" & popCount ( pHashA  bxor   pHashB ) , 2 )
   txt =  txt & "  dHD=" &  right( "00" & popCount ( dHashA  bxor   dHashB ) , 2 )

   txt =  txt & "    "   &  right( "00000" &  CANVAS ( "IMAGE.FILE", "GET" , "WIDTH"  , FileB )  , 5 )
   txt =  txt & "/"      &  right( "00000" &  CANVAS ( "IMAGE.FILE", "GET" , "height" , FileB )  , 5 )
   txt =  txt & "    "   & FileB
   sob ( TarInfo , "SET" , "TITLE",  txt )

END function

FUNCTION removeThumbNails ( siMatrix )
   ' input parameter is the SOB ID of the target   MATRIX
   dim ChildCnt =  SOB ( siMatrix , "CHILD" , "COUNT"  )

   dim i
   dim siTmp ,  ThumbnailId

   FOR i = 1 to ChildCnt
      siTmp  = sob ( siMatrix ,   "child", "handle" ,  i )
      IF (  sob ( siTmp ,"GET","data" )  ) then

         sob( siTmp, "set" , "image" , "")

         ThumbnailId = sob( siTmp, "get" , "canvas"  )
         IF  ( ThumbnailId )   then
            canvas( ThumbnailId , "DELETE" )
         END IF
         sob ( siTmp ,"SET","data" , 0 )
      END IF

   NEXT i

END function

FUNCTION removeAllThumbNails (  )
   sob (RefInfo , "SET", "TITLE" , "" )
   sob (TarInfo , "SET", "TITLE" , "" )

   removeThumbNails ( siImageGroup )
   removeThumbNails ( siImageMatrix )

END Function

FUNCTION ImageCnts ( rid  )
   ' ------------------------------------------
   ' create a table of images where
 sob ( StatusTxt , "EMPTY"    )
   '   ImageGroup  value is the same as the reference image
   CreateImageGroupTable ( rid )

   '    pHash / dHash values are "near-enough"
   CreateSimilarImagesTable ( rid )

   ' ------------------------------------------

   SELECT count (*) from ImageGroupTbl
   dim igCnt = qrSingleValue

   SELECT count (*) from MatchesSimilarTbl where not selfa in ( select selfa from ImageGroupTbl )
   dim msCnt = qrSingleValue

    sob ( StatusTxt , "SET", "TITLE" , "*identical* images= " & igCnt & "    *similar*= " & msCnt  & "  " &  sob ( StatusTxt , "gET", "TITLE"  ) )
  

END Function

FUNCTION getCopies ( rid  )
   ' based on the specified rid
   ' get its   xHash
   ' then get all   xHashes within a Hamming distance of    maxHD

   ' there are 2 reason to treat an images as identical/near-identical to the reference image
   ' 1)
   '  it's pHash / dHash are "near-enough"
   ' 2)
   '  an image has been given the same   ImageGroup  value as the reference image

   ' ------------------------------------------------------------------------------------

   ' first we tidy up from any previous display!

   dim gridIndex = 0
   dim matrixIndex = 0
   dim siTmp
   dim CanvasHandle
   dim i , zFile

   ' ------------------------------------------------------------------------------------
   ' Because this function is called from different places it
   ' is possible that the reference image is
   '    logically removed
   ' or physically removed i.e. no longer in the file system

   '  sob ( siGroup00 ,"SET","data" ,  rid )

   > select path||name  , IgnoreFile from Master  where rowid =
   freestring = freestring & " " & rid
   WITHQUERY ( freestring )
      zFile = wqText(1)
      i = wqInt (2)
   END withquery

   IF ( i ) then
      ' logically removed
      sob ( RefInfo , "SET", "TITLE" , "Logically removed " & zFile )
      '    EXIT function
   END if

   IF (! isFile ( zFile) ) then
      ' physically removed
      sob ( RefInfo , "SET", "TITLE" , "Physically removed " & zFile )
      '   EXIT function
   END if

   ' ------------------------------------------
   ' create a table of images whose

   '   ImageGroup  value is the same as the reference image
   CreateImageGroupTable ( rid )

   '   pHash / dHash values are "near-enough"
   CreateSimilarImagesTable ( rid )

   ' ------------------------------------------
   ' now handle the reference image
   ' display it

   dim xHash ,  ImageGroup
   dim txt =  right("000000" & rid ,6) & "                "
   > select  path|| name   , pHash  , ImageGroup   from ImageGroupTbl   where selfa =
   freestring = freestring & " " & rid

   WITHQUERY (freestring )
      zFile = wqtext(1)
      xhash = wqtext(2)
      ImageGroup = wqText(3)

      sob ( siGroup00 ,"SET","data" ,  rid )

      IF (   isFile (  zFile )   )   then

         sob ( siGroup00 ,"SET","IMAGE", zFile )

         txt =  txt & "    "   &  right( "00000" &  CANVAS ( "IMAGE.FILE", "GET" , "WIDTH"  , zFile )  , 5 )
         txt =  txt & "/"      &  right( "00000" &  CANVAS ( "IMAGE.FILE", "GET" , "height" , zFile )  , 5 )
         txt =  txt & "    "   &  zFile
      ELSE
         txt = txt &  "    File does not exist "  &  zFile
      END if

      sob ( RefInfo , "SET", "TITLE" , txt )

   END withquery

   ' ------------------------------------------
   ' any IMAGEs in the   ImageGroupTbl   should not be  handled as a   POTENTIAL matches

   > delete from MatchesSimilarTbl where  selfA in ( select selfA from ImageGroupTbl )
   SilentSQL (freestring )

   ' ------------------------------------------
   ' do not want to handle the REFERENCE  IMAGE again, so remove it

   > delete from ImageGroupTbl where  selfA =
   freestring = freestring & " " & rid
   SilentSQL (freestring )

   ' ------------------------------------------
   ' any IMAGE still in the   MatchesSimilarTbl   can be displayed
   matrixIndex = 0

   > select   path||name , selfA   from MatchesSimilarTbl    limit
   freestring = freestring & " " &  ( maxThumbNailIndex  )

   WITHQUERY (freestring )
      siTmp = sob ( siMatrix00 ,  "SIBLING", matrixIndex )

      sob(siTmp ,"SET","data" , wqInt(2) )

      IF (   isFile (  wqtext(1) )   )   then
         sob(siTmp ,"SET","IMAGE", wqtext(1))
      END IF

      matrixIndex = matrixIndex + 1

   END withquery
   ' ------------------------------------------
   ' any IMAGE still in the   ImageGroupTbl   can be displayed

   gridIndex = 1

   > select   path||name , selfA   from ImageGroupTbl
   >>  limit
   freestring = freestring & " " &  ( maxThumbNailIndex + 1)
   WITHQUERY (freestring )

      siTmp = sob ( siGroup00 ,   "SIBLING", gridIndex )
      gridIndex = gridIndex + 1

      sob(siTmp ,"SET","data" , wqInt(2) )

      IF (   isFile (  wqtext(1) )   )   then
         sob(siTmp ,"SET","IMAGE", wqtext(1))
      END IF

   END withquery

   ' ------------------------------------------

   IF  (  ( MatrixIndex == 1 )  and ( gridIndex == 1 ) )  then

      CreateTargetReport ( sob ( siMatrix00 ,   "SIBLING", 0 ) )
   ELSEIF  (  ( MatrixIndex == 0 )  and ( gridIndex == 2 ) )  then
      CreateTargetReport ( sob ( siGroup00 ,   "SIBLING", 1 ) )
   END if

   ' ImageCnts ( rid  )

END function

FUNCTION MakeBkTree ( )

   ' Not HAPPY
   ' it sees that a calls to  DBsave   and  DBSaveAs cause
   ' the VIRTUAL tables that were previously existant to be
   ' emptied.
   ' But the TABLE name remains known.
   ' So need some code to check whether the BKTree is really present !

   dim flag = 0
   > select  tbl_name from sqlite_temp_master where  tbl_name like 'xHashTbl'
   WITHQUERY (freestring)

      > select count (*) from xHashTbl
      WITHQUERY (freestring)
         flag = qrsingleValue
      END withquery
   END withquery

   IF ( flag ) then
      EXIT function
   END if

   drop table if exists xHashTbl
   create virtual table temp.xHashTbl using bk64tree

   >   insert into xHashTbl  (metric , link)  select phash , rowid from master
   >>  where
   >>      IgnoreFile = 0
   >>      and not phash is NULL
   >>      and  ext in
   freestring = freestring & " " & ImageFileExtensions
   sql( freestring)

END Function

FUNCTION  cbImageGroupTools ( sobid )
   sob ( ImageGroupOvl , "set", "show", 1 )

   MakeBkTree ()
   getCopies ( CurrentRowid )

END Function

' ---------------------------------------------------------------------------------------------------------
'  End of Image Grouping
' ---------------------------------------------------------------------------------------------------------

FUNCTION selectToolPage (  )
   ' dependent on the popup Check flags
   ' decide which tool page should be displayed

   IF ( currenthash == "" ) then
      EXIT function

   END if

   dim rid
   > select rowid from master where hash =
   freestring = freestring & " " & sqlString (currenthash)
   >> limit 1
   WITHQUERY ( freestring )
      rid = wqInt ( 1 )
   END withquery

   ImageCnts ( rid  )

   IF ( sob ( RegionPopUpid , "get", "check" )  )  then
      sob ( TagCommentOvl   , "set" , "show" , 1)
   ELSEIF  ( sob ( TaggingPopUpid , "get", "check"  ) )  then
      cbtoolsMenuTagFilesB ( TaggingPopUpid )

   ELSEIF  ( sob ( FreeTextPopUpid , "get", "check" )  )  then
      cbFreeTextTools ( FreeTextPopUpid )

   ELSEIF  ( sob ( ImageGroupPopUpid , "get", "check" )  )  then
      cbImageGroupTools ( ImageGroupPopUpid )

   END if

END FUNCTION

' --------------------

FUNCTION cbPopupToolSelect ( sobid )
   sob ( sobid , "set", "checks.off"  )
   sob ( sobid , "set", "check" , 1 )
   selectToolPage ()
END function

' --------------------

dim  RegionPopUpid  = sob (CopyPastePopUp , "add", "menu","Vertical", "Region Tools")
sob (   -1     ,  "ON"   ,  "CLICK"  , "cbPopupToolSelect")

' --------------------

dim  TaggingPopUpid  = sob (CopyPastePopUp , "add", "menu","Vertical", "Tagging Tools")
sob ( -1 , "set" , "check" , 1 )
sob ( -1 ,  "ON"   ,  "CLICK"  , "cbPopupToolSelect")

' --------------------

dim  FreeTextPopUpid  = sob (CopyPastePopUp , "add", "menu","Vertical", "Free Text Tools")
sob (   -1     ,  "ON"   ,  "CLICK"  , "cbPopupToolSelect")

' --------------------

dim  ImageGroupPopUpid  = sob (CopyPastePopUp , "add", "menu","Vertical", "Image Grouping")
sob (   -1     ,  "ON"   ,  "CLICK"  , "cbPopupToolSelect")

' --------------------

FUNCTION cbImageMOUSECLICKS ( sobid, clickId )
   ' right mouse button  clickid = 7

   if ( clickid <> 7 ) then exit function

   IF ( ! ImageLoadedFlag ) then
      EXIT function
   END if

   ' treat as a left mouse button
   cbImagePress ( sobid )

   ' --------------------
   ' decide which popup menu options are relevant

   SELECT count (*) from tblRectList where not  rlHit =  0
   IF ( qrSingleValue ) then

      IF ( copyTagName == "" ) then
         sob ( PastePopUpid , "SET" , "MENU.GREY" , 1 )
      ELSE
         sob ( PastePopUpid , "SET" , "MENU.GREY" , 0 )
      END if

      sob ( CopyPopUpid , "SET" , "MENU.GREY" , 0 )
      sob ( DeletePopUpid , "SET" , "MENU.GREY" , 0 )

   ELSE
      sob ( CopyPopUpid   , "SET" , "MENU.GREY" , 1 )
      sob ( PastePopUpid  , "SET" , "MENU.GREY" , 1 )
      sob ( DeletePopUpid , "SET" , "MENU.GREY" , 1 )

   END IF

   ' --------------------

   sob(CopyPastePopUp,"SET","POSITION", sob ( appWindow , "get" , "cursor.x" ),  sob ( appWindow , "get" , "cursor.y" ) )
   sob(CopyPastePopUp,"set","show",1)

END function

' image takes size of SOB
' minimum SOB size 10 x 10 Pixels
dim sobImageHolder    = sob (ImagePanelSob , "ADD","image.holder",0 ,10,10    )
dim sobImageHolderFixed = sobImageHolder

sob ( sobImageHolder , "ON"  , "PRESS", "cbImagePress")
sob ( sobImageHolder , "ON"  , "MOUSECLICKS", "cbImageMOUSECLICKS")

sob ( sobImageHolder , "SET"  , "RGB", RGB( 175 , 225, 255) )
' -----------------------------------------------------
sob ("RGB","DEFAULT")

' -----------------------------------------------------

FUNCTION getFileHash ( fullName )
   getFilehash = 0
   IF ( isFile (  fullName )  == 1 ) then

      getFilehash = HashFile ( "MD5",   fullName )
   END IF
END FUNCTION

' -------------------------------------------------------
' tag boxes
' -------------------------------------------------------

FUNCTION CB_FIND_tag ( sobID ,editChr  )

   ' based on the txt in a filter box (  sobid  )
   ' look for matching   tag txts  in the appropriate tag column

   ' set the filter's COMBO   to be empty
   dim FilterCombo = sob(sobid ,"SIBLING",  1)
   sob ( FilterCombo,"empty")

   ' get sobId for the related  COMBO that defines the TAG Group
   dim typeSobComo =  sob(sobid ,"SIBLING",  -1)

   ' get the TagType
   dim typeTag     = sob( typeSobComo, "GET" , "TITLE" )

   dim filterTxt = sob(sobid,"GET","TITLE")

   ' do not include any special (non-printable) character in the filter text

   IF ( editChr < 0x020 ) then
   ELSEIF ( editChr > 0x7e ) then
   ELSE
      filterTxt = filterTxt & chr(editChr)
   END IF

   IF (   isDBopen )  then
      ' find the matching  TAG  txts (yes allow > 1 )
      > select ttName from tagTable where ttGroup like $Type and ttName like '%' || $txt || '%'  order by ttName  asc
      freestring = replace ( freestring , "$Type"   ,  sqlIdentifier ( typeTag & TagGroupId ) )
      freestring = replace ( freestring , "$txt"    ,  sqlString     ( filterTxt       ) )

      WITHQUERY (freestring)
         ' place the tag txts in the filter's   COMBO
         sob ( FilterCombo, "add", "row" , wqText(1))
      END withquery

   END if

   ' default is to select the first txt in the combo
   sob( FilterCombo , "SET", "SELECTION" , "ROW", 1 )

END Function

FUNCTION onEditFilter ( sobid , editChr )

   IF ( editChr == escChr) then
      sob( sobid    , "EMPTY")
      sob( sob(sobid ,"SIBLING",  1) , "EMPTY")
   END IF

END FUNCTION

FUNCTION CB_action_select ( sobid  , row   )

   dim actionBtnId =  sob(sobid,"GET","UNK")
   dim ActionTxt    = sob(sobid,"GET","TITLE")

   sob ( actionBtnId , "SET" , "TITLE" ,ActionTxt)

   IF ( ActionTxt == NoTag ) then
      sob( actionBtnId, "SET" ,  "RGB" , defBoxTxtCol)
   ELSE
      sob( actionBtnId, "SET" ,  "RGB" , 0x0ff )  ' red

   END IF

END FUNCTION

' -------------------------------------------------------

FUNCTION updateSingleFile ( onhash, actionType, tagGroup , tagTxt )

   IF ( actionType == "remove ALL" ) then

      > update master  SET
      freestring =    freestring &  " "  & sqlIdentifier ( tagGroup & TagGroupId  )
      >> =
      freestring =    freestring &  " "  & sqlString  ( TagDelim  )
      >>  WHERE       hash like
      freestring =    freestring &  " "  & sqlString  ( onHash  )

      sql ( freestring )
      EXIT function
   END IF

   IF    ( tagTxt == "" )  then
      EXIT function
   END if

   IF ( actionType == "add" ) then

      > UPDATE master SET

      freestring = freestring & " " & sqlIdentifier ( tagGroup & TagGroupId )
      >> =
      freestring = freestring & " " & sqlIdentifier ( tagGroup & TagGroupId )
      >>  ||
      freestring = freestring & " " &     sqlString ( tagTxt  & tagDelim )
      >> where
      freestring = freestring & " " & sqlIdentifier ( tagGroup & TagGroupId )
      >> NOT LIKE '%' ||
      freestring = freestring & " " &     sqlString ( tagDelim & tagTxt & tagDelim)
      >>  || '%'  AND

      >>  hash like
      freestring = freestring & " " &     sqlString ( onHash )
      sql ( freestring )

   ELSEIF ( actionType == "replace" ) then

      ' remove  any Region reference for this Tag group
      > select ttName from tagTable where ttGroup like
      freestring = freestring & " " &   sqlString (  TagGroup   )
      WITHQUERY ( freestring )
         deReferenceTagInRegions  ( TagGroup , wqText(1)     )
      END withquery

      > UPDATE master SET

      freestring = freestring & " " & sqlIdentifier ( tagGroup & TagGroupId )
      >> =
      freestring = freestring & " " &     sqlString ( tagDelim & tagTxt & tagDelim)

      >> where

      >> hash like
      freestring = freestring & " " &     sqlString ( onHash )
      sql ( freestring )

   ELSEIF ( actionType == "remove" ) then

      > UPDATE master SET

      freestring = freestring & " " & sqlIdentifier ( tagGroup & TagGroupId )
      >> = replace (
      freestring = freestring & " " & sqlIdentifier ( tagGroup & TagGroupId )
      >> ,
      freestring = freestring & " " &     sqlString ( TagDelim & tagTxt & TagDelim )
      >> ,
      freestring = freestring & " " &     sqlString ( TagDelim )
      >> )   WHERE
      freestring = freestring & " " & sqlIdentifier ( tagGroup & TagGroupId )
      >>  LIKE '%' ||
      freestring = freestring & " " &     sqlString ( TagDelim & tagTxt & TagDelim )
      >>  || '%'   and

      >> hash like
      freestring = freestring & " " &     sqlString ( onHash )
      sql ( freestring )
      ' but the  TAG  could also be in   RectMeta

      deReferenceTagInRegionsInHash ( onHash   , tagGroup , tagTxt   )

   ELSE ' treat as NoTag

   END IF

END function

FUNCTION cbBulkActionSelect ( sobid , rowid )

   dim actionTxt = sob( sobid, "GET" , "TITLE" )

   dim ActionTagGroup= sob( sob(sobid,"sibling",1) ,  "GET" , "TITLE" )

   IF  ( (  actionTxt ==   noTag )    or   (  ActionTagGroup ==   noTag )  )  then
      sob ( sob(sobid ,"SIBLING",  4 ) , "SET" ,"RGB", defLabelCol )
      sob ( sob(sobid ,"SIBLING",  4 ) , "SET" ,"TITLE", NoTag )
      sob ( sob(sobid ,"SIBLING",  3 ) , "empty" )
   ELSE
      sob ( sob(sobid ,"SIBLING",  4 ) , "SET" ,"RGB",  0x0ff )
      sob ( sob(sobid ,"SIBLING",  4 ) , "SET" ,"TITLE", actionTxt )
   END IF

END FUNCTION

FUNCTION cbBulkDoOnePress ( sobid )
   IF ( ! isDBOpen ) then
      ErrorReport ("No database selected" )
      EXIT function
   END if

   dim actionType , TagType , TagTxt

   dim BaseSob  = sob( sobid ,"SIBLING",  -4 )

   actionType = sob( BaseSob  , "GET" , "TITLE" )
   TagType    = sob( sob( BaseSob ,"SIBLING",  1 ), "GET" , "TITLE" )
   TagTxt     = sob( sob( BaseSob ,"SIBLING",  3 ), "GET" , "TITLE" )

   updateSingleFile ( currenthash, actionType, TagType  , TagTxt )

   toggleWarnColour ( sobid )
   DisplayTagsInFile ()

END function

FUNCTION cbBulkDoOneDrop ( sobid )
   IF ( ! isDBOpen ) then
      ErrorReport ("No database selected" )
      EXIT function
   END if

   dim fileCount
   IF   (  sob(sobid,"GET" , "TITLE" ) == NoTag )    then
      EXIT function
   END IF

   IF ( ! isDBopen  ) then
      ErrorReport ("No database selected" )
      EXIT function
   END IF

   dim actionType , TagType , TagTxt

   dim BaseSob  = sob( sobid ,"SIBLING",  -4 )

   actionType = sob( BaseSob  , "GET" , "TITLE" )
   TagType    = sob( sob( BaseSob ,"SIBLING",  1 ), "GET" , "TITLE" )
   TagTxt     = sob( sob( BaseSob ,"SIBLING",  3 ), "GET" , "TITLE" )

   CreateDroppedFileList ()

   dim i , hasHash , inDir , hasExt

   SELECT count (*) from temp.bulk where type  like 'file'
   fileCount = qrSingleValue

   cancelText( "Tagging in progress" , 1 )
   cancelText( "This can take a short while" , 3 )
   cancelText( "Files to process: " & FileCount , 2 )
   cancelShow(1)

   WITHQUERY ( "select hash , ( path|| name ) , ext from temp.bulk where type  like 'file' ")

      IF ( extensionCheck ( wqText(3) ) ) then
         sob( PathFile , "ADD" , "ROW" , wqText(2)  & EOL )
         updateSingleFile ( wqText(1) , actionType, TagType  , TagTxt )
      END IF

      cancelToggle ()
      fileCount--
      IF ( fileCount BAND 0x0f ) then
      ELSE
         cancelText( "Files to process: " & FileCount , 2 )
      END IF

   END WithQuery
   cancelShow(0)

   toggleWarnColour ( sobid )

END FUNCTION

FUNCTION cbBulkDoAllPress ( sobid )
   IF ( ! isDBOpen ) then
      ErrorReport ("No database selected" )
      EXIT function
   END if
   cbBulkActionOnHash (  CurrentHash  )
   cbSingleFile ( CurrentFile )
END function

FUNCTION cbBulkDoAllDrop ( sobid )
   IF ( ! isDBOpen ) then
      ErrorReport ("No database selected" )
      EXIT function
   END if
   dim fileCount
   IF   (  sob(sobid,"GET" , "TITLE" ) == NoTag )    then
      EXIT function
   END IF

   IF ( ! isDBopen  ) then
      ErrorReport ("No database selected" )
      EXIT function
   END IF

   CreateDroppedFileList ()

   dim i , hasHash , inDir , hasExt

   SELECT count (*) from temp.bulk where type  like 'file'
   fileCount = qrSingleValue

   cancelText( "Tagging in progress" , 1 )
   cancelText( "This can take a short while" , 3 )
   cancelText( "Files to process: " & FileCount , 2 )
   cancelShow(1)

   WITHQUERY ( "select hash , ( path|| name ) , ext from temp.bulk where type  like 'file' ")

      IF ( extensionCheck ( wqText(3) ) ) then
         sob( PathFile , "ADD" , "ROW" , wqText(2)  & EOL )
         cbBulkActionOnHash ( hasHash )
      END IF

      cancelToggle ()
      fileCount--
      IF ( fileCount BAND 0x0f ) then
      ELSE
         cancelText( "Files to process: " & FileCount , 2 )
      END IF

   END WithQuery
   cancelShow(0)

   toggleWarnColour ( sobid )
END FUNCTION

' -------------------------------------------------------
FUNCTION cbDoBlock ( sobid  , hasHash)

   IF ( ! isDBOpen ) then
      ErrorReport ("No database selected" )
      EXIT function
   END if

   dim blockOfRows = sob ( sobid, "get", "unk" )  ' a COLUMN CONTAINER
   dim rowNbr = 1
   dim HandledCnt = 0
   dim actionType , TagType , TagTxt
   dim ColID
   dim rowID = sob ( blockOfRows , "GET" , "handle" , 0 , rowNbr )
   DO while ( rowid )
      ' is a ROW CONTAINER

      ColID = sob ( rowid , "GET" ,"handle" , 0 , 1 )

      actionType =    sob( sob ( colID , "SIBLING", 0 ) , "GET", "TITLE" )
      TagType    =    sob( sob ( colID , "SIBLING", 1 ) , "GET", "TITLE" )
      TagTxt     =    sob( sob ( colID , "SIBLING", 3 ) , "GET", "TITLE" )

      IF ( actionType == noTag ) then
      ELSEIF ( TagType == noTag ) then
      ELSE
         HandledCnt = HandledCnt + 1
         updateSingleFile ( hasHash, actionType, TagType  , TagTxt )
      END IF

      rowNbr++
      rowID = sob ( blockOfRows , "GET" , "handle" , 0 , rowNbr )
   LOOP

   ' want HANDLE of the DO button

   if ( HandledCnt ) then toggleWarnColour ( sobid )
END function

FUNCTION cbDoBlockOnPress ( sobid )

   cbDoBlock ( sobid  , currentHash)
   DisplayTagsInFile ()

END FUNCTION

FUNCTION CreateDroppedFileList ( )

   dim i  , inDir
   drop table if exists  temp.bulkSum

   cancelClear ()
   cancelText( "Identifing target files" , 1 )
   cancelText( "This can take a short while" , 3 )
   cancelShow(1)

   FOR i = 1 to GetDropCount
      IF ( isFile ( getDropData ( i ) )  == 1 )   then
         dbFileList ( "temp", "inputBulkFile" , getDropData ( i  )  , , "*","md5")
      ELSEIF ( isFile ( getDropData ( i ) )  == -1 )   then
         inDir= getDropData ( i )   & "\\"
         dbFileList ( "temp", "inputBulkFile" , inDir, -1 , ,"MD5"  )
      END IF

      IF ( i == 1 ) then
         alter table temp.inputBulkFile rename to   bulkSum
      ELSE
         insert into temp.bulkSum select * from temp.inputBulkFile
      END IF

      cancelToggle ()
   NEXT I
   cancelShow(0)

   delete from temp.bulk  where not type like 'file'
   drop table if exists temp.Bulk

   create temp table bulk as select * from master where fsHash in ( select hash from bulkSum )

END FUNCTION

FUNCTION cbDoBlockOnDrop ( sobid )
   IF ( ! isDBOpen ) then
      ErrorReport ("No database selected" )
      EXIT function
   END if
   dim fileCount
   IF   (  sob(sobid,"GET" , "TITLE" ) == NoTag )    then
      EXIT function
   END IF

   IF ( ! isDBopen  ) then
      ErrorReport ("No database selected" )
      EXIT function
   END IF

   CreateDroppedFileList ()

   dim i , hasHash , inDir , hasExt

   SELECT count (*) from temp.bulk where type  like 'file'
   fileCount = qrSingleValue

   cancelText( "Tagging in progress" , 1 )
   cancelText( "This can take a short while" , 3 )
   cancelText( "Files to process: " & FileCount , 2 )
   cancelShow(1)

   WITHQUERY ( "select hash , ( path|| name ) , ext from temp.bulk where type  like 'file' ")

      IF ( extensionCheck ( wqText(3) ) ) then
         sob( PathFile , "ADD" , "ROW" , wqText(2)  & EOL )
         cbDoBlock ( sobid  , wqText(1)  )
      END IF

      cancelToggle ()
      fileCount--
      IF ( fileCount BAND 0x0f ) then
      ELSE
         cancelText( "Files to process: " & FileCount , 2 )
      END IF

   END WithQuery
   cancelShow(0)

   toggleWarnColour ( sobid )
END FUNCTION

FUNCTION makeOneofBlockOfRows (sobidParent)

   dim thisRowSob = sob ( sobidParent , "ADD", "CONTAINER", "ROW" )

   sob ( -1 , "ADD" , "COMBO"  , "dropDown" , defActionComboText )
   sob ( -1 , "add" , "row" ,  NoTag )
   sob ( -1 , "add" , "row" , "add" )
   sob ( -1 , "add" , "row" , "replace" )
   sob ( -1 , "add" , "row" , "remove" )
   sob ( -1 , "add" , "row" , "remove all" )

   sob ( -1 , "SET" , "SELECTION" , "ROW", 1 )
   sob ( -1 , "ON"  , "SELECTION" , "cbBulkActionSelect" )

   dim comboSOb = sob ( -1 , "ADD" , "COMBO"  , "dropdown" , defTypeComboText )
   sob ( -1 , "add" , "row" , NoTag )
   sob ( -1 , "SET" , "SELECTION" , "ROW", 1 )
   sob ( -1 , "ON"  , "SELECTION" , "cbFilterTagSelect" )

   ' to automatically populate with Tag Group changes
   isTagTypeCombo ( comboSOb  )
   isSavedTagTypeCombo (comboSOb  )
   sob ( thisRowSob , "Add" , "edit" , "         " )
   sob ( -1 , "empty" )

   sob ( -1 , "ON","EDIT"   ,   "onEditFile " )
   sob ( -1 , "ON","EDITED" ,   "onEditedFile" )

   sob ( -1 , "ON","ENTER", "CB_FIND_tag")
   sob ( -1 , "add","COMBO" , "dropdown" , defaultText )
   sob ( -1 , "empty")
   sob ( -1 , "set" ,"stretch" , 1 )

   sob ( thisRowSob , "add" , "Button" , "PUSH", "        " )
   sob ( -1 , "set" , "title" , noTag )

   sob ( -1 , "ON", "CLICK", "cbBulkDoOnePress")
   sob ( -1 , "ON", "DROP.FILE", "cbBulkDoOneDrop")

END FUNCTION

FUNCTION makeBlockOfRows ( sobid , nbrRows , BlkId)

   dim blockRow  = sob ( sobid , "ADD", "CONTAINER" , "ROW.h")

   dim actionBtn = sob ( blockRow   , "add" , "Button" , "PUSH", "        " )
   sob ( actionBtn , "ON"  , "PRESS", "cbDoBlockOnPress")
   sob ( -1 , "ON"  , "DROP.FILE", "cbDoBlockOnDrop")
   sob ( -1 , "set" , "title" , "Do (" & BlkId & ")" )

   dim BlockOfRows = sob ( blockRow , "ADD", "CONTAINER" , "COLUMN.w")

   dim i
   FOR i = 1 to nbrRows
      makeOneofBlockOfRows (BlockOfRows )
   NEXT I

   sob ( actionBtn , "set" , "unk" , BlockOfRows   )

   sob ( sobid , "add" , "space" , 0,4 )

END FUNCTION

FUNCTION makeBlocksB ( )

   dim BlockOfRows = sob ( FileTaggingOvl  , "ADD", "CONTAINER" , "COLUMN.w")
   sob ( -1 , "ADD", "LABEL" ,"File Tagging" )
   sob ( -1 , "SET", "RGB" , -1 )

   sob ( BlockOfRows , "ADD", "CONTAINER" , "ROW")

   sob ( -1 , "add", "LABEL" , "            Action        Tag Group   Filter     Tag Name                 " )
   sob ( -1 , "add",  "LABEL" , "              " )

   dim scrolledSob  = sob ( BlockOfRows , "ADD", "CONTAINER" , "BOX.SCROLLED", "  ",10)

   dim rowHolder = sob ( scrolledSob , "ADD", "CONTAINER" , "COLUMN.W")

   makeBlockOfRows ( rowHolder , 6 , "A" )
   makeBlockOfRows ( rowHolder , 6 , "B" )
   makeBlockOfRows ( rowHolder , 6 , "C" )
   makeBlockOfRows ( rowHolder , 6 , "D" )
   makeBlockOfRows ( rowHolder , 6 , "E" )
   makeBlockOfRows ( rowHolder , 6 , "F" )
   makeBlockOfRows ( rowHolder , 6 , "G" )
   makeBlockOfRows ( rowHolder , 6 , "H" )
END function
makeBlocksb ()

' -------------------------------------------------------
' FileExportOvl

FUNCTION onEditFile ( sobid , editChr )
   IF ( editChr == escChr) then
      sob( sobid     , "EMPTY")
      sob( sob(sobid , "SIBLING",  1)  , "EMPTY")
   END IF
END FUNCTION

FUNCTION updateSpecificTagNameCombo ( sobid , typeTag ,FilterTxt )
   dim cnt = 0
   sob( sobid , "empty" )

   IF ( isDBopen ) then
      EXIT function
   END IF

   ' find the matching  TAG  txts (yes allow > 1 )
   > select ttName from tagTable where ttGroup like $Type and ttName like '%' || $txt || '%'  order by ttname  asc
   freestring = replace ( freestring , "$Type"   ,  sqlIdentifier ( typeTag & TagGroupId ) )
   freestring = replace ( freestring , "$txt"    ,  sqlString     ( filterTxt       ) )

   WITHQUERY (freestring)
      ' place the tag txts in the filter's   COMBO
      sob (  sobid, "add", "row" , wqText(1))
      cnt++
   END withquery

   IF ( cnt == 0 ) then
      > select ttName from tagTable where ttGroup like $Type  order by ttName  asc
      freestring = replace ( freestring , "$Type"   ,  sqlIdentifier ( typeTag & TagGroupId ) )

      WITHQUERY (freestring)
         ' place the tag txts in the filter's   COMBO
         sob (  sobid, "add", "row" , wqText(1))
         cnt++
      END withquery
   END if

   ' default is to select the first txt in the combo
   sob( sobid , "SET", "SELECTION" , "ROW", 1 )

END FUNCTION

FUNCTION GetFilteredChoice ( sobid )

   dim TagGroupSob =  sobid
   dim FilterSob    = sob(sobid ,"SIBLING",  1 )
   dim TagListSob   = sob(sobid ,"SIBLING",  2 )

   dim TagGroup    =  sob(  TagGroupSob ,"GET" , "TITLE" )
   dim filterTxt   =  sob(  FilterSob   ,"GET" , "TITLE" )

   sob ( TagListSob , "empty")

   IF (   isDBopen )  then
      ' find the matching  TAG  txts (yes allow > 1 )
      > select ttName from tagTable where ttGroup like $Type and ttName like '%' || $txt || '%'  order by ttname  asc
      freestring = replace ( freestring , "$Type"   ,  sqlIdentifier ( TagGroup & TagGroupId ) )
      freestring = replace ( freestring , "$txt"    ,  sqlString     ( filterTxt       ) )

      WITHQUERY (freestring)
         ' place the tag txts in the filter's   COMBO
         sob (  TagListSob, "add", "row" , wqText(1))
      END withquery

   END if

   ' default is to select the first ttName in the combo
   sob( TagListSob , "SET", "SELECTION" , "ROW", 1 )
END FUNCTION

FUNCTION onEditedFile ( sobid , editChr )
   ' for every character entered in to the filter box
   ' trigger an update of the related  tag Txt combo

   IF ( editChr == escChr) then
      sob( sobid    , "EMPTY")
      sob( sob(sobid ,"SIBLING",  1)  , "EMPTY")
   ELSE
      IF (   editChr  > 0x01f ) then

         dim useTypeCombo = sob(sobid ,"SIBLING",  -1 )
         dim useTxtCombo  = sob(sobid ,"SIBLING",  1 )

         ' set the filter's COMBO   to be empty
         sob ( useTxtCombo  ,"empty")

         ' get the TagType
         dim typeTag     = sob( useTypeCombo, "GET" , "TITLE" )

         dim filterTxt = sob(sobid,"GET","TITLE")

         ' do not include any special (non-printable) character in the filter text

         IF ( editChr < 0x020 ) then
         ELSEIF ( editChr > 0x7e ) then
         ELSE
            filterTxt = filterTxt & chr(editChr)
         END IF

         IF (   isDBopen )  then
            ' find the matching  TAG  txts (yes allow > 1 )
            > select ttName from tagTable where ttGroup like $Type and ttName like '%' || $txt || '%'  order by ttname  asc
            freestring = replace ( freestring , "$Type"   ,  sqlIdentifier ( typeTag & TagGroupId ) )
            freestring = replace ( freestring , "$txt"    ,  sqlString     ( filterTxt       ) )

            WITHQUERY (freestring)
               ' place the tag txts in the filter's   COMBO
               sob (  useTxtCombo, "add", "row" , wqText(1))
            END withquery

         END if

         ' default is to select the first ttName in the combo
         sob( useTxtCombo , "SET", "SELECTION" , "ROW", 1 )

      END IF
   END IF
   updateNewTagNameField ()

END FUNCTION

FUNCTION cbExportActionSelect ( sobid , rowid )
   dim TagAction = sob ( sobid , "GET", "TITLE")
   dim TagGroup  = sob(sobid ,"SIBLING",  1 )
   dim TagFilter = sob(sobid ,"SIBLING",  2 )
   dim Tagname   = sob(sobid ,"SIBLING",  3 )

   IF ( instr ( Tagaction , "path" )  ) Then
   ELSEIF ( instr ( Tagaction , "file" )) Then
   ELSEIF ( instr ( Tagaction , "ext" ) )Then
   ELSEIF ( instr ( Tagaction , "lock" ) )Then
   ELSEIF ( instr ( Tagaction , "+duplicate" ) )Then
   ELSEIF ( instr ( Tagaction , "+empty" ) )Then
   ELSE
      ' is a TAG action
      EXIT function
   END IF
   ' is a file system action
   sob ( TagGroup , "set" , "SELECTION" , "ROW" , 1 )
   sob ( TagName  , "empty" )

END function

FUNCTION cbFilterTagSelect ( sobid, rowid )

   dim TagGroup = sob ( sobid , "GET", "TITLE")
   dim TagTxt  = sob ( sob(sobid ,"SIBLING",  1 )  , "GET", "TITLE")
   dim ActionTxt  = sob ( sob(sobid ,"SIBLING",  -1 )  , "GET", "TITLE")

   sob ( sob(sobid ,"SIBLING",  2 ) , "empty" )

   IF  ( (  actionTxt ==   noTag )    or   (   TagGroup ==   noTag )  )  then
      sob ( sob(sobid ,"SIBLING",  3 ) , "SET" ,"RGB", defLabelCol )
      sob ( sob(sobid ,"SIBLING",  3 ) , "SET" ,"TITLE", NoTag )
      EXIT function
   ELSE
      sob ( sob(sobid ,"SIBLING",  3 ) , "SET" ,"RGB",  0x0ff )
      sob ( sob(sobid ,"SIBLING",  3 ) , "SET" ,"TITLE", actionTxt )
   END IF

   IF ( tagTxt == "" ) then
      tagTxt == "%"
   END IF

   updateSpecificTagNameCombo ( sob(sobid ,"SIBLING",  2 )  , TagGroup ,tagTxt  )

   ' trigger the FILTER to be re-evaluated
   onEditedFile ( sob ( sobid , "SIBLING", 1 )      , "" )

END FUNCTION

FUNCTION makeFileListSectionBoxes ( sobid )
   dim AreaSob = sob ( sobid , "ADD", "CONTAINER", "ROW")

   sob ( -1 , "ADD" , "COMBO"  , "dropdown" , defActionComboText )
   sob ( -1 , "add" , "row" , NoTag )
   sob ( -1 , "add" , "row" , "add ==" )
   sob ( -1 , "add" , "row" , "add <>" )
   sob ( -1 , "add" , "row" , "add any" )
   sob ( -1 , "add" , "row" , "add non" )
   sob ( -1 , "add" , "row" , "add ==?" )
   sob ( -1 , "add" , "row" , "add <>?" )

   sob ( -1 , "add" , "row" , "Tags ==" )
   sob ( -1 , "add" , "row" , "Tags =+" )

   sob ( -1 , "add" , "row" , "Tag ==" )
   sob ( -1 , "add" , "row" , "Tag =+" )
   sob ( -1 , "add" , "row" , "Tag only" )
   sob ( -1 , "add" , "row" , "+duplicate" )
   sob ( -1 , "add" , "row" , "+empty" )

   sob ( -1 , "add" , "row" , "remove <>" )
   sob ( -1 , "add" , "row" , "remove ==" )
   sob ( -1 , "add" , "row" , "remove non" )
   sob ( -1 , "add" , "row" , "remove any" )
   sob ( -1 , "add" , "row" , "remove <>?" )
   sob ( -1 , "add" , "row" , "remove ==?" )
   sob ( -1 , "add" , "row" , "-Unchanged" )
   sob ( -1 , "add" , "row" , "-New" )
   sob ( -1 , "add" , "row" , "-Changed" )

   sob ( -1 , "add" , "row" , "lock" )

   sob ( -1 , "SET" , "SELECTION" , "ROW", 1 )
   sob ( -1 , "ON"  , "SELECTION" ,  "cbExportActionSelect" )

   dim ComboSob = sob ( -1 , "ADD" , "COMBO"  , "dropdown" , defTypeComboText )
   sob ( -1 , "add" , "row" , NoTag )
   sob ( -1 , "SET" , "SELECTION" , "ROW", 1 )
   sob ( -1 , "ON"  , "SELECTION" ,   "cbFilterTagSelect" )

   ' to automatically populate with Tag Group changes
   isTagTypeCombo ( ComboSob  )
   isSavedTagTypeCombo ( ComboSob  )

   sob ( AreaSob , "Add" , "edit" , "         " )
   sob ( -1 , "empty" )

   sob ( -1 , "ON","EDIT"   ,   "onEditFile " )
   sob ( -1 , "ON","EDITED" ,   "onEditedFile" )

   sob ( -1 , "ON","ENTER", "CB_FIND_tag")
   sob ( -1 , "add","COMBO" , "dropdown" , defaultText )
   sob ( -1 , "empty")

END FUNCTION

FUNCTION cbMakeNewFileList ( sobid )
   exportFilter ( "new" ,  "new" ,  "new"    )
   sob ( NbrFilesInFilter , "empty")
END FUNCTION

dim FileFilterArraySob
dim NbrFilterRows = 7

FUNCTION  cbResetFilter ( sobid )
   dim BaseSob  , i

   FOR i = 0 to NbrFilterRows

      BaseSob = sob ( FileFilterArraySob, "CHILD" ,"HANDLE" , 1 + i  )

      sob ( sob ( BaseSob, "CHILD", "HANDLE" , 1 ) , "SET" , "SELECTION" , "ROW", 1 )
      sob ( sob ( BaseSob, "CHILD", "HANDLE" , 2 ) , "SET" , "SELECTION" , "ROW", 1 )
      sob ( sob ( BaseSob, "CHILD", "HANDLE" , 3 ) , "EMPTY")
      sob ( sob ( BaseSob, "CHILD", "HANDLE" , 4 ) , "EMPTY")

   NEXT i
END FUNCTION

FUNCTION cbExportProcess ( sobid )

   IF ( ! isDBOpen ) then
      ErrorReport ("No database selected" )
      EXIT function
   END if

   IF ( isDBTable (  "temp", "SubList"  )  )  THEN
   ELSE
      MarkRowid = 0
      drop table if exists temp.SubList
      create table temp.SubList as select rowid as rid , * from master limit 0
   END IF

   sob ( NbrFilesInFilter , "SET", "TITLE" , ""  )
   NoErrorReport ("" )
   dim BaseSob

   dim action  , TagType , TagName , filter
   dim txt
   dim i
   FOR i = 0 to NbrFilterRows

      BaseSob = sob ( FileFilterArraySob, "CHILD" ,"HANDLE" , 1 + i  )

      action  = sob ( sob ( BaseSob, "CHILD", "HANDLE" , 1 ) , "GET" ,"TITLE")
      TagType = sob ( sob ( BaseSob, "CHILD", "HANDLE" , 2 ) , "GET" ,"TITLE")
      filter  = sob ( sob ( BaseSob, "CHILD", "HANDLE" , 3 ) , "GET" ,"TITLE")

      TagName = sob ( sob ( BaseSob, "CHILD", "HANDLE" , 4 ) , "GET" ,"TITLE")
      IF     ( action == NoTag ) then
      ELSEIF ( action == "lock" ) then
         exportFilter ( action ,  "" , ""   )
      ELSEIF ( action == "+duplicate" ) then
         exportFilter ( action ,  "" , ""   )
      ELSEIF ( action == "+empty" ) then
         exportFilter ( action ,  "" , ""   )

         ' handle those which use a partial TagName
      ELSEIF ( action == "add ==?" ) then
         exportFilter ( action ,  TagType , filter   )
      ELSEIF ( action == "add <>?" ) then
         exportFilter ( action ,  TagType , filter   )
      ELSEIF ( action == "remove <>?" ) then
         exportFilter ( action ,  TagType , filter   )
      ELSEIF ( action == "remove ==?" ) then
         exportFilter ( action ,  TagType , filter   )

      ELSEIF ( action == "-unchanged" ) then
         exportFilter ( "-like" ,  "rescanState" , "old"   )
      ELSEIF ( action == "-new" ) then
         exportFilter ( "-like" ,  "rescanState" , "new"   )
      ELSEIF ( action == "-changed" ) then
         exportFilter ( "-like" ,  "rescanState" , "changed"   )

         ' handle those which use a complete Tagname
      ELSE
         exportFilter ( action ,  TagType ,  TagName    )
      END IF
   NEXT i

   IF ( sob ( sob(inSertWhere,"sibling",-1), "GET","CHECK") ) then
      txt = trim ( sob ( inSertWhere , "get", "title") )
      IF ( txt <> "" ) then
         >  insert into temp.SubList select rowid , * from master where type  like 'file'   and
         freestring = freestring & " (" & txt & ")"

         TRY
            sql(freestring )
         CATCH
            ErrorReport("Invalid   Insert into   statement")
         END try
      END if
   END IF

   IF ( sob (sob(DeleteWhere,"sibling",-1), "GET","CHECK") ) then

      txt = trim (  sob ( DeleteWhere , "get", "title") )
      IF ( txt <> "" ) then
         >  delete from  temp.SubList where
         freestring = freestring & " (" & txt & ")"
         TRY
            sql(freestring )
         CATCH
            ErrorReport("Invalid   Insert into   statement")
         END try
      END if
   END IF

   sob ( NbrFilesInFilter , "SET", "TITLE" , "" & exportFilter ( "statistic" ,  "" ,  ""    ) )
END FUNCTION

dim NbrFilesInFilter
dim bulkExportMatrix

FUNCTION toggleCheckState ( sobid )
   sob ( sobid , "SET", "CHECK" , ! sob(sobid , "GET", "CHECK") )

END FUNCTION

FUNCTION makeFileListSection (  )

   dim ExportAreaCol = sob ( FileExportOvl , "ADD", "CONTAINER", "COLUMN.W")

   SubListTitleSob = sob ( -1 , "add" , "LABEL", "Create a File List (for exporting / deleting and power tagging" )
   sob ( -1 , "SET" , "RGB" , 0x0ff00 )

   ' ---------------------
   sob ( ExportAreaCol , "ADD", "CONTAINER", "ROW.w")

   sob( -1 , "add", "BUTTON" , "PUSH", "New List    " )
   sob( -1 , "ON" , "PRESS"  , "cbMakeNewFileList")

   sob( -1 , "add", "BUTTON", "PUSH", "Apply Filters" )
   sob( -1 , "ON" , "PRESS"    , "cbExportProcess")

   sob( -1 , "add", "BUTTON" , "PUSH", "Reset Filter" )
   sob( -1 , "ON" , "PRESS"  , "cbResetFilter")

   ' ---------------------
   sob ( ExportAreaCol , "ADD", "CONTAINER", "ROW")

   sob( -1 , "add",   "Label", " Number of Files" )
   NbrFilesInFilter = sob( -1 , "add",   "Label", "     " )

   ' ---------------------
   sob ( ExportAreaCol , "ADD", "CONTAINER", "ROW")
   sob ( -1 , "ADD" , "SPACE" , 0 ,5 )
   sob ( -1 , "SET" , "RGB" , -1 )

   ' ---------------------
   sob ( ExportAreaCol , "ADD", "CONTAINER", "ROW")
   sob ( -1 , "add", "LABEL" , "Action        Tag Group   Filter     Tag Name" )
   sob ( -1 , "add" , "SPACE", 0,0 )

   ' ---------------------
   sob ( ExportAreaCol , "ADD", "CONTAINER", "COLUMN.W")

   FileFilterArraySob =  sob("last")
   dim i
   FOR i = 0 to NbrFilterRows
      makeFileListSectionBoxes (FileFilterArraySob)
   NEXT i

   tmpSob = sob ( ExportAreaCol , "ADD" , "CONTAINER" , "COLUMN.w")
   sob ( -1 , "add" , "SPACE" , 0 , 5)
   sob ( -1 , "SET" , "RGB" , -1 )

   ' -----------------------------------

   InsertDeleteWhereSob = sob ( tmpSob , "ADD" , "CONTAINER" , "COlumn.w")

   sob ( InsertDeleteWhereSob , "ADD" , "CONTAINER" , "row")

   dim chkBtn = sob( -1 , "add" , "button", "check" , "Insert where" )
   sob ( chkBtn, "set", "CHECK" , 0 )
   sob ( chkBtn, "on", "CLICK" , "toggleCheckState" )

   InsertWhere = sob ( -1, "add", "edit" , "    " )
   sob ( InsertDeleteWhereSob , "ADD" , "CONTAINER" , "row")

   chkBtn = sob( -1 , "add" , "button", "check" , "Delete where" )
   sob ( chkBtn, "set", "CHECK" , 0 )
   sob ( chkBtn, "on", "CLICK" , "toggleCheckState" )

   DeleteWhere = sob ( -1, "add", "edit" , "    " )
   ' -----------------------------------

   sob ( tmpSob , "add" , "SPACE" , 0 , 5)
   sob ( tmpSob , "SET" , "RGB" , -1 )
   sob ( tmpSob , "ADD" , "CONTAINER" , "ROW.W")

   BtnExportFiles =sob ( -1 , "add", "BUTTON", "PUSH", "Export Files" )

   sob ( -1 , "SET" , "RGB" , RGB(0x8f,0x8f,0x0ff ) )

   sob ( -1 , "add" , "SPACE" , 0 , 0)
   sob ( -1 , "SET" , "RGB" , -1 )

   BtnDeleteFiles = sob ( -1 , "add", "BUTTON", "PUSH", "Delete Files in Subset" )
   sob ( -1 , "ON" , "PRESS"    , "CbdeleteFileListDoit")

   sob ( -1 , "SET" , "RGB" , RGB(0xff,0,0 ) )

   sob ( ExportAreaCol , "add" , "SPACE" , 0 , 0)
   sob ( -1 , "SET" , "RGB" , -1 )

END function

dim BtnExportFiles
dim BtnDeleteFiles
dim SubListTitleSob

makeFileListSection ()

dim TagCommentEdit ,   TagRect , TagRectCombo

FUNCTION DisplayTagsInFIle ( )

   sob (TagInfo, "empty")
   dim i ,j , splitLine
   IF ( tagFlag ) then
      sob (TagInfo,"add", "row" ,  "-- TAGS for this file --" & EOL )

      FOR i = 0 to  uBoundTagArray
         j = 1

         ' > select  $tag   from  master   where hash = ### limit 1
         > select
         freestring = freestring & " " &         sqlIdentifier ( tagArray(i) )
         >>  from  master   where hash =

         freestring = freestring & " " &         sqlString ( currenthash  )
         >> limit 1
         sql ( freestring )

         splitLine =   qrSingleValue

         IF  ( splitLine  == "" ) THEN
         ELSEIF ( splitLine == tagDelim ) THEN
         ELSE
            IF  ( j ) then
               sob (TagInfo,"add", "row" ,  "-- " & right ( tagArray(i) ,-1*length( TagGroupId ) )  & " --" & EOL )
               j = 0
            END IF

            splitLine = replace ( splitLine , tagDelim , EOL )
            IF ( left ( splitline , 1 ) == EOL ) then
               splitline = left ( splitline , -1 )
            END IF
            sob (TagInfo,"add", "row" ,  splitLine & EOL )

         END IF

      NEXT i
   END IF
   selectToolPage()
   '  sob ( TagTxtOvl, "set" ,  "SHOW" , 1 )
   cbSelectFreeTextField ( 1 , 1) ' do not care about the parameter values

END FUNCTION

FUNCTION CbUPdateTagCommentField ( sobid )

   dim rowNr  = sob ( TagRectCombo  , "get", "selection" ,"row", 1 )
   > select rlTagName from tblRectList where not rlHit = 0 order by rowid asc limit 1 offset
   freestring = freestring & " " &  rowNr - 1
   sql ( freestring )
   dim Name = qrSingleValue

   TRY
      ' > update TagTable set ttComment = ## where ttName = ###
      > update TagTable set ttComment =
      freestring = freestring & " " &         sqlString ( sob(TagCommentEdit,"get","title")  )
      >>  where ttName  like
      freestring = freestring & " " &         sqlString ( Name  )

      sql = freestring

      toggleOKColour ( sobid )

      sob ( sobid , "SET" , "TITLE" , "" )
      '      sob ( sobid , "SET", "RGB", defBoxTxtCol )

      sob (TagCommentEdit,"set", "row" , "top" , 0 )
   CATCH
      toggleWarningColour ( sobid )
   END TRY

END FUNCTION

FUNCTION cbChangeRectRubberBandTriggered ( sobid )

   dim Newname  = sob ( sob(sobid, "SIBLING", -1 )  , "get", "title")
   dim TagGroup = sob ( sob(sobid, "SIBLING", -3 )  , "get", "title")

   cbMakeRubberbandRegion ( sobId )

   SELECT count (*) from tblRectList where  rlHit = 1
   IF ( qrSingleValue <> 1 ) then
      EXIT function
   END if

   ' initially the RECT will be made with the  "name"   "fffffffffffffff"
   sob ( TagRectCombo , "empty" )
   sob ( TagRectCombo , "add" , "row" , "fffffffffffffff" )
   sob ( TagRectCombo , "set" , "selection", "row" ,1 )

   ' update the  MASTER   RectMeta   and TAG column to hold this TAG name
   ' get Tag group and name   from    tblRectList

   dim OldName = sob( TagRectCombo,"get","TITLE")
   dim rowNr  = sob ( TagRectCombo  , "get", "selection" ,"row", 1 )

   > select rlRect from tblRectList where not rlHit = 0 order by rowid asc limit 1 offset
   freestring = freestring & " " &  rowNr - 1
   sql ( freestring )
   dim Rect = qrSingleValue

   UpDateRectMeta ( CurrentHash ,  Rect, OldName , NewName , TagGroup   )

   ' now must recreate the    tblRectList   list
   CreateRectInfo ()

   ' but recreating it looses the HIT indicator

   update temp.tblRectList set rlHit = 0

   > update temp.tblRectList set rlHit = 1 where rlrect like
   freestring = freestring & " " & sqlString ( Rect)
   sql (freestring )

   DisplayTagsInFIle ()

   sob ( TagRectCombo , "empty" )

   sob ( TagRectCombo , "add" , "row" , NewName )
   sob ( TagRectCombo , "set" , "selection", "row" ,1 )

   fncShowRegions ()
   HaveRubberBandRect = 0
   cbSelectOneRect ( TagRectCombo , 1 )
   toggleOKColour ( sobid )

END FUNCTION

FUNCTION cbChangeRect ( sobid )

   sob ( TagCommentEdit , "empty" )

   IF  ( sob ( sobid , "get", "title") =  NoTag ) then
      togglewarnColour ( sobid)
      EXIT function
   END IF

   dim Newname = sob ( sob(sobid, "SIBLING", -1 )  , "get", "title")
   IF  ( newName = "" ) then
      togglewarnColour ( sobid)
      EXIT function
   END IF

   dim TagGroup = sob ( sob(sobid, "SIBLING", -3 )  , "get", "title")
   IF ( TagGroup = NoTag ) then
      togglewarnColour ( sobid)
      EXIT function
   END IF

   IF ( HaveRubberBandRect  ) then
      cbChangeRectRubberBandTriggered ( sobid )
      EXIT function
   ELSEIF (   sob(TagRectCombo,"get","TITLE")  == ""  ) then
      togglewarnColour ( sobid)
      EXIT function
   END if

   ' we are changing the NAME associated with the current HIT object

   ' ----------------------------------------------------------------------------
   ' update the  MASTER    RectMeta   and TAG columns to hold this TAG name
   ' get Tag group and name   from    tblRectList

   dim OldName = sob ( TagRectCombo , "get","TITLE")
   dim rowNr   = sob ( TagRectCombo , "get", "selection" ,"row", 1 )

   > select rowid from tblRectList where not rlHit = 0 order by rowid asc limit 1 offset
   freestring = freestring & " " &  rowNr - 1
   sql ( freestring )
   dim rowid = qrSingleValue

   SELECT count (*) from tblRectList where  rlHit = 1
   IF ( qrSingleValue <> 1 ) then
      EXIT function
   END if

   > select rlTagGroup from tblRectList where rowid =
   freestring = freestring & " " &  rowid
   sql ( freestring )
   dim OldTagGroup = qrSingleValue

   > select rlRect from tblRectList where rowid =
   freestring = freestring & " " &  rowid
   sql ( freestring )
   dim Rect = qrSingleValue

   IF ( !  ( oldName == newName ) ) then
      UpDateRectMeta ( CurrentHash ,  Rect, OldName , NewName , TagGroup   )
   ELSE
      > UPDATE master SET

      freestring = freestring & " " & sqlIdentifier ( tagGroup & TagGroupId )
      >> =
      freestring = freestring & " " & sqlIdentifier ( tagGroup & TagGroupId )
      >>  ||
      freestring = freestring & " " &     sqlString ( NewName  & tagDelim )
      >> where
      freestring = freestring & " " & sqlIdentifier ( tagGroup & TagGroupId )
      >> NOT LIKE '%' ||
      freestring = freestring & " " &     sqlString ( tagDelim & NewName & tagDelim)
      >>  || '%'  AND

      >>  hash like
      freestring = freestring & " " &     sqlString ( CurrentHash )
      sql ( freestring )

      OldName = ""
   END IF

   ' ----------------------------------------------------------------------

   ' it is possible that we have changed the name of a RectPicasa object
   ' that would create a new entry in RectMeta
   ' which in turn would need a new entry in    tblRectList

   ' recreate the   tblRectList
   CreateRectInfo ()
   update tblRectList set rlHit = 0

   > update tblRectList set rlHit = 1 where rlsrc like 'RectMeta' and rlrect like
   freestring = freestring & " " & Sqlstring ( rect )
   sql ( freestring )

   deReferenceTagFromTagColumn ( currentHash , OldTagGroup , OldName )

   DisplayTagsInFIle ()

   sob ( TagRectCombo , "empty" )

   sob ( TagRectCombo , "add" , "row" , NewName )
   sob ( TagRectCombo , "set" , "selection", "row" ,1 )

   fncShowRegions ()
   fnOfferRectChoice ()

   toggleOKColour ( sobid )

END function

FUNCTION cbActionSelectRect ( sobid , rowid )

   dim actionTxt = sob( sobid, "GET" , "TITLE" )
   dim useCol = bgTypeCol
   IF (  actionTxt ==   noTag ) then
      useCol  = defBtnCol
   ELSE
      GetFilteredChoice (sobid)
   END IF

   sob ( sob(sobid ,"SIBLING",  3 ) , "SET" ,"RGB", useCol )
   sob ( sob(sobid ,"SIBLING",  3 ) , "SET" ,"TITLE", actionTxt )

END FUNCTION

FUNCTION makeRenameRect ( sobidParent)

   dim thisRowSob = sob ( sobidParent , "ADD", "CONTAINER", "ROW" )

   sob ( -1 , "ADD" , "COMBO"  , "droPDown" , defActionComboText )
   sob ( -1 , "add" , "row" , "replace by" )

   sob ( -1 , "SET" , "SELECTION" , "ROW", 1 )
   sob ( -1 , "ON"  , "SELECTION" , "cbBulkActionSelect" )

   dim comboSOb =  sob ( -1 , "ADD" , "COMBO"  , "dropdown" , defTypeComboText )
   sob ( -1 , "add" , "row" , NoTag )
   sob ( -1 , "SET" , "SELECTION" , "ROW", 1 )
   sob ( -1 , "ON"  , "SELECTION" , "cbActionSelectRect" )

   ' to automatically populate with Tag Group changes''
   isTagTypeCombo ( comboSob  )
   isSavedTagTypeCombo (comboSOb  )
   sob ( thisRowSob , "Add" , "edit" , "         " )
   sob ( -1 , "empty" )

   sob ( -1 , "ON","EDIT"   ,   "onEditFile" )
   sob ( -1 , "ON","EDITED" ,   "onEditedFile" )

   sob ( -1 , "ON","ENTER", "CB_FIND_tag")
   sob ( -1 , "add","COMBO" , "dropdown" , defaultText )
   sob ( -1 , "empty")
   sob ( -1 , "set" , "stretch" , 1) ' on

   sob ( thisRowSob , "add" , "Button" , "PUSH", "        " )
   sob ( -1 , "set" , "title" , NoTag )

   sob ( -1 , "ON", "CLICK", "cbChangeRect")

END FUNCTION

FUNCTION cbNewNameonEditedFile (sobid , editchr )

   onEditedFile (sobid , editchr )

   sob ( _
   sob ( sobid, "GET" , "unk" )_
   , "SET" , "TITLE" , _
   sob ( sob(sobid,"SIBLING", 1 ) , "GET", "TITLE" ) _
   )
END function

FUNCTION InsertRectMeta ( hashVal ,  Rect   )

   IF ( ! haveRectMeta ) then
      EXIT function
   END if

   > select count (*)  from master where  RectMeta like '%(' ||
   freestring = freestring & " " &         sqlString ( rect  )
   >>  || ')%'  and  hash =
   freestring = freestring & " " &         sqlString ( hashVal  )
   >> limit 1

   sql ( freestring )

   IF (  qrsingleValue > 0 ) then
      EXIT function
   END if

   ' ----------------------------------------------------------
   ' create initial entry  "faces="   if not present

   > select RectMeta from master where  hash =
   freestring = freestring & " " &         sqlString ( hashVal  )
   >> limit 1
   sql ( freestring )

   IF ( qrSingleValue = "" ) then

      ' > update master set RectMeta = RectMeta || #   where  hash = ###
      > update master set RectMeta =  RectMeta  ||
      freestring = freestring & " " &         sqlString ( "faces=rect64(" & Rect & "),fffffffffffffff;"   )
      >>    where hash =
      freestring = freestring & " " &         sqlString ( hashVal  )
      sql ( freestring )

      sql ( freestring )
   ELSE
      ' > update master set RectMeta = RectMeta || #   where  hash = ###
      > update master set RectMeta =  RectMeta  ||
      freestring = freestring & " " &         sqlString ( ";rect64(" & Rect & "),fffffffffffffff;" )
      >>    where hash =
      freestring = freestring & " " &         sqlString ( hashVal  )
      sql ( freestring )
   END IF
   ' ----------------------------------------------------------

END function

FUNCTION GetRectEntry ( Rect , RectDefn ) string

   dim pre

   GetRectEntry = ""
   ' first see if the have     RECT string followed by   ),
   dim inPos = instr ( RectDefn, Rect & "),"  )

   IF ( inPos ) THEN

      ' create a string that starts at the begining of the RectDefn and STOPS
      ' where our  RECT starts
      pre  = left ( RectDefn , inpos -1 )

      ' go back to it' s  rect(
      inPos = instrRev ( pre   , "rect64"   )

      ' have the starting point
      GetRectEntry =  left ( RectDefn, -1 * (inpos -1)  )

      ' now find where we STOP

      IF (      inPos := instr    ( GetRectEntry   , ";;rect64("   ) ) then
      ELSEIF  ( inPos := instr    ( GetRectEntry   , ";rect64("   ) ) then
      ELSEIF  ( inPos := instrRev ( GetRectEntry   , ";"   ) ) then
      ELSE
         inPos = length(GetRectEntry)
      END IF
      GetRectEntry = left ( GetRectEntry ,   inpos     )
   END IF
END function

FUNCTION deReferenceTagFromTagColumn ( hashVal , TagGroup , Tagname )

   > select count (*) from tblRectList where   rlTagGroup  like
   freestring =    freestring &  " "  & sqlString ( TagGroup )
   >>  and rlTagName  like
   freestring =    freestring &  " "  & sqlString ( Tagname )
   >>  and  rlSrc like 'RectMeta'
   sql ( freestring )

   IF ( qrSingleValue == 0 ) then

      ' delete Tagname  from master Tag column
      > update master  set
      freestring =    freestring &  " "  & sqlIdentifier ( tagGroup & TagGroupId  )
      >> = REPLACE (
      freestring =    freestring &  " "  & sqlIdentifier ( tagGroup & TagGroupId  )
      >>  ,
      freestring =    freestring &  " "  & sqlString ( TagDelim & Tagname & TagDelim )
      >>  ,
      freestring =    freestring &  " "  & sqlString (  TagDelim   )

      >> ) where
      freestring =    freestring &  " "  & sqlIdentifier ( tagGroup & TagGroupId  )
      >> like
      freestring =    freestring &  " "  & sqlString ( "%" & TagDelim & Tagname & TagDelim & "%" )
      >>  AND hash like
      freestring =    freestring &  " "  & sqlString ( hashVal )

      sql ( freestring )

   END IF

END FUNCTION

FUNCTION UpDateRectMeta ( hashVal ,  Rect, OldName , NewName , TagGroup   )

   ' --------------------------------------------------------------------
   ' ensure that there is no RECT defn  for this RECT

   IF ( ! haveRectMeta ) then
      EXIT function
   END if

   > select RectMeta from  master   where hash =
   freestring = freestring & " " &         sqlString ( hashVal  )
   >>   limit 1

   sql ( freestring )

   dim oldRectEntry = GetRectEntry ( Rect , qrSingleValue  )

   ' > update master set RectMeta = replace ( RectMeta , # , '' ) where hash = ###
   > update master set RectMeta = replace ( RectMeta ,
   freestring = freestring & " " &         sqlString ( oldRectEntry  )
   >>  , '' ) where hash =
   freestring = freestring & " " &         sqlString ( hashVal  )
   sql ( freestring )

   ' --------------------------------------------------------------------

   ' we want an entry
   ' note how initially we do NOT have a leading    ;
   ' the first entry in a Picasa RECT defn does not have a leading  ;
   dim wantRect = "rect64(" & rect & ")," & NewName & ";"

   ' --------------------------------------------------------------------

   IF (   haveRectPicasa ) then
      ' if new entry is in the ## RectPicasa ## then   nothing to do
      > select count (*) from master where RectPicasa like
      freestring = freestring & " " &         sqlString ( "%" & left(wantRect,-1) & "%"   )
      >>  and hash =
      freestring = freestring & " " &         sqlString ( hashVal  )
      sql ( freestring )

      IF ( qrSingleValue ) then

         EXIT function
      END IF
   END IF

   ' ----------------------------------------------------------
   ' create initial entry  "faces="   if not present

   ' > select RectMeta from master where  hash = ### limit 1

   > select RectMeta from master where  hash =
   freestring = freestring & " " &         sqlString ( currentHash  )
   >>  limit 1
   sql ( freestring )

   IF ( qrSingleValue = "" ) then

      > update master set RectMeta = "faces="  where  hash =
      freestring = freestring & " " &         sqlString ( currentHash  )
      sql ( freestring )
   END IF

   ' ----------------------------------------------------------

   wantRect = "rect64("& rect & ")," &TagGroup &  TagDelim &  NewName & ";"

   '  wantRect = "rect64(" & tagGroup & TagGroupId & TagDelim  &  & rect & ")," & NewName & ";"

   > update master set RectMeta = RectMeta ||
   freestring =  freestring &   sqlString ( wantRect )
   >>  where  hash =
   freestring =    freestring &  sqlString ( hashVal )
   sql ( freestring )

   ' ----------------------------------------------------------

   ' UPDATE master SET §Tag = §Tag || §Txt || '§'    WHERE §Tag  NOT LIKE   '%' ||  §Txt  || '§%'   AND hash = §hash

   > UPDATE master SET
   freestring =    freestring &  " "  & sqlIdentifier ( tagGroup & TagGroupId  )
   >> =
   freestring =    freestring &  " "  & sqlIdentifier ( tagGroup & TagGroupId  )
   >>  ||
   freestring =    freestring &  " "  & sqlString ( NewName )
   >>  ||
   freestring =    freestring &  " "  & sqlString ( TagDelim )
   >> where
   freestring =    freestring &  " "  & sqlIdentifier ( tagGroup & TagGroupId  )
   >> not like  '%' ||
   freestring =    freestring &  " "  & sqlString ( NewName )
   >>  ||
   freestring =    freestring &  " "  & sqlString ( TagDelim & "%" )
   >>  AND hash like
   freestring =    freestring &  " "  & sqlString ( hashVal )

   sql ( freestring )

   ' ----------------------------------------------------------

END function

FUNCTION cbNewNameAndChangeRect  ( sobid )

   IF ( ! isDBopen  ) then
      ErrorReport ("No database selected" )
      EXIT function
   END IF

   IF ( ! haveRectMeta   ) then
      EXIT function
   END if

   dim rowNr   = sob ( TagRectCombo  , "get", "selection" ,"row", 1 )

   IF ( rowNr ) then
   ELSEIF ( HaveRubberBandRect ) then
   ELSE
      ErrorReport ("No region selected" )
      EXIT function
   END IF

   dim NewName =  sob (  sob ( sobid, "GET" , "unk" ) , "GET" , "TITLE"    )
   NewName = trim ( NewName )
   IF ( NewName = ""  ) then
      ErrorReport ("No new name defined" )
      EXIT function
   END if

   dim TagGroupSob   = sob(sobid ,"SIBLING",  -3 )
   dim TagGroup      = sob(TagGroupSob ,"get","title" )
   IF ( TagGroup = NoTag  ) then
      ErrorReport ("No Tag group selected" )
      EXIT function
   END if

   dim TagFilterSob  = sob(sobid ,"SIBLING",  -2 )

   ' ---------------------------------------------------------------------
   ' only proceed if this  TagGroup / NewName combination is unique

   > select count (*) from TagTable where ttGroup like
   freestring = freestring & " " &  sqlString ( TagGroup & TagGroupId  )
   >>  and  ttName  like
   freestring = freestring & " " &  sqlString ( NewName )
   sql (freestring )

   IF ( qrsinglevalue ) then
      ErrorReport ("Tag group/name already exists" )

      ToggleWarnColour ( sobid )
      EXIT function
   END if

   ' ---------------------------------------------------------------------
   ' create new entry in ttTagTable

   > INSERT into  TagTable  (  ttGroup , ttName , ttComment ) values (
   freestring = freestring & " " &  sqlString ( TagGroup & TagGroupId  )
   >> ,
   freestring = freestring & " " &  sqlString ( NewName  )
   >> , '' )
   sql = freestring

   ' ---------------------------------------------------------------------

   sob ( TagFilterSob , "set" , "TITLE" , NewName )
   GetFilteredChoice ( TagGroupSob  )

   cbChangeRect ( sobid )

END function

FUNCTION makeNewNameRect ( sobidParent)

   dim thisRowSob = sob ( sobidParent , "ADD", "CONTAINER", "ROW" )

   sob ( -1 , "ADD" , "COMBO"  , "dropdOwn" , defActionComboText )
   sob ( -1 , "add" , "row" , "derive" )
   sob ( -1 , "SET" , "SELECTION" , "ROW", 1 )

   dim combosob = sob ( -1 , "ADD" , "COMBO"  , "dropdown" , defTypeComboText )
   sob ( -1 , "add" , "row" , NoTag )
   sob ( -1 , "SET" , "SELECTION" , "ROW", 1 )
   sob ( -1 , "ON"  , "SELECTION" , "cbActionSelectRect" )

   ' to automatically populate with Tag Group changes''
   isTagTypeCombo ( comboSob )
   isSavedTagTypeCombo (comboSOb  )
   dim EditSob = sob ( thisRowSob , "Add" , "edit" , "         " )
   sob ( -1 , "empty" )

   sob ( -1 , "ON","EDIT"   ,   "onEditFile" )
   sob ( -1 , "ON","EDITED" ,   "cbNewNameonEditedFile" )

   sob ( -1 , "ON","ENTER", "CB_FIND_tag")
   sob ( -1 , "add","COMBO" , "dropdown" , defaultText )
   sob ( -1 , "empty")
   sob ( -1 , "set" , "stretch" , 1) ' on

   dim doItSob = sob ( thisRowSob , "add" , "Button" , "PUSH", "        " )
   sob ( -1 , "set" , "title" , "Do it" )

   sob ( -1 , "ON", "CLICK", "cbNewNameAndChangeRect")

   dim NewNameEdit = sob ( sobidParent , "ADD", "EDIT", "         " )
   sob ( -1 , "empty")
   sob ( EditSob , "SET", "UNK" , NewNameEdit )
   sob ( doItSob , "SET", "UNK" , NewNameEdit )

END FUNCTION
dim TagCommentAreaCol

' -----------------------------------------------------
' rubber band things
' -----------------------------------------------------
dim RubberBandEdit

FUNCTION cbMakeRubberbandRegion ( sobId  )

   IF ( ! imageLoadedFlag ) then
      EXIT function
   END IF

   dim sobW = sob ( sobImageHolder , "get" , "width"  )
   dim sobH = sob ( sobImageHolder , "get" , "height" )
   dim CanvasHandle = SOB(  sobImageHolder , "GET" , "CANVAS" )

   dim imW = canvas ( CanvasHandle , "get" , "width"  )
   dim imH = canvas ( CanvasHandle , "get" , "height" )

   dim   leftRect     , TopRect , rightRect , BottomRect

   '  leftRB   etc   are screen co-ordinates
   '   and NOT CANVAS co-ordinates

   sob ( RubberBandEdit , "add" , "row" ,"Make " &  leftRB & " "  & topRB   & " "  &  rightRB  & " "  & bottomRB & EOL )

   leftRect   = cint( 0x010000 * leftRB / imW )
   TopRect    = cint( 0x010000 * topRB  / imH )

   rightRect  = cint( 0x010000 * ( leftRB + rightRB  ) / imW )
   BottomRect = cint( 0x010000 * ( topRB  + bottomRB ) / imH   )

   dim Rect
   rect =        right( "0000" & left(hex(leftRect),-2)  , 4  )
   rect = rect & right( "0000" & left(hex(TopRect),-2)  , 4  )
   rect = rect & right( "0000" & left(hex(RightRect),-2)  , 4  )
   rect = rect & right( "0000" & left(hex(BottomRect),-2) , 4   )

   sob ( RubberBandEdit , "add" , "row" ,"Rect64 = " &  rect & EOL )

   InsertRectMeta ( currentHash ,  Rect   )
   CreateRectInfo ()

   dim PerCentX = ( (leftRB +   rightRB  /2)  * 100) / imW
   dim PerCentY = ( (topRB  +   bottomRB /2)  * 100) / imH
   cbImageHitStatus (  PerCentX , PerCentY  )

END FUNCTION

FUNCTION fncMakeRubberBandTools ()
   dim RubberBandCol = sob ( RubberBandOvl , "ADD", "CONTAINER", "COLUMN.W")
   sob ( -1 , "add" , "LABEL", "Define a region of the object, that can be associated with a Tag." )
   sob ( -1 , "SET" , "RGB" , 0x0ff00 )

   RubberBandEdit = sob(RubberBandCol,"add","Edit.rows" ,   "  ", 20 )

   sob ( RubberBandCol , "add" , "SPACE" , 0 , 0)
   sob ( -1 , "SET" , "RGB" , -1 )

   sob ( RubberBandCol, "ADD", "Button" , "PUSH", "Press to create this region")
   '  sob ( -1 , "ON", "click" ,  "cbMakeRubberbandRegion")

   sob ( RubberBandCol , "add" , "SPACE" , 0 , 0)
   sob ( -1 , "SET" , "RGB" , -1 )
END FUNCTION

FUNCTION cbReDrawRegions ( sobid )
   fncShowRegions ()

   IF ( sob ( TagRectCombo , "GET", "SELECTION" , "ROW" ) ) then
      cbSelectOneRect ( TagRectCombo , sob ( TagRectCombo , "GET", "SELECTION" , "ROW" ) )
   END IF

END function

FUNCTION cbDeleteRegion ( sobid )

   IF ( ! isDBopen  ) then
      ErrorReport ("No database selected" )
      EXIT function
   END IF

   IF (   sob(TagRectCombo,"get","TITLE")  == ""  ) then
      EXIT function
   END if

   dim OldName = sob ( TagRectCombo,"get","TITLE")
   dim rowNr   = sob ( TagRectCombo  , "get", "selection" ,"row", 1 )

   > select rlRect from tblRectList where not rlHit = 0 order by rowid asc limit 1 offset
   freestring = freestring &  " " & rowNr - 1
   sql ( freestring )
   dim Rect = qrSingleValue

   > select rlTagGroup from tblRectList where not rlHit = 0 order by rowid asc limit 1 offset
   freestring = freestring &  " " & rowNr - 1
   sql ( freestring )
   dim TagGroup = qrSingleValue

   sob ( TagCommentEdit , "empty" )
   dim haveRect = "rect64(" & rect & ")," & TagGroup & TagDelim & OldName & ";"

   ' remove OLD entry
   ' > update master set RectMeta = replace ( RectMeta , ## , '' ) where hash = ###

   IF ( haveRectMeta ) then
      > update Master  set RectMeta   = replace(RectMeta,
      freestring = freestring & " " &         sqlString ( ":" & haveRect )
      >> ,
      freestring = freestring & " " &         sqlString ( "" )
      >>   ) where hash like
      freestring = freestring & " " &         sqlString ( currentHash  )
      sql ( freestring )

      > update Master  set RectMeta   = replace(RectMeta,
      freestring = freestring & " " &         sqlString ( haveRect )
      >> ,
      freestring = freestring & " " &         sqlString ( "" )
      >>   ) where hash like
      freestring = freestring & " " &         sqlString ( currentHash  )
      sql ( freestring )
   END if

   haveRect = "rect64(" & rect & "),"   & OldName & ";"

   IF ( haveRectPicasa ) then
      > update Master  set RectPicasa         = replace(RectPicasa      ,
      freestring = freestring & " " &         sqlString ( ":" & haveRect )
      >> ,
      freestring = freestring & " " &         sqlString ( "" )
      >>   ) where hash like
      freestring = freestring & " " &         sqlString ( currentHash  )
      sql ( freestring )

      > update Master  set RectPicasa         = replace(RectPicasa      ,
      freestring = freestring & " " &         sqlString ( haveRect )
      >> ,
      freestring = freestring & " " &         sqlString ( "" )
      >>   ) where hash like
      freestring = freestring & " " &         sqlString ( currentHash  )
      sql ( freestring )
   END If

   CreateRectInfo ()

   deReferenceTagFromTagColumn ( currentHash , TagGroup , OldName )

   fncShowRegions ()

   ' since we have deleted a REGION
   ' then we can not currently have a RECT to offer
   '  fnOfferRectChoice ()
   displayTagsInFile ()

   sob ( TagRectCombo,"empty")
   SetLblRegionRGB ( defBtnCol)

END FUNCTION

FUNCTION cbObjectCommentEdit ( sobid, char )
   ' if the user has done and edit to the Object Comment field
   ' then set the  ACTION to be    edit

   sob ( lblRegionUpdateComment , "SET" , "TITLE" , "Comment edited, press to save" )
   sob ( lblRegionUpdateComment , "SET", "RGB", rgb(255,0,0)  )

END FUNCTION

dim lblRegionSelection ,  lblRegionUpdateComment , lblRegionChangeName , lblRegionCreateName , lblRegionDelete
FUNCTION SetLblRegionRGB ( toRgb )

   sob ( lblRegionSelection  , "SET" , "RGB" , toRGB )
   sob ( lblRegionChangeName , "SET" , "RGB" , toRGB )
   sob ( lblRegionCreateName, "SET" , "RGB" , toRGB )
   sob ( lblRegionDelete, "SET" , "RGB" , toRGB )
   sob ( lblRegionUpdateComment , "SET" , "RGB" , defBtnCol )

END FUNCTION

FUNCTION cbSelectFreeTextField ( sobid , rowid)
   dim i
   sob ( TagTxtEdit , "EMPTY")

   IF ( ! FreeTextFlag ) then
      EXIT function
   END if

   FOR i = 0 to  uBoundTagTxtArray

      > select
      freestring = freestring & " " &         sqlIdentifier ( tagTxtArray(i) )
      >>  from  master   where hash =

      freestring = freestring & " " &         sqlString ( currenthash  )
      >> limit 1
      sql ( freestring )

      IF  ( sob ( FreeTextComboSob , "GET", "TITLE" ) == ( right(tagTxtArray(i), -1*length(FreeTxtId)) )    ) then
         sob (TagTxtEdit,"add", "row" ,  qrSingleValue& EOL  & EOL  )
      ELSE  ( sob ( FreeTextComboSob , "GET", "TITLE" ) == " all" )
         sob (TagTxtEdit,"add", "row" ,  "-- " & right(tagTxtArray(i), -1*length(FreeTxtId)) & " --" & EOL )
         sob (TagTxtEdit,"add", "row" ,  qrSingleValue& EOL  & EOL  )

      END if

   NEXT i
END FUNCTION
dim TagTxtEdit
dim FreeTextActionSob , FreeTextComboSob , FreeTextDoItSob

FUNCTION cbFreeTextDoIt ( sobid  )
   dim actionTxt = sob ( FreeTextDoItSob  , "GET", "TITLE")
   dim TextField   = sob ( FreeTextComboSob , "GET", "TITLE")
   dim newText
   dim i
   IF ( actionTxt == "none" ) then
      EXIT function
   END if
   SELECT CASE  actionTxt
   CASE  "update"
      ' can only be single Free text field
      newText =  sob ( TagTxtEdit , "GET", "TITLE")
      > update master set
      freestring = freestring & " " & sqlidentifier ( TextField & FreeTxtId )
      >> =
      freestring = freestring & " " & sqlString ( newText )
      >> where  hash =
      freestring = freestring & " " & sqlidentifier ( currentHash )
      sql(freestring )

   CASE "clear"
      ' can be all or a single Free text field
      IF ( TextField == " all" )  then
         FOR i = 0 to uBoundTagTxtArray
            > update master set
            freestring = freestring & " " & sqlidentifier ( TagTxtArray(i)  )
            >> = ''
            >> where  hash =
            freestring = freestring & " " & sqlidentifier ( currentHash )
            sql(freestring )

         NEXT i
      ELSE
         > update master set
         freestring = freestring & " " & sqlidentifier ( TextField & FreeTxtId )
         >> = ''
         >> where  hash =
         freestring = freestring & " " & sqlidentifier ( currentHash )
         sql(freestring )

      END IF

   END SELECT

   cbSingleFile ( currentfile )

END FUNCTION

FUNCTION cbDefineFreeTextDoIt (  )

   dim actionTxt = sob ( FreeTextActionSob , "GET", "TITLE")
   dim TextTxt   = sob ( FreeTextComboSob , "GET", "TITLE")

   IF ( TextTxt == noTag ) then
      Sob ( FreeTextDoItSob , "SET", "TITLE" , noTag )
      sob ( FreeTextDoItSob , "SET", "RGB" , defbtnCol )
      EXIT function
   END if

   SELECT CASE    actionTxt
   CASE "clear"
      sob ( FreeTextDoItSob , "SET", "TITLE" , actionTxt )
      sob ( FreeTextDoItSob , "SET", "RGB" , RGB(0,255,0) )
   CASE "Update"
      IF (  TextTxt == " all" ) then
         Sob ( FreeTextDoItSob , "SET", "TITLE" , noTag )
         sob ( FreeTextDoItSob , "SET", "RGB" , defbtnCol )
      ELSE
         sob ( FreeTextDoItSob , "SET", "TITLE" , actionTxt )
         sob ( FreeTextDoItSob , "SET", "RGB" , RGB(0,255,0) )
      END if

   CASE else
      Sob ( FreeTextDoItSob , "SET", "TITLE" , noTag )
      sob ( FreeTextDoItSob , "SET", "RGB" , defbtnCol )

   END SELECT

END FUNCTION

FUNCTION cbSelectFreeTextAction ( sobid , row )
   cbDefineFreeTextDoIt ()
END FUNCTION

FUNCTION cbSelectFreeTextItem ( sobid , row )
   cbDefineFreeTextDoIt ()
   cbSelectFreeTextField ( 1,1)
END FUNCTION

FUNCTION MakeFreeTxtActions ()

   dim TagTxtAreaCol = sob ( TagTxtOvl , "ADD", "CONTAINER", "COLUMN.W")

   sob(TagTxtAreaCol,"add","LABEL"  ,   "Free Text fields"  )
   sob ( -1 , "SET" , "RGB" , 0x0ff00 )

   tmpSob = sob ( TagTxtAreaCol , "ADD", "CONTAINER", "ROW.w")

   FreeTextActionSob   = sob ( tmpSob , "add" , "COMBO"  ,   "DROPDOWN", defTypeComboText )
   sob ( -1 , "add" , "ROW" , "Show" )
   sob ( -1 , "add" , "ROW" , "Clear" )
   sob ( -1 , "add" , "ROW" , "Update" )
   sob ( -1 , "SET" , "SELECTION" , "ROW" , 1 )
   sob ( -1 , "ON"  , "SELECTION" , "cbSelectFreeTextAction" )

   FreeTextComboSob    = sob ( tmpSob , "add" , "COMBO"  ,   "DROPDOWN", defTypeComboText )

   sob ( -1, "set", "stretch", 1 )

   FreeTextDoItSob = sob ( tmpSob , "add" , "BUTTON" ,   "PUSH",   "        " )
   sob ( -1 , "set" , "title" , noTag )

   sob ( -1 , "ON" , "press"    , "cbFreeTextDoIt")
   ' --------------------

   sob ( TagTxtAreaCol , "add" , "SPACE" , 0 , 20)
   sob ( -1 , "SET" , "RGB" , -1 )

   sob ( FreeTextComboSob , "EMPTY")

   sob ( FreeTextComboSob , "add" , "row" ,  NoTag )

   sob ( FreeTextComboSob , "ON", "SELECTION" ,  "cbSelectFreeTextItem")

   TagTxtEdit = sob(TagTxtAreaCol,"add", "Edit.rows" ,   "  ", 11 )
   '  sob ( -1 , "ON" , "edit"    , "cbFreeTextDotIt")

END Function
MakeFreeTxtActions ()

FUNCTION  cbFreeTextTools ( sobid )
   sob ( TagTxtOvl , "set", "show", 1 )
END Function

FUNCTION MakeTagCommentTools ()

   TagCommentAreaCol = sob ( TagCommentOvl , "ADD", "CONTAINER", "COLUMN.W")

   lblRegionSelection = sob ( -1 , "add" , "LABEL", "Comment associated with a region" )
   sob ( -1 , "SET" , "RGB" , 0x0ff00 )
   TagRectCombo= sob(TagCommentAreaCol,"add","COMBO"  ,   "DROPDOWN", "      "  )

   sob ( TagRectCombo , "EMPTY")
   sob ( TagRectCombo , "ON", "SELECTION" ,  "cbSelectOneRect")

   TagCommentEdit = sob(TagCommentAreaCol,"add", "Edit.rows" ,   "  ", 11 )
   sob ( -1 , "ON" , "edit"    , "cbObjectCommentEdit")

   lblRegionUpdateComment = sob(TagCommentAreaCol,"add","BUTTON"  ,  "PUSH", " "  )
   sob ( -1 , "ON" , "PRESS"    , "CbUPdateTagCommentField")

   sob ( TagCommentAreaCol , "add" , "SPACE" , 0 , 20)
   sob ( -1 , "SET" , "RGB" , -1 )

   lblRegionChangeName = sob(TagCommentAreaCol,"add","LABEL"  ,   "To change the name of this region:"  )

   sob ( -1 , "SET" , "RGB" , 0x0ff00 )

   sob ( TagCommentAreaCol , "add" , "SPACE" , 0 , 10)
   sob ( -1 , "SET" , "RGB" , -1 )

   makeRenameRect ( TagCommentAreaCol )
   makeRenameRect ( TagCommentAreaCol )
   makeRenameRect ( TagCommentAreaCol )
   makeRenameRect ( TagCommentAreaCol )
   makeRenameRect ( TagCommentAreaCol )
   makeRenameRect ( TagCommentAreaCol )
   makeRenameRect ( TagCommentAreaCol )
   makeRenameRect ( TagCommentAreaCol )
   makeRenameRect ( TagCommentAreaCol )
   makeRenameRect ( TagCommentAreaCol )
   sob ( TagCommentAreaCol , "add" , "SPACE" , 0 , 20)
   sob ( -1 , "SET" , "RGB" , -1 )

   lblRegionCreateName = sob(TagCommentAreaCol,"add","LABEL"  ,   "Create new name and apply to this region:"  )
   sob ( -1 , "SET" , "RGB" , 0x0ff00 )

   sob ( TagCommentAreaCol , "add" , "SPACE" , 0 , 10)
   sob ( -1 , "SET" , "RGB" , -1 )

   makeNewNameRect ( TagCommentAreaCol )

   sob ( TagCommentAreaCol , "add" , "SPACE" , 0 , 10)
   sob ( -1 , "SET" , "RGB" , -1 )

   ' -----------------------------------------------------
   tmpSob = sob ( TagCommentAreaCol , "ADD", "CONTAINER", "ROW.HW" )

   SOB ( "OVERRIDE" , "STYLE+"  , 0x00002000)
   >zzDeleteZZ
   >>Regionzz
   freestring= replace ( freestring , "ZZ" , chr(0x0d) )

   lblRegionDelete =   sob ( tmpSob , "add" , "BUTTON" , "PUSH" ,freestring )
   sob ( -1 , "ON", "press", "cbDeleteRegion" )

   SOB ( "OVERRIDE" , "STYLE+"  , 0x00002000)
   >ZZFree TextZZ
   >>ToolsZZ
   freestring= replace ( freestring , "ZZ" , EOL )

   sob ( tmpSob , "add" , "BUTTON" , "PUSH" ,freestring )
   sob ( -1 , "ON", "press", "cbFreeTextTools" )
   sob ( -1 , "SET" , "RGB" , rgb(0,255,0) )

   SOB ( "OVERRIDE" , "STYLE+"  , 0x00002000)
   >ZZTaggingZZ
   >>ToolsZZ
   freestring= replace ( freestring , "ZZ" , EOL )

   sob ( tmpSob , "add" , "BUTTON" , "PUSH" ,freestring )
   sob ( -1 , "ON", "press", "cbtoolsMenuTagFilesB" )
   sob ( -1 , "SET" , "RGB" , rgb(0,255,0) )
   ' -----------------------------------------------------

   SetLblRegionRGB ( defBtnCol )

END FUNCTION
MakeTagCommentTools()
fncMakeRubberBandTools ()
FUNCTION  cbBulkExportDoAllDrop ( sobid )
   IF   (  sob(sobid,"GET" , "TITLE" ) == NoTag )    then
      EXIT function
   END IF

   IF ( ! isDBopen  ) then
      ErrorReport ("No database selected" )
      EXIT function
   END IF

   dim i , hasHash , inDir
   FOR i = 1 to GetDropCount

      IF ( isFile ( getDropData ( i ) )  == 1 )   then
         sob( PathFile , "ADD" , "ROW" , "Drag'n'Drop file " & getDropData ( i  )  & EOL )
         hashash = getFileHash ( getDropData ( i ) )
         cbBulkActionOnHash ( hasHash )
      ELSEIF ( isFile ( getDropData ( i ) )  == -1 )   then

         inDir= getDropData ( i )   & "\\"
         cancelClear ()
         cancelText( "Identifing target files" , 0 )
         cancelText( "This can take a short while" , 3 )
         cancelShow(1)

         dbFileList ( "temp", "bulk" , inDir, -1 , ,"MD5"  )

         SELECT count (*) from temp.bulk where type  like 'file'
         fileCount = qrSingleValue

         cancelText( "Tagging in progress" , 0 )
         cancelText( "This can take a short while" , 3 )
         cancelText( "Files to process: " & FileCount , 2 )

         WITHQUERY ( "select hash , ( path|| name ) from temp.bulk where type  like 'file' ")
            sob( PathFile , "ADD" , "ROW" , wqText(2)  & EOL )
            cbBulkActionOnHash ( wqtext(1) )
            cancelToggle ()
            fileCount--
            IF ( fileCount BAND 0x0f ) then
            ELSE
               cancelText( "Files to process: " & FileCount , 2 )
            END IF

         END WithQuery
         cancelShow(0)
      ELSE
      END IF
   NEXT i

END function

FUNCTION cbBulkExportDoOnePress ( sobid )

   IF ( ! isDBOpen ) then
      ErrorReport ("No database selected" )
      EXIT function
   END if

   dim actionType , TagType , TagTxt , fileCount

   dim BaseSob  = sob(sobid ,"SIBLING",  -4)

   actionType = sob( BaseSob , "GET" , "TITLE" )
   TagType    = sob( sob(BaseSob ,"SIBLING",  1) , "GET" , "TITLE" )
   TagTxt     = sob( sob(BaseSob ,"SIBLING",  3) , "GET" , "TITLE" )

   SELECT count(*) from temp.SubList
   fileCount = qrSingleValue

   cancelClear ()
   cancelText( "Tagging the filtered Files" , 0 )
   cancelText( "This can take a short while" , 3 )
   cancelText( "Files to process: " & FileCount , 2 )
   cancelShow(1)

   WITHQUERY ( "select hash from temp.SubList where type like 'file' " )

      updateSingleFile ( wqText(1) , actionType, tagType , tagTxt )

      cancelToggle ()
      fileCount--
      IF ( fileCount BAND 0x0f ) then
      ELSE
         cancelText( "Files to process: " & FileCount , 2 )
      END IF

   END withQuery
   cancelShow(0)
   toggleWarnColour ( sobid )
END function

FUNCTION makeBulkExportTaggerRows ( sobidParent )

   dim thisRowSob = sob ( sobidParent , "ADD", "CONTAINER", "ROW" )

   sob ( -1 , "ADD" , "COMBO"  , "dropDOwn" , defActionComboText )
   sob ( -1 , "add" , "row" ,  NoTag )
   sob ( -1 , "add" , "row" , "add" )
   '   sob ( -1 , "add" , "row" , "replace" )
   sob ( -1 , "add" , "row" , "remove" )
   sob ( -1 , "add" , "row" , "remove all" )

   sob ( -1 , "SET" , "SELECTION" , "ROW", 1 )
   sob ( -1 , "ON"  , "SELECTION" , "cbBulkActionSelect" )

   dim comboSob = sob ( -1 , "ADD" , "COMBO"  , "dropdown" , defTypeComboText )
   sob ( -1 , "add" , "row" , NoTag )
   sob ( -1 , "SET" , "SELECTION" , "ROW", 1 )
   sob ( -1 , "ON"  , "SELECTION" , "cbFilterTagSelect" )

   ' to automatically populate with Tag Group changes
   isTagTypeCombo ( ComboSob  )
   isSavedTagTypeCombo ( ComboSob  )

   sob ( thisRowSob , "Add" , "edit" , "         " )
   sob ( -1 , "empty" )

   sob ( -1 , "ON","EDIT"   ,   "onEditFile " )
   sob ( -1 , "ON","EDITED" ,   "onEditedFile" )

   sob ( -1 , "ON","ENTER", "CB_FIND_tag")
   sob ( -1 , "add","COMBO" , "dropdown" , "                        "   )
   sob ( -1 , "empty")
   sob ( -1 , "SET" , "STRETCH" , 1) ' on

   sob ( thisRowSob , "add" , "Button" , "PUSH", "    " )
   sob ( -1 , "set" , "title" , noTag )

   sob ( -1 , "ON", "CLICK", "cbBulkExportDoOnePress")

END FUNCTION

dim PowerTaggingSob

FUNCTION makeBulkExportTagger (  )

   dim BulkArea   = sob ( FileExportOvl , "ADD", "CONTAINER", "COLUMN.W")
   PowerTaggingSob = BulkArea
   sob ( BulkArea , "ADD" , "CONTAINER" , "COLUMN")
   '  sob ( -1 , "add" , "SPACE" , 0 , 20)
   '  sob ( -1 , "SET" , "RGB" , -1 )

   sob ( -1 , "add" , "LABEL", "TAG the files in the sublist." )
   sob ( -1 , "SET" , "RGB" , 0x0ff00 )

   ' -------------------------------------
   ' now define the replicated ROWS

   ' if needed give a common text heading for the columns
   sob ( BulkArea , "ADD", "CONTAINER", "ROW")
   sob ( -1 , "add", "LABEL" , "Action        Tag Group   Filter     Tag Name           " )
   sob ( -1 , "add" , "SPACE", 0,0 )

   bulkExportMatrix =  sob ( BulkArea , "ADD", "CONTAINER", "COLUMN.W")
   dim i
   FOR i = 0 to NbrBulkExportRows
      makeBulkExportTaggerRows (bulkExportMatrix)
   NEXT i
   sob ( FileExportOvl , "add" , "SPACE", 0,0 )

   sob ( -1 , "SET" , "RGB" , -1 )

END function

makeBulkExportTagger ()

' -------------------------------------------------------
FUNCTION onPushOfferFileDelete  ( sobid )

   dim filename = sob ( FileListSob , "get", "title")
   
      if ( filename == "" ) then
     exit function
   END IF
   
   dim fileToDelete  = left ( filename, -10 )

   > delete from master where path||name Like
   freestring = freestring & " " & sqlString ( fileToDelete )
   sql ( freestring )

   deleteFile ( fileToDelete )

   dim index = sob ( FileListSob , "get", "selection", "row" )
   sob ( FileListSob , "delete", "row", index )
   sob ( FileListSob , "set", "selection", "row" , 1 )

END FUNCTION

dim FileNameNotinDB

' --------------------------------------------------

FUNCTION getProperty ( oFolder, oFile, index ) string
   dim i , tmpstr , name
   getProperty = ""
   dim res = oFolder.GetDetailsOf ( oFile, index)
   IF ( res <> "" ) then

      name =    oFolder.GetDetailsOf ( NULL,index)

      SELECT case length(name)
      CASE 0 to 6
         name = name & chr(0x09) & chr(0x09)& chr(0x09)& chr(0x09)
      CASE 6 to 13
         name = name & chr(0x09) & chr(0x09)  & chr(0x09)
      CASE 12 to 20
         name = name & chr(0x09)    & chr(0x09)

      CASE else
         name = name & chr(0x09)
      END select

      getProperty = name
      FOR i = 0 to length (res) -1
         tmpstr =  mid(res, i ,1 )
         IF (    asc (  tmpstr )  < 0x080 ) then
            getProperty = getProperty &  tmpstr
         END IF
      NEXT i
   END if

END function

FUNCTION handleFileGetDetailsOf ( AppDisplay , filePathName   )

   dim fs, folder

   dim FilePath =  Left ( filePathName ,  inStrRev ( filePathName , "\\" ) - 1)
   dim FileName =  Left ( filePathName , -1 *  inStrRev ( filePathName , "\\" )  )

   dim objShell = CreateObject ("Shell.Application")
   dim objFolder = objShell.Namespace(FilePath)
   dim objFile = objFolder.parsename (FileName )
   sob ( AppDisplay,"ADD", "ROW",  EOL & EOL & "Tags from SHELL" & EOL & EOL )

   dim i  , txt

   FOR i = 0 to 330

      SELECT case i
      CASE 0 to 6
      CASE 10 , 57 , 61
      CASE 164 , 169
      CASE 190 to 196
      CASE else
         txt =  getProperty ( objFolder, objFile, i )

         IF ( txt <> "" ) then
            SELECT case length(txt)
            CASE 0 to 7
               txt = txt & chr(0x09) & chr(0x09)& chr(0x09)
            CASE 8 to 15
               txt = txt & chr(0x09) & chr(0x09)
            CASE else
               txt = txt & chr(0x09)
            END select
            '        sob ( AppDisplay,"ADD", "ROW", right ( "0000" & i , 3)  & "  " & objFolder.GetDetailsOf (  NULL , i ) & "    " &   objFolder.GetDetailsOf ( objFile,i) & EOL )
            sob ( AppDisplay,"ADD", "ROW", txt & EOL )
         END if
      END select
   NEXT i
   SOB ( AppDisplay , "SET" , "ROW" , "TOP" , 1 )
END function

' --------------------------------------------------

' EXIF data contains an orientation value from 1 to 8:
'   1 = 0 degrees: the correct orientation, no adjustment is required.
'   2 = 0 degrees, mirrored: image has been flipped back-to-front.
'   3 = 180 degrees: image is upside down.
'   4 = 180 degrees, mirrored: image has been flipped back-to-front and is upside down.
'   5 = 90 degrees: image has been flipped back-to-front and is on its side.
'   6 = 90 degrees, mirrored: image is on its side.
'   7 = 270 degrees: image has been flipped back-to-front and is on its far side.
'   8 = 270 degrees, mirrored: image is on its far side.

FUNCTION handleFileWIA ( AppDisplay , filePathName )

   dim fs, folder

   dim FilePath =  Left ( filePathName ,  inStrRev ( filePathName , "\\" ) - 1)
   dim FileName =  Left ( filePathName , -1 *  inStrRev ( filePathName , "\\" )  )

   dim objIF = CreateObject("WIA.ImageFile")
   dim objV  = CreateObject("WIA.Vector")

   TRY
      objIF.LoadFile ( filePathName )
   CATCH
      sob ( AppDisplay,"ADD", "ROW",  "File error, or file not supported by WIA.IMAGEFILE" & EOL & EOL )
      handleFileGetDetailsOf ( AppDisplay , filePathName   )
      EXIT function
   END try

   sob ( AppDisplay,"ADD", "ROW",   EOL & EOL & "Tags from WIA" & EOL & EOL )

   dim txt , limit , name
   dim prop , i = 0 ,j , oV

   FOR each prop in objIF.properties

      '     sob ( AppDisplay,"ADD", "ROW", objIF.properties.item(i).PropertyID & EOL)

      WITH prop
         IF ( (  .PropertyID <> 20507) And ( .PropertyID <> 20624) And ( .PropertyID <> 20625)) Then

            name = .name

            SELECT case length(name)
            CASE 0 to 6
               name = name & chr(0x09) & chr(0x09)& chr(0x09)& chr(0x09)
            CASE 6 to 13
               name = name & chr(0x09) & chr(0x09)  & chr(0x09)
            CASE 12 to 20
               name = name & chr(0x09)    & chr(0x09)
            CASE else
               name = name & chr(0x09)
            END select
            sob ( AppDisplay,"ADD", "ROW",  name     )
            i++
            IF .IsVector = False Then
               IF .type = 1006  Then
                  TRY
                     sob ( AppDisplay,"ADD", "ROW",  .Value  & " " & .Value.Numerator & "/" & .Value.Denominator & "  "   &  chr(0x0a) )
                  CATCH
                     sob ( AppDisplay,"ADD", "ROW", "1066   " &    .Value    &  chr(0x0a) )
                  END TRY
              
              ELSE
                  TRY
                     sob ( AppDisplay,"ADD", "ROW",   .Value  & " " &  EOL )
                  CATCH
                     sob ( AppDisplay,"ADD", "ROW",  "   .Value  ?? " &  EOL )
                  END try
               END If
            ELSE
               ' isVector
               oV = .Value
               txt = ""

               limit = oV.Count
               IF ( limit  > 64 ) then limit = 64

               FOR j = 1 To limit
                  IF ( j == 1 ) then
                     txt = txt & istype(ov.item(j) ) & " "
                  END if

                  TRY
                     txt = txt & hex( oV.Item(j) ) & " "
                  CATCH
                     txt = txt & " ? "
                  END try
               NEXT j

               IF ( oV.Count  > 64 ) then txt = txt & "..."

               txt = Trim(txt)

               sob ( AppDisplay,"ADD", "ROW",  txt & EOL )

            END If

         END iF
      END with
   NEXT prop

   IF ( ! i ) then
      sob ( AppDisplay,"ADD", "ROW",  "no WIA tags found"  &  EOL )
      handleFileGetDetailsOf ( AppDisplay , filePathName   )
   END if

   SOB ( AppDisplay , "SET" , "ROW" , "TOP" , 1 )

END function

FUNCTION removeDeadFiles ( )

   > select path||name , self from temp.masterfilE
   WITHQUERY ( freestring )

      IF ( isFile ( wqtext(1))   ) then
      ELSE
         > delete from temp.masterfilE where self =
         freestring = freestring & " " & wqInt(2)
         sql(freestring)
      END if
   END withquery
   delete from temp.masterfilE where not self = ( select self from temp.masterfilE limit 1 )

END function

FUNCTION cbSingleFile ( targetFile )

   ' ----------------------------------------------
   Currenthash = ""
   CurrentFile = ""
   CurrentRowid = 0

   sob (PathFile,  "empty")
   sob (TagInfo,   "empty")
   sob (StatusTxt, "empty")
   ReleaseImage (sobImageHolder)
   removeThumbNails ( siImageMngmtMatrix )

   removeAllThumbNails ()
   delete from  tblRectList

   sob (TagRectCombo,"empty")

   NoErrorReport (  "" )

   FileNameNotinDB = ""

   IF ( targetFile == "" ) then
      EXIT function
   END IF
   makebkTree ()
   ' ----------------------------------------------

   drop table if exists temp.inputFile
   dbFileList ( "temp", "inputFile" , targetFile,   , ,"MD5"  )

   SELECT count (*) from temp.inputFile
   IF ( qrsingleValue == 1 ) then
   ELSE
      ErrorReport ( "File not found in file system"  )
      EXIT function
   END if

   ' ----------------------------------------------
   ' display the selected file as an IMAGE (if possible)

   AssignImage ( sobImageHolder , targetFile )

   ' ---------------------------------------------------
   ' check for a valid EXTENSION type

   dim i , j = 0 , haveExt
   IF ( extArray(0) == "*"  )  THEN
   ELSE
      SELECT ext from temp.inputFile
      haveExt = qrsingleValue

      FOR i = 0 to uBound ( extArray )
         IF ( haveExt ==  extArray(i) )  then
            j = 1
            EXIT for
         END IF
      NEXT i

      IF ( ! j ) then
         ErrorReport (  "Invalid extension"  )
         EXIT function
      END if
   END if

   ' ---------------------------------------------------

   sob ( FileListSob , "empty")

   ' ---------------------------------------------------
   ' work out whether (and how) we know this file

   ' ------------------------------------
   '  1) filesystem based cryptographic  hash e.g. MD5
   dim FileStatus = 0

   IF (!  FileStatus ) then
      ' see if FILE is   in DB

      ' careful  use hash here (old dbFileList no fsHash)
      update temp.inputFile set key =  Hash || path || name

      ' careful  use fshash here
      update master   set key =  fsHash || path || name

      drop table if exists temp.masterfilE
      create temp table masterfilE as select *, rowid as self from master where key in (select key from inputFile)
      removeDeadFiles ( ) 

      SELECT count (*) from temp.masterfilE
      IF ( qrsingleValue == 1) then
         FileStatus = 1
      END IF
   END IF

   ' ------------------------------------
   ' 2) simply by it's location i.e. path/name

   IF (!  FileStatus ) then
      ' see if FILE is
      '  in DB by full name  but not  fsHash

      update temp.inputFile set key =  path || name

      '   select key from inputFile limit 1
      '  report ( qrSingleValue )

      drop table if exists temp.MASTERfile
      create temp table MASTERfile as select *, rowid as self from master where (path || name) in (select key from inputFile)
      removeDeadFiles ( )
      SELECT count (*) from temp.MASTERfile
      IF ( qrsingleValue == 1) then
         sob (StatusTxt, "SET" ,"TITLE" , "WARNING:  file in database, but it's fsHASH has changed!" & EOL )
         sob (StatusTxt,"SET", "RGB" , WarningCol )
         FileStatus = 1
      END IF

   END IF

   MakeBkTree()

   ' ------------------------------------
   ' 3) by it's  pHash/dHash (only relevant for Image files)

   IF (!  FileStatus ) then

      dim pHash = 0 , dHash = 0
      phash = canvas("new", "phash.from.file", targetFile , byref dHash )
      ' first see if it has a pHash
      IF ( pHash ) then

         ' has a  pHash/dHash so look for this pair in the database
         drop table if exists temp.MasTerFile   
         > create temp table MasTerFile as select *, rowid as self from master where pHash  =
         freestring = freestring & " " & pHash
         >>  and dHash =
         freestring = freestring & " " & dHash  
         sql(freestring)

         removeDeadFiles ( )

         SELECT count (*) from temp.MasTerFile
         IF ( qrsingleValue == 1) then

            sob ( FileListSob , "ADD", "ROW", "External: " &  targetFile  )
            sob (StatusTxt,"SET" ,"TITLE" , "WARNING:  file NOT in database, but image hashes are known!" & EOL )
            sob (StatusTxt,"SET", "RGB" , WarningCol )
            FileStatus = 1
         END IF   

      END if

   END IF

   ' ---------------------------------------------------

   CurrentFile = targetFile

   IF (!  FileStatus ) then
      sob ( FileListSob , "ADD", "ROW", "External: " &  targetFile  )
      sob ( FileListSob , "set", "selection" , "ROW", 1  )
      ErrorReport (  "File unknown in database"  )
      EXIT function
   END IF

   >  select self, hash , path||name from temp.MasTerFile limit 1
   WITHQUERY ( freestring )
      CurrentRowid = wqInt (1)
      Currenthash = wqtext ( 2 )
      CurrentFile = wqtext ( 3 )
   END withquery

   ' ---------------------------------------------------

   update master   set key =   Hash || path || name

   ' ----------------------------------------------

   CreateRectInfo ()
   sob ( reDrawRegionsID , "trigger")

   ' ----------------------------------------------
   ' show names of Files in database with same HashValue

   > select (  path ||  name ) as FullName from master where  Hash =
   freestring =   freestring & " " &  sqlstring ( CurrentHash )

   WITHQUERY ( freestring )
      sob ( FileListSob , "ADD", "ROW", "Internal: " & wqText(1) )
   END withQuery

   sob ( FileListSob , "set", "selection" , "ROW", 1  )

   ' ----------------------------------------------
   ' now display the tag info for this fsHASH

   sob ( TagInfo , "SET", "SHOW", 0)

   DisplayTagsInFile ()

   IF (  haveWIA ) then
      IF ( sob ( SingleFileMenuWIA , "GET" , "CHECK" ) ) then   handleFileWIA ( TagInfo , CurrentFile )
   END IF
   IF (  haveShell ) then
      IF ( sob ( SingleFileMenuGetDetailsOf , "GET" , "CHECK" ) ) then  handleFileGetDetailsOf ( TagInfo ,CurrentFile   )
   END IF
   sob ( TagInfo , "SET", "SHOW", 1)

END Function

FUNCTION CB_drop_on_Image_area ( sobid   )
   emptyThings ()
   dim CanvasHandle
   IF ( ! isDBopen  ) then
      ErrorReport  ( "No Database selected" )
      EXIT function
   END IF

   IF  GetDropCount  == 1 THEN
      IF ( isFile ( getDropData(1) ) == 1 ) then
         cbSingleFile (  getDropData(1)   )
      END IF
   ELSE
      ReleaseImage (sobImageHolder)<
      EXIT function
   END if

END function

sob ( sobImageHolder   ,"ON","DROP.FILE", "CB_drop_on_Image_area")

FUNCTION  on@drb ( sobid , row, col )

   IF ( sob( sobid,"GET", "CELL", 0 ,1 )  == "path" )  then
      freestring = sob( sobid,"GET", "CELL", row ,1 ) & sob( sobid,"GET", "CELL", row ,2 )
      '     cbSingleFile (freestring )
      ShellExecute ( sob( sobid,"GET", "CELL", row ,1 ))
   END if
   inherit   on@drb ( sobid, row, col)
END function

FUNCTION updateHistory (  cmd )
   create table if not exists history ( cmd )
   sql ( replace ( "insert into History  values ( $cmd )" ,  "$cmd" , sqlstring (cmd)   ) )
   sql ( cmd )
END function

FUNCTION  replacedelim ( colName , oldDelim , newDelim)

   > update master set
   freestring = freestring & " " &  sqlIdentifier  ( colName )
   >>  =  replace (
   freestring = freestring & " " &  sqlIdentifier  ( colName )
   >> ,
   freestring = freestring & " " &  sqlstring ( oldDelim )
   >> ,
   freestring = freestring & " " &  sqlstring ( newDelim )
   >> )
   sql(freestring )

END Function

FUNCTION rePlaceDelim ()

   dim oldDelim = "§"
   dim newDelim = chr ( 0x01e ) & "§"     ' RS  = Record Separator

   IF ( haveRectPicasa ) then
      replacedelim ( "RectPicasa" , oldDelim , newDelim)
   END if

   IF ( haveRectMeta ) then
      replacedelim ( "RectMeta" , oldDelim , newDelim)
   END if

   replacedelim ( "whoTag" , oldDelim , newDelim)
   replacedelim ( "whatTag" , oldDelim , newDelim)
   replacedelim ( "whereTag" , oldDelim , newDelim)
   replacedelim ( "whenTag" , oldDelim , newDelim)
   replacedelim ( "keyWordtag" , oldDelim , newDelim)
   replacedelim ( "for DeletionTag" , oldDelim , newDelim)

END Function

FUNCTION assertTagGroupSpelling ( TagGroup  ) string

   assertTagGroupSpelling = ""

   > select ttGroup from  tagTable where ttGroup  like $TagGroup limit 1
   freestring = replace ( freestring , "$TagGroup" , sqlIdentifier ( TagGroup & TagGroupId  ) )
   sql ( freestring )

   IF ( istype (qrSingleValue) == "EMPTY" ) then
      ErrorReport ("TAG group" & TagGroup & "  not found TagTable " )
      EXIT function
   END IF

   assertTagGroupSpelling = right ( qrSingleValue , -3 )

END FUNCTION

FUNCTION assertTagSpelling ( TagGroup , name ) string

   assertTagSpelling = ""
   > select ttName from  tagTable where ttGroup  like $tagType and ttName like $name
   freestring = replace ( freestring , "$tagType" , sqlIdentifier ( TagGroup & TagGroupId  ) )
   freestring = replace ( freestring , "$name" , sqlstring ( name ) )
   sql ( freestring )

   IF ( istype (qrSingleValue) == "EMPTY" ) then
      ErrorReport ("TAG " & name & "  not found in TagGroup " & TagGroup )
      EXIT function
   END IF

   assertTagSpelling = qrSingleValue

END FUNCTION

FUNCTION rePlaceTag ( TagGroup , old, new )

   ' ----------------------------------------------------------
   ' BEWARNED
   ' DB replace commands are CASE SENSISTIVE

   TagGroup = assertTagGroupSpelling ( TagGroup)  ' this forces the TagGroup to have the correct case
   old = assertTagSpelling ( TagGroup , old ) ' then force the  OLD  tag name to have correct case
   new = assertTagSpelling ( TagGroup , new ) ' then force the  NEW  tag name to have correct case

   ' ----------------------------------------------------------
   ' update the appropriate TAG GROUP column

   > update master set
   freestring =   freestring  & " " &   sqlIdentifier ( TagGroup & TagGroupId )
   >>    = replace (
   freestring =   freestring  & " " &   sqlIdentifier ( TagGroup & TagGroupId )
   >>   ,
   freestring =   freestring  & " " &   sqlString ( old )
   >>   ,
   freestring =   freestring  & " " &   sqlString ( new )
   >>  ) where
   freestring =   freestring  & " " &   sqlIdentifier ( TagGroup & TagGroupId )
   >>  like
   freestring =   freestring  & " " &   sqlString ( "%" & TagDelim )
   >>  ||
   freestring =   freestring  & " " &   sqlString ( old )
   >>   ||
   freestring =   freestring  & " " &   sqlString ( TagDelim  &  "%"  )

   sql ( freestring )

   ' ----------------------------------------------------------
   ' just in case the tag has been assigned to a RECT
   ' we must update the RectMeta column

   IF ( haveRectMeta ) then
      > update Master  set RectMeta   = replace(RectMeta,
      freestring = freestring & " " &         sqlString ( TagDelim  &  oldName  & ";" )
      >> ,
      freestring = freestring & " " &         sqlString ( TagDelim  &  newName  & ";" )
      >>   ) where RectMeta  like
      freestring = freestring & " " &         sqlString ( %" & TagDelim  &  oldName  & ";%"  )
      sql ( freestring )
   END if

   ' ----------------------------------------------------------
   CreateUsersTagTableAndColumnsList ()
   resetTagBoxes ()

   ' ----------------------------------------------------------

   IF ( imageLoadedFlag ) then
      DisplayTagsInFIle ()
      fncShowRegions ()
      fnOfferRectChoice ()
   END IF

END Function

FUNCTION deleteTag ( TagGroup , old )

   ' ----------------------------------------------------------
   ' BEWARNED
   ' DB replace commands are CASE SENSISTIVE

   TagGroup = assertTagGroupSpelling ( TagGroup)
   old = assertTagSpelling ( TagGroup , old )
   ' new = assertTagSpelling ( TagGroup , new )

   ' ----------------------------------------------------------

   > DELETE  from tagTable where ttGroup  like
   freestring =   freestring  & " " &   sqlString ( TagGroup & TagGroupId )
   >> and ttName like
   freestring =   freestring  & " " &   sqlString ( old )
   sql ( freestring )

   > update master set
   freestring =   freestring  & " " &   sqlIdentifier ( TagGroup & TagGroupId )
   >>  = REPLACE (
   freestring =   freestring  & " " &   sqlIdentifier ( TagGroup & TagGroupId )
   >> ,
   freestring =   freestring  & " " &   sqlString ( TagDelim & OLD & TagDelim )
   >> ,
   freestring =   freestring  & " " &   sqlString ( TagDelim )
   >> )
   sql ( freestring )

   deReferenceTagInRegions (   TagGroup , old   )

   CreateUsersTagTableAndColumnsList ()
   resetTagBoxes ()
   IF (   imageLoadedFlag ) then
      DisplayTagsInFIle ()
      fncShowRegions ()
      fnOfferRectChoice ()
   END IF

END Function

FUNCTION renameTag ( tagGroup , oldName , newName )

   ' ----------------------------------------------------------
   ' BEWARNED
   ' DB --replace-- commands are CASE SENSITIVE

   TagGroup = assertTagGroupSpelling ( TagGroup)
   oldName = assertTagSpelling ( TagGroup , oldName )

   ' ----------------------------------------------------------
   '   check that NewName is not already used

   > select count (*) from TagTable where ttgroup like
   freestring = freestring & " " &         sqlIdentifier ( TagGroup & TagGroupId  )
   >> and ttname like
   freestring = freestring & " " &         sqlstring ( newName )
   sql ( freestring )

   IF ( qrSingleValue   ) then
      ErrorReport ("TAG " & newName & "  already in TagGroup " & TagGroup )
      EXIT function
   END IF

   > update TagTable  set ttname =
   freestring = freestring & " " &         sqlString (newName )
   >> where ttname like
   freestring = freestring & " " &         sqlString (oldName )
   >>  and ttGroup like
   freestring = freestring & " " &         sqlString (TagGroup & TagGroupId  )

   sql ( freestring )

   ReReferenceTagInRegions (  TagGroup , oldName  , newName  )

   > update Master  set
   freestring = freestring & " " &         sqlIdentifier ( tagGroup  & TagGroupId )

   >> = replace(
   freestring = freestring & " " &         sqlIdentifier ( tagGroup  & TagGroupId )
   >> ,
   freestring = freestring & " " &         sqlString ( TagDelim   &  oldName   & TagDelim   )
   >> ,
   freestring = freestring & " " &         sqlString ( TagDelim   &  newName   & TagDelim   )
   >> )  where
   freestring = freestring & " " &         sqlIdentifier ( tagGroup  & TagGroupId )
   >> like
   freestring = freestring & " " &         sqlString ( "%" & TagDelim  &  oldName   & TagDelim& "%"    )

   sql ( freestring )

   CreateUsersTagTableAndColumnsList ()
   resetTagBoxes ()

   IF ( imageLoadedFlag ) then
      DisplayTagsInFIle ()
      fncShowRegions ()
      fnOfferRectChoice ()
   END IF

END FUNCTION

FUNCTION makeNewTagType ( TagGroup )

   TRY
      > alter table master add column
      freestring = freestring & " " &      sqlString ( TagGroup & TagGroupId )
      sql ( freestring )

      > update master set
      freestring =   freestring  & " " &   sqlIdentifier ( TagGroup & TagGroupId )
      >>  =
      freestring =   freestring  & " " &   sqlString ( TagDelim )
      sql ( freestring )

   CATCH
      ErrorReport ("Could not create column "    &   TagGroup   & "  in table  MASTER" )
      EXIT function
   END try

   > INSERT into  tagTable values (
   freestring =   freestring  & " " &   sqlString ( TagGroup & TagGroupId  )
   >>  ,
   freestring =   freestring  & " " &   sqlString ( TagDelim )
   >>   , '' )
   sql ( freestring )

END Function

' ------------------------------------------------------------------

FUNCTION  onTagNameDoItClicked  ( sobid  )

   IF ( ! isDBopen ) then
      ErrorReport ("No database selected" )
      EXIT function
   END IF

   dim actionTxt = sob ( TagNameActionComboSOB, "GET", "TITLE")
   dim tagGroup  = sob ( TagGroupComboSob,      "GET", "TITLE" )
   dim tagName   = sob ( TagNameComboSob,       "GET", "TITLE" )
   dim newName   = sob ( TagNameNewNameSOB,     "GET", "TITLE" )

   IF ( TagGroup == "Tagged" ) then
      ErrorReport ("Actions on this tag group are not allowed" )
      EXIT function
   END if

   IF ( actionTxt == NoTag ) then
      sob ( TagNameComboSob, "Empty")
      EXIT function
   END IF

   IF ( tagGroup == NoTag ) then
      ErrorReport ( "No Tag Group Selected"   )
      sob ( TagNameComboSob, "Empty")
      EXIT function
   END IF

   IF ( actionTxt  == "edit" ) then
      sob ( TagNameNewNameSOB , "empty")
      sob ( TagNameNewNameSOB, "add" , "row" , selTxt  )
      sob ( TagNameNewNameSOB, "SET", "TITLE" , selTxt )
      sob ( TagNameNewNameSOB, "SET", "RGB"   , 0xff  )
   ELSEIF ( actionTxt  == "new" ) then
      > select count(*)  from tagTable where ttGroup like $tag  and ttName like $nam
      freestring = replace ( freestring , "$tag" , sqlstring ( tagGroup & TagGroupId) )
      freestring = replace ( freestring , "$nam" , sqlstring ( newName) )
      sql ( freestring )

      IF ( qrSingleValue > 0 ) then
         ErrorReport ("Tag " & newName & " already exists in tag group " & TagGroup )
      ELSE
         > insert into tagTable values ( $tag , $nam , '' )
         freestring = replace ( freestring , "$tag" , sqlstring ( tagGroup & TagGroupId) )
         freestring = replace ( freestring , "$nam" , sqlstring ( newName) )
         sql (freestring )
         sob ( TagNameNewNameSOB,  "empty")
      END IF

   ELSEIF ( actionTxt  == "rename" ) then
      renameTag ( tagGroup , tagName , newName )
   ELSEIF ( actionTxt  == "delete" ) then
      deleteTag ( tagGroup , tagName )
   ELSEIF ( actionTxt  == "move" ) then

      '  newName   must be the name of an existing TAGGroup
      ' and not =    TagGroup

      newName = assertTagGroupSpelling ( newName  )
      IF ( newName == "" ) then
         ErrorReport ("Destination tag group -" & sob ( TagNameNewNameSOB,     "GET", "TITLE" )   &  "- does not exist")
         EXIT function
      END IF

      IF ( TagGroup == newName ) then
         ErrorReport ("Destination tag group same as source tag group")
         EXIT function
      END IF

      ' -----------------------------

      IF ( haveRectMeta ) then
         > update master  set RectMeta = replace ( RectMeta ,
         freestring = freestring & " " &   sqlString ( "," & TagGroup  & TagDelim & TagName)
         >> ,
         freestring = freestring & " " &   sqlString ( "," & NewName  & TagDelim & TagName)
         >> )
         sql(freestring)
      END if

      ' -----------------------------

      > update master
      >> SET
      >>   dstGroup =  dstGroup || TagName || TagDelim
      >>   WHERE
      >>   srcGroup like '%' || TagDelim ||  TagName || TagDelim   ||'%'
      >>  and NOT dstGroup like '%' || TagDelim ||  TagName || TagDelim   ||'%'

      freestring = replace ( freestring , "TagDelim"  , sqlString(TagDelim) )
      freestring = replace ( freestring , "srcGroup"  , sqlIdentifier (TagGroup & TagGroupId ) )
      freestring = replace ( freestring , "dstGroup"  , sqlIdentifier (newName  & TagGroupId ) )
      freestring = replace ( freestring , "TagName"   , sqlIdentifier (TagName ) )
      sql(freestring)

      > update master  SET srcGroup =  replace ( srcGroup , TagDelim ,    TagDelim || TagName || TagDelim )
      freestring = replace ( freestring , "TagDelim"  , sqlString(TagDelim) )
      freestring = replace ( freestring , "srcGroup"  , sqlIdentifier (TagGroup & TagGroupId) )
      freestring = replace ( freestring , "TagName"   , sqlIdentifier (TagName ) )
      sql(freestring)

      ' -----------------------------

      > update TagTable
      >> SET
      >>   ttGroup  =  dstGroup
      >>   WHERE
      >>   ttGroup like  srcGroup
      >>   and ttName like    TagName

      freestring = replace ( freestring , "srcGroup"  , sqlIdentifier (TagGroup & TagGroupId ) )
      freestring = replace ( freestring , "dstGroup"  , sqlIdentifier (newName  & TagGroupId ) )
      freestring = replace ( freestring , "TagName"   , sqlIdentifier (TagName ) )
      sql(freestring)

   ELSE

   END IF

   UpdateTagNameList (   TagNameComboSob   , tagGroup )

   '  resetTagBoxes ()

   IF ( imageLoadedFlag ) then
      cbSingleFile ( currentFile )
   END IF

   IF ( sob(sobid , "GET" , "RGB" ) ==  altNameCol )  then
      sob(sobid , "SET" , "RGB", defNameCol )
   ELSE
      sob(sobid , "SET" , "RGB", altNameCol )
   END IF

END FUNCTION

sob( TagNameDoItSOB , "on"  , "press" , "onTagNameDoItClicked")

FUNCTION TagGroupDoItClicked ( sobid  )

   IF ( ! isDBopen  ) then
      ErrorReport ("No database selected" )
      EXIT function
   END IF

   dim actionTxt  = sob ( TagGroupActionComboSob, "GET", "TITLE" )
   dim TagGroup   = sob ( TagGroupComboSob, "GET", "TITLE" )
   dim newName    = trim (  sob ( TagGroupNewNameSOB , "GET","TITLE" )  )

   IF ( TagGroup == "Tagged" ) then
      ErrorReport ("Actions on this tag group are not allowed" )
      EXIT function
   END if

   IF ( actionTxt == "new" ) then
      IF (  isDBcolumn ( "master", newName & TagGroupId) ) then
         ErrorReport ("Tag Group -"& newName  & "- already exists." )
         EXIT function
      END if

      makeNewTagType (  newName  )

   ELSEIF  ( actionTxt == "replace" )  then
      IF ( ! isDBcolumn ( "master", newName) ) then
         ErrorReport ("Target  Tag Group does not exist." )
         EXIT function
      END if
   ELSEIF  ( actionTxt == "delete" )  then

      ' remove  any Region reference
      > select ttName from tagTable where ttGroup like
      freestring = freestring & " " &   sqlString (  TagGroup   )
      WITHQUERY ( freestring )
         deReferenceTagInRegions  ( TagGroup , wqText(1)     )
      END withquery

      ' REMOVE FROM TagTable
      > delete tagTable  where ttGroup like
      freestring = freestring & " " &   sqlString (  TagGroup   )
      sql ( freestring )

      ' REMOVE FROM    MASTER
      dbColumnDropByFilter (  "main", "master" , TagGroup & TagGroupId ,   1)

   ELSEIF  ( actionTxt == "move" )  then

      '  newName   must be the name of an existing TAG Group
      ' and not =    TagGroup
      newName = assertTagGroupSpelling ( TagGroup  )

      > select count (*) from TagTable where ttGroup =
      freestring = freestring & " " &   sqlString ( newName & TagGroupId )
      sql(freestring)
      IF ( qrSingleValue == 0 ) then
         ErrorReport ("Destination tag group -" & newName  &  "- does not exist")
         EXIT function
      END IF

      IF ( TagGroup == newName ) then
         ErrorReport ("Destination tag group same as source tag group")
         EXIT function
      END IF

      ' -----------------------------

      IF ( haveRectMeta ) then
         > update master  set RectMeta = replace ( RectMeta ,
         freestring = freestring & " " &   sqlString ( "," & TagGroup  & TagDelim)
         >> ,
         freestring = freestring & " " &   sqlString ( "," & NewName  & TagDelim)
         >> )
         sql(freestring)
      END IF
      ' -----------------------------

      > delete from tagTable where ttGroup like
      freestring = freestring & " " &   sqlString ( TagGroup & TagGroupId )
      >>   and  ttName in ( select ttname from tagtable where ttGroup like
      freestring = freestring & " " &   sqlString ( newName& TagGroupId )
      >> )
      sql(freestring)

      ' -----------------------------

      > update master
      >> SET
      >>   dstGroup =  dstGroup || frmTbl.ttName || TagDelim
      >>  FROM
      >>  ( select ttName  from TagTable where ttGroup = srcGroup ) as frmTbl
      >>   WHERE
      >>   srcGroup like '%' || TagDelim ||  frmTbl.ttName || TagDelim   ||'%'
      >>  and NOT dstGroup like '%' || TagDelim ||  frmTbl.ttName || TagDelim   ||'%'

      freestring = replace ( freestring , "TagDelim" , sqlString(TagDelim) )
      freestring = replace ( freestring , "srcGroup"  , sqlIdentifier (TagGroup & TagGroupId) )
      freestring = replace ( freestring , "dstGroup"  , sqlIdentifier (newName & TagGroupId ) )
      sql(freestring)

      ' -----------------------------

      ' REMOVE FROM TagTable
      > delete from tagTable  where ttGroup like
      freestring = freestring & " " &   sqlString (  TagGroup   )
      sql ( freestring )

      ' REMOVE FROM    MASTER
      dbColumnDropByFilter (  "main", "master" , TagGroup & TagGroupId ,   1)

   ELSE  ' treat as NoTag

   END IF

   CreateUsersTagTableAndColumnsList ()
   '  resetTagBoxes ()  ' irrelevant since  updateTagTypeCombos does it too
   updateTagTypeCombos (  )

   IF ( imageLoadedFlag ) then
      report(" reloaded " )
      cbSingleFile ( currentFile )
   END IF

   dim cnt = sob ( TagGroupComboSob , "GET", "ROWS")
   sob ( TagGroupComboSob  , "SET" ,"SELECTION"  , "ROW" , cnt )

   IF ( sob(TagGroupDoItSob , "GET" , "RGB" ) ==  altTypeCol )  then
      sob(TagGroupDoItSob , "SET" , "RGB", defTypeCol )
   ELSE
      sob(TagGroupDoItSob , "SET" , "RGB", altTypeCol )
   END IF

END FUNCTION

sob( TagGroupDoItSob , "on"  , "CLICK" , "TagGroupDoItClicked")

' -----------------------------------------------------
' RemoveDupsOvl
' -----------------------------------------------------

FUNCTION CbRemoveExternalDuplicates   ( sobid )
   sob ( CommonSobResult, "empty"   )

   IF ( isTable (  , "master") ) then

      sob ( CommonSobResult, "empty"   )

      cancelClear ()
      cancelText( "Reading in new folder" , 0 )
      cancelText( "This can take a short while" , 3 )
      cancelShow(1)

      dim TagArray , uBoundTagArray , i
      dim TargetPath = GetPath & "\\"

      dim src = TargetPath

      update master set key = hash || path || name
      IF ( targetPath = "\\" ) then
         sob ( CommonSobResult,  "ADD" , "row" ,  "Cancelled by user" & EOL  )
         cancelShow(0)
         EXIT function
      END IF

      sql ( replace ( "select count (*) from master where path = $pth", "$pth", sqlString(TargetPath))  )

      IF ( qrSingleValue > 0 ) then
         sob ( CommonSobResult,  "ADD" , "row" ,  "Folder " & TargetPath & EOL & "already in Master" & EOL  )
         EXIT function
      END IF

      cancelText( TargetPath , 1 )
      dbFileList ( "temp", "NewFolder"  , TargetPath , -1 , , "md5" )
      delete from temp.newFolder where (path||name)  in ( select (path||name) from master) and type like 'file'

      SELECT count(*) from temp.newFolder where not hash in ( select hash from master) and type like 'file'
      dim fileCount = qrSingleValue
      cancelText( "Files to keep: " & FileCount , 3 )

      SELECT count(*) from temp.newFolder where hash in ( select hash from master) and type like 'file'
      fileCount = qrSingleValue
      cancelText( "Files to ignore: " & FileCount , 2 )

      WITHQUERY ("select path||name from temp.newFolder where hash in ( select hash from master) and type like 'file' " )
         DeleteFileNow ( wqtext(1) )
         cancelToggle()
         fileCount--
         IF ( fileCount BAND 0x0f ) then
         ELSE
            cancelText( "Files to ignore: " & FileCount , 2 )
         END IF
      END withQuery

      delete from temp.newFolder where hash in ( select hash from master) and type like 'file'

      ' update newfolder set key = path
      update newfolder set key = path || name || '\'  where type like 'folder'
      update newfolder set level = level + 1 where type like 'folder'

      SELECT max ( level ) from newfolder

      FOR i  =  qrSingleValue to 0 step -1
         freestring = replace ( "select  key , path || name from newfolder where    level =  $i group by key having count (*) = 1 " , "$i" , ""&i )

         WITHQUERY ( freestring )
            freestring = replace ( "delete from newfolder where key like $pth ", "$pth" , sqlstring(wqtext(1))   )
            report = freestring
            TRY
               rmdir ( wqtext(2)   )
               sql (freestring )
            CATCH
               report (" failed " & wqtext(2))
            END try
         END withquery
      NEXT i

      cancelShow(0)
   ELSE
      sob ( CommonSobResult, "SET" , "TITLE" , "No open database"   )
   END IF

   toggleWarnColour ( sobid )

END Function

' -----------------------------------------------------
' Rescan Ovl
' -----------------------------------------------------

FUNCTION prepareUpdateForMaster ()

   ' in this FUNCTION we do NOT alter MASTER
   ' we only prepare other temp tables

   dim TagArray , uBoundTagArray , i

   drop table if exists temp.shadowMaster
   drop table if exists temp.dummy
   ' --------------------------------
   ' find the root folders (used in   dbFileList calls )
   ' repeat the dbFileList  calls and merge the results

   cancelClear ()
   cancelText( "Checking folder(s)" , 0 )

   SELECT count (*) from master
   i = qrSingleValue

   cancelText( "This can take about " & cint( (i + 5000) / 5000 ) & "  mins", 3 )

   cancelShow(1)
   ' ------------------------------------------------------------------------------------------------
   ' for each ROOT folder in   MASTER
   ' create a file list and  combine the lists into    shadowMaster
   WITHQUERY ( "select  distinct path  from master where folderkey = 0   " )
      cancelText( wqtext(1) , 1 )
      dbFileList ( "temp", "dummy" , wqtext(1) , -1 , "*" , "MD5" )
      create table if not exists  temp.shadowMaster as  select * from temp.dummy limit 0
      insert into temp.shadowMaster    select * from temp.dummy
      delete  from temp.dummy
   END withQuery
   drop table if exists temp.dummy

   ' ------------------------------------------------------------------------------------------------
   ' needed because the MD5 checksum is in   dbFileList  column   hash
   ' but in the meta database we use   fsHash   for the  filesstem MD5 value

 '  alter table temp.shadowMaster  rename column hash to fsHash

   ' ------------------------------------------------------------------------------------------------
   ' give the shadowmaster the  META columns that Master has

   dbTableColumns ( "master" )
   dbTableColumns ( "shadowMaster" )

   ' identify the COLUMNS that master has that  shadowMaster  does not
   delete from  temp.masterColumns where name in ( select name from temp.shadowMasterColumns)

   ' --------------------------------
   ' temp.masterColumns   lists the COLUMNS in the original MASTER that are not in  shadowMaster  i.e. the list
   ' just created by     dbFileList
   ' These columns need to be created in  shadowMaster,   and the contents in MASTER copied across

   SELECT count (*) from temp.masterColumns
   uBoundTagArray = qrSingleValue

   IF ( uBoundTagArray ) then
      SELECT group_concat (name , ',')  from  temp.masterColumns
      redim TagArray  = split ( qrsingleValue ,  "," )
      uBoundTagArray = uBound ( TagArray )

      ' add the "missing" columns to   shadowmaster
      FOR i = 0 to uBoundTagArray

         ' add the missing column
         >  alter table temp.shadowMaster  add column
         freestring = freestring & " " &  sqlidentifier (TagArray(i) )
         sql ( freestring )

         ' initialise it to have only a    TagDelim
         > update temp.shadowMaster  set
         freestring = freestring & " "   &  sqlidentifier (TagArray(i) )
         freestring = freestring & " = " &  sqlString  (TagDelim)
         sql ( freestring )

      NEXT i
   END IF
   
   update temp.shadowMaster  set  fshash = hash

   ' ------------------------------------------------------------------------------------------------
   ' identify LOST files and NEW files, put them in their own temp tables
   '  LOST  = file      in MASTER     not in  shadowMaster
   '   NEW  = file not  in MASTER         in  shadowMaster

   update Master  set key = path || name
   update temp.shadowMaster  set key = path || name

   drop table if exists temp.newFiles
   create table temp.newFiles as select * from temp.shadowMaster where not key in ( select key from master)

   drop table if exists temp.LostFiles
   create table temp.LostFiles as select * from  master where not key in ( select key from temp.shadowMaster)

   ' --------------------------------
   ' remove LOST files, and NEW files  from the shadowmaster

   delete from  temp.shadowMaster where key in ( select key from  temp.LostFiles  )
   delete from  temp.shadowMaster where key in ( select key from  temp.NewFiles   )
   ' --------------------------------
   ' remove  unchanged    files from shadowMaster

   update Master             set key = path || name || fsHash
   update temp.shadowMaster  set key = path || name || fsHash

   delete from  temp.shadowMaster where key in ( select key from  master   )

   ' --------------------------------
   ' identify changed files, ANYTHING still in shadowMaster must be a changed file
   ' since we have eliminated:  unchanged, lost and new  files
   ' CHANGED = same path/name  but different    fsHash

   drop table if exists temp.changedFiles
   create table temp.changedFiles as select * from temp.shadowMaster
   delete from  temp.shadowMaster where key in ( select key from  temp.changedFiles   )

   ' --------------------------------------------------------------------
   ' handle the CHANGED   files
   ' why not just update the master    fsHash
   ' because if we did, we would lose any lastUpdate info, not really important!

   '   give    CHANGED    files  META data from MASTER
   ' simply give them their ORIGINAL META data

   update temp.changedFiles  set key = path || name
   update master             set key = path || name

   ' since we are not doing any DROP or CREATE commands, we can use a WITHQUERY
   ' for each META column, copy the original META data across
   WITHQUERY ( "select name from  temp.masterColumns" )
      > update temp.changedFiles SET
      >>  $col = frmTbl. $col
      >> FROM
      >>   ( select $col , key  from master  )  as frmTbl
      >>  WHERE
      >>    changedFiles.key = frmTbl.key
      freestring = replace ( freestring , "$col" , sqlidentifier(wqText(1)) )

      sql ( freestring )
   END withquery

   ' --------------------------------------------------------------------
   ' tidy up

   update master set key = hash || path || name

   ' we have NOT removed LOST files, nor added NEW files
   ' we do that later

END FUNCTION

FUNCTION CbRescanDatabase  ( sobid )

   sob ( CommonSobResult, "empty"   )

   IF ( isTable ( , "master") ) then

      prepareUpdateForMaster ()
      cancelShow(0)
      upDateMaster ()

      sob ( CommonSobResult,  "ADD" , "row" ,  Date & " " & time & EOL  )
      SELECT count (*) from temp.newFiles where type like 'file'

      sob ( CommonSobResult,  "ADD" , "row" ,  "New files     : " & qrsingleValue & EOL  )
      SELECT count (*) from temp.changedFiles where type like 'file'

      sob ( CommonSobResult,  "ADD" , "row" ,  "Changed files : " & qrsingleValue   & EOL  )
      SELECT count (*) from temp.lostFiles where type like 'file'

      sob ( CommonSobResult,   "ADD" , "row" ,  "Lost files    : " & qrsingleValue  & EOL   )
      sob ( CommonSobResult,   "ADD" , "row" ,    EOL   )

      sob ( CommonSobResult,   "ADD" , "row" ,  "Update not finalised until Save/SavedAs is triggered." &  EOL   )

   ELSE
      sob ( CommonSobResult, "SET" , "TITLE" , "No open database"   )
   END IF

   toggleWarnColour ( sobid)

END Function

' -----------------------------------------------------
' Scan new folderOvl
' -----------------------------------------------------

dim ScanNewFolderReportSob

FUNCTION PopulateImageInfoIntoNewFiles ()

   ' if a new Folder file is truly new, then we have no pHash / dHash / ImageGroup / IgnoreFile  info for it
   cancelText( "Get pHash / dHash from image files" , 1 )

   dim pHash = 0 , dHash = 0
   > select path||name , rowid    from  temp.NewFolder where  ext in
   freestring = freestring & ImageFileExtensions
   WITHQUERY (freestring )

      phash = canvas("new", "phash.from.file", wqText(1) , byref dHash )

      > update temp.NewFolder  set
      >>  pHash =
      freestring = freestring & " " & pHash
      >>  , dHash =
      freestring = freestring & " " & dHash
      >> , ImageGroup = 0 , IgnoreFile = 0
      >> where fsHash =
      freestring = freestring & " " & sqlidentifier (wqText (2))
      sql(freestring)

   END WithQuery

   > update temp.newFolder
   >> set
   >>    ImageGroup  = num2Hex(pHash) ||     num2Hex(dHash)
   >>  ,  hash       = num2Hex(pHash) ||     num2Hex(dHash)
   >>  where
   >>  not pHash = 0
   sql(freestring)

END Function

FUNCTION addNewFolderStuctureToMaster ()

   cancelClear ()
   cancelText( "Reading in new folder" , 0 )
   cancelText( "This can take a short while" , 3 )
   cancelShow(1)

   dim TagArray , uBoundTagArray , i
   dim TargetPath = GetPath & "\\"

   addNewFolderStuctureToMaster = TargetPath

   cancelText( TargetPath , 1 )
   dbFileList ( "temp", "NewFolder"  , TargetPath , -1 , , "md5" )
   cancelText( "Folder(s) read" , 1 )

   ' -------------------------------------------------
   ' remove any files that we already have in the database
   update temp.NewFolder set key = path||name
   update master set key = path||name
   delete from temp.NewFolder where key in ( select key  from master )

   ' -------------------------------------------------
   ' if no new files then exit
   SELECT count (*) from temp.NewFolder where  type like 'file'

   IF ( qrSingleValue == 0 ) then
      ErrorReport ("Folder: " & TargetPath &   "  already in Master"   )
      EXIT function
   END IF

   ' -------------------------------------------------
   ' want NewFolder  to have same columns as  Master

   dbTableColumns ( "master" )
   dbTableColumns ( "NewFolder" )

   ' identify the COLUMNS that master has that  NewFolder  does not
   delete from  temp.masterColumns where name in ( select name from temp.NewFolderColumns)

   SELECT count (*) from temp.masterColumns
   uBoundTagArray = qrSingleValue

   ' would have liked to use  WITHQUERY, but can not do ALTER TABLE inside it
   cancelText( "Adding customer columns" , 1 )
   IF ( uBoundTagArray ) then
      SELECT group_concat (name , ',')  from  temp.masterColumns
      redim TagArray  = split ( qrsingleValue ,  "," )
      uBoundTagArray = uBound ( TagArray )

      FOR i = 0 to uBoundTagArray

         ' add the "missing" columns to   NewFolder
         >  alter table temp.NewFolder  add column
         freestring = freestring & " " &  sqlidentifier (TagArray(i) )
         sql ( freestring )

         ' give the column the default  value
         > update temp.NewFolder  set
         freestring = freestring & " " &  sqlidentifier (TagArray(i) )
         freestring = freestring & " = " &  sqlString  (TagDelim)
         sql ( freestring )

      NEXT i
   END IF

   ' -------------------------------------------------
   ' there is chance that a new folder file is   direct MD5 hash identical to   MASTER
   ' if so copy it's TAG info across
   cancelText( "Populating custom columns for known files" , 1 )

   WITHQUERY ( "select name from  temp.masterColumns " )

      ' copy values from   MASTER  to  NewFolder   use fsHash

      > update temp.NewFolder SET
      >>  $col = frmTbl. $col
      >> FROM
      >>   ( select $col , fsHash  from master  )  as frmTbl
      >>  WHERE
      >>    NewFolder.fsHash = frmTbl.fsHash
      freestring = replace ( freestring , "$col" , sqlidentifier(wqText(1)) )
      sql ( freestring )

      > update temp.newFolder set
      freestring = freestring & " " &  sqlidentifier (wqtext(1))
      freestring = freestring & " = " &  sqlString  (TagDelim)
      >> where
      freestring = freestring & " " &  sqlidentifier (wqtext(1))
      >> = NULL or
      freestring = freestring & " " &  sqlidentifier (wqtext(1))
      >>    = ''
      sql ( freestring )

   END withquery

   update temp.NewFolder SET  fsHash = hash ,   pHash = 0 , dHash = 0, ImageGroup='' , IgnoreFile = 0  ,  ImageGroupType ='unhandled'

   dim pHash = 0 , dHash = 0

   > select path||name , rowid    from  temp.NewFolder where  ext in
   freestring = freestring & ImageFileExtensions
   WITHQUERY (freestring )

      phash = canvas("new", "phash.from.file", wqText(1) , byref dHash )

      > update temp.NewFolder  set
      >>  pHash  =
      freestring = freestring & " " & pHash
      >>  , dHash  =
      freestring = freestring & " " & dHash
      >> where rowid =
      freestring = freestring & " " &  wqInt (2)
      sql(freestring)

   END WithQuery
   update temp.NewFolder set ImageGroup = num2Hex(pHash) || num2Hex(dHash)  where not pHash = 0

   cancelText( "Insert new files into Master table" , 1 )

   insert into master  select * from temp.NewFolder
   update master set key = hash || path || name

   PopulateImageInfoIntoNewFiles ()

   drop table if exists temp.xHashTbl
   MakeBkTree ( )

END FUNCTION

FUNCTION getRootFolders ( reportSob , reportCombo)

   IF ( ! isDBopen  ) then
      ErrorReport ("No database selected" )
      EXIT function
   END IF

   sob ( reportSob, "add" , "ROW" , "The root folders of the database are:" & EOL  )

   drop table if exists temp.baseFolders
   create temp table baseFolders as select path from master group by path

   drop table if exists shortest
   create temp table shortest ( path text )
   dim shortest
   DO
      SELECT path from baseFolders order by length(path) asc limit 1
      shortest = qrSingleValue
      sob ( reportSob    , "add" , "ROW" ,  shortest & EOL  )
      sob ( reportCombo  , "add" , "ROW" ,  shortest   )

      > SELECT count (*) from master where type  like 'file' and path like
      freestring = freestring & " " & sqlString ( shortest & "%" )
      sql ( freestring )
      sob ( reportSob    , "add" , "ROW" , "   Number of files: " & qrSingleValue & EOL  )

      insert into shortest    select path from baseFolders order by length(path) asc limit 1

      delete from basefolders where path like  ( select path from baseFolders order by length(path) asc limit 1 ) || '%'

      SELECT count (*) from basefolders
   LOOP while  qrsingleValue > 0

   sob ( reportCombo, "set" , "selection" ,  "row" ,       1   )

END FUNCTION

FUNCTION CbScanNewFolder  ( sobid )

   sob ( CommonSobResult, "empty"   )

   IF ( isTable (  , "master") ) then

      dim TargetPath = addNewFolderStuctureToMaster ()
      CancelShow(0)
      IF ( targetPath = "\\" ) then
         sob ( StatusTxt,  "ADD" , "row" ,  "Cancelled by user" & EOL  )
         EXIT function
      END IF

      sob ( CommonSobResult,  "ADD" , "row" ,  Date & " " & time & EOL  )
      sob ( CommonSobResult,  "ADD" , "row" ,  targetPath & EOL  )

      SELECT count (*) from temp.newFolder where type  not like 'file'
      sob ( CommonSobResult,  "ADD" , "row" ,  "New Folders  : " & qrsingleValue & EOL  )

      SELECT count (*) from temp.newFolder where type  like 'file'
      sob ( CommonSobResult,  "ADD" , "row" ,  "New files     : " & qrsingleValue & EOL  )
      sob ( CommonSobResult,  "ADD" , "row" ,  EOL  )
      sob ( CommonSobResult,   "ADD" , "row" ,  "Additions not finalised until Save/SavedAs is triggered." &  EOL   )
      toggleOKColour ( sobid)
   ELSE
      sob ( CommonSobResult, "SET" , "TITLE" , "No open database"   )
      toggleWarnColour ( sobid)
   END IF
   cancelShow(0)

END Function

' ------------------------------------------------------------------

FUNCTION CbImportMasterToCSV ( sobid )
   IF ( ! isDBOpen ) then
      ErrorReport ("No database selected" )
      EXIT function
   END if
   dim CsvFile
   sob ( CommonSobResult, "empty"   )

   dim proceed = 1
   IF (  ! isDbOpen   )   then

      dbOpen("memory")

      SetFileFilter ( "CSV Files(*.csv)\0*.cs*\0All Files (*.*)\0*.*\0\0"   )
      CsvFile = getFile

      IF ( right( csvFile,4) == ".csv" ) then
      ELSE
         csvFile = csvFile & ".csv"
      END if

      IF ( isFile (CsvFile) ) then
         CSVread ( csvFile  , , "master")
      END IF

      IF ( isDBtable ( , "master") ) then
         sob ( CommonSobResult, "add" , "row" ,"Master table read from CSV" & EOL  )

         CsvFile = replace ( CsvFile , ".csv", "TT.csv" )

         IF ( isFile (CsvFile) ) then
            CSVread ( csvFile  , , "TagTable")
            IF ( isDBtable ( , "TagTable") ) then
               sob ( CommonSobResult, "add" , "row", "TAG table read from CSV" & EOL  )
            ELSE
               sob ( CommonSobResult, "add" , "row", "FAILURE: Could not read TAG table from CSV" & EOL  )
            END IF
         END IF
         OnOpenPrepareMasterTagTable (CommonSobResult)
      ELSE
         sob ( CommonSobResult, "add" , "row" ,"FAILURE: Could not read Master table rom CSV" & EOL  )
      END IF
   ELSE
      sob ( CommonSobResult, "add" , "row" , "FAILURE: CSV read. A database is already open !" & EOL  )
   END if

   cancelShow(0)

   toggleWarnColour ( sobid)

END function

' ------------------------------------------------------------------
FUNCTION CbExportSubListToCSV ( sobid )
   IF ( ! isDBOpen ) then
      ErrorReport ("No database selected" )
      cancelShow(0)

      toggleWarnColour ( sobid)
      EXIT function
   END if
   dim CsvFile
   sob ( CommonSobResult, "empty"   )

   IF ( isTable ( "temp" , "SubList") ) then

      SetFileFilter ( "CSV Files(*.csv)\0*.cs*\0All Files (*.*)\0*.*\0\0"   )
      CsvFile = getFile

      IF ( right( csvFile,4) == ".csv" ) then
      ELSE
         csvFile = csvFile & ".csv"
      END if

      TRY
         qrWriteToCSV (CsvFile ,"select * from SubList")
         NoErrorReport ("CSV written: "  &csvFile )
      CATCH
         ErrorReport ("CSV write failed: "  &csvFile )
      END try

   ELSE

      sob ( CommonSobResult, "SET" , "TITLE" , "No open database"   )
   END IF
   cancelShow(0)

   toggleWarnColour ( sobid)

END function

FUNCTION CbExportMasterToCSV ( sobid )
   IF ( ! isDBOpen ) then
      ErrorReport ("No database selected" )
      cancelShow(0)

      toggleWarnColour ( sobid)
      EXIT function
   END if
   dim CsvFile
   sob ( CommonSobResult, "empty"   )

   IF ( isTable (  , "master") ) then

      SetFileFilter ( "CSV Files(*.csv)\0*.cs*\0All Files (*.*)\0*.*\0\0"   )
      CsvFile = getFile

      IF ( right( csvFile,4) == ".csv" ) then
      ELSE
         csvFile = csvFile & ".csv"
      END if

      qrWriteToCSV (CsvFile ,"select * from master")

      IF ( isTable (  , "TagTable") ) then
         CsvFile = replace ( CsvFile , ".csv", "TT.csv" )
         qrWriteToCSV (CsvFile ,"select * from TagTable")
      END IF

   ELSE
      sob ( CommonSobResult, "SET" , "TITLE" , "No open database"   )
   END IF
   cancelShow(0)

   toggleWarnColour ( sobid)

END function

' ------------------------------------------------------------------

FUNCTION CbExportMasterToExcel ( sobid )

   IF ( ! isDBOpen ) then
      ErrorReport ("No database selected" )
      EXIT function
   END if

   dim ExlFile
   sob ( CommonSobResult, "empty"   )

   dim InitialExcelState
   IF ( isTable (  , "master") ) then

      SetFileFilter ( "EXCEL Files(*.xlsx)\0*.xl*\0All Files (*.*)\0*.*\0\0"   )
      ExlFile = getFile

      cancelClear ()
      cancelText( "Export a database to Excel" , 0 )
      cancelText( "Creating link to Excel" , 1 )
      cancelText( " " , 3 )
      cancelShow(1)

      InitialExcelState = xlActive
      IF ( ! xlRunning ) then
         xlopen ()
      ELSE
         dim myWb = exl.Workbooks.Add
      END IF

      cancelText( "Exporting MASTER table, should be less than 60 seconds" , 1 )

      exl.ActiveSheet.name ="Master"
      qrWriteToXL ( "select * from master")
      cancelText( "Formating Master table, should be less than 60 seconds" , 1 )

      xlTableFormat ()
      exl.range(exl.cells(1,1),exl.cells(1,QRcols)).autofilter
      cancelText( "Exporting Tag table, should be less than 60 seconds" , 1 )

      exl.worksheets.add().name = "TagTable"
      qrWriteToXL ( "select * from TagTable")
      cancelText( "Formating Tag table, should be less that 60 seconds" , 1 )

      xlTableFormat ()
      exl.range(exl.cells(1,1),exl.cells(1,QRcols)).autofilter
      ' -----------------------------------------------------------
      cancelText( "Creating Admin sheet" , 1 )

      exl.worksheets.add().name = "Admin"

      exl.cells(1,1).value = "Content:"
      exl.Cells(2,1).value = "Source:"

      exl.Cells(3,1).value = "Generated:"

      exl.cells(1,2).value = "Master table, and Tag table"
      exl.Cells(2,2).value =       sob ( statusDBFile, "GET" ,"TITLE"   )

      exl.Cells(3,2).value =  "'" & date & " " & time

      exl.Cells(9,1).value = "Generated using " & appName & " " & AppVersion
      exl.Cells(10,1).value = "Freeware, no installation, single file, < 5 Mbyte"
      exl.Cells(11,1).value = "www.PlodWare.com"
      exl.Cells(9,1).font.size = 8
      exl.Cells(10,1).font.size = 8
      exl.Cells(11,1).font.size = 8

      exl.cells.columns.autofit

      exl.cells.VerticalAlignment = -4108
      ' -----------------------------------------------------------

      cancelText( "Saving workbook to file" ,1 )

      exl.Application.DisplayAlerts = 0

      exl.ActiveWorkBook.saveas ( ExlFile , 50 )

      ' 50 = xlExcel12 (Excel Binary Workbook in 2007-2013 with or without macro's, xlsb)
      ' 51 = xlOpenXMLWorkbook (without macro's in 2007-2013, xlsx)
      ' 52 = xlOpenXMLWorkbookMacroEnabled (with or without macro's in 2007-2013, xlsm)
      ' 56 = xlExcel8 (97-2003 format in Excel 2007-2013, xls)
      ' ActiveWorkBook.close
      exl.Application.DisplayAlerts = 1

      exl.ActiveWorkbook.Close

      IF ( ! InitialExcelState ) then
         exl.quit
         set exl = nothing
      END IF

      sob ( CommonSobResult, "ADD" , "ROW" , "Database saved to: " & EOL & ExlFile   )

   ELSE

      sob ( CommonSobResult, "SET" , "TITLE" , "No open database"   )
   END IF
   cancelShow(0)

   toggleWarnColour ( sobid)

END function

' ------------------------------------------------------------------

FUNCTION CbImportMasterToExcel ( sobid )
   IF ( ! isDBOpen ) then
      ErrorReport ("No database selected" )
      EXIT function
   END if
   dim ExlFile , proceed
   sob ( CommonSobResult, "empty"   )

   dim InitialExcelState
   IF (  ! isDbOpen   )   then
      proceed = 1
   END IF

   IF ( proceed ) then
      proceed = dbValidityCheck ()
   END IF

   IF ( proceed) then
      SetFileFilter ( "EXCEL Files(*.xlsx)\0*.xl*\0All Files (*.*)\0*.*\0\0"   )
      ExlFile = getFile

      cancelClear ()
      cancelText( "Creating a database from Excel" , 0 )
      cancelText( "Creating link to Excel" , 1 )
      cancelText( " " , 3 )
      cancelShow(1)

      dbOpen ("memory")

      dim xlState = isXLrunning ()

      cancelText( "Importing MASTER table, should be less than 60 seconds" , 1 )

      proceed =  xlExportToDB (  ExlFile , "master", "master"  , , ,1  )
      IF ( proceed ) then
         cancelText( "Importing TagTable , should be less than 60 seconds" , 1 )
         proceed =   xlExportToDB (  ExlFile , "TagTable", "TagTable"   )
      END if

      IF ( ! xlState ) then
         exl.quit
         set exl = nothing
      END IF

      IF ( proceed ) then
         OnOpenPrepareMasterTagTable (CommonSobResult)
         sob ( CommonSobResult, "ADD" , "ROW" , "Database created from: " & EOL & ExlFile   )
      ELSE
         sob ( CommonSobResult, "ADD" , "ROW" , "FAILED: Tying to create Database from: " & EOL & ExlFile   )
         dbClose ()
      END IF
   ELSE
      sob ( CommonSobResult, "SET" , "TITLE" , "No open database"   )
   END IF
   cancelShow(0)

   toggleWarnColour ( sobid)

END function

' ------------------------------------------------------------------

FUNCTION createCommonPanel ( sobid  )

   dim localWindow = sob ( sobid , "add", "CONTAINER", "COLUMN.W")

   sob ( -1 , "ADD" , "SPACE" , 0 , 10)
   sob ( -1 , "SET" , "RGB" , -1 )
   CommonSobTitle = sob ( -1 , "ADD" , "LABEL", "Scan new folder and enter in database" )
   sob ( -1 , "SET" , "RGB" , bgBoxCol )
   sob ( -1 , "ADD" , "SPACE" , 0 , 10)
   sob ( -1 , "SET" , "RGB" , -1 )

   CommonSobInfo =sob ( -1 , "ADD" , "EDIT.ROWS" , "   "  , 13 )
   sob ( -1 , "EMPTY" )

   sob ( -1 , "SET" , "RW" , 0 )
   sob ( -1 , "SET" , "RGB" , bgROeditCol )

   sob ( -1 , "ADD" , "SPACE" , 0 , 10)
   sob ( -1 , "SET" , "RGB" , -1 )

   sob ( localWindow , "add", "CONTAINER", "row.h")

   CommonSobBtn = sob ( -1 , "ADD" , "BUTTON" , "PUSH", "Scan" )

   sob ( -1 , "ADD" , "SPACE" , 0 , 40)
   sob ( -1 , "SET" , "RGB" , -1 )
   CommonSobBtnB = sob ( -1 , "ADD" , "BUTTON" , "PUSH", "Open Export folder" )
   sob ( -1 , "ADD" , "SPACE" , 0 , 40)
   sob ( -1 , "SET" , "RGB" , -1 )
   sob ( CommonSobBtnB , "ON"  , "PRESS", "CbOpenExportFolder")

   CommonSobCombo     = sob(-1,"add","COMBO" , "dropdown" , "  "     )

   sob ( localWindow , "ADD" , "SPACE" , 0 , 10)
   sob ( -1 , "SET" , "RGB" , -1 )

   CommonSobResult =     sob ( localWindow , "ADD" , "EDIT.ROWS" , "   "  , 13 )
   sob ( -1 , "EMPTY" )

   sob ( -1 , "SET" , "RW" , 0 )
   sob ( -1 , "SET" , "RGB" , bgROeditCol )

   ' trick to have an invisible button, so that we have a asynchronous triggerable event
   reDrawRegionsID = sob ( localWindow , "add" , "BUTTON" , "PUSH" ," " )

   sob ( -1 , "set" , "show" , 0 )
   sob ( -1 , "ON", "press", "cbReDrawRegions" )

   sob ( localWindow , "add" , "SPACE" , 0 , 1)
   sob ( -1 , "SET" , "RGB" , -1 )

END FUNCTION

createCommonPanel ( CommonOvl)

'---------------------------
' FINISHED
'---------------------------

FUNCTION CbBackUpDatabase  ( sobid )

   IF ( ! isDbOpen ) then
      ErrorReport("no database open")
      cancelShow(0)

      toggleWarnColour ( sobid)
      EXIT function
   END if
   drop table if exists temp.srcMaster
   create temp table srcMaster as select "" as dst , * from master

   CbBackUpDatabaseInner ( sobid )

END Function

FUNCTION CbBackUpSubList  ( sobid )

   IF ( ! isDbOpen ) then
      ErrorReport("no database open")
      cancelShow(0)
      toggleWarnColour ( sobid)
      EXIT function
   END if

   drop table if exists temp.srcMaster
   create temp table srcMaster as select "" as dst , * from sublist
   insert into srcMaster  select "" as dst  , rowid, * from master where type  like 'folder'
   update srcMaster  set children = 0
   update srcMaster  set key = path || name || '\'
   > update srcMaster
   >> set
   >> children = frmtbl.cnt
   >> from
   >> ( select count(*) as cnt, path  from srcMaster   where type like 'file' group by  path ) as frmTbl
   >> Where
   >> srcMaster    .type like 'folder'
   >> and (   srcMaster .key = frmTbl.path  )
   sql ( freestring )
   delete from srcMaster where  type like 'folder' and children = 0

   CbBackUpDatabaseInner ( sobid )

END Function

FUNCTION CbBackUpDatabaseInner ( sobid )

   dim proceed = 1
   dim dstFolder , dstLength , srcPath , srcPathLast, srcLength , fileCount
   sob ( CommonSobResult, "empty"   )

   proceed = isDbOpen

   IF ( proceed ) then
      dstFolder = GetPath
      IF ( dstFolder ==  ""  ) then
         proceed = 0
      ELSE
         IF ( ! isFile ( dstFolder  )  ) then
            sob ( CommonSobResult, "ADD", "ROW" , "Destination does not exist, it will be created" & EOL  )
            IF ( ! MKDIR ( dstFolder ) ) then
               sob ( CommonSobResult, "ADD", "ROW" , "Could not create destination folder " & EOL & dstFolder & EOL  )
               proceed = 0
            END if
         END if
      END IF
   ELSE
      sob ( CommonSobResult, "SET" , "TITLE" , "No open database"   )
   END IF

   IF ( proceed ) then
      ' prepare the DST file list
      dstFolder = dstFolder & "\\"
      dstLength = length( dstFolder)

   END IF

   IF ( proceed ) then

      sob ( CommonSobResult, "add"  , "row" , "Destination folder base: " & dstFolder & EOL  )

      dim fso = createobject ("Scripting.FileSystemObject")
      IF ( ! fso ) THEN
         report (" could not create FSO")
         proceed = 0
      END IF
   END if

   IF ( proceed ) then

      cancelClear ()
      cancelText( "Back-up database " , 0 )
      cancelText( "Establish content of back-up area" , 1 )
      cancelText( " " , 3 )
      cancelShow(1)

      ' prepare srcMaster to have
      '   src file name   path||name
      '   dst path        dst

      getrootFolders (CommonSobResult ,CommonSobCombo )

      drop table if exists temp.dstMaster
      drop table if exists temp.dstMasterRoot

      ' set  srcMaster to have  DST path for each file
      dim index = 0
      WITHQUERY ( "select path from shortest " )
         index = index + 1
         sob ( CommonSobResult, "add"  , "row" , "Src folder base: " & WQtext(1) & EOL  )
 
         srcLength = length ( wqtext(1))
         redim srcPath = split (  wqtext(1) , "\\" )

         ' arrange that srcMaster . dst
         ' holds the destination PATH  for its ROW

         srcPathLast = dstFolder & right( "00000" & index ,4) & "-" &   srcPath (  uBound(srcPath) ) & "\\"
         sob ( CommonSobResult, "add"  , "row" , "Dst for this Src:  " & srcPathLast & EOL  )

         IF ( isFILE ( srcPathLast)   ) then
         ELSE
            mkdirPath ( srcPathLast )
            IF    ( ISFILe ( srcPathLast)   )   then
            ELSE
               message = "Problem at : "  & srcPathLast
            END IF
         END if

         > update srcMaster
         >> SET
         >>   dst = $dst ||  subStr ( path , $len)
         >> WHERE
         >>   path like $key || '%'
         freestring =   replace ( freestring , "$dst" , sqlString(srcPathLast) )
         freestring =   replace ( freestring , "$len" , "" & (srcLength+1))
         freestring =   replace ( freestring , "$key" , sqlString (wqtext(1)))

         sql ( freestring )

         sob ( CommonSobResult, "add"  , "row" , "DST:  " & srcPathLast& EOL  )

         ' BE WARNED:  dbFileList internally tries to DROP its target TBL
         ' and then create a new one
         ' BUT: inside a WITHQUERY / End loop   table DROP does NOT work (database is locked)
         ' so, I delete the rows of the table so that in the next loop, the table is empty
         dbFileList ( "temp" , "dstMasterRoot" ,  srcPathLast   ,-1)

         create temp table if not exists dstMaster as select * from  temp.dstMasterRoot limit 0
         insert into temp.dstMaster select * from temp.dstMasterRoot
         delete from temp.dstMasterRoot

      END WithQuery

   END if

   IF ( proceed   ) then

      ' work out which files have to be deleted from DST because they no longer exist in the SRC

      cancelText( "Deleting files in back-up, not in database" , 1 )

      update srcMaster set key =   dst  || name || size || write  where type like 'file'
      drop table if exists  bupMaster
      create table  bupMaster as select * from temp.srcmaster
      update bupMaster set path = dst
      alter table bupMaster drop column dst

      update dstMaster set key =   path || name || size || write  where type like 'file'

      '---------------------------
      ' remove any dst  FILES which are no longer in    src

      SELECT count (*)  from dstMaster where not key in ( select key from srcMaster ) and type like 'file'
      fileCount = qrSingleValue
      sob ( CommonSobResult, "add"  , "row" , "Nr files in DST not in SRC:  " & qrSingleValue & EOL  )
      cancelText( "Files to delete: " & FileCount , 2  )

      ' delete the file from the file system
      WITHQUERY ( " select (path||name )  from dstMaster where not key in ( select key from srcMaster ) and type like 'file'  ")
         deleteFileNow ( wqtext(1) )

         report = "Deleting FILE from DST where file nolonger in SRC, or SRC file has changed: " & wqtext(1)

         cancelToggle ()
         fileCount--
         IF ( fileCount BAND 0x0f ) then
         ELSE
            cancelText( "Files to delete: " & FileCount , 2 )
            report ("Files to delete: " & FileCount )
         END IF
      END withquery

      ' delete the file entry in dst
      delete from dstMaster where not key in ( select key from srcMaster )   and type like 'file'

      '---------------------------
      ' remove from the  dst any  FOLDERS which are no longer in    src
      cancelText( "Deleting folders in back-up, not in database" , 1 )

      update srcMaster set key =   dst  || name || '\'    where type like 'folder'
      update dstMaster set key =   path || name || '\'    where type like 'folder'

      SELECT count (*)  from dstMaster where not key in ( select key from srcMaster ) and type like 'folder'
      fileCount = qrSingleValue
      sob ( CommonSobResult, "add"  , "row" , "Nr folders in DST not in SRC:  " & qrSingleValue & EOL  )
      cancelText( "Folders to delete: " & FileCount , 2  )

      ' we use the   Scripting.FileSystemObject   from the operating system to do the delete folder!

      ' delete the FOLDER from the file system
      WITHQUERY ( " select path , name  from dstMaster where not key in ( select key from srcMaster ) and type like 'folder'  order by level desc ")
         report (  "delete folder " & wqtext(1) & wqtext(2))

         fso.DeleteFolder  ( wqtext(1) & wqtext(2) )
         cancelToggle ()
         fileCount--
         IF ( fileCount BAND 0x0f ) then
         ELSE
            cancelText( "Folders to delete: " & FileCount , 2 )
            report ("Folders to delete: " & FileCount )
         END IF
      END withquery

      ' delete the FOLDER entry in dst
      delete from dstMaster where not key in ( select key from srcMaster )   and type like 'FOLDER'

      '---------------------------

   END if

   dim dstPoint
   IF ( proceed ) then
      cancelText( "Create the DST folder structure" , 1 )

      ' create the DST folder structure
      WITHQUERY ( " select dst ,  dst || name || '\\'   from srcMaster where not key in ( select key from dstMaster )  and    type like 'folder'  group by (dst||name)  order by level ")

         IF ( isFILE ( wqText(2))   ) then
         ELSE
            mkdirPath ( wqText(2) )
            IF    ( ISFILe ( wqText(2))   )   then
            ELSE
               message = "Problem at : "  & wqText(2)
            END IF
         END if
      END withquery

   END if

   IF ( proceed ) then
      cancelText( "Copy files" , 1 )

      ' do not need to copy files with key in src & dst

      SELECT count (*) from srcMaster where key in ( select key from dstMaster ) and  type like 'file'
      sob ( CommonSobResult, "add"  , "row" , "Nr files in SRC that have NOT changed:  " & qrSingleValue & EOL  )
      delete from srcMaster where key in ( select key from dstMaster )

      SELECT count (*) from srcMaster where  type like 'file'
      fileCount = qrSingleValue

      cancelText( "Files to go: " & FileCount , 2  )

      ' copy the SRC files  to DST
      WITHQUERY ( " select path || name  , dst   from srcMaster where not key in ( select key from dstMaster )  and    type like 'file'     ")

         TRY
            fso.copyFile  ( wqtext(1) ,wqtext(2)  )
         CATCH
            IF ( isFile (wqtext(1)   ) then
               report ( "copy file failure: " & EOL & wqtext(1) & EOL   & wqtext(2) & EOL )
            END IF
         END try

         cancelToggle ()
         fileCount--
         IF ( fileCount BAND 0x0f ) then
         ELSE
            cancelText( "Files to go: " & FileCount , 2  )
         END IF

      END withquery
   END if

   vacuum

   dim saveDBas=  dstFolder & "MetaTagger " & date & " " & replace ( left(time,5 ) , ":", "-") & ".db3"
   DBSaveCopy ( saveDBas , 1 )

   > ATTACH DATABASE
   freestring = freestring & " " & sqlstring (saveDBas)
   >> as NEW
   sql ( freestring )
   drop table new.master
   alter table new.bupmaster rename   to   master
   vacuum
   detach database new

   cancelShow(0)

   toggleWarnColour ( sobid)

END function

FUNCTION createFrontPage ( sobid  )

   dim localWindow = sob ( HelpFixedOvl , "add", "CONTAINER", "COLUMN.W")

   sob ( -1 , "ADD" , "SPACE" , 0 , 10)
   sob ( -1 , "SET" , "RGB" , -1 )
   sob ( -1 , "ADD" , "LABEL", appName )
   sob ( -1 , "SET" , "RGB" , bgBoxCol )
   sob ( -1 , "ADD" , "SPACE" , 0 , 10)
   sob ( -1 , "SET" , "RGB" , -1 )

   HelpFixedHTMLSOB =sob ( -1 , "ADD" , "web" )
   sob ( HelpFixedHTMLSOB, "SET",   "SILENT" , 1)

   sob ( -1 , "EMPTY" )

END FUNCTION

' redirect the PWS default status reports to  MetaTagger status area

redirectStatusReportingTo ( StatusTxt)

createFrontPage ( HelpPageSob )
sink ()

db_arg_open ( invocationPath &  ExecutionName & ".db3") 

UpdateUsedFileList()

WelcomeMessage(1)

autoStartChk ( )

sob ( appWindow,"SET","SHOW",1)