Home Page

R. T. RUSSELL

BBC BASIC for Windows

Picture viewer



This program displays or prints pictures in most of the common image formats (BMP, GIF, JPG, ICO, EMF and WMF). It also illustrates how the elements making up the Windows™ user interface may easily be incorporated in BBC BASIC programs.

Download VIEWER.BBC Run VIEWER.EXE

     REM. Picture viewer in BBC BASIC for Windows, RTR 31-Oct-2004, 20-Apr-2009

     
INSTALL @lib$+"WINLIB"

     SYS "LoadLibrary","OLEAUT32.DLL" TO oleaut32%
     SYS "GetProcAddress",oleaut32%,"OleLoadPicturePath" TO `OleLoadPicturePath`

     SYS "CreateMenu" TO hfile%
     SYS "AppendMenu",hfile%,0,&101,"&New"+CHR$9+"Ctrl+N"
     SYS "AppendMenu",hfile%,0,&102,"&Open..."+CHR$9+"Ctrl+O"
     SYS "AppendMenu",hfile%,&800,0,0
     SYS "AppendMenu",hfile%,0,&103,"Page se&tup..."
     SYS "AppendMenu",hfile%,0,&104,"&Print..."+CHR$9+"Ctrl+P"
     SYS "AppendMenu",hfile%,&800,0,0
     SYS "AppendMenu",hfile%,0,&109,"E&xit"

     SYS "CreateMenu" TO hmenu%
     SYS "SetMenu",@hwnd%,hmenu%
     SYS "AppendMenu",hmenu%,16,hfile%,"&File"
     SYS "DrawMenuBar",@hwnd%

     REM. Setup status bar
     
parts% = 4
     DIM edge%(parts%-1)
     edge%() = 50,100,150,-1
     hstat% = FN_createstatusbar("")
     SYS "SendMessage",hstat%,1028,parts%,^edge%(0)

     REM. Setup tool bar
     
buttons% = 3
     DIM button%(buttons%-1),buttid%(buttons%-1),button$(buttons%-1)
     button%() = 6,7,14
     buttid%() = &101,&102,&104
     button$() = "New","Open","Print"
     htool% = FN_createtoolbar(buttons%,button%(),buttid%())
     PROC_addtooltips(htool%,buttons%,button$(),buttid%())

     REM. Initialise Open File dialogue
     
DIM Ofn{lStructSize%, hwndOwner%, hInstance%, lpstrFilter%, \
     
\      lpstrCustomFilter%, nMaxCustFilter%, nFilterIndex%, \
     
\      lpstrFile%, nMaxFile%, lpstrFileTitle%, \
     
\      nMaxFileTitle%, lpstrInitialDir%, lpstrTitle%, \
     
\      flags%, nFileOffset{l&,h&}, nFileExtension{l&,h&}, \
     
\      lpstrDefExt%, lCustData%, lpfnHook%, lpTemplateName%}
     DIM fname% 255
     filter$ = "Image files"+CHR$0+"*.BMP;*.GIF;*.JPG;*.JPEG;*.ICO;*.EMF;*.WMF"+CHR$0+"All files"+CHR$0+"*.*"+CHR$0+CHR$0
     Ofn.lStructSize% = DIM(Ofn{})
     Ofn.hwndOwner% = @hwnd%
     Ofn.lpstrFilter% = !^filter$
     Ofn.lpstrFile% = fname%
     Ofn.nMaxFile% = 256

     REM. Initialise Print dialogue
     
DIM Pd{lStructSize%, hwndOwner%, hDevMode%, hDevNames%, \
     
\      hdc%, flags%, nFromPage{l&,h&}, nToPage{l&,h&}, \
     
\      nMinPage{l&,h&}, nMaxPage{l&,h&}, nCopies{l&,h&}, \
     
\      hInstance%, lCustData%, lpfnPrintHook%, lpfnSetupHook%, \
     
\      lpPrintTemplateName%, lpSetupTemplateName%, \
     
\      hPrintTemplate%, hSetupTemplate%}
     Pd.lStructSize% = DIM(Pd{})
     Pd.hwndOwner% = @hwnd%
     Pd.flags% = &400 : REM PD_RETURNDEFAULT
     
SYS "PrintDlg", Pd{}

     REM. Initialise Page Setup dialogue
     
DIM Psd{lStructSize%, hwndOwner%, hDevMode%, hDevNames%, \
     
\      flags%, ptPaperSize{w%,h%}, rtMinMargin{l%,t%,r%,b%}, \
     
\      rtMargin{l%,t%,r%,b%}, hInstance%, lCustData%, \
     
\      lpfnPageSetupHook%, lpfnPagePaintHook%, \
     
\      lpPageSetupTemplateName%, hPageSetupTemplate%}
     Psd.lStructSize% = DIM(Psd{})
     Psd.hwndOwner% = @hwnd%
     Psd.flags% = 10 : REM PSD_MARGINS | PSD_INHUNDREDTHSOFMILLIMETERS
     
Psd.rtMargin.l% = 1000
     Psd.rtMargin.t% = 1000
     Psd.rtMargin.r% = 1000
     Psd.rtMargin.b% = 1000

     ON CLOSE PROCexit
     ON ERROR SYS "MessageBox",@hwnd%,REPORT$,0,48:PROCexit
     ON MOVE PROCmove(@msg%,@wparam%,@lparam%):RETURN
     ON SYS
Click% = @wparam% AND &FFFF:RETURN

     PROC
new
     Click% = -1
     Display% = FALSE
     
*ESC OFF
     MOUSE ON 3
     REPEAT
       
temp% = INKEY(1)
       IF temp% = -1 SWAP temp%,Click%
       CASE temp% OF
         WHEN
&101,14: PROCnew
         WHEN &102,15: PROCopen
         WHEN &103: PROCpagesetup
         WHEN &104,16: IF ?fname% PROCprint
         WHEN &109: PROCexit
       ENDCASE
       SYS
"EnableMenuItem",hfile%,&104,(?fname% = 0) AND 1
       SYS "SendMessage",htool%,1041,&104,(?fname% <> 0) AND 4
       MOUSE X%,Y%,B%
       C% = TINT(X%,Y%)
       IF C% <> -1 THEN
         SYS
"SendMessage",hstat%,1025,0,"R = "+STR$(C%AND&FF)
         SYS "SendMessage",hstat%,1025,1,"G = "+STR$((C%>>8)AND&FF)
         SYS "SendMessage",hstat%,1025,2,"B = "+STR$((C%>>16)AND&FF)
       ENDIF
       IF
Display% THEN
         
Display% = FALSE
         PROC
display
         WAIT 10
       ENDIF
     UNTIL FALSE
     END

     
DEF PROCnew
     GCOL 128 : CLG
     
?fname% = 0
     SYS "SetWindowText",@hwnd%,"Viewer"
     ENDPROC

     
DEF PROCopen : LOCAL ok%
     SYS "GetOpenFileName",Ofn{} TO ok%
     IF ok% THEN
       SYS
"SetWindowText",@hwnd%,"Viewer - "+$$fname%
       Display% = TRUE
     ENDIF
     ENDPROC

     
DEF PROCpagesetup : LOCAL ok%
     Psd.hDevMode% = Pd.hDevMode%
     Psd.hDevNames% = Pd.hDevNames%
     SYS "PageSetupDlg", Psd{} TO ok%
     IF ok% THEN
       
Pd.hDevMode% = Psd.hDevMode%
       Pd.hDevNames% = Psd.hDevNames%
     ENDIF
     ENDPROC

     
DEF PROCprint : LOCAL ok%,N%,V%,W%,X%,Y%
     Pd.flags% = &10C : REM PD_RETURNDC | PD_NOPAGENUMS | PD_NOSELECTION
     
SYS "PrintDlg", Pd{} TO ok%
     IF ok% THEN
       SYS
"DeleteDC",@prthdc%
       @prthdc% = Pd.hdc%
       SYS "GetDeviceCaps",@prthdc%,8  TO X% : REM Width in pixels
       
SYS "GetDeviceCaps",@prthdc%,10 TO Y% : REM Height in pixels
       
SYS "GetDeviceCaps",@prthdc%,88 TO V% : REM X Pixels/inch
       
SYS "GetDeviceCaps",@prthdc%,90 TO W% : REM Y pixels/inch
       
X% -= Psd.rtMargin.l%/2540*V% + Psd.rtMargin.r%/2540*V% : REM Adjust width
       
Y% -= Psd.rtMargin.t%/2540*W% + Psd.rtMargin.b%/2540*W% : REM Adjust height
       
V% = Psd.rtMargin.l%/2540*V% : REM Left margin
       
W% = Psd.rtMargin.t%/2540*W% : REM Top margin
       
FOR N% = 1 TO Pd.nCopies.l&
         VDU 2,1,32,3
         PROCrender(@prthdc%,$$fname%,V%,W%,X%,Y%)
         VDU 2,1,12,3
       NEXT
     ENDIF
     ENDPROC

     
DEF PROCdisplay : LOCAL V%,W%,X%,Y%
     VDU 26 : CLG
     SYS
"GetClientRect",@hwnd%,^V%
     PROCrender(@memhdc%,$$fname%,0,34,X%,Y%-54)
     SYS "InvalidateRect",@hwnd%,0,0
     SYS "UpdateWindow",@hwnd%
     ENDPROC

     
DEF PROCexit
     PROC_removestatusbar
     PROC_removetoolbar
     QUIT

     
DEF PROCmove(M%,W%,L%)
     SYS "PostMessage",hstat%,M%,W%,L%
     SYS "PostMessage",htool%,M%,W%,L%
     IF M% = 5 IF ?fname% Display% = TRUE
     ENDPROC

     
DEF PROCrender(hdc%,pic$,ox%,oy%,cx%,cy%)
     LOCAL iid%,pic%,len%,gpp%,hmw%,hmh%,new%
     DIM iid% LOCAL 15,pic% LOCAL 513
     SYS "MultiByteToWideChar",0,0,pic$,LEN(pic$),pic%,256 TO len%
     pic%!(2*len%) = 0

     iid%!0  = &7BF80980
     iid%!4  = &101ABF32
     iid%!8  = &AA00BB8B
     iid%!12 = &AB0C3000

     SYS `OleLoadPicturePath`,pic%,0,0,0,iid%,^gpp%
     IF gpp% = 0 SYS "MessageBox",@hwnd%,"Unrecognised image format","Viewer",48 : ENDPROC
     SYS
!(!gpp%+24),gpp%,^hmw% : REM. IPicture::get_Width
     
SYS !(!gpp%+28),gpp%,^hmh% : REM. IPicture::get_Height

     
IF hmw%/hmh% > cx%/cy% THEN
       
new% = cx%*hmh%/hmw%
       oy% += (cy%-new%)/2
       cy% = new%
     ELSE
       
new% = cy%*hmw%/hmh%
       ox% += (cx%-new%)/2
       cx% = new%
     ENDIF

     SYS
!(!gpp%+32),gpp%,hdc%,ox%,oy%,cx%,cy%,0,hmh%,hmw%,-hmh%,0 : REM. IPicture::Render
     
SYS !(!gpp%+8),gpp% : REM. IPicture::Release
     
ENDPROC


Home - Products - Contact us

Best viewed with Any Browser Valid HTML 3.2!
© Richard Russell 2009