Guidance
指路人
g.yi.org
software / rapidq / examples / gui / Edit & Richedit / editor / Rapidq2 / newq110.bas

Register 
注册
Search 搜索
首页 
Home Home
Software
Upload

  
     $INCLUDE "Rapidq.inc"
     $APPTYPE GUI
     $TYPECHECK ON
     $RESOURCE ICO_NEWQ AS "Newq.ico"

     Application.IconHandle = ICO_NEWQ

' API calls

' Sub to execute separate processes
     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)

' Function to properly minimize
     DECLARE FUNCTION SetWindowLong LIB "USER32" ALIAS "SetWindowLongA" (hwnd AS LONG, nIndex AS LONG, dwNewLong AS LONG) AS LONG

' Sub for keyboard activity
     DECLARE SUB keybd_event LIB "user32.dll" ALIAS "keybd_event" (bVk AS BYTE,bScan AS BYTE,dwFlags AS LONG,dwExtraInfo AS LONG)

' Constants

     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 ERRFILE$ = "Newq.err"
     CONST HLPFILE$ = "Newqhelp.Html"

' Function And Sub Declarations

'DECLARE FUNCTION RightPad$(source AS STRING, newlen AS INTEGER) AS STRING
     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

' File Menu

     DECLARE SUB FileNew
     DECLARE SUB FileOpen
     DECLARE SUB FileSave
     DECLARE SUB FileSaveas
     DECLARE SUB FilePrint
     DECLARE SUB FileQuit

' Edit Menu

     DECLARE SUB InsertDate
     DECLARE SUB InsertTime
     DECLARE SUB DeleteLine
     DECLARE SUB EditUndo
     DECLARE SUB EditCut
     DECLARE SUB EditCopy
     DECLARE SUB EditPaste
     DECLARE SUB EditSelectAll

' Search Menu

     DECLARE SUB SearchDlg
     DECLARE SUB SearchText
     DECLARE SUB Searchable
     DECLARE SUB Replaceable
     DECLARE SUB ReplaceTextGlobal
     DECLARE SUB ReplaceText
     DECLARE SUB SearchCancel

' Options Menu

     DECLARE SUB ToggleWrap
     DECLARE SUB ToggleSplit
     DECLARE SUB SetEOpts
     DECLARE SUB AcceptEOpts
     DECLARE SUB CancelEOpts

' Program Options

     DECLARE SUB SetPOpts
     DECLARE SUB AcceptPOpts
     DECLARE SUB CancelPOpts

' Compiler options

     DECLARE SUB SelCommandPath
     DECLARE SUB SetCOpts
     DECLARE SUB SelCompPath
     DECLARE SUB AcceptCOpts
     DECLARE SUB DefaultCOpts
     DECLARE SUB CancelCOpts

' Help Options

     DECLARE SUB SetHPaths
     DECLARE SUB SelHlpPath
     DECLARE SUB SelHlpExePath
     DECLARE SUB SelNewqHlpPath
     DECLARE SUB SelNewqHlpExePath
     DECLARE SUB AcceptHOpts
     DECLARE SUB DefaultHOpts
     DECLARE SUB CancelHOpts

' Run Menu

     DECLARE SUB RunProg
     DECLARE SUB Compile
     DECLARE SUB Prompt

' Help Menu

     DECLARE SUB Help
     DECLARE SUB NewqHelp
     DECLARE SUB AboutBox

' Misc
     DECLARE SUB CreateBak
     DECLARE SUB StartUp
     DECLARE SUB ShutDown
     DECLARE SUB UpDate
     DECLARE SUB UpdateSplit
     DECLARE SUB UpdateRecentFiles
     DECLARE SUB UpdateMenu
     DECLARE SUB OpenPrevious0

' Object Declarations

     DIM Main AS QFORM

' Edit Area

     DIM DlgFOpen AS QOPENDIALOG
     DIM File AS QFILESTREAM
     DIM EditFont AS QFONT

' Variable Declarations

     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
掌柜推荐
 
 
 
 
 
 
 
 
 
 
 
 
© Wed 2021-12-8  Guidance Laboratory Inc.
Email:webmaster1g.yi.org Hits:0 Last modified:2003-10-14 14:06:34