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