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]
hn_PhotoshopConversion.bas: (2779 lines / 1913 real codelines / 3 Subs / 19 Functions / 0 Properties)
1| '|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 2| ' 3| 4| ' 5| ' h.nogajski@web.de (http://horst.nogajski.de) 6| ' 7| ' CREDITS: _Many_ thanks to Klaus Schwarzburg for his help! =:) 8| ' 9| '-------------------------------------------------------------------------------------------------- 10| ' 11| ' PhotoshopConversion (IMatch SAX-Basic) 12| ' 13| ' Using Adobe Photoshop from IMatch via OLE-Automation 14| ' 15| ' Needed Classes, Modules and Libs: 16| ' hnFncPSOLE.lib (needs the Adobe-Photoshop-Typelibrary embedded via Menu: Edit->References) 17| ' hnClsRegKey.cls 18| ' hnClsWorkFlow.cls 19| ' hnFncDebugMsg.lib 20| ' hnFncUtils.lib (needs the IMatch3-Scripthelper-Typelibrary embedded via Menu: Edit->References) 21| ' hn_GLOBALVARS.lib 22| ' hnClsTransmission.cls 23| ' 24| 'V 0.9 (02-Jul-2003) 25| ' 26| '|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 27| '-------------------------------------------------------------------------------------------------- 28| ' 29| ' Program (Sub Main): 30| ' 31| ' -Defines the Name of a PhotoshopActionsList-filename, check its Result and if there is no valid Actionslist correct this automaticly 32| ' -Defines the Name of a ICC-Profilelist-filename and check its Result 33| ' -Open Photoshop 34| ' -Get some Infos from PhotoshopApplication 35| ' 36| ' -Call the Main-Dialog, and Exit Script if the User cancels the DiaLogg. 37| ' -Get the Settings from UserDialog 38| ' 39| ' -If the simulation-Button is pressed we do a simulation and presents it result in users EditorApp 40| ' Else we run the program: 41| ' 42| ' -If "Overwrite original files" is checked, we ask for confirmation! 43| ' -Cleares Targetfolder and refreshes DB if Targetfolder is a DB-Folder 44| ' 45| ' Processing every Image: 46| ' -(Re)Set DocumentVars and Counter 47| ' -Build all Filename-Strings 48| ' 49| ' -If the Image is Offline create a Placeholder 50| ' -Else Open the Image and ... 51| ' 52| ' -Get DocumentInformations 53| ' -For better Performance flatten the Image, if Source is PSD and Target is another Fileformat 54| ' -Scale the Image and/or set a dpi-value 55| ' -Assign a ICC-Profile to Files without a Profile. Optionaly overwrite existing one. 56| ' -Convert to a ICC-Profile 57| ' -Play a Photoshop-Action 58| ' -Check if the Targetfile already exists and if so, append next free Number to the FileName 59| ' -Select the right SaveFunction and saves the Conversionresult to that Fileformat 60| ' -Close the Image 61| ' 62| ' -UpdateDatabase 63| ' -Bookmark the Image 64| ' -Writes LogfileCache into Logfile 65| ' 66| '-------------------------------------------------------------------------------------------------- 67| ' 68| ' Dialogs: 69| ' 70| ' Dlg_Initial 71| ' Shows the main Dialog and lets the user choose settings 72| ' Dlg_Global 73| ' Shows a Dialog for some global settings 74| ' Dlg_ICC 75| ' Shows a Dialog in which the user can edit/create a list of ICC-Profiles 76| ' Dlg_FileFormat 77| ' Shows a Dialog for FileFormatSettings of all supported FileTypes 78| ' 79| '-------------------------------------------------------------------------------------------------- 80| ' 81| ' Private Functions and Subs: 82| ' 83| ' PS_GetPrefs 84| ' Gets All Values out of Registry And creates All needed Variables And Objects 85| ' CheckSetup 86| ' Checks if all Dialogboxes was seen and saved by the user at least for one time 87| ' CreateTargetStrings 88| ' Builds all Strings (Sourcefolder, SourceFilename, SourceFileFormat, TargetFolder, TargetFilename, TargetFileFormat) 89| ' BuildProperPath 90| ' Concatenate Drive and Pathparts 91| ' CreateTargetDir 92| ' Checks if Targetdirectory exists and if not, create it. 93| ' OverwriteConfirmation 94| ' Asks for Confirmation if "overwrite original Files" is selected 95| ' HandleOfflineImage 96| ' Creates a Placeholder 150x150pix for offlineImages in Selection 97| ' MyPrefsArray 98| ' Returns a StringArray of all Registry-Key/Valuepairs for this Script and optional print it to DebugWindow 99| ' AddToLogfileCache 100| ' Appends a new Information to the existing LogfileCache 101| ' FlushLogfileCache 102| ' Writes/Clears LogfileCache to Logfile 103| ' hn_showInfo 104| ' Opens A HTML-Document with Scriptinformations in Standard-HTML-Browser 105| ' 106| '-------------------------------------------------------------------------------------------------- 107| '|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 108| 109| 110| '#uses "lib\hnPublicDeclarations.lib" 111| '#uses "lib\hnPSoleDeclarations.lib" 112| '#uses "lib\hnFncUtils.lib" 113| '#uses "lib\hnFncPSOLE.lib" 114| '#uses "lib\hnClsRegKey.cls" 115| '#uses "lib\hnClsWorkflowCats.cls" 116| '#uses "lib\hnClsTransmission.cls" 117| 118| 119| Option Explicit 120| 121| 122| 'SCRIPTNAME is needed for RegTreeNames, MsgBoxTitles etc. 123| Private Const SCRIPTNAME As String = "PS_OLE_Public" 124| 125| 126| ' Values Photoshop-Options 127| Private Const phClassCMYKColorMode As Long = 1129142605 128| Private Const phClassGrayscaleMode As Long = 1198684531 129| Private Const phClassLabColorMode As Long = 1281508173 130| Private Const phClassMultichannelMode As Long = 1298953283 131| Private Const phClassBitmapMode As Long = 1114926413 132| Private Const phClassIndexedColorMode As Long = 1231971395 133| Private Const phClassDuotoneMode As Long = 1231971395 134| Private Const phEnumCMYKColor As Long = 1162038617 135| Private Const phEnumRGBColor As Long = 1380401731 136| Private Const phEnumLabColor As Long = 1281508204 137| Private Const phEnumGrayScale As Long = 1198684515 138| Private Const phEnumIndexedColor As Long = 1231971436 139| Private Const phEnumDuotone As Long = 1148481056 140| Private Const phEnumMultichannel As Long = 1298953320 141| Private Const phEnumOS2 As Long = 1330852384 142| Private Const phEnumWindows As Long = 1466527264 143| Private Const phEnumMacintosh As Long = 1298361972 144| Private Const phEnumIBMPC As Long = 1229081936 145| Private Const None As Long = 0 146| Private Const phEnumTIFF As Long = 1414088262 147| Private Const phEnum1BitPerPixel As Long = 1332626036 148| Private Const phEnum8BitsPerPixel As Long = 1164404802 149| Private Const phEnumASCII As Long = 1095975753 150| Private Const phEnumBinary As Long = 1114534521 151| Private Const phEnumJPEG As Long = 1246774599 152| Private Const phEnumLowQuality As Long = 1282875424 153| Private Const phEnumMediumQuality As Long = 1298427168 154| Private Const phEnumHighQuality As Long = 1214736416 155| Private Const phEnumMaximumQuality As Long = 1299737888 156| Private Const SuppressClassNotReadyMsg As Boolean = True 157| 158| ' LogfileVars 159| Public Type PS_Logfile 160| Create As Boolean 161| onlyErrors As Boolean 162| Overwrite As Boolean 163| FName As String 164| Cache As String 165| End Type 166| Private Enum LogfileInfoType 167| ERRORS 168| INFOS 169| End Enum 170| 171| 172| ' Variables for ImageEdit 173| Private Type PSImageEdit 174| ProceedScaling As Boolean 175| NewSize As Integer 176| Targetdpi As Integer 177| End Type 178| ' Variables for Photoshopactions 179| Private Type PhotoshopActions 180| ProceedAction As Boolean 181| ActionName As Variant 182| Listfile As String 183| End Type 184| ' Variables for ColorspaceConversion 185| Private Type ICCProfiles 186| assignICC As Boolean 187| assignICCoverwrite As Boolean 188| assignICCProfile As String 189| ProceedICC As Boolean 190| TargetICCProfile As String 191| iccListFile As String 192| End Type 193| ' Global File and Folder Variables 194| Private Type StrGlobalNameParams 195| NoCopy As Boolean 196| TargetType As Integer 197| SubTargetName As String 198| clearMainTarget As Boolean 199| MainTargetFolder As String 200| 'FeindatenSubFolder As String 201| 'WebgallerySubFolder As String 202| SaveAsFiletype As Boolean 203| AppendStrToFN As Boolean 204| FindReplace As Boolean 205| StrToFN As String 206| Needle As String 207| ReplaceStr As String 208| End Type 209| 210| ' Single File and Folder Variables 211| Private Type StrSingleNameParams 212| Sourcefolder As String 213| TargetFolder As String 214| SourceFileName As String 215| TargetFilename As String 216| SourceFileFormat As String 217| TargetFileFormat As String 218| SourceBaseName As String 219| TargetBaseName As String 220| End Type 221| 222| ' DatabaseUpdate-Options 223| Private Type DBUpdate 224| AddNewImageToDB As Boolean 225| 'AddNewFolderToDB As Boolean 226| BookmarkToImage As Boolean 227| AssignToWorkflowCats As Boolean 228| End Type 229| 230| ' ScriptControlObject 231| Private Type ScriptControl 232| IsCanceld As Boolean 233| IsLooped As Boolean 234| IsSimulation As Boolean 235| Starttime As Double 236| Endtime As Double 237| CurrentProcess As Boolean 238| AutoReadPSactions As Boolean 239| AllDocs As Integer 240| ToDoDocs As Integer 241| CurrentDoc As Integer 242| PS_FuncResult As String 243| End Type 244| 245| Private Type FileFormatInfo 246| globl As String 247| psd As String 248| tif As String 249| eps As String 250| jpg As String 251| png As String 252| gif As String 253| End Type 254| 255| Private Type ScriptGlobals 256| ICONS As String 257| Use_WorkFlow As Boolean 258| NoPS_Palettes As Boolean 259| closeApp As Boolean 260| ShutDownWin As Boolean 261| openLog As Boolean 262| PowerUser As Boolean 263| DlgMainRefresh As PresetRefreshInfo 264| End Type 265| 266| 267| Private PS_PRESETFOLDER As String 268| 269| 270| ' Variables for ScriptControl 271| Private SC As ScriptControl 272| 'Public OLE_TimeOut As Long 'is already dimed in hnFncPSOLE.lib 273| 274| 'ScriptGlobals 275| Private SG As ScriptGlobals 276| Private inf As PSAppInfo 277| Private Logg As PS_Logfile 278| 279| ' DocumentOptions- and other Settings-Groups 280| Private Gdoc As StrGlobalNameParams 281| Private Sdoc As StrSingleNameParams 282| Private Actions As PhotoshopActions 283| Private PS_acts() As String 284| Private ICC As ICCProfiles 285| Private iccList() As String 286| Private Edit As PSImageEdit 287| Private DBU As DBUpdate 288| 289| ' FilesaveParameterGroups 290| 'Public ffglobal As PSffGlobal 'is set in hnFncPSOLE.lib! 291| Private ffinfo As FileFormatInfo 292| Private ffjpg As PSffJPEG 293| Private fftif As PSffTIFF 294| Private ffeps As PSffEPS 295| 296| 297| ' ListboxArrays 298| Private dpiList1() As String 299| Private fileformatList() As String 300| 301| 302| ' Database Variables 303| Private DB As Database 304| Private Selection As Images 305| Private AddImageResult As IMFileOperationResults 306| Private Reg As clsRegKey 307| Private RegSetup As clsRegKey 308| 'Private RegTreePreset As clsRegTreePresets 309| Private WoFlo As clsWorkflowCats 310| Private Trans As clsTransmission 311| 312| 313| Sub Main 314| 315| On Error GoTo ErrHandler 316| 317| dbgmsg = True 318| PromptMe = False 319| DbgOutPutPriority = Production 320| InitializeGlobalVars 321| 322| PS_PRESETFOLDER = SCRIPTSUBFOLDER & "psole_presets\" 323| ICONS = MacroDir & "\icons\" 324| 325| 326| Dim RegKeyClassesName As String 327| RegKeyClassesName = SCRIPTNAME 328| 329| Set Reg = New clsRegKey 330| If Not Reg.CheckVersionAgainst(8000) Then GoTo Escape 331| If Reg.ClassInit(RegKeyClassesName) <> -1 Then 332| MsgBox "Couldn't initialize the Script-RegKeyClass!" & vbNewLine & "(" & RegKeyClassesName & ")", vbExclamation, "(" & SCRIPTNAME & ") stops now!" 333| GoTo Escape 334| End If 335| 336| Set RegSetup = New clsRegKey 337| If Not RegSetup.CheckVersionAgainst(8000) Then GoTo Escape 338| If RegSetup.ClassInit(RegKeyClassesName & "_Setup") <> -1 Then 339| MsgBox "Couldn't initialize the Setup-RegKeyClass!" & vbNewLine & "(" & RegKeyClassesName & "_Setup)", vbExclamation, "(" & SCRIPTNAME & ") stops now!" 340| GoTo Escape 341| End If 342| 343| 'Set RegTreePreset = New ClsRegTreePresets 344| ' If Not RegTreePreset.CheckVersionAgainst(5000) Then GoTo Escape 345| ' If RegTreePreset.ClassInit(RegKeyClassesName, Reg) <> -1 Then 346| ' MsgBox "Couldn't initialize the RegTreePresetClass!" & vbNewLine & "(" & RegKeyClassesName & ")", vbExclamation, "(" & SCRIPTNAME & ") stops now!" 347| ' GoTo Escape 348| ' End If 349| 350| 351| Set DB = Application.ActiveDatabase 352| If DB Is Nothing Then 353| MsgBox "We have no open database!", vbInformation, "(" & SCRIPTNAME & ") stops now!" 354| GoTo Escape 355| End If 356| 357| 358| Set WoFlo = New clsWorkflowCats 359| If Not WoFlo.CheckVersionAgainst(8100) Then GoTo Escape 360| If WoFlo.ClassInit(Reg,DB,SuppressClassNotReadyMsg) = -1 Then 361| Reg.SaveKey("Use_WorkFlow",True,AsBoolean) 362| Else 363| Reg.SaveKey("Use_WorkFlow",False,AsBoolean) 364| 'MsgBox "Couldn't initialize the WorkflowClass!", vbExclamation, "(" & SCRIPTNAME & ") stops now!" 365| 'GoTo Escape 366| End If 367| 368| 369| Set Trans = New clsTransmission 370| If Not Trans.CheckVersionAgainst(200) Then GoTo Escape 371| If Trans.ClassInit(Reg, DB, DB, SuppressClassNotReadyMsg, False) <> -1 Then 372| MsgBox "Couldn't initialize the TransmissionClass!" & vbNewLine & "Script stops now!", vbExclamation, "PS-OLE TransmissionClass" 373| GoTo Escape 374| End If 375| 376| 377| Set Selection = DB.ActiveSelection 378| If Selection Is Nothing Or Selection.Count = 0 Then 379| MsgBox "No valid selection of Images!", vbInformation, "(" & SCRIPTNAME & ") stops now!" 380| GoTo Escape 381| End If 382| 383| 384| SC.AllDocs = Selection.Count 385| SC.ToDoDocs = Selection.Count 386| 387| Dim WaitDialogText As String 388| Dim WorkflowBucket As ImageBucket 389| Set WorkflowBucket = DB.CreateImageBucket 390| Dim TheImage As Image 391| 392| 'Get Settings from Registry 393| PS_GetPrefs 394| 395| 396| 397| 398| RETRYGETACTIONLIST: 399| 'defines the Name of a PhotoshopActionsList-filename and check its Result 400| Actions.Listfile = PS_PRESETFOLDER & "actionslist.ini" 401| PS_acts = ReadListFromFile(Actions.Listfile) 402| If Not IsValidStrArray(PS_acts) Then 403| If Logg.Create Then Logg.Cache = Logg.Cache & "ERROR! (" & Now & ")" & vbNewLine & "Your ActionsListfile returns no valid StringArray." & vbNewLine & "This will now corrected automaticly!" & vbNewLine & vbNewLine 404| DoDbgMsg(Production,"Sub Main",SubProcess,"Your ActionsListfile returns no valid StringArray." & vbNewLine & "This will now corrected automaticly!") 405| SC.AutoReadPSactions = True 406| MsgBox("Your ActionsListfile returns no valid StringArray." & vbNewLine & "This will now corrected automaticly!",vbInformation,"No valid ActionsList") 407| On Error Resume Next 408| AppActivate "Adobe Photoshop" 409| If Err.Number = 0 Then 410| SC.PS_FuncResult = PS_OLE_Start() 411| SC.PS_FuncResult = PS_OLE_Close() 412| If SC.PS_FuncResult <> "" Then 413| If Logg.Create Then Logg.Cache = Logg.Cache & "ERROR! (" & Now & ")" & vbNewLine & SC.PS_FuncResult 414| MsgBox("Your ActionsListfile returns no valid StringArray." & vbNewLine & "This will now corrected!" & vbNewLine & "Please close the PhotoshopApplication manually before pressing the OK-Button of this MsgBox!",vbInformation,"Please close the PhotoshopApplication") 415| End If 416| End If 417| Err.Clear 418| On Error GoTo ErrHandler 419| End If 420| 421| 422| 423| 'open Photoshop 424| SC.PS_FuncResult = PS_OLE_Start(Reg) 425| If SC.PS_FuncResult <> "" Then 426| If Logg.Create Then Logg.Cache = Logg.Cache & "ERROR! (" & Now & ")" & vbNewLine & SC.PS_FuncResult 427| MsgBox "Could not start your Adobe Photoshop Application!" & vbNewLine & "The Script stops now.",vbSystemModal,"Error! Script Stops." 428| GoTo ErrHandler 429| End If 430| 431| 432| 'If there was no valid Actionslist we will correct this automatically now 433| If SC.AutoReadPSactions Then 434| ReDim PS_acts(500) 435| PS_GetActionNames(PS_App,PS_acts) 436| WriteListToFile(Actions.Listfile,PS_acts()) 437| PS_acts = ReadListFromFile(Actions.Listfile) 438| If Not IsValidStrArray(PS_acts) Then 439| If Logg.Create Then Logg.Cache = Logg.Cache & "ERROR! (" & Now & ")" & vbNewLine & "Your ActionsListfile returns no valid StringArray." & vbNewLine & "The automatic started Correction has failed!" & vbNewLine & vbNewLine 440| Dim AskAction As VbMsgBoxResult 441| AskAction = MsgBox("Your ActionsListfile returns no valid StringArray." & vbNewLine & "An automatic started Correction has also failed!" & vbNewLine & "What want you to do, Abort, Retry or Ignore and go on?",vbAbortRetryIgnore + vbCritical,"Attention: No valid Actionlist") 442| Select Case AskAction 443| Case vbAbort 444| GoTo Exit_ 445| Case vbRetry 446| GoTo RETRYGETACTIONLIST 447| End Select 448| End If 449| End If 450| 451| 452| 453| 454| 'Hides the Photoshop-Palettes. 455| 'To run proper it needs that the PhotoshopApp was opened by the script, otherwise (if your PhotoshopApp is already open) you need to focus it and press the TAB-Button. 456| If SG.NoPS_Palettes Then 457| If CBool(Reg.GetKey("FirstStart")) Then 458| AppActivate "Adobe Photoshop" 459| SendKeys "{Tab}",False 460| Else 461| AppActivate "Adobe Photoshop" 462| SendKeys "{Tab}{Tab}",False 463| End If 464| End If 465| 466| 467| 468| 'get some Infos from Photoshop 469| inf = GetAppInfoStructureFromPS() 470| 471| 472| 'defines the Path to the folder containing DialogIcons 473| SG.ICONS = ICONS 474| 475| 476| 'defines the Name of a user-ICC-Profilelist and check its Result 477| ICC.iccListFile = PS_PRESETFOLDER & "icclist.ini" 478| iccList = ReadListFromFile(ICC.iccListFile) 479| 480| 481| 'checks if all Dialogboxes was seen and saved by the user at least for onetime 482| Dim checkIt As Boolean 483| Do 484| checkIt = CheckSetup() 485| Loop Until checkIt Or SC.IsCanceld 486| If SC.IsCanceld Then GoTo Exit_ 487| 488| 489| 'check the Result of the user-ICC-Profile-list 490| If Not IsValidStrArray(iccList) Then 491| DoDbgMsg(Production,"Sub Main",SubProcess,"Your ICC-inifile returns no valid StringArray." & vbNewLine & "Please corrrect this." & vbNewLine & "For this go to ICC-Setup-Dialog!") 492| If Logg.Create Then Logg.Cache = Logg.Cache & "ERROR! (" & Now & ")" & vbNewLine & "Your ICC-inifile returns no valid StringArray." & vbNewLine & "Please corrrect this." & vbNewLine & "For this go to ICC-Setup-Dialog!" & vbNewLine & vbNewLine 493| MsgBox "Your ICC-inifile returns no valid StringArray." & vbNewLine & "Please corrrect this." & vbNewLine & "For this go to ICC-Setup-Dialog!" 494| End If 495| 496| 497| 498| 499| 500| 'Call the Main-Dialog, and Exit Script if the User cancels the Dialog. 501| If Not Dlg_Initial(SC.AllDocs) Then 502| SC.IsCanceld = True 503| GoTo Exit_ 504| End If 505| 506| 507| 508| ' Get the Settings from UserDialog 509| PS_GetPrefs 510| 511| 512| 513| ' If the simulation-Button is pressed 514| If SC.IsSimulation And Not Gdoc.NoCopy Then 515| 516| Dim simulatedSource() As String 517| Dim simulatedTarget() As String 518| Logg.Create = True 519| Logg.onlyErrors = False 520| Logg.Cache = vbNewLine & vbNewLine 521| AddToLogfileCache("######## Proceed Simulation ########" & vbNewLine & SC.AllDocs & " files are selected." ,INFOS,False) 522| FlushLogfileCache 523| 524| 525| ' Else we run the program 526| Else 527| 528| 529| ' If "Overwrite original files" is checked, we ask for confirmation! 530| If Gdoc.NoCopy And Not SG.PowerUser Then 531| If OverwriteConfirmation(SC.AllDocs) = vbNo Then 532| SC.IsCanceld = True 533| GoTo Exit_ 534| End If 535| End If 536| 537| ' Check for Mistakes 538| If SG.openLog And Not Logg.Create Then 539| Reg.SaveKey("LogCreate",True,AsBoolean) 540| Logg.Create = True 541| End If 542| 543| ' Print RegSettings to DebugWindow 544| If dbgmsg Then MyPrefsArray(True) 545| 546| 547| ' Cleares Targetfolder and refreshs DB if Targetfolder is a DB-Folder 548| If (Gdoc.TargetType = 1 And Gdoc.clearMainTarget) And (Not Gdoc.NoCopy) Then 549| hn_Xdel_IMFolder(Gdoc.MainTargetFolder,DB,True) 550| AddToLogfileCache("Clears Targetfolder: " & Gdoc.MainTargetFolder & vbNewLine,INFOS,False) 551| End If 552| 553| 554| ' Do some Logging 555| If Logg.Create And Not Logg.onlyErrors Then 556| Dim PSLoginfoString As String 557| SC.starttime = Timer 558| PSLoginfoString = "# Photoshop-Settings:" & vbNewLine & "MemoryUsagePercent=" & inf.MemoryUsagePercent & vbNewLine & "SaveAdvancedTiff=" & inf.SaveAdvancedTiff & vbNewLine & "SaveComposite=" & inf.SaveComposite & vbNewLine & "openDocs=" & inf.openDocs & vbNewLine 559| Logg.Cache = Logg.Cache & vbNewLine & "##############################################" & vbNewLine & "Starting Batchprocess for " & SC.AllDocs & " selected files: " & Now & vbNewLine & vbNewLine & "# RegistrySettings:" & vbNewLine & MyPrefsArray(False) & vbNewLine & PSLoginfoString & vbNewLine & "# Selected-Options-Summary:" & vbNewLine & OptionSummary 560| FlushLogfileCache(Logg.Overwrite) 561| End If 562| 563| End If 564| 565| 566| 'Start Statusbar 567| Application.StatusBarSetText "Working with Adobe Photoshop via OLE-automation ..." 568| Application.StatusBarShowPercentage 0, Selection.Count 569| 'Start Waitdialog 570| WaitDialogText = "Working with Adobe Photoshop via OLE-automation ..." & vbNewLine 571| Application.WaitDialogOpen WaitDialogText,0,Selection.Count,True 572| 573| 574| ' Processing every Image 575| For Each TheImage In Selection 576| 577| 578| ' (Re)Set StrSingleNameParams and Counter 579| SC.CurrentDoc = SC.CurrentDoc + 1 580| Sdoc.Sourcefolder = "" 581| Sdoc.TargetFolder = "" 582| Sdoc.SourceFileName = "" 583| Sdoc.TargetFilename = "" 584| Sdoc.SourceFileFormat = "" 585| Sdoc.TargetFileFormat = "" 586| Sdoc.SourceBaseName = "" 587| Sdoc.TargetBaseName = "" 588| 589| 'refresh Satusbar 590| Application.StatusBarSetPercentage SC.CurrentDoc 591| 'refresh Waitdialog 592| Application.WaitDialogSetPercentage SC.CurrentDoc 593| 594| 595| ' If the simulation-Button is pressed 596| If SC.IsSimulation And Not Gdoc.NoCopy Then 597| 598| 599| ' Build all Filename-Strings 600| SC.PS_FuncResult = CreateTargetStrings(TheImage.FileName) 601| If SC.PS_FuncResult <> "" Then AddToLogfileCache(SC.PS_FuncResult,ERRORS,False) 602| 603| 'refresh Waitdialog 604| Application.WaitDialogSetText WaitDialogText & "Current Sourcefile: " & Sdoc.SourceBaseName & vbNewLine & "(Simulation)" 605| 606| ' Check for offline Images 607| If Not DB.IsFileOnline(TheImage) Then 608| AddToLogfileCache(vbNewLine & "Image is Offline" & vbNewLine,ERRORS,True) 609| End If 610| 611| ' Check Target 612| If hn_FileExists(Sdoc.TargetFilename,vbNormal) And Not Gdoc.clearMainTarget Then 613| AddToLogfileCache(vbNewLine & "The Targetfile already exists!" & vbNewLine,ERRORS,True) 614| End If 615| 616| ' Create Arrays 617| ReDim Preserve simulatedSource(SC.CurrentDoc) 618| simulatedSource(SC.CurrentDoc) = Sdoc.SourceFileName 619| ReDim Preserve simulatedTarget(SC.CurrentDoc) 620| simulatedTarget(SC.CurrentDoc) = Sdoc.TargetFilename 621| 622| 623| 'Check if user has pressed CancelButton! 624| If Application.WaitDialogIsCanceled Then GoTo BreakTheLoop 625| 626| 627| 'Else we run the Program for each Image 628| Else 629| 630| 631| 632| If Not hn_FileExists(TheImage.FileName) Then 633| 634| 635| 636| 'AddToLogfileCache("SourceFile not found: " & TheImage.FileName,ERRORS,False) 637| 638| 639| 640| Else 641| 642| 643| ' Build all Filename-Strings 644| SC.PS_FuncResult = CreateTargetStrings(TheImage.FileName) 645| If SC.PS_FuncResult <> "" Then AddToLogfileCache(SC.PS_FuncResult,ERRORS,False) 646| 647| 648| 'refresh Waitdialog 649| Application.WaitDialogSetText WaitDialogText & "Current Sourcefile: " & Sdoc.SourceBaseName 650| 651| 652| ' Do some LogInfos 653| DoDbgMsg(Production,"MainSub",SubProcess, "proceed Image " & SC.CurrentDoc & "/" & SC.AllDocs & " (" & Now & ")" & vbNewLine & "SourceFilename: " & Sdoc.SourceFileName & Chr(13) & "TargetFilename: " & Sdoc.TargetFileName)'DebugMessage 654| If Logg.Create And Not Logg.onlyErrors Then Logg.Cache = Logg.Cache & "proceed Image " & SC.CurrentDoc & "/" & SC.AllDocs & " (" & Now & ")" & vbNewLine & "SourceFilename: " & Sdoc.SourceFileName & vbNewLine & "TargetFilename: " & Sdoc.TargetFileName & vbNewLine 655| 656| 657| ' If the Image is Offline we create a Placeholder 658| If Not DB.IsFileOnline(TheImage) Then 659| 660| HandleOfflineImage(Sdoc.TargetFileName & "_.jpg") 661| Sdoc.TargetFileName = Sdoc.TargetFileName & "_.jpg" 662| 663| 'Else we run the Program for Imagemanipulation 664| Else 665| 666| 667| ' Open the Image 668| 'refresh Waitdialog 669| Application.WaitDialogSetText WaitDialogText & "Current Sourcefile: " & Sdoc.SourceBaseName & vbNewLine & "(open Image)" 670| SC.PS_FuncResult = PS_OpenDocument(Sdoc.SourceFileName) 671| If SC.PS_FuncResult <> "" Then AddToLogfileCache(SC.PS_FuncResult) 672| 673| 674| 675| ' For better Performance of next ConversionSteps we flatten the Image now, if it will Converted from PSD to another Fileformat 676| If LCase(Sdoc.SourceFileFormat) = "psd" And Not LCase(Sdoc.TargetFileFormat) = "psd" Then 677| 'refresh Waitdialog 678| Application.WaitDialogSetText WaitDialogText & "Current Sourcefile: " & Sdoc.SourceBaseName & vbNewLine & "(flatten Image)" 679| PS_FlattenImage 680| End If 681| 682| 683| 'Check if user has pressed CancelButton! 684| If Application.WaitDialogIsCanceled Then GoTo BreakTheLoop 685| 686| 687| ' Scale the Image and/or set a dpi-value 688| If Edit.ProceedScaling Then 689| 'refresh Waitdialog 690| Application.WaitDialogSetText WaitDialogText & "Current Sourcefile: " & Sdoc.SourceBaseName & vbNewLine & "(scale Image)" 691| Dim w As Integer 692| Dim h As Integer 693| Dim landscape As Boolean 694| landscape = False 695| If TheImage.Width > TheImage.Height Then landscape = True 696| w = Edit.NewSize 697| h = Edit.NewSize 698| ' If the image dimensions are smaller than the requested dimensions, use the original dimensions 699| If w > TheImage.Width Then 700| w = TheImage.Width 701| End If 702| If h > TheImage.Height Then 703| h = TheImage.Height 704| End If 705| 706| SC.PS_FuncResult = PS_ScaleImage(CDbl(w),CDbl(h),Edit.Targetdpi,landscape) 707| If SC.PS_FuncResult <> "" Then AddToLogfileCache(SC.PS_FuncResult) 708| 709| End If 710| 711| 712| 'Check if user has pressed CancelButton! 713| If Application.WaitDialogIsCanceled Then GoTo BreakTheLoop 714| 715| 716| ' Assign a ICC-Profile to Files without a Profile. Optionaly overwrite existing one. 717| If ICC.assignICC Then 718| 'refresh Waitdialog 719| Application.WaitDialogSetText WaitDialogText & "Current Sourcefile: " & Sdoc.SourceBaseName & vbNewLine & "(assign ICC-Profile)" 720| 'Check if there is already an embedded profile 721| 'If (docinf.hasProfile And ICC.assignICCoverwrite) Or Not docinf.hasProfile Then 722| SC.PS_FuncResult = PS_ICC_Assign(ICC.assignICCProfile) 723| If SC.PS_FuncResult <> "" Then AddToLogfileCache(SC.PS_FuncResult) 724| 'End If 725| End If 726| 727| ' Do ICC-Conversion 728| If ICC.ProceedICC Then 729| 'refresh Waitdialog 730| Application.WaitDialogSetText WaitDialogText & "Current Sourcefile: " & Sdoc.SourceBaseName & vbNewLine & "(convert to ICC-Profile " & ICC.TargetICCProfile & ")" 731| SC.PS_FuncResult = PS_ICC_Conversion(ICC.TargetICCProfile) 732| If SC.PS_FuncResult <> "" Then AddToLogfileCache(SC.PS_FuncResult) 733| End If 734| 735| 736| 'Check if user has pressed CancelButton! 737| If Application.WaitDialogIsCanceled Then GoTo BreakTheLoop 738| 739| 740| ' Play a Photoshop-Action 741| If Actions.ProceedAction And Actions.ActionName <> "" Then 742| 'refresh Waitdialog 743| Application.WaitDialogSetText WaitDialogText & "Current Sourcefile: " & Sdoc.SourceBaseName & vbNewLine & "(play PhotoshopAction: " & Actions.ActionName & ")" 744| 'HIER FEHLT NOCH EIN ErrorLogging!! 745| PS_App.PlayAction(Actions.ActionName) 746| End If 747| 748| 749| 'Check if user has pressed CancelButton! 750| If Application.WaitDialogIsCanceled Then GoTo BreakTheLoop 751| 752| 753| ' Save the new/edited Image 754| If Gdoc.NoCopy Then 755| 756| 'refresh Waitdialog 757| Application.WaitDialogSetText WaitDialogText & "Current Sourcefile: " & Sdoc.SourceBaseName & vbNewLine & "(save the Image)" 758| 759| ' Select the right SaveFunction 760| Select Case LCase(Sdoc.SourceFileFormat) 761| Case "psd" 762| SC.PS_FuncResult = PS_SaveFileAsPSD(Sdoc.TargetFileName) 763| If SC.PS_FuncResult <> "" Then AddToLogfileCache(SC.PS_FuncResult) 764| Case "jpg" 765| SC.PS_FuncResult = PS_SaveFileAsJPG(Sdoc.SourceFileFormat, Sdoc.TargetFileName, CLng(ffjpg.quality), ffjpg.optimized, CLng(ffjpg.scans)) 766| If SC.PS_FuncResult <> "" Then AddToLogfileCache(SC.PS_FuncResult) 767| Case "tif" 768| SC.PS_FuncResult = PS_SaveFileAsTIF(Sdoc.SourceFileFormat, Sdoc.TargetFileName, fftif.byteorder, fftif.LZW) 769| If SC.PS_FuncResult <> "" Then AddToLogfileCache(SC.PS_FuncResult) 770| Case "eps" 771| SC.PS_FuncResult = PS_SaveFileAsEPS(Sdoc.SourceFileFormat, Sdoc.TargetFileName, ffeps.Preview, ffeps.Depth, ffeps.Encoding, ffeps.EncodingJPEGQuality) 772| If SC.PS_FuncResult <> "" Then AddToLogfileCache(SC.PS_FuncResult) 773| Case Else 774| SC.PS_FuncResult = PS_SaveFile() 775| If SC.PS_FuncResult <> "" Then AddToLogfileCache(SC.PS_FuncResult) 776| End Select 777| 778| 779| Else 780| 781| ' Check if the Targetfile already exists and if so, append next free Number to the FileName. 782| If hn_FileExists(Sdoc.TargetFilename,vbNormal) Then 783| Sdoc.TargetFilename = hn_AppendNextFreeNumberToFN(Sdoc.TargetFilename) 784| AddToLogfileCache("The Targetfile already exists!" & vbNewLine & "NewTargetFilename: " & Sdoc.TargetFilename,ERRORS,False) 785| End If 786| 787| 'refresh Waitdialog 788| Application.WaitDialogSetText WaitDialogText & "Current Sourcefile: " & Sdoc.SourceBaseName & vbNewLine & "(save to: " & Sdoc.TargetFilename & ")" 789| 790| ' Select the right SaveFunction and saves the Conversionresult to that Fileformat 791| Select Case LCase(Sdoc.TargetFileFormat) 792| Case "psd" 793| SC.PS_FuncResult = PS_SaveFileAsPSD(Sdoc.TargetFileName) 794| If SC.PS_FuncResult <> "" Then AddToLogfileCache(SC.PS_FuncResult) 795| Case "jpg" 796| SC.PS_FuncResult = PS_SaveFileAsJPG(Sdoc.SourceFileFormat, Sdoc.TargetFileName, CLng(ffjpg.quality), ffjpg.optimized, CLng(ffjpg.scans)) 797| If SC.PS_FuncResult <> "" Then AddToLogfileCache(SC.PS_FuncResult) 798| Case "tif" 799| SC.PS_FuncResult = PS_SaveFileAsTIF(Sdoc.SourceFileFormat, Sdoc.TargetFileName, fftif.byteorder, fftif.LZW) 800| If SC.PS_FuncResult <> "" Then AddToLogfileCache(SC.PS_FuncResult) 801| Case "eps" 802| SC.PS_FuncResult = PS_SaveFileAsEPS(Sdoc.SourceFileFormat, Sdoc.TargetFileName, ffeps.Preview, ffeps.Depth, ffeps.Encoding, ffeps.EncodingJPEGQuality) 803| If SC.PS_FuncResult <> "" Then AddToLogfileCache(SC.PS_FuncResult) 804| Case Else 805| 806| 807| GoTo Exit_ 808| End Select 809| End If 810| 811| 812| 'close the Image 813| SC.PS_FuncResult = PS_CloseDocument() 814| If SC.PS_FuncResult <> "" Then AddToLogfileCache(SC.PS_FuncResult) 815| 816| End If 817| 818| 819| 'Check if user has pressed CancelButton! 820| If Application.WaitDialogIsCanceled Then GoTo BreakTheLoop 821| 822| 823| 824| 'DATABASE UPDATE 825| 'refresh Waitdialog 826| Application.WaitDialogSetText WaitDialogText & "Current Sourcefile: " & Sdoc.SourceBaseName & vbNewLine & "(update Database)" 827| 828| 'AddImage / RefreshImage 829| If DBU.AddNewImageToDB Then 830| AddImageResult = DB.AddImage(Sdoc.TargetFileName) 831| If Not AddImageResult = imforSuccess And Logg.Create Then AddToLogfileCache("Couldn't add the Image '" & Sdoc.TargetFileName & "' to the Database!" & vbNewLine,ERRORS,False) 832| 833| 'Transmit Properties and Categories if selected 834| If Reg.GetKey("transProp") Then 835| Trans.TransmitProperties(TheImage, DB.GetImages(Sdoc.TargetFileName)) 836| End If 837| If Reg.GetKey("transCat") Then 838| Trans.TransmitCategories(TheImage, DB.GetImages(Sdoc.TargetFileName)) 839| End If 840| 841| Else 842| Application.UpdateDatabase(Sdoc.TargetFileName,True) 843| End If 844| 845| 846| 'Bookmark Image 847| If DBU.BookmarkToImage Then 848| DB.AddBookmark(DB.GetImages(Sdoc.TargetFilename)) 849| End If 850| 851| 852| 'Add Image to WorkflowCats 853| If DBU.AssignToWorkflowCats Then 854| 'Add Image to a Bucket for assign them all at once later 855| WorkflowBucket.CombineImage(DB.GetImages(Sdoc.TargetFilename)) 856| End If 857| 858| 859| 'writes LogfileCache into Logfile 860| FlushLogfileCache 861| 862| End If 863| 864| End If 865| 866| Next 867| 868| 869| BreakTheLoop: 870| 871| 'Reset Statusbar 872| Application.StatusBarHidePercentage 873| 874| 'Close Waitdialog 875| Application.WaitDialogClose 876| 877| 878| 'Add ImageBucket to WorkflowCats 879| If DBU.AssignToWorkflowCats Then 880| If Not WoFlo.AssignImageBucketToCats(WorkflowBucket) Then MsgBox "Couldn't properly assign all Images to the selected Workflow-Categories!" 881| End If 882| 883| 884| ' If the simulation-Button is pressed 885| ' Checks if the CurrentSelection results in Targetfilename-Conflicts 886| If SC.IsSimulation And Not Gdoc.NoCopy Then 887| Dim i As Integer, i2 As Integer, k As Integer, k2 As Integer 888| i = 0 889| For k = 1 To UBound(simulatedTarget) 890| i = i + 1 891| i2 = 0 892| For k2 = 1 To UBound(simulatedTarget) 893| i2 = i2 + 1 894| If simulatedTarget(i2) = simulatedTarget(i) And i <> i2 Then 895| AddToLogfileCache("Targetfilename-Conflict: " & simulatedSource(i) & "->" & simulatedTarget(i2) & vbNewLine,ERRORS,False) 896| End If 897| Next 898| Next 899| If Logg.Cache = "" Then Logg.Cache = vbNewLine & "No Conflicts detected!" & vbNewLine 900| GoTo Exit_ 901| End If 902| 903| 904| DoDbgMsg(Production,"Sub Main",FunctionExit,Now & " - Batchprocess has finished!" & Chr(13) & "##############################################") 905| If Logg.Create And Not Logg.onlyErrors Then Logg.Cache = Logg.Cache & Now & " - Batchprocess has finished!" & Chr(13) & "##############################################" 906| 907| 908| 909| Exit_: 910| If SG.closeApp And Not (SC.IsCanceld Or SC.IsSimulation) Then 911| SC.PS_FuncResult = PS_OLE_Close() 912| If SC.PS_FuncResult <> "" And Logg.Create Then AddToLogfileCache(SC.PS_FuncResult,ERRORS,False) 913| End If 914| 915| SC.endtime = Timer 916| If Logg.Create And Not (SC.IsCanceld Or SC.IsSimulation Or Logg.onlyErrors) Then Logg.Cache = Logg.Cache & vbNewLine & "Batchprocess takes " & hn_friendlyTimerStr(CDbl(SC.endtime - SC.starttime),True) 917| FlushLogfileCache 918| 919| If (SG.openLog Or SC.IsSimulation) And Not SC.IsCanceld Then Application.ShellExecute("open",Logg.FName) 920| 921| Exit Sub 922| 923| 924| ErrHandler: 925| MsgBox "ERROR: " & Err.Number & vbNewLine & Err.Description, vbExclamation, SCRIPTNAME & " (Sub Main)" 926| Err.Clear 927| GoTo Exit_ 928| 929| Escape: 930| 931| End Sub 932| 933| 934| 935| ' Shows the initial dialog and lets the user choose settings 936| Private Function Dlg_Initial(SelImgs As Integer) As Boolean 937| 938| Dlg_Initial = False 939| SG.DlgMainRefresh = CanceledByUser 940| 941| Do 942| 943| 'If SG.DlgMainRefresh = StoreSet Then 944| ' 'This is only True if the user has opened the PresetDialog and pressed the StoreSet-Button! 945| ' Dim MiniLoop As Boolean 946| ' Do 947| ' Select Case RegTreePreset.StoreCurrentSet() 948| ' Case CanceledByUser 949| ' 'SG.DlgMainRefresh = CanceledByUser 950| ' MiniLoop = False 951| ' Case SuccessfulLoaded 952| ' SG.DlgMainRefresh = CanceledByUser 953| ' MiniLoop = True 954| ' Case UnexpectedError 955| ' MsgBox "Couldn't save the CurrentSet as Preset", vbExclamation, SCRIPTNAME & " (Dlg_Initial)" 956| ' MiniLoop = True 957| ' GoTo Escape 958| ' End Select 959| ' 960| ' If Not MiniLoop Then 961| ' If RegTreePreset.PresetDialog() <> StoreSet Then 962| ' SG.DlgMainRefresh = CanceledByUser 963| ' MiniLoop = True 964| ' End If 965| ' End If 966| ' Loop Until MiniLoop 967| 'End If 968| 969| 970| ReDim dpiList1(9) 971| dpiList1(0) = "36" 972| dpiList1(1) = "72" 973| dpiList1(2) = "96" 974| dpiList1(3) = "120" 975| dpiList1(4) = "150" 976| dpiList1(5) = "240" 977| dpiList1(6) = "300" 978| dpiList1(7) = "360" 979| dpiList1(8) = "1000" 980| 981| ReDim fileformatList(4) 982| fileformatList(0) = "psd" 983| fileformatList(1) = "tif" 984| fileformatList(2) = "eps" 985| fileformatList(3) = "jpg" 986| 'fileformatList(4) = "png" 987| 'fileformatList(5) = "gif" 988| 'fileformatList(6) = "pdf" 989| 990| 991| 'Define the MainDialog 992| Begin Dialog UserDialog 810,525,"Options for converting " & SelImgs & " selected Images via Photoshop!",.Dlg_Initial_Func ' %GRID:10,7,1,1 993| Picture 619,-3,187,51,SG.ICONS & "ps_oleLogo.bmp",0,.ps_app 994| Picture 4,47,802,107,SG.ICONS & "farbe_gruen_5.bmp",0,.color_folders 995| Picture 4,152,802,107,SG.ICONS & "farbe_blau_5.bmp",0,.color_files 996| Picture 4,259,802,133,SG.ICONS & "farbe_rot_5.bmp",0,.color_images 997| Text 17,53,775,90,"",.ColorText11 998| Text 17,158,775,90,"",.ColorText12 999| Text 17,263,775,118,"",.ColorText13 1000| 1001| GroupBox 10,476,470,42,"",.outputgroup5 1002| GroupBox 490,476,310,42,"",.outputgroup9 1003| GroupBox 10,53,790,94,"Select Folder-Options : ",.outputgroup1 1004| 'Text 210,28,390,14,"Preferences > ColorSettings: """ & inf.ColorSettings & """",.ColorPrefs,1 1005| Text 210,14,390,14,"Photoshop MemoryUsage: """ & inf.MemoryUsagePercent & "%""",.ramusage,1 1006| CancelButton 500,490,100,21,.Cancel 1007| OKButton 690,490,100,21,.OK 1008| 1009| GroupBox 10,158,790,94,"Define FileName and FileType : ",.outputgroup6 1010| DropListBox 250,224,70,112,fileformatList(),.DTargetFileFormat 1011| GroupBox 10,263,790,122,"Image Manipulation : ",.outputgroup4 1012| DropListBox 250,273,340,84,iccList(),.DassignICCProfile 1013| 1014| DropListBox 250,301,340,84,iccList(),.DTargetICCProfile 1015| DropListBox 510,329,80,98,dpiList1(),.DTargetdpi 1016| GroupBox 10,7,200,35,"! Be carefull !",.outputgroup2 1017| 'Text 540,154,230,14,"(leave blank to not apply)",.Text7 1018| 1019| DropListBox 250,357,340,119,PS_acts(),.actsi 1020| GroupBox 10,392,230,84,"Update Database : ",.outputgroup7 1021| GroupBox 600,399,200,70,"after Batchprocess: ",.outputgroup8 1022| GroupBox 30,91,750,7,"",.GroupBox1 1023| GroupBox 30,212,750,7,"",.GroupBox2 1024| Text 80,126,160,14,"-| Main Targetfolder ->",.MTFtxt,1 1025| 'Text 120,154,190,14,"-| Feindaten-Subfolder ->",.Text1,1 1026| Text 20,308,220,14,"-| Convert to ColorspaceProfile ->",.Text2,1 1027| Text 20,280,220,14,"-| Assign ColorspaceProfile ->",.Text4,1 1028| Text 20,364,220,14,"-| available PhotoshopActions ->",.Text9,1 1029| Text 400,336,100,14,"-| dpi-Setting ->",.Text5,1 1030| Text 70,329,170,28,"-| new ImageSize in Pixel (0 for no change) ->",.Text6,1 1031| Text 30,226,210,14,"-| Convert Images to ->",.Text8,1 1032| Text 30,193,210,14,"-| Append String to Filename ->",.Text3,1 1033| Text 30,175,210,14,"-| Find String in Filename ->",.Text7,1 1034| Text 340,175,80,14,"+ Replace->",.Text10,1 1035| 1036| OptionGroup .DTargetType 1037| OptionButton 30,70,290,14,"Create one Subfolder in every SourceDir",.UseDiffSubfolders 1038| OptionButton 30,105,170,14,"Use one Targetfolder",.UseMainTargetFolder 1039| 1040| TextBox 320,63,210,21,.DSubTargetName 1041| TextBox 250,119,340,21,.DMainTargetFolder 1042| 'TextBox 320,147,210,21,.DFeindatenSubfolder 1043| TextBox 250,193,250,21,.DStrToFN 1044| TextBox 250,168,80,21,.DNeedle 1045| TextBox 420,168,80,21,.DReplaceStr 1046| TextBox 250,329,90,21,.DNewSize 1047| 1048| CheckBox 30,21,170,14,"Overwrite existing Files!",.DNoCopy 1049| CheckBox 510,224,80,21,"enable",.DSaveAsFiletype 1050| CheckBox 600,329,80,21,"enable",.DProceedScaling 1051| CheckBox 510,193,80,21,"enable",.DAppendStrToFN 1052| CheckBox 510,168,80,21,"enable",.DFindReplace 1053| CheckBox 600,357,80,21,"enable",.DProceedAction 1054| CheckBox 600,301,70,21,"enable",.DProceedICC 1055| CheckBox 600,273,70,21,"enable",.DassignICC 1056| CheckBox 30,406,200,14,"Add Images to Database",.DAddNewImageToDB 1057| CheckBox 30,420,150,14,"Bookmark Images",.DAddBookmarks 1058| CheckBox 30,462,200,14,"Add to Workflow Categories",.DAssignToCats 1059| CheckBox 30,434,200,14,"transmit Properties",.Dtransprop 1060| CheckBox 30,448,200,14,"transmit Categories",.Dtranscat 1061| 1062| PushButton 600,119,180,21,"select Folder",.BrowseMTF 1063| PushButton 600,224,180,21,"Setup Fileformat Options",.FFOptions 1064| PushButton 240,490,110,21,"Global Options",.GlobalOptions 1065| PushButton 680,301,100,21,"Setup ICC-List",.ICCOptions 1066| PushButton 680,357,100,21,"update Actions",.UpdateActions 1067| PushButton 20,490,110,21,"Scriptinfo",.scriptinfo 1068| Text 330,226,170,14,"(ffparams)",.ffparams 1069| CheckBox 250,105,340,14,"Clear Targetfolder at Processbegin",.DclearMainTarget 1070| CheckBox 620,434,170,14,"close Photoshop",.DcloseApp 1071| CheckBox 620,448,170,14,"Shutdown Windows",.DShutDownWin 1072| CheckBox 620,420,170,14,"open Logfile",.DopenLog 1073| CheckBox 680,273,110,21,"overwrite",.DassignICCoverwrite 1074| PushButton 600,490,90,21,"Simulation",.DSimulation 1075| PushButton 250,392,340,21,"Select Workflow Categories and JobTicket",.Btn_AssignToCats 1076| Text 270,420,300,49,"Current Cats und JobTicket",.CurCats 1077| PushButton 130,490,110,21,"show Logfile",.Btn_showLog 1078| 'PushButton 350,490,120,21,"Presets",.Btn_Presets 1079| Text 600,168,180,42,"If you enable both options: replace string will proceed first, append string second",.Text1 1080| End Dialog 1081| 1082| 1083| Dim dlg As UserDialog 1084| 1085| 'Set elements to storedValues or to defaultValues if no stored ones can be found 1086| With dlg 1087| ' Actions to proceed 1088| .DProceedScaling = Reg.GetKey("ProceedScaling",False) 1089| .DNewSize = CStr(Reg.GetKey("NewSize","0")) 1090| .DTargetdpi = Reg.GetKey("Targetdpi_ListID",6) 1091| .DProceedAction = Reg.GetKey("ProceedAction") 1092| .actsi = Reg.GetKey("ActionName_ListID") 1093| .DassignICC = Reg.GetKey("assignICC",0) 1094| .DassignICCoverwrite = Reg.GetKey("assignICCoverwrite",0) 1095| .DassignICCProfile = Reg.GetKey("assignICCProfile_ListID") 1096| .DProceedICC = Reg.GetKey("ProceedICC",0) 1097| .DTargetICCProfile = Reg.GetKey("TargetICCProfile_ListID") 1098| .Dtransprop = Reg.GetKey("transprop", False) 1099| .Dtranscat = Reg.GetKey("transcat", False) 1100| ' FileOptions 1101| .DNoCopy = Reg.GetKey("NoCopy") 1102| .DSaveAsFiletype = Reg.GetKey("SaveAsFiletype") 1103| .DTargetFileFormat = Reg.GetKey("TargetFileFormat_ListID") 1104| .DAppendStrToFN = Reg.GetKey("AppendStrToFN",1) 1105| .DStrToFN = Reg.GetKey("StrToFN","_StringToFname") 1106| ' FolderOptions 1107| .DTargetType = Reg.GetKey("TargetType",1) 1108| .DSubTargetName = Reg.GetKey("SubTargetName","modified") 1109| .DclearMainTarget = Reg.GetKey("clearMainTarget",False) 1110| .DMainTargetFolder = Reg.GetKey("MainTargetFolder",Environ("temp") & "\IMatchPS_output") 1111| '.DFeindatenSubfolder= Reg.GetKey("FeindatenSubFolder","") 1112| ' Global ScriptSettings and DataBaseOptions 1113| .DAddNewImageToDB = Reg.GetKey("AddNewImageToDB",False) 1114| .DAddBookmarks = Reg.GetKey("AddBookmarks",False) 1115| .DAssignToCats = Reg.GetKey("AssignToCats",False) 1116| .DcloseApp = Reg.GetKey("closeApp",False) 1117| .DopenLog = Reg.GetKey("openLog",False) 1118| .DFindReplace = Reg.GetKey("FindReplace",False) 1119| .DNeedle = Reg.GetKey("Needle","") 1120| .DReplaceStr = Reg.GetKey("ReplaceStr","") 1121| End With 1122| 1123| 1124| 'Call the Dialog and catch its IntegerResult 1125| Dim DlgResult As Integer 1126| DlgResult = Dialog(dlg) 1127| 1128| 1129| 'Evaluate DlgResult 1130| Select Case DlgResult 1131| 'Case -1 1132| 'OK pressed 1133| 'Dlg_Initial = False 1134| 'Nothing special is to do. We save the Settings and run the Script 'til it's ended. 1135| 1136| Case 0 1137| SC.IsCanceld = True 1138| Dlg_Initial = False 1139| Exit Function 1140| 1141| Case Else 1142| If (SG.DlgMainRefresh = SuccessfulLoaded) Then 1143| 'Prevent for saving the DialogValues. 1144| 'Instead we have to load the copied values into the Dialog by refreshing it! (Do Loop Until DlgMainRefresh = CanceledByUser) 1145| GoTo DONOTSAVE_DLGSETTINGS 1146| End If 1147| 1148| 'If (SG.DlgMainRefresh = StoreSet) Then 1149| 'We have to save the DialogSettings and then copy them to the returned PresetNumber from PresetsDialog! 1150| 'End If 1151| 1152| 'If SC.IsSimulation Then 1153| 'Nothing special is to do. We save the Settings and run the Script 'til it's ended. 1154| 'End If 1155| 1156| End Select 1157| 1158| SAVE_DLGSETTINGS: 1159| 1160| ' FriendlyNames of DropdownlistValues 1161| If dlg.actsi > -1 Then 1162| Reg.SaveKey("ActionName",PS_acts(dlg.actsi)) 1163| Else 1164| Reg.SaveKey("ActionName","") 1165| End If 1166| 1167| If dlg.DTargetICCProfile > -1 Then 1168| Reg.SaveKey("TargetICCProfile",iccList(dlg.DTargetICCProfile)) 1169| Else 1170| Reg.SaveKey("TargetICCProfile","") 1171| End If 1172| If dlg.DassignICCProfile > -1 Then 1173| Reg.SaveKey("assignICCProfile",iccList(dlg.DassignICCProfile)) 1174| Else 1175| Reg.SaveKey("assignICCProfile","") 1176| End If 1177| 1178| 1179| Reg.SaveKey("Targetdpi",dpiList1(dlg.DTargetdpi)) 1180| Reg.SaveKey("TargetFileFormat",fileformatList(dlg.DTargetFileFormat)) 1181| 1182| ' List-Indexes of Dropdownlists 1183| If dlg.actsi > -1 Then 1184| Reg.SaveKey("ActionName_ListID",dlg.actsi,AsInteger) 1185| Else 1186| Reg.SaveKey("ActionName_ListID",0,AsInteger) 1187| End If 1188| 1189| If dlg.DTargetICCProfile > -1 Then 1190| Reg.SaveKey("TargetICCProfile_ListID",dlg.DTargetICCProfile,AsByte) 1191| Else 1192| Reg.SaveKey("TargetICCProfile_ListID",0,AsByte) 1193| End If 1194| If dlg.DassignICCProfile > -1 Then 1195| Reg.SaveKey("assignICCProfile_ListID",dlg.DassignICCProfile,AsByte) 1196| Else 1197| Reg.SaveKey("assignICCProfile_ListID",0,AsByte) 1198| End If 1199| 1200| Reg.SaveKey("Targetdpi_ListID",dlg.DTargetdpi,AsByte) 1201| Reg.SaveKey("TargetFileFormat_ListID",dlg.DTargetFileFormat,AsByte) 1202| Reg.SaveKey("AddBookmarks",dlg.DAddBookmarks,AsBoolean) 1203| Reg.SaveKey("AssignToCats",dlg.DAssignToCats,AsBoolean) 1204| 1205| ' StringVars 1206| Reg.SaveKey("SubTargetName",dlg.DSubTargetName) 1207| Reg.SaveKey("MainTargetFolder",dlg.DMainTargetFolder) 1208| Reg.SaveKey("clearMainTarget",dlg.DclearMainTarget,AsBoolean) 1209| 'Reg.SaveKey("FeindatenSubfolder",dlg.DFeindatenSubfolder) 1210| Reg.SaveKey("StrToFN",dlg.DStrToFN) 1211| Reg.SaveKey("Needle",dlg.DNeedle) 1212| Reg.SaveKey("ReplaceStr",dlg.DReplaceStr) 1213| 1214| ' Numeric Values 1215| Reg.SaveKey("NewSize",dlg.DNewSize,AsInteger) 1216| 1217| ' GroupSelects 1218| Reg.SaveKey("TargetType",dlg.DTargetType,AsInteger) 1219| 1220| ' Checkboxes 1221| Reg.SaveKey("ProceedScaling",dlg.DProceedScaling,AsBoolean) 1222| Reg.SaveKey("AppendStrToFN",dlg.DAppendStrToFN,AsBoolean) 1223| Reg.SaveKey("SaveAsFiletype",dlg.DSaveAsFiletype,AsBoolean) 1224| Reg.SaveKey("NoCopy",dlg.DNoCopy,AsBoolean) 1225| Reg.SaveKey("ProceedAction",dlg.DProceedAction,AsBoolean) 1226| Reg.SaveKey("ProceedICC",dlg.DProceedICC,AsBoolean) 1227| Reg.SaveKey("assignICC",dlg.DassignICC,AsBoolean) 1228| Reg.SaveKey("assignICCoverwrite",dlg.DassignICCoverwrite,AsBoolean) 1229| Reg.SaveKey("AddNewImageToDB",dlg.DAddNewImageToDB,AsBoolean) 1230| Reg.SaveKey("closeApp",dlg.DcloseApp,AsBoolean) 1231| Reg.SaveKey("openLog",dlg.DopenLog,AsBoolean) 1232| Reg.SaveKey("FindReplace",dlg.DFindReplace,AsBoolean) 1233| Reg.SaveKey("transProp",dlg.Dtransprop,AsBoolean) 1234| Reg.SaveKey("transCat",dlg.Dtranscat,AsBoolean) 1235| 1236| DONOTSAVE_DLGSETTINGS: 1237| 1238| Loop Until (SG.DlgMainRefresh = CanceledByUser) Or SC.IsCanceld Or SC.IsSimulation 1239| 1240| 1241| 'MainDialog at least has finished by OK! 1242| RegSetup.SaveKey("Dlg_Initial","X") 1243| Dlg_Initial = True 1244| 1245| 1246| Escape: 1247| Exit Function 1248| 1249| ErrHandler: 1250| MsgBox "Error: " & Err.Number & vbNewLine & Err.Description, vbExclamation, SCRIPTNAME & " (DLG_Initial)" 1251| Resume Escape 1252| 1253| End Function 1254| 1255| 1256| Private Function Dlg_Global() As Boolean 1257| 1258| Begin Dialog UserDialog 800,210,"Advanced Options for ImageManipulation via Photoshop! (Global ScriptSettings)",.Dlg_Global_Func ' %GRID:10,7,1,1 1259| GroupBox 10,7,470,77,"Logfile ",.outputgroup3 1260| 1261| PushButton 300,49,160,21,"get Filename",.Btn_BrowseForLogFile 1262| CheckBox 30,28,120,14,"Create Logfile",.DLogCreate 1263| CheckBox 300,28,170,14,"overwrite, not append",.DLogOverwrite 1264| CheckBox 160,28,120,14,"Log only Errors",.DLogOnlyErrors 1265| TextBox 30,49,260,21,.DLogfileName 1266| 1267| GroupBox 490,7,300,161,"OLE Server Timeout",.outputgroup2 1268| Text 500,49,270,112,"Set a Timeout for OLE-Serverautomation in seconds for each Scriptcommand which will send to Photoshop." & vbNewLine & "120 sec. will be a good value for work with files of 2-5 MB." & vbNewLine & "If you work with bigger files or you let Photoshop do operations wich took a lot more time, you can set this to a higher value, e.g. 180 sec or 400 sec.",.Text1 1269| PushButton 10,182,140,21,"Scriptinfo",.scriptinfo 1270| PushButton 160,182,310,21,"clear/reset all Registry-Settings of this Script",.DresetRegKeys 1271| CancelButton 610,182,90,21,.Cancel 1272| OKButton 700,182,90,21,.OK 1273| GroupBox 10,91,470,77,"Misc",.outputgroup 1274| CheckBox 240,112,230,14,"PowerUser, no WarnMessages!",.DPowerUser 1275| TextBox 710,25,60,19,.DOLE_TimeOut 1276| CheckBox 30,112,190,14,"Hide Photoshop-Palettes",.DNoPS_Palettes 1277| End Dialog 1278| 1279| 1280| Dim dlg As UserDialog 1281| With dlg 1282| .DOLE_TimeOut = CStr(CLng(Reg.GetKey("OLE_TimeOut",180000)) / CLng(1000)) ' If no Value is stored we use a 60 sec default 1283| .DPowerUser = Reg.GetKey("PowerUser",False) 1284| .DLogCreate = Reg.GetKey("LogCreate",True) 1285| .DLogOnlyErrors = Reg.GetKey("LogOnlyErrors",False) 1286| .DLogOverwrite = Reg.GetKey("LogOverwrite",False) 1287| .DLogFileName = Reg.GetKey("LogFileName",Environ("Temp") & "\Imatch_PS_OLE_Logg.txt") 1288| .DNoPS_Palettes = Reg.GetKey("NoPS_palettes",False) 1289| End With 1290| 1291| 1292| If Dialog(dlg) >= 0 Then 1293| Dlg_Global = False 1294| Exit Function 1295| End If 1296| 1297| Reg.SaveKey("OLE_TimeOut",CLng(1000) * CLng(dlg.DOLE_TimeOut),AsLong) 1298| OLE_TimeOut = CLng(1000) * CLng(dlg.DOLE_TimeOut) 1299| Reg.SaveKey("PowerUser",dlg.DPowerUser,AsBoolean) 1300| SG.PowerUser = CBool(dlg.DPowerUser) 1301| Reg.SaveKey("LogCreate",dlg.DLogCreate,AsBoolean) 1302| Reg.SaveKey("LogOnlyErrors",dlg.DLogOnlyErrors,AsBoolean) 1303| Reg.SaveKey("LogOverwrite",dlg.DLogOverwrite,AsBoolean) 1304| Reg.SaveKey("LogFileName",dlg.DLogFileName) 1305| Reg.SaveKey("NoPS_palettes",dlg.DNoPS_Palettes,AsBoolean) 1306| 1307| 1308| RegSetup.SaveKey("Dlg_Global", "X") 1309| Dlg_Global = True 1310| 1311| End Function 1312| 1313| 1314| Private Function Dlg_ICC() As Boolean 1315| 1316| Begin Dialog UserDialog 800,192,"Advanced Options for ImageManipulation via Photoshop! (ICC-Options)",.Dlg_ICC_Func ' %GRID:10,6,1,1 1317| PushButton 150,161,150,21,"Info about ICC-List",.ICCinfo 1318| PushButton 10,161,140,21,"Scriptinfo",.scriptinfo 1319| GroupBox 610,60,180,90,"",.GroupBox1 1320| CancelButton 610,161,90,21,.Cancel 1321| OKButton 700,161,90,21,.OK 1322| GroupBox 10,6,290,144,"",.outputgroup 1323| Text 310,12,280,12,"Colorspace-Profiles :",.Text2 1324| PushButton 30,72,250,18,"<- remove selected Item",.ICCRemoveOne 1325| PushButton 630,78,140,36,"open List with Editor",.ICCEditor 1326| PushButton 630,114,140,24,"refresh edited List",.ICCEditorRefresh 1327| PushButton 30,42,250,21,"add name to list ->",.ICCAddNew 1328| TextBox 30,21,250,21,.ICCNewProfile 1329| ListBox 310,24,280,126,iccList(),.ICCListBox 1330| PushButton 30,126,250,18,"| Reset to StandardProfiles |",.ICCReset 1331| Picture 740,6,45,30,SG.ICONS & "ps_profile.bmp",0,.ps_profile 1332| End Dialog 1333| 1334| 1335| Dim dlg As UserDialog 1336| With dlg 1337| End With 1338| 1339| If Dialog(dlg) >= 0 Then 1340| Dlg_ICC = False 1341| Exit Function 1342| End If 1343| 1344| RegSetup.SaveKey("Dlg_ICC", "X") 1345| Dlg_ICC = True 1346| 1347| End Function 1348| 1349| 1350| Private Function Dlg_FileFormat() As Boolean 1351| 1352| Dim jpgqualitaet(0 To 12) As String 1353| jpgqualitaet(0) = " 0 (Low)" 1354| jpgqualitaet(1) = " 1 (Low)" 1355| jpgqualitaet(2) = " 2 (Low)" 1356| jpgqualitaet(3) = " 3 (Low)" 1357| jpgqualitaet(4) = " 4 (Normal)" 1358| jpgqualitaet(5) = " 5 (Normal)" 1359| jpgqualitaet(6) = " 6 (Normal)" 1360| jpgqualitaet(7) = " 7 (High)" 1361| jpgqualitaet(8) = " 8 (High)" 1362| jpgqualitaet(9) = " 9 (High)" 1363| jpgqualitaet(10) = "10 (Max)" 1364| jpgqualitaet(11) = "11 (Max)" 1365| jpgqualitaet(12) = "12 (Max)" 1366| 1367| Dim epsEnc(0 To 5) As String 1368| epsEnc(0) = "ASCII" 1369| epsEnc(1) = "Binary" 1370| epsEnc(2) = "JPEG LowQuality" 1371| epsEnc(3) = "JPEG MediumQuality" 1372| epsEnc(4) = "JPEG HighQuality" 1373| epsEnc(5) = "JPEG MaximumQuality" 1374| 1375| Dim epsPrev(0 To 2) As String 1376| epsPrev(0) = "None" 1377| epsPrev(1) = "Tiff 1 Bit/Pixel" 1378| epsPrev(2) = "Tiff 8 Bit/Pixel" 1379| 1380| 1381| Begin Dialog UserDialog 800,441,"Advanced Options for ImageManipulation via Photoshop! (Fileformat-Options)",.Dlg_FileFormat_Func ' %GRID:10,7,1,1 1382| GroupBox 310,147,290,147,"Global Options",.GroupBox1 1383| CheckBox 340,203,160,14,"FileTypeLowerCase",.DGFSO_LowerCase 1384| CheckBox 340,182,160,14,"Embed-ICC-Profiles",.DGFSO_EmbedProfiles 1385| CancelButton 610,231,90,21,.Cancel 1386| OKButton 700,231,90,21,.OK 1387| Text 70,21,210,14,"Quality",.Text8 1388| Text 610,49,170,14,"Photoshop Information:",.Text5 1389| Text 610,70,170,14,"Prefs -> Advanced TIFF:",.Text1 1390| Text 610,84,170,14,CStr(inf.SaveAdvancedTiff),.Text2 1391| Text 610,112,170,14,"Prefs -> Composite:",.Text3 1392| Text 610,126,170,14,CStr(inf.SaveComposite),.Text4 1393| GroupBox 10,7,290,133,"JPEG",.outputgroup 1394| GroupBox 310,7,290,133,"TIFF",.outputgroup2 1395| GroupBox 310,301,290,133,"GIF",.outputgroup3 1396| GroupBox 10,301,290,133,"PNG",.outputgroup4 1397| GroupBox 10,147,290,147,"EPS",.outputgroup6 1398| DropListBox 70,35,210,84,jpgqualitaet(),.DjpgQualitaet 1399| OptionGroup .DjpgFormat 1400| OptionButton 30,63,250,14,"Baseline (Standard)",.OptionButton0 1401| OptionButton 30,77,250,14,"Baseline optimized",.OptionButton1 1402| OptionButton 30,91,250,14,"optimized 3 Scans",.OptionButton2 1403| OptionButton 30,105,250,14,"optimized 4 Scans",.OptionButton3 1404| OptionButton 30,119,250,14,"optimized 5 Scans",.OptionButton4 1405| CheckBox 330,38,240,14,"save with LZW Compression",.DtifLZW 1406| DropListBox 28,193,250,63,epsPrev(),.DepsPreview 1407| CheckBox 328,61,240,14,"save with Mac-Byteorder",.DtifMac 1408| DropListBox 30,231,250,70,epsEnc(),.DepsEncoding 1409| PushButton 610,196,180,21,"Scriptinfo",.scriptinfo 1410| Text 30,179,240,14,"Preview",.Text6 1411| Text 30,217,240,14,"Encoding",.Text7 1412| Picture 16,145,45,30,SG.ICONS & "ps_eps.bmp",0,.ps_eps 1413| Picture 318,5,45,30,SG.ICONS & "ps_tif.bmp",0,.ps_tif 1414| Picture 315,300,46,30,SG.ICONS & "ps_gif.bmp",0,.ps_gif 1415| Picture 16,299,46,30,SG.ICONS & "ps_png.bmp",0,.ps_png 1416| Picture 19,5,45,30,SG.ICONS & "ps_jpg.bmp",0,.ps_jpg 1417| Picture 739,7,45,30,SG.ICONS & "ps_psd.bmp",0,.ps_psd 1418| End Dialog 1419| 1420| Dim dlg As UserDialog 1421| With dlg 1422| .DGFSO_LowerCase = Reg.GetKey("GFSO_LowerCase",True) 1423| .DGFSO_EmbedProfiles = Reg.GetKey("GFSO_EmbedProfiles",True) 1424| .DepsEncoding = Reg.GetKey("epsEncoding_ListID",1) 1425| .DepsPreview = Reg.GetKey("epsPreview_ListID",2) 1426| .DjpgQualitaet = Reg.GetKey("jpgQualitaet",12) 1427| .DjpgFormat = Reg.GetKey("jpgFormat",0) 1428| .DtifLZW = Reg.GetKey("tifLZW") 1429| .DtifMac = Reg.GetKey("tifMac") 1430| End With 1431| 1432| If Dialog(dlg) >= 0 Then 1433| Dlg_FileFormat = False 1434| Exit Function 1435| End If 1436| 1437| 'Global FileSaveOptions 1438| Reg.SaveKey("GFSO_LowerCase",dlg.DGFSO_LowerCase,AsBoolean) 1439| Reg.SaveKey("GFSO_EmbedProfiles",dlg.DGFSO_EmbedProfiles,AsBoolean) 1440| Reg.SaveKey("ffinfoglobl",CStr("(embedd Profiles=" & CBool(dlg.DGFSO_EmbedProfiles)) & ")") 1441| 1442| 'PSD FileSaveOptions 1443| Reg.SaveKey("ffinfopsd","()") 1444| 1445| 'TIFF FileSaveOptions 1446| Reg.SaveKey("tifLZW",dlg.DtifLZW,AsBoolean) 1447| Reg.SaveKey("tifMac",dlg.DtifMac,AsBoolean) 1448| Reg.SaveKey("ffinfotif","(LZW=" & CBool(dlg.DtifLZW) & " / Mac=" & CBool(dlg.DtifMac) & ")") 1449| 1450| 'JPEG FileSaveOptions 1451| Reg.SaveKey("jpgQualitaet",dlg.DjpgQualitaet,AsByte) 1452| Reg.SaveKey("jpgFormat",dlg.DjpgFormat,AsByte) 1453| Dim ffinfojpg As String 1454| ffinfojpg = "(Q=" & CByte(dlg.DjpgQualitaet) 1455| Select Case CInt(dlg.DjpgFormat) 1456| Case 0 1457| Reg.SaveKey("jpgOptimized",False,AsBoolean) 1458| Reg.SaveKey("jpgScans",0,AsByte) 1459| ffinfojpg = ffinfojpg & " / Basic" 1460| Case 1 1461| Reg.SaveKey("jpgOptimized",True,AsBoolean) 1462| Reg.SaveKey("jpgScans",0,AsByte) 1463| ffinfojpg = ffinfojpg & " / Optimized" 1464| Case 2 1465| Reg.SaveKey("jpgOptimized",True,AsBoolean) 1466| Reg.SaveKey("jpgScans",3,AsByte) 1467| ffinfojpg = ffinfojpg & " / 3Scans" 1468| Case 3 1469| Reg.SaveKey("jpgOptimized",True,AsBoolean) 1470| Reg.SaveKey("jpgScans",4,AsByte) 1471| ffinfojpg = ffinfojpg & " / 4Scans" 1472| Case 4 1473| Reg.SaveKey("jpgOptimized",True,AsBoolean) 1474| Reg.SaveKey("jpgScans",5,AsByte) 1475| ffinfojpg = ffinfojpg & " / 5Scans" 1476| End Select 1477| Reg.SaveKey("ffinfojpg",ffinfojpg & ")") 1478| 1479| 1480| 'EPS FileSaveOptions 1481| Reg.SaveKey("epsEncoding_ListID", dlg.DepsEncoding,AsByte) 1482| Reg.SaveKey("epsPreview_ListID", dlg.DepsPreview,AsByte) 1483| Dim ffinfoeps As String 1484| Select Case CInt(dlg.DepsPreview) 1485| Case 0 1486| Reg.SaveKey("epsPreview", None, AsLong) 1487| ffinfoeps = "(Preview=No" 1488| Case 1 1489| Reg.SaveKey("epsPreview", phEnumTIFF, AsLong) 1490| Reg.SaveKey("epsDepth", phEnum1BitPerPixel, AsLong) 1491| ffinfoeps = "(Preview=1Bit" 1492| Case 2 1493| Reg.SaveKey("epsPreview", phEnumTIFF, AsLong) 1494| Reg.SaveKey("epsDepth", phEnum8BitsPerPixel, AsLong) 1495| ffinfoeps = "(Preview=8Bits" 1496| End Select 1497| Select Case CInt(dlg.DepsEncoding) 1498| Case 0 1499| Reg.SaveKey("epsEncoding", phEnumASCII, AsLong) 1500| ffinfoeps = ffinfoeps & " / ASCII" 1501| Case 1 1502| Reg.SaveKey("epsEncoding", phEnumBinary, AsLong) 1503| ffinfoeps = ffinfoeps & " / Binary" 1504| Case 2 1505| Reg.SaveKey("epsEncoding", phEnumJPEG, AsLong) 1506| Reg.SaveKey("epsEncodingJPEGQuality", phEnumLowQuality, AsLong) 1507| ffinfoeps = ffinfoeps & " / lowJPG" 1508| Case 3 1509| Reg.SaveKey("epsEncoding", phEnumJPEG, AsLong) 1510| Reg.SaveKey("epsEncodingJPEGQuality", phEnumMediumQuality, AsLong) 1511| ffinfoeps = ffinfoeps & " / medJPG" 1512| Case 4 1513| Reg.SaveKey("epsEncoding", phEnumJPEG, AsLong) 1514| Reg.SaveKey("epsEncodingJPEGQuality", phEnumHighQuality, AsLong) 1515| ffinfoeps = ffinfoeps & " / highJPG" 1516| Case 5 1517| Reg.SaveKey("epsEncoding", phEnumJPEG, AsLong) 1518| Reg.SaveKey("epsEncodingJPEGQuality", phEnumMaximumQuality, AsLong) 1519| ffinfoeps = ffinfoeps & " / maxJPG" 1520| End Select 1521| Reg.SaveKey("ffinfoeps",ffinfoeps & ")") 1522| 1523| 1524| RegSetup.SaveKey("Dlg_FileFormat", "X") 1525| Dlg_FileFormat = True 1526| 1527| End Function 1528| 1529| 1530| Private Function Dlg_Global_Func(DlgItem$, Action%, SuppValue&) As Boolean 1531| 1532| Select Case Action% 1533| Case 1 1534| If CBool(DlgValue("DLogCreate")) Then 1535| DlgEnable "DLogOnlyErrors",True 1536| DlgEnable "DLogFileName",True 1537| DlgEnable "DLogOverwrite",True 1538| DlgEnable "Btn_BrowseForLogFile",True 1539| Else 1540| DlgEnable "DLogOnlyErrors",False 1541| DlgEnable "DLogOverwrite",False 1542| DlgEnable "Btn_BrowseForLogFile",False 1543| DlgEnable "DLogFileName",False 1544| End If 1545| 1546| 1547| Case 2 1548| Select Case DlgItem$ 1549| Case "Cancel" 1550| Dlg_Global_Func = False 1551| Case "OK" 1552| Dlg_Global_Func = False 1553| 1554| Case "DresetRegKeys" 1555| RegSetup.DelAllKeys 1556| Reg.DelAllKeys 1557| Dlg_Global_Func = False 1558| 1559| Case "Btn_BrowseForLogFile" 1560| Dim fn As String 1561| fn = hn_BrowseForFile(ConfirmCreation,"Browse for existing or new Logfile","txt;log;rep;asc","IMatch_PS-OLE.log",DlgText("DLogfileName")) 1562| If fn <> "" Then DlgText("DLogfileName",fn) 1563| Dlg_Global_Func = True 1564| 1565| Case "DLogCreate" 1566| If CBool(DlgValue("DLogCreate")) Then 1567| DlgEnable "DLogOnlyErrors",True 1568| DlgEnable "DLogFileName",True 1569| DlgEnable "DLogOverwrite",True 1570| DlgEnable "Btn_BrowseForLogFile",True 1571| Else 1572| DlgEnable "DLogOnlyErrors",False 1573| DlgEnable "DLogOverwrite",False 1574| DlgEnable "Btn_BrowseForLogFile",False 1575| DlgEnable "DLogFileName",False 1576| End If 1577| Dlg_Global_Func = True 1578| 1579| Case "scriptinfo" 1580| Dim retErrStr As String 1581| SC.CurrentProcess = False 1582| retErrStr = hn_showInfo() 1583| If Not SC.CurrentProcess Then MsgBox retErrStr 1584| SC.CurrentProcess = False 1585| Dlg_Global_Func = True 1586| 1587| End Select 1588| End Select 1589| 1590| End Function 1591| 1592| 1593| Private Function Dlg_Initial_Func(DlgItem$, Action%, SuppValue&) As Boolean 1594| 1595| Dim k As Integer 1596| 1597| Select Case Action% 1598| Case 1 1599| If CBool(DlgValue("DNoCopy")) Then 1600| DlgEnable "DtransProp",False 1601| DlgEnable "DtransCat",False 1602| DlgEnable "DSimulation",False 1603| DlgEnable "UseDiffSubfolders",False 1604| DlgEnable "DSubTargetName",False 1605| DlgEnable "UseMainTargetFolder",False 1606| DlgEnable "MTFtxt",False 1607| DlgEnable "DMainTargetFolder",False 1608| DlgEnable "DclearMainTarget",False 1609| DlgEnable "BrowseMTF",False 1610| DlgEnable "DAppendStrToFN",False 1611| DlgEnable "DStrToFN",False 1612| DlgEnable "DSaveAsFiletype",False 1613| DlgEnable "DTargetFileFormat",False 1614| DlgEnable "outputgroup2",True 1615| DlgEnable "outputgroup1",False 1616| DlgEnable "outputgroup6",False 1617| 'DlgEnable "outputgroup7",False 1618| DlgEnable "Text8",False 1619| DlgEnable "Text3",False 1620| DlgEnable "Text7",False 1621| DlgEnable "Text10",False 1622| DlgEnable "DAddNewImageToDB",False 1623| DlgEnable "DAddBookmarks",True 1624| DlgEnable "ffparams",False 1625| DlgText("ffparams","") 1626| DlgEnable "DFindReplace",False 1627| DlgEnable "DNeedle",False 1628| DlgEnable "DReplaceStr",False 1629| Else 1630| DlgEnable "DFindReplace",True 1631| If CBool(DlgValue("DFindReplace")) Then 1632| DlgEnable "DNeedle",True 1633| DlgEnable "DReplaceStr",True 1634| Else 1635| DlgEnable "DNeedle",False 1636| DlgEnable "DReplaceStr",False 1637| End If 1638| DlgEnable "DSimulation",True 1639| DlgEnable "Text8",True 1640| DlgEnable "Text7",True 1641| DlgEnable "Text10",True 1642| DlgEnable "DAddNewImageToDB",True 1643| If CBool(DlgValue("DAddNewImageToDB")) Then 1644| DlgEnable "DAddBookmarks",True 1645| DlgEnable "DtransProp",True 1646| DlgEnable "DtransCat",True 1647| Else 1648| DlgEnable "DAddBookmarks",False 1649| DlgEnable "DtransProp",False 1650| DlgEnable "DtransCat",False 1651| End If 1652| DlgEnable "UseDiffSubfolders",True 1653| DlgEnable "UseMainTargetFolder",True 1654| DlgEnable "DSaveAsFiletype",True 1655| DlgEnable "DAppendStrToFN",True 1656| DlgEnable "outputgroup2",False 1657| DlgEnable "outputgroup1",True 1658| DlgEnable "outputgroup6",True 1659| 'DlgEnable "outputgroup7",True 1660| DlgEnable "Text3",True 1661| If DlgValue("DTargetType") = 0 Then 1662| DlgEnable "DSubTargetName",True 1663| DlgEnable "DMainTargetFolder",False 1664| DlgEnable "DclearMainTarget",False 1665| DlgEnable "MTFtxt",False 1666| DlgEnable "BrowseMTF",False 1667| Else 1668| DlgEnable "DSubTargetName",False 1669| DlgEnable "MTFtxt",True 1670| DlgEnable "BrowseMTF",True 1671| DlgEnable "DMainTargetFolder",True 1672| DlgEnable "DclearMainTarget",True 1673| End If 1674| If CBool(DlgValue("DAppendStrToFN")) Then 1675| DlgEnable "DStrToFN",True 1676| Else 1677| DlgEnable "DStrToFN",False 1678| End If 1679| If CBool(DlgValue("DSaveAsFiletype")) Then 1680| DlgEnable "DTargetFileFormat",True 1681| DlgText("ffparams",Reg.GetKey("ffinfo" & LCase(fileformatList(DlgValue("DTargetFileFormat"))))) 1682| DlgEnable "ffparams",True 1683| Else 1684| DlgEnable "DTargetFileFormat",False 1685| DlgEnable "ffparams",False 1686| End If 1687| End If 1688| 1689| If CBool(DlgValue("DProceedAction")) Then 1690| DlgEnable "actsi",True 1691| Else 1692| DlgEnable "actsi",False 1693| End If 1694| 1695| 1696| If CBool(DlgValue("DProceedICC")) Then 1697| DlgEnable "DTargetICCProfile",True 1698| Else 1699| DlgEnable "DTargetICCProfile",False 1700| End If 1701| If CBool(DlgValue("DassignICC")) Then 1702| DlgEnable "DassignICCProfile",True 1703| DlgEnable "DassignICCoverwrite",True 1704| Else 1705| DlgEnable "DassignICCProfile",False 1706| DlgEnable "DassignICCoverwrite",False 1707| End If 1708| 1709| If CBool(DlgValue("DProceedScaling")) Then 1710| DlgEnable "DTargetdpi",True 1711| DlgEnable "DNewSize",True 1712| Else 1713| DlgEnable "DTargetdpi",False 1714| DlgEnable "DNewSize",False 1715| End If 1716| 1717| 1718| If CBool(DlgValue("DNoCopy")) Or CBool(DlgValue("DAddNewImageToDB")) Then 1719| DlgEnable "DAddBookmarks",True 1720| Else 1721| DlgEnable "DAddBookmarks",False 1722| End If 1723| 1724| 1725| 'Initialize WorkflowClassCheckbox etc. 1726| If SG.Use_WorkFlow Then 1727| DlgText("CurCats",SetWorkflowDlgInfoText()) 1728| If (CBool(DlgValue("DNoCopy")) Or CBool(DlgValue("DAddNewImageToDB"))) Then 1729| DlgEnable "DAssignToCats",True 1730| If CBool(DlgValue("DAssignToCats")) Then 1731| DlgEnable "Btn_AssignToCats",True 1732| DlgEnable "CurCats",True 1733| Else 1734| DlgEnable "Btn_AssignToCats",False 1735| DlgEnable "CurCats",False 1736| End If 1737| Else 1738| DlgEnable "DAssignToCats",False 1739| DlgEnable "Btn_AssignToCats",False 1740| DlgEnable "CurCats",False 1741| End If 1742| Else 1743| DlgEnable "DAssignToCats",False 1744| DlgEnable "Btn_AssignToCats",False 1745| DlgEnable "CurCats",False 1746| DlgText("CurCats","") 1747| DlgValue("DAssignToCats",CBool(False)) 1748| End If 1749| 1750| 1751| 1752| Case 2 1753| Select Case DlgItem$ 1754| 1755| 1756| Case "Btn_Presets" 1757| 'SG.DlgMainRefresh = RegTreePreset.PresetDialog() 1758| 'If SG.DlgMainRefresh <= 0 Then Dlg_Initial_Func = True 1759| 1760| 1761| Case "DFindReplace" 1762| If CBool(DlgValue("DFindReplace")) Then 1763| DlgEnable "DNeedle",True 1764| DlgEnable "DReplaceStr",True 1765| Else 1766| DlgEnable "DNeedle",False 1767| DlgEnable "DReplaceStr",False 1768| End If 1769| Dlg_Initial_Func = True 1770| 1771| Case "DAssignToCats" 1772| If SuppValue& Then 1773| DlgEnable "Btn_AssignToCats",True 1774| DlgEnable "CurCats",True 1775| Else 1776| DlgEnable "Btn_AssignToCats",False 1777| DlgEnable "CurCats",False 1778| End If 1779| Dlg_Initial_Func = True 1780| 1781| Case "Btn_AssignToCats" 1782| WoFlo.GetChildNamesFromDialog 1783| DlgText("CurCats",SetWorkflowDlgInfoText()) 1784| Dlg_Initial_Func = True 1785| 1786| 1787| Case "Cancel" 1788| SG.DlgMainRefresh = CanceledByUser 1789| Dlg_Initial_Func = False 1790| Case "OK" 1791| SG.DlgMainRefresh = CanceledByUser 1792| Dlg_Initial_Func = False 1793| Case "DSimulation" 1794| SG.DlgMainRefresh = CanceledByUser 1795| SC.IsSimulation = True 1796| Dlg_Initial_Func = False 1797| 1798| 1799| Case "UpdateActions" 1800| Dim UpResult As VbMsgBoxResult 1801| UpResult = MsgBox("To update the List with your PhotoshopActions a Photoshop-Restart is required." & vbCr & "Do you want to update your List now?",vbYesNo + vbQuestion,"Listupdate Photoshopactions") 1802| If UpResult = vbYes Then 1803| PS_OLE_Close() 1804| PS_OLE_Start() 1805| ReDim PS_acts(500) 1806| PS_GetActionNames(PS_App,PS_acts) 1807| WriteListToFile(Actions.Listfile,PS_acts()) 1808| PS_acts = ReadListFromFile(Actions.Listfile) 1809| If Not IsValidStrArray(PS_acts()) Then MsgBox("Update has failed!" & vbNewLine & "Please cancel this Script and try it with a restart of Photoshop and Imatch",vbCritical,"Cannot get a valid Actionslist!") 1810| inf = GetAppInfoStructureFromPS() 1811| DlgText "ramusage","Photoshop MemoryUsage: """ & inf.MemoryUsagePercent & "%""" 1812| 'DlgText "ColorPrefs","Preferences > ColorSettings: """ & inf.ColorSettings & """" 1813| 'DlgEnable "DProceedAction",True 1814| DlgListBoxArray "actsi", PS_acts() 1815| DlgValue("actsi",0) 1816| End If 1817| Dlg_Initial_Func = True 1818| 1819| Case "DNoCopy" 1820| If CBool(SuppValue&) Then 1821| DlgEnable "DtransProp",False 1822| DlgEnable "DtransCat",False 1823| DlgEnable "DSimulation",False 1824| DlgEnable "UseDiffSubfolders",False 1825| DlgEnable "DSubTargetName",False 1826| DlgEnable "UseMainTargetFolder",False 1827| DlgEnable "DclearMainTarget",False 1828| DlgEnable "MTFtxt",False 1829| DlgEnable "DMainTargetFolder",False 1830| DlgEnable "BrowseMTF",False 1831| DlgEnable "DAppendStrToFN",False 1832| DlgEnable "DStrToFN",False 1833| DlgEnable "DSaveAsFiletype",False 1834| DlgEnable "DTargetFileFormat",False 1835| DlgEnable "outputgroup2",True 1836| DlgEnable "outputgroup1",False 1837| DlgEnable "outputgroup6",False 1838| 'DlgEnable "outputgroup7",False 1839| DlgEnable "Text8",False 1840| DlgEnable "Text3",False 1841| DlgEnable "Text3",False 1842| DlgEnable "Text7",False 1843| DlgEnable "Text10",False 1844| DlgEnable "ffparams",False 1845| 1846| DlgEnable "DAddNewImageToDB",False 1847| DlgEnable "DAddBookmarks",True 1848| 'Initialize WorkflowClassCheckbox etc. 1849| If SG.Use_WorkFlow Then 1850| DlgText("CurCats",SetWorkflowDlgInfoText()) 1851| If (CBool(DlgValue("DNoCopy")) Or CBool(DlgValue("DAddNewImageToDB"))) Then 1852| DlgEnable "DAssignToCats",True 1853| If CBool(DlgValue("DAssignToCats")) Then 1854| DlgEnable "Btn_AssignToCats",True 1855| DlgEnable "CurCats",True 1856| Else 1857| DlgEnable "Btn_AssignToCats",False 1858| DlgEnable "CurCats",False 1859| End If 1860| Else 1861| DlgEnable "DAssignToCats",False 1862| DlgEnable "Btn_AssignToCats",False 1863| DlgEnable "CurCats",False 1864| End If 1865| Else 1866| DlgEnable "DAssignToCats",False 1867| DlgEnable "Btn_AssignToCats",False 1868| DlgEnable "CurCats",False 1869| DlgText("CurCats","") 1870| DlgValue("DAssignToCats",CBool(False)) 1871| End If 1872| 1873| DlgEnable "DFindReplace",False 1874| DlgEnable "DNeedle",False 1875| DlgEnable "DReplaceStr",False 1876| 1877| 1878| Else 1879| 1880| DlgEnable "DFindReplace",True 1881| If CBool(DlgValue("DFindReplace")) Then 1882| DlgEnable "DNeedle",True 1883| DlgEnable "DReplaceStr",True 1884| Else 1885| DlgEnable "DNeedle",False 1886| DlgEnable "DReplaceStr",False 1887| End If 1888| 1889| DlgEnable "DAddNewImageToDB",True 1890| If CBool(DlgValue("DAddNewImageToDB")) Then 1891| DlgEnable "DAddBookmarks",True 1892| DlgEnable "DtransProp",True 1893| DlgEnable "DtransCat",True 1894| Else 1895| DlgEnable "DAddBookmarks",False 1896| DlgEnable "DtransProp",False 1897| DlgEnable "DtransCat",False 1898| End If 1899| 'Initialize WorkflowClassCheckbox etc. 1900| If SG.Use_WorkFlow Then 1901| DlgText("CurCats",SetWorkflowDlgInfoText()) 1902| If (CBool(DlgValue("DNoCopy")) Or CBool(DlgValue("DAddNewImageToDB"))) Then 1903| DlgEnable "DAssignToCats",True 1904| If CBool(DlgValue("DAssignToCats")) Then 1905| DlgEnable "Btn_AssignToCats",True 1906| DlgEnable "CurCats",True 1907| Else 1908| DlgEnable "Btn_AssignToCats",False 1909| DlgEnable "CurCats",False 1910| End If 1911| Else 1912| DlgEnable "DAssignToCats",False 1913| DlgEnable "Btn_AssignToCats",False 1914| DlgEnable "CurCats",False 1915| End If 1916| Else 1917| DlgEnable "DAssignToCats",False 1918| DlgEnable "Btn_AssignToCats",False 1919| DlgEnable "CurCats",False 1920| DlgText("CurCats","") 1921| DlgValue("DAssignToCats",CBool(False)) 1922| End If 1923| DlgEnable "DSimulation",True 1924| DlgEnable "ffparams",True 1925| DlgEnable "UseDiffSubfolders",True 1926| DlgEnable "UseMainTargetFolder",True 1927| DlgEnable "DSaveAsFiletype",True 1928| DlgEnable "DAppendStrToFN",True 1929| DlgEnable "outputgroup2",False 1930| DlgEnable "outputgroup1",True 1931| DlgEnable "outputgroup6",True 1932| 'DlgEnable "outputgroup7",True 1933| DlgEnable "Text3",True 1934| DlgEnable "Text8",True 1935| DlgEnable "Text7",True 1936| DlgEnable "Text10",True 1937| If DlgValue("DTargetType") = 0 Then 1938| DlgEnable "DSubTargetName",True 1939| DlgEnable "DMainTargetFolder",False 1940| DlgEnable "DclearMainTarget",False 1941| DlgEnable "MTFtxt",False 1942| DlgEnable "BrowseMTF",False 1943| Else 1944| DlgEnable "DSubTargetName",False 1945| DlgEnable "MTFtxt",True 1946| DlgEnable "BrowseMTF",True 1947| DlgEnable "DMainTargetFolder",True 1948| DlgEnable "DclearMainTarget",True 1949| End If 1950| If CBool(DlgValue("DAppendStrToFN")) Then 1951| DlgEnable "DStrToFN",True 1952| Else 1953| DlgEnable "DStrToFN",False 1954| End If 1955| If CBool(DlgValue("DSaveAsFiletype")) Then 1956| DlgEnable "DTargetFileFormat",True 1957| DlgText("ffparams",Reg.GetKey("ffinfo" & LCase(fileformatList(DlgValue("DTargetFileFormat"))))) 1958| DlgEnable "ffparams",True 1959| Else 1960| DlgEnable "DTargetFileFormat",False 1961| DlgEnable "ffparams",False 1962| End If 1963| End If 1964| Dlg_Initial_Func = True 1965| 1966| Case "DTargetType" 1967| If DlgValue("DTargetType") = 0 Then 1968| DlgEnable "DSubTargetName",True 1969| DlgEnable "DMainTargetFolder",False 1970| DlgEnable "DclearMainTarget",False 1971| DlgEnable "MTFtxt",False 1972| DlgEnable "BrowseMTF",False 1973| Else 1974| DlgEnable "DSubTargetName",False 1975| DlgEnable "MTFtxt",True 1976| DlgEnable "BrowseMTF",True 1977| DlgEnable "DMainTargetFolder",True 1978| DlgEnable "DclearMainTarget",True 1979| End If 1980| If CBool(DlgValue("DAppendStrToFN")) Then 1981| DlgEnable "DStrToFN",True 1982| Else 1983| DlgEnable "DStrToFN",False 1984| End If 1985| If CBool(DlgValue("DSaveAsFiletype")) Then 1986| DlgEnable "DTargetFileFormat",True 1987| Else 1988| DlgEnable "DTargetFileFormat",False 1989| End If 1990| Dlg_Initial_Func = True 1991| 1992| Case "DSaveAsFiletype" 1993| If CBool(SuppValue&) Then 1994| DlgEnable "DTargetFileFormat",True 1995| DlgText("ffparams",Reg.GetKey("ffinfo" & LCase(fileformatList(DlgValue("DTargetFileFormat"))))) 1996| DlgEnable "ffparams",True 1997| Else 1998| DlgEnable "DTargetFileFormat",False 1999| DlgEnable "ffparams",False 2000| End If 2001| Dlg_Initial_Func = True 2002| 2003| Case "DTargetFileFormat" 2004| DlgText("ffparams",Reg.GetKey("ffinfo" & LCase(fileformatList(DlgValue("DTargetFileFormat"))))) 2005| 2006| Case "DAppendStrToFN" 2007| If CBool(SuppValue&) Then 2008| DlgEnable "DStrToFN",True 2009| Else 2010| DlgEnable "DStrToFN",False 2011| End If 2012| Dlg_Initial_Func = True 2013| 2014| Case "DProceedAction" 2015| If CBool(SuppValue&) Then 2016| DlgEnable "actsi",True 2017| Else 2018| DlgEnable "actsi",False 2019| End If 2020| Dlg_Initial_Func = True 2021| 2022| Case "DProceedICC" 2023| If CBool(SuppValue&) Then 2024| DlgEnable "DTargetICCProfile",True 2025| Else 2026| DlgEnable "DTargetICCProfile",False 2027| End If 2028| Dlg_Initial_Func = True 2029| 2030| Case "DassignICC" 2031| If CBool(DlgValue("DassignICC")) Then 2032| DlgEnable "DassignICCProfile",True 2033| DlgEnable "DassignICCoverwrite",True 2034| Else 2035| DlgEnable "DassignICCProfile",False 2036| DlgEnable "DassignICCoverwrite",False 2037| End If 2038| Dlg_Initial_Func = True 2039| 2040| Case "DProceedScaling" 2041| If CBool(SuppValue&) Then 2042| DlgEnable "DTargetdpi",True 2043| DlgEnable "DNewSize",True 2044| Else 2045| DlgEnable "DTargetdpi",False 2046| DlgEnable "DNewSize",False 2047| End If 2048| Dlg_Initial_Func = True 2049| 2050| Case "DAddNewImageToDB" 2051| If CBool(SuppValue&) Then 2052| DlgEnable "DAddBookmarks",True 2053| DlgEnable "DtransProp",True 2054| DlgEnable "DtransCat",True 2055| 'Initialize WorkflowClassCheckbox etc. 2056| If SG.Use_WorkFlow Then 2057| DlgEnable "DAssignToCats",True 2058| If CBool(DlgValue("DAssignToCats")) Then 2059| DlgEnable "Btn_AssignToCats",True 2060| DlgEnable "CurCats",True 2061| Else 2062| DlgEnable "Btn_AssignToCats",False 2063| DlgEnable "CurCats",False 2064| End If 2065| End If 2066| Else 2067| DlgEnable "DAddBookmarks",False 2068| DlgEnable "DtransProp",False 2069| DlgEnable "DtransCat",False 2070| 'Initialize WorkflowClassCheckbox etc. 2071| If SG.Use_WorkFlow Then 2072| DlgEnable "DAssignToCats",False 2073| DlgEnable "DAssignToCats",False 2074| DlgEnable "Btn_AssignToCats",False 2075| DlgEnable "CurCats",False 2076| End If 2077| End If 2078| Dlg_Initial_Func = True 2079| 2080| Case "BrowseMTF" 2081| Dim p As String 2082| p = Application.BrowseForFolder(DlgText("DMainTargetFolder"),"Select the MainTargetFolder for your converted files") 2083| DlgText("DMainTargetFolder",p) 2084| Dlg_Initial_Func = True 2085| 2086| Case "Btn_showLog" 2087| 'opens the Logfile 2088| If hn_FileExists(Logg.FName) Then 2089| Application.ShellExecute("open",Logg.FName) 2090| Else 2091| MsgBox "There doesn't already exist a logfile!" & vbNewLine & "(" & Logg.FName & ")" 2092| End If 2093| Dlg_Initial_Func = True 2094| 2095| Case "FFOptions" 2096| 'open the SetupDialog 2097| Dlg_FileFormat() 2098| DlgText("ffparams",Reg.GetKey("ffinfo" & LCase(fileformatList(DlgValue("DTargetFileFormat"))))) 2099| Dlg_Initial_Func = True 2100| 2101| Case "GlobalOptions" 2102| 'open the SetupDialog 2103| Dlg_Global() 2104| Dlg_Initial_Func = True 2105| 2106| Case "ICCOptions" 2107| 'Store the current selected ListItem 2108| Dim starti As Integer, starttxt As String 2109| starti = DlgValue("DTargetICCProfile") 2110| If starti > -1 Then 2111| starttxt = iccList(starti) 2112| Else 2113| starttxt = "leeresArray" 2114| End If 2115| starti = -1 2116| 2117| Dim starti2 As Integer, starttxt2 As String 2118| starti2 = DlgValue("DassignICCProfile") 2119| If starti2 > -1 Then 2120| starttxt2 = iccList(starti2) 2121| Else 2122| starttxt2 = "leeresArray" 2123| End If 2124| starti2 = -1 2125| 2126| 'open the SetupDialog 2127| Dlg_ICC() 2128| 2129| 'look for old selected Item in new Array 2130| If UBound(iccList) >= 0 Then 2131| For k = 0 To UBound(iccList) 2132| If iccList(k) = starttxt Then starti = k 2133| If iccList(k) = starttxt2 Then starti2 = k 2134| Next 2135| End If 2136| 2137| 'refresh the Listbox 2138| DlgListBoxArray "DTargetICCProfile", iccList() 2139| If starti > -1 Then 2140| DlgValue("DTargetICCProfile",starti) 2141| Reg.SaveKey("TargetICCProfile",iccList(starti)) 2142| Reg.SaveKey("TargetICCProfile_ListID",starti,AsByte) 2143| Else 2144| DlgValue("DTargetICCProfile",0) 2145| Reg.SaveKey("TargetICCProfile","") 2146| Reg.SaveKey("TargetICCProfile_ListID",0,AsByte) 2147| End If 2148| DlgListBoxArray "DassignICCProfile", iccList() 2149| If starti2 > -1 Then 2150| DlgValue("DassignICCProfile",starti2) 2151| Reg.SaveKey("assignICCProfile",iccList(starti2)) 2152| Reg.SaveKey("assignICCProfile_ListID",starti2,AsByte) 2153| Else 2154| DlgValue("DassignICCProfile",0) 2155| Reg.SaveKey("assignICCProfile","") 2156| Reg.SaveKey("assignICCProfile_ListID",0,AsByte) 2157| End If 2158| Dlg_Initial_Func = True 2159| 2160| Case "scriptinfo" 2161| Dim retErrStr As String 2162| SC.CurrentProcess = False 2163| retErrStr = hn_showInfo() 2164| If Not SC.CurrentProcess Then MsgBox retErrStr 2165| SC.CurrentProcess = False 2166| Dlg_Initial_Func = True 2167| 2168| End Select 2169| End Select 2170| 2171| End Function 2172| 2173| 2174| Private Function Dlg_ICC_Func(DlgItem$, Action%, SuppValue&) As Boolean 2175| 2176| Dim k As Integer 2177| 2178| Select Case Action% 2179| 'Case 1 2180| 'If Len(Clipboard$()) <= 62 Then DlgText("ICCNewProfile",Clipboard$()) 2181| 2182| Case 2 ' Value changing or button pressed 2183| Select Case DlgItem$ 2184| 2185| Case "Cancel" 2186| Dlg_ICC_Func = False 2187| Case "OK" 2188| Dlg_ICC_Func = False 2189| 2190| Case "scriptinfo" 2191| Dim retErrStr As String 2192| SC.CurrentProcess = False 2193| retErrStr = hn_showInfo() 2194| If Not SC.CurrentProcess Then MsgBox retErrStr 2195| SC.CurrentProcess = False 2196| Dlg_ICC_Func = True 2197| 2198| Case "ICCinfo" 2199| Dim infomsg As String 2200| infomsg = "Because we have not found a proper way to get" & vbNewLine & "the list of ICC-profiles out of Photoshop," & vbNewLine & "you have to create your list yourself." & vbNewLine & vbNewLine & "To add a ICC-profile you must type it's name to the list" & vbNewLine & "as it appears in Photoshopdialogs!" 2201| MsgBox infomsg,vbInformation,"Why and how you must Setup the ICC-list" 2202| Dlg_ICC_Func = True 2203| 2204| Case "ICCEditorRefresh" 2205| 'refresh the Listbox 2206| iccList = ReadListFromFile(ICC.iccListFile) 2207| If Not IsValidStrArray(iccList) Then MsgBox "Error creating ICC-inifile: " & ICC.iccListFile 2208| DlgListBoxArray "ICCListBox", iccList() 2209| DlgValue("ICCListBox",UBound(iccList)) 2210| Dlg_ICC_Func = True 2211| 2212| Case "ICCEditor" 2213| 'opens the ICC.iccListFile with external editor 2214| Dim editRes As Long 2215| editRes = Application.ShellExecute ("open","""" & ICC.iccListFile & """") 2216| If editRes <= 32 Then 2217| editRes = Application.ShellExecute ("edit","""" & ICC.iccListFile & """") 2218| If editRes <= 32 Then 2219| ' Not associated with an application. Use Notepad 2220| Shell "notepad.exe """ & ICC.iccListFile & """",vbNormalFocus 2221| End If 2222| End If 2223| Dlg_ICC_Func = True 2224| 2225| Case "ICCReset" 2226| Dim newlist(5) As String 2227| newlist(0) = "Adobe RGB (1998)" 2228| newlist(1) = "Apple RGB" 2229| newlist(2) = "sRGB IEC61966-2.1" 2230| newlist(3) = "ECI-RGB.icc" 2231| newlist(4) = "Offset_Bilderdruck.icc" 2232| WriteListToFile(ICC.iccListFile,newlist()) 2233| iccList = ReadListFromFile(ICC.iccListFile) 2234| If Not IsValidStrArray(iccList) Then MsgBox "Error creating ICC-inifile: " & ICC.iccListFile 2235| 'refresh the Listbox 2236| DlgListBoxArray "ICCListBox", iccList() 2237| DlgValue("ICCListBox",UBound(iccList)) 2238| Dlg_ICC_Func = True 2239| 2240| Case "ICCAddNew" 2241| If Trim$(DlgText("ICCNewProfile")) <> "" Then 2242| ReDim Preserve iccList(UBound(iccList)) 2243| iccList(UBound(iccList)) = Trim$(DlgText("ICCNewProfile")) 2244| WriteListToFile(ICC.iccListFile,iccList()) 2245| iccList = ReadListFromFile(ICC.iccListFile) 2246| If Not IsValidStrArray(iccList) Then MsgBox "Error creating ICC-inifile: " & ICC.iccListFile 2247| DlgText("ICCNewProfile","") 2248| 'refresh the Listbox 2249| DlgListBoxArray "ICCListBox", iccList() 2250| DlgValue("ICCListBox",UBound(iccList)) 2251| 'Clipboard$ "" 2252| End If 2253| Dlg_ICC_Func = True 2254| 2255| Case "ICCRemoveOne" 2256| If Not DlgValue("ICCListBox") = -1 Then 2257| Dim tmp() As String, i As Integer 2258| i = 0 2259| ReDim tmp(UBound(iccList)) 2260| 2261| For k = 0 To UBound(iccList) 2262| If iccList(k) <> iccList(DlgValue("ICCListBox")) Then 2263| tmp(i) = iccList(k) 2264| i = i + 1 2265| End If 2266| Next 2267| Erase iccList 2268| iccList = tmp() 2269| WriteListToFile(ICC.iccListFile,iccList()) 2270| iccList = ReadListFromFile(ICC.iccListFile) 2271| If Not IsValidStrArray(iccList) Then MsgBox "Error creating ICC-inifile: " & ICC.iccListFile 2272| 'refresh the Listbox 2273| DlgListBoxArray "ICCListBox", iccList() 2274| DlgValue("ICCListBox",0) 2275| End If 2276| Dlg_ICC_Func = True 2277| 2278| End Select 2279| End Select 2280| End Function 2281| 2282| 2283| Private Function Dlg_FileFormat_Func(DlgItem$, Action%, SuppValue&) As Boolean 2284| 2285| 'Select Case Action% 2286| 'Case 1 2287| 2288| 'Case 2 2289| Select Case DlgItem$ 2290| 2291| Case "scriptinfo" 2292| Dim retErrStr As String 2293| SC.CurrentProcess = False 2294| retErrStr = hn_showInfo() 2295| If Not SC.CurrentProcess Then MsgBox retErrStr 2296| SC.CurrentProcess = False 2297| Dlg_FileFormat_Func = True 2298| 2299| End Select 2300| 'End Select 2301| 2302| End Function 2303| 2304| 2305| 2306| '''' Helpfunctions '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 2307| 2308| Private Function CheckSetup() As Boolean 2309| 2310| Dim Glob As String, File As String, ICC As String 2311| 2312| Glob = RegSetup.GetKey("Dlg_Global") 2313| File = RegSetup.GetKey("Dlg_FileFormat") 2314| ICC = RegSetup.GetKey("Dlg_ICC") 2315| 2316| If Glob = "" Or File = "" Or ICC = "" Then 2317| If MsgBox("To work with that Script, you have to Setup some Options first." & vbNewLine & vbNewLine & _ 2318| "Now you will see 3 DialogWindows in which you can choose Options." & vbNewLine & _ 2319| "Please Quit each of them with OK!" & vbNewLine & vbNewLine & _ 2320| "You can refer in every Dialog to a Button [ScriptInfo] to get some Information about Options." & vbNewLine & vbNewLine & _ 2321| "Please read the section about the ICC-ProfileList." & vbNewLine & _ 2322| "You have to create your own list if you want to work with Profiles!" & vbNewLine & vbNewLine & _ 2323| "Finally the MainDialog opens, from which you also can access the first 3 Dialogs at everytime.", _ 2324| vbOkCancel + vbInformation,"Setup Options") = vbCancel Then 2325| SC.IsCanceld = True 2326| Exit Function 2327| Else 2328| If File = "" Or Not SC.isLooped Then Dlg_FileFormat() 2329| If Glob = "" Or Not SC.isLooped Then Dlg_Global() 2330| If ICC = "" Or Not SC.isLooped Then Dlg_ICC() 2331| Glob = RegSetup.GetKey("Dlg_Global") 2332| File = RegSetup.GetKey("Dlg_FileFormat") 2333| ICC = RegSetup.GetKey("Dlg_ICC") 2334| SC.isLooped = True 2335| End If 2336| End If 2337| 2338| If Glob = "X" And File = "X" And ICC = "X" Then CheckSetup = True 2339| 2340| End Function 2341| 2342| 2343| Private Function OverwriteConfirmation(ByVal SelIm As Integer) As VbMsgBoxResult 2344| 2345| Dim TheOptions As String, TheMessage As String 2346| 2347| TheOptions = OptionSummary 2348| 2349| TheMessage = "You have selected " & SelIm & " Images! ..." & Chr(13) & Chr(13) & _ 2350| "...with these Options:" & Chr(13) & Chr(13) & TheOptions & _ 2351| "You've choosed to OVERWRITE your original Images and not to save the result to a Copy!" & Chr(13) & _ 2352| "Are you really sure you want do that?" 2353| 2354| OverwriteConfirmation = MsgBox(TheMessage, vbYesNo + vbDefaultButton2, "OVERWRITE original files?") 2355| 2356| End Function 2357| 2358| Private Function OptionSummary() As String 2359| 2360| Dim TheOptions As String, ToCats As String 2361| 2362| If (DBU.AddNewImageToDB And Not Gdoc.NoCopy) Or DBU.BookmarkToImage Or (DBU.AssignToWorkflowCats And SG.Use_WorkFlow) Then 2363| ToCats = "# Selected-Database-Updates:" & vbNewLine 2364| If DBU.AddNewImageToDB And Not Gdoc.NoCopy Then ToCats = ToCats & "-Add new images to Database" & vbNewLine 2365| If DBU.BookmarkToImage Then ToCats = ToCats & "-Bookmark images" & vbNewLine 2366| If SG.Use_WorkFlow And DBU.AssignToWorkflowCats Then 2367| Dim wfc As WorkflowChildCatObject 2368| Dim wfp As WorkflowParentCatObject 2369| Dim wfr As WorkflowRetoucheObject 2370| wfp = WoFlo.GetParentNames 2371| wfc = WoFlo.GetChildNamesFromRegistry 2372| wfr = WoFlo.GetRetoucheCats 2373| ToCats = ToCats & wfp.JobticketParentName & "=" & wfc.AssignTo_JOBTICKET & vbNewLine 2374| ToCats = ToCats & wfp.EditstateParentName & "=" & wfc.AssignTo_EDITSTATE & vbNewLine 2375| If wfr.IsInUse Then 2376| If wfr.AssignToA Then ToCats = ToCats & " " & wfr.ChildAName & vbNewLine 2377| If wfr.AssignToB Then ToCats = ToCats & " " & wfr.ChildBName & vbNewLine 2378| If wfr.AssignToC Then ToCats = ToCats & " " & wfr.ChildCName & vbNewLine 2379| End If 2380| ToCats = ToCats & wfp.ColorspaceParentName & "=" & wfc.AssignTo_COLORSPACE & vbNewLine 2381| ToCats = ToCats & wfp.BitrateParentName & "=" & wfc.AssignTo_BITRATE & vbNewLine 2382| End If 2383| ToCats = ToCats & vbNewLine 2384| End If 2385| 2386| If ICC.assignICC Or ICC.ProceedICC Or Edit.ProceedScaling Or Actions.ProceedAction Then 2387| TheOptions = "# Selected-Image-Manipulations:" & vbNewLine 2388| If ICC.assignICC Then TheOptions = TheOptions & "Assign ICC-Profile: " & ICC.assignICCProfile & vbNewLine 2389| If ICC.ProceedICC Then TheOptions = TheOptions & "Convert to ICC-Profile: " & ICC.TargetICCProfile & vbNewLine 2390| If Edit.ProceedScaling Then TheOptions = TheOptions & "Scale Image to NewSize [" & Edit.NewSize & "] with dpiSetting [" & Edit.Targetdpi & "]" & vbNewLine 2391| If Actions.ProceedAction Then TheOptions = TheOptions & "Play Photoshop-Action: " & Actions.ActionName & vbNewLine 2392| End If 2393| 2394| If TheOptions = "" Then TheOptions = "No Imagemanipulations are selected." & vbNewLine & "But the current Settings from FileFormat-Dialog will apply to the Images!" & vbNewLine 2395| TheOptions = TheOptions & vbNewLine & "# FileFormatOptions:" & vbNewLine & "jpg=" & ffinfo.jpg & vbNewLine & "tif=" & ffinfo.tif & vbNewLine & "eps=" & ffinfo.eps & vbNewLine & "psd=" & ffinfo.psd & vbNewLine & "png=" & ffinfo.png & vbNewLine & "gif=" & ffinfo.gif & vbNewLine & "Global=" & ffinfo.globl & vbNewLine & vbNewLine 2396| 2397| OptionSummary = TheOptions & ToCats 2398| 2399| End Function 2400| 2401| Private Function SetWorkflowDlgInfoText() As String 2402| SetWorkflowDlgInfoText = "JobTicket: " & WoFlo.GetChildNamesFromRegistry.AssignTo_JOBTICKET & vbNewLine & _ 2403| "Editstate: " & WoFlo.GetChildNamesFromRegistry.AssignTo_EDITSTATE & vbNewLine & _ 2404| "Colorspace: " & WoFlo.GetChildNamesFromRegistry.AssignTo_COLORSPACE & vbNewLine & _ 2405| "Bitrate: " & WoFlo.GetChildNamesFromRegistry.AssignTo_BITRATE 2406| End Function 2407| 2408| 2409| Private Function hn_showInfo() As String 2410| 2411| Dim infohtml As String 2412| Dim WindowTitle As String 2413| WindowTitle = "Using Adobe Photoshop with IMatch via OLE" 2414| 2415| SC.CurrentProcess = True 2416| On Error Resume Next 2417| AppActivate Left$(WindowTitle,15) 2418| 'MsgBox CStr(Err.Number) 2419| If Err.Number Then 2420| SC.CurrentProcess = False 2421| Dim FN As Integer 2422| FN = FreeFile 2423| infohtml = Environ("TEMP") & "\ScriptInfo_using_Photoshop_with_IMatch_via_OLE.htm" 2424| Open infohtml For Output As #FN 2425| Print #FN, "<html>" 2426| Print #FN, "<head>" 2427| Print #FN, "<title>" & WindowTitle & "</title>" 2428| Print #FN, "<meta http-equiv=""Content-Type"" content=""Text/html; charset=windows-1252"">" 2429| Print #FN, "<style type=""Text/css"">" 2430| Print #FN, "<!--" 2431| Print #FN, "h2 { font-family: Verdana, Arial, Helvetica, sans-serif; font-size: large; font-style: normal; font-weight: bold; text-decoration: underline}" 2432| Print #FN, "p { font-family: Arial, Helvetica, sans-serif; font-size: medium; font-style: normal}" 2433| Print #FN, "-->" 2434| Print #FN, "</style>" 2435| Print #FN, "</head>" 2436| Print #FN, "<body bgcolor=""#DDDDDD"" text=""#333333"" link=""#0099CC"" vlink=""#339999"" alink=""#0099CC"" leftmargin=20 topmargin=20 marginwidth=20 marginheight=20> 2437| Print #FN, "<h2>" & WindowTitle & "</h2>" 2438| Print #FN, "<p>Here will be a short explanation in the final version.</p>" 2439| Print #FN, "<p>And also the link to my IMatch ScriptSection:<br>" 2440| Print #FN, "<a href=" & Chr(34) & "http://horst.nogajski.de/imatch/index.php?show=PhotoshopConversion&sub=psole.explanation.inc.php#Show" & Chr(34) & ">very good Explanation ;)</a></p>" 2441| Print #FN, "</body>" 2442| Print #FN, "</html>" 2443| Close #FN 2444| 2445| Dim SinnDesLebens As Variant 2446| SinnDesLebens = Application.ShellExecute("open",infohtml) 2447| 2448| If CInt(SinnDesLebens) = 42 Then 2449| SC.CurrentProcess = True 2450| Else 2451| Wait 2 2452| On Error Resume Next 2453| AppActivate Left$(WindowTitle,15) 2454| If Err.Number Then hn_showInfo = "Have tried to display an info-html-document with your MainHTML-Browser" & Chr(13) & Chr(13) & "Seems that this won't work." & Chr(13) & "The file was generated here: " & Chr(13) & " < " & infohtml & " >" 2455| End If 2456| 2457| End If 2458| 2459| End Function 2460| 2461| 2462| Private Function BuildProperPath(ByVal Mainfolder As String, Optional ByVal Subfolder As String, Optional MakeDir As Boolean = False) As String 2463| 2464| SC.CurrentProcess = False 2465| DoDbgMsg(medium,"BuildProperPath",FunctionEntry,"Mainfolder: " & Mainfolder & Chr(13) & "Subfolder: " & Subfolder & Chr(13) & Chr(13) & "MakeDir: " & MakeDir)'DebugMessage 2466| 2467| BuildProperPath = hn_BuildFolderStr(Mainfolder, Subfolder) 2468| SC.CurrentProcess = True 2469| 2470| 2471| If MakeDir Then 2472| SC.CurrentProcess = False 2473| If CreateTargetDir(BuildProperPath) Then SC.CurrentProcess = True 2474| End If 2475| 2476| End Function 2477| 2478| 2479| Private Function CreateTargetStrings(ByVal ImageFN As String) As String 2480| 2481| CreateTargetStrings = "" 2482| 2483| Dim s As FileStrObj, t As FileStrObj 2484| 2485| s = hn_FileStrObject(ImageFN) 2486| t = s 2487| 2488| Sdoc.SourceFileName = s.PathFull 2489| Sdoc.SourceFileFormat = s.FType 2490| Sdoc.Sourcefolder = s.PathWithDrive 2491| Sdoc.SourceBaseName = s.FBasename 2492| 2493| 2494| If Gdoc.NoCopy Then 2495| 2496| Sdoc.TargetFileName = s.PathFull 2497| Sdoc.TargetFileFormat = s.FType 2498| Sdoc.TargetBaseName = s.FBasename 2499| Sdoc.TargetFolder = s.PathWithDrive 2500| 2501| Else 2502| 2503| ' Build the TargetPath-String, 2504| ' Check Targetfolder [and create it if it not exists] 2505| If Gdoc.TargetType = 1 Then 2506| t.PathWithDrive = BuildProperPath(Gdoc.MainTargetFolder,"",True) 2507| If Not SC.CurrentProcess Then 2508| CreateTargetStrings = "Was not able to find/create the Targetfolder:" & Chr(13) & t.PathWithDrive 2509| GoTo Exit_ 2510| End If 2511| ElseIf Gdoc.TargetType = 0 Then 2512| t.PathWithDrive = BuildProperPath(Sdoc.Sourcefolder,Gdoc.SubTargetName,True) 2513| If Not SC.CurrentProcess Then 2514| CreateTargetStrings = "Was not able to find/create the Targetfolder:" & Chr(13) & t.PathWithDrive 2515| GoTo Exit_ 2516| End If 2517| Else 2518| CreateTargetStrings = "An Error has occured!" & Chr(13) & Chr(13) & "Don't know where to save the Targetfiles!" 2519| GoTo Exit_ 2520| End If 2521| 2522| If CBool(Gdoc.SaveAsFiletype) Then t.FType = Reg.GetKey("TargetFileFormat") 2523| If CBool(Gdoc.FindReplace) And Trim$(Gdoc.Needle) <> "" Then t.FName = DoReplaceStr(s.FName, Gdoc.Needle, Gdoc.ReplaceStr) 2524| t.FBasename = t.FName & "." & t.FType 2525| If CBool(Gdoc.AppendStrToFN) Then t.FBasename = AppendStringToFilename(t.FBasename, Gdoc.StrToFN) 2526| 2527| End If 2528| 2529| Sdoc.TargetFileFormat = t.FType 2530| Sdoc.TargetFolder = t.PathWithDrive 2531| Sdoc.TargetFileName = t.PathWithDrive & t.FBasename 2532| Sdoc.TargetBaseName = t.FBasename 2533| 2534| Exit_: 2535| 2536| End Function 2537| 2538| 2539| Public Function CreateTargetDir(ByVal TheLongDirName As String) As Boolean 2540| 2541| CreateTargetDir = False 2542| 2543| If hn_FileExists(TheLongDirName,vbDirectory) Then 2544| 'The TargetDirectory already exists 2545| CreateTargetDir = True 2546| 2547| Else 2548| 2549| 'Loginformation 2550| DoDbgMsg(medium,"CreateTargetDir",FunctionEntry,"Directory does not exist: " & TheLongDirName)'DebugMessage 2551| If Logg.Create Then Logg.Cache = Logg.Cache & "INFO! (" & Now & ")" & " - Directory does not exist: " & TheLongDirName & vbNewLine 2552| 2553| 'The Targetdirectory does not exist we try to create it 2554| SC.PS_FuncResult = hn_MkDir(TheLongDirName) 2555| If SC.PS_FuncResult <> "" Then 2556| 'hn_MkDir has failed 2557| DoDbgMsg(medium,"CreateTargetDir",FunctionExit,SC.PS_FuncResult)'DebugMessage 2558| If Logg.Create Then Logg.Cache = Logg.Cache & "ERROR! (" & Now & ")" & vbNewLine & SC.PS_FuncResult & vbNewLine 2559| Else 2560| 'Success! 2561| CreateTargetDir = True 2562| DoDbgMsg(medium,"CreateTargetDir",FunctionExit,"MkDir " & TheLongDirName & ": Success!")'DebugMessage 2563| If Logg.Create Then Logg.Cache = Logg.Cache & "INFO! (" & Now & ")" & " - hn_MkDir " & TheLongDirName & " = Success!" & vbNewLine 2564| End If 2565| End If 2566| 2567| Exit_: 2568| Exit Function 2569| 2570| Err_: 2571| Resume Exit_ 2572| 2573| End Function 2574| 2575| 2576| Private Function MyPrefsArray(Optional DoDebugOutput As Boolean = False) As String 2577| 2578| Dim AllKeys() As String 2579| Dim I As Integer 2580| 2581| AllKeys = Reg.GiveKeyArray() 2582| 2583| If DoDebugOutput Then Debug.Print vbNewLine; vbNewLine; "############ (" & Now & ") ############"; vbNewLine; vbNewLine; "RegistrySettings:"; vbNewLine; vbNewLine; 2584| For I = LBound(AllKeys) To UBound(AllKeys) 2585| MyPrefsArray = MyPrefsArray & AllKeys(I) & vbNewLine 2586| If DoDebugOutput Then Debug.Print AllKeys(I) 2587| Next I 2588| 2589| End Function 2590| 2591| 2592| Private Function AddToLogfileCache(ByVal msg As String, Optional msgType As LogfileInfoType = ERRORS, Optional addFileNames As Boolean = True) 2593| 2594| If Logg.Create And ((Logg.onlyErrors And msgType = ERRORS) Or Not Logg.onlyErrors) Then 2595| 2596| Dim TheInformation As String 2597| Dim IType As String 2598| Select Case msgType 2599| Case ERRORS 2600| IType = "ERROR!" 2601| Case INFOS 2602| IType = "INFO!" 2603| End Select 2604| TheInformation = IType & " (" & Now & ")" & vbNewLine 2605| If addFileNames Then TheInformation = TheInformation & "SourceFilename: " & Sdoc.SourceFileName & vbNewLine & "TargetFilename: " & Sdoc.TargetFileName 2606| TheInformation = TheInformation & msg & vbNewLine 2607| 2608| Logg.Cache = Logg.Cache & TheInformation 2609| 2610| End If 2611| 2612| End Function 2613| 2614| 2615| Private Sub FlushLogfileCache(Optional ByRef Overwrite As Boolean = False) 2616| 2617| If Logg.Cache <> "" Then 2618| Dim intFN As Integer 2619| intFN = FreeFile 2620| If Overwrite Then 2621| Open Logg.FName For Output As #intFN 2622| Else 2623| Open Logg.FName For Append As #intFN 2624| End If 2625| Print #intFN, Logg.Cache 2626| Print #intFN, "------------" 2627| Close #intFN 2628| Logg.Cache = "" 2629| End If 2630| 2631| End Sub 2632| 2633| 2634| Private Function HandleOfflineImage(NewTargetTypeFilename As String) As String 2635| 2636| HandleOfflineImage = "" 2637| 2638| Dim bm As New IMBitmap 2639| bm.Resize(150,150) 2640| bm.Fill(RGB(128,0,0)) 2641| Dim msg As String 2642| msg = "X" 2643| Dim fnt As New IMFont 2644| fnt.FaceName = "Arial" 2645| fnt.Color = RGB(0,0,0) 2646| fnt.Size = 60 2647| bm.DrawText(msg,fnt,imfaCenter,imfaMiddle,0,0,150,150) 2648| Set fnt = Nothing 2649| bm.SaveFile(NewTargetTypeFilename,IMatch.imbfJPEG24Standard) 2650| Set bm = Nothing 2651| 2652| If Logg.Create Then Logg.Cache = Logg.Cache & "ERROR! (" & Now & ")" & vbNewLine & "SourceFilename: " & Sdoc.SourceFileName & vbNewLine & "TargetFilename: " & Sdoc.TargetFileName & vbNewLine & "Image is Offline! Placeholder created > " & NewTargetTypeFilename & vbNewLine 2653| 2654| End Function 2655| 2656| 2657| Private Sub PS_GetPrefs 2658| 2659| 'FileSaveOptions 2660| ffglobal.LowerCase = Reg.GetKey("GFSO_LowerCase",True) 2661| ffglobal.EmbedProfiles = Reg.GetKey("GFSO_EmbedProfiles",True) 2662| 2663| ffjpg.quality = Reg.GetKey("jpgQualitaet",12) 2664| ffjpg.optimized = Reg.GetKey("jpgOptimized",False) 2665| ffjpg.scans = Reg.GetKey("jpgScans",0) 2666| 2667| If CBool(Reg.GetKey("tifMac")) Then 2668| fftif.byteorder = phEnumMacintosh 2669| Else 2670| fftif.byteorder = phEnumWindows 2671| End If 2672| If CBool(Reg.GetKey("tifLZW")) Then 2673| fftif.LZW = True 2674| Else 2675| fftif.LZW = False 2676| End If 2677| 2678| ffeps.Preview = Reg.GetKey("epsPreview", phEnumTIFF) 2679| ffeps.Depth = Reg.GetKey("epsDepth", phEnum8BitsPerPixel) 2680| ffeps.Encoding = Reg.GetKey("epsEncoding", phEnumBinary) 2681| ffeps.EncodingJPEGQuality = Reg.GetKey("epsEncodingJPEGQuality", phEnumMaximumQuality) 2682| 2683| ffinfo.globl = Reg.GetKey("ffinfoglobl") 2684| ffinfo.psd = Reg.GetKey("ffinfopsd") 2685| ffinfo.tif = Reg.GetKey("ffinfotif") 2686| ffinfo.jpg = Reg.GetKey("ffinfojpg") 2687| ffinfo.eps = Reg.GetKey("ffinfoeps") 2688| ffinfo.png = Reg.GetKey("ffinfopng") 2689| ffinfo.gif = Reg.GetKey("ffinfogif") 2690| 2691| 2692| 'Global Scriptoptions 2693| SG.Use_WorkFlow = Reg.GetKey("Use_WorkFlow") 2694| SG.NoPS_Palettes = Reg.GetKey("NoPS_palettes",False) 2695| SG.openLog = Reg.GetKey("openLog",False) 2696| SG.closeApp = Reg.GetKey("closeApp",False) 2697| SG.ShutDownWin = Reg.GetKey("ShutDownWin",False) 2698| SG.PowerUser = Reg.GetKey("PowerUser") 2699| 2700| 2701| OLE_TimeOut = Reg.GetKey("OLE_TimeOut",CLng(180000)) 2702| 2703| 2704| 'LogfileVars 2705| Logg.Create = Reg.GetKey("LogCreate",True) 2706| Logg.onlyErrors = Reg.GetKey("LogOnlyErrors",False) 2707| Logg.FName = Reg.GetKey("LogFileName",Environ("Temp") & "\Imatch_PS_OLE_Logg.txt") 2708| Logg.Overwrite = Reg.GetKey("LogOverwrite",False) 2709| 2710| 2711| 'Document- and ConversionOptions 2712| Gdoc.TargetType = Reg.GetKey("TargetType") 2713| Gdoc.SubTargetName = Reg.GetKey("SubTargetName") 2714| Gdoc.MainTargetFolder = Reg.GetKey("MainTargetFolder") 2715| Gdoc.clearMainTarget = Reg.GetKey("clearMainTarget") 2716| Gdoc.NoCopy = Reg.GetKey("NoCopy") 2717| Gdoc.SaveAsFiletype = Reg.GetKey("SaveAsFiletype") 2718| 2719| Gdoc.AppendStrToFN = Reg.GetKey("AppendStrToFN") 2720| 2721| Gdoc.StrToFN = Reg.GetKey("StrToFN") 2722| Gdoc.FindReplace = Reg.GetKey("FindReplace") 2723| Gdoc.Needle = Reg.GetKey("Needle") 2724| Gdoc.ReplaceStr = Reg.GetKey("ReplaceStr") 2725| 2726| Sdoc.TargetFileFormat = Reg.GetKey("TargetFileFormat") 2727| 2728| 2729| Edit.ProceedScaling = Reg.GetKey("ProceedScaling") 2730| Edit.NewSize = Reg.GetKey("NewSize") 2731| Edit.Targetdpi = Reg.GetKey("Targetdpi") 2732| 2733| 2734| ICC.assignICC = Reg.GetKey("assignICC") 2735| ICC.assignICCoverwrite = Reg.GetKey("assignICCoverwrite") 2736| ICC.assignICCProfile = Reg.GetKey("assignICCProfile") 2737| ICC.ProceedICC = Reg.GetKey("ProceedICC") 2738| ICC.TargetICCProfile = Reg.GetKey("TargetICCProfile") 2739| 2740| Actions.ProceedAction = Reg.GetKey("ProceedAction") 2741| Actions.ActionName = Reg.GetKey("ActionName") 2742| 2743| 2744| DBU.AddNewImageToDB = Reg.GetKey("AddNewImageToDB") 2745| DBU.BookmarkToImage = Reg.GetKey("AddBookmarks",True) 2746| DBU.AssignToWorkflowCats = Reg.GetKey("AssignToCats",False) 2747| 2748| 2749| End Sub 2750| 2751| 2752| 2753| '### FunctionList: 2754| ' - Private Function AddToLogfileCache(ByVal msg As String, Optional msgType As LogfileInfoType = ERRORS, Optional addFileNames As Boolean = True) 2755| ' - Private Function BuildProperPath(ByVal Mainfolder As String, Optional ByVal Subfolder As String, Optional MakeDir As Boolean = False) As String 2756| ' - Private Function CheckSetup() As Boolean 2757| ' - Private Function CreateTargetStrings(ByVal ImageFN As String) As String 2758| ' - Private Function Dlg_FileFormat() As Boolean 2759| ' - Private Function Dlg_FileFormat_Func(DlgItem$, Action%, SuppValue&) As Boolean 2760| ' - Private Function Dlg_Global() As Boolean 2761| ' - Private Function Dlg_Global_Func(DlgItem$, Action%, SuppValue&) As Boolean 2762| ' - Private Function Dlg_ICC() As Boolean 2763| ' - Private Function Dlg_ICC_Func(DlgItem$, Action%, SuppValue&) As Boolean 2764| ' - Private Function Dlg_Initial(SelImgs As Integer) As Boolean 2765| ' - Private Function Dlg_Initial_Func(DlgItem$, Action%, SuppValue&) As Boolean 2766| ' - Private Function HandleOfflineImage(NewTargetTypeFilename As String) As String 2767| ' - Private Function MyPrefsArray(Optional DoDebugOutput As Boolean = False) As String 2768| ' - Private Function OptionSummary() As String 2769| ' - Private Function OverwriteConfirmation(ByVal SelIm As Integer) As VbMsgBoxResult 2770| ' - Private Function SetWorkflowDlgInfoText() As String 2771| ' - Private Function hn_showInfo() As String 2772| ' - Private Sub FlushLogfileCache(Optional ByRef Overwrite As Boolean = False) 2773| ' - Private Sub PS_GetPrefs 2774| ' - Public Function CreateTargetDir(ByVal TheLongDirName As String) As Boolean 2775| ' - Sub Main 2776| 2777| '### Public Declarations: 2778| ' - Public Type PS_Logfile 2779|