ScreenShot
option explicit
dim Menu, bDialog, gstrTitle, gstrURL, h

const S309_STD_ENABLE = 1
const S309_STD_DISABLE = -1
const S309_VIEW_ENABLE = 2
const S309_VIEW_DISABLE = -2

const STD_CUT = 0
const STD_COPY = 1
const STD_PASTE = 2
const STD_UNDO = 3
const STD_REDOW = 4
const STD_DELETE = 5
const STD_FILENEW = 6
const STD_FILEOPEN = 7
const STD_FILESAVE = 8
const STD_PRINTPRE = 9
const STD_PROPERTIES = 10
const STD_HELP = 11
const STD_FIND = 12
const STD_REPLACE = 13
const STD_PRINT = 14

const VIEW_LARGEICONS = 0
const VIEW_SMALLICONS = 1
const VIEW_LIST = 2
const VIEW_DETAILS = 3
const VIEW_SORTNAME = 4
const VIEW_SORTSIZE = 5
const VIEW_SORTDATE = 6
const VIEW_SORTTYPE = 7
const VIEW_PARENTFOLDER = 8
const VIEW_NETCONNECT = 9
const VIEW_NETDISCONNECT = 10
const VIEW_NEWFOLDER = 11

gstrTitle = "S309PictureBox Example"
gstrURL = "http://members.xoom.com/S309"
Menu = array("&File||File","&Tools||Tools","&Help||Help","|",gstrTitle,"|",gstrURL)
setmenu "TitleBar",Menu
Menu = array("&Open...||btnSelect","Save &As...||btnSave","-","E&xit||mnuFileExit")
setmenu "File",Menu
Menu = array("&About Box||mnuAboutBox")
setmenu "Help",menu
Menu = array("Capture &Screen||mnuToolsCapture","-","&Cls||mnuCls","Refres&h||mnuRefresh","-","&Toggle Full Screen||mnuToggle")
setmenu "Tools",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

on error resume next
err.clear
addobject "Dialog","Dialog",0,0,0,0
if err.number = 0 then
  bDialog = true
end if
on error goto 0

addobject "s309.picturebox.1","btnSelect",5,5,20,20
btnSelect.autosize = true
btnSelect.borderstyle = 1
btnSelect.Appearance = 1
btnSelect.CommonBitmapType = S309_STD_ENABLE
btnSelect.CommonBitmapID = STD_FILEOPEN

addobject "s309.picturebox.1","btnSave",28,5,20,20
btnSave.autosize = true
btnSave.borderstyle = 1
btnSave.Appearance = 1
btnSave.CommonBitmapType = S309_STD_ENABLE
btnSave.CommonBitmapID = STD_FILESAVE

addobject "s309.picturebox.1","btnRotate",51,5,20,20
btnRotate.autosize = true
btnRotate.borderstyle = 1
btnRotate.Appearance = 1
btnRotate.CommonBitmapType = S309_STD_ENABLE
btnRotate.CommonBitmapID = STD_REDOW

addobject "s309.picturebox.1","btnMirror",75,5,20,20
btnMirror.autosize = true
btnMirror.borderstyle = 1
btnMirror.Appearance = 1
btnMirror.CommonBitmapType = S309_STD_ENABLE
btnMirror.CommonBitmapID = STD_FIND

addobject "s309.picturebox.1","picBox",100,0,output.width-100,output.height
picBox.backcolor=vbwhite
call ResetSize

addobject "ComboBox","cmbMirror",5,30,90,200
cmbMirror.style = 2
cmbMirror.additem "No Mirror"
cmbMirror.additem "Mirror Horizontal"
cmbMirror.additem "Mirror Veritcal"
cmbMirror.additem "Mirror Both"
cmbMirror.listindex = 0

addobject "ComboBox","cmbRotate",5,55,90,200
cmbRotate.style = 2
cmbRotate.additem "No Rotation"
cmbRotate.additem "Rotate 90"
cmbRotate.additem "Rotate 180 "
cmbRotate.additem "Rotate 270"
cmbRotate.listindex = 0

addobject "ComboBox","cmbBorder",5,80,90,200
cmbBorder.style = 2
cmbBorder.additem "No Border"
cmbBorder.additem "3D Tile Sunken Border"
cmbBorder.additem "3D Soft Sunken Border"
cmbBorder.additem "Single Line Border"
cmbBorder.additem "3D Soft Raised Border"
cmbBorder.additem "3D Tile Raised Border"
cmbBorder.listindex = 3
call cmbBorder_Click()

addobject "ComboBox","cmbAlign",5,105,90,200
cmbAlign.style = 2
cmbAlign.additem "No Alignment"
cmbAlign.additem "AutoSize"
cmbAlign.additem "Stretch"
cmbAlign.additem "Center Horizontally"
cmbAlign.additem "Center Vertically"
cmbAlign.additem "Center Both"
cmbAlign.listindex = 0

addobject "CheckBox", "chkInvert", 5,130,90,15
chkInvert.backcolor = output.backcolor
chkInvert.caption = "Invert Colors"

addobject "CheckBox", "chkWaitCursor", 5,150,90,15
chkWaitCursor.backcolor = output.backcolor
chkWaitCursor.caption = "Wait Cursor"
chkWaitCursor.value = 1
call chkWaitCursor_click()

picBox.ZOrder 0

sub mnuFileExit_Click()
  bye
end sub
sub mnuToolsCapture_Click()
  updatescreen
  picBox.CaptureScreen
end sub
sub btnSelect_Click()
  dim strFile, strMsg, pos
  btnSelect.appearance = -1 
  btnSelect.refresh
  if bDialog then
    dialog.dialogtitle = "Select an image file to display"
    pos = instrrev(picBox.picture,"\")
    if pos < 2 then
      dialog.initdir = "\"
    else
      dialog.initdir = left(picBox.picture, pos - 1)
    end if  
    strFile = "All Images|*.2bp;*.bmp;*.gif;*.jpg;*.jpeg;*.jpe;*.xbm|"
    strFile = strFile & "Bitmaps Images|*.2bp;*.bmp|Gif Images|*.gif|"
    strFile = strFile & "Jpeg Images|*.jpg;*.jpeg;*.jpe|Xbm Images|*.xbm|All Files|*.*"
    dialog.filter = strFile
    dialog.filterindex =1
    dialog.flags = &h1000 or &h800
    dialog.filename = ""
    dialog.cancelerror = true
    on error resume next
    err.clear
    dialog.showopen
    if err.number <> 0 then
      on error goto 0
      btnSelect.appearance = 1 
      btnSelect.refresh
      exit sub
    end if  
    on error goto 0
    strFile = dialog.filename
  else  
    strMsg = "Common Dialogs ActiveX control not found on the system." & vbcrlf & vbcrlf
    strMsg = strMsg & "Please enter the name of an image file to display."
    strFile = InputBox(strMsg,gstrTitle,picBox.picture)
  end if
  picBox.Picture = strFile
  if not picBox.ImageLoaded then
    msgbox "File not found: " & strFile
  else
    btnMirror.CommonBitmapID = btnMirror.CommonBitmapID
    btnRotate.CommonBitmapID = btnRotate.CommonBitmapID
  end if
  btnSelect.appearance = 1 
  btnSelect.refresh
end sub
sub btnMirror_Click()
  cmbMirror.setfocus
  if cmbMirror.listindex = 0 then
    msgbox "No mirroring value set in combobox.", vbExclamation, gstrTitle
    exit sub
  end if  
  btnMirror.appearance = -1
  btnMirror.refresh
  picBox.MirrorImage
  btnMirror.appearance = 1
  btnMirror.MirrorImage
end sub
sub btnRotate_Click()
  cmbRotate.setfocus
  if cmbRotate.listindex = 0 then
    msgbox "No rotation value set in combobox.", vbExclamation, gstrTitle
    exit sub
  end if  
  btnRotate.appearance = -1
  btnRotate.refresh
  picBox.RotateImage
  btnRotate.appearance = 1
  btnRotate.RotateImage
end sub
sub cmbAlign_Click()
  select case cmbAlign.listindex
    case 1
      picBox.autosize = true
      picBox.Center = 0 
      picBox.Stretch = false
    case 2
      picBox.autosize = false
      picBox.Center = 0
      picBox.Stretch = true
    case 3, 4, 5
      picBox.autosize = false
      picBox.Stretch = false
      picBox.Center = (cmbAlign.listindex - 2) 
    case Else
      picBox.autosize = false
      picBox.Center = 0
      picBox.Stretch = false
  end select
  call ResetSize
end sub  
sub cmbBorder_Click()
  if cmbBorder.listindex = 0 then
    picBox.borderstyle = 0
  else
    picBox.borderstyle = 1
    picBox.appearance = cmbBorder.listindex - 3
  end if
  picBox.refresh       
end sub
sub chkWaitCursor_Click()
  if chkWaitCursor.value = 1 then
    picBox.WaitCursor = true
  else
    picBox.WaitCursor = false
  end if  
end sub
sub cmbMirror_Click()
  picBox.Mirror = cmbMirror.listindex
  btnMirror.Mirror = cmbMirror.listindex
end sub
sub cmbRotate_Click()
  picBox.Rotate = (cmbRotate.listindex * 90)
  btnRotate.Rotate = (cmbRotate.listindex * 90)
end sub
sub mnuAboutBox_Click()
  picBox.aboutbox
end sub
sub mnuCls_Click()
  picBox.Cls
end sub
sub mnuRefresh_Click()
  picBox.refresh
end sub  
sub mnuToggle_Click()
  call picBox_DblClick()
end sub
sub picBox_DblClick()
  if picBox.left = 0 then
    picBox.move 100, 0, (output.width - 100), output.height
  else
    picBox.move 0, 0, output.width, output.height
   end if  
end sub  
sub ResetSize()
  if picBox.left = 0 then
    picBox.move 0, 0, output.width, output.height
  else  
    picBox.move 100, 0, (output.width - 100), output.height
  end if  
end sub   
sub chkInvert_Click()
  if chkInvert.value = 1 then
    picBox.Invert = true
  else
    picBox.Invert = false
  end if  
  picBox.InvertImage
end sub  
sub btnSave_Click()
  dim strFile, strMsg, pos
  btnSave.appearance = -1 
  btnSave.refresh
  if bDialog then
    dialog.dialogtitle = "Select a name for the saved image"
    pos = instrrev(picBox.picture,"\")
    if pos < 2 then
      dialog.initdir = "\"
    else
      dialog.initdir = left(picBox.picture, pos - 1)
    end if  
    strFile = "Bitmaps Images|*.bmp|"
    dialog.filter = strFile
    dialog.filterindex =1
    dialog.flags = &h200000 or &h800 or &h8000 or &h2
    dialog.filename = ""
    dialog.cancelerror = true
    on error resume next
    err.clear
    dialog.showsave
    if err.number <> 0 then
      on error goto 0
      btnSave.appearance = 1 
      btnSave.refresh
      exit sub
    end if  
    on error goto 0
    strFile = dialog.filename
  else  
    strMsg = "Common Dialogs ActiveX control not found on the system." & vbcrlf & vbcrlf
    strMsg = strMsg & "Please select a name for the saved image."
    strFile = InputBox(strMsg,gstrTitle,picBox.picture)
  end if
  picBox.SaveImageToFile strFile,0
  btnSave.appearance = 1 
  btnSave.refresh
end sub