Working with "EveryThing" filer instant search.
[Post 277] Everything is a free language C application making an instant search. it can be launched from everything.exe (with an INI file).this is the native GUI.it can be manipulated also with command lines with ES.exe (a DOS programm). vfp can easily work with the ES command line. this is set in original everything options. for this project the files must be in source folder to make the project working: -es.exe -everything.exe (+ini file) -yEverything.exe (vfp application managing everything command lines) The everything.exe is here hidden (even icon in traybar) and works only in background. a complete database rebuild is done everytime Everything.exe runs.it takes less than 1 minute in first rebuild and becomes more fast for the next searches. this database is heavily compressed(ratio= 11:1). The entire database is loaded into memory when Everything is running.The Everything.db is saved to disk when exiting Everything (its ~31Mbytes in my PC....a vfp table~ 160 Mbytes without any compression). Everything requires low level read access to NTFS volumes to index and monitor them. here its used as administrator priveleges to run. the result of any search here is output to a csv file (who support unicode and can be appened to a vfp table/cursor easily). the only one problem with vfp is the unicode import (??? instead of unicode real characters). i added an html unicode view for this vfp caveat. can type any word,extension,..to search in all discs.the first search make some time (less 1mn to rebuild the database) and the next are very fast. the application shows the result in a vfp grid (filename,path,size,date modified,date created,attributes). can sort in the left combo (~ 14 sortings modes) can view path+fullnames in html view (can also preview/print any search). rightclick on any row to fire a contextuel menu... Everything can be downloaded at: https://www.voidtools.com/.i used the portable 64 bits version https://www.voidtools.com/Everything-1.4.1.895.x64.zip. can read more on everything tool in the previous link.(read also FAQ in https://www.voidtools.com/faq/) *for this project,download the complet application in the link below.
Click on code to select [then copy] -click outside to deselect
*1* yeverything.prg (everything.exe(+ini) and es.exe must be in same folder.)
if !_vfp.startmode=0
on shutdown quit
endi
_screen.windowstate=1
set talk off
set safe off
PUBLIC oform
oform=NEWOBJECT("yEverything")
oform.Show
read events
RETURN
*
DEFINE CLASS yEveryThing AS form
Height = 531
Width = 1195
ShowWindow = 2
ShowTips = .T.
AutoCenter = .T.
Caption = "Everything command lines - instant search"
Name = "Form1"
ADD OBJECT grid1 AS grid WITH ;
Anchor = 15, ;
Height = 469, ;
Left = 9, ;
ReadOnly = .T., ;
Top = 65, ;
Width = 1177, ;
visible=.f.,;
Name = "Grid1"
Add object olecontrol1 as olecontrol with oleclass="shell.explorer.2",anchor=15,left=9,width=1177,top=65,height=469,visible=.f.,name="olecontrol1"
ADD OBJECT image1 as image with anchor=15,stretch=2,left=9,top=60,height=469,width=1177,picture="",name="image1"
ADD OBJECT text1 AS textbox WITH ;
Height = 25, ;
Left = 96, ;
ToolTipText = "Rightclick to paste clipboard", ;
Top = 12, ;
Width = 433, ;
fontsize=12,;
Name = "Text1"
ADD OBJECT combo1 as comboBox with left=96 ,top=39 ,width=200,height=20 ,name="combo1"
ADD OBJECT check1 as checkbox with style=1,left=330,top=39,width=180,height=20,fontsize=9,backcolor=255,mousepointer=15,caption="Html fullnames (UTF-8)",value=0,name="check1"
Add Object yprint as image with left=515,top=41,width=16,height=16,stretch=2,picture=home(1)+"graphics\bitmaps\tlbr_w95\print.bmp",mousepointer=15,enabled=.f.,name="yprint"
ADD Object img as image with top=3,left=5,mousepointer=15,name="img"
ADD OBJECT command1 AS commandbutton WITH ;
Top = 12, ;
Left = 540, ;
Height = 25, ;
Width = 25, ;
Picture = home(1)+ "ffc\graphics\find.bmp", ;
Caption = "", ;
Default = .T., ;
MousePointer = 15, ;
Name = "Command1"
ADD OBJECT yel AS label WITH ;
BackStyle = 0, ;
Caption = "", ;
Height = 25, ;
Left = 540, ;
Top = 39, ;
Width = 160, ;
ForeColor = RGB(128,0,64), ;
Name = "yel"
ADD OBJECT label1 AS label WITH ;
BackStyle = 0, ;
Caption = "", ;
Height = 25, ;
Left = 672, ;
Top = 12, ;
Width = 120, ;
ForeColor = RGB(255,0,0), ;
Name = "Label1"
ADD OBJECT labtot AS label WITH ;
BackStyle = 0, ;
Caption = "", ;
Height = 25, ;
Left = 870, ;
Top = 35, ;
Width = 160, ;
fontbold=.t.,;
ForeColor = 255, ;
Name = "Labtot"
ADD OBJECT label2 AS label WITH ;
AutoSize = .T., ;
FontSize = 11, ;
BackStyle = 0, ;
Caption = "Rightclick anywhere on grid row to run the context menu", ;
Height = 19, ;
Left = 800, ;
Top = 12, ;
Width = 184, ;
ForeColor = RGB(128,0,64), ;
Name = "Label2"
procedure combo1.init
with this
.additem("-sort-name-ascending")
.additem("-sort-name-descending")
.additem("-sort-path-ascending")
.additem("-sort-path-descending")
.additem("-sort-size-ascending")
.additem("-sort-size-descending")
.additem("-sort-extension-ascending")
.additem("-sort-extension-descending")
.additem("-sort-date-created-ascending")
.additem("-sort-date-created-descending")
.additem("-sort-date-modified-ascending")
.additem("-sort-date-modified-descending")
.additem("-sort-attributes-ascending")
.additem("-sort-attributes-descending")
.listindex=1
.style=2
endwith
endproc
procedure img.click
local m.myvar
text to m.myvar noshow
es -h > yhelp.txt
endtext
strtofile(m.myvar,"ybat.bat")
result=shellexecute(0,"open","ybat.bat","","",0)
inke(1)
dele file ybat.bat
modi comm yhelp.txt in (thisform.name) same noedit &&nomenu
endproc
procedure combo1.interactiveChange
if ! empty(thisform.text1.value)
thisform.command1.click
endi
endproc
PROCEDURE my
sele ycurs
local m.lcfilename
m.lcfilename=addbs(xpath)+allt(xfilename)
if messagebox("open "+m.lcfilename,4+64)=6
try
result = ShellExecute(0, "open", m.lcfilename,"","",1)
catch
messagebox("no association to open this file",16+4096,1300)
endtry
endi
ENDPROC
PROCEDURE Init
close data all
set defa to addbs(justpath(sys(16,1)))
if !file("es.exe")
messagebox("es.exe everything command line interface must be in source folder...cancelling",16+4096,'',1400)
return .f.
endi
*test if everything.exe exists an installed before and es.exe also
LOCAL loWMI, lcQuery, loResult, loProcess
loWMI = GetObject("winmgmts://")
lcQuery = "select * from win32_process where name='everything.exe'" &&here the exe name application to kill
loResult = loWMI.ExecQuery(m.lcQuery)
messagebox(trans(loResult.count)+" instances of everything.exe running.",0+32+4096,'',1300)
if loResult.count=0
local m.xfilename
m.xfilename=locfile("everything.exe","exe")
if empty(m.xfilename) or !lower(justfname(m.xfilename))=="everything.exe"
return .f.
endi
result = ShellExecute(0, "runas", m.xfilename," /close ","",0) &&run everything.exe mandatory as hidden completly (no in ytraybar) &&-instance 'foxpro' show traybar icon??
endi
thisform.image1.picture=ygrad(1)
erase bmp*.bmp
local m.myvar
text to m.myvar noshow
R0lGODlhMAAwAPcAAAAAAJI7BJY8AJY+Bpg1AJs+AJw+AJs/CKI+AJpABJ1AAZ5CA51BBZtECJ9GDZdHGJpFEJtKFp1IEZ9MFplJGZtOHZ5OHZ1RIZ9WJKNCAKBBBKFEAqBEB6VCAKVEAKZEAKZGAqFGCKJHC6FHDadJBKNJDaRIC6VKDalGAKxFAK9FAK5GAKpIAalJBa1IAK5JAa9JA61KBa9OAqlLCatNDK1PCqBJEaJNEaFNFqZOEKFNGalOEKZRFaRSH6dUHKlVHbFJALJOBrRLALRMALROALZMALdOALBOCbhOALpSAL1SAKFRIKFUIKFVI6NVIqFVJqVXI6JWKadYI6ZYJaNbLKdbLKVcL6lZJKhaJahaKKleL6JbMqJcM6ddMalgLqtmN61lNallOalmOKtkOKpnOqlmPqxlOKxoPaprRattRq5zTK90TLBvQbJxRrFzS7F1T7J1ULJ3VLZ3ULN5VrZ7UrV6VbZ8VLV/Wrh6Vrh/WsBRAMBTAMNTAMFVAMVWAMdYAMhWAMhZAMhaAMpaAMpdAM1aAM1cAMxeAM5cAM9eANBbANBeANJhANNkANRgANViANdiANZlANliANlkANxmAN5pAOFpAOJtAORrAOVsAOpuAOpxAO1xAOxyAO5yAO10APByAPB0APF2APJ0APJ2APR1APR2APJ4APV4APl6APp8APx9APx+AP5+ALaBXbmBXbiBYLqEY7yFY72HZ7yIZ7yIaL2NaryLcL6Pcv+AAP+CAMCLacCObcGOcMKQb8GRcsKVd8WVd8KVecedgsefhMWhg8WhhMqiicymi86pks+vm9GtktKum9Gym9OzmdKyndS2n9O2odS1o9W3ote2o9e3pdW5ote7qNm5pdm6qNm+qti+rdnArdvEstzCs97Fs97FtdzHuN7It+DMueHNveDNweLRwOPSxOTSw+TSx+bUyObVyufXzujXzurXzOjZzura0Onc0eve1Ovg1uzg1+7h2e3k2+3k3vHl3+7m4fHn4PHn4vHo4vLo5PPq5AAAACH/C05FVFNDQVBFMi4wAwEAAAAh+QQFCgAAACwAAAAAMAAwAAAI/gABCBxIsKDBgwgTKlzIsKHDhxAjSpxIsaLFixgzatzIkZsxXLeKcbvHUeG3VzoKGFCgwEACCXDClSyY79cVGkoaYdrEKdOjPjOk+GI3E0C7WDeUUAKVilWuXK1ShbKUhIcceSXtyToQyFOrp1/DPv0kaEMdfhx7lQCECupTXXB1gc2FKpGAYBvF9dhTym0uTIn88DmUSRXYVHuWTNNY5wWmsKQcrcgxpcoNIIVEgeWEgo4+jOQiFDKcSxShBGWANcMGrIyEPqjCFvrRDOMuBp6gtjrUQE3Be7YCMGqay1MMNxf5jRnStlUoEmvyHbTTIRNUVEqcXET3RBBpRD6u/iE8Z4OQ4VWLJsSzqK0Cpa+5hLChl9BMklRfKUnwZvEZBUxP5dLBLArFcoQpT2HiQDUWMfOAdU8h8ItCvdQwSoIjUGNRNBRYEuAHrviTUB1BIJiLJQ5kY5E4FziyylNJeJFOQk70YVgrkEhQjkXxWNFHKk9RcgIxCD2jQSQvphKIDhi9gcKFragyBBTbGETOE0OQAtUoRWiBUTIQWMLKV5XIgIE07+DDDzzKnOHBJS+2UskOvGB0TgWwQZVKJUT40MYsvLTxQxBIfpVKEmCQg5E1ESihJVSqeNJHDCaUEIMfmazSyqaWhFDnRd1QkcEmYhmKCiigmKLKplCV0kEX4+tcRI4YBlyyaStyzeUXfJ8IMQA3F8UTBgvvwfcIJW25FVYrqzTiAg7QBHsHCI/EqUolKLCwBySf4LeKKp1Q0gcJXyRz0Ty2NGAIkGNisoIVbkzhARJ+DFKIH0akoIMr2mD0SwNKAIlrJkNYUE080NSCBhdRPLFFGrAsg9ZFyPDgKHyiFJGFuQO9A0422ICznkZnGNFJWKXoAcUxRRlkThOOuGXKIAsIs0/LBY3DhCRgIUJAHDgfRIYKmuTyBwdz9BO0Qc5gAQIMIuTRztIHTVMLHsOoQzVC9biz9ddghy120AEBADs=
endtext
thisform.img.pictureval=strconv(m.myvar,14)
thisform.grid1.visible=.f.
thisform.image1.visible=.t.
thisform.text1.setfocus
ENDPROC
PROCEDURE Load
&&shellexecute
DECLARE INTEGER ShellExecute IN SHELL32.DLL INTEGER nWinHandle,;
STRING cOperation,;
STRING cFileName,;
STRING cParameters,;
STRING cDirectory,;
INTEGER nShowWindow
Declare integer Sleep in kernel32 integer
ENDPROC
PROCEDURE Resize
try
with thisform.grid1
.column1.width=0.3*thisform.width-10
.column2.width=0.35*thisform.width-10
.column3.width=0.1*thisform.width
.column4.width=0.1*thisform.width
.column5.width=0.1*thisform.width
.column6.width=0.05*thisform.width
endwith
catch
endtry
ENDPROC
PROCEDURE Destroy
*close everything processes
LOCAL loWMI, lcQuery, loResult, loProcess
loWMI = GetObject("winmgmts://")
lcQuery = "select * from win32_process where name='everything.exe'" &&here the exe name application to kill
loResult = loWMI.ExecQuery(m.lcQuery)
if loResult.count>0
FOR EACH loProcess IN loResult
loProcess.Terminate(0)
NEXT
endi
erase bmp*.bmp
clea events
ENDPROC
PROCEDURE text1.RightClick
thisform.ytmenu()
ENDPROC
PROCEDURE command1.Click
local t0
t0=seconds()
thisform.yel.caption=""
thisform.label1.caption=""
thisform.labtot.caption=""
thisform.grid1.recordsource=""
thisform.grid1.refresh
thisform.image1.picture=ygrad(2)
erase bmp*.bmp
thisform.image1.visible=.t.
local m.x
m.x=allt(thisform.text1.value)
if empty(m.x)
return .f.
endi
if file(addbs(sys(2023))+"temp.bat")
erase (addbs(sys(2023))+"temp.bat")
endi
local m.myvar
text to m.myvar textmerge noshow
es "<<m.x>>" -name -path-column -size -dm -dc -attributes -size-format 1 <<thisform.combo1.value>> -export-csv "<<addbs(sys(2023))>>temp.csv"
del <<addbs(sys(2023))>>temp.bat
endtext
*(size kOctets)
set safe off
local m.lcdest
m.lcdest=addbs(sys(2023))+"temp.bat"
strtofile(m.myvar,m.lcdest)
*result = ShellExecute(0, "open", m.lcdest,"","",0)
* better than shellexecute
local oshell
oshell=newObject("wscript.shell")
oshell.run(m.lcdest,0,.t.) &&wait until finished
oshell=null
*
local m.oo
m.oo=addbs(sys(2023))+"temp.csv"
if !file(m.oo)
messagebox("Command line fails to create csv file...cancelling!",16+4096,'',1300)
return .f.
endi
if used("ycurs")
use in select("ycurs")
endi
create cursor ycurs codepage=1252 (xfilename c(90),xpath c(150),xsize c(12),dateModif c(16),datecreat c(16),attrib c(10))
APPEND From (m.oo) type csv
*A CSV file has field names as the first line in the file; the field names are ignored when the file is imported. ok
* brow
sele ycurs
repl all xpath with strconv(xpath,11),xfilename with strconv(xfilename,11)
local m.tot
sum int(val(xsize)) to m.tot
thisform.labtot.caption="total size="+ trans(m.tot/(1024*1024),"99999.999")+" Mbytes"
erase (m.oo)
thisform.image1.visible=.f.
thisform.grid1.visible=.t.
sele ycurs
local m.nr
m.nr=trans(reccount())
thisform.label1.caption=m.nr+ " occurs"
with thisform.grid1
.themes=.f.
.recordsource=""
.recordsource="ycurs"
.recordsourcetype=1
.gridlines=0
.deletemark=.f.
.highlightStyle=2
.column1.width=0.3*thisform.width-10
.column2.width=0.35*thisform.width-10
.column3.width=0.1*thisform.width
.column4.width=0.1*thisform.width
.column5.width=0.1*thisform.width
.column6.width=0.05*thisform.width
.SetAll("DynamicBackColor", "IIF(MOD(RECNO( ), 2)=0, RGB(255,255,255) , RGB(220,255,190))", "Column")
.column1.dynamicForecolor="rgb(128,0,64)"
.column1.fontbold=.t.
.setall("fontbold",.t.,"header")
.setall("fontsize",12,"header")
locate
.refresh
for i=1 to .columncount
bindevent(.columns(i).text1,"rightclick",thisform,"yrmenu")
endfor
thisform.text1.setfocus
endwith
thisform.yel.caption="Ellapsed time="+trans(seconds()-t0)+" sec"
ENDPROC
procedure ytmenu
Define Popup raccourci0 SHORTCUT Relative From Mrow(),Mcol()
Define Bar _Med_slcta Of raccourci0 Prompt "Sélec\<tionner tout" ;
KEY CTRL+A, "Ctrl+A" ;
MESSAGE "Sélectionne tout le texte ou tous les éléments de la fenêtre active"
Define Bar _Med_cut Of raccourci0 Prompt "\<Couper" ;
KEY CTRL+X, "Ctrl+X" ;
MESSAGE "Enlève la sélection et la place dans le Presse-papiers"
Define Bar _Med_paste Of raccourci0 Prompt "C\<oller" ;
KEY CTRL+V, "Ctrl+V" ;
MESSAGE "Place le contenu du Presse-papiers au point d'insertion"
Define Bar _Med_copy Of raccourci0 Prompt "Co\<pier" ;
KEY CTRL+C, "Ctrl+C"
Define Bar 1 of raccourci0 Prompt "\<Search";
MESSAGE "Search"
on selection bar 1 of raccourci0 _screen.activeform.command1.click()
activate popup raccourci0
endproc
Procedure yrmenu
Define Popup raccourci SHORTCUT Relative From Mrow(),Mcol()
Define Bar _Med_slcta Of raccourci Prompt "Sélec\<tionner tout" ;
KEY CTRL+A, "Ctrl+A" ;
MESSAGE "Sélectionne tout le texte ou tous les éléments de la fenêtre active"
Define Bar _Med_cut Of raccourci Prompt "\<Couper" ;
KEY CTRL+X, "Ctrl+X" ;
MESSAGE "Enlève la sélection et la place dans le Presse-papiers"
Define Bar _Med_paste Of raccourci Prompt "C\<oller" ;
KEY CTRL+V, "Ctrl+V" ;
MESSAGE "Place le contenu du Presse-papiers au point d'insertion"
Define Bar _Med_copy Of raccourci Prompt "Co\<pier" ;
KEY CTRL+C, "Ctrl+C" ;
MESSAGE "Copie la sélection et la place dans le Presse-papiers"
Define Bar _Med_undo Of raccourci Prompt "\<Annuler" ;
KEY CTRL+Z, "Ctrl+Z" ;
MESSAGE "Annule la dernière modification"
Define Bar _Med_redo Of raccourci Prompt "\<Rétablir" ;
KEY CTRL+R, "Ctrl+R" ;
MESSAGE "Rétablit la dernière opération annulée"
Define Bar 1 Of raccourci Prompt "\<Capture fullname" ;
MESSAGE "capture fullname (and path)"
Define Bar 2 Of raccourci Prompt "\<Run" ;
MESSAGE "Run with associated application"
Define Bar 3 Of raccourci Prompt "\<Open folder location" ;
MESSAGE "Open folder location"
Define bar 4 Of raccourci Prompt "\<Gridlines 0-1-2-3"
on selection bar 1 of raccourci _screen.activeform.yfullname()
on selection bar 2 of raccourci _screen.activeform.yrun()
on selectio bar 3 of raccourci _screen.activeform.yfloc()
on selection bar 4 of raccourci _screen.activeform.ygrd()
Activate Popup raccourci
Endproc
Procedure yfullname()
sele ycurs
_cliptext=allt(addbs(xPath))+allt(xfilename)
messagebox( allt(addbs(xPath))+allt(xfilename),0+32+4096,'in clipboard',1400)
endproc
Procedure yrun
Sele ycurs
result = ShellExecute(0, "open", addbs(xpath)+Allt(xfilename),"","",1)
If result<=32
Messagebox("An error was occured with window associated application",16+4096,'',1300)
Endi
Endproc
Procedure yfloc
sele ycurs
messagebox(xpath)
local m.xp
m.xp=allt(xpath)
run/n explorer &xp
endproc
procedure ygrd
try
with thisform.grid1
.gridlines=.gridlines+1
endwith
catch
thisform.grid1.gridlines=0
endtry
endproc
procedure check1.interactiveChange
local m.x
m.x=allt(thisform.text1.value)
if empty(m.x)
return .f.
endi
if this.value=0
thisform.olecontrol1.visible=.f.
this.backcolor=255
return .f.
else
this.backcolor=rgb(0,255,0)
endi
thisform.olecontrol1.navigate("about:blank")
if file(addbs(sys(2023))+"temp.bat")
erase (addbs(sys(2023))+"temp.bat")
endi
local m.myvar
text to m.myvar textmerge noshow
es "<<m.x>>" -name -path-column -size -dm -dc -attributes -size-format 1 <<thisform.combo1.value>> -export-txt "<<addbs(sys(2023))>>temp.txt"
del <<addbs(sys(2023))>>temp.bat
endtext
*(2----size kOctets) 1---size in bytes
set safe off
local m.lcdest
m.lcdest=addbs(sys(2023))+"temp.bat"
strtofile(m.myvar,m.lcdest)
local oshell
oshell=newObject("wscript.shell")
oshell.run(m.lcdest,0,.t.) &&wait until finished (better than shellexecute API)
oshell=null
erase addbs(sys(2023))+"temp.bat"
local m.oo
m.oo=addbs(sys(2023))+"temp.txt"
if !file(m.oo)
messagebox("Command line fails to create txt file...cancelling!",16+4096,'',1300)
return .f.
endi
**
local m.x
m.x=filetostr(m.oo)
m.x=strtran(m.x,chr(13),"<BR>")
m.x=strtran(m.x,chr(13)+chr(10),"<br>")
local m.myvar
text to m.myvar textmerge noshow
<!DOCTYPE html>
<html lang="en">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8"/>
</head>
<body bgcolor="bisque" oncontextmenu="return false;">
<center><h2 style="width:60%;border-style:border-width:5px;border-style:groove;color:red;">Search for <<allt(thisform.text1.value)>>- <<allt(thisform.label1.caption)>> - <<allt(thisform.labtot.caption)>> </h2></center>
<p style="color:rgb(70,0,35);backgroundcolor:rgb(255,255,232);fontfamily: Verdana, sans-serif;fontsize;12px;">
endtext
local m.lcdest
m.lcdest=addbs(sys(2023))+"temp.html"
=strtofile(m.myvar+m.x,m.lcdest)
with thisform.olecontrol1
.visible=.f.
.navigate(m.lcdest)
inke(2)
.visible=.t.
endwith
thisform.yprint.enabled=iif(thisform.check1.value=0,.f.,.t.)
****
try
erase (m.oo)
erase (m.lcdest)
catch
endtry
endproc
procedure yprint.click
if thisform.check1.value=0
this.enabled=.f.
return .f.
endi
#DEFINE OLECMDID_PRINT 6 && print
#DEFINE OLECMDID_PRINTPREVIEW 7 && print/preview
#DEFINE OLECMDEXECOPT_DODEFAULT 0
#DEFINE OLECMDEXECOPT_PROMPTUSER 1
try
with thisform.olecontrol1
.ExecWB( OLECMDID_PRINTPREVIEW , 0) &&print preview
*.ExecWb( OLECMDID_PRINT,0) &&print
endwith
catch
endtry
endproc
procedure olecontrol1.beforenavigate
LPARAMETERS pdisp, url, flags, targetframename, postdata, headers, cancel
cancel=.t.
return .f.
endproc
procedure olecontrol1.refresh
nodefault
return .f.
endproc
ENDDEFINE
*
*-- EndDefine: yeveryThing
*generate directly a random gradient bitmap with colors (256x1 px)
function ygrad()
lparameters xx
Local m.xcolor1,m.xcolor2
do case
case xx=1
m.xcolor1=rgb(225,123,60) &&rgb(255*rand(),255*rand(),255*rand())
m.xcolor2=rgb(255,255,49) &&rgb(255*rand(),255*rand(),255*rand())
case xx=2
m.xcolor1=rgb(255,155,155)
m.xcolor2=rgb(213,240,204)
endcase
Local m.x1,m.x2,m.red1,m.green1,m.blue1,m.red2,m.green2,m.blue2
m.x1= color2RGB(m.xcolor1)
m.red1 =Int(Val(Getwordnum(m.x1,1,",") ))
m.green1 =Int(Val(Getwordnum(m.x1,2,",") ))
m.blue1 =Int(Val(Getwordnum(m.x1,3,",")))
m.x2=color2RGB(m.xcolor2)
m.red2 =Int(Val(Getwordnum(m.x2,1,",") ))
m.green2 =Int(Val(Getwordnum(m.x2,2,",") ))
m.blue2 =Int(Val(Getwordnum(m.x2,3,",")))
Local m.bmp,m.red,m.green,m.blue,mfn
*bmp header
m.bmp="BM6"+Chr(3)+Replicate(Chr(0),6)+Chr(0x36)+Replicate(Chr(0),3)+ ;
chr(0x28)+Replicate(Chr(0),4)+Chr(1)+Replicate(Chr(0),2)+ ;
chr(1)+Replicate(Chr(0),3)+Chr(1)+Chr(0)+Chr(0x18)+Replicate(Chr(0),6)+ ;
chr(3)+Replicate(Chr(0),18)
*fill fill linear gradient
For m.i=0 To 255
m.red=Round(red1*(255-m.i)/255+red2*m.i/255,0)
m.blue=Round(blue1*(255-m.i)/255+blue2*m.i/255,0)
m.green=Round(green1*(255-m.i)/255+green2*m.i/255,0)
m.bmp=m.bmp+Chr(m.blue)+Chr(m.green)+Chr(m.red)
Next
*save to unique bmp
m.fn="bmp"+Sys(2015)+".bmp"
Strtofile(m.bmp,m.fn)
Return m.fn
endfunc
Function color2RGB
*convert any color to red,green,blue components
Lparameters RGBChr
m.RGBChr=Left(BinToC(RGBChr,'R'),3)
Local m.rr,m.gg,m.bb
rr=Asc(Substr(m.RGBChr,1,1)) && RED
gg=Asc(Substr(m.RGBChr,2,1)) && GREEN
bb=Asc(Substr(m.RGBChr,3,1)) && BLUE
Return (Trans(rr)+','+Trans(gg)+','+Trans(bb))
Endfunc
download the rar and decompress it.run yEverything.exe (compiled under vfp9 or recompile the project).
|
|
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.