Custom Button example by Allden

[pistol350]

Hi!
this is an example of custom button written and posted by Allden a few years ago on the previous forum.
Hope it can be useful to anyone else.
See the attached zip file as it contains the source code and all the images required to get the program work properly.

Code Select Expand


CONST BIF_DONTGOBELOWDOMAIN = &H2
const BIF_RETURNONLYFSDIRS=&H1
const BIF_BROWSEFORCOMPUTERS=&H1000
const BIF_BROWSEFORPRINTERS=&H2000
Type BROWSEINFO
    def hWnd:int
    def root:int
    def folder:string
    def title:string
    def flags:int
    def callback:int
    def lparam:int
    def iimage:int
EndType
DECLARE "shell32",SHBrowseForFolder(lpbi:BROWSEINFO),int
declare "shell32",SHGetPathFromIDList(pidl:int,pszPath:string)
DECLARE "ole32",CoTaskMemFree(pidl:int)
def list,fname,directory,short,foundstr,lan2,long:string
directory="C:\Program Files\Diablo II\save"
def nfiles:pointer
def run,pidl:int
def buffer:string
declare dir(path:string,list[]:string,nfiles:pointer)
def n,count,exist,time,found,lan:int
Def win,tooltip,help:window
Def path,filecopy,masterfind[400]:string
Def img[10]:int
Def area[21],clean,display:int
Def mx,my,tab,qcount,ql,areaclicked:int
Def Screen,winup,cwinmm,activetip,rev:int
Def rbutton:int
img[4]=loadimage (Getstartpath + "\img\buttonup.jpg",4)
img[7]=loadimage (Getstartpath + "\img\guantletsel2.cur",@imgcursor)
img[6]=loadimage (Getstartpath + "\img\guantlet.cur",@imgcursor)
img[5]=loadimage (Getstartpath + "\img\tabbase.jpg",4)
img[3]=loadimage (Getstartpath + "\img\buttondwn.jpg",4)
img[2]=loadimage (Getstartpath + "\img\top.jpg",4)
img[8]=loadimage (Getstartpath + "\img\path.jpg",4)
img[9]=loadimage (Getstartpath + "\img\folder.jpg",4)
img[1]=loadimage (Getstartpath + "\img\icon.ico",@imgicon)
window win,0,0,300,540,@caption|@noautodraw|@minbox,0,"DiabloII Character Backup",main
window tooltip,0,0,0,0,@nocaption,win,"",cwin
showwindow tooltip,@swhide
setCURSOR tooltip, @cscustom,img[7]
'CONTROL win,"L,,10,110,272,280,0x50B00140|@CTLISTNOTIFY,1010"
'setcontrolcolor win,1010,rgb(20,20,20),rgb(155,155,155)
SETFONT win, "Arial", 10, 700

seticon win,img[1]
setwindowcolor win,rgb(30,30,30)
showimage win,img[2],4,0,0
showimage win,img[4],4,0,400,300,36
showimage win,img[4],4,0,436,300,36
showimage win,img[4],4,0,472,300,36
showimage win,img[5],4,0,20
frontpen win,rgb(150,150,150)
move win,262,72
print win,"?"

'showimage win,img[4],4,0,498,300,36
'showimage win,img[0],4,105,0
waituntil win=0
deleteimage img[6],@imgcursor
deleteimage img[3],4
deleteimage img[4],4
deleteimage img[8],4
deleteimage img[9],4
deleteimage img[2],4
deleteimage img[5],4
deleteimage img[1],@imgicon
deleteimage img[7],@imgcursor
end

sub main
select @class
case @idmousemove
stoptimer win
if winup=1

winup=0
endif
gosub mousereturn
starttimer win,1200

Case @idtimer
gosub tooltips

case @idlbuttonup
rbutton=0
if ql=0
frontpen win,rgb(150,150,150)
move win,262,72
print win,"?"
else
frontpen win,rgb(250,250,250)
move win,262,72
print win,"?"
endif
if areaclicked=3
showimage win,img[4],4,0,400,300,36
Endif
if areaclicked=4
showimage win,img[4],4,0,436,300,36
endif
if areaclicked=5
showimage win,img[4],4,0,472,300,36
endif
areaclicked=0
gosub mousereturn


case @idlbuttondn
rbutton=1
areaclicked=0
if area[6]=1
gosub helpscreen
endif
IF ((@mouseX > 39) & (@mouseY > 61))
IF ((@mousex < 39+64) & (@mousey < 61+39))
tab=0
areaclicked=1
showimage win,img[4],4,0,400,300,36
showimage win,img[4],4,0,436,300,36
showimage win,img[4],4,0,472,300,36
gosub mousereturn
if activetip=3 then activetip=0
if activetip=6 then activetip=0
if activetip=5 then activetip=0

showimage win,img[8],4,10,120
rect win,10,120,270,32,rgb(140,140,140)
rect win,42,120,238,32,rgb(140,140,140)
frontpen win,rgb(230,230,230)
drawmode win,@transparent
move win,43,130
print win,directory

Endif : endif
IF ((@mouseX > 129) & (@mouseY > 61))
IF ((@mousex < 129+64) & (@mousey < 61+39))
tab=1
areaclicked=2
showimage win,img[4],4,0,400,300,36
showimage win,img[4],4,0,436,300,36
showimage win,img[4],4,0,472,300,36

gosub mousereturn

if activetip=3 then activetip=0
if activetip=6 then activetip=0
if activetip=5 then activetip=0

showimage win,img[9],4,10,120
rect win,10,120,270,32,rgb(140,140,140)
rect win,42,120,238,32,rgb(140,140,140)

Endif : endif
if ((areaclicked=1) | (areaclicked=2))
if tab=0
showimage win,img[5],4,0,60
line win,91,61,116,86,0
move win,23,61
frontpen win,rgb(250,250,250)
print win,"character save"
move win,153,61
frontpen win,rgb(150,150,150)
print win,".... load"
Endif
If tab=1
showimage win,img[5],4,0,60
move win,23,61
frontpen win,rgb(150,150,150)
print win,"character.."
line win,117,84,141,60,0
move win,110,61
frontpen win,rgb(250,250,250)
print win,"character load"
pset win,116,85,0
endif : endif


IF ((@mouseX > 0) & (@mouseY > 400))
IF ((@mousex < 300) & (@mousey < 436))
areaclicked=3
showimage win,img[3],4,0,400,300,36
frontpen win,rgb(100,100,100)
if tab=0
move win,68,411
print win,"B a c k u p   C h a r a c t e r"
Else
move win,65,411
print win,"R e s t o r e  C h a r a c t e r"
Endif
Endif : endif
IF ((@mouseX > 0) & (@mouseY > 436))
IF ((@mousex < 300) & (@mousey < 472))
areaclicked=4
showimage win,img[3],4,0,436,300,36
frontpen win,rgb(100,100,100)
if tab=0
move win,42,447
print win,"B a c k u p   A l l   C h a r a c t e r s"
else
move win,39,447
print win,"R e s t o r e   A l l   C h a r a c t e r s"
endif
Endif : endif
IF ((@mouseX > 0) & (@mouseY > 472))
IF ((@mousex < 300) & (@mousey < 540))
areaclicked=5
showimage win,img[3],4,0,472,300,36
frontpen win,rgb(100,100,100)
move win,35,483
if tab=0
print win,"C h a r a c t e r    L o a d   S c r e e n"
else
print win,"C h a r a c t e r    S a v e  S c r e e n"
endif
Endif : endif
if ql=0
frontpen win,rgb(150,150,150)
move win,262,72
print win,"?"
else
frontpen win,rgb(250,250,250)
move win,262,72
print win,"?"
endif

Case @idpaint
backpen win,@transparent
showimage win,img[5],4,0,60
showimage win,img[2],4,0,0
if tab=0
showimage win,img[8],4,10,120
rect win,10,120,270,32,rgb(140,140,140)
rect win,42,120,238,32,rgb(140,140,140)
frontpen win,rgb(230,230,230)
drawmode win,@transparent
move win,43,130
print win,directory
else
showimage win,img[9],4,10,120
rect win,10,120,270,32,rgb(140,140,140)
rect win,42,120,238,32,rgb(140,140,140)
endif

showimage win,img[4],4,0,400,300,36
showimage win,img[4],4,0,436,300,36
showimage win,img[4],4,0,472,300,36
frontpen win,rgb(150,150,150)
move win,262,72
print win,"?"
if tab=0
line win,91,61,116,86,0
move win,23,61
frontpen win,rgb(250,250,250)
print win,"character save"
move win,153,61
frontpen win,rgb(150,150,150)
print win,".... load"
else
move win,23,61
frontpen win,rgb(150,150,150)
print win,"character.."
line win,117,84,141,60,0
line win,117,84,141,60,0
move win,110,61
frontpen win,rgb(250,250,250)
print win,"character load"
pset win,116,85,0
endif
frontpen win,rgb(24,24,34)
drawmode win,@transparent
gosub mousereturn

case @idcreate
centerwindow win
case @idclosewindow
closewindow win
endselect
return

sub cwin
select @class
case @IDlbuttondn
showwindow tooltip,@swhide
case @idmousemove
cwinmm=cwinmm+1
if cwinmm=2
showwindow tooltip,@swhide
endif
case @idsize

endselect
return

sub mousereturn
for clean=1 to 20
area[clean]=0
next clean
mx=@mousex
my=@mousey
ql=0
qcount=qcount+1


frontpen win,rgb(24,24,34)
drawmode win,@transparent
if qcount=6

frontpen win,rgb(150,150,150)
move win,262,72
print win,"?"
qcount=0
Endif

setcursor win, @cscustom,img[6]

IF ((@mouseX > 20) & (@mouseY > 61))
IF ((@mousex < 39+64) & (@mousey < 61+39))
area[1]=1
setCURSOR win, @cscustom,img[7]
Endif : endif

IF ((@mouseX > 129) & (@mouseY > 61))
IF ((@mousex < 129+80) & (@mousey < 61+39))
area[2]=1
setCURSOR win, @cscustom,img[7]
Endif : endif


'area 3
IF ((@mouseX > 0) & (@mouseY > 400))
IF ((@mousex < 300) & (@mousey < 436))
area[3]=1
setCURSOR win, @cscustom,img[7]

Endif : endif

'area 4
IF ((@mouseX > 0) & (@mouseY > 436))
IF ((@mousex < 300) & (@mousey < 472))
area[4]=1
setCURSOR win, @cscustom,img[7]

Endif : endif

'area 5

IF ((@mouseX > 0) & (@mouseY > 472))
IF ((@mousex < 300) & (@mousey < 540))
area[5]=1
SETCURSOR win, @cscustom,img[7]

Endif:endif
'255,68,29,27

'help screen
IF ((@mouseX > 250) & (@mouseY > 62))
IF ((@mousex < 284) & (@mousey < 95))
area[6]=1
ql=1
setCURSOR win, @cscustom,img[7]
frontpen win,rgb(250,250,250)
move win,262,72
print win,"?"
Endif : endif
if tab=0
if areaclicked=3
frontpen win,rgb(100,100,100)
move win,68,411
print win,"B a c k u p   C h a r a c t e r"
else
if area[3]=0
If screen=0
move win,70,410
frontpen win,rgb(24,24,34)
print win,"B a c k u p   C h a r a c t e r"
EndIF : Else
If areaclicked~3
move win,70,410
frontpen win,rgb(255,255,0)
print win,"B a c k u p   C h a r a c t e r"
Endif : Endif : Endif

if areaclicked=4
frontpen win,rgb(100,100,100)
move win,42,447
print win,"B a c k u p   A l l   C h a r a c t e r s"
else
if area[4]=0
If screen=0
frontpen win,rgb(24,24,34)
move win,44,446
print win,"B a c k u p   A l l   C h a r a c t e r s"
EndIF : Else
If areaclicked~4
frontpen win,rgb(255,255,0)
move win,44,446
print win,"B a c k u p   A l l   C h a r a c t e r s"
Endif : Endif : Endif


if areaclicked=5
frontpen win,rgb(100,100,100)
move win,35,483
print win,"C h a r a c t e r    L o a d   S c r e e n"
else
if area[5]=0
If screen=0
frontpen win,rgb(24,24,34)
move win,37,482
print win,"C h a r a c t e r    L o a d   S c r e e n"

EndIF : Else
If areaclicked~5
frontpen win,rgb(255,255,0)
move win,37,482
print win,"C h a r a c t e r    L o a d   S c r e e n"
Endif : Endif : Endif

Else

if areaclicked=3
frontpen win,rgb(100,100,100)
move win,65,411
print win,"R e s t o r e  C h a r a c t e r"
else
if area[3]=0
If screen=0
move win,67,410
frontpen win,rgb(24,24,34)
print win,"R e s t o r e   C h a r a c t e r"
EndIF : Else
If areaclicked~3
move win,67,410
frontpen win,rgb(255,255,0)
print win,"R e s t o r e   C h a r a c t e r"
Endif : Endif : Endif

if areaclicked=4
frontpen win,rgb(100,100,100)
move win,39,447
print win,"R e s t o r e   A l l   C h a r a c t e r s"
else
if area[4]=0
If screen=0
frontpen win,rgb(24,24,34)
move win,41,446
print win,"R e s t o r e   A l l   C h a r a c t e r s"
EndIF : Else
If areaclicked~4
frontpen win,rgb(255,255,0)
move win,41,446
print win,"R e s t o r e   A l l   C h a r a c t e r s"
Endif : Endif : Endif


if areaclicked=5
frontpen win,rgb(100,100,100)
move win,35,483
print win,"C h a r a c t e r    S a v e   S c r e e n"
else
if area[5]=0
If screen=0
frontpen win,rgb(24,24,34)
move win,37,482
print win,"C h a r a c t e r    S a v e   S c r e e n"

EndIF : Else
If areaclicked~5
frontpen win,rgb(255,255,0)
move win,37,482
print win,"C h a r a c t e r    S a v e   S c r e e n"
Endif : Endif : Endif
ENdif

return

sub tooltips
if rbutton=0
if area[1]=1
if activetip~1

showwindow tooltip,@swrestore
if mx+210>300
mx=300-210
endif
setsize tooltip,mx-2,my-2,210,35
setCURSOR tooltip, @cscustom,img[7]
setwindowcolor tooltip,rgb(255,255,200)
frontpen tooltip,0
drawmode tooltip,@transparent
move tooltip,20,0
print tooltip,"Click to select the character"
move tooltip,60,14
print tooltip,"backup screen"
cwinmm=0
activetip=1
winup=1
endif :endif

if area[2]=1
if activetip~2


if mx+210>300
mx=0

endif
showwindow tooltip,@swrestore
setsize tooltip,mx,my-30,210,35

setwindowcolor tooltip,rgb(255,255,200)
frontpen tooltip,0
drawmode tooltip,@transparent
move tooltip,10,0
print tooltip,"Click to select the character"
move tooltip,60,14
print tooltip,"restore screen"
cwinmm=0
activetip=2
winup=1
endif :endif

if area[6]=1
if activetip~6

showwindow tooltip,@swrestore
setsize tooltip,mx-34,my-2,36,20

setwindowcolor tooltip,rgb(255,255,200)
frontpen tooltip,0
drawmode tooltip,@transparent
move tooltip,3,0
print tooltip,"help"

cwinmm=0
activetip=6
winup=1
endif :endif

if area[3]=1
if activetip~3


if mx+190>300
rev=1
else
rev=0
endif

showwindow tooltip,@swrestore
if rev=0

setsize tooltip,mx,my-18,190,20

else
if mx-190<0
setsize tooltip,0,my-18,190,20
else
setsize tooltip,mx-188,my-18,190,20
endif
endif

setwindowcolor tooltip,rgb(255,255,200)
frontpen tooltip,0
drawmode tooltip,@transparent
move tooltip,10,0
if tab=0
print tooltip,"Click to backup character"
else
print tooltip,"Click to restore character"
endif
cwinmm=0
activetip=3
winup=1
endif :endif


if area[4]=1
if activetip~4


if mx+210>300
rev=1
else
rev=0
endif

showwindow tooltip,@swrestore
if rev=0

setsize tooltip,mx,my-18,210,20

else
if mx-210<0
setsize tooltip,0,my-18,210,20
else
setsize tooltip,mx-208,my-18,210,20
endif
endif

setwindowcolor tooltip,rgb(255,255,200)
frontpen tooltip,0
drawmode tooltip,@transparent
move tooltip,10,0
if tab=0
print tooltip,"Click to backup all characters"
else
print tooltip,"Click to restore all characters"
endif
cwinmm=0
activetip=4
winup=1
endif :endif

if area[5]=1
if activetip~5


if mx+200>300
rev=1
else
rev=0
endif

showwindow tooltip,@swrestore
if rev=0

setsize tooltip,mx,my-18,200,20

else
if mx-200<0
setsize tooltip,0,my-18,200,20
else
setsize tooltip,mx-208,my-18,200,20
endif
endif

setwindowcolor tooltip,rgb(255,255,200)
frontpen tooltip,0
drawmode tooltip,@transparent
move tooltip,10,0
if tab=0
print tooltip,"Character restore screen"
else
print tooltip,"  Character save screen"
endif
cwinmm=0
activetip=5
winup=1
endif :endif

setfocus win
endif
return

sub dir(path,list[],nfiles)
path=directory
def opened:int
def name:string

opened=findopen(path+"\*.*")
if opened
   do
     name=findnext(opened)
     if (name<>"")&(name<>".")&(name<>"..")
       dir(path+"\"+name,list,nfiles)
    short=name       
if (right$(lcase$(short),len(fname))=fname)|(left$(lcase$(short),len(fname))=fname)
'foundstr=" "+ short[n]+"  loc: " +list[n]
long=path+"\"+name
print path+name
found=found+1
'print list[n]
Endif
nfiles=nfiles+1

     endif
   until name=""
   findclose opened
endif
return

sub helpscreen
showwindow win,@swhide
stoptimer win
if help=0
window help,0,0,300,320,@caption|@minbox,0,"DiabloII CB&R Help",helpsub
'setwindowcolor help,rgb(120,120,130)
CONTROL help,"L,,0,0,294,288,0x50B00140|@CTLISTNOTIFY,1010"
setcontrolcolor help,1010,0,rgb(255,255,200)
seticon help,img[1]
gosub addhelp
else
showwindow help,@swrestore
endif

return

sub helpsub
select @class
Case @idsize
setfocus help
case @idclosewindow
showwindow help,@swhide
showwindow win,@swrestore
Case @idcreate
centerwindow help
Endselect
return

sub addhelp
addstring help,1010,"Diablo II character backup & restore help."
addstring help,1010,"____________________________________"
addstring help,1010,""
addstring help,1010,""

addstring help,1010,"1.) Backing up character files."
addstring help,1010,""
addstring help,1010,"     a.)When you backup any or all your"
addstring help,1010,"character files this program saves them"
addstring help,1010,"in order of date & time. "
addstring help,1010,""
addstring help,1010,"     b.)In the center of the program are"
addstring help,1010,"checkboxs'. these represent individual"
addstring help,1010,"characters to be saved. You may "
addstring help,1010,"save them individualy (for hard disk"
addstring help,1010,"space reasons)or useally and "
addstring help,1010,"preferably all at once."
addstring help,1010,""
addstring help,1010,"2.) Restoring character files."
addstring help,1010,""
addstring help,1010,"     a.) This process is to replace the"
addstring help,1010,"characterfile of choice."

return

sub characterfind
fname="d2s"
openconsole
dir(directory,list,nfiles)
do : until inkey$<>""
closeconsole :closewindow win
return

[aurelCB]

Hi Pistol but this program dont work properly on my computer.
When i move mouse to window area mouse just disapiere?
Window color is black?
Where is the problem?

[aurelCB]

Hi...
I change this and program work but i dont understand how?

Code Select Expand

img[4]=loadimage (Getstartpath + "buttonup.jpg",4)
img[7]=loadimage (Getstartpath + "guantletsel2.cur",@imgcursor)
img[6]=loadimage (Getstartpath + "guantlet.cur",@imgcursor)
img[5]=loadimage (Getstartpath + "tabbase.jpg",4)
img[3]=loadimage (Getstartpath + "buttondwn.jpg",4)
img[2]=loadimage (Getstartpath + "top.jpg",4)
img[8]=loadimage (Getstartpath + "path.jpg",4)
img[9]=loadimage (Getstartpath + "folder.jpg",4)
img[1]=loadimage (Getstartpath + "icon.ico",@imgicon)

[LarryMc]

Getstartpath automatically includes the required trailing slash (\)

Larry

[pistol350]

That's quite strange.
I have not changed anything from the source code but it works properly without any errors or bugs of any kind.

[aurelCB]

Like i said when i do this changes program work.
maby is somthing wrong wit my computer i just dont know.
However works.