2002-08-04 09:44

'From: "Alan Jones" <aej@tesco.net> Sun, 4 Aug 2002 02:27:29 +0100

'A variation on the recent theme of QRichEdit text manipulation

'Just some ideas I've been playing with - maybe they'll be of use to
'someone.

     $ESCAPECHARS ON
     $INCLUDE "RapidQ.inc"

     DECLARE SUB Resize
     DECLARE SUB SetFont
     DECLARE SUB SetSize
     DECLARE SUB SetColour
     DECLARE SUB SetStyle(Sender AS QCHECKBOX)
     DECLARE SUB SetCase(Sender AS QBUTTON)
     DECLARE SUB Change

     DIM Style AS SHORT
     DIM StyleFlag AS SHORT
     DIM Flag AS SHORT

     CONST Delim$ = CHR$(10) + CHR$(32) + CHR$(34) + CHR$(39) + CHR$(40)

     TYPE FontData
      Name AS STRING * 2
      Style AS STRING * 2
      Size AS STRING * 2
      Colour AS STRING * 2
      BG AS STRING * 2
     END TYPE

     DIM Font1Data AS FontData

     CREATE Font1 AS QFONT
      Name = "Courier New"
      Size = 9
     END CREATE

     CREATE Form AS QFORM
      Width = 400
      Height = 300
      CAPTION = "FontStyle"
      CREATE Panel1 AS QPANEL
       Width = 355
       Height = 50
       BevelWidth = 0
       CREATE gbFont AS QGROUPBOX
        Top = 2
        Width = 130
        Height = 43
        CAPTION = "  Font  "
        CREATE cmFont AS QCOMBOBOX
         Top = 15
         Left = 5
         Width = 120
         AddItems "Arial", "Comic Sans MS", "Courier New", "Impact", _
          "MS Sans Serif", "MS Serif", "Tahoma", "Times New Roman", _
          "Verdana"
         ItemIndex = 2
         DropDownCount = 9
         OnChange = SetFont
        END CREATE
       END CREATE
       CREATE gbSize AS QGROUPBOX
        Top = 2
        Left = 135
        Width = 50
        Height = 43
        CAPTION = "  Size  "
        CREATE cmSize AS QCOMBOBOX
         Top = 15
         Left = 5
         Width = 40
         AddItems "8", "9", "10", "11", "12", "14", "16", "18", "20", "22", _
          "24", "26", "28", "36", "48", "72"
         ItemIndex = 2
         DropDownCount = 16
         OnChange = SetSize
        END CREATE
       END CREATE
       CREATE gbColour AS QGROUPBOX
        Top = 2
        Left = 190
        Width = 165
        Height = 43
        CAPTION = "  Colour  "
        CREATE cmColour AS QCOMBOBOX
         Top = 15
         Left = 5
         Width = 70
         AddItems "black", "blue", "green", "cyan", "red", "magenta", "brown", _
          "white", "grey", "lt blue", "lt green", "lt cyan", "lt red", _
          "lt magenta", "yellow", "br white"
         ItemIndex = 0
         DropDownCount = 16
         OnChange = SetColour
        END CREATE
        CREATE rbFG AS QRADIOBUTTON
         Top = 8
         Left = 80
         Height = 15
         Width = 40
         CAPTION = "Text"
         Checked = True
        END CREATE
        CREATE rbBG AS QRADIOBUTTON
         Top = 22
         Left = 80
         Height = 15
         Width = 80
         CAPTION = "Background"
        END CREATE
       END CREATE
      END CREATE
      CREATE Panel2 AS QPANEL
       Width = 385
       Height = 50
       BevelWidth = 0
       CREATE gbStyle AS QGROUPBOX
        Top = 2
        Left = 0
        Height = 43
        Width = 225
        CAPTION = "  Style  "
        CREATE ckBold AS QCHECKBOX
         Top = 16
         Left = 5
         CAPTION = "Bold"
         Tag = 1
         OnClick = SetStyle
        END CREATE
        CREATE ckItalic AS QCHECKBOX
         Top = 16
         Left = 55
         CAPTION = "Italic"
         Tag = 2
         OnClick = SetStyle
        END CREATE
        CREATE ckUnderline AS QCHECKBOX
         Top = 16
         Left = 105
         CAPTION = "U/line"
         Tag = 4
         OnClick = SetStyle
        END CREATE
        CREATE ckStrikeOut AS QCHECKBOX
         Top = 16
         Left = 165
         Width = 55
         CAPTION = "Str/Out"
         Tag = 8
         OnClick = SetStyle
        END CREATE
       END CREATE
       CREATE gbCase AS QGROUPBOX
        Top = 2
        Left = 230
        Width = 155
        Height = 43
        CAPTION = "  Case  "
        CREATE btUpper AS QBUTTON
         Top = 16
         Left = 5
         Width = 45
         Height = 20
         CAPTION = "Upper"
         Tag = 1
         OnClick = SetCase
        END CREATE
        CREATE btLower AS QBUTTON
         Top = 16
         Left = 55
         Width = 45
         Height = 20
         CAPTION = "Lower"
         Tag = 2
         OnClick = SetCase
        END CREATE
        CREATE btCaps AS QBUTTON
         Top = 16
         Left = 105
         Width = 45
         Height = 20
         CAPTION = "Caps"
         Tag = 3
         OnClick = SetCase
        END CREATE
       END CREATE
      END CREATE
      CREATE reEdit AS QRICHEDIT
       Top = 50
       Font = Font1
       HideSelection = 0
       Text = "Select some text and changes _
            will take place as each selection _
            is made.\n\nIf nothing is selected _
            then ALL text will be changed._
            \n\n(Try out the 'tweaks' in the _
            \"Resize\" SUB as well.)"
      END CREATE
      OnShow = Resize
      OnResize = Resize
      Center
      SHOWMODAL
     END CREATE

     SUB Resize
      A$ = reEdit.Text
      SELECT CASE Form.ClientWidth
      CASE IS < 390
       Form.ClientWidth = 390
      CASE IS < 745
       IF Form.Height < 200 THEN
        Form.Height = 200
       END IF
       Panel1.Left = (Form.ClientWidth - 355) \ 2
       Panel2.Left = (Form.ClientWidth - 385) \ 2
       Panel2.Top = 50
       reEdit.Top = 100
       reEdit.Width = Form.ClientWidth
       reEdit.Height = Form.ClientHeight - 100
      CASE IS > 745
       IF Form.Height < 150 THEN
        Form.Height = 150
       END IF
       Panel1.Left = (Form.ClientWidth - 745) \ 3
       Panel2.Left = Panel1.Left + 355 + (Form.ClientWidth - 745) \ 3
       Panel2.Top = 0
       reEdit.Top = 50
       reEdit.Width = Form.ClientWidth
       reEdit.Height = Form.ClientHeight - 50
      END SELECT
      reEdit.Clear
      reEdit.Text = A$
     END SUB

     SUB SetStyle
      IF Sender.Checked THEN
       Flag = 1
      ELSE
       Flag = -1
      END IF
      SELECT CASE Sender.Tag
      CASE 1
       StyleFlag = StyleFlag + (1 * Flag)
       IF Flag = 1 THEN
        Font1.AddStyles(fsBold)
       ELSE
        Font1.DelStyles(fsBold)
       END IF
      CASE 2
       StyleFlag = StyleFlag + (2 * Flag)
       IF Flag = 1 THEN
        Font1.AddStyles(fsItalic)
       ELSE
        Font1.DelStyles(fsItalic)
       END IF
      CASE 4
       StyleFlag = StyleFlag + (4 * Flag)
       IF Flag = 1 THEN
        Font1.AddStyles(fsUnderline)
       ELSE
        Font1.DelStyles(fsUnderline)
       END IF
      CASE 8
       StyleFlag = Styleflag + (8 * Flag)
       IF Flag = 1 THEN
        Font1.AddStyles(fsStrikeOut)
       ELSE
        Font1.DelStyles(fsStrikeOut)
       END IF
      END SELECT
      Font1Data.Style = STR$(StyleFlag)
      Change
     END SUB

     SUB SetCase
      IF reEdit.SelLength = 0 THEN
       reEdit.SelectAll
      END IF
      A$ = reEdit.SelText
      SELECT CASE Sender.Tag
      CASE 1
       A$ = UCASE$(A$)
      CASE 2
       A$ = LCASE$(A$)
      CASE 3
       FOR X% = 1 TO LEN(Delim$)
        X$ = MID$(Delim$, X%, 1)
        A% = TALLY(A$, X$)
        B% = 1
        FOR C% = 0 TO A%
         D% = ASC(MID$(A$, B%, 1))
         IF D% > 96 AND D% < 123 THEN
          B$ = CHR$(D% - 32)
          A$ = REPLACE$(A$, B$, B%)
         END IF
         B% = INSTR(B%, A$, X$) + 1
        NEXT
       NEXT
      END SELECT
      reEdit.SelText = A$
     END SUB

     SUB SetFont
      Font1.Name = cmFont.Item(cmFont.ItemIndex)
      Font1Data.Name = STR$(cmFont.ItemIndex)
      Change
     END SUB

     SUB SetSize
      Font1.Size = VAL(cmSize.Item(cmSize.ItemIndex))
      Font1Data.Size = STR$(cmSize.ItemIndex)
      Change
     END SUB

     SUB SetColour
      IF rbFG.Checked THEN
       Font1.COLOR = QBColor(cmColour.ItemIndex)
       Font1Data.Colour = STR$(cmColour.ItemIndex)
       Change
      ELSE
       reEdit.COLOR = QBColor(cmColour.ItemIndex)
       Font1Data.BG = STR$(cmColour.ItemIndex)
      END IF
     END SUB

     SUB Change
      IF reEdit.SelLength = 0 THEN
       reEdit.SelectAll
      END IF
      reEdit.SelAttributes = Font1
     END SUB

2002-08-04 09:44