A pdf Reader with horizontal scroll page by page
![]()
[Post 275] In previous post i presented a PDF reader but as native vertical scrolling position. Modern apps make readers page by page as slideshow (the pdf reader on win 8.1 have this improvment but it erased by microsoft in win10).. but how to achieve this goal? the idea is to have the pdf in separates pages and then present each page in the screen with a navigation. i found a free pdf tool named "pdfTK" running as DOS programm (http://www.pdfhacks.com/pdftk/).there is licence to read.retain only the pdftk.exe with this work (2255 ko). this can with a command line split any pdf to single separatly pages orderedas with printing. a cursor gather all pages each one in a memo file and then can build a summary navigation as a any pdf viewer/reader horizontally. -can open and view any local pdf file, form titlebar on/off,show/hide command container. -can memorize pdf readings in a temp txt file to re call each one for reading. -can advance next,previous page, go top page, go bottom page, fill pdf horizontally,zoom in ,zoom out -can show/hide pdf native toolbar,pannels,scrollbar (on/off) -can view any page number. -can play acustom web diaporama,a custom web classic music playlist (play/stop).can adjust sound volume. -the temp file histo.txt can be erased , it rebuilds itself in code. for preventing any broken link i made all project in a download (see below) *the yPDFReaderH.prg is split into 2 parts below(for sections insuffisent space) *Warning : Internet must be connected and fast (for web urls as diaporama,music) .if internet is very slow bad result are obtained with diaporamas/music particulary .there is a function yinternet() testing the connection from form init.add it to the zip download if want.
Click on code to select [then copy] -click outside to deselect
*1* created on sunday 29 of april 2018
*a pdf Reader page per page horizontally.
*Warning:this is the part1 or the yPDFReaderH.prg.please complete this prg with the part2.prg below (2 classes+2 fucntion).
if !_vfp.startmode=0
on shutdown quit
endi
publi m.yrep
m.yrep=addbs(justpath(sys(16,1)))
set defa to (yrep)
if !file("pdftk.exe")
messagebox("pdftk.exe must be in source folder mandatory...cancelling",16+4096,'',1300)
return .f.
endi
PUBLIC oform
oform=NEWOBJECT("yPDFReaderH")
oform.Show
read events
RETURN
*
DEFINE CLASS yPDFReaderH AS form
Height = 625
Width = 1133
ShowWindow = 2
ShowTips = .T.
AutoCenter = .T.
Caption = "yPDFReaderH"
height0 = .F.
ycl = 0
mus = 0
ii = 0
Name = "Form1"
ADD OBJECT olecontrol1 AS olecontrol WITH ;
Oleclass="shell.explorer.2",;
Top = 3, ;
Left = 72, ;
Height = 513, ;
Width = 960, ;
Anchor = 15, ;
Name = "Olecontrol1"
ADD OBJECT image1 AS image WITH ;
Anchor = 768, ;
Stretch = 2, ;
Height = 49, ;
Left = 1052, ;
MousePointer = 15, ;
Top = 226, ;
Width = 49, ;
Name = "Image1"
ADD OBJECT image2 AS image WITH ;
Anchor = 768, ;
Stretch = 2, ;
Height = 49, ;
Left = 6, ;
MousePointer = 15, ;
Top = 238, ;
Width = 49, ;
Name = "Image2"
ADD OBJECT container1 AS ycnt WITH ;
Anchor = 768, ;
Top = 544, ;
Left = 60, ;
Width = 1020, ;
Height = 75, ;
BackStyle = 1, ;
BorderWidth = 0, ;
BackColor = RGB(223,255,191), ;
Name = "Container1"
ADD OBJECT ycnt1 AS ycnt1 WITH ;
Name = "ycnt1"
ADD OBJECT ybkg AS image WITH ;
Anchor = 15, ;
Stretch = 2, ;
Height = 84, ;
Left = -3, ;
Top = 2, ;
Visible = .F., ;
Width = 84, ;
Name = "ybkg"
ADD OBJECT timer1 AS timer WITH ;
Top = 18, ;
Left = 1076, ;
Height = 23, ;
Width = 23, ;
Enabled = .F., ;
Interval = 10000, ;
Name = "Timer1"
ADD OBJECT timer2 AS timer WITH ;
Top = 19, ;
Left = 1046, ;
Height = 23, ;
Width = 23, ;
Enabled = .F., ;
Interval = 3000, ;
Name = "Timer2"
ADD OBJECT yshp AS shape WITH ;
Top = 114, ;
Left = 13, ;
Height = 37, ;
Width = 73, ;
BackStyle = 1, ;
BorderStyle = 0, ;
DrawMode = 9, ;
Visible = .F., ;
SpecialEffect = 0, ;
Name = "ySHP"
PROCEDURE Destroy
*****
*vfp have always problem to erase fill folder (even if all files deleted)
*this is a dos method to do that easily
local m.zrep
m.zrep=m.yrep+"temp"
local m.myvar
text to m.myvar textmerge noshow
rd /s /q "<<m.zrep>>"
del ubat.bat
endtext
strtofile(m.myvar,"ubat.bat")
ShellExecute(0, "open", "ubat.bat","","",0)
*another solution
*fso = CREATEOBJECT("Scripting.FileSystemObject")
*fso.DeleteFolder(m.yrep+"temp")
*fso=null
***
erase m.yrep+"ybat.bat"
erase doc_data.txt
erase addbs(sys(2023))+"ytemp.m3u"
wmp=null
release wmp
m.yrep=null
release m.yrep
clea events
ENDPROC
PROCEDURE Load
DECLARE INTEGER ReleaseCapture IN WIN32API
DECLARE INTEGER SendMessage IN WIN32API INTEGER, INTEGER, INTEGER, INTEGER
Declare integer mouse_event In WIN32API Integer,Integer,Integer,Integer,Integer
Declare Integer SetCursorPos In WIN32API Integer, Integer
Declare Integer SendMessage In user32;
INTEGER HWnd,;
INTEGER Msg,;
INTEGER wParam,;
INTEGER Lparam
&&shellexecute
DECLARE INTEGER ShellExecute IN SHELL32.DLL INTEGER nWinHandle,;
STRING cOperation,;
STRING cFileName,;
STRING cParameters,;
STRING cDirectory,;
INTEGER nShowWindow
set talk off
set safe off
set curs off
_screen.windowstate=1
ENDPROC
Procedure mousedown &&move the form
LPARAMETERS nButton, nShift, nXCoord, nYCoord
*DECLARE INTEGER GetFocus IN WIN32API
lnHandle = THISFORM.HWND &&getFocus()
param1 = 274
param2 = 0xF012
thisform.mousepointer=15
bb=ReleaseCapture()
bb=SendMessage(lnHandle, param1, param2,0)
thisform.mousepointer=0
endproc
Procedure olecontrol1.init
this.silent=.t.
this.navigate("about:blank")
inke(1)
local m.myvar
text to m.myvar noshow
<img src= 'http://decouvertesalgerie.com/images/wilayas/galerie/5728adb322e80.jpg' width="100%" height="100%">
endtext
with this.document
.open()
.write(m.myvar)
.close()
endwith
endproc
PROCEDURE Init
=yinternet() &&warning if no internet (add it to the zip download if want)
with thisform.container1.slider.object
.orientation=0
.borderstyle=0
.tickstyle=3
.tickFrequency=1
.textposition=1
.smallChange=1
.largeChange=5
.refresh
endwith
thisform.height0=thisform.olecontrol1.height
thisform.resize
thisform.timer1.enabled=.f. &&avoid flickers
Publi Wmp As WindowsMediaPlayer
Wmp = Createobject("WMPlayer.OCX.7")
With Wmp
.settings.autoStart = .f.
.settings.Volume=60
.settings.setMode('loop',.T.) &&loop
Endwith
local m.myvar
text to m.myvar noshow
http://mazikna.com/music/mp3/Music%20Classique/beethoven/WwW.Anghamzik.Com_3rd-symphony.mp3
http://mazikna.com/music/mp3/Music Classique/beethoven/WwW.Anghamzik.Com_7th-symphony.mp3
http://mazikna.com/music/mp3/Music Classique/beethoven/WwW.Anghamzik.Com_sonata-claro-de-luna.mp3
http://mazikna.com/music/mp3/Music Classique/beethoven/track (11).mp3
http://mazikna.com/music/mp3/Music Classique/beethoven/track (7).mp3
http://mazikna.com/music/mp3/Music Classique/beethoven/WwW.Anghamzik.Com_5th-simphony.mp3
http://mazikna.com/music/mp3/Music Classique/beethoven/c.mp3
http://mazikna.com/music/mp3/Music Classique/beethoven/track (8).mp3
http://mazikna.com/music/mp3/Music Classique/beethoven/track (3).mp3
http://mazikna.com/music/mp3/Music Classique/beethoven/track (9).mp3
http://mazikna.com/music/mp3/Music Classique/beethoven/track (6).mp3
http://mazikna.com/music/mp3/Music Classique/beethoven/WwW.Anghamzik.Com_piano-concerto-no-5.mp3
http://mazikna.com/music/mp3/Music Classique/beethoven/WwW.Anghamzik.Com_9th-symphony.mp3
endtext
set safe off
local m.lcdest
m.lcdest=addbs(sys(2023))+"ytemp.m3u"
strtofile(m.myvar,m.lcdest)
thisform.mus=0
ENDPROC
PROCEDURE Resize
with thisform.ybkg
.left=0
.top=0
.width=.parent.width
.height=.parent.height
.zorder(1)
endwith
ENDPROC
PROCEDURE image1.Init
local m.myvar
text to m.myvar noshow
iVBORw0KGgoAAAANSUhEUgAAAB4AAAAeCAYAAAA7MK6iAAAAGXRFWHRTb2Z0d2FyZQBBZG9iZSBJbWFnZVJlYWR5ccllPAAABg9JREFUeNqMV1tMFGcUntmZvXJfwMKCAmq5NIg3bElE0JCoUVM1xiiptBoNpj4YH3whIekD9cXEhIQg4YFo3xpLQ0j7Yo0CD6IVg4olQWMU5CIgF2GXnb3NbL8z/YdM19llJznszs/5z/efc77/nLM8F/vhmXB79+41ud1u3ufz8X6/n7948aLocDj4mzdvBuj/NpstnJSUFO7t7VXY3jATw0eMAWhiIhQVFZmLi4vt+HQAWJyamgoLgpAmiqIA8KnS0lIuLy8vPDY25h8eHpY+fvwYwj4ZojAJGwEYrQkkmZmZ5u3btzsOHz68bsuWLRsg1SkpKVVms7lCvyEUCj1HNAaePXv2R2tr69CTJ0/ciEoABwiyA8ixvOeYhxQFe35+furJkyc3dHR0VMLo7+GIZ3p6Wh4dHZUj15eWln5FZApwYFdaWloK2WI2TbHySQqO3Nxc55kzZzZ3d3d/K8vyKBkMBAJKe3t7YP/+/V7ouPWya9eulRs3bgQkSVKY7vP79+/X7ty5cwMilEY2mW0+Gqg9OTnZeeDAgc137tw5Dht+MnT37t0QcuiJBIwU8GDl6dOnIc177PsOa/kM3G4ETjm1QlLKysoKrl+/fhB5G6PNt27dCoBI7rVANSHda9eu+TXwtra24y6Xaz3ZZhiCBk5/zJDEjIwM16VLlyoXFhb+1Dw1AkXuPCSxDkDXjGyAH/14/wqSRRgMy6QRykYhrqqqKrl9+/Y52rCysiIj14bGm5qa/ENDQ3IscIvF4p6cnAySrb6+vp9g60usOwmLea0CJ+A+usDiynfv3v1Cyi0tLYFoRsFclURrgdfX1/tIb25urgfvZZBs5rWo5Rf5T9l46NChg16v9zkpV1RUeKMZ3LFjx4oGTp/0bqSXnp7uAVfUXKemplZhrQCSCrGYNEaj5DlQGJx2u30r8qI8fvxYjnbvBgcHlX379knLy8thpIjv6emxA/yzezo/Px9GJVNLKkrsVpRUq3anVeDExEQBxLKjUmWQEopDeI0aroJv27ZNevnypRILHGVU/URBylUUZZXVqiIWBJ7nzSgWlHguGAxy8Tzgg3LlyhU/fSfwrq4ue6QObHIMwwrCCgxY9ZhDXvnZ2VnuzZs3Er1nZWXFBUweAkw9LHmODiZF6uAOq90K5dWNNP6vgNC9ciG/3xQUFJxHuZslMkS7SkYEi8ZuqgHQUa8UCtOPwPga6zl0i0y63qngSoXGx8dHaOHEiRNiLE8ppxRe8rS6ulpaXFz8jBc1NTUCdMSZmZl/cLhPSOFql9KA5f9SG/ShMbymhYaGBuq1hsDxgNLT2Niorg8MDIzig7iw2qcFBm5B8m0ej8eBkwmnT5/OzM7OdlmtVu7evXufXSsiH1LCHT161BcN9OzZs+Lly5ftsPkBuf8NnWsCywsQSklgtYDQ5cZEscfpdJ6/cOFCu1bkYUCKt0Fosnv3bi+FlfZjMOjC2jnIHn0BEfQTB7w2wxPbxMSEkJCQsIw+W3Ls2DER+znUWzkeptfV1YmdnZ1W1GpTf3//ALjyF5bJ21nIEsRHQVttEqyAb4ZUgY0/gKU/o153a56PjIz4Tp06JSHvhl7SgPDo0SOvpv/w4cNBrDdBviebzPZqk+B1Q4CVFXCqXjkAz0NF21hbW1sCkpTk5ORQd+EwSymvXr0KoeGrucU14QoLC1X20jta6hR6+OurV6/+jde3VLwgk5A5ll8imczrBgGRnSaZgWcDPBcEW48Ck9Pc3Fx45MiRjE2bNhUZhfj9+/dvHzx4MI+ONIz8UmjHWYg/MNBlFmZitsJHTJZmBp7EwvIFkyxUnXVgphNdLLW8vDwT3YvGGQ6T5dKLFy/m0HvnGWspl9OQGSYLLB1abtW7zBuMtRZd2IntBJDODkKMTAT71fkJLY/D9xBIKUEojJ8YEB1ikZFJC29AP+byBuOtiXluYQNaAotAEjuMQzc7acWHDHsZiEY46tESAwzqhvuYA702X4u6CGhiiZiTFZa3ADuAX+dhSMtp5EDPx5ix9YfQ/6ThDfZpv5P0P1n0YHH9hOHWOMxaTzgepX8FGADuEJHbscc2FgAAAABJRU5ErkJggg==
endtext
this.pictureVal=strconv(m.myvar,14)
ENDPROC
PROCEDURE image1.Click
if !used("ycurs") or reccount("ycurs")=0
return .f.
endi
sele ycurs
try
skip
catch
go bottom
endtry
if empty(xfile)
go botto
endi
thisform.olecontrol1.navigate(xfile)
thisform.container1.label5.caption="Page "+trans(recno())+"/"+trans(reccount())
thisform.container1.slider.value=recno()
ENDPROC
PROCEDURE image2.Click
if !used("ycurs") or reccount("ycurs")=0
return .f.
endi
sele ycurs
try
skip-1
catch
locate
endtry
if empty(xfile)
locate
endi
thisform.olecontrol1.navigate(xfile)
thisform.container1.label5.caption="Page "+trans(recno())+"/"+trans(reccount())
thisform.container1.slider.value=recno()
ENDPROC
PROCEDURE image2.Init
local m.myvar
text to m.myvar noshow
iVBORw0KGgoAAAANSUhEUgAAAB4AAAAeCAYAAAA7MK6iAAAAGXRFWHRTb2Z0d2FyZQBBZG9iZSBJbWFnZVJlYWR5ccllPAAABflJREFUeNqMV1tMFFcYntnZC7vclgUsLgisUJBGMd5aEnQxMQEDpIEQY0ix1WAk5ckH04aEpA/UF42JiVHDg9G+NcSGkPbFJoo8ACqGa0nAGAG5FJCLsOx9Z7bfP54h0824u5P8Oztnzvm/c/7L9//Dc9Evngl3+vRpncvl4n0+H+/3+/mWlha9xWLh7927F6D3CQkJ4eTk5PDz588ltjbMRPPSRwHUMRGKi4sNBw4cMONuAbB+aWkpLAhCml6vFwC+dPDgQS4vLy88Nzfnn5yc9H748CGEdSJEYhLWAtAaE0gyMzMNR44csdTU1Ow5dOhQLqQiNTXVaTAYytQLQqHQKKwxNDIy8ufdu3fHX7165YJVAthAkG1AjHZ6jp2QrGDOz8+3njt3LvfBgwcnofSPcMS1vLwszs7OipHjW1tbv8MyDmzYnpaWlkq6mE5dNH/SBEtOTo6tqampsKen51tRFGdJYSAQkDo7OwOVlZUezHGp5cSJE+5bt24FvF6vxOaOPn36tPHYsWO5sFAa6WS6+c+BmlNSUmxVVVWFXV1d9dDhJ0VPnjwJwYc7kYCRgjhwv379OqScHuu+w1g+AzdrgZNPTZDU0tJSx40bN87Cb3O0+OHDhwEEkisWqCI09/r1634F/P79+/V2u30f6WYYggJOPwZIUkZGhr21tfXkxsbGX8pJY4HCj5qWoDQjHYiPATx/BckiDIalUwIqgUzsdDpLHj16dIkWuN1uEb7eiQU6Pj4udnR0+CPfGY1G1+LiYpB09fX1/QJdX2LcRljs1DJwIvLRjig+OTMz8xtNvnPnTiAa6NGjR93IWzmY6K4158qVKz56v7a21ovnUshedmq94l/4P3V/dXX1WY/HM0qTy8rKPNFAkTYSSx+JnrXmpaen7yBWZF9brVYnxhwQK8SoUyIalGcBMdjMZvNh+EV68eKFqJVzANH19vZS9PMTExMS8t0zPDwsac1dX18Pg8lkSgXFHgalmpScloGTkpIEBJYZTJVBk0AO4XhAKyoqvJubm1EZCW6Q79hgjiRJu1EtRxcGBJ7nDSALcjwXDAY1lXR3d8ug9P/q1av+WKB0QSfHMEwIWIEByyfm4Fd+dXWVe/v2rZees7KyNJXU19d7t7e3w2wTCWSBWMDIYdkNoFcX3Pg/AqG8ssO/3zgcjmbQ3SoFw+dSSUmhWIGlkAnmyCkFYvoRGF9jPJuySKeqnRJSKjQ/Pz9FAw0NDZolk8xLviUfk9nJ5587+ZkzZwTM0a+srPyDzX6EC3erlLJA/OTaoA+F4Q0NtLW1Ua3l4gEn32vNa29vl0GGhoZmcSOSUddpObzTISUmk6kaJv4JjDNC5rl586Y/HuZqbm72Rb67ePGil1HmEvL5Z4ydJQxIBmOvTwRCyY2O4pTNZmu+fPlyp0LypCDeAqFIeXm5h8xK69EYdGPsEuSUmkAEdceBkDcguBIWFhaExMTEbdTZkrq6Oj3Wc+BbkYvjunDhgv7x48cmcLVuYGBgCLHyN4YXIKuQLQhZJ7hbJBiBF0KciMYfYMZfwdc9ysmnpqZ858+f98LvmqekBmFwcNCjzO/v7x/GeAfke9LJdO8WCV7VBJgYgZMPsgGeB0bb39jYWIIgKcnOzqbqwqGXkqanp0Mo+HLgIE24oqIiOXrpGSV1CTX8zbVr117i8R2RF2QRsgbZYUEm8qpGQM92k8LA9wI8BwG3DwSTffv27aLa2tqMgoKCYi0Tv3///t2zZ8/WUZEm4V8y7Twz8b8MdJuZmSJb4iM6SwMDT2Zm+YJJFlhnD3oqG6qY9fjx45moXtTOcOgst8bGxtaQCet0YObLZcgKkw3mDsW3ci7zGm2tUWV2ivY0lm42FpFJiH65f0LJ4/A/hKD0QsiMHxkQbWKTBZNi3oC6zeU12lsdO7mRNWiJzALJbDMWVe+kkA8p9jAQJeCISr0MMKhq7qM29Ep/rVdZQBFjRJ8sMb8F2Ab8qhOGFJ9GNvR8lB5bvQn1Jw2vsU75TlJ/sqjB4vqE4WJsJtYVjmfSfwIMAI2bkxctQTAaAAAAAElFTkSuQmCC
endtext
this.pictureval=strconv(m.myvar,14)
ENDPROC
PROCEDURE container1.Init
with this
.left=(thisform.width-.width)/2
endwith
ENDPROC
PROCEDURE ybkg.Init
local m.lcUrl
m.lcUrl='http://decouvertesalgerie.com/images/wilayas/galerie/5728adb322e80.jpg'
this.stretch=2
with this
.left=0
.top=0
.width=.parent.width
.height=.parent.height
.zorder(1)
endwith
try
m.loRequest = Createobject('MsXml2.XmlHttp')
m.loRequest.Open("GET",lcUrl,.F.)
m.loRequest.Send()
Thisform.ybkg.PictureVal=m.loRequest.ResponseBody
thisform.image1.zorder(0)
m.loRequest=Null
catch
endtry
ENDPROC
PROCEDURE timer1.Timer
thisform.lockscreen=.t.
local m.myvar
text to m.myvar noshow
http://www.algerie.uz/images/F09.jpg
https://www.populationdata.net/wp-content/uploads/2016/05/Algerie-Sahara-Tadrart-rouge.jpg
http://www.lematindalgerie.com/sites/default/files/styles/landscape_l/public/2018-04/atelier_generateurs-panneaux_solaires-photovoltaiques-001-zoom.jpg?itok=tOxNasvM
http://www.algerie-monde.com/hotels/tipaza/ruines-romaines-tipaza.jpg
http://www.lematindz.net/thumb/600x350/r/files/2015/06/algeri_268468888.jpg
http://www.dirlaffaire.net/souq/files/12-2017/ad64355/1513678762758999388_large.jpg
https://i.pinimg.com/736x/ef/a5/5a/efa55a7881763d3a5ffb7631a2172945--desert-sahara-il-grande.jpg
http://cache-media.britannica.com/eb-media/44/61044-050-B8EAA0E2.jpg
http://excursionsamarrakech.com/wp-content/uploads/2017/07/IMG-6839.jpg
http://vaudais.net/var/ezflow_site/storage/images/site/photo/albums/le-sahara-algerien-le-plus-beaux-desert-du-monde/guelta/16984-1-fre-FR/guelta.jpg
http://www.voyagesphotosmanu.com/Complet/images/oasis_algerie.jpg
https://www.vitaminedz.org/photos/19/19939-taghit-l-enchanteresse-ou-carrement-l-nvoutante.jpg
https://c.pxhere.com/photos/cb/c0/desert_dunes_sand-863293.jpg!d
https://pbs.twimg.com/media/B1eMOuRIYAALIcU.jpg
https://i.pinimg.com/originals/3e/92/ed/3e92ed75b16a24a8b246f388f73726c4.jpg
https://i.pinimg.com/originals/73/67/f3/7367f37b9e362f4d88f0373c0ec90790.jpg
http://www.algerie-monde.com/photos/tamanrasset/assekrem/assekrem-tamanrasset-1.jpg
https://encrypted-tbn0.gstatic.com/images?q=tbn:ANd9GcR3_MPjwwJOcbhrK47eCrI4DYxYpUVoMmdZRi9GuwWUu-jyP8U_
http://i41.servimg.com/u/f41/11/21/97/97/sahra610.jpg
https://encrypted-tbn0.gstatic.com/images?q=tbn:ANd9GcTA7DwlgoDw5Z5LOw-4KYmcsy82Seb5WQgkK-eKxbMfVyRkmD6ENA
https://www.tsvoyages.com/images/2015/02/6995933-desert-oasis-libya-1250x703.jpg
https://pbs.twimg.com/media/C0n1QtsXUAAe9YA.jpg
https://encrypted-tbn0.gstatic.com/images?q=tbn:ANd9GcQksN9dfG76ChWgIt76het4OfZ61ufDnt_2IwrUleqKd2VeoNx-
https://encrypted-tbn0.gstatic.com/images?q=tbn:ANd9GcRSDAZnHXWfAsmnTV34zK5WhXPxJ-59ZgIN3K0pn7KR5esCUI__yw
https://encrypted-tbn0.gstatic.com/images?q=tbn:ANd9GcRrrxIonD5_JIs8Xt_C35lZ0YXyYlCBbdzlh4M4vB4YyfziqsLU
endtext
thisform.ii=thisform.ii+1
if thisform.ii>memlines(m.myvar)
thisform.ii=1
endi
local m.lcUrl
m.lcUrl=mline(m.myvar,thisform.ii)
try
m.loRequest = Createobject('MsXml2.XmlHttp')
m.loRequest.Open("GET",lcUrl,.F.)
m.loRequest.Send()
Thisform.ybkg.PictureVal=m.loRequest.ResponseBody
thisform.image1.zorder(0)
m.loRequest=Null
catch
endtry
* rand(-1)
* thisform.ycnt1.shape4.backcolor=rgb(255*rand(),255*rand(),255*rand())
with thisform.yshp
.left=0
.top=0
.width=thisform.width
.height=thisform.height
rand(-1)
.backcolor=rgb(255*rand(),255*rand(),255*rand())
.zorder(0)
.visible=.t.
endwith
thisform.timer2.enabled=.t.
thisform.lockscreen=.f.
ENDPROC
PROCEDURE timer2.Timer
thisform.yshp.visible=.f.
ENDPROC
PROCEDURE yshp.Init
with this
.left=0
.top=0
.width=.parent.width
.height=.parent.height
endwith
ENDPROC
procedure olecontrol1.beforeVavigate2
LPARAMETERS pdisp, url, flags, targetframename, postdata, headers, cancel
if !used("ycurs")
cancel=.t.
return .f.
endi
endproc
ENDDEFINE
*
*-- EndDefine: form1
Click on code to select [then copy] -click outside to deselect
*1.1* this is the part2 completing the yPDFReaderH.prg (part1 is in the section above)
*
DEFINE CLASS ycnt AS container
Anchor = 768
Top = 544
Left = 60
Width = 1020
Height = 75
BackStyle = 1
BorderWidth = 0
BackColor = RGB(223,255,191)
Name = "Container1"
toolb=.f.
scrl=.t.
add object yclose AS image with ;
Height = 30,;
Left = 984,;
Top = 44,;
Width = 30,;
mousepointer=15,;
Name = "yclose"
ADD OBJECT label1 AS label WITH ;
WordWrap = .T., ;
BackStyle = 0, ;
Caption = "", ;
Height = 50, ;
Left = 327, ;
Top = 1, ;
Width = 273, ;
Name = "Label1"
ADD OBJECT combo1 AS combobox WITH ;
Height = 24, ;
Left = 790, ;
Top = 6, ;
Width = 100, ;
DisplayCount = 13, ;
Name = "Combo1"
ADD OBJECT combo2 AS combobox WITH ;
Anchor = 768, ;
Height = 25, ;
Left = 897, ;
Top = 6, ;
Width = 87, ;
DisplayCount = 12, ;
Name = "Combo2"
ADD OBJECT image1 AS image WITH ;
Picture = home(1)+"graphics\icons\win95\openfold.ico", ;
Stretch = 2, ;
BackStyle = 0, ;
Height = 32, ;
Left = 3, ;
MousePointer = 15, ;
Top = 1, ;
Width = 32, ;
ToolTipText = "Open", ;
Name = "Image1"
ADD OBJEC combo3 AS combobox with ;
FontSize = 8,;
Height = 20,;
Left = 4,;
ToolTipText = "History",;
Top = 44,;
Width = 120,;
Name = "Combo3"
ADD OBJECT ytb AS shape WITH ;
Top = 44, ;
Left = 127, ;
Height = 13, ;
Width = 13, ;
Curvature = 99, ;
MousePointer = 15, ;
ToolTipText = "Titlebar off/on", ;
BackColor = RGB(255,255,0), ;
Name = "ytb"
ADD OBJECT image2 AS image WITH ;
Picture = home(1)+ "samples\solution\coverage\covaddin.ico", ;
Stretch = 0, ;
BackStyle = 0, ;
Height = 32, ;
Left = 108, ;
MousePointer = 15, ;
Top = 1, ;
Width = 32, ;
ToolTipText = "Search", ;
Name = "Image2"
ADD OBJECT image3 AS image WITH ;
Picture = home(1)+"ffc\graphics\previous.bmp", ;
Stretch = 2, ;
BackStyle = 0, ;
Height = 32, ;
Left = 172, ;
MousePointer = 15, ;
Top = 1, ;
Width = 32, ;
ToolTipText = "Previous", ;
Name = "Image3"
ADD OBJECT image4 AS image WITH ;
Picture = home(1)+"ffc\graphics\next.bmp", ;
Stretch = 2, ;
BackStyle = 0, ;
Height = 32, ;
Left = 204, ;
MousePointer = 15, ;
Top = 1, ;
Width = 32, ;
ToolTipText = "Next", ;
Name = "Image4"
ADD OBJECT image5 AS image WITH ;
Picture = home(1)+"samples\solution\coverage\colors.bmp", ;
Stretch = 2, ;
BackStyle = 0, ;
Height = 32, ;
Left = 258, ;
MousePointer = 15, ;
Top = 1, ;
Width = 32, ;
ToolTipText = "Fit H", ;
Name = "Image5"
ADD OBJECT image6 AS image WITH ;
Picture = home(1)+"graphics\bitmaps\outline\plus.bmp", ;
Stretch = 2, ;
BackStyle = 0, ;
Height = 32, ;
Left = 293, ;
MousePointer = 15, ;
Top = 1, ;
Width = 32, ;
ToolTipText = "Zooms", ;
Name = "Image6"
ADD OBJECT shape1 AS shape WITH ;
Top = 6, ;
Left = 1001, ;
Height = 13, ;
Width = 13, ;
Curvature = 99, ;
MousePointer = 15, ;
ToolTipText = "Backcolor", ;
BackColor = RGB(255,255,0), ;
Name = "Shape1"
ADD OBJECT image7 AS image WITH ;
Picture =home(1)+"ffc\graphics\remall.bmp", ;
Stretch = 2, ;
BackStyle = 0, ;
Height = 32, ;
Left = 143, ;
MousePointer = 15, ;
Top = 1, ;
Width = 32, ;
ToolTipText = "First page", ;
Name = "Image7"
ADD OBJECT image8 AS image WITH ;
Picture = home(1)+"ffc\graphics\bottom.bmp", ;
Stretch = 2, ;
BackStyle = 0, ;
Height = 32, ;
Left = 229, ;
MousePointer = 15, ;
Top = 1, ;
Width = 32, ;
ToolTipText = "Last Page", ;
Name = "Image8"
ADD OBJECT yrot AS image WITH ;
Anchor = 768, ;
Picture = "rot.gif", ;
Stretch = 2, ;
BackStyle = 0, ;
Height = 22, ;
Left = 42, ;
Top = 5, ;
Visible = .F., ;
Width = 22, ;
Name = "yrot"
ADD OBJECT shape2 AS shape WITH ;
Top = 11, ;
Left = 81, ;
Height = 13, ;
Width = 13, ;
Anchor = 768, ;
Curvature = 99, ;
MousePointer = 15, ;
ToolTipText = "Infos", ;
BackColor = RGB(255,0,0), ;
FillColor = RGB(255,0,0), ;
Name = "Shape2"
ADD OBJECT label5 AS label WITH ;
AutoSize = .T., ;
FontSize = 18, ;
Anchor = 768, ;
BackStyle = 0, ;
Caption = "", ;
Height = 30, ;
Left = 619, ;
Top = 4, ;
Width = 2, ;
ForeColor = RGB(0,0,255), ;
Name = "Label5"
ADD OBJECT slider AS olecontrol WITH ;
oleclass="MSComctlLib.Slider.2",;
Top = 39, ;
Left = 810, ;
Height = 32, ;
Width = 100, ;
Anchor = 768, ;
enabled=.f.,;
Name = "slider"
PROCEDURE Init
with this
.left=(thisform.width-.width)/2
endwith
ENDPROC
procedure ytb.click
thisform.titlebar=iif(thisform.titlebar=1,0,1)
endproc
procedure yrot.init
local m.myvar
text to m.myvar noshow
R0lGODlhIAAgALMAAP///7Ozs/v7+9bW1uHh4fLy8rq6uoGBgTQ0NAEBARsbG8TExJeXl/39/VRUVAAAACH/C05FVFNDQVBFMi4wAwEAAAAh+QQFBQAAACwAAAAAIAAgAAAE5xDISSlLrOrNp0pKNRCdFhxVolJLEJQUoSgOpSYT4RowNSsvyW1icA16k8MMMRkCBjskBTFDAZyuAEkqCfxIQ2hgQRFvAQEEIjNxVDW6XNE4YagRjuBCwe60smQUDnd4Rz1ZAQZnFAGDd0hihh12CEE9kjAEVlycXIg7BAsMB6SlnJ87paqbSKiKoqusnbMdmDC2tXQlkUhziYtyWTxIfy6BE8WJt5YEvpJivxNaGmLHT0VnOgGYf0dZXS7APdpB309RnHOG5gDqXGLDaC457D1zZ/V/nmOM82XiHQjYKhKP1oZmADdEAAAh+QQFBQAAACwAAAAAGAAXAAAEchDISasKNeuJFKoHs4mUYlJIkmjIV54Soypsa0wmLSnqoTEtBw52mG0AjhYpBxioEqRNy8V0qFzNw+GGwlJki4lBqx1IBgjMkRIghwjrzcDti2/Gh7D9qN774wQGAYOEfwCChIV/gYmDho+QkZKTR3p7EQAh+QQFBQAAACwBAAAAHQAOAAAEchDISWdANesNHHJZwE2DUSEo5SjKKB2HOKGYFLD1CB/DnEoIlkti2PlyuKGEATMBaAACSyGbEDYD4zN1YIEmh0SCQQgYehNmTNNaKsQJXmBuuEYPi9ECAU/UFnNzeUp9VBQEBoFOLmFxWHNoQw6RWEocEQAh+QQFBQAAACwHAAAAGQARAAAEaRDICdZZNOvNDsvfBhBDdpwZgohBgE3nQaki0AYEjEqOGmqDlkEnAzBUjhrA0CoBYhLVSkm4SaAAWkahCFAWTU0A4RxzFWJnzXFWJJWb9pTihRu5dvghl+/7NQmBggo/fYKHCX8AiAmEEQAh+QQFBQAAACwOAAAAEgAYAAAEZXCwAaq9ODAMDOUAI17McYDhWA3mCYpb1RooXBktmsbt944BU6zCQCBQiwPB4jAihiCK86irTB20qvWp7Xq/FYV4TNWNz4oqWoEIgL0HX/eQSLi69boCikTkE2VVDAp5d1p0CW4RACH5BAUFAAAALA4AAAASAB4AAASAkBgCqr3YBIMXvkEIMsxXhcFFpiZqBaTXisBClibgAnd+ijYGq2I4HAamwXBgNHJ8BEbzgPNNjz7LwpnFDLvgLGJMdnw/5DRCrHaE3xbKm6FQwOt1xDnpwCvcJgcJMgEIeCYOCQlrF4YmBIoJVV2CCXZvCooHbwGRcAiKcmFUJhEAIfkEBQUAAAAsDwABABEAHwAABHsQyAkGoRivELInnOFlBjeM1BCiFBdcbMUtKQdTN0CUJru5NJQrYMh5VIFTTKJcOj2HqJQRhEqvqGuU+uw6AwgEwxkOO55lxIihoDjKY8pBoThPxmpAYi+hKzoeewkTdHkZghMIdCOIhIuHfBMOjxiNLR4KCW1ODAlxSxEAIfkEBQUAAAAsCAAOABgAEgAABGwQyEkrCDgbYvvMoOF5ILaNaIoGKroch9hacD3MFMHUBzMHiBtgwJMBFolDB4GoGGBCACKRcAAUWAmzOWJQExysQsJgWj0KqvKalTiYPhp1LBFTtp10Is6mT5gdVFx1bRN8FTsVCAqDOB9+KhEAIfkEBQUAAAAsAgASAB0ADgAABHgQyEmrBePS4bQdQZBdR5IcHmWEgUFQgWKaKbWwwSIhc4LonsXhBSCsQoOSScGQDJiWwOHQnAxWBIYJNXEoFCiEWDI9jCzESey7GwMM5doEwW4jJoypQQ743u1WcTV0CgFzbhJ5XClfHYd/EwZnHoYVDgiOfHKQNREAIfkEBQUAAAAsAAAPABkAEQAABGeQqUQruDjrW3vaYCZ5X2ie6EkcKaooTAsi7ytnTq046BBsNcTvItz4AotMwKZBIC6H6CVAJaCcT0CUBTgaTg5nTCu9GKiDEMPJg5YBBOpwlnVzLwtqyKnZagZWahoMB2M3GgsHSRsRACH5BAUFAAAALAEACAARABgAAARcMKR0gL34npkUyyCAcAmyhBijkGi2UW02VHFt33iu7yiDIDaD4/erEYGDlu/nuBAOJ9Dvc2EcDgFAYIuaXS3bbOh6MIC5IAP5Eh5fk2exC4tpgwZyiyFgvhEMBBEAIfkEBQUAAAAsAAACAA4AHQAABHMQyAnYoViSlFDGXBJ808Ep5KRwV8qEg+pRCOeoioKMwJK0Ekcu54h9AoghKgXIMZgAApQZcCCu2Ax2O6NUud2pmJcyHA4L0uDM/ljYDCnGfGakJQE5YH0wUBYBAUYfBIFkHwaBgxkDgX5lgXpHAXcpBIsRADs=
endtext
this.pictureval=strconv(m.myvar,14)
endproc
PROCEDURE yclose.Init
local m.myvar
text to m.myvar noshow
iVBORw0KGgoAAAANSUhEUgAAAB4AAAAeCAYAAAA7MK6iAAAACXBIWXMAAAsTAAALEwEAmpwYAAAABGdBTUEAANjr9RwUqgAAACBjSFJNAABtmAAAc44AAPJxAACDbAAAg7sAANTIAAAx7AAAGbyeiMU/AAAG7ElEQVR42mJkwA8YoZjBwcGB6fPnz4w/fvxg/PnzJ2N6ejoLFxcX47Rp036B5Dk4OP7z8vL+P3DgwD+o3v9QjBUABBALHguZoJhZXV2dVUNDgxNIcwEtZnn27Nl/ZmZmQRYWFmag5c90dHQY5OXl/z98+PDn1atXv79+/foPUN9fIP4HxRgOAAggRhyWMoOwqKgoq6GhIZe3t7eYrq6uHBDb8/Pz27Gysloga/jz588FYGicPn/+/OapU6deOnXq1GdgqPwCOuA31AF/0S0HCCB0xAQNBU4FBQWB0NBQublz59oADV37Hw28ePHi74MHD/6ii3/8+HEFMGQUgQ6WEhQU5AeZBTWTCdkigABC9ylIAZeMjIxQTEyMysaNG/3+/v37AGTgr1+//s2cOfOXm5vbN6Caz8jY1NT0a29v76/v37//g6q9sHfv3khjY2M5YAgJgsyEmg0PYYAAQreUk4+PT8jd3V1l1apVgUAzfoIM2rlz5x9gHH5BtxAdA9PB1zNnzvyB+R6oLxoopgC1nBPZcoAAgiFQnLIDMb+enp5iV1eXBzDeHoI0z58//xcwIX0mZCkMg9S2trb+hFk+ffr0QCkpKVmQ2VA7QHYxAgQQzLesQMwjIiIilZWVZfPu3bstMJ+SYikyBmUzkBnA9HEMyNcCYgmQHVC7mAACCJagOEBBbGdnp7lgwYJEkIavX7/+BcY1SvAaGRl9tba2xohjMTGxL8nJyT+AWQsuxsbG9vnp06e/QWYdPHiwHmiWKlBcCGQXyNcAAQSzmBuoSQqYim3u37+/EKR48uTJv5ANB+bVr7Dga2xs/AkTV1JS+gq0AJyoQIkPWU9aWtoPkPibN2/2A/l6QCwJ9TULQADB4hcY//xKXl5eHt++fbsAUmxhYYHiM1DiAsr9R7ZcVVUVbikIdHd3/0TWIyws/AWYVsByAgICdkAxRSAWAGI2gACClV7C4uLiOv7+/lEgRZ8+ffqLLd6ABck3ZMuB6uCWrlu37je29HDx4kVwQisvL88FFqkaQDERUHADBBAomBl5eHiYgQmLE1hSgQQZgIUD1lJm69atf4HR8R1YKoH5QIPAWWP9+vV/gOI/gHkeQw+wGAXTwAJJ5t+/f/BUDRBA4NIEKMDMyMjICtQIiniG379/4yza7t69+//Lly8oDrty5co/bJaCAEwcZCkwwTJDLWYCCCCwxcDgY3z16hXDnTt3voP4EhISWA0BFgZMwNqHExh3jMiG1tbWsgHjnA2bHmAeBtdWwOL1MycnJ7wAAQggBmi+kgIW/OaKiorJwOLuFShO0LMSMPF9AUYBSpz6+vqixHlOTs4P9MIEWHaDsxSwYMoE2mEGFJcG5SKAAGJCqjv/AbPUn8ePH98ACQQHB6NUmZqamkzABIgSp5s3bwbHORCA1QDLAWZkPc7OzszA8oHl5cuXVy5duvQBGIXwWgoggGA+FgO6xkBNTS28r69vDrT2+Y1cIMDyJchX6KkXVEmAshd6KB06dAic94EO3AzkBwGxPhCLg8ptgACCZyeQp9jZ2b2AmsuAefM8tnxJCk5ISPgOLTKfAdNEOVDMA2QHLDsBBBC8AAFlbmCLwlZISCg5JSVlJizeQAaQaimoWAUFK0g/sGGwHiiWCMS2yAUIQAAxI7c4gEmeFZi4OJ48ecLMzc39CRiEmgEBASxA/QzA8vYvAxEgNjaWZc2aNezAsprp2LFjp4FpZRdQ+AkQvwLij0AMSoC/AQIIXklAC3AVUBoBxmE8sPXQAiyvN8J8fuPGjR/h4eHf0eMdhkENhOPHj8OT+NGjR88BxZuBOA5kJtRseCUBEECMSI0AdmgBDooDaaDl8sASTSkyMlKzpqZGU1paGlS7MABLrX83b978A6zwwakTmE0YgIkSnHpBfGCV+gxYh98qKSk5CeTeAxVeQPwUiN8AMSjxgdLNX4AAYkRqCLBAXcMHtVwSaLkMMMHJAvOq9IQJE9R8fHxElJWV1bEF8aNHj+7t27fvLTDlXwXGLyhoH0OD+DnU0k/QYAa1QP8BBBAjWsuSFWo5LzRYxKFYAljqiAHzqxCwIBEwMTERBdZeoOYMA7Bl+RFYEbwB5oS3IA9D4/IFEL+E4nfQ6IDFLTgvAwQQI5ZmLRtSsINSuyA0uwlBUyQPMPWD20/AKo8ByP4DTJTfgRgUjB+gFoEc8R6amGDB+wu5mQsQQIxYmrdMUJ+zQTM6NzQEeKGO4UJqOzFADQMZ/A1qCSzBfQXi71ALfyM17sEAIIAY8fQiWKAYFgIwzIbWTv4HjbdfUAf8RPLhH1icojfoAQKIEU8bG9kRyF0aRiz6YP0k5C4LsmUY9TtAADEyEA+IVfufGEUAAQYABejinPr4dLEAAAAASUVORK5CYII=
endtext
this.pictureVal=strconv(m.myvar,14)
ENDPROC
PROCEDURE yclose.Click
thisform.release
ENDPROC
PROCEDURE combo3.Click
this.parent.label1.caption=""
local m.lcfile
m.lcfile=this.value
if empty(m.lcfile) or !inlist(lower(justext(m.lcfile)),"pdf")
return .f.
endi
if !directory (m.yrep+"temp")
md (m.yrep+"temp")
else
try
erase m.yrep+"temp\*.*"
catch
endtry
endi
this.parent.yrot.visible=.t.
local m.myvar
text to m.myvar textmerge noshow
pdftk "<<m.lcfile>>" burst
copy pg_*.pdf <<m.yrep>>temp
del pg_*.pdf
endtext
set safe off
strtofile(m.myvar,m.yrep+"ybat.bat")
local oshell
oshell=newObject("wscript.shell")
oshell.run(m.yrep+"ybat.bat",0,.t.) &&execute and wait until done
oshell=null
crea cursor ycurs ( page i,xfile c(200))
gnbre= adir (gabase,m.yrep+"temp\*.pdf")
*messagebox(trans(gnbre)+" pdf created",0+32+4096,'',1300)
this.parent.yrot.visible=.f.
if gnbre=0
return .f.
endi
for i=1 to gnbre
insert into ycurs values (i,"file:///"+allt(m.yrep)+"temp\"+gabase(i,1))
endfor
*brow
locate
thisform.olecontrol1.navigate(xfile)
this.parent.label5.caption="Page "+trans(recno())+"/"+trans(reccount())
this.parent.label1.caption=proper(m.lcfile)
if reccount()>0
this.parent.slider.min=1
this.parent.slider.max=reccount()
endi
ENDPROC
PROCEDURE combo3.Init
local m.temp
m.temp=addbs(sys(2023))+"histo.txt"
if !file(m.temp)
return .f.
endi
set memow to 255
local m.x
m.x=filetostr(m.temp)
with this
for i=1 to memlines(m.x)
if !empty(mline(m.x,i))
.additem(allt(mline(m.x,i)))
endi
endfor
.listindex=1
.style=2
endwith
ENDPROC
PROCEDURE combo1.Click
thisform.olecontrol1.setfocus
#Define MOUSEEVENTF_LEFTDOWN 0x0002 &&The left button is down.
#Define MOUSEEVENTF_LEFTUP 0x0004 &&The left button is up.
x=thisform.left+Thisform.olecontrol1.left+thisform.olecontrol1.width-40
Y=thisform.top+Thisform.olecontrol1.Top+120
=SetCursorPos(x,Y)
=Inkey(0.2)
mouse_event(MOUSEEVENTF_LEFTDOWN +MOUSEEVENTF_LEFTUP,x,y,0,0) && left mouse down+up
local oshell
oshell=newObject("wscript.shell")
do case
case this.value=1
oshell.sendkeys("^{home}")
case this.value=2
oshell.sendkeys("^{end}")
case this.value=3
oshell.sendkeys('^ "Plus"')
case this.value=4
oshell.sendkeys("^{!}")
case this.value=5
oshell.sendkeys("^{+}")
case this.value=6
oshell.sendkeys("^{p}")
case this.value=7
oshell.sendkeys("^{S}") &&MAJ CTRL S
case this.value=8
oshell.sendkeys("^{h}")
*wait window "Issue ESC to siop reader mode" nowait
case this.value=9
oshell.sendkeys("^{l}")
case this.value=10
oshell.sendkeys("+{F4}")
endcase
doevent
oshel=null
ENDPROC
PROCEDURE combo1.Init
with this
.additem("Top Page")
.additem("Bottom Page")
.additem("zoom+")
.additem("zoom-")
.additem("Rotate 90° clockwise")
.additem("Print")
.ADDITEM("Save to")
.additem("Reader mode")
.additem("switch View")
.additem("hide/show right panel")
.listindex=1
.value=1
.style=2
endwith
ENDPROC
PROCEDURE combo2.Init
with this
.additem("Thumbnails")
.additem("Fit")
.additem("zoom")
.additem("Toolbar")
.additem("Scroll")
.additem("Go to page")
.listindex=1
.style=2
.value=1
endwith
ENDPROC
PROCEDURE combo2.Click
if !vartype(thisform.olecontrol1.object.document)="O"
return .f.
endi
local m.x
try
do case
case this.value=1
m.x=inputbox("thumbnails(1)-Bookmarks(2)-none(3)","","3") &&can be Fit,FitH,FitV,FitB,FitBH,FitBV (1-6)
if !inlist(m.x,"1","2","3" )
m.x="3"
endi
local m.y
do case
case m.x="1"
m.y="thumnails"
case m.x="2"
m.y="bookmarks"
case m.x="3"
m.y="none"
endcase
Thisform.olecontrol1.oBJECT.Document.setPageMode(m.y)
case this.value=2
m.x=inputbox("fit(1)-fith(2)","","1")
if !inlist(m.x,"1","2")
m.x="1"
endi
local m.y
do case
case m.x="1"
m.y="fit"
case m.x="2"
m.y="fith"
endcase
Thisform.olecontrol1.oBJECT.Document.setView(m.y)
case this.value=3
m.x=inputbox("zoom 10-200%","","100")
if empty(m.x) or val(m.x)=0
return .f.
endi
m.y=int(val(m.x))
Thisform.olecontrol1.oBJECT.Document.setZoom(m.y) && 0-200....
case this.value=4
try
this.parent.toolb=iif(this.parent.toolb=.f.,.t.,.f.)
Thisform.olecontrol1.oBJECT.Document.setShowToolbar(this.parent.toolb)
catch
endtry
case this.value=5
this.parent.scrl=iif(this.parent.scrl=.t.,.f.,.t.)
try
Thisform.olecontrol1.oBJECT.Document.setShowScrollbars(this.parent.scrl)
catch
endtry
case this.value=6
m.x=inputbox("Page number:","","1")
m.x=int(val(m.x))
if m.x=0
return .f.
endi
sele ycurs
if m.x>reccount()
m.x=reccount()
endi
go m.x
thisform.olecontrol1.navigate(xfile)
thisform.container1.label5.caption="Page "+trans(recno())+"/"+trans(reccount())
this.parent.slider.value=recno()
endcase
catch
messagebox("error",0+32+4096,'',1200)
endtry
ENDPROC
PROCEDURE image1.Click
this.parent.label1.caption=""
local m.lcfile
m.lcfile=getfile('pdf')
if empty(m.lcfile) or !inlist(lower(justext(m.lcfile)),"pdf")
return .f.
endi
***
*add to historic files (append)
local m.temp
m.temp=addbs(sys(2023))+"histo.txt"
if file(m.temp) and ! allt(m.lcfile) $ filetostr(m.temp)
strtofile(m.lcfile+chr(13)+chr(10),m.temp,.t.)
this.parent.combo3.additem(allt(m.lcfile))
endi
***
if !directory (m.yrep+"temp")
md (m.yrep+"temp")
else
try
erase m.yrep+"temp\*.*"
catch
endtry
endi
this.parent.yrot.visible=.t.
local m.myvar
text to m.myvar textmerge noshow
pdftk "<<m.lcfile>>" burst
copy pg_*.pdf <<m.yrep>>temp
del pg_*.pdf
endtext
set safe off
strtofile(m.myvar,m.yrep+"ybat.bat")
local oshell
oshell=newObject("wscript.shell")
oshell.run(m.yrep+"ybat.bat",0,.t.) &&execute and wait until done
oshell=null
crea cursor ycurs ( page i,xfile c(200))
gnbre= adir (gabase,m.yrep+"temp\*.pdf")
this.parent.yrot.visible=.f.
if gnbre=0
return .f.
endi
for i=1 to gnbre
insert into ycurs values (i,"file:///"+allt(m.yrep)+"temp\"+gabase(i,1))
endfor
*brow
locate
thisform.olecontrol1.navigate(xfile)
this.parent.label5.caption="Page "+trans(recno())+"/"+trans(reccount())
this.parent.label1.caption=proper(m.lcfile)
if reccount()>0
this.parent.slider.enabled=.t.
this.parent.slider.min=1
this.parent.slider.max=reccount()
this.parent.slider.value=recno()
endi
ENDPROC
PROCEDURE image2.Click
thisform.olecontrol1.setfocus
local oshell
oshell=newObject("wscript.shell")
oshell.sendkeys("^{f}")
oshell=null
ENDPROC
PROCEDURE image3.Click
if !used("ycurs")
return .f.
endi
sele ycurs
try
skip-1
catch
locate
endtry
thisform.olecontrol1.navigate(xfile)
thisform.container1.label5.caption="Page "+trans(recno())+"/"+trans(reccount())
this.parent.slider.value=recno()
ENDPROC
PROCEDURE image4.Click
if !used("ycurs")
return .f.
endi
sele ycurs
try
skip
catch
go bottom
endtry
if empty(xfile)
go botto
endi
thisform.olecontrol1.navigate(xfile)
thisform.container1.label5.caption="Page "+trans(recno())+"/"+trans(reccount())
this.parent. slider.value=recno()
ENDPROC
PROCEDURE image5.Click
thisform.olecontrol1.setfocus
try
Thisform.olecontrol1.oBJECT.Document.setView("FitH")
catch
endtry
ENDPROC
PROCEDURE image6.Click
thisform.olecontrol1.setfocus
local m.x
m.x=inputbox("zoom 10-200%","","100")
if empty(m.x) or val(m.x)=0
return .f.
endi
m.y=int(val(m.x))
try
Thisform.olecontrol1.oBJECT.Document.setZoom(m.y) && 0-200....
catch
endtry
ENDPROC
PROCEDURE shape1.Click
local m.x
m.x=getcolor()
if m.x=-1
return .f.
endi
with thisform
.backcolor=m.x
.container1.backcolor=.backcolor
endwith
ENDPROC
PROCEDURE image7.Click
if !used("ycurs")
return .f.
endi
sele ycurs
locate
thisform.olecontrol1.navigate(xfile)
thisform.container1.label5.caption="Page "+trans(recno())+"/"+trans(reccount())
this.parent.slider.value=recno()
ENDPROC
PROCEDURE image8.Click
if !used("ycurs")
return .f.
endi
sele ycurs
go bottom
thisform.olecontrol1.navigate(xfile)
thisform.container1.label5.caption="Page "+trans(recno())+"/"+trans(reccount())
this.parent.slider.value=recno()
ENDPROC
PROCEDURE shape2.Click
if file("doc_data.txt")
local m.x
m.x=filetostr("doc_data.txt")
m.x=strtran(m.x,"InfoValue:"," ")
m.x=strtran(m.x,"InfoKey:" ,"")
local oshell
oshell=newObject("wscript.shell")
oshell.Popup(m.x,0, 'PDF informations', 0+32+4096) &&4,16,48,64...
oshell=Null
endi
ENDPROC
PROCEDURE slider.Change
*** Événement de contrôle ActiveX ***
if !used("ycurs")
return .f.
endi
lok=.t.
try
if empty(dbf("ycurs")) or reccount()=0
return .f.
endi
catch
lok=.f.
endtry
if lok=.f.
return .f.
endi
sele ycurs
try
if reccount()>0
go this.value
thisform.olecontrol1.navigate(xfile)
thisform.container1.label5.caption="Page "+trans(recno())+"/"+trans(reccount())
endi
catch
endtry
ENDPROC
ENDDEFINE
*-- EndDefine: ycnt
*
*
DEFINE CLASS ycnt1 AS container
Anchor = 768
Top = 554
Left = 1081
Width = 56
Height = 61
BackStyle = 1
BorderWidth = 0
BackColor = RGB(255,213,191)
Name = "ycnt1"
add object ycom as commandbutton with caption="",backcolor=rgb(0,255,0),left=0,top=0,width=15,height=61,name="ycom",picture=home(1)+"ffc\graphics\remall.bmp"
ADD OBJECT shape1 AS shape WITH ;
Top = 45, ;
Left = 17, ;
Height = 13, ;
Width = 13, ;
Anchor = 768, ;
Curvature = 99, ;
MousePointer = 15, ;
ToolTipText = "Hide/show container", ;
BackColor = RGB(255,0,0), ;
Name = "Shape1"
Add object shape4 as image with anchor=768,mousepointer=15,tooltiptext="Slideshow" ,stretch=2,top=9,left=16,width=16,height=16,picture=home(1)+"graphics\icons\misc\misc15.ico",backstyle=0,name="shape4"
ADD OBJECT shape5 AS shape WITH ;
Top = 9, ;
Left = 40, ;
Height = 15, ;
Width = 15, ;
Anchor = 768, ;
Curvature = 99, ;
MousePointer = 15, ;
ToolTipText = "Music/rightclick for volume", ;
BackColor = RGB(255,255,0), ;
Name = "Shape5"
PROCEDURE Init
with this
.left=thisform.width-15
endwith
ENDPROC
procedure ycom.mouseEnter
LPARAMETERS nButton, nShift, nXCoord, nYCoord
this.parent.mouseEnter(1)
endproc
PROCEDURE MouseEnter
LPARAMETERS nButton, nShift, nXCoord, nYCoord
with this
.left=thisform.width-this.width
endwith
ENDPROC
PROCEDURE MouseLeave
LPARAMETERS nButton, nShift, nXCoord, nYCoord
with this
.left=thisform.width-15
endwith
ENDPROC
PROCEDURE shape1.Click
with thisform.container1
.visible=!.visible
if .visible=.f.
thisform.height0=thisform.olecontrol1.height
thisform.olecontrol1.height=thisform.height-this.height
else
thisform.olecontrol1.height=thisform.height0
endi
endwith
ENDPROC
PROCEDURE shape4.Click
thisform.ycl=iif(thisform.ycl=0,1,0)
do case
case thisform.ycl=1
thisform.timer1.enabled=.t.
thisform.setall("visible",.f.)
thisform.ybkg.visible=!thisform.ybkg.visible
case thisform.ycl=0
thisform.setall("visible",.t.)
thisform.container1.zorder(0)
thisform.timer1.enabled=.f.
thisform.timer1.timer()
endcase
thisform.container1.yrot.visible=.f.
this.parent.zorder(0)
this.parent.setall("visible",.t.)
this.parent.visible=.t.
ENDPROC
PROCEDURE shape5.RightClick
#Define APPCOMMAND_VOLUME_MUTE 0x80000
#Define APPCOMMAND_VOLUME_UP 0xA0000
#Define APPCOMMAND_VOLUME_DOWN 0x90000
#Define WM_APPCOMMAND 0x319
SendMessage(_vfp.HWnd, WM_APPCOMMAND, _vfp.HWnd, APPCOMMAND_VOLUME_UP)
ENDPROC
PROCEDURE shape5.Click
this.curvature=iif(this.curvature=99,0,99)
this.backcolor=iif(this.backcolor=rgb(255,255,0),255,rgb(255,255,0))
if !file(addbs(sys(2023))+"ytemp.m3u")
return .f.
endi
thisform.mus=iif(thisform.mus=0,1,0)
if thisform.mus=1
wmp.settings.mute=.f.
wmp.url=addbs(sys(2023))+"ytemp.m3u"
wmp.settings.setMode('shuffle',.t.) &&random reading playlist
wmp.settings.setMode('loop',.T.) &&loop
wmp.controls.play()
else
wmp.settings.mute=.t.
endi
ENDPROC
ENDDEFINE
*
*-- EndDefine: ycnt1
****
Function yinternet()
Declare Integer InternetCheckConnection In wininet;
STRING lpszUrl, Integer dwFlags, Integer dwReserved
#Define FLAG_ICC_FORCE_CONNECTION 1
lcURL="http://www.microsoft.com"
lResult = (InternetCheckConnection(lcURL, FLAG_ICC_FORCE_CONNECTION, 0)=1)
If lResult=.T.
Return .T.
Else
Messagebox("There is no internet connexion ! this must be established mandatory to run the program.",0+16,"internet Connection",1400)
*Return .F.
Endi
Endfunc
download yPDFReaderH.rar from this link.
note that vfp9 beautify have a bug if he code contains an encoded base 64 big string.i dont know if its marked as bug in the vfp9 bug list.
Important:All Codes above are tested on VFP9SP2 & windows 10 pro 64 bits version 1709(fall creator) & IE11 emulation. Navigator: firefox - screen:32 pouces.