If you don't know it, have a look at http://www.photools.com/
These Scripts can be used any way, but also without any kind of warranty!
If you don't agree, please leave now.
= new Script
= updated Script
Multi Database Transmission V 1.2 (06-Jun-2003) - This script transmits Images from a SourceDB to a TargetDB, preserving all Category-Assignments and Property-Entries. (And, *g*, if Mario would give us an updated Timestamp for the DatabaseImageRecords, we could merge Databases by checking which Entry is newer. Think about mobile IMatch.)
Remove Empty Categories from Database V 1.0 (30-May-2003) - This script removes all 'empty'-Categories from the active Database.
OffLineCache Garbage Collector V 1.0 (28-Jun-2003) - This script checks all existing Images in OfflineCacheFolder of the active Database and deletes ownerless OLC-Images. Additionally you can select some Categories from which you want delete the Images OfflineCache-pendants.
Photoshop Conversion (PS 5.5 + 6) V 0.9 (02-Jul-2003) - This Script combines the ManagementPower of IMatch with the ImageManipulationPower of Adobes Photoshop 6.0 in an easy to use way. This Script I have written together with Klaus Schwarzburg. Many thanks for your help, Klaus.
lcms Webgallery Creator V 0.1 (05-Oct-2002) - This script enhance the original Webgallery-Creator-Script with an ICC-Conversion-feature.
little Batch Converter V 1.2 (26-Jun-2003) - This script create resized copies, optionally with ICC-Conversion for Tiff- and Jpeg-sources. Can work with OfflineCacheImages instead of originals and can transmit all Property-, Category- and IPTC-data to the copies.
Registry Functions V 1.0 (01-Nov-2002) - A littleHelper-Script to put and retrieve Data to/from Registry in its correct DataTypes. VB usually provides only the StringType. With this Lib you can store every DataType to Registry (Byte, Integer, Long, Double, Decimal, Boolean, Variant, ...).
Debug Messages V 1.0 (08-Nov-2002) - A littleHelper-Script which handles Debugoutput in Priorityclasses. With this you can have good Informationoutput when you develope a Script and a less or no Output when run the Script in Productivity-Mode. Your DebugmessagePoints can stay in code without any (auswirkung). Usefull for future changes on your code.
Explanation
MainScript: hn_PhotoshopConversion.bas
Needed Modules: [hnFncPSOLE.lib]
[hnFncUtils.lib]
[hnClsRegKey.cls]
[hnPSoleDeclarations.lib]
[hnPublicDeclarations.lib]
hnClsRegKey.cls: (684 lines / 393 real codelines / 0 Subs / 5 Functions / 14 Properties)
1| VERSION 1.0 CLASS 2| BEGIN 3| MultiUse = -1 'True 4| Persistable = 0 'NotPersistable 5| DataBindingBehavior = 0 'vbNone 6| DataSourceBehavior = 0 'vbNone 7| MTSTransactionMode = 0 'NotAnMTSObject 8| END 9| Attribute VB_Name = "clsRegKey" 10| Attribute VB_GlobalNameSpace = False 11| Attribute VB_Creatable = True 12| Attribute VB_PredeclaredId = False 13| Attribute VB_Exposed = True 14| '|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 15| ' 16| 17| ' 18| ' h.nogajski@web.de 19| ' http://horst.nogajski.de 20| ' 21| '-------------------------------------------------------------------------------------------------- 22| ' 23| ' RegistryClass (for SAX-Basic or VBA) 24| ' 25| ' Set/Get Values to/from Registry with different VarTypes (Not only StringVars!) 26| ' 27| 'V 1.0 (21-Mar-2003) 28| ' 29| '|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 30| '-------------------------------------------------------------------------------------------------- 31| ' 32| ' Uses / Embedds 33| ' 34| '#uses "hnPublicDeclarations.lib" 35| ' 36| '-------------------------------------------------------------------------------------------------- 37| ' 38| ' Public Functions: 39| ' 40| ' ------------------------------------------------------------------------------------------- 41| ' ClsVersion 42| ' Descript: Returns the revision Version of this Class, 43| ' To allow testing For downward compatibility 44| ' two digits per position, allows for versions such as V 20.12.29 45| ' last position not used in String now 46| ' (could be used for internal releases for example), set to 00 in Long 47| ' Returns: Long 48| ' ------------------------------------------------------------------------------------------- 49| ' ClsVersionString 50| ' Returns: String 51| ' ------------------------------------------------------------------------------------------- 52| ' ClsName 53| ' Descript: returns the Private Const SCRIPTNAME 54| ' Returns: String 55| ' ------------------------------------------------------------------------------------------- 56| ' CheckVersionAgainst 57| ' Descript: Checks a given Long against the ClassVersionNumber. 58| ' The given Long represents the ClassVersionNumber which the 59| ' script-author has used creating his script. 60| ' Params: Long neededLong, Optional Boolean suppressMsgBox 61| ' Returns: Boolean 62| ' ------------------------------------------------------------------------------------------- 63| ' ClassInit 64| ' Descript: Initializes the class instance. Returncodes are: 65| ' 0 for an Error / couldn't be initialized 66| ' -1 for successfull initialization 67| ' 1 if it is already initialized 68| ' Params: String SectionStr, Optional String AppStr 69| ' Returns: Integer 70| ' ------------------------------------------------------------------------------------------- 71| ' ClassUNSET 72| ' Descript: Clears all values of all modulglobal-variables 73| ' After that, the class must/can be initialized again for further using 74| ' Returns: Boolean 75| ' ------------------------------------------------------------------------------------------- 76| ' SaveKey 77| ' Descript: Saves a Key/Value-Pair to Registry and a second one, storing the original Typedefinition. 78| ' Params: String KeyName, Variant KeyValue, Enumeration MyVarType 79| ' Returns: Boolean 80| ' ------------------------------------------------------------------------------------------- 81| ' GetKey 82| ' Descript: Returns the Value of a given Key converted to it's original VarType. (e.g. Integer, Boolean, Long, ...) 83| ' Params: String KeyName, Optional any Type DefaultValue 84| ' Returns: Variant (RegistryValue or optional the DefaultValue in correct Type) 85| ' ------------------------------------------------------------------------------------------- 86| ' DelKey 87| ' Descript: Deletes a given Key. 88| ' Params: String KeyName 89| ' Returns: Boolean 90| ' ------------------------------------------------------------------------------------------- 91| ' DelAllKeys 92| ' Descript: Deletes the whole KeyTree. 93| ' Params: / 94| ' Returns: Boolean 95| ' ------------------------------------------------------------------------------------------- 96| ' GiveTreeName 97| ' Descript: Returns the Treename 98| ' Returns: String 99| ' ------------------------------------------------------------------------------------------- 100| ' GiveKeyArray 101| ' Descript: Returns a sorted array with all Keys, optional with TypedefinitionKeys. 102| ' Params: Optional Boolean WithTypeDefinitions 103| ' Returns: String() 104| ' ------------------------------------------------------------------------------------------- 105| ' PRESETS_GiveKeyArray 106| ' Descript: Returns a whole SubfolderRegTree 107| ' Should only be used by the RegTreePreset-Class 108| ' Returns: String() 109| ' ------------------------------------------------------------------------------------------- 110| ' PRESETS_SaveKey 111| ' Descript: Saves only StringType Key/Value-Pairs to Registry without a second one! 112| ' Should only be used by the RegTreePreset-Class 113| ' Params: String KeyName, String KeyValue 114| ' Returns: Boolean 115| ' 116| '-------------------------------------------------------------------------------------------------- 117| ' 118| ' Private Functions: 119| ' 120| ' TypeToRegVal 121| ' Converts any Type to String and associate the Typedefinition to global CurRegValType 122| ' RegValToType 123| ' Converts a given Var to the Type stored in the second RegKey 124| ' ResetGlobalVars 125| ' Resets the two globalVars CurRegVal + CurRegValType 126| ' RKF_SortStringArray 127| ' Sorts a given StringArray ascending ByRef 128| ' 129| '-------------------------------------------------------------------------------------------------- 130| ' 131| ' VersionChanges: 132| ' 133| ' V 0.8 (08-Mar-2003) initial release; 134| ' was before: hnFncRegKey.lib V1.1, but as class it is more flexible; 135| ' 136| ' V 1.0 (21-Mar-2003) added two functions for using with RegTreePreset-Class 137| ' PRESETS_GiveKeyArray and PRESETS_SaveKey; 138| ' added the ClassUNSET-function; 139| ' 140| '-------------------------------------------------------------------------------------------------- 141| ' 142| ' Credits: 143| ' 144| ' ClassVersion, ClassVersionString / from Peter Meinhardt (Mei), many thanks Peter ;-) 145| ' 146| '-------------------------------------------------------------------------------------------------- 147| '|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 148| 149| 150| Option Explicit 151| 152| 'ClassVersion 153| Private Const ClassVersionString As String = "V 1.0 (21-Mar-2003)" 154| Private Const ClassVersion As Long = 10000 155| 156| 'SCRIPTNAME is needed for ClassName, MsgBoxTitles, etc. 157| Private Const SCRIPTNAME As String = "RegKeyClass" 158| 159| 'Will be set in ClassInit() 160| Private bSuppressClassNotReadyMsg As Boolean 161| Private bClassReady As Boolean 162| 163| 164| 'Two Vars which holds the SectionNames 165| Private My_RegKeyApp As String 166| Private My_RegKeySection As String 167| 168| 'A Suffix added to the RegKey storing the VarType 169| Private Const KEYSUFFIX As String = "_VarType" 170| 171| 'Two Vars, the Wrapperfunction needs for transferring data between them 172| Dim CurRegVal As Variant 173| Dim CurRegValType As String 174| 175| 176| Public Property Get ClsVersion() As Long 177| ClsVersion = ClassVersion 178| End Property 179| 180| Public Property Get ClsVersionString() As String 181| ClsVersionString = ClassVersionString 182| End Property 183| 184| Public Property Get ClsName() As String 185| ClsName = SCRIPTNAME 186| End Property 187| 188| Public Property Get CheckVersionAgainst(ByRef neededLong As Long, Optional ByRef suppressMsgBox As Boolean = False) As Boolean 189| If neededLong <= ClassVersion Then 190| CheckVersionAgainst = True 191| Else 192| CheckVersionAgainst = False 193| If Not suppressMsgBox Then 194| MsgBox "The version of the " & SCRIPTNAME & " is to old: " & ClassVersionString & " = long(" & ClassVersion & ")" & vbNewLine & vbNewLine & _ 195| "Maybe that you have overwritten the file contained in the ZIP file of this Script" & vbNewLine & _ 196| "with an outdated version delivered with another script in your Script folder." & vbNewLine & vbNewLine & _ 197| "Please check and reinstall the file from the ZIP file of this Script" & vbNewLine & _ 198| "with version: long(" & CStr(neededLong) & "), or greater.", vbInformation,"Outdated Classfile: " & SCRIPTNAME 199| End If 200| End If 201| End Property 202| 203| Public Property Get ClassUNSET() As Boolean 204| 'Here comes all modulglobal variables in 205| 'and must be set to false, null and emptystrings, etc. 206| My_RegKeyApp = "" 207| My_RegKeySection = "" 208| CurRegVal = "" 209| CurRegValType = "" 210| bClassReady = False 211| bSuppressClassNotReadyMsg = False 212| ClassUNSET = True 213| End Property 214| 215| 216| Public Property Get ClassInit(ByVal SectionStr As String, Optional ByVal AppStr As String = "photools.com\IMatch.3\Scripts", Optional ByVal TreeMustExist As Boolean = False) As Integer 217| 218| On Error GoTo ErrHandler 219| ClassInit = 0 220| 221| If bClassReady Then 222| ClassInit = 1 223| GoTo Escape 224| End If 225| 226| 227| If SectionStr <> "" And AppStr <> "" Then 228| My_RegKeyApp = AppStr 229| My_RegKeySection = SectionStr 230| 231| If TreeMustExist Then 232| Dim CheckVar As Variant 233| CheckVar = GetAllSettings(My_RegKeyApp,My_RegKeySection) 234| 'Next 2 line are needed to check for Error 10080 = Type mismatch! If this Error occurs we have a filled Array and so we know that the SectionTree exists! 235| On Error Resume Next 236| If (CheckVar = Empty) Then CheckVar = Empty 237| 238| If Err.Number > 0 Then 239| If Err.Number = 10080 Then 240| 'We have a filled Array 241| bClassReady = True 242| ClassInit = -1 243| Else 244| 'We have an unespected Error! 245| GoTo ErrHandler 246| End If 247| Else 248| 'No Error-Number: We have an Empty-Var, no filled Array! 249| MsgBox "The given TreeSection doesn't exist!" & vbNewLine & My_RegKeyApp & "\" & My_RegKeySection, vbInformation, SCRIPTNAME & " (ClassInit)" 250| End If 251| Else 252| 253| bClassReady = True 254| ClassInit = -1 255| 256| End If 257| End If 258| 259| Escape: 260| Exit Property 261| 262| ErrHandler: 263| MsgBox "Error: " & Err.Number & vbNewLine & Err.Description & vbNewLine & " ", , SCRIPTNAME & " (ClassInit)" 264| Resume Escape 265| 266| End Property 267| 268| 269| Public Property Get SaveKey(ByRef MyKey As String, ByVal MyVal As Variant, Optional ByRef AsType As MyVarType = AsString) As Boolean 270| 271| On Error GoTo ErrHandler 272| 273| If Not bClassReady Then 274| MsgBox "ERROR: The ClassInstance isn't initialized!" & vbNewLine & " - The AppStr: " & My_RegKeyApp & vbNewLine & " - The SectionStr: " & My_RegKeySection, vbCritical 275| Else 276| ResetGlobalVars() 277| NEWTypeToRegVal(MyVal,AsType) 278| SaveSetting My_RegKeyApp, My_RegKeySection, MyKey, CurRegVal 279| SaveSetting My_RegKeyApp, My_RegKeySection, MyKey & KEYSUFFIX, CurRegValType 280| SaveKey = True 281| End If 282| 283| Escape: 284| Exit Property 285| 286| ErrHandler: 287| MsgBox "Error: " & Err.Number & vbNewLine & Err.Description & vbNewLine & " ", , SCRIPTNAME & " (SaveKey)" 288| Resume Escape 289| 290| End Property 291| 292| 293| Public Property Get GetKey(ByRef MyKey As String, Optional ByVal MyDefaultValue As Variant = Empty) As Variant 294| 295| On Error GoTo ErrHandler 296| 'Debug.Print "- GetKey: " & MyKey 297| 298| If Not bClassReady Then 299| MsgBox "ERROR: The ClassInstance isn't initialized!" & vbNewLine & " - The AppStr: " & My_RegKeyApp & vbNewLine & " - The SectionStr: " & My_RegKeySection, vbCritical 300| Else 301| ResetGlobalVars() 302| CurRegValType = GetSetting(My_RegKeyApp, My_RegKeySection, MyKey & KEYSUFFIX) 303| 304| If CurRegValType = "" Then 305| If MyDefaultValue <> Empty Then GetKey = MyDefaultValue 306| Else 307| RegValToType(GetSetting(My_RegKeyApp, My_RegKeySection, MyKey, MyDefaultValue)) 308| GetKey = CurRegVal 309| End If 310| 'Debug.Print " - Value = " & GetKey 311| End If 312| 313| Escape: 314| Exit Property 315| 316| ErrHandler: 317| MsgBox "Error: " & Err.Number & vbNewLine & Err.Description & vbNewLine & " ", vbExclamation, SCRIPTNAME & " (GetKey)" 318| Resume Escape 319| 320| End Property 321| 322| 323| Public Property Get DelKey(ByRef MyKey As String) As Boolean 324| 325| On Error GoTo ErrHandler 326| 327| If Not bClassReady Then 328| MsgBox "ERROR: The ClassInstance isn't initialized!" & vbNewLine & " - The AppStr: " & My_RegKeyApp & vbNewLine & " - The SectionStr: " & My_RegKeySection, vbCritical 329| Else 330| ResetGlobalVars() 331| CurRegVal = GetSetting(My_RegKeyApp, My_RegKeySection, MyKey) 332| CurRegValType = GetSetting(My_RegKeyApp, My_RegKeySection, MyKey & KEYSUFFIX) 333| 334| If CurRegValType = "Empty" And TypeName(CurRegVal) = "String" And CurRegVal = "" Then 335| DeleteSetting(My_RegKeyApp, My_RegKeySection, MyKey) 336| End If 337| 338| If CurRegVal <> "" Then DeleteSetting(My_RegKeyApp, My_RegKeySection, MyKey) 339| If CurRegValType <> "" Then DeleteSetting(My_RegKeyApp, My_RegKeySection, MyKey & KEYSUFFIX) 340| 341| DelKey = True 342| End If 343| 344| Escape: 345| Exit Property 346| 347| ErrHandler: 348| MsgBox "Error: " & Err.Number & vbNewLine & Err.Description & vbNewLine & " ", , SCRIPTNAME & " (DelKey)" 349| Resume Escape 350| 351| End Property 352| 353| 354| Public Property Get DelAllKeys() As Boolean 355| 356| On Error GoTo ErrHandler 357| 358| If Not bClassReady Then 359| MsgBox "ERROR: The ClassInstance isn't initialized!" & vbNewLine & " - The AppStr: " & My_RegKeyApp & vbNewLine & " - The SectionStr: " & My_RegKeySection, vbInformation 360| Else 361| ResetGlobalVars() 362| SaveSetting(My_RegKeyApp, My_RegKeySection, "IwillDelYouSoon", "truely =:)") 363| DeleteSetting(My_RegKeyApp, My_RegKeySection) 364| DelAllKeys = True 365| End If 366| 367| Escape: 368| Exit Property 369| 370| ErrHandler: 371| MsgBox "Error: " & Err.Number & vbNewLine & Err.Description & vbNewLine & " ", , SCRIPTNAME & " (DelAllKeys)" 372| Resume Escape 373| 374| End Property 375| 376| 377| Public Property Get GiveKeyArray(Optional ByRef WithTypeDefinitions As Boolean = False, Optional ByRef PrintAlsoToDebugWindow As Boolean = False) As String() 378| 379| On Error GoTo ErrHandler 380| If Not bClassReady Then 381| MsgBox "ERROR: The ClassInstance isn't initialized!" & vbNewLine & " - The AppStr: " & My_RegKeyApp & vbNewLine & " - The SectionStr: " & My_RegKeySection, vbInformation, SCRIPTNAME & " (GiveKeyArray)" 382| Else 383| ResetGlobalVars() 384| Dim AllMyKeys As Variant 385| Dim SortedKeys() As String 386| Dim i As Integer 387| 388| AllMyKeys = GetAllSettings(My_RegKeyApp,My_RegKeySection) 389| For i = LBound(AllMyKeys) To UBound(AllMyKeys) 390| ReDim Preserve SortedKeys(i) 391| SortedKeys(i) = CStr(AllMyKeys(i,0)) & "=" & CStr(AllMyKeys(i,1)) 392| If PrintAlsoToDebugWindow And WithTypeDefinitions Then Debug.Print SortedKeys(i) 393| Next i 394| RKF_SortStringArray(SortedKeys()) 395| 396| If WithTypeDefinitions Then 397| GiveKeyArray = SortedKeys() 398| Else 399| Dim noTypeDefs() As String 400| Dim k As Integer 401| k = 0 402| For i = LBound(SortedKeys) To UBound(SortedKeys) 403| If InStr(SortedKeys(i),KEYSUFFIX) = 0 Then 404| ReDim Preserve noTypeDefs(k) 405| noTypeDefs(k) = SortedKeys(i) 406| If PrintAlsoToDebugWindow Then Debug.Print noTypeDefs(k) 407| k = k + 1 408| End If 409| Next i 410| GiveKeyArray = noTypeDefs() 411| End If 412| End If 413| 414| Escape: 415| Exit Property 416| 417| ErrHandler: 418| MsgBox "Error: " & Err.Number & vbNewLine & Err.Description & vbNewLine & " ", vbCritical, SCRIPTNAME & " (GiveKeyArray)" 419| Resume Escape 420| 421| End Property 422| 423| 424| Public Property Get PRESETS_GiveKeyArray(ByRef vArray As Variant) As Boolean 425| 426| On Error GoTo ErrHandler 427| If Not bClassReady Then 428| MsgBox "ERROR: The ClassInstance isn't initialized!" & vbNewLine & " - The AppStr: " & My_RegKeyApp & vbNewLine & " - The SectionStr: " & My_RegKeySection, vbInformation, SCRIPTNAME & " (GiveKeyArray)" 429| Else 430| 431| Dim AllMyKeys As Variant 432| AllMyKeys = GetAllSettings(My_RegKeyApp,My_RegKeySection) 433| vArray = AllMyKeys 434| 'vArray = Empty 'for testing purposes 435| 436| PRESETS_GiveKeyArray = True 437| 438| End If 439| 440| Escape: 441| Exit Property 442| 443| ErrHandler: 444| MsgBox "Error: " & Err.Number & vbNewLine & Err.Description & vbNewLine & " ", vbCritical, SCRIPTNAME & " (GiveKeyArray)" 445| Resume Escape 446| 447| End Property 448| 449| 450| Public Property Get PRESETS_SaveKey(ByRef MyKey As String, ByRef MyVal As String) As Boolean 451| 452| On Error GoTo ErrHandler 453| 454| If Not bClassReady Then 455| MsgBox "ERROR: The ClassInstance isn't initialized!" & vbNewLine & " - The AppStr: " & My_RegKeyApp & vbNewLine & " - The SectionStr: " & My_RegKeySection, vbInformation, SCRIPTNAME & " (PRESETS_SaveKey)" 456| Else 457| SaveSetting My_RegKeyApp, My_RegKeySection, MyKey, MyVal 458| PRESETS_SaveKey = True 459| End If 460| 461| Escape: 462| Exit Property 463| 464| ErrHandler: 465| MsgBox "Error: " & Err.Number & vbNewLine & Err.Description & vbNewLine & " ", vbCritical, SCRIPTNAME & " (PRESETS_SaveKey)" 466| Resume Escape 467| 468| End Property 469| 470| 471| Public Property Get GiveTreeName() As String 472| 473| On Error GoTo ErrHandler 474| 475| If Not bClassReady Then 476| MsgBox "ERROR: The ClassInstance isn't initialized!" & vbNewLine & " - The AppStr: " & My_RegKeyApp & vbNewLine & " - The SectionStr: " & My_RegKeySection, vbInformation, SCRIPTNAME & " (PRESETS_SaveKey)" 477| Else 478| GiveTreeName = My_RegKeyApp & "\" & My_RegKeySection 479| End If 480| 481| Escape: 482| Exit Property 483| 484| ErrHandler: 485| MsgBox "Error: " & Err.Number & vbNewLine & Err.Description & vbNewLine & " ", vbCritical, SCRIPTNAME & " (GiveTreeName)" 486| Resume Escape 487| 488| End Property 489| 490| 491| 492| Private Function NEWTypeToRegVal(ByRef MyVal As Variant, ByRef MyType As MyVarType) As String 493| 494| Select Case MyType 495| Case AsEmpty 496| CurRegVal = "" 497| CurRegValType = "Empty" 498| Case AsNull 499| CurRegVal = "" 500| CurRegValType = "Empty" 501| Case AsByte 502| CurRegVal = CStr(MyVal) 503| CurRegValType = "Byte" 504| Case AsInteger 505| CurRegVal = CStr(MyVal) 506| CurRegValType = "Integer" 507| Case AsLong 508| CurRegVal = CStr(MyVal) 509| CurRegValType = "Long" 510| Case AsSingle 511| CurRegVal = CStr(MyVal) 512| CurRegValType = "Single" 513| Case AsCurrency 514| CurRegVal = CStr(MyVal) 515| CurRegValType = "Currency" 516| Case AsDecimal 517| CurRegVal = CStr(MyVal) 518| CurRegValType = "Decimal" 519| Case AsDouble 520| CurRegVal = CStr(MyVal) 521| CurRegValType = "Double" 522| Case AsDate 523| CurRegVal = CStr(MyVal) 524| CurRegValType = "Date" 525| Case AsBoolean 526| If MyVal = 0 Then 527| CurRegVal = "False" 528| CurRegValType = "Boolean" 529| Else 530| CurRegVal = "True" 531| CurRegValType = "Boolean" 532| End If 533| Case AsString 534| CurRegVal = CStr(MyVal) 535| CurRegValType = "String" 536| Case AsVariant 537| CurRegVal = CStr(MyVal) 538| CurRegValType = "Variant" 539| Case Else 540| CurRegVal = CStr(MyVal) 541| CurRegValType = "Unknown" 542| End Select 543| 544| End Function 545| 546| 547| Private Function RegValToType(MyVal As String) 548| 549| Select Case CurRegValType 550| Case "Empty" 551| CurRegVal = Null 552| Case "Byte" 553| CurRegVal = CByte(MyVal) 554| Case "Integer" 555| CurRegVal = CInt(MyVal) 556| Case "Long" 557| CurRegVal = CLng(MyVal) 558| Case "Single" 559| CurRegVal = CSng(MyVal) 560| Case "Double" 561| CurRegVal = CDbl(MyVal) 562| Case "Currency" 563| CurRegVal = CCur(CDbl(MyVal)) 564| Case "Decimal" 565| CurRegVal = CDec(CDbl(MyVal)) 566| Case "Date" 567| CurRegVal = CDate(MyVal) 568| Case "Boolean" 569| CurRegVal = CBool(MyVal) 570| Case "String" 571| CurRegVal = CStr(MyVal) 572| Case Else 573| CurRegVal = CVar(MyVal) 574| End Select 575| 576| End Function 577| 578| 579| Private Function ResetGlobalVars() 580| CurRegVal = "" 581| CurRegValType = "" 582| End Function 583| 584| 585| Private Function RKF_SortStringArray(ByRef A() As String) 586| Dim t As String 587| Dim I As Long 588| Dim j As Long 589| 590| For I = LBound(A) To UBound(A) 591| For j = I + 1 To UBound(A) 592| If A(I) > A(j) Then 593| t = A(I) 594| A(I) = A(j) 595| A(j) = t 596| End If 597| Next 598| Next 599| 600| End Function 601| 602| 603| 604| 605| 606| ''''' was used in the lib ''''''''''''''''''''''''''' 607| Private Function TypeToRegVal(ByVal MyVal As Variant) As String 608| 609| Select Case TypeName(MyVal) 610| Case "Empty" 611| CurRegVal = "" 612| CurRegValType = "Empty" 613| Case "Null" 614| CurRegVal = "" 615| CurRegValType = "Empty" 616| Case "Byte" 617| CurRegVal = CStr(MyVal) 618| CurRegValType = "Byte" 619| Case "Integer" 620| CurRegVal = CStr(MyVal) 621| CurRegValType = "Integer" 622| Case "Long" 623| CurRegVal = CStr(MyVal) 624| CurRegValType = "Long" 625| Case "Single" 626| CurRegVal = CStr(MyVal) 627| CurRegValType = "Single" 628| Case "Currency" 629| CurRegVal = CStr(MyVal) 630| CurRegValType = "Currency" 631| Case"Decimal" 632| CurRegVal = CStr(MyVal) 633| CurRegValType = "Decimal" 634| Case "Double" 635| CurRegVal = CStr(MyVal) 636| CurRegValType = "Double" 637| Case "Date" 638| CurRegVal = CStr(MyVal) 639| CurRegValType = "Date" 640| Case "Boolean" 641| If MyVal = True Then 642| CurRegVal = "True" 643| CurRegValType = "Boolean" 644| Else 645| CurRegVal = "False" 646| CurRegValType = "Boolean" 647| End If 648| Case "String" 649| CurRegVal = CStr(MyVal) 650| CurRegValType = "String" 651| Case Else 652| CurRegVal = CStr(MyVal) 653| CurRegValType = "Unknown" 654| End Select 655| 656| End Function 657| 658| 659| 660| 661| 662| '### FunctionList: 663| ' - Private Function NEWTypeToRegVal(ByRef MyVal As Variant, ByRef MyType As MyVarType) As String 664| ' - Private Function RKF_SortStringArray(ByRef A() As String) 665| ' - Private Function RegValToType(MyVal As String) 666| ' - Private Function ResetGlobalVars() 667| ' - Private Function TypeToRegVal(ByVal MyVal As Variant) As String 668| ' - Public Property Get CheckVersionAgainst(ByRef neededLong As Long, Optional ByRef suppressMsgBox As Boolean = False) As Boolean 669| ' - Public Property Get ClassInit(ByVal SectionStr As String, Optional ByVal AppStr As String = "photools.com\IMatch.3\Scripts", Optional ByVal TreeMustExist As Boolean = False) As Integer 670| ' - Public Property Get ClassUNSET() As Boolean 671| ' - Public Property Get ClsName() As String 672| ' - Public Property Get ClsVersion() As Long 673| ' - Public Property Get ClsVersionString() As String 674| ' - Public Property Get DelAllKeys() As Boolean 675| ' - Public Property Get DelKey(ByRef MyKey As String) As Boolean 676| ' - Public Property Get GetKey(ByRef MyKey As String, Optional ByVal MyDefaultValue As Variant = Empty) As Variant 677| ' - Public Property Get GiveKeyArray(Optional ByRef WithTypeDefinitions As Boolean = False, Optional ByRef PrintAlsoToDebugWindow As Boolean = False) As String() 678| ' - Public Property Get GiveTreeName() As String 679| ' - Public Property Get PRESETS_GiveKeyArray(ByRef vArray As Variant) As Boolean 680| ' - Public Property Get PRESETS_SaveKey(ByRef MyKey As String, ByRef MyVal As String) As Boolean 681| ' - Public Property Get SaveKey(ByRef MyKey As String, ByVal MyVal As Variant, Optional ByRef AsType As MyVarType = AsString) As Boolean 682| 683| '### Public Declarations: 684|