Windows graphics tutorial

[hurtado]

Hello. This is not strictly freebasic. I'm making a graphics tutorial that you can access here using c and assembler in 32 and 64 bits, just using Windows and GDI, no external dll, no opengl neither directx. The compiled programs are usually below 20kb. I have learned a lot from basic community as you can see in credits. So, if you are interested you are welcome to visit it. There are no compiled programs in my site, just code, but you can get a bunch of them from the sixth chapter here. Regards.

[UEZ]

Nice documentation and source code. Thanks for sharing!

Btw, the Buddha code refers to Feigenbaum.

[hurtado]

Fixed, thank you!

[dodicat]

I translated one of the codes (from c)
chapter 01
templates
1.31 color gradients.

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      -
---------------------------------------------------------------------------- '/

#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:  pMainDIB    =Allocate((cdXsize)*(cdYsize))
Dim Shared As Integer                vdxClient, vdyClient
Dim Shared As BITMAPINFOHEADER  bi = Type(Sizeof(BITMAPINFOHEADER),cdXSize,-cdYSize,1,32,0,0,0,0,0,0)

Sub PintaObjeto () 
    'does nothing
    
End Sub

Sub Inicio () 
    Dim As Long x, y, k, cx, cy
    Var sz=(cdXsize)*(cdYsize)
    For y = 1 To cdYSize
        cy = (256/(cdYSize)*y)
        For x = 1 To cdXSize
            cx = (256/(cdXSize)*x)
            *(pMainDIB + k) = Rgb(128, cy, cx)
            k+=1
        Next
    Next
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
            Goto     wmDestruimos
        End If 
        Return 0 
        
    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) 
    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 = 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
winmain(GetModuleHandle( null ), null, Command( ), SW_NORMAL)

Sub finish Destructor
    Print "done"
    Deallocate  pMainDIB
    pMainDIB=0
    End Sub 

The only difference, I had to manually allocate some memory then deallocate it in the sub finish.

[paul doe]

It crashes when closing the window here (Win10 fbc 1.07.1 compiled with gcc 5.x). Most likely due to this part:

Code: Select all

'' ...
    Select Case message
   
    Case WM_CHAR
        If (wParam = VK_ESCAPE) Then
            Goto     wmDestruimos
        End If
        
        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
'' ...

Goto doesn't seem to play nicely within a select case.

[dodicat]

Thanks paul doe.
Perhaps the deallocate pMainDIB would be better situated in Case WM_DESTROY.

I notice it takes about a second to finish after "done" is shown, which I didn't really like, but allocate ~ deallocate must be paired somewhere in the code.
Win 10 fb 1.07.1 64 and 32 bits, but with the official gcc.exe, 5.2.0 for 64 bits and 32 bits.

[Josep Roca]

It crashes when closing the window here (Win10 fbc 1.07.1 compiled with gcc 5.x). Most likely due to this part:

Code: Select all

'' ...
    Select Case message
   
    Case WM_CHAR
        If (wParam = VK_ESCAPE) Then
            Goto     wmDestruimos
        End If
        
        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
'' ...

Goto doesn't seem to play nicely within a select case.

This is not the way to work with a window procedure.

1.- Instead of Goto wmDestruimos use SendMessage hwnd, WM_CLOSE, 0, 0
2.- Remove bResult = DestroyWindow (hWnd) from WM_DESTROY

[hurtado]

I've only had that problem once, so I never paid much attention to that. The advice was "let Windows close by itself", that is, remove "bResult = DestroyWindow (hWnd);". That should work well. I don't think the goto is any problem. I do not have gcc installed, so if, please, you can try this, I would appreciate the result. Do you have that problem if you compile it with tinyc?

[dodicat]

I have used goto (another case) in the past with fb with no problems.
Although it perhaps doesn't look good or conform to good code writing in fb.
gcc won't compile the c code
. . .
undefined reference to `CreateCompatibleDC@4'
undefined reference to `CreateDIBSection@24'
undefined reference to `SelectObject@8'
undefined reference to `StretchBlt@44'
undefined reference to `SelectObject@8'
undefined reference to `DeleteDC@4'
undefined reference to `DeleteObject@4'
. . .
tcc compiles and runs with no problems.

[hurtado]

Good translating to freebasic. It is basically a template, so:

- Inicio is for those code that you need to do at the init of the program
- PintaObjeto is for those code you need execute every time the timer is met, in this example is not used.

Thank you

[Josep Roca]

> I don't think the goto is any problem.

The problem is that in the way you're using it, you are bypassing the normal sequence of Windows events.

Closing the Window: https://docs.microsoft.com/en-us/window ... the-window

[hurtado]

Being a small code modification, it would be interesting if paul doe, who has detected the problem in gcc, could check to change "goto wmDestruimos" to "SendMessage hwnd, WM_CLOSE, 0, 0" and remove "DestroyWindow (hWnd)" in WM_DESTROY. Although, in principle, it would be the most orthodox.

[dodicat]

Of course the C switch is not the same as fb select case.
There is no break to end select, and each case is tested in C.
But goto is not affected.
Here is a C switch method in fb

Code: Select all

 
#define nobreak(n)  end select: select case n
#define switch select case   

dim as integer x=6

switch x

case 6
    print 6
    'x=12 '<----------  change
    nobreak(x)
    
case 2 to 7
    print 2;" to ";7
    nobreak(x)
 
case 9 to 14
    print 9;" to ";14
    nobreak(x)
   
case 5 to 7
    print 5;" to ";7
    nobreak(x)
   
case  12
print 12
nobreak(x)
 
 
case else
    print !"else\n (x=";x;")"
   

end select
sleep

  

[dodicat]

In my translation to fb, I see that I don't have to allocate any memory for pMainDIB
only:
Dim Shared As Ulong Ptr pMainDIB (~line 31)
and I don't deallocate in the sub finish.

So ~line 48
*(pMainDIB + k) = Rgb(128, cy, cx)
k+=1
sets values into the pointer as k increases.
I am not quite sure how exactly this method works, but it seems OK.
The c code does the same, no memory allocated.

[hurtado]

I have not been able to implement that change, I have continued with the allocate. Here is another example.

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:  pMainDIB    =Allocate((cdXSize)*(cdYSize))
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
            Goto     wmDestruimos
        End If 
        Return 0 
        
    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) 
        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 = 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 ,"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)

Sub finish Destructor
    'Print "done"
    Deallocate  pMainDIB
    pMainDIB=0
End Sub