Re: Bitmap palette

From: Rick VanNorman <rvn_at_forth.com>
Date: Tue, 02 May 2000 14:48:38 -0700

>From: "Bret Latshaw" <bret_at_bedford.net>

>Subject: Bitmap palette
>
>There seems to be a problem with the way the BITMAP class
>in BMP.F handles its palette.

Bret,

Good catch. Goes in tonight!

Thanks,
Rick

.

>From mikeg_at_logix-controls.com Tue May 2 15:39:55 2000
To: sftalk_at_forth.com
Message-Id: <m0000815_at_gerd.forthinc.com>
Date: Tue, 2 May 2000 15:39:55 -0700
From: "Mike Ghan" <mikeg_at_logix-controls.com>
Subject: Super-Classing

Hello all - I find this super-classing utility useful for altering existing
controls:

\ * SuperClass ****************************************************

[DEFINED] :: NOT
[IF] : :: ( noop ) ; IMMEDIATE [THEN] \ Syntax sugar

Function: GetClassInfoEx ( hinst lpszClass lpWNDCLASSEX -- res )

WNDCLASSEX SUBCLASS WND-SUPERCLASS

   VARIABLE PrevWndProc
   VARIABLE Atom

   : GET-CLASS ( zClassName -- )
      0 SWAP ADDR :: GetClassInfoEx 0= THROW ;

   : NEW-CLASS ( zNewClassName newProc -- )
      WndProc @ PrevWndProc ! ( Save Old Proc )
      WndProc ! ( New Procedure )
      ClassName ! ( New Class Name )
      HINST Instance ! ( Our Instance )
      ADDR :: RegisterClassEx DUP 0= THROW Atom ! ;

   : DEF-PREV-PROC ( n -- res ) \ Forward to existing procedure
      DROP PrevWndProc @ HWND MSG WPARAM LPARAM :: CallWindowProc ;

   : RE-CLASS ( zNewClassName newProc zClassName -- )
      GET-CLASS NEW-CLASS ;

END-CLASS

\\ ********** Example **********************

Function: MessageBeep ( sound_type -- flag ) \ True = Error

WND-SUPERCLASS BUILDS EDIT#-CLASS EDIT#-CLASS Construct

: DEF-EDIT#-PROC ( n -- res ) EDIT#-CLASS DEF-PREV-PROC ;

: EDIT#-CHAR ( -- res )
   WPARAM ( char )
   DUP [CHAR] 0 [CHAR] : WITHIN IF DEF-EDIT#-PROC EXIT THEN
   DUP 0 BL ( Control ) WITHIN IF DEF-EDIT#-PROC EXIT THEN
   DUP CASE
   [CHAR] . OF DEF-EDIT#-PROC EXIT ENDOF
   [CHAR] , OF DEF-EDIT#-PROC EXIT ENDOF
   [CHAR] : OF DEF-EDIT#-PROC EXIT ENDOF
   [CHAR] / OF DEF-EDIT#-PROC EXIT ENDOF
   [CHAR] - OF DEF-EDIT#-PROC EXIT ENDOF
   ENDCASE
   0 ( default ) MessageBeep DROP 0 ( res ) ;

[SWITCH EDIT#-MESSAGES DEF-EDIT#-PROC
   WM_CHAR RUNS EDIT#-CHAR
SWITCH]

:NONAME ( -- res ) MSG LOWORD EDIT#-MESSAGES ; 4 CB: EDIT#PROC

: BUILD-EDIT#-CLASS ( -- )
   Z" Edit#Only" EDIT#PROC Z" Edit" EDIT#-CLASS RE-CLASS ;

:ONSYSLOAD BUILD-EDIT#-CLASS ;

PACKAGE DLGCOMP \ Extend the Dialog Compiler

\ New "Numeric" edit control
S" Edit#Only" (OR ES_LEFT WS_BORDER WS_TABSTOP) CONTROL [EDIT#

END-PACKAGE

*******************************************************************

Best Regards, Mike Ghan mikeg_at_logix-controls.com

.
Received on Tue May 02 2000 - 14:48:38 PDT


Subscribe to our e-mail list service. It's free for all SwiftForth and SwiftX users!

This archive was generated 09-Feb-2012. Archive updated nightly.