Windows graphics tutorial

Windows specific questions.
hurtado
Posts: 47
Joined: Apr 26, 2017 8:57
Contact:

Windows graphics tutorial

Postby hurtado » Jan 10, 2020 20:10

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
Posts: 416
Joined: May 05, 2017 19:59
Location: Germany

Re: Windows graphics tutorial

Postby UEZ » Jan 10, 2020 22:21

Nice documentation and source code. Thanks for sharing!

Btw, the Buddha code refers to Feigenbaum.
hurtado
Posts: 47
Joined: Apr 26, 2017 8:57
Contact:

Re: Windows graphics tutorial

Postby hurtado » Jan 10, 2020 22:49

Fixed, thank you!
dodicat
Posts: 6230
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Windows graphics tutorial

Postby dodicat » Jan 11, 2020 13:57

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
Posts: 1135
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: Windows graphics tutorial

Postby paul doe » Jan 11, 2020 14:22

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
Posts: 6230
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Windows graphics tutorial

Postby dodicat » Jan 11, 2020 14:41

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
Posts: 471
Joined: Sep 27, 2016 18:20
Location: Valencia, Spain

Re: Windows graphics tutorial

Postby Josep Roca » Jan 11, 2020 15:15

paul doe wrote: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
Posts: 47
Joined: Apr 26, 2017 8:57
Contact:

Re: Windows graphics tutorial

Postby hurtado » Jan 11, 2020 15:33

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
Posts: 6230
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Windows graphics tutorial

Postby dodicat » Jan 11, 2020 15:46

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
Posts: 47
Joined: Apr 26, 2017 8:57
Contact:

Re: Windows graphics tutorial

Postby hurtado » Jan 11, 2020 15:50

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
Posts: 471
Joined: Sep 27, 2016 18:20
Location: Valencia, Spain

Re: Windows graphics tutorial

Postby Josep Roca » Jan 11, 2020 16:13

> 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
Posts: 47
Joined: Apr 26, 2017 8:57
Contact:

Re: Windows graphics tutorial

Postby hurtado » Jan 11, 2020 17:27

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
Posts: 6230
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Windows graphics tutorial

Postby dodicat » Jan 11, 2020 18:10

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
Posts: 6230
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Windows graphics tutorial

Postby dodicat » Jan 11, 2020 19:36

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
Posts: 47
Joined: Apr 26, 2017 8:57
Contact:

Re: Windows graphics tutorial

Postby hurtado » Jan 11, 2020 20:27

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

Return to “Windows”

Who is online

Users browsing this forum: No registered users and 0 guests