Cairo under Windows

Windows specific questions.
Post Reply
UEZ
Posts: 988
Joined: May 05, 2017 19:59
Location: Germany

Cairo under Windows

Post by UEZ »

I'm searching for a way to use Cairo lib under Windows but using winapi GUI window.

Code: Select all

#include "Cairo.bi"
#include "windows.bi"


Declare Function WndProc(hWnd As HWND,uMsg As UINT,wParam As WPARAM,lParam As LPARAM) As Integer

Dim wc As WNDCLASSEX
Dim msg As MSG
Dim hHWND As HWND
Dim As Integer sW, sH
ScreenInfo(sW, sH)

Dim szAppName As ZString * 30 => "FB GUI"
Dim As String sTitle = "Cairo Lib Test"
Dim Shared As ULong iW, iH
iW = 1000
iH = 600

With wc '...'
	.style         = CS_HREDRAW Or CS_VREDRAW
	.lpfnWndProc   = @WndProc
	.cbClsExtra    = NULL
	.cbWndExtra    = NULL
	.hInstance     = GetModuleHandle(NULL)
	.hIcon         = LoadIcon(NULL, IDI_APPLICATION)
	.hCursor       = LoadCursor(NULL, IDC_ARROW)
	.hbrBackground = GetStockObject(WHITE_BRUSH)
	.lpszMenuName  = NULL
	.lpszClassName = @szAppName
	.cbSize			= SizeOf(WNDCLASSEX)
End With
 
RegisterClassEx(@wc)
hHWND = CreateWindowEx(0, wc.lpszClassName, sTitle, _
							  WS_OVERLAPPEDWINDOW Or WS_VISIBLE, _
							  (sW - iW) / 2, (sH - iH) / 2, _
							  iW, iH, _
							  NULL, NULL, wc.hInstance, NULL)

Dim As ULong iStride = cairo_format_stride_for_width(CAIRO_FORMAT_ARGB32, iW)
Dim As UByte aMem(iStride * iH * 3)
Dim As Any Ptr hDC = GetDC(hHWND), hGfxDC = CreateCompatibleDC(hDC), hHBitmap = CreateBitmap(iW, iH, 1, 32, @aMem(0)) 'CreateCompatibleBitmap(hDC, iW, iH)
Dim As HGDIOBJ hObjOld = SelectObject(hGfxDC, hHBitmap)

'Dim As cairo_surface_t Ptr surface = cairo_win32_surface_create(hGfxDC)
Dim As cairo_surface_t Ptr surface = cairo_image_surface_create_for_data(@aMem(0), CAIRO_FORMAT_ARGB32, iW, iH, iStride)

Dim As cairo_t Ptr context = cairo_create(surface)
Dim As PAINTSTRUCT lpPaint

? iStride, @aMem(0), surface, context, hHBitmap 

While GetMessage(@msg, 0, 0, 0)
	TranslateMessage(@msg)
	DispatchMessage(@msg)
	
	BeginPaint(hHWND, @lpPaint)
	
	cairo_set_source_rgba(context, 1, 1, 1, 1)
	
	cairo_set_line_width(context, 20)
	cairo_rectangle(context, 100, 100, 300, 300)
	cairo_stroke(context)
	
	/'cairo_set_source_rgba(context, 1, 1, 1, 1)
	cairo_set_line_width(context, 20)
	cairo_move_to(context, 10, 10)
	cairo_line_to(context, iW - 10, iH - 10)
	cairo_stroke(context) '/
	
	EndPaint(hHWND, @lpPaint)
	
	BitBlt(hDC, 0, 0, iW, iH, hGfxDC, 0, 0, SRCCOPY)
Wend

cairo_destroy(context)
cairo_surface_destroy(surface)

SelectObject(hGfxDC, hObjOld)
ReleaseDC(hHWND, hDC)
DeleteObject(hHBitmap)
DeleteDC(hGfxDC)
End

Function WndProc(hWnd As HWND,uMsg As UINT,wParam As WPARAM,lParam As LPARAM) As Integer
	Select Case uMsg
		Case WM_CLOSE
			PostQuitMessage(0)
		Case WM_CREATE
		
		Case Else
			Return DefWindowProc(hWnd, uMsg, wParam, lParam)
	End Select
End Function
Any idea why it doesn't work?
Roland Chastain
Posts: 1002
Joined: Nov 24, 2011 19:49
Location: France
Contact:

Re: Cairo under Windows

Post by Roland Chastain »

Hello!

I left Windows several years ago, and I no longer feel interest for it, but I still have on my HD some examples that I have made in Pascal. I put them on my website, in case you would like to take a look: freepascal-cairo-win32-examples.zip

Regards.

Roland
UEZ
Posts: 988
Joined: May 05, 2017 19:59
Location: Germany

Re: Cairo under Windows

Post by UEZ »

Merci Roland, I will check your Pascal examples.

Here, what I find out and which seems to work:

Code: Select all

'Coded by UEZ
#include "Cairo.bi"
#include "windows.bi"


Declare Function WndProc(hWnd As HWND,uMsg As UINT,wParam As WPARAM,lParam As LPARAM) As Integer

Dim wc As WNDCLASSEX
Dim msg As MSG
Dim Shared hHWND As HWND
Dim As Integer sW, sH
ScreenInfo(sW, sH)

Dim Shared As PAINTSTRUCT lpPaint

Dim szAppName As ZString * 6 = "FB GUI"
Dim As String sTitle = "Cairo Lib Test"
Dim Shared As ULong iW, iH
iW = 1000
iH = 600

With wc '...'
	.style         = CS_HREDRAW Or CS_VREDRAW
	.lpfnWndProc   = @WndProc
	.cbClsExtra    = NULL
	.cbWndExtra    = NULL
	.hInstance     = GetModuleHandle(NULL)
	.hIcon         = LoadIcon(NULL, IDI_APPLICATION)
	.hCursor       = LoadCursor(NULL, IDC_ARROW)
	.hbrBackground = GetStockObject(WHITE_BRUSH)
	.lpszMenuName  = NULL
	.lpszClassName = @szAppName
	.cbSize			= SizeOf(WNDCLASSEX)
End With
 
RegisterClassEx(@wc)
hHWND = CreateWindowEx(0, wc.lpszClassName, sTitle, _
						  WS_OVERLAPPEDWINDOW Or WS_VISIBLE, _
						  (sW - iW) / 2, (sH - iH) / 2, _
						  iW, iH, _
						  NULL, NULL, wc.hInstance, NULL)

Dim As BITMAPINFO tBITMAPV5HEADER
With tBITMAPV5HEADER.bmiHeader
      .biSize = SizeOf(BITMAPINFOHEADER)
      .biWidth = iW
      .biHeight = -iH
      .biPlanes = 1
      .biBitCount = 32
      .biCompression = BI_RGB
End With

Dim As UByte Ptr pBits
Dim Shared As Any Ptr hDC, hGfxDC, hHBitmap
hDC = GetDC(hHWND)
hGfxDC = CreateCompatibleDC(hDC)
hHBitmap = CreateDIBSection(hGfxDC, @tBITMAPV5HEADER, DIB_RGB_COLORS, @pBits, 0, 0)
Dim As HGDIOBJ hObjOld = SelectObject(hGfxDC, hHBitmap)

Dim As ULong iStride = cairo_format_stride_for_width(CAIRO_FORMAT_ARGB32, iW)
Dim Shared As cairo_surface_t Ptr surface
surface = cairo_image_surface_create_for_data(pBits, CAIRO_FORMAT_ARGB32, iW, iH, iStride)

Dim Shared As cairo_t Ptr context
context = cairo_create(surface)

SetTimer(hHWND, 1, 1, NULL)

While GetMessage(@msg, 0, 0, 0)
	TranslateMessage(@msg)
	DispatchMessage(@msg)
Wend

cairo_destroy(context)
cairo_surface_destroy(surface)

SelectObject(hGfxDC, hObjOld)
ReleaseDC(hHWND, hDC)
DeleteObject(hHBitmap)
DeleteDC(hGfxDC)
End

Function WndProc(hWnd As HWND,uMsg As UINT,wParam As WPARAM,lParam As LPARAM) As Integer
	Select Case uMsg
		Case WM_DESTROY
			KillTimer(hHWND, 1)
			PostQuitMessage(0)
        Case WM_CLOSE
            DestroyWindow(hHWND)
		Case WM_TIMER
		
			KillTimer(hHWND, 1)
			BeginPaint(hHWND, @lpPaint)
			BitBlt(hGfxDC, 0, 0, iW, iH, hGfxDC, 0, 0, BLACKNESS)
			
			cairo_set_source_rgba(context, 1, 1, 1, 1)
			
			cairo_set_line_width(context, 20)
			cairo_rectangle(context, 100, 100, 300, 300)
			cairo_stroke(context)
			
			cairo_set_source_rgba(context, 0, 1, 0, 1)
			cairo_set_line_width(context, 13)
			cairo_move_to(context, 10, 10)
			cairo_line_to(context, iW / 2 + Cos(Timer) * 30, iH  / 2 + Sin(Timer) * 30)
			cairo_stroke(context)
			
			BitBlt(hDC, 0, 0, iW, iH, hGfxDC, 0, 0, SRCCOPY)
			EndPaint(hHWND, @lpPaint)
			SetTimer(hHWND, 1, 30, NULL)
		Case Else
			Return DefWindowProc(hWnd, uMsg, wParam, lParam)
	End Select
End Function
I'm trying to use Cairo with Autoit and it crashes when drawing lines, with FB it works.
Last edited by UEZ on Mar 27, 2024 21:56, edited 1 time in total.
dodicat
Posts: 7983
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Cairo under Windows

Post by dodicat »

Hi UEZ/Roland.
I'm hardly ever on the pascal forum these days, but I have the 3.2.2 compiler here.
A strange thing happened here on win 11.
I was messing about with UEZ's code , trying to get an opengl screen ensconced in a win32 api using a winproc function.
At some stage during my tribulations I have completely lost my fb openGL screen.
That was last night.
I switched off the computer, and fired it up again this morning, and no opengl screen, it freezes at the console, it doesn't get past
Screen 20,32,,2
I know that working with the Win32 api uses some powerful windows procedures, I must have went a bridge too far this time.
Anyway, that is nice code UEZ, it still works here.
I get
Passing different pointer types, at parameter 2 of CREATEDIBSECTION()
On reflection, I must have passed a wrong pointer once too often during my efforts last night.
Roland, I like your cairo spiral in the other thread.
UEZ
Posts: 988
Joined: May 05, 2017 19:59
Location: Germany

Re: Cairo under Windows

Post by UEZ »

Thanks @dodicat.

Should be fixed now with passing different pointer.

I'm still porting the Cairo stuff to Autoit.

With the technique above you can use Cairo and GDI / GDI+ gfx functions together to display it in the GUI.
UEZ
Posts: 988
Joined: May 05, 2017 19:59
Location: Germany

Re: Cairo under Windows

Post by UEZ »

I've difficulties to understand what cairo_font_options_t is:
cairo_font_options_t
typedef struct _cairo_font_options cairo_font_options_t;
An opaque structure holding all options that are used when rendering fonts.

Individual features of a cairo_font_options_t can be set or accessed using functions named cairo_font_options_set_feature_name() and cairo_font_options_get_feature_name(), like cairo_font_options_set_antialias() and cairo_font_options_get_antialias().

New features may be added to a cairo_font_options_t in the future. For this reason, cairo_font_options_copy(), cairo_font_options_equal(), cairo_font_options_merge(), and cairo_font_options_hash() should be used to copy, check for equality, merge, or compute a hash value of cairo_font_options_t objects.

Since: 1.0

Code: Select all

void
cairo_set_font_options (cairo_t *cr,
                        const cairo_font_options_t *options);
Sources: https://www.cairographics.org/manual-1. ... tions.html, https://www.cairographics.org/manual/ca ... ons-t.html

Any idea?
Roland Chastain
Posts: 1002
Joined: Nov 24, 2011 19:49
Location: France
Contact:

Re: Cairo under Windows

Post by Roland Chastain »

UEZ wrote: Mar 29, 2024 13:42 Any idea?
I scanned my (big) collection of Cairo examples (in Basic, C and Pascal) and found only this:

var
...
font_options: cairo_font_options_t;

begin
...
cairo_select_font_face(context, 'Courier New', CAIRO_FONT_SLANT_NORMAL, CAIRO_FONT_WEIGHT_BOLD);
cairo_font_options_set_antialias(@font_options, CAIRO_ANTIALIAS_GRAY);
cairo_set_font_options(context, @font_options);


So it doesn't seem to be something really useful.
dodicat wrote: Mar 27, 2024 10:53 Roland, I like your cairo spiral in the other thread.
Glad that you like it!
dodicat
Posts: 7983
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Cairo under Windows

Post by dodicat »

Here is how I do fonts in Cairo, I have found no problems with the method.
(Tested 64 bits) Win 11.

Code: Select all


#cmdline "-s gui"
#include "fbgfx.bi"
#include once "cairo/cairo.bi" 

#define _rd_ Cast(Ubyte Ptr,@colour)[2]/255
#define _gr_ Cast(Ubyte Ptr,@colour)[1]/255
#define _bl_ Cast(Ubyte Ptr,@colour)[0]/255
#define _al_ Cast(Ubyte Ptr,@colour)[3]/255

Namespace chrs
Dim  As cairo_font_extents_t _fonts  
Dim  As cairo_text_extents_t _text
End Namespace

Const pi=4*Atn(1)

Sub InitFonts(surf As cairo_t Ptr,fonttype As String="times new roman")
    If Len(fonttype) Then
        cairo_select_font_face (surf,fonttype, CAIRO_FONT_SLANT_NORMAL, CAIRO_FONT_WEIGHT_BOLD)
    End If
    cairo_font_extents (surf, @chrs._fonts)
End Sub

Sub Cprint(surf As cairo_t Ptr,x As Long,y As Long,text As String,size As Single,colour As Ulong)
    cairo_set_font_size (surf,(size))
    cairo_move_to (surf, _ '                 lower left corner of text
    (x) - (chrs._text.width / 2 + chrs._text.x_bearing), _
    (y) + (chrs._text.height / 2) - chrs._fonts.descent)
    cairo_set_source_rgba surf,_rd_,_gr_,_bl_,_al_
    cairo_show_text(surf, text)
    cairo_stroke(surf)
End Sub


Function setscreen(xres As Integer,yres As Integer)  As cairo_t Ptr
    Screenres xres,yres,32
    Var surface = cairo_image_surface_create_for_data(Screenptr(), CAIRO_FORMAT_ARGB32,xres,yres,xres*4)
    Static As cairo_t Ptr res
    res= cairo_create(surface)
    Return res
End Function

Function framecounter As Long Static
    Dim As Long c,framerate
    Dim As Double t
    c += 1
	If Timer - t > 1 Then
		framerate = c
		c = 0
		t = Timer
    End If
    Return framerate
End Function


Var C=setscreen(1024,768)
Color ,Rgb(0,100,255)
Dim As Long dx=5,xpos,xpos2

Do
    xpos+=1
    xpos2+=1
    If xpos>1024 Then xpos=-1024
    If xpos2>1024*2 Then xpos2=0
    Screenlock
    Cls
    initfonts(C)
    For n As Long=1 To 10
        Var size=20+5*n
        Var seperation=size*.75
        Cprint(C,20+5*size+200*Sin(n/2.5),20+seperation*n,"Hello World!",size,Rgb(25*n,255-25*n,10*n))
    Next n
    initfonts(C,"consolas")
    cprint(C,xpos+dx,700,"THESE FONTS ARE CONSOLAS, FRAMERATE = "& framecounter,30,Rgb(100,0,0))
    cprint(C,xpos2+dx-1024,700,Lcase("THESE FONTS ARE CONSOLAS, FRAMERATE = "& framecounter),30,Rgb(100,0,0))
    Screenunlock
    Sleep 1
Loop Until Len(Inkey)

 
UEZ
Posts: 988
Joined: May 05, 2017 19:59
Location: Germany

Re: Cairo under Windows

Post by UEZ »

@dodicat: thank you for your example. I know about cairo_select_font_face but as mentioned somewhere above I'm porting the Cairo functions to Autoit and while going thru the font function I realized that a lot of font functions refer to struct cairo_font_options_t which is not described somewhere.
Roland Chastain
Posts: 1002
Joined: Nov 24, 2011 19:49
Location: France
Contact:

Re: Cairo under Windows

Post by Roland Chastain »

dodicat wrote: Mar 29, 2024 19:24 Here is how I do fonts in Cairo, I have found no problems with the method.
Please check the value of chrs._text.width and chrs._text.height!

Code: Select all

Sub Cprint(surf As cairo_t Ptr,x As Long,y As Long,text As String,size As Single,colour As Ulong)
  print(chrs._text.width)
  print(chrs._text.height)
As I said in 2022.
Last edited by Roland Chastain on Mar 29, 2024 23:17, edited 1 time in total.
dodicat
Posts: 7983
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Cairo under Windows

Post by dodicat »

Thanks Roland, I Ican add it in.

Code: Select all

#include "cairo/cairo.bi"
#define _rd_ Cast(Ubyte Ptr,@colour)[2]/255
#define _gr_ Cast(Ubyte Ptr,@colour)[1]/255
#define _bl_ Cast(Ubyte Ptr,@colour)[0]/255
#define _al_ Cast(Ubyte Ptr,@colour)[3]/255

Namespace chrs
Dim  As cairo_font_extents_t _fonts  
Dim  As cairo_text_extents_t _text
End Namespace
Sub InitFonts(surf As cairo_t Ptr,fonttype As String="times new roman")
    If Len(fonttype) Then
        cairo_select_font_face (surf,fonttype, CAIRO_FONT_SLANT_NORMAL, CAIRO_FONT_WEIGHT_BOLD)
    End If
    cairo_font_extents (surf, @chrs._fonts)
End Sub

Sub Cprint(surf As cairo_t Ptr,x As Long,y As Long,text As String,size As Single,colour As Ulong)
    cairo_set_font_size (surf,(size))
     cairo_text_extents (surf, text, @chrs._text) '<--------------
    cairo_move_to (surf, _ '                 lower left corner of text
    (x) - (chrs._text.width / 2 + chrs._text.x_bearing), _
    (y) + (chrs._text.height / 2) - chrs._fonts.descent)
    cairo_set_source_rgba surf,_rd_,_gr_,_bl_,_al_
    cairo_show_text(surf, text)
    cairo_stroke(surf)
    print"text width ";(chrs._text.width)
    print"text height ";(chrs._text.height)
End Sub

Function setscreen(xres As Integer,yres As Integer)  As cairo_t Ptr
    Screenres xres,yres,32
    Var surface = cairo_image_surface_create_for_data(Screenptr(), CAIRO_FORMAT_ARGB32,xres,yres,xres*4)
    Static As cairo_t Ptr res
    res= cairo_create(surface)
    Return res
End Function

var c=setscreen(800,600)
width 800\8,600\16
initfonts(C)
screenlock
cprint(c,200,200,"hello world",50,rgb(255,255,255))

screenunlock
sleep 

UEZ
I think structure is confusing regardng cairo_font_options_t
It is not defined properly in the .bi file, so it is just like ANY ptr

Code: Select all


 type cairo_font_options_t as _cairo_font_options 'as in the cairo.bi file

dim as cairo_font_options_t ptr p

dim as zstring ptr z=@"123456"
 p=cast(cairo_font_options_t ptr,z)



print *cast(zstring ptr,p)
sleep
 
UEZ
Posts: 988
Joined: May 05, 2017 19:59
Location: Germany

Re: Cairo under Windows

Post by UEZ »

This is what I got from ChatGPT:
The cairo_font_options_t structure in the Cairo graphics library is an opaque data type, meaning its internal details are hidden from users of the library. This structure holds various options that affect how fonts are rendered, but the exact contents of this structure are not directly accessible or specified in the documentation you provided.

The documentation suggests that users interact with the cairo_font_options_t structure through functions that allow them to set or retrieve individual features of font rendering options. For example, there might be functions like cairo_font_options_set_antialias() to set antialiasing options or cairo_font_options_get_antialias() to retrieve the current antialiasing setting.

However, without additional documentation or access to the Cairo library's source code, it's not possible to provide specific details about the internal content of the cairo_font_options_t structure. Users are expected to manipulate instances of this structure through the provided functions, treating it as an opaque data type. This approach hides implementation details and provides a clean interface for working with font rendering options.
dodicat
Posts: 7983
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Cairo under Windows

Post by dodicat »

You can say similar about fb any ptr, as in say win32 api where any ptr hwnd= CreateWindowEx(. . ....)
It can hold (point to) a lot of information.
Simple example

Code: Select all


type cairo_font_options_t as _cairo_font_options

type Cairo_structure
    as string * 10 s="hi"
    as double d=5.5
    as long l=1024
end type

dim as cairo_font_options_t ptr p=cast(cairo_font_options_t ptr,@type<Cairo_structure>)

print cast(Cairo_structure ptr,p)->s
print cast(Cairo_structure ptr,p)->d
print cast(Cairo_structure ptr,p)->l

sleep
 
So I would guess in the absence of anything tangible (as it seems), then any pointer would be a close comparison to cairo_font_options_t ptr
UEZ
Posts: 988
Joined: May 05, 2017 19:59
Location: Germany

Re: Cairo under Windows

Post by UEZ »

dodicat wrote: Mar 30, 2024 11:37 You can say similar about fb any ptr, as in say win32 api where any ptr hwnd= CreateWindowEx(. . ....)
It can hold (point to) a lot of information.
Simple example

Code: Select all


type cairo_font_options_t as _cairo_font_options

type Cairo_structure
    as string * 10 s="hi"
    as double d=5.5
    as long l=1024
end type

dim as cairo_font_options_t ptr p=cast(cairo_font_options_t ptr,@type<Cairo_structure>)

print cast(Cairo_structure ptr,p)->s
print cast(Cairo_structure ptr,p)->d
print cast(Cairo_structure ptr,p)->l

sleep
 
So I would guess in the absence of anything tangible (as it seems), then any pointer would be a close comparison to cairo_font_options_t ptr
Thanks dodicat. Let's see how I can use those functions in Autoit...
Post Reply