I was dabbling a bit a while back but dropped it;
the lists below should include but need a bmp picture; if you are
brave enuf to=A0 look
at undocumented stuff-
first I found StretchBlt to=A0 be useful (WinAPI); though there must be
a more efficient way for Bitmap2.
If this makes any sense and you'd like I can email the BMP.
-------------------------------
strblt.f:
-------------------------------------
\ empty
=A011 import: StretchBlt
=A000 value px
=A000 value py
=A0GetDesktopWindow window-height 100 / 100 *
=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=
=A0=A0=A0=A0=A0=A0 dup 2/ dup to py
=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=
=A0=A0=A0=A0=A0=A0=A0=A0 + 2/=A0=A0=A0=A0 to px
=A0bitmap subclass bitmap2
=A0=A0 PUBLIC
=A0=A0 : paintit ( bitmap-addr -- ) BMP!
=A0=A0=A0=A0=A0 (BMPHANDLE)
=A0=A0=A0=A0=A0 Palette?
=A0=A0=A0=A0=A0=A0=A0 IF=A0 hDC @ hPalette @ 0 :: SelectPalette
=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0 hOldPalette !
=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0 hDC @ :: RealizePalette DROP
=A0=A0=A0=A0=A0=A0=A0 THEN
=A0=A0=A0=A0=A0 hDC @ :: CreateCompatibleDC hMemDC !
=A0=A0=A0=A0=A0 hMemDC @ hBitmap @ :: SelectObject hOldBitmap !
=A0=A0=A0=A0=A0 hDC @=A0=A0=A0=A0=A0=A0 0 0 px py=A0=A0=A0=A0=A0=A0=A0=A0=
=A0=A0=A0 \ destination position
=A0=A0=A0=A0=A0=A0=A0=A0 hMemDC @ 0 0 Width @ Height @ \ source position in=
bitmap
=A0=A0=A0=A0=A0 SRCCOPY :: StretchBlt DROP
=A0=A0=A0=A0=A0 hMemDC @ hOldBitmap @ :: SelectObject DROP
=A0=A0=A0=A0=A0 Palette?
=A0=A0=A0=A0=A0=A0=A0 IF hDC @ hOldPalette @ 0 :: SelectPalette DROP
=A0=A0=A0=A0=A0=A0=A0 THEN
=A0=A0=A0=A0=A0 hMemDC @ :: DeleteDC DROP
=A0=A0=A0=A0=A0 Palette? IF=A0 hPalette @ :: DeleteObject DROP=A0 THEN
=A0=A0=A0=A0=A0 hBitmap @ :: DeleteObject DROP ;
=A0=A0 : DRAW2 ( bitmap-addr dc x y -- )
=A0=A0=A0=A0=A0 y ! x ! hDC ! paintit ;
=A0=A0 :=A0 filled ( bitmap-addr hwnd -- )
=A0=A0=A0=A0=A0=A0 dup :: GetDC hDC !
=A0=A0=A0=A0=A0=A0 swap paintit
=A0=A0=A0=A0=A0=A0 ( hwnd) hDC @ :: ReleaseDC DROP ;
END-CLASS
gild
-----------------------------------
file splscr.f
--------------------------------------------
0 value opnsel
=A0include strblt
PACKAGE pABOUTBOX
PUBLIC
=A0 : bmtry=A0 ( -- addr n=A0 )=A0=A0=A0 \=A0 rootdir zcount pad zplace
=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0 s" spl3h.bmp" pad zplace
=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0 pad zcount ;
=A0 VARIABLE picbmp
=A0 0 value tht
=A0 0 value bdc
=A0 create txtrect 4 cells allot
=A0=A0=A0=A0=A0=A0 10 50 80 70 txtrect !rect
PRIVATE
=A00 value picff
=A0: bmpnam=A0=A0=A0 HWND
=A0 z"=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0 BU=
G-O=A0=A0 SE-XY=A0 PROGRAMMING TOOLS"
=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0 SetWindowText DRO=
P ;
DIALOG bmpdlg
=A0=A0 [MODAL=A0 100 60 px 2/ py 2/=A0 (FONT 10, MS Sans Serif)
=A0=A0=A0=A0=A0=A0=A0 ( -style WS_BORDER WS_CAPTION)=A0 ]
=A0=A0 [DEFPUSHBUTTON=A0 " OK"=A0 IDOK=A0 px 2/ 80 - 2/=A0 py 2/ 80 -=A0=A0=
80 50 ]
=A0=A0 [PUSHBUTTON " PIPE"=A0=A0=A0=A0 102=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=
=A0=A0=A0=A0=A0=A0=A0 65 65 75 50=A0=A0=A0=A0=A0 ]
=A0=A0 [PUSHBUTTON " PLATE"=A0=A0=A0 103=A0 PX 2/ 140 -=A0 65=A0=A0=A0=A0=
=A0=A0=A0=A0=A0=A0=A0 75 50=A0 ]
=A0=A0 [PUSHBUTTON " SHJOB"=A0=A0=A0 104=A0 px 2/ 125 -=A0 py 2/ 125 -=A0=
=A0 75=A0 50 ]
=A0=A0 [PUSHBUTTON " PIJOB"=A0=A0=A0 105=A0 50=A0=A0=A0=A0=A0=A0=A0=A0=A0=
=A0 py 2/ 125 -=A0=A0 75=A0 50 ]
=A0=A0 [STATIC=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0 101=A0=A0 0=
=A0=A0 0=A0=A0 px=A0 py
=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0 (+STY=
LE SS_OWNERDRAW) (-STYLE WS_BORDER) ]
END-DIALOG
=A0: drawbmp ( -- res )
=A0=A0 [OBJECTS=A0 BITMAP2 MAKES PICTURE=A0 OBJECTS]
=A0=A0 picbmp @ LPARAM 5 CELLS + @ PICTURE=A0 filled=A0 ;
=A0: closebmp ( -- res )=A0=A0 HWND 0 EndDialog ;
[SWITCH bmpcommands ZERO
=A0=A0 IDOK=A0=A0=A0=A0 RUN: 0 to opnsel closebmp ;
=A0=A0 102=A0=A0=A0=A0=A0 run: 2 to opnsel closebmp ;
=A0=A0 103=A0=A0=A0=A0=A0 run: 3 to opnsel closebmp ;
=A0=A0 104=A0=A0=A0=A0=A0 run: 4 to opnsel closebmp ;
=A0=A0 105=A0=A0=A0=A0=A0 run: 5 to opnsel closebmp ;
SWITCH]
[SWITCH bmpMsgs ZERO
=A0=A0 WM_CLOSE=A0=A0=A0=A0=A0=A0=A0=A0=A0 RUNS closebmp
=A0=A0 WM_DRAWITEM=A0=A0=A0=A0=A0=A0 RUN: picff if drawbmp=A0 then=A0 ;
=A0=A0 WM_INITDIALOG=A0=A0=A0=A0 RUN: ( -- res )=A0 LPARAM picbmp !=A0 bmpn=
am=A0=A0 -1
=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0 0 =
to opnsel=A0 ;
=A0=A0 WM_COMMAND=A0=A0=A0=A0=A0=A0=A0 RUN: ( -- res )=A0 WPARAM LOWORD bmp=
commands ;
SWITCH]
:NONAME ( -- res )=A0=A0 MSG LOWORD bmpMsgs ;=A0 4 CB: Runbmp
PUBLIC
: shobmp ( -- )
=A0=A0 ( ABOUT-IMAGE) bmtry READ-BMPFILE dup to picff >R
=A0=A0 HINST bmpdlg=A0 HWND=A0 Runbmp=A0 R@=A0 DialogBoxIndirectParam DROP
=A0=A0 R> ?DUP -EXIT FREE DROP
=A0;
END-PACKAGE
\ shobmp
---------------------------------------------------------
On Tue, Mar 23, 2010 at 11:01 AM, Gene LeFave <gene_at_tekdata.com> wrote:
>
> Does anyone have an example of some splash screen code? =A0I'd like to di=
splay a graphic
> plus a bit of text.
>
>
> Thanks,
>
> Gene- =A0Gene LeFave, =A0VP, Tek Data Systems; gene_at_tekdata.com; 1(847)36=
7-8800
>
> "The Quixotes of this Age fight with the Wind-mills of their owne Heads."
> John Cleveland, 1644
>
> ----------------------------------------------------------------------
> sftalk_at_forth.com =A0 =A0 =A0The SwiftForth programming discussion email l=
ist
> To unsubscribe, send subject "unsubscribe" to sftalk-request_at_forth.com
> For list command help, send subject "help" to sftalk-request_at_forth.com
> Message archives are located at http://www.forth.com/archive/sftalk
> ----------------------------------------------------------------------
> This list is a forum for SwiftForth users. =A0For product support and
> bug reports, please send email to support_at_forth.com
> ----------------------------------------------------------------------
>
----------------------------------------------------------------------
sftalk_at_forth.com The SwiftForth programming discussion email list
To unsubscribe, send subject "unsubscribe" to sftalk-request_at_forth.com
For list command help, send subject "help" to sftalk-request_at_forth.com
Message archives are located at http://www.forth.com/archive/sftalk
----------------------------------------------------------------------
This list is a forum for SwiftForth users. For product support and
bug reports, please send email to support_at_forth.com
----------------------------------------------------------------------
Received on Thu Mar 25 2010 - 10:10:36 PDT
Subscribe to our e-mail list service. It's free for all SwiftForth and SwiftX users!
This archive was generated 06-Feb-2012. Archive updated nightly.