Code: Select all
' Event Constants
Const REDRAW_EVENT = 1
Const KEY_EVENT = 2
Const BUTTON_EVENT = 3
Const MOUSE_EVENT = 6
' Window Style Constants
Const WS_SKINNED_FIXED = &H4000000
Const WS_SKINNED_SIZABLE = &H3000000
Const WS_FIXED = &H0000000
Const WS_SIZABLE = &H2000000
Const WS_FILL_TRANSPARENT = &B1000000000000000000000000000000
Const WS_FILL_GRADIENT = &B10000000000000000000000000000000
Const WS_COORD_CLIENT = &B100000000000000000000000000000
Const WS_CAPTION = &B10000000000000000000000000000
' Caption styles
Const CAPTION_MOVABLE = &H00000000
Const CAPTION_NONMOVABLE = &H01000000
' FR_FLAGS
Const FR_CAPTION = &B00001
Const FR_DOUBLE = &B00000
Const FR_RAISED = &B00010
Const FR_SUNKEN = &B00100
Const FR_ETCHED = &B00110
Const FR_RIDGED = &B01000
Const FR_FILLED = &B10000
' FR_TEXT_POSITION
Const FR_TEXT_POS_BOTTOM = 1
Const FR_TEXT_POS_TOP = 0
Type Size
Height As UShort
Width As UShort
End Type
Type Frame
Style As ULong
Width As UShort
Left As UShort
Height As UShort
Top As UShort
Outer_color As ULong
Inner_color As ULong
Flags As ULong
Text As ZString Ptr
Text_position As ULong
Font As ULong
Font_height As ULong
Fore_color As ULong
Back_color As ULong
End Type
Type Rect
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Dim Shared Scr As Size
Dim Shared Wnd As Rect
Dim Shared hBoxLib As Long
Dim Shared Frame1 As Frame
Dim Shared Frame2 As Frame
Dim Shared Frame3 As Frame
Dim Shared Frame4 As Frame
Dim Shared Frame5 As Frame
Declare Function WaitEvent() As Long
Declare Function GetKeyCode() As Long
Declare Function GetButton() As Long
Declare Function GetScreenSize() As Size
Declare Function GetSkinHeight() As ULong
Declare Function LoadLibrary(filename As ZString) As Long
Declare Function GetProcAddress(hLib As Long, ProcName As ZString) As Long
Declare Sub DrawWindow(WLeft As Long, WTop As Long, WRight As Long, WBottom As Long, Caption As ZString, BackColor As ULong, Style As ULong, CapStyle As ULong)
Declare Sub On_Redraw()
Declare Sub On_KeyPress()
Declare Sub On_ButtonPress()
Dim Shared FrameDraw As Sub(frame As frame)
'* -------------------------------------------------------- *'
#Undef RGB
#Define RGB(r,g,b) ((cuint(r) shl 16) or (cuint(g) shl 8) or Cuint(b))
'* -------------------------------------------------------- *'
#Macro ThreadTerminate()
Asm
mov eax, -1
int 64
End Asm
#EndMacro
'* -------------------------------------------------------- *'
#Macro BeginDraw()
Asm
mov eax, 12
mov ebx, 1
int 64
End Asm
#EndMacro
'* -------------------------------------------------------- *'
#Macro EndDraw()
Asm
mov eax, 12
mov ebx, 2
int 64
End Asm
#EndMacro
'* -------------------------------------------------------- *'
Sub Main()
Scr = GetScreenSize()
Wnd.Right = 731
Wnd.Bottom = 127
Wnd.Left = (Scr.width - Wnd.Right) Shr 1
Wnd.Top = (Scr.height - Wnd.Bottom) Shr 1
hBoxLib = LoadLibrary("/sys/lib/box_lib.obj")
FrameDraw = GetProcAddress(hBoxLib, "frame_draw")
With Frame1
.style = 0
.width = 131
.left = 8
.height = 81
.top = 13
.outer_color = &H00FFFFFF
.inner_color = &H00808080
.flags = FR_RAISED OR FR_CAPTION OR FR_FILLED
.text = @" raised "
.text_position = FR_TEXT_POS_TOP
.font = 1
.font_height = 16
.fore_color = RGB(200, 0, 0)
.back_color = &H00D0D0D0
End With
With Frame2
.style = 0
.width = 131
.left = 152
.height = 81
.top = 13
.outer_color = &H00FFFFFF
.inner_color = &H00808080
.flags = FR_SUNKEN OR FR_CAPTION
.text = @" sunken "
.text_position = FR_TEXT_POS_BOTTOM
.font = 1
.font_height = 16
.fore_color = RGB(0, 200, 0)
.back_color = &HD4D0C8
End With
With Frame3
.style = 0
.width = 131
.left = 296
.height = 81
.top = 13
.outer_color = &H00FFFFFF
.inner_color = &H00808080
.flags = FR_ETCHED OR FR_CAPTION OR FR_FILLED
.text = @" etched "
.text_position = FR_TEXT_POS_TOP
.font = 1
.font_height = 16
.fore_color = RGB(0, 0, 200)
.back_color = &H00D0D0D0
End With
With Frame4
.style = 0
.width = 131
.left = 440
.height = 81
.top = 13
.outer_color = &H00FFFFFF
.inner_color = &H00808080
.flags = FR_RIDGED OR FR_CAPTION
.text = @" ridged "
.text_position = FR_TEXT_POS_BOTTOM
.font = 1
.font_height = 16
.fore_color = RGB(200, 0, 200)
.back_color = &HD4D0C8
End With
With Frame5
.style = 0
.width = 131
.left = 584
.height = 81
.top = 13
.outer_color = &H00FFFFFF
.inner_color = &H00808080
.flags = FR_DOUBLE OR FR_CAPTION OR FR_FILLED
.text = @" double "
.text_position = FR_TEXT_POS_TOP
.font = 1
.font_height = 16
.fore_color = RGB(0, 200, 200)
.back_color = &H00D0D0D0
End With
Do
Select Case WaitEvent()
Case REDRAW_EVENT : On_Redraw
Case KEY_EVENT : On_KeyPress
Case BUTTON_EVENT : On_ButtonPress
End Select
Loop
End Sub
'* -------------------------------------------------------- *'
Sub On_KeyPress()
GetKeyCode
End Sub
'* -------------------------------------------------------- *'
Sub On_ButtonPress()
Select Case GetButton() Shr 8
Case 1
ThreadTerminate()
End Select
End Sub
'* -------------------------------------------------------- *'
Sub On_Redraw()
BeginDraw()
DrawWindow Wnd.Left, Wnd.Top, Wnd.Right, Wnd.Bottom, "Frames", RGB(192, 192, 192), WS_SKINNED_FIXED + WS_COORD_CLIENT + WS_CAPTION, CAPTION_MOVABLE
FrameDraw(Frame1)
FrameDraw(Frame2)
FrameDraw(Frame3)
FrameDraw(Frame4)
FrameDraw(Frame5)
EndDraw()
End Sub
'* -------------------------------------------------------- *'
Sub DrawWindow(WLeft As Long, WTop As Long, WRight As Long, WBottom As Long, Caption As ZString, BackColor As ULong, Style As ULong, CapStyle As ULong)
Asm
xor eax, eax
mov ebx, [WLeft]
shl ebx, 16
add ebx, [WRight]
mov ecx, [WTop]
shl ecx, 16
add ecx, [WBottom]
mov edx, [Style]
or edx, [BackColor]
mov edi, [Caption]
mov esi, [CapStyle]
int 64
End Asm
End Sub
'* -------------------------------------------------------- *'
Function WaitEvent Naked() As Long
Asm
mov eax, 10
int 64
ret
End Asm
End Function
'* -------------------------------------------------------- *'
Function GetKeyCode Naked() As Long
Asm
mov eax, 2
int 64
ret
End Asm
End Function
'* -------------------------------------------------------- *'
Function GetButton Naked() As Long
Asm
mov eax, 17
int 64
ret
End Asm
End Function
'* -------------------------------------------------------- *'
Function GetScreenSize Naked() As Size
Asm
push ebx
mov eax, 61
mov ebx, 1
int 64
pop ebx
ret
End Asm
End Function
'* -------------------------------------------------------- *'
Function GetSkinHeight Naked() As ULong
Asm
push ebx
mov eax, 48
mov ebx, 4
int 64
pop ebx
ret
End Asm
End Function
'* -------------------------------------------------------- *'
Function LoadLibrary(filename As ZString) As Long
Asm
mov eax, 68
mov ebx, 19
mov ecx, [filename]
int 64
mov [Function], eax
End Asm
End Function
'* -------------------------------------------------------- *'
Function GetProcAddress(hLib As Long, procname As ZString) As Long
Asm
mov edx, [hLib]
xor eax, eax
test edx, edx
jz 2f
' -----------------------
1:
cmp dword ptr [edx], 0
jz 2f
xor eax, eax
mov esi, [edx]
mov edi, [procname]
' -----------------------
0:
lodsb
scasb
jne 0f
or al, al
jnz 0b
jmp 1f
' -----------------------
0:
add edx, 8
jmp 1b
' -----------------------
1:
mov eax, [edx + 4]
' -----------------------
2:
mov [Function], eax
End Asm
End Function
!