option explicit
dim picButton(200), number, Top, Left, bNewRow, maxrowheight, Menu, gstrTitle, gstrURL
dim gbNoWaste
gbNoWaste =false ' set to true to use all screen space
gstrTitle = "S309PictureBox Bitmap Resource Example"
gstrURL = "http://members.xoom.com/S309"
Menu = array("&File||File",gstrTitle,"|",gstrURL)
setmenu "TitleBar",menu
Menu = array("E&xit||mnuFileExit")
setmenu "File", Menu
if (Output.Width mod 2) = 1 then
Output.Move 0, 0, (Output.ScaleX(Output.Width + 1, 3,1)), (Output.ScaleY(Output.Height, 3, 1))
end if
output.backcolor=vbgreen
updatescreen
addobject "S309.PictureBox.1","picHidden",1,1,1,1
pichidden.autosize = true
picHidden.hide
bNewrow = false
if gbNoWaste then
top = 0
left = 0
else
top = 44
left = 1
end if
DisplayButtons "CommCtrl.dll",140, 16
DisplayButtons "CommCtrl.dll",142, 16
DisplayButtons "pimres.dll",0, 16
DisplayButtons "ppv_res.dll",0, 16
DisplayButtons "pwd_res.dll",133, 16
DisplayButtons "pxl_res.dll",122, 16
DisplayButtons "VoiceCtl.dll",128, 16
DisplayButtons "pwd_res.dll",135, 15
DisplayButtons "pxl_res.dll",124, 15
DisplayButtons "office.dll",0, 0
DisplayButtons "main.cpl",305, 0
DisplayButtons "main.cpl",306, 0
DisplayButtons "main.cpl",307, 0
DisplayButtons "main.cpl",308, 0
DisplayButtons "sounds.cpl",317,0
DisplayButtons "sounds.cpl",318, 0
DisplayButtons "sounds.cpl",319, 0
DisplayButtons "sounds.cpl",320, 0
DisplayButtons "sounds.cpl",322, 0
DisplayButtons "mscecomdlg.dll",1, 0
DisplayButtons "mscecomdlg.dll",205, 0
DisplayButtons "mscecomm.dll",202, 0
DisplayButtons "mscefile.dll",204, 0
DisplayButtons "mscefile.dll",205, 0
DisplayButtons "mscegrid.dll",201, 0
DisplayButtons "msceimagelist.dll",201, 0
DisplayButtons "mscelistview.dll",201, 0
DisplayButtons "mscepicture.dll",201, 0
DisplayButtons "mscetabstrip.dll",214, 0
DisplayButtons "mscetreeview.dll",201, 0
DisplayButtons "mscewinsock.dll",201, 0
DisplayButtons "pwd_res.dll",107, 16
DisplayButtons "pwd_res.dll",134, 16
DisplayButtons "power.cpl",401, 0
DisplayButtons "power.cpl",400, 0
DisplayButtons "power.cpl",423, 0
DisplayButtons "VoiceCtl.dll",175, 0
DisplayButtons "msceimagelist.dll",202, 0
DisplayButtons "screen.cpl",306, 0
DisplayButtons "screen.cpl",308, 0
DisplayButtons "screen.cpl",318, 0
DisplayButtons "screen.cpl",319, 0
DisplayButtons "system.cpl",306, 0
DisplayButtons "intl.cpl",213, 0
if not gbNoWaste then
output.drawtext string(10," ") & "Click On A Bitmap"
output.drawtext string(10," ") & "For Properties"
end if
sub mnuFileExit_Click()
bye
end sub
sub DisplayButtons(byval strResourceFile, byval resourceID, byval width)
dim count, name, index, msg
picHidden.ResourceFile = strResourceFile
picHidden.ResourceBitmapID = resourceID
if picHidden.imageloaded then
if width = 0 then
width = pichidden.imagewidth
end if
count = (picHidden.imagewidth \ width) - 1
if bnewrow and (maxrowheight <> 0) then
bnewrow = false
top = top + maxrowheight + 2 + space()
left = space()
maxrowheight = 0
end if
for index = 0 to count
number = number + 1
if (left + (width + 2)) > output.width then
left = space()
top = top + maxrowheight + 2 + space()
maxrowheight = 0
end if
maxrowheight = max(maxrowheight, pichidden.imageheight)
name = "button" & cstr(number)
addobject "S309.PictureBox.1", name, left, top, 1, 1
execute " set picButton(" & cstr(number) & ") = " & name
picButton(number).autosize = true
picButton(number).borderstyle = 1
if (index = 0) and (width = picHidden.imagewidth) then
else
picButton(number).clip = true
picButton(number).cliptop = 0
picButton(number).clipLeft =index * 16
picButton(number).clipWidth = width
picButton(number).clipHeight = pichidden.imageheight
end if
picButton(number).ResourceFile = strResourceFile
picButton(number).ResourceBitmapID = resourceID
execute "sub " & name & "_click()" & vbcrlf & " picClick(" & number &")" & vbcrlf & "end sub"
updatescreen
left = left + width + 2 + space()
next
end if
end sub
sub picClick(byval number)
picButton(number).refresh
if ((picButton(number).Height * 2) <= output.height) and ((picButton(number).Width * 2) <= output.width) then
picHidden.Resize = True
picHidden.ResizeHeight = (picButton(number).Height * 2)
picHidden.ResizeWidth = (picButton(number).Width * 2)
else
picHidden.Resize = False
end if
picHidden.AutoSize = picButton(number).AutoSize
picHidden.BorderStyle = picButton(number).BorderStyle
picHidden.Clip = picButton(number).Clip
picHidden.ClipHeight = picButton(number).ClipHeight
picHidden.ClipLeft = picButton(number).ClipLeft
picHidden.ClipTop = picButton(number).ClipTop
picHidden.ClipWidth = picButton(number).ClipWidth
picHidden.ResourceFile = picButton(number).ResourceFile
picHidden.ResourceBitmapID = picButton(number).ResourceBitmapID
if not gbNoWaste then
picHidden.show
picHidden.zorder 0
end if
call picHidden_Click()
end sub
sub picHidden_Click()
dim msg
msg = ".AutoSize=" & cstr(picHidden.AutoSize) & vbcrlf
msg = msg & ".BorderStyle=" & cstr(picHidden.BorderStyle) & vbcrlf
if picHidden.Clip then
msg = msg & ".Clip=" & cstr(picHidden.Clip) & vbcrlf
msg = msg & ".ClipHeight=" & cstr(picHidden.ClipHeight) & vbcrlf
msg = msg & ".ClipLeft=" & cstr(picHidden.ClipLeft) & vbcrlf
msg = msg & ".ClipTop=" & cstr(picHidden.ClipTop) & vbcrlf
msg = msg & ".ClipWidth=" & cstr(picHidden.ClipWidth) & vbcrlf
end if
msg = msg & ".ResourceFile=" & cstr(picHidden.ResourceFile) & vbcrlf
msg = msg & ".ResourceBitmapID=" & cstr(picHidden.ResourceBitmapID)
msgbox msg, vbINFORMATION,"Properties for Bitmap"
end sub
function Max(n1, n2)
if n1 > n2 then
Max = n1
else
Max = n2
end if
end function
function Space()
if gbNoWaste then
Space = 0
else
Space = 1
end if
end function