Proment modul

[Lionheart008]

Hello all

Perhaps some Guys May Test this new Module for thinbasic

I have written proment during Corona time but First start was already in 2017...

A Test File you can find in rar package below

Place proment.dll and thinbasic_proment.dll in Lib folder so all must Work I Hope so
All written in freebasic and oxgenbasic




uses "proment"

string pros

pros="
long a,b,c

a=365 : b=2023 : c=a*b+31

print "Hello myWorld! Our days on earth: "+c
'result: 738426
"
ha_basis pros
ha_drive




Regards frank

[ErosOlmi]

Ciao Frank,


can you please give more info on what this module is about?
Which a re the functions, what they do and what is the syntax to call them?


Thanks
Eros

[Lionheart008]

Yes wait please some days more to come soon :) ciao Frank

[Lionheart008]

Hello again Made some Progress on freebasic site and my Editor is nearly ready

Here are two new examples with proment Module
I have added a short Legend too. More to come later... Thx





'
' - short "proment" module legend for simple examples using thinbasic:
' - a) you need only a string to start, b) code example with usual types, dim, float, long, string, arrays etcpp,
' - c) "ha_basis" at the end and "ha_drive" you need for execution the script example that's all
' - jan-feb2024
'
uses "proment"

string pros

pros="

'classes

'1)
class multiply
method thor(n as float) as float
return n*n*n*n
end method
end class

dim multiply ui
print ui.thor 4 'result: 256

'2)
class multiply
method thor(k as float,p as float) as float
return k*k*k*p*p*p
end method
end class

dim multiply loky
print loky.thor(4,8) 'result: 32768

"
ha_basis pros
ha_drive

[Lionheart008]

And Here a little Speed Test adapted from oxygen Site



'
' - short "proment" module legend for simple examples using thinbasic:
' - a) you need only a string to start, b) code example with usual types, dim, float, long, string, arrays etcpp,
' - c) "ha_basis" at the end and "ha_drive2" you need for execution the script example that's all
' - jan-feb2024
'
uses "proment"

string pros

pros="

'timer example with array redim

Type SYSTEMTIME
word wYear
word wMonth
word wDayOfWeek
word wDay
word wHour
word wMinute
word wSecond
word wMilliseconds
End Type

Declare GetSystemTime LIB "KERNEL32.DLL" ( SYSTEMTIME *lpSystemTime )
Declare GetLocalTime Lib "kernel32.dll" ( ByRef lpSystemTime As SYSTEMTIME )

function TimeLapsesMis(SYSTEMTIME *ti1,*ti2) as long
===============================================
'<60 second timer
long tad = ti2.wMilliSeconds-ti1.wMilliseconds+
((ti2.wSecond-ti1.wSecond)*1000)+
((ti2.wMinute-ti1.wMinute)*60000)+
((ti2.wHour-ti1.wHour)*3600000)+
((ti2.wDayOfWeek-ti1.wDayOfWeek)*86400000)
'
'end of week crossing
if tad<0 then tad+=604800000
return tad
end function

'---Variables declaration
dim MaxCount as long
maxCount = 1e7 '10 million
'maxCount = 10000000
SYSTEMTIME thisTime0
SYSTEMTIME thisTime1

'---Start time
GetSystemTime thisTime0

'---Dimension the array
redim int MyArray(maxcount)
' int=long integer 32 bit

dim count as long
'---Fill the array
for Count = lbound(MyArray) to ubound(MyArray)
MyArray(Count) = Count*Count '^2
next
'---End time
GetSystemTime thisTime1

'format 'str better here
print "total time to fill an EXT array of " + MaxCount + " elements: " + str(TimeLapsesMis(thisTime0,thisTime1), "###") + " msecs"

"
ha_basis pros
ha_drive

[Lionheart008]

Here are two examples in one Script :)

Array and Type example



'--- Script created on 02-12-2024 22:17:39 by frank bruebach
'--- proment module, thinbasic: two examples: type example + array example
'
uses "proment"

string arri

arri="
' type example
'
type fish64
a as byte
b as byte
c as byte
dx as byte
st as string
end type

dim v as fish64

v.a=16
v.b=16
v.c=16
v.dx=32
v.st="hai: "

print v.st + hex (v.dx) 'hai: 20

' array example
'
dim as long a(12)=>(2,4,6,8,10,12,14,16,18,20)
a(12)=a(1)+a(4)+a(6)
'2+8+12 = 22

print a(12) 'result: 22
"
ha_basis arri
ha_drive

[Lionheart008]

Much more interesting stuff...

Window frame SDK style with minimal source
All Files until today you can find in rar folder below



'-- create a minimal sdk window frame, promen/thinbasic, pure
'-- 19-02-2024 by lionheart008, frank
'
uses "proment"

string swin

swin="

'----- window sdk style, thinbasic module promen
'----- 19-02-2024, by lionheart008, frank
'
type WNDCLASS
;40 bytes
STYLE as long
lpfnwndproc as long
cbClsextra as long
cbWndExtra as long
hInstance as long
hIcon as long
hCursor as long
hbrBackground as long
lpszMenuName as long
lpszClassName as long
end type

type point
x as long
y as long
end type

type MSG
; 28 bytes
hwnd as long
message as long
wParam as long
lParam as long
time as long
pt as point
end type

dim kernel32,user32,GDI32 as long
kernel32=LoadLibrary `kernel32.dll`
user32=LoadLibrary `user32.dll`
GDI32=LoadLibrary `GDI32.dll`

bind kernel32
(
GetCommandLine GetCommandLineA ; @0
GetModuleHandle GetModuleHandleA ; @4
ExitProcess ExitProcess ; @4
)

bind user32
(
LoadIcon LoadIconA ; @8
LoadCursor LoadCursorA ; @8
RegisterClass RegisterClassA ; @4
MessageBox MessageBoxA ; @4
CreateWindowEx CreateWindowExA ; @48
ShowWindow ShowWindow ; @8
UpdateWindow UpdateWindow ; @4
GetMessage GetMessageA ; @16
TranslateMessage TranslateMessage ; @4
DispatchMessage DispatchMessageA ; @4
PostQuitMessage PostQuitMessage ; @4
BeginPaint BeginPaint ; @8
EndPaint EndPaint ; @8
GetClientRect GetClientRect ; @8
DrawText DrawTextA ; @20
PostMessage PostMessageA ; @16
DefWindowProc DefWindowProcA ; @16
)

extern lib "user32.dll"
! GetSystemMetrics
! invalidaterect
end extern

extern lib "gdi32.dll"
! SetDCpencolor
! SetDCbrushcolor
! SelectObject
! MovetoEx
! lineto

long Rectangle (long hdc,X1,Y1,X2,Y2)
long Ellipse (long hdc,X1,Y1,X2,Y2)
end extern

bind GDI32
(
SetBkColor SetBkColor ; @16
SetTextColor SetTextColor ; @16
GetStockObject GetStockObject ; @4
)

string st=error() : if st then print st

% CS_VREDRAW 1
% CS_HREDRAW 2
% IDI_APPLICATION 32512
% IDC_ARROW 32512
% WHITE_BRUSH 0
% MB_ICONERROR 16
% SM_CXSCREEN 0
% SM_CYSCREEN 1

type RECT
; 16 bytes
left as long
top as long
right as long
bottom as long
end type

type rgbacolor
red as byte
green as byte
blue as byte
alpha as byte
end type

type PAINTSTRUCT
; 64 bytes
hDC as long
fErase as long
rcPaint as rect
fRestore as long
fIncUpdate as long
rgb as rgbacolor
Reserved as 32
end type

% WM_CREATE 1
% WM_DESTROY 2
% WM_PAINT 15
% WM_CLOSE 16
% WM_KEYDOWN 256
% WM_TIMER &h113


'Common RGB Colors
% BLACK = &H000000
% BLUE = &HFF0000
% GREEN = &H00FF00
% CYAN = &HFFFF00
% RED = &H0000FF
% MAGENTA = &HFF00FF
% YELLOW = &H00FFFF
% WHITE = &HFFFFFF
% GRAY = &H808080
% LTGRAY = &HC0C0C0


Def SW_NORMAL 1
Def SW_SHOWDEFAULT 10
Def CS_VREDRAW 1
Def CS_HREDRAW 2
Def IDI_APPLICATION 32512
Def IDC_ARROW 32512
Def WHITE_BRUSH 0
Def BLACK_BRUSH 4
Def WM_CREATE 1
Def WM_DESTROY 2
Def WM_PAINT 15
Def WM_CLOSE 16
Def WM_QUIT 18
Def WM_SIZE 5
Def CW_USEDEFAULT 0x80000000
Def WS_OVERLAPPEDWINDOW 0x00cf0000
Def WS_DLGFRAME 0x400000
Def PM_REMOVE 1
Def SW_SHOW 5
Def SM_CXSCREEN 0
Def SM_CYSCREEN 1
Def WM_INPUT 0x0FF
Def WM_KEYFIRST 0x100
Def WM_KEYDOWN 0x100
Def WM_KEYUP 0x101
Def WM_TIMER 0x113
Def ID_Timer 3000
Def Interval 100
Def WM_INITDIALOG 0x110

Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Declare Function InvalidateRect Lib "user32.dll" (ByVal hwnd As Long, ByRef lpRect As RECT, ByVal bErase As Long) As Long
Declare Function ValidateRect Lib "user32.dll" (ByVal hwnd As Long, ByRef lpRect As RECT) As Long
Declare Function Rectangle Lib "gdi32.dll" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Declare Function Ellipse Lib "gdi32.dll" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Declare Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long
DECLARE FUNCTION SetTimer LIB "USER32.DLL" (BYVAL hWnd AS DWORD, BYVAL nIDEvent AS LONG, BYVAL uElapse AS DWORD, BYVAL lpTimerFunc AS LONG) AS LONG
DECLARE FUNCTION KillTimer LIB "USER32.DLL" (BYVAL hWnd AS DWORD, BYVAL nIDEvent AS LONG) AS LONG

DECLARE FUNCTION SetDCPenColor lib "GDI32.DLL" alias "SetDCPenColor" ( _
BYVAL hdc AS DWORD _
, BYVAL color AS DWORD _
) AS DWORD

DECLARE FUNCTION SetDCBrushColor lib "GDI32.DLL" alias "SetDCBrushColor" ( _
BYVAL hdc AS DWORD _
, BYVAL color AS DWORD _
) AS DWORD

DECLARE FUNCTION MoveToEx lib "GDI32.DLL" alias "MoveToEx" ( _
BYVAL hdc AS DWORD _
, BYVAL x AS LONG _
, BYVAL y AS LONG _
, OPTIONAL BYREF lppt AS POINT _
) AS LONG

DECLARE FUNCTION LineTo lib "GDI32.DLL" ALIAS "LineTo" ( _
BYVAL hdc AS DWORD _
, BYVAL x AS LONG _
, BYVAL y AS LONG _
) AS LONG

'------------------- windows sdk entry point ------ //
'
dim cmdline as asciiz ptr
dim hinst as long
@cmdline=GetCommandLine
hinst=GetModuleHandle 0
'
'----------------------------------------------------------------------------
Function Windowsdk(long hinst, prevInst, asciiz*cmdline, long show) as long
'============================================================================

WndClass wsx
MSG wms

sys hwnd, swd, sht, stx, sty, pax
with wsx
.style = CS_HREDRAW or CS_VREDRAW
.lpfnWndProc = @WndProc
.cbClsExtra =0
.cbWndExtra =0
.hInstance =hinst
.hIcon=LoadIcon 0, IDI_APPLICATION
.hCursor=LoadCursor 0,IDC_ARROW
.hbrBackground = GetStockObject WHITE_BRUSH
.lpszMenuName =null
.lpszClassName = strptr "Demo"
end with
RegisterClass (@wsx)

swd = 640 : sht = 480
Pax = GetSystemMetrics SM_CXSCREEN
stx = (pax - swd) /2
Pax = GetSystemMetrics SM_CYSCREEN
sty = (pax - sht) /2

hwnd = CreateWindowEx 0,wsx.lpszClassName,"PROMETHAN BASIC",WS_OVERLAPPEDWINDOW,stx,sty,swd,sht,0,0,hinst,0
ShowWindow hwnd,SW_SHOW
UpdateWindow hwnd
'
sys cRet
'
do while cRet := GetMessage (@wms, 0, 0, 0)
if cRet = -1 then
'show an error message
else
TranslateMessage @wms
DispatchMessage @wms
end if
wend
End Function

dim as rect trect

'--------------------------------------------------------------------
function WndProc ( long hWnd, wMsg, wParam, lparam ) as long callback
'====================================================================

static as sys hdc
static as String st
static as PaintStruct Paintst

'==========
select wMsg
'==========

'--------------
case WM_CREATE
'=============
GetClientRect hWnd,tRect

'--------------
case WM_DESTROY
'===============
PostQuitMessage 0

'------------
case WM_PAINT
'============
GetClientRect hWnd,tRect
hDC=BeginPaint hWnd,Paintst
SetBkColor hdc,green
SetTextColor hdc,blue
DrawText hDC,"Hello my new World!",-1,tRect,0x25
EndPaint hWnd,Paintst

'--------------
case WM_KEYDOWN
'==============

'============
Select wParam
'============
Case 27 : SendMessage hwnd, WM_CLOSE, 0, 0 'ESCAPE

End Select

'--------
case else
'========
function=DefWindowProc hWnd,wMsg,wParam,lParam
end select

end function
'
' call windowsdk at the end of script
'------------------------------------ //
Windowsdk hinst,0,cmdline,SW_NORMAL
'------------------------------------ //
"
ha_basis swin
ha_drive