newscript
dim appVersion = "2023-03-21"
FUNCTION appDescription ()
freestring = "??" & appVersion & "????"
>>Catch a drag'n'dropped file, then use GetDetailsOf API of the Shell.Application??
>> to get properties of that file.??
>>??
>>Drag'n'drop a file on the coloured area above, or on this display panel.
appDescription = replace ( freestring , "??" , chr(0x0a) )
END Function
' --------------------------------------------------
FUNCTION toggleWarnColour ( sobid )
IF ( sob (sobId , "GET", "RGB" ) == RGB ( 0xff ,0xbf ,0xbf ) ) then
sob ( sobId , "SET", "RGB" , RGB ( 0xff ,0,0 ) )
ELSE
sob ( sobId , "SET", "RGB" , RGB ( 0xff ,0xbf ,0xbf ) )
END IF
END FUNCTION
FUNCTION toggleOKColour ( sobid )
IF ( sob (sobId , "GET", "RGB" ) == RGB ( 0 ,0xff ,0 ) ) then
sob ( sobId , "SET", "RGB" , RGB ( 0x7f ,0xff ,0x7f ) )
ELSE
sob ( sobId , "SET", "RGB" , RGB ( 0 ,0xff ,0 ) )
END IF
END FUNCTION
' --------------------------------------------------
FUNCTION getProperty ( oFolder, oFile, index ) string
dim i , tmpstr , name
getProperty = ""
dim res = oFolder.GetDetailsOf ( oFile, index)
IF ( res <> "" ) then
name = right ( "0000" & index , 3) & " " & oFolder.GetDetailsOf ( NULL,index)
SELECT case length(name)
case 0 to 6
name = name & chr(0x09) & chr(0x09)& chr(0x09)& chr(0x09)
case 6 to 13
name = name & chr(0x09) & chr(0x09) & chr(0x09)
case 12 to 20
name = name & chr(0x09) & chr(0x09)
case else
name = name & chr(0x09)
END select
getProperty = name
FOR i = 0 to length (res) -1
tmpstr = mid(res, i ,1 )
IF ( asc ( tmpstr ) < 0x080 ) then
getProperty = getProperty & tmpstr
END IF
NEXT i
END if
END function
FUNCTION handleFile ( filePathName )
dim fs, folder
dim FilePath = Left ( filePathName , inStrRev ( filePathName , "\\" ) - 1)
dim FileName = Left ( filePathName , -1 * inStrRev ( filePathName , "\\" ) )
dim objShell = CreateObject ("Shell.Application")
dim objFolder = objShell.Namespace(FilePath)
dim objFile = objFolder.parsename (FileName )
sob ( AppDisplay,"ADD", "ROW", "Path " & FilePath & chr(0x0a) )
sob ( AppDisplay,"ADD", "ROW", "File " & FileName & chr(0x0a) & chr(0x0a) )
dim i , txt
FOR i = 0 to 330
txt = getProperty ( objFolder, objFile, i )
IF ( txt <> "" ) then
sob ( AppDisplay,"ADD", "ROW", txt & chr(0x0a) )
' sob ( AppDisplay,"ADD", "ROW", right ( "0000" & i , 3) & " " & objFolder.GetDetailsOf ( NULL , i ) & " " & objFolder.GetDetailsOf ( objFile,i) & chr(0x0a) )
END if
NEXT i
SOB ( AppDisplay , "SET" , "ROW" , "TOP" , 1 )
END function
' --------------------------------------------------
FUNCTION toggleOKColour ( sobid )
IF ( sob (sobId , "GET", "RGB" ) == rgb ( 0x7f, 0xff, 0x7f ) ) then
sob ( sobId , "SET", "RGB" , RGB ( 0 ,0xff ,0 ) )
ELSE
sob ( sobId , "SET", "RGB" , rgb ( 0x7f, 0xff, 0x7f ) )
END IF
END FUNCTION
' create a window to contain some SOBs
dim myWindow = sob ("application","NEW","Image properties using GetDetailsOf")
' Define a callback to handle a click on the TOP Right "X"
FUNCTION XmyWindow ( sobid )
sob ( sobid, "delete")
END function
' Associate the callback with myWindow
sob ( myWindow,"ON","CLICK", "XmyWindow")
' sob ( myWindow , "SET" , "TITLE" , "Replace text in all PPTs" )
' -----------------------------------------------------
' Define a callback to handle a click on the TOP Right "X"
' Callbacks are discussed in detail in the CALLBACK help option
FUNCTION ClickMyWindow ( sobid )
' delete the SOB myWindow , automatically deletes all of its child SOBs
sob ( myWindow, "delete")
END function
' -----------------------------------------------------
' add a menu bar myWindow
dim myMenuBar = sob (myWindow , "add" , "menu" , "bar" )
' ( target , action , qualifier , qualifier )
' add two horizonal menus to myMenuBar
dim myMenuFile = sob (myMenuBar , "add" , "menu" , "Horizontal" , "File" )
' ( target , action , qualifier , qualifier , parameter )
'dim myMenuOptions = sob (myMenuBar , "add" , "menu" , "Horizontal" , "Input Options" )
' ( target , action , qualifier , qualifier , parameter )
dim myMenuTools = sob (myMenuBar , "add" , "menu" , "Horizontal" , "Tools" )
' ( target , action , qualifier , qualifier , parameter )
dim myMenuHelp = sob (myMenuBar , "add" , "menu" , "Horizontal" , "Help" )
' ( target , action , qualifier , qualifier , parameter )
' -----------------------------------------------------
' add a menu item to the FILE menu
' Note: we are not going to explicitly remember the ID of the menu SOB we are about to create.
' This is a trick, see comment in about 4 lines!
sob ( myMenuFile , "add" , "menu" , "Vertical" , "Exit" )
' target , action , qualifier , qualifier , parameter )
' Associate a click / press on the File.Exit menu option with a callback handler
' Note: a SOB id of -1 always refers to the SOB used in the last SOB command
' If we did not have this, then we would have had to have a DIM in the previous SOB command line
sob ( -1 , "ON" , "CLICK" , "ClickMyWindow")
' ( target , action , qualifier , parameter )
' -----------------------------------------------------
' Define a callback to handle a click on the Help.About menu option (not yet defined)
FUNCTION ClickAbout ( sobid )
sob ( AppDisplay, "EMPTY")
sob ( AppDisplay, "ADD", "ROW", appDescription() )
sob ( AppDisplay, "SET", "row" , "top", 1 )
toggleOKColour ( AppCatchArea )
END Function
' add an ABOUT menu item to the HELP menu
sob ( myMenuHelp , "add" , "menu" , "Vertical", "About" )
' ( target , action , qualifier , qualifier , parameter )
' Associate the callback with the Help.About menu option
' Note: we use the -1 trick again
sob ( -1 , "ON" , "CLICK" , "ClickAbout" )
' ( target , action , qualifier , parameter )
' -----------------------------------------------------
' Define a callback to handle a click on the Help.Contact menu option (not yet defined)
FUNCTION ClickContact ( sobid )
sob ( AppDisplay, "EMPTY")
sob ( AppDisplay, "ADD", "ROW", "E-Mail: George.Salisbury@RipeTech.com" & chr(0x0a) )
toggleOKColour ( AppCatchArea )
END Function
' add a CONTACT menu item to the HELP menu
sob ( myMenuHelp , "add" , "menu" , "Vertical" , "Contact" )
' ( target , action , qualifier , qualifier , parameter )
' Associate the callback with the Help.Contact menu option
' Note: we use the -1 trick again
sob ( -1 ,"ON","CLICK", "ClickContact")
' --------------------------------------------------
FUNCTION CbClearAppDisplay ( sobid )
sob ( AppDisplay, "EMPTY")
END Function
sob ( myMenuTools , "add" , "menu" , "Vertical", "Clear display area" )
sob ( -1 , "ON" , "CLICK" , "CbClearAppDisplay" )
' --------------------------------------------------
dim wideColumn = sob ( myWindow , "ADD" , "CONTAINER" , "COLUMN.W")
sob ( wideColumn , "SET" , "STRETCH" , 1 )
' --------------------------------------------------
dim FolderPath = sob ( wideColumn , "ADD" , "LABEL" , " ")
SOB ( "OVERRIDE" , "STYLE+" , 0x00002000)
>??
>>Drag'n'drop a file here??
dim AppCatchArea = sob ( wideColumn , "ADD" , "BUTTON" , "PUSH" , replace ( freestring, "??", chr(0x0a)) )
dim AppDisplay = sob ( wideColumn , "ADD" , "EDIT.ROWS" , " " , 3 )
font("RESET")
font("SET" ,"FaceName" , "Courier New" )
dim myFont = Font("CREATE")
sob ( AppDisplay , "SET", "FONT" , myFont )
FUNCTION cbCatchDroppedObject ( sobId )
IF ( isFile ( getDropData(1) ) == -1 ) THEN
' handleFolder (getDropData(1) & "\\")
END IF
END FUNCTION
FUNCTION cbCatchDroppedObject ( sobId )
sob ( AppDisplay, "empty")
IF ( isFile ( getDropData(1) ) == 1 ) THEN
' file
handleFile (getDropData(1) )
toggleOKColour ( AppCatchArea)
ELSEIF ( isFile ( getDropData(1) ) == -1 ) THEN
' folder
sob ( AppDisplay,"ADD", "ROW", "Sorry, no handler for a folder(s) " & chr(0x0a) )
ELSE
' error
sob ( AppDisplay,"ADD", "ROW", "Invalid file path/ name" & chr(0x0a) & getDropData(1) & chr(0x0a) )
END IF
END FUNCTION
' --------------------------------------------------------------------
sob ( AppCatchArea ,"ON" ,"DROP.FILE", "cbCatchDroppedObject")
sob ( AppDisplay ,"ON" ,"DROP.FILE", "cbCatchDroppedObject")
toggleOKColour ( AppCatchArea )
sob ( AppDisplay, "empty")
sob ( AppDisplay,"ADD", "ROW", appDescription() )
sob ( AppDisplay, "SET", "row" , "top", 1 )