Windows graphics tutorial

[Josep Roca]

When you call CreateDIBSection, pMainDIB will receive a pointer to the location of the DIB bit values. Therefore, allocating memory to it with Allocate((cdXSize)*(cdYSize)) before calling CreateDIBSection is useless, and as CreateDIBSection will change the value of pMainDIB, when you call Deallocate pMainDIB you're trying to deallocate a memory that does not belong to you, not the memory that you have previously allocated, creating a memory leak.

CreateDIBSection function: https://docs.microsoft.com/en-us/window ... dibsection

ppvBits
A pointer to a variable that receives a pointer to the location of the DIB bit values.

...and you continue using a goto instead of sending a WM_CLOSE message.

Well, it's your business.

[paul doe]

Here:

Code: Select all

/' ----------------------------------------------------------------------------
-       Plantilla Programación Gráfica - SWGPTG -  FreeBasic                  -
-----                                                                     -----
-       AUTOR   : Alfonso Víctor Caballero Hurtado                            -
-----                                                                     -----
-       VERSION : 1.0                                                         -
-----                                                                     -----
-      (c) 2020. http://www.abreojosensamblador.epizy.com                     -
-                Small Windows Graphics Programming Tutorial With GDI         -
---------------------------------------------------------------------------- '/

#include "windows.bi"

#define cdXPos          CW_USEDEFAULT
#define cdYPos          CW_USEDEFAULT
#define cdXSize         640 '//cdYSize*1.6
#define cdYSize         400
#define cdColFondo      0
#define MAIN_ICON       100   ' //  IDI_APPLICATION
#define cdVCursor       IDC_ARROW
#define cdVBarTipo      0
#define cdVBtnTipo      WS_OVERLAPPEDWINDOW
#define cdIdTimer       1
'#define DIB_RGB_COLORS  0

' Prototipos de funciones
Declare Function WndProc (As HWND,As UINT,As WPARAM, As LPARAM) As LRESULT

'// Variables globales
Dim Shared As Ulong Ptr             pMainDIB
Dim Shared As Integer                vdxClient, vdyClient
Dim Shared As BITMAPINFOHEADER  bi = Type(Sizeof(BITMAPINFOHEADER),cdXSize,-cdYSize,1,32,0,0,0,0,0,0)
Dim Shared As Long vdMotion

Sub PintaObjeto ()
  Dim As Long x, y, k, cx, cy
  For y = 1 To cdYSize
      cy = y + vdMotion
      For x = 1 To cdXSize
          cx = x - vdMotion
          cx = (cx xor cy) and 255
          cx = (cx or (cx SHL 8)) or 4194304
          *(pMainDIB + k) = cx
          k+=1
      Next
  Next
  vdMotion += 1
End Sub

Sub Inicio ()
End Sub

Function WndProc(hWnd As HWND, message As UINT, wParam As wPARAM,lParam As LPARAM) As LRESULT
    Static As   HDC               bufDIBDC
    Static As  HBITMAP           hMainDIB
    Dim As      HDC               hdc
    Dim As      PAINTSTRUCT       ps
    Static As  HGDIOBJ           hOldDIB=0, hGDITmp
    Dim As     Integer               bResult
   
    Select Case message
    Case WM_CHAR
        If (wParam = VK_ESCAPE) Then
          SendMessage hWnd, WM_CLOSE, 0, 0
        End If
        Return 0
       
    Case WM_CREATE:
        hdc = GetDC(hWnd)
        
        '' Creates a dib buffer for PintaObjeto. pMainDIB is a pointer to it
        bufDIBDC = CreateCompatibleDC (hdc)
        hMainDIB = CreateDIBSection(hdc,Cast(Any Ptr, @bi), DIB_RGB_COLORS, @pMainDIB, NULL, 0)
        hOldDIB  = SelectObject (bufDIBDC, hMainDIB)
       
        '' Free device context
        ReleaseDC (hWnd, hdc)
       
        Inicio ()
        SetTimer (hWnd, cdIdTimer, 20, NULL)
        Return 0
   
    Case WM_TIMER :
        InvalidateRect (hWnd, NULL, FALSE)
        Return 0

        Case WM_SIZE :
        vdxClient = lParam And &hFFFF
        vdyClient = lParam Shr &h10
        Return 0

    Case WM_PAINT :
        hdc = BeginPaint(hWnd, @ps)
        PintaObjeto ()
        bResult = StretchBlt (hdc, 0, 0, vdxClient, vdyClient, bufDIBDC, 0, 0, cdXSize, cdYSize, SRCCOPY)
        EndPaint(hWnd, @ps)
        Return 0

    Case WM_DESTROY
        KillTimer (hWnd, cdIdTimer)
        hGDITmp = SelectObject (bufDIBDC, hOldDIB)
        bResult = DeleteDC (bufDIBDC)
        bResult = DeleteObject (hMainDIB)
        PostQuitMessage (0)
        Return 0
    End Select

    Return DefWindowProc (hWnd, message, wParam, lParam)
End Function

Function  WinMain ( hInstance As HINSTANCE,  hPrevInstance As HINSTANCE, _
    szCmdLine As pSTR, iCmdShow As Integer) As Integer
    Dim As  RECT   WRect
    Static As String szAppName:szAppName = "SWGPTG"
    Dim As HWND         hWnd
    Dim As MSG          msg
    Dim As WNDCLASS     wndclass
    wndclass.style         = CS_HREDRAW Or CS_VREDRAW
    wndclass.lpfnWndProc   =  @WndProc
    wndclass.cbClsExtra    = 0
    wndclass.cbWndExtra    = 0
    wndclass.hbrBackground = cdColFondo
    wndclass.lpszMenuName  = NULL
    wndclass.lpszClassName = Strptr(szAppname)
    wndclass.hInstance     = GetModuleHandle (NULL)
    wndclass.hIcon         = LoadIcon(hInstance, MAKEINTRESOURCE(MAIN_ICON))
    wndclass.hCursor       = LoadCursor (NULL, IDC_ARROW)
   
    If RegisterClass (@wndclass) =0 Then
        MessageBox (NULL, "This program requires Windows NT!", _
        "Error", MB_ICONERROR)
        Return 0
    End If
   
   
    SetRect (@WRect, 0, 0, cdXSize, cdYSize)
    AdjustWindowRectEx (@WRect, cdVBtnTipo, 0, cdVBarTipo)
    WRect.bottom -= WRect.top
    WRect.right  -= WRect.left
    WRect.left    = (GetSystemMetrics (SM_CXSCREEN) - WRect.right)/2
    WRect.top     = (GetSystemMetrics (SM_CYSCREEN) - WRect.bottom) / 3
   
    hWnd = CreateWindowex(0,szAppname ,"Floor with GetMessage - (c) abreojosensamblador.net", _
    cdVBtnTipo , _
    WRect.left,WRect.top,WRect.right,WRect.bottom, _
    NULL, NULL, hInstance, NULL)
   
    ShowWindow (hWnd, iCmdShow)
    UpdateWindow (hWnd)
   
    While (GetMessage (@msg, NULL, 0, 0))
        TranslateMessage (@msg)
        DispatchMessage (@msg)
    Wend
   
    Return msg.wParam
End Function

winmain(GetModuleHandle( null ), null, Command( ), SW_NORMAL)

Made both changes (no allocation and changing the WM_DESTROY handler). Works as expected without being unruly awful ;)

[hurtado]

> ...and you continue using a goto instead of sending a WM_CLOSE message.

No, I agree with you and don't cost me anything, just need time to modify all the code... more if paul doe just confirm us that it's going well.

Speaking of heterodox codes, someone may wonder why I do "pMainDib [] = miPaleta[]" being the first integer, and the second a structure. That's becuase miPaleta is, in the end, an integer and TinyC allows me to do that, while the right way would be (myPaleta[].Azul) | (myPaleta[].Verde << 8) | (myPaleta[].Rojo << 16).

I have uploaded some freebasic code for the first chapter.

[hurtado]

Another thing, if you see in some code the call to "PintaObjeto" within WM_PAINT, it is incorrect, this call has to be within WM_TIMER, before Invalidaterect. You will not realize why if you do not resize the window.

[dodicat]

Thanks paul doe, using the timer sub now for motion, nice.
I forget sometimes that the winapi is actually a high level language in it's own right, and it does the memory allocation/deallocation for you.
Using fb with no external lib you get into the habit of writing down instructions pedantically, but some things should be omitted using the winapi.
Never mind, the thrust of this is a template to create more colourful mainwindows in the future.
And thanks hurtado for the interesting link you gave us.
And thanks Josep Roca for removing the goto.
For fun, a pseudo under the hood allocation of memory.

Code: Select all

screen 19,32
dim shared as ulong ptr p

sub GetMeSomeMem(p as ulong ptr ptr,i as integer ptr)
     #define mk(a,b) a or b shl 16
    *p=screenptr
    dim as integer w,h
    screeninfo w,h
    *i=mk(w,h)
    end sub

sub dothis
    dim as integer i
    GetMeSomeMem(@p,@i)
    
dim as long inc
screenlock
    for y as long=0 to hiword(i)-1
        for x as long=0 to loword(i)-1
    *(p+inc)=rgb(x,x xor y,y)
    inc+=1
next
next
screenunlock
end sub
    
dothis
sleep

  

[UEZ]

Here a GDI+ variant of the moving xor gfx:

Code: Select all

#Include "fbgfx.bi"
#Ifdef __Fb_64bit__
   #Inclib "gdiplus"
   #Include Once "win/gdiplus-c.bi"
#Else
   #Include Once "win/gdiplus.bi"
   Using gdiplus
#Endif 

Using FB 

Dim As ULong iW = 512, iH = 512, aBitmap(0 To iW * iH)

Dim GDIPlusStartupInput As GDIPLUSSTARTUPINPUT 
Dim As ULONG_PTR GDIPlusToken 
GDIPlusStartupInput.GdiplusVersion = 1 
GdiplusStartup(@GDIPlusToken, @GDIPlusStartupInput, NULL) 

Dim As Any Ptr hBitmap, hCanvas, hTexture

GdipCreateBitmapFromScan0(iW, iH, iW * 4, PixelFormat32bppARGB, Cptr(Ubyte Ptr, @aBitmap(0)), @hBitmap)

For i As ULong = 0 To UBound(aBitmap) - 1
	aBitmap(i) = Rgba(i Mod 256, i Mod 256, i Shr 1, 255)
Next

GdipCreateTexture(hBitmap, 0, @hTexture)

Screencontrol SET_DRIVER_NAME, "GDI"
Screenres iW, iH, 32, 1, GFX_HIGH_PRIORITY Or GFX_NO_SWITCH 

Dim As HWND hHWND
Screencontrol(GET_WINDOW_HANDLE, Cast(Integer, hHWND))

Dim As Any Ptr 	hDC = GetDC(hHWND), _
				hHBitmap = CreateCompatibleBitmap(hDC, iW, iH), _
				hDC_backbuffer = CreateCompatibleDC(hDC), _
				hDC_obj = SelectObject(hDC_backbuffer, hHBitmap)
GdipCreateFromHDC(hDC_backbuffer, @hCanvas)

Dim As Single x = 1, y = 2, z = 0
Do 
	GdipTranslateTextureTransform(hTexture, x * Sin(z / 128), y * Cos(z / 192), 0)
	GdipFillRectangle(hCanvas, hTexture, 0, 0, iW, iH)
	BitBlt(hDC, 0, 0, iW, iH, hDC_backbuffer, 0, 0, SRCCOPY)
	z += 0.5
	Sleep(10)
	If Inkey <> ""  Then Exit do
Loop

GdipDisposeImage(hBitmap) 
GdipDeleteBrush(hTexture)
SelectObject(hDC_backbuffer, hDC_obj)
DeleteDC(hDC_backbuffer)
DeleteObject(hHBitmap)
ReleaseDC(hHWND, hDC)
GdiplusShutdown(GDIPlusToken)

[jj2007]

The Goto is innocent, it crashes in RtlFreeHeap called by Deallocate pMainDIB

Code: Select all

'// Variables globales
Dim Shared As Ulong Ptr             pMainDIB:  pMainDIB    =Allocate((cdXsize)*(cdYsize))
print "Allocated: ";pMainDIB	' compare to what you get in Sub finish
...
    print "before CreateDIBSection: ";pMainDIB
    hMainDIB = CreateDIBSection(hdc,Cast(Any Ptr, @bi), DIB_RGB_COLORS, @pMainDIB, NULL, 0)
    print " after CreateDIBSection: ";pMainDIB
...
Sub finish Destructor
    Print "dealloc: ";pMainDIB	' not the same value!!
    Deallocate  pMainDIB
    Print "done"	' <<<<<<< you will not see this one

IMHO there should be no allocation and no deallocation:

Code: Select all

'// Variables globales
Dim Shared As Ulong Ptr             pMainDIB:  pMainDIB    =0 'do NOT Allocate((cdXsize)*(cdYsize))

Microsoft: https://docs.microsoft.com/en-us/window ... dibsection

ppvBits

A pointer to a variable that receives a pointer to the location of the DIB bit values.
...
if hSection is NULL, the system allocates memory for the DIB. The system closes the handle to that memory when you later delete the DIB by calling the DeleteObject function.

[Josep Roca]

The goto is innocent of the crash, but I haven't seen a worse way of trying to close an application.

[jj2007]

Sorry, Josep, I just saw that you had already mentioned the issue with CreateDibsection.
I agree about the Goto and sending WM_CLOSE, although the whole WM_CHAR handler is somewhat superfluous if you can use the default Alt F4 without a handler.

Besides, SetTimer and Case WM_TIMER do nothing useful.

The WM_SIZE handler could be replaced by a GetClientRect in the WM_PAINT handler.

Code: Select all

Case WM_SIZE :
vdxClient = lParam And &hFFFF
vdyClient = lParam Shr &h10 '>>
Return 0

IMHO returning 0 is bad programming practice except when one really wants to suppress the default handling by DefWindowProc.

[dodicat]

jj2007
The return 0 was only for the c code, where switch goes through all cases if not used.
SetTimer and Case WM_TIMER are the drivers for the Sub PintaObjeto () if used.
Here is another simple example for Sub PintaObjeto ()

Code: Select all

 

/' ----------------------------------------------------------------------------
-       Plantilla Programación Gráfica - SWGPTG -  Tiny C                  -
-----                                                                  -----
-       AUTOR   : Alfonso Víctor Caballero Hurtado                         -
-----                                                                  -----
-       VERSION : 1.0                                                      -
-----                                                                  -----
-      (c) 2018. http://www.abreojosensamblador.net                        -
-                Small Windows Graphics Programming Tutorial With GDI      -
---------------------------------------------------------------------------- '/
screen 19,32,,-1  'null window, but still has all the properties of gfx.
color ,rgb(200,0,0)
#include "windows.bi"

#define cdXPos          CW_USEDEFAULT
#define cdYPos          CW_USEDEFAULT
#define cdXSize         800 
#define cdYSize         600
#define cdColFondo      0
#define MAIN_ICON       100   ' //  IDI_APPLICATION
#define cdVCursor       IDC_ARROW
#define cdVBarTipo      0
#define cdVBtnTipo      WS_OVERLAPPEDWINDOW
#define cdIdTimer       1
#define _getpixel(_x,_y)  *cptr(ulong ptr,row + (_y)*pitch + (_x) shl 2)
'#define DIB_RGB_COLORS  0
 
'// Variables globales
Dim Shared As Ulong Ptr             pMainDIB
Dim Shared As Integer                vdxClient, vdyClient,pitch
Dim Shared As BITMAPINFOHEADER  bi = Type(Sizeof(BITMAPINFOHEADER),cdXSize,-cdYSize,1,32,0,0,0,0,0,0)
dim shared as any ptr row
row=screenptr
screeninfo ,,,,pitch

Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
    Static As Double timervalue,_lastsleeptime,t3,frames
    frames+=1
    If (Timer-t3)>=1 Then t3=Timer:fps=frames:frames=0
    Var sleeptime=_lastsleeptime+((1/myfps)-Timer+timervalue)*1000
    If sleeptime<1 Then sleeptime=1
    _lastsleeptime=sleeptime
    timervalue=Timer
    Return sleeptime
End Function

Sub DisplayProc()
    cls
    Static x As Long = 150
    Static y As Long = 150
    Static dx As Long = 3
    Static dy As Long = 3
    Static As Long fps
        x += dx : y += dy
        If x<50 Or x>=cdxsize-50 Then dx = -dx
        If y<50 Or y>=cdysize-50 Then dy = -dy
        Circle(x,y),50,rgb(0,200,0),,,,f 'draw the ball
        Draw String(20,20),"Framerate = " &fps
        Sleep regulate(60,fps)
End Sub

Sub PintaObjeto () 
    displayproc
    Dim As integer  k
    For y as integer= 1 To cdYSize
        For x as integer = 1 To cdXSize
            *(pMainDIB + k) =_getpixel(x-1,y-1)
            k+=1
        Next
    Next
End Sub

Sub Inicio () 
  'for static stuff 
End Sub


Function WndProc(hWnd As HWND, message As UINT, wParam As wPARAM,lParam As LPARAM) As LRESULT
    
    Static As   HDC               bufDIBDC
    Static As  HBITMAP           hMainDIB
    Dim As      HDC               hdc 
    Dim As      PAINTSTRUCT       ps 
    Static As  HGDIOBJ           hOldDIB=0, hGDITmp
    Dim As     Integer               bResult
    
    Select Case message
    
    Case WM_CHAR 
        If (wParam = VK_ESCAPE) Then
            SendMessage hWnd, WM_CLOSE, 0, 0
        End If 
       
        
    Case WM_CREATE:
    hdc = GetDC(hWnd)
    
    '// Crea un búfer dib para PintaObjeto. pMainDIB es un puntero a él
    bufDIBDC = CreateCompatibleDC (hdc)
    hMainDIB = CreateDIBSection(hdc,Cast(Any Ptr, @bi), DIB_RGB_COLORS, @pMainDIB, NULL, 0)
    hOldDIB  = SelectObject (bufDIBDC, hMainDIB)
    
    ReleaseDC (hWnd, hdc)'   // Libera device context
    
    Inicio ()
    SetTimer (hWnd, cdIdTimer, 20, NULL) 
   
    
Case WM_TIMER :
InvalidateRect (hWnd, NULL, FALSE) 
Return 0 

Case WM_SIZE :
vdxClient = lParam And &hFFFF
vdyClient = lParam Shr &h10 '>>
Return 0 

Case WM_PAINT :
hdc = BeginPaint(hWnd, @ps)
PintaObjeto ()
'//bResult = BitBlt(hdc, 0, 0, cdXSize, cdYSize, bufDIBDC, 0, 0, SRCCOPY)
bResult = StretchBlt (hdc, 0, 0, vdxClient, vdyClient, bufDIBDC, 0, 0, cdXSize, cdYSize, SRCCOPY)
EndPaint(hWnd, @ps)
Return 0 

Case WM_DESTROY 
    wmDestruimos:
    KillTimer (hWnd, cdIdTimer) 
    hGDITmp = SelectObject (bufDIBDC, hOldDIB)
    bResult = DeleteDC (bufDIBDC)
    bResult = DeleteObject (hMainDIB)
    bResult = DestroyWindow (hWnd)
    PostQuitMessage (0) 
    Return 0 
End Select

Return DefWindowProc (hWnd, message, wParam, lParam) 
End Function

Function  WinMain ( hInstance As HINSTANCE,  hPrevInstance As HINSTANCE, _
    szCmdLine As pSTR, iCmdShow As Integer) As Integer
    Dim As  RECT   WRect
    Static As String szAppName:szAppName = "SWGPTG" 
    Dim As HWND         hWnd 
    Dim As MSG          msg 
    Dim As WNDCLASS     wndclass 
    wndclass.style         = CS_HREDRAW Or CS_VREDRAW 
    wndclass.lpfnWndProc   =  @WndProc
    wndclass.cbClsExtra    = 0 
    wndclass.cbWndExtra    = 0 
    wndclass.hbrBackground = cdColFondo 
    wndclass.lpszMenuName  = NULL 
    wndclass.lpszClassName = Strptr(szAppname) 
    wndclass.hInstance     = GetModuleHandle (NULL) 
    wndclass.hIcon         = LoadIcon(hInstance, MAKEINTRESOURCE(MAIN_ICON)) 
    wndclass.hCursor       = LoadCursor (NULL, IDC_ARROW) 
    
    If RegisterClass (@wndclass) =0 Then
        MessageBox (NULL, "This program requires Windows NT!", _
        "Error", MB_ICONERROR) 
        Return 0 
    End If
    
    
    SetRect (@WRect, 0, 0, cdXSize, cdYSize)
    AdjustWindowRectEx (@WRect, cdVBtnTipo, 0, cdVBarTipo)
    WRect.bottom -= WRect.top
    WRect.right  -= WRect.left
    WRect.left    = (GetSystemMetrics (SM_CXSCREEN) - WRect.right)/2
    WRect.top     = (GetSystemMetrics (SM_CYSCREEN) - WRect.bottom) / 3
    
    hWnd = CreateWindowex(0,szAppname ,"Drawing Basic Shapes - (c) abreojosensamblador.net", _
    cdVBtnTipo , _
    WRect.left,WRect.top,WRect.right,WRect.bottom, _
    NULL, NULL, hInstance, NULL) 
    
    ShowWindow (hWnd, iCmdShow) 
    UpdateWindow (hWnd) 
    
    While (GetMessage (@msg, NULL, 0, 0)) 
        TranslateMessage (@msg) 
        DispatchMessage (@msg) 
    Wend
    
    Return msg.wParam 
End Function


end winmain(GetModuleHandle( null ), null, Command( ), SW_NORMAL)

 

[hurtado]

Occasionally there are programmers who try to impose their style, as if it were a religion :)

> The goto is innocent of the crash, but I haven't seen a worse way of trying to close an application.
Agreeing that it is not the orthodox way of doing it, what is wrong with using a goto? It seems to me the most direct way of doing something in certain circumstances, we should not be afraid of the gotos.

> The WM_SIZE handler could be replaced by a GetClientRect in the WM_PAINT handler
Of course, there are hundreds of possibilities to do the same thing, why not use WM_SIZE?

> the whole WM_CHAR handler is somewhat superfluous if you can use the default Alt F4 without a handler.
Oh my God. And why use ALT + F4 if you have the close button. In my opinion, a graphic demo that cannot be closed with the ESC key is not correct, but that is my opinion.

>SetTimer and WM_TIMER does nothing
Of course, in this case no, but what if you had to move something through the window?

[hurtado]

You may use peekmessage, instead of getmessage, with fps stabilizator

http://abreojosensamblador.epizy.com/Pr ... orWM02.asm

The example compiled here:
http://masm32.com/board/index.php?actio ... ttach=8021

[hurtado]

This could be the postcard of my tuto. Background music.

http://board.flatassembler.net/download.php?id=8067

[jj2007]

The return 0 was only for the c code, where switch goes through all cases if not used.

Right, that would be a big problem. In C, you would use break, though. Returning 0 means you don't let DefWindowProc do its job, which means no harm in most cases but occasionally Windows may bite you ;-)

[dodicat]

I agree.
fb needs no break instructions within a case, it is automatic, although there is an instruction exit select if needed.
I'll try and figure out an example where you must use exit select.