$INCLUDE "Rapidq.inc"
$APPTYPE GUI
$TYPECHECK ON
$RESOURCE ICO_NEWQ AS "Newq.ico"
Application.IconHandle = ICO_NEWQ
DECLARE SUB ShellExecute LIB "SHELL32" ALIAS "ShellExecuteA"(HWnd AS LONG, lpOperation AS STRING, lpFile AS STRING, lpParameters AS STRING, lpDirectory AS STRING, nShowCmd AS LONG)
DECLARE FUNCTION SetWindowLong LIB "USER32" ALIAS "SetWindowLongA" (hwnd AS LONG, nIndex AS LONG, dwNewLong AS LONG) AS LONG
DECLARE SUB keybd_event LIB "user32.dll" ALIAS "keybd_event" (bVk AS BYTE,bScan AS BYTE,dwFlags AS LONG,dwExtraInfo AS LONG)
CONST MAINTITLE$ = " NewQ"
CONST HVER$ = "1.10"
CONST CRLF = CHR$(13) + CHR$(10)
CONST QUOTE$ = CHR$(34)
CONST HTITLE$ = MAINTITLE$
CONST HBDATE$ = "10/14/2003"
CONST HAUTHOR$ = "croaker@whoever.com"
CONST HTEXT$ = "A source code editor written with and for Rapid-Q " _
+ CRLF + "although it should be configurable to other" _
+ CRLF + "compilers or as a general purpose text editor."_
+ CRLF
CONST FMSG$ = "Save current file?"
CONST FBTNSET = mbYes OR mbNo OR mbCancel
CONST DEFAULTNAME$ = "Noname.bas"
CONST DEFAULTINI$ = "Newq110.ini"
CONST HLPFILE$ = "Newqhelp.Html"
DECLARE FUNCTION StripFileExt$(XFile$ AS STRING)AS STRING
DECLARE FUNCTION ExtractFilePath$(XFile$ AS STRING) AS STRING
DECLARE FUNCTION GetFileName$(FOpen AS QOPENDIALOG, Filter$ AS STRING) AS STRING
DECLARE FUNCTION DateF$ AS STRING
DECLARE FUNCTION TimeF$ AS STRING
DECLARE SUB FileNew
DECLARE SUB FileOpen
DECLARE SUB FileSave
DECLARE SUB FileSaveas
DECLARE SUB FilePrint
DECLARE SUB FileQuit
DECLARE SUB InsertDate
DECLARE SUB InsertTime
DECLARE SUB DeleteLine
DECLARE SUB EditUndo
DECLARE SUB EditCut
DECLARE SUB EditCopy
DECLARE SUB EditPaste
DECLARE SUB EditSelectAll
DECLARE SUB SearchDlg
DECLARE SUB SearchText
DECLARE SUB Searchable
DECLARE SUB Replaceable
DECLARE SUB ReplaceTextGlobal
DECLARE SUB ReplaceText
DECLARE SUB SearchCancel
DECLARE SUB ToggleWrap
DECLARE SUB ToggleSplit
DECLARE SUB SetEOpts
DECLARE SUB AcceptEOpts
DECLARE SUB CancelEOpts
DECLARE SUB SetPOpts
DECLARE SUB AcceptPOpts
DECLARE SUB CancelPOpts
DECLARE SUB SelCommandPath
DECLARE SUB SetCOpts
DECLARE SUB SelCompPath
DECLARE SUB AcceptCOpts
DECLARE SUB DefaultCOpts
DECLARE SUB CancelCOpts
DECLARE SUB SetHPaths
DECLARE SUB SelHlpPath
DECLARE SUB SelHlpExePath
DECLARE SUB SelNewqHlpPath
DECLARE SUB SelNewqHlpExePath
DECLARE SUB AcceptHOpts
DECLARE SUB DefaultHOpts
DECLARE SUB CancelHOpts
DECLARE SUB RunProg
DECLARE SUB Compile
DECLARE SUB Prompt
DECLARE SUB Help
DECLARE SUB NewqHelp
DECLARE SUB AboutBox
DECLARE SUB CreateBak
DECLARE SUB StartUp
DECLARE SUB ShutDown
DECLARE SUB UpDate
DECLARE SUB UpdateSplit
DECLARE SUB UpdateRecentFiles
DECLARE SUB UpdateMenu
DECLARE SUB OpenPrevious0
DIM Main AS QFORM
DIM DlgFOpen AS QOPENDIALOG
DIM File AS QFILESTREAM
DIM EditFont AS QFONT
DIM MainTop AS INTEGER
DIM MainLeft AS INTEGER
DIM MainHeight AS INTEGER
DIM MainWidth AS INTEGER
DIM EditHeight AS INTEGER
DIM EditFontColor AS LONG
DIM EditBackGroundColor AS LONG
DIM WordWrap AS INTEGER
DIM SplitScreen AS INTEGER
DIM OldEditHeight AS INTEGER
DIM OldX AS INTEGER
DIM MainTop$ AS STRING
DIM MainLeft$ AS STRING
DIM MainHeight$ AS STRING
DIM MainWidth$ AS STRING
DIM EditHeight$ AS STRING
DIM EditFontColor$ AS STRING
DIM EditBackGroundColor$ AS STRING
DIM WordWrap$ AS STRING
DIM SplitScreen$ AS STRING
DIM OldEditHeight$ AS STRING
DIM CompPath$ AS STRING
DIM CompOpt$ AS STRING
DIM LibPath$ AS STRING
DIM IncPath$ AS STRING
DIM HlpPath$ AS STRING
DIM HlpExe$ AS STRING
DIM NewqHlpPath$ AS STRING
DIM NewqHlpExe$ AS STRING
DIM ProgOpt$ AS STRING
DIM CmdExe$ AS STRING
DIM DefaultPath$ AS STRING
DIM OpenFile$ AS STRING
DIM DefaultFileType$ AS STRING
DIM Bat$ AS STRING
DIM RecentFiles0$ AS STRING
CREATE Menu AS QMAINMENU
PARENT = Main
CREATE FileMenu AS QMENUITEM
CAPTION = "&File"
CREATE FNew AS QMENUITEM
CAPTION = "&New"
OnClick = FileNew
END CREATE
CREATE FOpen AS QMENUITEM
CAPTION = "&Open"
OnClick = FileOpen
END CREATE
CREATE FSave AS QMENUITEM
CAPTION = "&Save"
OnClick = FileSave
END CREATE
CREATE FSaveAs AS QMENUITEM
CAPTION = "Save&As"
OnClick = FileSaveAs
END CREATE
CREATE FPrint AS QMENUITEM
CAPTION = "&Print"
OnClick = FilePrint
END CREATE
CREATE FSpacer AS QMENUITEM
CAPTION = "-"
END CREATE
CREATE FExit AS QMENUITEM
CAPTION = "E&xit"
OnClick = FileQuit
END CREATE
CREATE FSpacer2 AS QMENUITEM
CAPTION = "-"
Visible = False
END CREATE
CREATE PrevOpen0 AS QMENUITEM
CAPTION = ""
OnClick = OpenPrevious0
Visible = False
END CREATE
END CREATE
CREATE EditMenu AS QMENUITEM
CAPTION = "&Edit
CREATE EUndo AS QMenuItem
Caption = "&"Undo
OnClick = EditUndo
ShortCut = "CTRL+"U
END CREATE
CREATE ESpacer AS QMenuItem
Caption = "-"
END CREATE
CREATE ODate AS QMenuItem
Caption = "Insert &"Date
OnClick = InsertDate
END CREATE
CREATE OTime AS QMenuItem
Caption = "Insert &"Time
OnClick = InsertTime
END CREATE
CREATE ODelLine AS QMenuItem
Caption = "Delete &"Line
OnClick = DeleteLine
ShortCut = "CTRL+"Y
END CREATE
CREATE ESpacer2 AS QMenuItem
Caption = "-"
END CREATE
CREATE ECut AS QMenuItem
Caption = "Cu&"t
OnClick = EditCut
ShortCut = "CTRL+"X
END CREATE
CREATE ECopy AS QMenuItem
Caption = "&"Copy
OnClick = EditCopy
ShortCut = "CTRL+"C
END CREATE
CREATE EPaste AS QMenuItem
Caption = "&"Paste
OnClick = EditPaste
ShortCut = "CTRL+"V
END CREATE
CREATE ESelectall AS QMenuItem
Caption = "&SELECT "All
OnClick = EditSelectAll
ShortCut = "CTRL+"A
END CREATE
END CREATE
CREATE ViewMenu AS QMenuItem
Caption = "&"View
Visible = False
CREATE VSplit AS QMenuItem
Caption = "&ERROR "Window
OnClick = ToggleSplit
Checked = True
END CREATE
END CREATE
CREATE SearchMenu AS QMenuItem
Caption = "&"Search
CREATE FSearch AS QMenuItem
Caption = "&Search/"Replace
OnClick = SearchDlg
ShortCut = ""F3
END CREATE
END CREATE
CREATE RunMenu AS QMenuItem
Caption = "&"Run
CREATE RRun AS QMenuItem
Caption = "&"Run
ShortCut = ""F5
OnClick = RunProg
END CREATE
CREATE RCompile AS QMenuItem
Caption = "Com&"pile
ShortCut = ""F6
OnClick = Compile
END CREATE
CREATE RConsole AS QMenuItem
Caption = "&"Console
ShortCUt = ""F12
OnClick = Prompt
END CREATE
END CREATE
CREATE OptionMenu AS QMenuItem
Caption = "&"Options
CREATE OWrap AS QMenuItem
Caption = "&Line "Wrap
OnClick = ToggleWrap
END CREATE
CREATE OEOpts AS QMenuitem
Caption = "&Editor "Options
OnClick = SetEOpts
END CREATE
CREATE OPOpts AS QMenuItem
Caption = "&Program "Options
OnClick = SetPOpts
END CREATE
CREATE OCOpts AS QMenuItem
Caption = "&Compiler "Options
OnClick = SetCOpts
END CREATE
CREATE OHOpts AS QMenuItem
Caption = "&Help "Options
OnClick = SetHPaths
END CREATE
END CREATE
CREATE HelpMenu AS QMenuItem
Caption = "&"Help
CREATE HContents AS QMenuItem
Caption = "&"Contents
ShortCut = ""F1
OnClick = Help
END CREATE
CREATE HNewqHelp AS QMenuItem
Caption = "&"Help
ShortCut = ""F2
OnClick = NewqHelp
END CREATE
CREATE HSpacer AS QMenuItem
Caption = "-"
END CREATE
CREATE HAbout AS QMenuItem
Caption = "&"About
OnClick = AboutBox
END CREATE
END CREATE
END CREATE
' Search Dialog Box
CREATE DlgSearch AS QFORM
BorderStyle = bsDialog
Caption = "Search/Replace "Text
Top = 200
Left = 200
Width = 425
Height = 170
CREATE LblSearch AS QLABEL
Caption = "Search "For
Top = 5
Left = 10
END CREATE
CREATE EdtSearch AS QEDIT ' Search edit box
OnChange = Searchable
Top = 20
Left = 10
Width = 280
END CREATE
CREATE LblReplace AS QLABEL
Caption = "Replace "With
Top = 45
Left = 10
END CREATE
CREATE EdtReplace AS QEDIT ' Replace edit box
OnChange = Replaceable
Top = 60
Left = 10
Width = 280
END CREATE
CREATE BtnFind AS QBUTTON
Enabled = False
Caption = "Find "Next
Onclick = SearchText
Top = 10
Left = 310
Width = 70
END CREATE
CREATE BtnReplace AS QBUTTON
Enabled = False
Caption = ""Replace
Onclick = ReplaceText
Top = 45
Left = 310
Width = 70
Height = 20
END CREATE
CREATE BtnReplaceAll AS QBUTTON
Enabled = False
Caption = "Replace "All
Onclick = ReplaceTextGlobal
Top = 80
Left = 310
Width = 70
Height = 20
END CREATE
CREATE BtnCancelFind AS QBUTTON
Caption = ""Close
Onclick = SearchCancel
Top = 115
Left = 310
Width = 70
Height = 20
END CREATE
CREATE ChkSearchCase AS QCHECKBOX
Caption = "Match "Case
Top = 90
Left = 20
END CREATE
CREATE ChkWholeWord AS QCHECKBOX
Caption = "Match Whole "Word
Width = 140
Top = 115
Left = 20
END CREATE
END CREATE
' Editor Options Dialog Box
CREATE DlgEditOpts AS QFORM
BorderStyle = bsDialog
Caption = "Editor "Options
Top = 200
Left = 200
Height = 200
Width = 425
CREATE LblFTOpts AS QLABEL
Top = 5
Left = 10
Caption = "Default file TYPE(s) - EXAMPLE: Basic Files (*.BAS)|*."BAS
END CREATE
CREATE EdtFTOpts AS QEDIT
Top = 20
Left = 10
Width = 280
END CREATE
CREATE LblFCOpts AS QLABEL
Top = 45
Left = 10
Caption = "Font COLOR (in HEX, ie 0000FF = Red)"
END CREATE
CREATE EdtFCOpts AS QEDIT
Top = 60
Left = 10
Width = 280
END CREATE
CREATE LblBCOpts AS QLABEL
Top = 85
Left = 10
Caption = "Background COLOR (in HEX, ie FF0000 = Blue)"
END CREATE
CREATE EdtBCOpts AS QEDIT
Top = 100
Left = 10
Width = 280
END CREATE
CREATE LblCommandExe AS QLABEL
Caption = "Path TO Command Prompt Executable (console)"
Top = 125
Left = 10
END CREATE
CREATE EdtCommandExe AS QEDIT
Top = 140
Left = 10
Width = 280
END CREATE
CREATE BtnCommandExe AS QBUTTON
Caption = "..."
Top = 140
Left = 300
Height = 20
Width = 20
OnClick = SelCommandPath
END CREATE
CREATE BtnAcceptEditOpts AS QBUTTON
Caption = ""Accept
Top = 60
Left = 335
Height = 20
Width = 60
OnClick = AcceptEOpts
END CREATE
CREATE BtnCancelEditOpts AS QBUTTON
Caption = ""Cancel
Top = 100
Left = 335
Height = 20
Width = 60
OnClick = CancelEOpts
END CREATE
END CREATE
' Program Options Dialog Box
CREATE DlgProgOpts AS QFORM
BorderStyle = bsDialog
Caption = "Program "Options
Top = 200
Left = 200
Height = 110
Width = 400
CREATE LblPOpts AS QLABEL
Top = 5
Left = 10
Caption = "Program "Options
END CREATE
CREATE EdtPOpts AS QEDIT
Top = 20
Left = 10
Width = 280
END CREATE
CREATE BtnAcceptProgOpts AS QBUTTON
Caption = ""Accept
Top = 20
Left = 310
Height = 20
Width = 60
OnClick = AcceptPOpts
END CREATE
CREATE BtnCancelProgOpts AS QBUTTON
Caption = ""Cancel
Top = 50
Left = 310
Height = 20
Width = 60
OnClick = CancelPOpts
END CREATE
END CREATE
' Compiler Options Dialog Box
CREATE DlgCompPaths AS QFORM
BorderStyle = bsDialog
Caption = "Compiler Paths AND "Options
Top = 200
Left = 200
Width = 425
Height = 200
CREATE LblComp AS QLABEL
Caption = "Path TO "Compiler
Top = 5
Left = 10
END CREATE
CREATE EdtComp AS QEDIT
Top = 20
Left = 10
Width = 280
END CREATE
CREATE BtnComp AS QBUTTON
Caption = "..."
Top = 20
Left = 300
Height = 20
Width = 20
OnClick = SelCompPath'
END CREATE
CREATE LblCompOpt AS QLABEL
Caption = "Compiler "Options
Top = 45
Left = 10
END CREATE
CREATE EdtCompOpt AS QEDIT
Top = 60
Left = 10
Width = 280
END CREATE
CREATE LblLibs AS QLABEL
Caption = "Path TO "Libraries
Top = 85
Left = 10
END CREATE
CREATE EdtLibs AS QEDIT
Top = 100
Left = 10
Width = 280
END CREATE
CREATE LblIncs AS QLABEL
Caption = "Path TO "Includes
Top = 125
Left = 10
END CREATE
CREATE EdtIncs AS QEDIT
Top = 140
Left = 10
Width = 280
END CREATE
CREATE BtnAcceptCPaths AS QBUTTON
Caption = ""Accept
Top = 40
Left = 335
Width = 60
Height = 20
Onclick = AcceptCOpts
END CREATE
CREATE BtnCancelCPaths AS QBUTTON
Caption = ""Cancel
Top = 80
Left = 335
Width = 60
Height = 20
Onclick = CancelCOpts
END CREATE
CREATE BtnDefaultCPaths AS QBUTTON
Caption = ""Default
Top = 120
Left = 335
Width = 60
Height = 20
Onclick = DefaultCOpts
END CREATE
END CREATE
' Help Paths Dialog
CREATE DlgHelpPaths AS QFORM
BorderStyle = bsDialog
Caption = "Help Paths AND "Options
Top = 200
Left = 200
Width = 425
Height = 200
CREATE LblHlp AS QLABEL
Caption = "Path TO Compiler Help "File
Top = 5
Left = 10
END CREATE
CREATE EdtHlp AS QEDIT
Top = 20
Left = 10
Width = 280
END CREATE
CREATE BtnHlp AS QBUTTON
Caption = "..."
Top = 20
Left = 300
Height = 20
Width = 20
OnClick = SelHlpPath
END CREATE
CREATE LblHlpExe AS QLABEL
Caption = "Path TO Compiler Help "Executable
Top = 45
Left = 10
END CREATE
CREATE EdtHlpExe AS QEDIT
Top = 60
Left = 10
Width = 280
END CREATE
CREATE BtnHlpExe AS QBUTTON
Caption = "..."
Top = 60
Left = 300
Height = 20
Width = 20
OnClick = SelHlpExePath
END CREATE
CREATE LblNewqHlp AS QLABEL
Caption = "Path TO Newq Help "File
Top = 85
Left = 10
END CREATE
CREATE EdtNewqHlp AS QEDIT
Top = 100
Left = 10
Width = 280
END CREATE
CREATE BtnNewqHlp AS QBUTTON
Caption = "..."
Top = 100
Left = 300
Height = 20
Width = 20
OnClick = SelNewqHlpPath
END CREATE
CREATE LblNewqHlpExe AS QLABEL
Caption = "Path TO Newq Help "Executable
Top = 125
Left = 10
END CREATE
CREATE EdtNewqHlpExe AS QEDIT
Top = 140
Left = 10
Width = 280
END CREATE
CREATE BtnNewqHlpExe AS QBUTTON
Caption = "..."
Top = 140
Left = 300
Height = 20
Width = 20
OnClick = SelNewqHlpExePath
END CREATE
CREATE BtnAcceptHlpPaths AS QBUTTON
Caption = ""Accept
Top = 40
Left = 335
Width = 60
Height = 20
Onclick = AcceptHOpts
END CREATE
CREATE BtnCancelHlpPaths AS QBUTTON
Caption = ""Cancel
Top = 80
Left = 335
Width = 60
Height = 20
Onclick = CancelHOpts
END CREATE
CREATE BtnDefaultHlpPaths AS QBUTTON
Caption = ""Default
Top = 120
Left = 335
Width = 60
Height = 20
Onclick = DefaultHOpts
END CREATE
END CREATE
CREATE DlgFSave AS QSAVEDIALOG
InitialDir = DefaultPath$
Filter = DefaultFileType$ & "|All Files (*.*)|*.*"
FilterIndex = 1
END CREATE
CREATE MainFont AS QFONT
Name = ""Arial
Size = 10
Color = &H000000
AddStyles(fsBold)
END CREATE
CREATE Edit AS QRICHEDIT
Parent = Main
Align = alTop
Top = 1
Left = 1
Font = EditFont
Color = &HEEEEEE
HideSelection = False
ScrollBars = ssVertical
PlainText = True
OnKeyUp = UpDate
OnMouseDown = UpDate
END CREATE
CREATE Splitter AS QSPLITTER
Parent = Main
OnMoved = UpdateSplit
END CREATE
CREATE ErrView AS QRICHEDIT
Parent = Main
ReadOnly = True
ScrollBars = ssBoth
Font = EditFont
Color = &HEEEEEE
END CREATE
CREATE STBar AS QSTATUSBAR
Parent = Main
AddPanels "", "" , "", ""
END CREATE
' ################### All Functions ###################
FUNCTION DateF$
DIM Month$(1 to 12) AS STRING
Month$(1) = ""Jan
Month$(2) = ""Feb
Month$(3) = ""Mar
Month$(4) = ""Apr
Month$(5) = ""May
Month$(6) = ""Jun
Month$(7) = ""Jul
Month$(8) = ""Aug
Month$(9) = ""Sep
Month$(10) = ""Oct
Month$(11) = ""Nov
Month$(12) = ""Dec
DateF$ = Month$(Val(MID$(DATE$, 1, 2))) + " " + MID$(DATE$, 4, 2) + ", " + MID$(DATE$, 7, 4)
END FUNCTION
FUNCTION TImeF$
DIM TSplit AS INTEGER
TSplit = VAL(MID$(TIME$, 1, 2))
IF TSplit > 12 THEN
TSplit = TSplit - 12
TimeF$ = STR$(TSplit) + MID$(TIME$, 3, 3) + " "pm
ELSE
TimeF$ = MID$(TIME$, 1, 5) + " "am
END IF
END FUNCTION
FUNCTION GetFileName$(FOpen AS QOPENDIALOG, Filter$ AS STRING)
WITH FOpen
.InitialDir = DefaultPath$
.Filter = Filter$
.FilterIndex = 1
END WITH
IF FOpen.Execute THEN
GetFileName$ = DlgFOpen.FileName
END IF
END FUNCTION
'FUNCTION RightPad$(source AS STRING, newlen AS INTEGER)
'
' DIM pad$ AS STRING
' pad$ = " "
'
' WHILE Len(source) < newlen
' source = source + pad$
' WEND
' RightPad$ = source
'
'END FUNCTION
FUNCTION ExtractFilePath$(XFile$ AS STRING)
DIM FL AS INTEGER
IF XFile$ <> "" THEN
FL = LEN(XFile$)
IF INSTR(XFile$, "\") > 0 THEN
WHILE MID$(XFILE$, FL, 1) <> "\"
DEC FL
WEND
ExtractFilePath$ = MID$(XFile$, 1, FL)
ELSE
ExtractFilePath$ = XFile$
END IF
END IF
END FUNCTION
FUNCTION StripFileExt$(XFile$ AS STRING)
DIM FL AS INTEGER
IF XFile$ <> "" THEN
FL = LEN(XFile$)
IF INSTR(XFile$, ".") > 0 THEN
WHILE MID$(XFILE$, FL, 1) <> "."
DEC FL
WEND
StripFileExt$ = MID$(XFile$, 1, FL-1) ' -1 to remove decimal
ELSE
StripFileExt$ = XFile$
END IF
END IF
END FUNCTION
' ################### All Subs ###################
SUB Update_Menu
IF RecentFiles0$ <> "" THEN
PrevOpen0.Caption = RecentFiles0$
PrevOpen0.Visible = True
FSpacer2.Visible = True
END IF
END SUB
SUB UpdateRecentFiles
' Check if most recent is already on top
IF RecentFiles0$ <> OpenFile$ THEN
RecentFiles0$ = OpenFile$
END IF
Update_Menu
END SUB
SUB OpenPrevious0
DIM Test AS INTEGER
IF Edit.Modified = True THEN
Test = MessageDlg(FMSG$, mtWarning, FBTNSET, 0)
IF Test = mrCancel THEN
Edit.Clear
EXIT SUB
END IF
IF Test = mrYes THEN FileSave
END IF
IF FileExists(RecentFiles0$) THEN ' Make sure the file hasn't been deleted
OpenFile$ = RecentFiles0$
Edit.LoadFromFile(OpenFile$)
Edit.Modified = False
CreateBak
ELSE
MessageDLG("Could NOT find file: " + RecentFiles0$, mtError, mbOK, 0)
END IF
ErrView.Clear
UpDate
END SUB
SUB DeleteLine
Edit.Line(Edit.WhereY) = "" ' Delete the text and
keybd_event(8,0,0,0) ' issue a backspace
END SUB
SUB InsertDate
Edit.Line(Edit.WhereY) = MID$(Edit.Line(Edit.WhereY), 1, Edit.WhereX) + " " + DateF$ + " " + MID$(Edit.Line(Edit.WhereY), Edit.WhereX + 1)
keybd_event(13,0,0,0) ' Issue a LineFeed
END SUB
SUB InsertTime
Edit.Line(Edit.WhereY) = MID$(Edit.Line(Edit.WhereY), 1, Edit.WhereX) + " " + TimeF$ + " " + MID$(Edit.Line(Edit.WhereY), Edit.WhereX + 1)
keybd_event(13,0,0,0) ' Issue a LineFeed
END SUB
SUB UpDate
' Update the status bar at the bottom
STBar.Panel(0).Caption = "POS: " + STR$(Edit.WhereY + 1) + " : " + STR$(Edit.WhereX + 1)
STBar.Panel(1).Caption = "Lines: " + STR$(Edit.LineCount)
IF Edit.Modified = True Then
STBar.Panel(2).Caption = ""Modified
ELSE
STBar.Panel(2).Caption = ""
END IF
STBar.Panel(3).Caption = OpenFile$
END SUB
SUB FileNew
DIM Test AS INTEGER
IF Edit.Modified = True THEN
Test = MessageDlg(FMSG$, mtWarning, FBTNSET, 0)
IF Test = mrCancel THEN EXIT SUB
IF Test = mrYes THEN FileSave
END IF
OpenFile$ = DefaultPath$ + DEFAULTNAME$
Edit.Clear
Edit.Modified = False
ErrView.Clear
UpDate
END SUB
SUB FileOpen
DIM Test AS INTEGER
IF Edit.Modified = True THEN
Test = MessageDlg(FMSG$, mtWarning, FBTNSET, 0)
IF Test = mrCancel THEN EXIT SUB
IF Test = mrYes THEN FileSave
END IF
OpenFile$ = GetFileName$(DlgFOpen, DefaultFileType$ & "|All Files (*.*)|*.*")
IF OpenFile$ <> "" THEN
Edit.LoadFromFile(OpenFile$)
CreateBak
Edit.Modified = False
UpdateRecentFiles
END IF
ErrView.Clear
UpDate
END SUB
SUB FilePrint
DIM I AS INTEGER
IF Edit.LineCount > 0 THEN
FOR I = 0 TO Edit.LineCount
LPRINT Edit.Line(I)
NEXT I
LFLUSH
END IF
END SUB
SUB FileSave
Edit.SaveToFile(OpenFile$)
Edit.Modified = False
UpDate
END SUB
SUB FileSaveAs
DlgFSave.FileName = OpenFile$
IF DlgFSave.Execute THEN
DlgFSave.Caption = "Save "As
OpenFile$ = DlgFSave.FileName
Edit.SaveToFile(OpenFile$)
Edit.Modified = False
END IF
UpDate
END SUB
SUB FileQuit
DIM Test AS INTEGER
IF Edit.Modified = True THEN
Test = MessageDlg(FMSG$, mtWarning, FBTNSET, 0)
IF Test = mrCancel THEN EXIT SUB
IF Test = mrYes THEN FileSave
END IF
CALL ShutDown
END SUB
SUB AboutBox ' Basic Info
MessageDLG("Title: " + HTITLE$ + CRLF + CRLF + "Version: " + HVER$ + CRLF_
+ CRLF + "Date: " + HBDATE$ + CRLF + CRLF + "By: " + _
HAUTHOR$ + CRLF + CRLF + HTEXT$, mtInformation, mbOK, 0)
END SUB
SUB EditUndo
SENDMESSAGE Edit.Handle, &H304, 0, 0
END SUB
SUB EditCut
Edit.CutToClipboard
END SUB
SUB EditCopy
Edit.CopyToClipboard
END SUB
SUB EditPaste
Edit.PasteFromClipboard
END SUB
SUB EditSelectAll
Edit.SelectAll
END SUB
SUB SearchText
IF ChkWholeWord.Checked = True THEN EdtSearch.Text = " " + EdtSearch.Text + " "
IF ChkSearchCase.Checked = True THEN
Edit.SelStart = INSTR(Edit.SelStart + Edit.SelLength, Edit.Text, EdtSearch.Text)-1
Edit.SelLength = LEN(EdtSearch.Text)
IF LTRIM$(RTRIM$(Edit.SelText))="" THEN
SHOWMESSAGE("No more occurences of " + QUOTE$ + EdtSearch.Text + QUOTE$)
Edit.SelStart = 0
END IF
ELSE
Edit.SelStart = INSTR(Edit.SelStart + Edit.SelLength, UCASE$(Edit.Text), UCASE$(EdtSearch.Text))-1
Edit.SelLength = LEN(EdtSearch.Text)
IF LTRIM$(RTRIM$(Edit.SelText))="" THEN
SHOWMESSAGE("No more occurences of " + QUOTE$ + EdtSearch.Text + QUOTE$)
Edit.SelStart = 0
END IF
END IF
END SUB
SUB Searchable
IF EdtSearch.Text <> "" THEN
BtnFind.Enabled = True
Else
BtnFind.Enabled = False
END IF
END SUB
SUB Replaceable
IF EdtReplace.Text <> "" THEN
BtnReplace.Enabled = True
BtnReplaceAll.Enabled = True
Else
BtnReplace.Enabled = False
BtnReplaceAll.Enabled = False
END IF
END SUB
SUB ReplaceTextGlobal
DIM x AS INTEGER
DIM z AS INTEGER
z = 0
OldX = Edit.SelStart
Edit.SelStart = 0
IF ChkWholeWord.Checked = True THEN EdtSearch.Text = " " + EdtSearch.Text + " "
IF ChkSearchCase.Checked = True THEN
DO
Edit.SelStart = INSTR(Edit.SelStart + Edit.SelLength, Edit.Text, EdtSearch.Text)-1
Edit.SelLength = LEN(EdtSearch.Text)
Edit.SelText=EdtReplace.Text
INC z
x = LEN(RTRIM$(Edit.Text))
LOOP UNTIL (Edit.SelStart + Edit.SelLength + 2) > x
ELSE
DO
Edit.SelStart = INSTR(Edit.SelStart + Edit.SelLength, UCASE$(Edit.Text), UCASE$(EdtSearch.Text))-1
Edit.SelLength = LEN(EdtSearch.Text)
Edit.SelText=EdtReplace.Text
INC z
x = LEN(RTRIM$(Edit.Text))
LOOP UNTIL (Edit.SelStart + Edit.SelLength + 2) > x
END IF
SHOWMESSAGE( STR$(z) + " occurences of " + QUOTE$ + EdtSearch.Text + QUOTE$ + " changed TO " + QUOTE$ + EdtReplace.Text + QUOTE$)
Edit.SelStart=OldX
END SUB
SUB ReplaceText
IF EdtReplace.Text <> "" THEN ' Make sure Replacement text exists
Edit.SelText=EdtReplace.Text
END IF
END SUB
SUB SearchDlg
DlgSearch.ShowModal
END SUB
SUB SearchCancel
EdtSearch.Text = ""
EdtReplace.Text = ""
DlgSearch.Close
END SUB
SUB ToggleWrap
IF Edit.WordWrap = False THEN
OWrap.Checked = True
Edit.WordWrap = True
Edit.ScrollBars = ssVertical
WordWrap = True
ELSE
OWrap.Checked = False
Edit.WordWrap = False
Edit.ScrollBars = ssBoth
WordWrap = False
END IF
END SUB
SUB UpdateSplit
OldEditHeight = Edit.Height
END SUB
SUB ToggleSplit
IF VSplit.Checked = True THEN
SplitScreen = False
OldEditHeight = Edit.Height
Edit.Height = Main.ClientHeight
VSplit.Checked = False
Splitter.Visible = False
ErrView.Visible = False
ELSE
SplitScreen = True
Edit.Height = OldEditHeight
VSplit.Checked = True
Splitter.Visible = True
Splitter.Align = alTop
Splitter.Height = 10
Splitter.Cursor = crVSplit
ErrView.Visible = True
ErrView.Align = alClient
END IF
END SUB
SUB CreateBak
DIM BakFile$ AS STRING
BakFile$ = StripFileExt$(OpenFile$) + "."bak
Edit.SaveToFile(BakFile$)
' SHOWMESSAGE(OpenFile$ + " backed up AS " + BakFile$ + ".")
END SUB
SUB SetEOpts ' Editor Options
EdtFTOpts.Text = DefaultFileType$
EdtFCOpts.Text = Convbase$(Str$(EditFontColor), 10, 16)
EdtBCOpts.Text = Convbase$(Str$(EditBackGroundColor), 10, 16)
EdtCommandExe.Text = CmdExe$
DlgEditOpts.ShowModal
END SUB
SUB SelCommandPath
Dim Temp$ AS STRING
Temp$ = GetFileName$(DlgFOpen, "All Files (*.*)|*.*")
IF Temp$ <> "" THEN
EdtCommandExe.Text = Temp$
END IF
END SUB
SUB AcceptEOpts
DefaultFileType$ = EdtFTOpts.Text
EdtFCOpts.Text = Ucase$(EdtFCOpts.Text)
EditFontColor = VAL(Convbase$(EdtFCOpts.Text, 16, 10))
EditFontColor$ = Str$(EditFontColor)
EditFont.Color = EditFontColor
EdtBCOpts.Text = Ucase$(EdtBCOpts.Text)
EditBackGroundColor = VAL(Convbase$(EdtBCOpts.Text, 16, 10))
EditBackGroundColor$ = Str$(EditBackGroundColor)
Edit.Color = EditBackGroundColor
CmdExe$ = EdtCommandExe.Text
DlgEditOpts.Close
END SUB
SUB CancelEOpts
DlgEditOpts.Close
END SUB
SUB SetPOpts ' Program Options
DlgProgOpts.ShowModal
END SUB
SUB AcceptPOpts
ProgOpt$ = RTrim$(EdtPOpts.Text)
END SUB
SUB CancelPOpts
DlgProgOpts.Close
END SUB
SUB SetCOpts ' Compiler Options
DlgCompPaths.ShowModal
END SUB
SUB SelCompPath
Dim Temp$ AS STRING
Temp$ = GetFileName$(DlgFOpen, "All Files (*.*)|*.*")
IF Temp$ <> "" THEN
EdtComp.Text = Temp$
END IF
END SUB
SUB AcceptCOpts
CompPath$ = RTrim$(EdtComp.Text)
CompOpt$ = RTrim$(EdtCompOpt.Text)
LibPath$ = RTrim$(EdtLibs.Text)
IncPath$ = RTrim$(EdtIncs.Text)
CmdExe$ = RTrim$(EdtCommandExe.Text)
DlgCompPaths.Close
END SUB
SUB DefaultCOpts
EdtComp.Text = DefaultPath$ + "RC."Exe
EdtCompOpt.Text = "-"opt
EdtLibs.Text = "-"L + DefaultPath$
EdtIncs.Text = "-"I + DefaultPath$
EdtCommandExe.Text = "C:\Command."com
END SUB
SUB CancelCOpts
DlgCompPaths.Close
END SUB
SUB SetHPaths ' Paths to Help Files
DlgHelpPaths.ShowModal
END SUB
SUB SelHlpPath
Dim Temp$ AS STRING
Temp$ = GetFileName$(DlgFOpen, "All Files (*.*)|*.*")
IF Temp$ <> "" THEN
EdtHlp.Text = Temp$
END IF
END SUB
SUB SelHlpExePath
Dim Temp$ AS STRING
Temp$ = GetFileName$(DlgFOpen, "All Files (*.*)|*.*")
IF Temp$ <> "" THEN
EdtHlpExe.Text = Temp$
END IF
END SUB
SUB SelNewqHlpPath
Dim Temp$ AS STRING
Temp$ = GetFileName$(DlgFOpen, "All Files (*.*)|*.*")
IF Temp$ <> "" THEN
EdtNewqHlp.Text = Temp$
END IF
END SUB
SUB SelNewqHlpExePath
Dim Temp$ AS STRING
Temp$ = GetFileName$(DlgFOpen, "All Files (*.*)|*.*")
IF Temp$ <> "" THEN
EdtNewqHlpExe.Text = Temp$
END IF
END SUB
SUB AcceptHOpts
HlpPath$ = RTrim$(EdtHlp.Text)
HlpExe$ = RTrim$(EdtHlpExe.Text)
NewqHlpPath$ = RTrim$(EdtNewqHlp.Text)
NewqHlpExe$ = RTrim$(EdtNewqHlpExe.Text)
DlgHelpPaths.Close
END SUB
SUB DefaultHOpts
EdtHlp.Text = DefaultPath$ + "Docs\" + "index."html
EdtHlpExe.Text = "C:\Progra~1\Intern~1\Iexplore."exe
EdtNewqHlp.Text = DefaultPath$ + "Newqhelp."txt
EdtNewqHlpExe.Text = "C:\Windows\Notepad."exe
END SUB
SUB CancelHOpts
DlgHelpPaths.Close
END SUB
SUB Compile
DIM Compile$ AS STRING
IF Edit.Modified = True THEN
FileSave
END IF
KILL StripFileExt$(OpenFile$) + "."exe
Bat$ = "Newq."bat
Compile$ = CompPath$ + " " + CompOpt$ + " " + LibPath$ + " " + IncPath$ + " " + OpenFile$ + " " + ProgOpt$
File.Open(DefaultPath$ + Bat$, fmCreate)
File.WriteLine(Compile$)
File.Close
RUN "Newq."bat
' ErrView.LoadFromFile(DefaultPath$ + ERRFILE$)
END SUB
SUB RunProg
DIM ExeFile$ AS STRING
Compile
ExeFile$ = StripFileExt$(OpenFile$) + "."exe
RUN ExeFile$
END SUB
SUB Prompt
RUN CmdExe$
END SUB
SUB Help
IF FileExists(HlpExe$) <> False THEN
IF FileExists(HlpPath$) <> False THEN
ShellExecute 0, ""Open, HlpExe$, HlpPath$, "", 1
ELSE
MessageDLG("Could NOT find file: " + HlpPath$, mtError, mbOK, 0)
END IF
ELSE
MessageDLG("Could NOT find file: " + HlpExe$, mtError, mbOK, 0)
END IF
END SUB
SUB NewqHelp
IF FileExists(NewqHlpExe$) <> False THEN
IF FileExists(NewqHlpPath$) <> False THEN
ShellExecute 0, ""Open, NewqHlpExe$, NewqHlpPath$, "", 1
ELSE
MessageDLG("Could NOT find file: " + NewqHlpPath$, mtError, mbOK, 0)
END IF
ELSE
MessageDLG("Could NOT find file: " + NewqHlpExe$, mtError, mbOK, 0)
END IF
END SUB
SUB StartUp
DefaultPath$ = ExtractFilePath$(Command$(0))
IF FileExists(DefaultPath$ + DEFAULTINI$) THEN ' Does an .INI file exist?
File.Open(DefaultPath$ + DEFAULTINI$, fmOpenRead)
MainTop$ = File.ReadLine
MainTop = Val(MainTop$)
MainLeft$ = File.ReadLine
MainLeft = Val(MainLeft$)
MainHeight$ = File.ReadLine
MainHeight = Val(MainHeight$)
MainWidth$ = File.ReadLine
MainWidth = Val(MainWidth$)
EditHeight$ = File.ReadLine
EditHeight = Val(EditHeight$)
WordWrap$ = File.ReadLine
WordWrap = Val(WordWrap$)
SplitScreen$ = File.ReadLine
SplitScreen = Val(SplitScreen$)
OldEditHeight$ = File.ReadLine
OldEditHeight = Val(OldEditHeight$)
DefaultFileType$ = File.ReadLine
EditFontColor$ = File.ReadLine
EditFontColor = Val(EditFontColor$)
EditBackGroundColor$ = File.ReadLine
EditBackGroundColor = VAL(EditBackGroundColor$)
CompPath$ = File.ReadLine
CompOpt$ = File.ReadLine
LibPath$ = File.ReadLine
IncPath$ = File.ReadLine
HlpPath$ = File.ReadLine
HlpExe$ = File.ReadLine
NewqHlpPath$ = File.ReadLine
NewqHlpExe$ = File.ReadLine
CmdExe$ = File.ReadLine
RecentFiles0$ = File.ReadLine
ELSE ' If no .INI use defaults
MainTop = 150
MainLeft = 150
MainHeight = 400
MainWidth = 500
EditHeight = 275
WordWrap = False
SplitScreen = False
OldEditHeight = EditHeight
DefaultFileType$ = "Rapidq Files (*.RQ)|*.rq|Basic Files (*.BAS)|*."BAS
EditFontColor = 0
EditBackGroundColor = 51450126
CompPath$ = DefaultPath$ + ""RC
CompOpt$ = "-"opt
LibPath$ = "-"L + DefaultPath$
IncPath$ = "-"I + DefaultPath$
HlpPath$ = DefaultPath$ + "Docs\" + "index."html
HlpExe$ = "C:\Progra~1\Intern~1\Iexplore."exe
NewqHlpPath$ = DefaultPath$ + "Newqhelp."txt
NewqHlpExe$ = "C:\Windows\Notepad."exe
CmdExe$ = "C:\Command."com
RecentFiles0$ = ""
END IF
File.Close
WITH Main
.ICOHandle = ICO_NEWQ
.BorderStyle = bsSizeable
' .DelBorderIcons(biMaximize)
.Top = MainTop
.Left = MainLeft
.Height = MainHeight
.Width = MainWidth
.Font = EditFont
.Caption = MAINTITLE$
.OnClose = FileQuit
END WITH
WITH EditFont
.Name = ""System
.Color = EditFontColor
END WITH
WITH Edit
.Height = EditHeight
.Font = EditFont
.Color = EditBackGroundColor
.Clear
END WITH
' Set up status bar
STBar.Panel(0).Width = (Edit.Width / 5)
STBar.Panel(1).Width = (Edit.Width / 5)
STBar.Panel(2).Width = (Edit.Width / 8)
' Set up dialog box values
EdtFTOpts.Text = DefaultFileType$
EdtFcOpts.Text = EditFontColor$
EdtBcOpts.Text = EditBackGroundColor$
EdtComp.Text = CompPath$
EdtCompOpt.Text = CompOpt$
EdtCommandExe.Text = CmdExe$
EdtLibs.Text = LibPath$
EdtIncs.Text = IncPath$
EdtHlp.Text = HlpPath$
EdtHlpExe.Text = HlpExe$
EdtNewqHlp.Text = NewqHlpPath$
EdtNewqHlpExe.Text = NewqHlpExe$
IF Wordwrap = True THEN
OWrap.Checked = True
Edit.WordWrap = True
Edit.ScrollBars = ssVertical
ELSE
OWrap.Checked = False
Edit.WordWrap = False
Edit.ScrollBars = ssBoth
END IF
IF SplitScreen = True THEN
VSplit.Checked = True
Edit.Align = alTop
Edit.Height = OldEditHeight
Splitter.Visible = True
Splitter.Align = alTop
Splitter.Cursor = crVSplit
Splitter.Height = 10
ErrView.Visible = True
ErrView.Align = alClient
ELSE
VSplit.Checked = False
Splitter.Visible = False
ErrView.Visible = False
Edit.Height = Main.ClientHeight
END IF
' If a file is passed on the command line check existance,
' open if exist else error message file not found
IF LEN(Command$(1)) > 0 THEN
IF FileExists(Command$(1)) THEN
OpenFile$ = Command$(1)
Edit.LoadFromFile(OpenFile$)
Edit.Modified = False
ELSE
MessageDLG("Could NOT find file: " + Command$(1), mtInformation, mbOK, 0)
END IF
ELSE
OpenFile$ = DefaultPath$ + DEFAULTNAME$
END IF
Update_Menu
END SUB
SUB ShutDown
File.Open(DefaultPath$ + DEFAULTINI$, fmCreate)
MainTop = Main.Top
MainTop$ = Str$(MainTop)
MainLeft = Main.Left
MainLeft$ = Str$(MainLeft)
MainHeight = Main.Height
MainHeight$ = Str$(MainHeight)
MainWidth = Main.Width
MainWidth$ = Str$(MainWidth)
EditHeight = Edit.Height
EditHeight$ = Str$(EditHeight)
WordWrap$ = Str$(WordWrap)
SplitScreen$ = Str$(SplitScreen)
OldEditHeight$ = Str$(OldEditHeight)
File.WriteLine(MainTop$)
File.WriteLine(MainLeft$)
File.WriteLine(MainHeight$)
File.WriteLine(MainWidth$)
File.WriteLine(EditHeight$)
File.WriteLine(WordWrap$)
File.WriteLine(SplitScreen$)
File.WriteLine(OldEditHeight$)
File.WriteLine(DefaultFileType$)
File.WriteLine(EditFontColor$)
File.WriteLine(EditBackGroundColor$)
File.WriteLine(CompPath$)
File.WriteLine(CompOpt$)
File.WriteLine(LibPath$)
File.WriteLine(IncPath$)
File.WriteLine(HlpPath$)
File.WriteLine(HlpExe$)
File.WriteLine(NewqHlpPath$)
File.WriteLine(NewqHlpExe$)
File.WriteLine(CmdExe$)
File.WriteLine(RecentFiles0$)
File.Close
Main.Close
END SUB
StartUp
UpDate
SetWindowLong(Main.Handle, -8, 0)
SetWindowLong(Application.Handle, -8, Main.handle)
Main.ShowModal
|
|
搜索
论坛
Home
回顶部
g.yi.org Hits:0 Last modified:2003-10-14 14:06:34
