build a vfp run application as windows

Published on by Yousfi Benameur

                  
[Post 271]
 this app is generated as utility an could replace the windows run (this last is fired by  winKey+R ).its movable by mousedown ,but activated near the traybar.
it runs on the traybar with a simple icon to click (no contextuel menu and no class systray.vcx to add).
a click on icon fires the application yrun.
on the yrun can type a filename, search in dialog,...a filename to execute (button run).
the filename execution is made by shellexecute API then the registered associated application to open this filename.
if there is no application for that, windows fire a dialog to choose an application, otherwise an error occurs (shellexecute result<=32).
can rightclick on textbox to fill it with the clipboard text (captured).dblclick to clear the textbox.
the button "hide" ,hides the form and must reclick the traybar icon to show it.
the button X quit application (after asking).
Added: support of oledrag and drop filenames from explorer to texbox.
       button run is default(issue enter in textbox to run the filename typed)
       History of successfull filenames executed (to clean by user).


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


*1*created on friday 06 of april 2018  save as yrun.prg for generating an exe in next.
*build a similar windows run but i traybar with icon.see the help in application.this have additional capabilities compratively to windows run app.
*updated on sunday 08 of april 2018 by adding an history of filenames executed successfully.OP can clean the txt file created.

Set Defa To Addbs(Justpath(Sys(16,1)))
_Screen.WindowState=1
set date short

Public oform
oform=Newobject("yRun")
oform.Show
Inke(1)
=ytray(oform.HWnd,"favicon.ico")
Read Events
Return
*
Define Class yRun As Form
  BorderStyle = 0
  Top = 1
  Left = 1144
  Height = 164
  Width = 357
  ShowWindow = 2
  ShowInTaskbar = .F.
  titlebar=1
  Caption = "yRUN"
  ControlBox = .F.
  MaxButton = .F.
  MinButton = .F.
  AlwaysOnTop=.T.
  ShowTips=.T.
  OLEDragMode = 1
  Name = "Form1"

  Add Object image1 As Image With ;
    Picture = "favicon.ico", ;
    BackStyle = 0, ;
    Height = 32, ;
    Left = 12, ;
    Top = 12, ;
    Width = 32, ;
    tooltiptext="click for web site",;
    mousepointer=15,;
    Name = "Image1"

  Add Object label1 As Label With ;
    AutoSize = .T., ;
    FontBold = .T., ;
    FontSize = 10, ;
    WordWrap = .T., ;
    BackStyle = 0, ;
    Caption = "Enter a name of exe file, a folder or  a document to open", ;
    Height = 34, ;
    Left = 72, ;
    Top = 24, ;
    Width = 212, ;
    Name = "Label1"

  Add Object xquit As label With ;
    AutoSize = .T., ;
    Top = 1, ;
    Left = Thisform.Width-27-2, ;
    Height = 27, ;
    Caption = "X", ;
    MousePointer = 15, ;
    backcolor=rgb(255,165,0) ,;
    backstyle=0,;
    fontbold=.t.,;
    fontsize=16,;
    tooltiptext="Exit/Remove from traybar"
  Name = "xquit"

  Add Object text1 As TextBox With ;
    FontName = "Courier New", ;
    FontSize = 8, ;
    Height = 25, ;
    Left = 12, ;
    SelectOnEntry = .T., ;
    Top = 72, ;
    Width = 300, ;
    OLEDragMode = 1, ;
    OLEDropMode = 1, ;
    Name = "Text1"

  Add Object command1 As CommandButton With ;
    AutoSize = .T., ;
    Top = 72, ;
    Left = 317, ;
    Height = 27, ;
    Width = 27, ;
    Caption = "...", ;
    MousePointer = 15, ;
    Name = "Command1"

  Add Object command2 As CommandButton With ;
    AutoSize = .F., ;
    Top = 129, ;
    Left = 196, ;
    Height = 27, ;
    Width = 51, ;
    Caption = "Run", ;
    MousePointer = 15, ;
    default=.t.,;
    Name = "Command2"

  Add Object command3 As CommandButton With ;
    AutoSize = .F., ;
    Top = 129, ;
    Left = 260, ;
    Height = 27, ;
    Width = 51, ;
    Caption = "Hide", ;
    MousePointer = 15, ;
    Name = "Command3"

     Add Object ytl1  As Label With ;
    AutoSize = .T., ;
    Top = 129, ;
    Left = 4, ;
    Caption = "yRUN", ;
    fontsize=20,;
    backstyle=0,;
    fontbold=.T.,;
    forecolor=0,;
    Name = "ytl1"

     Add Object ytl2  As Label With ;
    AutoSize = .T., ;
    Top = 129+2, ;
    Left = 4+2, ;
    Caption = "yRUN", ;
    fontsize=20,;
    backstyle=0,;
    fontbold=.T.,;
    forecolor=255
    Name = "ytl2"

    Add Object yhis  As Label With ;
    AutoSize = .T., ;
    Top = 109, ;
    Left = 5, ;
    Caption = "History", ;
    fontunderline=.t.,;
    backstyle=0,;
    forecolor=rgb(0,0,255),;
    mousepointer=15,;
    Name = "yhis"

  Add Object yhelp  As Label With ;
    AutoSize = .T., ;
    Top = 129, ;
    Left = 260+51+4, ;
    Caption = "?", ;
    fontsize=16,;
    backstyle=0,;
    fontbold=.T.,;
    MousePointer = 15, ;
    Name = "yhelp"

  Procedure yhis.click
  local lcHistory
  m.lcHistory=addbs(justpath(sys(16,1)))+"yhisto.txt"
  if file(m.lcHistory)
  run/n notepad &lchistory
  else
  wait window "not yet created" timeout 1
  endi
  endproc

  Procedure text1.OLEDragDrop
Lparameters oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord
Local i, cText, cNewStr
If oDataObject.GetFormat(1)	&&CF_TEXT
cText = oDataObject.GetData(1)
This.Value =cText     && cNewStr
Endif
If oDataObject.GetFormat(15)	&&CF_TEXT
Local aFiles[1]
oDataObject.GetData(15,@aFiles)  &&can be sorted here
effect =2  && copy
This.Value =aFiles(1)   &&retain only first file if selection
This.Refresh
Endif
Endproc

Procedure text1.OLEDragOver
Lparameters oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord, nState
Do Case
Case nState == 0		&&DRAG_ENTER
Do Case
Case oDataObject.GetFormat("OLE Variant Array")	&& Array
	This.OLEDropHasData = 1		&&DROPHASDATA_USEFUL
	This.OLEDropEffects = 1+2	&&DROPEFFECT_COPY + DROPEFFECT_MOVE

Case oDataObject.GetFormat(1)				&& Text
	This.OLEDropHasData = 1		&&DROPHASDATA_USEFUL
	This.OLEDropEffects = 1+2	&&DROPEFFECT_COPY + DROPEFFECT_MOVE

Case oDataObject.GetFormat(15)				&& Files CF_HDROP
	This.OLEDropHasData = 1		&&DROPHASDATA_USEFUL
	This.OLEDropEffects = 4		&&DROPEFFECT_LINK
Otherwise
	This.OLEDropHasData = 0		&&DROPHASDATA_NOTUSEFUL
Endcase
Case nState == 1	&& Drag Leave
Case nState == 2	&& Drag Over
Endcase
Endproc

  Procedure Init
    With This
      .titlebar=0
      .Left=Sysmetric(1)-.Width-50
      .Top=Sysmetric(2)-.Height-2*35
    Endwith
    local m.myvar
text to m.myvar noshow
AAABAAEAICAAAAEAIACoEAAAFgAAACgAAAAgAAAAQAAAAAEAIAAAAAAAABAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAHKSqgBifZIYapKrJ////wCOtccAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAcITEAAAAAAClFW4YvS2C+U42sElKNrQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAChXegAnUHErK36u4CqGu/w+nM1kAHvDAILA3QAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA5YYAAOldzEjR0nqgrk87/JpnY/zSUyNtPnsU1MpbDAKXF2gAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADHyM8AAABHAHCeuCc5irijLICy/CePyP8omdf/LXus/zWTx85Foc0+kLbGAl6nyAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABUYGQAFBQcBbYuYBKzEzgesvsMHkbbHD3etyjFepcx6QZzO2CqZ1P8ndKT/JovD/yia2f8ocJ3/KorB/y+a1eg9nc+HS6HLMm2rxg6duMEHr7/HB5G2xwhsj6ECcpSlAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFxgaAAYAAAkwVnF6Q5jHvECfz7o9ndHJOZ3R6i+a0/4nmNX/JpbS/yZkjP8okMv/J5ra/yVwnv8mdqj/JprY/ymZ1P4umtLsNJvRyD2d0bpBn9C9SJO7l09ofBRMbYQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAASFhsADAAABy5NY3MqeKb2J5jX/yaY1v8mmNb/JprY/yib2v8oe63/IFV4/yiX1f8nmtj/JoC0/yBVeP8rltL/KZvZ/yeZ1v8mmNb/J5jW/yuW0f46i7eVVXaOE0h6mAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAsOEgAEAAAOJ1BppS2HvP8nmNX/J5nX/ymW0f8oeKf/HlBw/xQoOf8lbJf/KJrY/yeY1v8nldD/GDxU/xY3Tv8kYon/Kom+/yia1/8nmNb/KZjV/zWOvrtAZX4cOmmIAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABUkNQATHSg6JnWj7iea2f8qj8j/GkZj/wkMEv8CAAD/FS0//yuRy/8nmdb/JpjW/yea2f8lbZf/CAgL/wMCBP8PIC7/JW6Z/yeZ1v8pmdT6N5XEVTal3QAJCRAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADVzpwAGDpbADBOZjArf7HoKZjV/x5KaP8DAgT/AQAA/woTHP8nd6b/KJnY/yaY1v8nmNb/J5jX/ymV0f8cRWH/AwED/wEAAP8MFB7/Jnyr/yqa1vw9nM5jF47dAHevtwAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAChx9sArdHiBYSyyxtepsxYOZTFximY1P8pgLH/DBEY/wIAAP8KFB7/ImqT/yiZ1/8nmNb/J5jW/yeY1v8nmNb/JpnX/yqPx/8XPlb/BAQG/wIAAP8aQlr/KZjU/y2Z0+A+ntFrSp7JGYa3ygMAOnwA////AAAAAAAAAAAAEg4UAAAAAARBbIR5QpvL3jGa1Pgomdb/J5va/yJljf8ICxD/FTNI/yV6qf8pmdf/JpjW/yeY1v8nmNb/KJjW/yeY1v8mmNb/J5nX/yiSy/8eWXv/DBgj/xAhL/8qjsf/KZjX/yqY1fowmdPZP5C8kFB0ixFMd5IAAAAAAAAAAAAXFBoAAAAAABouQEknapTgKJbS/yaZ1/8rk8//KnCf/yZyoP8rk83/JprY/yaY1v8nmNb/J5jW/yiU0P8rkc3/J5jX/yeY1v8mmNb/JpnX/ymZ1f8ohrz/JWaR/y6DuP8nmNX/J5jW/y2Qx+oyc5xfQDtEBDpbdAAAAAAAAAAAAAAAAAAaDw8AI4PEABkoOE0ocp7qKJnW/yiX1P8pmNT/J5rZ/yiY1v8nmNb/J5jW/yeY1v8nmdf/KY7J/yqGvf8nmdf/J5jW/yeY1v8nmNb/KJjW/yaZ1/8omtj/K5bS/yeY1v8qls7zMH+nYQAAAAAmPlYAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAwUAAAAAAR9CXoEpjMT/JpnY/yeY1v8nmNb/J5jW/yeY1v8nmNb/J5jW/yeZ1/8ojMX/KH6x/yeZ1/8nmNb/J5jW/yeY1v8nmNb/J5jW/yaY1v8mmNb/KJjW/zSYzJ5LcX4GPHqYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAASHi8AERYkKCdvm+Epmdf/J5jW/yeY1v8nmNb/J5jW/yeY1v8nmNb/J5nX/yeKwv8ndaT/J5nX/yeY1v8nmNb/J5jW/yeY1v8nmNb/J5jW/yeY1v8umdXySJ/RQj+c0QAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAYEBQAAAAABIEtojyqPxv8nmdf/J5jW/yeY1v8nmNb/J5jW/yeY1v8nmdf/KI7I/yx5qv8omdf/J5jW/yeY1v8nmNb/J5jW/yeY1v8nmNb/KJjW/zec0rNyrc4KYanRAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAQVNmAADe/wA0bpNyK4/G/ieZ1/8nmNb/J5jW/yeY1v8nmNb/J5jW/yeY1/8rkcv/L36y/yiY1/8nmNb/J5jW/yeY1v8nmNb/J5jW/yeY1v8omNb/NZzTxk+gzSBFntIAlaSVAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFBOXQAdzf8AOHSaTy+RyOgpmdX/J5jW/yeY1v8nmNb/J5jW/yeY1v8nmNb/JpjW/ymU0P8ui8L/J5jX/yeY1v8nmNb/J5jW/yeY1v8nmNb/J5jW/yeY1v8omNb/M5rQr1CjyhZFn8oAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAN3GWADhlhS0wi77YKZfX/yiY1v8nmNb/J5jW/yeY1v8nmNb/J5jW/yeY1v8nmNb/J5jW/yiY1f8mmNf/J5jX/yeY1v8nmNb/J5jW/yeY1v8nmNb/J5jW/yeY1v8qmNX/O5/RkXuxyAVdqMsAAAAAAAAAAAAAAAAAAAAAACQ/YQAiJEAKL3+vpSeY0v8nmNb/J5jW/yeY1v8nmNb/J5jW/yeY1v8nmNb/J5jW/yeY1P8qltT/KpbT/ymX1P8omdf/J5jX/yeY1v8nmNb/J5jW/yeY1v8nmNb/J5jW/yiY1v8umtPyQp3MTyuXzgCKv9EAAAAAAAAAAAALCAwAN5XIACtnilYqkcn3JpnW/yeY1v8nmNb/J5jW/yeY1v8nmNb/J5jW/yaY1/8rlc32K3ObwidljKUpZYymKWSHuSZsmOIojs7/KJHU/yiR0/8nkdL/J5LT/yeS0/8nktP/J5LS/yiS0/83kc/EWY6/FVSPwQAAAAAAAAAAABYkOgAXEB0NK3WluyiV1P8nlNX/J5TV/yeU1f8nlNX/J5TV/yeU1f8nlNX/KpTP/TSLt41EUVcMAAAAARwCAAEkAAAFEyAxRiBNieckZbz/I2S8/yNku/8kZbz/JGW8/yRlvP8kZb3/JGW9/ylkuvo5ZaxZL2GxAGeHrwAAAAAAITprACA1YT4lX6vxI2rA/yRowP8lab//JWjA/yRowP8lacD/JWnA/yZot/wuaKGdRmuIEUJtkgAAAAAAAAAAAAIBBAAAAAABFCA8YyJHie4mW7f/JFu6/yZbuf8nW7n/J1u5/yZbuf8lWrn/JVy4/zJjs693h6sGX32zABQVFAA6eu8AITtygCdYsf8mW7j/Jlu4/yZbuP8mW7j/Jlu5/yVcuf8nV6rzKEmJiSUpUBAhMWEA/wAAAAAAAAAAAAAAAAAAABMKCAAJAAADFB47UiFAfNonWa7/JV26/yZbuv8mW7n/Jlu5/yZbuf8mW7n/LF+23UZtrh5FbK4ADhAUAAAAAAQiQX2vJ1u3/yZbuf8lW7r/JVy6/yVcuf8mWbH9KFCZyylEe1UfITAFIixLAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADN//8ADhMlLRwyYKkkTJX2J1q0/yZdu/8lXLr/Jlu6/yVbuf8oXbj0PGezPThlswAAAQYAAAAAByBFibomXLr/Jly7/ydbtv8nV6r5J0+X0CZEfXUbKkwZN2vIAAkDBAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAMCxAADwgECxUfOlQfN2i4JEuR8iZXrf8nXLn/Jly7/ydeufw6Z7NUMmKzAAACCgAAAAAHIkKAuidTovskTJTZJEOAoB81aVUcJUUWKAAAABkPEQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFhQbAA4KCQwSGS8/Gi5YiCA+eMkkS5LuJ1Wj+TplqVIzX6cAAwQMAAAAAAMbKEtIHixURxQbMRsAAAADBQIGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAABBAMEDxAXLTMbK05UK0FnFyU6YAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA//5////+P////D////gf///wB//4AAAf+AAAH/gAAB/4AAAf/AAAP/wAAD/gAAAHwAAAA+AAAAPwAAAP8AAAD/gAAB/4AAAf/AAAH/gAAA/wAAAH4AAAB+AAAAPAAAADwAPAAcAH4AGAD/gBgD/8AYD//wGD///B//////////8=
endtext
strtofile(strconv(m.myvar,14),"favicon.ico")
thisform.image1.pictureVAl=strconv(m.myvar,14)
  Endproc

  procedure image1.click
  local o
  o=newObject("hyperlink")
  o.navigateto("www.yousfi.over-blog.com")
  o=null
  endproc


  procedure xquit.mouseEnter
  LPARAMETERS nButton, nShift, nXCoord, nYCoord
  this.backstyle=1
  endproc

  procedure xquit.mouseLeave
  LPARAMETERS nButton, nShift, nXCoord, nYCoord
  this.backstyle=0
  endproc

  Procedure xquit.Click
    If Messagebox("Want indeed to quit ?",4+64)=6
      Try
        *compose a string of parameters (as NOTIFYICONDATA structure)
        lcNotifyString = lcStartNotifyString + long2str(0)
        lcNotifyString = Padr(long2str(Len(lcNotifyString)+4),4," ") + lcNotifyString
        Shell_NotifyIcon(NIM_DELETE, lcNotifyString) && supprimer l'icône de TrayBar
        DestroyIcon(phiconLarge)
        DestroyIcon(phiconSmall)
        DoEvent
      Catch
      Endtry
      Thisform.Release
    Endi
  Endproc

  Procedure yhelp.Click
    Local m.myvar
    TEXT to m.myvar noshow
 this app is generated as utility an could replace the windows run (this is fired by  winKey+R ).its movable by mousedown.
it runs on the traybar with a simple icon to click (no contextuel menu and no class systray.vcx to add).
a click on icon fires the application yrun.
on the yrun can type a filename, search in dialog,...a filename to execute (button run).
the filename execution is made by shellexecute API then the registered associated application to open this filename.
if there is no application for that, windows fire a dialog to choose an application, otherwise an error occurs (shellexecute result<=32).
can rightclick on textbox to fill it with the clipboard text (captured).dblclick to clear the textbox.
the button "hide" ,hides the form and must reclick the traybar icon to show it.
the button X quit application (after asking).
Added:  -support of oledrag and drop from explorer to texbox.
        -button run is default(issue enter in textbox to run the filename typed)
        -history of filenames run successfully with date/time.OP can clean this txt file created in source folder.
Yousfi benameur 06 april 2018   yousfi.over-blog.com
    ENDTEXT
   * Messagebox(m.myvar,0+32+4096)
    	local oshell  && if big string
    	oshell=newobject("Wscript.shell")
    	oshell.popup(m.myvar,0,"Summarey help",32)
    	oshell=null
Endproc

  Procedure Destroy
  erase favicon.ico
    Clea Events
  Endproc

  Procedure Load
    &&shellexecute
    Declare Integer ShellExecute In SHELL32.Dll Integer nWinHandle,;
      STRING cOperation,;
      STRING cFileName,;
      STRING cParameters,;
      STRING cDirectory,;
      INTEGER nShowWindow

    Declare Integer ReleaseCapture In WIN32API
    Declare Integer SendMessage In WIN32API Integer, Integer, Integer, Integer
  Endproc

  Procedure text1.RightClick  && rightclick to fill textbox with clipboard
    This.Value=_Cliptext
  Endproc

  Procedure text1.DblClick
    This.Value=""
  Endproc

  Procedure text1.Init
    This.Value=""
  Endproc

  Procedure command1.Click
    Local m.lcfilename
    m.lcfilename=Getfile()
    If Empty(m.lcfilename)
      Return .F.
    Endi
    Thisform.text1.Value=Proper(m.lcfilename)
    With Thisform.text1
      .SetFocus
      Keyboard "{CTRL+A}"
    Endwith
  Endproc

  Procedure command2.Click
    Local m.lcfilename
    m.lcfilename=Thisform.text1.Value
    If Empty(m.lcfilename)
      Return .F.
    Endi
    m.lcfilename=Allt(m.lcfilename)
    If Directory(m.lcfilename) And Right(m.lcfilename,1)="\"
      m.lcfilename=Substr(m.lcfilename,1,Len(m.lcfilename)-1)
    Endi
    result = ShellExecute(0, "open",m.lcfilename ,"","",1)
    If m.result<=32
      Messagebox("An error was occured  with "+m.lcfilename,16+4096,"Error",1500)
     else
     local m.x
      m.x=PADR(ttoc(datetime()) ,30)+chr(9)+   m.lcfilename+chr(13)+chr(10)
     strtofile(m.x,"yhisto.txt",.t.)  &&appended to yhisto.txt if success
    Endi
  Endproc

  Procedure command3.Click
    * Thisform.hide
    =ytray(oform.HWnd,"favicon.ico")
  Endproc

  Procedure MouseDown  &&move the form
    Lparameters nButton, nShift, nXCoord, nYCoord
    lnHandle = Thisform.HWnd
    param1 = 274
    param2 = 0xF012
    Thisform.MousePointer=15
    bb=ReleaseCapture()
    bb=SendMessage(lnHandle, param1, param2,0)
    Thisform.MousePointer=0
  Endproc

Enddefine
*
*-- EndDefine:yRun

Procedure ytray
  Lparameters HWnd,lcIconNameFile

  If Pcount()<2 Or !Vartype(HWnd)="N" Or  !( Lower(Justext(lcIconNameFile))=="ico")
    Messagebox("Incorrect parameters...cancelling.",16+4096,'',1200)
    Return .F.
  Endi

  If Vartype(lcIconNameFile)="C" And !Empty(lcIconNameFile)
    If Atc(".ico",lcIconNameFile)=0
      lcIconNameFile = lcIconNameFile + ".ico"
    Endif
    _Screen.Icon = lcIconNameFile
  Else
    If Empty(_Screen.Icon)
      Messagebox ("Le fichier d'icône n'est pas défini.", 48, "Erreur")
      Return .F.
    Else
      lcIconNameFile = _Screen.Icon
    Endif
  Endif
  If !File(_Screen.Icon)
    Messagebox ("Fichier d'icône introuvable", 48, "Erreur")
    Return .F.
  Endif

  If !File(lcIconNameFile)
    Messagebox ("Fichier d'icônes non trouvé" + lcIconNameFile + ".", 48, "Erreur")
    Return .F.
  Endif

  * declare WinAPI
  Declare Integer ShowWindow In WIN32API Integer, Integer
  Declare Integer GetAsyncKeyState In "user32" Long
  Declare Integer SetForegroundWindow In "USER32" Integer
  Declare Integer Shell_NotifyIcon In "SHELL32" Long, String
  Declare Long ExtractIconEx In "shell32.dll" String lpszFile, Long nIconIndex, Long @phiconLarge, Long @phiconSmall, Long nIcons
  Declare Long DestroyIcon In "user32" Long hIcon

  * initit constants
  Local VK_LBUTTON, VK_RBUTTON, NIM_ADD, NIM_MODIFY, NIM_DELETE, NIF_MESSAGE, NIF_ICON, NIF_TIP, ;
    SW_HIDE, SW_SHOW, SW_MINIMIZE, SW_RESTORE

  SW_HIDE = 0
  SW_SHOW = 5
  SW_MINIMIZE = 6
  SW_RESTORE = 9

  VK_LBUTTON = 1
  VK_RBUTTON = 2

  NIM_ADD = 0
  NIM_MODIFY = 1
  NIM_DELETE = 2
  NIF_MESSAGE = 1
  NIF_ICON = 2
  NIF_TIP = 4

  * init variables
  Local HWnd, phiconLarge, phiconSmall, lcTip, lcStartNotifyString, lcNotifyString, lnKey

  * tip text
  lcTip = "yRun.exe -  Click to restore original  window."   && 64 chars max

  * Variables  to store icon descriptors
  phiconLarge=0
  phiconSmall=0
  * return the icon descriptors
  ExtractIconEx(lcIconNameFile,0,@phiconLarge,@phiconSmall,1)

  * build a string of parameterss (as NOTIFYICONDATA structure)
  lcStartNotifyString = long2str(HWnd) + long2str(0) + long2str(Bitor(Bitor(NIF_ICON,NIF_TIP),NIF_MESSAGE))+ long2str(0x201)
  lcNotifyString = lcStartNotifyString + long2str(phiconSmall)+ Alltrim(Padr(Left(lcTip,64),64," "))
  lcNotifyString = Padr(long2str(Len(lcNotifyString)+4),4," ") + lcNotifyString

  Shell_NotifyIcon(NIM_ADD, lcNotifyString) && ajouter une icône à TrayBar

  * reduce and hide vfp window
  ShowWindow(HWnd, SW_MINIMIZE)
  ShowWindow(HWnd, SW_HIDE)

  Do While .T.  &&&& waits indefinitely for a keystroke.(M: check for a mouse click)
    Inkey(0,"M")
    lnKey = GetAsyncKeyState(VK_LBUTTON)
    If lnKey<>0
      Exit
    Endif
  Enddo

  * make vfp forward
  SetForegroundWindow(HWnd)

  * reduce and hide  window
  ShowWindow(HWnd, SW_SHOW)
  ShowWindow(HWnd, SW_RESTORE)
  Return

Function long2str
  * Passed : 32-bit non-negative numeric value (m.longval)
  * Returns : ASCII character representation of passed  value in low-high format (m.retstr)
  * Example :
  * m.long = 999999
  * m.longstr = long2str(m.long)
  Parameters m.longval
  Private i, m.retstr
  m.retstr = ""
  For i = 24 To 0 Step -8
    m.retstr = Chr(Int(m.longval/(2^i))) + m.retstr
    m.longval = Mod(m.longval, (2^i))
  Next
  Return m.retstr
Endproc




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


*2* created on friday 06 of april 2018
*this builds a project, add files and compile into standalone executable yrun.exe (as tool).
*yrun.prg above must be present here.

set defa to addbs(justpath(sys(16,1)))
set safe off
text to m.myvar noshow
screen=off
resource=off
safe=off
endtext
strtofile(m.myvar,"config.fpw")

BUILD PROJECT yproj FROM   yrun.prg,config.fpw recompile

* can achieve some modification in current project here
MODI PROJECT YPROJ NOWAIT
WITH _VFP.ACTIVEPROJECT
.debug=.f.
.encrypted=.t.
**can add all info in vfp menu/project/infomations dialog box as made manually
.close()
endwith

BUILD EXE yrun FROM yproj recompile
dele file yproj*.*
run/n  yrun.exe


build a vfp run application as windows
build a vfp run application as windows
build a vfp run application as windows

                     

Yousfi Benameur


Important:All Codes above are tested on VFP9SP2 & windows 10 pro 64 bits version 1709(fall creator) & IE11 emulation. Navigator: firefox - screen:32 pouces.

build a vfp run application as windows
To be informed of the latest articles, subscribe:
Comment on this post
C
Hello Dear, I have read your article and it's really so nice and useful content... You have maintained your website very nicely...
Reply