Wenn ich deine Wissensbasis nehme, also die hier, die in einem anderen Artikel:
Code: Alles auswählen
#include "Gra.ch"
#include "Xbp.ch"
#include "Common.ch"
#include "Appevent.ch"
#pragma library ("XppUi2")
*------------------------------------------------------------- HB_SLE_UPPER ------
CLASS HB_SLE_UPPER FROM XbpSLE
EXPORTED
METHOD keyboard
ENDCLASS
METHOD HB_SLE_UPPER:keyboard( nKey )
IF nKey > 90 .AND. nKey < 255
nKey := Asc( Upper( Chr( nKey ) ) )
ENDIF
::xbpSLE:keyboard( nKey )
RETURN self
*------------------------------------------------------------- HB_SHOW_RECNO ------
CLASS HB_SHOW_RECNO FROM XbpStatic
PROTECTED
VAR nColorEOF
VAR nColorOK
VAR cMaske
VAR oXbp
EXPORTED
VAR datalink // nur aus Kompatibilitätsgründen.
VAR changed // nur aus Kompatibilitätsgründen.
METHOD init
METHOD create
METHOD SetData
METHOD GetData
METHOD validate
ENDCLASS
*----------------------------------------------------------------
METHOD HB_SHOW_RECNO:init(oParent,oOwner,aPos,aSize,aPresParam,lVisible)
// zuerst einen Rahmen zeichnen
::oXbp := XbpStatic():new(oParent,oOwner,aPos,aSize,aPresParam,lVisible)
::oXbp:clipSiblings := .t.
::oXbp:type := XBPSTATIC_TYPE_RECESSEDBOX
aPos := { aPos[1]+2,aPos[2]+2 }
aSize := { aSize[1]-4,aSize[2]-4 }
::XbpStatic:init(oParent,oOwner,aPos,aSize,aPresParam,lVisible)
return self
*----------------------------------------------------------------
METHOD HB_SHOW_RECNO:create(oParent,oOwner,aPos,aSize,aPresParam,lVisible)
::oXbp:create()
::oXbp:clipSiblings := .f.
::cMaske := "999,999,999,999,999"
::nColorEOF := GRA_CLR_RED
::nColorOK := GRA_CLR_GREEN
::caption := "Test"
::datalink := {|| "" } // dieser wird nicht verwendet, muss aber vom richtigen Typ sein.
::type := XBPSTATIC_TYPE_TEXT
::options := XBPSTATIC_TEXT_RIGHT
::changed := .f. // sonst erfolgt keine Anzeige vor EOF ...
::XbpStatic:create(oParent,oOwner,aPos,aSize,aPresParam,lVisible)
return self
*----------------------------------------------------------------
METHOD HB_SHOW_RECNO:SetData()
local nA
nA := GetParentForm(self):nHA // IM PARENT FENSTER muss der numerische Alias
// in dieser Instanzvariablen gespeichert sein. Sonst anpassen !!!
if nA==NIL
::SetCaption("NO DBF")
::setColorBG(::nColorEOF)
else
do case
case (nA)->(eof())
::SetCaption("EOF")
::setColorBG(::nColorEOF)
case (nA)->(deleted())
::SetCaption("* "+ltrim(transform((nA)->(recno()),::cMaske)))
::setColorBG(::nColorEOF)
otherwise
::SetCaption(ltrim(transform((nA)->(recno()),::cMaske)))
::setColorBG(::nColorOK)
endcase
endif
::changed := .f.
return .t.
*----------------------------------------------------------------
METHOD HB_SHOW_RECNO:GetData()
::changed := .f.
Return ::SetData()
*----------------------------------------------------------------
METHOD HB_SHOW_RECNO:validate()
return .t.
*------------------------------------------------------------- HB_SLE_SingleChar ------
CLASS HB_SLE_SingleChar FROM XbpSLE
EXPORTED
VAR NurDieseZeichen
VAR Erzwingen // kann den Wechsel mit MAUS nicht blockieren !!!
VAR HinweisText // zusätzlich zu automatischem FehlerText !
METHOD keyboard
METHOD SetInputFocus
METHOD INIT
METHOD create
METHOD validate
ENDCLASS
METHOD HB_SLE_SingleChar:init( oParent, oOwner, aPos, aSize, aPP, lVisible )
::XbpSLE:init( oParent, oOwner, aPos, aSize, aPP, lVisible )
::bufferLength := 1
::NurDieseZeichen := ""
::HinweisText:= ""
::Erzwingen := .t. // kann den Wechsel mit MAUS nicht blockieren !!!
RETURN SELF
METHOD HB_SLE_SingleChar:create( oParent, oOwner, aPos, aSize, aPP, lVisible )
// diese Parameter erzwingen
::bufferLength := 1
::XbpSLE:create( oParent, oOwner, aPos, aSize, aPP, lVisible )
RETURN SELF
METHOD HB_SLE_SingleChar:validate()
local lValid
lValid := ::XbpSLE:validate()
* aber wenn NurDieseZeichen, müssen diese den VALID-Zustand überprüfen
if len(::NurDieseZeichen) > 0
lValid := lValid .and. left(::editBuffer()+" ",1) $ upper(::NurDieseZeichen)
endif
RETURN lValid
METHOD HB_SLE_SingleChar:SetInputFocus()
::XbpSLE:SetInputFocus()
::setMarked( {1,::bufferLength+1} ) // um Überschreiben zu simmulieren hier Markierung setzen
RETURN SELF
METHOD HB_SLE_SingleChar:keyboard( nKey )
local cKey, lBlock, cErrTxt
if nKey < 32 .or. nKey > 255 // Steuerzeichen nie blockieren und nicht bearbeiten
if ::Erzwingen .and. nKey = xbeK_TAB .and. ! ::validate() // TAB würde Feld verlassen !
lBlock := .t.
cErrTxt := "Es muß eines der folgenden Zeichen eingegeben werden:"+CRLF+CRLF+::NurDieseZeichen
if ! empty(::HinweisText)
cErrTxt += CRLF+CRLF+::HinweisText
endif
errbox( cErrTxt)
SetAppFocus( self )
else
lBlock := .f.
endif
else
cKey := Chr( nKey ) // für Vergleich ist ein String einfach besser
if nKey > 90 .AND. nKey < 255 // upper Umwandlung
cKey := Upper( cKey )
nKey := Asc( cKey )
endif
if len(::NurDieseZeichen)=0
lBlock := .f.
else
if left(cKey+" ",1) $ upper(::NurDieseZeichen) // leere Eingabefelder nur erlauben, wenn auch Blanks erlaubt sind
lBlock := .f.
else
lBlock := .t.
cErrTxt := "Es ist nur eines der folgenden Zeichen erlaubt:"+CRLF+CRLF+::NurDieseZeichen
if ! empty(::HinweisText)
cErrTxt += CRLF+CRLF+::HinweisText
endif
errbox( cErrTxt)
SetAppFocus( self )
endif
endif
endif
if ! lBlock
::xbpSLE:keyboard( nKey )
if ::autoTab .and. nKey # 9
::xbpSLE:keyboard( 9 )
endif
endif
RETURN self
*------------------------------------------------------------- HB_SLE_FilterSLE ------
CLASS HB_SLE_FilterSLE FROM XbpSLE
EXPORTED
VAR NurDieseZeichen
VAR NichtLeer
VAR AutoMark // Überschreibenmarkierung bei SetInputFocus automatisch setzten ?
METHOD keyboard
METHOD INIT
METHOD validate
METHOD SetInputFocus
ENDCLASS
METHOD HB_SLE_FilterSLE:init( oParent, oOwner, aPos, aSize, aPP, lVisible )
::XbpSLE:init( oParent, oOwner, aPos, aSize, aPP, lVisible )
::bufferLength := 10 // nur als Vorgabe, kann geändert werden.
::NurDieseZeichen := ""
::NichtLeer := .f.
::AutoMark := .f.
RETURN SELF
METHOD HB_SLE_FilterSLE:validate()
local lValid, x, xMaxX
lValid := ::XbpSLE:validate()
xMaxX :=len(::editBuffer())
do case
case ::NichtLeer .and. xMaxX=0
lValid := .f.
case len(::NurDieseZeichen) > 0
for x := 1 to xMaxX
if ! substr(::editBuffer(),x,1) $ upper(::NurDieseZeichen)
lValid := .f.
endif
next
endcase
RETURN lValid
METHOD HB_SLE_FilterSLE:keyboard( nKey )
local cKey, lBlock
if nKey < 32 .or. nKey > 255 // Steuerzeichen nie blockieren und nicht bearbeiten
lBlock := .f.
else
cKey := Chr( nKey ) // für Vergleich ist ein String einfach besser
if nKey > 90 .AND. nKey < 255 // upper Umwandlung
cKey := Upper( cKey )
nKey := Asc( cKey )
endif
if len(::NurDieseZeichen)=0
lBlock := .f.
else
if left(cKey+" ",1) $ upper(::NurDieseZeichen) // leere Eingabefelder nur erlauben, wenn auch Blanks erlaubt sind
lBlock := .f.
else
lBlock := .t.
endif
endif
endif
if ! lBlock
::xbpSLE:keyboard( nKey )
endif
RETURN self
METHOD HB_SLE_FilterSLE:SetInputFocus()
::XbpSLE:SetInputFocus()
if ::AutoMark
::setMarked( {1,::bufferLength+10} ) // um Überschreiben zu simmulieren hier Markierung setzen
endif
RETURN SELF
*------------------------------------------------------------- HB_SLE_BLZ ------
CLASS HB_SLE_BLZ FROM HB_SLE_FilterSLE
EXPORTED
METHOD INIT
METHOD create
METHOD KillInputFocus
ENDCLASS
METHOD HB_SLE_BLZ:create( oParent, oOwner, aPos, aSize, aPP, lVisible )
// diese Parameter erzwingen
::bufferLength := 8
::NurDieseZeichen := "1234567890"
::HB_SLE_FilterSLE:create( oParent, oOwner, aPos, aSize, aPP, lVisible )
RETURN SELF
METHOD HB_SLE_BLZ:init( oParent, oOwner, aPos, aSize, aPP, lVisible )
::HB_SLE_FilterSLE:init( oParent, oOwner, aPos, aSize, aPP, lVisible )
::bufferLength := 8
::NurDieseZeichen := "1234567890"
::NichtLeer := .f. // ein BLZ Feld muß nicht unbedingt ausgefüllt werden,
// aber wenn es ausgefüllt ist, muß es 8 Stellen lang sein !
RETURN SELF
METHOD HB_SLE_BLZ:KillInputFocus()
if len(::editbuffer()) > 0 .and. len(::editbuffer()) # 8
errbox("Eine Bankleitzahl besteht immer aus 8 Ziffern ! ")
setAppFocus(self)
endif
RETURN SELF
*-------------------------------------------------------------- HB_SLE_DATE ------
CLASS HB_SLE_DATE FROM XbpSLE
EXPORTED
VAR cDateChar
VAR nDateCharPos1
VAR nDateCharPos2
VAR nLenMaxEinPos1
VAR nLenMaxEinPos2
VAR nLenMaxEinPos3
METHOD keyboard
METHOD INIT
METHOD create
METHOD KillInputFocus
METHOD getValue
METHOD setValue
METHOD SetData // bei internem Setzen immer .t. als 2. Parameter übergeben.
ENDCLASS
METHOD HB_SLE_DATE:keyboard( nKey )
local cEditBuffer, cKey, lBlock, nAnzPunkte, nPosPunkt1, nPosPunkt2, aMark
local nLenEinPos1, nLenEinPos2, nLenEinPos3 // Länge der Eingabepositionen
local nMarkVon,nMarkBis, nCursorPos
cEditBuffer := ::EditBuffer()
cKey := chr(nKey)
nAnzPunkte := CharCount(cEditBuffer,::cDateChar)
do case
case nKey < 32 .or. nKey > 255 // Steuerzeichen nicht blockieren
lBlock := .f.
case cKey $ "0123456789"+::cDateChar // andere Tasten blockieren
lBlock := .f.
if ::queryMarked()[1] # ::queryMarked()[2] // Markierung vorhanden, erst Inhalt löschen
nMarkVon := min(::queryMarked()[1], ::queryMarked()[2])
nMarkBis := max(::queryMarked()[1], ::queryMarked()[2])
cEditBuffer := stuff( cEditBuffer, nMarkVon, nMarkBis-nMarkVon, "" )
::setdata(cEditBuffer,.t.) // ::changed setzen
::setMarked({nMarkVon,nMarkVon})
endif
nPosPunkt1 := at(::cDateChar,cEditBuffer,1)
nPosPunkt2 := max(nPosPunkt1,at(::cDateChar,cEditBuffer,nPosPunkt1+1))
aMark := ::queryMarked()
nLenEinPos1 := max(0,nPosPunkt1-1)
nLenEinPos2 := max(0,nPosPunkt2-nPosPunkt1-1)
nLenEinPos3 := max(0,len(cEditBuffer)-nPosPunkt2)
do case
case cKey = ::cDateChar
do case
case empty(cEditBuffer) .or. strTran(cEditBuffer," ","")="."
lBlock := .t.
case ( len(cEditBuffer)=::nDateCharPos1-1 .or. ;
len(cEditBuffer)=::nDateCharPos2-1 ) .and. ;
nAnzPunkte < 2
// Cursor steht vor nächstem Punkt,
// Punkt wo er hingehört, nichts machen
case len(cEditBuffer) < ::nLenMaxEinPos1 .and. ;
::nLenMaxEinPos1== 4 // JAHRESZAHL in erster Position !
// das kommt nur in der Einstellung mit ANSI Datum vor !
// 4 stelliges Jahr ermitteln (berücksichtigt EPOCH) ...
cEditBuffer := dtos(ctod(alltrim(cEditBuffer)+;
::cDateChar+"01"+::cDateChar+"01"))
cEditBuffer := left(cEditBuffer,4)
::setData(cEditBuffer+::cDateChar,.t.) // ::changed setzen
::setMarked({::nDateCharPos1+1,::nDateCharPos1+1})
lBlock := .t.
case len(cEditBuffer)=::nDateCharPos1-2 .and. nAnzPunkte < 2
::setData("0"+cEditBuffer+::cDateChar,.t.) // ::changed setzen
::setMarked({::nDateCharPos1+1,::nDateCharPos1+1})
lBlock := .t.
case len(cEditBuffer)=::nDateCharPos2-2 .and. nAnzPunkte < 2
::setData(left(cEditBuffer,::nDateCharPos1)+"0"+;
right(cEditBuffer,1)+::cDateChar,.t.) // ::changed setzen
::setMarked({::nDateCharPos2+1,::nDateCharPos2+1})
lBlock := .t.
case nAnzPunkte < 2
* Es fehlen Punkte, also Eingabe zulassen.
* Aber auch falsche Position verbessern.
nCursorPos := ::queryMarked()[2]
do case
case nCursorPos = ::nDateCharPos1-1
::setData("0"+cEditBuffer,.t.) // ::changed setzen
::setMarked({::nDateCharPos1,::nDateCharPos1})
case nCursorPos = ::nDateCharPos2-1
::setData(left(cEditBuffer,::nDateCharPos1)+"0"+;
substr(cEditBuffer,::nDateCharPos1+1),.t.) // ::changed setzen
::setMarked({::nDateCharPos2,::nDateCharPos2})
endcase
otherwise
* Es fehlen keine Punkte, also Punkte auf jeden Fall blockieren
lBlock := .t.
* Aber auch (falsche) Position verbessern.
* die alte Cursor Positon muss vor den Manipulationen gespeichert werden.
nCursorPos := ::queryMarked()[2]
// Wenn Datum gültig ist, einfach das gültige setzen,
// wenn nicht, nichts machen ... eventuell einen Fehlerton ...
if empty(ctod(cEditBuffer))
// nichts machen wäre am Besten !!!
else
cEditBuffer := dtoc(ctod(cEditBuffer))
::setData(cEditBuffer,.t.) // ::changed setzen
// Cursor setzen, je nach Position
do case
case nCursorPos <= ::nDateCharPos1
// VOR dem 1. Punkt steht, dann dahinter
::setMarked({::nDateCharPos1+1,::nDateCharPos1+1})
case nCursorPos <= ::nDateCharPos2
// VOR dem 2. Punkt steht, dann dahinter
::setMarked({::nDateCharPos2+1,::nDateCharPos2+1})
otherwise
// sonst ganz nach hinten.
::setMarked({::bufferLength+1,::bufferLength+1})
endcase
endif
endcase
otherwise // jetzt Zahlen verarbeiten
do case
case len(cEditBuffer)=::nDateCharPos1-1 .and. nAnzPunkte < 1 .or. ;
len(cEditBuffer)=::nDateCharPos2-1 .and. nAnzPunkte < 2
// der Anwender gibt gerade die Ziffern ein ohne
// einen Punkt, also wird der Punkt automatisch gesetzt.
::setData(cEditBuffer+::cDateChar,.t.) // ::changed setzen
::setMarked({len(cEditBuffer)+2,len(cEditBuffer)+2})
case aMark[1] == aMark[2]
// wenn diese beiden Werte gleich sind, steht der Cursor
// genau dort (Cursor vor nächstem Zeichen)
// Das gewünschte Verhalten unterscheidet nun je nach
// Lage des Punktes und der Cursorposition
if empty(nPosPunkt1) .or. empty(nPosPunkt2)
// das kann nur nach manueller Löschung vorkommen
// dann soll der Anwender das auch wieder manuell
// verbessern. Killinputfocus() versucht nachzubessern.
else
do case // in welchem Eingabebereich steht der Cursor ?
case aMark[2] <= nPosPunkt1 // vor 1. Punkt
do case // wie ist die Situation
case nLenEinPos1 < ::nLenMaxEinPos1
// vor 1. Punkt ist noch Platz, einfügen
::setMarked({aMark[2],aMark[2]})
case aMark[2] < nPosPunkt1
// 1. Punkt ist schon am Platz
// Steht Cursor vor Ziffer, dann ersetzen
::setMarked({aMark[2],aMark[2]+1})
case aMark[2] == nPosPunkt1
// 1. Punkt ist schon am Platz
// Cursor vor dem Punkt, diesen retten,
// aber Achtung, ist im 2. Bereich noch Platz ?
if nLenEinPos2 < ::nLenMaxEinPos2
// dort ist noch Platz, einfügen
::setMarked({nPosPunkt1+1,nPosPunkt1+1})
else
// 2. Punkt ist auch am Platz, überschreiben
::setMarked({nPosPunkt1+1,nPosPunkt1+2})
endif
otherwise
lBlock := .t.
endcase
case aMark[2] <= nPosPunkt2 // vor 2. Punkt
do case // wie ist die Situation
case nLenEinPos2 < ::nLenMaxEinPos2
// vor 2. Punkt ist noch Platz, einfügen
::setMarked({aMark[2],aMark[2]})
case aMark[2] < nPosPunkt2
// 2. Punkt ist schon am Platz
// Steht Cursor vor Ziffer, dann ersetzen
::setMarked({aMark[2],aMark[2]+1})
case aMark[2] == nPosPunkt2
// 2. Punkt ist schon am Platz
// Cursor vor dem Punkt, diesen retten,
// aber Achtung, ist danach noch Platz ?
if nLenEinPos3 < ::nLenMaxEinPos3
// dort ist noch Platz, einfügen
::setMarked({nPosPunkt2+1,nPosPunkt2+1})
else
// kein Platz, überschreiben
::setMarked({nPosPunkt2+1,nPosPunkt2+2})
endif
otherwise
lBlock := .t.
endcase
otherwise // nach 2. Punkt
// hier müssen wir nur noch prüfen ob genug
// Platz zum Einfügen ist ...
if nLenEinPos3 < ::nLenMaxEinPos3
// dort ist noch Platz, einfügen
::setMarked({aMark[2],aMark[2]})
else
// kein Platz, überschreiben
::setMarked({aMark[2],aMark[2]+1})
endif
endcase
endif
endcase
* nun die Zahl, nichts blockieren !
endcase
otherwise
lBlock := .t.
endcase
if ! lBlock
::xbpSLE:keyboard( nKey )
endif
RETURN self
METHOD HB_SLE_DATE:create( oParent, oOwner, aPos, aSize, aPP, lVisible )
local cDate := dtoc(ctod("")) // leerer Datumsstring
// diese Parameter erzwingen
::bufferLength := len(cDate)
::cDateChar := left(strTran(cDate," ","")+".",1) // ermitteln ist sicherer !
::nDateCharPos1 := at(::cDateChar,cDate)
::nDateCharPos2 := rat(::cDateChar,cDate)
::nLenMaxEinPos1 := max(0,::nDateCharPos1-1)
::nLenMaxEinPos2 := max(0,::nDateCharPos2-::nDateCharPos1-1)
::nLenMaxEinPos3 := max(0,::bufferLength-::nDateCharPos2)
::XbpSLE:create( oParent, oOwner, aPos, aSize, aPP, lVisible )
RETURN SELF
METHOD HB_SLE_DATE:init( oParent, oOwner, aPos, aSize, aPP, lVisible )
::XbpSLE:init( oParent, oOwner, aPos, aSize, aPP, lVisible )
::bufferLength := 10
RETURN SELF
METHOD HB_SLE_DATE:KillInputFocus()
local dDatum, cDatum, cFormat
cDatum := alltrim(::editbuffer())
cFormat := upper(SET(_SET_DATEFORMAT )) // yyyy/mm/dd
cFormat := strTran(cFormat,"Y","J")
cFormat := strTran(cFormat,"D","T")
if CharCount(cDatum,::cDateChar) < 2 // vielleicht fehlen nur die Punkte
cDatum := StrTran(cDatum,::cDateChar,"") // zuerst alle entfernen, falls nur einer fehlt.
cDatum := left( cDatum,::nDateCharPos1-1)+::cDateChar+;
substr(cDatum,::nDateCharPos1,2)+::cDateChar+;
substr(cDatum,::nDateCharPos2,4)
endif
dDatum := ctod(cDatum) // Datum formatieren und auf Gültigkeit Prüfen
if empty(dDatum) // Datum war ungültig
if ! empty(::editbuffer()) // es wurde etwas eingegeben
errbox("Das Datum ist ungültig und wird gelöscht ! "+CRLF+;
"Datumsformat: "+cFormat)
setAppFocus(self)
endif
::setData( "" ,.t.) // ::changed setzen
else
// Gültiges Datum sauber formatieren.
::setData( dtoc( dDatum ) ,.t.) // ::changed setzen
endif
RETURN SELF
METHOD HB_SLE_DATE:getValue()
RETURN ctod(::getData())
METHOD HB_SLE_DATE:setValue(dDatum)
if ! empty(dDatum)
::XbpSLE:setData( dtoc( dDatum ) )
else
::XbpSLE:setData( "" )
endif
RETURN SELF
METHOD HB_SLE_DATE:setData(xVal,SetChanged)
DEFAULT SetChanged TO .f.
// Zuerst datalink prüfen
if IsNil(xVal)
// hier würde XbpSLE den datalink codeblock ausführen falls es einen gibt ...
if IsNil(::datalink)
// es gibt keinen, also SLE einfach löschen
xVal := ""
else
// Rückgabewert ermitteln, aber ACHTUNG, KEINE PARAMETER SETZEN !
xVal := eval(::datalink)
endif
endif
do case
case SetChanged // interner Aufruf, Parameter ist TEXT
::XbpSLE:setData(xVal)
::changed := .t.
case ValType(xVal) == "D" // direkter Datumstyp
::setValue(xVal)
case ! empty(ctod(xVal)) // Datum als TT.MM.JJJJ
::setValue(ctod(xVal))
case ! empty(stod(xVal)) // Datum als JJJJMMTT
::setValue(stod(xVal))
otherwise
::XbpSLE:setData(xVal) // bei falschen Datentyp auch einen Error akzeptieren.
endcase
RETURN SELF
*-------------------------------------------------------------- HB_SLE_MonatJahr ------
CLASS HB_SLE_MonatJahr FROM XbpSLE
EXPORTED
VAR cDateChar
VAR nDateCharPos1
VAR nDateCharPos2
VAR cMonthYearPos // "MJ" - Monat.Jahr; "JM" - Jahr.Monat
VAR nLenMaxEinPos1
VAR nLenMaxEinPos2
METHOD keyboard
METHOD INIT
METHOD create
METHOD KillInputFocus
METHOD getValue
METHOD setValue
METHOD getMonat
METHOD getJahr
METHOD SetData // bei internem Setzen immer .t. als 2. Parameter übergeben.
PROTECTED
METHOD GetDate
ENDCLASS
METHOD HB_SLE_MonatJahr:keyboard( nKey )
local cEditBuffer, cKey, lBlock, nAnzPunkte, nPosPunkt1, aMark,cMon
local nMarkVon,nMarkBis, nCursorPos
cEditBuffer := ::EditBuffer()
cKey := chr(nKey)
nAnzPunkte := CharCount(cEditBuffer,::cDateChar)
do case
case nKey < 32 .or. nKey > 255 // Steuerzeichen nicht blockieren
lBlock := .f.
case cKey $ "0123456789"+::cDateChar // andere Tasten blockieren
lBlock := .f.
if ::queryMarked()[1] # ::queryMarked()[2] // Markierung vorhanden, erst Inhalt löschen
nMarkVon := min(::queryMarked()[1], ::queryMarked()[2])
nMarkBis := max(::queryMarked()[1], ::queryMarked()[2])
cEditBuffer := stuff( cEditBuffer, nMarkVon, nMarkBis-nMarkVon, "" )
::setdata(cEditBuffer,.t.) // ::changed setzen
::setMarked({nMarkVon,nMarkVon})
endif
nPosPunkt1 := at(::cDateChar,cEditBuffer,1)
aMark := ::queryMarked()
do case
case cKey = ::cDateChar
do case
case empty(cEditBuffer) .or. strTran(cEditBuffer," ","")="."
lBlock := .t.
case len(cEditBuffer)=::nDateCharPos1-1 .and. nAnzPunkte < 1
* Punkt wo er hingehört, nichts machen
case len(cEditBuffer) < ::nLenMaxEinPos1 .and. ;
::nLenMaxEinPos1== 4 // JAHRESZAHL in erster Position !
// das kommt nur in der Einstellung mit ANSI Datum vor !
// 4 stelliges Jahr ermitteln (berücksichtigt EPOCH) ...
// hierbei spielt es keine Rolle ob MM/TT oder TT/MM
// da ja beide als 01 definiert werden.
if nPosPunkt1>0 // es gibt einen Punkt ...
cMon := alltrim(substr(cEditBuffer,nPosPunkt1+1))
else
cMon := ""
endif
cEditBuffer := dtos(ctod(alltrim(cEditBuffer)+;
::cDateChar+"01"+::cDateChar+"01"))
cEditBuffer := left(cEditBuffer,4)
::setData(cEditBuffer+::cDateChar+cMon,.t.) // ::changed setzen
::setMarked({::nDateCharPos1+1,::nDateCharPos1+1})
lBlock := .t.
case len(cEditBuffer)=::nDateCharPos1-2 .and. nAnzPunkte < 1
::setData("0"+cEditBuffer+::cDateChar,.t.) // ::changed setzen
::setMarked({::nDateCharPos1+1,::nDateCharPos1+1})
lBlock := .t.
case nAnzPunkte < 1
* Es fehlen Punkte, also Eingabe zulassen.
* Aber auch falsche Position verbessern.
nCursorPos := ::queryMarked()[2]
do case
case nCursorPos = ::nDateCharPos1-1
::setData("0"+cEditBuffer,.t.) // ::changed setzen
::setMarked({::nDateCharPos1,::nDateCharPos1})
endcase
otherwise
* Es fehlen keine Punkte, also Punkte auf jeden Fall blockieren
lBlock := .t.
* Aber auch (falsche) Position verbessern.
* die alte Cursor Positon muss vor den Manipulationen gespeichert werden.
nCursorPos := ::queryMarked()[2]
// Bei der Umwandlung muss aber DTOS() genutzt werden,
// sonst könnte MM und TT vertauscht sein.
cEditBuffer := ::GetDate("S")
if ::cMonthYearPos == "MJ"
cEditBuffer := substr(cEditBuffer,5,2)+::cDateChar+;
left(cEditBuffer,4)
else
cEditBuffer := left(cEditBuffer,4)+::cDateChar+;
substr(cEditBuffer,5,2)
endif
::setData(cEditBuffer,.t.) // ::changed setzen
// Cursor setzen, je nach Position
do case
case nCursorPos <= ::nDateCharPos1
// VOR dem 1. Punkt steht, dann dahinter
::setMarked({::nDateCharPos1+1,::nDateCharPos1+1})
otherwise
// sonst ganz nach hinten.
::setMarked({::bufferLength+1,::bufferLength+1})
endcase
endcase
otherwise // jetzt Zahlen verarbeiten
do case
case len(cEditBuffer)=::nDateCharPos1-1 .and. nAnzPunkte < 1
// der Anwender gibt gerade die Ziffern ein ohne
// einen Punkt, also wird der Punkt automatisch gesetzt.
::setData(cEditBuffer+::cDateChar,.t.) // ::changed setzen
::setMarked({len(cEditBuffer)+2,len(cEditBuffer)+2})
case aMark[1] == aMark[2]
// wenn diese beiden Werte gleich sind, steht der Cursor
// genau dort (Cursor vor nächstem Zeichen)
// Das gewünschte Verhalten unterscheidet nun je nach
// Lage des Punktes und der Cursorposition
do case
case empty(nPosPunkt1)
// das kann nur nach manueller Löschung vorkommen
// dann soll der Anwender das auch wieder manuell
// verbessern. Killinputfocus() versucht nachzubessern.
case (nPosPunkt1<::nDateCharPos1 .and. aMark[2]<=nPosPunkt1)
// der jeweilige Punkt existiert, aber er ist vor der
// richtigen Position UND der Cursor liegt davor
// davor bleiben und nichts markieren -> einfügen
::setMarked({aMark[2],aMark[2]})
case (nPosPunkt1==::nDateCharPos1 .and. aMark[2] == nPosPunkt1)
// der jeweilige Punkt existiert und er ist an der
// richtigen Position UND der Cursor liegt genau
// davor. Wir müssen den Punkt schützen !
// die Punkte stehen richtig, also dahinter springen
::setMarked({aMark[2]+1,aMark[2]+2})
otherwise
::setMarked({aMark[2],aMark[2]+1})
endcase
endcase
* nun die Zahl, nichts blockieren !
endcase
otherwise
lBlock := .t.
endcase
if ! lBlock
::xbpSLE:keyboard( nKey )
endif
RETURN self
*----------------------------------------------------------------------
METHOD HB_SLE_MonatJahr:GetDate(cArt) // EditBuffer() in Datum nach Einstellung wandeln.
local xDate, cMon, cJahr, cEditBuffer, x
DEFAULT cArt TO "D" // "D" = als Datum, "C" = dtoC(), "S" = dtoS()
cEditBuffer := ::EditBuffer()
x := at(::cDateChar,cEditBuffer)
if x == 0
if cArt="D"
xDate := ctod("")
else
xDate := ""
endif
else
if ::cMonthYearPos == "MJ"
cMon := left(cEditBuffer,x-1)
cJahr := Substr(cEditBuffer,x+1,4)
else
cJahr := left(cEditBuffer,x-1)
cMon := Substr(cEditBuffer,x+1,2)
endif
// ein Monat wird immer auch ein gültiger Tag sein :-)
if ::cMonthYearPos == "MJ"
xDate := cMon+::cDateChar+cMon+::cDateChar+cJahr
else
xDate := cJahr+::cDateChar+cMon+::cDateChar+cMon
endif
// bei dtos() ist immer JJJJ MM -> Tag auf 01 setzen
xDate := stod(left(dtos(ctod(xDate)),6)+"01")
do case
case empty(xDate) .and. ! cArt="D"
xDate := ""
case cArt="C"
xDate := dtoc(xDate)
case cArt="S"
xDate := dtos(xDate)
endcase
endif
return xDate
*----------------------------------------------------------------------
METHOD HB_SLE_MonatJahr:create( oParent, oOwner, aPos, aSize, aPP, lVisible )
local cDate := dtoc(ctod("")) // leerer Datumsstring
// diese Parameter erzwingen
::bufferLength := len(cDate)-3
::cDateChar := left(strTran(cDate," ","")+".",1)
::nDateCharPos1 := at(::cDateChar,cDate)
::nDateCharPos2 := rat(::cDateChar,cDate)
::nLenMaxEinPos1 := max(0,::nDateCharPos1-1)
::nLenMaxEinPos2 := max(0,::bufferLength-::nDateCharPos1)
::XbpSLE:create( oParent, oOwner, aPos, aSize, aPP, lVisible )
RETURN SELF
*----------------------------------------------------------------------
METHOD HB_SLE_MonatJahr:init( oParent, oOwner, aPos, aSize, aPP, lVisible )
::XbpSLE:init( oParent, oOwner, aPos, aSize, aPP, lVisible )
::bufferLength := 7
if left(upper(SET(_SET_DATEFORMAT )),1) = "Y"
::cMonthYearPos := "JM" // "MJ" - Monat.Jahr; "JM" - Jahr.Monat
else
::cMonthYearPos := "MJ"
endif
RETURN SELF
*----------------------------------------------------------------------
METHOD HB_SLE_MonatJahr:KillInputFocus()
local dDatum, cDatum, cFormat,nLenJahr, cJahr
cFormat := upper(SET(_SET_DATEFORMAT )) // yyyy/mm/dd
cFormat := strTran(cFormat,"Y","J")
cFormat := strTran(cFormat,"D","T")
if SET(_SET_CENTURY) // 4 stelliges Jahrhundert
cFormat := "JJJJ"
nLenJahr := 4
else
cFormat := "JJ"
nLenJahr := 2
endif
dDatum := ::GetDate("D")
cDatum := dtos(dDatum)
if nLenJahr==4
cJahr := left(cDatum,4)
else
cJahr := substr(cDatum,3,2)
endif
if ::cMonthYearPos == "MJ"
cDatum := substr(cDatum,5,2)+::cDateChar+cJahr
cFormat := "MM"+::cDateChar+cFormat
else
cDatum := cJahr+::cDateChar+substr(cDatum,5,2)
cFormat := cFormat+::cDateChar+"MM"
endif
if empty(dDatum) // Datum war ungültig
if ! empty(::editbuffer()) // es wurde etwas eingegeben
errbox("Das Datum ist ungültig und wird gelöscht ! "+CRLF+;
"Datumsformat: "+cFormat)
setAppFocus(self)
endif
::setData( "" ,.t.) // ::changed setzen
else
if ::cMonthYearPos == "MJ"
::setData( cDatum ,.t.) // ::changed setzen
else
::setData( cDatum ,.t.) // ::changed setzen
endif
endif
RETURN SELF
METHOD HB_SLE_MonatJahr:getMonat(cAlsCoderN) // Rückgabewert kann C oder N sein.
local uReturn
default cAlsCoderN to "N"
cAlsCoderN := upper(left(alltrim(cAlsCoderN),1))
do case
case cAlsCoderN = "N"
uReturn := month(::GetDate("D"))
case cAlsCoderN = "C"
uReturn := ntrim(month(::GetDate("D")))
endcase
RETURN uReturn
METHOD HB_SLE_MonatJahr:getJahr(cAlsCoderN) // Rückgabewert kann C oder N sein.
local uReturn
default cAlsCoderN to "N"
cAlsCoderN := upper(left(alltrim(cAlsCoderN),1))
do case
case cAlsCoderN = "N"
uReturn := year(::GetDate("D"))
case cAlsCoderN = "C"
uReturn := ntrim(year(::GetDate("D")))
endcase
RETURN uReturn
METHOD HB_SLE_MonatJahr:getValue()
RETURN ::getData()
METHOD HB_SLE_MonatJahr:setValue(dDatum)
local cMon,cJahr,nLenJahr
if ! empty(dDatum)
if SET(_SET_CENTURY) // 4 stelliges Jahrhundert
nLenJahr := 4
else
nLenJahr := 2
endif
cMon := StrZero(month(dDatum),2)
cJahr := StrZero(year(dDatum),nLenJahr)
if ::cMonthYearPos == "MJ"
::setData( cMon + ::cDateChar + cJahr ,.t.) // ::changed setzen
else
::setData( cJahr + ::cDateChar + cMon ,.t.) // ::changed setzen
endif
else
::XbpSLE:setData( "" )
endif
RETURN SELF
METHOD HB_SLE_MonatJahr:setData(xVal,SetChanged)
DEFAULT SetChanged TO .f.
// Zuerst datalink prüfen
if IsNil(xVal)
// hier würde XbpSLE den datalink codeblock ausführen falls es einen gibt ...
if IsNil(::datalink)
// es gibt keinen, also SLE einfach löschen
xVal := ""
else
// Rückgabewert ermitteln, aber ACHTUNG, KEINE PARAMETER SETZEN !
xVal := eval(::datalink)
endif
endif
do case
case SetChanged // interner Aufruf, Parameter ist TEXT
::XbpSLE:setData(xVal)
::changed := .t.
case ValType(xVal) == "D" // direkter Datumstyp
::setValue(xVal)
case ! empty(ctod(xVal)) // Datum als TT.MM.JJJJ
::setValue(ctod(xVal))
case ! empty(stod(xVal)) // Datum als JJJJMMTT
::setValue(stod(xVal))
otherwise
::XbpSLE:setData(xVal) // bei falschen Datentyp auch einen Error akzeptieren.
endcase
RETURN SELF
*-------------------------------------------------------------- HB_SLE_Zahl ------
CLASS HB_SLE_Zahl FROM XbpSLE
EXPORTED
VAR MASKE // Maske wie für Transform(n, !!! )
VAR NurPositiv // Komma wird unterdrückt
VAR NurGanzzahl // Minuszeichen wird unterdrückt
VAR AutoMark // Überschreibenmarkierung bei SetInputFocus automatisch setzten ?
METHOD keyboard
METHOD INIT
METHOD KillInputFocus
METHOD SetInputFocus
METHOD getValue // numerischen Wert abfragen
METHOD setValue // numerischen Wert setzen
METHOD SetData // bei internem Setzen immer .t. als 2. Parameter übergeben.
ENDCLASS
METHOD HB_SLE_Zahl:keyboard( nKey )
local cEditBuffer, cKey, cErlaubteKeys, nZahl, cZahl, nCursorPos, lBlock, nMarkVon, nMarkBis, x
local nMaxAnzDezVal, IsNochPlatzFuerDezimalstellen, IsCursorMarkieren := .f.
cErlaubteKeys := "0123456789"
if ! ::NurPositiv
cErlaubteKeys += "-"
endif
if ! ::NurGanzzahl
cErlaubteKeys += ","
x := at(".",::MASKE)
if x > 0
nMaxAnzDezVal := len(::MASKE) - x // x = Dezimalpunkt + Vorkommastellen
else // MASKE verbietet Nachkommastellen, also merken
::NurGanzzahl := .t.
nMaxAnzDezVal := 0
endif
else
// Einstellungen verbessern
x := at(".",::MASKE)
if x > 0 // keine Nachkommastellen bei ::NurGanzzahl
::MASKE := left(::MASKE,x-1)
endif
nMaxAnzDezVal := 0
endif
cEditBuffer := ::EditBuffer()
cKey := chr(nKey)
do case
case nKey < 32 .or. nKey > 255 // Steuerzeichen nicht blockieren
lBlock := .f.
case cKey $ cErlaubteKeys // andere Tasten blockieren
if ::queryMarked()[1] # ::queryMarked()[2] // Markierung vorhanden, erst Inhalt löschen
nMarkVon := min(::queryMarked()[1], ::queryMarked()[2])
nMarkBis := max(::queryMarked()[1], ::queryMarked()[2])
cEditBuffer := stuff( cEditBuffer, nMarkVon, nMarkBis-nMarkVon, "" )
::setdata(cEditBuffer,.t.) // ::changed setzen
::setMarked({nMarkVon,nMarkVon})
endif
lBlock := .f.
do case
case cKey = "-"
if empty(cEditBuffer)
* OK, Vorzeichen zulassen
else
lBlock := .t.
endif
case cKey = ","
nCursorPos := ::queryMarked()[2]
do case
case empty(cEditBuffer) // noch nicht, dann führende 0 einfügen
::setData("0,",.t.) // ::changed setzen
::setMarked({3,3})
lBlock := .t.
case "," $ cEditBuffer .and. nCursorPos > rat(",",cEditBuffer)
lBlock := .t.
case "," $ cEditBuffer
cEditBuffer := left(cEditBuffer,nCursorPos-1)
cEditBuffer := StrTran(cEditBuffer,".","")
cEditBuffer := alltrim(Transform(val(cEditBuffer),"999,999,999,999,999"))
::setData(cEditBuffer,.t.) // Formatierung erzwingen
::setMarked({len(cEditBuffer)+1,len(cEditBuffer)+1})
endcase
otherwise // jetzt Zahlen verarbeiten
* jetzt noch auf möglichen numerischen Überlauf prüfen.
if ! empty(::maske) // Überlauf möglich !
nCursorPos := ::queryMarked()[2]
cZahl := left(cEditBuffer,nCursorPos-1)+cKey+substr(cEditBuffer,nCursorPos)
cZahl := strtran(cZahl,".","") // Tausendertrenner entfernen
cZahl := strtran(cZahl,",",".") // Dezimal Komma nach Dezimal Punkt
nZahl := VAL(cZahl)
cZahl := transform(nZahl,::maske)
if "*" $ cZahl // es würde einen Überlauf geben,
IsCursorMarkieren := .t.
if ! IsCursorMarkieren
msgbox("Die Anzahl der erlaubten Stellen vor dem Komma,"+CRLF+;
"wurde überschritten !")
lBlock := .t. // also Taste blockieren
endif
else
x := at(",",cEditBuffer)
if x == 0 .or. len(substr(cEditBuffer,x+1)) < nMaxAnzDezVal
// kein Komma oder zu wenige Dezimalstellen eingegeben.
IsNochPlatzFuerDezimalstellen := .t.
IsCursorMarkieren := .f.
else
IsNochPlatzFuerDezimalstellen := .f.
// Nur solange etwas zum Überschreiben bleibt,
// darf dies genutzt werden.
IsCursorMarkieren := nCursorPos <= len(cEditBuffer) .and.;
nCursorPos > rat(",",cEditBuffer)
endif
endif
else // bei leerer Maske entscheidet dieser Eintrag:
IsNochPlatzFuerDezimalstellen := ! ::NurGanzzahl
endif
do case
case lBlock
* geblockt nichts eingeben
case empty(::maske)
* alles erlaubt
case nCursorPos<=2 .and. left(cEditBuffer,1)=="0"
// führende Nullen durch Markierung überschreiben
::setMarked({1,2})
case IsCursorMarkieren
* wir blockieren nicht, sondern markieren die nächste Ziffer
* damit diese überschrieben wird.
if substr(cEditBuffer,nCursorPos,1) $ ".,"
::setMarked({nCursorPos+1,nCursorPos+2})
else
::setMarked({nCursorPos,nCursorPos+1})
endif
case nMaxAnzDezVal > 0 .and. "," $ cEditBuffer .and.;
nCursorPos > rat(",",cEditBuffer) .and. ;
! IsNochPlatzFuerDezimalstellen
lBlock := .t. // also Taste blockieren
endcase
endcase
otherwise
lBlock := .t.
endcase
if ! lBlock
::xbpSLE:keyboard( nKey )
endif
RETURN self
METHOD HB_SLE_Zahl:init( oParent, oOwner, aPos, aSize, aPP, lVisible )
::XbpSLE:init( oParent, oOwner, aPos, aSize, aPP, lVisible )
::bufferLength := 10
::Maske := ""
::align := XBPSLE_RIGHT
::NurPositiv := .f.
::NurGanzzahl := .f.
::AutoMark := .f.
RETURN SELF
METHOD HB_SLE_Zahl:SetInputFocus()
::XbpSLE:SetInputFocus()
if ::AutoMark
::setMarked( {1,::bufferLength+10} ) // um Überschreiben zu simmulieren hier Markierung setzen
endif
RETURN SELF
METHOD HB_SLE_Zahl:KillInputFocus()
local nZahl, cZahl
if ! empty(::maske)
nZahl := ::getValue()
cZahl := alltrim(transform(nZahl,::maske))
::setData( cZahl ,.t.) // ::changed setzen
endif
::XbpSLE:KillInputFocus()
RETURN SELF
METHOD HB_SLE_Zahl:getValue()
local cZahl, nZahl
cZahl := ::editbuffer()
cZahl := strtran(cZahl,".","") // Tausendertrenner entfernen
cZahl := strtran(cZahl,",",".") // Dezimal Komma nach Dezimal Punkt
nZahl := VAL(cZahl)
RETURN nZahl
METHOD HB_SLE_Zahl:setValue(nZahl)
local lErfolg, cZahl
if ! empty(::maske)
cZahl := transform(nZahl,::maske)
else
cZahl := str(nZahl)
endif
::XbpSLE:setData(alltrim(cZahl))
lErfolg := "*" $ cZahl
RETURN lErfolg
METHOD HB_SLE_Zahl:setData(xVal,SetChanged)
DEFAULT SetChanged TO .f.
// Zuerst datalink prüfen
if IsNil(xVal)
// hier würde XbpSLE den datalink codeblock ausführen falls es einen gibt ...
if IsNil(::datalink)
// es gibt keinen, also SLE einfach löschen
xVal := ""
else
// Rückgabewert ermitteln, aber ACHTUNG, KEINE PARAMETER SETZEN !
xVal := eval(::datalink)
endif
endif
do case
case SetChanged // interner Aufruf, Parameter ist normalerweise TEXT
if ValType(xVal) == "N"
::setValue(xVal)
else
::XbpSLE:setData(xVal)
endif
::changed := .t.
case ValType(xVal) == "N" // Zahl wurde übergeben
::setValue(xVal)
case ValType(xVal) == "C" // Zahl ermitteln
::setValue(HB_VAL(xVal))
otherwise
::XbpSLE:setData(xVal) // bei falschen Datentyp auch einen Error akzeptieren.
endcase
RETURN SELF
* Hilfsroutine um Zahlentexte einfacher einzulesen ...
*-----------------------------------------------------------------------------
function HB_VAL(cNUM)
local nWert, nAnzKomma, nAnzPunkt
nAnzKomma := CharCount(cNUM,",")
nAnzPunkt := CharCount(cNUM,".")
do case
case empty(nAnzKomma) .and. empty(nAnzPunkt)
* nichts ändern
case empty(nAnzKomma) .and. nAnzPunkt=1
* nichts ändern
case empty(nAnzPunkt) .and. nAnzKomma=1
cNUM := strtran(cNUM,",",".")
case nAnzKomma=1 .and. nAnzPunkt > 1
cNUM := strtran(cNUM,".","") // Tausender Trennpunkte entfernen
cNUM := strtran(cNUM,",",".") // Komma auf Punkt umsetzten
case nAnzPunkt=1 .and. nAnzKomma > 1
cNUM := strtran(cNUM,",","") // Tausender TrennKOMMA entfernen
case nAnzKomma=1 .and. nAnzPunkt = 1
* was ist jetzt welches ?
if at(".",cNUM) > at(",",cNUM)
cNUM := strtran(cNUM,",","") // Tausender TrennKOMMA entfernen
else
cNUM := strtran(cNUM,".","") // Tausender Trennpunkte entfernen
cNUM := strtran(cNUM,",",".") // Komma auf Punkt umsetzten
endif
endcase
nWert := VAL(cNUM)
return nWert
*-----------------------------------------------------------------------------
function CharCount(cText,cChar)
local nAnzahl
if len(cChar) > 0
nAnzahl := len(cText)-len(strtran(cText,cChar,""))
else
nAnzahl := 0
endif
return nAnzahl
.
wie ist denn das passiert ...