GFX_NULL demo

Windows specific questions.
MichaelW
Posts: 3500
Joined: May 16, 2006 22:34
Location: USA

GFX_NULL demo

Postby MichaelW » Jul 18, 2007 8:35

This is in response to several questions asked recently. It seems to work without problems, but I did not thoroughly test it. I suspected that the repeated calls to ScreenRes might result in a memory leak, but there appears to be no problem with this. I can’t really see any good use for it, but perhaps someone with a little more imagination can.

Code: Select all

'========================================================================
'' GFX_NULL demo, with resizable window, full-programmed
'' menu, and keyboard accelerators.
'========================================================================
#include "fbgfx.bi"
#include "windows.bi"
'========================================================================

dim shared as BITMAPV4HEADER bmi
dim shared as RECT rcw
dim shared as HACCEL hAccel
dim shared as integer _color = &hffffff

'' This corrects for a problem with the ACCEL structure, at least as
'' it was defined until recently, without the field = 2.

type _ACCEL field = 2
    fVirt as BYTE
    key as WORD
    cmd as WORD
end type

'========================================================================

function InitMenu() as HMENU

  dim as HMENU hMenu, hFileMenu
  dim as _ACCEL accl( 0 to 2)

  hMenu = CreateMenu
  hFileMenu = CreateMenu

  AppendMenu( hMenu, MF_POPUP, cast(UINT_PTR,hFileMenu), "&Select" )
  AppendMenu( hFileMenu, MF_STRING, 1000, !"&Red\tCtrl+R" )
  AppendMenu( hFileMenu, MF_SEPARATOR, 0, 0 )
  AppendMenu( hFileMenu, MF_STRING, 1001, !"&Green\tCtrl+G" )
  AppendMenu( hFileMenu, MF_SEPARATOR, 0, 0 )
  AppendMenu( hFileMenu, MF_STRING, 1002, !"&Blue\tCtrl+B" )

  accl(0).fVirt = FCONTROL or FVIRTKEY
  accl(0).key = asc("R")
  accl(0).cmd = 1000
  accl(1).fVirt = FCONTROL or FVIRTKEY
  accl(1).key = asc("G")
  accl(1).cmd = 1001
  accl(2).fVirt = FCONTROL or FVIRTKEY
  accl(2).key = asc("B")
  accl(2).cmd = 1002

  hAccel = CreateAcceleratorTable( cast(LPACCEL,@accl(0)), 3 )

  return hMenu

end function

'========================================================================

function WindowProc( byval hWnd as HWND,_
                     byval uMsg as uint,_
                     byval wParam as WPARAM,_
                     byval lParam as LPARAM ) as LRESULT

  select case uMsg

    case WM_CREATE

      SetMenu( hWnd, InitMenu() )

      GetClientRect( hWnd, @rcw )

      with bmi
        .bV4Size = len(BITMAPV4HEADER)
        .bv4width = rcw.right+1
        .bv4height = -(rcw.bottom+1)
        .bv4planes = 1
        .bv4bitcount = 32
        .bv4v4compression = 0
        .bv4sizeimage = (rcw.right+1) * (rcw.bottom+1) * 4
        .bV4RedMask = &h0f00
        .bV4GreenMask = &h00f0
        .bV4BlueMask = &h000f
        .bV4AlphaMask = &hf000
      end with

      ScreenRes rcw.right+1, rcw.bottom+1, 32, 1, FB.GFX_NULL

    case WM_PAINT

      dim as PAINTSTRUCT ps
      dim as RECT rc

      GetClientRect( hWnd, @rc )
      BeginPaint( hWnd, @ps )

      with rc

        StretchDIBits( ps.hdc, _
                       0, _
                       0, _
                       .right - .left + 1, _
                       .bottom - .top + 1, _
                       0, _
                       0, _
                       .right - .left + 1, _
                       .bottom - .top + 1, _
                       screenptr, _
                       cptr( BITMAPINFO ptr, @bmi), _
                       DIB_RGB_COLORS, SRCCOPY )
      end with

      EndPaint( hWnd, @ps )

    case WM_SIZE

      '' Update the necessary variables and reinitialize the
      '' graphics mode so the GFX code can generate everything
      '' at the new size.

      with rcw
        .right = loword(lParam)-1
        .bottom = hiword(lParam)-1
      end with

      with bmi
        .bv4width = loword(lParam)
        .bv4height = -(hiword(lParam))
        .bv4sizeimage = loword(lParam) * hiword(lParam) * 4
      end with

      ScreenRes rcw.right+1, rcw.bottom+1, 32, 1, FB.GFX_NULL

    case WM_ERASEBKGND

      '' This corrects a severe flicker problem by preventing the
      '' default window procedure from processing WM_ERASEBKGND.

    case WM_COMMAND

      select case loword(wParam)
        case 1000
          _color = &hff0000
        case 1001
          _color = &hff00
        case 1002
          _color = &hff
      end select

    case WM_CLOSE

      DestroyWindow( hWnd )

    case WM_DESTROY

      DestroyAcceleratorTable( hAccel )
      PostQuitMessage( null )

    case else

      return DefWindowProc( hWnd, uMsg, wParam, lParam )

    end select

    return 0

end function

'========================================================================

function WinMain ( byval hInstance as HINSTANCE,_
                   byval hPrevInstance as HINSTANCE,_
                   byval lpCmdLine as LPSTR,_
                   byval nCmdShow as integer ) as integer

  dim hWnd as HWND
  dim wMsg as MSG
  dim as integer wx, wy, nWidth, nHeight
  dim wcx as WNDCLASSEX
  dim className as string = "test_class"

  with wcx
    .cbSize = sizeof( WNDCLASSEX )
    .style = CS_HREDRAW or CS_VREDRAW or CS_BYTEALIGNWINDOW
    .lpfnWndProc = cast( WNDPROC, @WindowProc )
    .cbClsExtra = null
    .cbWndExtra = null
    .hInstance = hInstance
    .hbrBackground = cast( HBRUSH,COLOR_WINDOW + 1 )
    .lpszMenuName = null
    .lpszClassName = strptr( className )
    .hIcon = LoadIcon( null, IDI_APPLICATION )
    .hCursor = LoadCursor ( null, IDC_ARROW )
    .hIconSm = 0
  end with

  RegisterClassEx( @wcx )

  nWidth = 400
  nHeight = 300
  wx = (GetSystemMetrics( SM_CXSCREEN ) / 2) - nWidth / 2
  wy = (GetSystemMetrics( SM_CYSCREEN ) / 2) - nHeight / 2

  hWnd = CreateWindowEx( 0,_
                         strptr( className ),_
                         "Test",_
                         WS_OVERLAPPEDWINDOW,_
                         wx, wy, nWidth, nHeight,_
                         null, null,_
                         hInstance, null )

  ShowWindow( hWnd, nCmdShow )
  UpdateWindow( hWnd )

  do
    if PeekMessage( @wMsg, null, 0, 0, PM_REMOVE ) then

      if wMsg.message = WM_QUIT then exit do
      if TranslateAccelerator( hWnd, hAccel, @wMsg ) = 0 then
        TranslateMessage( @wMsg )
        DispatchMessage( @wMsg )
      end if

    else

      '' This code runs whenever there is no message to process.

      line (rcw.left+1,rcw.top)-(rcw.right-1,rcw.bottom-1), _color
      line (rcw.right-1,rcw.top)-(rcw.left+1,rcw.bottom-1), _color
      RedrawWindow( hwnd, 0, 0, RDW_INVALIDATE )

    end if
  loop

  return wMsg.wParam

end function

'========================================================================
end WinMain( GetModuleHandle( null ), null, command$, SW_NORMAL )
'========================================================================
Last edited by MichaelW on Jul 18, 2007 23:02, edited 1 time in total.
1000101
Posts: 2556
Joined: Jun 13, 2005 23:14
Location: SK, Canada

Postby 1000101 » Jul 18, 2007 11:38

Neat
D.J.Peters
Posts: 7191
Joined: May 28, 2005 3:28

Postby D.J.Peters » Jul 18, 2007 15:52

nice and simple

if you used field=2 you can define the first item as WORD too
and the target for blitting is 0,0 why 0,-1 ?

joshy
Antoni
Posts: 1393
Joined: May 27, 2005 15:40
Location: Barcelona, Spain

Postby Antoni » Jul 18, 2007 19:26

I wrote this one for the wiki some time ago. I just adapted it to FB 0.17
http://www.freebasic.net/wiki/wikka.php ... cPgGfxNull
MichaelW
Posts: 3500
Joined: May 16, 2006 22:34
Location: USA

Postby MichaelW » Jul 18, 2007 23:01

D.J.Peters wrote:if you used field=2 you can define the first item as WORD too
and the target for blitting is 0,0 why 0,-1 ?

The field = 2 was to ensure that the structure members would be aligned as the Microsoft compilers would align them, which is what the API expects. I can see no reason to change the fVirt member to a WORD.

The -1 corrected for a problem I encountered using 0,0, where random pixels in the top row were white, with the number of white pixels increasing as the speed of resizing increased. Over the several hours I spent trying to find the cause of the problem it never occurred to me that it could be the system I was using. I have now tested on my #2 system and 0 works just as it should, so I have changed the code back to 0,0.
MichaelW
Posts: 3500
Joined: May 16, 2006 22:34
Location: USA

Postby MichaelW » Jul 18, 2007 23:22

Antoni wrote:I wrote this one for the wiki some time ago

Your code saved me from having to spend hours working out the basic concepts. I got it from the FB Manual, and didn't recall who created it.

Return to “Windows”

Who is online

Users browsing this forum: No registered users and 2 guests