- - - - - - - - - -            
Hi all.

The little program hereunder is an example of the use of API calls to manage
graphics with numerous different colors.
Unfortunately this works only on CW versions 1.5 to 2.003, and only in 16 bit.

In 32 bit, the colors are not set.
Under clarion 4, it GPF's when you press one of the buttons.

Could anybody suggest improvements to make this work under all the versions
of CW ?

   PROGRAM
! Windows types :
HANDLE          EQUATE(UNSIGNED)
UINT            EQUATE(UNSIGNED)
DWORD           EQUATE(ULONG)
LPVOID          EQUATE(ULONG)
BOOL            EQUATE(SIGNED)
WORD            EQUATE(SIGNED)
LPARAM          EQUATE(LONG)
LRESULT         EQUATE(LONG)
WPARAM          EQUATE(UINT)
HDC             EQUATE(HANDLE)
HWND            EQUATE(HANDLE)
HGDIOBJ         EQUATE(HANDLE)
HBRUSH          EQUATE(HANDLE)
COLORREF        EQUATE(DWORD)
HPALETTE        EQUATE(HANDLE)
WM_PAINT        EQUATE(000Fh)
BLACK_BRUSH     EQUATE(4)
PC_RESERVED     EQUATE(01h)
PALET{*filter*}TRY    GROUP,TYPE
peRed             BYTE
peGreen           BYTE
peBlue            BYTE
peFlags           BYTE
                END

!-- Module global data :
SavedProc      LONG,THREAD
!-----

  MAP
Main PROCEDURE
     SubClassFunc(USHORT,USHORT,USHORT,LONG),LONG,Pascal
     MODULE('Windows.DLL')
        AnimatePalette(HPALETTE, UNSIGNED,
UNSIGNED,*PALET{*filter*}TRY),BOOL,PASCAL,RAW
            OMIT('***',_WIDTH32_)
        CallWindowProc(LONG, HWND, WORD, WPARAM, LPARAM),LRESULT,PASCAL !
            ***
            COMPILE('***',_WIDTH32_)

CallWindowProc(LONG,HWND,UNSIGNED,WPARAM,LPARAM),LRESULT,PASCAL,NAME('CallWi
ndowProcA')
            ***
        CreateSolidBrush(COLORREF),HBRUSH,PASCAL
        CreatePalette(*LOGPALETTE),HPALETTE,PASCAL,RAW
        EllipseAPI(HDC,SIGNED,SIGNED,SIGNED,SIGNED),BOOL,PASCAL,NAME('Ellipse')
        DeleteDC(HDC),BOOL,PASCAL
        DeleteObject(HGDIOBJ),BOOL,PASCAL
        GetDC(HWND),HDC,PASCAL
        GetStockObject( SIGNED),HGDIOBJ,PASCAL
        ReleaseDC(HWND, HDC),SIGNED,PASCAL
        RealizePalette(HDC),UNSIGNED,PASCAL
        SelectObject(HDC, HGDIOBJ),HGDIOBJ,PASCAL
        SelectPalette(HDC, HPALETTE, BOOL),HPALETTE,PASCAL
        GetPalet{*filter*}tries(HPALETTE, WORD, WORD, *PALET{*filter*}TRY),WORD,PASCAL,RAW
     END
  END

  CODE
  Main

!-------------
Main PROCEDURE

StepX                SHORT
StepY                SHORT
! For API drawings :
hVideoDC       HANDLE
hPen           HANDLE
hBrush         HANDLE
! For Palette management :
HandWDP        HANDLE                   ! Active window handle
hPal           HANDLE
PalEntry       GROUP(Palet{*filter*}try).
LOGPALETTE     GROUP
palVersion        WORD
palNumEntries     WORD
palEntries        GROUP(Palet{*filter*}try),DIM(210).
               END
PaletteIndex   GROUP(Palet{*filter*}try),DIM(210).
GlobPalIndex   GROUP(Palet{*filter*}try),OVER(PaletteIndex).
!---------------------------------------------
MainWindow WINDOW('7P
Software'),AT(,,301,113),IMM,PALETTE(256),SYSTEM,GRAY,RESIZE
       TOOLBAR,AT(0,0,300,15),COLOR(080FF80H)
         BUTTON('Palette Change'),AT(2,2,66,12),USE(?PalButton)
         BUTTON('Color Cycling'),AT(73,2,66,12),USE(?StartButton)
       END
     END
  CODE
  ! ---
  StepX =5 ; StepY =5
  ! ---
  DO PrepareProcedure
  ACCEPT
    CASE EVENT()
    OF EVENT:CloseWindow
      ! Release system ressources :
      IF DeleteObject(Hpal).
      IF ReleaseDC(handWDP,hVideoDC).
    OF EVENT:OpenWindow
      DO  DrawCircles
    OF EVENT:LoseFocus
      !-- End of window subclassing :
      IF SavedProc <>0
         TARGET{Prop:ClientWndProc} = SavedProc
         SavedProc =0
      END
    OF EVENT:GainFocus
      !-- Palette activation :
      IF SelectPalette(hVideoDC,Hpal,FALSE).
      IF RealizePalette(hVideoDC).
      !-- Window subclassing :
      IF SavedProc =0
         SavedProc = TARGET{Prop:ClientWndProc}
         TARGET{Prop:ClientWndProc} = Address(SubClassFunc)
      END
    OF EVENT:Timer
      ! Palette cycling :
      IF GetPalet{*filter*}tries(hPal,0,200,GlobPalIndex).   ! retrieves palette
description
      PaletteIndex[200] = PaletteIndex[1]
      LOOP i#=1 to 199
        PalEntry = PaletteIndex[i#+1]                  ! shift colors
        PaletteIndex[i#] = PalEntry
      END
      IF AnimatePalette(hPal,0,200,GlobPalIndex).      ! modify 200 colors
in the current palette
    ELSE
      IF EVENT() = 401H THEN DO DrawCircles.
    END
    CASE FIELD()
    OF ?StartButton
      CASE EVENT()
      OF EVENT:Accepted
        TARGET{Prop:Timer} = 1         ! Start color cycling
      END
    OF ?PalButton
      CASE EVENT()
      OF EVENT:Accepted
        ! Set a new palette (200 colors) :
        SR# =1 ; SG# =3 ; SB# = 5
        LOOP i#=1 to 200
          Red# += SR# ; Green# += SG# ; Blue# += SB#
          IF Red# >255 THEN Red# = 255; SR# =-SR# .
          IF Red# <0 THEN Red# = 0; SR# =-SR# .
          IF Green# >255 THEN Green# = 255; SG# =-SG# .
          IF Green# <0 THEN Green# = 0; SG# =-SG# .
          IF Blue# >255 THEN Blue# = 255; SB# =-SB# .
          IF Blue# <0 THEN Blue# = 0; SB# =-SB# .
          PalEntry.PeRed = Red#
          PalEntry.PeGreen = Green#
          PalEntry.PeBlue = Blue#
          PalEntry.PeFlags = PC_RESERVED
          PaletteIndex[i#] = PalEntry
        END
        IF AnimatePalette(hPal,0,200,GlobPalIndex).  ! Palette change (200
colors changed)
      END
    END
  END
!---------------------------------------------------------------------------
PrepareProcedure ROUTINE
  OPEN(MainWindow)
  !-- Windows housekeeping before to use a palette :
  HandWDP = TARGET{Prop:ClientHandle}
  hVideoDC = GetDC(handWDP)
  !-- Palette definition and activation (initial content = blue scale) :
  LOOP PP# = 1 TO 210                        ! 210 colors
     PalEntry.PeBlue = 200
     PalEntry.PeGreen = PP#
     PalEntry.PeRed = PP#
     PalEntry.PeFlags = 1                       ! equates PC_RESERVED
     LogPalette.PalEntries[PP#] = PalEntry
  END
  LogPalette.PalVersion = 300H
  LogPalette.PalNumEntries = 210
  Hpal = CreatePalette(LogPalette)
!---------------------------------------------------------------------------
DrawCircles  ROUTINE
 x# =0 ; Y# =20 ; S#=20
 LOOP i# =0 to 199
   Hbrush = CreateSolidBrush(1000000H + i#)
   IF SelectObject(hVideoDC,hBrush).
   X# += S#
   IF x#>700 OR X#<20 THEN X# -=S# ; y# +=35 ; S# =-S# .
   IF EllipseAPI(hVideoDC,X#,Y#,X#+15,Y#+15).
   IF SelectObject(hVideoDC,GetstockObject(Black_BRUSH)).
   IF DeleteObject(hBrush).
 END
!-------------------------------
SubClassFunc   FUNCTION(HW,WM,WP,LP)
  CODE
  CASE WM
    OF WM_PAINT
       POST(401H)
  END
  RETURN(CallWindowProc(SavedProc,HW,WM,WP,LP))
!-------------------------
Gerard Swinnen
136, Av. de Thiervaux
B 4802  HEUSY (Belgium)
Phone/Fax : (32)87230455