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: 1007
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: 1007
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: 1007
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...
Avata
Posts: 105
Joined: Jan 17, 2021 7:27

Re: Cairo under Windows

Post by Avata »

There is an example demonstrating how Cairo works under Windows with VisualFBEditor ( https://github.com/XusinboyBekchanov/VisualFBEditor). Compiling the code requires the MFF framework.
cairo_GDI.frm (download https://github.com/XusinboyBekchanov/M ... ro_GDI.frm)

Code: Select all

'################################################################################
'#  cairo_GDI.frm                                                              #
'#  This file is an examples of MyFBFramework.                                  #
'#  Authors: Xusinboy Bekchanov, Liu XiaLin                                     #
'################################################################################

'#Region "Form"
	#if defined(__FB_MAIN__) AndAlso Not defined(__MAIN_FILE__)
		#define __MAIN_FILE__
		#ifdef __FB_WIN32__
			#cmdline "Form1.rc"
		#endif
		Const _MAIN_FILE_ = __FILE__
	#endif
	
	#include once "mff/Form.bi"
	#include once "mff/Panel.bi"
	#include once "mff/Label.bi"
	#include once "mff/CommandButton.bi"
	#include once "mff/TrackBar.bi"
	#include once "mff/TimerComponent.bi"
	Using My.Sys.Forms
	#include once "cairo/cairo-win32.bi"
	
	Dim Shared As cairo_surface_t Ptr cairoSurface
	Dim Shared As cairo_t Ptr cairoCreate
	
	Dim Shared As Boolean Ending, Playing = True
	' Adjust speed here
	Dim Shared As Long speed = 160 ' Frames Per Second
	' Adjust speed here
	Dim Shared As Long fps
	Const PI = 3.1415926535897932
	
	Const g = 39.81 ' gravitational effect
	Const length = 290 ' length of sticks
	
	Dim Shared As Double angle1 = 39.6, angle2 = 40.3, angle3 = 47, angle4 = 41.1, angle5 = 41.8, angle6 = 42.2
	Dim Shared As Double vel1 = 0, vel2 = 0, vel3 = 0, vel4 = 0, vel5 = 0, vel6 = 0
	Dim Shared As Double accel1, accel2, accel3, accel4, accel5, accel6
	Dim Shared As Double dt = 0.05
	
	Type Form1Type Extends Form
		Declare Sub Form_Resize(ByRef Sender As Control, NewWidth As Integer, NewHeight As Integer)
		Declare Sub Form_Create(ByRef Sender As Control)
		Declare Sub Form_Close(ByRef Sender As Form, ByRef Action As Integer)
		Declare Sub PanelRender_Resize(ByRef Sender As Control, NewWidth As Integer, NewHeight As Integer)
		Declare Sub cmdPlay_Click(ByRef Sender As Control)
		Declare Sub cmdPause_Click(ByRef Sender As Control)
		Declare Sub TrackBarFPS_Change(ByRef Sender As TrackBar, Position As Integer)
		Declare Sub Form_Paint(ByRef Sender As Control, ByRef Canvas As My.Sys.Drawing.Canvas)
		Declare Sub PanelRender_Paint(ByRef Sender As Control, ByRef Canvas As My.Sys.Drawing.Canvas)
		Declare Sub TimerFPS_Timer(ByRef Sender As TimerComponent)
		Declare Constructor
		
		Dim As Panel PanelRender
		Dim As Label lblFPS, lblLanguage
		Dim As CommandButton cmdPause, cmdPlay
		Dim As TrackBar TrackBarFPS
		Dim As TimerComponent TimerFPS
	End Type
	
	Constructor Form1Type
		#if _MAIN_FILE_ = __FILE__
			With App
				.CurLanguagePath = ExePath & "/Languages/"
				.CurLanguage = "Chinese (Simplified)" '.Language
			End With
		#endif
		' Form1
		With This
			.Name = "Form1"
			.Text = "VisualFBEditor-Cairo with GDI"
			.Designer = @This
			.StartPosition = FormStartPosition.CenterScreen
			.OnResize = Cast(Sub(ByRef Designer As My.Sys.Object, ByRef Sender As Control, NewWidth As Integer, NewHeight As Integer), @Form_Resize)
			.OnCreate = Cast(Sub(ByRef Designer As My.Sys.Object, ByRef Sender As Control), @Form_Create)
			.OnClose = Cast(Sub(ByRef Designer As My.Sys.Object, ByRef Sender As Form, ByRef Action As Integer), @Form_Close)
			.OnPaint = Cast(Sub(ByRef Designer As My.Sys.Object, ByRef Sender As Control, ByRef Canvas As My.Sys.Drawing.Canvas), @Form_Paint)
			.SetBounds 0, 0, 620, 450
		End With
		
		' PanelRender
		With PanelRender
			.Name = "PanelRender"
			.Text = "PanelRender"
			.TabIndex = 2
			.BackColor = 8421376
			.DoubleBuffered = True 
			.Anchor.Top = AnchorStyle.asAnchor
			.Anchor.Right = AnchorStyle.asAnchor
			.Anchor.Left = AnchorStyle.asAnchor
			.Anchor.Bottom = AnchorStyle.asAnchor
			.SetBounds 90, 10, 510, 400
			.Designer = @This
			.OnResize = Cast(Sub(ByRef Designer As My.Sys.Object, ByRef Sender As Control, NewWidth As Integer, NewHeight As Integer), @PanelRender_Resize)
			.OnPaint = Cast(Sub(ByRef Designer As My.Sys.Object, ByRef Sender As Control, ByRef Canvas As My.Sys.Drawing.Canvas), @PanelRender_Paint)
			.Parent = @This
		End With
		' lblFPS
		With lblFPS
			.Name = "lblFPS"
			.Text = "FPS:"
			.TabIndex = 1
			.SetBounds 10, 40, 70, 20
			.Designer = @This
			.Parent = @This
		End With
		' cmdPause
		With cmdPause
			.Name = "cmdPause"
			.Text = ML("Pause")
			.TabIndex = 2
			.SetBounds 20, 70, 60, 20
			.Designer = @This
			.OnClick = Cast(Sub(ByRef Designer As My.Sys.Object, ByRef Sender As Control), @cmdPause_Click)
			.Parent = @This
		End With
		' cmdPlay
		With cmdPlay
			.Name = "cmdPlay"
			.Text = ML("Play")
			.TabIndex = 3
			.ControlIndex = 2
			.SetBounds 20, 100, 60, 20
			.Enabled = False 
			.Designer = @This
			.OnClick = Cast(Sub(ByRef Designer As My.Sys.Object, ByRef Sender As Control), @cmdPlay_Click)
			.Parent = @This
		End With
		' TrackBarFPS
		With TrackBarFPS
			.Name = "TrackBarFPS"
			.Text = "TrackBarFPS"
			.TabIndex = 4
			.ControlIndex = 4
			.Hint = ML("change the FPS")
			.MaxValue = 255
			.MinValue = 10
			.Position = speed
			.SetBounds 8, 55, 77, 10
			.Designer = @This
			.OnChange = Cast(Sub(ByRef Designer As My.Sys.Object, ByRef Sender As TrackBar, Position As Integer), @TrackBarFPS_Change)
			.Parent = @This
		End With
		' lblLanguage
		With lblLanguage
			.Name = "lblLanguage"
			.Text = ML("Language:") & App.CurLanguage
			.TabIndex = 5
			.ControlIndex = 1
			.SetBounds 10, 0, 80, 40
			.Designer = @This
			.Parent = @This
		End With
		' TimerFPS
		With TimerFPS
			.Name = "TimerFPS"
			.Interval = 50
			.Enabled = True
			.SetBounds 20, 170, 16, 16
			.Designer = @This
			.OnTimer = Cast(Sub(ByRef Designer As My.Sys.Object, ByRef Sender As TimerComponent), @TimerFPS_Timer)
			.Parent = @This
		End With
	End Constructor
	
	Dim Shared Form1 As Form1Type
	
	#if _MAIN_FILE_ = __FILE__
		App.DarkMode = False
		Form1.MainForm = True
		Form1.Show
		App.Run
	#endif
'#End Region

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

'the main rendering code.  渲染代码主过程。
Sub RenderProj(Param As Any Ptr)
	
End Sub

Private Sub Form1Type.Form_Create(ByRef Sender As Control)
	
End Sub

Private Sub Form1Type.Form_Resize(ByRef Sender As Control, NewWidth As Integer, NewHeight As Integer)
	
End Sub


Private Sub Form1Type.Form_Close(ByRef Sender As Form, ByRef Action As Integer)
	Ending = True
	
End Sub

Private Sub Form1Type.PanelRender_Resize(ByRef Sender As Control, NewWidth As Integer, NewHeight As Integer)
	
End Sub

Private Sub Form1Type.cmdPlay_Click(ByRef Sender As Control)
	Playing = True
	cmdPlay.Enabled = Not Playing
	cmdPause.Enabled = Playing
	If Playing Then RenderProj(0)
	TimerFPS.Enabled = Playing
End Sub

Private Sub Form1Type.cmdPause_Click(ByRef Sender As Control)
	Playing = False
	cmdPlay.Enabled = Not Playing
	cmdPause.Enabled = Playing
	If Playing Then RenderProj(0)
	TimerFPS.Enabled = Playing
End Sub

Private Sub Form1Type.TrackBarFPS_Change(ByRef Sender As TrackBar, Position As Integer)
	If Sender.Position < 10 Then Sender.Position = 10
	speed = Sender.Position
	lblFPS.Text = "FPS:" & speed
End Sub

Private Sub Form1Type.Form_Paint(ByRef Sender As Control, ByRef Canvas As My.Sys.Drawing.Canvas)
	
End Sub

Private Sub Form1Type.PanelRender_Paint(ByRef Sender As Control, ByRef Canvas As My.Sys.Drawing.Canvas)
	cairoSurface = cairo_win32_surface_create(Canvas.Handle)
	cairoCreate = cairo_create(cairoSurface)

		
		cairo_set_source_rgb(cairoCreate, 0, 0, 0)
		cairo_paint(cairoCreate)
		
		' circle for pivot
		cairo_arc(cairoCreate, 320, 320, 10, 0, 2 * PI) : cairo_set_source_rgb(cairoCreate, 0, 1, 1) : cairo_fill(cairoCreate)
		
		' Draw sticks
		cairo_move_to(cairoCreate, 320, 320) : cairo_line_to(cairoCreate, 320 + length * Sin(angle1), 320 + length * Cos(angle1)) : cairo_set_source_rgb(cairoCreate, 1, 0, 1) : cairo_stroke(cairoCreate)
		cairo_arc(cairoCreate, 320 + length * Sin(angle1), 320 + length * Cos(angle1), 15, 0, 2 * PI) : cairo_set_source_rgb(cairoCreate, 1, 0, 1) : cairo_fill(cairoCreate)
		cairo_move_to(cairoCreate, 320, 320) : cairo_line_to(cairoCreate, 320 + length * Sin(angle2), 320 + length * Cos(angle2)) : cairo_set_source_rgb(cairoCreate, 0, 1, 0) : cairo_stroke(cairoCreate)
		cairo_arc(cairoCreate, 320 + length * Sin(angle2), 320 + length * Cos(angle2), 15, 0, 2 * PI) : cairo_set_source_rgb(cairoCreate, 0, 1, 0) : cairo_fill(cairoCreate)
		cairo_move_to(cairoCreate, 320, 320) : cairo_line_to(cairoCreate, 320 + length * Sin(angle3), 320 + length * Cos(angle3)) : cairo_set_source_rgb(cairoCreate, 1, 1, 0) : cairo_stroke(cairoCreate)
		cairo_arc(cairoCreate, 320 + length * Sin(angle3), 320 + length * Cos(angle3), 15, 0, 2 * PI) : cairo_set_source_rgb(cairoCreate, 1, 1, 0) : cairo_fill(cairoCreate)
		cairo_move_to(cairoCreate, 320, 320) : cairo_line_to(cairoCreate, 320 + length * Sin(angle4), 320 + length * Cos(angle4)) : cairo_set_source_rgb(cairoCreate, 0, 1, 1) : cairo_stroke(cairoCreate)
		cairo_arc(cairoCreate, 320 + length * Sin(angle4), 320 + length * Cos(angle4), 15, 0, 2 * PI) : cairo_set_source_rgb(cairoCreate, 0, 1, 1) : cairo_fill(cairoCreate)
		cairo_move_to(cairoCreate, 320, 320) : cairo_line_to(cairoCreate, 320 + length * Sin(angle5), 320 + length * Cos(angle5)) : cairo_set_source_rgb(cairoCreate, 1, 0, 0) : cairo_stroke(cairoCreate)
		cairo_arc(cairoCreate, 320 + length * Sin(angle5), 320 + length * Cos(angle5), 15, 0, 2 * PI) : cairo_set_source_rgb(cairoCreate, 1, 0, 0) : cairo_fill(cairoCreate)
		cairo_move_to(cairoCreate, 320, 320) : cairo_line_to(cairoCreate, 320 + length * Sin(angle6), 320 + length * Cos(angle6)) : cairo_set_source_rgb(cairoCreate, 1, 1, 1) : cairo_stroke(cairoCreate)
		cairo_arc(cairoCreate, 320 + length * Sin(angle6), 320 + length * Cos(angle6), 15, 0, 2 * PI) : cairo_set_source_rgb(cairoCreate, 1, 1, 1) : cairo_fill(cairoCreate)
		Form1.lblFPS.Text = "FPS:" & speed
		
	cairo_destroy(cairoCreate)
	cairo_surface_destroy(cairoSurface)
End Sub

Private Sub Form1Type.TimerFPS_Timer(ByRef Sender As TimerComponent)
		' Calculate acceleration
		accel1 = -g / length * Sin(angle1)
		accel2 = -g / length * Sin(angle2)
		accel3 = -g / length * Sin(angle3)
		accel4 = -g / length * Sin(angle4)
		accel5 = -g / length * Sin(angle5)
		accel6 = -g / length * Sin(angle6)
		
		' Update velocities
		vel1 += accel1 * dt
		vel2 += accel2 * dt
		vel3 += accel3 * dt
		vel4 += accel4 * dt
		vel5 += accel5 * dt
		vel6 += accel6 * dt
		
		' Update angles
		angle1 += vel1 * dt
		angle2 += vel2 * dt
		angle3 += vel3 * dt
		angle4 += vel4 * dt
		angle5 += vel5 * dt
		angle6 += vel6 * dt
		App.DoEvents
		PanelRender.Repaint
		Sleep regulate(speed, fps), 1
		
End Sub

Post Reply