gdi test

Windows specific questions.
Post Reply
bluatigro
Posts: 660
Joined: Apr 25, 2012 10:35
Location: netherlands

gdi test

Post by bluatigro »

i m trying to use every graphics comand of win32
i know there are more [ need help whit that ]

error :
my triangle goes wrong
a line gets not drawn

i want to use this so i can praktice win32 c++ in FB

Code: Select all



#include once "windows.bi"
#include "color.bas"

''todo : define gamw objects

declare function        WinMain     ( byval hInstance as HINSTANCE, _
                                      byval hPrevInstance as HINSTANCE, _
                                      byval szCmdLine as string, _
                                      byval iCmdShow as integer ) as integer
                                  
                                  
end WinMain( GetModuleHandle( null ), null, Command( ), SW_NORMAL )

dim shared as integer mousex , mousey , leftbutton , rightbutton _
, key( 256 )

#define FRAME_TIMER 1044

function WndProc ( byval hWnd as HWND, _
                   byval wMsg as UINT, _
                   byval wParam as WPARAM, _
                   byval lParam as LPARAM ) as LRESULT
    
''  function = 0
    
  select case( wMsg )
    case WM_CREATE            
      SetTimer( hwnd , FRAME_TIMER , 40 , NULL ) 
    case WM_TIMER
      select case wParam
        case FRAME_TIMER
          ''todo : update game objects
          InvalidateRect( hwnd , NULL , true ) 
        case else
      end select
    case WM_PAINT
      dim rct as RECT
      dim pnt as PAINTSTRUCT
      dim hdc as HDC
          
      hdc = BeginPaint( hWnd, @pnt )
      GetClientRect( hWnd, @rct )
      
      ''todo : draw game objects
      
      dim as HPEN newpen = CreatePen( PS_SOLID , 7 , red ) 
      dim as HBRUSH newbrush = CreateSolidBrush( yellow ) 
      dim as HPEN oldpen = SelectObject( hdc , newpen ) 
      dim as HBRUSH oldbrush = SelectObject( hdc , newbrush ) 
      dim as POINT p(3) = {300,100,400,100,400,200}

      Rectangle( hdc , 100 , 100 , 200 , 200 ) 
      Ellipse( hdc , 200 , 100 , 300 , 200 )
      Polygon( hdc , @p(0) , 3 )

      SelectObject( hdc, oldpen ) 
      SelectObject( hdc, oldbrush ) 
      DeleteObject( newpen ) 
      DeleteObject( newbrush ) 

            
      DrawText( hDC , _
                "Hello, World!" , _
                -1 , _
                @rct , _
                DT_SINGLELINE or DT_CENTER or DT_VCENTER )
            
      EndPaint( hWnd, @pnt )
    case WM_KEYDOWN
			if( lobyte( wParam ) = 27 ) then
				PostMessage( hWnd, WM_CLOSE, 0, 0 )
      else
        key( wParam ) = 1
			end if
    case WM_KEYUP
      key( wParam ) = 0
    case WM_MOUSEMOVE
      ''mousex =    
      ''mousey =    
    case WM_LBUTTONDOWN
      leftbutton = 1
    case WM_LBUTTONUP
      leftbutton = 0
    case WM_RBUTTONDOWN
      rightbutton = 1
    case WM_RBUTTONUP
      rightbutton = 0
    case WM_DESTROY
      PostQuitMessage( 0 )
    case else
      return DefWindowProc( hWnd, wMsg, wParam, lParam )    
  end select  
  return 0
end function

'':::::
function WinMain ( byval hInstance as HINSTANCE, _
                   byval hPrevInstance as HINSTANCE, _
                   byval szCmdLine as string, _
                   byval iCmdShow as integer ) as integer    
     
    dim wMsg as MSG
    dim wcls as WNDCLASS     
    dim hWnd as HWND
     
    function = 0
     
    with wcls
    	.style         = CS_HREDRAW or CS_VREDRAW
    	.lpfnWndProc   = @WndProc
    	.cbClsExtra    = 0
    	.cbWndExtra    = 0
    	.hInstance     = hInstance
    	.hIcon         = LoadIcon( NULL, IDI_APPLICATION )
    	.hCursor       = LoadCursor( NULL, IDC_ARROW )
    	.hbrBackground = GetStockObject( BLACK_BRUSH )
    	.lpszMenuName  = NULL
    	.lpszClassName = @"HelloWin"
    end with
          
    if( RegisterClass( @wcls ) = FALSE ) then
       MessageBox( null, "Failed to register wcls", "Error", MB_ICONERROR )
       exit function
    end if
    
    hWnd = CreateWindowEx( 0, _
    			 		   @"HelloWin", _
                           "The Hello Program", _
                           WS_OVERLAPPEDWINDOW , _
                           CW_USEDEFAULT, _
                           CW_USEDEFAULT, _
                           CW_USEDEFAULT, _
                           CW_USEDEFAULT, _
                           NULL, _
                           NULL, _
                           hInstance, _
                           NULL )
                          

    ShowWindow( hWnd, iCmdShow )
    UpdateWindow( hWnd )
     
    while( GetMessage( @wMsg, NULL, 0, 0 ) <> FALSE )    
        TranslateMessage( @wMsg )
        DispatchMessage( @wMsg )
    wend
    
    function = wMsg.wParam

end function

Code: Select all

''bluatigro 13 feb 2015
''color.bas

''some colors consts + functions

#ifndef COLOR_H
#define COLOR_H

#include "math.bas"

''primary colors
const as ulong black      = &h000000
const as ulong blue       = &hff0000
const as ulong green      = &h00ff00
const as ulong cyan       = &hffff00
const as ulong red        = &h0000ff
const as ulong magenta    = &hff00ff
const as ulong yellow     = &h00ffff
const as ulong white      = &hffffff
''mix colors
const as ulong orange     = &h007fff
const as ulong gray       = &h7f7f7f
const as ulong pink       = &h7f7fff
const as ulong purple     = &h7f007f
const as ulong darkRed    = &h00007f
const as ulong darkYellow = &h007f7f
const as ulong darkGreen  = &h007f00
const as ulong darkBlue   = &h7f0000

function mix( kla as ulong , f as single , klb as ulong ) as ulong
  dim as ulong ra , ga , ba , rb , gb , bb , r , g , b 
  ra = ( kla shr 16 ) and 255
  ga = ( kla shr 8 ) and 255
  ba = kla and 255
  rb = ( klb shr 16 ) and 255
  gb = ( klb shr 8 ) and 255
  bb = klb and 255
  r = ra + ( rb - ra ) * f
  g = ga + ( gb - ga ) * f
  b = ba + ( bb - ba ) * f
  return rgb( r , g , b )
end function

function rainbow( x as single ) as ulong
  dim as ulong r , g , b
  r = sin( rad( x ) ) * 127 + 128
  g = sin( rad( x - 120 ) ) * 127 + 128
  b = sin( rad( x + 120 ) ) * 127 + 128
  return rgb( r , g , b )
end function 

function rndcolor() as ulong
  return rgb( rnd * 255 , rnd * 255 , rnd * 255 )
end function

#endif

Code: Select all

''bluatigro 30-dec-2013
''game + animation lib : 
''some math const[s] + function[s]

#ifndef MATH_H
#define MATH_H

const as Single pi    = CSng( atn( 1.0 ) * 4.0 )
const as Single golden_ratio = CSng( ( sqr(5.0) - 1.0 ) / 2.0 )

function rad( x as single ) as single
''help function degrees to radians 
  return x * pi / 180
end function

function degrees( x as single ) as single
  return x * 180 / pi
end function

function range( l as single , h as single ) as single
  return rnd * ( h - l ) + l
end function

#endif
bluatigro
Posts: 660
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: gdi test

Post by bluatigro »

update :
more gdi graphics

Code: Select all



#include once "windows.bi"
#include "color.bas"

''todo : define gamw objects

declare function        WinMain     ( byval hInstance as HINSTANCE, _
                                      byval hPrevInstance as HINSTANCE, _
                                      byval szCmdLine as string, _
                                      byval iCmdShow as integer ) as integer
                                  
                                  
end WinMain( GetModuleHandle( null ), null, Command( ), SW_NORMAL )

dim shared as integer mousex , mousey , leftbutton , rightbutton _
, key( 256 )

#define FRAME_TIMER 1044

function WndProc ( byval hWnd as HWND, _
                   byval wMsg as UINT, _
                   byval wParam as WPARAM, _
                   byval lParam as LPARAM ) as LRESULT
    
''  function = 0
    
  select case( wMsg )
    case WM_CREATE            
      SetTimer( hwnd , FRAME_TIMER , 40 , NULL ) 
    case WM_TIMER
      select case wParam
        case FRAME_TIMER
          ''todo : update game objects
          InvalidateRect( hwnd , NULL , true ) 
        case else
      end select
    case WM_PAINT
      dim rct as RECT
      dim pnt as PAINTSTRUCT
      dim hdc as HDC
          
      hdc = BeginPaint( hWnd, @pnt )
      GetClientRect( hWnd, @rct )
      
      ''todo : draw game objects
      
      dim as HPEN newpen = CreatePen( PS_SOLID , 7 , red ) 
      dim as HBRUSH newbrush = CreateSolidBrush( yellow ) 
      dim as HPEN oldpen = SelectObject( hdc , newpen ) 
      dim as HBRUSH oldbrush = SelectObject( hdc , newbrush ) 
''      dim as POINT p(3) = {300,100,400,100,400,200}

      Rectangle( hdc , 100 , 100 , 200 , 200 ) 
      Ellipse( hdc , 200 , 100 , 300 , 200 )
''      Polygon( hdc , @p(0) , 3 )
''      MoveTo( hdc , 400 , 100 , NULL )
''      LineTo( hdc , 500 , 200 )
      Arc( hdc , 600 , 100 , 700 , 200 , 700 , 100 , 700 , 200 )
      Pie( hdc , 600 , 300 , 700 , 400 , 700 , 300 , 700 , 400 )

      SelectObject( hdc , oldpen ) 
      SelectObject( hdc , oldbrush ) 
      DeleteObject( newpen ) 
      DeleteObject( newbrush ) 

            
      DrawText( hdc , _
                "Hello, World!" , _
                -1 , _
                @rct , _
                DT_SINGLELINE or DT_CENTER or DT_VCENTER )
            
      EndPaint( hWnd, @pnt )
    case WM_KEYDOWN
			if( lobyte( wParam ) = 27 ) then
				PostMessage( hWnd, WM_CLOSE, 0, 0 )
      else
        key( wParam ) = 1
			end if
    case WM_KEYUP
      key( wParam ) = 0
    case WM_MOUSEMOVE
      mousex = loword( lParam )    
      mousey = hiword( lParam )   
    case WM_LBUTTONDOWN
      leftbutton = 1
    case WM_LBUTTONUP
      leftbutton = 0
    case WM_RBUTTONDOWN
      rightbutton = 1
    case WM_RBUTTONUP
      rightbutton = 0
    case WM_DESTROY
      PostQuitMessage( 0 )
    case else
      return DefWindowProc( hWnd, wMsg, wParam, lParam )    
  end select  
  return 0
end function

'':::::
function WinMain ( byval hInstance as HINSTANCE, _
                   byval hPrevInstance as HINSTANCE, _
                   byval szCmdLine as string, _
                   byval iCmdShow as integer ) as integer    
     
    dim wMsg as MSG
    dim wcls as WNDCLASS     
    dim hWnd as HWND
     
    function = 0
     
    with wcls
    	.style         = CS_HREDRAW or CS_VREDRAW
    	.lpfnWndProc   = @WndProc
    	.cbClsExtra    = 0
    	.cbWndExtra    = 0
    	.hInstance     = hInstance
    	.hIcon         = LoadIcon( NULL, IDI_APPLICATION )
    	.hCursor       = LoadCursor( NULL, IDC_ARROW )
    	.hbrBackground = GetStockObject( BLACK_BRUSH )
    	.lpszMenuName  = NULL
    	.lpszClassName = @"HelloWin"
    end with
          
    if( RegisterClass( @wcls ) = FALSE ) then
       MessageBox( null, "Failed to register wcls", "Error", MB_ICONERROR )
       exit function
    end if
    
    hWnd = CreateWindowEx( 0, _
    			 		   @"HelloWin", _
                           "The Hello Program", _
                           WS_OVERLAPPEDWINDOW , _
                           CW_USEDEFAULT, _
                           CW_USEDEFAULT, _
                           CW_USEDEFAULT, _
                           CW_USEDEFAULT, _
                           NULL, _
                           NULL, _
                           hInstance, _
                           NULL )
                          

    ShowWindow( hWnd, iCmdShow )
    UpdateWindow( hWnd )
     
    while( GetMessage( @wMsg, NULL, 0, 0 ) <> FALSE )    
        TranslateMessage( @wMsg )
        DispatchMessage( @wMsg )
    wend
    
    function = wMsg.wParam

end function
bluatigro
Posts: 660
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: gdi test

Post by bluatigro »

update :
i think i got them al now

or dit i forget one or more

Code: Select all

''bluatigro 3 jan 2017
''gdi test

#include once "windows.bi"
#include "color.bas"

''todo : define game objects

declare function WinMain( byval hInstance as HINSTANCE, _
                          byval hPrevInstance as HINSTANCE, _
                          byval szCmdLine as string, _
                          byval iCmdShow as integer ) as integer
                                  
                                  
end WinMain( GetModuleHandle( null ), null, Command( ), SW_NORMAL )

dim shared as integer mousex , mousey , leftbutton , rightbutton _
, key( 256 )

#define FRAME_TIMER 1044

function WndProc ( byval hWnd as HWND, _
                   byval wMsg as UINT, _
                   byval wParam as WPARAM, _
                   byval lParam as LPARAM ) as LRESULT
    
  select case( wMsg )
    case WM_CREATE            
      SetTimer( hwnd , FRAME_TIMER , 40 , NULL ) 
    case WM_TIMER
      select case wParam
        case FRAME_TIMER
          ''todo : update game objects
          InvalidateRect( hwnd , NULL , true ) 
        case else
      end select
    case WM_PAINT
      dim rct as RECT
      dim pnt as PAINTSTRUCT
      dim hdc as HDC
          
      hdc = BeginPaint( hWnd, @pnt )
      GetClientRect( hWnd, @rct )
      
      ''todo : draw game objects
      
      ''ps_solid ps_dash ps_dot ps_dashdot ps_dashdotdot
      dim as HPEN newpen = CreatePen( PS_SOLID , 7 , red ) 
      ''hs_bdiagonal hs_cross hs_diagcross hs_fdiagonal 
      ''hs_horizontal hs_vertical
      ''dim as HBRUSH newbrush = CreateHatchBrush( HS_DIAGCROSS , black ) 
      dim as HBRUSH newbrush = CreateSolidBrush( yellow )
      dim as HPEN oldpen = SelectObject( hdc , newpen ) 
      dim as HBRUSH oldbrush = SelectObject( hdc , newbrush ) 
      dim as POINT p(3) 
      p(0).x = 300
      p(0).y = 100
      p(1).x = 400
      p(1).y = 100
      p(2).x = 400
      p(2).y = 200

      Rectangle( hdc , 100 , 100 , 200 , 200 ) 
      Ellipse( hdc , 200 , 100 , 300 , 200 )
      Polygon( hdc , @p(0) , 3 )
      MoveToEx( hdc , 400 , 100 , NULL )
      LineTo( hdc , 500 , 200 )
      Arc( hdc , 600 , 100 , 700 , 200 , 700 , 100 , 700 , 200 )
      Pie( hdc , 600 , 300 , 700 , 400 , 700 , 300 , 700 , 400 )
      RoundRect( hdc , 100 , 300 , 200 , 400 , 40 , 40 )
      MoveToEx( hdc , 250 , 350 , NULL )
      AngleArc( hdc , 250 , 350 , 50 , 300 , 120 )
      Chord( hdc , 300 , 300 , 400 , 400 , 300 , 300 , 400 , 400 )
      p(0).x = 400
      p(0).y = 300
      p(1).x = 400
      p(1).y = 400
      p(2).x = 500
      p(2).y = 300
      p(3).x = 500
      p(3).y = 400
      PolyBezier( hdc , @p(0) , 4 )

      SelectObject( hdc , oldpen ) 
      SelectObject( hdc , oldbrush ) 
      DeleteObject( newpen ) 
      DeleteObject( newbrush ) 

            
      DrawText( hdc , _
                "Hello, World!" , _
                -1 , _
                @rct , _
                DT_SINGLELINE or DT_CENTER or DT_VCENTER )
            
      EndPaint( hWnd, @pnt )
    case WM_KEYDOWN
			if( lobyte( wParam ) = 27 ) then
				PostMessage( hWnd, WM_CLOSE, 0, 0 )
      else
        key( wParam ) = 1
			end if
    case WM_KEYUP
      key( wParam ) = 0
    case WM_MOUSEMOVE
      mousex = loword( lParam )    
      mousey = hiword( lParam )   
    case WM_LBUTTONDOWN
      leftbutton = 1
    case WM_LBUTTONUP
      leftbutton = 0
    case WM_RBUTTONDOWN
      rightbutton = 1
    case WM_RBUTTONUP
      rightbutton = 0
    case WM_DESTROY
      PostQuitMessage( 0 )
    case else
      return DefWindowProc( hWnd, wMsg, wParam, lParam )    
  end select  
  return 0
end function

'':::::
function WinMain ( byval hInstance as HINSTANCE, _
                   byval hPrevInstance as HINSTANCE, _
                   byval szCmdLine as string, _
                   byval iCmdShow as integer ) as integer    
     
    dim wMsg as MSG
    dim wcls as WNDCLASS     
    dim hWnd as HWND
     
    function = 0
     
    with wcls
    	.style         = CS_HREDRAW or CS_VREDRAW
    	.lpfnWndProc   = @WndProc
    	.cbClsExtra    = 0
    	.cbWndExtra    = 0
    	.hInstance     = hInstance
    	.hIcon         = LoadIcon( NULL, IDI_APPLICATION )
    	.hCursor       = LoadCursor( NULL, IDC_ARROW )
    	.hbrBackground = GetStockObject( BLACK_BRUSH )
    	.lpszMenuName  = NULL
    	.lpszClassName = @"HelloWin"
    end with
          
    if( RegisterClass( @wcls ) = FALSE ) then
       MessageBox( null, "Failed to register wcls", "Error", MB_ICONERROR )
       exit function
    end if
    
    hWnd = CreateWindowEx( 0, _
    			 		   @"HelloWin", _
                           "The Hello Program", _
                           WS_OVERLAPPEDWINDOW , _
                           CW_USEDEFAULT, _
                           CW_USEDEFAULT, _
                           CW_USEDEFAULT, _
                           CW_USEDEFAULT, _
                           NULL, _
                           NULL, _
                           hInstance, _
                           NULL )
                          

    ShowWindow( hWnd, iCmdShow )
    UpdateWindow( hWnd )
     
    while( GetMessage( @wMsg, NULL, 0, 0 ) <> FALSE )    
        TranslateMessage( @wMsg )
        DispatchMessage( @wMsg )
    wend
    
    function = wMsg.wParam

end function
Pierre Bellisle
Posts: 56
Joined: Dec 11, 2016 17:22

Re: gdi test

Post by Pierre Bellisle »

Hi,
Those might be of interest ...
-Chord, -Ellipse,-Pie, -Polygon,
FillRect, FrameRect,
-Rectangle, -RoundRec
InvertRect, PolyPolygon
Filled Shape Functions

-AngleArc, -Arc, -LineTo, -MoveToEx, -PolyBezier
ArcTo, GetArcDirection, LineDDA, LineDDAProc
PolyBezierTo, PolyDraw, Polyline, PolylineTo, PolyPolyline, SetArcDirection
Line and Curve Functions

Windows GDI

Pierre
Post Reply