Donnerstag, 7. September 2017

Buttons zur Laufzeit dynamisch generieren / generate buttons dynamically during runtime



Vor einiger Zeit benötigte ich eine einblendbare Buttonleiste die ich, ohne Programmänderungen und neukompilieren, an sich ändernde Bedürfnisse anpassen/erweitern konnte.

Heraus kam ein Prototyp basierend auf einer XML Datei die problemlos durch neue Datensätze erweitert werden konnte.
Die XML Daten sahen wie folgt aus:

Name:
    crsDynamic.xml 

Struktur:
    dyn_id          I      Interne Satznummer
    dyn_description C(25)  Beschriftung
    dyn_code        m      Auszuführender Code bei CLICK 
    dyn_picpath     C(250) Pfad und Name einer zu verwendenden Bitmap


Aus Sicherheitsgründen kann der Inhalt des Feldes dyn_code einfach mit STRCONV() nach Hexbinary gewandelt werden oder die XML Daten werden einfach in einer Datenbanktabelle hinterlegt.

Der untenstehende Mustercode nutzt insgesamt 5 Grafiken die im Code entsprechend Eurem Bildarchiv angepasst werden sollten. Sucht im Code (oder ladet die XML Datei in einen Cursor) nach und passt den dort befindlichen relativen Pfad und Dateinamen an.

Im u.a. Mustercode wird keine XML Datei gelesen sondern der XML Stream der Einfachheit wegen  im Form.LOAD generiert.

Zum Testen bauen wir eine Form auf der sich Labels, Textboxen u.ä. Zeug befinden:

über das kleine Bild links oben wird die Buttonleiste per CLICK eingeblendet.

Code in  FORM.LOAD:

* // Create a Datasource so we have something to work with            
* // In a real app this data should be stored in 1 or more tables    

USE IN SELECT( [crsDynamic] )

TEXT TO lcXML TEXTMERGE NOSHOW PRETEXT 2
<?xml version = "1.0" encoding="Windows-1252" standalone="yes"?>
<VFPData>
    <xsd:schema id="VFPData" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata">
        <xsd:element name="VFPData" msdata:IsDataSet="true">
            <xsd:complexType>
                <xsd:choice maxOccurs="unbounded">
                    <xsd:element name="crsdynamic" minOccurs="0" maxOccurs="unbounded">
                        <xsd:complexType>
                            <xsd:sequence>
                                <xsd:element name="dyn_id" type="xsd:int"></xsd:element>
                                <xsd:element name="dyn_description">
                                    <xsd:simpleType>
                                        <xsd:restriction base="xsd:string">
                                            <xsd:maxLength value="25"></xsd:maxLength>
                                        </xsd:restriction>
                                    </xsd:simpleType>
                                </xsd:element>
                                <xsd:element name="dyn_code">
                                    <xsd:simpleType>
                                        <xsd:restriction base="xsd:string">
                                            <xsd:maxLength value="2147483647"></xsd:maxLength>
                                        </xsd:restriction>
                                    </xsd:simpleType>
                                </xsd:element>
                                <xsd:element name="dyn_picpath">
                                    <xsd:simpleType>
                                        <xsd:restriction base="xsd:string">
                                            <xsd:maxLength value="250"></xsd:maxLength>
                                        </xsd:restriction>
                                    </xsd:simpleType>
                                </xsd:element>
                            </xsd:sequence>
                        </xsd:complexType>
                    </xsd:element>
                </xsd:choice>
                <xsd:anyAttribute namespace="http://www.w3.org/XML/1998/namespace" processContents="lax"></xsd:anyAttribute>
            </xsd:complexType>
        </xsd:element>
    </xsd:schema>
    <crsdynamic>
        <dyn_id>1</dyn_id>
        <dyn_description>Change Forms FontColor</dyn_description>
        <dyn_code><![CDATA[* // Formreference to current form is _SCREEN.ActiveForm 

PUBLIC piRGB as integer

piRGB = GETCOLOR()

IF piRGB >= 0 AND piRGB <> _SCREEN.ActiveForm.BackColor

    _SCREEN.ActiveForm.SetAll( [ForeColor] , piRGB )

ELSE

    MESSAGEBOX( [BackColor and ForeColor would be identical],0,[Incorrect Color Selection] )

ENDIF]]></dyn_code>
        <dyn_picpath>.\_iconex\bmp\16x16\inf_rt_selectcolor.bmp</dyn_picpath>
    </crsdynamic>
    <crsdynamic>
        <dyn_id>2</dyn_id>
        <dyn_description>Change Forms BackColor</dyn_description>
        <dyn_code><![CDATA[* // Formreference to current form is _SCREEN.ActiveForm

PUBLIC piRGB as integer
piRGB = GETCOLOR()

IF piRGB >= 0 and piRGB <> _SCREEN.ActiveForm.ForeColor

    _SCREEN.ActiveForm.BackColor = piRGB

ELSE

    MESSAGEBOX( [BackColor and ForeColor would be identical],0,[Incorrect Color Selection] )

ENDIF

RELEASE piRGB]]></dyn_code>
        <dyn_picpath>.\_iconex\bmp\16x16\inf_rt_selectcolor.bmp</dyn_picpath>
    </crsdynamic>
    <crsdynamic>
        <dyn_id>3</dyn_id>
        <dyn_description>Switch Forms Label Align</dyn_description>
        <dyn_code><![CDATA[* // Formreference to current form is _SCREEN.ActiveForm 

LOCAL liLoop As Integer

FOR liLoop = 1 to _SCREEN.ActiveForm.ControlCount

    IF _SCREEN.ActiveForm.Controls( liLoop ).BaseClass = [Label]

            _SCREEN.ActiveForm.Controls( liLoop ).Alignment = IIF( _SCREEN.ActiveForm.Controls( liLoop ).Alignment = 0 , 1 , 0 )

    ENDIF

ENDFOR

RELEASE liLoop]]></dyn_code>
        <dyn_picpath>.\_iconex\bmp\16x16\inf_rt_alignright.bmp</dyn_picpath>
    </crsdynamic>
    <crsdynamic>
        <dyn_id>4</dyn_id>
        <dyn_description>Decrease Label Fontsize</dyn_description>
        <dyn_code><![CDATA[* // Formreference to current form is _SCREEN.ActiveForm 

LOCAL liLoop As Integer

FOR liLoop = 1 to _SCREEN.ActiveForm.ControlCount

    IF _SCREEN.ActiveForm.Controls( liLoop ).BaseClass = [Label]

        _SCREEN.ActiveForm.Controls( liLoop ).FontSize = _SCREEN.ActiveForm.Controls( liLoop ).FontSize ;
                                                                - IIF( ;
                                                                    _SCREEN.ActiveForm.Controls( liLoop ).FontSize > 7 , ;
                                                                    1 , ;
                                                                    0 ;
                                                                    )
    ENDIF

ENDFOR

RELEASE liLoop
]]></dyn_code>
        <dyn_picpath>.\_iconex\bmp\16x16\inf_rt_fontdn.bmp</dyn_picpath>
    </crsdynamic>
    <crsdynamic>
        <dyn_id>5</dyn_id>
        <dyn_description>Increase Label Fontsize</dyn_description>
        <dyn_code><![CDATA[* // Formreference to current form is _SCREEN.ActiveForm 

LOCAL liLoop As Integer

FOR liLoop = 1 to _SCREEN.ActiveForm.ControlCount

    IF _SCREEN.ActiveForm.Controls( liLoop ).BaseClass = [Label]
    
        _SCREEN.ActiveForm.Controls( liLoop ).FontSize = _SCREEN.ActiveForm.Controls( liLoop ).FontSize ;
                                                                + IIF( ;
                                                                    _SCREEN.ActiveForm.Controls( liLoop ).FontSize < 10 , ;
                                                                    1, ;
                                                                    0 ;
                                                                    )
    ENDIF

ENDFOR

RELEASE liLoop
]]></dyn_code>
        <dyn_picpath>.\_iconex\bmp\16x16\inf_rt_fontup.bmp</dyn_picpath>
    </crsdynamic>
</VFPData>
ENDTEXT

XMLTOCURSOR( lcXML , [crsDynamic] )    


Code in FORM.INIT:


PUBLIC poMyForm as Form
poMyForm = Thisform

Thisform.CreateButtons()


Code in neuer Methode FORM.CREATEBUTTONS:

IF USED( [crsDynamic] )

    Thisform.AddObject( [cmgDynamic] , [commandgroup] )

    WITH Thisform.cmgDynamic
    
        .ButtonCount = RECCOUNT( [crsDynamic] )
        .Height = Thisform.Height + 1
        .Width = 126
        .Left = 0
        .Top = 0
        .BorderStyle = 0
        .BackColor = RGB(253,254,216)
        .Visible = .F.
        BINDEVENT( poMyForm.cmgDynamic , [MouseEnter] , Thisform , [ShowHideDynamic] )
        
        GO TOP IN crsDynamic
        FOR liLoop = 1 TO RECCOUNT( [crsDynamic] )
        
            .Buttons( liLoop ).WordWrap = .T.
            .Buttons( liLoop ).Width = 120
            .Buttons( liLoop ).Height = 45
            .Buttons( liLoop ).Left = 2
            .Buttons( liLoop ).Top = ( liLoop - 1 ) * .Buttons( liLoop ).Height
            .Buttons( liLoop ).Caption = ALLTRIM( crsDynamic.dyn_description )
            .Buttons( liLoop ).Picture = FULLPATH( ALLTRIM( crsDynamic.dyn_picpath ) )
            .Buttons( liLoop ).FontSize = 8
            .Buttons( liLoop ).PicturePosition = 0
            
            loButton = EVALUATE( [poMyForm.cmgDynamic.Command] + TRANSFORM( liLoop ) )
            BINDEVENT( loButton , [Click] , Thisform , [ButtonHandler] )
            SKIP IN crsDynamic
            
        ENDFOR 

    ENDWITH 
    
ENDIF 

Code in neuer Methode FORM.BUTTONHANDLER:

SELECT crsDynamic
GO ( Thisform.cmgDynamic.Value )
IF NOT EMPTY( crsDynamic.dyn_code )
    TRY 
        EXECSCRIPT( crsDynamic.dyn_code )
    CATCH 
        MESSAGEBOX( [Code incorrect],0,[Error])
    ENDTRY 
ENDIF 

Code in neuer Methode FORM.SHOWHIDEDYNAMIC:

LPARAMETERS nButton, nShift, nXCoord, nYCoord

IF Thisform.cmgDynamic.Visible = .F.
    Thisform.cmgDynamic.Visible = .T.
ELSE 
    Thisform.cmgDynamic.Visible = .F.
ENDIF 


Code in Icon linksoben FORM.IMAGE1.CLICK:

Thisform.ShowHideDynamic()

Basierend auf den XML Daten erscheint nach dem Click auf das kleine Icon eine voll funktionstüchtige Buttonleiste:


Donnerstag, 20. Juli 2017

Datumsspielereien (Teil 10) / Date gadgets (Part 10)

Beim Datum führen viele Wege nach Rom. Umwege, komplizierte Wege und kurze Wege.
Diese Erkenntnis hatte ich heute im Zusammenspiel mit der Generierung eines indizierbaren Datumsstring.

Ziel war eine Ausgabe in Form von YYYYMMDD auf Basis eines erfassten Datumfeldes.

Dummerweise ist der Fux mit reichlich Funktionen zur Datumsmanipulation und -verarbeitung ausgestattet, so dass es recht einfach ist, den Überblick zu verlieren.
DAY(), MONTH(), YEAR(), DATETIME(), DATE(), CTOD(), DTOT(), SET DATE TO und diverse weitere Funktionen die wir in den Datumsspielereien schon kennengelernt haben.

Die schnellste Methode den oben aufgezeigten Aufbau zu erhalten besteht im Einsatz von DTOC() mit dem ein Datum in einen Textstring gewandelt werden kann.
Wer jetzt glaubt, dass dafür noch weitere Funktionen nötig sind...

?CHRTRAN( DTOC( DATE() ) , [.] , [] ) && unvollständiges Beispiel :(

oder genauer so etwas oder vergleichbares (ergänzt aufgrund Matthias' Kommentar)

?SUBSTR(DTOC(DATE()),7)+SUBSTR(DTOC(DATE()),4,2)+SUBSTR(DTOC(DATE()),1,2)
?TRANSFORM(YEAR(DATE()))+PADL(MONTH(DATE()),2,[0])+PADL(DAY(DATE()),2,[0])

...irrt sich gewaltig :)

Irgendwann hat diese Funktion nämlich einen zweiten (optionalen) Parameter erhalten der einen indizierbaren Datumswert erzeugt.

* // returns the current date as YYYYMMDD
* // or YYMMDD, depending on your system configuration
?DTOC( DATE() , 1 )

Also: Vergesst komplizierte verschachtelte Funktionen. DTOC(,1) schafft es in minimaler Form.

Donnerstag, 4. Mai 2017

Die Matrix ist volljährig geworden / The Matrix has come of age

Als im Jahr 1999 der erste Teil der Matrix Trilogie in den Kinos anlief war ich (wie vermutlich viele andere) von den Zeichenkaskaden des Matrixcodes fasziniert. Irgendwann baute ich mir dann zum Spaß eine ähnliche Funktionalität für den _screen des VFP Entwicklungsfensters.
Nun zum 18jährigen Jubiläum des Films habe ich den angestaubten Code heraus gekramt und abgestaubt.

Der u.a. Code kann einfach in eine .prg Datei einkopiert werden.
Solltet Ihr auf Eurem Rechner die Schriftart 'Consolas' nicht installiert haben, dann ersetzt sie in der Funktion 'SetScreen' durch eine nicht proportionale Schriftart Eurer Wahl.

* // i n i t i a l i z a t i o n
ON KEY LABEL F12 ExitLoop()
CLEAR 

PUBLIC pbExit as Boolean, paRGB( 6 )

pbExit = .F.
paRGB( 1 )    = RGB(0,60,0)
paRGB( 2 )    = RGB(0,100,0)
paRGB( 3 )    = RGB(0,140,0)
paRGB( 4 )    = RGB(0,180,0)
paRGB( 5 )    = RGB(0,220,0)
paRGB( 6 )    = RGB(0,255,0)

=SetScreen( 1 )

LOCAL    liHMax as Integer, liVMax as Integer, ;
         liCol as Integer, liLight as Integer
        
liHMax   = INT( _screen.Width / FONTMETRIC( 6 , _screen.FontName , _screen.FontSize ) )
liVMax   = INT( _screen.Height / FONTMETRIC( 1 , _screen.FontName , _screen.FontSize ) )
liCol    = 0
liLight  = RGB(180,255,180)

LOCAL    laRowFadeOut( liHMax ), laRowCurrent( liHMax )
        
STORE -6 TO laRowFadeOut
STORE -1 TO laRowCurrent

* // T H E  M A T R I X C O D E
DO WHILE pbExit = .F.
    
    * // select random column
    liCol = INT( RAND() * liHMax )
    
    * // new value for current column
    IF laRowCurrent( liCol + 1 ) > laRowFadeOut( liCol + 1 ) ;
    OR ( laRowFadeOut( liCol + 1 ) > laRowCurrent( liCol + 1 ) AND laRowFadeOut( liCol + 1 ) - laRowCurrent( liCol + 1 ) > 20 )
        laRowCurrent( liCol + 1 ) = IIF( laRowCurrent( liCol + 1 ) >= liVMax - 1 OR ROUND( RAND() * liVMax , 0 ) > liVMax - 2 , 0 , laRowCurrent( liCol + 1 ) + 1 )
        @ laRowCurrent( liCol + 1 ) - 1, liCol say GetChar()
        _screen.ForeColor = liLight
        @ laRowCurrent( liCol + 1 ) , liCol say GetChar()
        _screen.ForeColor = paRGB( ALEN( paRGB , 1 ) )
    ENDIF 

    * // fade out for current colum
    IF laRowCurrent( liCol + 1 ) > INT( liVMax / 1.5 ) ;
    OR laRowFadeOut( liCol + 1 ) >= laRowCurrent( liCol + 1 )
        @ laRowFadeOut( liCol + 1 ) , liCol say [ ]
        FOR liLoop = 1 TO ALEN( paRGB , 1 )
            _screen.ForeColor = paRGB( liLoop )
            @ laRowFadeOut( liCol + 1 ) + liLoop , liCol say GetChar()
        ENDFOR                         
        laRowFadeOut( liCol + 1 ) = IIF( laRowFadeOut( liCol + 1 ) = liVMax - 1 , ALEN( paRGB , 1 ) * -1 , laRowFadeOut( liCol + 1 ) + 1 )
        _screen.ForeColor = paRGB( ALEN( paRGB , 1 ) )
    ENDIF 
    
    * // place 10 random chars in current column
    IF laRowFadeOut( liCol + 1 ) + ALEN( paRGB , 1 ) < laRowCurrent( liCol + 1 )
        FOR liLoop = 1 TO 10
            liVal = laRowCurrent( liCol + 1 ) - ( laRowFadeOut( liCol + 1 ) + ALEN( paRGB , 1 ) )
            liRow = INT( RAND() * liVal )
            @ laRowFadeOut( liCol + 1 ) + liRow + ALEN( paRGB , 1 ) , liCol say GetChar()
        ENDFOR 
    ENDIF 
    
ENDDO 

* // c l e a n u p
=SetScreen( 2 )
ON KEY LABEL F12
RELEASE paRGB, pbExit

* // f u n c t i o n s
FUNCTION GetChar()
    RETURN CAST( ROUND( RAND() * 96 , 0 ) as C( 1 ) )
ENDFUNC 
FUNCTION ExitLoop
    pbExit = .T.
    CLEAR 
ENDPROC 
FUNCTION SetScreen
LPARAMETERS vVariante as Integer
    DO CASE 
    CASE vVariante = 1
        _screen.FontName = [OCR A EXTENDED]
        _screen.FontSize = 11
        _screen.FontBold = .F.
        _screen.BackColor = paRGB( 1 )
        _screen.ForeColor = paRGB( 6 )
    CASE vVariante = 2
        _screen.FontName = [Consolas]
        _screen.FontSize = 10
        _screen.FontBold = .F.
        _screen.BackColor = RGB(255,255,255)
        _screen.ForeColor = RGB(0,0,0)
    ENDCASE 
ENDFUNC 

Viel Spaß beim Anschauen :) und nicht vergessen: Mit F12 geht's zurück in die Realität! ;)

05.05.17 EDIT: verbesserte Version eingefügt...