VB-Script Text Processor

Wednesday, 16 April 2008 03:11 by Frimbob

Project Reasons

As part of my current work at Australasian Investment Review, I need to post articles sent to me by the editor onto their web-site. Their CMS is not what I would qualify as words best. Like many web-posters we are forced to use inline styles. Simply Setting a few global style parameters in an opening div tag can waste, many minutes per article. Their CMS does allow images to be pasted directly in the story however the graphs are sent separately to the story. there need to be a way to group images per story and the ability to transform text into basic html with some opening style parameters. This script processor is the result and it my favourite program and a raising success.

Project Aim

  • Remove all formatting characters that MS-word products that confuse the CMS Java Applet, Notepad us perfect program for the job
  • Ensure consistent results in text, (remove MS_word formatting characters)
  • Global Style Parameters
  • Use Active-X objects to manipulate files
  • Using HTA with scripting language (VB-Script)
  • Display List of Images based on their Date-Created
  • Using this master list group images to a particular article
  • Image Preview that can by right Clicked > copy to clipboard.
  • Process Text (Insert extra line break)
  • Convert some pre-defined text-sequences into html e.g '......'  into <hr>. 

Results

What is a HTA:  HTAs pack all the power of Internet Explorer—its object model, performance, rendering power and protocol support—without enforcing the strict security model and user interface of the browser. They are basically a sandbox version of Internet Explorer they make very useful script font-ends with the ability to use HTML to render the controls.

I was able to meet all my requirements, this project took me around a month to write  in November-December 2007. I will cover a class over-view in this review at 1327 lines of code not including the HTML it just shorter this way.

Classes 

Class Name Description
Class TextFile Represents a single TextFile
Class FileList Wrapps Dictionary object to store Text-File object
Class CreateOpenTextFile Contains the code that Uses WSH active X object to open and create text files
Class RegexFilters Contains a number of Test methods used in the HTML conversion process.

Class ProcessTextFiles

Contains all the logic to transform a text file into html.
Class ImageFiles Represents a single image File
Class ImageOutput Wrapper for a dictionary object of Image Files
Global Declarations No constructor is supported must use global variables instead to initialise the above classes
Event Handlers UI Code for the font end

 

WSH objects used 

 

Namespace Use

Scripting.FileSystemObject

return File System Information
Wscript.Shell Open Notepad
Scripting.Dictionary Dictionary Collection

 

Language Tricks

While VB-Script does support basic class encapsulation with properties and methods, it does not support any class inheritance.  Another major shortcoming is functions are not allowed to return an object only a value type. However there is a lonely document but usable way to force object returns from functions.

VB-script is a garbage-collection language so orphaned objects will be re-claimed after the garbage collection cycle and since we can pass object references as function parameters we are able to use scope to our advantage. In our calling function we can create a new instance of the class , empty of data, this empty object can be then passed to a function, the function is able then to set the object's reference to that of another object of same type. As this object is in scope and NOT disposed by either function will have an object with a reference to and existing object returned. Effectively we have returned an object from a function not using the (return) statement but scope. 

General Code 

   1: Option Explicit
   2: '------------------------------------------------------------------------------'
   3: 'Indiviudal File object'
   4: Class TextFile
   5:   
   6:   'declare Constances'
   7:   Private strExtension
   8:   Private strBaseName
   9:   
  10:   'Class Initilize'
  11:   Private Sub Class_Initialize
  12:     strExtension = ".txt"  
  13:     strBaseName = "Article"
  14:   End Sub
  15:  
  16:   'Class Terminate'
  17:   'Private Sub Class_Terminate
  18:     
  19:   'End Sub
  20:   'Declare the Instance Varibales'
  21:   Private strFileName
  22:   Private intNumber
  23:   Private strRead
  24:   Private strFinal
  25:   
  26:    
  27:   'Public Property Let (Write- Statements)'
  28:   Public Property Let FileName(strName)
  29:     If IsNumeric(strName) = false Then
  30:       Err.Raise 91, "TextFile", "The FileName is invalid"
  31:     End if
  32:     'set the values'
  33:     strFileName = CStr(strBaseName & strName & strExtension)   
  34:   End Property 
  35:   
  36:   Public Property Let  FileNumber(intNum) 
  37:     If IsNumeric(intNum) = False Then
  38:       Err.Raise 91, "TextFile", "The FileNumber is invalid"
  39:     End if 
  40:     'set the property Value'
  41:     intNumber = intNum
  42:   End Property
  43:   
  44:   Public Property Let Read(str)
  45:     strRead = str
  46:   End Property
  47:   
  48:   Public Property Let Final(str)
  49:     strFinal = str
  50:   End Property
  51:     
  52:   'public Property Get (Read-Statements)'
  53:   Public Property Get FileName 
  54:     FileName = strFileName 
  55:   End Property
  56:   Public Property Get FileNumber
  57:     FileNumber = intNumber 
  58:   End Property
  59:   
  60:   Public Property Get Extension 
  61:     Extension = strExtension
  62:   End Property
  63:   
  64:   Public Property Get BaseName 
  65:     BaseName = strBaseName
  66:   End Property
  67:   
  68:   Public Property Get Read
  69:     Read = strRead 
  70:   End Property
  71:   
  72:   Public Property Get Final
  73:     Final = strFinal 
  74:   End Property
  75:   
  76:   'methods'
  77:   Public Sub DisplayEntry
  78:   MsgBox " File List Entry:" & vbNewLine &_
  79:          "Extension:" & strExtension & _
  80:          "BaseName:" & strBaseName & _
  81:          "FileName:" & strFileName & _
  82:          "Number:" & intNumber 
  83:   End Sub
  84: End Class
  85: '------------------------------------------------------------------------------'
  86: '------------------------------------------------------------------------------'
  87: 'storage object for TextFile objects'
  88: Class FileList
  89:     
  90:     'Inistance Varaibles'
  91:     Private objDict
  92:     
  93:     'class Initilize'
  94:     Private Sub Class_Initialize
  95:        Set objDict = CreateObject("Scripting.Dictionary")
  96:     End Sub
  97:     
  98:     'class Terminate'
  99:     Private Sub Class_Terminate
 100:         Set objDict = Nothing
 101:     End Sub
 102:   
 103:     'wrapper for dictionary count'
 104:     Public Property Get ListCount
 105:         ListCount = objDict.Count
 106:     End Property
 107:     
 108:     'Wrapper for dictionary exists'
 109:     Public Function EntryExists(strFileName)
 110:       EntryExists = objDict.Exists(strFileName)
 111:     End Function 
 112:   
 113:     'Methods'
 114:     'Wrapper for the dictionary add method'
 115:     Public Sub AddEntry(objTextfile)
 116:       If TypeName(objTextfile) = "TextFile" Or TypeName(objTextfile) = "ImageFiles"  Then 'test if the object is the one expected'
 117:           objDict.Add objTextfile.FileName , objTextfile 'adds the file name as key and the object as the array value So have an array of objects' 
 118:       Else
 119:           Err.Raise 3200, "FileList", "Only TextFile objects can be stored"
 120:       End if
 121:      'use the file name as the key'
 122:      
 123:     End Sub
 124:     
 125:     'Wrapper for RemoveAll entry'
 126:     Public Sub ClearAll
 127:       objDict.RemoveAll 'clears the dictionary' 
 128:     End Sub 
 129:     
 130:     Public Function DisplayEntry(thefile,strFileName)
 131:       If  objDict.Exists(strFileName) Then
 132:           Set thefile = objDict.Item(strFileName)
 133:           'DisplayEntry=Cstr(objTFile.FileName) ' returns the file name as a string'
 134:       Else
 135:          Err.Raise 32002, "FileList" , "The filename " & strFileName &"not in the list"
 136:       End if
 137:     End Function
 138:     
 139:     'Matches index number to a key pair and returns the object'
 140:     Public Function MatchIndex(thefile,keynumber)
 141:       Dim arykey 
 142:       Dim i
 143:       arykey = objDict.Keys 'array with the keys'
 144:      'return the key at particular value'
 145:        For i = 0 to objDict.count -1 
 146:          If i = keynumber Then
 147:            'return the key which is the file name
 148:           Set theFile =  objDict.Item(arykey(i))
 149:           'Set MatchIndex =  theFile 
 150:          'Else ' not in index' 
 151:            'MatchIndex = null 'return a null object'
 152:          End if
 153:        Next
 154:     End Function
 155: End Class
 156: '------------------------------------------------------------------------------'
 157: '------------------------------------------------------------------------------'
 158: ' Methods to Open,Create,Delete,and Iterate through Physical Files'
 159: Class CreateOpenTextFile
 160:    'Class Initilize'
 161:    Private Sub Class_Initialize
 162:      Set objFSO       = CreateObject("Scripting.FileSystemObject")
 163:      Set wshSHELL     = CreateObject("Wscript.Shell")
 164:    End Sub
 165:  
 166:    'Class Terminate'
 167:    Private Sub Class_Terminate
 168:      Set objFSO = Nothing
 169:      Set wshSHELL = Nothing
 170:      Set objFileList = Nothing
 171:    End Sub
 172:  
 173:    'Class Varaibles'
 174:    'Private FileSystemObject'
 175:    Private objFSO
 176:    Private wshSHELL
 177:    Private objFileList
 178:    Private strActiveFile
 179:    Private strCurrentFileIndex
 180:    
 181:    
 182:    'Write statements   
 183:    Public Property Set FileLists(obj) 
 184:       Set objFileList  = obj 
 185:    End Property
 186:    
 187:    'read statement'     
 188: '    Public Property Get FileList  
 189: '       FileList = objFileList
 190: '    End Property
 191:    
 192:    Public Property Get CurrentFileIndex 
 193:       CurrentFileIndex = strCurrentFileIndex
 194:    End Property
 195:    
 196:    Public Property Get ActiveFileName
 197:       ActiveFileName = strActiveFile 
 198:    End Property
 199:    
 200:    'returns an object from the file list' 
 201:   Public Property Get ReturnObject(ByVal number) 
 202:    Dim thefile 
 203:    Set thefile = New TextFile 
 204:    Call objFileList.MatchIndex(thefile,number)
 205:    ReturnObject = Cstr(thefile.FileName) 
 206:   End Property
 207:   
 208:   'read statement'
 209:   Public Property Get ReturnTheObject(thefile,number) 
 210:     Call objFileList.MatchIndex(thefile,number)
 211:   End Property
 212:    
 213:    
 214:    'Define Public Methods'
 215:    Function CreateFiles(number) 
 216:      'data Type Test'
 217:      If Not IsNumeric(number) Then
 218:        Msgbox("Invalid Number of Files")
 219:      Else
 220:         'constants'
 221:         Const ForReading = 1
 222:            Const ForWriting = 2
 223:          
 224:         'varaibles'
 225:         Dim Filepointer  'file Pointer'  
 226:         Dim intNumFiles  'Loop Counter'
 227:         Dim intCounter   'loop counter'
 228:         Dim blnSucessful 'return value'
 229:         Dim objTextFile
 230:         
 231:         'set varaible Values'
 232:         intNumFiles = number
 233:         blnSucessful = False
 234:        
 235:          'create the Files'
 236:          For intCounter = 1 to intNumFiles
 237:                 'Create the file object'
 238:            Set objTextFile = New TextFile 'declared the class'
 239:            objTextFile.FileName = intCounter ' only part needed'
 240:            objTextFile.FileNumber = intCounter ' index in the For loop'
 241:            
 242:            'create the file' 
 243:            Set Filepointer = objFSO.OpenTextFile(objTextFile.FileName, ForWriting, True)
 244:                 Filepointer.Close()
 245:               Set Filepointer = Nothing
 246:             'Check if operation completed successfully
 247:                 
 248:             If objFSO.FileExists (objTextFile.FileName) Then 
 249:                      blnSucessful = True
 250:                     'store the file info into objFileList'
 251:               objFileList.AddEntry(objTextFile) 
 252:               
 253:             Else
 254:               blnSucessful = False
 255:               Set objTextFile = Nothing 'remove till next instance'
 256:               Exit for ' stop if a file not sucessfuly created'
 257:             End If  
 258:             
 259:             strCurrentFileIndex = intCounter
 260:             strActiveFile  =Cstr(objTextFile.BaseName &  strCurrentFileIndex & objTextFile.Extension)
 261:             Set objTextFile = Nothing 'remove till next instance'
 262:           Next
 263:       End if
 264:    CreateFiles = blnSucessful
 265:    End Function
 266:    'Open a Text File'
 267:    Public Sub Open
 268:       'test is file exists
 269:           If objFSO.FileExists(strActiveFile) Then
 270:               'open file in text editor
 271:               wshSHELL.Run strActiveFile
 272:           Else
 273:               'report error
 274:               MsgBox ("Error File NOT found Please start Process again")
 275:           End If
 276:    End Sub
 277:  
 278:   'next file'
 279:   Public Function NextFile 
 280:     'create new TextFile object to reternve the 2 class values of BaseName and Extension'
 281:     Dim objTextFile
 282:     Set objTextFile = New TextFile 'declared the class'
 283:     
 284:     If objFSO.FileExists(objTextFile.BaseName &  (strCurrentFileIndex+1) & objTextFile.Extension) Then
 285:        strActiveFile =Cstr(objTextFile.BaseName &  (strCurrentFileIndex+1) & objTextFile.Extension)
 286:        'add one increment the counter'
 287:        strCurrentFileIndex =(strCurrentFileIndex +1) 'increment the value'
 288:       NextFile = True
 289:     Else
 290:       NextFile = False
 291:       
 292:     End if
 293:     'delete the object for next occurance' 
 294:     Set objTextFile = Nothing
 295:   End Function
 296:   
 297:   
 298:   Public Function PrevFile
 299:   'create new TextFile object to reternve the 2 class values of BaseName and Extension'
 300:     Dim objTextFile
 301:     Set objTextFile = New TextFile 'declared the class'
 302:     
 303:     If objFSO.FileExists(objTextFile.BaseName &  (strCurrentFileIndex-1) & objTextFile.Extension) Then
 304:        strActiveFile =Cstr(objTextFile.BaseName &  (strCurrentFileIndex-1) & objTextFile.Extension)
 305:        'add one increment the counter'
 306:        strCurrentFileIndex =(strCurrentFileIndex -1) 'increment the value'
 307:       PrevFile = True
 308:     Else
 309:       PrevFile = False
 310:       
 311:     End if
 312:     'delete the object for next occurance' 
 313:     Set objTextFile = Nothing
 314:     
 315:   End Function
 316:   
 317:   'Function to clear the disctionary and delete the files'
 318:   Public Function DeleteTheFiles 
 319:    Dim intCount
 320:    Dim intCounter
 321:    'test the index number'
 322:      If (objFileList.ListCount > 0)  Then
 323:         intCounter =  (objFileList.ListCount-1) 
 324:            For intCount = 0 to intCounter 
 325:               Dim thefile 
 326:               Set thefile = New TextFile 
 327:             Call objFileList.MatchIndex(thefile,intCount) 'get the physical object'
 328:               objFSO.DeleteFile(thefile.FileName)            'Delete the physical Files'
 329:               Set thefile = Nothing                          'Reset for next instance'
 330:           Next 
 331:         DeleteTheFiles = True   
 332:      Else
 333:         DeleteTheFiles = False
 334:      End if
 335:    
 336:    'clear the dict'
 337:     objFileList.ClearAll
 338:   
 339:   End Function
 340:      
 341:  End Class
 342: '------------------------------------------------------------------------------'
 343: '------------------------------------------------------------------------------'
 344: 'Object to contain Regex Patterns used in the program'
 345: Class RegexFilters
 346:     
 347:     'Class Global Variables'
 348:     Private objRegExp  
 349:     Private Pattern1
 350:     Private Pattern2
 351:     Private Pattern3
 352:     Private Pattern4
 353:      
 354:     'Class Initilize'
 355:     Private Sub Class_Initialize
 356:         Set objRegExp         = New RegExp      
 357:         objRegExp.IgnoreCase  = True 
 358:         objRegExp.Global      = True 
 359:         Pattern1              = "[…|*|.|a-z|0-9]"
 360:         Pattern2              = "\b(\w+?)\b" 
 361:         Pattern3              = "^(\.+|\*+)$"
 362:         Pattern4              ="^.+\.((gif)|(GIF)|(jpg)|(JPG)|(jpeg)|(JPEG)|(png)|(PNG))$"
 363:     End Sub
 364:   
 365:     'Class Terminate'
 366:     Private Sub Class_Terminate
 367:         Set objRegExp         = Nothing
 368:     End Sub
 369:     'Read Statements'
 370:     Public Property Get PatternOne 
 371:       PatternOne    = Pattern1
 372:     End Property
 373:     
 374:     Public Property Get PatternTwo
 375:       PatternTwo    = Pattern2
 376:     End Property
 377:     
 378:     Public Property Get PatternThree
 379:       PatternThree  = Pattern3
 380:     End Property
 381:     
 382:     Public Property Get PatternFour
 383:       PatternThree  = Pattern4
 384:     End Property
 385:     
 386:     'Public Methods'
 387:     Public Function TestEmptyLine(strLine) 
 388:       objRegExp.Pattern = Pattern1
 389:       If (objRegExp.Test(strLine)) Then
 390:          TestEmptyLine    = True
 391:       Else
 392:         TestEmptyLine     = False  
 393:       End if
 394:      End Function 
 395:     
 396:     Public Function TestLineBreak(strLine)
 397:       objRegExp.Pattern = Pattern3
 398:       If ((objRegExp.Test(strLine))) Then
 399:           TestLineBreak    = True
 400:       Else
 401:           TestLineBreak    = False
 402:       End if
 403:     End Function
 404:    
 405:     Public Function TestFileType(strFileName)
 406:       objRegExp.Pattern = Pattern4
 407:       If ((objRegExp.Test(strFileName))) Then
 408:           TestFileType    = True
 409:       Else
 410:           TestFileType    = False
 411:       End if
 412:     End Function
 413:     
 414:     Public Function AddressOK(strFilePath)
 415:     Dim StrReplace
 416:         
 417:     'replace blackslashes with foward slashes'
 418:     StrReplace = Replace(strFilePath,"\","/")
 419:     
 420:     'replace spaces with a % sign'
 421:     StrReplace = Replace(StrReplace," ","%")
 422:     
 423:     AddressOK = strReplace
 424:     
 425:     End Function
 426:    
 427: End Class
 428: '------------------------------------------------------------------------------'
 429:   
 430: '------------------------------------------------------------------------------'
 431:  'Object that will contain processing logic and the Text-Stream controls
 432:  
 433:  Class ProcessTextFiles
 434:     
 435:     'Global Variables
 436:     Private objRegexFilters 
 437:     'Declare the Instance Varibales'
 438:     Private Paragraph
 439:     Private Paragraph_Close
 440:     Private Div
 441:     Private Div_Close
 442:     Private Img
 443:     Private Img_Path 
 444:     Private Img_Open
 445:     Private Img_Close
 446:     Private LineBreak
 447:     Private HRule
 448:     Private objFSO 
 449:     Private ForReading
 450:       Private ForWriting
 451:       Private objRegex
 452:       Private objTextFileInterface
 453:       Private objImageFileInterface
 454:       Private objImageOutputClass
 455:       Private blnModeSelect
 456:           
 457:     'Class Initilize'
 458:     Private Sub Class_Initialize
 459:       Set objFSO           = CreateObject("Scripting.FileSystemObject")
 460:        HRule               = "<hr style="" height: 1px; width: 80%; border: none; background-color: #527393; color: #527393;"" /><br />"
 461:        Paragraph           ="<p>"
 462:        Paragraph_Close     ="</p>"
 463:        Div                 ="<div style=""font-size:14px"">"
 464:        Div_Close           ="</div>"
 465:        Img_Open            ="<img alt=""Image"" src=""file:///"
 466:        Img_Close           = """/>"
 467:        LineBreak           ="<hr style="" height: 1px; width: 80%; border: none; background-color: #527393; color: #527393;"" /><br />"
 468:        ForReading          = 1
 469:        ForWriting          = 2
 470:        blnModeSelect          = False
 471:       End Sub
 472:  
 473:     'Class Terminate'
 474:     Private Sub Class_Terminate
 475:        Set objRegexFilters = Nothing
 476:        Set TextFileInterface = Nothing
 477:        Set objImageOutputClass = Nothing
 478:        Set objImageFileInterface = Nothing
 479:     End Sub
 480:  
 481:  'Write Statements'
 482:    Public Property Set TextFileInterface(obj) 
 483:       Set objTextFileInterface  = obj 
 484:    End Property
 485:   
 486:    'Write Statements'
 487:    Public Property Set RegexFilters(obj) 
 488:       Set objRegexFilters  = obj 
 489:    End Property
 490:    
 491:    Public Property Let ModeSelect(ByVal bln)
 492:       blnModeSelect =bln
 493:    End Property
 494:    
 495:    'Write Statements'
 496:    Public Property Set ImageFileInterface(obj) 
 497:       Set objImageFileInterface  = obj 
 498:    End Property
 499:    
 500:    Public Property Set ImageOutputClass(obj)
 501:       Set objImageOutputClass = obj
 502:    End Property
 503:  
 504:  'Processing function will be the control loop and call other private individual functions
 505:  Public Function ProcessFiles(ByVal intNumb)
 506:   Dim intCount 
 507:   'loop through each file'
 508:   For intCount = 0 to (intNumb-1) 'ListCount value gives e.g 5 files, but index starts at 0 so only need length value of 0-4 = 5 files'
 509:     Call ReadFile(intCount) 'filenumber starts at 0'
 510:       If (blnModeSelect = True) Then
 511:         Call ProcessFile(intCount)
 512:       Else 
 513:         Call ProcessFileNormal(intCount)
 514:       End if
 515:     Call WriteFile(intCount)
 516:   Next
 517:  End Function
 518:  
 519:  Public Function ProcessFileNormal(intFileIndex)
 520:    Dim objTextFile, aryNewString(), retString
 521:    
 522:    'get the current object'
 523:     Set objTextFile = New  TextFile 
 524:     Call objTextFileInterface.ReturnTheObject(objTextFile,intFileIndex)
 525:    
 526:     'process code here'
 527:    If (Ubound(objTextFile.Read) > 0) Then
 528:       'get the current value'
 529:       retString = objTextFile.Read 'get the values'
 530:       'past into final'
 531:       objTextFile.Final = retString 
 532:       ProcessFileNormal = True
 533:    Else 
 534:     ProcessFileNormal = False
 535:    End if
 536:    
 537:    'close the objects'
 538:     Set objTextFile = Nothing
 539:  End Function
 540:   
 541:  Public Function ProcessFile(intFileIndex)
 542:   Dim theFile,intI,retstring, objTextFile, i, aryNewString() ,intMax
 543:   Dim intImageFileCount, intLoop, aryImagefilePath(),strCurrentTextFileName, strElement  
 544:   
 545:   'get the current object'
 546:   Set objTextFile = New  TextFile 
 547:   Call objTextFileInterface.ReturnTheObject(objTextFile,intFileIndex)
 548:   
 549:   'file:///C:/Users/Lewis/Documents/Air/071030_BLD%20301007.gif
 550:   'get the listcount from the image object'
 551:   '' intImageFileCount = objImageFileInterface.ListCount
 552:    'set the aryImagefilePath() file Size'
 553:    'ReDim aryImagefilePath(intImageFileCount-1) '0...count
 554:   
 555:   'get current file name of the current textfile
 556:    'strCurrentTextFileName =objTextFile.filename
 557:   
 558:   'loop through each image'
 559: '   For intLoop = 0 to intImageFileCount-1
 560: '       Dim strImageFilePath
 561: '       'call method that will return the file path of each image'
 562: '       strImageFilePath =objImageOutputClass.ReturnPathIfRelationExists(strCurrentTextFileName,intLoop)
 563: '       If (strImageFilePath <> empty) Then
 564: '         'filter the path'
 565: '         strImageFilePath = objRegexFilters.AddressOK(strImageFilePath)
 566: '         'set the path into the array'
 567: '         aryImagefilePath(intLoop) = strImageFilePath
 568: '       'msgbox(aryImagefilePath(intLoop))
 569: '       End if 
 570: '   Next
 571:   
 572:   If (Ubound(objTextFile.Read) > 0) Then
 573:       'process the file'
 574:       intI=0 'set the innerloop counter'
 575:       retstring = objTextFile.Read 'get the values'
 576:       ReDim aryNewString(0) 
 577:       intMax = False 
 578:             
 579:       While intMax = False
 580:      
 581:         If (i = 0) Then 'first line'
 582:           ReDim Preserve aryNewString(i) 
 583:           aryNewString(i) = Div
 584:             'insert images here'
 585:             i=(i+1) 'increment for the images'
 586:             
 587:             'loop to print images'
 588: '             For Each strElement in aryImagefilePath 
 589: '               If (strElement <> Empty) Then
 590: '                 ReDim Preserve aryNewString(i)
 591: '                 aryNewString(i) = Paragraph & Img_Open & strElement & Img_Close & Paragraph_Close
 592: '                 i=(i+1)
 593: '               End if
 594: '             Next
 595:             
 596:         Elseif (intI = (Ubound(retstring))) Then 'last line'
 597:           ReDim Preserve aryNewString(i)
 598:           aryNewString(i) = Div_Close
 599:           intMax= True 'last operation finish the loop'
 600:         Else 'normal line'
 601:           
 602:           If  (objRegexFilters.TestLineBreak(retstring(intI))) Then   'line break' 
 603:             ReDim Preserve aryNewString(i)
 604:             aryNewString(i) =  HRule
 605:             intI =intI +1
 606:           Else
 607:             ReDim Preserve aryNewString(i)
 608:             aryNewString(i) = Paragraph & retstring(intI) & Paragraph_Close 
 609:             intI =intI +1
 610:           End if
 611:           
 612:         End if
 613:         
 614:         i= i +1 'increment the count'
 615:      
 616:       WEnd 
 617:      
 618:      'return sucess'
 619:       ProcessFile =true 
 620:      'write result to the object'
 621:       objTextFile.Final = aryNewString  
 622:   Else
 623:       'file is empty'
 624:       ProcessFile =False
 625:   End if
 626:   'close the objects'
 627:   Set objTextFile = Nothing
 628:   End Function
 629:  
 630:   Private Function WriteFile(intFileNumber)
 631:     Dim objTextFile, retstring,intCount,thefile
 632:     
 633:     'get the current object'
 634:     Set objTextFile = New Textfile
 635:     Call objTextFileInterface.ReturnTheObject(objTextFile,intFileNumber)
 636:     
 637:     If (Ubound(objTextFile.Read) > 0) Then 'test if file is Not Empty'
 638:     
 639:       'Set the Fso object to open the file'
 640:       Set theFile = objFso.OpenTextFile(objTextFile.FileName, ForWriting, False)
 641:       'get the object to write'
 642:       retstring = objTextFile.Final
 643:       intCount = 0
 644:       For intCount =0 To Ubound(retstring)
 645:         theFile.WriteLine(retstring(intCount))
 646:         theFile.WriteBlankLines(1)
 647:       Next
 648:       'Reset the objects
 649:       'objTextFile = Nothing
 650:   
 651:     End if
 652:   
 653:   End Function
 654:  
 655:  'this function will read the textfile internal Method
 656:   Private Function ReadFile(intFileNumber) 
 657:     Dim theFile,intI,retstring(), objTextFile
 658:     
 659:     'get the current object'
 660:     Set objTextFile = New  TextFile 
 661:     Call objTextFileInterface.ReturnTheObject(objTextFile,intFileNumber)
 662:     'set the fso object to the textfile'
 663:     Set theFile = objFso.OpenTextFile(objTextFile.FileName, ForReading, False)
 664:     'read the file' 
 665:     intI=0 'set the innerloop counter'
 666:     ReDim retstring(0) 
 667:     Do While thefile.AtEndOfStream = False  'only execute if file not empty'
 668:      'read the file into an array
 669:      retstring(intI) = theFile.ReadLine() 'line stored in current intI value, if previous not incremented will replace empty line.
 670:                     If objRegexFilters.TestEmptyLine(retstring(intI)) Then 'regular expression applied
 671:                      intI=intI+1 ' incremented to move next line
 672:                            ReDim Preserve retstring(intI) 
 673:                     Else 'empty line value will not increment
 674:                   End IF 
 675:     Loop
 676:          
 677:      theFile.close()'close the file'
 678:      objTextFile.Read  = retstring 'set retstring to the object'
 679:      'Reset the Variables'
 680:      Set theFile = Nothing
 681:      Set objTextFile = Nothing
 682:    End Function
 683:     
 684:  
 685:  End Class
 686: '------------------------------------------------------------------------------'
 687:  'Defines the Image Files
 688: Class ImageFiles
 689:   
 690:   'Class Global Variables
 691:    Private strAssocTextFile
 692:   
 693:    'Class Initilize'
 694:    Private Sub Class_Initialize
 695:       strAssocTextFile = empty
 696:    End Sub
 697:  
 698: '    'Class Terminate'
 699: '    Private Sub Class_Terminate
 700: '        
 701: '    End Sub
 702:   'Declare the Instance Varibales'
 703:    Private strFileName
 704:    Private strFilePath  
 705:       
 706:   'Read Statements'
 707:   Public Property Get FileName
 708:     FileName = strFileName  
 709:   End Property
 710:   
 711:   Public Property Get FilePath
 712:     FilePath = strFilePath
 713:   End Property
 714:   
 715:   Public Property Get AssocTextFile
 716:     AssocTextFile = strAssocTextFile
 717:   End Property
 718:   
 719:   'Write Statements'
 720:    Public Property Let FileName(strFile) 
 721:      strFileName = strFile  
 722:    End Property
 723:   
 724:    Public Property Let FilePath(str)
 725:      strFilePath = str  
 726:    End Property   
 727:      
 728: '   Public Property Set RelatedTextFiles(obj)
 729: '     If TypeName(obj) <> "TextFile" Then
 730: '        Msgbox ("invalid Object Type")
 731: '     Else ' is correct object'
 732: '       Set objTextFiles = obj
 733: '     End if
 734: '   End Property
 735:  
 736:   Property Let AssocTextFile(str)
 737:     strAssocTextFile = str
 738:   End Property
 739:  
 740: End Class
 741: '------------------------------------------------------------------------------'
 742: 'build add data and control output to event handlers '
 743: Class ImageOutput
 744:   'Class Instance Constants'
 745:   Private objFSO
 746:   Private intDays 
 747:   Private strDirectory 
 748:   'Varaibles'
 749:   Private objImageFileList 
 750:     
 751:   'class Initiate'
 752:   Private Sub Class_Initialize
 753:       Set objFSO       = CreateObject("Scripting.FileSystemObject")
 754:       intDays          = -1
 755:       strDirectory     = "C:\Users\Lewis\Documents\Air\"
 756:   End Sub
 757:   'class Terminate'
 758:   Private Sub Class_Terminate
 759:       Set objFSO    = Nothing
 760:   End Sub 
 761:   
 762:     'Read Statements'
 763:   Public Property Get PrintDays
 764:    Days = intDays 
 765:   End Property
 766:     
 767:      
 768:   'returns an object from the file list' 
 769:   Public Property Get ReturnPath(ByVal strFname) 
 770:    Dim objImage 
 771:    Set objImage = New ImageFiles 
 772:    Call objImageFileList.DisplayEntry(objImage,strFname)
 773:    ReturnPath = Cstr(objImage.FilePath) 
 774:   End Property
 775:   
 776:   'Write Statements'
 777:    Public Property Set ImageLists(obj) 
 778:       Set objImageFileList  = obj 
 779:    End Property
 780:   
 781:   Public Function Days(number)
 782:     intDays = -number
 783:   End Function
 784:            
 785:   'Methods'
 786:   'used to intilize the datastructure'
 787:   Public Function PopulateDictionary()
 788:     Dim objFolder
 789:     Dim objFilesCollection,intFiles
 790:     Dim objImageFiles
 791:     Dim dteToday
 792:     Dim RegexTest
 793:     Dim temp
 794:         
 795:     'regex test'
 796:     Set RegexTest = New RegexFilters
 797:     
 798:     temp = intDays
 799:     'Set the date properties'
 800:     dteToday = DateAdd("d",temp,Date)
 801:      
 802:      'clear the list if any items in there'
 803:      If (objImageFileList.ListCount >= 0) Then
 804:       Call objImageFileList.ClearAll()
 805:      End if
 806:         
 807:     'populate the objects'
 808:     If (objFSO.FolderExists(strDirectory)) Then
 809:       Set objFolder= objFSO.GetFolder(strDirectory)
 810:       Set objFilesCollection = objFolder.Files
 811:       For Each intFiles in objFilesCollection 
 812:            If (intFiles.DateCreated >= dteToday)  Then
 813:               If (RegexTest.TestFileType(intFiles.Name)) Then
 814:                 'created the file object'
 815:                 Set objImageFiles = New ImageFiles
 816:                 
 817:                 'add properties to objImageFiles'
 818:                 objImageFiles.FileName = intFiles.Name
 819:                 objImageFiles.FilePath = strDirectory & intFiles.Name           
 820:                 'add the entry to data-structure'
 821:                 objImageFileList.AddEntry(objImageFiles)
 822:                 Set objImageFiles = Nothing 'reset for next instance'
 823:               End if
 824:          End if
 825:       Next
 826:       PopulateDictionary = True
 827:     Else
 828:       PopulateDictionary = False
 829:     End if
 830:   End Function
 831:   
 832:   'return an array of all image objects'
 833:   Public Function ReturnArray()
 834:     'varaibles'
 835:     Dim aryImageFiles(), intCount, i
 836:      i=0 'set the inner loop counter default'
 837:        
 838:     'populate the array'
 839:     For intCount =0 to objImageFileList.ListCount 
 840:       'Create and ImageFiles object'
 841:       Dim objImage
 842:       Set objImage = New ImageFiles
 843:       'call the function to Set it'     
 844:       Call objImageFileList.MatchIndex(objImage,intCount) 'reterive the object'
 845:       
 846:       'Test if assocatiions are not null'
 847:       If (IsEmpty(objImage.AssocTextFile))  Then 
 848:         'resize the array'
 849:         ReDim Preserve aryImageFiles(i) 're-size the array' 
 850:         aryImageFiles(i) = objImage.FileName 'set the array vale as the image file name'
 851:         i=  (i+1)
 852:       End if 
 853:       
 854:       'reset the object'
 855:       Set objImage = Nothing
 856:     Next
 857:   
 858:     'return statement'
 859:     ReturnArray = aryImageFiles  
 860:   End Function
 861:  
 862:   'return an array of all image objects'
 863:   Public Function ReturnShortArray(strConditon)
 864:     'varaibles'
 865:     Dim aryImageFiles(), intCount ,i  
 866:      'msgbox(objImageFileList.ListCount)
 867:       i = 0
 868:            
 869:     'populate the array'
 870:     For intCount =0 to (objImageFileList.ListCount -1) 
 871:       'Create and ImageFiles object'
 872:       Dim objImage
 873:       Set objImage = New ImageFiles
 874:       'call the function to Set it'     
 875:       Call objImageFileList.MatchIndex(objImage,intCount) 'reterive the object'
 876:       
 877:       'Test if assocatiions are not null'
 878:       'Set the Inner Counter'
 879:       
 880:       
 881:       If (objImage.AssocTextFile = strConditon)  Then 
 882:         'resize the array'
 883:         ReDim Preserve aryImageFiles(i) 're-size the array' 
 884:         aryImageFiles(i) = objImage.FileName 'set the array vale as the image file name'
 885:         i = (i + 1) 'increment the counter'
 886:       End if 
 887:       
 888:       'reset the object'
 889:       Set objImage = Nothing
 890:      Next
 891:     
 892:     If (i > 0) Then  
 893:       'return statement'
 894:       ReturnShortArray = aryImageFiles
 895:     Else
 896:       ReturnShortArray = empty
 897:     End if   
 898:   End Function
 899:  
 900:    'set a varaible or remove it'
 901:   Public Function BindTextFileObject(strImgFileName,strText)
 902:     'access the dict reterive the object'
 903:     Dim objImage
 904:     Set objImage = New ImageFiles
 905:     Call objImageFileList.DisplayEntry(objImage,strImgFileName)
 906:     'msgbox("dddddd")
 907:     'change the object'
 908:     If typeName(objImage) = "ImageFiles" Then 
 909:       objImage.AssocTextFile = strText
 910:       BindTextFileObject = true
 911:        
 912:     Else 
 913:       BindTextFileObject = False
 914:     End if
 915:     
 916:     'Set objImage = Nothing 'reset the object'
 917:   End Function
 918:   
 919:     
 920:   Public Function UNBindTextFileObject(strImageFileName)
 921:     'access the dict reterive the object'
 922:     Dim objImage
 923:     Set objImage = New ImageFiles
 924:     Call objImageFileList.DisplayEntry(objImage,strImageFileName)
 925:     
 926:     'change the object'
 927:     objImage.AssocTextFile = empty
 928:     
 929:     'Set objImage = Nothing 'reset the object'
 930:   End Function
 931:   
 932:   Public Function ReturnPathIfRelationExists(strTextFileName,intIndex)
 933:     Dim objImage, index
 934:     Set objImage = New ImageFiles
 935:     'set the current object reference'
 936:     Call objImageFileList.MatchIndex(objImage,intIndex)
 937:     If (objImage.AssocTextFile = strTextFileName) Then
 938:       'return value relationExists'  
 939:       ReturnPathIfRelationExists = Cstr(objImage.FilePath)  
 940:     Else
 941:       ReturnPathIfRelationExists = Empty
 942:     End if
 943:     'remove the objects'
 944:     'objImage = Nothing
 945:   End Function
 946: End Class
 947: '------------------------------------------------------------------------------'
 948: </script>
 949: <script type="text/vbscript">
 950: '**********************Global objects******************************************'
 951: Dim objCreate 'CreateOpenTextFile object '
 952: Dim objFLists 
 953: Dim ImageOutputArray, ImageFilesDataStructure
 954: Dim objProcessTextFiles
 955: Dim WeeklyImageOutputArray,WeeklyImageFilesDataStructure
 956:  
 957: 'Create the Files'
 958: Set objCreate = New CreateOpenTextFile
 959: Set objFLists = New FileList 'created a new file-dictionary'
 960: Set objCreate.FileLists = objFLists  
 961: Set ImageOutputArray = New ImageOutput
 962: 'send the datastructures to the ImageOutputArray class'
 963: Set ImageFilesDataStructure = New FileList 'same structure used previously new instance'
 964: Set ImageOutputArray.ImageLists   = ImageFilesDataStructure 
 965: 'Process class'
 966: Set objProcessTextFiles = New ProcessTextFiles
 967: Set objProcessTextFiles.TextFileInterface = objCreate
 968: Set objProcessTextFiles.RegexFilters = New RegexFilters
 969: Set objProcessTextFiles.ImageFileInterface = ImageFilesDataStructure
 970: Set objProcessTextFiles.ImageOutputClass = ImageOutputArray 
 971:  
 972: 'weekly Images'
 973: Set WeeklyImageOutputArray = New ImageOutput
 974: 'send the datastructures to the ImageOutputArray class'
 975: Set WeeklyImageFilesDataStructure = New FileList 'same structure used previously new instance'
 976: Set WeeklyImageOutputArray.ImageLists   = WeeklyImageFilesDataStructure
 977:  
 978: 'refresh the child box'
 979: Public Sub RefreshChild ()
 980:    Dim intCurrentFileIndex
 981:    'get the current File Index'
 982:    intCurrentFileIndex = objCreate.CurrentFileIndex
 983:    strTextFileName =  objCreate.ActiveFileName
 984:       
 985:       'Reset the child master'
 986:     If (lstChild.length > 0) Then
 987:       dim ii
 988:       ii = lstChild.length -1  
 989:       For j = 0 to ii
 990:         Call lstChild.remove(lstChild.length-1)
 991:       Next
 992:     End if
 993:     
 994:     'get the filename from the slected image '
 995:     Dim aryImageArray,i
 996:     aryImageArray = ImageOutputArray.ReturnShortArray(strTextFileName) 
 997:       If (typename(aryImageArray) <> "Empty") Then
 998:           For i = 0 to (Ubound(aryImageArray)) 'length ie next free element -1 to get actual' 
 999:             Dim y 
1000:             Set y = document.createElement("option")
1001:             y.text = aryImageArray(i)
1002:             Call lstChild.add(y)
1003:             Set y = Nothing
1004:          Next
1005:      End if
1006: End Sub
1007:  
1008: Sub MasterFill ()
1009:   'get an array'
1010:     Dim aryImageArray,i,j,aryOptions
1011:     aryImageArray = ImageOutputArray.ReturnArray() 
1012:     
1013:     'Reset the First master'
1014:     If (lstMaster.length > 0) Then
1015:       dim ii
1016:       ii = lstMaster.length -1  
1017:       For j = 0 to ii
1018:         Call lstMaster.remove(lstMaster.length-1)
1019:       Next
1020:     End if
1021:     
1022:     're-fill the List'    
1023:     for i =0 to (Ubound(aryImageArray)-1) 'length ie next free element -1 to get actual' 
1024:     Dim y 
1025:      Set y = document.createElement("option")
1026:      y.text = aryImageArray(i)
1027:      Call lstMaster.add(y)
1028:      Set y = nothing
1029:     Next
1030: End Sub
1031: '*********************Event Handlers*******************************************'
1032: 'the onload event handler in the body'
1033: Public Sub NewHTA()
1034:   'hide the frame onload'
1035:   WeeklyFrame.style.display = "none"
1036:   Call WeeklyImages(1) 'default is One'
1037: End Sub
1038:  
1039: Sub Create()
1040:   'created varables
1041:   Dim intNumber 'number of files' 
1042:   
1043:   'get the number of files from the input filed'
1044:   intNumber = NumInputDataFiles.value 
1045:   If (objCreate.CreateFiles(intNumber)) Then
1046:     diditwork_step1.InnerHTML = "Successful" 
1047:   Else
1048:     diditwork_step1.InnerHTML = "Failed To Create File"
1049:   End if 
1050:   
1051:   'disbale/enable buttons'
1052:   btnPreviousFilebutton.disabled = "false" 'started at last number need to move to previous first
1053:   btnOpenFile.Disabled = "False"
1054:   btnNextFile.Disabled = "False"
1055:   btnProcessCollection.disabled="False"
1056:   filepath.InnerHtml = "Article" & intNumber &".txt"
1057:   btnRemoveImage.Disabled = "False"
1058:   btnAddImage.Disabled = "False"
1059:   btnIncreaseTime.disabled = "False"
1060:   
1061:   'set the state Filds'
1062:   'numfiles.value = intNumber 'max number of Files'
1063:   'numFilesTwo.value = intNumber 'first article to max_Number'
1064:   
1065:   'bind the image selection boxes'
1066:      If (ImageOutputArray.PopulateDictionary()) Then
1067:        Call MasterFill ()
1068:      Else 
1069:     Msgbox("Image-Binding Failed")
1070:     End if
1071: End Sub
1072:  
1073: 'event handler to open the file'
1074: Sub OpenFile()
1075:    objCreate.Open()
1076: End sub
1077:  
1078: 'event handerls for btnNext'
1079: Sub Nextbutton() 
1080:  'only change the file path if true
1081:   If  (objCreate.NextFile()) Then
1082:     filepath.innerHTML = "Article"& objCreate.CurrentFileIndex &".txt"
1083:     If (btnPreviousFilebutton.disabled = "True")  then
1084:         btnPreviousFilebutton.disabled = "False"
1085:     End if 
1086:   Else
1087:     btnNextFile.Disabled = "True" 'so cant click again
1088:     msgbox("no Files")
1089:   End if
1090:   
1091:   'reset the master and child Ray'
1092:   Call MasterFill ()
1093:   'reset the Child'
1094:   Call RefreshChild ()
1095:  
1096: End Sub 
1097:  
1098: 'eventHandler for the btnPrevious'
1099: Sub PrevButton() 
1100:  'only change the file path if true
1101:   If  (objCreate.PrevFile()) Then
1102:     filepath.innerHTML = "Article"& objCreate.CurrentFileIndex &".txt"
1103:     If (btnNextFile.Disabled = "True") Then
1104:         btnNextFile.Disabled = "False"
1105:     End if 
1106:   Else
1107:     msgbox("no Files") 
1108:     btnPreviousFilebutton.disabled = "True"
1109:   End if
1110:  
1111:   'reset the master and child Ray'
1112:   Call MasterFill ()
1113:   'reset the Child'
1114:   Call RefreshChild ()
1115:   
1116: End Sub
1117:  
1118: 'Event Handler for the btnCleanupFilesButton'
1119: Sub ProcessCollection()
1120: Call objProcessTextFiles.ProcessFiles(objFLists.ListCount)
1121:  
1122: btnCleanupFilesButton.disabled ="False" 
1123: btnProcessCollection.disabled = "true"
1124: End Sub
1125:  
1126:  
1127: Sub CleanFiles()
1128:    If (objCreate.DeleteTheFiles())Then
1129:       btnCleanupFilesButton.disabled ="True"
1130:    Else
1131:       MsgBox ("Failed to Delete Files")
1132:   End If
1133:   'refresh the page'
1134:   Call window.location.reload()
1135: End Sub
1136:  
1137: 'event hander for the btnBindImage'
1138: Sub BindImage()
1139:   'get the current Textfile'
1140:   Dim intCurrentImgIndex,strFileName,strFName,intSelectedIndex
1141:   intCurrentImgIndex =CInt(objCreate.CurrentFileIndex)
1142:   
1143:   'Set objTextFile = New TextFile
1144:   strTextFileName = objCreate.ReturnObject(intCurrentImgIndex-1)
1145:   
1146:   'get slected image file'
1147:    intSelectedIndex = lstMaster.selectedIndex
1148:    
1149:   If (intSelectedIndex >=0) Then
1150:      strImageFName= lstMaster.options(intSelectedIndex).text 
1151:     'msgbox(strImageFName & strTextFileName)
1152:     'set the object properties'
1153:     If (ImageOutputArray.BindTextFileObject(strImageFName,strTextFileName)) Then
1154:      'refresh the dam thing'
1155:      'Reset the First master'
1156:       If (lstChild.length > 0) Then
1157:         dim ii
1158:         ii = lstChild.length -1  
1159:         For j = 0 to ii
1160:           Call lstChild.remove(lstChild.length-1)
1161:         Next
1162:       End if
1163:      'get the filename from the slected image '
1164:       Dim aryImageArray,i
1165:       aryImageArray = ImageOutputArray.ReturnShortArray(strTextFileName) 
1166:       For i = 0 to (Ubound(aryImageArray)) 'length ie next free element -1 to get actual' 
1167:          Dim y 
1168:          Set y = document.createElement("option")
1169:          y.text = aryImageArray(i)
1170:          Call lstChild.add(y)
1171:          Set y = Nothing
1172:       Next
1173:       'refersh the master array'
1174:         Call MasterFill()
1175:     Else
1176:     msgbox ("binding failed")
1177:     End If
1178:   End if
1179: End Sub 
1180:  
1181: 'Bind the currently selected image to the preview'
1182: Sub ImagePreview(text)
1183:     Dim strFName,intSelectedIndex,strFilePath
1184:     'check for the right list'
1185:     If (text = "Master") Then
1186:         'get the selected item'
1187:         intSelectedIndex = lstMaster.selectedIndex
1188:         If (intSelectedIndex >= 0 ) Then
1189:             strFName = lstMaster.options(intSelectedIndex).text
1190:         End if
1191:     Else
1192:         'get the selected item'
1193:         intSelectedIndex = lstChild.selectedIndex
1194:         If (intSelectedIndex >= 0 ) Then
1195:            strFName = lstChild.options(intSelectedIndex).text
1196:         End if
1197:     End if
1198:     If (strFName <> empty) Then 
1199:         'get the full path' 
1200:         strFPath = ImageOutputArray.ReturnPath(strFName)
1201:         'set the preview frame properties'
1202:         imgPreview.src =strFPath
1203:     End if
1204: End Sub
1205:  
1206: 'event handler for the btnUnbind 
1207: Public Sub UnBindImage()
1208:   Dim intSelectedIndex,strImageFName
1209:   'get slected image file'
1210:    intSelectedIndex = lstChild.selectedIndex
1211:    If (intSelectedIndex >= 0 ) Then 'if not valid dont call it'
1212:       strImageFName= lstChild.options(intSelectedIndex).text 
1213:       Call ImageOutputArray.UNBindTextFileObject(strImageFName)  
1214:       'refersh the master array'
1215:       Call MasterFill()
1216:       'refresh the child'
1217:       Call RefreshChild()
1218:   End if
1219: End Sub
1220:  
1221:  
1222: Public Sub ChangeTimeWeekly()
1223: Dim intNumDays
1224:    'get the value from the inputbox'
1225:    intNumDays = txtnumdaysWeekly.value
1226:    intNumDays = Cint(intNumDays)
1227:    intNumDays = abs(intNumDays)
1228:   'refresh the screen'   
1229:   Call WeeklyImages(intNumDays)    
1230: End sub
1231:  
1232: 'event handler for the btnChangeTime'
1233: Public Sub ChangeTime()
1234:    Dim intNumDays
1235:    
1236:    'get the value from the inputbox'
1237:    intNumDays = txtnumdays.value
1238:    intNumDays = Cint(intNumDays)
1239:    intNumDays = abs(intNumDays)
1240:    'msgbox(typename(intNumDays))
1241:    
1242:    
1243:    'validate the value  ie not negative and is a number <365
1244:   If (IsNumeric(intNumDays)) Then
1245:       
1246:       'call the method to empty the imagefile directory'
1247:       Call ImageFilesDataStructure.ClearAll()
1248:       
1249:       'set the days variable'
1250:       Call ImageOutputArray.Days(intNumDays)
1251:                        
1252:       'populate the dictionary'
1253:       Call ImageOutputArray.PopulateDictionary()
1254:       
1255:       'refersh the master array'
1256:       Call MasterFill()
1257:       'refresh the child'
1258:       Call RefreshChild()
1259:   Else
1260:     Msgbox ("Invalid Number")  
1261:   End if
1262: End Sub
1263:  
1264: 'event handers for the tabs '
1265: Public Sub SwitchWeekly ()
1266:   NormalFrame.style.display ="none"
1267:   WeeklyFrame.style.display = "block"
1268: End Sub
1269:  
1270: Public Sub SwitchNormal ()
1271:   WeeklyFrame.style.display ="none"
1272:   NormalFrame.style.display ="block"
1273: End Sub
1274:  
1275: 'event handler for the chkMode checkbox'
1276: Public Sub ModeSwitch()
1277:  If (chkMode.checked = True) Then  'non-markp mode
1278:   objProcessTextFiles.ModeSelect = False
1279:  Else     ' Markup Mode'
1280:   objProcessTextFiles.ModeSelect = True
1281:  End if
1282: End Sub
1283:  
1284: '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>..Event Handlers for second Frame..>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>'
1285:  
1286: Public Sub WeeklyImages(days)
1287:   'declare the varaibles'
1288:   Dim strFPath,intCount,i,thefilepath,FName
1289:   Dim objImageFile, temptext, testobject,NameNode,ButtonNode,temp
1290:    
1291:   'set the number of days'
1292:   Call WeeklyImageOutputArray.Days(days) 
1293:   
1294:   'populate the dictionary'
1295:   Call WeeklyImageOutputArray.PopulateDictionary()
1296:               
1297:   'Bind the currently selected image to the preview'
1298:   intCount = WeeklyImageFilesDataStructure.ListCount 'get count from the file list'
1299:   'use the match index method to return the image'
1300:    For i = 0 to intCount-1   
1301:        Set objImageFile = New ImageFiles
1302:        Call WeeklyImageFilesDataStructure.MatchIndex(objImageFile,i)
1303:        thefilepath= objImageFile.FilePath
1304:        FName= objImageFile.FileName
1305:        
1306:        'define button node'
1307: '        Set ImageNode  = document.createElement("img")
1308: '        Set NameNode   = document.createElement("div")
1309: '        Set ButtonNode = document.createElement("button")
1310: '                    
1311: '        With WeeklyFrame.appendChild(NameNode)
1312: '                  .innerHTML      =FName   
1313: '        End With
1314: '           
1315: '        With WeeklyFrame.appendChild(ImageNode)
1316: '        Call    .setAttribute("src", thefilepath&FileName)
1317: '                
1318: '        End With
1319:        
1320:        'With WeeklyFrame.appendChild(ImageNode)
1321:        
1322:        'End With
1323:        
1324:        temptext = temptext & "<img style=""margin:10px 20px 10px 20px"" src="""&thefilepath&FileName&""" />"
1325:        WeeklyFrame.innerHTML = tempText
1326:    Next
1327:       temptext = empty 'reset just incase'
1328: End Sub

 

Screen-Shots

 

blog_230408_01 blog_230408_02

Blog_230408_03 blog_230408_04

blog_230408_05

 

 

Download: LineRemoverClass.hta (48.81 kb)

 

Be the first to rate this post

  • Currently 0/5 Stars.
  • 1
  • 2
  • 3
  • 4
  • 5

Comments

Add comment


(Will show your Gravatar icon)  

  Country flag

biuquote
  • Comment
  • Preview
Loading