An applications launcher

Published on by Yousfi Benameur

                        
Wscript.shell is a windows com object based on scripting.
Creating a WshShell object whenever wanting to run a program locally, manipulate the contents of the registry, create a shortcut, or access a system folder. The WshShell object provides the Environment collection. This collection allows you to handle environmental variables (such as WINDIR, PATH, or PROMPT).
in this code we show how to work with windows shortcuts or links, gathering all desktop shortcuts on a top evel form (semi transparent) and lauching applications from here.this desserves an application launcher ( as windows10 start menu).

the first code gathers all desktop links (can modify or add others with the code).
the second code creates some icons to embed with buttons created.Icons are distributed on picture buttons in order.
the 3th code is the application launcher.can create a project, add a config.fpw and compile an exe.
the code is made with commandbuttons (picture+caption) and specialEffect commandbutton property.
can switch specialeffect,adjust form transparency.the controls  container is visible with mousemove on .can switch alwaysonTop property dynamically.
if the number of links is big, can make form.scrollbars=2.
rightclick on any thumb to see the shortcut properties.click on to lauch specific target application.

Execute code *1* and *2* before running code *3*.


Click on code to select [then copy] -click outside to deselect


*1* gather all desktop links and cole them into  working folder.must populate this folder with some links to make it working.

set safe off
local m.yrepw
m.yrepw=addbs(justpath(sys(16,1)))+"links"
*messagebox(m.yrepw)

create cursor ycurs (ylink c(150))

local  FSO, WshShell, Files, File, Shortcut

 FSO = CreateObject("Scripting.FileSystemObject")
 WshShell = CreateObject("WScript.Shell")

Files = FSO.GetFolder(WshShell.SpecialFolders("Desktop")).Files
*messagebox(trans(Files.count))
For Each File In Files

if lower(justext(file.path))=="lnk"
insert into ycurs values (file.path)
endi
Next

brow title trans(reccount())+" links on desktop"

sele ycurs
scan
copy file allt(ylink) to (m.yrepw+"\"+justfname(ylink))
endscan


Click on code to select [then copy] -click outside to deselect


*2*
*this extract 325 icons form shell32.dll into images folder (created if not exists)

Clea All
Do yDeclare

Local m.yrep
m.yrep=Addbs(Justpath(Sys(16,1)))
If !Directory(m.yrep+"images")
    Md (m.yrep+"images")
Endi

Local m.lcdest,lnIndex,lcfile
m.lcfile="c:\windows\system32\shell32.dll"
m.lnIndex=325  &&lasr icon of shell32.dll here
*Messagebox("extract Icon as ico from :"+m.lcdest,0+32+4096,'',1500)
For lnIndex=0 To 325
	Try
		m.lcdest=m.yrep+"\images\"+Juststem(m.lcfile)+"_"+Trans(m.lnIndex)+'.ico'
		=IconExtract(m.lcfile, m.lcdest, m.lnIndex)
	Catch
	Endtry
Endfor
Set Defa To (yrep)

*If File(m.lcdest)
* Run/N explorer /Select, &lcdest
*Else
*	Messagebox("error!")
*Endi
Clear Dlls 'ExtractIcon', 'OleCreatePictureIndirect', 'DestroyIcon'
Retu

Procedure IconExtract
	Lparameters tcSourceFile As String, tcTargetFile As String, tnIconIndex As Integer
	Local lnIconHandle As Integer, loIconReference As Object
	tnIconIndex = Iif(Vartype(tnIconIndex) = 'N', tnIconIndex, 0)

	lnIconHandle = ExtractIcon(0, tcSourceFile, tnIconIndex)
	If lnIconHandle # 0
		tcStructure = Long2String(16) + Long2String(3) + Long2String(lnIconHandle) + Long2String(0)
		tcIdentifier = Replicate(Chr(0), 8) + Chr(0xC0)+ Replicate(Chr(0), 6) + Chr(0x46)
		loIconReference = 0
		OleCreatePictureIndirect(@tcStructure, @tcIdentifier, 1, @loIconReference)
		If Vartype(loIconReference) = 'O'
			If SavePicture(loIconReference, tcTargetFile)  =.T.
				*icon successfule created
			Endif
		Else
			Messagebox('OleCreatePictureIndirect() error')
		Endif
		DestroyIcon(lnIconHandle)
	Else
		Messagebox('ExtractIcon() error')
	Endif
	Return
Endproc
*

Function Long2String
	Lparameters tnLong
	tnLong = Int(tnLong)
	Return Chr(Bitand(tnLong, 255)) + ;
		CHR(Bitand(Bitrshift(tnLong, 8), 255)) + ;
		CHR(Bitand(Bitrshift(tnLong, 16), 255)) + ;
		CHR(Bitand(Bitrshift(tnLong, 24), 255))
Endfunc



Procedure yDeclare
	Declare Integer ExtractIcon In shell32 Integer, String, Integer
	Declare Long OleCreatePictureIndirect In oleaut32 String @, String @, Long, Object @
	Declare SHORT DestroyIcon In user32 Integer
Endproc


Click on code to select [then copy] -click outside to deselect



*3* Applications launcher.the code *1* and *2* must be executed mandatory before.

Publi yform
yform=Newobject("ylauncher")
yform.Show
Read Events
Retu
*
Define Class ylauncher As Form
BorderStyle = 0
Height = 640
Width = 760
ShowWindow = 2
ShowTips = .T.
AutoCenter = .T.
Caption = "Applications launcher"
Movable = .F.
Icon=Home(1)+"GRAPHICS\ICONS\ELEMENTS\SUN.ICO"
BackColor = Rgb(0,0,0)
width0 = .F.
Name = "Form1"

Add Object ycont As ycont With ;
Anchor = 768, ;
Top = 600, ;
Left = 0, ;
Width = 804, ;
Height = 37, ;
BackStyle = 0, ;
BorderWidth = 0, ;
BackColor = Rgb(0,0,160), ;
Name = "yCont"


Procedure my
Lparameters nButton, nShift, nXCoord, nYCoord
If !nButton=1
    Return .F.
Endi

*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
*messagebox(loObject.name+ " clicked)-",0+32+4096,'',1000)
*keyboard "{CTRL+ALT+SHIFT+A}"
Sele ycurs
Go Int(Val(Strextract(loObject.Name,"ycom","") ))
*brow
Local m.cfilename
m.cfilename=Allt(ylink)
Thisform.Caption="Applications launcher ["+Trans(Reccount())+"]  - "+m.cfilename
Messagebox(m.cfilename,0+32+4096,'',1000)

*run the shortcut
Thisform.WindowState=1
&&shellexecute
result = ShellExecute(0, "open",m.cfilename,"","",1)
If result<=32
	Messagebox("An error was occured! "+m.cfilename,0+32+4096,"Error")
Endi
Endproc

Procedure ygather
*remove all objects (ycom)
With Thisform
	For i=1 To .ControlCount
		Try
			If Lower(Substr(.Controls(i).Name,1,4))=="ycom"
				.Parent.RemoveObject(.Controls(i).Name)
			Endi
		Catch
		Endtry
	Endfor
Endwith

Local m.xx
m.xx=Adir(gbbase,m.yrep+"images\*.ico")
If m.xx=0
	Messagebox("must populate "+m.yrep+"images with icons",16+4096,'',800)
Endi

Local gnbre,m.delta,j
m.delta=10
j=1
k=0
ww=48*1.5
hh=48
gnbre=Adir(gabase,Addbs(m.yrepw)+"*.lnk")

Try
	Sele ycurs
	Zap
Catch
Endtry

Local rmax
rmax=Floor(Thisform.Width/(m.ww+m.delta))
*messagebox( trans(rmax),0+32+4096,'',400)

If gnbre >0
	Create Cursor ycurs (ylink c(100),yicon c(100))
	For i=1 To  gnbre
		Insert Into ycurs Values(Addbs(m.yrepw)+gabase(i,1),"")
	Endfor
	Sele ycurs
	*brow
	Scan
		i=Recno()
		With Thisform
			Try
				.AddObject("ycom"+Trans(i),"commandbutton")
			Catch
			Endtry
			ximg=".ycom"+Trans(i)
			With  Eval (ximg)

				If i=1
					.Left=10
					.Top=10
				Endi

				k=k+1

				If k>rmax
					k=1
					j=j+1
					.Left=10
					.Top=10+(j-1)*(m.hh+m.delta)
				Else
					If i>1
						.Left=Eval(".parent.ycom"+Trans(i-1)+".left")+m.ww+m.delta
						.Top =Eval(".parent.ycom"+Trans(i-1)+".top")
					Endi
				Endi

				.Width=m.ww
				.Height=m.hh

				.SpecialEffect=Iif(Thisform.ycont.check1.Value=0,0,2)
				.ForeColor=Iif(Thisform.ycont.check1.Value=0,Rgb(0,0,138),Rgb(255,255,255))
				*.backcolor=iif(thisform.ycont.check1.value=0,0,rgb(240,240,240))   &&rgb(212,208,200)
				.BackColor=Iif(Thisform.ycont.check1.Value=0,Rgb(0,255,0),0)   &&rgb(212,208,200)
				.Caption=Lower(Juststem(ylink))
				.AutoSize=.F.
				.WordWrap=.T.

				.FontSize=8
				.MousePointer=15
				.PicturePosition=13
				.ToolTipText=Allt(Juststem(ylink))
				If i<=xx
					.Picture=Iif(m.xx>0,"images\"+gbbase(i,1),"")
				Else
					.Picture=Iif(m.xx>0,"images\"+gbbase(i-xx,1),"")
				Endi
				Sele ycurs
				Repl yicon With .Picture

				.Visible=.T.
			Endwith
			Bindevent(Eval(ximg),"mousedown",Thisform,"my")
			Bindevent (Eval(ximg),"MouseEnter",Thisform,"my1")
			Bindevent (Eval(ximg),"MouseLeave",Thisform,"my2")
			Bindevent (Eval(ximg),"RightClick",Thisform,"my3")

			.Refresh
		Endwith
	Endscan


Endi
Sele ycurs
Thisform.Caption="Applications launcher ["+Trans(Reccount())+"]"
With Thisform.ycont
	.Anchor=768
	.ZOrder(0)
Endwith
Endproc

Procedure my1
Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]

With loObject
	.Left=.Left-2
	.Top=.Top-2
Endwith
Sele ycurs
Go Int(Val(Strextract(loObject.Name,"ycom","") ))
*brow
Thisform.Caption="Applications launcher ["+Trans(Reccount())+"]  - "+Allt(ylink)
Endproc

Procedure my2
Lparameters nButton, nShift, nXCoord, nYCoord

*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]

With loObject
	.Left=.Left+2
	.Top=.Top+2
Endwith
Thisform.Caption="Applications launcher ["+Trans(Reccount())+"]"
Endproc

Procedure my3
Sele ycurs
m.xlink=Allt(ylink)

Local oShell
oShell = Createobject('WScript.Shell')
Link = oShell.CreateShortcut(m.xlink)

TEXT to m.myvar textmerge noshow
link:<<m.xlink>>		
-arguments=<<link.arguments>>
-description=<<link.description>>
-Hotkey=<<link.hotkey>>
-Icon Location=<<link.iconLocation>>
-target=<<link.targetPath>>
-window style=<<link.windowstyle>>
-working directory=<<link.WorkingDirectory>>
ENDTEXT

Messagebox(m.myvar,0+32+4096,"in clipboard")
_Cliptext=m.myvar
Link=Null
oShell=Null

Endproc


Procedure ytranspa
******
#Define LWA_COLORKEY 1
#Define LWA_ALPHA 2
#Define GWL_EXSTYLE -20
#Define WS_EX_LAYERED 0x80000

Local nExStyle, nRgb, nAlpha, nFlags
nExStyle = GetWindowLong(Thisform.HWnd, GWL_EXSTYLE)
nExStyle = Bitor(nExStyle, WS_EX_LAYERED)
= SetWindowLong(Thisform.HWnd, GWL_EXSTYLE, nExStyle)
= SetLayeredWindowAttributes(Thisform.HWnd, 0,Thisform.ycont.spinner1.Value,LWA_ALPHA)  &&LWA_COLORKEY+
Endproc

Procedure Destroy
Clea Events
Endproc

Procedure KeyPress
Lparameters nKeyCode, nShiftAltCtrl
If nKeyCode=27
	Thisform.Release
Endi
Endproc

Procedure Init
_Screen.WindowState=1
Set Safe Off
Sys(2002)  &&set curs off

Publi m.yrep,m.yrepw
m.yrep=Addbs(Justpath(Sys(16,1)))
m.yrepw=m.yrep+"links"
If !Directory(m.yrepw)
	Md (m.yrepw)
Endi
With Thisform
	.AlwaysOnTop=Thisform.ycont.check2.Value
	.width0=.Width
	.AlwaysOnTop=.T.
	.Left=0
	.Top=Sysmetric(2)-.Height-40
Endwith

#Define LWA_COLORKEY 1
#Define LWA_ALPHA 2
#Define GWL_EXSTYLE -20
#Define WS_EX_LAYERED 0x80000

Local nExStyle, nRgb, nAlpha, nFlags
nExStyle = GetWindowLong(Thisform.HWnd, GWL_EXSTYLE)
nExStyle = Bitor(nExStyle, WS_EX_LAYERED)
= SetWindowLong(Thisform.HWnd, GWL_EXSTYLE, nExStyle)


= SetLayeredWindowAttributes(Thisform.HWnd, 0,Thisform.ycont.spinner1.Value,LWA_ALPHA)  &&LWA_COLORKEY+
Thisform.ygather()
Endproc


Procedure Load
Declare Integer ShellExecute In SHELL32.Dll Integer nWinHandle,;
	STRING cOperation,;
	STRING cFileName,;
	STRING cParameters,;
	STRING cDirectory,;
	INTEGER nShowWindow
Declare Integer GetWindowLong In user32;
	INTEGER HWnd, Integer nIndex

Declare Integer SetWindowLong In user32;
	INTEGER HWnd, Integer nIndex, Integer dwNewLong

Declare Integer SetLayeredWindowAttributes In user32;
	INTEGER HWnd, Integer crKey,;
	SHORT bAlpha, Integer dwFlags
Endproc


Procedure Resize
Thisform.ygather()
Endproc

Procedure DblClick
Thisform.ygather()
Endproc

Procedure MouseMove
Lparameters nButton, nShift, nXCoord, nYCoord
With Thisform.ycont
	If Between (nYCoord,.Top,.Top+.Height)
		.Visible=.T.
	Else
		.Visible=.F.
	Endi
Endwith
Endproc

Enddefine
*
*-- EndDefine: ylauncher

Define Class ycont As Container
Anchor = 768
Top = 600
Left = 0
Width = 804
Height = 37
BackStyle = 0
BorderWidth = 0
BackColor = Rgb(0,0,160)
Name = "yCont"

Add Object command1 As CommandButton With ;
Top = 6, ;
Left = 11, ;
Height = 27, ;
Width = 73, ;
Anchor = 768, ;
Caption = "Add item", ;
MousePointer = 15, ;
SpecialEffect = 2, ;
BackColor = Rgb(128,255,0), ;
Name = "Command1"

Add Object check1 As Checkbox With ;
Top = 6, ;
Left = 475, ;
Height = 17, ;
Width = 89, ;
Anchor = 768, ;
AutoSize = .T., ;
Alignment = 0, ;
BackStyle = 0, ;
Caption = "SpecialEffect", ;
MousePointer = 15, ;
ForeColor = Rgb(255,255,128), ;
value=1,;
Name = "Check1"

Add Object check2 As Checkbox With ;
Top = 6, ;
Left = 570, ;
Height = 17, ;
Width = 93, ;
Anchor = 768, ;
AutoSize = .T., ;
Alignment = 0, ;
BackStyle = 0, ;
Caption = "AlwaysOnTop", ;
Value = .T., ;
MousePointer = 15, ;
ForeColor = Rgb(255,255,128), ;
Name = "Check2"

Add Object spinner1 As Spinner With ;
Anchor = 768, ;
Height = 24, ;
KeyboardHighValue = 255, ;
KeyboardLowValue = 200, ;
Left = 686, ;
MousePointer = 15, ;
SpinnerHighValue = 255.00, ;
SpinnerLowValue = 200.00, ;
Top = 6, ;
Width = 71, ;
Value = 240, ;
Name = "Spinner1"


Procedure Init
With This
	.Left=0
	.Width=Thisform.Width
	.Top=Thisform.Height-.Height
	.ZOrder(0)
Endwith
Endproc


Procedure MouseMove
Lparameters nButton, nShift, nXCoord, nYCoord
Endproc

Procedure command1.Click
Local oform
oform=Newobject("ycreatelink")
oform.Show
Endproc

Procedure check1.Click
Thisform.ygather()
Endproc

Procedure check2.Click
With Thisform
	.AlwaysOnTop=!.AlwaysOnTop
	*.ygather()
Endwith
Endproc

Procedure spinner1.InteractiveChange
If This.Value<200
	This.Value=200
Endi

If This.Value>255
	This.Value=255
Endi

Thisform.ytranspa()
Endproc

Enddefine
*
*-- EndDefine:ycont


Define Class ycreateLink As Form
Top = 17
Left = 135
Height = 258
Width = 458
ShowWindow = 1
DoCreate = .T.
Caption = "Add a link"
MaxButton = .F.
MinButton = .F.
WindowType = 1
Name = "Form1"

Add Object text1 As TextBox With ;
Height = 29, ;
Left = 101, ;
Top = 31, ;
Width = 277, ;
Name = "Text1"

Add Object label1 As Label With ;
AutoSize = .T., ;
Caption = "Shortcut Name", ;
Height = 17, ;
Left = 12, ;
Top = 36, ;
Width = 84, ;
Name = "Label1"

Add Object text2 As TextBox With ;
Height = 29, ;
Left = 118, ;
Top = 74, ;
Width = 277, ;
Name = "Text2"

Add Object label2 As Label With ;
AutoSize = .T., ;
Caption = "Shortct description", ;
Height = 17, ;
Left = 4, ;
Top = 81, ;
Width = 111, ;
Name = "Label2"

Add Object text3 As TextBox With ;
Value = "Ctrl+Alt+Z", ;
Height = 29, ;
Left = 114, ;
Top = 114, ;
Width = 277, ;
Name = "Text3"

Add Object label3 As Label With ;
AutoSize = .T., ;
Caption = "Shortcut  hotkey", ;
Height = 17, ;
Left = 8, ;
Top = 121, ;
Width = 88, ;
Name = "Label3"

Add Object text4 As TextBox With ;
Height = 29, ;
Left = 79, ;
Top = 156, ;
Width = 336, ;
Name = "Text4"

Add Object label4 As Label With ;
AutoSize = .T., ;
Caption = "Target path", ;
Height = 17, ;
Left = 6, ;
Top = 163, ;
Width = 64, ;
Name = "Label4"

Add Object label5 As Label With ;
AutoSize = .T., ;
Caption = "Window style", ;
Height = 17, ;
Left = 5, ;
Top = 199, ;
Width = 74, ;
Name = "Label5"

Add Object text5 As TextBox With ;
Alignment = 3, ;
Value = 1, ;
Height = 25, ;
Left = 87, ;
Top = 192, ;
Width = 61, ;
Name = "Text5"

Add Object command1 As CommandButton With ;
Top = 216, ;
Left = 312, ;
Height = 27, ;
Width = 108, ;
Caption = "SAVE", ;
MousePointer = 15, ;
BackColor = Rgb(128,255,0), ;
Name = "Command1"

Add Object command2 As CommandButton With ;
Top = 225, ;
Left = 12, ;
Height = 25, ;
Width = 97, ;
Caption = "Example", ;
MousePointer = 15, ;
BackColor = Rgb(255,128,64), ;
Name = "Command2"

Add Object command3 As CommandButton With ;
Top = 156, ;
Left = 420, ;
Height = 25, ;
Width = 25, ;
Caption = "...", ;
MousePointer = 15, ;
Name = "Command3"

Procedure Destroy
Set Curs Off
Endproc

Procedure Load
Set Curs On
Endproc

Procedure command1.Click
*!*	*create a complet shortcut in the m.yrepW folder
Local oShell
oShell = Createobject('WScript.Shell')
DesktopPath = oShell.SpecialFolders(m.yrepw)
Link = oShell.CreateShortcut(m.yrepw+"\"+Allt(Thisform.text1.Value)+".LNK")
Link.Description = Thisform.text2.Value
Link.HotKey = Allt(Thisform.text3.Value)
Link.TargetPath = Thisform.text4.Value
Link.WindowStyle =Iif(Between(Thisform.text5.Value,1,3),Thisform.text5.Value,1)

Link.WorkingDirectory = Justpath(Link.TargetPath)
Link.Save()
oShell=Null

Try
	Thisform.Parent.ygather()
Catch
Endtry
Messagebox(m.yrepw+"\"+Allt(Thisform.text1.Value)+" created",0+32+4096,'',1200)
Thisform.Release
Endproc

Procedure command2.Click
Local m.myvar
TEXT to m.myvar noshow
local oshell
oShell = CreateObject("WScript.Shell")
objShortcut = oShell.CreateShortcut("C:\Users\Paul\Desktop\Edit BOOT.INI.lnk")
With objShortcut
 .TargetPath = "C:\Windows\Notepad.exe "
 .Arguments = "C:\Boot.ini"
 .WorkingDirectory = "C:\"
 .Description = "Opens BOOT.INI in Notepad"
 .Hotkey = "Ctrl+Alt+Z"
 .IconLocation = "C:\Windows\System32\Shell32.dll,21"
 .WindowStyle = 3
 .Save
End With
ENDTEXT
Messagebox(m.myvar,0+32+4096,"create link example")
Endproc

Procedure command3.Click
Thisform.text4.Value=Getfile('exe')  &&exe
Endproc

Enddefine
*
*-- EndDefine: ycreateLink


An applications launcher
An applications launcher
An applications launcher

Important:All Codes above are tested on VFP9SP2 & windows 10 pro.

Please come back with any bug.correcting code is usefull to all readers.

To be informed of the latest articles, subscribe:
Comment on this post