so for now i get it to open file and load into Scintilla control
FBSci bas file :
Code: Select all
#include once "windows.bi"
#Include Once "win\COMMDLG.BI"
#define PLAT_WIN 1
#include "scintilla.bi"
#include "scilexer.bi"
DyLibLoad("SciLexer.dll")
const SCE_FB_DEFAULT = 0
const SCE_FB_LINECOMMENT = 1
const SCE_FB_NUMBER = 2
const SCE_FB_KEYWORD0 = 3
const SCE_FB_STRING = 4
const SCE_FB_PREPROCESSOR = 5
const SCE_FB_OPERATOR = 6
const SCE_FB_IDENTIFIER = 7
const SCE_FB_DATE = 8
const SCE_FB_STRINGEOL = 9
const SCE_FB_KEYWORD1 = 10
const SCE_FB_KEYWORD2 = 11
const SCE_FB_KEYWORD3 = 12
Declare Function Control Lib "user32.dll" Alias "CreateWindowExA"(ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, ByRef lpParam As Long) As Long
Declare Function WinMain( byval hInstance as HINSTANCE, byval hPrevInstance as HINSTANCE, byval szCmdLine as string, byval iCmdShow as integer ) as integer
end WinMain( GetModuleHandle( null ), null, Command( ), SW_NORMAL )
DIM Shared As Long controlID, notifycode
Dim Shared As HWND hSci
Dim Shared tx As zstring ptr
Dim Shared text as string
Dim Shared fName as string
Dim Shared sciBlue As zstring ptr
Dim shared txcolor as string
declare Sub fbKeys()
declare function Open_File() as string
'declare function SaveFile() as string
declare function rgbX( byval red as INTEGER,byval green as INTEGER,byval blue as INTEGER) as integer
dim Shared b102_id as long : b102_id = 102
dim Shared b103_id as long : b103_id = 103
dim Shared b104_id as long : b104_id = 104
dim Shared b105_id as long : b105_id = 105
dim Shared b106_id as long : b106_id = 106
dim Shared b107_id as long : b107_id = 107
dim Shared b108_id as long : b108_id = 108
function WndProc ( byval hWnd as HWND, byval wMsg as UINT, byval wParam as WPARAM, byval lParam as LPARAM ) as LRESULT
'function = 0
select case( wMsg )
case WM_CREATE
'/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Dim text as string
text = "print Scintilla Test..OK!"
tx = strptr(text)
Dim As Integer i,rx,ry,rw,rh,ext,sci_style,sciID
rx=180: ry=84 : rw=598 : rh=390 : ext= &h200 : sciID = 400
hSci = CreateWindowEx(ext,"Scintilla","", WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or WS_CLIPCHILDREN,rx,ry,rw,rh,hWnd,null, 0,0)
'SendMessage(hSci, SCI_SETSELBACK, 1, Cast(LPARAM,&HFFEFD0))
SendMessage(hSci,SCI_SETLEXER,75,0)
'load keywords
fbkeys()
sciBlue = strptr(txcolor)
'set keywords
SendMessage(hSci,SCI_STYLECLEARALL, 0, 1)
'
SendMessage(hSci,SCI_SETKEYWORDS,0,Cast(LPARAM,sciBlue))
'set font
'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,1
'End Function
' dim as long hFont,fheight,fwidth,flag
'hFont = CreateFont(fheight,fwidth,0,0,flag,0,0,0,1,0,0,0,2, sfont)
dim fontName as string
dim sfont as any ptr
fontname = "Consolas"
sfont = strptr(fontname)
For i = 0 to 12
SendMessage hsci,SCI_STYLESETFONT, i,cast(LPARAM, sFont)
SendMessage(hsci,SCI_STYLESETSIZE, i, 10)
Next
'set number margin (for numnbers)------------------------------------
SendMessage(hsci, SCI_SETMARGINTYPEN, 0, SC_MARGIN_NUMBER)
SendMessage(hsci, SCI_SETMARGINWIDTHN, 0, 46)
'set SELECTIONED LINES COLOR-----------------------------------------
SendMessage hsci,SCI_SETSELBACK,1,cast(LPARAM, &HFF0000)
SendMessage hsci,SCI_SETSELFORE,1,cast(LPARAM, &HFFFFFF)
'caret line-
SENDMESSAGE(hsci, SCI_STYLESETFORE, SCE_FB_DEFAULT, RGBx(200,0,0)) '0 default
SENDMESSAGE(hsci, SCI_STYLESETFORE, SCE_FB_LINECOMMENT, RGBx(0,120,0)) '1 line comment
SENDMESSAGE(hsci, SCI_STYLESETFORE, SCE_FB_NUMBER, RGBx(160,0,0)) '2 number
SENDMESSAGE(hsci, SCI_STYLESETFORE, SCE_FB_KEYWORD0, RGBx(0,0,200)) '3 keyword0 - blue
SENDMESSAGE(hsci, SCI_STYLESETFORE, SCE_FB_STRING, RGBx(150,0,150)) '4 string
SENDMESSAGE(hsci, SCI_STYLESETFORE, SCE_FB_PREPROCESSOR, RGBx(0,0,250)) '5 preproc
SENDMESSAGE(hsci, SCI_STYLESETFORE, SCE_FB_OPERATOR, RGBx(180,0,0)) '6 operator
SENDMESSAGE(hsci, SCI_STYLESETFORE, SCE_FB_IDENTIFIER, RGBx(0,0,0)) '7 identifier/var names
SENDMESSAGE(hsci, SCI_STYLESETFORE, SCE_FB_DATE, RGBx(0,0,0)) '8 date
SENDMESSAGE(hsci, SCI_STYLESETFORE, SCE_FB_STRINGEOL, RGBx(0,100,0)) '9 string EOL
SENDMESSAGE(hsci, SCI_STYLESETFORE, SCE_FB_KEYWORD1, RGBx(220,0,0)) '10 keyword1 -work red
SENDMESSAGE(hsci, SCI_STYLESETFORE, SCE_FB_KEYWORD2, RGBx(160,80,0)) '11 keyword2 - as brown
SENDMESSAGE(hsci, SCI_STYLESETFORE, SCE_FB_KEYWORD3, RGBx(220,0,220))
SendMessage(hSci,SCI_SETTEXT,0, cast(LPARAM,tx) )
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
case WM_COMMAND
controlID = Loword(wparam) ' Control ID
notifycode = Hiword(wparam) ' notification events
select case controlID
case b103_id
if notifycode = 0 then
fname = Open_File
Open fname For Binary Access Read As #1
'If LOF(hfile) > 0 Then
text = String(LOF(1), 0) ' this not work ? txt is a string
MessageBox GetActiveWindow(), str(LOF(1)),"Len of File",MB_ICONASTERISK
Get #1, ,text : tx = strptr(text)
SendMessage hSci,SCI_SETTEXT,0,strptr(text)
'MessageBox GetActiveWindow(), "OK","Get File",MB_ICONASTERISK
' End If
Close #1
end if
end select
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
case WM_KEYDOWN
if( lobyte( wParam ) = 27 ) then
PostMessage( hWnd, WM_CLOSE, 0, 0 )
end if
case WM_DESTROY
PostQuitMessage( 0 )
exit function
end select
function = DefWindowProc( hWnd, wMsg, wParam, lParam )
end function
'':::::
function WinMain ( byval hInstance as HINSTANCE, _
byval hPrevInstance as HINSTANCE, _
byval szCmdLine as string, _
byval iCmdShow as integer ) as integer
dim wMsg as MSG
dim wcls as WNDCLASS
dim hWnd as HWND
dim wnd as HWND
dim As HWND hCtrl2,hCtrl3,hCtrl4,hCtrl5,hCtrl6,hCtrl7,hCtrl8
dim static1 as HWND
dim static1_id As Long
static1_id = 500
dim classname as any ptr
dim cname as string
cname = "FBWin"
classname = strptr(cname)
function = 0
with wcls
.style = CS_HREDRAW or CS_VREDRAW
.lpfnWndProc = @WndProc
.cbClsExtra = 0
.cbWndExtra = 0
.hInstance = hInstance
.hIcon = LoadIcon( NULL, IDI_APPLICATION )
.hCursor = LoadCursor( NULL, IDC_ARROW )
.hbrBackground = GetStockObject( WHITE_BRUSH )
.lpszMenuName = NULL
.lpszClassName = classname
end with
if( RegisterClass( @wcls ) = FALSE ) then
MessageBox( null, "Failed to register wcls", "Error", MB_ICONERROR )
exit function
end if
hWnd = CreateWindowEx( 0, classname, "Aurel_FB_SCi", WS_OVERLAPPEDWINDOW, 100, 100, 800, 600,NULL,NULL,hInstance,NULL)
' wnd = hWnd
static1 = CreateWindowEx ( 0, "static", "" , WS_Border or WS_VISIBLE Or WS_CHILD , 10 , 50 , 100 , 100 , hWnd,cast(HMENU,static1_id), 0,byval NULL)
'new
hCtrl2 = CreateWindowEx(0, "Button", "New", WS_CHILD OR WS_VISIBLE OR WS_TABSTOP OR BS_PUSHBUTTON, 10, 10, 34, 34,hWnd,cast(HMENU,b102_id), 0,0)
'open
hCtrl3 = CreateWindowEx(0, "Button", "Open", WS_CHILD OR WS_VISIBLE OR WS_TABSTOP OR BS_PUSHBUTTON, 48, 10, 34, 34,hWnd,cast(HMENU,b103_id), 0,0)
'save
hCtrl4 = CreateWindowEx(0, "Button", "Save", WS_CHILD OR WS_VISIBLE OR WS_TABSTOP OR BS_PUSHBUTTON, 86, 10, 34, 34,hWnd,cast(HMENU,b104_id), 0,0)
'compile
hCtrl5 = CreateWindowEx(0, "Button", "Comp", WS_CHILD OR WS_VISIBLE OR WS_TABSTOP OR BS_PUSHBUTTON, 124, 10, 34, 34,hWnd,cast(HMENU,b105_id), 0,0)
'run
hCtrl6 = CreateWindowEx(0, "Button", "Run", WS_CHILD OR WS_VISIBLE OR WS_TABSTOP OR BS_PUSHBUTTON, 162, 10, 34, 34,hWnd,cast(HMENU,b106_id), 0,0)
'misc
hCtrl7 = CreateWindowEx(0, "Button", "Misc", WS_CHILD OR WS_VISIBLE OR WS_TABSTOP OR BS_PUSHBUTTON, 200, 10, 34, 34,hWnd,cast(HMENU,b107_id), 0,0)
'about
hCtrl8 = CreateWindowEx(0, "Button", "About",WS_CHILD OR WS_VISIBLE OR WS_TABSTOP OR BS_PUSHBUTTON, 238, 10, 34, 34,hWnd,cast(HMENU,b108_id), 0,0)
ShowWindow( hWnd, iCmdShow )
UpdateWindow( hWnd )
while( GetMessage( @wMsg, NULL, 0, 0 ) <> FALSE )
TranslateMessage( @wMsg )
DispatchMessage( @wMsg )
wend
function = wMsg.wParam
end function
sub fbKeys()
'add some keywords...
txcolor = "if then end dim print while wend for next "
end sub
Function RGBX(byval red as INTEGER,byval green as INTEGER,byval blue as INTEGER) as integer
dim rgb_color as integer
rgb_color = red
rgb_color = rgb_color + green*256
rgb_color = rgb_color + blue*65536
function = rgb_color
End Function
Function Open_File () as String
Dim ofn As OPENFILENAME, hWnd as HWND
Dim Nul As String, fn As String * 2048, filter As String
DIM fName AS String
dim hEdit as HWND
Nul = Chr$(0) 'Make it shorter
filter = "All Files (*.*)" + Nul + "*.*" + Nul + _
"Text Documents (*.txt)" + Nul + "*.txt" + Nul + _
"Basic Files (*.bas)" + Nul + "*.bas" + Nul + Nul
ofn.lStructSize = 76
ofn.nMaxFile = 2048
ofn.hwndOwner = hWnd
ofn.lpstrFile = Strptr(fn)
ofn.lpstrfilter = Sadd(filter)
ofn.Flags = OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST Or OFN_EXPLORER
IF (GetOpenFileName(@ofn) = FALSE) THEN
MessageBox GetActiveWindow(), "error OFN","Get File",MB_ICONASTERISK
Else
Open_File = fn
End if
End Function
Function Save_File () AS STRING
Dim ofn As OPENFILENAME, hWnd as HWND
Dim Nul As String, fn As String * 2048, filter As String
Nul = Chr$(0) 'Make it shorter
filter = "All Files (*.*)" + Nul + "*.*" + Nul + _
"Text Documents (*.txt)" + Nul + "*.txt" + Nul + _
"Basic Files (*.bas)" + Nul + "*.bas" + Nul + Nul
ofn.lStructSize = SizeOf(ofn)
ofn.nMaxFile = 2048
ofn.hwndOwner = hWnd
ofn.lpstrFile = Strptr(fn)
ofn.lpstrfilter = Sadd(filter)
ofn.Flags = OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST Or OFN_EXPLORER
IF (GetSaveFileName(@ofn) = FALSE) THEN
RETURN ""
Else
'Save_File = fn 'Saves if OpenSave = 0
End If
End Function