////////////////////////////////////////////////////////////////////// // // AKDialog aus DATADLG.PRG // // Inhalt: // Klassen AKDialog und AKDialogMenu ////////////////////////////////////////////////////////////////////// // und ganz unten: DialogFF als "Dialog from File" // und : BlattFF als "Blatt from File" /////////////////////////////////// #include "Gra.ch" #include "Xbp.ch" #include "Dmlb.ch" #include "Common.ch" #include "Appevent.ch" #include "AKDialog.ch" /* * Klassendeklaration */ CLASS AKTabPage FROM XbpTabPage //, XbpDialog EXPORTED VAR Fenster VAR drawingArea // VAR minButton // VAR maxButton // VAR sysMenu // VAR titleBar METHOD INIT METHOD CREATE ENDCLASS METHOD AKTabPage:INIT( oParent, oOwner, aPos, ASize, aPP, lVisible ) // ::XbpDialog:INIT() ::XbpTabPage:INIT( oParent, oOwner, aPos, ASize, aPP, lVisible ) ::Fenster := XbpDialog():new( self, , {0,0}, {ASize[1],ASize[2]-15}, aPP, lVisible ) ::Fenster:minButton := .F. ::Fenster:maxButton := .F. ::Fenster:sysMenu := .F. ::Fenster:titleBar := .F. // ::Fenster:XbpDialog():CREATE() ::drawingarea := ::Fenster:drawingArea RETURN self METHOD AKTabPage:CREATE( oParent, oOwner, aPos, ASize, aPP, lVisible ) ::XbpTabPage:CREATE( oParent, oOwner, aPos, ASize, aPP, lVisible ) RETURN self CLASS AKDialog FROM XbpDialog, SCManager PROTECTED: VAR appendMode // Wird ein neuer Datensatz angelegt? VAR editControls // XBPs, die Daten „ndern VAR appendControls // XBPs, die nur bei APPEND // aktiv sind VAR keyControls // Liste von XBPs fr Tastaturnavigation VAR keyboardBlock // Codeblock fr xbeP_Keyboard Ereignisse EXPORTED: VAR area READONLY // aktueller Arbeitsbereich VAR newTitle // Codeblock um Titel zu „ndern VAR contextMenu // Kontextmen fr Datendialog VAR windowMenu // Dynamisches Fenstermen // im Anwendungsfenster VAR currentControl // Aktuelles Edit Control VAR seekOrder // Daten fr die Suche im VAR seekExpr // SeekDialog VAR seekFields VAR seekTitle VAR cFont VAR aData1 VAR aData2 METHOD init // Lebenszyklus METHOD create METHOD configure METHOD destroy METHOD addEditControl // XBP fr Edit registrieren METHOD addAppendControl // XBP fr Append registrieren METHOD addKeyControl // XBP fr Keyboard handling registrieren METHOD notify // Nachricht von DBO verarbeiten METHOD readData // Daten einlesen METHOD validateAll // Daten validieren METHOD writeData // Daten schreiben METHOD isIndexUnique // Indexwert prfen METHOD setDisplayFocus // Dialog hat Fokus bekommen METHOD keyHandler // Tastatursteuerung fr Edit controls METHOD StrukturErweiterung // Erweitert die Struktur von Dateien // 1.1.2005 ENDCLASS /* * Datendialog initialisieren */ METHOD AKDialog:init( oParent, oOwner , ; aPos , aSize , ; aPParam, lVisible ) LOCAL aPSize LOCAL nBSb DEFAULT lVisible TO .T., ; oParent TO SetAppWindow() aPParam := IIf( Empty(aPParam), {}, aPParam ) nBSb := AppDesktop():currentSize()[1] IF nBSb > 1200 cFont := "12.Arial" ELSEIF nBSb > 1000 cFont := "10.Arial" ELSEIF nBSb >750 cFont := "8.Arial" ELSE cFont := "7.Arial" ENDIF AAdd ( aPParam, { XBP_PP_COMPOUNDNAME, cFont } ) /* * Ohne Angabe einer Position wird das Fenster zentriert angezeigt */ IF aPos == NIL aPSize := oParent:currentSize() ASize := {100,100} aPos := { (aPSize[1] - aSize[1]) / 2, ; (aPSize[2] - aSize[2]) / 2 } ENDIF ::XbpDialog:INIT( oParent, oOwner, ; aPos , aSize , ; aPParam, lVisible ) ::XbpDialog:taskList := .T. // // 21.04.2007 18:38 Die Wirkung muss beobachtet werden: // damit die Fenster nicht immer per 'X' geschlossen werden oder minimiert werden: ::sysmenu := .F. //21.04.2007 18:31 hebt Min+Max-Button/X/System-Men auf !! // ::maxButton := .F. //???wieso wirkt das nicht?: ::XbpDialog:minButton := .F. // -->Bei einem MDI Client Fenster wird der Pushbutton zum Minimieren des Fensters immer angezeigt, // es sei denn, :titleBar ist auf .F. (falsch) gesetzt. ::aData1 := {} ::aData2 := {} ::area := 0 ::border := XBPDLG_RAISEDBORDERTHIN_FIXED ::editControls := {} ::appendControls := {} ::keyControls := {} ::keyboardBlock := {|nKey,x,obj| ::keyHandler( nKey, obj ) } ::appendMode := .F. ::newTitle := {|obj| obj:getTitle() } RETURN self /* * Systemresourcen anfordern * und AKDialog im aktuellen Arbeitsbereich registrieren */ METHOD AKDialog:create( oParent, oOwner , ; aPos , aSize , ; aPParam, lVisible ) ::xbpDialog:create( oParent, oOwner , ; aPos , aSize , ; aPParam, lVisible ) ::appendMode := Eof() ::area := Select() ::close := {|mp1,mp2,obj| obj:destroy() } DbRegisterClient( self ) RETURN self /* * Systemresourcen konfigurieren * und Dialog ggf. in neuem Arbeitsbereich registrieren */ METHOD AKDialog:configure( oParent, oOwner , ; aPos , aSize , ; aPParam, lVisible ) LOCAL lRegister := (::area <> Select()) ::xbpDialog:configure( oParent, oOwner , ; aPos , aSize , ; aPParam, lVisible ) IF lRegister (::area)->( DbDeRegisterClient( self ) ) ENDIF ::area := Select() ::appendMode := Eof() IF lRegister DbRegisterClient( self ) ENDIF RETURN self /* * Systemresourcen freigeben und AKDialog entregistrieren */ METHOD AKDialog:destroy() /* * Aufruf ignorieren wenn das Fenster schon im INIT Status ist. */ IF ::Status() == XBP_STAT_INIT RETURN self ENDIF // ::writeData() // wird schon an anderer Stelle gemacht (zB: Button:activate ::hide() // (::Area)->( DbCloseArea() ) //// /* //// * Eintrag im Fenstermen l”schen //// */ //// IF ! Empty( ::windowMenu ) //// ::windowMenu:delItem( self ) // //// ::windowMenu := NIL //// ENDIF //// //// /* //// * Referenzen auf den AKDialog und das Kontextmen l”schen //// */ //// IF ! Empty( ::contextMenu ) //// ::contextMenu:cargo := NIL //// ::contextMenu := NIL //// ENDIF DbDeRegisterClient( self ) /* * Systemresourcen freigeben und Instanzvariablen * auf die Werte im Zustand :init() zurcksetzen */ ::xbpDialog:destroy() ::Area := 0 ::appendMode := .F. ::editControls := {} ::appendControls := {} ::newTitle := {|obj| obj:getTitle() } RETURN self /* * Notify Methode: * - Vor Bewegen des Satzzeigers, Daten schreiben * - Nach Bewegen des Satzzeigers, Daten neu einlesen */ METHOD AKDialog:notify( nEvent, mp1, mp2 ) IF nEvent <> xbeDBO_Notify RETURN self // ** RETURN ** ENDIF DbSuspendNotifications() DO CASE CASE mp1 == DBO_MOVE_PROLOG // Satzzeiger wird bewegt ::writeData() CASE mp1 == DBO_MOVE_DONE .OR. ; // Skip ist beendet mp1 == DBO_GOBOTTOM .OR. ; mp1 == DBO_GOTOP ::readData() //// DO CASE //// CASE Empty( ::contextMenu ) //// CASE Eof() // Eintr„ge im Kontextmen //// ::contextMenu:disableBottom() // verfgbar machen oder //// ::contextMenu:disableEof() // sperren, je nachdem //// CASE mp1 == DBO_GOBOTTOM // wo der Satzzeiger sich //// ::contextMenu:enableAll() // befindet. //// ::contextMenu:disableBottom() //// CASE mp1 == DBO_GOTOP //// ::contextMenu:enableAll() //// ::contextMenu:disableTop() //// OTHERWISE //// ::contextMenu:enableAll() //// ENDCASE //// //// DO CASE //// CASE Eof() // Eintr„ge im Bearbeiten-Men //// WinMenu():editMenu:disableBottom() // des Fensters sperren //// WinMenu():editMenu:disableEof() // oder verfgbar machen //// CASE mp1 == DBO_GOBOTTOM // je nachdem, wo sich //// WinMenu():editMenu:enableAll() // der Satzzeiger befindet //// WinMenu():editMenu:disableBottom() //// CASE mp1 == DBO_GOTOP //// WinMenu():editMenu:enableAll() //// WinMenu():editMenu:disableTop() //// OTHERWISE //// WinMenu():editMenu:enableAll() //// ENDCASE ENDCASE DbResetNotifications() RETURN self /* * EditControl an Liste anfgen */ METHOD AKDialog:addEditControl( oXbp ) IF ValType( oXbp ) = "O" // dieses IF von ak am 31.12.02 IF AScan( ::editControls, oXbp ) == 0 AAdd( ::editControls, oXbp ) ::addKeyControl( oXbp ) ENDIF ELSE AAdd( ::editControls, oXbp ) ENDIF RETURN self /* * AppendControl an Liste anfgen */ METHOD AKDialog:addAppendControl( oXbp ) IF AScan( ::appendControls, oXbp ) == 0 AAdd( ::appendControls, oXbp ) ::addKeyControl( oXbp ) ENDIF RETURN self /* * XBP an Liste fr die Tastatursteuerung anfgen. Jeder XBP bekommt * den gleichen :keyBoard Codeblock. Er wird nach dem Ereignis * xbeP_Keyboard ausgewertet und ruft einen benutzerdefinierten * Tastatur-Handler */ METHOD AKDialog:addKeyControl( oXbp ) IF AScan( ::keyControls, oXbp ) == 0 AAdd( ::keyControls, oXbp ) oXbp:keyBoard := ::keyboardBlock ENDIF RETURN self /* * Fenster hat den Fokus bekommen. * Workarea ausw„hlen, Eintrag im Fenstermen markieren und Fokus * auf das aktuelle Edit Control setzen */ METHOD AKDialog:setDisplayFocus DbSelectArea( ::area ) IF ::windowMenu <> NIL ::windowMenu:checkItem( self ) ENDIF IF ::currentControl <> NIL SetAppFocus( ::currentControl ) ENDIF RETURN self //////****************************************************************************** //////* Die ueberladene Keyboard Methode muss die Methode the SCManager Basisklasse //////* rufen um die ShortCuts zu bearbeiten //////****************************************************************************** //////METHOD AKDialog:Keyboard( nKey ) ////// ////// LOCAL lHandled := FALSE ////// ////// lHandled := ::HandleShortCut( nKey ) ////// IF ! lHandled ////// RETURN ::xbpDialog:keyBoard( nKey ) ////// ENDIF ////// //////RETURN self /* * Benutzerdefinierte Tastaturverarbeitung */ METHOD AKDialog:keyHandler( nKey, oXbp ) LOCAL i:=AScan( ::keyControls, oXbp ) //** SCManager: LOCAL lHandled := ::HandleShortCut( nKey ) IF ! lHandled DO CASE CASE i == 0 CASE oXbp:isDerivedFrom( "XbpMLE" ) .OR. oXbp:isDerivedFrom( "XbpListbox" ) // Return, PageUp, PageDown werden zum Editieren von MLE und Listbox // verwendet. In dem Fall werden die Tasten hier ignoriert. CASE nKey == xbeK_RETURN IF ++i > Len( ::keyControls ) i := 1 ENDIF DO WHILE ! ::keyControls[i]:isenabled() i ++ ENDDO SetAppFocus( ::keyControls[i] ) ////// CASE nKey == xbeK_PGDN ////// IF ! Eof() ////// SKIP ////// IF Eof() ////// DbSuspendNotifications() ////// SKIP -1 // Append-Situation vermeiden ////// DbResetNotifications() ////// DbGobottom() // Notification ausl”sen ////// ENDIF ////// ENDIF ////// ////// CASE nKey == xbeK_PGUP ////// IF ! Bof() ////// SKIP -1 ////// ENDIF ////// ENDCASE ENDIF RETURN self /* * Datensatz lesen und Daten in EditControls einlesen */ METHOD AKDialog:readData() LOCAL i, imax := Len( ::editControls ) FOR i:=1 TO imax // Daten aus Datei in ::editControls[i]:setData() // XBPs bertragen NEXT Eval( ::newTitle, self ) // Neuer Fenstertitel IF Eof() // XBPs aktivieren oder IF ! ::appendMode // deaktivieren, die nur imax := Len( ::appendControls ) // bei APPEND zug„nglich FOR i:=1 TO imax // sein drfen ::appendControls[i]:enable() // Eof() ist erreicht NEXT // XBPs entsperren ENDIF ::appendMode := .T. ELSEIF ::appendMode // Satzzeiger wurde von imax := Len( ::appendControls ) // Eof() auf existierenden FOR i:=1 TO imax // Datensatz bewegt. ::appendControls[i]:disable() // XBPs wieder sperren NEXT ::appendMode := .F. ENDIF RETURN /* * Daten der EditControls in eine Datei schreiben */ METHOD AKDialog:writeData() LOCAL i, imax LOCAL lLocked := .F. , ; // Ist Satzsperre gesetzt? lAppend := .F. , ; // Ist Datensatz neu? aChanged := {} , ; // XBPs mit ge„nderten Daten nOldArea := Select() // Aktueller Bereich dbSelectArea( ::area ) IF Eof() // Neuen Datensatz anlegen //// IF ::validateAll() // Daten vor Append validieren ////// IF ConfirmBox( self, "Soll ein Datensatz angefgt werden?", ; ////// "Dateiende erreicht", ; ////// XBPMB_YESNO, ; ////// XBPMB_QUESTION ) == XBPMB_RET_YES //// APPEND BLANK //// lAppend := .T. //// aChanged := ::editControls // Alle XBPs k”nnen ge„ndert sein //// lLocked := ! NetErr() // Automatische Sperre ////// ELSE ////// DbSelectArea( nOldArea ) // keinen neuen Datensatz schreiben ////// RETURN .F. // *** ZURšCK *** ////// ENDIF //// ELSE //// MsgBox("Ungltige Daten") // Keine ungltigen Daten DbSelectArea( nOldArea ) // in neuen Datensatz schreiben RETURN .F. // *** ZURšCK *** //// ENDIF ELSE imax := Len( ::editControls ) // Feststellen, welche Daten FOR i:=1 TO imax // ge„ndert wurden IF ::editControls[i]:changed AAdd( aChanged, ::editControls[i] ) ENDIF NEXT IF Empty( aChanged ) // Keine Žnderung -> DbSelectArea( nOldArea ) // keine Satzsperre n”tig RETURN .T. // *** ZURšCK *** // ELSEIF ConfirmBox( oCB, "Žnderungen speichern?", ; // "Datensatz wurde ge„ndert.", ; // XBPMB_YESNO, ; // XBPMB_QUESTION ) = XBPMB_RET_NO // DbSelectArea( nOldArea ) // keine Satzsperre n”tig // RETURN .F. // *** ZURšCK *** ENDIF lLocked := DbRLock( Recno() ) // Datensatz sperren ENDIF IF ! lLocked MsgBox( "Datensatz ist zur Zeit gesperrt" ) DbSelectArea( nOldArea ) // keine Satzsperre m”glich RETURN .F. // *** ZURšCK *** ENDIF imax := Len( aChanged ) // Schreibzugriff nur fr FOR i:=1 TO imax // ge„nderte Daten IF ! lAppend // erforderlich IF ! aChanged[i]:validate() aChanged[i]:undo() // ungltige Daten ! LOOP // Original wiederherstellen ENDIF // und n„chsten XBP validieren ENDIF aChanged[i]:getData() // Daten aus XBP holen und NEXT // in Datei schreiben DbCommit() // Datenpuffer wegschreiben DbRUnlock( Recno() ) // Sperre aufheben // Dialogelemente nach Append IF ::appendMode // wieder sperren imax := Len( ::appendControls ) FOR i:=1 TO imax ::appendControls[i]:disable() NEXT ::appendMode := .F. IF ! Empty( ::contextMenu ) ::contextMenu:disableBottom() ::contextMenu:enableEof() ENDIF //// WinMenu():editMenu:disableBottom() //// WinMenu():editMenu:enableEof() ENDIF DbSelectArea( nOldArea ) RETURN .T. /* * Daten aus allen EditControls validieren * Wird bei APPEND gebraucht bevor ein neuer Datensatz angefgt wird */ METHOD AKDialog:validateAll() LOCAL i := 0, imax := Len( ::editControls ) LOCAL lValid := .T. DO WHILE ++i <= imax .AND. lValid lValid := ::editControls[i]:validate() ENDDO RETURN lValid /* * Prfen, ob ein Indexeintrag noch nicht vorhanden ist */ METHOD AKDialog:isIndexUnique( nOrder, xIndexValue ) LOCAL nOldOrder := OrdNumber() LOCAL nRecno := Recno() LOCAL lUnique := .T. IF !Empty( xIndexValue ) DbSuspendNotifications() // Keine Nachricht vom DBO // an self bei DbSeek() !!! OrdSetFocus( nOrder ) SatzDelete() // damit er sich nicht selber findet lUnique := .NOT. DbSeek( xIndexValue ) OrdSetFocus( nOldOrder ) DbGoTo( nRecno ) SatzRecall() // damit er wieder da ist DbResetNotifications() ENDIF RETURN lUnique // neue Felder in einer Datei anfgen: METHOD AKDialog:StrukturErweiterung( cDatei, aNeuFeld, nA ) LOCAL nOldArea := SELECT(), i, aFeld cDatei := cDatver + cDatei SELECT (nA) DbUseArea( , , cDatei ) // Datei ”ffnen COPY TO (cDatei+"k") // Sicherungskopie COPY TO temp // Daten zwischenspeichern DbCopyExtStruct( "Struct" ) // Struktur bertragen DbUseArea( , , "Struct" ) // strukturerweiterte Datei FOR i := 1 TO Len(aNeuFeld) aFeld := aNeuFeld[i] DbAppend() // ”ffnen und neue FIELD->Field_Name := aFeld[1] // Felddefinition eintragen FIELD->Field_Type := aFeld[2] FIELD->Field_Len := aFeld[3] FIELD->Field_Dec := aFeld[4] NEXT DbCloseArea() //// // Sicherungskopie fr //// IF FILE(cDatver+"Temp.dbf") //// COPY FILE ( cDatei+".dbf" ) TO ( cDatver+"Temp.dbf" ) // - DBF-Datei //// COPY FILE ( cDatei+".dbt" ) TO ( cDatver+"Temp.dbt" ) // - Memo-Datei //// ELSE //// FRename( cDatei+".dbf", cDatver+"Temp.dbf" ) // - DBF-Datei //// Frename( cDatei+".dbt", cDatver+"Temp.dbt" ) // - Memo-Datei //// ENDIF DbCreateFrom( cDatei,, "Struct" ) // Neue Datei erzeugen DbUseArea( , , cDatei ) // Datei ”ffnen DbImport( cDatver+"Temp" ) // Datens„tze aus Sicherungskopie bernehmen DbCloseArea() //// // Dateien umbenennen //// IF FILE(cDatei+".bkf") //// COPY FILE ( cDatver+"Temp.dbf" ) TO ( cDatei+".bkf" ) // - DBF-Datei //// COPY FILE ( cDatver+"Temp.dbt" ) TO ( cDatei+".bkt" ) // - Memo-Datei //// ELSE //// FRename( cDatver+"Temp.dbf", cDatei+".bkf" ) // - DBF-Datei //// FRename( cDatver+"Temp.dbt", cDatei+".bkt" ) // - Memo-Datei //// ENDIF FErase( "Struct.dbf" ) // Strukturerweiterte Datei l”schen SELECT (nOldArea) RETURN self //******************************************************************************** //******************************************************************************** //******************************************************************************** CLASS DialogFF PROTECTED: VAR appendMode // Wird ein neuer Datensatz angelegt? VAR appendControls // XBPs, die nur bei APPEND // aktiv sind VAR keyControls // Liste von XBPs fr Tastaturnavigation VAR keyboardBlock // Codeblock fr xbeP_Keyboard Ereignisse EXPORTED: VAR editControls // XBPs, die Daten „ndern VAR MenuBar VAR SubMenu VAR SMNr VAR BEArea VAR BENr VAR BrowseFeld VAR BFNr VAR GruppenBox VAR GBNr VAR ListBox VAR LBNr VAR TextZeile VAR TZNr VAR DruckKnopf VAR DKNr VAR MultiZeile VAR MZNr VAR SingleZeile VAR SZNr VAR LogikKnopf VAR LKNr VAR SpinKnopf VAR SKNr VAR Fancy VAR StartFocus VAR aFeld VAR aFNr // VAR VArea VAR VArea // enth„lt die Area der best.dbf (=1) VAR aStructure // enth„lt die Struktur der best.dbf VAR aFelder // enth„lt alle Feldbezeichnungen der best.dbf VAR aBeschreib // enth„lt alle Feldbeschreibungen der best.dbf (sp„ter einmal...17.4.2005) VAR SuchFeld // enth„lt die Beschreibung aus aBeschreib 17.04.2005 VAR aData1 // enth„lt alle Feldinhalte des augenblicklichen Datensatzes VAR aData2 // VAR aIndex // enth„lt die Namen der Indexdateien VAR oTip // eingeblendete Tip-Zeile VAR cTipTime // Zeit, zu der PaintTip() aufgerufen wurde 27.04.2008 22:03 VAR oFocLFSle // letztes Feld-SLE, welches den Focus hatte VAR oFocLMSle // letztes Member-SLE, welches den Focus hatte VAR cBestLF // cargo des letzten Feld-SLE in Best, welches den Focus hatte VAR thisTab // die aktuelle Tabpage VAR BriefText // editierbarer Text in bl_Standardbriefen VAR aTxBd // Adresse etc. des Briefes VAR TxBd0 // editierbarer Text in bl_Standardbriefen VAR TxBd1 // editierbarer Text in bl_Standardbriefen VAR TxBd2 // editierbarer Text in bl_Standardbriefen VAR TxBd3 // editierbarer Text in bl_Standardbriefen VAR TxBd4 // editierbarer Text in bl_Standardbriefen VAR TxBd5 // editierbarer Text in bl_Standardbriefen VAR TxBd6 // editierbarer Text in bl_Standardbriefen VAR TxBd7 // editierbarer Text in bl_Standardbriefen VAR TxBd8 // editierbarer Text in bl_Standardbriefen VAR TxBd9 // editierbarer Text in bl_Standardbriefen VAR TxBd10 // editierbarer Text in bl_Standardbriefen VAR TxBd11 // editierbarer Text in bl_Standardbriefen VAR aR // ROT 15.11.2006 09:58 fr Trauerdruck VAR aG // GELB VAR aB // BLAU VAR aI1 // HilfsVariable 1 15.11.2006 14:28 VAR aI2 // HilfsVariable 2 VAR aI3 // HilfsVariable 3 VAR Sperre // wenn .T., dann Žndern nur nach Abfrage 26.01.2007 22:36 METHOD INIT METHOD CREATE METHOD destroy METHOD addEditControl // XBP fr Edit registrieren METHOD addAppendControl // XBP fr Append registrieren METHOD addKeyControl // XBP fr Keyboard handling registrieren // METHOD notify METHOD XbpNummer METHOD XbpObjekt METHOD XbpObjektSet // setData in alle Objects desselben Namens in aEditbuffers 05.11.2006 13:41 METHOD XbpObjektGet // getData aus allen Objects desselben Namens in aEditbuffers 05.11.2006 13:41 METHOD BrowseSpalte METHOD NEU METHOD ENTF METHOD SUCH METHOD Eingabe METHOD Erlaubnis // Abfrage bei Feldinhalts-Žnderung METHOD CodeWort // fr WernerX entwickelt 06.04.2007 18:40 METHOD BenutzerAendern // ~ METHOD BenutzerSuche // ~ METHOD PaintTip METHOD KillTip METHOD TabMax METHOD StrukturErweiterung // neue Felder in einer Datei anfgen METHOD AdrDaten // holt Adresse aus vers.dbf/Area5 METHOD AutoDaten // fllt automatisch Felder mit Daten, z.B. Anrede aus 1 Buchstaben METHOD PlzDE // Suche in Gesamtdeutschland nach PLZ oder Ort METHOD TextSuchen // liest Texte/Bilder aus TEXTE.DBF METHOD TextSpeichern // speichert Texte/Bilder aus TEXTE.DBF METHOD DatumSet // setzt Datumsfelder auf Sterbedatum/Date() oder erh”ht/vermindert um 1/7 METHOD HilfeFilm // zeigt einen Tutor-Film mit Ton // METHOD Gross // Upper(::value) ////// METHOD DateiErzeugen // neue Datei erzeugen => sollte schon in INEUx sein! ENDCLASS METHOD DialogFF:INIT( oParent, oOwner, aPos, ASize, aPP, lVisible, nBz, cFF, nAnf, nEnd, nA ) LOCAL i,j,k ::VArea := nA // 17.4.2005 ::SuchFeld := "AuftragsNummer" ::aStructure := {} // ::aFelder := {} // ::aBeschreib := {} // ::aData1 := {} // ::aData2 := {} // ::aIndex := {} // 17.4.2005 ::SubMenu := {} ::SMNr := 0 ::BEArea := {} ::BENr := 0 ::BrowseFeld := {} ::BFNr := 0 // ::BVariable := {} // ::BVNr := 0 ::GruppenBox := {} ::GBNr := 0 ::ListBox := {} ::LBNr := 0 ::TextZeile := {} ::TZNr := 0 ::DruckKnopf := {} ::DKNr := 0 ::MultiZeile := {} ::MZNr := 0 ::SingleZeile := {} ::SZNr := 0 ::LogikKnopf := {} ::LKNr := 0 ::SpinKnopf := {} ::SKNr := 0 ::editControls := {} ::appendControls := {} ::keyControls := {} ::keyboardBlock := {|nKey,x,obj| ::BEArea[1]:cargo:keyHandler( nKey, obj ) } // ::keyboardBlock := {|nKey,x,obj| ::keyHandler( nKey, obj ) } ::Fancy := Trim(" ") ::aFNr := (nA)->(FCount()) // und: z„hlt bei setname() oberhalb der Anzahl Felder ::aFeld := Array( ::aFNr ) ::BriefText := "" // Test fr neues Textprogramm auf bl_Basis (SinzigX) ::aTxBd := {} // Adresse etc. des Briefes ::TxBd0 := "" // Text/Bild fr Briefe/Trauerdrucke ::TxBd1 := "" // Text/Bild fr Briefe/Trauerdrucke ::TxBd2 := "" // Text/Bild fr Briefe/Trauerdrucke ::TxBd3 := "" // Text/Bild fr Briefe/Trauerdrucke ::TxBd4 := "" // Text/Bild fr Briefe/Trauerdrucke ::TxBd5 := "" // Text/Bild fr Briefe/Trauerdrucke ::TxBd6 := "" // Text/Bild fr Briefe/Trauerdrucke ::TxBd7 := "" // Text/Bild fr Briefe/Trauerdrucke ::TxBd8 := "" // Text/Bild fr Briefe/Trauerdrucke ::TxBd9 := "" // Text/Bild fr Briefe/Trauerdrucke ::TxBd10:= "" // Text/Bild fr Briefe/Trauerdrucke ::TxBd11:= "" // Text/Bild fr Briefe/Trauerdrucke ::Sperre := IIf(cAdrBM=" ",.T.,.F.) RETURN self METHOD DialogFF:CREATE( oParent, oOwner, aPos, ASize, aPP, lVisible, nBz, cFF, nAnf, nEnd, nA ) LOCAL oXbp //nH, nV := AppDesktop():currentSize()[1]/800, [2]/600 waagrecht:nH, senkrecht:nV LOCAL nBo := ( AppDesktop():currentSize()[2]-90*nV), nZeiF := 0, nZeiT := 0, cN, nN LOCAL aPosT, aSizeT, aPosF, aSizeF LOCAL aPPSle := { { XBP_PP_FGCLR , GRA_CLR_BLACK } , ; { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } // LOCAL aPPTxt := { { XBP_PP_FGCLR , GRA_CLR_YELLOW } , ; // { XBP_PP_BGCLR , GRA_CLR_BLUE } , ; // { XBP_PP_COMPOUNDNAME, IIf(nV>1.5,"12.Arial",IIf(nV>1,"10.Arial","8.Arial")) } } // LOCAL aPPTxt := { { XBP_PP_FGCLR , GRA_CLR_BLACK } , ; // { XBP_PP_BGCLR , XBPSYSCLR_DIALOGBACKGROUND } , ; // { XBP_PP_COMPOUNDNAME, IIf(nV>1.5,"12.Arial",IIf(nV>1,"10.Arial","8.Arial")) } } // LOCAL aPPTxt := { { XBP_PP_FGCLR , GRA_CLR_BLACK }} LOCAL aPPTxt := {{ XBP_PP_COMPOUNDNAME, IIf(nV>1.5,"12.Arial",IIf(nV>1,"10.Arial","8.Arial")) }} LOCAL nOldArea := SELECT(), i, y, cFeld, cPic, nBzStd := nBz, nBENr, oPSX, oBitmapX //10.09.2006 13:47 PRIVATE bT, cT ::aBeschreib := AClone(::aFelder) IF FILE( cDatver+"xFldPos.ntx" ) .AND. !("MENG"$Upper(AppName()).AND.cSystem="S") // 29.11.2005 // Experiment, damit der Aufbau aus s_.tak statt aus s_*.dbf erfolgt: DbUseArea( .T.,"SDFNTX", "s_.tak", "sv", .T. ) // .T./.T. bedeutet : NEW Area/shared OrdListAdd("xFldPos") // 9.2.2005: weil schon in ineux geindext // OrdCreate( "C:\HDBE\xFldPos",, "Upper(fname)+StrZero(field_pos+1000,4,0)" ) // 22.7.2004 DbSetScope( SCOPE_BOTH, PadR(Upper(cFF),8) ) // 8.2.2005 ELSE IF cSystem == "S" .AND. "MENG"$Upper(AppName()) // 12.11.2005: bei Menge, wenn mit s-t-a gestartet wird QOut("DialogFF-Start:"+Time()) DbUseArea( .T.,"SDFNTX", "C:\HDBE\s_.tak", "sv" ) // .T. bedeutet : NEW Area OrdCreate( "C:\HDBE\xFldPos",, "Upper(fname)+StrZero(field_pos+1000,4,0)" ) // OrdCreate( "C:\HDBE\xFldPos",, "field_pos" ) // 22.7.2004 DbSetScope( SCOPE_BOTH, PadR(Upper(cFF),8) ) // 8.2.2005 ELSE DbUseArea( .T.,, cFF, "sv" ) // .T. bedeutet : NEW Area ENDIF ENDIF *** // OrdCreate( "xFldPos",, "Str(field_pos,3,0)" ) // ( das entspricht : INDEX ON FIELD_POS TO xFLDPOS ) ////////******************????? DbSuspendNotifications() DbGoTop() DO WHILE !Eof() //.AND. IIf( IsFieldVar("FNAME"), FName=cFF, .T. ) IF (sv->FIELD_POS < nAnf .OR. sv->FIELD_POS > nEnd .OR. sv->FIELD_POS = 0) //8.2.2005://.AND. .NOT. sv->FIELD_POS < 0 sv->(DbSkip()) LOOP ENDIF // 17.04.2005: IF Len(::aBeschreib)>0 .AND. sv->FIELD_TYPE $ "CNDM" //17.4.2005 fr die "sortiert nach"-ToolTips cN := IIf( sv->FIELD_NAME[1]=="&", &(SubStr(sv->FIELD_NAME,2)), sv->FIELD_NAME ) nN := AScan(::aFelder,Trim(cN)) IF nN != 0 ::aBeschreib[nN] := IIf(!Empty(sv->Text),Trim(sv->TEXT),Trim(sv->FIELD_NAME)) ENDIF ENDIF // DO CASE CASE sv->FIELD_TYPE $ "AWGawg" // erzeugt Browse/Edit - Areas nBz := IIf( !Empty(sv->HoF), sv->HoF*nV, nBzStd ) aPosT := {Int(sv->SpaT*nH),Int(sv->ZeiT*nV)} ; aSizeT := {Int(sv->BrT*nH),Int(sv->HoT*nV)} // DrawingArea bekommt FarbVariablen von einem Dummy-"A" (Gr”áe 0) in der Position 1 der s_*.dbf IF ::BENr = 1 .AND. cFarbeBG != "0" ////// ::BEArea[::BENr]:setColorBG( XBPSYSCLR_TRANSPARENT ) // damit Farbe durchscheint IF Val(sv->ZAHL_FORM) >= 1000 // 10.09.2006 13:42 Resourcen aus DLL laden (Muster.dll fr alle Bestatter gleich) oPSX := XbpPresSpace():New() //10.09.2006 13:42 oPSX:create( ::BEArea[::BENr]:windevice(), ::BEArea[::BENr]:currentsize(), GRA_PU_LOMETRIC ) oBitmapX := XbpBitmap():new():create( oPSX ) ::BEArea[::BENr]:setColorFG( IIf("."$sv->ZAHL_FORM, Val(SubStr(sv->ZAHL_FORM, ; At(".",sv->ZAHL_FORM)+1,2)), GRA_CLR_BLACK )) // ::BEArea[::BENr]:bitmap := Val( sv->Zahl_Form ) oBitmapX:load( "MUSTER.DLL", Val( sv->Zahl_Form ) ) //10.09.2006 13:41 ::BEArea[::BENr]:bitmap := oBitmapX //10.09.2006 13:42 ::BEArea[::BENr]:configure() ELSEIF Val(sv->ZAHL_FORM)>0 .AND. Val(sv->ZAHL_FORM)<16 // 31.10.2005 wie weiter unten ::BEArea[::BENr]:setColorFG( IIf("."$sv->ZAHL_FORM, ; Val(SubStr(sv->ZAHL_FORM, 1, At(".",sv->ZAHL_FORM)-1)), GRA_CLR_BLACK )) ::BEArea[::BENr]:setColorBG( IIf("."$sv->ZAHL_FORM .AND. .NOT. ","$sv->ZAHL_FORM, ; Val(SubStr(sv->ZAHL_FORM, At(".",sv->ZAHL_FORM)+1,2)), ; IIf(","$sv->ZAHL_FORM, GraMakeRGBColor( ; IIf("."$sv->ZAHL_FORM, &("{"+Trim(SubStr(sv->ZAHL_FORM, At(".",sv->ZAHL_FORM)+1))+"}"), ; &("{"+Trim(sv->ZAHL_FORM)+"}") )), ; XBPSYSCLR_DIALOGBACKGROUND ) )) ELSE ::BEArea[::BENr]:setColorFG( GRA_CLR_BLACK ) ::BEArea[::BENr]:setColorBG( XBPSYSCLR_DIALOGBACKGROUND ) ENDIF ELSEIF ::BENr = 1 ::BEArea[::BENr]:setColorFG( GRA_CLR_BLACK ) ::BEArea[::BENr]:setColorBG( IIf(!Empty(::Menubar), GRA_CLR_DARKGREEN, ; XBPSYSCLR_DIALOGBACKGROUND ) ) ENDIF // // "A" macht ein Textfeld und "W" macht ein Fenster ohne Titelzeile IF sv->FIELD_TYPE ="A" AAdd( ::BEArea, MStatic():new( oParent, oOwner, aPosT, aSizeT, aPPTxt,, ; XBPSTATIC_TYPE_BITMAP ) ) ++::BENr ::BEArea[::BENr]:CREATE() ::BEArea[::BENr]:helpLink := MagicHelpLabel():New(sv->BrF) ELSEIF sv->FIELD_TYPE ="a" //18.10.2006 16:35 fr Datei-Bitmaps, z.B. Artikelbilder nBENr := IIf( sv->FIELD_DEC<0, ::BENr + sv->FIELD_DEC + 1, ; IIf( sv->FIELD_DEC>0, sv->FIELD_DEC, ::BENr ) ) cFeld := Trim( sv->FIELD_NAME ) IF (nA)->(IsFieldVar( cFeld )) // 18.10.2006 17:03 XbpStatic mit Bitmap aus Feld y := (nA)->(FieldPos( cFeld )) // y : Feld-Position in WorkArea nA AAdd( ::BEArea, BitView():new( ::BEArea[nBENr], ::BEArea[nBENr], aPosT, aSizeT, aPPTxt,, ; XBPSTATIC_TYPE_BITMAP, @(nA)->&cFeld, y, nA ) ) ++::BENr ::BEArea[::BENr]:CREATE( ::BEArea[nBENr], ::BEArea[nBENr], aPosT, aSizeT, aPPTxt,, ; XBPSTATIC_TYPE_BITMAP, @(nA)->&cFeld ) ::BEArea[::BENr]:setData() ::BEArea[::BENr]:helpLink := MagicHelpLabel():New(sv->BrF) ::BEArea[::BENr]:setName( y ) ::BEArea[::BENr]:cargo := Trim( sv->FIELD_NAME ) ::addEditControl( ::BEArea[::BENr] ) ELSE AAdd( ::BEArea, MStatic():new( ::BEArea[nBENr], ::BEArea[nBENr], aPosT, aSizeT, aPPTxt,, ; XBPSTATIC_TYPE_BITMAP ) ) ++::BENr ::BEArea[::BENr]:CREATE() ::BEArea[::BENr]:helpLink := MagicHelpLabel():New(sv->BrF) ENDIF ELSEIF sv->FIELD_TYPE = "G" // erzeugt eine Gruppenbox //*** noch testen !!!!!!! // s.o. aPosT := {Int(sv->SpaT*nV),Int(sv->ZeiT*nV)} ; aSizeT := {Int(sv->BrT*nV),Int(sv->HoT*nV)} AAdd( ::GruppenBox, MStatic():new( ::BEArea[::BENr], oOwner, aPosT, aSizeT, aPP,, ; XBPSTATIC_TYPE_GROUPBOX, ; IIf(SET(43)==0,ConvToAnsiCP(Trim(sv->TEXT)),Trim(sv->TEXT)) ) ) //03.12.2006 15:26 ++::GBNr IIf( nV<=1, ::GruppenBox[::GBNr]:setFontCompoundName( "6.Arial" ), ) ::GruppenBox[::GBNr]:create() ::GruppenBox[::GBNr]:helpLink := MagicHelpLabel():New(sv->BrF) ELSEIF sv->FIELD_TYPE ="W" // Fenster direkt auf der DrawingArea oXbp := XbpDialog():new( ::BEArea[1], ::BEArea[1], aPosT, aSizeT, aPPTxt,, ) oXbp:minButton := .F. oXbp:maxButton := .F. oXbp:sysMenu := .F. oXbp:titleBar := .F. oXbp:border := sv->FIELD_LEN + 3 // 3 = XBPDLG_THINBORDER, 1 = XBPDLG_NO_BORDER oXbp:CREATE() AAdd( ::BEArea, oXbp:drawingArea ) // die DrawingArea des Fensters ++::BENr ::BEArea[::BENr]:cargo := oXbp // das XbpDialog-Objekt = Fenster ::BEArea[::BENr]:helpLink := MagicHelpLabel():New(sv->BrF) ::BEArea[::BENr]:clipSiblings := .T. ::BEArea[::BENr]:setColorBG( XBPSYSCLR_TRANSPARENT ) // damit Farbe durchscheint ELSEIF sv->FIELD_TYPE ="w" // Fenster auf einem bereits eingegebenen Fenster nBENr := IIf( sv->FIELD_DEC<0, ::BENr + sv->FIELD_DEC + 1, ; IIf( sv->FIELD_DEC>0, sv->FIELD_DEC, ::BENr ) ) oXbp := XbpDialog():new( ::BEArea[nBENr], ::BEArea[nBENr], aPosT, aSizeT, aPPTxt,, ) oXbp:minButton := .F. oXbp:maxButton := .F. oXbp:sysMenu := .F. oXbp:titleBar := .F. oXbp:border := sv->FIELD_LEN + 3 // 3 = XBPDLG_THINBORDER, 1 = XBPDLG_NO_BORDER oXbp:CREATE() AAdd( ::BEArea, oXbp:drawingArea ) // die DrawingArea des Fensters ++::BENr ::BEArea[::BENr]:cargo := oXbp // das Xbp_Dialog-Objekt = Fenster ::BEArea[::BENr]:helpLink := MagicHelpLabel():New(sv->BrF) ::BEArea[::BENr]:clipSiblings := .T. ::BEArea[::BENr]:setColorBG( XBPSYSCLR_TRANSPARENT ) // damit Farbe durchscheint ELSEIF sv->FIELD_TYPE = "g" // kleines "g" - erzeugt eine TabPage auf oDlg:drawingArea nBENr := IIf( sv->FIELD_DEC<0, ::BENr + sv->FIELD_DEC + 1, ; IIf( sv->FIELD_DEC>0, sv->FIELD_DEC, ::BENr ) ) aPosT := {Int(sv->SpaT*nH),Int(sv->ZeiT*nV)} ; aSizeT := {Int(sv->BrT*nH),Int(sv->HoT*nV)} AAdd( ::BEArea, XbpTabPage():new( ::BEArea[nBENr], ::BEArea[nBENr], aPosT, aSizeT, aPPTxt, lVisible ) ) ::BEArea[++::BENr]:caption := IIf(SET(43)==0,ConvToAnsiCP(sv->FIELD_NAME),sv->FIELD_NAME) //03.12.2006 15:27 ::BEArea[::BENr]:clipSiblings := .T. ::BEArea[::BENr]:tabStop := .T. ::BEArea[::BENr]:preOffset := sv->SpaF ::BEArea[::BENr]:postOffset := SV->ZeiF //#define XBPTABPAGE_TAB_BOTTOM 2 //#define XBPTABPAGE_TAB_TOP 4 ::BEArea[::BENr]:TYPE := IIf(sv->HoF=2,2,4) //22.04.2007 19:05 ::BEArea[::BENr]:create() ::BEArea[::BENr]:helpLink := MagicHelpLabel():New(sv->BrF) ::BEArea[::BENr]:minimized := sv->TAB_STOP IIf(sv->TAB_STOP,::BEArea[::BENr]:minimize(), ; {::BEArea[::BENr]:maximize(),::thistab:=::BEArea[::BENr]} ) //11.11.2006 19:10 ::BEArea[::BENr]:TabActivate := &(sv->TEXT) // CodeBlock ::BEArea[::BENr]:cargo := Trim(sv->FIELD_NAME) ENDIF IF cFarbeBG != "0" IF ::BEArea[::BENr]:isDerivedfrom( "BitView" ) // Farbe ist schon als Grafik eingestellt ! ELSEIF Val(sv->ZAHL_FORM) >= 1000 .AND. IsMemberVar( ::BEArea[::BENr], "bitmap" ) // 10.09.2006 13:42 Resourcen aus DLL laden (Muster.dll fr alle Bestatter gleich) oPSX := XbpPresSpace():New() //10.09.2006 13:42 oPSX:create( ::BEArea[::BENr]:windevice(), ::BEArea[::BENr]:currentsize(), GRA_PU_LOMETRIC ) oBitmapX := XbpBitmap():new():create( oPSX ) // Umschaltung der Mandantenfarben 09.09.2006 14:03 : IF "," $ sv->ZAHL_FORM .AND. (cDatver = cNetver2 .OR. IIf( IsMemVar("cDru"), ; Upper(cDru) = Trim(sv->TEXT), .F. )) //04.02.2007 09:54 cZF2 := SubStr( sv->ZAHL_FORM, At( ",", sv->ZAHL_FORM)+1 ) ::BEArea[::BENr]:setColorFG( IIf("."$cZF2, Val(SubStr( cZF2, ; At(".",cZF2)+1,2)), GRA_CLR_BLACK )) // ::BEArea[::BENr]:bitmap := Val( cZF2 ) oBitmapX:load( "MUSTER.DLL", Val( cZF2 ) ) ::BEArea[::BENr]:bitmap := oBitmapX ::BEArea[::BENr]:configure() ELSE ::BEArea[::BENr]:setColorFG( IIf("."$sv->ZAHL_FORM, Val(SubStr(sv->ZAHL_FORM, ; At(".",sv->ZAHL_FORM)+1,2)), GRA_CLR_BLACK )) // ::BEArea[::BENr]:bitmap := Val( sv->Zahl_Form ) // stattdessen neu: oBitmapX:load( "MUSTER.DLL", Val( sv->Zahl_Form ) ) //10.09.2006 13:41 ::BEArea[::BENr]:bitmap := oBitmapX //10.09.2006 13:42 ::BEArea[::BENr]:configure() ENDIF ELSEIF Val(sv->ZAHL_FORM)>0 .AND. Val(sv->ZAHL_FORM)<16 .OR. ","$sv->ZAHL_FORM ::BEArea[::BENr]:setColorFG( IIf("."$sv->ZAHL_FORM, ; Val(SubStr(sv->ZAHL_FORM, 1, At(".",sv->ZAHL_FORM)-1)), GRA_CLR_BLACK )) ::BEArea[::BENr]:setColorBG( IIf("."$sv->ZAHL_FORM .AND. .NOT. ","$sv->ZAHL_FORM, ; Val(SubStr(sv->ZAHL_FORM, At(".",sv->ZAHL_FORM)+1,2)), ; IIf(","$sv->ZAHL_FORM, GraMakeRGBColor( ; IIf("."$sv->ZAHL_FORM, &("{"+Trim(SubStr(sv->ZAHL_FORM, At(".",sv->ZAHL_FORM)+1))+"}"), ; &("{"+Trim(sv->ZAHL_FORM)+"}") )), ; XBPSYSCLR_DIALOGBACKGROUND ) )) ELSE ::BEArea[::BENr]:setColorFG( GRA_CLR_BLACK ) ::BEArea[::BENr]:setColorBG( XBPSYSCLR_DIALOGBACKGROUND ) ENDIF ELSE ::BEArea[::BENr]:setColorFG( GRA_CLR_BLACK ) ::BEArea[::BENr]:setColorBG( XBPSYSCLR_DIALOGBACKGROUND ) ENDIF ////// IF ((".BMP"$Upper( sv->TEXT ) .OR. ".JPG"$Upper( sv->TEXT ) .AND. ::Fancy != "0") ) //18.10.2006 17:07 ////// IF !Empty(sv->text) ////// ::BEArea[::BENr]:cargo := BitView():new( ::BEArea[::BENr] ) ////// ::BEArea[::BENr]:cargo:load( Trim(::Fancy) + Trim(sv->TEXT) ) ////// ::BEArea[::BENr]:paint := {|x,y,obj| x:=obj:currentSize(), ; ////// ::BEArea[::BENr]:cargo:DISPLAY( {0,0,x[1],x[2]} ) } ////// ::BEArea[::BENr]:cargo:CREATE() ////// ELSEIF (nA)->(IsFieldVar(Trim(sv->FIELD_NAME))) .AND. sv->FIELD_TYPE ="A" // fr Artikelbilder ////// ::BEArea[::BENr]:cargo := BitView():new( ::BEArea[::BENr] ) ////// cFeld := Trim( sv->FIELD_NAME ) ////// y := (nA)->(FieldPos( cFeld )) // y : Feld-Position in WorkArea nA ////// ::BEArea[::BENr]:cargo:datalink := {|x| IIf( PCOUNT()==0,(nA)->&cFeld,(nA)->&cFeld:=x ) } ////// ::BEArea[::BENr]:cargo:CREATE():setdata() ////// ::BEArea[::BENr]:cargo:setname( y ) ////// ::addEditControl( ::BEArea[::BENr]:cargo ) ////// ENDIF ////// ENDIF IF ((".BMP"$Upper( sv->TEXT ) .OR. ".JPG"$Upper( sv->TEXT ) .AND. ::Fancy != "0") .OR. ; (nA)->(IsFieldVar(Trim(sv->FIELD_NAME)))) // 26.02.2006 fr Artikelbilder ::BEArea[::BENr]:cargo := BitView():new( ::BEArea[::BENr] ) IF !Empty(sv->text) ::BEArea[::BENr]:cargo:load( Trim(::Fancy) + Trim(sv->TEXT) ) ::BEArea[::BENr]:paint := {|x,y,obj| x:=obj:currentSize(), ; ::BEArea[::BENr]:cargo:DISPLAY( {0,0,x[1],x[2]} ) } ::BEArea[::BENr]:cargo:CREATE() ELSEIF (nA)->(IsFieldVar(Trim(sv->FIELD_NAME))) .AND. sv->FIELD_TYPE != "a"// fr Artikelbilder cFeld := Trim( sv->FIELD_NAME ) y := (nA)->(FieldPos( cFeld )) // y : Feld-Position in WorkArea nA ::BEArea[::BENr]:cargo:datalink := {|x| IIf( PCOUNT()==0,(nA)->&cFeld,(nA)->&cFeld:=x ) } ::BEArea[::BENr]:cargo:CREATE():setdata() ::BEArea[::BENr]:cargo:setname( y ) ::addEditControl( ::BEArea[::BENr]:cargo ) ENDIF ENDIF ************* ********************************** CASE sv->FIELD_TYPE = "m" // kleines "m" - erzeugt eine MenuBar // ::MenuBar := IIf(::BENr>2,::BEArea[::BENr]:setParent():menubar(),::BEArea[1]:cargo:menuBar()) ::MenuBar := ::BEArea[1]:cargo:menuBar() CASE sv->FIELD_TYPE = "t" // kleines "t" - erzeugt MenuTitel IF sv->FIELD_DEC <>0 // 06.11.2006 17:47 erzeugt ein Kontextmen nTZNr := IIf( sv->FIELD_DEC<0, ::TZNr + sv->FIELD_DEC + 1, ; IIf( sv->FIELD_DEC>0, sv->FIELD_DEC, ::TZNr ) ) AAdd( ::SubMenu, XbpMenu():new(::TextZeile[nTZNr]):CREATE() ) ++::SMNr ::SubMenu[::SMNr]:title := IIf(SET(43)==0,ConvToAnsiCP(Trim(sv->TEXT)),Trim(sv->TEXT)) ::SubMenu[::SMNr]:cargo := IIf(SET(43)==0,ConvToAnsiCP(Trim(sv->TEXT)),Trim(sv->TEXT)) IF sv->TAB_STOP = .T. ::TextZeile[nTZNr]:RBDown := { |mp1, mp2, obj| ; oEdit:XbpObjekt(oEdit:SubMenu,obj:caption):PopUp( obj, mp1, 2 , ; XBPMENU_PU_DEFAULT + XBPMENU_PU_MOUSE_RBDOWN ) } ELSE ::TextZeile[nTZNr]:LBDown := { |mp1, mp2, obj| ; oEdit:XbpObjekt(oEdit:SubMenu,obj:caption):PopUp( obj, mp1, 2 , ; XBPMENU_PU_DEFAULT + XBPMENU_PU_MOUSE_LBDOWN ) } ENDIF ELSE // erzeugt ein Untermen in einer MenuBar AAdd( ::SubMenu, XbpMenu():new(::MenuBar):CREATE() ) ++::SMNr ::SubMenu[::SMNr]:title := IIf(SET(43)==0,ConvToAnsiCP(Trim(sv->TEXT)),Trim(sv->TEXT)) ::MenuBar:addItem( {::SubMenu[::SMNr],NIL} ) ENDIF CASE sv->FIELD_TYPE = "u" // kleines "u" - erzeugt MenuEintr„ge cU := IIf(SET(43)==0,ConvToAnsiCP(Trim(sv->Text)),Trim(sv->Text)) ::SubMenu[::SMNr]:addItem( &cU ) CASE sv->FIELD_TYPE = "B" // erzeugt den Browser-Rahmen // ACHTUNG:18.10.2006 11:31 *nV eingefgt bei aPosT[2] !!! aPosT := {Int(sv->SpaT*nH),Int(sv->ZeiT*nV)} ; aSizeT := {Int(sv->BrT*nH),Int(sv->HoT*nV)} AAdd( ::BrowseFeld, MBrowse():new( ::BEArea[::BENr], oOwner, aPosT, aSizeT, aPP,, nA ) ) ++::BFNr ::BrowseFeld[::BFNr]:caption := IIf(SET(43)==0,ConvToAnsiCP(Trim(sv->Text)),Trim(sv->Text)) ::BrowseFeld[::BFNr]:hScroll := .T. ::BrowseFeld[::BFNr]:CREATE() ::BrowseFeld[::BFNr]:softTrack := .F. CASE sv->FIELD_TYPE = "S" // erzeugt die Browse-Spalte cFeld := Trim( sv->FIELD_NAME ) cFeld := IIf( cFeld="&", &(substr( cFeld,2,len(cFeld)-1 )), cFeld ) y := (nA)->(FieldPos( cFeld )) // y : Feld-Position in best.dbf ::BrowseFeld[::BFNr]:addColumns( ::BrowseFeld[::BFNr],, y, sv->FIELD_LEN, ; IIf(SET(43)==0,ConvToAnsiCP(Trim(sv->Text)),Trim(sv->Text)), nA ) //03.12.2006 15:29 IF Abs(sv->FIELD_DEC)>1 ::BrowseFeld[::BFNr]:getColumn(::BrowseFeld[::BFNr]:colcount):colorBlock := {|x| IIf( x < 0, {GRA_CLR_RED,}, ) } ENDIF // 25.06.2007 22:28 Test ::BrowseFeld[::BFNr]:show() IF sv->FIELD_DEC<0 ::BrowseFeld[::BFNr]:show() ENDIF ::BrowseFeld[::BFNr]:cargo := " " ::BrowseFeld[::BFNr]:getColumn(::BrowseFeld[::BFNr]:colcount):helpLink := MagicHelpLabel():New(sv->BrF) CASE sv->FIELD_TYPE = "s" // erzeugt die Browse-Spalte zum Editieren cFeld := Trim( sv->FIELD_NAME ) cFeld := IIf( cFeld="&", &(substr( cFeld,2,len(cFeld)-1 )), cFeld ) y := (nA)->(FieldPos( cFeld )) // y : Feld-Position in best.dbf cT := sv->text //20.09.2007 11:36 // ConvCP findet bei MStatic() statt 03.12.2006 16:37 cT := IIf( cT="&",&(SubStr(cT,2)),cT) //20.09.2007 11:36 IF (nA)->(IsFieldVar( cFeld )) ::BrowseFeld[::BFNr]:addGetColumns( ::BrowseFeld[::BFNr],, @(nA)->&cFeld, sv->FIELD_LEN, ; IIf(SET(43)==0,ConvToAnsiCP(Trim(cT)),Trim(cT)), nA ) //03.12.2006 15:30 ELSEIF IsMemVar( cFeld ) ::BrowseFeld[::BFNr]:addGetColumns( ::BrowseFeld[::BFNr],, @&cFeld, ; sv->FIELD_LEN, Trim(cT), nA ) ENDIF IF Abs(sv->FIELD_DEC)>1 ::BrowseFeld[::BFNr]:getColumn(::BrowseFeld[::BFNr]:colcount):colorBlock := {|x| IIf( x < 0, {GRA_CLR_RED,}, ) } ENDIF // 25.06.2007 22:28 Test ::BrowseFeld[::BFNr]:show() IF sv->FIELD_DEC<0 ::BrowseFeld[::BFNr]:show() ENDIF ::BrowseFeld[::BFNr]:getColumn(::BrowseFeld[::BFNr]:colcount):editable := !sv->TAB_STOP //20.06.2007 12:51 ::BrowseFeld[::BFNr]:cargo := " " ::BrowseFeld[::BFNr]:getColumn(::BrowseFeld[::BFNr]:colcount):helpLink := MagicHelpLabel():New(sv->BrF) CASE sv->FIELD_TYPE = "T" // erzeugt eine Textzeile nBENr := IIf( sv->FIELD_DEC<0 .AND. Abs(sv->FIELD_DEC)FIELD_DEC + 1, ; IIf( sv->FIELD_DEC>0 .AND. Abs(sv->FIELD_DEC)FIELD_DEC, ::BENr ) ) //26.11.2006 10:43 nBo := ::BEArea[nBENr]:currentSize()[2] - IIf(!Empty(::Menubar),(HoT+2),35)*nV nZeiT := IIf( sv->ZeiT < 1, nZeiT+nBz*sv->ZeiT, nBo+nBz-nBz*sv->ZeiT ) aPosT := {Int(sv->SpaT*nH), nZeiT} ; aSizeT := {Int(sv->BrT*nH),Int(sv->HoT*nV)} cT := sv->text //03.12.2006 15:31 // ConvCP findet bei MStatic() statt 03.12.2006 16:37 cT := IIf( cT="&",&(SubStr(cT,2)),cT) // AAdd( ::TextZeile, MStatic():new( ::BEArea[nBENr], oOwner, aPosT, aSizeT, aPPTxt,, ; XBPSTATIC_TYPE_TEXT, Trim(cT) ) ) // 31.10.2006 12:18 ++::TZNr IIf( nV<=1, ::TextZeile[::TZNr]:setFontCompoundName( "8.Arial" ), ) IF sv->TAB_STOP==.T. .AND. sv->HoF<0 //11.11.2006 17:18 ::TextZeile[::TZNr]:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_CENTER ELSEIF sv->TAB_STOP==.T. ::TextZeile[::TZNr]:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_LEFT ENDIF ::TextZeile[::TZNr]:create() ::TextZeile[::TZNr]:helpLink := MagicHelpLabel():New( IIf(sv->BrF!=0,sv->BrF, ; IIf( sv->FIELD_DEC!=0 .AND. Abs(sv->FIELD_DEC)>Len(::BEArea),sv->FIELD_DEC,0))) //26.11.2006 10:37 ::TextZeile[::TZNr]:cargo := Trim(sv->FIELD_NAME) IF Val(sv->ZAHL_FORM)>0 .AND. Val(sv->ZAHL_FORM)<16 .OR. ","$sv->ZAHL_FORM ::TextZeile[::TZNr]:setColorFG( IIf("."$sv->ZAHL_FORM, ; Val(SubStr(sv->ZAHL_FORM, 1, At(".",sv->ZAHL_FORM)-1)), GRA_CLR_BLACK )) ::TextZeile[::TZNr]:setColorBG( IIf("."$sv->ZAHL_FORM .AND. .NOT. ","$sv->ZAHL_FORM, ; Val(SubStr(sv->ZAHL_FORM, At(".",sv->ZAHL_FORM)+1,2)), ; IIf(","$sv->ZAHL_FORM, GraMakeRGBColor( ; IIf("."$sv->ZAHL_FORM, &("{"+Trim(SubStr(sv->ZAHL_FORM, At(".",sv->ZAHL_FORM)+1))+"}"), ; &("{"+Trim(sv->ZAHL_FORM)+"}") )), ; XBPSYSCLR_DIALOGBACKGROUND ) )) ENDIF CASE sv->FIELD_TYPE = "P" // erzeugt die PushButtons nBo := ::BEArea[::BENr]:currentSize()[2] - IIf(!Empty(::Menubar),(HoT+2),35)*nV nZeiT := IIf( sv->ZeiT < 1, nZeiT+nBz*sv->ZeiT, nBo+nBz-nBz*sv->ZeiT ) aPosT := {Int(sv->SpaT*nH), nZeiT } ; aSizeT := {Int(sv->BrT*nH),Int(sv->HoT*nV)} AAdd( ::DruckKnopf, MPButton():new( ::BEArea[::BENr], oOwner, aPosT, aSizeT,,,Trim(sv->TEXT), ; IIf(SET(43)==0,ConvToAnsiCP(Trim(sv->FIELD_NAME)),Trim(sv->FIELD_NAME)), ; @aData1, nFontR, nA, sv->TAB_STOP ) ) //03.12.2006 16:44 ++::DKNr ::DruckKnopf[::DKNr]:CREATE() ::DruckKnopf[::DKNr]:helpLink := MagicHelpLabel():New(sv->FIELD_DEC) ::DruckKnopf[::DKNr]:cargo := Trim( sv->FIELD_NAME ) CASE sv->FIELD_TYPE = "p" // erzeugt die PushButtons mit eigenem Window nBo := ::BEArea[1]:cargo:currentSize()[2]-60// - IIf(!Empty(::Menubar),(HoT+2),25)*nV // nZeiT := IIf( sv->ZeiT < 1, nZeiT+nBz*sv->ZeiT, nBo+nBz-nBz*sv->ZeiT ) aPosT := {Int(sv->SpaT*nH), nBo } ; aSizeT := {Int(sv->BrT*nH),Int(sv->HoT*nV)} oXbpD := XbpDialog():new( ::BEArea[1], ::BEArea[1]:cargo, aPosT, aSizeT, aPPTxt,, ) oXbpD:minButton := .F. oXbpD:maxButton := .F. oXbpD:sysMenu := .F. oXbpD:titleBar := .F. oXbpD:border := sv->FIELD_LEN + 3 // 3 = XBPDLG_THINBORDER, 1 = XBPDLG_NO_BORDER oXbpD:CREATE() AAdd( ::DruckKnopf, MPButton():new( oXbpD:drawingArea, oOwner, {0,0}, aSizeT,,,Trim(sv->TEXT), ; IIf(SET(43)==0,ConvToAnsiCP(Trim(sv->FIELD_NAME)),Trim(sv->FIELD_NAME)), ; @aData1, nFontR, nA, sv->TAB_STOP ) ) //03.12.2006 16:44 ++::DKNr ::DruckKnopf[::DKNr]:CREATE() ::DruckKnopf[::DKNr]:helpLink := MagicHelpLabel():New(sv->FIELD_DEC) ::DruckKnopf[::DKNr]:cargo := Trim( sv->FIELD_NAME ) CASE sv->FIELD_TYPE = "X" // erzeugt die ListBox-Objekte // 10.3.2004 nBo := ::BEArea[::BENr]:currentSize()[2] - IIf(!Empty(::Menubar),(HoT+2),35)*nV nZeiF := IIf( sv->ZeiF < 1, nZeiF+nBz*sv->ZeiF, nBo+nBz-nBz*sv->ZeiF ) // nZeiT := IIf( sv->ZeiT < 1, nZeiT+nBz*sv->ZeiT, nBo+nBz-nBz*sv->ZeiT ) aPosF := {Int(sv->SpaF*nH), nZeiF} ; aSizeF := {Int(sv->BrF*nH),Int(sv->HoF*nV)} // aPosT := {Int(sv->SpaT*nV), nZeiT} ; aSizeT := {Int(sv->BrT*nV),Int(sv->HoT*nV)} AAdd( ::ListBox, XbpListBox():new( ::BEArea[::BENr], oOwner, aPosF, aSizeF, aPPSle )) ++::LBNr ::ListBox[::LBNr]:create() ::ListBox[::LBNr]:helpLink := MagicHelpLabel():New(sv->FIELD_DEC) IF !Empty( sv->FIELD_LEN ) // 20.08.2006 15:52 ::ListBox[::LBNr]:setItemsHeight( sv->FIELD_LEN * nV * 1.02 ) ENDIF ::ListBox[::LBNr]:cargo := Trim( sv->FIELD_NAME ) CASE sv->FIELD_TYPE = "M" // erzeugt die Mle-Objekte nBo := ::BEArea[::BENr]:currentSize()[2] - IIf(!Empty(::Menubar),(HoT+2),35)*nV nZeiF := IIf( sv->ZeiF < 1, nZeiF+nBz*sv->ZeiF, nBo+nBz-nBz*sv->ZeiF ) nZeiT := IIf( sv->ZeiT < 1, nZeiT+nBz*sv->ZeiT, nBo+nBz-nBz*sv->ZeiT ) aPosF := {Int(sv->SpaF*nH), nZeiF} ; aSizeF := {Int(sv->BrF*nH),Int(sv->HoF*nV)} aPosT := {Int(sv->SpaT*nH), nZeiT} ; aSizeT := {Int(sv->BrT*nH),Int(sv->HoT*nV)} cFeld := Trim( sv->FIELD_NAME ) cPic := IIf( sv->FIELD_TYPE != "C", Trim(sv->ZAHL_FORM), NIL ) IF (nA)->(IsFieldVar( cFeld )) // 26.4.03 y := (nA)->(FieldPos( cFeld )) // y : Feld-Position in best.dbf/vv.dbf ... AAdd( ::MultiZeile, MMleXR():new( ::BEArea[::BENr], oOwner, aPosF, aSizeF, aPPSle,, ; @(nA)->&cFeld, sv->FIELD_LEN, sv->TAB_STOP, cPic, ; Trim(sv->TEXT), aPosT, aSizeT, aPPTxt, nA ) ) ++::MZNr ::MultiZeile[::MZNr]:cargo := Trim( sv->FIELD_NAME ) ::MultiZeile[::MZNr]:CREATE() //1.1.2005###################:setData() ::MultiZeile[::MZNr]:helpLink := MagicHelpLabel():New(sv->FIELD_DEC) ::MultiZeile[::MZNr]:setName( y ) ::addEditControl( ::MultiZeile[::MZNr] ) ELSEIF IsMemberVar( self, cFeld ) AAdd( ::MultiZeile, MMleXR():new( ::BEArea[::BENr], oOwner, aPosF, aSizeF, aPPSle,, ; @oEdit:&cfeld, sv->FIELD_LEN, sv->TAB_STOP, cPic, ; Trim(sv->TEXT), aPosT, aSizeT, aPPTxt, nA ) ) ++::MZNr ::MultiZeile[::MZNr]:cargo := Trim( sv->FIELD_NAME ) ::MultiZeile[::MZNr]:CREATE() //1.1.2005###################:setData() ::MultiZeile[::MZNr]:helpLink := MagicHelpLabel():New(sv->FIELD_DEC) ::MultiZeile[::MZNr]:setName( ++::aFNr ) // oberhalb der y-Werte ::addEditControl( ::MultiZeile[::MZNr] ) ELSEIF IsMemVar( cFeld ) AAdd( ::MultiZeile, MMleXR():new( ::BEArea[::BENr], oOwner, aPosF, aSizeF, aPPSle,, ; @&cFeld, sv->FIELD_LEN, sv->TAB_STOP, cPic, ; Trim(sv->TEXT), aPosT, aSizeT, aPPTxt, nA ) ) ++::MZNr ::MultiZeile[::MZNr]:cargo := Trim( sv->FIELD_NAME ) ::MultiZeile[::MZNr]:CREATE() //1.1.2005###################:setData() ::MultiZeile[::MZNr]:helpLink := MagicHelpLabel():New(sv->FIELD_DEC) ::MultiZeile[::MZNr]:setName( ++::aFNr ) // oberhalb der y-Werte ::addEditControl( ::MultiZeile[::MZNr] ) ENDIF CASE sv->FIELD_TYPE = "C" .OR. sv->FIELD_TYPE = "N" .OR. sv->FIELD_TYPE = "D" ; .OR. sv->FIELD_TYPE = "L" // erzeugt Sle mit MGETXR nBo := ::BEArea[::BENr]:currentSize()[2] - IIf(!Empty(::Menubar),(HoT+2),35)*nV nZeiF := IIf( sv->ZeiF < 1, nZeiF+nBz*sv->ZeiF, nBo+nBz-nBz*sv->ZeiF ) nZeiT := IIf( sv->ZeiT < 1, nZeiT+nBz*sv->ZeiT, nBo+nBz-nBz*sv->ZeiT ) aPosF := {Int(sv->SpaF*nH), nZeiF} ; aSizeF := {Int(sv->BrF*nH),Int(sv->HoF*nV)} aPosT := {Int(sv->SpaT*nH), nZeiT} ; aSizeT := {Int(sv->BrT*nH),Int(sv->HoT*nV)} cFeld := Trim( sv->FIELD_NAME ) cFeld := IIf( cFeld="&", &(substr( cFeld,2,len(cFeld)-1 )), cFeld ) cPic := IIf( sv->FIELD_TYPE != "C", Trim(sv->ZAHL_FORM), NIL ) IF (nA)->(IsFieldVar( cFeld )) // 26.4.03 y := (nA)->(FieldPos( cFeld )) // y : Feld-Position in WorkArea nA AAdd( ::SingleZeile, MGetXR():new( ::BEArea[::BENr], oOwner, aPosF, aSizeF, aPPSle,, ; @(nA)->&cFeld, sv->FIELD_LEN, sv->TAB_STOP, cPic, ; Trim(sv->TEXT), aPosT, aSizeT, aPPTxt, nA ) ) ++::SZNr ::SingleZeile[::SZNr]:CREATE() //1.1.2005###################:setdata() ::SingleZeile[::SZNr]:helpLink := MagicHelpLabel():New(sv->FIELD_DEC) ::SingleZeile[::SZNr]:setName( y ) ::SingleZeile[::SZNr]:cargo := Trim( sv->FIELD_NAME ) ::addEditControl( ::SingleZeile[::SZNr] ) ::StartFocus := IIf( sv->ZAHL_FORM[1]="F", sv->ZAHL_FORM[2], ::StartFocus ) ////// ELSEIF IsMemberVar( self, cFeld ) // Ur-Version: 21.08.2006 13:47 ////// AAdd( ::SingleZeile, MGetXR():new( ::BEArea[::BENr], oOwner, aPosF, aSizeF, aPPSle,, ; ////// @oEdit:&(cfeld), sv->FIELD_LEN, sv->TAB_STOP, cPic, ; ////// Trim(sv->TEXT), aPosT, aSizeT, aPPTxt, nA ) ) ////// ++::SZNr ////// ::SingleZeile[::SZNr]:CREATE() //1.1.2005###################:setdata() ////// ::SingleZeile[::SZNr]:helpLink := MagicHelpLabel():New(sv->FIELD_DEC) ////// ::SingleZeile[::SZNr]:setName( ++::aFNr ) // oberhalb der y-Werte ////// ::SingleZeile[::SZNr]:cargo := Trim( sv->FIELD_NAME ) ////// ::addEditControl( ::SingleZeile[::SZNr] ) ////// ::StartFocus := IIf( sv->ZAHL_FORM[1]="F", sv->ZAHL_FORM[2], ::StartFocus ) ELSEIF IsMemberVar( self, IIf("["$cFeld,SubStr(cFeld,1,At("[",cFeld)-1), cFeld ) ) //19.08.2006 21:09 cF := ("oEdit:"+cFeld) IF ValType( &cF ) == "C" //24.08.2006 19:06 &cF := PadR( &cF, sv->FIELD_LEN ) ENDIF AAdd( ::SingleZeile, MGetXR():new( ::BEArea[::BENr], oOwner, aPosF, aSizeF, aPPSle,, ; @&cf, sv->FIELD_LEN, sv->TAB_STOP, cPic, ; Trim(sv->TEXT), aPosT, aSizeT, aPPTxt, nA ) ) ++::SZNr ::SingleZeile[::SZNr]:CREATE() //1.1.2005###################:setdata() ::SingleZeile[::SZNr]:helpLink := MagicHelpLabel():New(sv->FIELD_DEC) ::SingleZeile[::SZNr]:setName( ++::aFNr ) // oberhalb der y-Werte ::SingleZeile[::SZNr]:cargo := Trim( sv->FIELD_NAME ) ::addEditControl( ::SingleZeile[::SZNr] ) ::StartFocus := IIf( sv->ZAHL_FORM[1]="F", sv->ZAHL_FORM[2], ::StartFocus ) ELSEIF IsMemVar( cFeld ) IF ValType( &cFeld ) == "C" //24.08.2006 19:06 &cFeld := PadR( &cFeld, sv->FIELD_LEN ) ENDIF AAdd( ::SingleZeile, MGetXR():new( ::BEArea[::BENr], oOwner, aPosF, aSizeF, aPPSle,, ; @&cFeld, sv->FIELD_LEN, sv->TAB_STOP, cPic, ; Trim(sv->TEXT), aPosT, aSizeT, aPPTxt, nA ) ) ++::SZNr ::SingleZeile[::SZNr]:unreadable := IIf( sv->ZAHL_FORM="****", .T., .F. ) //06.04.2007 22:38 ::SingleZeile[::SZNr]:CREATE() //1.1.2005###################:setdata() ::SingleZeile[::SZNr]:helpLink := MagicHelpLabel():New(sv->FIELD_DEC) ::SingleZeile[::SZNr]:setName( ++::aFNr ) // oberhalb der y-Werte ::SingleZeile[::SZNr]:cargo := Trim( sv->FIELD_NAME ) ::addEditControl( ::SingleZeile[::SZNr] ) ::StartFocus := IIf( sv->ZAHL_FORM[1]="F", sv->ZAHL_FORM[2], ::StartFocus ) ENDIF // die Variablen mit kleinem c,n,d,l sind nur fr XbpSle-Anzeige-Felder gedacht: CASE sv->FIELD_TYPE = "c" .OR. sv->FIELD_TYPE = "n" .OR. sv->FIELD_TYPE = "d" ; .OR. sv->FIELD_TYPE = "l" // erzeugt Sle nBo := ::BEArea[::BENr]:currentSize()[2] - IIf(!Empty(::Menubar),(HoT+2),35)*nV nZeiF := IIf( sv->ZeiF < 1, nZeiF+nBz*sv->ZeiF, nBo+nBz-nBz*sv->ZeiF ) nZeiT := IIf( sv->ZeiT < 1, nZeiT+nBz*sv->ZeiT, nBo+nBz-nBz*sv->ZeiT ) aPosF := {Int(sv->SpaF*nH), nZeiF} ; aSizeF := {Int(sv->BrF*nH),Int(sv->HoF*nV)} aPosT := {Int(sv->SpaT*nH), nZeiT} ; aSizeT := {Int(sv->BrT*nH),Int(sv->HoT*nV)} cFeld := Trim( sv->FIELD_NAME ) cFeld := IIf( cFeld="&", &(substr( cFeld,2,len(cFeld)-1 )), cFeld ) cPic := IIf( sv->FIELD_TYPE != "c".OR.sv->ZAHL_FORM[1]="@", Trim(sv->ZAHL_FORM), NIL ) IF (nA)->(IsFieldVar( cFeld )) // 26.4.03 y := (nA)->(FieldPos( cFeld )) // y : Feld-Position in WorkArea nA AAdd( ::SingleZeile, MGet():new( ::BEArea[::BENr], oOwner, aPosF, aSizeF, aPPSle,, ; @(nA)->&cFeld, sv->FIELD_LEN, sv->TAB_STOP, cPic, ; Trim(sv->TEXT), aPosT, aSizeT, aPPTxt, nA ) ) ++::SZNr ::SingleZeile[::SZNr]:CREATE() //1.1.2005###################:setdata() ::SingleZeile[::SZNr]:helpLink := MagicHelpLabel():New(sv->FIELD_DEC) ::SingleZeile[::SZNr]:setName( y ) ::SingleZeile[::SZNr]:cargo := Trim( sv->FIELD_NAME ) ::addEditControl( ::SingleZeile[::SZNr] ) ::StartFocus := IIf( sv->ZAHL_FORM[1]="F", sv->ZAHL_FORM[2], ::StartFocus ) ELSEIF IsMemberVar( self, cFeld ) selfeld := cFeld AAdd( ::SingleZeile, MGet():new( ::BEArea[::BENr], oOwner, aPosF, aSizeF, aPPSle,, ; @oEdit:&cfeld, sv->FIELD_LEN, sv->TAB_STOP, cPic, ; Trim(sv->TEXT), aPosT, aSizeT, aPPTxt, nA ) ) ++::SZNr ::SingleZeile[::SZNr]:CREATE() //1.1.2005###################:setdata() ::SingleZeile[::SZNr]:helpLink := MagicHelpLabel():New(sv->FIELD_DEC) ::SingleZeile[::SZNr]:setName( ++::aFNr ) // oberhalb der y-Werte ::SingleZeile[::SZNr]:cargo := Trim( sv->FIELD_NAME ) ::addEditControl( ::SingleZeile[::SZNr] ) ::StartFocus := IIf( sv->ZAHL_FORM[1]="F", sv->ZAHL_FORM[2], ::StartFocus ) ELSEIF IsMemVar( cFeld ) AAdd( ::SingleZeile, MGet():new( ::BEArea[::BENr], oOwner, aPosF, aSizeF, aPPSle,, ; @&cFeld, sv->FIELD_LEN, sv->TAB_STOP, cPic, ; Trim(sv->TEXT), aPosT, aSizeT, aPPTxt, nA ) ) ++::SZNr ::SingleZeile[::SZNr]:CREATE() //1.1.2005###################:setdata() ::SingleZeile[::SZNr]:helpLink := MagicHelpLabel():New(sv->FIELD_DEC) ::SingleZeile[::SZNr]:setName( ++::aFNr ) // oberhalb der y-Werte ::SingleZeile[::SZNr]:cargo := Trim( sv->FIELD_NAME ) ::addEditControl( ::SingleZeile[::SZNr] ) ::StartFocus := IIf( sv->ZAHL_FORM[1]="F", sv->ZAHL_FORM[2], ::StartFocus ) ENDIF CASE sv->FIELD_TYPE = "o" // fr XbpCheckBox nBo := ::BEArea[::BENr]:currentSize()[2] - IIf(!Empty(::Menubar),(HoT+2),35)*nV nZeiF := IIf( sv->ZeiF < 1, nZeiF+nBz*sv->ZeiF, nBo+nBz-nBz*sv->ZeiF ) nZeiT := IIf( sv->ZeiT < 1, nZeiT+nBz*sv->ZeiT, nBo+nBz-nBz*sv->ZeiT ) aPosF := {Int(sv->SpaF*nH), nZeiF} ; aSizeF := {Int(sv->BrF*nH),Int(sv->HoF*nV)} aPosT := {Int(sv->SpaT*nH), nZeiT} ; aSizeT := {Int(sv->BrT*nH),Int(sv->HoT*nV)} cFeld := Trim( sv->FIELD_NAME ) cFeld := IIf( cFeld="&", &(substr( cFeld,2,len(cFeld)-1 )), cFeld ) cPic := IIf( sv->FIELD_TYPE != "c", Trim(sv->ZAHL_FORM), NIL ) IF (nA)->(IsFieldVar( cFeld )) // 26.4.03 y := (nA)->(FieldPos( cFeld )) // y : Feld-Position in WorkArea nA AAdd( ::LogikKnopf, MCheck():new( ::BEArea[::BENr], oOwner, aPosF, aSizeF, aPPSle,, ; y, sv->FIELD_LEN, sv->TAB_STOP,; Trim(sv->TEXT), aPosT, aSizeT, aPPTxt, nA ) ) ++::LKNr ::LogikKnopf[::LKNr]:CREATE() // ::LogikKnopf[::LKNr]:helpLink := MagicHelpLabel():New(sv->FIELD_DEC) ::LogikKnopf[::LKNr]:setName( y ) ::LogikKnopf[::LKNr]:cargo := Trim( sv->FIELD_NAME ) ::addEditControl( ::LogikKnopf[::LKNr] ) ELSEIF IsMemberVar( self, cFeld ) AAdd( ::LogikKnopf, XbpCheckBox():new( ::BEArea[::BENr], oOwner, aPosF, aSizeF, aPPSle) ) ++::LKNr ::LogikKnopf[::LKNr]:dataLink := {|x| IIf( PCOUNT()==0, ; oEdit:&cFeld, oEdit:&cFeld := x ) } ::LogikKnopf[::LKNr]:caption := sv->Text ::LogikKnopf[::LKNr]:CREATE() // ::LogikKnopf[::LKNr]:helpLink := MagicHelpLabel():New(sv->FIELD_DEC) ::LogikKnopf[::LKNr]:setName( ++::aFNr ) ::LogikKnopf[::LKNr]:cargo := Trim( sv->FIELD_NAME ) ::addEditControl( ::LogikKnopf[::LKNr] ) ELSEIF IsMemVar( cFeld ) AAdd( ::LogikKnopf, XbpCheckBox():new( ::BEArea[::BENr], oOwner, aPosF, aSizeF, aPPSle) ) ++::LKNr ::LogikKnopf[::LKNr]:dataLink := {|x| IIf( PCOUNT()==0, ; &cFeld, &cFeld := x ) } ::LogikKnopf[::LKNr]:caption := sv->Text ::LogikKnopf[::LKNr]:CREATE() // ::LogikKnopf[::LKNr]:helpLink := MagicHelpLabel():New(sv->FIELD_DEC) ::LogikKnopf[::LKNr]:setName( ++::aFNr ) ::LogikKnopf[::LKNr]:cargo := Trim( sv->FIELD_NAME ) ::addEditControl( ::LogikKnopf[::LKNr] ) ENDIF CASE sv->FIELD_TYPE = "i" // fr XbpSpinButton nBo := ::BEArea[::BENr]:currentSize()[2] - IIf(!Empty(::Menubar),(HoT+2),35)*nV nZeiF := IIf( sv->ZeiF < 1, nZeiF+nBz*sv->ZeiF, nBo+nBz-nBz*sv->ZeiF ) nZeiT := IIf( sv->ZeiT < 1, nZeiT+nBz*sv->ZeiT, nBo+nBz-nBz*sv->ZeiT ) aPosF := {Int(sv->SpaF*nH), nZeiF} ; aSizeF := {Int(sv->BrF*nH),Int(sv->HoF*nV)} aPosT := {Int(sv->SpaT*nH), nZeiT} ; aSizeT := {Int(sv->BrT*nH),Int(sv->HoT*nV)} cFeld := Trim( sv->FIELD_NAME ) cFeld := IIf( cFeld="&", &(substr( cFeld,2,len(cFeld)-1 )), cFeld ) AAdd( ::TextZeile, MStatic():new( ::BEArea[::BENr], oOwner, aPosT, aSizeT, aPPTxt,, ; XBPSTATIC_TYPE_TEXT, Trim(sv->TEXT) ) ) ++::TZNr IIf( nV<=1, ::TextZeile[::TZNr]:setFontCompoundName( "8.Arial" ), ) ::TextZeile[::TZNr]:create() ::TextZeile[::TZNr]:helpLink := MagicHelpLabel():New(sv->FIELD_DEC) AAdd( ::SpinKnopf, XbpSpinButton():new( ::BEArea[::BENr], oOwner, aPosF, aSizeF, aPPSle) ) ++::SKNr ::SpinKnopf[::SKNr]:datalink := {|x| IIf( PCOUNT()==0, ; &(cFeld), &(cFeld) := x ) } ::SpinKnopf[::SKNr]:CREATE() //:setData(&cFeld) ::SpinKnopf[::SKNr]:setNumLimits( Val(SubStr(sv->zahl_form,1,At(",",sv->zahl_form)-1)), ; Val(SubStr(sv->zahl_form,At(",",sv->zahl_form)+1))) ::SpinKnopf[::SKNr]:cargo := Trim( sv->FIELD_NAME ) ::SpinKnopf[::SKNr]:setName( ++::aFNr ) ::addEditControl( ::SpinKnopf[::SKNr] ) CASE sv->FIELD_TYPE = "k" // erzeugt die killInputFocus-Bl”cke cFeld := Trim( sv->FIELD_NAME ) //***11.4.04 cFeld := IIf( cFeld="&", &(substr( cFeld,2,len(cFeld)-1 )), cFeld ) y := ::XbpNummer( ::SingleZeile, cFeld ) // ergibt die Nummer aus :setName() IF y > 0 // der CodeBlock-TEIL (in sv->Text) wird an das Objekt gebunden und als &cT ausgefhrt: // (mehrere Funktionen hintereinander mssen in sv->TEXT zu einem Array gebunden werden) ::SingleZeile[y]:killer := Trim( sv->TEXT ) ::SingleZeile[y]:killInputFocus := ; {|mp1,mp2,obj,cA| DeHiliteSle( obj ), ; IIf(obj:changed, {oCB:cargo:writeData(), ; cT := obj:killer, &cT, ; oCB:cargo:readData()},) } // oCB gibt es in allen Masken! //// IIf(obj:changed, { bT := obj:killer, &bT },) } ::SingleZeile[y]:helpLink := MagicHelpLabel():New(sv->FIELD_DEC) ELSE y := ::XbpNummer( ::MultiZeile, cFeld ) // ergibt die Nummer aus :setName() IF y > 0 // der CodeBlock-TEIL (in sv->Text) wird an das Objekt gebunden und als &cT ausgefhrt: // (mehrere Funktionen hintereinander mssen in sv->TEXT zu einem Array gebunden werden) ::MultiZeile[y]:killer := Trim( sv->TEXT ) ::MultiZeile[y]:killInputFocus := ; {|mp1,mp2,obj,cA| DeHiliteSle( obj ), ; IIf(obj:changed, {oCB:cargo:writeData(), ; cT := obj:killer, &cT, ; oCB:cargo:readData()},) } // oCB gibt es in allen Masken! //// IIf(obj:changed, { bT := obj:killer, &bT },) } ::MultiZeile[y]:helpLink := MagicHelpLabel():New(sv->FIELD_DEC) ENDIF ENDIF CASE sv->FIELD_TYPE = "K" // erzeugt die killInputFocus-Bl”cke im Edit-Browser 18.1.2004 cFeld := Trim( sv->FIELD_NAME ) //***11.4.04 cFeld := IIf( cFeld="&", &(substr( cFeld,2,len(cFeld)-1 )), cFeld ) y := ::BrowseSpalte( ::BrowseFeld[1], cFeld ) // ergibt die Nummer aus :setName() IF y > 0 // der CodeBlock (in sv->Text) wird an das Objekt gebunden und als &bT ausgefhrt: bT := Trim( sv->TEXT ) ::BrowseFeld[1]:getcolumn(y):killer := &bT //// die n„chsten Zeilen werden nicht gebraucht: write() und read() passiert automatisch ! //// ::BrowseFeld[1]:getcolumn(y):killInputFocusSle := ; //// {|mp1,mp2,obj,cA| ; //// IIf(obj:changed, {oCB:cargo:writeData(), cA := SELECT(), ; //// bT := oEdit:BrowseFeld[1]:getcolumn(4):killer, &bT, ; //// DbSelectArea( cA ), oCB:cargo:readData()},) } // oBEDA gilt nur fr Hauptmaske! ENDIF CASE sv->FIELD_TYPE = "e" // erzeugt die editable-Variablen cFeld := Trim( sv->FIELD_NAME ) // ! 3.4.04 cFeld := IIf( cFeld="&", &(substr( cFeld,2,len(cFeld)-1 )), cFeld ) y := ::XbpNummer( ::SingleZeile, cFeld ) // ergibt die Nummer aus :setName() IF y > 0 ::SingleZeile[y]:editable := sv->TAB_STOP ::SingleZeile[y]:helpLink := MagicHelpLabel():New(sv->FIELD_DEC) ENDIF // IF (nA)->(IsFieldVar( cFeld )) // 26.4.03 // oParent:childFromName( 1->(FieldPos( cFeld )) ):editable := sv->TAB_STOP // ENDIF // oParent:childFromName( 1->(FieldPos( cFeld )) ):helpLink := MagicHelpLabel():New(sv->FIELD_DEC) CASE sv->FIELD_TYPE = "v" // Makro: erzeugt Variable, ggf. mit Inhalt cFeld := Trim( sv->TEXT ) cFeld := IIf( cFeld="&", &(substr( cFeld,2,len(cFeld)-1 )), &cFeld ) ENDCASE sv->(DbSkip()) ENDDO sv->(DbCloseArea()) ::startFocus := IIf( Empty(::startFocus), "5", ::startFocus ) IF Len(::singleZeile) >= Val(::startFocus) .AND. Val(::startFocus) > 0 // 19.12.2004 ::oFocLFSle := ::singleZeile[Val(::startFocus)] ENDIF SELECT &nOldArea //???? DBRegisterClient(self) IF cSystem == "S" .AND. "MENG"$Upper(AppName()) // 14.2.2005: bei Menge, wenn mit s-t-a gestartet wird QOut("DialogFF-Ende:"+Time()) ENDIF //???? RETURN self METHOD DialogFF:destroy( nA ) //?????? (nA)->(DbDeregisterClient()) ::killTip() // 04.08.2004 ASize( ::BEArea, 0 ) ::BENr := 0 ASize( ::BrowseFeld, 0 ) ::BFNr := 0 // ASize( ::BVariable, 0 ) // ::BVNr := 0 ASize( ::GruppenBox, 0 ) ::GBNr := 0 ASize( ::TextZeile, 0 ) ::TZNr := 0 ASize( ::DruckKnopf, 0 ) ::DKNr := 0 ASize( ::MultiZeile, 0 ) ::MZNr := 0 ASize( ::SingleZeile, 0 ) ::SZNr := 0 ASize( ::editControls, 0 ) ASize( ::appendControls, 0 ) ASize( ::keyControls, 0 ) ::keyboardBlock := {|nKey,x,obj| 0 } RETURN self METHOD DialogFF:addEditcontrol( oXbp ) IF AScan( ::editControls, oXbp ) == 0 AAdd( ::editControls, oXbp ) ::addKeyControl( oXbp ) ENDIF RETURN self METHOD DialogFF:addAppendControl( oXbp ) IF AScan( ::appendControls, oXbp ) == 0 AAdd( ::appendControls, oXbp ) ::addKeyControl( oXbp ) ENDIF RETURN self METHOD DialogFF:addKeyControl( oXbp ) IF AScan( ::keyControls, oXbp ) == 0 AAdd( ::keyControls, oXbp ) oXbp:keyBoard := ::keyboardBlock ENDIF RETURN self //METHOD DialogFF:notify( nEvent, mp1, mp2 ) // ::AKDialog():notify( nEvent, mp1, mp2 ) //RETURN self METHOD DialogFF:XbpNummer( aObj, cVarName ) // ergibt die Nummer aus :setName() LOCAL y := 0 DEFAULT aObj TO ::singleZeile //03.06.2007 17:37 AEval( aObj, {|x,i| y := IIf( Upper(x:cargo)==Upper(cVarName), i, y ) } ) RETURN y METHOD DialogFF:XbpObjekt( aObj, cVarName ) // ergibt das Object LOCAL o := NIL DEFAULT aObj TO ::singleZeile //03.06.2007 17:37 AEval( aObj, {|x,i| o := IIf( ValType(x:cargo)="C" .AND. Upper(x:cargo)==Upper(cVarName), x, o ) } ) RETURN o METHOD DialogFF:XbpObjektSet( aObj, cVarName, cVal ) // setData in alle Objects mit cVarName LOCAL o := NIL, xVal DEFAULT aObj TO ::singleZeile //03.06.2007 17:37 AEval( aObj, {|x,i| IIf( ValType(x:cargo)="C" .AND. Upper(x:cargo)==Upper(cVarName), ; xVal:=IIf(cVal=NIL,x:setData(),x:setData(cVal)), ) } ) //05.11.2006 13:30 mehrere Sles fr eine Variable RETURN xVal METHOD DialogFF:XbpObjektGet( aObj, cVarName ) // getData aus allen Objects mit cVarName LOCAL o := NIL DEFAULT aObj TO ::singleZeile //03.06.2007 17:37 PRIVATE xVar AEval( aObj, {|x,i| IIf( ValType(x:cargo)="C" .AND. Upper(x:cargo)==Upper(cVarName), ; xVar := x:getData(), ) } ) //05.11.2006 13:30 mehrere Sles fr eine Variable RETURN xVar METHOD DialogFF:BrowseSpalte( oBrow, cVarName ) // ergibt die Spalte des Sle im Browser LOCAL y := 0 FOR y := 1 TO oBrow:colCount IF oBrow:getcolumn(y):cargo == cVarName RETURN y ENDIF NEXT RETURN 0 METHOD DialogFF:Neu( oDlg1, nA ) (nA)->(DbAppend()) (nA)->(DbGotop()) (nA)->(DbSkip(0)) RETURN self METHOD DialogFF:Entf( oDlg1, nA ) IF ConfirmBox( oDlg1, "Soll der Datensatz gel”scht werden?", ; "Datensatz l”schen", ; XBPMB_YESNO, ; XBPMB_QUESTION ) == XBPMB_RET_YES Satzsp( oCB ) (nA)->(DbDelete()) // (nA)->(DbSkip(0)) (nA)->(DbSkip(-1)) // 21.6.2005 zum Test RETURN self ENDIF RETURN self // vor Aufruf von ::Such in die nA-Area wechseln! : METHOD DialogFF:Such( oDlg1, cProg, nAnf, nEnd, nA, nRec, aPos, ASize, aPP, cTitel, cS ) //16.04.2006 12:56 LOCAL oDlg, nEvent, mp1, mp2, oBrowse //, cArtLei := Trim(" ") LOCAL nOldArea := Select(), oFocus := SetAppFocus(), oFoc LOCAL lFlucht := .F. // 3.2.2005 LOCAL cSuchWort := IIf(Empty(cS), "", ; IIf((OrdKey()="ADRSCHL + TXNAME + DtoS(DATUM)" .OR. ; OrdKey()="N1 + TXNAME + ADRSCHL").AND. RecNo()>1,cS, ; IIf(cS[1]="!",PadR(cS,10),""))) // 16.04.2006 21:20 PRIVATE oCB DEFAULT aPos TO {10*nH,30*nV} , ASize TO {int(330*nH),int(250*nV)} DEFAULT cTitel TO "Suchwort tippen/ausw„hlen ( = zurck) :" oDlg := AKDialog():new( AppDesktop(), oDlg1:cargo ) oDlg:tasklist := .T. oDlg:title := cTitel oDlg:maxButton := .F. oDlg:border := XBPDLG_RAISEDBORDERTHIN_FIXED oDlg:create(,, aPos, ASize ) oDlg:drawingArea:setColorBG( GRA_CLR_DARKCYAN ) oCB := oDlg:drawingArea oCB:cargo := oDlg ////////// (nA)->(DbSuspendNotifications()) // 28.02.2006 geremt // jetzt folgt die Erzeugung der Eingabefelder oBrowse := DialogFF():new( oCB,oDlg, , ,,, nBz, cProg, nAnf, nEnd, nA ) oBrowse:Fancy := "" oBrowse:VArea := nA oBrowse:BEArea := {} AAdd( oBrowse:BEArea, oCB ) oBrowse:BENr := Len( oBrowse:BEArea ) // 28.02.2006 geremt oBrowse:CREATE( oCB,oDlg, , ,aPP,, nBz, cProg, nAnf, nEnd, nA ) // bis hierhin geht die Erzeugung der Eingabefelder AEval( oBrowse:editControls, {|x| oDlg:addEditControl( x ) } ) // 28.02.2006 oDlg:setModalState( XBP_DISP_APPMODAL ) oDlg:show() SetAppFocus( oBrowse:BrowseFeld[1] ) nEvent := xbeP_None DO WHILE nEvent <> xbeP_Close nEvent := AppEvent( @mp1, @mp2, @oXbp ) IF nEvent == xbeBRW_ItemSelected PostAppEvent( xbeP_Close) ENDIF IF nEvent == xbeP_Keyboard DO CASE CASE mp1 >= Asc(" ") .and. mp1 <= Asc("z") .AND. "tippen"$cTitel // 29.04.2007 15:41 cSuchWort += Chr(mp1) DbSeek( Upper(cSuchWort), .T. ) IF !Found() DbSkip(-1) ENDIF oBrowse:BrowseFeld[1]:refreshAll() CASE mp1 == xbeK_RETURN .or. mp1 == xbeK_F10 .OR. mp1 == xbeK_TAB //02.09.2006 17:30 PostAppEvent( xbeP_Close) CASE mp1 == xbeK_ESC lFlucht := .T. PostAppEvent( xbeP_Close) // hier F5/F6 einbauen fr die Bestatter <================================================= CASE mp1 == xbeK_F5 .OR. mp1 == xbeK_CTRL_F5 .AND. Upper(cProg)=="S_RECH" IF !14->(Bof()) 14->(DbSkip(-1)) ENDIF 6->(DbSeek( 14->art )) oBrowse:BrowseFeld[1]:refreshAll() CASE mp1 == xbeK_F6 .OR. mp1 == xbeK_CTRL_F6 .AND. Upper(cProg)=="S_RECH" IF !14->(Eof()) 14->(DbSkip()) ENDIF 6->(DbSeek( 14->art )) oBrowse:BrowseFeld[1]:refreshAll() CASE mp1 == xbeK_CTRL_DEL oFoc := SetAppFocus() IF ConfirmBox( oDlg1, "Soll der Datensatz wirklich gel”scht werden?", ; "Datensatz l”schen!", ; XBPMB_YESNO, ; XBPMB_QUESTION, ; XBPMB_DEFBUTTON2 ) == XBPMB_RET_YES Satzsp( oCB ) (nA)->(DbDelete()) IF !(nA)->(Bof()) (nA)->(DbSkip(-1)) // 21.6.2005 zum Test ENDIF nRec := RecNo() oBrowse:BrowseFeld[1]:refreshAll() ENDIF SetAppFocus(oFoc) ENDCASE ENDIF oXbp:handleEvent( nEvent, mp1, mp2 ) ENDDO oDlg:setModalState( XBP_DISP_MODELESS ) oDlg:destroy() /// IF lFlucht = .T. (nA)->(DbGoto(nRec)) ENDIF ////////// (nA)->(DbResetNotifications()) // 28.02.2006 geremt (nA)->(DbSkip(0)) //////// DbDeRegisterclient() // 09.03.2006 geremt, nach Feldsuche fehlte Wochentag! SetAppFocus( oFocus ) RETURN lFlucht // wurde bis heute (06.04.2007 15:00) nirgends verwendet! // wird jetzt fr die Passwort-Eingabe bei WernerX aktiviert // vor Aufruf von ::Eingabe in die nA-Area wechseln! : METHOD DialogFF:Eingabe( oDlg1, cProg, nAnf, nEnd, cDatei, nA, nRec, aPos, ASize, aPP, cTitel ) //06.04.2007 13:43 LOCAL oDlg, nEvent, mp1, mp2 LOCAL nOldArea := Select(), oFocus := SetAppFocus() LOCAL lFlucht := .F. DEFAULT cTitel TO "Codewort tippen ( = zurck) :" //06.04.2007 13:43 PRIVATE oCB, oEdit // fr alle F„lle DEFAULT aPos TO {230*nH,32*nV} , ASize TO {int(197*nH),int(150*nV)} // Arbeitsbereich ausw„hlen, wenn noch nicht passiert und wenn n”tig: IF nA > 0 .AND. nA != SELECT() SELECT (nA) ENDIF // Datei ”ffnen, wenn noch nicht passiert und wenn n”tig: IF !Empty(cDatei) DbUseArea( , , cDatei ) ENDIF // Satzzeiger positionieren, wenn noch nicht passiert und wenn n”tig: IF !Empty(nRec) DbGoto(nRec) ENDIF oDlg := AKDialog():new( AppDesktop(), oDlg1:cargo ) oDlg:tasklist := .T. oDlg:title := cTitel oDlg:maxButton := .F. oDlg:border := XBPDLG_RAISEDBORDERTHIN_FIXED oDlg:create(,, aPos, ASize ) oDlg:drawingArea:setColorBG( GRA_CLR_DARKCYAN ) oCB := oDlg:drawingArea oCB:cargo := oDlg // (nA)->(DbSuspendNotifications()) // jetzt folgt die Erzeugung der Eingabefelder oEdit := DialogFF():new( oCB,oDlg, , ,,, nBz, cProg, nAnf, nEnd, nA ) oEdit:Fancy := "" oEdit:VArea := nA oEdit:BEArea := {} AAdd( oEdit:BEArea, oCB ) // weil direkt mit DialogFF gearbeitet wird! oEdit:BENr := Len( oEdit:BEArea ) oEdit:CREATE( oCB,oDlg, , ,aPP,, nBz, cProg, nAnf, nEnd, nA ) // bis hierhin geht die Erzeugung der Eingabefelder oDlg:setModalState( XBP_DISP_APPMODAL ) oCtrl := XbpGetController():new( oDlg ) oCtrl:create() // oCtrl:LastXbp := oBest:XbpObjekt( oBest:singleZeile,"name") --- irgendwie verwendbar?? oCtrl:READ( , .F. ) nEvent := xbeP_None DO WHILE nEvent <> xbeP_Close nEvent := AppEvent( @mp1, @mp2, @oXbp ) IF nEvent == xbeP_Keyboard DO CASE CASE mp1 == xbeK_ESC lFlucht := .T. PostAppEvent( xbeP_Close) ENDCASE ENDIF oXbp:handleEvent( nEvent, mp1, mp2 ) ENDDO oDlg:setModalState( XBP_DISP_MODELESS ) oDlg:destroy() IF lFlucht = .T. // wenn gedrckt wurde // Satzzeiger zurck-positionieren, wenn noch nicht passiert und wenn n”tig: IF !Empty(nRec) DbGoto(nRec) ENDIF ENDIF // Datei schlieáen, wenn noch nicht passiert und wenn n”tig: IF !Empty(cDatei) DbCloseArea() ENDIF // Arbeitsbereich zurckstellen, wenn noch nicht passiert und wenn n”tig: IF nOldArea > 0 SELECT (nOldArea) ENDIF SetAppFocus( oFocus ) RETURN lFlucht METHOD DialogFF:Erlaubnis( oDlg1, oXbp, cAltWert ) LOCAL cFeld IF !Empty(oXbp) //02.09.2007 09:49 Erlaubnis auf Feldebene cFeld := ::aBeschreib[AScan(::aFelder, Upper( ; IIf(oXbp:cargo[1]="&",&(SubStr(Trim(oXbp:cargo),2)),Trim(oXbp:cargo))))] IF Val(cRS) < 7 ConfirmBox( oDlg1, "Sie haben dazu NICHT die Berechtigung!", ; IIf(SET(43)==0,ConvToAnsiCP("Inhalt des Felds "+cFeld+" „ndern?"), ; "Inhalt des Feldes "+cFeld+" „ndern?"), ; XBPMB_OK, ; XBPMB_WARNING ) IF !Empty(cAltWert) .AND. IsMemberVar(oXbp,"value") oXbp:setData( cAltWert ) oXbp:getData( ) ENDIF RETURN .F. ELSE IF oEdit:Codewort( oDlg1, "s_best", 840, 859, cDatver+"mwstdat", 9, , ; {300*nH,200*nV}, {300*nH,300*nV}, , "Mit Codewort best„tigen:" ) ; < "7" IF !Empty(cAltWert) .AND. IsMemberVar(oXbp,"value") oXbp:setData( cAltWert ) oXbp:getData( ) oXbp:vorigerwert := cAltWert ENDIF RETURN .F. ENDIF ENDIF ELSE //02.09.2007 09:49 Erlaubnis auf Satzebene IF Val(cRS) < 7 ConfirmBox( oDlg1, "Sie haben dazu NICHT die Berechtigung!", ; IIf(SET(43)==0,ConvToAnsiCP("Inhalt dieses Datensatzes „ndern?"), ; "Inhalt dieses Datensatzes „ndern?"), ; XBPMB_OK, ; XBPMB_WARNING ) RETURN .F. ELSE IF oEdit:Codewort( oDlg1, "s_best", 840, 859, cDatver+"mwstdat", 9, , ; {300*nH,200*nV}, {300*nH,300*nV}, , "Mit Codewort best„tigen:" ) ; < "7" RETURN .F. ELSE AEval( oEdit:singlezeile, {|a,i| a:editable := .T. } ) ENDIF ENDIF ENDIF RETURN .T. // CodeWort „ndern darf jeder k”nnen // Benutzernummer und RechteStufe darf nur der Admin „ndern k”nnen, also wenn cRS=="9" ist METHOD DialogFF:CodeWort( oDlg1, cProg, nAnf, nEnd, cDatei, nA, nRec, aPos, ASize, aPP, cTitel ) LOCAL lFlucht := .F. PRIVATE cCodeAlt := "" // gelten nur innerhalb ::CodeWort+::BenutzerAendern+BenutzerSuche PRIVATE cBenutzer := IIf("nutzer"$cTitel,cBK,"") // Public, wird beim Einloggen generiert PRIVATE cBenutzNr := IIf("nutzer"$cTitel,cBNr,"") // Public, wird beim Einloggen generiert PRIVATE cRechtStuf := IIf("nutzer"$cTitel,cRS,"") // Public, wird beim Einloggen generiert PRIVATE cCodeNeu1 := "" PRIVATE cCodeNeu2 := "" nEnd := IIf(cRS="9",Max(819,nEnd-10),nEnd) // Admin darf alle Felder editieren lFlucht := ::Eingabe( oDlg1, cProg, nAnf, nEnd, cDatei, nA, nRec, aPos, ASize, aPP, cTitel ) RETURN IIf("SuperweiseR"$cCodeAlt,"9",IIf(lFlucht,"-",cRechtStuf)) METHOD DialogFF:BenutzerAendern() IF cCodeNeu1!=" " .AND. cCodeNeu1 == cCodeNeu2 mwstdat->(Satzsp(oCB)) mwstdat->&("PW"+cBenutzNr) := VerKey(cCodeNeu1) // VerKey() ist in EuroV.prg mwstdat->&("BK"+cBenutzNr) := PadR(cBenutzer,2) // BenutzerKurzname IF cRS = "9" // wenn der Admin das macht mwstdat->&("RS"+cBenutzNr) := PadR(cRechtStuf,1) // Rechtestufe (kann nur der Admin „ndern) ENDIF mwstdat->(DbRUnlock()) ELSE RETURN .F. // Žndern misslungen ENDIF RETURN .T. // Žndern gelungen METHOD DialogFF:BenutzerSuche() cBenutzNr := "-" cRechtStuf := "-" // EntKey() ist in EuroV.prg FOR n := 0 TO 9 // 10 m”gliche Passw”rter/User cPW := EntKey( mwstdat->&("PW"+Str(n,1)) ) // Passwort in Datei lesen IF AllTrim(cPW) == AllTrim(cCodeAlt) // ist PW in der Eingabe enthalten? cRechtStuf := mwstdat->&("RS"+Str(n,1)) // Rechtestufe aus Datei lesen cBenutzer := mwstdat->&("BK"+Str(n,1)) // BenutzerKurzname cBenutzNr := Str(n,1) // BenutzerNr EXIT // gefunden! ENDIF NEXT ::XbpObjektSet(::SingleZeile,"cRechtStuf",cRechtStuf) ::XbpObjektSet(::SingleZeile,"cBenutzNr",cBenutzNr) ::XbpObjektSet(::SingleZeile,"cBenutzer",cBenutzer) IF Val(cBenutzNr) = 0 .OR. (Val(cBenutzNr)!=Val(cBNr).AND. cRS!="9") //29.04.2007 13:46 keine Žnderungen durch Gast SetAppFocus(::XbpObjekt(::SingleZeile,"cCodeAlt")) ENDIF RETURN cRechtStuf METHOD DialogFF:PaintTip(cTip,aTipPos) LOCAL aAreaAttr, aStringAttr LOCAL oPS LOCAL aPoints LOCAL aTipSize := {0,0} DEFAULT cTip TO "*******" aTipPos[1] := aTipPos[1]*nH aTipPos[2] := aTipPos[2]*nV IF ::oTip != NIL ::KillTip() ENDIF ::oTip := XbpStatic():new() // ::oTip:options := XBPSTATIC_TYPE_FGNDFRAME ::oTip:create(AppDesktop(),AppDesktop(), aTipPos, { 0 , 0 }) oPS := ::oTip:lockPS() aPoints := GraQueryTextBox( oPS, cTip) ::oTip:unlockPS() aTipSize[1] := (aPoints[3,1] - aPoints[1,1]) + 8 aTipSize[2] := (aPoints[1,2] - aPoints[2,2]) + 4 ::oTip:setSize(aTipSize,.F.) oPS := ::oTip:lockPS() aAreaAttr := Array( GRA_AA_COUNT ) aAreaAttr [ GRA_AA_COLOR ] := XBPSYSCLR_INFOBACKGROUND GraSetAttrArea( oPS, aAreaAttr ) GraBox( oPS, { 0, 0}, {aTipSize[1]-1, aTipSize[2]-1}, GRA_OUTLINEFILL) aStringAttr := Array( GRA_AS_COUNT ) aStringAttr [ GRA_AS_COLOR ] := XBPSYSCLR_INFOTEXT GraSetAttrString( oPS, aStringAttr ) GraStringAt( oPS, {4,4}, cTip) ::oTip:unLockPS( oPS) ::oTip:cargo := .T. ::cTipTime := Time("+1") //27.04.2008 22:02 setzt auf 1 Minute sp„ter RETURN(SELF) METHOD DialogFF:KillTip() IF ::oTip!=NIL .AND. ::oTip:IsDerivedFrom("XbpStatic") // 6.8.2004 IF ::oTip:cargo != NIL ::oTip:destroy() ::oTip:cargo := NIL ENDIF ENDIF RETURN self METHOD DialogFF:TabMax(o,aTab) LOCAL n := AScan(::BEArea,o) AEval(aTab, {|x,i| ::BEArea[n+x]:minimize()}, 1, Len(aTab)-1 ) ::thisTab := ::BEArea[n+ATail(aTab)] ::thisTab:maximize() RETURN self // neue Felder in einer Datei anfgen: METHOD DialogFF:StrukturErweiterung( cDatei, aNeuFeld, nA ) LOCAL nOldArea := SELECT(), i, aFeld cDatei := cDatver + cDatei SELECT (nA) DbUseArea( , , cDatei ) // Datei ”ffnen DbCopyExtStruct( "Struct" ) // Struktur bertragen DbUseArea( , , "Struct" ) // strukturerweiterte Datei FOR i := 1 TO Len(aNeuFeld) aFeld := aNeuFeld[i] DbAppend() // ”ffnen und neue FIELD->Field_Name := aFeld[1] // Felddefinition eintragen FIELD->Field_Type := aFeld[2] FIELD->Field_Len := aFeld[3] FIELD->Field_Dec := aFeld[4] NEXT DbCloseArea() // Sicherungskopie fr IF FILE(cDatver+"Temp.dbf") COPY FILE ( cDatei+".dbf" ) TO ( cDatver+"Temp.dbf" ) // - DBF-Datei COPY FILE ( cDatei+".dbt" ) TO ( cDatver+"Temp.dbt" ) // - Memo-Datei ELSE FRename( cDatei+".dbf", cDatver+"Temp.dbf" ) // - DBF-Datei Frename( cDatei+".dbt", cDatver+"Temp.dbt" ) // - Memo-Datei ENDIF DbCreateFrom( cDatei,, "Struct" ) // Neue Datei erzeugen DbUseArea( , , cDatei ) // Datei ”ffnen DbImport( cDatver+"Temp" ) // Datens„tze aus Sicherungskopie bernehmen DbCloseArea() // Dateien umbenennen IF FILE(cDatei+".bkf") COPY FILE ( cDatver+"Temp.dbf" ) TO ( cDatei+".bkf" ) // - DBF-Datei COPY FILE ( cDatver+"Temp.dbt" ) TO ( cDatei+".bkt" ) // - Memo-Datei ELSE FRename( cDatver+"Temp.dbf", cDatei+".bkf" ) // - DBF-Datei FRename( cDatver+"Temp.dbt", cDatei+".bkt" ) // - Memo-Datei ENDIF FErase( "Struct.dbf" ) // Strukturerweiterte Datei l”schen SELECT (nOldArea) RETURN self // wird fr das Korrespondenzmodul gebraucht und in bl_quit/bl_alb2 verwendet: // cKey: (nA=5)->verskz => wird in Adressdatei gesucht // (nA=1)->"Sehr geehrte"/"Liebe" o.„. => Brief-Anrede wird komplettiert // nA: die Workarea der Adressdaten // aD: (nA=5)->{"name1","name2","strasse","plz_ort"} => Adresse fr bl_quit // (nA=1)->@oBest:aBP => Anrede fr bl_alb2/Brief an Angeh”rige METHOD DialogFF:AdrDaten( cKey, nA, aD ) // fllt aE z.B. mit Adressen aus Area5 LOCAL nRec := (nA)->(RecNo()), i, aE := {} PRIVATE cD IF nA == 5 (nA)->(DbSuspendNotifications()) (nA)->(DbSeek(cKey,.F.)) FOR i:=1 TO Len(aD) cD := aD[i] AAdd( aE, (nA)->&cD ) NEXT (nA)->(DbGoto(nRec)) (nA)->(DbResumeNotifications()) ELSEIF nA == 1 // erg„nzt fr bl_alb2 (o.„.): 02.07.2006 15:53 DO CASE // hAN1 := oBest:AdrDaten("Sehr geehrte",1)[8] CASE aD[1] = "Herr" AAdd(aD,cKey+"r Herr "+Trim(aD[3])+",") // 8.Glied des Arrays CASE aD[1] = "Frau" AAdd(aD,cKey+" Frau "+Trim(aD[3])+",") OTHERWISE AAdd(aD,cKey+" Damen und Herren,") ENDCASE aE := aD ENDIF RETURN aE // Eingabehilfe, z.B. fr Anrede 19.05.2007 22:38 // aD wird gefllt z.B. mit {"Herr","Frau","Kind"} // cKey ist der Eingabewert im Anredefeld, z.B. "h" // cD = aD[i] wird zurckgegeben, wenn cKey mit dem Anfang von aD[i] bereinstimmt: METHOD DialogFF:AutoDaten(cKey,aD) LOCAL cD := cKey AEval( aD, {|x,i| cD := IIf(Upper(x)=Upper(Trim(cKey)),x,cD) } ) RETURN cD // Suche in Gesamtdeutschland nach der PLZ oder dem Ort // Indizierung in IneuX.prg: //////OrdCreate( "PLZDE", "w", "WERT" ) // PLZ //////OrdCreate( "PLZDE", "o", "ORT" ) // Ort ohne PLZ //////OrdCreate( "PLZDE", "po", "WERT_ORT" ) // PLZ + " " + Ort METHOD DialogFF:PlzDE(cKey) LOCAL cD, nOldArea := SELECT() DO CASE CASE Trim(cKey) == Str(Val(cKey),5,0) // Eingabe = PLZ DbUseArea(.T.,"FOXCDX","PlzDe","plz") OrdListAdd("PlzDE","w") DbSeek(Trim(cKey)) CASE Val(cKey) = 0 // Eingabe = Ort DbUseArea(.T.,"FOXCDX","PlzDe","plz") OrdListAdd("PlzDE","o") DbSeek(Trim(cKey)) CASE Len(cKey)>6 .AND. cKey[6] = " " DbUseArea(.T.,"FOXCDX","PlzDe","plz") OrdListAdd("PlzDE","po") DbSeek(Trim(cKey)) OTHERWISE SELECT (nOldArea) RETURN cKey + " -> PLZ oder Ort eingeben!" ENDCASE IF !Eof() cD := plz->wert_ort ELSE cD := cKey +" -> PLZ oder Ort eingeben!)" ENDIF DbCloseArea() SELECT (nOldArea) RETURN cD // Texte fr Briefe oder Trauerdrucke suchen (10 Texte/Bilder pro Druck m”glich): // (FOXCDX kann statt eines Textes auch etwas Bin„res, z.B. ein Bild, speichern) // cTagName und cSuch bestimmen in welcher Sortierung und wonach gesucht wird // wenn cSuch[1]=="!", dann wird nach eindeutigem Standardtext gesucht (z.B. in bl_v) METHOD DialogFF:TextSuchen( oDlg1, cDatei, cProg, nAnf, nEnd, cTagName, cSuch, aPos, ASize, aPP, cTitel ) LOCAL nOldArea := SELECT(), nRec, nA := 10, nNL := Len(5->name1) DEFAULT cDatei TO "TEXTE" cSuch := IIf(cTagName="at", IIf( oBest:aBP[7]=3, Stuff(PadR(cSuch,18),E+1,1,4->P_PERSKZ), ; PadR(cSuch,18) ), ; IIf(cTagName="nt",cSuch,PadR(cSuch,18))) // 06.06.2006 18:15 DbSuspendNotifications() SELECT (nA) DbUseArea(,"FOXCDX",cDatei) OrdListAdd(cDatei,cTagName) // IF Upper(cDatei) = "ABRECH-ANGEBOT-MAHNUNG" .OR. cSuch="!" // 12.02.2006 // IF !DbSeek(cSuch,.F.) // HardSeek, weil der individuelle Text gesucht wird // DbSeek(SubStr(cSuch,1,10),.F.) // wenn kein individueller Text, dann Standardtext // ENDIF // ELSE // fr Standardbriefe/"TEXTE" // DbSeek(cSuch,.T.) // Softseek, weil das Auge sucht mit... // IIf(SubStr(cSuch,1,10)!=(nA)->txname,(nA)->(DbSkip(-1)),) // wenn nicht gefunden // ENDIF //** Beispiele: // 06.04.2006 // Textkrzel ist vorgegeben: // cSuch = "!VERSICH 123456" - einmaligen, auftragsunabh„ngigen Standardtext suchen, oder Leertext // cSuch = "!versich 123456" - auftragsbezogenen, individuellen Text suchen // wenn nicht gefunden: Standardtext suchen, oder Leertext // cSuch = "versich 123456" - auftragsbezogenen, individuellen Text suchen // wenn nicht gefunden: ein Schritt zurck // Textkrzel ist nicht vorgegeben, wird ggf. vom Anwender selbst vergeben/gesucht: // cSuch = " " - Suchtabelle auf Leertext positionieren und Textname eingeben oder w„hlen **// IF cSuch[1]="!" .AND. Upper(cSuch[2])=cSuch[2] // 06.04.2006, obligatorischer Standardtext IF !DbSeek(SubStr(cSuch,1,IIf(cTagName="ta",10,8)),.F.) // HardSeek, weil der Standardtext gesucht wird DbGotop() // wenn kein Standardtext, dann Leertext ENDIF ELSEIF cSuch[1]="!" // auftragsbezogener Standardtext IF !DbSeek(cSuch,.F.) // HardSeek, weil der individuelle Text gesucht wird IF !DbSeek(SubStr(cSuch,1,IIf(cTagName="ta",10,8)),.F.) // wenn kein individueller Text, dann Standardtext DbGotop() // wenn kein Standardtext, dann Leertext ENDIF ENDIF ELSE // fr freie Briefe/"TEXTE" o.„. !!06.06.2006 19:11!! cSuch justiert IF cTagName == "ta" // 16.04.2006 cSuch := IIf(cSuch=" ", "", cSuch ) DbSeek(cSuch,.T.) // Softseek, weil das Auge sucht mit... IIf(SubStr(cSuch,1,10)!=(nA)->txname,(nA)->(DbSkip(-1)),) // wenn nicht gefunden, voriger ELSEIF cTagName == "at" // 16.04.2006 cSuch := Trim(cSuch) cSuch := IIf(Len(cSuch)<8,PadR(cSuch,8),cSuch) DbSeek(cSuch,.T.) // Softseek, weil das Auge sucht mit... IIf(Val(SubStr(cSuch,1,8))!=Val((nA)->adrschl),(nA)->(DbGotop()),) // wenn nicht gefunden, Anfang ELSEIF cTagName == "nt" // 16.04.2006 cSuch := IIf(nNL<40,PadR(SubStr(cSuch,1,nNL),40)+SubStr(cSuch,nNL+1),cSuch) //19.06.2006 22:07 cSuch := IIf( Len(cSuch)>(nNL+9).AND.SubStr(cSuch,(nNL+1),10)=Space(10), PadR(cSuch,40), cSuch ) DbSeek(cSuch,.T.) // Softseek, weil das Auge sucht mit... IIf(cSuch!=(nA)->n1,(nA)->(DbSkip(-1)),) // wenn nicht gefunden, voriger ENDIF ENDIF nRec := RecNo() // damit die Suchtabelle positioniert wird // aPos, aSize, aPP, cTitel drfen NIL sein -> werden in ::such() DEFAULT gesetzt: IF cSuch != "!" IF ::Such( oDlg1, cProg, nAnf, nEnd, nA, nRec, aPos, ASize, aPP, cTitel, cSuch ) //16.04.2006 12:55 ::aTxBd := {" ",PadR(StrX(1->auftrnr,E,0)+IIf(oBest:aBP[7]=3 .AND. oBest:PvPERSKZ!="@", ; oBest:PvPERSKZ," "),8),"","","","",CtoD(""),"","","",""} ELSE // wenn gefunden/ausgew„hlt ( ==> lFlucht=.F. !!!) ::aTxBd := {(nA)->TXNAME, PadR(StrX(1->auftrnr,E,0)+IIf(oBest:aBP[7]=3 .AND. oBest:PvPERSKZ!="@", ; oBest:PvPERSKZ," "),8), (nA)->N1, (nA)->N2, (nA)->STR, (nA)->ORT, ; (nA)->DATUM, (nA)->KENNZ, (nA)->BETRZ, (nA)->BETRV, (nA)->ANR } ::TxBd0 := (nA)->TEXTBILD0 ::TxBd1 := (nA)->TEXTBILD1 ::TxBd2 := (nA)->TEXTBILD2 ::TxBd3 := (nA)->TEXTBILD3 ::TxBd4 := (nA)->TEXTBILD4 ::TxBd5 := (nA)->TEXTBILD5 ::TxBd6 := (nA)->TEXTBILD6 ::TxBd7 := (nA)->TEXTBILD7 ::TxBd8 := (nA)->TEXTBILD8 ::TxBd9 := (nA)->TEXTBILD9 ENDIF // IF IsMemberVar( self, "aDK" ) //06.10.2006 20:44 // a := ::TxBd // IF !Empty(a) .AND. a[1]="{" .AND. ValType( &a ) == "A" .AND. Len( &a ) >= 56 // ::aDK := &a // ENDIF // ENDIF ELSE // 06.04.2006 wenn eindeutige Standardtexte gesucht werden, muss cSuch[1]=="!" sein // wenn z.B. cSuch = "!versicher" IF cSuch = "!versicher" //17.04.2006 ohne Suchfenster, weil sonst s_.tak 2x ge”ffnet!!! ::aTxBd := {SubStr(cSuch,1,10),PadR(StrX(1->auftrnr,E,0)+IIf(oBest:aBP[7]=3 .AND. oBest:PvPERSKZ!="@", ; oBest:PvPERSKZ," "),8),"","","","",CtoD(""),"", ; (nA)->BETRZ, (nA)->BETRV, (nA)->ANR} ELSEIF Upper(cSuch[2]) != cSuch[2] .AND. ; !::Such( oDlg1, cProg, nAnf, nEnd, nA, nRec, aPos, ASize, aPP, cTitel, cSuch ) //16.04.2006 21:24 ::aTxBd := {SubStr(cSuch,1,10),PadR(StrX(1->auftrnr,E,0)+IIf(oBest:aBP[7]=3 .AND. oBest:PvPERSKZ!="@", ; oBest:PvPERSKZ," "),8),"","","","",CtoD(""),"", ; (nA)->BETRZ, (nA)->BETRV, (nA)->ANR} ELSE // wenn z.B. cSuch = "!LEER" ::aTxBd := { SubStr(cSuch,1,10), Space(8), "", "", "", "", CtoD(""), "", ; (nA)->BETRZ, (nA)->BETRV, (nA)->ANR } // Betreff + Anrede kann im Standard sein ENDIF ::TxBd0 := (nA)->TEXTBILD0 ::TxBd1 := (nA)->TEXTBILD1 ::TxBd2 := (nA)->TEXTBILD2 ::TxBd3 := (nA)->TEXTBILD3 ::TxBd4 := (nA)->TEXTBILD4 ::TxBd5 := (nA)->TEXTBILD5 ::TxBd6 := (nA)->TEXTBILD6 ::TxBd7 := (nA)->TEXTBILD7 ::TxBd8 := (nA)->TEXTBILD8 ::TxBd9 := (nA)->TEXTBILD9 ENDIF DbCloseArea() SELECT(nOldArea) DbResumeNotifications() RETURN self METHOD DialogFF:TextSpeichern(cDatei,cTagName, cSuch, aBrDaten) LOCAL nOldArea := SELECT(), nA := 10 DEFAULT cDatei TO "TEXTE" IF aBrDaten[1] = "!LEER" RETURN self ENDIF ::aTxBd := AClone(aBrDaten) cSuch := IIf( cTagName="nt", PadR(::aTxBd[3],40)+cSuch, cSuch ) //16.08.2006 16:08 DbSuspendNotifications() SELECT (nA) DbUseArea(,"FOXCDX",cDatei) OrdListAdd(cDatei,cTagName) DbSeek(cSuch,.F.) // Hardseek, damit nur der richtige Fall ge„ndert wird! IF (nA)->(Eof()) (nA)->(DbAppend()) (nA)->txname := ::aTxBd[1] ELSE //04.09.2007 10:31 damit jede Adresse ihren eigenen Eintrag fr diesen Auftrag+diesen Zweck bekommt DO WHILE (nA)->adrschl = ::aTxBd[2] .AND. (nA)->txname = ::aTxBd[1] .AND. !Eof() //04.09.2007 10:25 IF (nA)->n1 = ::aTxBd[3] (nA)->(Satzsp(oCB)) EXIT ENDIF DbSkip() ENDDO IF (nA)->adrschl != ::aTxBd[2] .OR. (nA)->txname != ::aTxBd[1] (nA)->(DbAppend()) (nA)->txname := ::aTxBd[1] ENDIF ENDIF (nA)->adrschl := ::aTxBd[2] (nA)->n1 := ::aTxBd[3] (nA)->n2 := ::aTxBd[4] (nA)->str := ::aTxBd[5] (nA)->ort := ::aTxBd[6] (nA)->datum := ::aTxBd[7] (nA)->kennz := ::aTxBd[8] (nA)->betrz := ::aTxBd[9] (nA)->betrv := ::aTxBd[10] (nA)->anr := ::aTxBd[11] (nA)->TEXTBILD0 := ::TxBd0 (nA)->TEXTBILD1 := ::TxBd1 (nA)->TEXTBILD2 := ::TxBd2 (nA)->TEXTBILD3 := ::TxBd3 (nA)->TEXTBILD4 := ::TxBd4 (nA)->TEXTBILD5 := ::TxBd5 (nA)->TEXTBILD6 := ::TxBd6 (nA)->TEXTBILD7 := ::TxBd7 (nA)->TEXTBILD8 := ::TxBd8 (nA)->TEXTBILD9 := ::TxBd9 DbCloseArea() SELECT(nOldArea) DbResumeNotifications() RETURN self METHOD DialogFF:HilfeFilm( oDlg1, cFileName, oVideo ) LOCAL oDlg, aPos:=oDlg1:currentpos(), ASize:=oDlg1:currentsize() LOCAL ASizeV:=AClone(ASize) LOCAL nEvent, mp1, mp2, oXbp aSizeV[2]:=aSizeV[2]-30 // Titelleiste abziehen oDlg := XbpDialog():new( oDlg1, oDlg1, aPos, ASize ) oDlg:taskList := .T. oDlg:title := "Hilfefilm "+cFileName+" - >>>>> Fenster schlieáen mit ESC <<<<<" // oDlg:titlebar := .F. oDlg:visible := .T. oDlg:create() // oDlg:setModalState( XBP_DISP_APPMODAL ) oDlg:show() oVideo := BDVideo():new(oDlg:drawingArea,,aPos,ASizeV):create() oVideo:cargo := oDlg oVideo:loadFile(cFileName) oVideo:play() ////// DO WHILE .T. //nEvent <> xbeP_Keyboard //Close ////// nEvent := AppEvent( @mp1, @mp2, @oXbp ) ////// IF nEvent >= xbeP_Keyboard .AND. nEvent <= xbeM_RbDblClick //.OR. nEvent == xbeM_RbDown .OR. nEvent == xbeM_LbDown //////// IF mp1 == xbeK_ESC ////// oVideo:stop() ////// oVideo:destroy() ////// EXIT ////// ELSE ////// oXbp:handleEvent( nEvent, mp1, mp2 ) //////// PostAppEvent( xbeP_Close, .T.,, oXbp ) //////// ENDIF ////// ENDIF //////// oXbp:handleEvent( nEvent, mp1, mp2 ) ////// ENDDO ////// oDlg:setModalState( XBP_DISP_MODELESS ) ////// oDlg:destroy() RETURN self // setzt das Datum in einem Datumfeld mit # auf das Sterbedatum, mit "'" auf date() // oder erh”ht/vermindert es mit +/- um jeweils 1 bzw. mit */_ um jeweils 7 Tage METHOD DialogFF:DatumSet(oXbp,nPM) //03.06.2007 15:27 nPM = +1/-1 (+7/-7), je nach Taste +/- (*/_) LOCAL dDat := oXbp:value DEFAULT nPM TO 0 // IF oXbp:value = CtoD(" ") .AND. nPM != 0 dDat := 1->gestorben ELSEIF nPM == 0 dDat := DATE() ENDIF oXbp:setData( dDat + nPM ) oXbp:getData() // oXbp:original := CtoD(" . . ") RETURN self //------------------------------------------ //------------------------------------------ CLASS BlattFA PROTECTED: VAR appendMode // Wird ein neuer Datensatz angelegt? VAR appendControls // XBPs, die nur bei APPEND // aktiv sind VAR keyControls // Liste von XBPs fr Tastaturnavigation VAR keyboardBlock // Codeblock fr xbeP_Keyboard Ereignisse EXPORTED: VAR editControls // XBPs, die Daten „ndern VAR LeditC // L„nge des Arrays editControls VAR BEArea VAR BENr //// VAR BrowseFeld //// VAR BFNr ////// VAR BVariable ////// VAR BVNr VAR GruppenBox VAR GBNr VAR TextZeile VAR TZNr VAR DruckKnopf VAR DKNr VAR MultiZeile VAR MZNr VAR SingleZeile VAR SZNr VAR aBlatt // Array, in dem die Blatt-Aufbau-Information steckt VAR aBlattZ VAR aSeite VAR aNa VAR aPrompt VAR aText VAR aTFont VAR aBereich VAR aFeld VAR aFFont VAR aZei VAR aSpa VAR aParam // Array, in dem die Blatt-Aufbau-Information steckt VAR aSeiteP VAR aNaP VAR aPromptP VAR aTextP VAR aTFontP VAR aBereichP VAR aFeldP VAR aFFontP VAR aZeiP VAR aSpaP VAR Vorschau METHOD INIT METHOD CREATE METHOD destroy METHOD addEditControl // XBP fr Edit registrieren METHOD addAppendControl // XBP fr Append registrieren METHOD addKeyControl // XBP fr Keyboard handling registrieren // METHOD notify METHOD Such // „hnlich :Such() bei DialogFF 16.07.2006 10:12 ENDCLASS METHOD BlattFA:INIT( oParent, oOwner, aPos, ASize, aPP, lVisible, nBz, aBlattG, aParamG ) LOCAL aPPTxt := { { XBP_PP_FGCLR , GRA_CLR_BLACK } , ; { XBP_PP_BGCLR , XBPSYSCLR_DIALOGBACKGROUND } , ; { XBP_PP_COMPOUNDNAME, IIf(nV>1.5,"12.Arial",IIf(nV>1,"10.Arial","8.Arial")) } } // LOCAL nV := AppDesktop():currentSize()[1]/800 ::BEArea := {} ::BENr := 0 AAdd( ::BEArea, oParent ) ::BENr := Len( ::BEArea ) // Erste TabPage ist maximiert AAdd( ::BEArea, XbpTabPage():new( oParent, oOwner, aPos, aSize, aPPTxt, lVisible ) ) ::BEArea[++::BENr]:caption := "~Parameter" ::BEArea[::BENr]:clipSiblings := .T. ::BEArea[::BENr]:tabStop := .T. ::BEArea[::BENr]:preOffset := 0 ::BEArea[::BENr]:postOffset := 80 ::BEArea[::BENr]:create() ::BEArea[::BENr]:helpLink := MagicHelpLabel():New(707) ::BEArea[::BENr]:maximize() ::BEArea[::BENr]:minimize() ::BEArea[::BENr]:maximize() ::BEArea[::BENr]:minimized := .F. ::BEArea[::BENr]:TabActivate := {|m,n,o| n := AScan(::BEArea,o), ; ::BEArea[n+1]:minimize(), ::BEArea[n+2]:minimize(),; o:maximize(), IIf(Empty(o:childList()), SetAppFocus(o), ; SetAppFocus(o:childList()[1])) } // Zweite TabPage ist minimiert AAdd( ::BEArea, XbpTabPage():new( oParent, oOwner, aPos, aSize, aPPTxt, lVisible ) ) ::BEArea[++::BENr]:caption := "Da~ten-1" ::BEArea[::BENr]:clipSiblings := .T. ::BEArea[::BENr]:tabStop := .T. ::BEArea[::BENr]:preOffset := 20 ::BEArea[::BENr]:postOffset := 60 ::BEArea[::BENr]:create() ::BEArea[::BENr]:helpLink := MagicHelpLabel():New(708) ::BEArea[::BENr]:maximize() ::BEArea[::BENr]:minimize() // ::BEArea[::BENr]:TabActivate := {|| ::BEArea[::BENr-1]:minimize(), ::BEArea[::BENr+1]:minimize(),; // ::BEArea[::BENr]:maximize(), SetAppFocus(::BEArea[::BENr]) } ::BEArea[::BENr]:TabActivate := {|m,n,o| n := AScan(::BEArea,o), ; ::BEArea[n-1]:minimize(), ::BEArea[n+1]:minimize(),; o:maximize(), IIf(Empty(o:childList()), SetAppFocus(o), ; SetAppFocus(o:childList()[1])) } // Dritte TabPage ist minimiert AAdd( ::BEArea, XbpTabPage():new( oParent, oOwner, aPos, aSize, aPPTxt, lVisible ) ) ::BEArea[++::BENr]:caption := "Para~meter-2" ::BEArea[::BENr]:clipSiblings := .T. ::BEArea[::BENr]:tabStop := .T. ::BEArea[::BENr]:preOffset := 40 ::BEArea[::BENr]:postOffset := 40 ::BEArea[::BENr]:create() ::BEArea[::BENr]:helpLink := MagicHelpLabel():New(709) ::BEArea[::BENr]:maximize() ::BEArea[::BENr]:minimize() // ::BEArea[::BENr]:TabActivate := {|| ::BEArea[::BENr-2]:minimize(), ::BEArea[::BENr-1]:minimize(),; // ::BEArea[::BENr]:maximize(), SetAppFocus(::BEArea[::BENr]) } ::BEArea[::BENr]:TabActivate := {|m,n,o| n := AScan(::BEArea,o), ; ::BEArea[n-2]:minimize(), ::BEArea[n-1]:minimize(),; o:maximize(), IIf(Empty(o:childList()), SetAppFocus(o), ; SetAppFocus(o:childList()[1])) } //// ::BrowseFeld := {} //// ::BFNr := 0 ////// ::BVariable := {} ////// ::BVNr := 0 ::GruppenBox := {} ::GBNr := 0 ::TextZeile := {} ::TZNr := 0 ::DruckKnopf := {} ::DKNr := 0 ::MultiZeile := {} ::MZNr := 0 ::SingleZeile := {} ::SZNr := 0 ::editControls := {} ::appendControls := {} ::keyControls := {} ::keyboardBlock := {|nKey,x,obj| ::keyHandler( nKey, obj ) } ::aBlatt := aBlattG ::aBlattZ := {} ::aSeite := {} ::aNa := {} ::aPrompt := {} ::aText := {} ::aTFont := {} ::aBereich := {} ::aFeld := {} ::aFFont := {} ::aZei := {} ::aSpa := {} ::aParam := aParamG ::aSeiteP := {} ::aNaP := {} ::aPromptP := {} ::aTextP := {} ::aTFontP := {} ::aBereichP := {} ::aFeldP := {} ::aFFontP := {} ::aZeiP := {} ::aSpaP := {} RETURN self //METHOD DialogFF:CREATE( oParent, oOwner, aPos, ASize, aPP, lVisible, nBz, cFF, nAnf, nEnd, nA ) METHOD BlattFA:CREATE( oParent, oOwner, aPos, ASize, aPP, lVisible, nBz ) LOCAL oXbp //nH, nV := AppDesktop():currentSize()[1]/800, [2]/600 waagrecht:nH, senkrecht:nV LOCAL nBo := ( AppDesktop():currentSize()[2]-60*nV), nBr := 7, nHv := nBz, nHt := nBz //*0.8 LOCAL nZeiF := nBo, nZeiT := nBo, aPosT, aSizeT, aPosF, aSizeF LOCAL aPPSle := { { XBP_PP_FGCLR , GRA_CLR_BLACK } , ; { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } , ; { XBP_PP_COMPOUNDNAME, IIf(nV>1.5,"12.Arial",IIf(nV>1,"10.Arial","8.Arial")) } } // LOCAL aPPTxt := { { XBP_PP_FGCLR , GRA_CLR_YELLOW } , ; // { XBP_PP_BGCLR , GRA_CLR_BLUE } , ; // { XBP_PP_COMPOUNDNAME, IIf(nV>1.5,"12.Arial",IIf(nV>1,"10.Arial","8.Arial")) } } LOCAL aPPTxt := { { XBP_PP_FGCLR , GRA_CLR_BLACK } , ; { XBP_PP_BGCLR , XBPSYSCLR_DIALOGBACKGROUND } , ; { XBP_PP_COMPOUNDNAME, IIf(nV>1.5,"12.Arial",IIf(nV>1,"10.Arial","8.Arial")) } } // LOCAL aPPTxt := {} LOCAL nOldArea := SELECT(), i, j, y, cFeld, cText, nSpa, nZei // !TEST LOCAL nFA := IIf(Upper(AppName())$"BERGX.EXE",70,100), nZ4:=0 PRIVATE bT, cB, cF, xF //// ::aParam := aParamG FOR j := 1 TO Len(::aParam) ::aBlattZ := ::aParam[j] AAdd( ::aSeiteP, ::aBlattZ[1], j ) AAdd( ::aNaP, ::aBlattZ[2], j ) AAdd( ::aPromptP, ::aBlattZ[3], j ) AAdd( ::aTextP, ::aBlattZ[4], j ) AAdd( ::aTFontP, ::aBlattZ[5], j ) AAdd( ::aBereichP, ::aBlattZ[6], j ) AAdd( ::aFeldP, ::aBlattZ[7], j ) // Feldbezeichnung AAdd( ::aFFontP, ::aBlattZ[8], j ) AAdd( ::aZeiP, ::aBlattZ[9], j ) AAdd( ::aSpaP, ::aBlattZ[10], j ) IF j > 1 nZei := IIf( ::aZeiP[j] < -1, -1, IIf(::aZeiP[j]=0, -1, ::aZeiP[j] ) ) //IIf( ::aBlattZ[9]<1, nZei - ::aBlattZ[9], ::aBlattZ[9] ) nSpa := IIf( ::aBlattZ[10]<1, (nSpa + Len(Trim(::aTextP[j-1])) ; + Len(Trim(::aFeldP[j-1])) - ::aBlattZ[10]), ::aBlattZ[10] ) ELSE nZei := IIf( ::aZeiP[j] > 2, 2, IIf( ::aZeiP[j] < 1, 1, ::aZeiP[j]) ) nSpa := ::aSpaP[j] ENDIF IF Upper( ::aSeiteP[j] ) = "P" .AND. ::aZeiP[j] > 0 // zuerst kommt der Prompt-Text : aSizeT := ::BEArea[2]:currentSize() nZeiF := IIf( nZei < 1, nZeiF+nHv*nZei, aSizeT[2]-nHv-IIf(Len(::aParam)>20,1,1.5)*nHv*nZei ) aPosF := {Int(0), nZeiF} ; aSizeF := {aSizeT[1]*.2,Int(nHv)} AAdd( ::TextZeile, MStatic():new( ::BEArea[2], , aPosF, aSizeF, aPPTxt,, ; XBPSTATIC_TYPE_TEXT, Trim(::aPromptP[j]) ) ) ++::TZNr IIf( nV<=1, ::TextZeile[::TZNr]:setFontCompoundName( "8.Arial" ), ) // ::XbpStatic:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_LEFT ::TextZeile[::TZNr]:create() // ...und dann der Eingabe-Sle : //// ::aTextP[j] := IIf(SET(43)==0,ConvToAnsiCP(::aTextP[j]),::aTextP[j]) ::aTextP[j] := PadR( ::aTextP[j], nFA ) aPosF := {aSizeT[1]*.2, nZeiF} ; aSizeF := {aSizeT[1]*.78,Int(nHv)} // AAdd( ::SingleZeile, MGetX():new( ::BEArea[2], , aPosF, aSizeF, aPPSle,, ; // 0, nFA, , , ; // , , , ::aTextP, j ) ) AAdd( ::SingleZeile, MGetXR():new( ::BEArea[2], , aPosF, aSizeF, aPPSle,, ; @::aTextP[j], nFa, .T., , ; , , , , nA ) ) ++::SZNr ::SingleZeile[::SZNr]:cargo := Trim(::aFeldP[j]) ::SingleZeile[::SZNr]:clipSiblings := .F. ::SingleZeile[::SZNr]:trigger := ::aSpaP[j] // normalerweise=0 - 16.07.2006 10:41 // >>>>>>>>>> Variable p wird erzeugt, wenn ParameterUpdate erfolgt ist. /////////////////////////////////////////////////////////////////////////////////////////////// // bisher war ::aSpaP[j] IMMER Null ! Wenn :trigger!=0 , dann existiert auch oBest:TxBdX // wenn :changed() und :trigger>0, dann suche Text zu der neuen Eingabe: ::SingleZeile[::SZNr]:killInputFocus := {|mp1,mp2,obj| DeHiliteSle( obj ), ; IIf( obj:changed(), ; {IIf(obj:trigger > 0, ; &( "oEdit:TxBd" + Str(obj:trigger-1,IIf(obj:trigger<11,1,2))):=::Such(obj),), ; ::Vorschau:ParUpdate(), p:=1, ::Vorschau:UPDATE()}, ; ) } // ::Such neu 15.07.2006 22:43 ////////////////////////////////////////////////////////////////////////////////////////////// ::SingleZeile[::SZNr]:CREATE():setdata() ::addEditControl( ::SingleZeile[::SZNr] ) ELSE nZei := ++nZ4 // zuerst kommt der Prompt-Text : aSizeT := ::BEArea[2]:currentSize() nZeiF := IIf( nZei < 1, nZeiF+nHv*nZei, aSizeT[2]-nHv-IIf(Len(::aParam)>20,1,1.5)*nHv*nZei ) aPosF := {Int(0), nZeiF} ; aSizeF := {aSizeT[1]*.2,Int(nHv)} AAdd( ::TextZeile, MStatic():new( ::BEArea[4], , aPosF, aSizeF, aPPTxt,, ; XBPSTATIC_TYPE_TEXT, Trim(::aPromptP[j]) ) ) ++::TZNr IIf( nV<=1, ::TextZeile[::TZNr]:setFontCompoundName( "8.Arial" ), ) // ::XbpStatic:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_LEFT ::TextZeile[::TZNr]:create() // ...und dann der Eingabe-Sle : //// ::aTextP[j] := IIf(SET(43)==0,ConvToAnsiCP(::aTextP[j]),::aTextP[j]) ::aTextP[j] := PadR( ::aTextP[j], nFA ) aPosF := {aSizeT[1]*.2, nZeiF} ; aSizeF := {aSizeT[1]*.78,Int(nHv)} // AAdd( ::SingleZeile, MGetX():new( ::BEArea[4], , aPosF, aSizeF, aPPSle,, ; // 0, nFA, , , ; // , , , ::aTextP, j ) ) AAdd( ::SingleZeile, MGetXR():new( ::BEArea[4], , aPosF, aSizeF, aPPSle,, ; @::aTextP[j], nFa, .T., , ; , , , , nA ) ) ++::SZNr ::SingleZeile[::SZNr]:clipSiblings := .F. ::SingleZeile[::SZNr]:killInputFocus := {|mp1,mp2,obj| DeHiliteSle( obj ), IIf( obj:changed(), ; {::Vorschau:ParUpdate(), p:=1, ::Vorschau:UPDATE()},) } //12.05.2006 19:02 ::SingleZeile[::SZNr]:CREATE():setdata() ::addEditControl( ::SingleZeile[::SZNr] ) ENDIF NEXT ::LeditC := Len(::editControls) nZeiF := nBo // 24.08.2004, nZeiT wird hier gar nicht gebraucht // ::aBlatt := aBlattG FOR i := 1 TO Len(::aBlatt) ::aBlattZ := ::aBlatt[i] AAdd( ::aSeite, ::aBlattZ[1], i ) AAdd( ::aNa, ::aBlattZ[2], i ) AAdd( ::aPrompt, ::aBlattZ[3], i ) AAdd( ::aText, ::aBlattZ[4], i ) AAdd( ::aTFont, ::aBlattZ[5], i ) AAdd( ::aBereich, ::aBlattZ[6], i ) AAdd( ::aFeld, ::aBlattZ[7], i ) // Feldbezeichnung AAdd( ::aFFont, ::aBlattZ[8], i ) AAdd( ::aZei, ::aBlattZ[9], i ) AAdd( ::aSpa, ::aBlattZ[10], i ) IF i > 1 .AND. nZeiF!=nBo // 24.8.2004 nZei := IIf( ::aZei[i] < 0, -1, IIf(::aZei[i]=0, -1, ::aZei[i]) ) ////// 24.08.2004 nSpa := IIf( ::aBlattZ[10]<1, (nSpa + Len(Trim(::aText[i-1])) ; ////// + Len(Trim(::aFeld[i-1])) - ::aBlattZ[10]), ::aBlattZ[10] ) ELSE nZei := IIf( ::aZei[i] > 1, 1, ::aZei[i] ) ////// nSpa := ::aSpa[i] ENDIF DO CASE CASE Upper( ::aSeite[i] ) = "R" .OR. Upper( ::aSeite[i] ) = "V" .OR. ::aSeite[i] = "2" ; .OR. Upper( ::aSeite[i] ) = "K" // keine Žnderungen, wenn es sich um "Rechnungszeilen" handelt ::addEditControl( ::aFeld[i] ) CASE ::aNa[i] = "t" // erzeugt ein Sle fr eine Textzeile // zuerst kommt der Prompt-Text : aSizeT := ::BEArea[3]:currentSize() nZeiF := IIf( nZei < 1, nZeiF+nHt*nZei, aSizeT[2]-nHt-1.5*nHt*nZei ) aPosF := {Int(0), nZeiF} ; aSizeF := {aSizeT[1]*.2,Int(nHt)} AAdd( ::TextZeile, MStatic():new( ::BEArea[3], oOwner, aPosF, aSizeF, aPPTxt,, ; XBPSTATIC_TYPE_TEXT, Trim(::aPrompt[i]) ) ) ++::TZNr IIf( nV<=1, ::TextZeile[::TZNr]:setFontCompoundName( "8.Arial" ), ) // ::XbpStatic:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_LEFT ::TextZeile[::TZNr]:create() ////// aSizeT := ::BEArea[3]:currentSize() ////// nZeiF := IIf( nZei < 1, nZeiF+nHv*nZei, aSizeT[2]-nHv-1.5*nHv*nZei ) aPosF := {aSizeT[1]*.2, nZeiF} ; aSizeF := {aSizeT[1]*.78,Int(nHt)} //// ::aText[i] := IIf(SET(43)==0,ConvToAnsiCP(::aText[i]),::aText[i]) ::aText[i] := PadR( ::aText[i], nFA ) // nZeiF := IIf( nZei < 1, nZeiF+nHv*nZei, nBo+nHv-nHv*nZei ) // aPosF := {Int(nSpa*nBr*nV), nZeiF} ; aSizeF := {Int(Len(xF:=::aText[i])*nBr),Int(15*nV)} // AAdd( ::SingleZeile, MGetX():new( ::BEArea[3], oOwner, aPosF, aSizeF, aPPSle,, ; // 0, nFA, , , ; // , , , ::aText, i ) ) AAdd( ::SingleZeile, MGetXR():new( ::BEArea[3], , aPosF, aSizeF, aPPSle,, ; @::aText[i], nFa, .T., , ; , , , , nA ) ) ++::SZNr ::SingleZeile[::SZNr]:clipSiblings := .F. ::SingleZeile[::SZNr]:cargo := ::vorschau ::SingleZeile[::SZNr]:killInputFocus := {|mp1,mp2,obj| DeHiliteSle( obj ), ; obj:getData(), obj:cargo:UPDATE() } ::SingleZeile[::SZNr]:CREATE():setdata() ::addEditControl( ::SingleZeile[::SZNr] ) CASE ::aNa[i] = "f" // erzeugt ein Sle fr eine Feldzeile // zuerst kommt der Prompt-Text : aSizeT := ::BEArea[3]:currentSize() nZeiF := IIf( nZei < 1, nZeiF+nHt*nZei, aSizeT[2]-nHt-1.5*nHt*nZei ) aPosF := {Int(0), nZeiF} ; aSizeF := {aSizeT[1]*.2,Int(nHt)} AAdd( ::TextZeile, MStatic():new( ::BEArea[3], oOwner, aPosF, aSizeF, aPPTxt,, ; XBPSTATIC_TYPE_TEXT, Trim(::aPrompt[i]) ) ) ++::TZNr IIf( nV<=1, ::TextZeile[::TZNr]:setFontCompoundName( "8.Arial" ), ) // ::XbpStatic:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_LEFT ::TextZeile[::TZNr]:create() ////// cB := ::aBereich[i] ; cF := ::aFeld[i] ////// xF := ( (&cB)->(&cF) ) //Feldinhalt ////// DO CASE ////// CASE Valtype( xF ) == "C" ////// ::aFeld[i] := xF ////// CASE ValType( xF ) == "N" ////// ::aFeld[i] := Str( xF ) ////// CASE ValType( xF ) == "D" ////// ::aFeld[i] := DtoC( xF ) ////// ENDCASE // nZeiF := IIf( nZei < 1, nZeiF+nHt*nZei, nBo+nHv-nHv*nZei ) // aPosF := {Int(nSpa*nBr*nV), nZeiF} ; aSizeF := {Int(Len(xF:=::aFeld[i])*nBr),Int(15*nV)} ::aFeld[i] := PadR( ::aFeld[i], nFA ) aPosF := {aSizeT[1]*.2, nZeiF} ; aSizeF := {aSizeT[1]*.78,Int(nHt)} AAdd( ::SingleZeile, MGetXR():new( ::BEArea[3], , aPosF, aSizeF, aPPSle,, ; @::aFeld[i], nFa, .T., , ; , , , , nA ) ) ++::SZNr ::SingleZeile[::SZNr]:clipSiblings := .F. ::SingleZeile[::SZNr]:cargo := ::vorschau ::SingleZeile[::SZNr]:killInputFocus := {|mp1,mp2,obj| DeHiliteSle( obj ), ; obj:getData(), obj:cargo:UPDATE() } ::SingleZeile[::SZNr]:CREATE():setdata() ::addEditControl( ::SingleZeile[::SZNr] ) //------------ CASE ::aNa[i] = "M" // erzeugt ein Mle fr einen Text // zuerst kommt der Prompt-Text : aSizeT := ::BEArea[3]:currentSize() nZeiF := IIf( nZei < 1, nZeiF+nHt*nZei, aSizeT[2]-nHt-1.5*nHt*nZei ) aPosF := {Int(0), nZeiF} ; aSizeF := {aSizeT[1]*.2,Int(nHt)} AAdd( ::TextZeile, MStatic():new( ::BEArea[3], oOwner, aPosF, aSizeF, aPPTxt,, ; XBPSTATIC_TYPE_TEXT, Trim(::aPrompt[i]) ) ) ++::TZNr IIf( nV<=1, ::TextZeile[::TZNr]:setFontCompoundName( "8.Arial" ), ) ::TextZeile[::TZNr]:create() ::aFeld[i] := PadR( ::aFeld[i], nFA ) cF := ::aFeld[i] nZeiF := nZeiF+(::aTFont[i]-1)*nHt*nZei aPosF := {aSizeT[1]*.2, nZeiF} ; aSizeF := {aSizeT[1]*.78,::aTFont[i]*Int(nHt)} AAdd( ::MultiZeile, MMleXR():new( ::BEArea[3], , aPosF, aSizeF, aPPSle,, ; @&cF, nFa, .T., , ; , , , , nA ) ) ++::MZNr ::MultiZeile[::MZNr]:cargo := ::vorschau ::MultiZeile[::MZNr]:killInputFocus := {|mp1,mp2,obj| DeHiliteSle( obj ), ; obj:getData(), obj:cargo:UPDATE() } ::MultiZeile[::MZNr]:CREATE() //1.1.2005###################:setData() // ::MultiZeile[::MZNr]:helpLink := MagicHelpLabel():New(sv->FIELD_DEC) // ::MultiZeile[::MZNr]:setName( y ) ::addEditControl( ::MultiZeile[::MZNr] ) CASE ::aNa[i] = "v" // erzeugt ein Sle fr eine Variablen/Feldzeile // zuerst kommt der Prompt-Text : aSizeT := ::BEArea[3]:currentSize() nZeiF := IIf( nZei < 1, nZeiF+nHt*nZei, aSizeT[2]-nHt-1.5*nHt*nZei ) aPosF := {Int(0), nZeiF} ; aSizeF := {aSizeT[1]*.2,Int(nHt)} AAdd( ::TextZeile, MStatic():new( ::BEArea[3], oOwner, aPosF, aSizeF, aPPTxt,, ; XBPSTATIC_TYPE_TEXT, Trim(::aPrompt[i]) ) ) ++::TZNr IIf( nV<=1, ::TextZeile[::TZNr]:setFontCompoundName( "8.Arial" ), ) // ::XbpStatic:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_LEFT ::TextZeile[::TZNr]:create() //// ::aFeld[i] := IIf(SET(43)==0,ConvToAnsiCP(::aFeld[i]),::aFeld[i]) cF := ::aFeld[i] xF := PadR( &(cF), nFA ) //Variableninhalt DO CASE CASE xF == NIL ::aFeld[i] := "&(" + cF + ")" CASE Valtype( xF ) == "C" ::aFeld[i] := xF CASE ValType( xF ) == "N" ::aFeld[i] := Str( xF ) CASE ValType( xF ) == "D" ::aFeld[i] := DtoC( xF ) ENDCASE IF xF != NIL // nZeiF := IIf( nZei < 1, nZeiF+nHv*nZei, nBo+nHv-nHv*nZei ) // aPosF := {Int(nSpa*nBr*nV), nZeiF} ; aSizeF := {Int(Len(xF:=::aFeld[i])*nBr),Int(15*nV)} ::aFeld[i] := PadR( ::aFeld[i], nFA ) aPosF := {aSizeT[1]*.2, nZeiF} ; aSizeF := {aSizeT[1]*.78,Int(nHt)} ////// AAdd( ::SingleZeile, MGet():new( ::BEArea[3], oOwner, aPosF, aSizeF, aPPSle,, ; ////// @&cF, nFA, .F., , ; ////// , , , , nA ) ) // AAdd( ::SingleZeile, MGetX():new( ::BEArea[3], oOwner, aPosF, aSizeF, aPPSle,, ; // 0, nFA, , , ; // , , , ::aFeld, i ) ) AAdd( ::SingleZeile, MGetXR():new( ::BEArea[3], , aPosF, aSizeF, aPPSle,, ; @::aFeld[i], nFa, .T., , ; , , , , nA ) ) ++::SZNr ::SingleZeile[::SZNr]:clipSiblings := .F. ::SingleZeile[::SZNr]:cargo := ::vorschau ::SingleZeile[::SZNr]:killInputFocus := {|mp1,mp2,obj| DeHiliteSle( obj ), ; obj:getData(), obj:cargo:UPDATE() } ::SingleZeile[::SZNr]:CREATE():setdata() ::addEditControl( ::SingleZeile[::SZNr] ) ELSE ::addEditControl( ::aFeld[i] ) ENDIF CASE !Empty( xF := ::aText[i] ) ////// nZeiF := IIf( nZei < 1, nZeiF+nHt*nZei, nBo+nHt-nHt*nZei ) ////// aPosF := {Int(nSpa*nBr*nV), nZeiF} ; aSizeF := {Int(Len(xF:=Trim(::aText[i]))*nBr),Int(15*nV)} ////// AAdd( ::TextZeile, MStatic():new( ::BEArea[::BENr], oOwner, aPosF, aSizeF, aPPTxt,, ; ////// XBPSTATIC_TYPE_TEXT, Trim(::aText[i]) ) ) ////// ++::TZNr ////// IIf( nV<=1, ::TextZeile[::TZNr]:setFontCompoundName( "8.Arial" ), ) //////// ::XbpStatic:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_LEFT ////// ::TextZeile[::TZNr]:create() ::addEditControl( ::aText[i] ) CASE !Empty( xF := ::aFeld[i] ) IF ::aNa[i] != "v" .AND. ::aBereich[i] = "v" // im aFeld steht Mem-Variable cF := ::aFeld[i] ::aFeld[i] := "&(" + cF + ")" ELSE cB := ::aBereich[i] ; cF := ::aFeld[i] ::aFeld[i] := ((&cB)->(&cF)) //Feldinhalt ENDIF ////// IF ValType( ::aFeld[i] ) != "M" ////// nZeiF := IIf( nZei < 1, nZeiF+nHt*nZei, nBo+nHt-nHt*nZei ) ////// aPosF := {Int(nSpa*nBr*nV), nZeiF} ; aSizeF := {Int(Len(xF:=Trim(::aFeld[i]))*nBr),Int(15*nV)} ////// AAdd( ::TextZeile, MStatic():new( ::BEArea[::BENr], oOwner, aPosF, aSizeF, aPPTxt,, ; ////// XBPSTATIC_TYPE_TEXT, Trim(::aFeld[i]) ) ) ////// ++::TZNr ////// IIf( nV<=1, ::TextZeile[::TZNr]:setFontCompoundName( "8.Arial" ), ) //////// ::XbpStatic:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_LEFT ////// ::TextZeile[::TZNr]:create() ::addEditControl( ::aFeld[i] ) ////// ENDIF OTHERWISE ::addEditControl( ::aFeld[i] ) ENDCASE ::aBlatt[i] := { ::aSeite[i], ::aNa[i], ::aPrompt[i], ; ::aText[i], ::aTFont[i], ::aBereich[i], ; ::aFeld[i], ::aFFont[i], ::aZei[i], ::aSpa[i] } NEXT //////////// SELECT &nOldArea // wohl berflssig?? //???? DBRegisterClient(self) // wozu, wenn wir aus dem Array arbeiten? //???? RETURN self METHOD BlattFA:destroy( nA ) //?????? (nA)->(DbDeregisterClient()) ASize( ::BEArea, 0 ) ::BENr := 0 ////// ASize( ::BrowseFeld, 0 ) ////// ::BFNr := 0 // ASize( ::BVariable, 0 ) // ::BVNr := 0 ASize( ::GruppenBox, 0 ) ::GBNr := 0 ASize( ::TextZeile, 0 ) ::TZNr := 0 ASize( ::DruckKnopf, 0 ) ::DKNr := 0 ////// ASize( ::MultiZeile, 0 ) ////// ::MZNr := 0 ASize( ::SingleZeile, 0 ) ::SZNr := 0 ASize( ::editControls, 0 ) ASize( ::appendControls, 0 ) ASize( ::keyControls, 0 ) ::keyboardBlock := {|nKey,x,obj| 0 } ASize( ::aBlatt, 0 ) ASize( ::aParam, 0 ) ASize( ::aBlattZ, 0 ) ASize( ::aSeite, 0 ) ASize( ::aNa, 0 ) ASize( ::aPrompt, 0 ) ASize( ::aText, 0 ) ASize( ::aTFont, 0 ) ASize( ::aBereich, 0 ) ASize( ::aFeld, 0 ) ASize( ::aFFont, 0 ) ASize( ::aZei, 0 ) ASize( ::aSpa, 0 ) RETURN self METHOD BlattFA:addEditcontrol( oXbp ) IF ValType( oXbp ) = "O" IF AScan( ::editControls, oXbp ) == 0 AAdd( ::editControls, oXbp ) ::addKeyControl( oXbp ) ENDIF ELSE AAdd( ::editControls, oXbp ) ENDIF RETURN self METHOD BlattFA:addAppendControl( oXbp ) IF AScan( ::appendControls, oXbp ) == 0 AAdd( ::appendControls, oXbp ) ::addKeyControl( oXbp ) ENDIF RETURN self METHOD BlattFA:addKeyControl( oXbp ) IF AScan( ::keyControls, oXbp ) == 0 AAdd( ::keyControls, oXbp ) oXbp:keyBoard := ::keyboardBlock ENDIF RETURN self // zum Suchen nach Texten in der Vorschau (fr Trauerkarten-Druck) 16.07.2006 10:14 // (erweiterte Version der Spruchsuche (siehe in BlattDrVG) METHOD BlattFA:Such( oSE, oDlg1, cProg, nAnf, nEnd, nA, nRec, aPos, ASize, aPP, cTitel, cS, cDatei ) LOCAL oDlg, nEvent, mp1, mp2, oXbp, oBrowse, cText := "" LOCAL nOldArea := Select(), oFocus := SetAppFocus(), oFoc LOCAL lFlucht := .F. PRIVATE oCB DEFAULT oDlg1 TO oVODA DEFAULT cProg TO "s_dru" DEFAULT nAnf TO 900, nEnd TO 999, nA TO 25, nRec TO RecNo() DEFAULT aPos TO {10*nH,30*nV} , ASize TO {int(400*nH),int(250*nV)} DEFAULT cTitel TO "Text ausw„hlen ( = zurck) :" DEFAULT cS TO Upper(Trim(oSE:getData())) DEFAULT cDatei TO "TextSymb" IF cS = "-" // 20.09.2006 17:02 damit in TKarten leere Streifen erzeugt werden k”nnen RETURN "-" ENDIF // DbSuspendNotifications() SELECT(nA) IF Val(cS) = 0 // wenn nach einem Textteil gesucht wird (nA)->(DbSetFilter( {|| cS$Upper((nA)->text) } )) IIf( !(nA)->(Bof()), (nA)->(DbGotop()), ) ELSE // wenn nach einer TextNr gesucht wird (nA)->(DbSeek( cS, .T. )) IF Val(cS) < Val((nA)->textnr) (nA)->(DbSkip(-1)) ENDIF ENDIF oDlg := AKDialog():new( AppDesktop(), oDlg1:cargo ) oDlg:tasklist := .T. oDlg:title := cTitel oDlg:maxButton := .F. oDlg:border := XBPDLG_RAISEDBORDERTHIN_FIXED oDlg:create(,, aPos, ASize ) oDlg:drawingArea:setColorBG( GRA_CLR_DARKCYAN ) oCB := oDlg:drawingArea oCB:cargo := oDlg // jetzt folgt die Erzeugung der Eingabefelder oBrowse := DialogFF():new( oCB,oDlg, , ,,, nBz, cProg, nAnf, nEnd, nA ) oBrowse:Fancy := "" oBrowse:VArea := nA oBrowse:BEArea := {} AAdd( oBrowse:BEArea, oCB ) oBrowse:BENr := Len( oBrowse:BEArea ) oBrowse:CREATE( oCB,oDlg, , ,aPP,, nBz, cProg, nAnf, nEnd, nA ) // bis hierhin geht die Erzeugung der Eingabefelder AEval( oBrowse:editControls, {|x| oDlg:addEditControl( x ) } ) oDlg:setModalState( XBP_DISP_APPMODAL ) oDlg:show() SetAppFocus( oBrowse:BrowseFeld[1] ) nEvent := xbeP_None DO WHILE nEvent <> xbeP_Close nEvent := AppEvent( @mp1, @mp2, @oXbp ) IF nEvent == xbeBRW_ItemSelected PostAppEvent( xbeP_Close) ENDIF IF nEvent == xbeP_Keyboard DO CASE CASE mp1 >= Asc(" ") .and. mp1 <= Asc("z") cSuchWort += Chr(mp1) DbSeek( Upper(cSuchWort), .T. ) IF !Found() DbSkip(-1) ENDIF oBrowse:BrowseFeld[1]:refreshAll() CASE mp1 == xbeK_RETURN .or. mp1 == xbeK_F10 PostAppEvent( xbeP_Close) CASE mp1 == xbeK_ESC lFlucht := .T. PostAppEvent( xbeP_Close) CASE mp1 == xbeK_CTRL_DEL oFoc := SetAppFocus() IF ConfirmBox( oDlg1, "Soll der Datensatz wirklich gel”scht werden?", ; "Datensatz l”schen!", ; XBPMB_YESNO, ; XBPMB_QUESTION, ; XBPMB_DEFBUTTON2 ) == XBPMB_RET_YES Satzsp( oCB ) (nA)->(DbDelete()) IF !(nA)->(Bof()) (nA)->(DbSkip(-1)) // 21.6.2005 zum Test ENDIF nRec := RecNo() oBrowse:BrowseFeld[1]:refreshAll() ENDIF SetAppFocus(oFoc) ENDCASE ENDIF oXbp:handleEvent( nEvent, mp1, mp2 ) ENDDO oDlg:setModalState( XBP_DISP_MODELESS ) oDlg:destroy() IF lFlucht = .F. oSE:setData( (nA)->textnr + " | " + PadR((nA)->text,40) ) // wird in Param-Tab angezeigt IF oSE:trigger < 11 (nA)->(DbClearFilter()) (nA)->(DbSetScope( SCOPE_BOTH, (nA)->textnr )) (nA)->(DbEval({|| cText += Trim((nA)->text+CRLF)})) // setzt den Spruch zusammen (nA)->(DbClearScope()) cText := Stuff(cText,Len(cText)-1,2," ") // damit letztes CRLF verschwindet ELSE cText := (nA)->bild //22.07.2006 16:23 ENDIF ELSE (nA)->(DbClearFilter()) cText := "" ENDIF SELECT (nOldArea) // DbResetNotifications() // (nA)->(DbSkip(0)) SetAppFocus( oFocus ) RETURN cText //------------------------------------------ //------------------------------------------ CLASS MStatic from XbpStatic EXPORTED: METHOD Init METHOD CREATE ENDCLASS METHOD MStatic:Init( oParent, oOwner, aPos, aSize, aPP, lVisible, nType, cText ) LOCAL nOptions := IIf( nType = NIL .OR. nType = XBPSTATIC_TYPE_TEXT, ; XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT, XBPSTATIC_FRAMETHIN ) LOCAL aPPG := { { XBP_PP_FGCLR , GRA_CLR_BLACK } , ; { XBP_PP_BGCLR , XBPSYSCLR_DIALOGBACKGROUND } } // 07.11.2005 bisher WHITE aPP := IIf( aPP=NIL, aPPG, aPP ) IIf( nType = XBPSTATIC_TYPE_GROUPBOX, AAdd ( aPP, { XBP_PP_COMPOUNDNAME, "8.Arial kursiv" } ), ) nType := IIf( nType = NIL, XBPSTATIC_TYPE_TEXT, nType ) ::XbpStatic:init( oParent, oOwner, aPos, aSize, aPP, lVisible ) ::TYPE := nType ::caption := IIf(SET(43)==0 .AND. ValType(cText)=="C",ConvToAnsiCP(cText),cText) IF nType = XBPSTATIC_TYPE_TEXT .AND. cColor = "D" ::setColorBG( oParent:setColorBG() ) ::setColorFG( GRA_CLR_YELLOW ) ENDIF ::clipSiblings := .F. ::options := nOptions RETURN self METHOD MStatic:CREATE( oParent, oOwner, aPos, aSize, aPP, lVisible ) ::XbpStatic:create( oParent, oOwner, aPos, aSize, aPP, lVisible ) RETURN self //------------------------------------------ CLASS MGet FROM XbpSle // NUR fr Anzeige! NICHT fr Eingabe! EXPORTED: VAR picture VAR killer METHOD INIT METHOD CREATE METHOD killInputFocus // ak 22.3.04 ENDCLASS METHOD MGet:INIT( oDlg1, oDlg2, aPos, aSize, aPP,lVisible, cVarR, nFa, lT, cPicture, ; cTEXT, aPosT, aSizeT, aPPTxt, nA ) LOCAL oXbp DEFAULT cPicture TO Trim(" ") IF !Empty( cText ) oXbp := MStatic():new( oDlg1,, aPosT, aSizeT, aPPTxt,, XBPSTATIC_TYPE_TEXT, cText ) oXbp:CREATE() ENDIF ::XbpSle:INIT( oDlg1, , aPos, aSize, aPP ) ::clipSiblings := .T. ::tabStop := lT ::setInputFocus := {|mp1,mp2,obj| HiliteSle( obj ) } ::killInputFocus := {|mp1,mp2,obj| DeHiliteSle( obj ) } ::group := XBP_WITHIN_GROUP ::bufferLength := nFa // ::editable := lT ::picture := cPicture DO CASE CASE ValType( cVarR ) == "C" ::dataLink := {|x| IIf( PCOUNT()==0, cVarR, cVarR := x ) } CASE ValType( cVarR ) == "N" ::dataLink := {|x| IIf( PCOUNT()==0, Transform(cVarR,cPicture), cVarR := Val(x) ) } CASE ValType( cVarR ) == "D" ::dataLink := {|x| IIf( PCOUNT()==0, DtoC(cVarR), cVarR := CtoD(x) ) } CASE ValType( cVarR ) == "L" ::dataLink := {|x| IIf( PCOUNT()==0, cVarR, cVarR := x ) } ENDCASE RETURN self METHOD MGet:CREATE( oParent, oOwner, aPos, aSize, aPP, lVisible ) ::XbpSle:CREATE( oParent, oOwner, aPos, aSize, aPP, lVisible ) RETURN self METHOD MGet:killInputFocus() // ak 22.3.04 IF ::changed .AND. !Empty(::killer) .AND. ValType(&(::killer)) == "B" Eval(&(::killer),self) // 9.4.2005 ENDIF ::XbpSle:killinputfocus() RETURN self CLASS MGetX FROM XbpGet EXPORTED: VAR killer METHOD INIT METHOD CREATE ENDCLASS METHOD MGetX:INIT( oDlg1, oDlg2, aPos, aSize, aPP,lVisible, y, nFa, lT, cPicture, ; cTEXT, aPosT, aSizeT, aPPTxt, nA ) LOCAL oXbp IF !Empty( cText ) oXbp := MStatic():new( oDlg1,, aPosT, aSizeT, aPPTxt,, XBPSTATIC_TYPE_TEXT, cText ) oXbp:CREATE() ENDIF ::XbpGet:INIT( oDlg1, , aPos, aSize, aPP ) ::clipSiblings := .T. ::tabStop := lT ::setInputFocus := {|mp1,mp2,obj| HiliteSle( obj ) } ::killInputFocus := {|mp1,mp2,obj| DeHiliteSle( obj ) } ::group := XBP_WITHIN_GROUP ::bufferLength := nFa DO CASE CASE y == 0 ::dataLink := {|x| IIf( PCOUNT()==0, aPPTxt[nA], aPPTxt[nA] := x ) } CASE (nA)->(FieldInfo( y, FLD_TYPE )) = "C" .AND. FIELD_TYPE == "U" ::dataLink := {|x| IIf( PCOUNT()==0, (nA)->&((nA)->(FieldName(y))), (nA)->&((nA)->(FieldName(y))) := Upper( x ) ) } CASE (nA)->(FieldInfo( y, FLD_TYPE )) = "C" ::dataLink := {|x| IIf( PCOUNT()==0, (nA)->&((nA)->(FieldName(y))), (nA)->&((nA)->(FieldName(y))) := x ) } CASE (nA)->(FieldInfo( y, FLD_TYPE )) = "L" ::dataLink := {|x| IIf( PCOUNT()==0, (nA)->&((nA)->(FieldName(y))), (nA)->&((nA)->(FieldName(y))) := x ) } CASE (nA)->(FieldInfo( y, FLD_TYPE )) = "N" ::dataLink := {|x| IIf( PCOUNT()==0, (nA)->&((nA)->(FieldName(y))), (nA)->&((nA)->(FieldName(y))) := x ) } IF !Empty(cPicture) ::picture := cPicture ELSE DO CASE CASE nFa == 3 ::picture := "999" CASE nFa == 5 ::picture := "99.99 Uhr" CASE nFa == 6 ::picture := "999999" CASE nFa == 8 ::picture := "99,999.99" CASE nFa == 10 ::picture := "9,999,999.99" ENDCASE ENDIF CASE (nA)->(FieldInfo( y, FLD_TYPE )) = "D" ::picture := IIf( !Empty(cPicture), cPicture, "DD.MM.YYYY" ) ::dataLink := {|x| IIf( PCOUNT()==0, (nA)->&((nA)->(FieldName(y))), (nA)->&((nA)->(FieldName(y))) := x ) } ENDCASE IF y > 0 ::cargo := (nA)->(FieldName(y)) ELSE ::cargo := aPPTxt[nA] //****** Testen, ob das beim Drucken geht!!!!! ENDIF // ::setName( y ) RETURN self METHOD MGetX:CREATE( oParent, oOwner, aPos, aSize, aPP, lVisible ) ::XbpGet:CREATE( oParent, oOwner, aPos, aSize, aPP, lVisible ):setdata() //*************** steht im DialogFF:create() // DBRegisterClient(self) //*************** RETURN self //------------------------------------------ CLASS MGetXR FROM XbpGet EXPORTED: VAR killer VAR trigger // Ausl”ser fr UDF/Methoden-Aufruf bei killinputfocus 15.07.2006 22:36 METHOD INIT METHOD CREATE ENDCLASS METHOD MGetXR:INIT( oDlg1, oDlg2, aPos, aSize, aPP,lVisible, cVarR, nFa, lT, cPicture, ; cTEXT, aPosT, aSizeT, aPPTxt, nA ) LOCAL oXbp, y := 1000 DEFAULT cPicture TO Trim(" ") IF !Empty( cText ) oXbp := MStatic():new( oDlg1,, aPosT, aSizeT, aPPTxt,, XBPSTATIC_TYPE_TEXT, cText ) oXbp:CREATE() ENDIF ::XbpGet:INIT( oDlg1, , aPos, aSize, aPP ) ::clipSiblings := .T. ::tabStop := lT ::setInputFocus := {|mp1,mp2,obj| HiliteSle( obj ) } ::killInputFocus := {|mp1,mp2,obj| DeHiliteSle( obj ) } ::group := XBP_WITHIN_GROUP ::bufferLength := nFa IF !Empty(cPicture) ::picture := cPicture // ELSE // ENDIF ::dataLink := {|x| IIf( PCOUNT()==0, cVarR, cVarR := x ) } ////// DO CASE ////// CASE ValType( cVarR ) == "C" ////// ::dataLink := {|x| IIf( PCOUNT()==0, cVarR, cVarR := x ) } ////// CASE ValType( cVarR ) == "N" ////// ::dataLink := {|x| IIf( PCOUNT()==0, Transform(cVarR,cPicture), cVarR := Val(x) ) } ////// CASE ValType( cVarR ) == "D" ////// ::dataLink := {|x| IIf( PCOUNT()==0, DtoC(cVarR), cVarR := CtoD(x) ) } ////// CASE ValType( cVarR ) == "L" ////// ::dataLink := {|x| IIf( PCOUNT()==0, cVarR, cVarR := x ) } ////// ENDCASE RETURN self METHOD MGetXR:CREATE( oParent, oOwner, aPos, aSize, aPP, lVisible ) ::XbpGet:CREATE( oParent, oOwner, aPos, aSize, aPP, lVisible ):setdata() //*************** steht im DialogFF:create() // DBRegisterClient(self) //*************** RETURN self //------------------------------------------ CLASS MMle FROM XbpMle EXPORTED: VAR killer VAR vorigerWert // 19.12.2004 VAR value // 19.12.2004 METHOD INIT METHOD CREATE ENDCLASS METHOD MMle:INIT( oDlg1, oDlg2, aPos, aSize, aPP, lVisible, y, nFa, lT, ; cTEXT, aPosT, aSizeT, aPPTxt, nA ) LOCAL oXbp IF !Empty( cText ) oXbp := MStatic():new( oDlg1,, aPosT, aSizeT, aPPTxt,, XBPSTATIC_TYPE_TEXT, cText ) oXbp:CREATE() ENDIF ::XbpMle:INIT( oDlg1, , aPos, aSize, aPP ) ::dataLink := {|x| IIf( PCOUNT()==0, (nA)->&((nA)->(FieldName(y))), ; (nA)->&((nA)->(FieldName(y))) := IIf(DbRLock(),x,x) ) } ::clipSiblings := .T. ::ignoreTab := .T. ::tabStop := .F. ::setInputFocus := {|mp1,mp2,obj| HiliteSle( obj ) } ::killInputFocus := {|mp1,mp2,obj| DeHiliteSle( obj ) } ::wordWrap := .T. ::horizScroll := .F. ::group := XBP_END_GROUP ::cargo := (nA)->(FieldName(y)) RETURN self METHOD MMle:CREATE( oDlg1, oDlg2, aPos, aSize, aPP ) ::XbpMle:CREATE( oDlg1,, aPos, aSize, aPP ):setdata() RETURN self //---------------- CLASS MMleXR FROM XbpMle EXPORTED: VAR killer VAR vorigerWert // 19.12.2004 VAR value // 19.12.2004 METHOD INIT METHOD CREATE ENDCLASS METHOD MMleXR:INIT( oDlg1, oDlg2, aPos, aSize, aPP,lVisible, cVarR, nFa, lT, cPicture, ; cTEXT, aPosT, aSizeT, aPPTxt, nA ) LOCAL oXbp DEFAULT cPicture TO Trim(" ") IF !Empty( cText ) oXbp := MStatic():new( oDlg1,, aPosT, aSizeT, aPPTxt,, XBPSTATIC_TYPE_TEXT, cText ) oXbp:CREATE() ENDIF ::XbpMle:INIT( oDlg1, , aPos, aSize, aPP ) ::clipSiblings := .T. ::ignoreTab := .T. ::tabStop := .T. ::setInputFocus := {|mp1,mp2,obj| HiliteSle( obj ) } ::killInputFocus := {|mp1,mp2,obj| DeHiliteSle( obj ) } ::wordWrap := .T. ::horizScroll := .F. ::group := XBP_END_GROUP ::dataLink := {|x| IIf( PCOUNT()==0, cVarR, cVarR := IIf(DbRLock(),x,x) ) } RETURN self METHOD MMleXR:CREATE( oDlg1, oDlg2, aPos, aSize, aPP ) ::XbpMle:CREATE( oDlg1,, aPos, aSize, aPP ):setdata() RETURN self //------------------------------------------ CLASS MCheck FROM XbpCheckBox EXPORTED: VAR vorigerWert // 19.12.2004 VAR value // 19.12.2004 METHOD INIT METHOD CREATE ENDCLASS METHOD MCheck:INIT( oDlg1, oDlg2, aPos, aSize, aPP, lVisible, y, nFa, lT, ; cTEXT, aPosT, aSizeT, aPPTxt, nA ) LOCAL oXbp ::XbpCheckBox:INIT( oDlg1, , aPos, aSize, aPP ) ::dataLink := {|x| IIf( PCOUNT()==0, (nA)->&((nA)->(FieldName(y))), ; (nA)->&((nA)->(FieldName(y))) := x ) } // ::clipSiblings := .T. // ::ignoreTab := .T. ::tabStop := .T. // ::setInputFocus := {|mp1,mp2,obj| HiliteSle( obj ) } // ::killInputFocus := {|mp1,mp2,obj| DeHiliteSle( obj ) } // ::wordWrap := .T. // ::horizScroll := .F. ::caption := cText // ::group := XBP_END_GROUP // ::cargo := (nA)->(FieldName(y)) RETURN self METHOD MCheck:CREATE( oDlg1, oDlg2, aPos, aSize, aPP ) ::XbpCheckBox:CREATE( oDlg1,, aPos, aSize, aPP ):setdata() RETURN self //------------------------------------------ CLASS MBrowse FROM XbpBrowse EXPORTED: METHOD INIT METHOD CREATE METHOD configure METHOD addColumns METHOD addGetColumns METHOD notify ENDCLASS METHOD MBrowse:INIT( oBrowseArea,oOwner, aPos, ASize, aPP, lVisible, nA ) DEFAULT aPP TO { { XBP_PP_FGCLR , GRA_CLR_BLACK } , ; { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } ::XbpBrowse:INIT( oBrowseArea,oOwner, aPos, ASize, aPP, lVisible ) // Navigations Codebloecke fuer den Browser ::skipBlock := {|n| (nA)->(DbSkipper(n)) } ::goTopBlock := {| | (nA)->(DbGoTop()) } ::goBottomBlock := {| | (nA)->(DbGoBottom()) } ::phyPosBlock := {| | (nA)->(Recno()) } // Codebloecke fuer den vertikalen Scrollbar. // Hinweis: DbPosition() liefert Werte zwischen 0 und 100. ::posBlock := {| | (nA)->(DbPosition()) } ::goPosBlock := {|n| (nA)->(DbGoPosition(n)) } ::lastPosBlock := {| | 100 } ::firstPosBlock := {| | 0 } ::cursorMode := XBPBRW_CURSOR_ROW RETURN self METHOD MBrowse:CREATE( oBrowseArea,oOwner, aPos, ASize, aPP, lVisible ) DEFAULT aPP TO { { XBP_PP_FGCLR , GRA_CLR_BLACK } , ; { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } ::XbpBrowse:CREATE( oBrowseArea,oOwner, aPos, ASize, aPP, lVisible ) RETURN self METHOD MBrowse:CONFIGURE() ::XbpBrowse:CONFIGURE() RETURN self METHOD MBrowse:addColumns( oParent, oOwner, y, nBreite, cTitel, nA ) LOCAL oColumn LOCAL bBlock := {|x| IIf( PCOUNT()==0, (nA)->&((nA)->(FieldName(y))), (nA)->&((nA)->(FieldName(y))) := x ) } LOCAL aPPB := { { XBP_PP_COL_HA_CAPTION , Trim( sv->Text ) }, ; { XBP_PP_COL_DA_FGCLR , GRA_CLR_BLACK }, ; { XBP_PP_COL_DA_BGCLR , GRA_CLR_WHITE }, ; { XBP_PP_COL_DA_HILITE_FGCLR , GRA_CLR_WHITE }, ; { XBP_PP_COL_DA_HILITE_BGCLR , GRA_CLR_DARKGRAY }, ; { XBP_PP_COL_DA_HILITEFRAMELAYOUT, XBPFRAME_BOX + XBPFRAME_RECT + XBPFRAME_DOTTED }, ; { XBP_PP_COL_DA_CELLFRAMELAYOUT , XBPFRAME_BOX + XBPFRAME_RAISED }, ; { XBP_PP_COL_DA_CHARWIDTH , nBreite }, ; { XBP_PP_COL_DA_ROWSEPARATOR , XBPCOL_SEP_LINE }, ; { XBP_PP_COL_DA_COLSEPARATOR , XBPCOL_SEP_NONE }, ; { XBP_PP_COL_DA_FRAMELAYOUT , XBPFRAME_BOX }, ; { XBP_PP_COL_DA_HILITE_BGCLR , XBPSYSCLR_HILITEBACKGROUND } } // { XBP_PP_COL_FA_CAPTION , "" }, ; aPPB[1,2] := cTitel // aPP[2,2] := "Leistungs-Bezeichnung" oColumn := XbpColumn():new( oParent,,,, aPPB ) oColumn:dataLink := bBlock oParent:addColumn( oColumn ) RETURN oParent //METHOD MBrowse:addGetColumns( oParent, oOwner, y, nBreite, cTitel, nA ) METHOD MBrowse:addGetColumns( oParent, oOwner, cVarR, nBreite, cTitel, nA ) LOCAL oColumn // LOCAL bBlock := {|x| IIf( PCOUNT()==0, (nA)->&((nA)->(FieldName(y))), (nA)->&((nA)->(FieldName(y))) := x ) } LOCAL bBlock := {|x| IIf( PCOUNT()==0, cVarR, cVarR := x ) } LOCAL aPPB := { { XBP_PP_COL_HA_CAPTION , Trim( sv->Text ) }, ; { XBP_PP_COL_DA_FGCLR , GRA_CLR_BLACK }, ; { XBP_PP_COL_DA_BGCLR , GRA_CLR_WHITE }, ; { XBP_PP_COL_DA_HILITE_FGCLR , GRA_CLR_WHITE }, ; { XBP_PP_COL_DA_HILITE_BGCLR , GRA_CLR_DARKGRAY }, ; { XBP_PP_COL_DA_HILITEFRAMELAYOUT, XBPFRAME_BOX + XBPFRAME_RECT + XBPFRAME_DOTTED }, ; { XBP_PP_COL_DA_CELLFRAMELAYOUT , XBPFRAME_BOX + XBPFRAME_RAISED }, ; { XBP_PP_COL_DA_CHARWIDTH , nBreite }, ; { XBP_PP_COL_DA_ROWSEPARATOR , XBPCOL_SEP_LINE }, ; { XBP_PP_COL_DA_COLSEPARATOR , XBPCOL_SEP_NONE }, ; { XBP_PP_COL_DA_FRAMELAYOUT , XBPFRAME_BOX }, ; { XBP_PP_COL_DA_HILITE_BGCLR , XBPSYSCLR_HILITEBACKGROUND } } // { XBP_PP_COL_FA_CAPTION , "" }, ; aPPB[1,2] := cTitel // aPP[2,2] := "Leistungs-Bezeichnung" oColumn := XbpGetColumn():new( oParent,,,, aPPB ) oColumn:cargo := Trim(sv->FIELD_NAME) oColumn:dataLink := bBlock oParent:addColumn( oColumn ) ::cursorMode := XBPBRW_CURSOR_CELL RETURN oParent METHOD MBrowse:notify( nEvent, mp1, mp2 ) IF nEvent == xbeDBO_Notify // Notify-Ereignis IF mp1 == DBO_MOVE_DONE // Skip ist beendet ::XbpBrowse:forceStable() ENDIF ENDIF RETURN //------------------------------------------ CLASS MPButton FROM XbpPushButton EXPORTED: METHOD INIT METHOD CREATE ENDCLASS //Parent ist die drawingArea und Owner ist das XbpWindow METHOD MPButton:INIT( oDlg1, oDlg2, aPos, aSize, aPP, lVisible, ; cButtProg, cCaption, aData1, nFon, nA, lT ) ::XbpPushButton:INIT( oDlg1, , aPos, ASize ) ::caption := cCaption ::clipSiblings := .T. ::tabstop := lT IF Upper( cCaption ) = "OK" ::activate := {|| oDlg2:writeData(), PostAppEvent( xbeP_Close ) } // geREMt am 27.07.2006 16:59: // ELSEIF "<"$cCaption .OR. ">"$cCaption // 27.02.2006 weil SKIP sowieso write macht -> OK so // ::activate := {|cA,oF| cA := SELECT(), ; // PButtProg( oDlg1, cButtProg, cCaption, @aData1, nFontR ), ; // DbSelectArea( cA ), oDlg2:readData(), ; // SetAppFocus( oFocSle )} //, oFocSle:setInputFocus() } ELSEIF !Empty( cButtProg ) ::activate := {|cA,oF| oDlg2:writeData(), cA := SELECT(), ; PButtProg( oDlg1, cButtProg, cCaption, @aData1, nFontR ), ; DbSelectArea( cA ), oDlg2:readData(), ; SetAppFocus( oFocSle )} //, oFocSle:setInputFocus() } ENDIF RETURN self METHOD MPButton:CREATE( oDlg1, oDlg2, aPos, ASize, aPP, lVisible ) ::XbpPushButton:CREATE( oDlg1,, aPos, ASize, aPP, lVisible ) RETURN self //------------------------------------------ FUNCTION PButtProg( oDlg1, cButtProg, cCaption, aData, nFont ) // PRIVATE oDlg := oDlg1, cT //, nFontR := nFont // weil Makros nur mit PRIVATE funktionieren! PRIVATE cT //, nFontR := nFont // weil Makros nur mit PRIVATE funktionieren! DO CASE // CASE ValType(&cButtProg) == "B" // 20.5.2005 : soll das n„chste CASE ersetzen! // Eval( &cButtProg ) CASE SubStr( cButtProg,1,1 ) == "{" Eval( &cButtProg ) OTHERWISE cT := cButtProg // weil Makros nur mit PRIVATE funktionieren! cT := &cT ENDCASE RETURN .T. // Eof() //======================================================================== // Hier steht noch etwas als Ged„chtnissttze: CLASS MWin FROM AKDialog EXPORTED: METHOD INIT METHOD CREATE ENDCLASS METHOD MWin:INIT( oDlg1, oDlg2, aPos, ASize, aPP, lVisible, cDatei, nStart, nEnd, cTitle, ; aEditControls ) LOCAL oXbp, nOldArea := SELECT() LOCAL aPPSle := { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } LOCAL aPPTxt, y // LOCAL nV := AppDesktop():currentSize()[1]/800 LOCAL nBo := aSize[2] - 50 // tats„chliche Bildschirmaufl”sung: LOCAL aSizeDesktop := AppDesktop():currentSize() LOCAL nBSb := aSizeDesktop[1] LOCAL nBSh := aSizeDesktop[2] // folgende Zahlen-Werte basieren auf 800x600: LOCAL n5 := 5*nV LOCAL n10 := 10*nV LOCAL nBh := int(20*nV) // H”he des Bezeichnungsfeldes =20 LOCAL nBz := int(25*nV) // Zeilenh”he des Bezeichnungsfeldes =25 LOCAL nFa := 0 ::AKDialog:INIT( oDlg1, oDlg2, aPos, ASize ) ::title := cTitle ::taskList := .T. ::minButton := .F. ::maxButton := .F. oCB := ::drawingArea IF !Empty( cDatei ) // jetzt folgt die Erzeugung der Eingabefelder DbUseArea( .T.,, "s_best", "sb" ) OrdCreate( "xFldPos",, "Str(field_pos,3,0)" ) // INDEX ON FIELD_POS TO xFLDPOS DbGoTop() FOR i := 1 TO LastRec() IF sb->FIELD_POS < nStart .OR. sb->FIELD_POS > nEnd DbSkip() LOOP ENDIF IF sb->FIELD_TYPE = "S" aPosT := {Int(sb->SpaT*nH),Int(sb->ZeiT*nV)} ; aSizeT := {Int(sb->BrT*nH),Int(sb->HoT*nV)} oXbp := MStatic():new( oCB,, aPosT, aSizeT, aPP,, XBPSTATIC_TYPE_GROUPBOX, Trim(sb->TEXT) ) IIf( nV<=1, oXbp:setFontCompoundName( "6.Arial" ), ) oXbp:create() ELSEIF sb->FIELD_TYPE = "P" aPosT := {Int(sb->SpaT*nH),Int(sb->ZeiT*nV)} ; aSizeT := {Int(sb->BrT*nH),Int(sb->HoT*nV)} cDummy := ("oXbp"+LTrim(Str( sb->FIELD_DEC ))) &cDummy := MPButton():new( oCB,, aPosT, aSizeT,,, Trim(sb->Text), Trim(sb->Field_NAME), ; @aEditControls, @aData1, nFontR ) &cDummy:CREATE() ELSEIF FIELD_TYPE = "M" aPosT := {Int(sb->SpaT*nH),nBo+nBz-nBz*sb->ZeiT} ; aSizeT := {Int(sb->BrT*nH),Int(sb->HoT*nV)} aPosF := {Int(sb->SpaF*nH),nBo+nBz-nBz*sb->ZeiF} ; aSizeF := {Int(sb->BrF*nH),Int(sb->HoF*nV)} y := 1->(FieldPos( cFeld )) // y : Feld-Position in best.dbf oXbpN := MMle():new( oCB,, aPosF, aSizeF, aPPSle,, y, nFa, sb->TAB_STOP,; Trim(sb->TEXT), aPosT, aSizeT, aPPTxt ) oXbpN:CREATE():setData() oXbpN:setName( y ) AAdd ( aEditControls, oXbpN ) ELSE aPosT := {Int(sb->SpaT*nH),nBo+nBz-nBz*sb->ZeiT} ; aSizeT := {Int(sb->BrT*nH),Int(sb->HoT*nV)} aPosF := {Int(sb->SpaF*nH),nBo+nBz-nBz*sb->ZeiF} ; aSizeF := {Int(sb->BrF*nH),Int(sb->HoF*nV)} cFeld := Trim( sb->FIELD_NAME ) cFeld := IIf( cFeld="&", ; &(substr( cFeld,2,len(cFeld)-1 )), ; cFeld ) y := 1->(FieldPos( cFeld )) // y : Feld-Position in best.dbf nFa := sb->FIELD_LEN oXbp := MGetX():new( oCB,, aPosF, aSizeF, aPPSle,, y, nFa, sb->TAB_STOP, Trim( sb->ZAHL_FORM ), ; Trim(sb->TEXT), aPosT, aSizeT, aPPTxt ) oXbp:CREATE():setdata() oXbp:setName( y ) AAdd ( aEditControls, oXbp ) ENDIF DbSkip() NEXT DbCloseArea() // bis hierhin geht die Erzeugung der Eingabefelder SELECT &nOldArea ELSE oXbpBok := XbpPushbutton():new( oCB, , {aSize[1]/2-36,20}, {72,24} ) oXbpBok:caption := "OK" oXbpBok:activate := {|| Satzsp(), Gather( aEditControls ), DbRUnlock(), ; PostAppEvent( xbeP_Close ) } oXbpBok:TabStop := .T. oXbpBok:group := XBP_WITHIN_GROUP oXbpBok:create() ENDIF RETURN self METHOD MWin:CREATE( oDlg1, oDlg2, aPos, ASize, aPP, lVisible ) ::AKDialog:CREATE( oDlg1, oDlg2, aPos, ASize, aPP, lVisible ) RETURN self //------------------------------------------------- ****************************************************************************** /* * Spinbutton Klasse mit ueberladener :keyboard() Methode. Dadurch koennen die * xbeK_UP, xbeK_DOWN Tasten zur Browsernavigation verwendet werden. * Der Spinbutton reagiert stattdessen auf xbeK_ALT_UP, xbeK_ALT_DOWN */ CLASS XbpGetSpinbutton FROM XbpSpinbutton EXPORTED: VAR controller METHOD keyboard ENDCLASS METHOD XbpGetSpinbutton:keyboard( nKey ) DO CASE /* * Der Spinbutton reagiert bei xbeK_ALT_UP oder xbeK_ALT_DOWN genau so * als waere xbeK_UP oder xbeK_DOWN gedrueckt worden. */ CASE nKey == xbeK_ALT_UP ::xbpSpinbutton:keyboard( xbeK_UP ) CASE nKey == xbeK_ALT_DOWN ::xbpSpinbutton:keyboard( xbeK_DOWN ) CASE ::controller == NIL .OR. .NOT. ::controller:keyboard( nKey ) /* * xbeK_UP und xbeK_DOWN werden vom :controller Objekt * (XbpSpinbuttonColumn) an den Browser weitergeleitet und der * fuehrt bei UP/DOWN eine Navigation durch. Alle Tasten, die * nicht vom :controller Objekt behandelt werden, uebernimmt * XbpSpinbutton. */ ::xbpSpinbutton:keyboard( nKey ) ENDCASE RETURN self //================================================================ /* * Klasse zum Anzeigen von Bitmaps oder Metadateien - und jetzt auch Bitmap-Variablen (FOX-Memos) */ CLASS BitView FROM XbpStatic, DataRef // 26.02.2006: DataRef siehe Beispiel MDI: CLASS BitmapRef PROTECTED: VAR oFrame // wird nicht gebraucht VAR oCanvas // ist die Parent-BEArea VAR oPS VAR oBitmap VAR oMetafile VAR nMode VAR lIsEmpty // 26.02.2006 EXPORTED: VAR autoScale VAR file METHOD init, create, load, DISPLAY METHOD setdata, getdata, editbuffer ENDCLASS /* * Objekt initialisieren. Self ist Parent fr zwei XbpStatic Objekte */ METHOD BitView:init( oParent, oOwner, aPos, aSize, aPresParam, lVisible, nType, cVarR, y, nA ) //18.10.2006 17:40 ::dataref:INIT() // 26.02.2006 IF aPos != NIL //19.10.2006 12:10 ::xbpStatic:init( oParent, oOwner, aPos, aSize, aPresParam, lVisible ) ::xbpStatic:type := XBPSTATIC_TYPE_RAISEDRECT ::oFrame := XbpStatic():new( self ) ::oFrame:type := XBPSTATIC_TYPE_RECESSEDRECT ::oCanvas := XbpStatic():new( self ) ELSE ::oCanvas := oParent // wenn schon als Parent erzeugt ENDIF ::autoScale := .T. ::nMode := 0 ::lIsEmpty := .T. // 26.02.2006 noch ist nichts zugewiesen ::oPS := XbpPresSpace():new() ::oBitmap := XbpBitmap():new() // 26.02.2006 frher bei ::loadfile() erzeugt // Test: // ::dataLink := {|x| IIf( PCOUNT()==0, cVarR, cVarR := x ) } //18.10.2006 17:40 ::dataLink := {|x| IIf( PCOUNT()==0, (nA)->&((nA)->(FieldName(y))), ; (nA)->&((nA)->(FieldName(y))) := IIf(DbRLock(),x,x) ) } RETURN self /* * Systemresourcen anfordern. Self ist der „uáere Rahmen, ::oFrame ist der * innere Rahmen und in ::oCanvas wird das Bild gezeichnet */ METHOD BitView:create( oParent, oOwner, aPos, aSize, aPresParam, lVisible ) LOCAL aAttr[ GRA_AA_COUNT ] IF aPos != NIL //19.10.2006 12:10 ::xbpStatic:create( oParent, oOwner, aPos, aSize, aPresParam, lVisible ) aSize := ::currentSize() aSize[1] -= 8 aSize[2] -= 8 ::oFrame:create(self,, {4,4}, aSize ) aSize[1] -= 2 aSize[2] -= 2 ::oCanvas:create(::oFrame,, {1,1}, aSize ) ENDIF /* * Presentation Space mit dem Device Kontext von XbpStatic verbinden */ ::oPS:create( ::oCanvas:winDevice() ) ::oBitmap:CREATE( ::oPS ) // 26.02.2006 jetzt schon hier aAttr[ GRA_AA_COLOR ] := GRA_CLR_BACKGROUND ::oPS:setAttrArea( aAttr ) ::oCanvas:paint := {| aClip | ::display( aClip ) } RETURN self /* * Bitmapdaten aus Feld in Puffer bertragen // 26.02.2006 aus MDI:BitmapRef */ METHOD BitView:setdata( cBuffer ) IF cBuffer == NIL cBuffer := Eval( ::dataLink ) ENDIF IF ! Empty( cBuffer ) ::oBitmap:setBuffer( cBuffer, XBPBMP_FORMAT_WIN3X ) ::lIsEmpty := .F. ::nMode := 1 ELSE ::lIsEmpty := .T. ::nMode := 0 ENDIF ::changed := .F. ::DISPLAY() RETURN cBuffer /* * Gepufferte Bitmap in Feld bertragen // 26.02.2006 aus MDI:BitmapRef */ METHOD BitView:getdata() LOCAL cBuffer := ::oBitmap:setBuffer() IF Valtype( ::dataLink ) == "B" .AND. .NOT. ::lIsEmpty Eval( ::dataLink, cBuffer ) ENDIF RETURN cBuffer METHOD BitView:editbuffer() // 26.02.2006 aus MDI:BitmapRef RETURN ::oBitmap:setBuffer() /* * Bilddatei laden */ METHOD BitView:load( cFile ) LOCAL lSuccess := .F. IF Valtype( cFile ) <> "C" .OR. ! File( cFile ) RETURN lSuccess ENDIF ::nMode := 0 ::file := "" IF ".BMP" $ Upper( cFile ) .OR. ; ".GIF" $ Upper( cFile ) .OR. ; ".JPG" $ Upper( cFile ) .OR. ; ".PNG" $ Upper( cFile ) IF ::oBitmap == NIL // ist jetzt (26.02.2006) schon in ::init() erzeugt ::oBitmap := XbpBitmap():New():create( ::oPS ) ENDIF IF ( lSuccess := ::oBitmap:loadFile( cFile ) ) ::nMode := 1 ::file := cFile ::lIsEmpty := .F. // 26.02.2006 ENDIF ELSEIF ".EMF" $ Upper( cFile ) .OR. ".MET" $ Upper( cFile ) IF ::oMetafile == NIL ::oMetafile := XbpMetafile():New():create() ENDIF IF ( lSuccess := ::oMetafile:load( cFile ) ) ::nMode := 2 ::file := cFile ::lIsEmpty := .F. // 26.02.2006 ENDIF ENDIF RETURN lSuccess /* * Bilddatei anzeigen */ METHOD BitView:display( aClip ) LOCAL lSuccess := .F. LOCAL aSize := ::oCanvas:currentSize() LOCAL aTarget, aSource, nAspect /* * Clip Bereich vorbereiten */ DEFAULT aClip TO { 1, 1, aSize[1]-1, aSize[2]-1 } GraPathBegin( ::oPS ) GraBox( ::oPS, { aClip[1]-1, aClip[2]-1 }, { aClip[3]+1, aClip[4]+1 }, GRA_OUTLINE ) GraPathEnd( ::oPS ) GraPathClip( ::oPS, .T. ) GraBox( ::oPS, {0,0}, aSize, GRA_FILL ) DO CASE CASE ::nMode == 1 /* * Eine Bitmap Datei ist geladen */ aSource := {0,0,Max(::oBitmap:xSize,1),Max(::oBitmap:ySize,1)} // 07.09.2006 19:07 wg. '/0' aTarget := {1,1,aSize[1]-2,aSize[2]-2} IF ::autoScale /* * Bitmap wird auf die Gr”áe von ::oCanvas skaliert */ nAspect := aSource[3] / aSource[4] IF nAspect > 1 aTarget[4] := aTarget[4] / nAspect //25.11.2006 13:06 original:[4]=[3]/nA.. ist falsch!! ELSE aTarget[3] := aTarget[3] * nAspect //25.11.2006 13:07 original:[3]=[4]*nA.. ist falsch!! ENDIF ELSE aTarget[3] := aSource[3] aTarget[4] := aSource[4] ENDIF /* * Bitmap in ::oCanvas horizontal oder vertikal zentrieren */ IF aTarget[3] < aSize[1]-2 nAspect := ( aSize[1]-2-aTarget[3] ) / 2 aTarget[1] += nAspect aTarget[3] += nAspect ENDIF IF aTarget[4] < aSize[2]-2 nAspect := ( aSize[2]-2-aTarget[4] ) / 2 aTarget[2] += nAspect aTarget[4] += nAspect ENDIF ::oBitmap:draw( ::oPS, aTarget, aSource, , GRA_BLT_BBO_IGNORE ) // ::oBitmap:draw( ::oPS, aTarget, aSource, , GRA_BLT_BBO_OR ) // 9.7.04 Sleep(1) CASE ::nMode == 2 /* * Eine Metadatei ist geladen */ IF ::autoScale ::oMetafile:draw( ::oPS, XBPMETA_DRAW_SCALE ) ELSE ::oMetafile:draw( ::oPS, XBPMETA_DRAW_DEFAULT ) ENDIF ENDCASE GraPathClip( ::oPS, .F. ) RETURN lSuccess