Post Reply 
Social Buttons
 
Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Aurel Edit
05-19-2017, 05:01 AM
Post: #1
Aurel Edit
Here is latest version of Aurel Edit in O2

Code:
'Alternative code editor for Oxygen Basic v0.35
'created by Aurel 5/2017 , scintilla ver-2.2.0.0
$ Filename "AurelEdit.exe"
Include "RTL32.inc"
Include "awinh.inc"
#LOOKAHEAD ' for procedures
Type NMHDR
      hwndFrom as sys
      idFrom   as sys
      code     as sys
  End Type

sys win,hsci,wabout,optWin,fWindow,theme
INT winstyle,aboutWindow,optWinOn,findWinOn,stFW1,stFW2,stfw1ID=600,stfw2ID=601
INT fb1,fb2,fb3,fb1ID=501,fb2ID=502,fb3ID=503,fwed1,fwed1ID=504,fwed2,fwed2ID=505
INT button0,button1,button2,button3,button4,button5,button6,button7,button8,bGoto
INT edit1,edit2,edit3,edit4,edit5,editOpt
INT Lbox,static1,static2,static3,static4,ststic6,static7,static8,static9
INT ed1ID,ed2ID,ed3ID,edoID
INT b0ID,b1ID,b2ID,b3ID,b4ID,b5ID,b6ID,b7ID,b8ID=0,b9ID,b10ID
INT bo1,bo2,bo3,bo4,bo5,bo5,bo6,bo7
INT bo1ID=151,bo2ID=152,bo3ID=153,bo4ID=154,bo5ID=155,bo6ID=156
INT LboxID = 300,LBhdc,LBhdcMEM
INT st1ID,st2ID,st6ID,st7ID,st8ID
int x,y,w,h : string CRLF = chr(13)+chr(10)
INT reID
bGotoID = 120
b0ID=99
b1ID=100
b2ID=101
b3ID=102
b4ID=103
b5ID=104
b6ID=105
b7ID=106
b8ID=107
'print str(b8ID)
b9ID =108
b10ID=110
% SW_RESIZE = 2
'-----------------
ed1ID=200
ed2ID=201
ed3ID=202
ed4ID=203
ed5ID=204
edoID=205
'----------------
st1ID=350
st2ID=351
st3ID=352
st4ID=353
st6ID=356
st7ID=357
'##### SCINTILLA CONSTANTS ###################################
sciID=400  'scintilla ID
INT hlibsci,hsci 'scintilla handlers
INT bip

% SCE_OB_DEFAULT = 0
% SCE_OB_LINECOMMENT = 1
% SCE_OB_BLOCKCOMMENT = 2
% SCE_OB_NUMBER = 3
% SCE_OB_KEYWORD = 4
% SCE_OB_TYPE = 5
% SCE_OB_SETID = 6
% SCE_OB_PREPROCESSOR = 7
% SCE_OB_STRING = 8
% SCE_OB_OPERATOR = 9
% SCE_OB_IDENTIFIER = 10
% SCE_OB_LABEL = 11
% SCE_OB_ASM = 12

% SCLEX_OBASIC = 40

% SCI_SETLEXER = 4001
% SCI_COLOURISE = 4003
% SCI_STYLESETFORE = 2051
% SCI_STYLESETBACK = 2052
% SCI_STYLECLEARALL = 2050
% SCI_SETKEYWORDS = 4005
% SCI_STYLESETFONT = 2056
% SCI_STYLESETSIZE = 2055
% SCI_STYLESETBOLD = 2053
% SCI_SETMARGINWIDTHN = 2242
% SCI_SETMARGINTYPEN = 2240
% SCI_SETMARGINSENSITIVEN = 2246
% SCI_SETSELBACK = 2068
% SCI_GOTOLINE = 2024
% SCI_LINELENGTH = 2350
% SCI_GETLINE = 2153
% SCI_GETLINECOUNT = 2154
% SCI_GETCURLINE= 2027
% SCI_SCROLLCARET=2169
% SCI_SETCURRENTPOS = 2141
% SCI_SETANCHOR=2026
% SCI_SEARCHANCHOR=2366
% SCI_GETSELECTIONSTART=2143
'--------------------------------
% SCFIND_REGEXP=0x00200000
% SCFIND_WHOLEWORD=2
% SCFIND_MATCHCASE=4
% SCI_SEARCHNEXT=2367
% SCI_SEARCHPREV=2368
% SCI_REPLACESEL = 2170
'--------------------------------
% SCI_GOTOPOS=2025
% SCI_GETTEXT = 2182
% SCI_SETTEXT = 2181
% SCI_GETTEXTLENGTH = 2183

% SCI_CLEAR=2180
% SCI_CLEARALL=2004
% SCI_BRACEBADLIGHT=2352
% SCI_BRACEHIGHLIGHT=2351
% SCI_BRACEMATCH=2353
% SCI_GETSELECTIONEND=2145
% SCI_SETSELECTIONEND=2144
% SCI_SETCARETLINEVISIBLE=2096
% SCI_SETCARETFORE = 2069
% SCI_SETCARETLINEBACK = 2098
% SCI_SCROLLCARET=2169
% SCI_UNDO = 2176
% SCI_CUT = 2177
% SCI_COPY = 2178
% SCI_PASTE = 2179
% SCI_SETSAVEPOINT = 2014
% SCI_EMPTYUNDOBUFFER = 2175

% SC_MARGIN_SYMBOL = 0
% SC_MARGIN_NUMBER = 1
% SCI_SETMARGINMASKN = 2244

% TCN_SELCHANGE = -551

'init color strings
bSTRING sciblue,scired,scibrown
Gosub oxyKeywords
'- tview -------------
INT htv
'--------------------
STRING cOption="-c " ' default copt - gui No console "-c " for oxygen
STRING fName
char tx[500000]
string gxName="\gxo2.exe"   ' for oxygen change path to \gxo2.exe
char cdPath[256]
'string cdPath
GetCurrentDir 256,strptr cdPath
'GetTempPath ( 256, strptr cdPath)
cdPath = cdPath + gxName
'MsgBox cdPath , "Compiler Path...OK!"
'-------------------------------------
'global file name
STRING fileName
INT tab
'--------------------------------------
'loadbmp
'##################################################
INT bmpB0,bmpB1,bmpB2,bmpB3,bmpB4,bmpB5,bmpB6,bmpB7,bmpB8
bmpB1 = LoadImage(0,"AELogo.bmp",0,400,300,16)
'......................................................

'##################################################
x=100:y=100:w=740:h=480
winstyle = WS_CLIPCHILDREN | WS_MINMAXSIZE
'create window **************************************************
win = SetWindow("AurelEdit:",x,y,w,h,0,winstyle)
'InitDrawing(win)
    'WindowColor( win, 220, 230, 250)
'****************************************************************
bGoto = SetButton(win,388,4,60,24,"GOTO-->",0x50000000,0x200,bGotoID)
edit2 = SetEditBox(win,450,5,48,22,"LINE",0x50004000,0x200,ed2ID)
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'create single-line edit control
edit1 = SetEditBox(win,160,30,560,23,"",0x50004000,0x200,ed1ID)
'tab item
edit3 = SetEditBox(win,30,30,18,20,"64",0x50004000,0x200,ed3ID)
'tab name
edit4 = SetEditBox(win,50,30,104,20,"TabName",0x50004000,0x200,ed4ID)
'create listbox ===================================================
INT lbx,lby,lbw,lbh
lbx=6:lby=54:lbw=168:lbh=366
Lbox = SetListBox(win,lbx,lby,lbw,lbh,"",0x50000140|CTLISTNOTIFY|WS_VSCROLL,0x200,LboxID)
ControlFont(LBox, 15, 7, 400, "Courier New")
Dim LBitems[2000] as INT
Dim LBitem as INT
'=================================================================
'create static control
static1 = SetStatic(win,6,32,24,13,"TAB:",0,0,st1ID)
'button  set compiler gxo2.exe path
static6 = SetButton(win,502,4,38,23,"GXO2",0,0x200,st6ID) ' gxo2 path button
ControlFont(static6, 16, 7, 500, "Courier New")
'option edit box
editOpt = SetEditBox(win,544,5,140,22,"compiler Path",0x50004000,0x200,edoID)

'set sci dimensions
INT rx,ry,rw,rh
rx=160:ry=80:rw=466:rh=360

'TOOLBAR-------------------------------------------------------------
Dim tbb as TBBUTTON
Dim AddBmp as TBADDBITMAP
' setting common control mode
Dim iccx as INITCOMMONCONTROLSEXtype
  iccx.dwSize = sizeOf(iccx )
  iccx.dwICC  = 4
' initialize common controls 32
InitCommonControlsEx( iccx )
with Addbmp
  .hinst = -1
  .nID   =  0
end with
INT htbar
INT toolID=99
'add handlers
INT  hImageList,hImage,iNum,id
'create toolbar -----------------------------------------------------
htbar = SetToolbar (win, 0 ,0,toolID)
'create tooltip -----------------------------------------------------
NMHDR pHdr
'set toolbar size ---------------------------------------------------
MoveWindow(htbar, 0, 0, 380, 28,0)
' Set the imagelist used with default images
  hImageList = ImageList_Create(20, 20, ILC_MASK OR ILC_COLOR8, 1, 0)
  hImage = LoadImage(0, "rCodetb.bmp", 0, 280, 20, 24)
  ImageList_AddMasked hImageList, hImage, RGB(231,223,231)
  DeleteObject hImage
'set image list  
SendMessage htbar,TB_SETIMAGELIST,0, hImageList
'set button structure size
SendMessage htbar , 1054, sizeof(tbb), NULL

'TBUTTONS & TOOLTIPS -------------------------------------------------
INT tooltip
tooltip = SetToolTip(htbar)

AddTButton(htbar, 100, 0, "New File")
AddTButton(htbar, 101, 1, "Open File")
AddTButton(htbar, 102, 2, "Save As...")
AddTButton(htbar, 103, 3, "Save File")
AddTButton(htbar, 104, 4, "Close File")
AddTButton(htbar, 105, 5, "Copy -->")
AddTButton(htbar, 106, 6, "<Paste>")
AddTButton(htbar, 107, 7, "Compile::")
AddTButton(htbar, 108, 8, "Run")
AddTButton(htbar, 109, 9, "Web Site")
AddTButton(htbar, 110, 10, "Info")
AddTButton(htbar, 111, 11, "Find")
AddTButton(htbar, 112, 12, "Options")
AddTButton(htbar, 113, 13, "Help")

'TAB control ---------------------------------------------------------
INT tc,tcID=500
tc = SetTabControl(win,180,55,466,26,0,0,tcID)
indexbase 0
INT tbArr[64],tabIndex,ai
STRING tabName[64],tabValue[64]
'reset tab info array >>>>>
For ai = 0 To 63
tabName[ai]  = ""
tabValue[ai] = ""
Next ai
'<<<<<<<<<<<<<<<<<<<<<<<<<<
tabIndex = -1
'add first tab.. index 0
CreateNewTab()

'Status bar
INT status
status = SetStatusBar ( win, "Status-Bar...",0,0)
'--------------------------------------------------------------------
int hdc=getdc(win)
int iBrush = CreateSolidBrush (0xff0000)
SelectObject Hdc, iBrush
'Rectangle Hdc, 0, 0, w,h
SetBkColor hdc,ibrush
ReleaseDC win,hdc

hlibsci = LoadLibrary "SciLexer.dll"  'load sciLexer.dll
if not hlibsci then
      print "Unable to load Scintilla: SciLexer.dll"
end if

sys rx,ry,rw,rh,ext,sci_style
rx=180: ry=80 : rw=540 : rh=340 : ext=0x200
sci_style =  WS_CHILD|WS_VISIBLE|ES_SUNKEN
hsci = CreateWindowEx(ext,"Scintilla","",sci_style,rx,ry,rw,rh,win,sciID,0,0)
'SendMessage hsci,
     '3  cpp
     '8  vb ***
     '40 lout
     '51 powerbasic
     '75 freebasic
      SendMessage hsci, SCI_SETLEXER, 75, 0
      include "oxykeywords.inc"
      'string sciblue
      SendMessage hsci, SCI_SETKEYWORDS, 0, sciblue
     ' SendMessage hsci, SCI_COLOURISE, 0, -1
      '
     'sm SCI_STYLESETFORE, SCE_OB_DEFAULT,0
     'sm SCI_STYLESETBACK,32,0xFFFFFF  'white
       'SendMessage hsci,SCI_STYLECLEARALL, 0, 1
      for i=0 to 7
        SendMessage hsci, SCI_STYLESETFONT, i, "Courier New" 'Courier / Lucida Console
        SendMessage hsci, SCI_STYLESETSIZE, i, 9 '10..14 point size range
      next i
      '
      SendMessage hsci, SCI_SETMARGINTYPEN,  0, SC_MARGIN_NUMBER
      SendMessage hsci, SCI_SETMARGINWIDTHN, 0, 46
      SendMessage hsci, SCI_SETCARETLINEBACK,RGB(245,245,200),0
      SendMessage hsci, SCI_SETCARETFORE,    0xff4444,0
      SendMessage hsci, SCI_SETCARETLINEVISIBLE,1,0
      '
      'setting RGB colors
      SendMessage hsci, SCI_STYLESETFORE, 0,  rgb(0,0,0)
      SendMessage hsci, SCI_STYLESETFORE,1,  rgb(0,120,0)      'line comment
      SendMessage hsci, SCI_STYLESETFORE,2,  rgb(164,42,42)  'numbers
      SendMessage hsci, SCI_STYLESETFORE,3,  rgb(0,0,170)     'keywords
      SendMessage hsci, SCI_STYLESETFORE,4,  rgb(150,0,150)   'string
      SendMessage hsci, SCI_STYLESETFORE,5,  0xc00080         '#names
      SendMessage hsci, SCI_STYLESETFORE,6,  rgb(200,0,0)     'symbols
      SendMessage hsci, SCI_STYLESETFORE,7,  0x002000  '
      '
  
'->->->->->->->->->->->->->->->->->->
sys bRet
  '
  WHILE GetMessage (&wm,0,0,0)<>0
  TranslateMessage &wm
  DispatchMessage &wm
WEND
'<-<-<-<-<-<-<-<-<-<-<-<-<-<-<-<-<-<-

Function WndProc(byval hWnd as long,byval wMsg as long, byval wParam as long,byval lparam as sys) as sys callback


SELECT hWnd
'-----------
CASE win
'----------
Select wMsg

CASE WM_CREATE
/*
hlibsci = LoadLibrary "SciLexer.dll"  'load sciLexer.dll
if not hlibsci then
      print "Unable to load Scintilla: SciLexer.dll"
end if
sys rx,ry,rw,rh,ext,sci_style
rx=180: ry=80 : rw=540 : rh=340 : ext=0x200
sci_style =  WS_CHILD|WS_VISIBLE|ES_SUNKEN
hsci = CreateWindowEx(ext,"Scintilla","",sci_style,rx,ry,rw,rh,win,sciID,0,0)
SendMessage hsci,
     '3  cpp
     '8  vb ***
     '40 lout
     '51 powerbasic
     '75 freebasic
      SendMessage hsci, SCI_SETLEXER, 8, 0
      'include "oxykeywords.inc"
      'string sciblue
      SendMessage hsci, SCI_SETKEYWORDS, 0, sciblue
      SendMessage hsci, SCI_COLOURISE, 0, -1
      '
     'sm SCI_STYLESETFORE, SCE_OB_DEFAULT,0
     'sm SCI_STYLESETBACK,32,0xFFFFFF  'white
     'sm SCI_STYLECLEARALL, 0, 1
      for i=0 to 7
        SendMessage hsci, SCI_STYLESETFONT, i, "Courier New" 'Courier / Lucida Console
        SendMessage hsci, SCI_STYLESETSIZE, i, 9 '10..14 point size range
      next i
      '
      SendMessage hsci, SCI_SETMARGINTYPEN,  0, SC_MARGIN_NUMBER
      SendMessage hsci, SCI_SETMARGINWIDTHN, 0, 46
      SendMessage hsci, SCI_SETCARETLINEBACK,RGB(245,245,200),0
      SendMessage hsci, SCI_SETCARETFORE,    0xff4444,0
      SendMessage hsci, SCI_SETCARETLINEVISIBLE,1,0
      '
      def sn SendMessage hsci, SCI_STYLESETFORE,
      '
      'setting RGB colors
      sn 0,  0x000000  '
      sn 1,  0x207800         'line comment
      sn 2,  rgb(164,42,42)  'numbers
      sn 3,  rgb(0,0,170)     'keywords
      sn 4,  rgb(150,0,150)   'string
      sn 5,  0xc00080         '#names
      sn 6,  rgb(200,0,0)     'symbols
      sn 7,  0x002000  '
      '
*/
CASE WM_DESTROY
PostQuitMessage 0
'------------------
case WM_SIZE
GetSize(win,x,y,w,h)
MoveWindow(hsci,180,80,(w-rw/2)+84,(h-76)-32 ,1)
MoveWindow(edit1,180,30,(w-rw/2)+84,23 ,1)
MoveWindow(Lbox,6,54,lbw,(h-76)-6 ,1)
MoveWindow(tc,180,55,(w-rw/2)+116,24,1)
'fix statusbar position on botom of window
MoveWindow ( status,0,(h-32),w,h,1)

'-------------------------------------------------------------
CASE WM_NOTIFY
  NMHDR notify at lparam
  Select notify.code
    case -552  'tcn_selchanging
    'leaving tab
    'int p = SendMessage(tc,TCM_GETCURSEL,0,0)
    'print "LEAVING-TAB->" + str(p)
    autoSave()

    case -551  'tcn_selchange
    'selected tab
    'int i = SendMessage(tc,TCM_GETCURSEL,0,0)
    'print "TAB:" + str(i)
     FindTab()

End Select

/*
CASE WM_CTLCOLORLISTBOX
LBhdc = getDC(LBox)
If theme = 3 ' default
    INT lbColor = CreateSolidBrush(RGB(255,255,255))
    'SetBkMode(LBhdc,1)
    SetBkColor( wparam, RGB(255,255,255))
    SetTextColor( wparam,RGB(20,45,125))
    'InvalidateRect(Lbox, 1, 0)
    return lbColor
End if
If theme = 1 ' light blue
    INT lbColor = CreateSolidBrush(RGB(240,240,255))
    'SetBkMode(LBhdc,1)
    SetBkColor( wparam, RGB(240,240,255))
    SetTextColor( wparam,RGB(0,5,0))
    'InvalidateRect(Lbox, 1, 0)
    return lbColor
End if
If theme = 2 ' soft yellow
    INT lbColor = CreateSolidBrush(RGB(243,242,214))
    'SetBkMode(LBhdc,1)
    SetBkColor( wparam, RGB(243,242,214))
    SetTextColor( wparam,RGB(0,5,0))
    'InvalidateRect(Lbox, 1, 0)
    return lbColor
End if
*/
'-------------------------------------------------------------
    CASE WM_COMMAND    
    controlID = LoWord(wParam) 'get control ID
    notifyCode = HiWord(wParam) 'get notification message

    Select controlID
     CASE LBoxID
     'doubleClick listbox item -> jump to line
        IF notifycode = LBN_DBLCLICK
        'pos=GETSELECTED(w1,3)
         pos = SendMessage Lbox,LB_GETCURSEL,0,0
        
        For n=0 TO pos    
            IF pos = n
            fnpos=LBitems[pos]
            SetFocus hsci
            SendMessage hsci,SCI_GOTOLINE,fnpos,0
            END IF
        Next n
        pos=0
        END IF

     'get file from clicked tab
    'CASE tcID
    
    

       CASE b1ID
        'NEW
        If notifycode=0
            autoSave() 'save current content
            SendMessage hsci,SCI_SETTEXT,0,strptr ""   'clear scintila
              NewTab()  'create new tab      
        End If

       CASE b2ID
        'OPEN
        If notifycode=0  
            doOpen()
            fnParser()
        End If

       CASE b3ID
         If notifycode=0
        doSave()    
        End If

      CASE b4ID
        If notifycode=0
        autoSave()
         Beep 1200,60
        End If

      CASE b5ID
        If notifycode=0
        doClose()
         Beep 800,50: Beep 600,50: Beep 400,50
        End If

      CASE b6ID
        If notifycode=0
        doCopy()
        End If

      CASE b7ID
        If notifycode=0
        doPaste()
        End If

      CASE 107
        If notifycode=0
        doCompile()
        End If

      CASE b9ID
        If notifycode=0
        doRun()
        End If

      CASE b10ID
        If notifycode=0
        'show About window
         AboutBox()
        End If

      CASE 111 ' open FindWindow
         If notifycode = 0
           FindWindow()
         End If

      CASE 112 ' Option Window
        If notifycode=0
        OptWindow()
        End If

     CASE st6ID ' set compiler path [ gxo2.exe ]
      If notifycode = 0
      cdPath = GetText(editOpt)
      MsgBox cdPath , "Compiler Path:"
      End If

    CASE bGotoID
     JumpToLine()

End Select



END SELECT
'------------------------------


'-----------------------
CASE wabout
'----------------------
Select wMsg
CASE WM_CLOSE
  IF aboutWindow = 1
    CloseWindow(wabout)
     aboutWindow=0
  END IF

End Select
'---------------------
CASE optWin   'option window events
'..........................
Select wMsg
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
CASE WM_COMMAND
    controlID = LoWord(wParam) 'get control ID
    notifyCode = HiWord(wParam) 'get notification message

    Select controlID
    CASE bo1ID
        'theme Clear Sea
        If notifycode=0
        print "You select theme -> CLEAR SEA"
         theme = 1 : SetTheme1(): ControlFont (LBox, 15,7, 0,"Courier New")
        End If
     CASE bo2ID
         'theme Soft Desert
        If notifycode=0
        print "You select theme -> SOFT DESERT"
         theme = 2 : SetTheme2(): ControlFont (LBox, 16,8, 0,"Courier New")    
        End If

    CASE bo3ID
         'theme Default
        If notifycode=0
        print "You select theme -> DEFAULT"
         theme = 3 : SetTheme3(): ControlFont (LBox, 16,8, 0,"Courier New")    
        End If

    CASE bo4ID
         'theme Dark Moon
        If notifycode=0
        print "You select theme -> DARK MOON"
         theme = 4 : SetTheme4(): ControlFont (LBox, 16,8, 0,"Courier New")    
        End If

    End Select
    
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
CASE WM_CLOSE
  IF optWinOn = 1
    CloseWindow(optWin)
     optWinOn=0
  END IF
End Select
'////////////// FIND WINDOW  ///////////////////////////////////
CASE fWindow
'///////////
Select wMsg ' for Find/Replace toolwindow
'////////////////////////////////////////////////////////////
CASE WM_COMMAND
    controlID = LoWord(wParam) 'get control ID
    notifyCode = HiWord(wParam) 'get notification message

    Select controlID

    CASE fb1ID
        'Find-next...
        If notifycode=0
        FindNext()        
        End If
     CASE fb2ID
         'ReplaceOnce
        If notifycode=0
        ReplaceOnce(0)          
        End If
    CASE fb3ID
        If notifycode=0
         ReplaceAll()
         End If


    End Select

'.............................
CASE WM_CLOSE
  IF findWinOn = 1
    CloseWindow(fWindow) ' cloase [Find/Replace] toolwindow
     findWinOn = 0
  END IF
End Select
'////////////////////////////////////////////////////////
'CASE Lbox
    'select  wMsg
        'case wm_paint
        'BitBlt(hDC, 0, 0, ww, hh, hdcMem, 0, 0, SRCCOPY)
        'InvalidateRect(Lbox, 1, 0)

    'end select

END SELECT


FUNCTION = DefWindowProc hwnd,wMsg,wParam,lParam


END FUNCTION


'************************************************************
'open file
Sub doOpen

INT hsize=0
fName=""
string dir=""
string sep=chr(0)
'filter = "All Files"+sep+"*.*"+sep"Text files"+sep+"*.txt"+ sep
filter = "All files "+sep+"*.*"+sep+"o2 files "+sep+"*.o2bas"
title="Open File... "
hwnd=0
fName = FileDialog(dir,filter,title,0,0,"o2bas")
fileName = fName
IF fName = "" Then Return
SendMessage edit1,WM_SETTEXT,0,strptr(fName)
SendMessage status,WM_SETTEXT,0,strptr(fName)
tx =  GetFile fName
SendMessage hsci,SCI_SETTEXT,0,strptr(tx)
SendMessage hsci,SCI_SETSAVEPOINT, 0, 0
SendMessage hsci,SCI_EMPTYUNDOBUFFER,0,0

If fName <> ""
FindNewTab()
End If

End Sub

'************************************************************
'save file
SUB doSave
INT hsize=0,found,c
string dir="",filePath
'char tx[32768]
'bstring tx
string ext=".o2bas"

filter= "OB Files (*.o2bas)"
title="Save File... "    'for Oxygen change to *.o2bas
hwnd=0
fName = FileDialog(dir,filter,title,0,1,"o2bas")

'print fname
If fName="" then Return
  IF RightS(fname,6) <> ".o2bas"  'for Oxygen set number to 6 , .o2bas
    fname = fname + ext
  END IF
'print fname
hsize = SendMessage hsci, SCI_GETTEXTLENGTH, 0, 0
'exit if empty
IF hsize = 0
print "ERROR: -> Document is Empty!"
Return    ' ->->->
END IF

'SendMessage hsci,SCI_GETTEXT,hsize+1,tx
'PutFile fName,tx
'SendMessage(hsci, SCI_SETSAVEPOINT, 0, 0)
'filePath = fName

found=0
INT tab = GetSelectedTab(tc)
string tName = GetTabText(tc,tab)
tName = Trim(tName)
'print "SAVE:tabname;" + tname
'if file exists ...............................................................
For c = 0 To 63
    IF tName <> "*New"
        IF tabName[c] = tName
           filePath = tabValue[c]
            'SetTabText(tc,tab,tName)  'update tab name
             'ReOpenFile()             'reOpen file from filePath
             fnParser()               'parse code
            found=1                  'confirm found    
             Exit For      
        END IF
   END IF
Next c
'if is tab *New ...............................................................
IF found = 0
print "is there tab NEW?"
For c = 0 To 63
        IF tabName[c] = "*New"
            filePath = Trim(fName)
           tabValue[c] = filePath
              tName = GetFileName(filePath)   'extract file name from file Path
            SetTabText(tc,tab,tName)        'update tab name
              tabName[c] = tName              'update tab name element
             'ReOpenFile()                    'reOpen file from filePath
             fnParser()                       'parse code
            found=1                          'confirm found    
             Exit For      
        END IF
Next c
END IF
'if filename not exists and there is no tab *New -> create NEW tab
'IF found = 0
'END IF

IF found = 1
    SendMessage hsci,SCI_GETTEXT,hsize+1,tx
    PutFile filePath,tx
    Return
ELSE
    Print "ERROR: SAVE! - File Not Found!" + chr(10) + "Create [*New] Document!"
    Return
END IF


END SUB
'*************************************************************
'auto-save
SUB autoSave
INT hsize,tab,found,c
STRING tName,filePath
'print "AutoSave->FNAME:" + fName

hsize = SendMessage hsci, SCI_GETTEXTLENGTH, 0, 0
'exit if empty
IF hsize = 0 Then Return    ' ->->->
found=0
INT tab = GetSelectedTab(tc)
string tName = GetTabText(tc,tab)
tName = Trim(tName)
'search...
For c = 0 To 63
        IF tabName[c] = tName
           filePath = tabValue[c]
            'SetTabText(tc,tab,tName)  'update tab name
             'ReOpenFile()             'reOpen file from filePath
             'fnParser()               'parse code
            found=1                  'confirm found    
             Exit For      
        END IF
Next c

IF found = 1
    SendMessage hsci,SCI_GETTEXT,hsize+1,tx
    PutFile filePath,tx
    Return
ELSE
    Print "ERROR: AUTOSAVE! - File Not Found!"
    Return
END IF

END SUB
'*************************************************************
'do Close
SUB doClose
INT tab,tabCount,c
STRING tName
'clear sci control
SendMessage hsci,SCI_SETTEXT,0,strptr ""
tabCount=GetTabCount(tc)
'print "TAB COUNT:" tabCount
IF tabCount > 0
    tab = GetSelectedTab(tc)
    'print "SELECTED TAB:" + str(tab)
        If tab > -1
         tName = GetTabText(tc,tab)
         tName = Trim(tName)
        DeleteTab(tc,tab)   ' delete selected tab
            'delete tab info from tabArray[]
             For c = 0 To 63
            IF  tabName[c] = tName         
                tabName[c] = ""      ' clear
                  tabValue[c] = ""     ' clear            
                  Exit For
              END IF
         Next c
         'print "TAB.INDEX:" + str(tabIndex)
         tabIndex = tabIndex -1
         SendMessage tc,TCM_SETCURSEL,tabIndex,0
        Findtab()
        End if
END IF
IF tabCount = 0
CreateNewTab()
END IF

END SUB
'*************************************************************
'do Copy / paste
SUB doCopy
SendMessage hsci,SCI_COPY,0,0
END SUB
'-------------------------------------------------------------
SUB doPaste
SendMessage hsci,SCI_PASTE,0,0
END SUB
'----------------------------------------------------------
SUB doCompile
char ln[256]
string fn=""
SendMessage edit1,WM_GETTEXT,256,strptr ln
fn = Trim(ln)
'print "FN:" + fn
IF LEN(fn) < 1
MsgBox "File Not Open!","Error::File"
Return
End If
int sRet
autosave()
'(sys hwnd, string lpOperation, lpFile, lpParameters, lpDirectory, sys nShowCmd) as sys
sRet = ShellExecute(0,"open",cdPath,"-c" + fName,"" , 5) ' if work sRet = 42
If sRet = 2 then MsgBox "Compiler gxo2 Not Found!"+ crlf + "Enter new compiler path!" , "GXO2 Path"
'sRet = ShellExecute 0,"open","gxo2.exe","-c "+ fn,"",5
'sRet = ShellExecute 0,"open",cdPath,cOption & chr(34) & fName & chr(34),"",5 'fb

END SUB
'---------------------------------------------------------

SUB doRun
STRING exepath=""
INT dotpos=0
dotpos=INSTR(fName,".")
exepath=Mid$(fName,1,dotpos-1)
exepath=exepath + ".exe"
'MESSAGEBOX 0,"path:"+exepath,"OK"
ShellExecute(0,"open", exepath, "","" , 5)
END SUB

'--------------------------------------------------------
SUB GetFileName (src as string) as String

String fname,sign1,name
INT dotpos,bslashpos,nameLen
'print "ShowFName::TABCOUNT->:"+str(tabcount)
'C:\OxygenBasic\examples\GUI\SciEditor\WinControls.o2bas
src=Trim(src)
bslashpos = FieldCount(src,chr(92))
name = Mid(src,bslashpos+1,LEN(src))
dotpos = INSTR(name,".")
'print "DOTP:" + str(dotpos)
'nameLen = LEN(src)-(LEN(src)-dotpos)

name = Mid(name,1,dotpos-1)
'
'print "ShowName->:" + name

Return name
END SUB
'-----------------------------------------------------------
SUB JumpToLine
INT tmpLine : char ln[100]
SendMessage edit2,WM_GETTEXT,100,ln
tmpLine = VAL (ln)-1
SetFocus hsci
SendMessage hsci,SCI_GOTOLINE,tmpLine,0
END SUB
'-----------------------------------------------------------
SUB FieldCount(source As String,delimiter As String) as Int
    Dim delpos,nexpos,count As Int
    'delimiter=chr$(92)
    count=1
    delpos=1
    nexpos=InStr(source,delimiter)
    While nexpos
        delpos=nexpos
        nexpos=InStr(delpos+1,source,delimiter)
        count++
    Wend
    RETURN delpos
END SUB  

'-----------------------------------------------------------------

SUB FindNewTab
INT found,tempTab,c,pos
STRING tName,tempName,tabNum
pos = GetSelectedTab(tc)
found=0
'search for tab -> *New
For c = 0 To 63
    IF  tabName[c] = "*New"         
        tabValue[c] = filename
         tName = GetFileName(filename) ' extract file name from filePath/tab name/
         tabName[c] = tName             ' update tab name
         SetTabText(tc,pos,tName)       ' set updated as tab text
         fnParser()
         found=1
         Exit For            
    END IF
Next c
            
IF found=1
'print "tab *New found!->RETURN"
Return   'ret    
end if
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~      
'If tabname already exists !
'IF found=0    
'tName = GetTabText(tc,pos)
'tName = Trim(tName)
/*
For c = 0 To 63
        IF tabName[c] = tName
           tabValue[c] = filename
            SetTabText(tc,pos,tName)  'update tab name
             ReOpenFile()             'reOpen file from filePath
             fnParser()               'parse code
            found=1                  'confirm found          
        END IF
Next c
END IF
*/

IF found=1
'print "tabname already exists!->RETURN"
Return   'ret
end if
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'print" ELSE -> create new tab ...."
'print "ELSE->CREATE NEW TAB"

tabIndex=tabIndex+1  ' increase tab count
AddTab( tc, tabIndex, "*New")
SendMessage tc,TCM_SETCURSEL,tabIndex,0  ' set newTab as SELECTED

IF found=0
INT epos = -1
'search for first empty tabName in tabName[]
        For c = 0 To 63
            IF  tabName[c] = ""         
                tabName[c] = "*New" ' set first empty place with *New
                  tabValue[c] = ""    ' reset
                  epos=c              
                  Exit For
              END IF
         Next c
'-------------------------------------------
IF epos = -1
print "ERROR: File List Out Of Range! -> 63"
RETURN
END IF
'------------------------------------------
'if is OK update new tab !
pos = GetSelectedTab(tc)
'print "GET SELECTED TAB:" + str(pos)
'search for tab -> *New
For c = 0 To 63
    IF  tabName[c] = "*New"         
        tabValue[c] = filename
         tName = GetFileName(filename) ' extract file name from filePath/tab name/
         tabName[c] = tName             ' update tab name
         SetTabText(tc,pos,tName)       ' set updated as tab text
         ReOpenFile()                   'reOpen file from filePath
         fnParser()    
         found=1
         Exit For            
    END IF
Next c

END IF
'~~~~~~~~~~~~~~~~~~~~~~
RETURN
END SUB
'----------------------------------------------------------
SUB FindTab
INT found,tempTab,c
STRING tName,tabItem

tempTab=GetSelectedTab(tc)
tabItem = str(tempTab)
SendMessage edit3,WM_SETTEXT,0,strptr(tabItem) ' show tab id /zero-based/
tName=GetTabText(tc,tempTab)
tName=Trim(tName)
'print "LEN:GETText:" + str(len(tname))
SendMessage edit4,WM_SETTEXT,0,strptr(tName)   'show tab name
'print "LEN_after_TRIM:" + str(len(tName))

IF tName="*New"
SendMessage hsci,SCI_CLEARALL,0,0
Return
END IF

found=0
'show filePath [EDIT 1]-> C:\folder\myfile.bas
SendMessage edit1,WM_SETTEXT,0,strptr(tabValue[tempTab])
'search tab name...
For c = 0 To 63
    IF  tabName[c] = tName
         'print "FOUND:" + tabName[c]         
        found=1:Exit For                
    END IF
Next c

IF found = 1
ReOpenFile()
fnParser()
Return                
END IF
'-------------------
IF found=0
'MESSAGEBOX 0,"New File!","Message..."
Return
END IF

END SUB

'----------------------------------------------------------
SUB ReOpenFile
SendMessage hsci,SCI_CLEARALL,0,0
INT tempTab,c
STRING name,filePath
tempTab=GetSelectedTab(tc)
name=GetTabText(tc,tempTab)
name=Trim(name)
'print "RE-OPEN:" + name

For c = 0 To 63
    IF  tabName[c] = name          
        filePath = tabValue[c]
         Exit For            
    END IF
Next c
SendMessage edit1,WM_SETTEXT,0,strptr(filePath)
'print "REOPEN-GetName:" + name
tx =  GetFile filePath
SendMessage hsci,SCI_SETTEXT,0,strptr(tx)
SendMessage hsci,SCI_SETSAVEPOINT, 0, 0
SendMessage hsci,SCI_EMPTYUNDOBUFFER,0,0


END SUB
'----------------------------------------------------------
SUB CreateNewTab
int tab,c=0 : string tabnum
tabIndex=tabIndex+1
'first stored info for tabArray AT pos->0
tabName[c]="*New"
tabValue[c] = ""
'create new tab
AddTab( tc, tabIndex,"*New")
SendMessage tc,TCM_SETCURSEL,tabIndex,0  'set selected new tab
Tab=GetSelectedTab(tc)                   'get selected tab
tabNum = str(tab)
SendMessage edit3,WM_SETTEXT,0,strptr(tabnum) 'show tab ID

Return
END SUB

'-----------------------------------------------------------
SUB NewTab
tabIndex=tabIndex+1  ' increase tab count
AddTab( tc, tabIndex, "*New")
SendMessage tc,TCM_SETCURSEL,tabIndex,0  ' set newTab as SELECTED
INT epos = -1
'search for first empty tabName in tabName[]
        For c = 0 To 63
            IF  tabName[c] = ""         
                tabName[c] = "*New" ' set first empty place with *New
                  tabValue[c] = ""    ' reset
                  epos=c              
                  Exit For
              END IF
         Next c
'-------------------------------------------
IF epos = -1
print "ERROR: File List Out Of Range! -> 63"
RETURN
END IF

END SUB
'-----------------------------------------------------------

SUB fnParser
'reset listbox content ***************************************
STRING o2script[100000] 'string array
SendMessage LBox,LB_RESETCONTENT,0,o2script[100000]
STRING i$,txt,d$=" "
STRING GW1,GW2
INT smax,start,lineNum,iLen,bo,ipos
start=0
smax = Sendmessage hsci,SCI_GETLINECOUNT, 0, 0

'parse line by line >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
FOR lineNum = 1 TO smax
    
int Pos=0
int EPos=0
int SPos=0
int WC=0

'get-line ........................................................

iLen = SendMessage hsci,SCI_LINELENGTH,lineNum,0    'get line length
o2script[lineNum] = String(iLen," ")                'set buffer space
Sendmessage hsci,SCI_GETLINE, lineNum, strPtr(o2script[lineNum])
'test ///////////////////////////////
'print "LINE:" + o2script[lineNum]
'///////////////////////////////////
o2script[lineNum] = Ltrim(o2script[lineNum])
'--------------------------------------------
WC = 1
    Pos = InStr(1,o2script[lineNum], d$)
    While Pos > 0
        WC = WC + 1
        Pos = InStr(pos+1,o2script[lineNum], d$)
    Wend
'test wc------------------------------------------
'print WC
IF wc>0      
    SPos = 1      
    EPos = InStr(SPos,o2script[lineNum], d$) - 1
    If EPos <= 0 Then EPos = LEN(o2script[lineNum])
    GW1 = RTrim(LTrim(Mid(o2script[lineNum], SPos, EPos - SPos + 1)))
'print "GW1:"+GW1
END IF
'--------------------------------------------------
IF wc>1      
    SPos=EPos+2      
    EPos = InStr(SPos,o2script[lineNum], d$) - 1
    If EPos <= 0 Then EPos = LEN(o2script[lineNum])
    GW2 = RTrim(LTrim(Mid(o2script[lineNum], SPos, EPos - SPos + 1)))
'print "GW2:"+GW2
END IF

'test string & add to listbox
'/// SUB ///
IF Ucase(GW1) = "SUB"
'remove bracket ((((((((((((((((
bo = Instr (GW2,"(")
'print str(Len(GW2))
'print "BO:"+str(bo)
IF bo<>0
   bo=bo-1
   GW2=Mid(GW2,1,bo)
   bo=0
END IF
i$ = "SUB:" + GW2

SendMessage Lbox,LB_ADDSTRING,0,i$
LBitems[LBitem]=lineNum
LBitem=LBitem+1
END IF

'/// FUNCTION ///
IF (Ucase(GW1) = "FUNCTION") And (Left(GW2,1)<>"=") And (Mid(GW1,9)<>"=")
bo = Instr (GW2,"(")
IF bo<>0
   bo=bo-1
   GW2=Mid(GW2,1,bo)
   bo=0
END IF
i$ = "FN:" + GW2
SendMessage Lbox,LB_ADDSTRING,0,i$
LBitems[LBitem]=lineNum
LBitem=LBitem+1
END IF
GW1="":GW2=""

NEXT
LBitem=0
END SUB


'///////////////////////////////////////
SUB AddTButton(twnd as sys,id as sys,iNum as sys,tip as string)
TOOLINFO tti

tti.cbSize = sizeof tti
tti.uFlags = 0   'TTF_SUBCLASS | TTF_IDISHWND
tti.hwnd   = twnd
tti.uId    = id
tti.hinst  = 0
tti.lpszText = strPtr tip

SendMessage(SendMessage( htbar, 1059,0,0),1028, 0, &tti)

'add button
tbb.iBitmap = iNum
tbb.idCommand = id
tbb.fsState = 4
tbb.fsStyle = 0    
tbb.dwData = 0
SendMessage htbar , 1044, 1, &tbb


END SUB


'//////////////////////////////////////
SUB oxyKeywords

'blue
sciblue="enum operator dim const local static global declare function sub method end if then else elseif endif "
sciblue=sciblue+"endsel do while enddo endwhile wend exit continue operation operations select case for to step next "
sciblue=sciblue+"goto gosub methods return block scope indexbase lib library extern that this "
sciblue=sciblue+"readstate writestate deff type val ltrim rtrim lcase ucase space left mid instr "
sciblue=sciblue+"asc len chr str hex print ellipse rgb sendmessage closewindow "
sciblue=sciblue+"with "
sciblue=sciblue+"noinit "
sciblue=sciblue+"byval "
sciblue=sciblue+"byref "
sciblue=sciblue+"economy "
sciblue=sciblue+"fpu "
sciblue=sciblue+"cpu "
sciblue=sciblue+"noprec "
sciblue=sciblue+"include "
sciblue=sciblue+"define "
sciblue=sciblue+"typedef "
sciblue=sciblue+"includepath "
sciblue=sciblue+"lookahead "
sciblue=sciblue+"view "
sciblue=sciblue+"endv "
sciblue=sciblue+"version "
sciblue=sciblue+"getmemory "
sciblue=sciblue+"freememory "
sciblue=sciblue+"getprocaddress "
sciblue=sciblue+"copy0 "
sciblue=sciblue+"copy00 "
sciblue=sciblue+"copyn "
sciblue=sciblue+"copy "
sciblue=sciblue+"msgbox "
sciblue=sciblue+"comparestr "
'----------------------------
sciblue=sciblue+"alias macro as "
sciblue=sciblue+"incl "
sciblue=sciblue+"semicolon "
sciblue=sciblue+"indexers "
sciblue=sciblue+"retn "
sciblue=sciblue+"offset "
sciblue=sciblue+"skip "
sciblue=sciblue+"with "
sciblue=sciblue+"dataspace "
sciblue=sciblue+"data "
sciblue=sciblue+"o2 "
sciblue=sciblue+"bind "
sciblue=sciblue+"defs "
sciblue=sciblue+"def "
sciblue=sciblue+"struct "
sciblue=sciblue+"class "
sciblue=sciblue+"var "
sciblue=sciblue+"asm "
sciblue=sciblue+"o2h "
sciblue=sciblue+"librarypath "
sciblue=sciblue+"file "
sciblue=sciblue+"quote "
sciblue=sciblue+"union "
sciblue=sciblue+"leaf "
sciblue=sciblue+"autodim "
sciblue=sciblue+"minormajor "
sciblue=sciblue+"alert "
sciblue=sciblue+"pragma "
sciblue=sciblue+"unique "
sciblue=sciblue+"console "
sciblue=sciblue+"elif "
sciblue=sciblue+"fi "
sciblue=sciblue+"ifdef "
sciblue=sciblue+"ifndef "
sciblue=sciblue+"undef "
sciblue=sciblue+"undefine "
sciblue=sciblue+"blockdepth "
sciblue=sciblue+"new "
sciblue=sciblue+"del "
sciblue=sciblue+"terminate "
sciblue=sciblue+"freestrings "
sciblue=sciblue+"freelibs "
sciblue=sciblue+"inherits "
sciblue=sciblue+"of "
sciblue=sciblue+"from "
sciblue=sciblue+"has "
sciblue=sciblue+"export "
sciblue=sciblue+"external "
sciblue=sciblue+"com "
sciblue=sciblue+"virtual "
sciblue=sciblue+"endselect "
sciblue=sciblue+"load "
sciblue=sciblue+"and "
sciblue=sciblue+"or "
sciblue=sciblue+"xor "
sciblue=sciblue+"stdcall "
sciblue=sciblue+"cdecl "
sciblue=sciblue+"ms64 "
sciblue=sciblue+"at "
sciblue=sciblue+"not "
sciblue=sciblue+"once "
sciblue=sciblue+"public "
sciblue=sciblue+"private "
sciblue=sciblue+"strptr "
sciblue=sciblue+"getfile putfile loadlibrary getdc releasedc sizeof "
sciblue=sciblue+"createwindowex filedialog trim msgbox "
'--/////////  AWIH keywords in blue  ///////////////////---------------------------------
sciblue=sciblue+"wndproc addtab getselectedtab settabtext gettabtext gettabcount gettext settext controlfont "
sciblue=sciblue+"setwindow seteditbox setrichedit setbutton setlistbox setcombobox setstatic settoolbar settabcontrol "
'############ RUBEN
sciblue=sciblue+"set wform txcolor pix shift loopto wtext line circle rect jump label "
sciblue=sciblue+"sin cos tan sqr rnd rand int sys long string bstring float double "

'darkred - brown
scibrown=scibrown+"void "
scibrown=scibrown+"byte "
scibrown=scibrown+"astring "
scibrown=scibrown+"pstring "
scibrown=scibrown+"bstring "
scibrown=scibrown+"char "
scibrown=scibrown+"zstring "
scibrown=scibrown+"wstring "
scibrown=scibrown+"bstring2 "
scibrown=scibrown+"zstring2 "
scibrown=scibrown+"asciiz "
scibrown=scibrown+"short "
'scibrown=scibrown+"int "
'scibrown=scibrown+"integer "
'scibrown=scibrown+"float "
scibrown=scibrown+"single "
'scibrown=scibrown+"sys "
'scibrown=scibrown+"double "
scibrown=scibrown+"quad "
scibrown=scibrown+"word "
scibrown=scibrown+"dword "
scibrown=scibrown+"qword "
scibrown=scibrown+"uint "
scibrown=scibrown+"__int8 "
scibrown=scibrown+"__int16 "
scibrown=scibrown+"__int32 "
scibrown=scibrown+"__int64 "
scibrown=scibrown+"int8_t "
scibrown=scibrown+"int16_t "
scibrown=scibrown+"int32_t "
scibrown=scibrown+"int64_t "
scibrown=scibrown+"uint8_t "
scibrown=scibrown+"uint16_t "
scibrown=scibrown+"uint32_t "
scibrown=scibrown+"uint64_t "
scibrown=scibrown+"any "
scibrown=scibrown+"sys"
scibrown=scibrown+"bool "
scibrown=scibrown+"signed "
scibrown=scibrown+"unsigned "
scibrown=scibrown+"string "
scibrown=scibrown+"long "
'------------------------
scibrown=scibrown+"defn narray "

END SUB
'
'///// EDITOR  ABOUT WINDOW - AboutBox  ///////////////////////////////////////////
SUB AboutBox
String mbff=""
mbff="Scintilla based code editor written with pure WIN32 API"+chr(13)
'mbff=mbff + "Code Editor written..................."+chr(13)
mbff=mbff + "Created by Aurel v01-2015"+chr(13)
'create  about window **************************
wabout = SetWindow("About AurelEdit...",300,160,412,400,0,WS_SYSMENU)
'create static control
static3 = SetStatic(wabout,2,2,400,300,"",0x5000030E,0,st3ID)
SendMessage static3, 370, 0, bmpB1
static4 = SetStatic(wabout,4,310,398,50,mbff,0x50000101,0x200,st4ID)

aboutWindow = 1
END SUB
    
'/////// EDITOR OPTION WINDOW  ////////////////////////////////////////////////////
SUB OptWindow
INT static5,st5ID=355
STRING bff,bf1
'create option window **************************
optWin = SetWindow("Editor options...",300,160,412,400,0,WS_SYSMENU)
bff="SET Theme by choosing one of options..."
static5 = SetStatic(optWin,4,4,398,14,bff,0x50000101,0,st5ID)
'----------------------------------------------------------------------------------
INT st6ID=336,st7ID=338,st8ID=339,st9ID=340
INT static6b,st6bID=337,static7b,st7bID=337,st8bID=440,st9bID=441
'----------------------------------------------------------------------------------
static6 = SetStatic(optWin,8,30,126,14,"Theme : Clear Sea",0x50000100,0,st6ID)
static6b = SetStatic(optWin,330,24,26,26,"",0x5000030E,0,st6bID)
SendMessage static6b, 370, 0, bmpB2
bo1 = SetButton(optWin,160,25,100,24,"[ CLEAR SEA ] -",0x50000000,0x200,bo1ID)
'---------------------------------------------------------------------------------
static7 = SetStatic(optWin,8,60,126,14,"Theme : Soft Desert",0x50000100,0,st7ID)
bo2 = SetButton(optWin,160,55,100,24,"[ SOFT DESERT ] -",0x50000000,0x200,bo2ID)
static7b = SetStatic(optWin,330,55,26,26,"",0x5000030E,0,st7bID)
SendMessage static7b, 370, 0, bmpB3
'----------------------------------------------------------------------------------
static8 = SetStatic(optWin,8,90,126,14,"Theme : Default",0x50000100,0,st8ID)
bo3 = SetButton(optWin,160,85,100,24,"[ DEFAULT ] -",0x50000000,0x200,bo3ID)
static8b = SetStatic(optWin,330,55,26,26,"",0x5000030E,0,st8bID)
SendMessage static8b, 370, 0, bmpB4
'----------------------------------------------------------------------------------
static9 = SetStatic(optWin,8,120,126,14,"Theme : Dark Moon",0x50000100,0,st9ID)
bo4 = SetButton(optWin,160,115,100,24,"[ DARK MOON ] -",0x50000000,0x200,bo4ID)
static9b = SetStatic(optWin,330,55,26,26,"",0x5000030E,0,st9bID)
SendMessage static9b, 370, 0, bmpB5

'----------------------------------------------------------------------------------
optWinOn = 1
END SUB
'===============================================================================​==
SUB FindWindow ' create Find/Replace window As TOOLWINDOW?
'INT fb1,fb2,fb3,fb1ID=501,fb2ID=502,fb3ID=503,fwed1,fwed1ID=504,fwed2,fwed2ID=505
'create ToolWindow require exetended window style to be set
INT hinst = GetModuleHandle 0
fWindow=CreateWindowEx (WS_TOOLWINDOW|WS_EX_TOPMOST , wcx.lpszClassName,"Find/Replace...",WS_SYSMENU, 600, 160, 412, 300, 0, 0, hinst, 0)
ShowWindow fWindow,SW_SHOW : UpdateWindow fWindow
fb1=SetButton(fWindow,20,240,100,24,"[ Find ]",0x50000000,0x200,fb1ID)
fb2=SetButton(fWindow,150,240,100,24,"[ Replace ]",0x50000000,0x200,fb2ID)
fb3=SetButton(fWindow,280,240,100,24,"[ Replace All ]",0x50000000,0x200,fb3ID)
'create single-line edit control and static control
stFW1 = SetStatic(fWindow,20,30,100,26,"Search Word >>>",0x50000001,0,stfw1ID)
fwed1 = SetEditBox(fWindow,150,30,200,23,"",0x50004000,0x200,fwed1ID)
stFW2 = SetStatic(fWindow,20,80,100,26,"Replace With >>>",0x50000001,0,stfw2ID)
fwed2 = SetEditBox(fWindow,150,80,200,23,"",0x50004000,0x200,fwed2ID)
findWinOn = 1
END SUB
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Sub FindNext () as long
INT loc,temp
if loc
loc=SENDMESSAGE hsci,SCI_GETSELECTIONEND,0,0
else
loc=SENDMESSAGE hsci,SCI_GETSELECTIONSTART,0,0
end if

SENDMESSAGE hsci,SCI_SETANCHOR,loc,0,
SENDMESSAGE hsci,SCI_SETCURRENTPOS,loc,0
SENDMESSAGE hsci,SCI_SEARCHANCHOR,0,0

temp=SCFIND_WHOLEWORD
loc=SENDMESSAGE hsci,SCI_SEARCHNEXT,temp,GetText(fwed1)
'---------------------------------------------
IF loc > -1
      SENDMESSAGE hsci,SCI_SCROLLCARET,0,0
ELSE
    Msgbox "No matches found","Search"
Return 0
END IF
'-------------------------------------------
Return loc
End Sub
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Function ReplaceOnce(RepeatS As Long) As Long
If FindNext() = 0    
    Return 0
End if
SENDMESSAGE hsci,SCI_REPLACESEL,0,GetText(fwed2)
Return 1
End Function
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Sub ReplaceAll
   dim iResult As Long
   'If FindNext() = 0 then
   ' Exit Function
   'End If
   iResult = ReplaceOnce(1)
If iResult = 0 then Exit Sub
   While iResult =1
      FindNext()
      iResult = ReplaceOnce(1)                  
   Wend
   MsgBox " All words Replaced!","Info"
End Sub
'/////////////////////////////////////////////////////////////////////
'//////////////////   theme  CLEAR SEA          //////////////////////
Sub SetTheme1
SENDMESSAGE(hsci, SCI_STYLESETBACK,32, RGB(240,240,255)) 'clear sea
SENDMESSAGE(hsci, SCI_STYLECLEARALL, 0, 1)
'set scintilla font
For i = 0 to 8
    SENDMESSAGE (hsci, SCI_STYLESETFONT, i, "Consolas")
    SENDMESSAGE (hsci, SCI_STYLESETSIZE, i, 11)
Next i
'set keyword colors
'SENDMESSAGE(hsci, SCI_SETKEYWORDS, 3,scibrown) :'darkred
SENDMESSAGE(hsci, SCI_SETKEYWORDS, 0, sciblue ):'blue
'Margins ////////////////////////////////////////////////////////
'set number margin (for numnbers)
SendMessage(hsci, SCI_SETMARGINTYPEN, 0, SC_MARGIN_NUMBER)
SendMessage(hsci, SCI_SETMARGINWIDTHN, 0, 46)
'caret line
SENDMESSAGE hsci,SCI_SETCARETLINEBACK,RGB(245,245,200),0
SENDMESSAGE hsci,SCI_SETCARETLINEVISIBLE,1,0
'SetFocus win
'--------------------------------------------------------------------
def sn SendMessage hsci, SCI_STYLESETFORE,
      '
      'setting RGB colors
      sn 0,  0xff0000  '
      sn 1,  0x207800         'line comment
      sn 2,  rgb(160,42,42)  'numbers
      sn 3,  rgb(0,0,170)     'keywords
      sn 4,  rgb(150,0,150)   'string
      sn 5,  0xc00080         '#names
      sn 6,  rgb(200,0,0)     'symbols
      sn 7,  0x002000  '
      '
SetFocus Lbox
End Sub
'//////////////////////////////////////////////////////////////////////
'////// theme  SOFT DESERT  ///////////////////////////////////////////
Sub SetTheme2
SENDMESSAGE(hsci, SCI_STYLESETBACK,32, rgb(243,242,214)) 'soft desert
SENDMESSAGE(hsci, SCI_STYLECLEARALL, 0, 1)
'set scintilla font
For i = 0 to 8
    SENDMESSAGE (hsci, SCI_STYLESETFONT, i, "Courier New")
    SENDMESSAGE (hsci, SCI_STYLESETSIZE, i, 12)
     'SENDMESSAGE hsci, SCI_STYLESETBOLD, i, 12 'uncomment if you wish bold text
Next i
'set keyword colors
'SENDMESSAGE(hsci, SCI_SETKEYWORDS, 0, sciblue ):'blue
SENDMESSAGE(hsci, SCI_SETKEYWORDS, 0, sciblue )
SendMessage hsci, SCI_COLOURISE, 0, -1
'Margins ////////////////////////////////////////////////////////
'set number margin (for numnbers)
SendMessage(hsci, SCI_SETMARGINTYPEN, 0, SC_MARGIN_NUMBER)
SendMessage(hsci, SCI_SETMARGINWIDTHN, 0, 46)
'caret line
SENDMESSAGE hsci,SCI_SETCARETLINEBACK,RGB(220,220,245),0
SENDMESSAGE hsci,SCI_SETCARETLINEVISIBLE,1,0

'--------------------------------------------------------------------
def sn SendMessage hsci, SCI_STYLESETFORE,
      '
      'setting RGB colors
      sn 0,  rgb(180,0,0)  '
      sn 1,  0x207800         'line comment
      sn 2,  rgb(164,42,42)  'numbers
      sn 3,  rgb(0,0,170)     'keywords
      sn 4,  rgb(150,0,150)   'string
      sn 5,  0xc00080         '#names
      sn 6,  rgb(200,0,0)     'symbols
      sn 7,  0x002000  '
      '    
SetFocus Lbox

End Sub
'///////////////////////////////////////////////////////////////////////
'////// theme DEFAULT   /////////////////////////////////////////////////
Sub SetTheme3
SENDMESSAGE(hsci, SCI_STYLESETBACK,32, rgb(255,255,255)) 'default
SENDMESSAGE(hsci, SCI_STYLECLEARALL, 0, 1)
'set scintilla font
For i = 0 to 8
    SENDMESSAGE (hsci, SCI_STYLESETFONT, i, "Courier New")
    SENDMESSAGE (hsci, SCI_STYLESETSIZE, i, 10)
     'SENDMESSAGE hsci, SCI_STYLESETBOLD, i, 12 'uncomment if you wish bold text
Next i
'set keyword colors
'SENDMESSAGE(hsci, SCI_SETKEYWORDS, 0, sciblue ):'blue
SENDMESSAGE(hsci, SCI_SETKEYWORDS, 0, sciblue )
SendMessage hsci, SCI_COLOURISE, 0, -1
'Margins ////////////////////////////////////////////////////////
'set number margin (for numnbers)
SendMessage(hsci, SCI_SETMARGINTYPEN, 0, SC_MARGIN_NUMBER)
SendMessage(hsci, SCI_SETMARGINWIDTHN, 0, 46)
'caret line
SENDMESSAGE hsci,SCI_SETCARETLINEBACK,RGB(245,245,200),0
SENDMESSAGE hsci,SCI_SETCARETLINEVISIBLE,1,0

'--------------------------------------------------------------------
def sn SendMessage hsci, SCI_STYLESETFORE,
      '
      'setting RGB colors
      sn 0,  rgb(180,0,0)  '
      sn 1,  0x207800         'line comment
      sn 2,  rgb(164,42,42)  'numbers
      sn 3,  rgb(0,0,170)     'keywords
      sn 4,  rgb(150,0,150)   'string
      sn 5,  0xc00080         '#names
      sn 6,  rgb(200,0,0)     'symbols
      sn 7,  0x002000  '
      '    
SetFocus Lbox

End Sub
'//////////////////////////////////////////////////////////////////////////
'///// theme DARK MOON   //////////////////////////////////////////////////
Sub SetTheme4
SENDMESSAGE(hsci, SCI_STYLESETBACK,32, rgb(50,50,80)) 'dark moon
SENDMESSAGE(hsci, SCI_STYLECLEARALL, 0, 1)
'set scintilla font
For i = 0 to 8
    SENDMESSAGE (hsci, SCI_STYLESETFONT, i, "Courier New")
    SENDMESSAGE (hsci, SCI_STYLESETSIZE, i, 10)
     'SENDMESSAGE hsci, SCI_STYLESETBOLD, i, 12 'uncomment if you wish bold text
Next i
'set keyword colors
'SENDMESSAGE(hsci, SCI_SETKEYWORDS, 0, sciblue ):'blue
SENDMESSAGE(hsci, SCI_SETKEYWORDS, 0, sciblue )
SendMessage hsci, SCI_COLOURISE, 0, -1
'Margins ////////////////////////////////////////////////////////
'set number margin (for numnbers)
SendMessage(hsci, SCI_SETMARGINTYPEN, 0, SC_MARGIN_NUMBER)
SendMessage(hsci, SCI_SETMARGINWIDTHN, 0, 46)
'caret line
SENDMESSAGE hsci,SCI_SETCARETLINEBACK,RGB(45,145,60),0
SENDMESSAGE hsci,SCI_SETCARETLINEVISIBLE,1,0

'--------------------------------------------------------------------
def sn SendMessage hsci, SCI_STYLESETFORE,
      '
      'setting RGB colors
      sn 0,  rgb(0,0,220)  '
      sn 1,  rgb(80,100,100)        'line comment
      sn 2,  rgb(200,180,123)   'numbers
      sn 3,  rgb(140,140,250)     'keywords
      sn 4,  rgb(150,0,150)   'string
      sn 5,  0xc00080         '#names
      sn 6,  rgb(200,180,100)     'symbols
      sn 7,  rgb(180,200,220) 'other
      '    
SetFocus Lbox
End Sub
Find all posts by this user
Quote this message in a reply
05-19-2017, 05:03 AM
Post: #2
RE: Aurel Edit
and here is include file for abouve code:
Code:
'#########################################
' awinh include file - by  Aurel 2013
'#########################################
'#lookahead
Type WNDCLASSEX
cbSize        as long
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
hIconSm       AS long
End Type

Type LARGE_INTEGER
lowpart AS INT
highpart AS INT
End Type


Type POINTAPI
x as sys
y as sys
End Type

Type MSG
hwnd    as sys
message as sys
wParam  as sys
lParam  as sys
time    as sys
pt      as PointApi
End Type

Type RECT
Left   as Long
Top    as Long
Right  as Long
Bottom as Long
End Type

type PAINTSTRUCT
    sys hDC
    bool fErase
    RECT rcPaint
    bool fRestore
    bool fIncUpdate
    byte rgbReserved[32]
  end type

Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As sys
    lpstrCustomFilter As sys
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As sys
    nMaxFile As Long
    lpstrFileTitle As sys
    nMaxFileTitle As Long
    lpstrInitialDir As sys
    lpstrTitle As sys
    flags As Long
    nFileOffset As word
    nFileExtension As word
    lpstrDefExt As sys
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As sys
End Type

% OFN_EXPLORER = 0x00080000
% OFN_PATHMUSTEXIST = 0x00000800
% OFN_FILEMUSTEXIST = 0x00001000
% OFN_OVERWRITEPROMPT = 0x00000002
% OFN_HIDEREADONLY = 0x00000004

% BCM_FIRST = 0x1600
% BCM_SETIMAGELIST = (BCM_FIRST + 0x0002)

% SW_NORMAL      = 1
% SW_SHOWDEFAULT = 10
% SW_SHOW        = 5
% CS_VREDRAW     = 1
% CS_HREDRAW     = 2
% CS_DBLCLKS     = 0x8
% CS_OWNDC       = 32
% SM_CXSCREEN    = 0
% SM_CYSCREEN    = 1
% IDI_HAND       = 32513
% IDI_QUESTION   = 32514
% IDI_EXCLAMATION= 32515
% IDI_ASTERISK   = 32516
% IDI_WINLOGO    = 32517
% IDI_APPLICATION= 32512
% IDC_ARROW      = 32512
% IDC_WAIT       = 32514
% IDC_HAND       = 32649
% IDC_ICON       = 32641
% IDC_IBEAM      = 32513
% IDC_NO         = 32648

% WM_SETICON     = &H80
% WM_KILLFOCUS = 0x8  
% WM_CREATE      = 1
% WM_DESTROY     = 2
% WM_CLOSE       = 0x10
% WM_PAINT       = 15
% WM_QUIT        = 18
% WM_SIZE        = 5
% WM_MOVE        = 3
% WM_CHAR        = 258
% WM_KEYLAST     = &H108
% WM_KEYFIRST    = &H100
% WM_KEYDOWN     = 256
% WM_MOUSEMOVE   = 512
% WM_MBUTTONDOWN = 519
% WM_LBUTTONDOWN = 513
% WM_RBUTTONDOWN = 516
% WM_LBUTTONUP   = 514
% WM_RBUTTONUP   = 517
% WM_MBUTTONUP   = 520
% WM_TIMER       = 275
% WM_WINDOWPOSCHANGED = &H47
% WM_NOTIFY      = 0x004E
% WM_SETFONT = &H30
% WM_COMMAND = 0x111
% BN_CLICKED = 0
% WM_PARENTNOTIFY = 0x210
% WM_SETTEXT  = &HC
% WM_GETTEXT = 0xD
% WM_USER = 0x400
% WM_HSCROLL = 276

' Edit Control Messages
% EM_GETSEL = 0xB0
% EM_SETSEL = 0xB1
% EM_HIDESEL = 19
% EM_GETRECT = 0xB2
% EM_SETRECT = 0xB3
% EM_SETRECTNP = 0xB4
% EM_SCROLL = 0xB5
% EM_LINESCROLL = 0xB6
% EM_SCROLLCARET = 0xB7
% EM_GETMODIFY = 0xB8
% EM_SETMODIFY = 0xB9
% EM_GETLINECOUNT = 0xBA
% EM_LINEINDEX = 0xBB
% EM_SETHANDLE = 0xBC
% EM_GETHANDLE = 0xBD
% EM_GETTHUMB = 0xBE
% EM_LINELENGTH = 0xC1
% EM_REPLACESEL = 0xC2
% EM_GETLINE = 0xC4
% EM_LIMITTEXT = 0xC5
% EM_CANUNDO = 0xC6
% EM_UNDO = 0xC7
% EM_FMTLINES = 0xC8
% EM_LINEFROMCHAR = 0xC9
% EM_SETTABSTOPS = 0xCB
% EM_SETPASSWORDCHAR = 0xCC
% EM_EMPTYUNDOBUFFER = 0xCD
% EM_GETFIRSTVISIBLELINE = 0xCE
% EM_SETREADONLY = 0xCF
% EM_SETWORDBREAKPROC = 0xD0
% EM_GETWORDBREAKPROC = 0xD1
% EM_GETPASSWORDCHAR = 0xD2
'stayle no hide selection -add to richedit style
% ES_NOHIDESEL = 256
'charformat structure...
TYPE CHARFORMAT
  INT     cbSize
  DWORD    dwMask
  DWORD    dwEffects
  LONG     yHeight
  LONG     yOffset
  INT crTextColor
  BYTE     bCharSet
  BYTE     bPitchAndFamily
  CHAR    szFaceName[LF_FACESIZE]
END TYPE

'bm bitmaps
% BM_SETIMAGE = 247
% IMAGE_BITMAP = 0
% COLOR_BTNFACE = 15
% ILC_MASK = 1
% ILC_COLOR8 = 8
% ILC_COLOR16 = 16
% PS_SOLID = 0
% SRCCOPY = 0xCC0020

'progress constants
% PBM_SETPOS = 0x402
% PBM_SETRANGE32 = 0x406

'trackbar constants
% TB_TUMBTRACK = 5

% WS_CLIPSIBLINGS = 0x4000000
% WS_CLIPCHILDREN = 0x2000000
% WS_SYSMENU     = 524288
% WS_THICKFRAME = 0x40000
% WS_CAPTION = 0xC00000
% WS_OVERLAPPED  = 0x0  
% WS_TOOLWINDOW = 0x80
% WS_TOPMOST = 0x8
% WS_EX_TOPMOST = 8
% WS_WINDOWEDGE = 0x100
% WS_HIDDEN = 2048
% WS_SIZED  = 262144
% WS_POPUP       = 0x80000000
% WS_DLGFRAME    = 0x400000
% WS_MAXIMIZE    = &H1000000
% WS_MINIMIZEBOX = &H20000
% WS_MAXIMIZEBOX = 0x10000
% WS_BORDER      = &H800000
% WS_CHILD = 0x40000000
% WS_VISIBLE = 0x10000000
% WS_VSCROLL = 0x200000
% WS_HSCROLL = 0x100000
'minmaxsize-> overlappedwindow
% WS_MINMAXSIZE =(WS_OVERLAPPED Or WS_VISIBLE Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)

% TRANSPARENT    = 1
% OPAQUE         = 2
% PM_REMOVE      = 1
% PM_NOREMOVE    = 0
% PM_NOYIELD     = 2
% NULL_BRUSH     = 5

% ES_SUNKEN = 0x4000
% ES_MULTILINE = 0x4
% ES_WANTRETURN = 0x1000
% ES_AUTOVSCROLL = 0x40
% ES_AUTOHSCROLL = 0x80

' Listbox messages
% LB_ADDSTRING = 0x180
% LB_INSERTSTRING = 0x181
% LB_DELETESTRING = 0x182
% LB_SELITEMRANGEEX = 0x183
% LB_RESETCONTENT = 0x184
% LB_SETSEL = 0x185
% LB_SETCURSEL = 0x186
% LB_GETSEL = 0x187
% LB_GETCURSEL = 0x188
% LB_GETTEXT = 0x189
% LB_GETTEXTLEN = 0x18A
% LB_GETCOUNT = 0x18B
% LB_SELECTSTRING = 0x18C
% LB_DIR = 0x18D
% LB_GETTOPINDEX = 0x18E
% LB_FINDSTRING = 0x18F
% LB_GETSELCOUNT = 0x190
% LB_GETSELITEMS = 0x191
% LB_SETTABSTOPS = 0x192
% LB_GETHORIZONTALEXTENT = 0x193
% LB_SETHORIZONTALEXTENT = 0x194
% LB_SETCOLUMNWIDTH = 0x195
% LB_ADDFILE = 0x196
% LB_SETTOPINDEX = 0x197
% LB_GETITEMRECT = 0x198
% LB_GETITEMDATA = 0x199
% LB_SETITEMDATA = 0x19A
% LB_SELITEMRANGE = 0x19B
% LB_SETANCHORINDEX = 0x19C
% LB_GETANCHORINDEX = 0x19D
% LB_SETCARETINDEX = 0x19E
% LB_GETCARETINDEX = 0x19F
% LB_SETITEMHEIGHT = 0x1A0
% LB_GETITEMHEIGHT = 0x1A1
% LB_FINDSTRINGEXACT = 0x1A2
% LB_SETLOCALE = 0x1A5
% LB_GETLOCALE = 0x1A6
% LB_SETCOUNT = 0x1A7
% LB_MSGMAX = 0x1A8
% LBN_DBLCLICK = 2
% CTLISTNOTIFY = 1

'combo constants------------------------------
% CB_INSERTSTRING = 0x14A
% CB_RESETCONTENT = 0x14B
% CB_FINDSTRING = 0x14C
% CB_SELECTSTRING = 0x14D
% CB_SETCURSEL = 0x14E
% CB_SHOWDROPDOWN = 0x14F
% CB_GETITEMDATA = 0x150
% CB_SETITEMDATA = 0x151

'treeview constants -------------------------
% TVS_LINESATROOT = 0x0004
% TVS_HASLINES = 2
% TVS_HASBUTTONS = 0x0001
% TV_FIRST = 0x1100
% TVS_CHECKBOXES = 0x100
% TVM_SETBKCOLOR = (TV_FIRST + 29)
% TVM_SETLINECOLOR = (TV_FIRST + 40)
% TVM_SETTEXTCOLOR = (TV_FIRST + 30)
% TVM_SETITEMA = (TV_FIRST + 13)
% TVM_INSERTITEMW = (TV_FIRST + 50)
% TVM_INSERTITEM = 4352
% TVI_ROOT = 0xFFFF0000
% TVI_LAST = 0xFFFF0002
'..................................
% TVIF_TEXT = 1
% TVIF_HANDLE = 16
% TVIF_IMAGE = 2
% TVIF_PARAM = 4
% TVIF_DI_SETITEM = 128
% TVSELECTEDIMAGE = 36
'.................................
TYPE TVINSERTSTRUCT
hParent as int
hInsertAfter as int
mask as int  ' tvitemex  
hitem as int
state as int
statemask as int
pszText as sys
cchTextMax as int
iImage as int
iSelectedImage as int
cChildren as int
lparam as int
IIntegral as int
End TYPE
'.................................
TYPE NMTREEVIEW
hwnd as int
idfrom as int
code as int
action as int
omask as int
ohitem as int
ostate as int
ostatemask as int
opszText as sys
occhTextMax as int
oiImage as int
oiSelectedImage as int
ocChildren as int
olparam as int
oIIntegral as int
nmask as int
nhitem as int
nstate as int
nstatemask as int
npszText as sys
ncchTextMax as int
niImage as int
niSelectedImage as int
ncChildren as int
nlparam as int
nIIntegral as int
End TYPE
Dim tvi As TVINSERTSTRUCT
Dim MyNmTV As NMTREEVIEW

'tabControl constants-------------------------
% TCM_FIRST = 0x1300
% TCM_SETITEM = (TCM_FIRST + 6)
% TCM_GETITEM = 4869
% TCM_GETITEMCOUNT = 4868
% TCM_DELETEITEM = (TCM_FIRST + 8)
% TCM_INSERTITEM = 0x1307
% TCM_SETCURFOCUS = 0x1330
% TCN_FIRST = -550
% TCN_SELCHANGE = -551
% TCN_SELCHANGING = -552
% TCM_GETCURSEL = 4875
% TCM_SETCURSEL = 0x130C
% TCIF_TEXT=1
% TCS_HOTTRACK = 0x40

TYPE TC_ITEM
mask as int
res1 as int
res2 as int
pszText as sys
cchTextMax as int
iImage as int
lParam as int
END TYPE

'toolbar constants.............................
'type INITCOMMONCONTROLSEX
'    dwSize as DWORD
'    dwICC as DWORD
'end type
'typedef INITCOMMONCONTROLSEX *LPINITCOMMONCONTROLSEX
typedef struct tagINITCOMMONCONTROLSEX {
  DWORD dwSize;
  DWORD dwICC;
} INITCOMMONCONTROLSEXtype, *LPINITCOMMONCONTROLSEX;

'tooltips constants ''''''''''''''''''''''''''''''''''''''''''''''''''
% TB_SETTOOLTIPS = 1060
% EBTOOLTIPS = 256
% TBSTYLE_TOOLTIPS = &H100
% TBSETTIP = 9
% TTS_ALWAYSTIP = &H1
% TTS_NOPREFIX = &H2
% TTS_BALLOON = &H40 ' comctl32.dll v5.8 require
% TTM_ACTIVATE = WM_USER+1

% TTM_ADDTOOL = (WM_USER + 4)
% TTM_DELTOOL = (WM_USER + 5)
% TTM_NEWTOOLRECT = (WM_USER + 6)
% TTM_GETTOOLINFO = (WM_USER + 8)
% TTM_SETTIPBKCOLOR = (WM_USER + 19)
% TTM_SETTIPTEXTCOLOR = (WM_USER + 20)
% TTM_SETMAXTIPWIDTH = (WM_USER + 24)
% TTM_UPDATETIPTEXT  = 1036
% TTDT_AUTOPOP = 2
% TTDT_INITIAL = 3

% TTF_IDISHWND = &H1
% TTF_CENTERTIP = &H2
% TTF_SUBCLASS = &H10

Type TOOLINFO
    cbSize      As int
    uFlags      As int
    hWnd        As int
    uId         As int
    cRect       As Rect
    hinst       As int
    lpszText    As sys
End Type

'trackbar constants'''''''''''''''''''''''''''''
% TBM_SETPAGESIZE = 1045
% TBM_SETRANGEMIN = 1031
% TBM_SETRANGEMAX = 1032
% TBM_SETPOS = 1029
% TRACKBARNORMAL = 1409351681

'..............................................
% CCS_ADJUSTABLE = 32
% CCS_NODIVIDER = 64
% TBSTYLE_FLAT = &H800
% tb_addbuttons = wm_user+21
% TB_SETIMAGELIST = 1072
% TB_ADDBITMAP    = 1043
% TB_AUTOSIZE     = 1057
'..............................................
TYPE TBBUTTON
    iBitmap    as long
    idCommand  as long
    fsState    as byte
    fsStyle    as byte
     bReserved[0] as byte
     bReserved[1] as byte
    dwData     as long
    iString     as sys
END TYPE

'statusbar constants
% SBARS_SIZEGRIP = 0x100

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

% WHITE_BRUSH    = 0
% BLACK_BRUSH    = 4
% LTGRAY_BRUSH = 0xC0C0C0
% LTGRBL_BRUSH = 0xDCDCCE

% vk_LBUTTON  = &H1    
% vk_RBUTTON  = &H2
% vk_MBUTTON  = &H4
% vk_BACK     = &H8
% vk_TAB      = &H9
% vk_CLEAR    = &HC
% vk_RETURN   = &HD
% vk_SHIFT    = &H10
% vk_CONTROL  = &H11
% vk_MENU     = &H12
% vk_PAUSE    = &H13
% vk_CAPITAL  = &H14
% vk_ESCAPE   = &H1B
% vk_SPACE    = &H20
% vk_PRIOR    = &H21
% vk_NEXT     = &H22
% vk_END      = &H23
% vk_HOME     = &H24
% vk_LEFT     = &H25
% vk_UP       = &H26
% vk_RIGHT    = &H27
% vk_DOWN     = &H28
% vk_PRINT    = &H2A
% vk_SNAPSHOT = &H2C    
% vk_INSERT   = &H2D
% vk_DELETE   = &H2E
% vk_HELP     = &H2F
% vk_0 = &H30
% vk_1 = &H31
% vk_2 = &H32
% vk_3 = &H33
% vk_4 = &H34
% vk_5 = &H35
% vk_6 = &H36
% vk_7 = &H37
% vk_8 = &H38
% vk_9 = &H39
% vk_@ = &H40
% vk_A = &H41
% vk_B = &H42
% vk_C = &H43
% vk_D = &H44
% vk_E = &H45
% vk_F = &H46
% vk_G = &H47
% vk_H = &H48
% vk_I = &H49
% vk_J = &H4A
% vk_K = &H4B
% vk_L = &H4C
% vk_M = &H4D
% vk_N = &H4E
% vk_O = &H4F
% vk_P = &H50
% vk_Q = &H51
% vk_R = &H52
% vk_S = &H53
% vk_T = &H54
% vk_U = &H55
% vk_V = &H56
% vk_W = &H57
% vk_X = &H58
% vk_Y = &H59
% vk_Z = &H5A
% vk_F1  = &H70
% vk_F2  = &H71
% vk_F3  = &H72
% vk_F4  = &H73
% vk_F5  = &H74
% vk_F6  = &H75
% vk_F7  = &H76
% vk_F8  = &H77
% vk_F9  = &H78
% vk_F10 = &H79
% vk_F11 = &H7A
% vk_F12 = &H7B
% vk_NUMLOCK    = &H90
% vk_OEM_SCROLL = &H91    
% vk_LSHIFT     = &HA0
% vk_RSHIFT     = &HA1
% vk_LCONTR     = &HA2    
% vk_RCONTROL   = &HA3
    
#lookahead

Dim kernel32,user32,gdi32,riched32,comdialog32,comctl32
kernel32 = LoadLibrary "kernel32.dll"
user32   = LoadLibrary "user32.dll"
gdi32    = LoadLibrary "gdi32.dll"
riched32 =  LoadLibrary "riched32.dll"
comctl32 = LoadLibrary "comctl32.dll"
'comdialog32 =  LoadLibrary "comdlg32.dll"
Bind kernel32
(
    
  GetModuleHandle GetModuleHandleA
  'GetCurrentDir    GetCurrentDirectoryA '"kernel32",GetCurrentDirectoryA(nBufferLength:int,lpBuffer:String),int  
  ExitProcess     ExitProcess
  GetTickCount    GetTickCount
  sleep           Sleep
  Beep            Beep    
)  

Bind user32
(
  LoadIcon         LoadIconA        
  LoadCursor       LoadCursorA      
  RegisterClass    RegisterClassA
  RegisterClassEx  RegisterClassExA  
  MessageBox       MessageBoxA      
  SendMessage      SendMessageA
  GetMessage       GetMessageA
  PeekMessage      PeekMessageA
  TranslateMessage TranslateMessage
  DispatchMessage  DispatchMessageA
  PostQuitMessage  PostQuitMessage  
  PostMessage      PostMessageA
  CreateWindowEx   CreateWindowExA  
  ShowWindow       ShowWindow        
  UpdateWindow     UpdateWindow      
  DefWindowProc    DefWindowProcA
  InvalidateRect   InvalidateRect
  ValidateRect     ValidateRect
  GetSystemMetrics GetSystemMetrics
  ReleaseDC        ReleaseDC
  GetDC            GetDC
  BeginPaint        BeginPaint
  EndPaint          EndPaint  
  ShowCursor       ShowCursor
  GetAsyncKeyState GetAsyncKeyState
)

Bind gdi32
(
  GetStockObject   GetStockObject
  CreateSolidBrush CreateSolidBrush
  SetBkMode        SetBkMode
  SetBkColor       SetBkColor
)
Declare Function GetCurrentDir Lib "kernel32.dll" Alias "GetCurrentDirectoryA" (ByVal nBufferLength As Long, ByVal lpPathName As Long) As Long
Declare Function GetTempPath Lib "kernel32.dll" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Declare Function lstrcmpi Lib "kernel32.dll" Alias "lstrcmpiA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Declare Function GetCommandLine Lib "kernel32.dll" Alias "GetCommandLineA" () as String
Declare Function GetParent Lib "user32.dll" (ByVal hWnd As Long) As Long
Declare Function GetSysColor Lib "user32.dll" (ByVal nIndex As Long) As Long
Declare Function GetWindowRect Lib "user32.dll" (ByVal hwnd As Long, lpRect As RECT) As Long
Declare Function SetWindowPos Lib "user32.dll"(hwnd AS INT,hWndInsertAfter AS INT,x AS INT,y AS INT,cx AS INT,cy AS INT,wFlags AS INT) As INT
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 GetFocus   Lib "user32.dll" () As Long
Declare Function SetFocus   Lib "user32.dll" (ByVal hwnd As INT) As INT
Declare Function LoadImage  Lib "user32.dll" Alias "LoadImageA" (ByVal hInst As Long,ByVal lpsz As String,ByVal un1 As Long,ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Declare Function GetPixel   Lib "gdi32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Declare Function CreateHatchBrush Lib "gdi32.dll" (ByVal nIndex As Long, ByVal crColor As Long) As Long
Declare Function CreatePen Lib "gdi32.dll" Alias "CreatePen" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Declare Function FillRect Lib "user32.dll" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush 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 LineTo   Lib "gdi32.dll" (ByVal hdc As sys, ByVal x As Long, ByVal y 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 GetClientRect Lib "user32.dll" (ByVal hwnd As sys, ByRef lpRect As RECT) As Long
Declare Function SetPixel   Lib "gdi32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) 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 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 TextOut    Lib "gdi32.dll" Alias "TextOutA" (ByVal hdc As Long, 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 Long) As Long
Declare Function PlaySound  Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
Declare Function PatBlt     Lib "gdi32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal dwRop As Long) As Long
Declare Function SetBkColor Lib "gdi32.dll" (ByVal hdc As Long, ByVal crColor As Long) As Long
Declare Function BitBlt     Lib "gdi32.dll" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop 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 Long
Declare Function GetObject  Lib "gdi32.dll" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, ByRef lpObject As Any) As Long

Declare Function SetWindowText Lib "user32.dll" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Declare Function DestroyWindow Lib "user32.dll" (ByVal hwnd As Long) As Long
'Declare Function UpdateWindow  Lib "user32.dll" (ByVal hwnd AS Long),As Long
Declare Function timeGetTime   Lib "winmm.dll" () As Long
Declare Function SelectObject  Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
Declare Function DeleteObject  Lib "gdi32.dll" (ByVal hObject As Long) As Long
Declare Function SetTextColor  Lib "gdi32.dll" (ByVal hdc As Long, ByVal crColor As Long) As Long
Declare Function FloodFill Lib "gdi32.dll" Alias "FloodFill" (ByVal hdc As Integer, ByVal x As Integer, ByVal y As Integer, ByVal crColor As Integer) As Integer
Declare Function ExtFloodFill Lib "gdi32.dll" Alias "ExtFloodFill" (ByVal hdc As Integer, ByVal x As Integer, ByVal y As Integer, ByVal crColor As Integer, ByVal wFillType As Integer) As Integer


Declare Function QueryPerformanceCounter   Lib "kernel32.dll" (ByRef lpPerformanceCount As LARGE_INTEGER) As Long
Declare Function QueryPerformanceFrequency Lib "kernel32.dll" (ByRef lpFrequency As LARGE_INTEGER) As Long
Declare Function CreateCompatibleBitmap    Lib "gdi32.dll" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Declare Function CreateCompatibleDC        Lib "gdi32.dll" (ByVal hdc As Long) As Long
Declare Function SetForegroundWindow       Lib "user32.dll" (ByVal hwnd As Long) As Long
'-------------------------------------------------------------------------------------------------------------------------
'def NULL 0
Declare Function GetModuleHandle  lib "kernel32.dll" alias "GetModuleHandleA" (sys lpModuleName) as long
Declare Function GetOpenFileName  Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Declare Function GetSaveFileName  Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long

Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
'Declare Function InitCommonControls() as INT
Declare  InitCommonControlsEx Lib "comctl32.dll" alias "InitCommonControlsEx" (INITCOMMONCONTROLSEXtype*ic) as sys
Declare Function ImageList_Create Lib "comctl32.dll" (byval cx as int,byval cy as int,byval flags as int,byval cInitial as int,byval cGrow as int) as sys
Declare Function ImageList_Add Lib "comctl32.dll" (ByVal cx As Int, ByVal cy As Int ByVal flags As uint, ByVal cInitial as Int, ByVal cGrow as Int) As sys
Declare Function ImageList_AddMasked Lib "comctl32.dll" (byval hImageList as sys,byval hBitmap as sys,byval crMask as sys) as sys
'-----------------------------------------------------------------------------------------------------------


Def sys_Red   1
Def sys_Green 2
Def sys_Blue  4
Def SYS_BLACK &h101010
Def SYS_WHITE &hE0E0E0


Type TRGB
r As Long
g As Long
b As Long
End Type

Type Button
Long w
Long h
Long c
Long a
Long b
String t
End Type

'----------------------------------------
TYPE TBADDBITMAP
     sys hInst
     sys nID
END TYPE


Dim But(512) As Button
Dim cRgb As TRGB
'define Msg,Class & ClassEx //////////////////////////////////
Dim wm as MSG
Dim rc as RECT
Dim wcx as WNDCLASSEX


'/////////////////////////////////////////////////////////////
Dim ShpHnd (512) As Long
Dim ShpHdc (512) As Long
Dim ShpWide(512) As Long
Dim ShpHigh(512) As Long
Dim SprHnd (512) As Long
Dim SprHdc (512) As Long
Dim SprWide(512) As Long
Dim SprHigh(512) As Long
Dim BmpHnd (512) As Long
Dim BmpHdc (512) As Long
Dim BmpWide(512) As Long
Dim BmpHigh(512) As Long
Dim ImgHdc (512) As Long
Dim ImgHnd (512) As Long
Dim ImgWide(512) As Long
Dim ImgHigh(512) As Long


Dim BackHdc   As Long
Dim BackHnd   As Long
Dim xBack     As Long
Dim yBack     As Long
Dim sys_Seed  As Long
Dim MouseX    As Long
Dim MouseY    As Long
Dim controlID As Long
Dim notifyCode As Long
Dim sys_clic  As Long
Dim sys_Hdc   As sys
Dim sys_hwnd  As sys

'Controls handler {{{{{{{{{{{{{{{{{{{{{{{
Dim hButton   As Long
Dim hEdit     As Long
Dim hRichEdit As Long
Dim hScrollBar As Long
Dim hListbox  As Long
Dim hCombobox As Long
Dim hStatic   As Long
Dim hProgress As Long

Dim hTreeView As Long
Dim hTabControl As long
Dim hTBControl as long
Dim hTTControl as Long
Dim hTrackBar As Long
'}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}
'------------------------------------
Dim sys_Focus As Long
Dim sys_hFont As Long
Dim sys_Font  As String
Dim sys_xFont As Long
Dim sys_yFont As Long
Dim sys_Flag  As Long
Dim WinExit   As Long
Dim WinWidth  As Long
Dim WinHeight As Long
Dim ImgHdc    As Long
Dim ImgHnd    As Long
Dim ImgWidth  AS Long
Dim ImgHeight AS Long
Dim sys_wx    As Long
Dim sys_wy    As Long
Dim sys_color As Long
Dim sys_xPos  As Long
Dim sys_yPos  As Long
sys bHnd,bHdc
int hbrush
Dim AscKey    as sys

'GLOBALS for drawing to DC ((((((((((((((((((((((((((((((((((((((((((((((((((((
INT hdc, hdcMem, hbmMem,   oldBmp, oldBrush, oldPen, oldFont, fColor,bColor
INT textX,textY,hBrush
INT ww,hh
')))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))​

'--------------------------------------------
MACRO Default
DefWindowProc hwnd,wMsg,wParam,lParam
END MACRO
'---------------------------------------------
Macro RightS(s,i)
mid(s,(-i))
end macro

'--------------------------------------------
Declare Function Main()
Function HiWord (byval hi as long) as long
shr hi,16 : function=hi
End Function
'---------------------------------------------
Function LoWord (byval lo as long) as long
And lo,&hffff : function=lo
End Function
'----------------------------------------------------------------
Function SetBuffer (byval x As Long, byval y As Long) as long
BackHnd = CreateCompatibleBitmap(sys_hdc, x, y)
BackHdc = CreateCompatibleDC(sys_hdc)
SelectObject BackHdc, BackHnd
xBack = x : yBack = y
Function = BackHdc
End Function
'---------------------------------------------------------------
Function ClearBuffer (byval color as long)
sys_color = color
sys_Brush = CreateSolidBrush color
SelectObject BackHdc, sys_Brush
Rectangle BackHdc,-1,-1,xBack+1,yBack+1
DeleteObject sys_Brush
End Function
'----------------------------------------------------------------
Function FlipBuffer()
BitBlt Sys_hdc, 0, 0, xBack, yBack, BackHdc, 0, 0, &hCC0020
End Function
'-----------------------------------------------------------------
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 DoWait()
While AscKey=0
Events
'iF WinExit=1
  ' WinEnd
  ' ExitProcess 0
'End iF
FlipBuffer
Wend
AscKey=0
End Sub
'===============================================================================​==========================
Function ControlFont ( byval hwnd as long,byval height As Long, byval width As long, byval flag As Long,byval fontname As string)  
int hFont
hFont = CreateFont( height,width,0,0,flag,0,0,0,1,0,0,0,2,fontname)
'CreateFont(_fsize,0,0,0,_ff,_fi,_fu,_fs,1,0,0,0,2,_fname)
SendMessage hwnd,WM_SETFONT,hfont,0
End Function
'----------------------------------------------------------------------
Function SetText (byval hwnd as int,byval stext as string)
SendMessage hwnd,WM_SETTEXT,0,strptr(stext)
UpdateWindow hwnd
End Function
'-------------------------------------------------------------------
Function GetText (byval hwnd as int) as string
char display[255]=""
SendMessage hwnd,WM_GETTEXT,255, display
Return display
End Function
'===============================================================================​=====================
Function SetRichEditBackColor(byval _ehwnd as int, byval _ecolor as int)
  SendMessage(_ehwnd, 1091,0,_ecolor) 'EM_SETBKGNDCOLOR=1091
End Function
'===============================================================================​======================
/*
FUNCTION  NewFont (fontName$, pointSize, weight, italic, underline, angle#)

    LOGFONT lf
    hDC = GetDC ($$HWND_DESKTOP)
    hFont = GetStockObject ($$DEFAULT_GUI_FONT)    ' get a font handle
    bytes = GetObjectA (hFont, SIZE(lf), &lf)        ' fill LOGFONT struct lf
    lf.faceName = fontName$                                            ' set font name
    lf.italic = italic                                                    ' set italic
    lf.weight = weight                                                    ' set weight
    lf.underline = underline                                        ' set underlined
    lf.escapement = angle# * 10                                    ' set text rotation
    lf.height = -1 * pointSize * GetDeviceCaps(hDC, $$LOGPIXELSY) / 72
    ReleaseDC ($$HWND_DESKTOP, hDC)
    Return CreateFontIndirectA (&lf)                        ' create a new font and get handle

End FUNCTION
*/
'===============================================================================​===================

'Function DoEvents()
'iF PeekMessage (&wm,0,0,0,Pm_Remove) >0
'iF wm.message = Wm_Quit Then WinExit =1
'TranslateMessage &wm
'DispatchMessage  &wm
'End iF
'End Function

'===============================================================================​====================

Sub Delay(byval time as long)
Long Tick, cTime  
cTime = timeGetTime
Tick = cTime + time
While  Tick > cTime
cTime = timeGetTime
Wend
End Sub
'-------------------------------------------------------------------------------------------------
Function DrawText( int wnd ,byval text as string, byval x3 as long, byval y3 as long, byval color as long)
'backHdc=GetDC(hwnd)
SetBkMode bHdc,1
SetTextColor bHdc,color
TextOut bHdc,x3,y3,text,Len(text)
ReleaseDC(bHdc)
End Function
'---------------------------------------------------------------------------------------------------
'Sub TextOn( int wnd,sys x, y, string txt)
'sys_hdc=GetDC(wnd)
'bHnd = CreateCompatibleBitmap(sys_hdc,640,480)
'bHdc = CreateCompatibleDC(sys_hdc)
'SelectObject bHdc, wnd
'SetBkMode bHdc,1
'color = r + g*256 + b*65536
'SetTextColor bHdc, color
'TextOut sys_hdc,x,y,txt,Len(txt)
'ReleaseDC(sys_Hdc)
'End Sub

'===============================================================================​====================

Function SetWindow (byval caption as string ,byval Wx as int,byval Wy as int, byval Ww as int, byval Wh as int, byval wparent as int, byval style as int) as int
inst = GetModuleHandle 0
'sys hbrush=RGB(250,250,255)
wcx.cbSize        = sizeof(WNDCLASSEX)
wcx.style         = CS_DBLCLKS |CS_OWNDC
wcx.lpfnWndProc   = &WndProc
wcx.cbClsExtra    =0
wcx.cbWndExtra    =0
wcx.hInstance     = inst
wcx.hIcon         =LoadIcon 0,IDI_APPLICATION        
wcx.hCursor       =LoadCursor 0,IDC_ARROW      
wcx.hbrBackground = CreateSolidBrush(GetSysColor(15))
wcx.lpszMenuName  = ?0
wcx.lpszClassName = @"Oxygen"
wcx.hIconSm       =LoadIcon 0,IDI_APPLICATION

RegisterClassEx &wcx

'create window ---------------------------------------------------------------------------------
sys_hwnd = CreateWindowEx 0, wcx.lpszClassName, caption, style, Wx, Wy, Ww, Wh, wparent, 0, inst, 0
'-----------------------------------------------------------------------------------------------
IF style <> WS_HIDDEN
ShowWindow sys_hwnd, SW_SHOW
END IF
UpdateWindow sys_hwnd
sys_hdc = GetDC(sys_hwnd)
'static defwndproc as var
'Dim MRET as sys
'MRET = DefWindowProc(sys_hwnd,wm,wParamS,lParamS)
'GetClientRect sys_hwnd,rc  
'w = ww-rc.right
'h = wh-rc.bottom
'GetWindowRect sys_hwnd,rc
'MoveWindow sys_hwnd,rc.left-1,rc.top-1,ww+w,wh+h,1
bHnd = CreateCompatibleBitmap(sys_hdc,ww,wh)
bHdc = CreateCompatibleDC(sys_hdc)
SelectObject bHdc, bHnd
Width = ww
Height= wh
'SetBuffer ww,wh
sys_Seed = timeGetTime
'QueryPerformanceFrequency sys_qf
'QueryPerformanceCounter   sys_qc1
Function = sys_hwnd
End Function

'- Msg Loop -----------------------------------------------------------------------------------
Function Wait()
  sys _message
  While GetMessage(@wm,0,0,0) <> 0
   _message = @wm
     Translatemessage @wm
     DispatchMessage @wm
    
  Wend
  Return _message
End Function

'----------------------------------------------------------------------------------------------
Function CloseWindow(wnd as INT) as INT
DestroyWindow wnd
'PostQuitMessage 0
Return wnd=0
End Function

'----------------------------------------------------------------------------------------------
Sub EndProgram
PostQuitMessage 0
End Sub

'GetClientsize --------------------------------------------------------------------------------
SUB GetSize(int hnd,hndx as int,hndy as int,hndw as int,hndh as int)
GetClientRect(hnd,rc)
'hndx=0:hndy=0:hndw=0:hndh=0
hndx = rc.left
hndy = rc.top
hndw = rc.right
hndh = rc.bottom

End SUB

'SetSize() --------------------------------------------------------------------------------------
SUB SetSize(int hnd,byref hndx as int,byref hndy as int,byref hndw as int,byref hndh as int)
INT sdata[4]
sdata[0]=hndx
sdata[1]=hndy
sdata[2]=hndw
sdata[3]=hndh
'SetWindowPos(hnd,0,sdata[0],sdata[1],sdata[2],sdata[3],0)
MoveWindow(hnd,sdata[0],sdata[1],sdata[2],sdata[3],1)

End SUB
'===============================================================================​================
'syn : SetButton (hwnd,x,y,w,h,caption$,style,ext,controlID)
Function SetButton(byval _bhwnd as int,byval _bx as int,byval _by as int,byval _bw as int,byval _bh as int, byval _btext as string,byval _bflag as int,byval _ext as int,byval _cID as INT) as int
INT _hfont
If _bflag=0
    _bflag = 0x50000000
EndIf
_ext = 0
hButton = CreateWindowEx(_ext,"BUTTON",_btext,_bflag,_bx,_by,_bw,_bh,_bhwnd,_cID,0,0)
_hfont = GetStockObject(17)
SendMessage hButton,WM_SETFONT,_hfont,0
UpdateWindow _bhwnd
Function = hButton
End Function
'===============================================================================​================
'syn : SetEditBox (hwnd,x,y,w,h,caption$,style,ext)
Function SetEditBox(byval _ehwnd as int,byval _ex as int,byval _ey as int,byval _ew as int,byval _eh as int, byval _etext as string,byval _eflag as int,byval _ext as int,byval _cID as INT) as int
INT _hfont
If _eflag=0
    _eflag = 0x50800000
EndIf
hEdit = CreateWindowEx(_ext,"EDIT",_etext,_eflag,_ex,_ey,_ew,_eh,_ehwnd,_cID,0,0)
_hfont = GetStockObject(17)
SendMessage hEdit,WM_SETFONT,_hfont,0
UpdateWindow _ehwnd
Function = hEdit
End Function

'===============================================================================​================
Function SetListBox (byval _ehwnd as int,byval _ex as int,byval _ey as int,byval _ew as int,byval _eh as int, byval _etext as string,byval _eflag as int,byval _ext as int,byval _cID as INT) as int
INT _hfont
If _eflag=0
    _eflag = 0x50A00140 or CTLISTNOTIFY
EndIf
hListbox = CreateWindowEx(_ext,"LISTBOX",_etext,_eflag,_ex,_ey,_ew,_eh,_ehwnd,_cID,0,0)
_hfont = GetStockObject(17)
SendMessage hListbox,WM_SETFONT,_hfont,0
UpdateWindow _ehwnd
Function = hListbox
End Function

'===============================================================================​================
Function SetStatic (byval _ehwnd as int,byval _ex as int,byval _ey as int,byval _ew as int,byval _eh as int, byval _etext as string,byval _eflag as int,byval _ext as int,byval _cID as INT) as int
INT _hfont
If _eflag=0
    _eflag = 0x5000010B
EndIf
hStatic = CreateWindowEx(_ext,"STATIC",_etext,_eflag,_ex,_ey,_ew,_eh,_ehwnd,_cID,0,0)
_hfont = GetStockObject(17)
SendMessage hStatic,WM_SETFONT,_hfont,0
UpdateWindow _ehwnd
Function = hStatic
End Function

'===============================================================================​======
Function SetRichEdit (byval _ehwnd as int,byval _ex as int,byval _ey as int,byval _ew as int,byval _eh as int, byval _etext as string,byval _eflag as int,byval _ext as int,byval _cID as INT) as int
INT _hfont
If _eflag=0
'0x50800080 single , 0x50B010C4 multiline
    _eflag = 0x50800080 Or ES_SUNKEN
EndIf
hRichEdit = CreateWindowEx(_ext,"richedit20a",_etext,_eflag,_ex,_ey,_ew,_eh,_ehwnd,_cID,0,0)
_hfont = GetStockObject(17)
SendMessage hRichEdit,WM_SETFONT,_hfont,0
UpdateWindow _ehwnd
Function = hRichEdit
End Function
'===============================================================================​======
'SetProgressbar(hwnd,x,y,w,h,min,max,pos,flag,ext)
Function SetProgressBar (byval _ehwnd as int,byval _ex as int,byval _ey as int,byval _ew as int,byval _eh as int,byval _emin as int,byval _emax as int,byval _epos as int,byval _eflag as int,byval _ext as int,byval cID as INT)
  If _eflag = 0 then
    _eflag=WS_CHILD or WS_VISIBLE
  End If
  hprogress = CreateWindowEx(_ext,"msctls_progress32","",_eflag,_ex,_ey,_ew,_eh,_ehwnd,cID,0,0)
  'UpdateWindow hprogress
  SendMessage(hprogress,PBM_SETRANGE32,_emin,_emax)
  SendMessage(hprogress,PBM_SETPOS,_epos,0)
   UpdateWindow hprogress
  Return hprogress
End Function
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::​::::::
'Progress SET  POSITION
SUB PBSetPos (byval _hpb as int,byval _pbpos as int)
If _hpb <> 0
SendMessage(_hpb,PBM_SETPOS,_pbpos,0)
UpdateWindow _hpb
End If
END SUB
'===============================================================================​======
'syn : SetRadioButton (hwnd,x,y,w,h,caption$,style,ext,controlID)
Function SetRadioButton(byval _bhwnd as int,byval _bx as int,byval _by as int,byval _bw as int,byval _bh as int, byval _btext as string,byval _bflag as int,byval _ext as int,byval _cID as INT) as int
INT _hfont
If _bflag=0
    _bflag = 0x50000009
End If
_ext = 0
hButton = CreateWindowEx(_ext,"BUTTON",_btext,_bflag,_bx,_by,_bw,_bh,_bhwnd,_cID,0,0)
_hfont = GetStockObject(17)
SendMessage hButton,WM_SETFONT,_hfont,0
UpdateWindow _bhwnd
Function = hButton
End Function
'===============================================================================​======
'syn : SetCheckBox (hwnd,x,y,w,h,caption$,style,ext,controlID)
Function SetCheckBox (byval _bhwnd as int,byval _bx as int,byval _by as int,byval _bw as int,byval _bh as int, byval _btext as string,byval _bflag as int,byval _ext as int,byval _cID as INT) as int
INT _hfont
If _bflag=0
    _bflag = 0x50008003
End If
_ext = 0
hButton = CreateWindowEx(_ext,"BUTTON",_btext,_bflag,_bx,_by,_bw,_bh,_bhwnd,_cID,0,0)
_hfont = GetStockObject(17)
SendMessage hButton,WM_SETFONT,_hfont,0
UpdateWindow _bhwnd
Function = hButton
End Function
'===============================================================================​======
Function SetComboBox(byval _cbhwnd as int,byval _cbx as int,byval _cby as int,byval _cbw as int,byval _cbh as int, byval _cbtext as string,byval _cbflag as int,byval _ext as int,byval _cID as INT) as int
INT _hfont
  If _cbflag=0
    _cbflag = 0x50A00603
  EndIf
  hComboBox = CreateWindowEx(_ext,"COMBOBOX",_cbText,_cbflag,_cbx,_cby,_cbw,_cbh,_cbhwnd,_cID,0,0)
_hfont = GetStockObject(17)
SendMessage hComboBox,WM_SETFONT,_hfont,0
UpdateWindow _cbhwnd
Function = hComboBox
End Function
'===============================================================================​======
Function SetTreeView(byval _tvhwnd as INT,byval _tvx as INT,byval _tvy as INT,byval _tvw as INT,_tvh,byval tvflag as INT,byval _tvextend as INT,byval _cID as INT) as INT
  'INT hTreeView
  If tvflag=0
    tvflag= tvflag | WS_CHILD | WS_VISIBLE | TVS_HASLINES | TVS_HASBUTTONS | TVS_LINESATROOT
  EndIf
  'If _tvinit=0
   ' FirstTreeViewInit()
  'EndIf
hTreeView  = CreateWindowEx(_tvextend,"SysTreeView32","",tvflag,_tvx,_tvy,_tvw,_tvh,_tvhwnd,_cID,0,0)
UpdateWindow _tvhwnd
  Function = hTreeView
End Function

'-------------------------------------------------------------------------------------
'FN -> InsertItem (hwnd ,text ,parent ,insertafter ,img, select)
Function TVInsertItem (byval hTree as INT ,tvText as string,byval tvParent as INT,byval insertAfter as INT,byval hImg as INT,byval tvselect as INT ) as INT
INT h
tvi.hparent = tvParent
tvi.hinsertAfter = insertAfter
tvi.mask = TVIF_TEXT | TVIF_IMAGE |TVSELECTEDIMAGE
tvi.state = 0
tvi.statemask = 0
tvi.pszText = strptr(tvText)
tvi.cchtextmax = sizeOf(tvText)+1
tvi.iImage = 0
tvi.iSelectedImage = 1
h = SendMessage(hTree,TVM_INSERTITEM,0,&tvi)
'UpdateWindow hTree
Function= h
End function

'===============================================================================​======
Function SetTabControl (byval _tbhwnd as INT,byval _tx as INT,byval _ty as INT,byval _tw as INT,byval _th as INT,byval _tbflag as INT,byval _ex as INT,byval cID as INT) As INT
INT _hfont
  If _tbflag=0
    _tbflag=WS_CHILD | WS_VISIBLE| TCS_HOTTRACK
  End If
  
  hTabControl = CreateWindowEx(_ex,"SysTabControl32","",_tbflag,_tx,_ty,_tw,_th,_tbhwnd,cID,0,0)
_hfont = GetStockObject(17)
SendMessage hTabControl,WM_SETFONT,_hfont,0
  UpdateWindow _tbhwnd
Function = hTabControl
End Function
'===============================================================================​======
'AddTab
Function AddTab (byval hwnd as INT ,byval tbpos as INT,byval tbtext as String ) as INT
TC_ITEM tie
tie.mask=1
tie.pszText= strptr(tbtext)
tie.cchTextMax=Len(tbtext)
tie.iImage = -1
SendMessage(hWnd,0x1307,tbpos,&tie)

End Function
'===============================================================================​======
Function SetTabText (cntID as INT,tbIndex as INT,tabText as String)
TC_ITEM tie
tie.mask=1
tie.pszText= strptr(tabText)
tie.cchTextMax=Len(tabtext)
tie.iImage = -1
SendMessage(cntID,TCM_SETITEM,tbIndex,&tie)
Return
End Function

'===============================================================================​======
SUB SetSelectedTab (cntID as INT,index as INT)
Sendmessage (cntID,TCM_SETCURSEL,index,0)

'Return tbIndex
End Sub
'===============================================================================​======

Function GetSelectedTab (cntID as INT) as sys
INT tbIndex
tbIndex = Sendmessage (cntID,TCM_GETCURSEL,0,0)

Return tbIndex
End Function

'===============================================================================​======
Function GetTabText (cntID as INT,tbIndex as INT) as string
string tabText=Space(256)
TC_ITEM tie
tie.mask=1
tie.pszText = strptr tabText
tie.cchTextMax = 256
tie.iImage = -1
Sendmessage (cntID,TCM_GETITEM,tbIndex,&tie)
Return tabText
End Function
'===============================================================================​======
Function GetTabCount (cntID as INT) as INT
INT tbCount
tbCount = Sendmessage (cntID,TCM_GETITEMCOUNT,0,0)

Return tbCount
End Function
'===============================================================================​======
Function DeleteTab (cntID as INT, index as INT ) as INT
Sendmessage (cntID,TCM_DELETEITEM,index,0)
Return 0
End Function

'===============================================================================​======

Function SetToolbar (byval _tbhwnd as INT,byval _tbflag as INT,byval _ex as INT,byval cID as INT) As INT
INT _hfont
INT  TBSTYLES = TBSTYLE_FLAT '| CCS_ADJUSTABLE '| CCS_NODIVIDER
  If _tbflag=0
    _tbflag=1342179328 | TBSTYLES |4 | &H100
  'ELSE
   '_tbflag=1342179328 | TBSTYLES |4 | _tbflag
  End If
  
  hTBControl = CreateWindowEx(_ex,"ToolbarWindow32","",_tbflag,0,0,0,0,_tbhwnd,0,0,0)
_hfont = GetStockObject(17)
SendMessage hTBControl,WM_SETFONT,_hfont,0
  UpdateWindow _tbhwnd
Function = hTBControl
End Function

'===============================================================================​======
'set tooltip control
Function SetToolTip (byval _tthwnd as INT) As INT
INT _hfont


hTTControl = CreateWindowEx(0,"tooltips_class32","", -805306368,0,0,0,0,_tthwnd,0,0,0)
SendMessage( _tthwnd, 1060, hTTControl,0)


Function = hTTControl
End Function

'===============================================================================​======
'Statusbar...
Function SetStatusBar (byval shwnd as INT,byval stext as STRING,byval sflag as INT,byval ex as INT) as INT
  If sflag=0
    sflag= 1409286400
    sflag = WS_CHILD | WS_VISIBLE | SBARS_SIZEGRIP | WS_CLIPSIBLINGS
  End If
  hStatus =CreateWindowEx(ex,"msctls_statusbar32",stext,sflag,0,0,0,0,shwnd,0,0,0)
'UpdateWindow shwnd  
  Return hStatus
End Function
'===============================================================================​========
'Trackbar...
Function SetTrackBar (_ehwnd,_ex,_ey,_ew,_eh,_emin,_emax,_epage,_epos,_eflag,_ext,_tID)
  
  If _eflag=0
    _eflag = TRACKBARNORMAL|_eflag
  End If
  hTrackbar=CreateWindowEx(_ext,"msctls_trackbar32","",_eflag,_ex,_ey,_ew,_eh,_ehwnd,_tID,0,0)
  SendMessage(hTrackbar, TBM_SETPAGESIZE,0,_epage)
  SendMessage(hTrackbar, TBM_SETRANGEMIN, 0,_emin)
  SendMessage(hTrackbar, TBM_SETRANGEMAX, 0,_emax)
  SendMessage(hTrackbar, TBM_SETPOS, 1,_epos)
  Return hTrackbar
End Function
'---------------------------------------------------------------------------------------
Function GetTrackPos (byval wnd as INT) as INT
INT tpos
  tpos=SendMessage( wnd , 1024,0,0)
Return tpos
End Function


'===============================================================================​======
Function Randomize()
sys_Seed = timeGetTime
End Function

'===============================================================================​======

Function RGB(sys red,green,blue) as sys
  sys color
  color = red
  color = color + green*256
  color = color + blue*65536
  Return color
End Function


'===============================================================================​======
'Sub PSet(wnd as int,sys x, y, r, g, b)
    'sys pcolor = RGB(r,g,b)
    'Setpixel hdc, x, y,pcolor
    'ReleaseDC(wnd, hdc)
'End Sub

Function Rand(byval z1 as long, byval z2 as long) as long
Long 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
Function = rnd
End Function

Function LoadBitmap(byval BmpFile As String, byval wBmp as long, byval hBmp as long) As Long
Static bNr as long: bNr +=1
If bNr >256 Then bNr =256  
BmpHnd(bNr) = LoadImage(0, BmpFile,0,0,0,16)
BmpHdc(bNr) = CreateCompatibleDC(sys_hdc)
SelectObject BmpHdc(bNr), BmpHnd(bNr)
BmpWide(bNr) = wBmp
BmpHigh(bNr) = hBmp
Function     = bNr
End Function

Function SetImage(byval iWidth as long, byval iHeight as long) as long
ImgHnd = CreateCompatibleBitmap(sys_hdc, iWidth, iHeight)
ImgHdc = CreateCompatibleDC(sys_hdc)
SelectObject ImgHdc, ImgHnd
ImgWidth = iWidth:ImgHeight = iHeight
Function = ImgHdc
End Function

Function FlipImageRect(byval x1 as long, byval y1 as long, byval iw as long, byval ih as long, byval x0 as long, byval y0 as long)
BitBlt sys_hdc, x1, y1, iw, ih, ImgHdc, x0, y0, &hCC0020
End Function

Function ClearImage()
PatBlt ImgHdc, 0, 0, ImgWidth, ImgHeight, &h42
End Function

Function FreeGraphics()
DeleteObject BackHnd
DeleteDC     BackHdc
DeleteObject ImgHnd
DeleteDC     ImgHdc
DeleteObject sys_Font
End Function

Function Key(byval cKey As Long) As Long
Function = GetAsyncKeyState(cKey)
End Function

Function EscKey() As Long
Function = GetAsyncKeyState(27)
End Function

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

Function GetRGB(byval color as long, co as long) as long
cRGB.r = color & &HFF0000
cRGB.g = color & &H00FF00
cRGB.b = color & &H0000FF
If  co = 1 Then Function = cRGB.r
If  co = 2 Then Function = cRGB.g
If  co = 4 Then Function = cRGB.b
End Function

'MsgBox--------------------------------
Function MsgBox (lpText AS STRING,lpCaption AS STRING) as INT
If lpCaption = "" then lpCaption="<MsgBox>"
Return MessageBox 0,lpText,lpCaption,0
End Function
'---------------------------------------
Function Replace(string t,w,r) as string
  '=======================================
  '
  sys a,b,lw,lr
  string s=t
  '
  lw=Len(w)
  lr=Len(r)
  a=1
  '  
  do
    a=Instr(a,s,w)
    If a=0 then exit do
    s=Left(s,a-1)+r+Mid(s,a+lw)
    a+=lr
  End do
  Return s
End Function

REM Contributed by James C. Fuller - April 2009.
REM' LTRIM
REM' multiple entries in Match$ are treated individually
macro Trim(dirty )
  Ltrim(Rtrim(dirty))    
End macro

'FileDialog( $ iDir , $ filter ,$ title , % parent ,% flag )
Function FileDialog(Dir As String, filter , Title , long Hwnd, Flags, defext) As String
Dim ofn As OPENFILENAME
Dim filename[255] As zstring
INT retval    
    
ofn.lStructSize = 76
ofn.hwndOwner = hWnd
ofn.hInstance = GetModuleHandle(0)
ofn.lpstrFilter = ?filter
ofn.lpstrCustomFilter= NULL
ofn.nMaxCustFilter = 0
ofn.nFilterIndex = 2
ofn.lpstrFile = @filename 'zstring buffer
ofn.nMaxFile = 255
ofn.lpstrFileTitle = NULL
ofn.nMaxFileTitle = 0
ofn.lpstrInitialDir = ?dir
ofn.lpstrTitle = ?title
IF Flags = 0 then ofn.Flags = OFN_EXPLORER Or OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY
IF Flags = 1 then ofn.Flags = OFN_EXPLORER Or OFN_OVERWRITEPROMPT Or OFN_HIDEREADONLY
ofn.nFileOffset = 0
ofn.nFileExtension = 0
ofn.lpstrDefExt = ?defext
ofn.lCustData = 0
ofn.lpfnHook = 0
ofn.lpTemplateName = NULL

' Execute the dialog box
IF Flags = 0 then retval = GetOpenFileName(ofn)
IF Flags = 1 then retval = GetSaveFileName(ofn)
    
Return filename

End Function

'*****************************************************************************
'********** I N I T   D R A W I N G *****************************************
'*****************************************************************************
SUB InitDrawing(byval wnd as INT)
'static ww,hh as int
''get current size of window
GetSize(wnd,0,0,ww,hh)
'get window DC
hdc=GetDC(wnd)
hdcMem = CreateCompatibleDC(0)
hbmMem = CreateCompatibleBitmap(hdc,ww,hh)
oldBmp = SelectObject( hdcMem, hbmMem )
oldBrush = SelectObject(hdcMem, CreateSolidBrush( RGB(231,223,231)) )
oldPen = SelectObject(hdcMem, CreatePen(PS_SOLID,1,RGB(231,223,231)))
'fill rectangle memDC with brush color
rc.right = ww + 1000
rc.bottom = hh + 1000

FillRect ( hdcMem,rc, oldBrush)
SetTextColor( hDC,RGB(0,0,0))
SetBkColor( hDC, RGB(231,223,231))
'blit to memDC
BitBlt(hDCmem, 0, 0, ww, hh, hdc, 0, 0, SRCCOPY)
'UpdateWindow wnd
ReleaseDC( wnd, hdc)
End SUB
' set window color =========================================================================
Sub FillSolidRect(wID as INT, x As Long, Y As Long, cx As Long, cy As Long, bbColor as INT)
    Dim hBr As Long ' rc As RECT
    hDC=GetDC(wID)
    rc.Left = x
    rc.Top = Y
    rc.right = x + cx
    rc.bottom = Y + cy
    hBr = CreateSolidBrush(bbColor)
    FillRect hDC, rc, hBr

    BitBlt(hdcMem, 0, 0, ww, hh, hdc, 0, 0, SRCCOPY)

    ReleaseDC( wID, hdc)
End Sub
'-----------------------------------------------------------------------------------------
SUB WindowColor(wID as INT,wr as INT,wg as INT,wb as INT)
INT backColor = RGB (wr,wg,wb)
FillSolidRect(wID,0,0,ww,hh,backColor)
END SUB    
'===============================================================================​=========
Find all posts by this user
Quote this message in a reply
Post Reply 


Forum Jump:


User(s) browsing this thread: