2013-06-19 07:54

     $TYPECHECK ON
     $INCLUDE "C:\MenuTest\RAPIDQ.INC"

     $OPTION ICON "C:\MenuTest\MenuTest.ico"

     TYPE QREdit EXTENDS QRICHEDIT
      RichFont AS QFONT
      CONSTRUCTOR
       PlainText = 1
       RichFont.Name = "Arial"
       RichFont.Size = 10
       Font = QREdit.RichFont
      END CONSTRUCTOR
     END TYPE

     CONST EM_UNDO = &HC7
     CONST EM_CANUNDO = &HC6


     DEFBYTE ESC = 27

     DECLARE SUB  frmFile_Click(key AS INTEGER)
     DECLARE SUB Edit_Close(key AS INTEGER)
     DECLARE SUB File_Click
     DECLARE SUB Edit_Click
     DECLARE SUB  New_Click
     DECLARE SUB Open_Click
     DECLARE SUB Save_Click
     DECLARE SUB SaveAs_Click
     DECLARE SUB Print_Click
     DECLARE SUB Exit_Click
     DECLARE SUB Undo_Click
     DECLARE SUB Cut_Click
     DECLARE SUB Copy_Click
     DECLARE SUB Paste_Click
     DECLARE SUB Clear_Click
     DECLARE SUB SelectAll_Click
     DECLARE SUB Delete_Click

     DIM SaveDialog AS QSAVEDIALOG
     DIM OpenDialog AS QOPENDIALOG
     DIM tmpfile AS STRING
     tmpfile = "noname.txt"
     DIM Font AS QFONT
     Font.COLOR = &HFF0000
     Font.Name = "Arial"
     Font.Size = 10
     CREATE frmMenuTest AS QFORM
      BorderStyle = 2 'bsSizeable
      CAPTION = "Menu Test " & tmpfile
      Height = 480
      Width = 640
      Center
      CREATE RichEdit AS QREdit
       Height = frmMenuTest.ClientHeight - 27
       Left = 2
       Top = 25
       Width = frmMenuTest.ClientWidth - 5
      END CREATE
      CREATE cmdFile AS QCOOLBTN
       BMP = "File.bmp"
       CAPTION = "File"
       Enabled = True
       Flat = True
       Font.Name = "Arial"
       Font.Size = 9
       Font.COLOR = 16711808
       Height = 25
       Hint = "File Menu"
       Layout = 0
       Left = 5
       OnClick = File_Click
       ShowHint = True
       Top = 1
       Width = 65
      END CREATE
      CREATE cmdEdit AS QCOOLBTN
       BMP = "Edit.bmp"
       CAPTION = "Edit"
       Enabled = True
       Flat = True
       Font.Name = "Arial"
       Font.Size = 9
       Font.COLOR = 16711808
       Height = 25
       Hint = "Edit Menu"
       Layout = 0
       Left = 70
       OnClick = Edit_Click
       ShowHint = True
       Top = 1
       Width = 65
      END CREATE
      CREATE frmFile AS QFORM
       BorderStyle = bsNone
       Cursor = crHandPoint
       Left = 210
       OnKeyPress = frmFile_Click
       Height = 190
       Top = 190
       Width = 150
      END CREATE
      CREATE lblFileESC AS QLABEL
       CAPTION = "ESC to exit File Menu"
       Font.Name = "Arial"
       Font.Size = 9
       Font.COLOR = 8421376
       Height = 40
       LabelStyle = 2
       LayOut = 2
       Left = 5
       PARENT = frmFile
       Top = 165
       Width = frmFile.ClientWidth - 5
      END CREATE
      CREATE cmdNew AS QCOOLBTN
       BMP= "New.bmp"
       CAPTION = "New"
       FLat = 1
       Font.Name = "Arial"
       Font.Size = 10
       Font.COLOR = clBlue
       Height = 20
       Hint = "New"
       Left = 0
       OnClick = New_Click
       PARENT = frmFile
       ShowHint = True
       Top = 5
       Width = 65
      END CREATE
      CREATE cmdOpen AS QCOOLBTN
       BMP= "Open.bmp"
       CAPTION = "Open"
       Flat = 1
       Font.Name = "Arial"
       Font.Size = 10
       Font.COLOR = clBlue
       Hint = "Open"
       Height = 20
       Left = 5
       OnClick = Open_Click
       PARENT = frmFile
       ShowHint = True
       Top = 25
       Width = 65
      END CREATE
      CREATE cmdSave AS QCOOLBTN
       BMP= "Save.bmp"
       CAPTION = "Save"
       Flat = 1
       Font.Name = "Arial"
       Font.Size = 10
       Font.COLOR = clBlue
       Height = 20
       Hint = "Save"
       Left = 0
       OnClick = Save_Click
       PARENT = frmFile
       ShowHint = True
       Top = 50
       Width = 65
      END CREATE
      CREATE cmdSaveAs AS QCOOLBTN
       BMP = "SaveAs.bmp"
       CAPTION = "SaveAs"
       Flat = 1
       Font.Name = "Arial"
       Font.Size = 10
       Font.COLOR = clBlue
       Height = 20
       Hint = "SaveAs"
       Left = 9
       OnClick = SaveAs_Click
       PARENT = frmFile
       ShowHint = True
       Top = 75
       Width = 65
      END CREATE
      CREATE mnuBar0 AS QIMAGE
       BMP= "MenuBar.bmp"
       Left = 0
       PARENT = frmFile
       Hint = "Press ESC to terminate the menu"
       ShowHint = 1
       Top = 95
       Width = frmFile.ClientWidth
      END CREATE
      CREATE cmdPrint AS QCOOLBTN
       BMP= "Print.bmp"
       CAPTION = "Print"
       Flat = 1
       Font.Name = "Arial"
       Font.Size = 10
       Font.COLOR = clBlue
       Height = 20
       Hint = "Print"
       LayOut = 0
       Left = 0
       OnClick = Print_Click
       PARENT = frmFile
       ShowHint = True
       Top = 100
       Width = 65
      END CREATE
      CREATE mnuBar1 AS QIMAGE
       AutoSize = True
       BMP= "MenuBar.bmp"
       Left = 0
       PARENT = frmFile
       Hint = "Press ESC to terminate the menu"
       ShowHint = 1
       Top = 125
      END CREATE
      CREATE cmdExit AS QCOOLBTN
       BMP= "Exit.bmp"
       CAPTION = "Exit"
       Flat = 1
       Font.Name = "Arial"
       Font.Size = 10
       Font.COLOR = clBlue
       Height = 20
       Hint = "Exit"
       Left = 0
       OnClick = Exit_Click
       PARENT = frmFile
       ShowHint = True
       Top = 135
       Width = 65
      END CREATE
      CREATE frmEdit AS QFORM
       BorderStyle = bsNone
       Cursor = crHandPoint
       Left = 275
       PARENT = frmMenuTest
       OnKeyPress = Edit_Close
       Height = 215
       Top = 190
       Width = 150
       CREATE lblEditESC AS QLABEL
        CAPTION = "ESC to exit Edit Menu"
        Font.Name = "Arial"
        Font.Size = 9
        Font.COLOR = 8421376
        Height = 40
        LabelStyle = 2
        LayOut = 2
        Left = 5
        PARENT = frmEdit
        Top = 190
        Width = frmEdit.ClientWidth - 5
       END CREATE
       CREATE cmdUndo AS QCOOLBTN
        BMP = "Undo.BMP"
        CAPTION = "Undo"
        Flat = 1
        Font.Name = "Arial"
        Font.Size = 10
        Font.COLOR = clBlue
        Height = 20
        Hint = "Undo"
        Left = 5
        PARENT = frmEdit
        OnClick = Undo_Click
        ShowHint = 1
        Top = 5
        Width = 65
       END CREATE
       CREATE mnuBar2 AS QIMAGE
        BMP = "MenuBar.bmp"
        Hint = "Press ESC to terminate the menu"
        ShowHint = 1
        Top = 27
        Width = frmEdit.ClientWidth
       END CREATE
       CREATE cmdCut AS QCOOLBTN
        BMP = "Cut.bmp"
        CAPTION = "Cut"
        Flat = 1
        Font.Name = "Arial"
        Font.Size = 10
        Font.COLOR = clBlue
        Height = 20
        Hint = "Cut"
        Left = 0
        PARENT = frmEdit
        OnClick = Cut_Click
        ShowHint = 1
        Top = 35
        Width = 65
       END CREATE
       CREATE mnuCopy AS QCOOLBTN
        BMP = "Copy.bmp"
        CAPTION = "Copy"
        Flat = 1
        Font.Name = "Arial"
        Font.Size = 10
        Font.COLOR = clBlue
        Height = 20
        Hint = "Copy"
        Left = 5
        OnClick = Copy_Click
        ShowHint = 1
        Top = 60
        Width = 65
       END CREATE
       CREATE cmdPaste AS QCOOLBTN
        BMP = "Paste.bmp"
        CAPTION = "Paste"
        Flat = 1
        Font.Name = "Arial"
        Font.Size = 10
        Font.COLOR = clBlue
        Height = 20
        Hint = "Paste"
        Left = 5
        PARENT = frmEdit
        OnClick = Paste_Click
        ShowHint = 1
        Top = 85
        Width = 65
       END CREATE
       CREATE mnuBar3 AS QIMAGE
        AutoSize = 1
        BMP = "MenuBar.bmp"
        PARENT = frmEdit
        Hint = "Press ESC to terminate the menu"
        ShowHint = 1
        Top = 110
       END CREATE
       CREATE cmdSelectAll AS QCOOLBTN
        BMP = "SelectAll.bmp"
        CAPTION = "SelectAll"
        Flat = 1
        Font.Name = "Arial"
        Font.Size = 10
        Font.COLOR = clBlue
        Height = 20
        Hint = "SelectAll"
        Left = 9
        OnClick = SelectAll_Click
        PARENT = frmEdit
        ShowHint = 1
        Top = 115
        Width = 75
       END CREATE
       CREATE cmdClear AS QCOOLBTN
        BMP = "Clear.bmp"
        CAPTION = "Clear"
        Flat = 1
        Font.Name = "Arial"
        Font.Size = 10
        Font.COLOR = clBlue
        Hint = "Clear"
        Left = 0
        PARENT = frmEdit
        OnClick = Clear_Click
        ShowHint = 1
        Top = 135
        Width = 65
       END CREATE
       CREATE cmdDelete AS QCOOLBTN
        BMP = "DeleteBtn.bmp"
        CAPTION = "Delete"
        Flat = 1
        Font.Name = "Arial"
        Font.Size = 10
        Font.COLOR = clBlue
        Hint = "Delete"
        Left = 5
        PARENT = frmEdit
        OnClick = Delete_Click
        ShowHint = 1
        Top = 160
        Width = 65
       END CREATE
      END CREATE
     END CREATE
     frmMenuTest.SHOWMODAL

     SUB frmFile_Click(key AS INTEGER)
      IF key = ESC THEN
       frmFile.CLOSE
      END IF
     END SUB

     SUB File_Click
      frmFile.SHOWMODAL
     END SUB

     SUB  New_Click
      RichEdit.Clear
      tmpfile = "noname.txt"
      frmMenuTest.CAPTION = "Menu Test " & tmpfile
      frmFile.CLOSE
     END SUB

     SUB Open_Click
      OpenDialog.Filter = "Text Files (*.txt)|*.txt|All File (*.*)|*.*"
      IF OpenDialog.EXECUTE THEN
       tmpfile = OpenDialog.Filename
       RichEdit.LoadFromFile(tmpfile)
      END IF
      frmMenuTest.CAPTION = "Menu Test " & tmpfile
      RichEdit.Modified = 0
      frmFile.CLOSE
     END SUB

     SUB Save_Click
      IF tmpfile = "noname.txt" THEN
       SaveAs_Click
      ELSE
       RichEdit.SaveToFile(tmpfile)
       RichEdit.Modified = 0
       frmFile.CLOSE
      END IF
     END SUB

     SUB SaveAs_Click
      SaveDialog.Filter = "Text Files (*.txt)|*.txt|All File (*.*)|*.*"
      IF SaveDialog.EXECUTE THEN
       tmpfile = SaveDialog.Filename
       IF FILEEXISTS(tmpfile) THEN
        IF MESSAGEBOX(tmpfile & " already exists, overwrite it?","Confirm Overwrite", 1) = 1 THEN
         RichEdit.SaveToFile(tmpfile)
         frmMenutest.CAPTION = "Menu Test " & tmpfile
         frmFile.CLOSE
        ELSE
         frmFile.CLOSE
         EXIT SUB
        END IF
       END IF
      END IF

      RichEdit.Modified = 0
     END SUB

     SUB Print_Click
      IF RichEdit.Text = "" THEN
       SHOWMESSAGE "There's nothing to print"
       frmFile.CLOSE
       EXIT SUB
      END IF
      WITH Printer
       Font.Name = RichEdit.Font.Name
       Font.Size = RichEdit.Font.Size
       Printer.TextOut(10, 10, Richedit.Text, 0, -0)
      END WITH
      frmFile.CLOSE
     END SUB

     SUB Exit_Click
      frmFile.CLOSE
      frmMenuTest.CLOSE
     END SUB

     SUB Edit_Click
      frmEdit.SHOWMODAL
     END SUB

     SUB Edit_Close(key AS INTEGER)
      frmEdit.CLOSE
     END SUB

     SUB Undo_Click
      SendMessage RichEdit.Handle, EM_UNDO, 0, 0
      frmEdit.CLOSE
     END SUB

     SUB Cut_Click
      RichEdit.CutToClipboard
      frmEdit.CLOSE
     END SUB

     SUB Copy_Click
      RichEdit.CopyToClipboard
      frmEdit.CLOSE
     END SUB

     SUB Paste_Click
      RichEdit.PasteFromClipboard
      frmEdit.CLOSE
     END SUB

     SUB Clear_Click
      IF MESSAGEBOX("***WARNING*** this will cause irevocable data loss, continue ?","Confirm Clear", 1) = 1 THEN
       RichEdit.Clear
       frmEdit.CLOSE
      ELSE
       frmEdit.CLOSE
      END IF
     END SUB

     SUB SelectAll_Click
      RichEdit.SelectAll
      frmEdit.CLOSE
     END SUB

     SUB Delete_Click
      RichEdit.SelText = ""
      frmEdit.CLOSE
     END SUB

2013-06-19 07:54