PLOT and DRAW with APi

Started by Zlatko Vid, December 21, 2022, 07:48:20 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

Nicola

Charles,
please how do I change the color of the segments that are drawn when I press the left mouse button?


  $ filename "t.exe"
  'uses rtl32
  'uses rtl64
  'uses MinWin
  uses corewin



  'extern lib "gdi32.dll"
  'sys Rectangle (sys hdc,X1,Y1,X2,Y2)
  'sys Ellipse   (sys hdc,X1,Y1,X2,Y2)
  'end extern


  #lookahead ' for procedures

  % ID_Timer   3000
  % Interval   100



  '==================
  'GLOBAL DEFINITIONS
  '==================


  sys inst,hdc
  sys xmax,ymax,r,idx,idy,xball,yball

  r =15 : idx =5 : idy=5 : xball=200 : yball=100 

redim int pu[20,2] 'contiene le coordinate dei punti
int pp = 0, j, ref 'pp è puntatore di pu[]


macro RGB(r,g,b) {r+(g<<8)+(b<<16)}

  '=========
  'MAIN CODE
  '=========
 
  dim cmdline as asciiz ptr,inst as sys
  &cmdline=GetCommandLine
  inst=GetModuleHandle 0
  '
  'WINDOWS
  '-------
  '
  WinMain inst,0,cmdline,SW_NORMAL
 
  endprog:


  '===========
  'END OF MAIN
  '===========

  'crea la finstra
  '------------------------------------------------------------------
  Function WinMain(sys inst,prevInst,zstring*cmdline,sys show) as sys
  '==================================================================

  WndClass wc
  MSG      wm

  sys hwnd, wwd, wht, wtx, wty, tax

  wc.style = CS_HREDRAW or CS_VREDRAW
  wc.lpfnWndProc = @WndProc
  wc.cbClsExtra =0
  wc.cbWndExtra =0   
  wc.hInstance =inst
  wc.hIcon=LoadIcon 0, IDI_APPLICATION
  wc.hCursor=LoadCursor 0,IDC_ARROW
  wc.hbrBackground = GetStockObject WHITE_BRUSH
  wc.lpszMenuName =0
  wc.lpszClassName = strptr "Demo"

  RegisterClass (&wc)
 
  Wwd = 800 : Wht = 600  'dimensioni finestra
  Tax = GetSystemMetrics SM_CXSCREEN
  Wtx = (Tax - Wwd) /2
  Tax = GetSystemMetrics SM_CYSCREEN
  Wty = (Tax - Wht) /2
 
  hwnd = CreateWindowEx 0,wc.lpszClassName,"OXYGEN BASIC",WS_OVERLAPPEDWINDOW,Wtx,Wty,Wwd,Wht,0,0,inst,0
  ShowWindow hwnd,SW_SHOW
  UpdateWindow hwnd

  '
  sys bRet
  '
  do while bRet := GetMessage (@wm, 0, 0, 0)
    if bret=0
      exit while
    end if
    if bRet = -1
      'show an error message
      exit while
    else
      TranslateMessage @wm
      DispatchMessage @wm
    end if
  end while
  End Function



  dim as rect crect 'for WndProc and TimerProc

  '-------------------------------------------------------------
  function WndProc (sys hWnd,wMsg,wParam,lparam) as sys callback
  '=============================================================

    static as sys count=0, refreshes=0, hdc, htimer
    static as String txt
    static as PaintStruct Paintst
 
    '==========
    select wMsg
    '==========
       
      '--------------
      case WM_CREATE
      '=============
        hTimer = SetTimer (hWnd, ID_Timer, 100, &TimerProc)
        GetClientRect  hWnd,&cRect

      '--------------
      case WM_TIMER
      '=============

      '-------------- 
      case WM_DESTROY
      '===============
        KillTimer(hWnd,ID_TIMER)
        PostQuitMessage 0
       
      '------------
      case WM_PAINT
      '============

      'TEXT
      'http://msdn.microsoft.com/en-us/library/dd144821(v=VS.85).aspx

      'DRAWING AND PAINTING
      'http://msdn.microsoft.com/en-us/library/dd162760(v=VS.85).aspx


      hDC=BeginPaint hWnd,&Paintst
      GetClientRect  hWnd,&cRect
      'style
      '0x20 DT_SINGLELINE
      '0x04 DT_VCENTER
      '0x01 DT_CENTER
      '0x25

'scrive il testo al centro della finestra
       SetBkColor   hdc,yellow
       SetTextColor hdc,red
       txt="x y pos" str(xball) " , " str(yball) " - " str(pp)
       'DrawText hDC,"Hello World",-1,&cRect,0x25
       DrawText hDC,strptr txt,-1,&cRect,0x25
       refreshes+=1
       Ellipse hdc, xball-r, yball-r, xball+r, yball+r
       'Ellipse hdc, xball, yball, xball+20, yball+30

        if pp>1 then
         SetDCPenColor(hdc, RGB(0,0,255))
          MovetoEx(hdc,pu[pp-1,0],pu[pp-1,1],null)
          Lineto(hdc,pu[pp,0],pu[pp,1])
        end if
        'pressed rmousek
        if ref=1 then
          SetDCPenColor(hdc, RGB(0,0,255))
'SetDCBrushColor(hdc, RGB(0,255,0))
          for j=2 to pp
             MovetoEx(hdc,pu[j-1,0],pu[j-1,1],null)
             Lineto(hdc,pu[j,0],pu[j,1])
          next j
          ref=0
         end if

       EndPaint hWnd,&Paintst
       ValidateRect hwnd,&crect
       
      '--------------   
      case WM_KEYDOWN
      '==============

      '============           
        Select wParam
      '============
          Case 37 : xball -= idx   'LEFT
          Case 39 : xball += idx   'RIGHT
          Case 38 : yball -= idy   'UP
       Case 40 : yball += idy   'DOWN
       Case 32 : Rectangle hdc, -1, -1, xmax+1, ymax+1 'SPACE
       Case 27 : SendMessage hwnd, WM_CLOSE, 0, 0      'ESCAPE

         End Select 'wParam
       '
         'InvalidateRect hwnd, &cRect, 1 'FULL SCREEN REFRESH
         InvalidateRect hwnd, &cRect, false 'FULL SCREEN REFRESH

      case WM_LBUTTONUP
        pp += 1
        pu[pp,0] = loword(lParam)
        pu[pp,1] = hiword(lParam)


      case WM_RBUTTONUP
        Ref=1

      '--------       
      case else
      '========
         
        function=DefWindowProc hWnd,wMsg,wParam,lParam
       
    end select

  end function ' WndProc


  '----------------------------------------------------
  sys TimerProc(sys hWnd,wMsg,nIDEvent,dwTime) callback
  '====================================================
  {
   static sys d=1


   select wMsg
 
     Case WM_TIMER
      'viene controllato l'allargamento e il restringimento del cerchio
      'InvalidateRect hwnd,&crect,1
      InvalidateRect hwnd,&crect,false
      if r=50 then d=-1
      if r=10 then d=1
      r+=d
      function = 0
   end select
 
  } ' TimerProc
 

Theo Gottwald

I See 3 Commands for the Color:
Try these.


       SetBkColor   hdc,yellow
       SetTextColor hdc,red

and we have

' Set Color to Blue
SetDCPenColor(hdc, RGB(0,0,255))




Nicola

Hi Theo,
I tried...
the first two commands are used for the background and for the text. I've already tested the third one you mentioned but it doesn't give the desired result.


case WM_PAINT
...
...
        SetDCPenColor(hdc, RGB(0,0,255))
        MovetoEx(hdc,pu[pp-1,0],pu[pp-1,1],null)
        Lineto(hdc,pu[pp,0],pu[pp,1])
...
the result is always black.

Charles Pegge

This is Peter's Line drawing procedure:

Sub Line(int x,y,a,b,w, rc,gc,bc)
    sys iPen,hPen
    int color = rc + gc*256 + bc*65536
    iPen = CreatePen PS_SOLID,w,color
    SelectObject bHdc, iPen
    MoveToEx bHdc,x,y,Byval 0
    LineTo bHdc,a,b
    DeleteObject iPen
    hPen = GetStockObject(DC_PEN)
    SelectObject bHdc, hPen
End Sub

Nicola

#19
Hi Charles,
but I'm not using Peter's API, but I'm using your program "GraphWin.o2bas" as a basis.

However I've tried using Peter's sub and also using the commands directly in the main program, but it doesn't work. :(


        if pp>1 then
          int color = RGB(255,255,255)
          sys iPen = CreatePen PS_SOLID,5,color
          SelectObject hdc, iPen
         'SetDCPenColor(hdc, RGB(0,0,255))
          'MovetoEx(hdc,pu[pp-1,0],pu[pp-1,1],null)
          MovetoEx(hdc,pu[pp-1,0],pu[pp-1,1])
          Lineto(hdc,pu[pp,0],pu[pp,1])
          'Line(pu[pp-1,0],pu[pp-1,1],pu[pp,0],pu[pp,1],1,0,0,255)
        end if

Charles Pegge

I agree, it does not respond to color setting, neither by Pen nor SolidBrush. Perhaps working with Peter's Window.inc would be more productive. It draws onto a back buffer instead of directly to the screen and avoids flickering when the scene is animated.

Pierre Bellisle

#21
Nicola,

One way to set the color using your code from post #15.
Change the line SetDCPenColor(hdc, RGB(0,0,255))
to SelectObject(hDc, CreatePen(PS_SOLID, 0, RGB(0, 0, 255))) 'Where %PS_SOLID = 0

Another way...
before the line SetDCPenColor(hdc, RGB(0, 0, 255))
add this SelectObject(hdc, GetStockObject(DC_PEN)) 'Where %DC_PEN =19
  •  

Charles Pegge

#22
Thanks Pierre,

The second method works perfectly without needing a new brush of pen object.

in WM_PAINT:
       'RGB COLOR
       SetDCPenColor hdc,0x00ff00 'lime green
       SetDCBrushColor hdc,0x00ff00 'lime green
       'CAN SELECT BOTH PEN AND BRUSH
       SelectObject hDC, hPen
       SelectObject hDC, hBrush
       Ellipse hdc, xball-r, yball-r, xball+r, yball+r
       MoveToEx hdc,xball,yball,Byval 0
       LineTo hdc,xball+r, yball+r

in WM_CREATE
      % DC_BRUSH       = 18
      % DC_PEN         = 19
      static sys hPen  = GetStockObject(DC_PEN)
      static sys hBrush = GetStockObject(DC_BRUSH)

Bernard Kunzy

#23
SUB DrawLine(BYVAL hDC AS LONG, BYVAL Xstart AS LONG, BYVAL Ystart AS LONG, BYVAL Xend AS LONG, BYVAL Yend AS LONG, BYVAL nStyle AS LONG, BYVAL nSize AS LONG, BYVAL nColor AS LONG)

    LOCAL lp AS LOGPEN
    LOCAL p AS POINTAPI
    LOCAL hPen AS LONG

    p.X = nSize: p.Y = nSize
    IF nSize > 1 THEN nStyle = 0 ' %PS_SOLID
    lp.lopnStyle = nStyle
    lp.lopnWidth = p
    lp.lopnColor = nColor
    hPen = SelectObject(hDC, CreatePenIndirect(lp))

    MoveToEx(hDC, Xstart, Ystart, BYVAL %NULL)
    LineTo(hDC, Xend, Yend)

    DeleteObject(SelectObject(hDC, hPen))

END SUB

and of course there is also the GdipDrawLine API.
  •  

Nicola

Hi Pierre,
really great. I also used the first solution in the Paintx sub and it works great.
I prefer this solution because you can also set the thickness of the line to be drawn. Thank you.


  $ filename "t.exe"
  'uses rtl32
  'uses rtl64
  'uses MinWin
  uses corewin



  'extern lib "gdi32.dll"
  'sys Rectangle (sys hdc,X1,Y1,X2,Y2)
  'sys Ellipse  (sys hdc,X1,Y1,X2,Y2)
  'end extern


  #lookahead ' for procedures

% ID_Timer  3000
% Interval  100

% PS_SOLID      = 0
% DC_PEN        = 19
% DC_BRUSH      = 18



  '==================
  'GLOBAL DEFINITIONS
  '==================


  sys inst,hdc
  sys xmax,ymax,r,idx,idy,xball,yball


  r =15 : idx =5 : idy=5 : xball=200 : yball=100 

redim int pu[20,2] 'contiene le coordinate dei punti
int pp = 0, j, ref, lm 'pp è puntatore di pu[]


'macro RGB(r,g,b) {r+(g<<8)+(b<<16)}
macro RGB(r,g,b) {r + g*256 + b*65536}

Sub Line(int x,y,a,b,w, rc,gc,bc,hdc, hpen,hBrush)

      SetDCPenColor hdc,0x00ff00 'lime green
      SetDCBrushColor hdc,0x00ff00 'lime green
      'CAN SELECT BOTH PEN AND BRUSH
      SelectObject hDC, hPen
      SelectObject hDC, hBrush
    MoveToEx Hdc,x,y,null
    LineTo Hdc,a,b
    'DeleteObject iPen
    'hPen = GetStockObject(DC_PEN)
    'SelectObject bHdc, hPen
    'SelectObject Hdc, hPen
End Sub

Sub Linex(int x,y,a,b,w, rc,gc,bc,hdc)
    SelectObject(hDc, CreatePen(PS_SOLID, w, RGB(rc,gc,bc)))
    MoveToEx Hdc,x,y,null
    LineTo Hdc,a,b
    'DeleteObject iPen
    'hPen = GetStockObject(DC_PEN)
    'SelectObject bHdc, hPen
    'SelectObject Hdc, hPen
End Sub

  '=========
  'MAIN CODE
  '=========
 
  dim cmdline as asciiz ptr,inst as sys
  &cmdline=GetCommandLine
  inst=GetModuleHandle 0
  '
  'WINDOWS
  '-------
  '
  WinMain inst,0,cmdline,SW_NORMAL
 
  endprog:


  '===========
  'END OF MAIN
  '===========

  'crea la finstra
  '------------------------------------------------------------------
  Function WinMain(sys inst,prevInst,zstring*cmdline,sys show) as sys
  '==================================================================

  WndClass wc
  MSG      wm

  sys hwnd, wwd, wht, wtx, wty, tax

  wc.style = CS_HREDRAW or CS_VREDRAW
  wc.lpfnWndProc = @WndProc
  wc.cbClsExtra =0
  wc.cbWndExtra =0   
  wc.hInstance =inst
  wc.hIcon=LoadIcon 0, IDI_APPLICATION
  wc.hCursor=LoadCursor 0,IDC_ARROW
  wc.hbrBackground = GetStockObject WHITE_BRUSH
  wc.lpszMenuName =0
  wc.lpszClassName = strptr "Demo"

  RegisterClass (&wc)
 
  Wwd = 800 : Wht = 600  'dimensioni finestra
  Tax = GetSystemMetrics SM_CXSCREEN
  Wtx = (Tax - Wwd) /2
  Tax = GetSystemMetrics SM_CYSCREEN
  Wty = (Tax - Wht) /2
 
  hwnd = CreateWindowEx 0,wc.lpszClassName,"OXYGEN BASIC",WS_OVERLAPPEDWINDOW,Wtx,Wty,Wwd,Wht,0,0,inst,0
  ShowWindow hwnd,SW_SHOW
  UpdateWindow hwnd

  '
  sys bRet
  '
  do while bRet := GetMessage (@wm, 0, 0, 0)
    if bret=0
      exit while
    end if
    if bRet = -1
      'show an error message
      exit while
    else
      TranslateMessage @wm
      DispatchMessage @wm
    end if
  end while
  End Function



  dim as rect crect 'for WndProc and TimerProc

  '-------------------------------------------------------------
  function WndProc (sys hWnd,wMsg,wParam,lparam) as sys callback
  '=============================================================

    static as sys count=0, refreshes=0, hdc, htimer
    static as String txt
    static as PaintStruct Paintst
 
    '==========
    select wMsg
    '==========
       
      '--------------
      case WM_CREATE
      '=============
        hTimer = SetTimer (hWnd, ID_Timer, 100, &TimerProc)
        GetClientRect  hWnd,&cRect

        static sys hPen  = GetStockObject(DC_PEN)
        static sys hBrush = GetStockObject(DC_BRUSH)

      '--------------
      case WM_TIMER
      '=============

      '-------------- 
      case WM_DESTROY
      '===============
        KillTimer(hWnd,ID_TIMER)
        PostQuitMessage 0
       
      '------------
      case WM_PAINT
      '============

      'TEXT
      'http://msdn.microsoft.com/en-us/library/dd144821(v=VS.85).aspx

      'DRAWING AND PAINTING
      'http://msdn.microsoft.com/en-us/library/dd162760(v=VS.85).aspx

      hDC=BeginPaint hWnd,&Paintst
      GetClientRect  hWnd,&cRect
      'style
      '0x20 DT_SINGLELINE
      '0x04 DT_VCENTER
      '0x01 DT_CENTER
      '0x25

        'scrive il testo al centro della finestra
      SetBkColor  hdc,yellow
      SetTextColor hdc,red
      txt="x y pos" str(xball) " , " str(yball) " - " str(pp)
      'DrawText hDC,"Hello World",-1,&cRect,0x25
      DrawText hDC,strptr txt,-1,&cRect,0x25

      refreshes+=1
      Ellipse hdc, xball-r, yball-r, xball+r, yball+r
      'Ellipse hdc, xball, yball, xball+20, yball+30

        if (pp>1 and lm > 0) then
          Linex(pu[pp-1,0],pu[pp-1,1],pu[pp,0],pu[pp,1],2,0,0,255,hdc)
          lm=0
        end if
        'pressed rmousek
        if ref=1 then
          SelectObject(hDc, CreatePen(PS_SOLID, 4, RGB(0, 0, 253)))
          for j=2 to pp
            MovetoEx(hdc,pu[j-1,0],pu[j-1,1],null)
            Lineto(hdc,pu[j,0],pu[j,1])
          next j
          ref=0
        end if

      EndPaint hWnd,&Paintst
      ValidateRect hwnd,&crect
       
      '-------------- 
      case WM_KEYDOWN
      '==============

      '============           
        Select wParam
      '============
          Case 37 : xball -= idx  'LEFT
          Case 39 : xball += idx  'RIGHT
          Case 38 : yball -= idy  'UP
          Case 40 : yball += idy  'DOWN
          Case 32 : Rectangle hdc, -1, -1, xmax+1, ymax+1 'SPACE
          Case 27 : SendMessage hwnd, WM_CLOSE, 0, 0      'ESCAPE

        End Select 'wParam
      '
        'InvalidateRect hwnd, &cRect, 1 'FULL SCREEN REFRESH
        InvalidateRect hwnd, &cRect, false 'FULL SCREEN REFRESH

      case WM_LBUTTONUP
        pp += 1
        pu[pp,0] = loword(lParam)
        pu[pp,1] = hiword(lParam)
        lm=1


      case WM_RBUTTONUP
        Ref=1

      '--------       
      case else
      '========
         
        function=DefWindowProc hWnd,wMsg,wParam,lParam
       
    end select

  end function ' WndProc


  '----------------------------------------------------
  sys TimerProc(sys hWnd,wMsg,nIDEvent,dwTime) callback
  '====================================================
  {
  static sys d=1


  select wMsg
 
    Case WM_TIMER
      'viene controllato l'allargamento e il restringimento del cerchio
      'InvalidateRect hwnd,&crect,1
      InvalidateRect hwnd,&crect,false
      if r=50 then d=-1
      if r=10 then d=1
      r+=d
      function = 0
 
  end select
 
 
  } ' TimerProc
 

Charles Pegge

    SelectObject(hDc, CreatePen(PS_SOLID, w, RGB(rc,gc,bc)))

If you create a pen or brush, you will need to delete it afterwards using its handle: DeleteObject hp
Therefore the handle must be captured.

    sys hp=CreatePen(PS_SOLID, w, RGB(rc,gc,bc))
    SelectObject(hDc,hp )
    ...
    DeleteObject hp


Pierre Bellisle

Charles,
You are right. There is even a little more to do, the original selected object must be restored after the job is done.

The  CreatePen() way...
sys hPen = CreatePen(PS_SOLID, 0, RGB(0, 0, 255)) 'Where %PS_SOLID = 0 
sys hOriginal = SelectObject(hDc, hPen)                       
...
'Do MovetoEx(), Lineto(), etc
...
SelectObject(hdc, hOriginal) 'Restore original object
DeleteObject(hPen) 'Delete the pen

The  GetStockObject(DC_PEN) way...
sys hPen = GetStockObject(DC_PEN) 'Where %DC_PEN = 19
sys hOriginal = SelectObject(hdc, hPen)
SetDCPenColor(hdc, RGB(0, 0, 255))     
...
'Do MovetoEx(), Lineto(), etc
...
SelectObject(hdc, hOriginal) 'Restore original object
DeleteObject(hPen) 'Not mandatory since this is a stock object
  •  

Nicola

Hi,
ok, i destroyed the created object. I put it in the sub.
(a strange thing, if I delete the sub linex it gives me a meaningless error).
You're giving me some great input.


  $ filename "t.exe"
  'uses rtl32
  'uses rtl64
  'uses MinWin
  uses corewin



  'extern lib "gdi32.dll"
  'sys Rectangle (sys hdc,X1,Y1,X2,Y2)
  'sys Ellipse   (sys hdc,X1,Y1,X2,Y2)
  'end extern


  #lookahead ' for procedures

% ID_Timer   3000
% Interval   100

% PS_SOLID       = 0
% DC_PEN         = 19
% DC_BRUSH       = 18



  '==================
  'GLOBAL DEFINITIONS
  '==================


  sys inst,hdc
  sys xmax,ymax,r,idx,idy,xball,yball


  r =15 : idx =5 : idy=5 : xball=200 : yball=100 

redim int pu[20,2] 'contiene le coordinate dei punti
int pp = 0, j, ref, lm 'pp è puntatore di pu[]


'macro RGB(r,g,b) {r+(g<<8)+(b<<16)}
macro RGB(r,g,b) {r + g*256 + b*65536}



Sub Linex(int x,y,a,b,w, rc,gc,bc,hdc)
End Sub

Sub Line(int x,y,a,b,w, rc,gc,bc,hdc)
    sys hpen = CreatePen(PS_SOLID, w, RGB(rc,gc,bc))
    sys hOriginal = SelectObject(hDc, hPen)

    MoveToEx Hdc,x,y,null
    LineTo Hdc,a,b

    SelectObject(hdc, hOriginal) 'Restore original object
    DeleteObject(hPen) 'Delete the pen
End Sub

  '=========
  'MAIN CODE
  '=========
 
  dim cmdline as asciiz ptr,inst as sys
  &cmdline=GetCommandLine
  inst=GetModuleHandle 0
  '
  'WINDOWS
  '-------
  '
  WinMain inst,0,cmdline,SW_NORMAL
 
  endprog:


  '===========
  'END OF MAIN
  '===========

  'crea la finstra
  '------------------------------------------------------------------
  Function WinMain(sys inst,prevInst,zstring*cmdline,sys show) as sys
  '==================================================================

  WndClass wc
  MSG      wm

  sys hwnd, wwd, wht, wtx, wty, tax

  wc.style = CS_HREDRAW or CS_VREDRAW
  wc.lpfnWndProc = @WndProc
  wc.cbClsExtra =0
  wc.cbWndExtra =0   
  wc.hInstance =inst
  wc.hIcon=LoadIcon 0, IDI_APPLICATION
  wc.hCursor=LoadCursor 0,IDC_ARROW
  wc.hbrBackground = GetStockObject WHITE_BRUSH
  wc.lpszMenuName =0
  wc.lpszClassName = strptr "Demo"

  RegisterClass (&wc)
 
  Wwd = 800 : Wht = 600  'dimensioni finestra
  Tax = GetSystemMetrics SM_CXSCREEN
  Wtx = (Tax - Wwd) /2
  Tax = GetSystemMetrics SM_CYSCREEN
  Wty = (Tax - Wht) /2
 
  hwnd = CreateWindowEx 0,wc.lpszClassName,"OXYGEN BASIC",WS_OVERLAPPEDWINDOW,Wtx,Wty,Wwd,Wht,0,0,inst,0
  ShowWindow hwnd,SW_SHOW
  UpdateWindow hwnd

  '
  sys bRet
  '
  do while bRet := GetMessage (@wm, 0, 0, 0)
    if bret=0
      exit while
    end if
    if bRet = -1
      'show an error message
      exit while
    else
      TranslateMessage @wm
      DispatchMessage @wm
    end if
  end while
  End Function



  dim as rect crect 'for WndProc and TimerProc

  '-------------------------------------------------------------
  function WndProc (sys hWnd,wMsg,wParam,lparam) as sys callback
  '=============================================================

    static as sys count=0, refreshes=0, hdc, htimer
    static as String txt
    static as PaintStruct Paintst
 
    '==========
    select wMsg
    '==========
       
      '--------------
      case WM_CREATE
      '=============
        hTimer = SetTimer (hWnd, ID_Timer, 100, &TimerProc)
        GetClientRect  hWnd,&cRect


      '--------------
      case WM_TIMER
      '=============

      '-------------- 
      case WM_DESTROY
      '===============
        KillTimer(hWnd,ID_TIMER)
        PostQuitMessage 0
       
      '------------
      case WM_PAINT
      '============

      'TEXT
      'http://msdn.microsoft.com/en-us/library/dd144821(v=VS.85).aspx

      'DRAWING AND PAINTING
      'http://msdn.microsoft.com/en-us/library/dd162760(v=VS.85).aspx

      hDC=BeginPaint hWnd,&Paintst
      GetClientRect  hWnd,&cRect
      'style
      '0x20 DT_SINGLELINE
      '0x04 DT_VCENTER
      '0x01 DT_CENTER
      '0x25

'scrive il testo al centro della finestra
       SetBkColor   hdc,yellow
       SetTextColor hdc,red
       txt="x y pos" str(xball) " , " str(yball) " - " str(pp)
       'DrawText hDC,"Hello World",-1,&cRect,0x25
       DrawText hDC,strptr txt,-1,&cRect,0x25

       refreshes+=1
       Ellipse hdc, xball-r, yball-r, xball+r, yball+r
       'Ellipse hdc, xball, yball, xball+20, yball+30

        'pressed Lmousek
        if (pp>1 and lm > 0) then
           Line(pu[pp-1,0],pu[pp-1,1],pu[pp,0],pu[pp,1],7,0,0,255,hdc)
           lm=0
        end if

        'pressed rmousek
        if ref=1 then
          for j=2 to pp
             Line(pu[j-1,0],pu[j-1,1],pu[j,0],pu[j,1],2,0,0,255,hdc)
          next j
          ref=0
         end if

       EndPaint hWnd,&Paintst
       ValidateRect hwnd,&crect
       
      '--------------   
      case WM_KEYDOWN
      '==============

      '============           
        Select wParam
      '============
          Case 37 : xball -= idx   'LEFT
          Case 39 : xball += idx   'RIGHT
          Case 38 : yball -= idy   'UP
       Case 40 : yball += idy   'DOWN
       Case 32 : Rectangle hdc, -1, -1, xmax+1, ymax+1 'SPACE
       Case 27 : SendMessage hwnd, WM_CLOSE, 0, 0      'ESCAPE

         End Select 'wParam
       '
         'InvalidateRect hwnd, &cRect, 1 'FULL SCREEN REFRESH
         InvalidateRect hwnd, &cRect, false 'FULL SCREEN REFRESH

      case WM_LBUTTONUP
        pp += 1
        pu[pp,0] = loword(lParam)
        pu[pp,1] = hiword(lParam)
        lm=1


      case WM_RBUTTONUP
        Ref=1

      '--------       
      case else
      '========
         
        function=DefWindowProc hWnd,wMsg,wParam,lParam
       
    end select

  end function ' WndProc


  '----------------------------------------------------
  sys TimerProc(sys hWnd,wMsg,nIDEvent,dwTime) callback
  '====================================================
  {
   static sys d=1


   select wMsg
 
     Case WM_TIMER
      'viene controllato l'allargamento e il restringimento del cerchio
      'InvalidateRect hwnd,&crect,1
      InvalidateRect hwnd,&crect,false
      if r=50 then d=-1
      if r=10 then d=1
      r+=d
      function = 0
 
   end select
 
 
  } ' TimerProc