TEdit V TGet
- David Williams
- Posts: 82
- Joined: Fri Mar 03, 2006 6:26 pm
- Location: Ireland
TEdit V TGet
Hi All,
As Antonio said some time ago, TEdit uses a standard Windows Edit control, but has anyone advice, on the best way of emulating the power of GET while following Windows standard behaviour?
I use @K extensively, but when the cursor lands on text in the Get, it will overwrite a character and not insert it. Is there a way of changing the ugly blocky/black caret to a standard cursor, when entering insert mode??
There has not been much discussion on this forum about the behaviour, so may be I have missed something
TIA
David
As Antonio said some time ago, TEdit uses a standard Windows Edit control, but has anyone advice, on the best way of emulating the power of GET while following Windows standard behaviour?
I use @K extensively, but when the cursor lands on text in the Get, it will overwrite a character and not insert it. Is there a way of changing the ugly blocky/black caret to a standard cursor, when entering insert mode??
There has not been much discussion on this forum about the behaviour, so may be I have missed something
TIA
David
- David Williams
- Posts: 82
- Joined: Fri Mar 03, 2006 6:26 pm
- Location: Ireland
Re: TEdit V TGet
Thank you Mastintin, Horacio & Manuel
I agree "Posible mejora para tGet".
Any thoughts on this, from others in the forum? Otto, Driessen or James?
I agree "Posible mejora para tGet".
Any thoughts on this, from others in the forum? Otto, Driessen or James?
- James Bott
- Posts: 4654
- Joined: Fri Nov 18, 2005 4:52 pm
- Location: San Diego, California, USA
- Contact:
Re: TEdit V TGet
David,
I think you are going to have to change the code in the TGet KeyDown method. Of course, you will have to remember to do this with each upgrade.
Alternatively, you may be able to convince Antonio to use a CLASS DATA in the standard source to enable the setting of a variable once to allow all gets to have this behavior. CLASS DATA is like a static var in a class.
Originally, I think, the standard Clipper GET cursors were used because we were converting users to Windows apps from DOS apps. But at this point, I can't think of a good reason to maintain the old Clipper GET cursor appearance, so perhaps nobody would have an objection to the standard behavior being the Windows standard cursors buy default. We would have to get a consensus on this as perhaps it would be a problem for some. I don't think it would break any existing code, just change the appearance, but I could be wrong.
James
I think you are going to have to change the code in the TGet KeyDown method. Of course, you will have to remember to do this with each upgrade.
Alternatively, you may be able to convince Antonio to use a CLASS DATA in the standard source to enable the setting of a variable once to allow all gets to have this behavior. CLASS DATA is like a static var in a class.
Originally, I think, the standard Clipper GET cursors were used because we were converting users to Windows apps from DOS apps. But at this point, I can't think of a good reason to maintain the old Clipper GET cursor appearance, so perhaps nobody would have an objection to the standard behavior being the Windows standard cursors buy default. We would have to get a consensus on this as perhaps it would be a problem for some. I don't think it would break any existing code, just change the appearance, but I could be wrong.
James
- Antonio Linares
- Site Admin
- Posts: 37481
- Joined: Thu Oct 06, 2005 5:47 pm
- Location: Spain
- Contact:
Re: TEdit V TGet
David, James,
In FWH 14.11 there is already a CLASSDATA to do that
Simply do:
TGet():lChangeCaret = .F.
and all your GETs will not modify the standard WIndows caret behavior
In FWH 14.11 there is already a CLASSDATA to do that
Simply do:
TGet():lChangeCaret = .F.
and all your GETs will not modify the standard WIndows caret behavior
- James Bott
- Posts: 4654
- Joined: Fri Nov 18, 2005 4:52 pm
- Location: San Diego, California, USA
- Contact:
Re: TEdit V TGet
Ah, Antonio to the rescue!
- Antonio Linares
- Site Admin
- Posts: 37481
- Joined: Thu Oct 06, 2005 5:47 pm
- Location: Spain
- Contact:
- richard-service
- Posts: 583
- Joined: Tue Oct 16, 2007 8:57 am
- Location: New Taipei City, Taiwan
- Contact:
Re: TEdit V TGet
Hi Antonio,
Sounds good.
But I hope it can make TEdit or Modify TGet or any class for Chinese WinXP-themes work fine( TEdit class - view MiniGUI ).
OR.
Unicode support full Unicode country users( I hope winxp-themes work ).
Sounds good.
But I hope it can make TEdit or Modify TGet or any class for Chinese WinXP-themes work fine( TEdit class - view MiniGUI ).
OR.
Unicode support full Unicode country users( I hope winxp-themes work ).
Regards,
Richard
Harbour 3.2.0dev (r1904111533)/xHarbour 1.2.3 Intl. (SimpLex) (Build 20180818) => Borland C++ v7.4
xHarbour 0.99.71 (SimpLex) => Borland C++ v5.5
MySQL v5.7 /ADS v12
Harbour 3.2.0dev (r1603181642) => Borland C++ v7.4 64bit
Richard
Harbour 3.2.0dev (r1904111533)/xHarbour 1.2.3 Intl. (SimpLex) (Build 20180818) => Borland C++ v7.4
xHarbour 0.99.71 (SimpLex) => Borland C++ v5.5
MySQL v5.7 /ADS v12
Harbour 3.2.0dev (r1603181642) => Borland C++ v7.4 64bit
- Antonio Linares
- Site Admin
- Posts: 37481
- Joined: Thu Oct 06, 2005 5:47 pm
- Location: Spain
- Contact:
Re: TEdit V TGet
Richard,
FWH 14.11 provides unicode support though not finsihed yet.
Please review FWH\samples\unicode.prg
FWH 14.11 provides unicode support though not finsihed yet.
Please review FWH\samples\unicode.prg
- richard-service
- Posts: 583
- Joined: Tue Oct 16, 2007 8:57 am
- Location: New Taipei City, Taiwan
- Contact:
Re: TEdit V TGet
Yes, I knew it.Antonio Linares wrote:Richard,
FWH 14.11 provides unicode support though not finsihed yet.
Please review FWH\samples\unicode.prg
I look new HMG331 Unicode IDE for build 32 and 64bit.
Important point, not IDE. I mean this IDE read Chinese.UNI file( save as UTF-8 style ) and Textbox/Editbox support WinXP-Themes/input Chinese Unicode word/Control any key => Perfect .... I hope FWH can do it, I hope...
Regards,
Richard
Harbour 3.2.0dev (r1904111533)/xHarbour 1.2.3 Intl. (SimpLex) (Build 20180818) => Borland C++ v7.4
xHarbour 0.99.71 (SimpLex) => Borland C++ v5.5
MySQL v5.7 /ADS v12
Harbour 3.2.0dev (r1603181642) => Borland C++ v7.4 64bit
Richard
Harbour 3.2.0dev (r1904111533)/xHarbour 1.2.3 Intl. (SimpLex) (Build 20180818) => Borland C++ v7.4
xHarbour 0.99.71 (SimpLex) => Borland C++ v5.5
MySQL v5.7 /ADS v12
Harbour 3.2.0dev (r1603181642) => Borland C++ v7.4 64bit
- David Williams
- Posts: 82
- Joined: Fri Mar 03, 2006 6:26 pm
- Location: Ireland
Re: TEdit V TGet
Thank you Antonio, now less grief from new clients
Thanks also to Horacio and James for your intervention
Thanks also to Horacio and James for your intervention
- Antonio Linares
- Site Admin
- Posts: 37481
- Joined: Thu Oct 06, 2005 5:47 pm
- Location: Spain
- Contact:
Re: TEdit V TGet
Richard,
On FWH current unicode implementation we were not able to solve SetWindowTextW()
I am not familiar with HMG, maybe you could review such function source code and give us a hand solving it
Thanks!
On FWH current unicode implementation we were not able to solve SetWindowTextW()
I am not familiar with HMG, maybe you could review such function source code and give us a hand solving it
Thanks!
- richard-service
- Posts: 583
- Joined: Tue Oct 16, 2007 8:57 am
- Location: New Taipei City, Taiwan
- Contact:
Re: TEdit V TGet
Antonio,Antonio Linares wrote:Richard,
On FWH current unicode implementation we were not able to solve SetWindowTextW()
I am not familiar with HMG, maybe you could review such function source code and give us a hand solving it
Thanks!
HMG use Window standard Control TEdit/Textbox. I don't know FWH TGet support it.
Code: Select all
/*----------------------------------------------------------------------------
HMG Source File --> h_UNICODE_STRING.prg
Copyright 2012-2014 by Dr. Claudio Soto (from Uruguay).
mail: <srvet@adinet.com.uy>
blog: http://srvet.blogspot.com
Permission to use, copy, modify, distribute and sell this software
and its documentation for any purpose is hereby granted without fee,
provided that the above copyright notice appear in all copies and
that both that copyright notice and this permission notice appear
in supporting documentation.
It is provided "as is" without express or implied warranty.
----------------------------------------------------------------------------*/
#include "hmg.ch"
/*
UNICODE/ANSI ANSI Only
------------ ---------
HMG_LEN() <=> LEN()
HMG_LOWER() <=> LOWER()
HMG_UPPER() <=> UPPER()
HMG_PADC() <=> PADC()
HMG_PADL() <=> PADL()
HMG_PADR() <=> PADR()
HMG_ISALPHA() <=> ISALPHA()
HMG_ISDIGIT() <=> ISDIGIT()
HMG_ISLOWER() <=> ISLOWER()
HMG_ISUPPER() <=> ISUPPER()
HMG_ISALPHANUMERIC() <=> RETURN (ISALPHA(c) .OR. ISDIGIT(c))
HB_USUBSTR() <=> SUBSTR()
HB_ULEFT() <=> LEFT()
HB_URIGHT() <=> RIGHT()
HB_UAT() <=> AT()
HB_UTF8RAT() <=> RAT()
HB_UTF8STUFF() <=> STUFF()
*/
#include "SET_COMPILE_HMG_UNICODE.ch"
#ifdef COMPILE_HMG_UNICODE
FUNCTION HMG_LEN (x)
IF HB_ISSTRING(x) .OR. HB_ISCHAR(x) .OR. HB_ISMEMO(x)
RETURN HB_ULEN (x)
ELSE
RETURN LEN (x)
ENDIF
RETURN NIL
FUNCTION HMG_PADC (xValue, nLen, cFillChar)
LOCAL cText, nSize, cPadText := ""
IF nLen > 0
IF HB_ISNIL(cFillChar)
cFillChar := " "
ENDIF
IF .NOT. HB_WILDMATCHI ("",cFillChar)
cFillChar := HB_USUBSTR (cFillChar,1,1)
cText := HB_VALTOSTR (xValue)
IF HB_ULEN (cText) >= nLen
cPadText := HB_USUBSTR (cText,1,nLen)
ELSE
nSize := nLen - HB_ULEN (cText)
cPadText := REPLICATE (cFillChar, (nSize/2)) + cText + REPLICATE (cFillChar, ((nSize+1)/2))
cPadText := HB_USUBSTR (cPadText,1,nLen)
ENDIF
ENDIF
ENDIF
RETURN cPadText
FUNCTION HMG_PADL (xValue, nLen, cFillChar)
LOCAL cText, nSize, cPadText := ""
IF nLen > 0
IF HB_ISNIL(cFillChar)
cFillChar := " "
ENDIF
IF .NOT. HB_WILDMATCHI ("",cFillChar)
cFillChar := HB_USUBSTR (cFillChar,1,1)
cText := HB_VALTOSTR (xValue)
IF HB_ULEN (cText) >= nLen
cPadText := HB_USUBSTR (cText,1,nLen)
ELSE
nSize := nLen - HB_ULEN (cText)
cPadText := REPLICATE (cFillChar, nSize) + cText
ENDIF
ENDIF
ENDIF
RETURN cPadText
FUNCTION HMG_PADR (xValue, nLen, cFillChar)
LOCAL cText, nSize, cPadText := ""
IF nLen > 0
IF HB_ISNIL(cFillChar)
cFillChar := " "
ENDIF
IF .NOT. HB_WILDMATCHI ("",cFillChar)
cFillChar := HB_USUBSTR (cFillChar,1,1)
cText := HB_VALTOSTR (xValue)
IF HB_ULEN (cText) >= nLen
cPadText := HB_USUBSTR (cText,1,nLen)
ELSE
nSize := nLen - HB_ULEN (cText)
cPadText := cText + REPLICATE (cFillChar, nSize)
ENDIF
ENDIF
ENDIF
RETURN cPadText
/*
HB_FUNC (HMG_LOWER)
HB_FUNC (HMG_UPPER)
HB_FUNC (HMG_ISALPHA)
HB_FUNC (HMG_ISDIGIT)
HB_FUNC (HMG_ISLOWER)
HB_FUNC (HMG_ISUPPER)
HB_FUNC (HMG_ISALPHANUMERIC)
*/
#else
FUNCTION HMG_LEN(x); RETURN LEN (x)
FUNCTION HMG_LOWER(c); RETURN LOWER (c)
FUNCTION HMG_UPPER(c); RETURN UPPER (c)
FUNCTION HMG_PADC(x,n,c); RETURN PADC(x,n,c)
FUNCTION HMG_PADL(x,n,c); RETURN PADL(x,n,c)
FUNCTION HMG_PADR(x,n,c); RETURN PADR(x,n,c)
FUNCTION HMG_ISALPHA(c); RETURN ISALPHA(c)
FUNCTION HMG_ISDIGIT(c); RETURN ISDIGIT(c)
FUNCTION HMG_ISLOWER(c); RETURN ISLOWER(c)
FUNCTION HMG_ISUPPER(c); RETURN ISUPPER(c)
FUNCTION HMG_ISALPHANUMERIC(c); RETURN (ISALPHA(c) .OR. ISDIGIT(c))
#endif
// #define UTF8_BOM ( HB_BCHAR (0xEF) + HB_BCHAR (0xBB) + HB_BCHAR (0xBF) )
FUNCTION HMG_IsUTF8WithBOM ( cString )
RETURN (HB_BLEFT (cString, HB_BLEN (UTF8_BOM)) == UTF8_BOM)
FUNCTION HMG_UTF8RemoveBOM ( cString )
IF HMG_IsUTF8WithBOM (cString) == .T.
cString := HB_BSUBSTR (cString, HB_BLEN ( UTF8_BOM ) + 1)
ENDIF
RETURN cString
FUNCTION HMG_UTF8InsertBOM ( cString )
IF HMG_IsUTF8WithBOM (cString) == .F.
cString := UTF8_BOM + HB_BCHAR (0x2F) + cString
ENDIF
RETURN cString
FUNCTION HMG_IsUTF8 ( cString ) // code from Harbour Project
LOCAL lASCII := .T.
LOCAL nOctets := 0
LOCAL nChar
LOCAL tmp
FOR EACH tmp IN cString
nChar := HB_BCODE( tmp )
IF HB_bitAND ( nChar, 0x80 ) != 0
lASCII := .F.
ENDIF
IF nOctets != 0
IF HB_bitAND ( nChar, 0xC0 ) != 0x80
RETURN .F.
ENDIF
--nOctets
ELSEIF HB_bitAND ( nChar, 0x80 ) != 0
DO WHILE HB_bitAND ( nChar, 0x80 ) != 0
nChar := HB_bitAND ( HB_bitSHIFT ( nChar, 1 ), 0xFF )
++nOctets
ENDDO
--nOctets
IF nOctets == 0
RETURN .F.
ENDIF
ENDIF
NEXT
RETURN !( nOctets > 0 .OR. lASCII )
Regards,
Richard
Harbour 3.2.0dev (r1904111533)/xHarbour 1.2.3 Intl. (SimpLex) (Build 20180818) => Borland C++ v7.4
xHarbour 0.99.71 (SimpLex) => Borland C++ v5.5
MySQL v5.7 /ADS v12
Harbour 3.2.0dev (r1603181642) => Borland C++ v7.4 64bit
Richard
Harbour 3.2.0dev (r1904111533)/xHarbour 1.2.3 Intl. (SimpLex) (Build 20180818) => Borland C++ v7.4
xHarbour 0.99.71 (SimpLex) => Borland C++ v5.5
MySQL v5.7 /ADS v12
Harbour 3.2.0dev (r1603181642) => Borland C++ v7.4 64bit
- richard-service
- Posts: 583
- Joined: Tue Oct 16, 2007 8:57 am
- Location: New Taipei City, Taiwan
- Contact:
Re: TEdit V TGet
C:\hmg.3.3.1\SOURCE\h_editbox.prg
Code: Select all
/*----------------------------------------------------------------------------
HMG - Harbour Windows GUI library source code
Copyright 2002-2014 Roberto Lopez <mail.box.hmg@gmail.com>
http://sites.google.com/site/hmgweb/
This program is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free Software
Foundation; either version 2 of the License, or (at your option) any later
version.
This program is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
You should have received a copy of the GNU General Public License along with
this software; see the file COPYING. If not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA (or
visit the web site http://www.gnu.org/).
As a special exception, you have permission for additional uses of the text
contained in this release of HMG.
The exception is that, if you link the HMG library with other
files to produce an executable, this does not by itself cause the resulting
executable to be covered by the GNU General Public License.
Your use of that executable is in no way restricted on account of linking the
HMG library code into it.
Parts of this project are based upon:
"Harbour GUI framework for Win32"
Copyright 2001 Alexander S.Kresin <alex@belacy.belgorod.su>
Copyright 2001 Antonio Linares <alinares@fivetech.com>
www - http://www.harbour-project.org
"Harbour Project"
Copyright 1999-2008, http://www.harbour-project.org/
"WHAT32"
Copyright 2002 AJ Wos <andrwos@aust1.net>
"HWGUI"
Copyright 2001-2008 Alexander S.Kresin <alex@belacy.belgorod.su>
---------------------------------------------------------------------------*/
MEMVAR _HMG_SYSDATA
#include "hmg.ch"
#include "common.ch"
*-----------------------------------------------------------------------------*
Function _DefineEditbox ( ControlName, ParentForm, x, y, w, h, value, ;
fontname, fontsize, tooltip, MaxLength, gotfocus, ;
change, lostfocus, readonly, break, HelpId, ;
invisible, notabstop , bold, italic, underline, strikeout , field , backcolor , fontcolor , novscroll , nohscroll , DISABLEDBACKCOLOR , DISABLEDFORECOLOR )
*-----------------------------------------------------------------------------*
Local i , cParentForm , mVar , ContainerHandle := 0 , k := 0
Local ControlHandle
Local FontHandle
Local WorkArea
Local cParentTabName
DEFAULT w TO 120
DEFAULT h TO 240
DEFAULT value TO ""
DEFAULT change TO ""
DEFAULT lostfocus TO ""
DEFAULT gotfocus TO ""
DEFAULT MaxLength TO 64000
DEFAULT invisible TO FALSE
DEFAULT notabstop TO FALSE
If ValType ( Field ) != 'U'
if HB_UAT ( '>', Field ) == 0
MsgHMGError ("Control: " + ControlName + " Of " + ParentForm + " : You must specify a fully qualified field name. Program Terminated" )
Else
WorkArea := HB_ULEFT ( Field , HB_UAT ( '>', Field ) - 2 )
If Select (WorkArea) != 0
Value := &(Field)
EndIf
EndIf
EndIf
if _HMG_SYSDATA [ 264 ] = .T.
ParentForm := _HMG_SYSDATA [ 223 ]
if .Not. Empty (_HMG_SYSDATA [ 224 ]) .And. ValType(FontName) == "U"
FontName := _HMG_SYSDATA [ 224 ]
EndIf
if .Not. Empty (_HMG_SYSDATA [ 182 ]) .And. ValType(FontSize) == "U"
FontSize := _HMG_SYSDATA [ 182 ]
EndIf
endif
if _HMG_SYSDATA [ 183 ] > 0
IF _HMG_SYSDATA [ 240 ] == .F.
x := x + _HMG_SYSDATA [ 334 ] [_HMG_SYSDATA [ 183 ]]
y := y + _HMG_SYSDATA [ 333 ] [_HMG_SYSDATA [ 183 ]]
ParentForm := _HMG_SYSDATA [ 332 ] [_HMG_SYSDATA [ 183 ]]
cParentTabName := _HMG_SYSDATA [ 225 ]
ENDIF
EndIf
If .Not. _IsWindowDefined (ParentForm)
MsgHMGError("Window: "+ ParentForm + " is not defined. Program terminated" )
Endif
If _IsControlDefined (ControlName,ParentForm)
MsgHMGError ("Control: " + ControlName + " Of " + ParentForm + " Already defined. Program Terminated" )
endif
mVar := '_' + ParentForm + '_' + ControlName
cParentForm := ParentForm
ParentForm = GetFormHandle (ParentForm)
if valtype(x) == "U" .or. valtype(y) == "U"
If _HMG_SYSDATA [ 216 ] == 'TOOLBAR'
Break := .T.
EndIf
_HMG_SYSDATA [ 216 ] := 'EDIT'
i := GetFormIndex ( cParentForm )
if i > 0
ControlHandle := InitEditBox ( ParentForm , 0, x, y, w, h, '', 0 , MaxLength , readonly, invisible, notabstop , novscroll , nohscroll )
if valtype(fontname) != "U" .and. valtype(fontsize) != "U"
FontHandle := _SetFont (ControlHandle,FontName,FontSize,bold,italic,underline,strikeout)
Else
FontHandle := _SetFont (ControlHandle,_HMG_SYSDATA [ 342 ],_HMG_SYSDATA [ 343 ],bold,italic,underline,strikeout)
endif
AddSplitBoxItem ( Controlhandle , _HMG_SYSDATA [ 87 ] [i] , w , break , , , , _HMG_SYSDATA [ 258 ] )
Containerhandle := _HMG_SYSDATA [ 87 ] [i]
If Valtype (Value) == 'C' ;
.or.;
Valtype (Value) == 'M'
If .Not. Empty (Value)
SetWindowText ( ControlHandle , value )
EndIf
EndIf
EndIf
Else
ControlHandle := InitEditBox ( ParentForm, 0, x, y, w, h, '', 0 , MaxLength , readonly, invisible, notabstop , novscroll , nohscroll )
if valtype(fontname) != "U" .and. valtype(fontsize) != "U"
FontHandle := _SetFont (ControlHandle,FontName,FontSize,bold,italic,underline,strikeout)
Else
FontHandle := _SetFont (ControlHandle,_HMG_SYSDATA [ 342 ],_HMG_SYSDATA [ 343 ],bold,italic,underline,strikeout)
endif
If Valtype (Value) == 'C' ;
.or.;
Valtype (Value) == 'M'
If .Not. Empty (Value)
SetWindowText ( ControlHandle , value )
EndIf
EndIf
endif
If _HMG_SYSDATA [ 265 ] = .T.
aAdd ( _HMG_SYSDATA [ 142 ] , Controlhandle )
EndIf
if valtype(tooltip) != "U"
SetToolTip ( ControlHandle , tooltip , GetFormToolTipHandle (cParentForm) )
endif
k := _GetControlFree()
Public &mVar. := k
_HMG_SYSDATA [1] [k] := "EDIT"
_HMG_SYSDATA [2] [k] := ControlName
_HMG_SYSDATA [3] [k] := ControlHandle
_HMG_SYSDATA [4] [k] := ParentForm
_HMG_SYSDATA [ 5 ] [k] := 0
_HMG_SYSDATA [ 6 ] [k] := ""
_HMG_SYSDATA [ 7 ] [k] := Field
_HMG_SYSDATA [ 8 ] [k] := Nil
_HMG_SYSDATA [ 9 ] [k] := ""
_HMG_SYSDATA [ 10 ] [k] := lostfocus
_HMG_SYSDATA [ 11 ] [k] := gotfocus
_HMG_SYSDATA [ 12 ] [k] := change
_HMG_SYSDATA [ 13 ] [k] := .F.
_HMG_SYSDATA [ 14 ] [k] := backcolor
_HMG_SYSDATA [ 15 ] [k] := fontcolor
_HMG_SYSDATA [ 16 ] [k] := ""
_HMG_SYSDATA [ 17 ] [k] := {}
_HMG_SYSDATA [ 18 ] [k] := y
_HMG_SYSDATA [ 19 ] [k] := x
_HMG_SYSDATA [ 20 ] [k] := w
_HMG_SYSDATA [ 21 ] [k] := h
_HMG_SYSDATA [ 22 ] [k] := 0
_HMG_SYSDATA [ 23 ] [k] := iif ( _HMG_SYSDATA [ 183 ] > 0 ,_HMG_SYSDATA [ 333 ] [_HMG_SYSDATA [ 183 ]] , -1 )
_HMG_SYSDATA [ 24 ] [k] := iif ( _HMG_SYSDATA [ 183 ] > 0 ,_HMG_SYSDATA [ 334 ] [_HMG_SYSDATA [ 183 ]] , -1 )
_HMG_SYSDATA [ 25 ] [k] := ""
_HMG_SYSDATA [ 26 ] [k] := ContainerHandle
_HMG_SYSDATA [ 27 ] [k] := fontname
_HMG_SYSDATA [ 28 ] [k] := fontsize
_HMG_SYSDATA [ 29 ] [k] := {bold,italic,underline,strikeout}
_HMG_SYSDATA [ 30 ] [k] := tooltip
_HMG_SYSDATA [ 31 ] [k] := cParentTabName
_HMG_SYSDATA [ 32 ] [k] := 0
_HMG_SYSDATA [ 33 ] [k] := ''
_HMG_SYSDATA [ 34 ] [k] := if(invisible,FALSE,TRUE)
_HMG_SYSDATA [ 35 ] [k] := HelpId
_HMG_SYSDATA [ 36 ] [k] := FontHandle
_HMG_SYSDATA [ 37 ] [k] := 0
_HMG_SYSDATA [ 38 ] [k] := .T.
_HMG_SYSDATA [ 39 ] [k] := 0
_HMG_SYSDATA [ 40 ] [k] := { NIL , NIL , NIL , NIL , NIL , NIL , NIL , NIL , NIL , NIL , NIL }
_HMG_SYSDATA [ 40 ] [k] [ 9 ] := DISABLEDBACKCOLOR
_HMG_SYSDATA [ 40 ] [k] [ 10 ] := DISABLEDFORECOLOR
_HMG_SYSDATA [ 40 ] [k] [ 11 ] := readonly
if valtype ( Field ) != 'U'
aAdd ( _HMG_SYSDATA [ 89 ] [ GetFormIndex ( cParentForm ) ] , k )
EndIf
Return Nil
Procedure _DataEditBoxRefresh (i)
Local Field
Field := _HMG_SYSDATA [ 7 ] [i]
_SetValue ( '' , '' , &Field , i )
Return
Procedure _DataEditBoxSave ( ControlName , ParentForm)
Local Field , i
i := GetControlIndex ( ControlName , ParentForm)
Field := _HMG_SYSDATA [ 7 ] [i]
REPLACE &Field WITH _GetValue ( Controlname , ParentForm )
Return
Last edited by richard-service on Wed Dec 10, 2014 12:11 pm, edited 1 time in total.
Regards,
Richard
Harbour 3.2.0dev (r1904111533)/xHarbour 1.2.3 Intl. (SimpLex) (Build 20180818) => Borland C++ v7.4
xHarbour 0.99.71 (SimpLex) => Borland C++ v5.5
MySQL v5.7 /ADS v12
Harbour 3.2.0dev (r1603181642) => Borland C++ v7.4 64bit
Richard
Harbour 3.2.0dev (r1904111533)/xHarbour 1.2.3 Intl. (SimpLex) (Build 20180818) => Borland C++ v7.4
xHarbour 0.99.71 (SimpLex) => Borland C++ v5.5
MySQL v5.7 /ADS v12
Harbour 3.2.0dev (r1603181642) => Borland C++ v7.4 64bit
- richard-service
- Posts: 583
- Joined: Tue Oct 16, 2007 8:57 am
- Location: New Taipei City, Taiwan
- Contact:
Re: TEdit V TGet
C:\hmg.3.3.1\SOURCE\h_textbox.prg
Code: Select all
/*----------------------------------------------------------------------------
HMG - Harbour Windows GUI library source code
Copyright 2002-2014 Roberto Lopez <mail.box.hmg@gmail.com>
http://sites.google.com/site/hmgweb/
This program is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free Software
Foundation; either version 2 of the License, or (at your option) any later
version.
This program is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
You should have received a copy of the GNU General Public License along with
this software; see the file COPYING. If not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA (or
visit the web site http://www.gnu.org/).
As a special exception, you have permission for additional uses of the text
contained in this release of HMG.
The exception is that, if you link the HMG library with other
files to produce an executable, this does not by itself cause the resulting
executable to be covered by the GNU General Public License.
Your use of that executable is in no way restricted on account of linking the
HMG library code into it.
Parts of this project are based upon:
"Harbour GUI framework for Win32"
Copyright 2001 Alexander S.Kresin <alex@belacy.belgorod.su>
Copyright 2001 Antonio Linares <alinares@fivetech.com>
www - http://www.harbour-project.org
"Harbour Project"
Copyright 1999-2008, http://www.harbour-project.org/
"WHAT32"
Copyright 2002 AJ Wos <andrwos@aust1.net>
"HWGUI"
Copyright 2001-2008 Alexander S.Kresin <alex@belacy.belgorod.su>
---------------------------------------------------------------------------*/
#include "SET_COMPILE_HMG_UNICODE.ch"
MEMVAR _HMG_SYSDATA
#include "common.ch"
#include "hmg.ch"
#define EM_REPLACESEL 194 // ok
#define WM_UNDO 772 // ok
#define EM_SETMODIFY 185 // ok
#define WM_PASTE 770 // ok
#define EM_GETLINE 196 // ok
#define EM_SETSEL 177 // ok
#define WM_CLEAR 771 // ok
#define EM_GETSEL 176 // ok
#define EM_UNDO 199 // ok
#define WM_SETTEXT 12 // ok
*--------------------------------------------------------*
function _DefineTextBox( cControlName, cParentForm, nx, ny, nWidth, nHeight, ;
cValue, cFontName, nFontSize, cToolTip, nMaxLenght, ;
lUpper, lLower, lNumeric, lPassword, ;
uLostFocus, uGotFocus, uChange , uEnter , RIGHT , ;
HelpId , readonly , bold, italic, underline, ;
strikeout , field , backcolor , fontcolor , ;
invisible , notabstop , disabledbackcolor , disabledfontcolor )
*--------------------------------------------------------*
local nParentForm := 0
local nControlHandle := 0
local mVar
Local FontHandle
Local WorkArea
Local k
Local cParentTabName
// Asign STANDARD values to optional params.
DEFAULT nWidth TO 120
DEFAULT nHeight TO 24
DEFAULT cValue TO ""
DEFAULT uChange TO ""
DEFAULT uGotFocus TO ""
DEFAULT uLostFocus TO ""
DEFAULT nMaxLenght TO 255
DEFAULT lUpper TO .f.
DEFAULT lLower TO .f.
DEFAULT lNumeric TO .f.
DEFAULT lPassword TO .f.
DEFAULT uEnter TO ""
If ValType ( Field ) != 'U'
if HB_UAT ( '>', Field ) == 0
MsgHMGError ("Control: " + cControlName + " Of " + cParentForm + " : You must specify a fully qualified field name. Program Terminated")
Else
WorkArea := HB_ULEFT ( Field , HB_UAT ( '>', Field ) - 2 )
If Select (WorkArea) != 0
cValue := &(Field)
EndIf
EndIf
EndIf
if _HMG_SYSDATA [ 264 ] = .T.
cParentForm := _HMG_SYSDATA [ 223 ]
if .Not. Empty (_HMG_SYSDATA [ 224 ]) .And. ValType(cFontName) == "U"
cFontName := _HMG_SYSDATA [ 224 ]
EndIf
if .Not. Empty (_HMG_SYSDATA [ 182 ]) .And. ValType(nFontSize) == "U"
nFontSize := _HMG_SYSDATA [ 182 ]
EndIf
endif
if _HMG_SYSDATA [ 183 ] > 0
IF _HMG_SYSDATA [ 240 ] == .F.
nx := nx + _HMG_SYSDATA [ 334 ] [_HMG_SYSDATA [ 183 ]]
ny := ny + _HMG_SYSDATA [ 333 ] [_HMG_SYSDATA [ 183 ]]
cParentForm := _HMG_SYSDATA [ 332 ] [_HMG_SYSDATA [ 183 ]]
cParentTabName := _HMG_SYSDATA [ 225 ]
ENDIF
EndIf
nParentForm := GetFormHandle( cParentForm )
// Check if the window/form is defined.
if ( .not. _IsWindowDefined( cParentForm ) )
MsgHMGError( "Window: " + cParentForm + " is not defined. Program terminated." )
endif
// Check if the control is already defined.
if ( _IsControlDefined( cControlName, cParentForm ) )
MsgHMGError( "Control: " + cControlName + " of " + cParentForm + " already defined. Program Terminated." )
endif
mVar := '_' + cParentForm + '_' + cControlName
// Creates the control window.
nControlHandle := InitTextBox( nParentForm, 0, nx, ny, nWidth, nHeight, '', 0, nMaxLenght, ;
lUpper, lLower, .f., lPassword , RIGHT , readonly , invisible , notabstop )
if valtype(cfontname) != "U" .and. valtype(nfontsize) != "U"
FontHandle := _SetFont (nControlHandle,cFontName,nFontSize,bold,italic,underline,strikeout)
Else
FontHandle := _SetFont (nControlHandle,_HMG_SYSDATA [ 342 ],_HMG_SYSDATA [ 343 ],bold,italic,underline,strikeout)
endif
If _HMG_SYSDATA [ 265 ] = .T.
aAdd ( _HMG_SYSDATA [ 142 ] , nControlHandle )
EndIf
// Add a tooltip if param has value.
if ( ValType( cToolTip ) != "U" )
SetToolTip( nControlHandle, cToolTip, GetFormToolTipHandle( cParentForm ) )
endif
k := _GetControlFree()
Public &mVar. := k
_HMG_SYSDATA [1] [k] := if( lNumeric, "NUMTEXT", "TEXT" )
_HMG_SYSDATA [2] [k] := cControlName
_HMG_SYSDATA [3] [k] := nControlHandle
_HMG_SYSDATA [4] [k] := nParentForm
_HMG_SYSDATA [ 5 ] [k] := 0
_HMG_SYSDATA [ 6 ] [k] := ""
_HMG_SYSDATA [ 7 ] [k] := Field
_HMG_SYSDATA [ 8 ] [k] := nil
_HMG_SYSDATA [ 9 ] [k] := ""
_HMG_SYSDATA [ 10 ] [k] := uLostFocus
_HMG_SYSDATA [ 11 ] [k] := uGotFocus
_HMG_SYSDATA [ 12 ] [k] := uChange
_HMG_SYSDATA [ 13 ] [k] := .F.
_HMG_SYSDATA [ 14 ] [k] := backcolor
_HMG_SYSDATA [ 15 ] [k] := fontcolor
_HMG_SYSDATA [ 16 ] [k] := uEnter
_HMG_SYSDATA [ 17 ] [k] := {}
_HMG_SYSDATA [ 18 ] [k] := ny
_HMG_SYSDATA [ 19 ] [k] := nx
_HMG_SYSDATA [ 20 ] [k] := nwidth
_HMG_SYSDATA [ 21 ] [k] := nheight
_HMG_SYSDATA [ 22 ] [k] := 0
_HMG_SYSDATA [ 23 ] [k] := iif ( _HMG_SYSDATA [ 183 ] > 0 ,_HMG_SYSDATA [ 333 ] [_HMG_SYSDATA [ 183 ]] , -1 )
_HMG_SYSDATA [ 24 ] [k] := iif ( _HMG_SYSDATA [ 183 ] > 0 ,_HMG_SYSDATA [ 334 ] [_HMG_SYSDATA [ 183 ]] , -1 )
_HMG_SYSDATA [ 25 ] [k] := ""
_HMG_SYSDATA [ 26 ] [k] := 0
_HMG_SYSDATA [ 27 ] [k] := cfontname
_HMG_SYSDATA [ 28 ] [k] := nfontsize
_HMG_SYSDATA [ 29 ] [k] := {bold,italic,underline,strikeout}
_HMG_SYSDATA [ 30 ] [k] := ctooltip
_HMG_SYSDATA [ 31 ] [k] := cParentTabName
_HMG_SYSDATA [ 32 ] [k] := 0
_HMG_SYSDATA [ 33 ] [k] := ''
_HMG_SYSDATA [ 34 ] [k] := .Not. invisible
_HMG_SYSDATA [ 35 ] [k] := HelpId
_HMG_SYSDATA [ 36 ] [k] := FontHandle
_HMG_SYSDATA [ 37 ] [k] := 0
_HMG_SYSDATA [ 38 ] [k] := .T.
_HMG_SYSDATA [ 39 ] [k] := 0
_HMG_SYSDATA [ 40 ] [k] := { NIL , NIL , NIL , NIL , NIL , NIL , NIL , NIL , NIL , NIL , NIL , NIL }
_HMG_SYSDATA [ 40 ] [k] [ 9 ] := DISABLEDBACKCOLOR
_HMG_SYSDATA [ 40 ] [k] [ 10 ] := DISABLEDFONTCOLOR
_HMG_SYSDATA [ 40 ] [k] [ 11 ] := readonly
// With NUMERIC clause, transform numeric value into a string.
if ( lNumeric )
If Valtype(cValue) != 'C'
cValue := ALLTRIM( STR( cValue ) )
EndIf
EndIf
// Fill the TEXTBOX with the text given.
if ( HMG_LEN( cValue ) > 0 )
SetWindowText ( nControlHandle , cValue )
endif
if valtype ( Field ) != 'U'
aAdd ( _HMG_SYSDATA [ 89 ] [ GetFormIndex ( cParentForm ) ] , k )
EndIf
return nil
*-----------------------------------------------------------------------------*
Function _DefineMaskedTextbox ( ControlName, ParentForm, x, y, inputmask , width , value , fontname, fontsize , tooltip , lostfocus ,gotfocus , change , height , enter , rightalign , HelpId , Format , bold, italic, underline, strikeout , field , backcolor , fontcolor , readonly , invisible , notabstop , disabledbackcolor , disabledfontcolor )
*-----------------------------------------------------------------------------*
Local i, cParentForm ,c,mVar , WorkArea , k := 0
Local ControlHandle
Local FontHandle
Local cParentTabName
* Unused Parameters
RightAlign := NIL
*
If ValType ( Field ) != 'U'
if HB_UAT ( '>', Field ) == 0
MsgHMGError ("Control: " + ControlName + " Of " + ParentForm + " : You must specify a fully qualified field name. Program Terminated" )
Else
WorkArea := HB_ULEFT ( Field , HB_UAT ( '>', Field ) - 2 )
If Select (WorkArea) != 0
Value := &(Field)
EndIf
EndIf
EndIf
if valtype(Format) == "U"
Format := ""
endif
For i := 1 To HMG_LEN (InputMask)
c := HB_USUBSTR ( InputMask , i , 1 )
#ifdef COMPILE_HMG_UNICODE
if c!='9' .and. c!='$' .and. c!='*' .and. c!='.' .and. c!= ',' .and. c != ' ' .and. c!='' .and. c!='??
#else
if c!='9' .and. c!='$' .and. c!='*' .and. c!='.' .and. c!= ',' .and. c != ' ' .and. c!=''
#endif
MsgHMGError("@...TEXTBOX: Wrong InputMask Definition" )
EndIf
Next i
For i := 1 To HMG_LEN (Format)
c := HB_USUBSTR ( Format , i , 1 )
if c!='C' .and. c!='X' .and. c!= '(' .and. c!= 'E'
MsgHMGError("@...TEXTBOX: Wrong Format Definition" )
EndIf
Next i
if valtype(change) == "U"
change := ""
endif
if valtype(gotfocus) == "U"
gotfocus := ""
endif
if valtype(enter) == "U"
enter := ""
endif
if valtype(lostfocus) == "U"
lostfocus := ""
endif
if valtype(Width) == "U"
Width := 120
endif
if valtype(height) == "U"
height := 24
endif
if valtype(Value) == "U"
Value := ""
endif
If .Not. Empty (Format)
Format := '@' + ALLTRIM(Format)
EndIf
InputMask := Format + ' ' + InputMask
Value := Transform ( value , InputMask )
if _HMG_SYSDATA [ 264 ] = .T.
ParentForm := _HMG_SYSDATA [ 223 ]
if .Not. Empty (_HMG_SYSDATA [ 224 ]) .And. ValType(FontName) == "U"
FontName := _HMG_SYSDATA [ 224 ]
EndIf
if .Not. Empty (_HMG_SYSDATA [ 182 ]) .And. ValType(FontSize) == "U"
FontSize := _HMG_SYSDATA [ 182 ]
EndIf
endif
if _HMG_SYSDATA [ 183 ] > 0
IF _HMG_SYSDATA [ 240 ] == .F.
x := x + _HMG_SYSDATA [ 334 ] [_HMG_SYSDATA [ 183 ]]
y := y + _HMG_SYSDATA [ 333 ] [_HMG_SYSDATA [ 183 ]]
ParentForm := _HMG_SYSDATA [ 332 ] [_HMG_SYSDATA [ 183 ]]
cParentTabName := _HMG_SYSDATA [ 225 ]
ENDIF
EndIf
If .Not. _IsWindowDefined (ParentForm)
MsgHMGError("Window: "+ ParentForm + " is not defined. Program terminated" )
Endif
If _IsControlDefined (ControlName,ParentForm)
MsgHMGError ("Control: " + ControlName + " Of " + ParentForm + " Already defined. Program Terminated" )
endif
mVar := '_' + ParentForm + '_' + ControlName
cParentForm := ParentForm
ParentForm = GetFormHandle (ParentForm)
ControlHandle := InitMaskedTextBox ( ParentForm, 0, x, y, width , '' , 0 , 255 , .f. , .f. , height , .t. , readonly , invisible , notabstop )
if valtype(fontname) != "U" .and. valtype(fontsize) != "U"
FontHandle := _SetFont (ControlHandle,FontName,FontSize,bold,italic,underline,strikeout)
Else
FontHandle := _SetFont (ControlHandle,_HMG_SYSDATA [ 342 ],_HMG_SYSDATA [ 343 ],bold,italic,underline,strikeout)
endif
If _HMG_SYSDATA [ 265 ] = .T.
aAdd ( _HMG_SYSDATA [ 142 ] , ControlHandle )
EndIf
if valtype(tooltip) != "U"
SetToolTip ( ControlHandle , tooltip , GetFormToolTipHandle (cParentForm) )
endif
k := _GetControlFree()
Public &mVar. := k
_HMG_SYSDATA [1] [k] := "MASKEDTEXT"
_HMG_SYSDATA [2] [k] := ControlName
_HMG_SYSDATA [3] [k] := ControlHandle
_HMG_SYSDATA [4] [k] := ParentForm
_HMG_SYSDATA [ 5 ] [k] := 0
_HMG_SYSDATA [ 6 ] [k] := ""
_HMG_SYSDATA [ 7 ] [k] := InputMask
_HMG_SYSDATA [ 8 ] [k] := Nil
_HMG_SYSDATA [ 9 ] [k] := GetNumMask ( InputMask )
_HMG_SYSDATA [ 10 ] [k] := lostfocus
_HMG_SYSDATA [ 11 ] [k] := gotfocus
_HMG_SYSDATA [ 12 ] [k] := Change
_HMG_SYSDATA [ 13 ] [k] := .F.
_HMG_SYSDATA [ 14 ] [k] := backcolor
_HMG_SYSDATA [ 15 ] [k] := fontcolor
_HMG_SYSDATA [ 16 ] [k] := enter
_HMG_SYSDATA [ 17 ] [k] := Field
_HMG_SYSDATA [ 18 ] [k] := y
_HMG_SYSDATA [ 19 ] [k] := x
_HMG_SYSDATA [ 20 ] [k] := width
_HMG_SYSDATA [ 21 ] [k] := height
_HMG_SYSDATA [ 22 ] [k] := .F.
_HMG_SYSDATA [ 23 ] [k] := iif ( _HMG_SYSDATA [ 183 ] > 0 ,_HMG_SYSDATA [ 333 ] [_HMG_SYSDATA [ 183 ]] , -1 )
_HMG_SYSDATA [ 24 ] [k] := iif ( _HMG_SYSDATA [ 183 ] > 0 ,_HMG_SYSDATA [ 334 ] [_HMG_SYSDATA [ 183 ]] , -1 )
_HMG_SYSDATA [ 25 ] [k] := ""
_HMG_SYSDATA [ 26 ] [k] := 0
_HMG_SYSDATA [ 27 ] [k] := fontname
_HMG_SYSDATA [ 28 ] [k] := fontsize
_HMG_SYSDATA [ 29 ] [k] := {bold,italic,underline,strikeout}
_HMG_SYSDATA [ 30 ] [k] := tooltip
_HMG_SYSDATA [ 31 ] [k] := cParentTabName
_HMG_SYSDATA [ 32 ] [k] := 0
_HMG_SYSDATA [ 33 ] [k] := ''
_HMG_SYSDATA [ 34 ] [k] := .Not. invisible
_HMG_SYSDATA [ 35 ] [k] := HelpId
_HMG_SYSDATA [ 36 ] [k] := FontHandle
_HMG_SYSDATA [ 37 ] [k] := 0
_HMG_SYSDATA [ 38 ] [k] := .T.
_HMG_SYSDATA [ 39 ] [k] := 0
_HMG_SYSDATA [ 40 ] [k] := { NIL , NIL , NIL , NIL , NIL , NIL , NIL , NIL , NIL , NIL , NIL , NIL }
_HMG_SYSDATA [ 40 ] [k] [ 9 ] := DISABLEDBACKCOLOR
_HMG_SYSDATA [ 40 ] [k] [ 10 ] := DISABLEDFONTCOLOR
_HMG_SYSDATA [ 40 ] [k] [ 11 ] := readonly
SetWindowText ( ControlHandle , value )
if valtype ( Field ) != 'U'
aAdd ( _HMG_SYSDATA [ 89 ] [ GetFormIndex ( cParentForm ) ] , k )
EndIf
Return Nil
Function GetNumFromText ( Text , i )
Local x , c , s
s := ''
For x := 1 To HMG_LEN ( Text )
c := HB_USUBSTR(Text,x,1)
If c='0' .or. c='1' .or. c='2' .or. c='3' .or. c='4' .or. c='5' .or. c='6' .or. c='7' .or. c='8' .or. c='9' .or. c='.' .or. c='-'
s := s + c
EndIf
Next x
If HB_ULEFT ( ALLTRIM(Text) , 1 ) == '(' .OR. HB_URIGHT ( ALLTRIM(Text) , 2 ) == 'DB'
s := '-' + s
EndIf
s := Transform ( Val(s) , _HMG_SYSDATA [ 9 ] [i] )
Return Val(s)
Function GetNumMask ( Text )
Local i , c , s
s := ''
For i := 1 To HMG_LEN ( Text )
c := HB_USUBSTR(Text,i,1)
If c='9' .or. c='.'
s := s + c
EndIf
if c = '$' .or. c = '*'
s := s+'9'
EndIf
Next i
Return s
*-----------------------------------------------------------------------------*
Function _DefineCharMaskTextbox ( ControlName, ParentForm, x, y, inputmask , width , value , fontname, fontsize , tooltip , lostfocus ,gotfocus , change , height , enter , rightalign , HelpId , bold, italic, underline, strikeout , field , backcolor , fontcolor , date , readonly , invisible , notabstop , disabledbackcolor , disabledfontcolor )
*-----------------------------------------------------------------------------*
Local cParentForm, mVar, WorkArea , dateformat , k := 0
Local ControlHandle
Local FontHandle
Local cParentTabName
If ValType ( Field ) != 'U'
if HB_UAT ( '>', Field ) == 0
MsgHMGError ("Control: " + ControlName + " Of " + ParentForm + " : You must specify a fully qualified field name. Program Terminated" )
Else
WorkArea := HB_ULEFT ( Field , HB_UAT ( '>', Field ) - 2 )
If Select (WorkArea) != 0
Value := &(Field)
EndIf
EndIf
EndIf
if valtype(date) == "U"
date := .F.
endif
if valtype(change) == "U"
change := ""
endif
if valtype(gotfocus) == "U"
gotfocus := ""
endif
if valtype(enter) == "U"
enter := ""
endif
if valtype(lostfocus) == "U"
lostfocus := ""
endif
if valtype(Width) == "U"
Width := 120
endif
if valtype(height) == "U"
height := 24
endif
if valtype(Value) == "U"
if date == .F.
Value := ""
else
Value := ctod (' / / ')
endif
endif
dateformat := set ( _SET_DATEFORMAT )
if date == .t.
if HMG_LOWER ( HB_ULEFT ( dateformat , 4 ) ) == "yyyy"
if '/' $ dateformat
Inputmask := '9999/99/99'
Elseif '.' $ dateformat
Inputmask := '9999.99.99'
Elseif '-' $ dateformat
Inputmask := '9999-99-99'
EndIf
elseif HMG_LOWER ( HB_URIGHT ( dateformat , 4 ) ) == "yyyy"
if '/' $ dateformat
Inputmask := '99/99/9999'
Elseif '.' $ dateformat
Inputmask := '99.99.9999'
Elseif '-' $ dateformat
Inputmask := '99-99-9999'
EndIf
else
if '/' $ dateformat
Inputmask := '99/99/99'
Elseif '.' $ dateformat
Inputmask := '99.99.99'
Elseif '-' $ dateformat
Inputmask := '99-99-99'
EndIf
endif
endif
if _HMG_SYSDATA [ 264 ] = .T.
ParentForm := _HMG_SYSDATA [ 223 ]
if .Not. Empty (_HMG_SYSDATA [ 224 ]) .And. ValType(FontName) == "U"
FontName := _HMG_SYSDATA [ 224 ]
EndIf
if .Not. Empty (_HMG_SYSDATA [ 182 ]) .And. ValType(FontSize) == "U"
FontSize := _HMG_SYSDATA [ 182 ]
EndIf
endif
if _HMG_SYSDATA [ 183 ] > 0
IF _HMG_SYSDATA [ 240 ] == .F.
x := x + _HMG_SYSDATA [ 334 ] [_HMG_SYSDATA [ 183 ]]
y := y + _HMG_SYSDATA [ 333 ] [_HMG_SYSDATA [ 183 ]]
ParentForm := _HMG_SYSDATA [ 332 ] [_HMG_SYSDATA [ 183 ]]
cParentTabName := _HMG_SYSDATA [ 225 ]
ENDIF
EndIf
If .Not. _IsWindowDefined (ParentForm)
MsgHMGError("Window: "+ ParentForm + " is not defined. Program terminated" )
Endif
If _IsControlDefined (ControlName,ParentForm)
MsgHMGError ("Control: " + ControlName + " Of " + ParentForm + " Already defined. Program Terminated" )
endif
mVar := '_' + ParentForm + '_' + ControlName
cParentForm := ParentForm
ParentForm = GetFormHandle (ParentForm)
ControlHandle := InitCharMaskTextBox ( ParentForm, 0, x, y, width , '' , 0 , 255 , .f. , .f. , height , rightalign , readonly , invisible , notabstop )
if valtype(fontname) != "U" .and. valtype(fontsize) != "U"
FontHandle := _SetFont (ControlHandle,FontName,FontSize,bold,italic,underline,strikeout)
Else
FontHandle := _SetFont (ControlHandle,_HMG_SYSDATA [ 342 ],_HMG_SYSDATA [ 343 ],bold,italic,underline,strikeout)
endif
If _HMG_SYSDATA [ 265 ] = .T.
aAdd ( _HMG_SYSDATA [ 142 ] , ControlHandle )
EndIf
if valtype(tooltip) != "U"
SetToolTip ( ControlHandle , tooltip , GetFormToolTipHandle (cParentForm) )
endif
k := _GetControlFree()
Public &mVar. := k
_HMG_SYSDATA [1] [k] := "CHARMASKTEXT"
_HMG_SYSDATA [2] [k] := ControlName
_HMG_SYSDATA [3] [k] := ControlHandle
_HMG_SYSDATA [4] [k] := ParentForm
_HMG_SYSDATA [ 5 ] [k] := 0
_HMG_SYSDATA [ 6 ] [k] := ""
_HMG_SYSDATA [ 7 ] [k] := Field
_HMG_SYSDATA [ 8 ] [k] := Nil
_HMG_SYSDATA [ 9 ] [k] := InputMask
_HMG_SYSDATA [ 10 ] [k] := lostfocus
_HMG_SYSDATA [ 11 ] [k] := gotfocus
_HMG_SYSDATA [ 12 ] [k] := Change
_HMG_SYSDATA [ 13 ] [k] := .F.
_HMG_SYSDATA [ 14 ] [k] := backcolor
_HMG_SYSDATA [ 15 ] [k] := fontcolor
_HMG_SYSDATA [ 16 ] [k] := enter
_HMG_SYSDATA [ 17 ] [k] :=date
_HMG_SYSDATA [ 18 ] [k] := y
_HMG_SYSDATA [ 19 ] [k] := x
_HMG_SYSDATA [ 20 ] [k] := width
_HMG_SYSDATA [ 21 ] [k] := height
_HMG_SYSDATA [ 22 ] [k] := 0
_HMG_SYSDATA [ 23 ] [k] := iif ( _HMG_SYSDATA [ 183 ] > 0 ,_HMG_SYSDATA [ 333 ] [_HMG_SYSDATA [ 183 ]] , -1 )
_HMG_SYSDATA [ 24 ] [k] := iif ( _HMG_SYSDATA [ 183 ] > 0 ,_HMG_SYSDATA [ 334 ] [_HMG_SYSDATA [ 183 ]] , -1 )
_HMG_SYSDATA [ 25 ] [k] := ""
_HMG_SYSDATA [ 26 ] [k] := 0
_HMG_SYSDATA [ 27 ] [k] := fontname
_HMG_SYSDATA [ 28 ] [k] := fontsize
_HMG_SYSDATA [ 29 ] [k] := {bold,italic,underline,strikeout}
_HMG_SYSDATA [ 30 ] [k] := tooltip
_HMG_SYSDATA [ 31 ] [k] := cParentTabName
_HMG_SYSDATA [ 32 ] [k] := 0
_HMG_SYSDATA [ 33 ] [k] := ''
_HMG_SYSDATA [ 34 ] [k] := .Not. invisible
_HMG_SYSDATA [ 35 ] [k] := HelpId
_HMG_SYSDATA [ 36 ] [k] := FontHandle
_HMG_SYSDATA [ 37 ] [k] := 0
_HMG_SYSDATA [ 38 ] [k] := .T.
_HMG_SYSDATA [ 39 ] [k] := 0
_HMG_SYSDATA [ 40 ] [k] := { NIL , NIL , NIL , NIL , NIL , NIL , NIL , NIL , NIL , NIL , NIL , NIL }
_HMG_SYSDATA [ 40 ] [k] [ 9 ] := DISABLEDBACKCOLOR
_HMG_SYSDATA [ 40 ] [k] [ 10 ] := DISABLEDFONTCOLOR
_HMG_SYSDATA [ 40 ] [k] [ 11 ] := readonly
if date == .F.
SetWindowText ( ControlHandle , Value )
Else
SetWindowText ( ControlHandle , dtoc ( Value ) )
endif
if valtype ( Field ) != 'U'
aAdd ( _HMG_SYSDATA [ 89 ] [ GetFormIndex ( cParentForm ) ] , k )
EndIf
Return Nil
*------------------------------------------------------------------------------*
PROCEDURE ProcessCharMask ( i , d )
*------------------------------------------------------------------------------*
Local InBuffer , OutBuffer := '' , icp , x , CB , CM , BadEntry := .F. , InBufferLeft , InBufferRight , Mask , OldChar , BackInbuffer
Local pc := 0
Local fnb := 0
Local dc := 0
Local pFlag := .F.
Local ncp := 0
Local NegativeZero := .F.
Local Output := ''
Local ol := 0
* Unused Parameters
d := Nil
*
If ValType (_HMG_SYSDATA [ 22 ] [i] ) == 'L'
If _HMG_SYSDATA [ 22 ] [i] == .F.
Return
EndIf
EndIf
Mask := _HMG_SYSDATA [ 9 ] [i]
// Store Initial CaretPos
icp := HiWord ( SendMessage( _HMG_SYSDATA [3] [i] , EM_GETSEL , 0 , 0 ) )
// Get Current Content
InBuffer := GetWindowText ( _HMG_SYSDATA [3] [i] )
// RL 104
If HB_ULEFT ( ALLTRIM(InBuffer) , 1 ) == '-' .And. Val(InBuffer) == 0
// Tone (1000,1)
NegativeZero := .T.
EndIf
//
If Pcount() > 1
// Point Count For Numeric InputMask
For x := 1 To HMG_LEN ( InBuffer )
CB := HB_USUBSTR (InBuffer , x , 1 )
If CB == '.'
pc++
EndIf
Next x
// RL 89
If HB_ULEFT (InbuFfer,1) == '.'
pFlag := .T.
EndIf
//
// Find First Non-Blank Position
For x := 1 To HMG_LEN ( InBuffer )
CB := HB_USUBSTR (InBuffer , x , 1 )
If CB != ' '
fnb := x
Exit
EndIf
Next x
EndIf
//
BackInBuffer := InBuffer
OldChar := HB_USUBSTR ( InBuffer , icp+1 , 1 )
If HMG_LEN ( InBuffer ) < HMG_LEN ( Mask )
InBufferLeft := HB_ULEFT ( InBuffer , icp )
InBufferRight := HB_URIGHT ( InBuffer , HMG_LEN (InBuffer) - icp )
// JK
if CharMaskTekstOK(InBufferLeft + ' ' + InBufferRight,Mask) .and. CharMaskTekstOK(InBufferLeft + InBufferRight,Mask)==.f.
InBuffer := InBufferLeft + ' ' + InBufferRight
else
InBuffer := InBufferLeft +InBufferRight
endif
EndIf
If HMG_LEN ( InBuffer ) > HMG_LEN ( Mask )
InBufferLeft := HB_ULEFT ( InBuffer , icp )
InBufferRight := HB_URIGHT ( InBuffer , HMG_LEN (InBuffer) - icp - 1 )
InBuffer := InBufferLeft + InBufferRight
EndIf
// Process Mask
For x := 1 To HMG_LEN (Mask)
CB := HB_USUBSTR (InBuffer , x , 1 )
CM := HB_USUBSTR (Mask , x , 1 )
Do Case
Case (CM) == '!'
OutBuffer := OutBuffer + HMG_UPPER(CB)
Case (CM) == 'A'
If HMG_ISALPHA ( CB ) .Or. CB == ' '
OutBuffer := OutBuffer + CB
Else
if x == icp
BadEntry := .T.
OutBuffer := OutBuffer + OldChar
Else
OutBuffer := OutBuffer + ' '
EndIf
EndIf
Case CM == '9'
If HMG_ISDIGIT ( CB ) .Or. CB == ' ' .Or. ( CB == '-' .And. x == fnb .And. Pcount() > 1 )
OutBuffer := OutBuffer + CB
Else
if x == icp
BadEntry := .T.
OutBuffer := OutBuffer + OldChar
Else
OutBuffer := OutBuffer + ' '
EndIf
EndIf
Case CM == ' '
If CB == ' '
OutBuffer := OutBuffer + CB
Else
if x == icp
BadEntry := .T.
OutBuffer := OutBuffer + OldChar
Else
OutBuffer := OutBuffer + ' '
EndIf
EndIf
OtherWise
OutBuffer := OutBuffer + CM
End Case
Next x
// Replace Content
If ! ( BackInBuffer == OutBuffer )
SetWindowText ( _HMG_SYSDATA [3] [i] , OutBuffer )
EndIf
If pc > 1
If NegativeZero == .T.
Output := Transform ( GetNumFromText ( GetWindowText ( _HMG_SYSDATA [3] [i] ) , i ) , Mask )
Output := HB_URIGHT (Output , ol - 1 )
Output := '-' + Output
// Replace Text
SetWindowText ( _HMG_SYSDATA [3] [i] , Output )
SendMessage( _HMG_SYSDATA [3] [i] , EM_SETSEL , HB_UAT('.',OutBuffer) + dc , HB_UAT('.',OutBuffer) + dc )
Else
SetWindowText ( _HMG_SYSDATA [3] [i] , Transform ( GetNumFromText ( GetWindowText ( _HMG_SYSDATA [3] [i] ) , i ) , Mask ) )
SendMessage( _HMG_SYSDATA [3] [i] , EM_SETSEL , HB_UAT('.',OutBuffer) + dc , HB_UAT('.',OutBuffer) + dc )
EndIf
Else
If pFlag == .T.
ncp := HB_UAT ( '.' , GetWindowText ( _HMG_SYSDATA [3] [i] ) )
SendMessage( _HMG_SYSDATA [3] [i] , EM_SETSEL , ncp , ncp )
Else
// Restore Initial CaretPos
If BadEntry
icp--
EndIf
SendMessage( _HMG_SYSDATA [3] [i] , EM_SETSEL , icp , icp )
// Skip Protected Characters
For x := 1 To HMG_LEN (OutBuffer)
CB := HB_USUBSTR ( OutBuffer , icp+x , 1 )
CM := HB_USUBSTR ( Mask , icp+x , 1 )
If ( .Not. HMG_ISDIGIT(CB) ) .And. ( .Not. HMG_ISALPHA(CB) ) .And. ( ( .Not. CB = ' ' ) .or. ( CB == ' ' .and. CM == ' ' ) )
SendMessage( _HMG_SYSDATA [3] [i] , EM_SETSEL , icp+x , icp+x )
Else
Exit
EndIf
Next x
EndIf
EndIf
RETURN
// JK
*------------------------------------------------------------------------------*
Function CharMaskTekstOK(cString,cMask)
*------------------------------------------------------------------------------*
Local lPassed:=.f.,CB,CM,x
For x := 1 To min(HMG_LEN(cString),HMG_LEN(cMask))
CB := HB_USUBSTR ( cString , x , 1 )
CM := HB_USUBSTR ( cMask , x , 1 )
Do Case
Case (CM) == '!'
If HMG_ISUPPER ( CB ) .Or. CB == ' '
lPassed:=.t.
EndIf
Case (CM) == 'A'
If HMG_ISALPHA ( CB ) .Or. CB == ' '
lPassed:=.t.
Else
lPassed:=.f.
Return lPassed
EndIf
Case CM == '9'
If HMG_ISDIGIT ( CB ) .Or. CB == ' '
lPassed:=.t.
Else
lPassed:=.f.
Return lPassed
EndIf
Case CM == ' '
If CB == ' '
lPassed:=.t.
Else
lPassed:=.f.
Return lPassed
EndIf
OtherWise
lPassed:=.t.
End Case
next i
Return lPassed
*------------------------------------------------------------------------------*
Procedure _DataTextBoxRefresh (i)
*------------------------------------------------------------------------------*
Local Field
If _HMG_SYSDATA [1] [i] == "MASKEDTEXT"
Field := _HMG_SYSDATA [ 17 ] [i]
Else
Field := _HMG_SYSDATA [ 7 ] [i]
EndIf
If Type ( Field ) == 'C'
_SetValue ( '' , '' , RTRIM( &(Field)) , i )
Else
_SetValue ( '' , '' , &(Field) , i )
EndIf
Return
*------------------------------------------------------------------------------*
Procedure _DataTextBoxSave ( ControlName , ParentForm)
*------------------------------------------------------------------------------*
Local Field , i
i := GetControlIndex ( ControlName , ParentForm)
If _HMG_SYSDATA [1] [i] == "MASKEDTEXT"
Field := _HMG_SYSDATA [ 17 ] [i]
Else
Field := _HMG_SYSDATA [ 7 ] [i]
EndIf
&(Field) := _GetValue ( Controlname , ParentForm )
Return
*------------------------------------------------------------------------------*
PROCEDURE ProcessNumText ( i )
*------------------------------------------------------------------------------*
Local InBuffer , OutBuffer := '' , icp , x , CB , BackInBuffer , BadEntry := .F. , fnb
// Store Initial CaretPos
icp := HiWord ( SendMessage( _HMG_SYSDATA [3] [i] , EM_GETSEL , 0 , 0 ) )
// Get Current Content
InBuffer := GetWindowText ( _HMG_SYSDATA [3] [i] )
BackInBuffer := InBuffer
// Find First Non-Blank Position
For x := 1 To HMG_LEN ( InBuffer )
CB := HB_USUBSTR (InBuffer , x , 1 )
If CB != ' '
fnb := x
Exit
EndIf
Next x
// Process Mask
For x := 1 To HMG_LEN(InBuffer)
CB := HB_USUBSTR(InBuffer , x , 1 )
If HMG_ISDIGIT ( CB ) .Or. ( CB == '-' .And. x == fnb ) .or. (CB == '.' .and. HB_UAT (CB, OutBuffer) == 0)
OutBuffer := OutBuffer + CB
Else
BadEntry := .t.
EndIf
Next x
If BadEntry
icp--
EndIf
// JK Replace Content
If ! ( BackInBuffer == OutBuffer )
SetWindowText ( _HMG_SYSDATA [3] [i] , OutBuffer )
EndIf
// Restore Initial CaretPos
SendMessage( _HMG_SYSDATA [3] [i] , EM_SETSEL , icp , icp )
RETURN
*------------------------------------------------------------------------------*
Function GETNumFromTextSP(Text,i)
*------------------------------------------------------------------------------*
Local x , c , s
s := ''
For x := 1 To HMG_LEN ( Text )
c := HB_USUBSTR(Text,x,1)
If c='0' .or. c='1' .or. c='2' .or. c='3' .or. c='4' .or. c='5' .or. c='6' .or. c='7' .or. c='8' .or. c='9' .or. c=',' .or. c='-' .or. c = '.'
if c == '.'
c :=''
endif
IF C == ','
C:= '.'
ENDIF
s := s + c
EndIf
Next x
If HB_ULEFT ( ALLTRIM(Text) , 1 ) == '(' .OR. HB_URIGHT ( ALLTRIM(Text) , 2 ) == 'DB'
s := '-' + s
EndIf
s := Transform ( Val(s) , _HMG_SYSDATA [ 9 ] [i] )
Return Val(s)
Regards,
Richard
Harbour 3.2.0dev (r1904111533)/xHarbour 1.2.3 Intl. (SimpLex) (Build 20180818) => Borland C++ v7.4
xHarbour 0.99.71 (SimpLex) => Borland C++ v5.5
MySQL v5.7 /ADS v12
Harbour 3.2.0dev (r1603181642) => Borland C++ v7.4 64bit
Richard
Harbour 3.2.0dev (r1904111533)/xHarbour 1.2.3 Intl. (SimpLex) (Build 20180818) => Borland C++ v7.4
xHarbour 0.99.71 (SimpLex) => Borland C++ v5.5
MySQL v5.7 /ADS v12
Harbour 3.2.0dev (r1603181642) => Borland C++ v7.4 64bit