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
PROCnew
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
PROCdisplay
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
