From: Ezra B. <ezr...@us...> - 2006-06-09 04:34:04
|
Update of /cvsroot/win32forth/win32forth/apps/ForthForm In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv4388/apps/ForthForm Modified Files: IMAGEWINDOW.F Log Message: Bug fix in popup menu. Readded ability to load supported image types from memory. Index: IMAGEWINDOW.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/ForthForm/IMAGEWINDOW.F,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** IMAGEWINDOW.F 5 May 2005 09:43:26 -0000 1.2 --- IMAGEWINDOW.F 9 Jun 2006 04:34:00 -0000 1.3 *************** *** 100,103 **** --- 100,117 ---- FIF_LBM Constant FIF_IFF + /* * Image type used in FreeImage. */ + 0 to enum-value + enum: + FIT_UNKNOWN // unknown type + FIT_BITMAP // standard image : 1-, 4-, 8-, 16-, 24-, 32-bit + FIT_UINT16 // array of unsigned short : unsigned 16-bit + FIT_INT16 // array of short : signed 16-bit + FIT_UINT32 // array of unsigned long : unsigned 32-bit + FIT_INT32 // array of long : signed 32-bit + FIT_FLOAT // array of float : 32-bit IEEE floating point + FIT_DOUBLE // array of double : 64-bit IEEE floating point + FIT_COMPLEX // array of FICOMPLEX : 2 x 64-bit IEEE floating point + ; + /* Image color type used in FreeImage. */ 0 to enum-value *************** *** 153,156 **** --- 167,175 ---- FICC_ALPHA // Use alpha channel FICC_BLACK // Use black channel + FICC_REAL // Complex images: use real part + FICC_IMAG // Complex images: use imaginary part + FICC_MAG // Complex images: use magnitude + FICC_PHASE // Complex images: use phase + ; *************** *** 181,184 **** --- 200,204 ---- 4 proc _FreeImage_Rescale@16 as FIReScale 2 proc _FreeImage_AdjustGamma@12 as FIAdjustGamma + 4 proc _FreeImage_LoadFromHandle@16 as FILoadFromHandle 1 to enum-value *************** *** 250,255 **** --- 270,316 ---- max-path bytes ImageFileName 256 value image-id + int &bitmap + int >&bitmap int DrawDibDC + 4 CallBack: FIReadProc { &buffer size cnt fihandle -- cnt } + fihandle &bitmap <> abort" Attempted read from wrong bitmap!" + cnt 0 + do >&bitmap &buffer size move + size +to >&bitmap + size +to &buffer + loop cnt ; + + 4 CallBack: FIWriteProc { &buffer size cnt fihandle -- size } + size ; + + 3 CallBack: FISeekProc { fihandle offset origin -- 0 } + fihandle &bitmap <> abort" Attempted seek from wrong bitmap!" + origin + case + SEEK_SET of fihandle offset + to >&bitmap endof + SEEK_END of abort" Invalid seek" endof + offset +to >&bitmap + endcase 0 ; + + 1 CallBack: FITellProc { fihandle -- res } + fihandle &bitmap <> abort" Attempted query from wrong bitmap!" + fihandle >&bitmap > abort" Invalid handle!" + >&bitmap fihandle - ; + + create IOProcs + &FIReadProc , + &FIWriteProc , + &FISeekProc , + &FITellProc , + + :M LoadFromHandle: { FIF_FORMAT addr -- FIBITMP } + addr to &bitmap addr to >&bitmap + 0 + &bitmap + IOProcs + FIF_FORMAT + FILoadFromHandle ;M + : gen-id ( -- id ) image-id *************** *** 369,414 **** 8 of true Check: mnu8 false Enable: mnu8 ! false dup Check: mnu16 ! dup Check: mnu24 ! dup Check: mnu32 ! true dup Enable: mnu16 ! dup Enable: mnu24 ! Enable: mnu32 endof ! 16 of true Check: mnu16 false Enable: mnu16 ! false dup Check: mnu8 ! dup Check: mnu24 ! dup Check: mnu32 ! true dup Enable: mnu8 ! dup Enable: mnu24 ! Enable: mnu32 endof ! 24 of true Check: mnu24 ! false Enable: mnu24 ! false dup Check: mnu8 ! dup Check: mnu16 ! Check: mnu32 ! true dup Enable: mnu8 ! dup Enable: mnu16 ! Enable: mnu32 endof ! 32 of true Check: mnu32 false Enable: mnu32 ! false dup Check: mnu8 ! dup Check: mnu16 ! dup Check: mnu24 ! true dup Enable: mnu8 ! dup Enable: mnu16 ! Enable: mnu24 endof ! ( default ) false dup Check: mnu8 ! dup Check: mnu16 ! dup Check: mnu24 ! Check: mnu32 ! true dup Enable: mnu8 ! dup Enable: mnu16 ! dup Enable: mnu24 ! Enable: mnu32 endcase ; --- 430,475 ---- 8 of true Check: mnu8 false Enable: mnu8 ! false Check: mnu16 ! false Check: mnu24 ! false Check: mnu32 ! true Enable: mnu16 ! true Enable: mnu24 ! true Enable: mnu32 endof ! 16 of true Check: mnu16 false Enable: mnu16 ! false Check: mnu8 ! false Check: mnu24 ! false Check: mnu32 ! true Enable: mnu8 ! true Enable: mnu24 ! true Enable: mnu32 endof ! 24 of true Check: mnu24 ! false Enable: mnu24 ! false Check: mnu8 ! false Check: mnu16 ! false Check: mnu32 ! true Enable: mnu8 ! true Enable: mnu16 ! true Enable: mnu32 endof ! 32 of true Check: mnu32 false Enable: mnu32 ! false Check: mnu8 ! false Check: mnu16 ! false Check: mnu24 ! true Enable: mnu8 ! true Enable: mnu16 ! true Enable: mnu24 endof ! ( default ) false Check: mnu8 ! false Check: mnu16 ! false Check: mnu24 ! false Check: mnu32 ! true Enable: mnu8 ! true Enable: mnu16 ! true Enable: mnu24 ! true Enable: mnu32 endcase ; *************** *** 433,437 **** endcase BackGroundColor WHITE = dup not Check: mnuBlack Check: mnuWhite ! check-bits ; : DisplayImage ( -- ) --- 494,499 ---- endcase BackGroundColor WHITE = dup not Check: mnuBlack Check: mnuWhite ! check-bits ! ; : DisplayImage ( -- ) *************** *** 513,516 **** --- 575,587 ---- then ;M + :M LoadMemoryBitmap: ( &bitmap -- ) + FIF_BMP swap LoadFromHandle: self + dup FIF_UNKNOWN <> + if UnLoadImage: self + to FIBITMAP + DisplayImage + else drop + then ;M + :M ReLoad: ( -- ) \ redraw using earlier set image LoadImage *************** *** 537,543 **** ;M ! :M On_Size: ( -- ) ! \ Refresh: self ! ;M :M AutoSize: ( -- ) --- 608,614 ---- ;M ! \ :M On_Size: ( -- ) ! \ \ Refresh: self ! \ ;M :M AutoSize: ( -- ) *************** *** 553,559 **** :M On_Init: ( -- ) On_Init: super - (( wincnt 0= - if -1 call _FreeImage_Initialise@4 drop - then 1 +to wincnt )) ImagePopupBar SetPopupBar: self GetDc: self dup Puthandle: ImageDC --- 624,627 ---- *************** *** 566,577 **** DrawDIBDC Call DrawDibClose drop UnLoadImage: self ! (( wincnt 1- dup to wincnt 0= ! if Call _FreeImage_DeInitialise@0 ! then )) On_Done: super ;M :M WM_RBUTTONDOWN ( h m w l -- ) dopopup? ! if self to ThisImage \ for popup menu WM_RBUTTONDOWN WM: Super else DefWindowProc: self --- 634,643 ---- DrawDIBDC Call DrawDibClose drop UnLoadImage: self ! On_Done: super ;M :M WM_RBUTTONDOWN ( h m w l -- ) dopopup? ! if self to ThisImage check-mode \ for popup menu WM_RBUTTONDOWN WM: Super else DefWindowProc: self *************** *** 850,852 **** _FreeImage_ZLibCompress@16 _FreeImage_ZLibUncompress@16 ! |