TEdit V TGet

User avatar
David Williams
Posts: 82
Joined: Fri Mar 03, 2006 6:26 pm
Location: Ireland

TEdit V TGet

Post by David Williams »

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 :oops:

TIA
David
horacio
Posts: 1270
Joined: Wed Jun 21, 2006 12:39 am
Location: Capital Federal Argentina

Re: TEdit V TGet

Post by horacio »

User avatar
David Williams
Posts: 82
Joined: Fri Mar 03, 2006 6:26 pm
Location: Ireland

Re: TEdit V TGet

Post by David Williams »

Thank you Mastintin, Horacio & Manuel

I agree "Posible mejora para tGet".

Any thoughts on this, from others in the forum? Otto, Driessen or James? :?
User avatar
James Bott
Posts: 4654
Joined: Fri Nov 18, 2005 4:52 pm
Location: San Diego, California, USA
Contact:

Re: TEdit V TGet

Post by James Bott »

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
User avatar
Antonio Linares
Site Admin
Posts: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Re: TEdit V TGet

Post by Antonio Linares »

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 :-)
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
James Bott
Posts: 4654
Joined: Fri Nov 18, 2005 4:52 pm
Location: San Diego, California, USA
Contact:

Re: TEdit V TGet

Post by James Bott »

Ah, Antonio to the rescue!
User avatar
Antonio Linares
Site Admin
Posts: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Re: TEdit V TGet

Post by Antonio Linares »

;-)
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
richard-service
Posts: 583
Joined: Tue Oct 16, 2007 8:57 am
Location: New Taipei City, Taiwan
Contact:

Re: TEdit V TGet

Post by richard-service »

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 ).
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
User avatar
Antonio Linares
Site Admin
Posts: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Re: TEdit V TGet

Post by Antonio Linares »

Richard,

FWH 14.11 provides unicode support though not finsihed yet.

Please review FWH\samples\unicode.prg
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
richard-service
Posts: 583
Joined: Tue Oct 16, 2007 8:57 am
Location: New Taipei City, Taiwan
Contact:

Re: TEdit V TGet

Post by richard-service »

Antonio Linares wrote:Richard,

FWH 14.11 provides unicode support though not finsihed yet.

Please review FWH\samples\unicode.prg
Yes, I knew it.
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
User avatar
David Williams
Posts: 82
Joined: Fri Mar 03, 2006 6:26 pm
Location: Ireland

Re: TEdit V TGet

Post by David Williams »

Thank you Antonio, now less grief from new clients :)

Thanks also to Horacio and James for your intervention :wink:
User avatar
Antonio Linares
Site Admin
Posts: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Re: TEdit V TGet

Post by Antonio Linares »

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!
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
richard-service
Posts: 583
Joined: Tue Oct 16, 2007 8:57 am
Location: New Taipei City, Taiwan
Contact:

Re: TEdit V TGet

Post by richard-service »

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!
Antonio,

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
User avatar
richard-service
Posts: 583
Joined: Tue Oct 16, 2007 8:57 am
Location: New Taipei City, Taiwan
Contact:

Re: TEdit V TGet

Post by richard-service »

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
User avatar
richard-service
Posts: 583
Joined: Tue Oct 16, 2007 8:57 am
Location: New Taipei City, Taiwan
Contact:

Re: TEdit V TGet

Post by richard-service »

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
Post Reply