A special pictures viewer from a toolbar
the code *1* builds a toolbar docked on bottom vfp screen. it embeds a container who can have a big quantity of buttons firing images(200 is a normal images count).can select any big folder of filtered format images (here jpg,png,bmp,gif ). the button class have mouseEnter event (fires a transparent form (transparency set on background color with constant LWA_COLORKEY ) the form visually is restricted to the image only.can click to make image fullscreen (image stretched to 2).form is shown once with its image embed and ajusted to be over the button source of event. on Mouseleave the form dispappears (its moved out of the visual area screen).this form is alwaysOnTop to be always over another controls,windows... when mousedown the image fills all the screen.move simply the mouse on another button to cut this fullscreen mode. the container is scrollable by 2 buttons (forward/backward.can set the scrolling increment in the container property...).these buttons invoke the container mouseWheel event as demonstrated on my previous posts. (this simulate the windows toolbar with windows thumbnails when moving the mouse on each pinned icon ) Can extend this sample to top level form (showWindow=2)...can also dock the toolbar in positions (here bottom as dock(3)...top left,right as 0,1,2). [post 263]
Click on code to select [then copy] -click outside to deselect
*1* created on wednesday 27 of february 2018
* a special pictures viewer built from a vfp toolbar ala windows.
Clea All
Set Defa To Addbs(Justpath(Sys(16,1)))
Publi gnbre, m.yrep
m.yrep=Getdir("","","",32)
If Empty(m.yrep)
Return .F.
Endi
Create Cursor ycurs (ximage c(200))
m.yrep=Addbs(m.yrep)
gnbre=Adir(gabase,m.yrep+"*.*") &&all files and filter to pictures extension jpg,png,bmp,gif only
For i=1 To gnbre
If Inlist(Lower(Justext(gabase(i,1))) ,"jpg","png","bmp","gif")
Insert Into ycurs Values (m.yrep+gabase(i,1))
Endi
Endfor
If Reccount()=0
Return .F.
Endi
Do ydeclare
Public o As Toolbar
o=Createobject("Toolbar1")
o.Dock(3)
o.Show()
Define Class toolbar1 As Toolbar
Add Object xNext As Label With FontName="webdings",AutoSize=.T.,FontSize=16,ForeColor=255,FontBold=.T.,Caption="3",MousePointer=15,ToolTipText="Backward"
Add Object xPrev As Label With FontName="webdings",AutoSize=.T.,FontSize=16,ForeColor=255,FontBold=.T.,Caption="4",MousePointer=15,ToolTipText="Foreward"
Add Object ycnt As ycontainer With Width=Sysmetric(1)-120,Height=30,BorderWidth=1,BackStyle=0,Name="ycnt"
Add Object xsepp0 As Separator
Add Object yhelp As Label With Caption="?",AutoSize=.T.,FontSize=16,ForeColor=255,MousePointer=15,FontBold=.T.
Add Object xsepp As Separator
Add Object cmdX As CommandButton With Caption='X',FontSize=16,Height=25,Width=20,ForeColor=255,Top=10,MousePointer=15
Procedure xNext.Click
This.Parent.ycnt.MouseWheel(-120)
Endproc
Procedure xPrev.Click
This.Parent.ycnt.MouseWheel(+120)
Endproc
Procedure cmdX.Click
o=Null
Release o
Try
_Screen.ActiveForm.yRELEASE
Catch
Endtry
Endproc
Procedure yhelp.Click
Local m.myvar
TEXT to m.myvar pretext 7 noshow
this code builds a toolbar docked on bottom vfp screen.
it embeds a container who can have a big quantity of buttons firing images(200 is a normal images count).can select any big folder of filtered format images (here jpg,png,bmp,gif ).
the button class have mouseEnter event (fires a transparent form (transparency set on background color with constant LWA_COLORKEY )
the form visually is restricted to the image only.can click to make image fullscreen (image stretched to 2).form is shown once with its image embed and ajusted to be over
the button source of event.
on Mouseleave the form dispappears (its moved out of the visual area screen).this form is alwaysOnTop to be always over another controls,windows...
when mousedown the image fill all the screen.move simply the mouse on another button to cut this fullscreen mode.
the container is scrollable by 2 buttons (forward/backward.can set the scrolling increment in the container property...).these buttons invoke the container
mouseWheel event as demonstrated on my previous posts.
(this simulate the windows toolbar with windows thumbnails when moving the mouse on each pinned icon )
Can extend this sample to top level form...can also dock the toolbar in positions (here bottom as 3...top left,right as 0,1,2).
ENDTEXT
Local oshell
oshell = Createobject('WScript.Shell')
oshell.Popup(m.myvar,0, 'Summary help', 0+32+4096) &&4,16,48,64...
oshell=Null
Procedure Init
With This
.AddProperty("form",Createobject("oform"))
.Form.Top=-500
.Form.Left=-500
.Form.Visible=.T.
With This.ycnt
DoDefault()
Sele ycurs
Scan
i=Recno()
.AddObject("ycom"+Trans(i),"picCMD")
With Eval(".ycom"+Trans(i))
.Caption=Trans(i)
.Width=27
.Tag=Allt(ximage)
.Top=5
.Left= (i-1)*.Width+5
.Visible=.T.
Endwith
Endscan
Endwith
Endwith
Enddefine
Define Class ycontainer As Container
Height=40
BackStyle=0
BorderWidth=0
Increment=100
Name="ycontainer"
Procedure MouseWheel &&dont work !!! initialized by click on external buttons. !
Lparameters nDirection, nShift, nXCoord, nYCoord
DoDefault()
If nDirection>0
With This
For Each obj In .Controls
obj.Left=obj.Left-This.Increment
Next
Endwith
Else
With This
For Each obj In .Controls
obj.Left=obj.Left+This.Increment
Next
Endwith
Endi
Endproc
Enddefine
Define Class picCmd As CommandButton
Width=24
Height=24
Tag=""
MousePointer=15
Procedure MouseEnter( nButton, nShift, nXCoord, nYCoord)
With This
With .Parent.Parent.Form && oform (form)
.Image.Picture=This.Tag
.Top=Sysmetric(2)-150-.Height
.Left=This.Left
Endwith
Endwith
Endproc
Procedure MouseLeave( nButton, nShift, nXCoord, nYCoord)
With This
With .Parent.Parent.Form
.Width=250
.Height=150
.Top =-500
.Left=-500
Endwith
Endwith
Endproc
Procedure MouseDown( nButton, nShift, nXCoord, nYCoord)
With This .Parent.Parent.Form
.Left=0
.Top=0
.Width=Sysmetric(1)
.Height=Sysmetric(2)
Endwith
Endproc
Enddefine
Define Class oform As Form
AlwaysOnTop=.T.
ControlBox=.F.
TitleBar=0
BorderStyle=0
Top=400
Left=10
Width=250
Height=150
KeyPreview=.T.
Name="form1"
Add Object Image As Image With Top=0,Left=0,Stretch=2,BorderStyle=1
Procedure Resize
With This
.Image.Width=.Width
.Image.Height=.Height
Endwith
Procedure Init(lcPic)
With This
.Resize
#Define LWA_COLORKEY 1
#Define LWA_ALPHA 2
#Define GWL_EXSTYLE -20
#Define WS_EX_LAYERED 0x80000
Local nExStyle, nRgb, nAlpha, nFlags
yHWnd=Thisform.HWnd
nExStyle = GetWindowLong(yHWnd, GWL_EXSTYLE)
nExStyle = Bitor(nExStyle, WS_EX_LAYERED)
= SetWindowLong(yHWnd, GWL_EXSTYLE, nExStyle)
nRgb = Thisform.BackColor &&the color to make transparent
nAlpha =128
nFlags = LWA_COLORKEY &&+ LWA_ALPHA
= SetLayeredWindowAttributes(yHWnd, m.nRgb,m.nAlpha, m.nFlags)
Endwith
Endproc
Procedure KeyPress
Lparameters nKeyCode, nShiftAltCtrl
If nKeyCode=27
With This &&oform (form)
.Top=Sysmetric(2)-150-.Height
.Left=This.Left
.Width=250
.Height=150
Endwith
Endi
Endproc
Procedure yRELEASE
gnbre=Null
Release gnbre
Close data all
Clea All
Thisform.Release
Endproc
Enddefine
Procedure ydeclare
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
|
|
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.