'-- 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
Bookmarks