Working with form regions and transparency part 1
this code shows how to work with regions and APIs.This subject is already studied in my previous posts (see the links below). the transparency is better than SetlayeredWindow API (see previous posts).the regions can be set individually to transparent. some controls can set to be opaque and other to be transparent on any form. in setLayeredWindow API the transparency can concern one color (LWA_COLORKEY) : this can set -a color transparent (100% only) on the form -or all the form (LWA_ALPHA) or even (LWA_COLORKEY+LW_ALPHA).all controls are set, no particularity because only the form handle hwnd is used. setLayeredwindow can be applied only on form.desktop=.t. (having windows behavior) or on a top level form.showWindow=2 mandatory. With regions the objects delimitations on the form are very fine. the createRectRGN,createRoundRgn,CombineRGn apis are used for this goal. can play with the constants below to build some transparency effects on any form. https://msdn.microsoft.com/en-us/library/windows/desktop/dd183514(v=vs.85).aspx && CreateRgn https://msdn.microsoft.com/en-us/library/windows/desktop/dd183465(v=vs.85).aspx && combineRGn RGN_AND Creates the intersection of the two combined regions. RGN_COPY Creates a copy of the region identified by hrgnSrc1. RGN_DIFF Combines the parts of hrgnSrc1 that are not part of hrgnSrc2. RGN_OR Creates the union of two combined regions. RGN_XOR Creates the union of two combined regions except for any overlapping areas. these constants are also used in gdiplusX: (_SCREEN.SYSTEM.Drawing.Drawing2d.CombineMode.xor) (read http://yousfi.over-blog.com/2015/02/gdiplusx-effects-operations-on-images.html) *note : some images works with internet connected(can make them local) [post 261]
Click on code to select [then copy] -click outside to deselect
*1* created on monday 12 of february 2018
*working with regions and APIs.the transparency is better than SetlayeredWindow (see previous posts).the regions can be set individually to transparent.
*in setLayeredWindow the transparency can concern one color (LWA_COLORKEY) : this can set a color transparnt on the form
* or all the form (LWA_ALPHA) or even (LWA_COLORKEY+LW_ALPHA)
*setLayered window can be applied only on form.desktop=.t.(having windows behavior) or on form.showWindow=2 mandatory.
*with Win regions, the objects delimitations on the form are very fine.
*can play with the constants below to build some transparency effects on a form.
*https://msdn.microsoft.com/en-us/library/windows/desktop/dd183514(v=vs.85).aspx && CreateRgn
*https://msdn.microsoft.com/en-us/library/windows/desktop/dd183465(v=vs.85).aspx && combineRGn
*!* RGN_AND Creates the intersection of the two combined regions.
*!* RGN_COPY Creates a copy of the region identified by hrgnSrc1.
*!* RGN_DIFF Combines the parts of hrgnSrc1 that are not part of hrgnSrc2.
*!* RGN_OR Creates the union of two combined regions.
*!* RGN_XOR Creates the union of two combined regions except for any overlapping areas.
clea all
_screen.windowstate=1
do ydeclare
&& constants of CombineRgn Styles
#Define RGN_AND 1
#Define RGN_OR 2
#Define RGN_XOR 3
#Define RGN_DIFF 4
#Define RGN_COPY 5
#Define RGN_MIN RGN_AND && 1
#Define RGN_MAX RGN_COPY && 5
publi oForm
oForm = Newobject("yrgn")
oForm. Show
Read Events
Retu
Define Class yRgn As Form
ShowWindow=2 && 0
BorderStyle=3
Width=800
Height=630
titlebar=0
backcolor=0
autocenter=.t.
desktop=.t. && .f.
showTips=.t.
minwidth=800
Name="form1"
xOffset=.f.
yOffset=.f.
ymode=0 && 0 rectangle region, 1 roundRectangle region
Add object ybkg as image with ;
left=30,;
top=30,;
width=800-60,;
height=620-55,;
anchor=15,;
stretch=2,;
picture="",;
name="ybkg"
Add Object img As Image With ;
anchor=256,;
picture= "",;
stretch=2,;
left=240,;
top=40+22,;
width=300,;
height=300,;
name="img"
Add Object img1 As Image With ;
anchor=0,;
picture= "",;
stretch=0,;
left=240+100,;
top=40+70,;
dragMode=0,;
tooltiptext="Drag me anywhere on the form",;
name="img1"
ADD OBJECT ycnt1 AS cntH WITH ;
Top =22, ;
Left = 25, ;
Width = 624, ;
Height = 50, ;
BorderWidth = 0, ;
backstyle=0,;
Name = "ycnt1"
Add Object Lbl As Label With ;
width=150,;
height=70,;
Left = 35 ,;
Top = 35+35+20 ,;
wordwrap=.T.,;
borderstyle=0,;
forecolor=rgb(215,215,215),;
backcolor=0,;
Caption =" this is a label control-it can embed some texts and is readonly .Lorem ipsum dolor sit amet, consectetur adipiscing elit. Proin vel risus eget lorem feugiat",;
name="lbl"
Add Object txt As TextBox With ;
Top = 150+20 ,;
Left = 35 ,;
width=130,;
value="Integer lobortis dignissim auctor",;
backcolor=Rgb(0,255,0),;
name="txt"
Add Object Command1 As CommandButton With ;
Left = 35 ,;
Top =180 +20 ,;
width=150,;
height=80,;
backcolor=rgb(255,128,0),;
fontsize=16,;
mousepointer=15,;
caption="Backcolor",;
wordwrap=.T.,;
name="command1"
Add object grid1 as grid with ;
anchor=15,;
left=60,;
top=350+12,;
width=600,;
height=220,;
recordsource="ycurs",;
recordsourcetype=1,;
gridlines=0,;
deletemark=.f.,;
name="grid1"
ADD OBJECT OPTIONGroup1 AS optiongroup with ;
anchor=256, ;
AutoSize = .T., ;
ButtonCount = 5, ;
Value = 1, ;
Height = 103, ;
Left = 600+20, ;
Top = 35, ;
Width = 150, ;
Name = "Optiongroup1", ;
Option1.Caption = "RGN_DIFF,RGN_XOR", ;
Option1.Value = 1, ;
Option1.Height = 17, ;
Option1.Left = 5, ;
Option1.Top = 5, ;
Option1.Width = 140 , ;
Option1.AutoSize = .T., ;
Option1.Name = "Option1", ;
Option2.Caption = "RGN_XOR,RGN_DIFF", ;
Option2.Height = 17, ;
Option2.Left = 5, ;
Option2.Top = 24, ;
Option2.Width = 140, ;
Option2.AutoSize = .T., ;
Option2.Name = "Option2", ;
Option3.Caption = "RGN_DIFF, RGN_OR", ;
Option3.Height = 17, ;
Option3.Left = 5, ;
Option3.Top = 43, ;
Option3.Width = 136, ;
Option3.AutoSize = .T., ;
Option3.Name = "Option3", ;
Option4.Caption = " RGN_OR, RGN_DIFF", ;
Option4.Height = 17, ;
Option4.Left = 5, ;
Option4.Top = 62, ;
Option4.Width = 139, ;
Option4.AutoSize = .T., ;
Option4.Name = "Option4", ;
Option5.Caption = "RGN_AND,RGN_DIFF", ;
Option5.Height = 17, ;
Option5.Left = 5, ;
Option5.Top = 81, ;
Option5.Width = 140, ;
Option5.AutoSize = .T., ;
Option5.Name = "Option5"
Add Object shape1 as shape with ;
Anchor=768,;
width=40, ;
height=20,;
curvature=12,;
backcolor=rgb(255,0,0),;
bordercolor=rgb(0,255,0),;
top=3,;
left=380 ,;
mousepointer=15,;
tooltiptext="move form",;
name="shape1"
Add Object ysystem1 As ysystem With ;
anchor=768,;
left=800-68,;
top=1,;
name="ysystem1"
procedure shape1.mousedown && move form [can be set on any object even of form. )
Lparameters nButton, nShift, nXCoord, nYCoord
Thisform.MousePointer=15
lnHandle0=Thisform.HWnd
param1 = 274
param2 = 0xF012
bb=ReleaseCapture()
bb=SendMessage(lnHandle0, param1, param2,0)
Thisform.MousePointer=0
Endproc
procedure command1.click
local m.xcolor
m.xcolor=getcolor()
if m.xcolor=-1
return .f.
endi
thisform.backcolor=m.xcolor
endproc
PROCEDURE optionGroup1.interactiveChange
do case
case this.value=1
THISFORM.RESIZE(4,3)
case this.value=2
THISFORM.RESIZE(3,4)
case this.value=3
THISFORM.RESIZE(4,2)
case this.value=4
THISFORM.RESIZE(2,1)
case this.value=5
THISFORM.RESIZE(1,4)
endcase
ENDPROC
procedure load
sele * from home(1)+"samples\data\customer" into cursor ycurs
endproc
Procedure KeyPress
Lparameters nKeyCode, nShiftAltCtrl
If nKeyCode=27
Thisform.Release
Endi
Endproc
procedure grid1.init
thisform.grid1.setall("dynamicBackColor",'iif(mod(recno(),2)=0,rgb(255,255,217),rgb(110,255,145))',"column")
endproc
Procedure Init
* thisform.titlebar=0
thisform.ybkg.pictureVal=yloadImg("http://img.over-blog-kiwi.com/1/43/54/07/20180212/ob_804072_kantara.jpg")
thisform.img1.pictureVal=yloadImg("http://img.over-blog-kiwi.com/1/43/54/07/20180212/ob_ac3f20_garden.png")
thisform.img.pictureVal=yloadImg("http://img.over-blog-kiwi.com/1/43/54/07/20180212/ob_361e2f_yarabesque.gif")
thisform.ybkg.zorder(1)
with thisform.optionGroup1
.setall("forecolor",rgb(255,255,255),"optionbutton")
.setall("backstyle",0,"optionButton")
.backcolor=0
endwith
for each loObj in thisform.controls
try
bindevent(loObj,"dragdrop",thisform,"ydd")
catch
endtry
next
Thisform .Resize(4,3) && RGN_DIFF,RGN_XOR
Endproc
procedure ydd && for form.objects
LPARAMETERS oSource, nXCoord, nYCoord
try
oSource.Left = nXCoord - THISFORM.XOffset
oSource.Top = nYCoord - THISFORM.YOffset
catch
endtry
endproc
Procedure Resize
lparameters p1,p2
try
if !between(p1,1,5) or !between(p2,1,5) or empty(p1) or empty(p2)
p1=4
p2=3
endi
catch
endtry
With Thisform
lnClientTop = Sysmetric (9) + Sysmetric (4)
lnClientLeft = Sysmetric (3)
lnFullHeight = lnClientTop + .Height + Sysmetric (4)
lnFullWidth = lnClientLeft + .Width + Sysmetric (3)
lnFullRegion = CreateRectRgn(0, 0, lnFullWidth, lnFullHeight) && region of form delimited area
if thisform.ymode=0
lnRegion = CreateRectRgn(lnClientLeft, lnClientTop, lnClientLeft + .Width, lnClientTop + .Height)
else
lnRegion = CreateRoundRectRgn(lnClientLeft, lnClientTop, lnClientLeft + .Width, lnClientTop + .Height,50,50)
endi
For Each loObj In .Controls
if !lower(loObj.name)=="optiongroup1"
if thisform.ymode=0
lnSubReg = CreateRectRgn( lnClientLeft + loObj. Left, lnClientTop + loObj.Top,lnClientLeft + loObj.Left + loObj.Width,lnClientTop + loObj.Top + loObj.Height)
else
lnSubReg = CreateRoundRectRgn( lnClientLeft + loObj. Left, lnClientTop + loObj.Top,lnClientLeft + loObj.Left + loObj.Width,lnClientTop + loObj.Top + loObj.Height,50,50)
endi
CombineRgn(lnRegion, lnRegion, lnSubReg, p1) &&RGN_DIFF)
endi
Endfor
CombineRgn(lnFullRegion, lnFullRegion, lnRegion, p2) &&RGN_XOR)
SetWindowRgn( Thisform .HWnd, lnFullRegion, .T.)
Endwith
Endproc
procedure activate
thisform.windowstate=2
endproc
***drag img1 (garden.png) on he form by mousedown on
procedure dragDrop &&for form
LPARAMETERS oSource, nXCoord, nYCoord
oSource.Left = nXCoord - THISFORM.XOffset
oSource.Top = nYCoord - THISFORM.YOffset
endproc
procedure img1.dragDrop
LPARAMETERS oSource, nXCoord, nYCoord
THIS.Parent.DragDrop(oSource, nXCoord, nYCoord)
endproc
procedure img1.mouseMove
LPARAMETERS nButton, nShift, nXCoord, nYCoord
IF nButton = 1 && Left button
this.mousepointer=15
THISFORM.XOffset = nXCoord - THIS.Left
THISFORM.YOffset = nYCoord - THIS.Top
THIS.Drag
this.zorder(0)
this.mousepointer=0
ENDIF
endproc
Procedure Destroy
Clea Dlls
Clea Events
Endproc
Enddefine
procedure ydeclare
DECLARE INTEGER CreateRoundRectRgn IN gdi32;
INTEGER nLeftRect, INTEGER nTopRect,;
INTEGER nRightRect, INTEGER nBottomRect,;
INTEGER nWidthEllipse, INTEGER nHeightEllipse
Declare Long CreateRectRgn In WIN32API Long, Long, Long, Long
Declare Long CombineRgn In WIN32API Long, Long, Long, Long
Declare Long SetWindowRgn In WIN32API Long, Long, Long
DECLARE INTEGER DeleteObject IN gdi32 INTEGER hObject
Declare Integer ReleaseCapture In WIN32API
Declare Integer SendMessage In WIN32API Integer, Integer, Integer, Integer
endproc
*&& container class :minimize,maximize/restore,close buttons as fonts.
Define Class ysystem As Container
Anchor=0
Width = 65
Height = 26
BackStyle=0
BorderWidth=0
Name = "ysystem"
Add Object label3 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontName = "Marlett", ;
FontSize = 12, ;
BackStyle = 0, ;
Caption = "0", ;
Height = 21, ;
Left = 0, ;
MousePointer = 15, ;
Top = 0, ;
Width = 22, ;
ForeColor = Rgb(255,0,0), ;
Name = "Label3"
Add Object label4 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontName = "Marlett", ;
FontSize = 12, ;
BackStyle = 0, ;
Caption = "r", ;
Height = 21, ;
Left = 43, ;
MousePointer = 15, ;
Top = 5, ;
Width = 22, ;
ForeColor = Rgb(255,0,0), ;
Name = "Label4"
Add Object label5 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontName = "Marlett", ;
FontSize = 12, ;
BackStyle = 0, ;
Caption = "1", ;
Height = 21, ;
Left = 22, ;
MousePointer = 15, ;
Top = 5, ;
Width = 22, ;
ForeColor = Rgb(255,0,0), ;
Name = "Label5"
Procedure label3.Click
Thisform.WindowState=1
Endproc
Procedure label3.MouseLeave
Lparameters nButton, nShift, nXCoord, nYCoord
This.ForeColor=255
Endproc
Procedure label3.MouseEnter
Lparameters nButton, nShift, nXCoord, nYCoord
This.ForeColor=Rgb(0,255,0)
Endproc
Procedure label4.Click
Thisform.Release
Endproc
Procedure label4.MouseLeave
Lparameters nButton, nShift, nXCoord, nYCoord
This.ForeColor=255
Endproc
Procedure label4.MouseEnter
Lparameters nButton, nShift, nXCoord, nYCoord
This.ForeColor=Rgb(0,255,0)
Endproc
Procedure label5.Init &&enabled
This.Enabled=.T.
Endproc
Procedure label5.MouseEnter
Lparameters nButton, nShift, nXCoord, nYCoord
This.ForeColor=Rgb(0,255,0)
Endproc
Procedure label5.MouseLeave
Lparameters nButton, nShift, nXCoord, nYCoord
This.ForeColor=255
Endproc
Procedure label5.Click
With Thisform
.WindowState=Iif(.WindowState=0,2,0)
If .WindowState=0
This.Caption="1"
Else
This.Caption="2"
Endi
Endwith
Endproc
Enddefine
*
*-- EndDefine: ysystem
*container class:collapsible container menu
DEFINE CLASS cntH AS container
Top = 12
Left = 12
Width = 624
Height = 60
BorderWidth = 0
Name = "cntH"
ADD OBJECT image1 AS image WITH ;
Picture = "", ;
Height = 48, ;
Left = 0, ;
Top = 5, ;
Width = 48, ;
Name = "Image1"
ADD OBJECT image2 AS image WITH ;
Picture = "", ;
Height = 48, ;
Left = 55, ;
Top = 5, ;
Width = 48, ;
Name = "Image2"
ADD OBJECT image3 AS image WITH ;
Picture = "", ;
Height = 48, ;
Left = 96, ;
Top = 5, ;
Width = 48, ;
Name = "Image3"
ADD OBJECT image4 AS image WITH ;
Picture = "", ;
Height = 48, ;
Left = 137, ;
Top = 5, ;
Width = 48, ;
Name = "Image4"
ADD OBJECT image5 AS image WITH ;
Picture = "", ;
Height = 48, ;
Left = 178, ;
Top = 5, ;
Width = 48, ;
Name = "Image5"
ADD OBJECT image6 AS image WITH ;
Picture = "", ;
Height = 48, ;
Left = 219, ;
Top = 5, ;
Width = 48, ;
Name = "Image6"
ADD OBJECT label1 AS label WITH ;
AutoSize = .T., ;
FontBold = .T., ;
FontName = "Webdings", ;
FontSize = 24, ;
Anchor = 768, ;
BackStyle = 0, ;
Caption = "3", ;
Height = 35, ;
Left = 585, ;
MousePointer = 15, ;
Top = 12, ;
Width = 35, ;
ForeColor = RGB(255,128,0), ;
Name = "Label1"
ADD OBJECT image7 AS image WITH ;
Picture = "", ;
Height = 48, ;
Left = 274, ;
Top = 5, ;
Width = 48, ;
Name = "Image7"
ADD OBJECT image8 AS image WITH ;
Picture = "", ;
Height = 48, ;
Left = 322, ;
Top = 5, ;
Width = 48, ;
Name = "Image8"
ADD OBJECT image9 AS image WITH ;
Picture = "", ;
Height = 48, ;
Left = 371, ;
Top = 5, ;
Width = 48, ;
Name = "Image9"
ADD OBJECT image10 AS image WITH ;
Picture = "", ;
Height = 48, ;
Left = 422, ;
Top = 5, ;
Width = 48, ;
Name = "Image10"
ADD OBJECT image11 AS image WITH ;
Picture = "", ;
Height = 48, ;
Left = 472, ;
Top = 5, ;
Width = 48, ;
Name = "Image11"
ADD OBJECT image12 AS image WITH ;
Picture = "", ;
Height = 48, ;
Left = 531, ;
Top = 5, ;
Width = 48, ;
Name = "Image12"
procedure init
with this
.setall("mousepointer",15)
for i=1 to .controlcount
if lower(.controls(i).class)=="image"
if lower(.controls(i).name)=="image1"
loop
endi
bindevent(.controls(i),"mouseEnter",this,"my1")
bindevent(.controls(i),"mouseLeave",this,"my2")
bindevent(.controls(i),"mouseDown",this,"my")
endi
endfor
endwith
this.populate()
endproc
procedure image1.click
this.parent.label1.click
endproc
PROCEDURE label1.Click
do case
case this.caption="3"
this.caption="4"
this.parent.width=48+10
this.left=this.left-5
case this.caption="4"
this.caption="3"
this.left=this.left+5
this.parent.width=624
endcase
ENDPROC
procedure my
Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
messagebox(loObject.name+" clicked..write some code from here.",0+32+4096,"",1200)
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
.top=.top-2
.left=.left-2
endwith
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
.top=.top+2
.left=.left+2
endwith
endproc
procedure populate() &&15 encoded images here(can customize)
local m.x
text to m.x noshow
iVBORw0KGgoAAAANSUhEUgAAADAAAAAwCAYAAABXAvmHAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAHESURBVGhD7ZivS15xGEffvmURLBNhQQUFwWAQLQbFWXRiUEHwF4jFYBFcm8G6gQj+AeKKWMQ2FAwiYrFsbfgDYXVxntNvecLuM3m/B0783s+BV+9739soFAqFwr+gFXtxEMcTdd8Oe0J4aB63cC9R9+2wJ8QH3McTvErUfTvsCbGGd/iMfxN13w57Qizgd/yJfxJ13w57QkzjN7zG34m6b4c9IbrRQ8u4maj7dtjTXHTgCH7EpUTdt8OeEB7axSOsur3Vpft22BNiBo/Ri9wn6r4d9oR49d8D/u358V2g9+Is3bfDnhBD+AkP8CxR9+2wJ8Q79NAEziXqvh32NBc9OIvr6EeYpft22BPCQ6f4A6vuDnXpvh32hFjES/yFVReuS/ftsCfEq/8eGMOv6KPseaLu22FPiE6cRP+JdhJ13w57QrRhP45i1f25Lt23w54Qb9FXGe+xL1H37bAnxABu4Geset1Rl+7bYU8If8r5e/QBq+4Odem+HfaEWMEbfMSqC9el+3bYE2IVb/EJqy5cl+7bYU8InwC38QseJuq+HeHH6Rb0VcYwTiXqvh32hHiDHmrHrkTdt8OeQqFQKBQK/xmNxgtxU8M3k2sjVwAAAABJRU5ErkJggg==
endtext
this.image1.pictureVal=strconv(m.x,14)
text to m.x noshow
iVBORw0KGgoAAAANSUhEUgAAADAAAAAwCAYAAABXAvmHAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAANcSURBVGhD7ZhJ6E5RFMC/WGBhiJUhQ2JvLlHYGTYWWIiFYWGhxMJKkTWZimwMe4qFkpWiiLKSEhspRaFkyPz71f/U7XX7vu/vvfcNead+i/fePfece9+555z3Wo000kgjjQyCjIcpMA8Ww0pYl+C1933uOMcPlOjUXNDZ3XAIjid47f21MAcc31cZB5NgCWwDHTwJl+EG3Ia7CV573+eOc7x66juP8/VUNDoL9sJ1eAo/4Tf8aYPPHed49dR3HufrifjqDYHNYGhcg2fwForOex0U7ztePfWdx/lmw2SoVXR+NZwDnfgMqXOpk+70rxGKiwjUd56zsApcRC0SMe9O6fx90Ph3SB36AV/hAVyAiyM8hG/gotLx6jvPPXARzl/LmYiY93W323mdfw+nYSkshxXgoj+Ci8jpxZtw/lrOhNnCA2fMttt5d1Lnt8IMmAk6dAB89gpSvSDehPNrR3uViinPrOHByzmQ7rzGdT6VTXAeHkFOP3B+7WivEokKa9429b2D1GDsvGfiDMTOTwRlGiyEw+C5eA2pfhHn1472KqnYkTYtPrk8r/MfQOeXgSGTis5vhKuQO8RFIntpz8peumLbu1j+raCp87mY1/k4fBNgKmyAY2BYPIcX8DLBM/EGPkG6CO1pV/ulxAbMHsY2IAxIxPwpcMx0SEXn58N+uAW2EncyGHpPwEWk82tvFyyCUmIXaTzqQEzuDhnP7vwW0PmI+ZB4A6bQ7bADdmbYA/vgJvhWLXra0J52tV9K7C7NzTZk4bwxapHKZZvRyhgYC0fgC7gI7WhPu9ovJc0COkjtCxj6MzD0WSjqwCVw58OAu9VNHVgPR8Eepy91wA8Me/QTYOyni5BOlXgBWMyuwGgrcSXfzvYiLuIg/Gsv5CL61guFVNGNmrkeQ04/qLwbDdGpof4eGPovsvSb2G9Xd7Pdmxi4b+IQM5J/DzTW7k1ENhmYvxIhkVbdKV+3MevB04mik14HxfuOV09953E+5639v1BInAkPnFnD1JerE0V87jjHq6d+LTHfSeJMmC1MedYJi50V2zbA1sGGLPDa+z53nOPVU7/WmO9WIrTWgD2MhcjQCLz2vs97GirdSlRsP8RtwOwibYUDr73vc8dVVmEbaaSRRhr5n6XV+guGag4Ujuk/cwAAAABJRU5ErkJggg==
endtext
this.image2.pictureVal=strconv(m.x,14)
text to m.x noshow
iVBORw0KGgoAAAANSUhEUgAAADAAAAAwCAYAAABXAvmHAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAANeSURBVGhD7ZlL6I15GMf/7iPUSDIWiLCYKDaS28KlyGVFSTIzm7EgLFyzQzasJLFgQXLZsJKixNJl5TJTY7IaGzM2ioViPp/6/+rXr+ecznvOe0Teb306/W7f53n+5/yf9z3vGWjUqNH3paEwHBbCTtgFuzPWw88wEXI5dt71fL/n9dFPX/37KoP8AHvgT/gL/s44BxvBZHM5dt71fL/n9dFPX/37qpEwBg7Dv/AfvM24Cr/CPMjl2HnX8/2e10c/ffXvq0bBODgOnwNugR+JBZDLsfOuR+f001f/viq9A77lzwPOwhaYC7kcO+96dE6/L/IOjIDRYDLXAw7BapgJuRw773p0Tj999e+LxsN0WAYGOwJRIgdgBayDTRmOnXc9Oqefvvobx3i1StPlsB+iBBJ7wSR87WS+RH/jGK9WLQbNL0P0GU6cgg2Dr53Ml+i/D4xXq/wYXINnEHWRxA3YNvjayXyJ/rZarxm1aAh4ddwOj+AfiAInei3gNRjHeMY1fk/SZBgcBC867yEKnOi1gA/gBc5uVcutxY8wDU6AyX+EKHCi1wL0twjjGdf4PWkq+A91HqKAJb0WkDDeIpgCPSndw9yEKFBJXQW47xco76kqy558DB5AFKikrgLuw1Ewfk/qtH0m6iqgtnZqO3sCtrcoUEldBRjvMfwOXcm7wrFgO9PsHUSBSuoqwHhec4zf1W22yf8EtrNPEAWJqKsAMe5JmAwWUUm2zyXQaftMXIJV4E3bxQzHzrsenWvFBTAPrwmVZPuyjVX5i8kZmAN+SV+Z4dh516NzrTB+V+3U9mUbs51FxiVv4A/wfn8SeAGakeHYedfd5/7Ip6Trdmr7ugJPITIuMSn/WpvBG7DyJizNue4+90c+JcY3j8rt1KvvPXgFkXHJQzgNa6FdAa67z/2RT4nxzcN8KmkHvIBO3+q7YMtbCu3kuvvcH/mUGN88zKeSfARS5bPazwLMw3wqqSmghZoCOlVTQAs1BXSqb76ArXAbvJTnz/MjfNzi5f43mA/t5Lr73F/+thBhfPMwn0ryYayPwu9A/otKyUvwVxYfGa6BWdBOrrvP/Z7zfOSbML55mE8lzQYP+SUk/02rxN+4JCU/AdrJ9VREOhv5JoxvHubTqFGjRl+dBgb+B3VhNVpgbJvnAAAAAElFTkSuQmCC
endtext
this.image3.pictureVal=strconv(m.x,14)
text to m.x noshow
iVBORw0KGgoAAAANSUhEUgAAADAAAAAwCAYAAABXAvmHAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAOBSURBVGhD7dlb6E1pGMfxfw4pN5IoJGfjmLNICGMcGoxxDCHJMZGUlJRLV8zNqCkluVNS7twSlzNypzQ3UjMX1JRcmt+nrHqbtvg3e7/a2U99+/c87/P81vus/1rvu9bafT3rWc++DZsd9oQj4UwHoe84jtdWI3o/PA0vOwh9x3G8ttqJ8Cw8CQ/DvXC7jdCjS99xHK+tdjH8Ex6HX8PlcLSN0KNL33Ecr63WNPAgnA97w+qwKWwPa8PC8H3YGcRXFvDFjcuTr06cDj269DvagH/3trAkjA1zwqowIbBJweTERxXwxY0z+erE6dCjS79KA+vDinAwXAnOIlsXrgbxRQV8ceNMvjpxOvSqNmCVOBB+CY/C4cCOh9/D9SCvgS9unMlXp54OvaoNOINzw8ZgMvMDc7ZNckOYUcAXN87kq1NPh17VBkyqnUavagOu2+8+/v05NA3ZQXcHcTdsA1+82WHlqyt1qjbwU9gSxO8Ek2EmaVMSt+o08MWNM/nqxOnQq9pA169CNqdZwYSsIm5EtiB4IBOfWsAXN87kqxOnQ69qA8uCzWhxsMJMCcz1vDk46zaoBr64cSZfnXo69Ko24HFgZDARZ3V0YCZrUpPD8AK+uHEmX516OvSqNtD198C+4Jr+LfwRmh3WS4nnevFdBXxx40y+OnE69Ko2sCa4BFzX5Q67NJikuJuzgS9unMlXJ06HXtUGun4nXh7cgM7oj2FaYNODTUl8fAFf3DiTr06cDr2qDfjXWwbPhhvBZJhJ3goul/KFhi9unMlXp54OvaoNOKjV41D4P6uQejr0qjbQ3MRbw6ngjYrZkM4FzzczC/jixpl8deq/yk1sIhNDsxN7XGDjgjE7rg2qgS9unMlXp56OsaoNzAvDwphgMiNCf0y+OvV06FVt4Idg5dgfLgUv6P0x+erU06FXtQEHPhZuhufhZOiPyVenng69qg14SXH9ejFptcNaHi8U8Fvt2Orp0KvagJVlYBgShobBgZmkrw9/hjcF/PKrhHx16unQq97AgDAomIxJsNPhRfgrvC/gixtn8tWpp1O9gU89C1nrXwW5Hwr44sZbWbVnoebb6I7gJeS/XAt/h3ehbIAvbrxVHb0q30Y/93X6bngbXDZlA3xx463qOv51+kt/HzCB18HZLm9ivrjxVnUd/32g63+h6frfyHrWs571rBPW1/cvf3a07q2HPJEAAAAASUVORK5CYII=
endtext
this.image4.pictureVal=strconv(m.x,14)
text to m.x noshow
iVBORw0KGgoAAAANSUhEUgAAADAAAAAwCAYAAABXAvmHAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAPTSURBVGhD7ZhLqE5RFICv96O8pt5GJshrJAoZYCYJ5RXJwIwMEAOKJCKPESEj70hKmSjKyIi8SjJRHkUib75vsGp3Ovf/z73/+f97b86qr3vPv/dee+211157ndNWSSWVVFJJd5CBMBwmwHSYBfMTfPZ32+1n/24lGjUeNHYDbIW9CT77+zwYB/bvUhkAQ2EGLAcNPAxn4TrchrsJPvu77fazv+Mcrx71tVScdDRshKvwGH7BH/hbA9vtZ3/HOV496muJuPWGwBIwNK7AE3gL9YwP7Gd/xzlePeobC8OgqaLxc+A4aMQXyDOyKI5XzzGYDS6iKRIxr6c0/j44+Q/IM6wojleP+k7AUmhKloqYd7vL8HyWr/AB9oPZrPQsZbbwwBmzZXj+N6jDvz7/BBdxDTbBTChVTHlmDQ9e1pjOEKGTdYT6ncf5SpG4Yc3bpr53kE7YUQw/9VyE3XAO7sFrsF39tm8BM1LDZ0HjjUkvnyJ5vh4adwlWQn9YCAfARdge98QhKCWtWrtYHniDpsb7v/H7EfTeJ4i2PMLzJ2EFTIE+MBEWw3nQcHWq+wzMBZ3XkFiAWcNYBqQGOZEH7xWkIdAeETbGdl/oDUo/GAx74Du4CPs733qYBg2JVaTxby2TZ9A+cKIjcAdeQtpPzz8CPa/xk0Hj9b4L0UHrwOyThqjzOa/zNySGj7nfgiw17DIYCpNA8XbeDi4i7afxFyDref/3clwLt+AFpOOcz3mdvyHJLiBi/xTonTGgRImxC1zEA6jneY0/DRrvJdaSBWi8ufsgjIJsFRk7cRQ64/mgtAVkz0DsgF7eAQtgCEQ9HzuxCJaBIdYRzwelnYH2stB7eAYuYiS4iFR6JShFPR+UloW8B3wNNC9HhhDrFhdxE2InDKfYiTA+vD8VVoNnp5bnxXm8d5zX+RsSb0JvRG/GvJtYQ57DTsg7ExrvjbsKboC7lo7Pon7n8eYv5d3ZWsRFWJuY+7O1UJTB6U4YToPAsDEE1oCe13h3LR2fJWoh47/U9wKzSa1qNHsmRkBHYj4ovRoNqfc+EGdCY60yt8FmsMapF/MS5bX6ncf5SpWib2QWddZFT+EhvIG8flnUp171N+UrheGgUt+JfQG3gMvbiW/gItwNjf8MaXuW8Lz61Kv+NJuVLmYkvx44Wa2dKEp4vulfJUIirfbY70IhcSZ63Je5kDgT8W3Ue8LLzhvbMsBaxoIs8Nnfbbef/R3XZd9GsxKh5WugNYwXkaER+Ozvtrc0VIpK3Ni+w3r7WkVaCgc++7vt9ivthq2kkkoqqeR/lra2f164S9COhj4JAAAAAElFTkSuQmCC
endtext
this.image5.pictureVal=strconv(m.x,14)
text to m.x noshow
iVBORw0KGgoAAAANSUhEUgAAADAAAAAwCAYAAABXAvmHAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAWcSURBVGhD7dhVqG1VFMbxY3d3F3Z3dysGdgd2B14b+yImdiF2YCcqmC8XFUVFRUXwUQQFHwRRxPp+cqcsz5l773W22+t92AP+3HPuWWvO8c055hhjrpGhDW1oQ2PThunDSmHXcGA4NuwW1guLhqnaOD9T2CPcFp4L74e7wvGBiP/F5g9WdZNgNTuxfzgiXBteDo8GQh4Mz4ZLAnG7h9r7hbWCOWcNAzHOm/iscGcXHguvhHfC5+HuQNCT4efwXrgn+P/a+wXvrBiIGIitGvYLF4YHuiBk3gzvho/DzWHv8HD4KXwY7Irfa+8XjgurhQXDQGyNcEi4PDzeBas/KRAg9q8KOwSr/mP4JAilp0Lt/cIpQRgtHAZiCwUitgl2AvtWODxYvVvCW+H5IP6fDsQRdEBwVmrvl7E3DJyfPQzUpglSpX9rNkOYJRDyYvgy/BFeDxeELUI36zV+37ZCkNf3DPuEVULNpgtEbB2clzcCAfcGzi8ValaEbxxOCOZaPdj5gZgBbw1i+ZHgYHazZcO24f5AgPTZzTg/TzgjfBTMpQgS8a9sjrBIEJ83hOuDHG/w5cN8oWbjFSBNqw2K3aXhijAxbB/sjp3tyzi/djgsXB0uCmdO/n3nQETNxitApromODvrBHNIyYcGu0NEXyYbnBoMrJCZaLNAwMVBrNcOXVsBJXT2CmqGDGTRdgnnBQLMsUzoy4SOvEyAcBFSMwYDyzJqg/6HiKa1FcB5zlkQ/ZI2gvk/jpuHkM3DuIyzwuPgIPYNrC/RqIlHsXllMPH6YbHQtLYChOeRwQJxds3AirCDwk3B7s8WLF4r47xt1JNMCJuGpskOBvf3Y8K6oWltBUjL9wXjSLFzh6YJqSeCvy8QiOhqpZDYPtnAi1uGpUPTSmW2arKSA211SrboJWDOYNdUZSlTWub8zKFpzqC2gh+e6VR//jbOc4Jj2mEv1rIAobALLwQh0NziXgI4v0EwvvZCSNasLJTnbgwWqqu5MUljJW3uFGp5uAhwuM4Pnucwx1kvASquVMkx+V/rXDO9EBF6p9uDpDJvsKhV63SoOpnQ2ip4lpCSLXoJ4JCOlICuDk02IsvdYrngnTFmleV5Wyo9tmlnxS0RKrMtlq04o3eqCZBdiBN6zed7FSoLaZHstMXl2xgTv9Kmfp1D4+kKNXguKoRz0mGrCeD8dsFzbneuqG1srrBk8F6zXvzD9CMnh2fC2UE4qLptOD08FE4LUq7MVRPgbxPCOUHIWbDaeKMxlobSOAqo3Whmvb9M3tcCu3wo6yZpi1Qqn18Wjg52pCagXC8VJ62IO0JtvE64HH0QpNYxhc0nD1dGd9m3w6vjYFIw8HXBSu0YagJK00aEu7OLTm28TpR5TgxjdmCJ4AC7u/4STNyW38OvQaqTycR2TYD0qed3vRw9Rhu+CQS4to4xB8UW3xGsztfhh1AbqEDsd8GO2V5ZQjep+NQEWCQihM5r4YvQbcEszG/h2/BZsHNdD78J/FEo+YZDRG3gAucNrOFzhsr9oFMdaBbAc4Oen3NEjB4bnCfu06BuHBUskK64anaBCF8ffNO0UvK1IuIqKVXC1dKXB46dFFTs5g2tlwCNm+yiHjicqr457KKPY+bysz5J1yu7KX66BM7riltZKTwbBblXRdTamnzloEOsWScBo630XnK8ORxyYWwuP+t6LUrfnxhVSSIWD/oVqBcm7NbethVgN4iw8+bQJiiC5vGzPojzfV8p+7W2AqaYlf7dyri89EKo+b6jahKg/Nee64TbmDlbx3ov47yrI8cc7l5oE3yCkV4JcGeoPdcJFypzEjEQ86XY9a7X1+mCz+kvBVX9++Bze+25TpSv0wP7MifrSHe+UHw1BdCSqBWdPkWO22QdItyI5OT/Gr1U7ZI/tKENbWhTpY2M/AnuyM8Z5nBnQgAAAABJRU5ErkJggg==
endtext
this.image6.pictureVal=strconv(m.x,14)
text to m.x noshow
iVBORw0KGgoAAAANSUhEUgAAADAAAAAwCAYAAABXAvmHAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAFlSURBVGhD7dm7SsRgEMXxKIqIWHlrrUQRwQdQsLKyEUHBasHGywtoZaWNYGtroYX4CoKVNjaCvoD4GF7/pxiw2c2XIuabMAd+5WbnTNhNNltEIpFIpIlMYwWrWMMiJjCCKhnDDMbRjz78SzT8Mc5wgQ7moBJVouG1gFkMQCVqjd5kCDu4xwOecI51qERKprCAPVxhC8MYRK3R8KM4xc8fdzjEElKi4bdxi0+cQMfV8WtNrwJHWEavTGIeB9Dwr/iGjueigIbfxA0+8AW9PvsCtvl9aPgXaHht30WBbps32RYo27zJtkDZ5k12BVI3b7IrkLp5k02BDVTZvMmmwC6qbN40XuAZl7iGhtcVNmXzpvEC73jEG3Rvkzq4iQKpaW0B958B999CrbkOuL8St+ZeyJJ6JrIt4P73gKXsTGRfwP1vYku3M+GmgJ2JLJ8LuXgy5/7ZqMXt02mL+/8HIpFIJNKGFMUvhlWNjAU7KuUAAAAASUVORK5CYII=
endtext
this.image7.pictureVal=strconv(m.x,14)
text to m.x noshow
iVBORw0KGgoAAAANSUhEUgAAADAAAAAwCAYAAABXAvmHAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAO/SURBVGhD7dlXqFRHGMDxa49djFgjiIoVkRgSFOz6oJFExIaCvSVEkURQDNgL9oIa1GjAmmBLTHzQqMlDJNggqFgeLKAiiqCo2LDl/wcHBlkPd+W6ex/OBz9kz7B355s5Z87MZ0EaaaSRhlEOVdAUndEbQ9EDbfARyqIUimXYeTv5JWbgJxzCCoxGW1SESeQ1SrxWHQ3RHv3xLZZgO/7Gf7iMo/gd62BiY/EFPkEdVEZOw86XRCN0xxTswBk8wwu8yuAp7uNfmIyJeGuZxHsN721HqTEc7QFwtBdiMw7iLG7Bzr9EpgSewySu4ST+gInMRDwr9VGkz4qdd5R8GB3tnbiCu8jU0WzdgAmFWWmHSsj6WQn3dg00QScMwndYjC0Io23nHyNTh7L1ACGJMCs+K2PQC95mtWFSiRHubZdBvzgde3EeTv/bbo2i9gT3cAQ/YBRawyQS4wNUxWBsgyvJBdxGrjovB8skruIEfsYcdEViuI7Xw1Jk+sP54gB6F4xHYpRHNbimex/ug2u5D+ydPHBZPoCNmIUuSAyXrTLwbepy9jV8m/6FSzl2Ed46LiBuSVqiJhLDB9gkvJXq4lP45UnwYfK5cJXwwf4VyzERi7AVu2C7L7VNWADbV8LrgavZKtg+DWsRt2/AXAyDS2oz2Hm3Ie8U/gET8R70R+chntLP8A2+h+2T4d7H5c/wbe314Cv4Tgkvrb6I211ECjXihQ1HwTfvj3Bpc3X6E0NguHlbD2fFdmfADZydNEbC64GzOQ490QK+HON2B6cjGqBI4nM45cfgqhD2NFNh+MKx7TpsdwPnLtSttOFWIV5V/sF82O7sOTBx+y/og+YokkgTQNzBNIFsI00AcQfTBLKNNAHEHUwTyDbSBBB3ME2gsOGW1hrQMliMsp7jD4Qz6364k9wNz68exG33NOWBxF2p7SYTd9ATnjta21fjOOL2U7DeNAEm6DH3ncLOWwM6DTtsx8OPeMh/BDv7EHFFzn/97HXb3yy/2OY1251JZzRu97Ollt/gGcQksgpPZqXhQWQ2PB+71/ckFk5N1jr3wFH0X9u8Ftr8HNr9bviewonOdk9xdjRu97Oz6m8PRCvYJ8s+hQo7b4nlY1jYGg4rZrnWD5ZSrMF61DWJxLDj1kG7waLWGmQaoVxx9jxbe0IbAQc0McJ/UPgF78E37818CQ+9d0JiVMCHcPRvwoJSqNHk0zkchlWKxLB4WgtWFzLVavLFom9cRHhrWM42iQ6wnlNc+EDbeQu8aaSRRhrFLgoK/gf6AS21ISl7sAAAAABJRU5ErkJggg==
endtext
this.image8.pictureVal=strconv(m.x,14)
text to m.x noshow
iVBORw0KGgoAAAANSUhEUgAAADAAAAAwCAYAAABXAvmHAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAJQSURBVGhD7Zg9T1RBFIb3D/gHlBoLSg1SAIFoKVLJPyBQaLTjy0JJJLbYS6ihEzo+AomVJGpjaWJMaOxtbPB5kp3kZjPIsjuTuzfMmzzJna9zzr0795zZ2yoqKioqGgTdgttwF+61r6uybb/jXjt/oGRQ92EG5sFgq7Jtv+PO67zB2jUGL2ATPsIqTFewbb/jznP+QOkp7MB3uIATeFPBtv2OO8/5tWgIHsBDmIUJGIE1+AznYKA/waADtu133HnOd53rtaM97Wo/q3TyHDZgC9waPs1t+A1/wEAvw3HnOd91rteO9rSr/azySb0Ft8FXOGpffwOD+wuxwAOOO8/5rnO9drzWrvazyp/7A3yBWIC9oj3taj+r3LMrcAixQHpFe9rVflb54oWMEwukV7SnXe0nVaiw5m0dmD18Ad3DsUB6RXva1b5+9JekYocKa/HxKZkCu8k21yVkJ+3rR39JKrZnlyfwHixC5vFuss11CdlJ+/qxYutX/33Jp7AI+xBznIs9WAD996WwhZbhAH5AzGEqfsEneAVJtlDQOCyBNxFznAqDfwePIKkmwadyDDHHqch2A1PwGsKpMhfJbyC8Ax66qqfKXCR/BzRSRxbSn37135fqqgP6S1IHwhZqbCVu/FmoU407jXaq8f8HGv+PrPH/iXN9lTD4ZzAKWfW/70JnYB43UCv2aYVuvgsZ/B2oRXOwCxYhAzXo9Qq27Xc8ZJyBknn7JTT222io2Fd9nX7cvu67wqZWqNieXWIB2rZ/uH2dvMIWFRUVFd1EtVr/ALOcabNDnXMhAAAAAElFTkSuQmCC
endtext
this.image9.pictureVal=strconv(m.x,14)
text to m.x noshow
iVBORw0KGgoAAAANSUhEUgAAADAAAAAwCAYAAABXAvmHAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAALASURBVGhD7ZnL605BGMdf94UShZVCFMmOsmDnFiWW2CslO2yxcGeh38r/4LaXy1ZZkS07YWOBNZ/P4qnTNO85XnPOyat56tOvmXnm+c7Mb67nnVSrVq1atSFtFWyA3XCshSNwALbAYlgETTNt/lY4CPrn4gTqqat+kRlkD5yFBy3ch5twCJaCjW2aafMPwy3QPxcnUE9d9YtsF5wBg75p4Tk8htOwDJZA00wvB8v10z8XJ1BPXfWL7CgswGv41cIXeAfnwYamHXD0V4Dl+umfixOop676RdbVgZ/wFZ7CRdgHNn7aFLJcP/2tZ/1c3NE6YCPewyVYDyuhzSzXT3/rWT8Xd7QOfIOPcBU2wxpos9WwES7DB7B+Lu5oHfgBzuc7sBMc3TZbC9vhBnyC75CLO1gHYs47cjY+eAW34QSsg3QqmTb/OLjdvgAbH/WN11wTg3Ug5rzT5jMobr5/TbvH7wAb2zTT5lueq2e85prorQMePPfgGThVnoAL8ArYmJdgIwLT5jvSNjow3eZvPOMaXx317oL6RbYfrsNDeAsXwHm+CdpG1HzLgy4/4xnX+Oqodw3ULzLvNt5dTsI52AvOZ3eTPxnZYFp5/KeMZ1zjq6OeuuoXWRxAQXpAKd42wkGar7/1rN+0Lr2ZLW6RQXrL7NpdUrp2qy69wcz9fRtM299t/CznxejWdUDVDvytxZz0hpm7Zfa9BlKt4jVgEHcDHym5e76N6HMXMr466vWyC8U5cAp8jHifd9SGOgeMr456vZwDcRI/Al9SPkaGPImNr4566hafxOldyJfUkHch48ddSN3iu9Dc30bTDsz9eyBF8Vn2964TOxitA47cXL+JY024AB39dOqkZrl++jfnfMpoHYg1MbffhQLXwT/5ZW7uv432/XXacv1G+zrd9+8Dlus32u8D1apVq1btf7bJ5Dd1ZQvGtMpUvwAAAABJRU5ErkJggg==
endtext
this.image10.pictureVal=strconv(m.x,14)
text to m.x noshow
iVBORw0KGgoAAAANSUhEUgAAADAAAAAwCAYAAABXAvmHAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAATcSURBVGhD7dhp6KZTGMfxf/axjJqaGSFpmoxtlqzZGWOJIoxlLBMiGqKQLGXfsjQJL7wgZpRlbJEkFGMp5YVCyP5OyMibSTL8PuXUScfk/P/PoNxXfes557qu33U993Puc5/7GRtssMEGG+zfsA3CJmFqmBF2DXuFfcOBYX44vMLYPL848fLk06H3j5qiW4adw4JwSrggXBquDjeGOyqMzfOLEy9PPh1669RcKcVczbPCZeHWcF9YFp4ML4SXwqvh9fBWhbF5fnHi5d0bbgn06B4W1FFvpEb0hOBqrgxfhTXhtwlC49fwZfAlbw/qqDchWy9Yl3OCn/v68HhwNb8OP4ZWQ+PBl1gVXBT66qinrvr60E+XSdo4nB6eDR+HVvF1hXrqqq+P7pt8h3BUuDsQ+z60Cq0Ort4nwdKyxhV+KjxRYc2bezG8Fj4KPwT5LV311FVfH/rpsiPCXeHt0CpQ0PwX4blwc7DLnBlOCydWWA7mLgqWxzPhs+BLtHQL6utDP11mi7M7WI/vrgX+m8I54dBgn58XrN1dKuz75vYOh4Szg631sdDSLdDXh3667OBwbbgz3L8WNDKeba9sy/JbugX19aGfLjsprAivhNaVKVwXdg9bhx4TL09+S7egvj7002UXBjfad6G1NgsPhP3CdqHHxMuT39ItqK8P/XSZb2znsC9/3uDTYOdxQ+4YxrOE5MmnQ69VR319dP8C1pyf98HwcgPb4fPBzauZzUKPiZcnnw69Vh319dF9D2wfJB0bFjfwgDk17BY0s1HoMfHy5NOh16qjvj708/+yPcL5wSnRT7gkLAyzw4bB+f6aYIvjPyPsE+z3blBXznzB2Dy/OPHm5dOhR5e+Ourxq68P/XSZpPfCN8Fu8H54NCwKmwYPoV+CkyS/I8Ql4eSwf7B2693E2Dy/OPHm5dOhR5e+Ourxq68P/XSZK/BB+DYQ+jDYj63VzYNjg+LlSO2Guzw4LlizDwXzBWPz/OLEmy/HaXp06aujHr/6+tBPl/35OeDz08GNtUXweC/NwQPnysDvSPFwqP3G5vnFia/99Ojyq6Oe+XE/B44Litri3gzLww3BG9mkcG5YGd4I/EuDn98blbPQVcF8wdg8vzjx5uXToUeXvjrq8auvD/10mRdv764K3xYuDk6VbjJnc4crhzhXjt/roJvTwW3bcHwwXzA2zy9OvHn5dOjRpa+Oevzq60M/XbZNkHRAIO7nt4adKDWyZzgmOKu7av5xED83eMJq8ugKY/P84sTLk0+HHl366qinrvri9TMhmxZcPQ04hHnB2CpMDusHBTyU+ODBY00XjItPnHh58unQ46OvjnojtSODdetfBMfcK4LziavjSGB7rI/B5wVXtWBc+8XLk0+Hnnn66qg3UrNz/BR+DnaHd8I9wQNp1h+f613FTsJXMK794uXx+UzPPH111Bup/dUXsO1Z265c3aBXRr6Cce0XL49v+AJ/x5xlvHw8EvzLYOtT3EuJm9C26P21/Avh5Z6vYFx84sTL46NDj4++OuqN1GYGNxZh+/RBYaegCf/b2L/9o+Ygxu/mnF5hbJ5fnHh58unQ46evjnojtSmBqJ/dNmdbtIs4v3gAadJLOvhtk3wFY/MlRrw8Pjr0+Omro95ggw022GCDDfYft7Gx3wESp+++LHI0vwAAAABJRU5ErkJggg==
endtext
this.image11.pictureVal=strconv(m.x,14)
text to m.x noshow
iVBORw0KGgoAAAANSUhEUgAAADAAAAAwCAYAAABXAvmHAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAANQSURBVGhD7dlZqE1hFMDxa57neShDkSFJvCEZUkiUPFA8IA8yPhheiBcRHkRKUhIRCinkxQsPJIWE5EVmpUwpEv9/+Wr77tn7nnuce8892at+da972mettdf+vr23mjzyyCOPPMoRLdEWozEXY9ARrVEVYfJdsRCHsQh9YRFVER3QGxtwB5sxGBbVENHsj14YgVHw7MeGoag8OmMA9uEXDsID90RDhMk3x0jMxwJ49mOzMQUWkRmVKmAqtuMQzhRwBHswE5lRiQLktXYBj+H3xt7jEVYjMypVwHiswHl8x09URQEhXOX6YCe+wCKqooCw70yGK99lVNUZCPvOGtzGSyQTDxqtAHds9xKTcm3350LRCu0wCWvhSmPyn+D3fsU7PMcTeHE3SgFhI3S9dlOyiEJh8t2wDm6YrxC6LZN/iBu4hJto0ALsvBei6/km7MBeuDH1RycYyc6b/FmY/Gf4faHzLqkeZxWWYCuOYh4yo9QCwiril9o5T/0H7IdLpEUYxXbe43i8LrA5E7AM45AZ9S0g7rydM4mP+AZHwCIWYyhmoZjOezyP60XeAjbA5PshM+pbQNx5kwjdlEV4JryznYFdKKbzHrekKLaAsNrYqY0InbeTycR+wCJM+jg8I3HnXSIvwjvfaTB5j19SFFtAWG1M/gHeIpl4scL6vgWOR7jYS466Cig08ybv9u/n7awdfoaswsLMJztv8m3wT1FXAXXNvMk7LtdwChaR/HtQtpmPI60AV4Gsmbfzr3EO67EcPogcwD28gZ8r+8zHkVbAIGTNvMnfhTdkPWCxLn9uZF68FuHnyj7zcaQVMB3uiCdQaOZd1+28d5XtYUd90vJ51iJ24zp8sirrzMeRVsBKmPx9+O9BmHk3J3dYd9pkWIRnwtHbhjko68zHkVaACbibHsMLmHhy5u28yXuvk4zwzDsEPpQPR1lnPo60AgYi3Lffgl1Pzrxj0yQirQBfbnlfMhEW4cgkZz7ufMUirYCwD4S7ySCe+YpHXMBVJNd1r4OlCf6efAHVWMai0DVXq4CnuAI3nvhlUyXZvO6oNQHhJi28G/WW4DROwg2pqfDMFxzh+O10U2V+5mm+f0X8/wNNlfmZp/nmkUceeeTx30dNzW9zLasyfpANQwAAAABJRU5ErkJggg==
endtext
this.image12.pictureVal=strconv(m.x,14)
this.refresh
endproc
ENDDEFINE
*
*-- EndDefine: cntH
function yloadimg
lparameters url
Local loRequest
m.loRequest = Createobject('MsXml2.XmlHttp')
m.loRequest.Open("GET",Url,.F.)
m.loRequest.Send()
local xpictureval
m.xpictureVal= m.loRequest.ResponseBody
m.loRequest=Null
return m.xpictureVal
endfunc
the garden.png is only image can be dragged anywhere on the form area( can code others).
Click on code to select [then copy] -click outside to deselect
*2* created on monday 12 of february 2018
*A top alertt created with api createwindowEx
*adapted form new2news: http://www.news2news.com/vfp/index.php?example=504
*can select dynamically color,fontname,fontsize,fontstyle and the text to show.
*can position the top alert on desktop
*can hide/show all desktop icons
Clea All
Public oform1, oAlert1 As TAlert
Set Defa To Addbs(Justpath(Sys(16,1)))
_Screen.WindowState=1
Do ydeclare
oform1=Newobject("yAlert")
oform1.Show
Read Events
Return
Define Class yAlert As Form
Top = 250
Left = 10
Height = 185
Width = 270
ShowWindow = 2
ShowTips = .T.
BorderStyle=0
Caption = "Top Alert"
MaxButton = .F.
AlwaysOnTop = .T.
BackColor=Rgb(212,210,208)
Name = "Form1"
Add Object command1 As CommandButton With ;
Top = 12, ;
Left = 12, ;
Height = 25, ;
Width = 97, ;
FontBold = .T., ;
Caption = "Build oAlert", ;
MousePointer = 15, ;
Name = "Command1"
Add Object command2 As CommandButton With ;
Top = 11, ;
Left = 156, ;
Height = 25, ;
Width = 85, ;
FontBold = .T., ;
Caption = "Close oAlert", ;
MousePointer = 15, ;
Name = "Command2"
Add Object edit1 As EditBox With ;
BorderStyle = 0, ;
Height = 48, ;
Left = 1, ;
ScrollBars = 0, ;
Top = 48, ;
Width = 240, ;
VALUE="FoxPro application requires "+Chr(13)+" your immediate attention!"
Name = "Edit1"
Add Object shape1 As Shape With ;
Top = 102, ;
Left = 5, ;
Height = 23, ;
Width = 37, ;
BackStyle = 1, ;
Curvature = 15, ;
MousePointer = 15, ;
ToolTipText = "text Forecolor", ;
SpecialEffect = 0, ;
BackColor = Rgb(128,255,0), ;
Name = "Shape1"
Add Object command3 As CommandButton With ;
AutoSize = .T., ;
Top = 99, ;
Left = 138-50, ;
Height = 27, ;
Width = 27, ;
Caption = "...", ;
ToolTipText = "Fontname/fontsize", ;
Name = "Command3"
Add Object text2 As TextBox With ;
FontSize = 8, ;
Value = "Impact", ;
Height = 25, ;
Left = 169-50, ;
Top = 101, ;
Width = 89, ;
Name = "Text2"
Add Object text3 As TextBox With ;
FontSize = 8, ;
Alignment = 3, ;
Value = -92, ;
Height = 25, ;
InputMask = "9999", ;
Left = 261-50, ;
Top = 100, ;
Width = 36, ;
Name = "Text3"
Add Object spinner1 As Spinner With ;
Height = 24, ;
KeyboardHighValue = Sysmetric(1), ;
KeyboardLowValue = 0, ;
Left = 0, ;
SpinnerHighValue = Sysmetric(1), ;
SpinnerLowValue = 0.00, ;
ToolTipText = "Left", ;
Top = 127, ;
Width = 60, ;
Value = 480, ;
Name = "Spinner1"
Add Object spinner2 As Spinner With ;
Height = 24, ;
KeyboardHighValue = Sysmetric(2), ;
KeyboardLowValue = 0, ;
Left = 65-8, ;
SpinnerHighValue = Sysmetric(2), ;
SpinnerLowValue = 0.00, ;
ToolTipText = "top", ;
Top = 127, ;
Width = 60, ;
Value = 50, ;
Name = "Spinner2"
Add Object spinner3 As Spinner With ;
Height = 24, ;
KeyboardHighValue = Sysmetric(1), ;
KeyboardLowValue = 0, ;
Left = 154-20, ;
SpinnerHighValue = Sysmetric(1), ;
SpinnerLowValue = 0.00, ;
ToolTipText = "width", ;
Top = 127, ;
Width = 60, ;
Value = 800, ;
Name = "Spinner3"
Add Object spinner4 As Spinner With ;
Height = 24, ;
KeyboardHighValue = (Sysmetric(2)), ;
KeyboardLowValue = 0, ;
Left = 219-20, ;
SpinnerHighValue = (Sysmetric(2)), ;
SpinnerLowValue = 0.00, ;
ToolTipText = "height", ;
Top = 127, ;
Width = 60, ;
Value = 600, ;
Name = "Spinner4"
Add Object yshowH As CommandButton With ;
AutoSize = .T., ;
Top = 127+24+2, ;
Left = 48, ;
Height = 27, ;
Width = 100, ;
Caption = "Hide/show Desktop icons", ;
Name = "yshowH"
Procedure yshowH.Click
#Define WM_COMMAND 0x0111
hWindow = FindWindowEx(0, 0, "Progman", 0)
hWindow = FindWindowEx(hWindow, 0, "SHELLDLL_DefView", 0)
SendMessage(hWindow, WM_COMMAND, 0x7402,1) &&switch automatically the desktop hide/show
Endproc
Procedure Destroy
Try
oAlert1.ClearAlert
olaert1=Null
Release oAlert1
Catch
Endtry
Clea Events
Endproc
Procedure command1.Click
_Screen.WindowState=1
Thisform.command2.Click
If Vartype(oAlert1)="O"
oAlert1=Null
Endi
Clea Dlls
Publi oAlert1 &&important
Local m.xleft,m.xtop,m.xwidth,m.xheight
m.xleft=Thisform.spinner1.Value
m.xtop=Thisform.spinner2.Value
m.xwidth=Thisform.spinner3.Value
m.xheight=Thisform.spinner4.Value
Do yof With Thisform.edit1.Value,Thisform.shape1.BackColor,Thisform.text2.Value,Thisform.text3.Value ,m.xleft,m.xtop,m.xwidth,m.xheight
Endproc
Procedure command2.Click
Try
oAlert1.ClearAlert
olaert1=Null
Release oAlert1
Catch
Endtry
Endproc
Procedure shape1.Click
Local m.xcolor
m.xcolor=Getcolor()
If m.xcolor=-1
Return .F.
Endi
This.BackColor=m.xcolor
Thisform.command1.Click
Endproc
Procedure text2.InteractiveChange
Thisform.command1.Click
Endproc
Procedure text3.InteractiveChange
Thisform.command1.Click
Endproc
Procedure spinner1.InteractiveChange
Thisform.command1.Click
Endproc
Procedure spinner2.InteractiveChange
Thisform.command1.Click
Endproc
Procedure spinner3.InteractiveChange
Thisform.command1.Click
Endproc
Procedure spinner4.InteractiveChange
Thisform.command1.Click
Endproc
Procedure command3.Click
Local m.xfont
m.xfont=Getfont()
If Empty(m.xfont)
Return .F.
Endi
Thisform.text2.Value=Getwordnum(m.xfont,1,',')
Thisform.text3.Value=Int(Val(Getwordnum(m.xfont,2,',')))
Endproc
Enddefine
*
*-- EndDefine: yAlert
*
Procedure yof
Lparameters xalertmessage,xforecolor,xfontname,xfontsize,xleft,xtop,xwidth,xheight
If Empty(xalertmessage)
xalertmessage="FoxPro application requires "+Chr(13)+" your immediate attention!"
Endi
If Empty(xforecolor)
xforecolor=Rgb(0,255,0)
Endi
If Empty(xfontname)
xfontname="Impact"
Endi
If Empty(xfontsize)
xfontsize=-92
Endi
oAlert1 = Createobject("TAlert")
With oAlert1
.Left=xleft
.Top =xtop
.Width=xwidth
.Height=xheight
.FontName=xfontname
.FontSize=Iif(xfontsize>0,-xfontsize,xfontsize)
.FontBold=.F.
.ForeColor=xforecolor
.alertmessage= xalertmessage
.ShowAlert
Endwith
Define Class TAlert As Custom
#Define SW_HIDE 0
#Define SW_SHOWNA 8
#Define WS_DISABLED 0x08000000
#Define WS_EX_TOPMOST 8
#Define WS_EX_TRANSPARENT 0x00000020
#Define WS_EX_LAYERED 0x80000
#Define WS_EX_NOACTIVATE 0x8000000
#Define SM_CXSCREEN 0
#Define SM_CYSCREEN 1
#Define SM_CYCAPTION 4
#Define SM_CXFRAME 32
#Define SM_CYFRAME 33
#Define DT_WORDBREAK 16
#Define FW_NORMAL 400
#Define FW_BOLD 700
#Define ANSI_CHARSET 0
#Define OUT_DEVICE_PRECIS 5
#Define OUT_OUTLINE_PRECIS 8
#Define CLIP_STROKE_PRECIS 2
#Define PROOF_QUALITY 2
#Define DEFAULT_PITCH 0
#Define ANTIALIASED_QUALITY 4
#Define LWA_COLORKEY 1
Left=0
Top=0
Width=300
Height=60
FontName="Arial"
FontSize=24
FontBold=.T.
ForeColor=0
alertmessage="Alert!"
hFont=0
hWindow=0
Add Object Timer1 As Timer With Interval=1000
Procedure Init
This.Declare
Endproc
Procedure Destroy
This.ClearAlert
Endproc
Procedure ClearAlert
This.ReleaseFont
This.ReleaseWindow
Endproc
Procedure HideAlert
= ShowWindowA(This.hWindow, 0)
This.Timer1.Interval=0
Endproc
Procedure ShowAlert
This.RefreshAlert
This.Timer1.Interval=1000
Endproc
Procedure Timer1.Timer
This.Parent.RefreshAlert
Endproc
Procedure RefreshAlert
If This.hWindow = 0
This.CreateWindow
This.CreateFont
Endif
= ShowWindow(This.hWindow,8) && SW_SHOWNA)
Local hDC
hDC = GetDC(This.hWindow)
= SelectObject(hDC, This.hFont)
This.DrawText(This.alertmessage, hDC,;
3, 3, This.Width-10, This.Height-10,;
THIS.ForeColor)
= ReleaseDC(This.hWindow, hDC)
Endproc
Procedure DrawText(cMessage, hDC, nLeft, nTop,;
nWidth, nHeight, nColor)
Local oRect As Rect
oRect = Createobject("RECT",;
nLeft, nTop, nWidth, nHeight)
= SetBkMode(hDC, 1) && transparent
= SetTextColor(hDC, nColor)
= DrawText(hDC, cMessage,;
LEN(cMessage), oRect.ToString(), DT_WORDBREAK)
Endproc
Procedure ReleaseWindow
If This.hWindow <> 0
= DestroyWindow(This.hWindow)
This.hWindow=0
Endif
Endproc
Procedure CreateWindow
This.ReleaseWindow
Local hParent, cClass, nExStyle, nStyle
hParent = _Screen.HWnd
cClass = This.GetWinClass(hParent)
* window styles
nStyle = WS_DISABLED
nExStyle = Bitor(WS_EX_TOPMOST, WS_EX_LAYERED,;
WS_EX_TRANSPARENT, WS_EX_NOACTIVATE)
This.hWindow = CreateWindowEx(nExStyle, cClass,;
"Alert", nStyle, This.Left, This.Top,;
THIS.Width, This.Height, hParent, 0, 0, 0)
* create region and apply it to the window;
* this cuts the caption and the frame off the window
Local nCaptionHeight, nFrameWidth, nFrameHeight,;
x1, y1, x2, y2, hRgnBase
nCaptionHeight = GetSystemMetrics(SM_CYCAPTION)
nFrameWidth = GetSystemMetrics(SM_CXFRAME)
nFrameHeight = GetSystemMetrics(SM_CYFRAME)
x1 = nFrameWidth
y1 = nFrameHeight+nCaptionHeight
x2 = This.Width-nFrameWidth-1
y2 = This.Height-nFrameHeight-1
* hRgnBase = CreateRectRgn(x1, y1, x2, y2)
hRgnBase=CreateRectRgn(0, Sysmetric(9)+0, This.Width,This.Height)
SetWindowRgn(This.hWindow, hRgnBase, 1)
= DeleteObject(hRgnBase)
* set window transparency -- white
= SetLayeredWindowAttributes(This.hWindow,;
RGB(255,255,255), 0, LWA_COLORKEY )
Endproc
Procedure ReleaseFont
If This.hFont <> 0
= DeleteObject(This.hFont)
This.hFont=0
Endif
Endproc
Procedure CreateFont
This.ReleaseFont
This.hFont = CreateFont(This.FontSize, 0, 0, 0,;
IIF(This.FontBold, FW_BOLD, FW_NORMAL), 0,0,0,;
ANSI_CHARSET, OUT_DEVICE_PRECIS, CLIP_STROKE_PRECIS,;
PROOF_QUALITY, DEFAULT_PITCH, This.FontName)
Endproc
Protected Procedure GetWinClass(hParent)
Local cClass, nSize
cClass = Replicate(Chr(0), 250)
nSize = RealGetWindowClass(hParent, @cClass , Len(cClass ))
Return Strtran(Substr(cClass, 1, nSize), Chr(0),"")
Endproc
Protected Procedure Declare
Declare Integer ReleaseCapture In WIN32API
Declare Integer FindWindowEx In user32;
INTEGER hwndParent,;
INTEGER hwndChildAfter,;
STRING @ lpszClass,;
STRING @ lpszWindow
Declare Integer SendMessage In user32;
INTEGER HWnd,;
INTEGER Msg,;
INTEGER wParam,;
INTEGER Lparam
Declare Integer DestroyWindow In user32 Integer hWindow
Declare Integer DeleteObject In gdi32 Integer hObject
Declare Integer SelectObject In gdi32 Integer hdc, Integer hObject
Declare Integer SetTextColor In gdi32 Integer hdc, Integer crColor
Declare Integer GetDC In user32 Integer hWindow
Declare Integer ReleaseDC In user32 Integer hWindow, Integer hdc
Declare Integer GetSystemMetrics In user32 Integer nIndex
Declare Integer RealGetWindowClass In user32;
INTEGER hWindow, String @pszType, Integer cchType
* DECLARE INTEGER ShowWindow IN user32 AS ShowWindowA;
INTEGER hWindow, INTEGER nCmdShow
Declare Integer CreateWindowEx In user32;
INTEGER dwExStyle, String lpClassName, String lpWindowName,;
INTEGER dwStyle, Integer x, Integer Y,;
INTEGER nWidth, Integer nHeight, Integer hWndParent,;
INTEGER hMenu, Integer hInstance, Integer lpParam
Declare Integer SetLayeredWindowAttributes In user32;
INTEGER HWnd, Integer crKey,;
SHORT bAlpha, Integer dwFlags
Declare Integer CreateFont In gdi32;
INTEGER nHeight, Integer nWidth, Integer nEscapement,;
INTEGER nOrientation, Integer fnWeight, Integer fdwItalic,;
INTEGER fdwUnderline, Integer fdwStrikeOut, Integer fdwCharSet,;
INTEGER fdwOutputPrec, Integer fdwClipPrec, Integer fdwQuality,;
INTEGER fdwPitchAndFamily, String lpszFace
Declare Integer CreateRectRgn In gdi32;
INTEGER nLeftRect, Integer nTopRect,;
INTEGER nRightRect, Integer nBottomRect
Declare Integer SetWindowRgn In user32;
INTEGER hWindow, Integer hRgn, SHORT bRedraw
Declare Integer DrawText In user32;
INTEGER hDC, String lpString, Integer nCount,;
STRING lpRect, Integer uFormat
Declare Integer SetBkMode In gdi32;
INTEGER hdc, Integer iBkMode
Declare Integer LoadBitmap In user32;
INTEGER hInstance, Integer lpBitmapName
Declare Integer LoadImage In user32;
INTEGER hinst, String lpszName, Integer uType,;
INTEGER cxDesired, Integer cyDesired, Integer fuLoad
Declare Integer AlphaBlend In Msimg32;
INTEGER hDestDC, Integer x, Integer Y,;
INTEGER nWidth, Integer nHeight, Integer hSrcDC,;
INTEGER xSrc, Integer ySrc, Integer nWidthSrc,;
INTEGER nHeightSrc, Integer blendFunction
Declare Integer ShowWindow In user32;
INTEGER HWnd,;
INTEGER nCmdShow
Endproc
Enddefine
Define Class Rect As Custom
Left=0
Top=0
Width=0
Height=0
Procedure Init(nLeft, nTop, nWidth, nHeight)
This.Left=m.nLeft
This.Top=m.nTop
This.Width=m.nWidth
This.Height=m.nHeight
Endproc
Function ToString As String
Return num2dword(This.Left) +;
num2dword(This.Top) +;
num2dword(This.Left+This.Width-1) +;
num2dword(This.Top+This.Height-1)
Endfunc
Enddefine
Function num2dword(lnValue)
#Define m0 0x0000100
#Define m1 0x0010000
#Define m2 0x1000000
If lnValue < 0
lnValue = 0x100000000 + lnValue
Endif
Local b0, b1, b2, b3
b3 = Int(lnValue/m2)
b2 = Int((lnValue - b3*m2) / m1)
b1 = Int((lnValue - b3*m2 - b2*m1) / m0)
b0 = Mod(lnValue, m0)
Return Chr(b0)+Chr(b1)+Chr(b2)+Chr(b3)
Endfunc
Procedure ydeclare && API for the builder form (not for the class)
Declare Integer FindWindowEx In user32;
INTEGER hwndParent,;
INTEGER hwndChildAfter,;
STRING @ lpszClass,;
STRING @ lpszWindow
Declare Integer SendMessage In user32;
INTEGER HWnd,;
INTEGER Msg,;
INTEGER wParam,;
INTEGER Lparam
Endproc
Click on code to select [then copy] -click outside to deselect
*3* created on monday 12 of february 2017
*demo for drawing predefined regions on desktop and colorize the intersections and non intersetions sub regions.
*of course ,drawing is not persistent.can use a timer to redraw systematically the regions (re run the code all the 1 sec for ex)
* or us ethe standard windows processing by Apis (CallWindowProc)...
*can draw the forms you project with this method on desktop or any hdc surface.
*can be desktop (hwnd=0),_screen.hwnd,form.hwnd....this is only trivial demo how to do it directly on desktop.
Clea All
_Screen.WindowState=1
Do ydeclare
Inke(2)
#Define RGN_AND 1
#Define RGN_OR 2
#Define RGN_XOR 3
#Define RGN_DIFF 4
#Define RGN_COPY 5
#Define RGN_MIN RGN_AND &&1
#Define RGN_MAX RGN_COPY &&5
#Define LTGRAY_BRUSH 1
#Define DKGRAY_BRUSH 3
*hide desktop icons
#Define WM_COMMAND 0x0111
hWindow = FindWindowEx(0, 0, "Progman", 0)
hWindow = FindWindowEx(hWindow, 0, "SHELLDLL_DefView", 0)
SendMessage(hWindow, WM_COMMAND, 0x7402,1) &&switch automatically the desktop hide/show
Local hRgn1 As Long, hRgn2 ,reg1,reg2,reg3,reg4,reg5,reg6 As Long && elliptical and rectangular source regions.
Local hXorRgn As Long, hAndRgn As Long && regions set to the non-intersection and intersection
Local hLightBrush As Long, hDarkBrush As Long && handles to light gray and dark gray brushes
*Local retval As Long && Return Value
* Create the four regions. The initial settings of hXorRgn and hAndRgn are irrelevant.
x=450
Y=450
r=200
hRgn1 = CreateEllipticRgn(x-r,Y-r,x+r,Y+r) && bounding rect /ellipse
hRgn2 = CreateRectRgn(x-r+100,Y-r+100,x+r+100,Y+r+100) && rectangle
hXorRgn = CreateRectRgn(0, 0, 0, 0) && meaningless initialization
hAndRgn = CreateRectRgn(0, 0, 0, 0) && meaningless initialization
reg1=CreateEllipticRgn(x-r+150,Y-r+250,x+r+250,Y+r+250)
reg2=CreateEllipticRgn(x-r+300,Y-r+300,x+r+300,Y+r+300)
reg3=CreateEllipticRgn(x-r-150,Y-r-150,x+r-150,Y+r-150)
reg4=CreateEllipticRgn(x-r-200,Y-r-200,x+r-200,Y+r-200)
reg5= CreateRoundRectRgn(x-r+200,Y-r-200,x+r+200,Y+r-200,100,100)
reg6=CreateEllipticRgn(0,0,Sysmetric(1)-100,Sysmetric(2)-100)
* Now set hAndRgn to the intersection of the two source regions and hXorRgn to the non-intersection of the two source regions.
= CombineRgn(hXorRgn, hRgn1, hRgn2, RGN_XOR) && non-intersection
= CombineRgn(hAndRgn, hRgn1, hRgn2, RGN_AND) && intersection
= CombineRgn(hXorRgn,reg1, reg2, RGN_XOR)
= CombineRgn(hAndRgn,reg3, reg4, RGN_AND)
= CombineRgn(hAndRgn,hXorRgn, reg5, RGN_XOR)
= CombineRgn(hXorRgn,hXorRgn, reg6, RGN_OR)
Inke(5,"H") &&better than sleep(5000)
* Now get the necessary stock brushes and fill in the two combined regions.
hLightBrush = GetStockObject(LTGRAY_BRUSH) && light gray solid brush
hDarkBrush = GetStockObject(DKGRAY_BRUSH) && dark gray solid brush
hWindow=0 &&desktop &&thisform.hwnd or _screen.hwnd
hDC=getdc(hWindow)
= FillRgn(hDC, hXorRgn, hLightBrush) && fill non-intersection
= FillRgn(hDC, hAndRgn, hDarkBrush) && fill intersection
Inke(5,"H")
= InvertRgn(hDC,hAndRgn) &&invert intersection region color
Inke(5,"H")
* Delete the four regions to free up resources.
= DeleteObject(hRgn1)
= DeleteObject(hRgn2)
= DeleteObject(reg1)
= DeleteObject(reg2)
= DeleteObject(reg3)
= DeleteObject(reg4)
= DeleteObject(reg5)
= DeleteObject(reg6)
= DeleteObject(hXorRgn)
= DeleteObject(hAndRgn)
ReleaseDC(hWindow, hDC)
*show desktop icons
#Define WM_COMMAND 0x0111
hWindow = FindWindowEx(0, 0, "Progman", 0)
hWindow = FindWindowEx(hWindow, 0, "SHELLDLL_DefView", 0)
SendMessage(hWindow, WM_COMMAND, 0x7402,1) &&switch automatically the desktop hide/show
Retu
Procedure ydeclare
Declare Integer Sleep In kernel32 Integer
Declare Integer FindWindowEx In user32;
INTEGER hwndParent,;
INTEGER hwndChildAfter,;
STRING @ lpszClass,;
STRING @ lpszWindow
Declare Integer SendMessage In user32;
INTEGER HWnd,;
INTEGER Msg,;
INTEGER wParam,;
INTEGER Lparam
Declare Integer CreateRoundRectRgn In gdi32;
INTEGER nLeftRect, Integer nTopRect,;
INTEGER nRightRect, Integer nBottomRect,;
INTEGER nWidthEllipse, Integer nHeightEllipse
Declare Integer CreateEllipticRgn In gdi32;
INTEGER nLeftRect,;
INTEGER nTopRect,;
INTEGER nRightRect,;
INTEGER nBottomRect
Declare Long CreateRectRgn In WIN32API Long, Long, Long, Long
Declare Long CombineRgn In WIN32API Long, Long, Long, Long
Declare Long SetWindowRgn In WIN32API Long, Long, Long
Declare Integer DeleteObject In gdi32 Integer hObject
Declare Integer GetStockObject In win32api Integer
Declare Integer FillRgn In win32api Integer hdc, Integer hrgn, Integer hbr
Declare Integer GetDC In user32 Integer HWnd
Declare Integer ReleaseDC In win32api Integer,Integer
Declare Integer InvertRgn In gdi32.Dll Integer hdc, Integer hRgn &&invert intersection color
Endproc
Click on code to select [then copy] -click outside to deselect
*4* created on tuesday 13 of february 2018
*creating rectangular and elliptic regions on a form (shaped form).
Public oform
oform=Newobject("yregions")
oform.Show
Read Events
Return
Define Class yregions As Form
Height = 651
Width = 1148
ShowWindow = 2
AutoCenter = .T.
Caption = "Working with Regions"
BackColor = Rgb(128,255,0)
Name = "Form1"
Add Object image1 As Image With ;
Anchor = 15, ;
Stretch = 2, ;
Height = 662, ;
Left = 0, ;
Top = -2, ;
Width = 1152, ;
Name = "Image1"
Add Object command1 As CommandButton With ;
Top = 612, ;
Left = 528, ;
Height = 27, ;
Width = 84, ;
Anchor = 768, ;
Caption = "Regions", ;
Name = "Command1"
Add Object label1 As Label With ;
AutoSize = .T., ;
FontSize = 18, ;
WordWrap = .T., ;
BackStyle = 0, ;
Caption = ("form.Mousedown to move the form esc to exit"+Chr(13)+"-click here to restore form."), ;
Height = 110, ;
Left = 135, ;
MousePointer = 15, ;
Top = 134, ;
Width = 277, ;
ForeColor = Rgb(255,0,0), ;
Name = "Label1"
Procedure Destroy
Clea Events
Endproc
Procedure KeyPress
Lparameters nKeyCode, nShiftAltCtrl
If nKeyCode=27
Thisform.Release
Endi
Endproc
Procedure MouseDown
Lparameters nButton, nShift, nXCoord, nYCoord
Thisform.MousePointer=15
lnHandle0=Thisform.HWnd
param1 = 274
param2 = 0xF012
Declare Integer ReleaseCapture In WIN32API
Declare Integer SendMessage In WIN32API Integer, Integer, Integer, Integer
bb=ReleaseCapture()
bb=SendMessage(lnHandle0, param1, param2,0)
Thisform.MousePointer=0
Endproc
Procedure Init
_Screen.WindowState=1
Endproc
Procedure image1.MouseDown
Lparameters nButton, nShift, nXCoord, nYCoord
Thisform.MousePointer=15
lnHandle0=Thisform.HWnd
param1 = 274
param2 = 0xF012
Declare Integer ReleaseCapture In WIN32API
Declare Integer SendMessage In WIN32API Integer, Integer, Integer, Integer
bb=ReleaseCapture()
bb=SendMessage(lnHandle0, param1, param2,0)
Thisform.MousePointer=0
Endproc
Procedure image1.Init
Local loRequest,lcUrl
m.lcUrl="http://img.over-blog-kiwi.com/1/43/54/07/20180212/ob_26b02d_brezina2.jpg"
m.loRequest = Createobject('MsXml2.XmlHttp')
m.loRequest.Open("GET",lcUrl,.F.)
m.loRequest.Send()
This.PictureVal=m.loRequest.ResponseBody
m.loRequest=Null
Endproc
Procedure command1.Click
*create rectangle rgion with points (X1,Y1) - (X2,Y2)
Declare Integer CreateRectRgn In gdi32 Integer X1, Integer Y1, Integer X2, Integer Y2
*create elliptice region with points(X1,Y1) - (X2,Y2)
Declare Integer CreateEllipticRgn In gdi32 Integer X1, Integer Y1, Integer X2, Integer Y2
*Combine 2 régions to create a 3th region with mode nCombineMode
Declare Integer CombineRgn In gdi32 Integer hDestRgn, Integer hSrcRgn1, Integer hSrcRgn2, Integer nCombineMode
*erase object from memory
Declare Integer DeleteObject In gdi32 Integer hObject
*create a region on the form (hwnd)
Declare Integer SetWindowRgn In user32 Integer HWnd, Integer hRgn, Integer, bRedraw As Boolean
*Constant for CombineRgn
#Define RGN_AND 1 &&Intersection des deux régions
#Define RGN_OR 2 &&Addition des deux régions
#Define RGN_XOR 3 &&Difficile à décrire ... essayez
* XOR : union of 2 regions
*intersetion of 2 regions
#Define RGN_DIFF 4
#Define RGN_COPY 5 &&Copy région
Local YY
* Déclaration of regions handles
local Cercle ,Rect, PCercleH, PCercleB, HCercle, Cadre, TrouB, TrouH, CercleBis, HCercleBis, CercleBisBis, yreg0 , yreg1 as Integer
local H, L , HBord , LBord , HT , LT as integer
H = Thisform.Height
L = Thisform.Width
HBord = Int(H / 100)
LBord = Int(L / 100)
HT = Int(H / 10)
LT = Int(L / 10)
*Create regions with APIs and combineRGN
HCercle = CreateEllipticRgn(((L - (2 * LBord)) / 4) + LBord, ((H - (2 * HBord)) / 2) + HBord, 3 * (((L - (2 * LBord)) / 4) + LBord), (H - HBord))
Cercle = CreateEllipticRgn(LBord, HBord, L - LBord, H - HBord)
Rect = CreateRectRgn(L / 2, 0, L, H)
CombineRgn (HCercle, Cercle, Rect, RGN_DIFF)
HCercleBis = CreateEllipticRgn(LBord, HBord, L - LBord, H - HBord)
PCercleB = CreateEllipticRgn(((L - (2 * LBord)) / 4) + LBord, ((H - (2 * HBord)) / 2) + HBord, 3 * (((L - (2 * LBord)) / 4) + LBord), (H - HBord))
CombineRgn (HCercleBis, HCercle, PCercleB, RGN_DIFF)
CercleBis = CreateEllipticRgn(LBord, HBord, L - LBord, H - HBord)
PCercleH = CreateEllipticRgn(((L - (2 * LBord)) / 4) + LBord, HBord, 3 * (((L - (2 * LBord)) / 4) + LBord), ((H - (2 * HBord)) / 2) + HBord)
CombineRgn (CercleBis, Cercle, PCercleH, RGN_DIFF)
CercleBisBis = CreateEllipticRgn(LBord, HBord, L - LBord, H - HBord)
HCercle = CreateEllipticRgn(0, 0, L, H)
CombineRgn (CercleBisBis, CercleBis, HCercleBis, RGN_DIFF)
yreg0 = CreateEllipticRgn(0, 0, L, H)
Cadre = CreateEllipticRgn(0, 0, L, H)
CombineRgn (yreg0, Cadre, CercleBisBis, RGN_DIFF)
yreg1= CreateEllipticRgn(0, 0, L, H)
TrouB = CreateEllipticRgn(((L - (2 * LBord)) / 2) + LBord - (LT / 2), ((3 * (H - (2 * HBord)) / 4)) + HBord - (HT / 2), ((L - (2 * LBord)) / 2) + LBord + (LT / 2), ((3 * (H - (2 * HBord)) / 4)) + HBord + (HT / 2))
CombineRgn (yreg1, yreg0, TrouB, RGN_OR)
YY = CreateEllipticRgn(0, 0, L, H)
TrouH = CreateEllipticRgn(((L - (2 * LBord)) / 2) + LBord - (LT / 2), ((H - (2 * HBord)) / 4) + HBord - (HT / 2), ((L - (2 * LBord)) / 2) + LBord + (LT / 2), ((H - (2 * HBord)) / 4) + HBord + (HT / 2))
CombineRgn (YY, yreg1, TrouH, RGN_DIFF)
SetWindowRgn (Thisform.HWnd, YY,.T.) && final region applied to the form
* clean and free memory
DeleteObject( Cercle)
DeleteObject (Rect)
DeleteObject (PCercleH)
DeleteObject (PCercleB)
DeleteObject (HCercle)
DeleteObject (Cadre)
DeleteObject (TrouB)
DeleteObject (TrouH)
DeleteObject (CercleBis)
DeleteObject (HCercleBis)
DeleteObject (CercleBisBis)
DeleteObject (yreg0)
DeleteObject (yreg1)
Endproc
Procedure label1.MouseLeave
Lparameters nButton, nShift, nXCoord, nYCoord
This.BorderStyle=0
Endproc
Procedure label1.MouseEnter
Lparameters nButton, nShift, nXCoord, nYCoord
This.BorderStyle=1
Endproc
Procedure label1.Click
For i=1 To 6
SetWindowRgn (Thisform.HWnd, 0,.T.)
Endfor
Endproc
Enddefine
*
*-- EndDefine: yregions
to work easily with coordinates x,y: put your drawing on mspaint and mousemove on the corners to see below x,y.
Click on code to select [then copy] -click outside to deselect
*5* created on tuesday 13 of february 2018
*this code builds a transparent region on a to level form with a star5.
*the points are gathered first on a form with mousedown (nxcoord,nycoord) into a cursor.this cursor is copied to a txt sdf and pasted here as m.myvar variable(for the demo).
*this uses the API CreatePolygonRgn
Clea All
_Screen.WindowState=1
Publi yform
yform=Newobject("yPlygonregion")
yform.Show
Read Events
Return
*
Define Class yPlygonregion As Form
BorderStyle = 0
Top = 0
Left = 0
Height = 768
Width = 1024
ShowWindow = 2
AutoCenter=.T.
Caption = "Form1"
*Movable = .F.
FillStyle = 0
KeyPreview = .T.
TitleBar = 1
FillColor = Rgb(255,166,166)
BackColor=rgb(0,255,0) &&Rgb(128,0,64)
Caption ="Make any polygon region with a cursor of points (close figure)"
posx = 0
posy = 0
hrgn = 0
hrgnbase =0
Name = "yFreeHand"
Procedure Init
*this is a star5 gathred manually point by point with mousedown on an image in a cursor translated to a variable m.myvar
Local m.myvar
TEXT to m.myvar pretext 7 noshow
386 68
405 105
424 155
445 205
464 251
510 250
549 249
598 250
635 245
681 245
642 271
612 291
578 316
548 336
514 362
530 410
542 441
563 491
585 542
551 528
518 507
478 482
443 458
401 435
373 455
333 481
298 502
270 524
230 551
241 509
254 480
265 448
278 412
291 369
254 345
226 327
195 311
147 283
114 257
141 255
179 255
224 253
276 253
326 253
338 217
347 189
358 159
368 119
389 73
ENDTEXT
Local xx,yy
For i=1 To Memlines(m.myvar)
m.xx=Int(Val(Allt( Getwordnum(Mline(m.myvar,i),1," ") )))
m.yy=Int(Val(Allt(Getwordnum(Mline(m.myvar,i),2," "))))
Insert Into ycurs Values(m.xx+120,m.yy) && +120 as star translation
Endfor
Locate
Insert Into ycurs Values(x,Y) &&close figure with first point
Sele ycurs
Endproc
Procedure Activate
Thisform.ForeColor=255
Thisform.DrawWidth=3
Thisform.ScaleMode=3 &&pixels mandatory
Thisform.PSet(x,Y)
Scan
Thisform.Line(x,Y) && to show the drawing phisycally only (for test).
Endscan
Thisform.yregionON()
Endproc
Procedure yregionON
This.hrgnbase=0
This.hrgn=0
This.hrgnbase = CreateRectRgn(0, 0, This.Width+2*Sysmetric(3), This.Height+2*Sysmetric(4)+Sysmetric(9))
#Define Alternate 1
#Define WINDING 2
lcPoints = Space(0)
Sele ycurs
Scan
lcPoints = lcPoints + Thisform.num2dword(x) + Thisform.num2dword(Y)
Endscan
This.hrgn =CreatePolygonRgn(@lcPoints,Reccount() ,WINDING)
#Define RGN_XOR 3 &&make the region transparent
Local m.yy
m.yy= CombineRgn(This.hrgnbase, This.hrgnbase, This.hrgn, RGN_XOR)
Local m.xx
m.xx = SetWindowRgn(Thisform.HWnd, This.hrgnbase, "TRUE") &&.t. dont work ?
DeleteObject(This.hrgn)
DeleteObject(This.hrgnbase)
Thisform.Cls && clear red drawing
Endproc
Procedure Load
Declare Integer Sleep In kernel32 Integer
Declare Integer CreateRectRgn In gdi32;
INTEGER nLeftRect, Integer nTopRect,;
INTEGER nRightRect, Integer nBottomRect
Declare Integer CombineRgn In gdi32;
INTEGER hrgnDest, Integer hrgnSrc1,;
INTEGER hrgnSrc2,;
INTEGER fnCombineMode
Declare Long SetWindowRgn In WIN32API Long HWnd, Long hRgn, String bRedraw
Declare Integer CreatePolygonRgn In gdi32 String@ pPoints, Integer nPoints, Integer nfillmode &&vfp declaration
Declare Integer DeleteObject In gdi32 Integer hObject
Create Cursor ycurs (x i,Y i)
Endproc
Procedure num2dword
Lparameters lnValue
#Define m0 0x0000100
#Define m1 0x0010000
#Define m2 0x1000000
If lnValue < 0
lnValue = 0x100000000 + lnValue
Endif
Local b0, b1, b2, b3
b3 = Int(lnValue/m2)
b2 = Int((lnValue - b3*m2)/m1)
b1 = Int((lnValue - b3*m2 - b2*m1)/m0)
b0 = Mod(lnValue, m0)
Return Chr(b0)+Chr(b1)+Chr(b2)+Chr(b3)
Endproc
Procedure Destroy
This.hrgn=Null
This.hrgnbase=Null
Clea Dlls
Clea Events
Enddefine
*EndDefine yPlygonregion
Click on code to select [then copy] -click outside to deselect
*6* created on tuesday 13 of february 2018
*!* You can create your own custom skins using this form...
*!* and its all, the APIs does the job making the green color set on form.picture as transparent 100% (with LWA_COLORKEY applied)
*!* form must be as desktop=.t. for showWindow=0,1 or showWIndow=2 mandatory to make available the APIs.
*!* Run the form and you should see your new skin as a form.
*!* Mousedown on the form or on form.caption and drag to move the form.
*!* this application recquires a form showWIndow=2 (top level form) or form.showWindow=0,1 + form.desktop=.t. (form windows style)
*!* select any bitmap and colorize the surface to want transparent in green,set it as the form.picture and go !
*Important: the form.picture can be a BMP,GIF or PNG transparent (not JPG).
*download the GIF picture demo for this code (can save it directly for this page below the code)
local m.ydownl
m.ydownl=.t. &&tur it to .f. after downloading the picture
if m.ydownl=.t.
Declare Integer URLDownloadToFile In urlmon.Dll Integer pCaller, String szURL, String szFileName, Integer dwReserved, Integer lpfnCB
Declare Integer DeleteUrlCacheEntry In wininet String lpszUrlName
Local lcDownloadURL,lcDownloadLoc,lnResult
lcDownloadURL = "http://img.over-blog-kiwi.com/1/43/54/07/20180214/ob_994b58_greenscreen-api.gif" && i replaced here bmp too big b y a gif...
lcDownloadLoc = "greenscreen_api.gif" &&mandatory
lnResult = DeleteUrlCacheEntry(lcDownloadURL)
lnResult = URLDownloadToFile(0, lcDownloadURL, lcDownloadLoc , 0,0)
If lnResult = 0
Wait Window "Download greenscreen_api.bmp Complete" nowait
*Else
*!* Messagebox("Download fails")
Endi
wait clea
endi
_screen.windowstate=1
PUBLIC oform
oform=NEWOBJECT("ySkinForm")
oform.Show
RETURN
*
DEFINE CLASS ySkinForm AS form
BorderStyle = 0
Height = 630
Width = 1044
Desktop = .T.
ShowWindow = 2
ShowTips = .T.
AutoCenter = .T.
Picture = "greenscreen_api.gif"
Caption = "Form1"
TitleBar = 0
Name = "Form1"
ADD OBJECT label4 AS label WITH ;
AutoSize = .T., ;
FontName = "Tahoma", ;
FontSize = 20, ;
BackStyle = 0, ;
Caption = "Creating a skined form with a gif background and APIs", ;
Height = 35, ;
Left = 136, ;
Top = 12, ;
Width = 672, ;
ForeColor = RGB(255,255,255), ;
Name = "Label4"
ADD OBJECT cmdexit AS commandbutton WITH ;
Top = 11, ;
Left = 864, ;
Height = 22, ;
Width = 24, ;
FontSize = 10, ;
Caption = "X", ;
MousePointer = 15, ;
SpecialEffect = 2, ;
ForeColor = RGB(255,255,255), ;
BackColor = RGB(255,0,0), ;
Name = "cmdExit"
ADD OBJECT lbl1 AS label WITH ;
AutoSize = .T., ;
FontBold = .T., ;
FontName = "Tahoma", ;
FontSize = 12, ;
Alignment = 2, ;
BackStyle = 0, ;
Caption = "Librairies", ;
Height = 21, ;
Left = 71, ;
Top = 331, ;
Width = 78, ;
ForeColor = RGB(255,128,0), ;
Name = "lbl1"
ADD OBJECT lbl2 AS label WITH ;
AutoSize = .T., ;
FontBold = .T., ;
FontName = "Tahoma", ;
FontSize = 12, ;
Alignment = 2, ;
BackStyle = 0, ;
Caption = "Forms", ;
Height = 21, ;
Left = 71, ;
Top = 426, ;
Width = 51, ;
ForeColor = RGB(255,128,0), ;
Name = "lbl2"
ADD OBJECT lbl3 AS label WITH ;
AutoSize = .T., ;
FontBold = .T., ;
FontName = "Tahoma", ;
FontSize = 12, ;
Alignment = 2, ;
BackStyle = 0, ;
Caption = "Reports", ;
Height = 21, ;
Left = 71, ;
Top = 518, ;
Width = 66, ;
ForeColor = RGB(255,128,0), ;
Name = "lbl3"
ADD OBJECT image1 AS image WITH ;
Picture = (HOME(4) + "gifs\morphfox.gif"), ;
Stretch = 1, ;
Height = 60, ;
Left = 876, ;
Top = 108, ;
Width = 60, ;
Name = "Image1"
ADD OBJECT edit1 AS editbox WITH ;
BackStyle = 0, ;
BorderStyle = 0, ;
Height = 140, ;
Left = 108, ;
ReadOnly = .T., ;
ScrollBars = 0, ;
Top = 96, ;
Width = 600, ;
DisabledBackColor = RGB(255,255,255), ;
DisabledForeColor = RGB(0,0,0), ;
Name = "Edit1"
ADD OBJECT lbl4 AS label WITH ;
AutoSize = .T., ;
FontBold = .T., ;
FontName = "Tahoma", ;
FontSize = 12, ;
Alignment = 2, ;
BackStyle = 0, ;
Caption = "Help", ;
Height = 21, ;
Left = 889, ;
Top = 330, ;
Width = 39, ;
ForeColor = RGB(255,128,0), ;
Name = "lbl4"
ADD OBJECT lbl5 AS label WITH ;
AutoSize = .T., ;
FontBold = .T., ;
FontName = "Tahoma", ;
FontSize = 12, ;
Alignment = 2, ;
BackStyle = 0, ;
Caption = "Links", ;
Height = 21, ;
Left = 889, ;
Top = 425, ;
Width = 44, ;
ForeColor = RGB(255,128,0), ;
Name = "lbl5"
ADD OBJECT lbl6 AS label WITH ;
AutoSize = .T., ;
FontBold = .T., ;
FontName = "Tahoma", ;
FontSize = 12, ;
Alignment = 2, ;
BackStyle = 0, ;
Caption = "Resources", ;
Height = 21, ;
Left = 889, ;
Top = 517, ;
Width = 85, ;
ForeColor = RGB(255,128,0), ;
Name = "lbl6"
ADD OBJECT command1 AS commandbutton WITH ;
Top = 11, ;
Left = 837, ;
Height = 22, ;
Width = 24, ;
FontSize = 10, ;
Caption = "-", ;
MousePointer = 15, ;
SpecialEffect = 2, ;
ForeColor = RGB(255,255,255), ;
BackColor = RGB(255,0,0), ;
Name = "Command1"
ADD OBJECT lbl7 AS label WITH ;
AutoSize = .T., ;
FontBold = .T., ;
FontName = "Tahoma", ;
FontSize = 24, ;
Alignment = 2, ;
BackStyle = 0, ;
Caption = "Applications", ;
Height = 41, ;
Left = 424, ;
Top = 560, ;
Width = 199, ;
ForeColor = RGB(255,128,0), ;
Name = "lbl7"
ADD OBJECT grid1 AS grid WITH ;
Height = 193, ;
Left = 264, ;
Top = 313, ;
Width = 517, ;
Name = "Grid1"
PROCEDURE my
Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
messagebox(loObject.parent.name+"."+loObject.name+" clicked! can make some actions from here.",0+32+4096,'',1300)
ENDPROC
PROCEDURE my1
Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
loObject.forecolor=255
ENDPROC
PROCEDURE my2
Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
loObject.forecolor=rgb(255,128,0)
ENDPROC
PROCEDURE Destroy
clea events
ENDPROC
PROCEDURE Load
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
Declare Integer ReleaseCapture In WIN32API
Declare Integer SendMessage In WIN32API Integer, Integer, Integer, Integer
ENDPROC
PROCEDURE Init
*recquire top level form (showWindow=2) or showWindow=0,1 + desktop=.t.
#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)
nRGB=rgb(0,255,0) && green color to make transparent
= SetLayeredWindowAttributes(THISform.HWnd, m.nRGB,255,LWA_COLORKEY) && +LWA_ALPHA)
with thisform
.setall("mousepointer",15,"label")
.setall("mousepointer",15,"commandbutton")
for i=1 to .controlcount
if lower(substr(.controls(i).name,1,3))=="lbl"
bindevent(.controls(i),"mousedown",thisform,"my")
bindevent(.controls(i),"mouseEnter",thisform,"my1")
bindevent(.controls(i),"mouseLeave",thisform,"my2")
endi
endfor
endwith
ENDPROC
PROCEDURE KeyPress
LPARAMETERS nKeyCode, nShiftAltCtrl
if nkeycode=27
thisform.release
endi
ENDPROC
PROCEDURE MouseDown
LPARAMETERS nButton, nShift, nXCoord, nYCoord
&& move form [can be set on any object even of form. )
Thisform.MousePointer=15
lnHandle0=Thisform.HWnd
param1 = 274
param2 = 0xF012
bb=ReleaseCapture()
bb=SendMessage(lnHandle0, param1, param2,0)
Thisform.MousePointer=0
ENDPROC
PROCEDURE label4.MouseDown
LPARAMETERS nButton, nShift, nXCoord, nYCoord
thisform.mousedown(1)
ENDPROC
PROCEDURE cmdexit.Click
Thisform.Release()
ENDPROC
PROCEDURE edit1.Init
TEXT TO this.Value NOSHOW
You can create your own custom skins using this form...
and its all, the APIs does the job making the green color set on form.picture as transparent 100% (with "LWA_COLORKEY" applied)
form must be as desktop=.t. for showWindow=0,1 or showWIndow=2 mandatory to make available the APIs.
Run the form and you should see your new skin as a form.
Mousedown on the form or on form.caption and drag to move the form.
this application recquires a form showWInd=2 (top level form) or form.showWindow=0,1 + form.desktop=.t. (form windows style)
ENDTEXT
ENDPROC
PROCEDURE command1.Click
Thisform.windowstate=1
ENDPROC
PROCEDURE grid1.Init
sele * from home(1)+"samples\data\customer" into cursor ycurs
with this
.recordsource="ycurs"
.recordsourcetype=1
.gridlines=0
.deletemark=.f.
.SetAll("DynamicBackColor", "IIF(MOD(RECNO( ), 2)=0, RGB(255,255,255) , RGB(190,235,200))", "Column")
.FontBold=.T.
locate
.refresh
endwith
ENDPROC
ENDDEFINE
*
*-- EndDefine: ySkinForm
this gif is downloaded in the code above to desserve the form.picture.green areas are made transparnt with the APIs.
specimen of shaped form can be running with the code above.the green color can be any "unused on form " color as rgb(255,0,255)...
Click on code to select [then copy] -click outside to deselect
*7* created on wednesday 14 of february 2018
*yet a shaped form with regions.
_screen.windowstate=1
Public oform
oform=Newobject("yRGN")
oform.Show
Read Events
Return
*
Define Class yRGN As Form
BorderStyle = 0
Height = 373
Width = 697
showWindow=2
AutoCenter = .T.
Caption = "Form1"
BackColor = Rgb(212,210,208)
Name = "Form1"
Add Object command1 As CommandButton With ;
Top = 324, ;
Left = 264, ;
Height = 27, ;
Width = 84, ;
Caption = "Regions", ;
Name = "Command1"
Add Object label1 As Label With ;
AutoSize = .T., ;
FontSize = 14, ;
WordWrap = .T., ;
BackStyle = 0, ;
Caption = "Move for by mousedown.-Click here to restore form.", ;
Height = 46, ;
Left = 147, ;
Top = 75, ;
Width = 325, ;
ForeColor = Rgb(255,255,128), ;
Name = "Label1"
Add Object label2 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 20, ;
BackStyle = 0, ;
Caption = "X", ;
Height = 35, ;
Left = 514, ;
MousePointer = 15, ;
Top = 79, ;
Width = 20, ;
ForeColor = Rgb(255,255,0), ;
Name = "Label2"
Add Object image1 As Image With ;
Height = 85, ;
Left = 0, ;
Top = 12, ;
Width = 121, ;
Name = "Image1"
Procedure yloadimg
Lparameters url
Local loRequest
m.loRequest = Createobject('MsXml2.XmlHttp')
m.loRequest.Open("GET",url,.F.)
m.loRequest.Send()
Local xpictureval
m.xpictureval= m.loRequest.ResponseBody
m.loRequest=Null
Return m.xpictureval
Endproc
Procedure KeyPress
Lparameters nKeyCode, nShiftAltCtrl
If nKeyCode=27
Thisform.Release
Endi
Endproc
Procedure MouseDown
Lparameters nButton, nShift, nXCoord, nYCoord
Thisform.MousePointer=15
lnHandle0=Thisform.HWnd
param1 = 274
param2 = 0xF012
bb=ReleaseCapture()
bb=SendMessage(lnHandle0, param1, param2,0)
Thisform.MousePointer=0
Endproc
Procedure Load
Declare Integer ReleaseCapture In WIN32API
Declare Integer SendMessage In WIN32API Integer, Integer, Integer, Integer
Declare Integer CreateEllipticRgn In gdi32;
INTEGER nLeftRect,;
INTEGER nTopRect,;
INTEGER nRightRect,;
INTEGER nBottomRect
Declare Long CombineRgn In WIN32API Long, Long, Long, Long
Declare Long SetWindowRgn In WIN32API Long, Long, Long
Declare Integer DeleteObject In gdi32 Integer hObject
Endproc
Procedure Init
Thisform.TitleBar=0
Endproc
Procedure Destroy
Clea Events
Endproc
Procedure command1.Click
#Define RGN_OR 2
Local h1,h2,h3 As Integer
h1=CreateEllipticRgn(0,0,200,200)
h2=CreateEllipticRgn(180,0,380,200)
h3=CreateEllipticRgn(360,0,560,200)
CombineRgn(h1,h1,h2,RGN_OR)
CombineRgn(h1,h1,h3,RGN_OR)
SetWindowRgn(Thisform.HWnd,h1,.T.)
*always free regions created
DeleteObject(h1)
DeleteObject(h2)
DeleteObject(h3)
Endproc
Procedure label1.Click
*restore form
SetWindowRgn (Thisform.HWnd, 0,.T.)
Endproc
Procedure label2.Click
Thisform.Release
Endproc
Procedure image1.MouseDown
Lparameters nButton, nShift, nXCoord, nYCoord
Thisform.MouseDown(1)
Endproc
Procedure image1.Init
With This
.Stretch=2
.Left=0
.Top=0
.Width=.Parent.Width
.Height=.Parent.Height
.ZOrder(1)
.PictureVal=Thisform.yloadimg("http://img.over-blog-kiwi.com/1/43/54/07/20180212/ob_804072_kantara.jpg")
Endwith
Endproc
Enddefine
*
*-- EndDefine: yRGN
some relative links in this blog
form-transparencies-in-visual-foxproworking-with-regions-and-apis-in-visual-foxpro
gdiplusx-effects-operations-on-images
free-hand-capturing-as-bitmaps
aero-glass-effect
a-cool-desktop-zones-captures
a-soundplayer-and-radio-player-with-a-basic-wmp
blurring-a-vfp-form-background
a-configurable-desktop-calendar
a-glass-form-as-exciting-windows-effect
blend-2-images-with-gdiplusx
vfp-shapes-and-maps-drawings
|
|
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.