http://www.desktopx.info/ Helping DX Coders Create, Enhance & Excel! en () Thu, 20 Nov 2008 12:11:41 UTC http://testsite.desktopx.info/tutorials/reidenbach/ http://testsite.desktopx.info/tutorials/reidenbach/ reidenbach reidenbach [link=http://pidstudio.com/components/com_fish/resource-1633.html]reidenbach[/link] reidenbach reidenbach [link=http://pidstudio.com/components/com_fish/resource-1633.html]reidenbach[/link] http://testsite.desktopx.info/snippets/reidenbach/#comments vbscript () Thu, 30 Oct 2008 13:50:20 UTC http://testsite.desktopx.info/tutorials/ini-read-write-update/ http://testsite.desktopx.info/tutorials/ini-read-write-update/ This is a INI reader/writer/updater that uses some simple commands to make this work in ANY program. Will write more later. Put all of this into a TEXT Object (just to test it out). Dim IniName, IniCnt, IniTitle(100), IniDetails(100) Const ForWriting =2 : Const ForReading = 1 : Const ForAppending = 8 'Called when the script is executed Sub Object_OnScriptEnter IniName = "BoxxiWP.ini" '---- INI FILE NAME Object.Text = "Ini Info: " & vbnewline Call ReadINI() For x = 1 To IniCnt Object.Text = object.text & IniTitle(x) & ": " & IniDetails(x) & vbnewline Next object.text = object.Text &vbnewline& "Checking on Light:" &vbnewline & ReadINIValue("Light_OnOff") If ReadINIValue("Light_OnOff") = "Off" Then Call SetINIValue("Light_onoff","On") Else Call SetINIValue("Light_onoff","Off") End If object.text = object.Text &vbnewline& "Checking on Light:" &vbnewline & ReadINIValue("Light_OnOff") x = ReadINIValue("SS_Interval") p = x + 1000 object.text = object.Text &vbnewline& "x/p: " & x & "/" & p End Sub 'Called when the script is terminated Sub Object_OnScriptExit End Sub Function WriteBlankINI() '------------------ INI DEFAUTL VALUES HERE ----------------------- IniCnt = 0 IniCnt = IniCnt+ 1 : IniTitle(1) = "Light_OnOff" : IniDetails(1) = "Off" IniCnt = IniCnt+ 1 : IniTitle(2) = "WP_Name" : IniDetails(2) = "Dark" IniCnt = IniCnt+ 1 : IniTitle(3) = "CPic_Name" : IniDetails(3) = "Lake.jpg" IniCnt = IniCnt+ 1 : IniTitle(4) = "SS_Folder" : IniDetails(4) = "c:\" IniCnt = IniCnt+ 1 : IniTitle(5) = "SS_Interval" : IniDetails(5) = 3000 IniCnt = IniCnt+ 1 : IniTitle(6) = "SS_OnOff" : IniDetails(6) = "Off" IniCnt = IniCnt+ 1 : IniTitle(7) = "SS_CurPhoto" : IniDetails(7) = 1 ' The INI File is Stored in the Directory where the Program is run IniContents = "" For x = 1 To INICnt IniContents = IniContents & IniTitle(x) & "|" & IniDetails(x) & vbnewline Next fn = desktopx.ExecutableDirectory & IniName System.SimpleWrite fn, IniContents, 1 End Function Function ReadINI() Call CheckForINI() ' object.text = Object.text & "Reading:" & vbnewline fn = desktopx.ExecutableDirectory & IniName TextList = System.SimpleRead(fn, 1) Lines = Split(TextList, Chr(10)) IniCnt = 0 For A = UBound(Lines) To LBound(Lines) Step -1 If Len(Lines(A)) > 0 Then t = instr(Lines(A),"|") IniCnt = IniCnt + 1 IniTitle(IniCnt) = left(Lines(A),t-1) IniDetails(IniCnt) = mid(Lines(A),t+1) l = len(IniDetails(IniCnt)) IniDetails(IniCnt) = left(IniDetails(IniCnt),l-1) 'object.Text = object.Text & "Title(" & IniCnt & "): [" & IniTitle(IniCnt) & "]" & vbnewline 'object.Text = object.Text & "Item(" & IniCnt & "): [" & IniDetails(IniCnt) & "]" & vbnewline End If Next End Function Function WriteINI() ' The INI File is Stored in the Directory where the Program is run IniContents = "" For x = 1 To INICnt IniContents = IniContents & IniTitle(x) & "|" & IniDetails(x) & vbnewline Next fn = desktopx.ExecutableDirectory & IniName System.SimpleWrite fn, IniContents, 1 End Function Function CheckForINI() fn = desktopx.ExecutableDirectory & IniName Set filesys = CreateObject("Scripting.FileSystemObject") temp = filesys.FileExists(fn) path = filesys.GetAbsolutePathName(fn) If Not filesys.FileExists(fn) Then Call WriteBlankFile() End If End Function Function ReadINIValue(Item) ReadINIValue = "" For x = 1 To INICnt If UCase(IniTitle(x)) = UCase(Item) Then temp = IniDetails(x) Next ReadINIValue = Temp End Function Function SetINIValue(Item,value) For x = 1 To INICnt If UCase(IniTitle(x)) = UCase(Item) Then IniDetails(x) = Value Next Call WriteINI() End Function http://testsite.desktopx.info/snippets/ini-read-write-update/#comments vbscript SirSmiley (Adam) Sun, 01 Jun 2008 15:26:55 UTC http://testsite.desktopx.info/tutorials/special-folders-recycle-bin/ http://testsite.desktopx.info/tutorials/special-folders-recycle-bin/ It creates a columnar list of your recycle bin contents. Eg. File Name, Size, Type, Date Deleted. You can easily add more items such as original location, etc. Place this script in a Text Object then click it to generate the list. Const MY_RECENT_DOCUMENTS = &H8& Const RECYCLE_BIN = &Ha& 'Const MY_COMPUTER = &H11& 'Const NETHOOD = &H13& Const DATE_DEL = 2 Const FILE_SIZE = 3 Const FILE_TYPE = 4 'Constants for size Const inBYTE = 1 Const inKILO = 1024 ' 2^10 Const inMEGA = 1048576 ' 2^20 Const inGIGA = 1073741824 ' 2^30 Const inTERA = 1099511627776 ' 2^40 Const inPETA = 1.12589990684262E+15 ' 2^50 Const inEXA = 1.15292150460685E+18 ' 2^60 Const inZETTA = 1.18059162071741E+21 ' 2^70 Const inYOTTA = 1.20892581961463E+24 ' 2^80 Set objShell = CreateObject("Shell.Application") Set WshShell = CreateObject("WScript.Shell") Set objFSO = CreateObject("Scripting.FileSystemObject") 'Called when L-click is released Function Object_OnLButtonUp(x, y, dragged) If Not dragged Then 'Call CreateList Call BuildArray End If End Function Dim arrData( ) ' Build MultiDimensional Array Function BuildArray Set objFolder = objShell.Namespace(RECYCLE_BIN) Set objFolderItem = objFolder.Self Set colItems = objFolder.Items objCount=colItems.Count intRows=objCount-1 r=0 ' Rows For Each objItem In colItems strName=objItem.Name strSize = objFolder.GetDetailsOf(objItem, FILE_SIZE) strType = objFolder.GetDetailsOf(objItem, FILE_TYPE) dtmDel = objFolder.GetDetailsOf(objItem, DATE_DEL) arrSize = Split(strSize, " ") intSize = CLng(arrSize(0)) ReDim Preserve arrData(intRows,4)'rows,columns arrData(r,0)=strName arrData(r,1)=intSize arrData(r,2)=strType arrData(r,3)=dtmDel r=r+1 'intSize=intSize*inKILO 'intTotal=intTotal+intSize ' Running Total 'Object.Text=Object.Text&objItem.Name&vbtab&intSize&vbtab&strType&vbtab&dtmDel&vbcrlf Next object.text="" Call DisplayData End Function Function FileSize(intSize) If intSize < inKILO Then fSize = (intSize/inBYTE) FileSize = FormatNumber(fSize,,,,0) & " Bytes" ElseIf intSize < inMEGA Then fSize = (intSize/inKILO) FileSize = FormatNumber(fSize,,,,0) & " KB" ElseIf intSize < inGIGA Then fSize = (intSize/inMEGA) FileSize = FormatNumber(fSize,,,,0) & " MB" ElseIf intSize < inTERA Then fSize = (intSize/inGIGA) FileSize = FormatNumber(fSize,,,,0) & " GB" End If End Function 'Called when the script is executed Sub Object_OnScriptEnter object.text="Click Here for ultimate sexyness!" End Sub ' Reads & formats multidimensional array data Sub DisplayData ' Lame work around since VBScript has pathetic sort options arrColPos=Array(100,100,100,100) ' Column Header Object.Text="File Name"&String(26,Chr(160))&_ "File Size"&String(26,Chr(160))&_ "File Type"&String(26,Chr(160))&_ "Date Deleted"&String(23,Chr(160))&_ vbcrlf For r=0 To UBound(arrData) ' Rows Statement For c=0 To 4 ' Nested Columns Statement If c = 1 Then intSize=FileSize(arrData(r, c)*inKILO) 'intSize =arrData(r, c)*inKILO intTotal=intTotal+(arrData(r, c)*inKILO) ' Running Total strData=intSize ElseIf c1 Then strData=arrData(r, c) End If ' Count Characters lngColDim=Len(strData) lngTCol=35'arrColPos(c) iValue=lngTCol-lngColDim If lngColDim http://testsite.desktopx.info/snippets/special-folders-recycle-bin/#comments vbscript romanda (David Roman) Wed, 21 May 2008 11:14:15 UTC http://testsite.desktopx.info/tutorials/hue-setting-button-code/ http://testsite.desktopx.info/tutorials/hue-setting-button-code/ Add the following code to the object that you want to assign a HUE shift of +10 on each click. In this example change the object names to ones from your project. These are just used as an example You can change the +10 to +5 if you want it to move slower up the HUE scale. Sub Object_OnLButtonDown(x, y) Dim ulHue ulHue = DesktopX.Object("3Dmetal_Clock_Face").hue ulHue = ulHue + 10 'if hue is set to Black "1000" then set it back to Unshifted "0" If ulHue > 1001 Then ulHue = 0 If ulHue > 255 And ulHue < 999 Then ulHue = 1000 Call SetHue(ulHue) End Sub '************************************************************* 'Resets the hue to 0 if right clicked Sub Object_OnRButtonDown(x, y) Call SetHue(1000) End Sub 'Resets the hue to 0 if right clicked Sub Object_OnScriptEnter If Object.LocalStorage("Hue") = "" Then ulHue = 1000 Else ulHue = Object.LocalStorage("Hue") End If Call SetHue(ulHue) End Sub Function SetHue(huesetting) DesktopX.Object("3Dmetal_Clock_Face").hue = huesetting DesktopX.Object("3Dmetal_Clock_Hours").hue =huesetting DesktopX.Object("3Dmetal_Clock_Minutes").hue = huesetting DesktopX.Object("3Dmetal_Clock_Seconds").hue = huesetting Object.LocalStorage("Hue") = huesetting desktopx.Object("test").text = huesetting End Function http://testsite.desktopx.info/snippets/hue-setting-button-code/#comments vbscript SirSmiley (Adam) Tue, 13 May 2008 13:39:58 UTC http://testsite.desktopx.info/tutorials/date-format-function/ http://testsite.desktopx.info/tutorials/date-format-function/ Use this function to format a date text object. I've included an example of how to use/create a dynamic date submenu. ' Create a Text Object called objText and create a script for it. ' Paste this code in it. Dim oText,iDateFormat Set oText=DesktopX.Object("objText") 'Called when L-click is released Function Object_OnLButtonUp(x, y, dragged) If not dragged then Call MyMenu End If End Function Dim arrDateFormats() ' Put's Date Formats into an array for a submenu Function Array_DateFormats For i=0 to 11 ReDim Preserve arrDateFormats(12) arrDateFormats(i)=FormatDate(Date,i) Next End Function ' This is the actual Date Formating Function Function FormatDate(dtmNumericDate,intFormat) ' Use Current Date dtmDay=DatePart("d",dtmNumericDate) If dtmDay < 10 Then dtmDay="0"&dtmDay dtmMth=DatePart("m",dtmNumericDate) If dtmMth < 10 Then dtmMth="0"&dtmMth dtmYr=DatePart("yyyy",dtmNumericDate) ' Select Date Format Select Case intFormat ' Little endian form (day, month, year) Case 0 ' dd/mm/yyyy FormatDate=dtmDay&"/"&dtmMth&"/"&dtmYr Case 1 'dd/mm/yy FormatDate=dtmDay&"/"&dtmMth&"/"&Right(dtmYr,2) Case 2 ' 16 November 2003 FormatDate=dtmDay&" "&MonthName(dtmMth,False)&" "&dtmYr Case 3 ' dd/mmm/yyyy 16 Nov 2003 FormatDate=dtmDay&"/"&MonthName(dtmMth,True)&"/"&dtmYr ' Middle endian form(month, day, year) Case 4 ' mm/dd/yyyy 11/16/2003 or 11-16-2003 or 11.16.2003 FormatDate=dtmMth&"/"&dtmDay&"/"&dtmYr Case 5 ' mm/dd/yy' 11.16.03 FormatDate=dtmMth&"/"&dtmDay&"/"&Right(dtmYr,2) Case 6 ' November 16, 2003 FormatDate=MonthName(dtmMth,False)&" "&dtmDay&", "&dtmYr Case 7 'mmm d, yyyy Nov. 16, 2003 FormatDate=MonthName(dtmMth,True)&" "&dtmDay&" , "&dtmYr ' ISO 8601 (year, month, day) Case 8 'yyyy.mm.dd FormatDate=dtmYr&"."&dtmMth&"."&dtmDay Case 9 'yyyy-mm-dd FormatDate=dtmYr&"-"&dtmMth&"-"&dtmDay Case 10 'yyyy/mm/dd FormatDate=dtmYr&"/"&dtmMth&"/"&dtmDay Case 11 'yyyymmdd FormatDate=dtmYr&dtmMth&dtmDay End SelectiDateFormat End Function Sub Object_OnScriptEnter oText.Text=Date ' Set's text object to today's date Call Array_DateFormats End Sub ' Example of Date Format Submenu Sub MyMenu Dim mainmenu, datemenu, result Set mainmenu = nothing Set datemenu = nothing Set datemenu= DesktopX.CreatePopupMenu For x = 0 To UBound(arrDateFormats)-1 datemenu.AppendMenu 0, 100+x, arrDateFormats(x) Next Set mainmenu = DesktopX.CreatePopupMenu mainmenu.AppendMenu 0, 1, "Menu Item A" mainmenu.AppendMenu 0, 2, "Menu Item B" mainmenu.AppendMenu &H00000010, datemenu.MenuID, "Format Date" result = mainmenu.TrackPopupMenu(0, System.CursorX, System.CursorY) Select Case result Case 1 msgbox "You Chose Menu Item A" Case 2 msgbox "You Chose Menu Item B" Case Else If result>=100 And result http://testsite.desktopx.info/snippets/date-format-function/#comments vbscript () Wed, 07 May 2008 03:26:27 UTC http://testsite.desktopx.info/tutorials/animflipstate/ http://testsite.desktopx.info/tutorials/animflipstate/ An 'flip' style animation for an object. Provide the name of one of the objects states to the funtion and the object will 'flip' from it's current state image to it's new state image. Sub animStateFlip(objName,newStateName) If DesktopX.IsObject(objName) = False then Exit Sub Set obj = DesktopX.Object(objName) frames = 5 objLeftOriginal = obj.Left objWidthOriginal = obj.Width widthStep = objWidthOriginal/frames For a = 1 to frames newWidth = obj.Width - widthStep obj.Width = newWidth newLeft = obj.Left + widthStep/2 obj.Left = newLeft Next obj.Width = 0 obj.State = newStateName For a = 1 to frames newWidth = obj.Width + widthStep obj.Width = newWidth newLeft = obj.Left - widthStep/2 obj.Left = newLeft Next obj.Width = objWidthOriginal obj.State = objLeftOriginal End Sub http://testsite.desktopx.info/snippets/animflipstate/#comments vbscript sViz (sViz) Tue, 29 Apr 2008 18:15:43 UTC http://testsite.desktopx.info/tutorials/faux-drag-and-drop-icons/ http://testsite.desktopx.info/tutorials/faux-drag-and-drop-icons/ This script creates drag and drop icons/shortcuts with auto grid capability, size options, and spacing options. It's a more functional alternative to the standard DX drag and drop icon shortcuts. '===INSTRUCTIONS===== 'Create "parent" object, accept drag and drop 'Create "temp_obj", parent="parent", child= yes... 'x/y = -50, set w/h, objecttype = shortcut... 'movement = locked '=================== 'Called when files are dropped onto object Sub Object_OnDropFiles(files) object.SetTimer 1, 100 End Sub Sub Object_OnTimer1 object.KillTimer 1 setIcon End Sub Sub setIcon On Error Resume Next Set fso = CreateObject("Scripting.FileSystemObject") 'Give real icon object name For Each elem In object.Children If elem.name = "" Then elem.name = "truicon" Set truicon = DesktopX.Object("truicon") End If Next If DesktopX.IsObject("truicon") = True Then 'Get number of faux icons icongrp = DesktopX.GroupObjects("icongrp").count 'Set new faux icon name newicon = "icon_" & icongrp + 1 'Clone faux icon template Set tempobj = DesktopX.Object("temp_obj") tempobj.clone newicon, tempobj.left, tempobj.top 'Set new faux icon information DesktopX.Object(newicon).parent = DesktopX.Object("p") DesktopX.Object(newicon).group = "icongrp" DesktopX.Object(newicon).picture = truicon.picture DesktopX.Object(newicon).command = truicon.command DesktopX.Object(newicon).tooltiptext = fso.getbasename(DesktopX.Object(newicon).command) 'Delete real icon object truicon.delete 'Get new faux icon count lastobj = DesktopX.GroupObjects("icongrp").count gap = 28 '--space between faux icons 'Arrange faux icons on grid For x = 1 To lastobj If x = 1 Then DesktopX.Object("icon_" & x).move 10,10 Else lastx = DesktopX.Object("icon_" & x-1).right + gap lasty = DesktopX.Object("icon_" & x-1).top If lastx => object.width - gap Then lastx = 10 lasty = DesktopX.Object("icon_" & x-1).bottom + gap End If DesktopX.Object("icon_" & x).move lastx, lasty End If Next Set fso = nothing Set truicon = nothing Set tempobj = nothing Else msgbox "Drag and drop not accepted; invalid file type." End If End Sub http://testsite.desktopx.info/snippets/faux-drag-and-drop-icons/#comments vbscript () Tue, 18 Dec 2007 14:29:07 UTC http://testsite.desktopx.info/tutorials/get-hard-drive-info-from-wmi/ http://testsite.desktopx.info/tutorials/get-hard-drive-info-from-wmi/ This reads your hard drive info from WMI It DOES NOT read A: B: so that it will not give you the Floppy grinding issue! AT TOP OF CODE: Dim Drive_Count, Drive_TotalSpace(100), Drive_FreeSpace(100), Drive_UsedSpace(100) Dim Drive_FileSystem(100), Drive_Description(100), Drive_Type(100) Dim Drive_VolumeName(100),Dim Drive_Letter(100) Sub GetDriveInfo() Drive_Count = 0 Temp_Count = 0 Set objWMIService = GetObject("winmgmts:\\.\root\cimv2") Set DriveInfo = objWMIService.ExecQuery ("Select * from Win32_LogicalDisk Where drivetype > 1") 'Dim DriveList 'DriveList = Array("C:","D:","E:","F:","G:","H:","I:","J:","K:","L:","M:","N:","O:","P:","Q:","R:","S:","T:","U:","V:","W:","X:","Y:","Z:") 'For Each DriveLtr In DriveList 'Set DriveInfo = objWMIService.ExecQuery ("Select * from Win32_LogicalDisk Where DeviceID = '" & DriveLtr & "'") For Each objDrive In DriveInfo Temp_count = Temp_count + 1 'If Drive_Letter(Temp_count) "A" Or Drive_Letter(Temp_count) "B" Then Drive_Count = Drive_Count + 1 Drive_Letter(Drive_Count) = objDrive.DeviceID Drive_Type(Drive_Count) = objDrive.drivetype Drive_TotalSpace(Drive_Count) = objDrive.Size If objDrive.Size > 1 Then Drive_TotalSpace(Drive_Count) = FormatNumber((objDrive.Size/1048576),2) Drive_FreeSpace(Drive_Count) = objDrive.FreeSpace If objDrive.FreeSpace > 1 Then Drive_FreeSpace(Drive_Count) = FormatNumber((objDrive.FreeSpace/1048576),2) Drive_UsedSpace(Drive_Count) = objDrive.Size - objDrive.FreeSpace If Drive_UsedSpace(Drive_Count) > 1 Then Drive_UsedSpace(Drive_Count) = FormatNumber((Drive_UsedSpace(Drive_Count)/1048576),2) Drive_FileSystem(Drive_Count) = objDrive.FileSystem Drive_Description(Drive_Count) = objDrive.Description Drive_Type(Drive_Count) = objDrive.DriveType Drive_VolumeName(Drive_Count) = objDrive.VolumeName 'End If Next 'Next End Sub Need to add some DIMS to the main script for this to work.. add them later. http://testsite.desktopx.info/snippets/get-hard-drive-info-from-wmi/#comments vbscript romanda (David Roman) Sat, 15 Dec 2007 13:06:31 UTC http://testsite.desktopx.info/tutorials/event-handler/ http://testsite.desktopx.info/tutorials/event-handler/ Event Handler test. var events = new eventsHandler(); function eventsHandler() { var eventList = new Array(); eventList['Object_OnLButtonDown'] = new Array(); eventList['Object_OnLButtonUp'] = new Array(); this.addEventListener = function(strEvent, refFunction) { // Add event listener this.eventList[strEvent].push(refFunction); } this.trigger = function(strFunction) { // Trigger event for (event in this.eventList[strFunction]) { if (arguments.length > 1) { args = array(); for (var i = 1; i < arguments.length; i++) { args.push(arguments[i]); } event.call(args); } else { event.call(); } } } } // Catch events function Object_OnLButtonDown(x, y) { events.trigger('Object_OnLButtonDown', x, y); } function Object_OnLButtonUp(x, y, d) { events.trigger('Object_OnLButtonUp', x, y, d); } /* ********** MODULE DEFINITION ********** * Core module providing basic functionalities. * this module must allways be included first. * All modules must provide a module definition. */ var core_module = new module('core', '0.1.0'); registerModule(core_module); /* ********** MODULE CODE BEGINS HERE ********** */ function foo() { MsgBox('Event! From Foo.'); } function bar() { MsgBox('Event! From Bar.'); } events.addEventListener('Object_OnLButtonUp', foo); events.addEventListener('Object_OnLButtonUp', bar); http://testsite.desktopx.info/snippets/event-handler/#comments jscript romanda (David Roman) Sat, 15 Dec 2007 10:08:20 UTC http://testsite.desktopx.info/tutorials/rgb2cmyk/ http://testsite.desktopx.info/tutorials/rgb2cmyk/ Converts RGB colour values to CMYK '=== INFORMATION ===' 'Version 1.0.0 ' # Author: Thomas Thomassen ' # Website: http://www.thomthom.net/ ' http://thomthom.wincustomize.com/ '=== DESCRIPTION ===' 'This widget converts from and to RGB and CMYK. 'It does not include any colour profile in the 'conversion. It uses the easyRGB forumla. 'CMYK values = 0 ÷ 1 'RGB values = 0 ÷ 255 '=== RESOURCES ===' 'http://www.easyrgb.com/math.php 'http://www.adaptiveview.com/cw/doc5a.html Option Explicit 'References Dim txtRed, txtBlue, txtGreen Dim txtCyan, txtMagenta, txtYellow, txtBlack 'General Variables Dim Init, modeRGB2CMYK, modeCMYK2RGB 'Called when the script is executed Sub Object_OnScriptEnter Set txtRed = DesktopX.ScriptObject("txtRed").Textbox Set txtBlue = DesktopX.ScriptObject("txtBlue").Textbox Set txtGreen = DesktopX.ScriptObject("txtGreen").Textbox Set txtCyan = DesktopX.ScriptObject("txtCyan").Textbox Set txtMagenta = DesktopX.ScriptObject("txtMagenta").Textbox Set txtYellow = DesktopX.ScriptObject("txtYellow").Textbox Set txtBlack = DesktopX.ScriptObject("txtBlack").Textbox txtRed.MaxLength = 3 txtBlue.MaxLength = 3 txtGreen.MaxLength = 3 txtCyan.MaxLength = 3 txtMagenta.MaxLength = 3 txtYellow.MaxLength = 3 txtBlack.MaxLength = 3 txtRed.Text = 0 txtBlue.Text = 0 txtGreen.Text = 0 txtCyan.Text = 0 txtMagenta.Text = 0 txtYellow.Text = 0 txtBlack.Text = 0 'All textboxes are initiated Init = True End Sub 'Called when the script is terminated Sub Object_OnScriptExit Set txtRed = nothing Set txtBlue = nothing Set txtGreen = nothing Set txtCyan = nothing Set txtMagenta = nothing Set txtYellow = nothing Set txtBlack = nothing End Sub Public Sub Changed(strTextbox) 'Check if the textboxes are initiated. This is because when the textbox first 'is loaded it will call this sub. But this sub checks the values of all the 'textboxes. So when txtRed first is loaded it calls this sub, but txtGreen, 'txtBlue, ... isn't referneced yet so it causes an error. It could also be 'worked around by using "On Error Resume Next" 'On Error Resume Next If Init Then Dim iR, iB, iG Dim iC, iM, iY, iK Select Case (strTextbox) Case "txtRed", "txtBlue", "txtGreen" 'Don't do anything if we are editing CMYK to RGB If Not modeCMYK2RGB Then 'Ensure valid data If txtRed.Text = "" Then txtRed.Text = 0 If txtGreen.Text = "" Then txtGreen.Text = 0 If txtBlue.Text = "" Then txtBlue.Text = 0 If txtRed.Text < 0 Then txtRed.Text = 0 If txtGreen.Text < 0 Then txtGreen.Text = 0 If txtBlue.Text < 0 Then txtBlue.Text = 0 If txtRed.Text > 255 Then txtRed.Text = 255 If txtGreen.Text > 255 Then txtGreen.Text = 255 If txtBlue.Text > 255 Then txtBlue.Text = 255 'RGB2CMYK modeRGB2CMYK = True If txtRed.Text = 0 And txtGreen.Text = 0 And txtBlue.Text = 0 Then 'If RGB is all 0 it will cause raise an error. This bypasses this issue txtCyan.Text = 0 txtMagenta.Text = 0 txtYellow.Text = 0 txtBlack.Text = 100 Else iC = 1 - ( txtRed.Text / 255 ) iM = 1 - ( txtGreen.Text / 255 ) iY = 1 - ( txtBlue.Text / 255 ) iK = 1 If iK > iC Then iK = iC If iK > iM Then iK = iM If iK > iY Then iK = iY txtCyan.Text = CInt( (iC - iK) / (1 - iK) * 100 ) txtMagenta.Text = CInt( (iM - iK) / (1 - iK) * 100 ) txtYellow.Text = CInt( (iY - iK) / (1 - iK) * 100 ) txtBlack.Text = CInt( iK * 100 ) End If modeRGB2CMYK = False End If Case "txtCyan", "txtMagenta", "txtYellow", "txtBlack" 'Don't do anything if we are editing RGB to CMYK If Not modeRGB2CMYK Then 'Ensure valid data If txtCyan.Text = "" Then txtCyan.Text = 0 If txtMagenta.Text = "" Then txtMagenta.Text = 0 If txtYellow.Text = "" Then txtYellow.Text = 0 If txtBlack.Text = "" Then txtBlack.Text = 0 If txtCyan.Text < 0 Then txtCyan.Text = 0 If txtMagenta.Text < 0 Then txtMagenta.Text = 0 If txtYellow.Text < 0 Then txtYellow.Text = 0 If txtBlack.Text < 0 Then txtBlack.Text = 0 If txtCyan.Text > 100 Then txtCyan.Text = 100 If txtMagenta.Text > 100 Then txtMagenta.Text = 100 If txtYellow.Text > 100 Then txtYellow.Text = 100 If txtBlack.Text > 100 Then txtBlack.Text = 100 'CMYK2RGB modeCMYK2RGB = True 'Where CMYK And CMY values = 0 ÷ 1 iC = txtCyan.Text / 100 iM = txtMagenta.Text / 100 iY = txtYellow.Text / 100 iK = txtBlack.Text / 100 iC = ( iC * ( 1 - iK ) + iK ) iM = ( iM * ( 1 - iK ) + iK ) iY = ( iY * ( 1 - iK ) + iK ) 'CMY values = 0 ÷ 1 'RGB values = 0 ÷ 255 txtRed.Text = CInt( (1 - iC) * 255 ) txtGreen.Text = CInt( (1 - iM) * 255 ) txtBlue.Text = CInt( (1 - iY) * 255 ) modeCMYK2RGB = False End If End Select End If End Sub Public Sub Tab(strObjectName, boolBackwards) If boolBackwards Then Select Case (strObjectName) Case "txtRed" txtBlack.SetFocus Case "txtGreen" txtRed.SetFocus Case "txtBlue" txtGreen.SetFocus Case "txtCyan" txtBlue.SetFocus Case "txtMagenta" txtCyan.SetFocus Case "txtYellow" txtMagenta.SetFocus Case "txtBlack" txtYellow.SetFocus End Select Else Select Case (strObjectName) Case "txtRed" txtGreen.SetFocus Case "txtGreen" txtBlue.SetFocus Case "txtBlue" txtCyan.SetFocus Case "txtCyan" txtMagenta.SetFocus Case "txtMagenta" txtYellow.SetFocus Case "txtYellow" txtBlack.SetFocus Case "txtBlack" txtRed.SetFocus End Select End If End Sub http://testsite.desktopx.info/snippets/rgb2cmyk/#comments vbscript