TextBox.jsrc - jabacoframework - Jabaco Framework

Source path: svn/ trunk/ Framework/ src/ VB/ TextBox.jsrc

‹r84

r89

<?xml version="1.0" encoding="ISO-8859-1"?>
<SourceFile><Source><![CDATA[Option Explicit

Public Enum ChangeType
   vbChangeRemove
   vbChangeInsert
End Enum

Implements IJabacoControl
Implements MouseListener 
Implements MouseMotionListener
Implements KeyListener
Implements FocusListener 
Implements DocumentListener

Event Change(ChangeType As ChangeType, ChangeEvt As DocumentEvent)
Event Click()
Event DblClick()
Event GotFocus()
Event KeyDown(KeyCode As Integer, Shift As Integer)
Event KeyPress(KeyAscii As Integer)
Event KeyUp(KeyCode As Integer, Shift As Integer)
Event LostFocus()
Event MouseEntered()
Event MouseExited() 
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

Dim myBorderStyle As fmBorderStyle
Dim mySpecialEffect As fmSpecialEffect
Dim myBorderColor As Long
Dim myTag As String

'Dim rtf As RTFEditorKit = New RTFEditorKit()
'Dim myText As New JTextPane()
Dim myText As New JTextArea()
Dim MemTabAction As Action, MemShiftTabAction As Action, MemSetTabAction As Boolean 
Dim myDefaultBorder As Border
Dim myMouseIcon As IResource 

' ******************************** INIT THIS CONTROL ********************************

Public Property Get Parent() As JTextArea
   Parent = myText
End Property

Public Sub Class_Initialize()
   On Error Resume Next
   Call Parent.addFocusListener(Me)
   Call Parent.addMouseListener(Me)
   Call Parent.addMouseMotionListener(Me)
   Call Parent.addKeyListener(Me)
   Call Me.setViewportView(myText)
   Call Parent.getDocument().addDocumentListener(Me)
   myDefaultBorder = Base.getBorder()
   Call Base.setOpaque(False)
End Sub

' ******************************** DEFAULT FOCUS - EVENTS ********************************

Public Sub focusGained(arg2 As FocusEvent)
   Raiseevent GotFocus()
End Sub

Public Sub focusLost(arg2 As FocusEvent)
   Raiseevent LostFocus()
End Sub

' ******************************** DEFAULT MOUSE - EVENTS ********************************

Public Sub insertUpdate(evt As DocumentEvent)
   Raiseevent Change(vbChangeInsert, evt)
End Sub

Public Sub removeUpdate(evt As DocumentEvent)
   Raiseevent Change(vbChangeRemove, evt)
End Sub

Public Sub changedUpdate(evt As DocumentEvent)
   ' NOP
End Sub

Public Sub mouseMoved(e As MouseEvent) 
    RaiseEvent MouseMove(getVBMouseButton(e),getVBMouseShift(e),e.getX(),e.getY())
End Sub

Public Sub mouseDragged(e As MouseEvent) 
    RaiseEvent MouseMove(getVBMouseButton(e),getVBMouseShift(e),e.getX(),e.getY())
End Sub

Public Sub mousePressed(e As MouseEvent) 
    RaiseEvent MouseDown(getVBMouseButton(e),getVBMouseShift(e),e.getX(),e.getY())
End Sub

Public Sub mouseReleased(e As MouseEvent) 
   RaiseEvent MouseUp(getVBMouseButton(e),getVBMouseShift(e),e.getX(),e.getY())
   If (e.getX > 0 And e.getY > 0 And e.getX < Me.getWidth And e.getY < Me.getHeight) Then
      If e.getClickCount() Mod 2 = 0 Then
         RaiseEvent DblClick()
      Else
         RaiseEvent Click()
      End If
   End If
End Sub

Public Sub mouseClicked(e As MouseEvent) 
    'done by actionlistener
End Sub

Public Sub mouseEntered(e As MouseEvent) 
    RaiseEvent MouseEntered()
End Sub 

Public Sub mouseExited(e As MouseEvent) 
    RaiseEvent MouseExited()
End Sub

' ******************************** DEFAULT KEY - EVENTS ********************************

Public Sub keyReleased(e As KeyEvent) 
   RaiseEvent KeyUp(KeyEventToKeyCode(e), KeyEventToShiftConstant(e))
End Sub

Public Sub keyTyped(e As KeyEvent)
   RaiseEvent KeyPress(e.getKeyChar)
End Sub

Public Sub keyPressed(e As KeyEvent)
   If Me.MultiLine = False Then
      If e.getKeyCode = KeyEvent.VK_ENTER Then
         e.consume 
      End If
   End If
   RaiseEvent KeyDown(KeyEventToKeyCode(e), KeyEventToShiftConstant(e))
End Sub 

' ******************************** SPECIAL FUNCTIONS ********************************

Public Property Get BorderStyle() As fmBorderStyle
   BorderStyle = myBorderStyle
End Property

Public Property Let BorderStyle(v As fmBorderStyle)
   myBorderStyle = v
   If v  = fmBorderStyleNone Then
      Me.setBorder Nothing
   Else
      Me.setBorder myDefaultBorder
   End If
End Property

Public Property Get HScrollBar() As vbScrollBarPolicy
   HScrollBar = JScrollBarToVBScrollBarPolicy(Base.getHorizontalScrollBarPolicy)
End Property

Public Property Let HScrollBar(v As vbScrollBarPolicy)
   Base.setHorizontalScrollBarPolicy(VBScrollBarToJScrollBarPolicy(v, True))
End Property

Public Property Get VScrollBar() As vbScrollBarPolicy
   HScrollBar = JScrollBarToVBScrollBarPolicy(Base.getVerticalScrollBarPolicy)
End Property

Public Property Let VScrollBar(v As vbScrollBarPolicy)
   Base.setVerticalScrollBarPolicy(VBScrollBarToJScrollBarPolicy(v, False))
End Property

Public Property Get SelStart() As Long 
   SelStart = Parent.getSelectionStart
End Property

Public Property Let SelStart(v As Long)
   Parent.setSelectionStart v
End Property

Public Property Get SelLength() As Long 
   SelLength = Parent.getSelectionStart - SelStart
End Property

Public Property Let SelLength(v As Long)
   myText.setSelectionEnd SelStart + v
End Property

Public Property Get Text() As String
   Text = Parent.getText()
End Property

Public Property Let Text(s As String)
   Parent.setText s
End Property

Public Property Get BackColorSel() As Long
   BackColorSel = ColorToRGB(Parent.getSelectionColor())
End Property

Public Property Let BackColorSel(v As Long)
   Parent.setSelectionColor(RGBtoColor(v))
End Property

Public Property Get ForeColorSel() As Long
   ForeColorSel = ColorToRGB(Parent.getSelectedTextColor())
End Property

Public Property Let ForeColorSel(v As Long)
   Parent.setSelectedTextColor(RGBtoColor(v))
End Property

Public Property Get MultiLine() As Boolean
   MultiLine = Parent.getLineWrap()
End Property

Public Property Let MultiLine(v As Boolean)
   Call Parent.setLineWrap(v)
End Property

Public Property Get TabSize() As Integer
   TabSize = Parent.getTabSize()
End Property

Public Property Let TabSize(v As Integer)
   Call Parent.setTabSize(v)
End Property

Public Sub InsertText(val As String, pos As Integer)
   Call Parent.insert(val, pos)
End Sub

Public Sub AppendText(val As String)
   Call Parent.append(val)
End Sub

Public Property Get LineCount() As Integer
   LineCount = Parent.getLineCount()
End Property

Public Property Get ForwardTab() As Boolean
   ForwardTab = MemSetTabAction
End Property

Public Property Let ForwardTab(v As Boolean)
   Dim im As #InputMap = Parent.getInputMap()
   Dim tab As #KeyStroke = KeyStroke.getKeyStroke("TAB")
   Dim shiftTab = KeyStroke.getKeyStroke("shift TAB")
   Call im.put(shiftTab, shiftTab)
   If v Then
      MemTabAction =  Parent.getActionMap().Get(im.get(tab))
      MemShiftTabAction =  Parent.getActionMap().Get(im.get(shiftTab))
      MemSetTabAction = True
      Parent.getActionMap().put(im.get(tab), New TabAction(True))
      Parent.getActionMap().put(im.get(shiftTab), New TabAction(False))
   Else
      If MemSetTabAction = True Then
         Parent.getActionMap().put(im.get(tab), MemTabAction)
         Parent.getActionMap().put(im.get(shiftTab), MemShiftTabAction)
         MemSetTabAction = False
      End If
   End If
End Property

Public Property Get Locked() As Boolean 
   Locked = Not Parent.isEditable
End Property

Public Property Let Locked(v As Boolean)
   Call Parent.setEditable(v = False)   
End Property

Public Function toString() As String
   toString = Text
End Function





' ******************************** SAME IN ALL JABACO CONTROLS ********************************

Public Property Get FontName() As String 
   FontName = Parent.getFont.GetFamily()
End Property

Public Property Let FontName(val As String)
   Parent.setFont(New Font(val, IIF(FontBold, BOLD, 0) OR IIF(FontItalic, ITALIC, 0), VBFontSizeToJFontSize(FontSize)))
End Property

Public Property Get FontBold() As Boolean 
   FontBold = Parent.getFont.isBold()
End Property

Public Property Let FontBold(val As Boolean)
   Parent.setFont(New Font(FontName, IIF(val, BOLD, 0) OR IIF(FontItalic, ITALIC, 0), VBFontSizeToJFontSize(FontSize)))
End Property

Public Property Get FontItalic() As Boolean
   FontItalic = Parent.getFont.isItalic()
End Property

Public Property Let FontItalic(val As Boolean)
   Parent.setFont(New Font(FontName, IIF(FontBold, BOLD, 0) OR IIF(val, ITALIC, 0), VBFontSizeToJFontSize(FontSize)))
End Property

Public Property Get FontSize() As Integer 
   FontSize = (JFontSizeToVBFontSize(Font.getSize()))
End Property

Public Property Let FontSize(val As Integer)
   Parent.setFont(New Font(FontName, IIF(FontBold, BOLD, 0) Or IIF(FontItalic, ITALIC, 0), VBFontSizeToJFontSize(val)))
End Property

Public Property Get Font() As Font
   Font = Parent.getFont()
End Property

'Public Property Get BackColor() As java#awt#Color
'   BackColor = Parent.getBackground()
'End Property
'Public Property Let BackColor(v As java#awt#Color)
'   Parent.setBackground(v)
'   Base.setBackground(Parent.getBackground())
'   Parent.setCaretColor(New java#awt#Color(Not v.getRGB))
'End Property

Public Property Get BackColor() As Long
   BackColor = ColortoRGB(Parent.getBackground())
End Property

Public Property Let BackColor(v As Long)
   Parent.setBackground(RGBtoColor(v))
   Base.setBackground(Parent.getBackground())
   Parent.setCaretColor(RGB (Parent.getBackground.getBlue XOR 255, Parent.getBackground.getGreen XOR 255, Parent.getBackground.getRed XOR 255))
End Property

'Public Property Get ForeColor() As java#awt#Color
'   BackColor = Parent.getForeground()
'End Property
'Public Property Let ForeColor(v As java#awt#Color)
'   Parent.setForeground(v)
'   Base.setForeground(Parent.getBackground())
'End Property

Public Property Get ForeColor() As Long
   ForeColor = ColortoRGB(Parent.getForeground())
End Property

Public Property Let ForeColor(v As Long)
    Parent.setForeground(RGBtoColor(v))
    Base.setForeground(Parent.getForeground())
End Property

Public Property Get Width() As Single
    Width = Me.getSize.Width
End Property

Public Property Let Width(v As Single)
    Me.setSize(v, Me.getSize.Height)
    Call Refresh()
End Property

Public Property Get Height() As Single
    Height = Me.getSize.Height
End Property

Public Property Let Height(v As Single)
    Me.setSize(Me.getSize.Width, v)
    Call Refresh()
End Property

Public Property Get Left() As Single
    Left = Me.getLocation.x
End Property

Public Property Let Left(v As Single)
    Me.setLocation(v, Me.getLocation.y)
End Property

Public Property Get Top() As Single
    Top = Me.getLocation.y
End Property

Public Property Let Top(v As Single)
    Me.setLocation(Me.getLocation.x, v)
End Property

Public Function Move(Left As Single, Optional Top As Single = -1, Optional Width As Single = -1, Optional Height As Single = -1)
   Me.Left = Left
   If Top <> -1 Then Me.Top = Top
   If Width <> -1 Then Me.Width = Width
   If Height <> -1 Then Me.Height = Height
End Function

Public Property Get ToolTip() As String 
    ToolTip = Parent.getToolTipText()
End Property

Public Property Let ToolTip(v As String)
	If Len(v) = 0 Then 
	    Parent.setToolTipText(Null)
    Else
	    Parent.setToolTipText(v)
    End If
End Property

Public Property Get Enabled() As Boolean 
   Enabled = Parent.isEnabled()
End Property

Public Property Let Enabled(v As Boolean)
   Call Parent.setEnabled(v)
End Property

Public Property Get Visible() As Boolean 
    Visible = Base.isVisible()
End Property

Public Property Let Visible(v As Boolean)
    Base.setVisible v
End Property

Public Property Get Tag() As String 
   Tag = myTag
End Property

Public Property Let Tag(v As String)
   myTag = v
End Property

Public Property Get MousePointer() As MousePointerConstants
   MousePointer = JCursorToVBMousePointer(Parent.getCursor())
End Property

Public Property Let MousePointer(v As MousePointerConstants)
   Call Parent.setCursor(VBMousePointerToJCursor(v))
End Property

Public Property Get MouseIcon() As #IResource
   MouseIcon = myMouseIcon
End Property

Public Property Let MouseIcon(v As #IResource)
   myMouseIcon = v
   Call Parent.setCursor(VBMouseIconToJCursor(v, Me))
End Property

Public Property Get CanGetFocus() As Boolean
   CanGetFocus = Parent.isFocusable
End Property

Public Property Let CanGetFocus(v As Boolean)
   Parent.setFocusable v
End Property

Public Sub SetFocus()
   Parent.requestFocus
End Sub

Public Sub Refresh()
   On Error Resume Next
   Call Parent.invalidate()
   Call Parent.repaint(0, 0, 0, Me.Width, Me.Height)
   Call Parent.setSize(Me.getSize())
End Sub



]]></Source><Param Name="(Name)" Value="TextBox"/><Param Name="(SuperClass)" Value="javax/swing/JScrollPane"/><Param Name="(Type)" Value="Class"/><Param Name="(Access)" Value="Public"/><Param Name="(NameSpace)" Value="VB"/></SourceFile>

Show details Hide details

Change log

r87 by theuse...@hotmail.com on Nov 20, 2011 Diff

Bugfix for disable TextBox and
RichTextBox. Fore more infos look at http:
//www.jabaco.org/board/761-command1-text1
-enabled-false-not-the-expected-
behaviour.html

Go to:

Older revisions

r84 by theuse...@hotmail.com on Sep 11, 2011 Diff

Fixed TextBox-caret-bug and bug with
BOLD/non-BOLD fonts. More about it at
http://www.jabaco.org/board/647-no-
blinking-cursor-in-textbox.html

r52 by olim...@gmx.net on Oct 13, 2009 Diff

added Interaction.LoadResData

r51 by olim...@gmx.net on Oct 11, 2009 Diff

renamed JabacoEventQueue; added
information.NotRGB; fixed
TextBox.BackColor+Caret; updated
enum.getName for flag-enums;

All revisions of this file

File info

Size: 13383 bytes, 466 lines

View raw file