Results 1 to 7 of 7

Thread: Proment modul

  1. #1
    Senior Member Lionheart008's Avatar
    Join Date
    Sep 2008
    Location
    Germany, Bad Sooden-Allendorf
    Age
    51
    Posts
    934
    Rep Power
    109

    Proment modul

    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
    Attached Files Attached Files
    Last edited by Lionheart008; 30-01-2024 at 22:00.
    you can't always get what you want, but if you try sometimes you might find, you get what you need

  2. #2
    thinBasic author ErosOlmi's Avatar
    Join Date
    Sep 2004
    Location
    Milan - Italy
    Age
    57
    Posts
    8,782
    Rep Power
    10
    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
    www.thinbasic.com | www.thinbasic.com/community/ | help.thinbasic.com
    Windows 10 Pro for Workstations 64bit - 32 GB - Intel(R) Xeon(R) W-10855M CPU @ 2.80GHz - NVIDIA Quadro RTX 3000

  3. #3
    Senior Member Lionheart008's Avatar
    Join Date
    Sep 2008
    Location
    Germany, Bad Sooden-Allendorf
    Age
    51
    Posts
    934
    Rep Power
    109
    Yes wait please some days more to come soon ciao Frank
    you can't always get what you want, but if you try sometimes you might find, you get what you need

  4. #4
    Senior Member Lionheart008's Avatar
    Join Date
    Sep 2008
    Location
    Germany, Bad Sooden-Allendorf
    Age
    51
    Posts
    934
    Rep Power
    109
    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
    
    Attached Files Attached Files
    Last edited by Lionheart008; 10-02-2024 at 21:27.
    you can't always get what you want, but if you try sometimes you might find, you get what you need

  5. #5
    Senior Member Lionheart008's Avatar
    Join Date
    Sep 2008
    Location
    Germany, Bad Sooden-Allendorf
    Age
    51
    Posts
    934
    Rep Power
    109
    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
    
    you can't always get what you want, but if you try sometimes you might find, you get what you need

  6. #6
    Senior Member Lionheart008's Avatar
    Join Date
    Sep 2008
    Location
    Germany, Bad Sooden-Allendorf
    Age
    51
    Posts
    934
    Rep Power
    109

    Arrays and Type example with proment / thinbasic

    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
    
    you can't always get what you want, but if you try sometimes you might find, you get what you need

  7. #7
    Senior Member Lionheart008's Avatar
    Join Date
    Sep 2008
    Location
    Germany, Bad Sooden-Allendorf
    Age
    51
    Posts
    934
    Rep Power
    109

    SDK window frame minimal

    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
    
    Attached Images Attached Images
    Attached Files Attached Files
    Last edited by Lionheart008; 19-02-2024 at 21:55.
    you can't always get what you want, but if you try sometimes you might find, you get what you need

Members who have read this thread: 5

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •