autodefine "off" $include "windowssdk.inc" $include "ctl.inc" TYPE WINRECT INT left INT top INT width INT height ENDTYPE WINRECT rc 'Declare to initialise pbsctrl.dll $use "pbsctrl.lib" DECLARE IMPORT,InitPBSoftCtrls(),INT InitPBSoftCtrls() 'Windows Declares DECLARE IMPORT,PathFindExtensionA(pszPath:POINTER),STRING DECLARE IMPORT,PathIsDirectoryA(pszPath:POINTER),INT 'Constants CONST IDC_SIZENS=32645 CONST IDC_SIZEWE=32644 CONST BFF=128 CONST FLB=129 Const PICBOX=130 CONST SB=131 CONST WM_USER=0x400 CONST BFF_READY=1 CONST BFF_SELCHANGE=2 CONST BFF_CLEAR=WM_USER+10000 'Remove all items from Treeview CONST BFF_REFRESH=WM_USER+10001 'Forces a repaint CONST BFF_PATH=WM_USER+10002 'New path, lParam is pszString CONST BFF_PATHBYPIDL=WM_USER+10003 'New path, wParam = %CSIDL_.. CONST BFF_JUMPTOPATH=WM_USER+10004 'Set to path. Selects the item with corresponding path, lParam is pszString CONST BFF_GETPATH=WM_USER+10005 'Returns path placed in provided buffer. wparam = size of empty buffer, lparam = pointer to buffer CONST BFF_GETPATHLEN=WM_USER+10006 'Use this to prepare a buffer CONST BFF_EXPANDFIRSTITEM=WM_USER+10007 'Opens/closes the first treeview item, wParam is switch CONST BFF_BACKCOLOR=WM_USER+10008 CONST FLB_BACKCOLOR=WM_USER+1000 'wParam is new RGB() CONST FLB_GETBACKCOLOR=WM_USER+1001 'Get backcolor CONST FLB_FORECOLOR=WM_USER+1002 'wParam is new RGB() CONST FLB_GETFORECOLOR=WM_USER+1003 'Get forecolor set CONST FLB_PATH=WM_USER+1004 'wParam is size of buffer set in lParam, 0 for szstring, lParam is buffer containing new path CONST FLB_GETPATH=WM_USER+1005 'wParam is size of buffer to fill, 0 for returning len required, lParam is buffer to fill CONST FLB_GETITEM=WM_USER+1006 'wParam is size of buffer to fill, 0 for returning len required, lParam is buffer to fill CONST FLB_SHOWICONS=WM_USER+1007 'wParam is Boolean CONST FLB_CLEAR=WM_USER+1008 'Empties control CONST FLB_REFRESH=WM_USER+1009 'Refills the control 'wParam = RGB(), -1 for no painting Const PIC_BACKCOLOR=WM_USER+10000 'Returns backcolor set Const PIC_GETBACKCOLOR=WM_USER+10001 'wParam is mode, See Const PIC_SIZE_... Const PIC_SIZE=WM_USER+10002 'Returns copy of image as hBITMAP, you should destroy it yourself Const PIC_GETIMAGE=WM_USER+10003 'Returns original handle, do not destroy! Const PIC_GETHANDLE=WM_USER+10004 'Returns original handle's imagetype Const PIC_GETTYPE=WM_USER+10005 'Returns RECT, lParam is pointer to RECT Const PIC_GETRECT=WM_USER+10006 'Image loading and unloading 'Removes existing image Const PIC_IMAGE_NONE=WM_USER+11000 'wParam = 0, lParam is pointer to asciiz fileName Const PIC_IMAGE_FILE=WM_USER+11002 'Loads an image from RC_DATA resource, ideal for stored JPG's, lParam = pointer to resource name Const PIC_IMAGE_RESOURCEDATA=WM_USER+11004 'wParam = length of data, lParam pointer to data, TIP: can be RC_DATA Const PIC_IMAGE_DATA=WM_USER+11005 'Keeps control size Const PIC_SIZE_NONE=0 'Sizes control to loaded image Const PIC_SIZE_PICTURE=1 'Unsupported yet Const PIC_SIZE_STRETCH=2 'IPICTURE picturetype constants, can exist in YOUR earlier declarations! Const PICTYPE_UNINITIALIZED=-1 Const PICTYPE_NONE=0 Const PICTYPE_BITMAP=1 '+ JPG Const PICTYPE_METAFILE=2 Const PICTYPE_ICON=3 Const PICTYPE_ENHMETAFILE=4 'WM_NOTIFY 'Picbox paint, before picture is redrawn Const PICN_BEGINPAINT=1 'Picbox paint, after picture is redrawn Const PICN_ENDPAINT=2 Type NM_PICBOX 'Normal notify header NMHDR hdr '// Copy of paintstruct during WM_PAINT, contains hDC and coordinates PAINTSTRUCT PS '// Imagehandle, do not destroy INT hImage '// Image type, See %PICTYPE_... INT nImageType EndType CONST SB_SETBKCOLOR=(0x2000+1) WINDOW win,winV,winH FILE ini UINT hInst,image,imagetype,l,t,w,h INT bf,fl,x1,y1,w1,h1,min,max,currentsplitter,x2,y2,w2,h2,errors,ret ISTRING iType[32],Paths[260],fileName[260],StartPath[260] 'Check for ini file - if missing, write an ini file with default startup path and use that path for initial viewing errors=OPENFILE(ini,GETSTARTPATH+"PicBox.ini","R") IF errors<>0 CLOSEFILE ini OPENFILE(ini,GETSTARTPATH+"PicBox.ini","W") WRITE ini,GETSTARTPATH CLOSEFILE ini StartPath=GETSTARTPATH ELSE OPENFILE(ini,GETSTARTPATH+"PicBox.ini","R") READ ini,StartPath CLOSEFILE ini ENDIF SetCurrentDirectoryA(StartPath) ret=PathIsDirectoryA(StartPath) IF ret=0 MESSAGEBOX win,"Your last accessed directory is not available:\nUsing "+UCASE$(GETSTARTPATH),"Path error",48 SetCurrentDirectoryA(GETSTARTPATH) ENDIF OPENWindow win,0,0,1024,768,@SIZE|@MINBOX|@MAXBOX|@SYSMENU|@BORDER,0,"PicBox",&main CONTROL win,@STATUS,"PicBox",0,0,0,0,0,SB SETWINDOWCOLOR win,GetSysColor(15) hInst=GetModuleHandleA(win.hWnd) setcaption win,"PicBox - "+StartPath CreateSplitter(win,winV,0,200,0,4,-1,1) SetSplitterColors(winV,GetSysColor(16),RGB(250,0,128)) SetSplitterMin(winV,100) CreateSplitter(win,winH,1,0,300,200,4,2) SetSplitterColors(winH,GetSysColor(16),RGB(250,0,128)) SetSplitterMin(winH,100) CreateWindowExA(0x200,"BrowseForFolder","",0x56810027,0,0,200,300,win.hWnd,BFF,hInst,0) conTVSetColor(win,BFF,-1,GetSysColor(15)) SENDMESSAGE win,BFF_JUMPTOPATH,LEN(StartPath),StartPath,BFF bf=SENDMESSAGE(win,BFF_GETPATHLEN,0,0,BFF) Paths=STRING$(bf,0) SENDMESSAGE(win,BFF_GETPATH,bf,Paths,BFF) CreateWindowExA(0x200,"FileListBox","",0x56A10103,0,300,200,406,win.hWnd,FLB,hInst,0) SENDMESSAGE win,FLB_BACKCOLOR,GetSysColor(15),0,FLB SENDMESSAGE win,FLB_SHOWICONS,1,0,FLB SENDMESSAGE win,LB_SETHORIZONTALEXTENT,261,0,FLB bf=SENDMESSAGE(win,BFF_GETPATHLEN,0,0,BFF) IF bf>0 Paths=STRING$(bf,0) bf=SENDMESSAGE(win,BFF_GETPATH,bf,Paths,BFF) Paths=LEFT$(Paths,bf) SENDMESSAGE win,FLB_PATH,bf,Paths,FLB conDrawOff(win,FLB) SENDMESSAGE win,FLB_REFRESH,bf,Paths,FLB conDrawOn(win,FLB) ENDIF SETCURSOR winV,@CSCUSTOM,LoadCursorA(0,IDC_SIZEWE) SETCURSOR winH,@CSCUSTOM,LoadCursorA(0,IDC_SIZENS) WaitUntil IsWindowClosed(win) IF StartPath="" THEN StartPath=GETSTARTPATH OPENFILE(ini,GETSTARTPATH+"PicBox.ini","W") WRITE ini,StartPath CLOSEFILE ini End Sub main(),INT Select @MESSAGE Case @IDCLOSEWINDOW StartPath=Paths CLOSEWINDOW win CASE @IDCREATE CENTERWINDOW win CreateWindowEx(0x200,"PicBox","",0x56800000|@BORDER,204,0,804,708,win.hWnd,PICBOX,hInst,0) SENDMESSAGE win,PIC_BACKCOLOR,RGB(192,192,192),0,PICBOX 'Sets back color of picture box CASE WM_SPLITTERRBUTTONDN CASE& WM_SPLITTERLBUTTONDN CASE& WM_SPLITTERSIZED CASE& WM_SPLITTERSIZING currentsplitter=@WPARAM CASE& @IDSIZE SizeControls() CASE WM_SPLITTERLBUTTONDBLCLK 'centre the splitter GETCLIENTSIZE win,l,t,w,h IF @WPARAM=1 GetSplitterPos(winV,x1,y1,w1,h1) SetSplitterPos(winV,w/2,y1,w1,h1) ELSE GetSplitterPos(winH,x1,y1,w1,h1) SetSplitterPos(winH,x1,h/2,w1,h1) ENDIF SizeControls() CASE @IDCONTROL SELECT @CONTROLID CASE BFF 'Browse for Folder CASE& BFF_SELCHANGE bf=SENDMESSAGE(win,BFF_GETPATHLEN,0,0,BFF) IF bf>0 Paths=STRING$(bf,0) bf=SENDMESSAGE(win,BFF_GETPATH,bf,Paths,BFF) Paths=LEFT$(Paths,bf) CONTROLCMD win,103,@SWSETPANETEXT,0,LCASE$(Paths) SENDMESSAGE win,FLB_PATH,bf,Paths,FLB conDrawOff(win,FLB) SENDMESSAGE win,FLB_REFRESH,bf,Paths,FLB conDrawOn(win,FLB) setcaption win,"PicBox - "+Paths ENDIF StartPath=Paths CASE FLB 'File List Box CASE& BFF_SELCHANGE fl=SENDMESSAGE win,FLB_GETITEM,0,0,FLB IF fl>0 fileName=STRING$(fl,0) fl=SENDMESSAGE(win,FLB_GETITEM,fl,fileName,FLB) fileName=LEFT$(fileName,fl) ShowPic() ENDIF ENDSELECT ENDSELECT Return 0 ENDSUB SUB ShowPic() 'Loads a picture into the PicBox SENDMESSAGE win,PIC_IMAGE_NONE,0,0,PICBOX 'Removes the image from control, if any was previously loaded into control SENDMESSAGE win,PIC_SIZE,0,0,PICBOX '0 sizes the control as original size; 1 sizes the control to fit the picture; 2 to stretch the image (doesn't seem to work) SendMessage win,PIC_IMAGE_FILE,0,fileName,PICBOX 'Loads an image into the control image=SendMessage win,PIC_GETHANDLE,0,0,PICBOX 'Gets the loaded image's handle imagetype=SendMessage win,PIC_GETTYPE,0,0,PICBOX 'Returns the type of image loaded 'Put picture into middle of picture control, if smaller than picture area GETSIZE(win,l,t,w,h) ZeroMemory(&rc,LEN(WINRECT)) SENDMESSAGE win,PIC_GETRECT,0,&rc,PICBOX 'Get size of picture rect rc.left=w-rc.width+190 rc.left=rc.left/2 t=h-rc.height-60 t=t/2 SETSIZE win,rc.left,t,rc.width,rc.height,PICBOX 'Show type of image loaded in statusbar SELECT imagetype CASE 0 iType="Unsupported format" CASE 1 iType="JPG or BMP" CASE 2 iType="Metafile" CASE 3 iType="Icon" CASE 4 iType="Enhanced Metafile" ENDSELECT IF imagetype=0 SENDMESSAGE(win,SB_SETBKCOLOR,0,RGB(198,105,128),SB) CONTROLCMD win,SB,@SWSETPANETEXT,0,"PicBox :: "+iType ELSE SENDMESSAGE(win,SB_SETBKCOLOR,0,RGB(89,198,133),SB) CONTROLCMD win,SB,@SWSETPANETEXT,0,fileName+" :: "+"Pic Size"+str$(rc.width)+" x"+str$(rc.height)+" :: Type"+str$(imagetype)+" = "+iType ENDIF 'Set focus back to FLB SETFOCUS win,FLB ENDSUB SUB SizeControls() CONTROLCMD win,SB,@SWRESIZE GETCLIENTSIZE win,l,t,w,h GetSplitterPos(winV,x1,y1,w1,h1) GetSplitterPos(winH,x2,y2,w2,h2) IF x1>w-100 THEN x1=w-100 IF x1<100 THEN x1=100 SetSplitterPos(winV,x1,y1,w1,h) 'set the height of winV to client height h; also any adjustment to x1 IF y2>h-100 THEN y2=h-100 IF y2<100 THEN y2=100 SetSplitterPos(winH,x2,y2,x1,h2) 'set the width of winH to x1 of winV; also any adjustment to y2 GetSplitterPos(winV,x1,y1,w1,h1) GetSplitterPos(winH,x2,y2,w2,h2) SETSIZE win,0,0,x1,y2,BFF SETSIZE win,0,y2+h2-2,x1,h-y2-h2-20,FLB SETSIZE win,x1+w1,0,w-x1-w1,h-22,PICBOX SetSplitterMax(winV,w-100) SetSplitterMax(winH,h-100) min=GetSplitterMin(winV) max=GetSplitterMax(winV) IF imagetype>0 ShowPic() ENDIF ENDSUB