Windows graphics tutorial
Windows graphics tutorial
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.
Re: Windows graphics tutorial
Fixed, thank you!
Re: Windows graphics tutorial
I translated one of the codes (from c)
chapter 01
templates
1.31 color gradients.
The only difference, I had to manually allocate some memory then deallocate it in the sub finish.
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
Re: Windows graphics tutorial
It crashes when closing the window here (Win10 fbc 1.07.1 compiled with gcc 5.x). Most likely due to this part:
Goto doesn't seem to play nicely within a select case.
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
'' ...
Re: Windows graphics tutorial
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.
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.
-
- Posts: 564
- Joined: Sep 27, 2016 18:20
- Location: Valencia, Spain
Re: Windows graphics tutorial
This is not the way to work with a window procedure.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:
Goto doesn't seem to play nicely within a select case.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 '' ...
1.- Instead of Goto wmDestruimos use SendMessage hwnd, WM_CLOSE, 0, 0
2.- Remove bResult = DestroyWindow (hWnd) from WM_DESTROY
Re: Windows graphics tutorial
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?
Re: Windows graphics tutorial
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.
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.
Re: Windows graphics tutorial
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
- 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
-
- Posts: 564
- Joined: Sep 27, 2016 18:20
- Location: Valencia, Spain
Re: Windows graphics tutorial
> 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
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
Re: Windows graphics tutorial
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.
Re: Windows graphics tutorial
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
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
Re: Windows graphics tutorial
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.
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.
Re: Windows graphics tutorial
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