Not sure if you meant like this - hope it doesn't screw up worse!

strblt.f : -
--------------------------------------------------------------------------
\ empty

 11 import: StretchBlt
 00 value px
 00 value py
 GetDesktopWindow window-height 100 / 100 *
                                dup 2/ dup to py
                                  + 2/ to px
 bitmap subclass bitmap2

   PUBLIC
   : paintit ( bitmap-addr -- ) BMP!
      (BMPHANDLE)
      Palette?
        IF hDC @ hPalette @ 0 :: SelectPalette
            hOldPalette !
            hDC @ :: RealizePalette DROP
        THEN
      hDC @ :: CreateCompatibleDC hMemDC !
      hMemDC @ hBitmap @ :: SelectObject hOldBitmap !

      hDC @ 0 0 px py \ destination position
         hMemDC @ 0 0 Width @ Height @ \ source position in bitmap
      SRCCOPY :: StretchBlt DROP

      hMemDC @ hOldBitmap @ :: SelectObject DROP
      Palette?
        IF hDC @ hOldPalette @ 0 :: SelectPalette DROP
        THEN
      hMemDC @ :: DeleteDC DROP
      Palette? IF hPalette @ :: DeleteObject DROP THEN
      hBitmap @ :: DeleteObject DROP ;

   : DRAW2 ( bitmap-addr dc x y -- )
      y ! x ! hDC ! paintit ;

   : filled ( bitmap-addr hwnd -- )
       dup :: GetDC hDC !
       swap paintit
       ( hwnd) hDC @ :: ReleaseDC DROP ;
END-CLASS

gild
-----------------------------------------
splscr.f - include this one and place a BMP file with strblt and
splscr in the same directory
_____________________

_________
0 value opnsel
 include strblt
PACKAGE pABOUTBOX

PUBLIC

  : bmtry ( -- addr n ) \ rootdir zcount pad zplace
           s" spl3h.bmp" pad zplace
           pad zcount ;
  VARIABLE picbmp
  0 value tht
  0 value bdc
  create txtrect 4 cells allot
       10 50 80 70 txtrect !rect

PRIVATE

 0 value picff
 : bmpnam HWND
  z" BUG-O SE-XY PROGRAMMING TOOLS"
                    SetWindowText DROP ;

DIALOG bmpdlg
   [MODAL 100 60 px 2/ py 2/ (FONT 10, MS Sans Serif)
        ( -style WS_BORDER WS_CAPTION) ]

   [DEFPUSHBUTTON " OK" IDOK px 2/ 80 - 2/ py 2/ 80 - 80 50 ]
   [PUSHBUTTON " PIPE" 102 65 65 75 50 ]
   [PUSHBUTTON " PLATE" 103 PX 2/ 140 - 65 75 50 ]
   [PUSHBUTTON " SHJOB" 104 px 2/ 125 - py 2/ 125 - 75 50 ]
   [PUSHBUTTON " PIJOB" 105 50 py 2/ 125 - 75 50 ]
   [STATIC 101 0 0 px py
                        (+STYLE SS_OWNERDRAW) (-STYLE WS_BORDER) ]
END-DIALOG

 : drawbmp ( -- res )
   [OBJECTS BITMAP2 MAKES PICTURE OBJECTS]
   picbmp @ LPARAM 5 CELLS + @ PICTURE filled ;
 : closebmp ( -- res ) HWND 0 EndDialog ;

[SWITCH bmpcommands ZERO
   IDOK RUN: 0 to opnsel closebmp ;
   102 run: 2 to opnsel closebmp ;
   103 run: 3 to opnsel closebmp ;
   104 run: 4 to opnsel closebmp ;
   105 run: 5 to opnsel closebmp ;
SWITCH]

[SWITCH bmpMsgs ZERO
   WM_CLOSE RUNS closebmp
   WM_DRAWITEM RUN: picff if drawbmp then ;
   WM_INITDIALOG RUN: ( -- res ) LPARAM picbmp ! bmpnam -1
                         0 to opnsel ;
   WM_COMMAND RUN: ( -- res ) WPARAM LOWORD bmpcommands ;
SWITCH]

:NONAME ( -- res ) MSG LOWORD bmpMsgs ; 4 CB: Runbmp

PUBLIC

: shobmp ( -- )
   ( ABOUT-IMAGE) bmtry READ-BMPFILE dup to picff >R
   HINST bmpdlg HWND Runbmp R@ DialogBoxIndirectParam DROP
   R> ?DUP -EXIT FREE DROP
 ;

END-PACKAGE

 shobmp

________________________________________________________________

On Thu, Mar 25, 2010 at 2:25 PM, Leon Wagner <leon_at_forth.com> wrote:
> Try re-posting it in HTML format instead. =A0We'd all like to see it :)
>
>
>> -----Original Message-----Gene LeFave <gene_at_tekdata.com> a bmp picture; =
if you are
>> > brave enuf to=3DA0 look
>> > at undocumented stuff-
>> > first I found StretchBlt to=3DA0 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:
>> > -------------------------------------
----------------------------------------------------------------------
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 - 12:40:43 PDT