/*  Include 64Bit for OxygenBasic by P. Wirbelauer 20/02/2012  */

'17:31 10/04/2023 CP

uses corewin

Indexbase 0

Type DEVMODE
  zstring dmDeviceName[32]    
  dmSpecVersion   as word    
  dmDriverVersion as word    
  dmSize          as word    
  dmDriverExtra   as word    
  dmFields        as long    
  dmOrientation   as word   
  dmPaperSize     as word   
  dmPaperLength   as word   
  dmPaperWidth    as word   
  dmScale         as word   
  dmCopies        as word   
  dmDefaultSource as word   
  dmPrintQuality  as word   
  dmColor         as word   
  dmDuplex        as word   
  dmYResolution   as word   
  dmTTOption      as word   
  dmCollate       as word   
  zstring dmFormName[32]    
  dmUnusedPadding as word   
  dmBitsPerPel    as long   
  dmPelsWidth     as long   
  dmPelsHeight    as long   
  dmDisplayFlags  as long   
  dmDisplayFrequency   as long  
  dmDisplayOrientation as long
End Type                     


Type OVERLAPPED
  ternal     As Long
  ternalHigh As Long
  offset     As Long
  OffsetHigh As Long
  hEvent     As Long
End Type

Type SECURITY_ATTRIBUTES
  nLength              As Long
  lpSecurityDescriptor As Long
  bInheritHandle       As Long
End Type

Type XFORM
  eM11 as Single
  eM12 as Single
  eM21 as Single
  eM22 as Single
  eDx  as Single
  eDy  as Single
End Type

Type SIZE
  cx As Long
  cy As Long
End Type

typedef POINT POINTAPI

Type BITMAP
  bmType       as Long
  bmWidth      as Long
  bmHeight     as Long
  bmWidthBytes as Long
  bmPlanes     as short
  bmBitsPixel  as short
  bmBits       as sys
End Type

Type BLENDFUNCTION
  BlendOp             as Byte
  BlendFlags          as Byte
  SourceConstantAlpha as Byte
  AlphaFormat         as Byte
End Type

Type TRGB
  r As sys
  g As sys
  b As sys
End Type

Type THLS
  h As Integer
  l As Integer
  s As Integer
End Type


% FW_DONTCARE    = 0
% FW_THIN        = 100
% FW_EXTRALIGHT  = 200
% FW_LIGHT       = 300
% FW_NORMAL      = 400
% FW_MEDIUM      = 500
% FW_SEMIBOLD    = 600
% FW_BOLD        = 700
% FW_EXTRABOLD   = 800
% FW_HEAVY       = 900

% DM_PELSWIDTH   = 0x80000
% DM_PELSHEIGHT  = 0x100000
% DM_BITSPERPEL  = 0x40000
% DI_MASK        = 1
% DI_IMAGE       = 2
% DI_NORMAL      = 3 

% GM_COMPATIBLE  = 1
% GM_ADVANCED    = 2
% MWT_IDENTITY   = 1
% MWT_LEFTMULTIPLY  = 2
% MWT_RIGHTMULTIPLY = 3
% MWT_MIN = 2
% MWT_MAX = 3

% MM_TEXT        = 1
% MM_LOMETRIC    = 2
% MM_HIMETRIC    = 3
% MM_LOENGLISH   = 4
% MM_HIENGLISH   = 5
% MM_TWIPS       = 6
% MM_ISOTROPIC   = 7
% MM_ANISOTROPIC = 8

% GENERIC_WRITE  = 0x40000000
% GENERIC_READ   = 0x80000000
% FILE_SHARE_READ  = 1
% FILE_SHARE_WRITE = 2
% OPEN_EXISTING  = 3
% OPEN_ALWAYS    = 4
% MB_OKCANCEL    = 1
% MB_OK          = 0
% MB_YESNO       = 4
% FILE_BEGIN     = 0
% FILE_CURRENT   = 1
% FILE_END       = 2

% CS_VREDRAW     = 1
% CS_HREDRAW     = 2
% CS_OWNDC       = 32
% SM_CXSCREEN    = 0
% SM_CYSCREEN    = 1
% IDI_WINLOGO    = 32517
% IDC_ARROW      = 32512
% PS_SOLID       = 0
% DC_PEN         = 19

% PM_REMOVE      = 1
% PM_NOREMOVE    = 0
% NULL_BRUSH     = 5
% BLACKNESS      = 0x42
% WHITENESS      = 0xFF0062

% FW_THIN       100
% FW_EXTRALIGHT 200
% FW_LIGHT      300
% FW_NORMAL     400
% FW_MEDIUM     500
% FW_SEMIBOLD   600
%  FW_EXTRABOLD  800
% FW_BOLD       700
% FW_HEAVY      900

% WHITE_BRUSH   0
% BLACK_BRUSH   4

Declare Function SetRect           Lib "user32.dll" (ByRef lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Declare Function DrawCaption       Lib "user32.dll" (ByVal hWnd As Long, ByVal hDC As Long, ByRef pcRect As Rect, ByVal un As Long) As Long
Declare Function GetWindowRect     Lib "user32.dll" (ByVal hwnd As Long, ByRef lpRect As RECT) As Long
Declare Function MoveWindow        Lib "user32.dll" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Declare Function LoadIconA         Lib "user32.dll" (ByVal hInstance As Long, ByVal lpIconName As String) As Long
Declare Function DrawIconEx        Lib "user32.dll"  (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long
Declare Function AlphaBlend        Lib "msimg32.dll" (ByVal hdcDest As sys, ByVal xDest As Long, ByVal yDest As Long, ByVal WidthDest As Long, ByVal HeightDest As Long, ByVal hdcSrc As sys, ByVal xSrc As Long, ByVal ySrc As Long, ByVal WidthSrc As Long, ByVal HeightSrc As Long, ByVal Blendfunc As Long) As Long
Declare Function Rectangle         Lib "gdi32.dll"   (ByVal hdc As sys, ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long) As Long
Declare Function MoveToEx          Lib "gdi32.dll" (ByVal hdc As sys, ByVal x As Long, ByVal y As Long, ByRef lpPoint As POINTAPI) As Long
Declare Function Ellipse           Lib "gdi32.dll" (ByVal hdc As sys, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Declare Function LineTo            Lib "gdi32.dll" (ByVal hdc As sys, ByVal x As Long, ByVal y As Long) As Long
Declare Function CreatePen         Lib "gdi32.dll" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Declare Function RoundRect         Lib "gdi32.dll" (ByVal hdc As sys, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Declare Function GetClientRect     Lib "user32.dll" (ByVal hwnd As sys, ByRef lpRect As RECT) As Long
Declare Function StretchBlt        Lib "gdi32.dll" (ByVal hdc As sys, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As sys, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Declare Function FillRect          Lib "user32.dll" (ByVal hdc As sys, ByRef lpRect As RECT, ByVal hBrush As sys) As Long
Declare Function SetPixelV         Lib "gdi32.dll" (ByVal hdc As sys, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Declare Function SetPixel          Lib "gdi32.dll" (ByVal hdc As sys, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Declare Function GetPixel          Lib "gdi32.dll" (ByVal hdc As sys, ByVal x As Long, ByVal y As Long) As Long
Declare Function TextOut           Lib "gdi32.dll" Alias "TextOutA" (ByVal hdc As sys, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Declare Function DeleteDC          Lib "gdi32.dll" (ByVal hdc As sys) As Long
Declare Function PlayWav           Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As sys, ByVal dwFlags As Long) As Long
Declare Function CreateFont        Lib "gdi32.dll" Alias "CreateFontA" (ByVal H As Long, ByVal W As Long, ByVal E As Long, ByVal O As Long, ByVal W As Long, ByVal I As Long, ByVal u As Long, ByVal S As Long, ByVal C As Long, ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, ByVal PAF As Long, ByVal F As String) As sys
Declare Function SetCursorPos      Lib "user32.dll" (ByVal x As Long, ByVal y As Long) As Long
Declare Function timeGetTime       Lib "winmm.dll" () As Long
Declare Function DestroyWindow     Lib "user32.dll" (ByVal hwnd As sys) As Long
Declare Function SelectObject      Lib "gdi32.dll" (ByVal hdc As sys, ByVal hObject As sys) As Long
Declare Function DeleteObject      Lib "gdi32.dll" (ByVal hObject As sys) As Long
Declare Function GetObject         Lib "gdi32.dll" Alias "GetObjectA" (ByVal hObject As sys, ByVal nCount As Long, ByRef lpObject As Any) As long
Declare Function SetTextColor      Lib "gdi32.dll" (ByVal hdc As sys, ByVal crColor As Long) As Long
Declare Function SetWindowText     Lib "user32.dll" Alias "SetWindowTextA" (ByVal hwnd As sys, ByVal lpString As String) As Long
Declare Function TransparentBlt    Lib "msimg32.dll" (ByVal hdc As sys, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As sys, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal crTransparent As Long) As Long
Declare Function LoadImage         Lib "user32.dll" Alias "LoadImageA" (ByVal hInst As sys,ByVal lpsz As String,ByVal un1 As Long,ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As sys
Declare Function BitBlt            Lib "gdi32.dll" (ByVal hDestDC As sys, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As sys, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Declare Function CreateSolidBrush  Lib "gdi32.dll" (ByVal crColor As Long) As sys
Declare Function GetAsyncKeyState  Lib "user32.dll" (ByVal vKey As Long) As short
Declare Function SetStretchBltMode Lib "gdi32.dll" (ByVal hdc As sys, ByVal nStretchMode As Long) As Long
Declare Function SetWorldTransform Lib "gdi32.dll" (ByVal hdc As sys, ByRef lpXform As xform) As Long
Declare Function SetMapMode        Lib "gdi32.dll" (ByVal hdc As sys, ByVal nMapMode As Long) As Long
Declare Function SetGraphicsMode   Lib "gdi32.dll" (ByVal hdc As sys, ByVal iMode As Long) As Long
Declare Function SetWindowExtEx    Lib "gdi32.dll" (ByVal hdc As sys, ByVal nX As Long, ByVal nY As Long, ByRef lpSize As SIZE) As Long
Declare Function SetWindowOrgEx    Lib "gdi32.dll" (ByVal hdc As sys, ByVal nX As Long, ByVal nY As Long, ByRef lpPoint As POINTAPI) As sys
Declare Function SetViewportExtEx  Lib "gdi32.dll" (ByVal hdc As sys, ByVal nX As Long, ByVal nY As Long, ByRef lpSize As SIZE) As Long
Declare Function GetStdHandle      Lib "kernel32.dll" (ByVal nStdHandle As Long) As sys
Declare Function SetStdHandle      Lib "kernel32.dll" (ByVal nStdHandle As Long, ByVal hHandle As sys) As Long
Declare Function CloseHandle       Lib "kernel32.dll" (ByVal hObject As Long) As Long
Declare Function SetFilePointer    Lib "kernel32.dll" (ByVal hFile As Long, ByVal lDistanceToMove As Long, ByRef lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Declare Function GetFileSize       Lib "kernel32.dll" (ByVal hFile As Long, ByRef lpFileSizeHigh As Long) As Long
Declare Function ReadFileM         Lib "kernel32.dll" Alias "ReadFile" (ByVal hFile As Long, ByRef lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, ByRef lpNumberOfBytesRead As Long, ByRef lpOverlapped As OVERLAPPED) As Long
Declare Function WriteFileM        Lib "kernel32.dll" Alias "WriteFile" (ByVal hFile As Long, ByRef lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, ByRef lpNumberOfBytesWritten As Long, ByRef lpOverlapped As OVERLAPPED) As Long
Declare Function CreateFileM       Lib "kernel32.dll" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByRef lpSecurityAttributes As SECURITY_ATTRIBUTES, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Declare Function DeleteFile        Lib "kernel32.dll" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
Declare Function CopyFileM         Lib "kernel32.dll" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Declare Function CreateDirectoryM  Lib "kernel32.dll" Alias "CreateDirectoryA" (ByVal lpPathName As String, ByRef lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long

Declare Function MessageBox        Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long

Declare Function ColorHLSToRGB     Lib "shlwapi.dll" (ByVal wHue As Integer, ByVal wLuminance As Integer, ByVal wSaturation As Integer) As sys
Declare Sub      ColorRGBToHLS     Lib "shlwapi.dll" (ByVal clrRGB As Long, ByRef pwHue As Integer, ByRef pwLuminance As Integer, ByRef pwSaturation As Integer)
Declare Function EnumDisplaySettings   Lib "user32.dll" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean
Declare Function ChangeDisplaySettings Lib "user32.dll" Alias "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwflags As Long) As Long
Declare Function ModifyWorldTransform  Lib "gdi32.dll" (ByVal hdc As sys, ByRef lpXform As xform, ByVal iMode As Long) As Long
Declare Function CreateCompatibleDC    Lib "gdi32.dll" (ByVal hdc As sys) As sys
Declare Function CreateCompatibleBitmap Lib "gdi32.dll" (ByVal hdc As sys, ByVal nWidth As Long, ByVal nHeight As Long) As sys
Declare Function QueryPerformanceCounter Lib "kernel32.dll" (ByRef lpPerformanceCount As quad) As Long
Declare Function QueryPerformanceFrequency Lib "kernel32.dll" (ByRef lpFrequency As quad) As Long

Declare GetFocus Lib "user32.dll" () as sys



Dim cHLS  As THLS
Dim cRGB  As TRGB
Dim info  As BITMAP
Dim wm    As MSG
Dim wc    As WNDCLASS 
Dim rc    As RECT
Dim mForm As XFORM
Dim Blend As BLENDFUNCTION
Dim DevM  As DEVMODE

Dim BmpWidth (512) as sys
Dim BmpHeight(512) as sys
Dim BmpFrame (512) as sys
Dim icoHnd(512)    as sys
Dim icoHdc(512)    as sys
Dim iHnd(512)      as sys
Dim iHdc(512)      as sys
Dim THdc(512)      as sys
Dim THnd(512)      as sys    
Dim TWidth (512)   as sys
Dim THeight(512)   as sys
/*
Dim gHnd(512) as sys
Dim gHdc(512) as sys
Dim GrabWidth (512) as sys
Dim GrabHeight(512) as sys
*/
Dim xReso(16) as sys
Dim yReso(16) as sys
Dim sys_Seed  as sys
Dim sys_hdc   as sys
Dim sys_hwnd  as sys
Dim sys_xPos  as sys
Dim sys_yPos  as sys
Dim AscKey    as sys
Dim sys_color as sys
Dim xMouse    as sys
Dim yMouse    as sys
Dim WinExit   as sys

Quad sys_cT1,sys_cT2,sys_Freq                                                               
Quad sys_qc1,sys_qc2,sys_qf
Double sys_Interval               
sys sys_fjs,sys_Frames,sys_zs,Width,Height,bHnd,bHdc,sys_mode=3,MouseButton
'sys sys_fjs,sys_Frames,sys_zs,width,height,bHnd,bHdc,sys_mode=3,MouseButton
sys tmpH,tmpW,tmpP,Font_Width,Font_Height,Font_Flag, string Font_Name

xReso(0) = 640 : yReso(0) =480
xReso(1) = 800 : yReso(1) =600
xReso(2) =1024 : yReso(2) =768
xReso(3) =1152 : yReso(3) =864
xReso(4) =1280 : yReso(4) =720
xReso(5) =1280 : yReso(5) =768
xReso(6) =1280 : yReso(6) =800
xReso(7) =1280 : yReso(7) =960
xReso(8) =1280 : yReso(8) =1024
xReso(9) =1360 : yReso(9) =768
xReso(10)=1366 : yReso(10)=768
xReso(11)=1440 : yReso(11)=900
xReso(12)=1600 : yReso(12)=900
xReso(13)=1600 : yReso(13)=1024
xReso(14)=1680 : yReso(14)=1050
xReso(15)=1920 : yReso(15)=1080

Function HiWord (sys hi) as sys
shr hi,16
Return hi
End Function

Function LoWord (sys lo) as sys
and lo,0xFFFF 
Return lo
End Function

Function LoadFile(File As String, byref dest As Any) as sys  
sys Handle, count, dwc
Handle = CreateFileM(file, GENERIC_WRITE or GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, BYVAL 0, OPEN_ALWAYS, 0, 0) 
count  = GetFileSize Handle, Byval 0  
ReadFileM Handle,dest,count,@dwc,Byval 0
CloseHandle Handle
Return dwc
End Function

Sub SaveFile(File as string,byref dest As Any, sys count)   
sys Handle,dwc
Handle = CreateFileM(File, GENERIC_WRITE or GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, BYVAL 0, OPEN_ALWAYS, 0, 0) 
WriteFileM Handle,dest,count,@dwc,Byval 0
CloseHandle Handle
End Sub


Function FilePointer(sys h, anz) as sys
    return SetFilePointer h, anz, null, FILE_BEGIN
End Function


Function OpenFile(string File) as sys 
    sys Handle
    Handle = CreateFileM(File, GENERIC_WRITE or GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, BYVAL 0, OPEN_ALWAYS, 0, 0) 
    Function = Handle
End Function

Function FileSize(string Handle) as sys
    Function = GetFileSize Handle, Byval 0
End Function

Sub CloseFile(sys Handle)
    CloseHandle Handle
End Sub

Sub CopyFile(string FileA, FileB) 
sys yn 
iF FileA = FileB 
   yn=MessageBox 0, FileA + " already Exits! overwrite?","FILE ERROR",4 
   iF yn=7 Then Exit Sub
   iF yn=6 Then CopyFileM FileA, FileB, 0
Else
   CopyFileM FileA, FileB, 0  
End iF 
End Sub

Sub ReadFile(Byval Handle As Long, Byref ziel As Any, Byval anz As sys)
    sys dwc
    ReadFileM Handle, ziel, anz, @dwc, byval 0
End Sub

Sub WriteFile(Byval Handle As Long, Byref Source As Any, Byval anz As sys)
    sys dwc
    WriteFileM Handle, Source, anz, @dwc, byval 0
End Sub

Sub CreateDirectory(string DirName) 
    CreateDirectoryM DirName, Byval 0
End Sub


Sub SetDisplay(sys width, height, bpp)
sys i,dev 
Do
dev = EnumDisplaySettings(0, i, @DevM)   
iF dev =0 Then Exit Do
i +=1
End Do
tmpW = DevM.dmPelsWidth
tmpH = DevM.dmPelsHeight  
tmpP = DevM.dmBitsPerPel
DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_BITSPERPEL
DevM.dmPelsWidth  = width
DevM.dmPelsHeight = height
DevM.dmBitsPerPel = bpp
ChangeDisplaySettings(@DevM,4)
End Sub

Sub RestoreDisplay()
DevM.dmPelsWidth  = tmpW
DevM.dmPelsHeight = tmpH
DevM.dmBitsPerPel = tmpP
ChangeDisplaySettings(@DevM,4)
End Sub

Sub WinEnd()             
sys jx
For jx=0 To 512
iF iHdc(jx) >0 
   DeleteObject iHnd(jx)
   DeleteDC     iHdc(jx)
   iHdc(jx) =0
EndiF
Next
For jx=0 To 512
iF THdc(jx) >0 
   DeleteObject THnd(jx)
   DeleteDC     THdc(jx)
   THdc(jx) =0
EndiF
Next
For jx=0 To 512
iF IcoHnd(jx) >0 
   DeleteObject IcoHnd(jx)
   IcoHnd(jx) =0
EndiF
Next
iF tmpH >0 and tmpW >0 Then RestoreDisplay
DestroyWindow sys_hwnd  
ReleaseDC sys_hwnd, sys_hdc
DeleteObject bHnd
DeleteDC     bHdc
End Sub

Sub ColorKey(sys red, green, blue)
sys_color = red + green*256 + blue*65536  
End Sub

Function LoadBmp(string File, sys Frames) as sys
    iF Frames=0 or Frames <0 Then Frames =1
    static id as sys
    iF id <512 Then id +=1
    iHnd(id) = LoadImage(0,File + ".bmp",0,0,0,16)
    iHdc(id) = CreateCompatibleDC(sys_hdc)
    SelectObject iHdc(id), iHnd(id)
    GetObject iHnd(id), sizeof info, &info
    BmpWidth (id) = info.bmWidth /Frames 
    BmpHeight(id) = info.bmHeight         
    BmpFrame (id) = Frames
    Return id
End Function        

Sub SetBmp(sys id, x1, y1, zx, zy, zF)
TransparentBlt bHdc,x1,y1,zx,zy,iHdc(id),BmpWidth(id)*zF,0,BmpWidth(id),BmpHeight(id),sys_color 
End Sub

Sub Sprite(sys id, x1, y1, zF)
TransparentBlt bHdc,x1,y1,BmpWidth(id),BmpHeight(id),iHdc(id),BmpWidth(id)*zF,0,BmpWidth(id),BmpHeight(id),sys_color 
End Sub

Sub iText(sys id, string txt, sys tx, ty, zx, zy) 
sys sx, rx
For sx=1 To Len(txt)
rx = Asc(txt, sx)
iF rx >=32 and rx <=127 
rx = rx -32
SetBmp id,tx,ty,zx,zy,rx
tx = tx + zx
End iF
Next 
End Sub

Function LoadIcon(string file) as sys
Static id as sys
iF id < 512 Then id +=1
IcoHnd(id) = LoadImage 0, file, 1, 0, 0, 16    
Return id
End Function

Sub SetIcon (sys idx, x, y, zx, zy, fx)
DrawIconEx bHdc, x, y, IcoHnd(idx), zx, zy, fx, 0, DI_NORMAL
End Sub

Function LoadTile(string File, sys xFrame,yFrame) as sys
iF xFrame=0 Then xFrame=1
iF yFrame=0 Then yFrame=1
static id as sys
iF id <512 Then id +=1
THnd(id) = LoadImage(0,File + ".bmp",0,0,0,16)
THdc(id) = CreateCompatibleDC(sys_hdc)
SelectObject THdc(id), THnd(id)
GetObject THnd(id), sizeof info, &info
TWidth (id) = info.bmWidth /xFrame
THeight(id) = info.bmHeight/yFrame         
Return id
End Function        

Sub SetTile(sys id, x1, y1, zx, zy, xF, yF)
TransparentBlt bHdc, x1,y1, zx,zy, THdc(id), TWidth(id)*xF,THeight(id)*yF, TWidth(id),THeight(id), sys_color 
End Sub

Sub Font(sys width, height, flag, string fontname)  
sys hFont
hFont = CreateFont height,width,0,0,flag,0,0,0,0,0,0,0,0,fontname
SelectObject bHdc, hFont
SetBkMode bHdc,1
DeleteObject hFont
Font_Width = width
Font_Height= height
Font_Flag  = flag
Font_Name  = fontname
End Sub

Sub Text( sys x, y, string txt, sys r,g,b) 
int color = r + g*256 + b*65536 
SetTextColor bHdc, color
TextOut bHdc,x,y,txt,Len(txt)
End Sub

Sub Events()
If PeekMessage (&wm,0,0,0,PM_REMOVE)>0
iF wm.message = WM_QUIT Then WinExit=1 
TranslateMessage &wm
DispatchMessage  &wm
End If
End Sub


Sub FlipBuffer()
    Events
    GetClientRect sys_hWnd, rc
    SetStretchBltMode sys_hdc,sys_mode  
    StretchBlt sys_hdc,0,0,rc.right,rc.bottom,bHdc,0,0,Width,Height,0xCC0020
End Sub

Sub ClsColor(sys r, g, b)
    int color = r + g*256 + b*65536  
    sys iBrush = CreateSolidBrush color
    SelectObject bHdc, iBrush
    Rectangle bHdc, 0, 0, Width, Height
    DeleteObject iBrush
End Sub

/*
Function GrabBmp(sys xPos,yPos,width,height) as sys
    sys x,y,col: static id as sys
    iF id <512 Then id +=1
    gHnd(id) = CreateCompatibleBitmap(sys_hdc, width, height)  
    gHdc(id) = CreateCompatibleDC(sys_hdc)
    SelectObject gHdc(id), gHnd(id)
    BitBlt gHdc(id),0,0,width,height,bHdc,xPos,yPos,0xCC0020
    GrabWidth (id) = width
    GrabHeight(id) = height
    Return id
End Function

Sub SetGrab(sys id, x,y, zx,zy)
    TransparentBlt bHdc,x,y,zx,zy,gHdc(id),0,0,GrabWidth(id),GrabHeight(id),sys_color 
End Sub
*/

#ifndef CustomWndProc
'
Function WndProc(byval hWnd as sys,byval wMsg as sys, byval wParam as sys,byval lparam as sys) as sys callback
select wMsg
case WM_CREATE
  '
case WM_PAINT
  '
case WM_SIZE
  FlipBuffer
case WM_MOVE 
  FlipBuffer
  ValidateRect sys_hwnd,0
case WM_MOUSEMOVE
  xMouse = LoWord(lParam)
  yMouse = HiWord(lParam)
  InValidateRect sys_hwnd,0,0
case WM_LBUTTONDOWN
  MouseButton =1
  InvalidateRect hWnd,0,0 
case WM_LBUTTONUP
  MouseButton =0  
  InvalidateRect hWnd,0,0 
case WM_RBUTTONDOWN
  MouseButton =2
  InvalidateRect hWnd,0,0 
case WM_RBUTTONUP
  MouseButton =0
  InvalidateRect hWnd,0,0
case WM_MBUTTONDOWN
  MouseButton =4
  InvalidateRect hWnd,0,0 
case WM_MBUTTONUP
  MouseButton =0
  InvalidateRect hWnd,0,0
case WM_CHAR
  AscKey = wParam
  InvalidateRect hWnd,0,0
case WM_KEYUP
  AscKey =0
  InvalidateRect hWnd,0,0
case WM_DESTROY
  PostQuitMessage 0
case Else
  Function = DefWindowProc hWnd,wMsg,wParam,lParam
end select
End Function
'
#endif


Function CheckReso(sys width, height) as sys
sys jx
For jx=0 to 15
iF xReso(jx) = width and yReso(jx) = height
   SetDisplay width, height, 32
   Return 0x80000000
EndiF
Next
Return 1
End Function   


Function Window (string caption, sys Ww, Wh, style) as sys
sys inst,wx,wy,scr,w,h
iF style =0 
   style = CheckReso ww,wh
EndiF       
iF style =1 then style =0xCF0000
iF style =2 then style =0x80000 
iF style =3 then style =0x80000000
iF style =4 then style =0x400000
inst = GetModuleHandle 0
wc.style = CS_HREDRAW or CS_VREDRAW or CS_OWNDC 
wc.lpfnWndProc = &WndProc
wc.cbClsExtra =0
wc.cbWndExtra =0
wc.hInstance  = inst
wc.hIcon=LoadIconA 0,IDI_WINLOGO            
wc.hCursor=LoadCursor 0,IDC_ARROW       
wc.hbrBackground = 0 
wc.lpszMenuName  = ?0
wc.lpszClassName = strptr "Oxygen"
RegisterClass &wc
Scr = GetSystemMetrics SM_CXSCREEN
Wx  = (Scr - Ww) /2
Scr = GetSystemMetrics SM_CYSCREEN
Wy  = (Scr - Wh) /2
sys_hwnd = CreateWindowEx 0, wc.lpszClassName, caption, style, wx,wy, ww,wh, 0,0, inst, 0
ShowWindow sys_hwnd,SW_SHOW 
sys_hdc = GetDC(sys_hwnd)
GetClientRect sys_hwnd,rc   'peter was here.
w = ww-rc.right
h = wh-rc.bottom
GetWindowRect sys_hwnd,rc
MoveWindow sys_hwnd,rc.left,rc.top,ww+w,wh+h,1
bHnd = CreateCompatibleBitmap(sys_hdc,ww,wh)
bHdc = CreateCompatibleDC(sys_hdc)
SelectObject bHdc, bHnd
Width = ww
Height= wh
sys_Seed = timeGetTime
QueryPerformanceFrequency sys_qf
QueryPerformanceCounter   sys_qc1
Return sys_hwnd
End Function


Sub Pause()
While AscKey=0
Events
iF WinExit=1
   Return
End iF
FlipBuffer
sleep 20
Wend
AscKey=0
End Sub


Function KeyState(int ikey) as short
if sys_hWnd=GetFocus() then 
  Return GetAsyncKeyState(iKey) 
end if
end function

Sub WaitKey(int iKey)
  While KeyState(ikey)=0
    sleep 10
    iF WinExit=1
       Return
    End iF
    FlipBuffer
  Wend
  While GetAsyncKeyState(iKey) <0
    FlipBuffer
  Wend
End Sub    

Function Key(int cKey) As short
iF WinExit=1 
   Return -1
End iF
Return KeyState(cKey) 
End Function

Function EscKey() As short
iF WinExit=1 
   Return -1
End iF
Return KeyState(27)
End Function

Sub ShowMouse(int mouse)   
ShowCursor(mouse)
End Sub                

Sub WaitMouse()
While (1)
iF MouseButton >=1 and MouseButton <=4
   Return MouseButton
ElseiF WinExit=1 
   Return -1
End iF
FlipBuffer
Wend
End Sub

Function GetColorR(int color) as sys
    Return color & 0xFF
End Function    

Function GetColorG(int color) as sys
    Return (color >> 8) & 0xFF
End Function    

Function GetColorB(int color) as sys
    Return (color >> 16) & 0xFF
End Function    

Function ColorRGB(int red, green, blue) as sys
    Return red + green*256 + blue*65536
End Function

Sub GetHLS(int col)
    ColorRGBtoHLS Col,cHLS.h,cHLS.l,cHLS.s 
End Sub 

Sub ColorHLS(int hue, lum, sat) 
    sys color
    color = ColorHLSToRGB hue,lum,sat
    GetHLS color
End Sub

Sub GetRGB(int col) 
    cRGB.r = col & 0xFF           
    cRGB.g = (col >>  8) & 0xFF   
    cRGB.b = (col >> 16) & 0xFF   
End Sub

Sub Poke(int x, y, r,g,b)
    SetpixelV (bHdc, x, y, ColorRGB(r,g,b))
End Sub

Sub Pixel(int x, y, color)
    SetpixelV bHdc, x, y, color
End Sub

Sub Peek(int x, y) 
    Return GetPixel (bHdc, x, y)
End Sub

Sub Randomize()
    sys_Seed = timeGetTime
End Sub

Function Rand(int z1, z2) as sys
    sys    rnd 
    mov    eax,z2
    sub    eax,z1
    inc    eax
    imul   edx,sys_Seed,0x8088405
    inc    edx
    mov    sys_Seed,edx
    mul    edx
    add    edx,z1
    mov    rnd,edx
    return rnd
End Function 

Sub SetBlend(int id, x, y, zx, zy, alpha)
    AlphaBlend bHdc,x,y,zx,zy,iHdc(id),0,0,bmpWidth(id),bmpHeight(id), 0x10000*alpha 
End Sub

Sub Oval(int x,y,ra,rb, r,g,b)
    sys iBrush
    int color = r + g*256 + b*65536 
    iBrush = CreateSolidBrush color
    SelectObject bHdc, iBrush
    Ellipse bHdc,x,y,ra+x,rb+y
    DeleteObject iBrush
End Sub

Sub Line(int x,y,a,b,w, rc,gc,bc)
    sys iPen,hPen
    int color = rc + gc*256 + bc*65536 
    iPen = CreatePen PS_SOLID,w,color
    SelectObject bHdc, iPen
    MoveToEx bHdc,x,y,Byval 0
    LineTo bHdc,a,b
    DeleteObject iPen
    hPen = GetStockObject(DC_PEN)
    SelectObject bHdc, hPen
End Sub

Sub RoundBox(int x,y,w,h,r1,r2, r,g,b)  
    sys iBrush
    int color = r + g*256 + b*65536 
    iBrush = CreateSolidBrush color
    SelectObject bHdc, iBrush
    RoundRect bHdc,x,y,w+x,h+y,r1,r2
    DeleteObject iBrush
End Sub

Sub FillBox(int x,y,w,h, r,g,b)  
    sys iBrush
    int color = r + g*256 + b*65536 
    iBrush = CreateSolidBrush color
    SelectObject bHdc, iBrush
    Rectangle bHdc,x,y,w+x,h+y
    DeleteObject iBrush
End Sub

Sub Box(int x, y, w, h, t, r,g,b)
    Line x, y, x+w, y, t, r,g,b
    Line x,y+h,x+w,y+h,t, r,g,b
    Line x, y, x, y+h, t, r,g,b
    Line x+w,y,x+w,y+h,t, r,g,b
End Sub

Sub Circle(int xj, yj, r, r1,g1,b1)
    sys f=1-r, ry= -2*r, rx, y=r, x
    Poke xj, yj + r, r1,g1,b1
    Poke xj, yj - r, r1,g1,b1
    Poke xj + r, yj, r1,g1,b1
    Poke xj - r, yj, r1,g1,b1
    While x < y 
    iF f >= 0 
       y -= 1
       ry +=2
       f  +=ry
    End iF
    x  += 1
    rx += 2
    f  += rx + 1
    Poke  xj + x, yj + y, r1,g1,b1
    Poke  xj - x, yj + y, r1,g1,b1
    Poke  xj + x, yj - y, r1,g1,b1
    Poke  xj - x, yj - y, r1,g1,b1
    Poke  xj + y, yj + x, r1,g1,b1
    Poke  xj - y, yj + x, r1,g1,b1
    Poke  xj + y, yj - x, r1,g1,b1
    Poke  xj - y, yj - x, r1,g1,b1
    Wend
End Sub

Sub WaitFor(int Frame)    
    QueryPerformanceFrequency sys_Freq                                                                                          
    sys_Interval = sys_Freq/Frame  
    While (1)                                                                       
    QueryPerformanceCounter sys_cT2                                                 
    iF sys_cT2 >= sys_cT1 + sys_Interval                                             
       QueryPerformanceCounter sys_cT1                                              
       Exit Sub            
    End iF
    Wend                                                                             
End Sub


Function ShowFrames() as sys 
    QueryPerformanceCounter sys_qc2
    iF sys_qc2 - sys_qc1 > sys_qf             
       sys_fjs = sys_Frames
       sys_Frames =0
       sys_qc1 += sys_qf                         
    End iF
    sys_Frames +=1
    Return sys_fjs
End Function

def WaitFPS WaitFor