Montag, 27. Dezember 2010

Form im Vollbild ohne Taskleiste anzeigen / Fullscreen form without taskbar

Vor ein paar Wochen drehte es sich in einem Forum um die Frage, ob und wie es möglich wäre, eine VFP Form maximiert darzustellen, ohne dass dabei die Taskbar zu sehen ist.

Dies ist bspw. darüber zu erreichen, dass wir uns eine Form bauen, die sich immer im Vordergrund befindet. Im folgenden Beispielcode wird zunächst eine kleine Form erzeugt, die sich bei einem Doppelklick auf den kompletten Bildschirm vergrößert und sobald sie den Fokus verliert wieder in den normalen Modus zurück schaltet.

PUBLIC oForm
oForm = CREATEOBJECT([MyForm])
oForm.Visible = .T.

DEFINE CLASS MyForm AS Form

    AlwaysOnTop    = .T.
    BorderStyle    = 0
    ShowWindow     = 2
    TitleBar       = 1
    Caption        = []
    Top            = 0
    Left           = 0
    Width          = 300
    Height         = 300

    PROCEDURE Init
        This.MinHeight   = This.Width
        This.MinWidth    = This.Height
    ENDPROC 
            
    PROCEDURE LostFocus
        This.ToggleFullScreen()
    ENDPROC 

    PROCEDURE DblClick
        This.ToggleFullScreen()
    ENDPROC 
    
    PROCEDURE ToggleFullScreen
        IF This.TitleBar  = 1
            This.TitleBar = 0
            This.Width    = SYSMETRIC(1)
            This.Height   = SYSMETRIC(2)
        ELSE 
            This.TitleBar = 1
            This.Height   = This.MinHeight
            This.Width    = This.MinWidth
        ENDIF 
    ENDPROC 
    
ENDDEFINE

Donnerstag, 4. November 2010

Druckerinformationen mit VFP Bordmitteln / Display printer infos with native VFP functions

Vor einiger Zeit hatte ich bereits in zwei Einträgen über die Anzeige des aktuellen Druckerstatus (Teil1 , Teil2 )geschrieben. Die dort vorgestellten Funktionen arbeiten auf Basis der Windows Management Instrumentation (WMI).
Die heutige Funktion kommt ohne WMI aus. Sie greift auf zwei native VFP Funktionen zu: GETPRINTER() und PRTINFO().

Die Funktion PRTINFO() kennt insgesamt 13 verschiedene Parameterwerte die uns über die aktuellen Einstellungen des zuvor mit GETPRINTER() ausgewählten Druckers Auskunft geben. Dummerweise gibt es aber in fast allen Rückmeldungen wiederum nur einfache Zahlenwerte die wir dann mühselig über die Hilfe nachschlagen müssen.

Die folgende Funktion AnalyzePrtInfo() schlüsselt diese Daten in Textinformationen auf. Liefert ein Drucker keine Kenndaten zu einem bestimmten Abfragewert zurück, dann wird dies mit 'n.v.' (=nicht verfügbar) quittiert.

* // Funktionstest START
CLEAR 
lcPrinter = GETPRINTER()
?lcPrinter
FOR i = 1 TO 13
    ? AnalyzePrtInfo( i , PRTINFO( i , lcPrinter ) )
ENDFOR 
* // Funktionstest ENDE 

FUNCTION AnalyzePrtInfo as String
LPARAMETERS vParam as Integer , vValue as Integer
    LOCAL lcTitel as String , lcReturn as String
    STORE [] TO lcTitel , lcReturn
    DO CASE 
    *!*    1    Paper orientation
    CASE vParam = 1
        lcTitel = [Papierausrichtung]
        DO CASE
        CASE vValue = 0
            lcReturn = [Portrait (Hoch)]
        CASE vValue = 1
            lcReturn = [Landscape (Quer)]
        OTHERWISE
            lcReturn = [n.v.]
        ENDCASE
    *!*    2    Paper size 
    CASE vParam = 2
        lcTitel = [Papierformat]
        DO CASE 
        CASE vValue = 1
            lcReturn = [Letter, 8 1/2 x 11 inch]
        CASE vValue = 2
            lcReturn = [Letter Small, 8 1/2 x 11 inch]
        CASE vValue = 3
            lcReturn = [Tabloid, 11 x 17 inch]
        CASE vValue = 4
            lcReturn = [Ledger, 17 x 11 inch]
        CASE vValue = 5
            lcReturn = [Legal, 8 1/2 x 14 inch]
        CASE vValue = 6
            lcReturn = [Statement, 5 1/2 x 8 1/2 inch]
        CASE vValue = 7
            lcReturn = [Executive, 7 1/4 x 10 1/2 inch]
        CASE vValue = 8
            lcReturn = [A3, 297 x 420 mm]
        CASE vValue = 9
            lcReturn = [A4, 210 x 297 mm]
        CASE vValue = 10
            lcReturn = [A4, Small 210 x 297 mm]
        CASE vValue = 11
            lcReturn = [A5, 148 x 210 mm]
        CASE vValue = 12
            lcReturn = [B4, 250 x 354 mm]
        CASE vValue = 13
            lcReturn = [B5, 182 x 257 mm]
        CASE vValue = 14
            lcReturn = [Folio, 8 1/2 x 13 inch]
        CASE vValue = 15
            lcReturn = [Quarto, 215 x 275 mm]
        CASE vValue = 16
            lcReturn = [10 x 14 inch]
        CASE vValue = 17
            lcReturn = [11 x 17 inch]
        CASE vValue = 18
            lcReturn = [Note, 8 1/2 x 11 inch]
        CASE vValue = 19
            lcReturn = [Envelope #9, 3 7/8 x 8 7/8 inch]
        CASE vValue = 20
            lcReturn = [Envelope #10, 4 1/8 x 9 1/2 inch]
        CASE vValue = 21
            lcReturn = [Envelope #11, 4 1/2 x 10 3/8 inch]
        CASE vValue = 22
            lcReturn = [Envelope #12, 4 1/2 x 11 inch]
        CASE vValue = 23
            lcReturn = [Envelope #14, 5 x 11 1/2 inch]
        CASE vValue = 24
            lcReturn = [C size sheet]
        CASE vValue = 25
            lcReturn = [D size sheet]
        CASE vValue = 26
            lcReturn = [E size sheet]
        CASE vValue = 27
            lcReturn = [Envelope DL, 110 x 220 mm]
        CASE vValue = 28
            lcReturn = [Envelope C5, 162 x 229 mm]
        CASE vValue = 29
            lcReturn = [Envelope C3, 324 x 458 mm]
        CASE vValue = 30
            lcReturn = [Envelope C4, 229 x 324 mm]
        CASE vValue = 31
            lcReturn = [Envelope C6, 114 x 162 mm]
        CASE vValue = 32
            lcReturn = [Envelope C65, 114 x 229 mm]
        CASE vValue = 33
            lcReturn = [Envelope B4, 250 x 353 mm]
        CASE vValue = 34
            lcReturn = [Envelope B5, 176 x 250 mm]
        CASE vValue = 35
            lcReturn = [Envelope B6, 176 x 125 mm]
        CASE vValue = 36
            lcReturn = [Envelope, 110 x 230 mm]
        CASE vValue = 37
            lcReturn = [Envelope Monarch, 3 7/8 x 7.5 inch]
        CASE vValue = 38
            lcReturn = [6 3/4 Envelope, 3 5/8 x 6 1/2 inch]
        CASE vValue = 39
            lcReturn = [US Std Fanfold, 14 7/8 x 11 inch]
        CASE vValue = 40
            lcReturn = [German Std Fanfold, 8 1/2 x 12 inch]
        CASE vValue = 41
            lcReturn = [German Legal Fanfold, 8 1/2 x 13 inch]
        OTHERWISE 
            lcReturn = [n.v.]
        ENDCASE 
    *!*    3    Paper length in .1 millimeter increments
    CASE vParam = 3
        lcTitel = [Papierlänge]
        DO CASE 
        CASE vValue >= 0
            lcReturn = TRANSFORM( vValue ) +  [ .1 mm]
        OTHERWISE 
            lcReturn = [n.v.]
        ENDCASE 
    *!*    4    Paper width in .1 millimeter increments
    CASE vParam = 4
        lcTitel = [Papierbreite]
        DO CASE 
        CASE vValue >= 0
            lcReturn = TRANSFORM( vValue ) +  [ .1 mm]
        OTHERWISE 
            lcReturn = [n.v.]
        ENDCASE 
    *!*    5    Factor by which printer output is scaled
    CASE vParam = 5
        lcTitel  = [Skalierung]
        DO CASE 
        CASE vValue >= 0
            lcReturn = TRANSFORM( vValue ) + [ %]
        OTHERWISE 
            lcReturn = [n.v.]
        ENDCASE 
    *!*    6    Number of copies to print
    CASE vParam = 6
        lcTitel  = [Anzahl Kopien]
        DO CASE 
        CASE vValue >= 0
            lcReturn = TRANSFORM( vValue )
        OTHERWISE 
            lcReturn = [n.v.]
        ENDCASE 
    *!*    7    Default paper source
    CASE vParam = 7
        lcTitel  = [Schacht]
        DO CASE 
        CASE vValue = 1
            lcReturn = [Oberer Schacht]
        CASE vValue = 2
            lcReturn = [Unterer Schacht]
        CASE vValue = 3
            lcReturn = [Mittlerer Schacht]
        CASE vValue = 4
            lcReturn = [Manueller Einzug]
        CASE vValue = 5
            lcReturn = [Briefumschlag Einzug]
        CASE vValue = 6
            lcReturn = [Manueller Briefumschlag Einzug]
        CASE vValue = 7
            lcReturn = [Automatischer Einzug]
        CASE vValue = 8
            lcReturn = [Traktoreinzug]
        CASE vValue = 9
            lcReturn = [Kleinformat]
        CASE vValue = 10
            lcReturn = [Großformat]
        CASE vValue = 11
            lcReturn = [Große Kapazität]
        CASE vValue = 14
            lcReturn = [Kassette]
        CASE vValue = 15
            lcReturn = [Standardeinzug (automatisch)]
         OTHERWISE 
            lcReturn = [n.v.]
         ENDCASE 
    *!*    8    A positive value that indicates the horizontal resolution
    *!*        in dots per inch (DPI) or a negative value that indicates
    *!*        the print quality.
    CASE vParam = 8
        lcTitel  = [Auflösung]
        DO CASE 
        CASE vValue = -1
            lcReturn = [Draft]
        CASE vValue = -2
            lcReturn = [Niedrig]
        CASE vValue = -3
            lcReturn = [Mittel]
        CASE vValue = -4
            lcReturn = [Hoch]
        OTHERWISE 
            lcReturn = TRANSFORM( vValue ) + [ DPI]
        ENDCASE         
    *!*    9    A value that indicates if a color printer rends color or
    *!*        monochrome output
    CASE vParam = 9
        lcTitel  = [Ausgabe]
        DO CASE 
        CASE vValue = 1
            lcReturn = [monochrome]
        CASE vValue = 2
            lcReturn = [farbig]
        OTHERWISE 
            lcReturn = [n.v.]
        ENDCASE 
    *!*    10    Duplex mode
    CASE vParam = 10
        lcTitel  = [Druckausgabe]
        DO CASE 
        CASE vValue = 1
            lcReturn = [Simplex Druck]
        CASE vValue = 2
            lcReturn = [Vertikaler Duplexdruck]
        CASE vValue = 3
            lcReturn = [Horizontaler Duplexdruck]
        OTHERWISE 
            lcReturn = [n.v.]
        ENDCASE 
    *!*    11    The vertical resolution in dots per inch (DPI). If not
    *!*        available, a value of -1 is returned.
    CASE vParam = 11
        lcTitel  = [vertik. Auslösung]
        DO CASE 
        CASE vValue >= 0
            lcReturn = TRANSFORM( vValue ) + [ DPI]
        OTHERWISE 
            lcReturn = [n.v.]
        ENDCASE 
    *!*    12    A value that indicates how TrueType® fonts are printed
    CASE vParam = 12
        lcTitel  = [Truetype Schriften]
        DO CASE 
        CASE vValue = 1
            lcReturn = [Druck als Bitmap Grafik]
        CASE vValue = 2
            lcReturn = [Druck über Softfonts]
        CASE vValue = 3
            lcReturn = [Druck über Ersatzfonts]
        OTHERWISE 
            lcReturn = [n.v.]
        ENDCASE  
    *!*    13    A value that indicates if output is collated
    CASE vParam = 13
        lcTitel  = [Sammeldruck]
        DO CASE 
        CASE vValue = 0
            lcReturn = [nein]
        CASE vValue = 1
            lcReturn = [ja]
        OTHERWISE 
            lcReturn = [n.v.]
        ENDCASE 
    ENDCASE 
    RETURN PADR( lcTitel , 20 , [ ] ) + [: ] + lcReturn
ENDFUNC 

Freitag, 8. Oktober 2010

Informationen über den Arbeitsspeicher ermitteln / Retrieving RAM infos

Im UT kam vor ein paar Tagen die Frage auf, wie denn unter VFP Informationen über den installierten Arbeitsspeicher in Erfahrung gebracht werden könnten. Hugo Ranea lieferte daraufhin einen kurzen Mustercode zur Abfrage dieser Informationen über die Windows Management Instrumentation (WMI). Der folgende Beispielcode basiert auf seinem Codemuster.

Auf MSDN gibt es wie immer eine detaillierte Beschreibung der Funktion, die ich als Basis für die Aufschlüsselung der gelieferten Integerwerte genutzt habe.

http://msdn.microsoft.com/en-us/library/aa394347%28VS.85%29.aspx

Das u.a. Beispiel wurde von mir (in Ermangelung einer neueren Version) unter WinXP SP3 getestet.

LOCAL    loRAMs as Object, ;
        loRAM as Object, ;
        loWMI as Object, ;
        loLocator as Object

CLEAR 
loLocator    = CREATEOBJECT( [WBEMScripting.SWBEMLocator] )
loWMI        = loLocator.ConnectServer()
loRAMs        = loWMI.ExecQuery( [Select * from Win32_PhysicalMemory] )

    ? [Anzahl RAM Bausteine  : ] + TRANSFORM( loRAMs.Count )
FOR EACH loRAM IN loRAMs
    ? [----------------------- ]
    ? [Position              : ] + loRAM.DeviceLocator
    ? [Typisierung           : ] + loRAM.BankLabel
    ? [Kapazität             : ] + TRANSFORM( loRAM.Capacity )
    ? [Beschriftung          : ] + loRAM.Caption
    ? [Bandbreite            : ] + TRANSFORM( loRAM.DataWidth )
    ? [Beschreibung          : ] + loRAM.Description
    ? [Bauarttyp             : ] + GetFormFactor( loRAM.FormFactor )
    ? [HotSwap tauglich      : ] + IIF( VARTYPE( loRAM.HotSwappable )         = [X] , [nein]      , TRANSFORM( loRAM.HotSwappable ) )
    ? [Interleave Datentiefe : ] + TRANSFORM( loRAM.InterleaveDataDepth ) + IIF( loRAM.InterleaveDataDepth = 0 , [ - nicht Interleave tauglich] , [] )
    ? [Interleave Position   : ] + GetILPosition( loRAM.InterleavePosition )
    ? [Hersteller            : ] + IIF( VARTYPE( loRAM.Manufacturer )         = [X] , [unbekannt] , TRANSFORM( loRAM.Manufacturer ) )
    ? [Speichertyp           : ] + TRANSFORM( loRAM.MemoryType )
    ? [Modell                : ] + IIF( VARTYPE( loRAM.Model )                = [X] , [unbekannt] , TRANSFORM( loRAM.Model ) )
    ? [Name                  : ] + loRAM.Name
    ? [Zusätzliche Infos     : ] + IIF( VARTYPE( loRAM.OtherIdentifyingInfo ) = [X] , [keine]     , TRANSFORM( loRAM.OtherIdentifyingInfo ) )
    ? [Artikelnummer         : ] + IIF( VARTYPE( loRAM.PartNumber )           = [X] , [unbekannt] , TRANSFORM( loRAM.PartNumber ) )
    ? [Steckplatz            : ] + TRANSFORM( loRAM.PositionInRow )
    ? [PoweredOn             : ] + IIF( VARTYPE( loRAM.PoweredOn )            = [X] , [nein]      , TRANSFORM( loRAM.PoweredOn ) )
    ? [Entfernbar            : ] + IIF( VARTYPE( loRAM.PartNumber )           = [X] , [nein]      , TRANSFORM( loRAM.Removable ) )
    ? [Austauschbar          : ] + IIF( VARTYPE( loRAM.Replaceable )          = [X] , [nein]      , TRANSFORM( loRAM.Replaceable ) )
    ? [Seriennummer          : ] + IIF( VARTYPE( loRAM.SerialNumber )         = [X] , [unbekannt] , TRANSFORM( loRAM.SerialNumber ) )
    ? [Stock Keeping Unit    : ] + IIF( VARTYPE( loRAM.SKU )                  = [X] , [unbekannt] , TRANSFORM( loRAM.SKU ) )
    ? [Taktung               : ] + TRANSFORM( loRAM.Speed )
    ? [Status                : ] + IIF( VARTYPE( loRAM.Status )               = [X] , [unbekannt] , TRANSFORM( loRAM.Status ) )
    ? [Unique Identifier     : ] + TRANSFORM( loRAM.Tag )
    ? [Gesamt Bandbreite     : ] + TRANSFORM( loRAM.TotalWidth )
    ? [Typ Details           : ] + GetTypDetails( loRAM.TypeDetail )
    ? [Version               : ] + IIF( VARTYPE( loRAM.Version )              = [X] , [unbekannt] , TRANSFORM( loRAM.Version ) )
    ? [Installationsdatum    : ] + IIF( VARTYPE( loRAM.Version )              = [X] , [unbekannt] , TRANSFORM( loRAM.InstallDate ) )
ENDFOR 

FUNCTION GetFormFactor as String
LPARAMETERS vValue as Integer
    LOCAL lcReturn as String
    lcReturn = []
    vValue = EVL( vValue , 0 )
    DO CASE 
    CASE vValue = 0
        lcReturn = [0 - unbekannt]
    CASE vValue = 1
        lcReturn = [1 - anderer]
    CASE vValue = 2
        lcReturn = [2 - SIP]
    CASE vValue = 3
        lcReturn = [3 - DIP]
    CASE vValue = 4
        lcReturn = [4 - ZIP]
    CASE vValue = 5
        lcReturn = [5 - SOJ]
    CASE vValue = 6
        lcReturn = [6 - Proprietär]
    CASE vValue = 7
        lcReturn = [7 - SIMM]
    CASE vValue = 8
        lcReturn = [8 - DIMM]
    CASE vValue = 9
        lcReturn = [9 - TSOP]
    CASE vValue = 10
        lcReturn = [10 - PGA]
    CASE vValue = 11
        lcReturn = [11 - RIMM]
    CASE vValue = 12
        lcReturn = [12 - SODIMM]
    CASE vValue = 13
        lcReturn = [13 - SRIMM]
    CASE vValue = 14
        lcReturn = [14 - SMD]
    CASE vValue = 15
        lcReturn = [15 - SSMP]
    CASE vValue = 16
        lcReturn = [16 - QFP]
    CASE vValue = 17
        lcReturn = [17 - TQFP]
    CASE vValue = 18
        lcReturn = [18 - SOIC]
    CASE vValue = 19
        lcReturn = [19 - LCC]
    CASE vValue = 20
        lcReturn = [20 - PLCC]
    CASE vValue = 21
        lcReturn = [21 - BGA]
    CASE vValue = 22
        lcReturn = [22 - FPBGA]
    CASE vValue = 23
        lcReturn = [23 - LGA]
    ENDCASE 
    RETURN lcReturn
ENDFUNC 

FUNCTION GetILPosition as String
LPARAMETERS vValue as Integer
    LOCAL lcReturn as String
    lcReturn = []
    vValue = EVL( vValue , 0 )
    DO CASE 
    CASE vValue = 0
        lcReturn = [0 - Non-Interleaved]
    CASE vValue = 1
        lcReturn = [1 - Erste Position]
    CASE vValue = 2
        lcReturn = [2 - Zweite Position]
    ENDCASE 
    RETURN lcReturn
ENDFUNC 

FUNCTION GetMemoryTyp as String
LPARAMETERS vValue as Integer
    LOCAL lcReturn as String
    lcReturn = []
    vValue = EVL( vValue , 0 )
    DO CASE
    CASE vValue = 0
        lcReturn = [0 - unbekannt]
    CASE vValue = 1
        lcReturn = [1 - anderer]
    CASE vValue = 2
        lcReturn = [2 - DRAM]
    CASE vValue = 3
        lcReturn = [3 - Synchroner DRAM]
    CASE vValue = 4
        lcReturn = [4 - Cache DRAM]
    CASE vValue = 5
        lcReturn = [5 - EDO]
    CASE vValue = 6
        lcReturn = [6 - EDRAM]
    CASE vValue = 7
        lcReturn = [7 - VRAM]
    CASE vValue = 8
        lcReturn = [8 - SRAM]
    CASE vValue = 9
        lcReturn = [9 - RAM]
    CASE vValue = 10
        lcReturn = [10 - ROM]
    CASE vValue = 11
        lcReturn = [11 - Flash]
    CASE vValue = 12
        lcReturn = [12 - EEPROM]
    CASE vValue = 13
        lcReturn = [13 - FEPROM]
    CASE vValue = 14
        lcReturn = [14 - EPROM]
    CASE vValue = 15
        lcReturn = [15 - CDRAM]
    CASE vValue = 16
        lcReturn = [16 - 3DRAM]
    CASE vValue = 17
        lcReturn = [17 - SDRAM]
    CASE vValue = 18
        lcReturn = [18 - SGRAM]
    CASE vValue = 19
        lcReturn = [19 - RDRAM]
    CASE vValue = 20
        lcReturn = [20 - DDR]
    CASE vValue = 21
        lcReturn = [21 - DDR-2]
    CASE vValue = 22
        lcReturn = [22 - DDR-3]
    ENDCASE
    RETURN lcReturn
ENDFUNC 

FUNCTION GetTypDetails as String
LPARAMETERS vValue as Integer
    LOCAL lcReturn as String
    lcReturn = []
    vValue = EVL( vValue , 4 )
    DO CASE
    CASE vValue = 1
        lcReturn = [1 - reserviert]
    CASE vValue = 2
        lcReturn = [2 - anderer]
    CASE vValue = 4
        lcReturn = [4 - unbekannt]
    CASE vValue = 8
        lcReturn = [8 - Fast-paged]
    CASE vValue = 16
        lcReturn = [16 - Statische Spalten]
    CASE vValue = 32
        lcReturn = [32 - Pseudo-statisch]
    CASE vValue = 64
        lcReturn = [64 - RAMBUS]
    CASE vValue = 128
        lcReturn = [128 - Synchron]
    CASE vValue = 256
        lcReturn = [256 - CMOS]
    CASE vValue = 512
        lcReturn = [512 - EDO]
    CASE vValue = 1024
        lcReturn = [1024 - Window DRAM]
    CASE vValue = 2048
        lcReturn = [2048 - Cache DRAM]
    CASE vValue = 4096
        lcReturn = [4096 - nicht flüchtig]
    ENDCASE
    RETURN lcReturn
ENDFUNC 

Montag, 6. September 2010

PEM Editor 6 auf VFPX verfügbar / PEM Editor 6 available on VPFX

Die neue Version dieses hervorragenden Tools steht auf VFPX zum Download bereit:

http://vfpx.codeplex.com/wikipage?title=PEM%20Editor&referringTitle=Home

Seit Version 4 gibt es übrigens eine Videoserie die auch beim Einstieg in Version 6 gute Dienste leistet.

Eine wirklich tolle Erweiterung (und teilweise Ersatz) für die VFP Entwicklungsoberfläche!

Donnerstag, 2. September 2010

Visual Foxpro Links - Reloaded

In den beiden vorangegangenden Postings zu Visual Foxpro Foren und - Blogs habe ich bereits jede Menge Seiten rund um VFP aufgezeigt. Mit diesem Posting gibt es eine weitere Linksliste welche in die beiden vorangegangenen Postings thematisch irgendwie nicht reingepaßt haben.
Diesen Seiten mit ihren bereitgestellten Codemustern und freien und erwerbbaren Sourcen sollte jeder einmal einen Besuch abgestattet haben.

Wem noch weitere Links einfallen, dann immer her damit!
An dieser Stelle nochmal einen Dank an Bernhard, der mir den Link zu Mike Lewis Consultants genannt hat.

ActiveVFP
http://activevfp.codeplex.com/

Atoutfox (Frankreich)
http://www.atoutfox.org/index.asp

BB Controls
http://www.bbcontrols.com/

Bibliothek für Reguläre Ausdrücke
http://regexlib.com/DisplayPatterns.aspx?cattabindex=6&categoryId=7

Carlos Alloatti's CTL32 Klassen
http://www.ctl32.com.ar/

Chilkat Software
http://www.chilkatsoft.com/products.asp

eTechnologia
http://www.etecnologia.net/

FoxBR (Brasilien)
http://www.vfpbrasil.com.br/modules/newbb/

FoxItaly (Italien)
http://www.foxitaly.com/

FoxPro Club (Russland)
http://www.foxclub.ru/

FoxRockx
http://www.foxrockx.com/

GLR Software
http://www.glrsoftware.com/index.asp

Leafe.com
http://leafe.com/dls/vfp

Learn Visual Foxpro @ GarfieldHudson.com
http://www.garfieldhudson.com/FreeVideos.aspx

MasFoxpro (Spanien?)
http://www.masfoxpro.com/Portada

Mike Lewis Consultants Ltd.
http://www.ml-consult.co.uk/foxstuff.htm

MSDN Visual Foxpro Developer Center
http://msdn.microsoft.com/en-us/vfoxpro/default.aspx

News2News
http://www.news2news.com/vfp/index.php

PortalFox (Spanien)
http://www.portalfox.com/

Srdjan Djordjevic's ReportSculptor
http://www.report-sculptor.com/

Stonefield White Papers
http://www.stonefield.com/techpap.aspx

SunSoft
http://www.sunsoft.sk/sunline/default_en.asp

Tek-Tips
http://www.tek-tips.com/faq.cfm?pid=184

VandU
http://www.vandu.eu/

VFPX
http://vfpx.codeplex.com/

Virtual Foxpro User Group
http://www.vfug.org/

XFRX Homepage
http://www.eqeus.com/

Dienstag, 24. August 2010

Feststellen der aktuellen Zeitzone / Discover the current time zone

Wenn wir mit Daten arbeiten, die nicht nur in einer einzigen Zeitzone erfaßt werden, dann können wir nicht direkt mit der Uhrzeit der jeweiligen Arbeitsstation arbeiten. Dies würde die Erfassungszeitpunkte ad absurdum führen.

In einem solchen Fall haben wir zwei Möglichkeiten. Ersten können wir die Zeitstempel vor dem Speichern entsprechend anpassen oder zweitens, wir führen einen Merker, der uns eine Nachberechnung der Zeitstempel ermöglicht.

Wie auch immer, wir müssen auf jeden Fall feststellen, wie die Uhrzeit in Bezug auf die Greenwich Mean Time (GMT) berechnet ist. Ein weiterer Aspekt dem wir Beachtung schenken müssen ist die Sommerzeit die u.a. in Mitteleuropa gilt. Hierdurch entsteht eine weitere Zeitverschiebung.

Im folgenden ein Codemuster, wie die entsprechenden Informationen aus Windows herausgekitzelt werden können. Benötigt wird übrigens die kernel32.dll.

* // Deklaration der Arbeitsvariablen                                        
LOCAL   lcTimeZoneDB     as String, ;
        liTimeZoneFlag   as Integer, ;
        lcTimeZoneDesc   as String, ;
        liTimeZoneOffset as Integer, ;
        liGMTOffset      as Integer, ;
        liSUTOffset      as Integer

* // Deklaration der Zeitzonen API Funktion und abrufen der Informationen    
#DEFINE TIME_ZONE_SIZE  172
DECLARE Integer GetTimeZoneInformation IN kernel32 String @lpTimeZoneInformation
lcTimeZoneDB             = REPLICATE( CHR( 0 ) , TIME_ZONE_SIZE )
liTimeZoneFlag           = GetTimeZoneInformation( @lcTimeZoneDB )

* // Feststellen der Standard- und Sommerzeitabweichung                        
liGMTOffset              = CTOBIN( SUBSTR( lcTimeZoneDB ,   1 , 4 ) , [4RS] )
liSUTOffset              = CTOBIN( SUBSTR( lcTimeZoneDB , 169 , 4 ) , [4RS] )

* // Feststellen der Zeitzonenabweichungen                                    
IF liTimeZoneFlag = 2    && Sommerzeit Abweichung berücksichtigen            
    lcTimeZoneDesc       = STRTRAN( STRCONV( SUBSTR( lcTimeZoneDB , 89 , 64 ) , 6 ) , CHR( 0 ) , [])  
    liTimeZoneOffset     = ( liGMTOffset + liSUTOffset ) * 60
ELSE                     && Nur Standard GMT Zeit Abweichung                    
    lcTimeZoneDesc       = STRTRAN( STRCONV( SUBSTR( lcTimeZoneDB ,  5 , 64 ) , 6 ) , CHR( 0 ) , [])  
    liTimeZoneOffset     = liGMTOffset * 60
ENDIF 

* // Informationsausgabe im _screen                                            
CLEAR 
lcFont           = _screen.FontName
_screen.FontName = [Courier New]

?PADR([Zeitzone] , 25 , [ ] )
??TRANSFORM( liTimeZoneFlag ) + [ - ] + lcTimeZoneDesc
?PADR([Zeitverschiebung gesamt] , 25 , [ ] )
??[=] + TRANSFORM( ABS( liTimeZoneOffset ) ) + [ sek / ]
??[=] + TRANSFORM( INT( ABS( liTimeZoneOffset ) / 60) ) + [ min / ]
??[=] + TRANSFORM( INT( ABS( liTimeZoneOffset ) / 60 / 60) ) + [ std]
?PADR([GMT Verschiebung ] , 25 , [ ] )
??TRANSFORM( liGMTOffset ) + [ min]
?PADR([SOZ Verschiebung] , 25 , [ ] )
??TRANSFORM( liSUTOffset ) + [ min]
?PADR([MESZ] , 25 , [ ] )
??TIME()
?PADR([GMT] , 25 , [ ] )
??GETWORDNUM( CAST( DATETIME() + liTimeZoneOffset as C( 20 ) ) , 2 , [ ] )

_screen.FontName = lcFont

Donnerstag, 12. August 2010

Umzug der VFP-Runtime Installer / VFP-Runtime Installers have moved

wOOdy hat im internationalen Visual Foxpro Forum soeben  mitgeteilt, dass die seit Jahren von vielen genutzten Runtime Installer ab sofort direkt über die MSDN Seiten von Microsoft zur Verfügung stehen.

Hier geht es direkt zu seiner Mitteilung:

http://social.msdn.microsoft.com/Forums/de-DE/visualfoxprogeneral/thread/1f5e4714-72fa-4f33-bdcc-77d768f92d82

Montag, 9. August 2010

Parallele Prozessverarbeitung mit Visual Foxpro / Parallel processing in Visual Foxpro

Am Sonntag hat Joel Leach über sein aktuelles VFPX Projekt gebloggt in dem es um die parallele Verarbeitung von Prozessen unter VFP geht.
Sein Projekt mit dem Namen ParallelFox steht in der Beta Version auf VFPX ab sofort zum Download bereit.

Hier gehts direkt zu Joel's Blog:
http://weblogs.foxite.com/joel_leach/archive/2010/08/08/12986.aspx

Hier gehts zum Download auf VFPX:
http://vfpx.codeplex.com/wikipage?title=ParallelFox

Donnerstag, 5. August 2010

Mein Blog im neuen Gewand / A new look for my blog

Nein, der Browser hat keine Macke, der Bildschirm ist auch nicht kaputt, mit der Grafikkarte ist ebenfalls noch alles in Ordnung und auch die Brille muss nicht geputzt werden... ;-)

Ich konnte einfach nur das drei Jahre alte Design meines Blogs nicht mehr sehen. Im ersten Schritt habe ich jetzt ein etwas moderneres Design gewählt. Mal schauen, wann es mich in den Fingern juckt und ich damit anfange daran Änderungen vorzunehmen...

Dienstag, 3. August 2010

Visual Foxpro Blogs

Wie bereits im letzten Posting angekündigt gibt es nun eine Liste mit Blogs rund um Visual Foxpro.
Diese Liste ist bestimmt nicht vollzählig, und falls ich einen Eurer Meinung nach wichtigen Blog vergessen habe, dann teilt mir dies bitte per Kommentar mit. Ich werde die Liste dann umgehend erweitern.

Nicht alle dieser Blogs werden noch aktiv weiter geführt. Aber auch solche verfügen über ein interessantes Archiv mit Infos, Tipps, Tricks und Codebeispielen.
Einen kleinen Haken haben diese Blogs jedoch und dies war ursprünglich auch der Grund dafür, dass ich eben diesen Blog ins Leben gerufen habe: Sie sind alle auf Englisch...

Alan Stevens Cave Markings
http://netcave.org/default.aspx

Alex Feldstein
http://alexfeldstein.blogspot.com/

Andrew McNeill - AKSEL Solutions
http://akselsoft.blogspot.com/

Andrew McNeill - Learning Visual Foxpro
http://www.learningvisualfoxpro.com/

Andrew McNeill - The Fox Show podcast
http://www.thefoxshow.com/

Andy Kramek
http://weblogs.foxite.com/andykramek/

Atoutfox
http://www.atoutfox.org/rss.asp

Bernard Bout - May the Fox be with you
http://weblogs.foxite.com/bernardbout/

Bo Durban's Moxie data, inc
http://blog.moxiedata.com/

Boudewijn Lutgerink - BL's Blog
http://weblogs.foxite.com/boudewijnlutgerink/

Burkhard Stiller - Burkhard's VFP Blog
http://myvfpblog.blogspot.com/

Calvin Hsia's Weblog - thoughts from a professional developer
http://blogs.msdn.com/b/calvin_hsia/

Cathy Pountney
http://cathypountney.blogspot.com/

Cesar Chalom's VFP Imaging
http://weblogs.foxite.com/vfpimaging//

Christof Wollenhaupts Knowlbits
http://www.foxpert.com/knowlbits.htm

Christof Wollenhaupts GUINEU
http://guineu-blog.blogspot.com/

Craig Berntson
http://www.craigberntson.com/blog/

Craig Boyd's SPSBlog
http://www.sweetpotatosoftware.com/SPSBlog/

Dave Crozier's Blog
http://www.replacement-software.co.uk/blog/

David Stevenson's Talking Fox
http://talkingfox.blogspot.com/

Deciacco Blog
http://deciacco.com/blog/

Del Lee's Blog
http://deltonlee.blogspot.com/

Doug Hennig
http://doughennig.blogspot.com/

Emerson Santon Reed
http://weblogs.foxite.com/emersonreed/

Eric den Doop
http://weblogs.foxite.com/ericdendoop/default.aspx

Eric Sink
http://www.ericsink.com/index.html

Frank Garzón
http://weblogs.foxite.com/fgarzonhz/

Frank Perez's Blog
http://www.pfsolutions-mi.com/blog/default.aspx

Herman Tan's Blog
http://hermantan.blogspot.com/

Jim Duffy -  Take Note
http://geekswithblogs.net/takenote/Default.aspx

Jochen Kirstätter (JOKI)
http://jochen.kirstaetter.name/

Joel Leach - Focused on Visual Foxpro and related technologies
http://weblogs.foxite.com/joel_leach/archive/2010/04/10/10747.aspx

Juan Calcagno's Blog
http://blog.jlcconsulting.com/

Jun Tangunan - Jun's Blog
http://www.junblogs.com/

Ken Cully
http://cully.biz/

Ken Levy's alter Blog auf MSDN
http://blogs.msdn.com/b/klevy/

Ken Levy's Blog - MashupX
http://mashupx.com/blog/

Kevin Ragsdale
http://kevinragsdale.net/

Kok Kiet's Blog - abpóut programming, Visual Foxpro, .net
http://weblogs.foxite.com/kkchan/

Lisa Slater Nichols - TechSpoken
http://spacefold.com/lisa/

Mark Gordon
http://dotbloat.blogspot.com/

Martin Pirringer's MYSQL Blog
http://pirringers.com/mysqlblog/

Matt Slay
http://therealmattslay.blogspot.com/

Nancy Folsom - Experiencing Life on the Verge
http://nancyfolsom.wordpress.com/

Paul Mrozowski's Blog - A day in the life (of a developer)
http://www.rcs-solutions.com/blog/

Randy Jean's Blog
http://randyjean.blogspot.com/

Rick Borup - fiat volpes
http://rickborup.blogspot.com/

Rick Schummer - Shedding Some Light
http://rickschummer.com/blog2/

Rick Strahl's Foxpro and Web Connection Web Log
http://www.west-wind.com/wconnect/weblog/

Ronald Ramirez Moran
http://weblogs.foxite.com/dlanorok/

Sergey Berezniker
http://www.berezniker.com/content/pages/visual-foxpro

Simon Arnold
http://weblogs.foxite.com/simonarnold/

Sjordan Djordjevic's Report Sculptor
http://weblogs.foxite.com/reportsculptor/

Steve Bodnar's Blog
http://www.geeksandgurus.com/blogs/sjb/

Stuart Dunkeld's Fox Weblog
http://weblogs.foxite.com/stuartdunkeld/

Tod McKenna - Tod means Fox
http://blog.todmeansfox.com/

Tom Meek's beginning visual foxpro tips
http://vfpstart.blogspot.com/

Toni Feltman - F1 Technologies Blog
http://f1technologies.blogspot.com/

Vassilis Aggelakos
http://weblogs.foxite.com/vassilisaggelakos/default.aspx

Visionpace Blog
http://blog.visionpace.com/

Walt Krzystek - VFP and More
http://wkrzystek.blogspot.com/

wOOdy auf MSDN
http://code.msdn.microsoft.com/FoxPro/Project/ProjectRss.aspx

wOOdy's Blog
http://woody-prolib.blogspot.com/

Yair Alan Griver (YAG)
http://blogs.msdn.com/b/yag/

Montag, 12. Juli 2010

Links zu Visual Foxpro im Web / Links about Visual Foxpro on the web

Im folgenden gibt es eine (ganz bestimmt nicht vollständige) Liste mit Quellen und Foren rund um den Fuchs. Diese Liste berücksichtigt nicht die vielen Blogs rund um VFP. Eine Blogliste werde ich demnächst gesondert posten.

Diese Liste darf von Euch gerne per Kommentar ergänzt werden.

deutschsprachige Foxpro User Group

Foxite (englisch)

(Chris Wollenhaupt's) Guineu (englisch)

Microsofts deutschsprachiges Visual Foxpro Forum

Microsofts Visual Foxpro General Forum (englisch)

Universal Thread (englisch)

News2News - Using Win32 functions in Visual Foxpro (englisch)

VFPx auf Codeplex (englisch)

(Steven Black's) Visual Foxpro Wiki (englisch)

Freitag, 9. Juli 2010

Microsofts neue Diskussionsforen / Microsoft's new forums

Nachdem Microsoft vor einigen Wochen die alten Newsgroups und somit auch die darauf basierenden Webforen geschlossen hat, dachte ich zunächst, was solls, im deutschen Forum war in den letzten Jahren sowieso nicht so richtig was los und die Präsentation der Webforen war nicht wirklich geglückt.
ABER: Für den Fall der Fälle standen die alten VFP Hasen immer Gewehr bei Fuss um bei einfachen und auch schwierigeren Problemen den Fragestellern unter die Arme zu greifen.

Mit der Ankündigung, im MSDN Bereich eine modernere Oberfläche zum Informationsaustausch bereit zu stellen, haben sich viele entrüstet abgewandt, zumindest laut entsprechender Kommentare im alten Foxpro Forum...

Jetzt, ein paar Wochen später, und dem kontinuierlichen Beobachten des neuen deutschsprachigen VFP Forums auf MSDN muss ich feststellen, dass es entweder tatsächlich von vielen gezielt ignoriert wird oder noch gar nicht entdeckt wurde?

Eigentlich schade, denn die neue Oberfläche empfinde ich als eine deutliche Verbesserung. Mal ganz davon abgesehen, dass VFP als Entwicklungsumgebung nun wirklich nichts dafür kann, dass es nun bei Microsoft einen neuen Platz zum Informationsaustausch gibt. Es hätte auch David nicht geholfen, wenn er Goliath einfach ignoriert hätte. Aber wozu eine Schleuder gut ist, das wissen heute fast alle... ;-)

Ich kann mir nicht vorstellen, dass es rund um Foxpro keine Fragen und Probleme mehr zu stellen oder zu schildern gibt. Und auch wenn das Web viele Antworten per Google, Bing, Yahoo usw. zu unseren Fragen findet, so werden viele davon, auch heute noch, zum ersten Mal gestellt.

Aus meiner Sicht gibt es also eigentlich keinen Grund, NICHT im Forum aktiv vorbei zu schauen, zu Helfen, zu Fragen und immer wieder etwas Neues zu erfahren, oder?

-> http://social.msdn.microsoft.com/Forums/de-DE/foxprode/

Mittwoch, 7. Juli 2010

Analoge Uhr selbst gebaut / Self made analog clock

Nachdem ich im letzten Monat einen Eintrag bzgl. einer digitalen Anzeige gepostet habe fiel mir jetzt wieder ein altes Stück Code in die Finger, bei dem es sich um eine analoge Uhrzeitanzeige dreht. Nachdem ich den Staub entfernt und den Code ein wenig optimiert habe steht einem neuen Blogeintrag nichts mehr im Wege.

Damit das Codemuster funktioniert (und natürlich, damit die Analoguhr dem eigenen Geschmack angepaßt werden kann), sollten die u.a. Grafiken in einen Unterordner namens _bitmaps kopiert werden, der sinnvollerweise im VFP-Suchpfad liegt. Ist dies nicht so ohne weiteres möglich, dann muss halt ein wenig am Code rumgeschraubt werden ;-)







(Die beiden Pfeile sind für die Imageobjekte zum Wechsel des Hintergrundbilds gedacht.)

Das aus meiner Sicht interessante an diesem Codemuster dürfte, neben dem Algorithmus zum Positionieren der drei Line-Objekte, das minimalistische Dateihandling der Hintergrundbilder sein.

Diese werden im INIT in eine Array-Property (.PictureArray) eingelesen und über eine zweite Property (.CurrentImage) verwaltet. CurrentImage verfügt über eine _Assign-Methode, in welcher das jeweils nächste oder vorherige Bild zugewiesen wird.

Diese Vorgehensweise ermöglicht es uns, jederzeit neue Hintergrundbilder bereitzustellen. Sie müssen nur mit 'Clock' beginnen, vom Typ BMP sein und 100 * 100 Pixel messen.

Im u.a. Funktionstest ist die Entfernung des Objekts auskommentiert. Die Zeile kann jedoch problemlos über die Zwischenablage ins Befehlsfenster kopiert werden.

* // Funktionstest START    

_screen.AddObject([oClock],[cClock])
_screen.oClock.Visible = .T.
*_screen.removeobject([oClock])

* // Funktionstest ENDE        



DEFINE CLASS cClock AS container

    Width = 100
    Height = 100
    BackStyle = 0
    BorderWidth = 0
    currentimage = 0
    Name = "cClock"
    twopi = .F.
    DIMENSION picturearray[1,5]

    ADD OBJECT imgclock AS image WITH ;
        Stretch = 1, ;
        Height = 100, ;
        Left = 0, ;
        Top = 0, ;
        Width = 100, ;
        Name = "imgClock"

    ADD OBJECT timer1 AS timer WITH ;
        Top = 0, ;
        Left = 77, ;
        Height = 23, ;
        Width = 23, ;
        Interval = 1000, ;
        Name = "Timer1"

    ADD OBJECT lineh AS line WITH ;
        BorderWidth = 4, ;
        Height = 50, ;
        Left = 50, ;
        Top = 24, ;
        Width = 0, ;
        Name = "LineH"

    ADD OBJECT linem AS line WITH ;
        BorderWidth = 2, ;
        Height = 50, ;
        Left = 50, ;
        Top = 24, ;
        Width = 0, ;
        Name = "LineM"

    ADD OBJECT lines AS line WITH ;
        BorderWidth = 1, ;
        Height = 50, ;
        Left = 50, ;
        Top = 24, ;
        Width = 0, ;
        BorderColor = RGB(128,0,0), ;
        Name = "LineS"

    ADD OBJECT imgnext AS image WITH ;
        Picture = "_bitmaps\next.bmp", ;
        Height = 5, ;
        Left = 90, ;
        MousePointer = 15, ;
        Top = 90, ;
        Width = 6, ;
        Name = "imgNext"

    ADD OBJECT imgprev AS image WITH ;
        Picture = "_bitmaps\prev.bmp", ;
        Height = 5, ;
        Left = 5, ;
        MousePointer = 15, ;
        Top = 90, ;
        Width = 6, ;
        Name = "imgPrev"

    PROCEDURE calcanddraw
        LPARAMETERS nPartOf as Integer , nLineLen as Integer , oLine as Object
        LOCAL    liX as Integer , liY as Integer 

        * // Berechnung der x- und y- Koordinaten
        WITH This

            liX = 50 + COS( .TwoPi * ( -.25 + nPartOf ) ) * nLineLen
            liY = 50 + SIN( .TwoPi * ( -.25 + nPartOf ) ) * nLineLen

        ENDWITH 

        * // Berechnete Daten zuweisen
        WITH oLine

            .Top        = MIN( liY , 50 )
            .Left       = MIN( liX , 50 )
            .Height     = ABS( liY - 50 )
            .Width      = ABS( liX - 50 )
            .LineSlant  = IIF( ( liY > 50 ) # ( liX > 50 ) , [/] , [\] )

        ENDWITH 
    ENDPROC

    PROCEDURE drawtime
        LPARAMETERS lFromInit as Boolean
        LOCAL lcTime as String, liHour as Integer, liMinute as Integer, liSecond as Integer

        * // Uhrzeit zerlegen. Um sicherzustellen, dass mit 
        * // einem einheitlichen Wert gearbeitet wird er-
        * // folgt dies mit    einer Stringvariablen
        lcTime      = TIME()
        liHour      = VAL( GETWORDNUM( lcTime , 1 , [:] ) ) % 12
        liMinute    = VAL( GETWORDNUM( lcTime , 2 , [:] ) )
        liSecond    = VAL( GETWORDNUM( lcTime , 3 , [:] ) )

        WITH This

            * // Sekundenzeiger Position berechnen
            .CalcAndDraw( liSecond / 60 , 45 , .LineS )

            IF liSecond = 0 OR lFromInit

                * // Minutenzeiger Position berechnen
                .CalcAndDraw( liMinute / 60 , 40 , .LineM )
                * // Stundenzeiger Position berechnen
                .CalcAndDraw( ( liHour + liMinute / 60 ) / 12 , 30 , .LineH )

            ENDIF 

        ENDWITH 

        RELEASE lcTime , liHour , liMinute, liSecond
    ENDPROC

    PROCEDURE currentimage_assign
        LPARAMETERS vNewVal
        LOCAL lcPic as String

        WITH This

            .CurrentImage        = ICASE( ;
                                        vNewVal < 1 , ALEN( .PictureArray , 1 ) , ;
                                        vNewVal > ALEN( .PictureArray , 1 ) , 1 , ;
                                        vNewVal ;
                                       )
            .imgClock.Picture    = [_bitmaps\] + .PictureArray( .CurrentImage , 1 )
            .Refresh

        ENDWITH 
    ENDPROC

    PROCEDURE Init
        WITH This

            * // Alle Objekte einblenden
            .SetAll( [visible] , .T. , [line] )

            * // Arbeitsvariable füllen
            .TwoPi = 2 * PI()

            * // Uhrzeit initialisieren
            .DrawTime( .T. )

            * // Vorhandene Hintergrundbilder einlesen
            ADIR(.PictureArray,[_bitmaps\clock*.bmp],[],1)

            * // auf 1. Bild im Vektor positionieren
            .CurrentImage = 1

        ENDWITH 
    ENDPROC

    PROCEDURE timer1.Timer
        This.Parent.DrawTime
    ENDPROC

    PROCEDURE imgnext.Click
        WITH This.Parent

            .CurrentImage = .CurrentImage - 1

        ENDWITH 
    ENDPROC

    PROCEDURE imgprev.Click
        WITH This.Parent

            .CurrentImage = .CurrentImage + 1

        ENDWITH 
    ENDPROC

ENDDEFINE

Freitag, 25. Juni 2010

Erzeugen von UNC Pfadnamen / Creating UNC Pathnames (Revisited)

Nachdem ich heute zufälligerweise in eine alte Funktion von mir reingeschaut habe (Erzeugen von UNC-Pfadnamen), gab es auch gleich Verbesserungsbedarf. Im Blogeintrag vom September 2008 konnte nur ein Laufwerksbuchstabe (bspw. H:) übergeben werden. Die neue Funktion habe ich nun dahingehend erweitert, dass es jetzt sowohl reine Laufwerksbuchstaben, als auch komplette Verzeichnis- und/oder Dateinamen sein dürfen. Die verschiedenen Möglichkeiten sind im vorgelagerten Funktionstest zu ersehen.

* // Funktionstest Start    
CLEAR 
?GetFullUNCPath( [H:] )
?GetFullUNCPath( [H:\] )
?GetFullUNCPath( [H:\Foxprogs] )
?GetFullUNCPath( [H:\Foxprogs\] )
?GetFullUNCPath( [H:\Foxprogs\mware71] )
?GetFullUNCPath( [H:\Foxprogs\mware71\] )
?GetFullUNCPath( [H:\Foxprogs\mware71\konf.exe] )
* // Funktionstest Ende        

FUNCTION GetFullUNCPath as String
LPARAMETERS vMappedName as String
    * // Datendeklaration und Initialisierung            
    LOCAL    lcUNCBuffer as String, liLength as Integer, ;
            lcUNCName as String, llContinue as Boolean, ;
            lcMessage as String, lcPath as String
    lcUNCBuffer    = []
    liLength    = 0
    lcUNCName    = []
    llContinue    = .T.
    lcMessage    = []
    vMappedName    = IIF(DIRECTORY( vMappedName ) , ADDBS( vMappedName ) , vMappedName )
    lcPath        = IIF( LEN( vMappedName ) > 2 , SUBSTR( vMappedName , 3 ) , [] )
    vMappedName    = JUSTDRIVE( vMappedName )
    * // Deklaration der API-Funktion                    
    TRY
        DECLARE INTEGER WNetGetConnection IN WIN32API ;
            STRING @ lpLocalName, ;
            STRING @ lpRemoteName, ;
            INTEGER @ lpliLength
    CATCH
        TEXT TO lcMessage NOSHOW TEXTMERGE PRETEXT 2
            Deklaration von WNetGetConnection in WIN32API
            ist fehlgeschlagen. Funktion wird vorzeitig beendet.
        ENDTEXT
        MESSAGEBOX(lcMessage,0+16+0,[Information])
        llContinue = .F.
    ENDTRY
    * // Umsetzung des lokalen Pfades in einen UNC Pfad    
    IF llContinue
        IF !EMPTY( vMappedName ) AND VARTYPE( [vMappedName] ) = [C]
            lcUNCBuffer    = REPL( CHR( 0 ) , 261 )
            liLength    = LEN( lcUNCBuffer )
            vMappedName    = ALLTRIM( vMappedName )
            IF LEN( vMappedName ) = 1
                vMappedName = vMappedName + [:]
            ENDIF
            TRY
                IF WNetGetConnection( vMappedName , @lcUNCBuffer , @liLength ) = 0
                    lcUNCName = LEFT( lcUNCBuffer , AT( CHR( 0 ) , lcUNCBuffer ) - 1 )
                ENDIF
            CATCH
                TEXT TO lcMessage NOSHOW TEXTMERGE PRETEXT 2
                    Aufruf von WNetGetConnection in WIN32API
                    ist fehlgeschlagen. UNC-Pfad konnte nicht
                    generiert werden.
                ENDTEXT
                MESSAGEBOX( lcMessage , 0+16+0 , [Information] )
            ENDTRY
        ENDIF
    ENDIF
    RETURN lcUNCName + lcPath
ENDFUNC

Dienstag, 15. Juni 2010

Marquee Texte schnell und einfach erzeugen / Creating marquee texts quick and easy

Wenn wir mit einfachen Mitteln einen Lauftext (Marquee) erzeugen bzw. darstellen wollen, dann ist alles, was wir benötigen eine Containerklasse mitsamt Label- und Timerobjekt. Dem Container verpassen wir noch einen Eigenschaft, mit welcher die Laufrichtung bzw. das Verhalten beim Verlassen des sichtbaren Bereiches gesteuert wird und fertig ist die Laube.

Der folgende Mustercode kann, wenn als PRG in Foxpro gestartet, über das Befehlsfenster direkt beeinflußt werden. Ausschlaggebend hierfür ist die Eigenschaft _screen.oMover._Mode. Sie verarbeitet die Werte 1 - 4 (Siehe Kommentare im Block Funktionstest des Codebeispiels). Defaultwert ist die 2 (Von rechts nach links bewegen).

* // Funktionstest -START-

_screen.AddObject([oMover],[cntMover])
_screen.oMover.Visible = .T.
* // kontinuierlich nach rechts scrollen        
* _screen.oMover._Mode = 1
* // kontinuierlich nach links scrollen    
* _screen.oMover._Mode = 2
* // JoJo-Effekt nach links initiieren        
* _screen.oMover._Mode = 3
* // JoJo-Effekt nach rechts initiieren        
* _screen.oMover._Mode = 4
* // Mover-Objekt entsorgen...                
*_screen.RemoveObject([oMover])



* // Funktionstest -ENDE-


DEFINE CLASS cntmover AS container

    Anchor = 14
    Width = 570
    Height = 20
    BackColor = RGB(128,128,128)
    Name = [cntmover]
    _Mode = 2

    ADD OBJECT lblmove AS label WITH ;
        AutoSize = .T., ;
        BackStyle = 0, ;
        Caption = [Timer basierender Marquee Text], ;
        Height = 17, ;
        Left = 1, ;
        Top = 3, ;
        Width = 280, ;
        ForeColor = RGB(255,255,255), ;
        Name = [lblMove]

    ADD OBJECT tmrmove AS timer WITH ;
        Top = 1, ;
        Left = 1, ;
        Height = 23, ;
        Width = 23, ;
        Interval = 20, ;
        Name = [tmrMove]

    PROCEDURE tmrmove.Timer
    
        WITH This.Parent

            DO CASE 
            CASE ._Mode = 1
            
                .lblMove.Left = .lblMove.Left - 1
                IF .lblMove.Left < .lblMove.Width * (-1)
                    .lblMove.Left = .Width
                ENDIF
                
            CASE ._Mode = 2
            
                .lblMove.Left = .lblMove.Left + 1
                IF .lblMove.Left > .Width
                    .lblMove.Left = .lblMove.Width * (-1)
                ENDIF
                
            CASE ._Mode = 3
            
                .lblMove.Left = .lblMove.Left - 1
                IF .lblMove.Left + .lblMove.Width < 1
                    ._Mode = 4
                ENDIF 
                
            CASE ._Mode = 4
            
                .lblMove.Left = .lblMove.Left + 1
                IF .lblMove.Left > .Width
                    ._Mode = 3
                ENDIF 
                
            ENDCASE 

        ENDWITH 
        
    ENDPROC

ENDDEFINE

Freitag, 4. Juni 2010

Digitale Anzeige selbst gebaut / Self made digital display

Vor einiger Zeit hatte ich an dieser Stelle über mein Problem mit dem richtigen Timing bei meinem Tee geschrieben. Thema war damals das Abspielen von WAV-Dateien in VFP.

Was mich ursprünglich dazu veranlasst hatte, mir einen Teatimer zu programmieren war, dass ich einfach mal ausprobieren wollte, wie aufwändig die Erstellung einer digitalen Zahlenanzeige ist, OHNE einen ensprechenden Font einzusetzen. Mit anderen Worten: Welche Grafiken benötige ich und wie blende ich wann die richtigen image-Objekte ein, damit auch alles nach einer altmodischen LED-Anzeige aussieht.

Als erstes legte ich mich auf eine Zahlendarstellung mit Hilfe von 7 Elementen fest, schliesslich ging es nicht um Schönheit sondern um einen grundsätzlichen Funktionstest.

1    -
2u3 | |
4    -
5u6 | |
7    -

Als Grafiken benötigte ich somit 2 Basiselemente ( - und | ), einen Doppelpunkt als Trenner für Minuten und Sekunden sowie eine Hintergrundgrafik, welche in dunkelgrau die ausgeblendeten Elemente visualisieren sollte.




Nachdem die vier Grafiken verfügbar waren musste ich diese nur noch mit Hilfe von Image-Objekten in einen Container verfrachten und sauber positionieren. Der Container bekam den Namen 'cntDigit' und enthielt anschliessend sieben image-Objekte. Der Doppelpunkt und die Hintergrundgrafik kommen in meinem Code erst in einem Hauptcontainer zum Zuge, in dem mehrere 'cntDigit' Container nebeneinander positioniert werden und erkennbar als Stunde : Minute dargestellt werden sollen. Es spricht jedoch nichts dagegen, die 8er-Template bereits im Basiscontainer einzufügen. Der verwendete Code läßt dies ohne Änderung zu.


Optisch war nun alles in Butter. Nun kam die Ausprogrammierung der Klasse 'cntDigit' an die Reihe.

Zunächst war die Image-Klasse an der Reihe. Hier musste zwar kein Code hinterlegt werden, aber sowohl die waagerechten als auch die senkrechten Balken benötigten Eigenschaften, mit deren Hilfe eine Sichtbarkeit in Abhängigkeit von der anzuzeigenden Zahl möglich war. Hierfür erstellte ich 10 individuell zu setzende Eigenschaften die je nach Image-Position gefüllt werden.

Wie die 10 Eigenschaften vom Typ Boolean (-> _0, _1, _2, _3, ..., _9) zu füllen sind liegt letztlich an der Position des jeweiligen Image-Objektes. Wird das Objekt zur Darstellung der anzuzeigenden Zahl benötigt, erhält die Eigenschaft ein .T. andernfalls ein .F. (-> Default). Vorteil diese Methodik ist, dass eine Erweiterung auf eine komplexere Darstellung bzw. Erweiterung auf Buchstaben problemlos umzusetzen ist.

Um eine wertbezogene Anzeige zu generieren erhielt cntDigit zunächst einmal die Eigenschaft '_DisplayDigit' inkl. einer dazugehörigen Assign-Methode '_DisplayDigit_assign'. Zusätzlich kam noch die Methode 'initdigit' dazu, um den Container  'NICHTS' anzeigen zu lassen (Diese Methode wird im Teatimer immer nach dem Ablauf des Timers aufgerufen).

Innerhalb von '_DisplayDigit_assign' wird eine FOR..EACH Schleife durchlaufen, in der mit Hilfe von PEMSTATUS() überprüft wird, ob die zusammengesetzte Eigenschaft im Zielobjekt vorhanden ist. Anschliessend wird deren Wert einfach der Visible-Eigenschaft des Imageobjektes zugewiesen. Voilà, fertig war die digitale Zahlenanzeige. Da kommt einem doch sofort der Werbespruch eines ehemaligen Tennisprofis in den Sinn: Das ging ja einfach!!  ;-)

Hier nun das Codesegment von cntDigit:

* // Funktionstest    -START-    
WITH _screen

    .AddObject ( [oShape] , [Shape] )
    .oShape.Width = 48
    .oShape.Height = 82
    .oShape.BackColor = RGB( 0 , 0 , 0 )
    .oShape.Visible = .T.
    .AddObject ( [oTemplate], [imgTemplate] )
    .oTemplate.Top = 5
    .oTemplate.Left = 5
    .oTemplate.Visible = .T.
    .AddObject ( [oDigit] , [cntDigit] )

ENDWITH 

WITH _screen.oDigit
    
    .Top            = 5
    .Left            = 5
    .Visible        = .T.
    ._DisplayDigit    = [1]
    WAIT WINDOW [Taste für 2]
    ._DisplayDigit    = [2]
    WAIT WINDOW [Taste für 3]
    ._DisplayDigit    = [3]
    WAIT WINDOW [Taste für 4]
    ._DisplayDigit    = [4]
    WAIT WINDOW [Taste für 5]
    ._DisplayDigit    = [5]
    WAIT WINDOW [Taste für 6]
    ._DisplayDigit    = [6]
    WAIT WINDOW [Taste für 7]
    ._DisplayDigit    = [7]
    WAIT WINDOW [Taste für 8]
    ._DisplayDigit    = [8]
    WAIT WINDOW [Taste für 9]
    ._DisplayDigit    = [9]
    WAIT WINDOW [Taste für 0]
    ._DisplayDigit    = [0]
    WAIT WINDOW [Schliessen]

ENDWITH 

WITH _screen

    .RemoveObject( [oDigit] )
    .RemoveObject( [oTemplate] )
    .RemoveObject( [oShape] )

ENDWITH 
* // Funktionstest    -ENDE-    

DEFINE CLASS cntdigit AS container

    Width = 38
    Height = 71
    BackStyle = 0
    BorderWidth = 0
    _displaydigit = ""
    Name = "cntdigit"

    ADD OBJECT imgom AS imgdigithorizontal WITH ;
        Left = 5, ;
        Top = 0, ;
        Visible = .F., ;
        _0 = .T., ;
        _1 = .F., ;
        _2 = .T., ;
        _3 = .T., ;
        _4 = .F., ;
        _5 = .T., ;
        _6 = .T., ;
        _7 = .T., ;
        _8 = .T., ;
        _9 = .T.
        
    ADD OBJECT imgum AS imgdigithorizontal WITH ;
        Left = 5, ;
        Top = 62, ;
        Visible = .F., ;
        _0 = .T., ;
        _1 = .F., ;
        _2 = .T., ;
        _3 = .T., ;
        _4 = .F., ;
        _5 = .T., ;
        _6 = .T., ;
        _7 = .F., ;
        _8 = .T., ;
        _9 = .T.

    ADD OBJECT imgmm AS imgdigithorizontal WITH ;
        Left = 5, ;
        Top = 31, ;
        Visible = .F., ;
        _0 = .F., ;
        _1 = .F., ;
        _2 = .T., ;
        _3 = .T., ;
        _4 = .T., ;
        _5 = .T., ;
        _6 = .T., ;
        _7 = .F., ;
        _8 = .T., ;
        _9 = .T.

    ADD OBJECT imgol AS imgdigitvertical WITH ;
        Left = 0, ;
        Top = 6, ;
        Visible = .F., ;
        _0 = .T., ;
        _1 = .F., ;
        _2 = .F., ;
        _3 = .F., ;
        _4 = .T., ;
        _5 = .T., ;
        _6 = .T., ;
        _7 = .F., ;
        _8 = .T., ;
        _9 = .T.

    ADD OBJECT imgur AS imgdigitvertical WITH ;
        Left = 29, ;
        Top = 37, ;
        Visible = .F., ;
        _0 = .T., ;
        _1 = .T., ;
        _2 = .F., ;
        _3 = .T., ;
        _4 = .T., ;
        _5 = .T., ;
        _6 = .T., ;
        _7 = .T., ;
        _8 = .T., ;
        _9 = .T.

    ADD OBJECT imgul AS imgdigitvertical WITH ;
        Left = 0, ;
        Top = 37, ;
        Visible = .F., ;
        _0 = .T., ;
        _1 = .F., ;
        _2 = .T., ;
        _3 = .F., ;
        _4 = .F., ;
        _5 = .F., ;
        _6 = .T., ;
        _7 = .F., ;
        _8 = .T., ;
        _9 = .F.

    ADD OBJECT imgor AS imgdigitvertical WITH ;
        Left = 29, ;
        Top = 6, ;
        Visible = .F., ;
        _0 = .T., ;
        _1 = .T., ;
        _2 = .T., ;
        _3 = .T., ;
        _4 = .T., ;
        _5 = .F., ;
        _6 = .F., ;
        _7 = .T., ;
        _8 = .T., ;
        _9 = .T.

    PROCEDURE _displaydigit_assign
        LPARAMETERS vNewVal

        * // Einblenden der für die darzustellende Zahl
        * // benötigten Bits. Gesteuert wird dies über
        * // die Properties _0 - _9 die über die 
        * // FOR...EACH Schleife direkt ausgewertet werden.

        IF This._DisplayDigit <> m.vNewVal

            LOCAL lcProperty as String
            This._DisplayDigit = m.vNewVal

            FOR EACH oDigit IN This.Controls
                lcProperty = [_] + This._DisplayDigit
                IF PEMSTATUS(oDigit,lcProperty,5)
                    oDigit.Visible = oDigit.&lcProperty
                ENDIF 
            ENDFOR 

        ENDIF 
    ENDPROC

    PROCEDURE initdigit
        * // Ausblenden sämtlicher Bits
        FOR EACH oDigit IN This.Controls
            oDigit.Visible = .F.
        ENDFOR 
    ENDPROC

ENDDEFINE

DEFINE CLASS imgdigithorizontal AS image

    Picture = "..\_bitmaps\inf_digit_horizontal.bmp"
    BackStyle = 0
    Height = 9
    Width = 28
    _1 = .F.
    _2 = .F.
    _3 = .F.
    _4 = .F.
    _5 = .F.
    _6 = .F.
    _7 = .F.
    _8 = .F.
    _9 = .F.
    _0 = .F.

ENDDEFINE

DEFINE CLASS imgdigitvertical AS image

    Picture = "..\_bitmaps\inf_digit_vertical.bmp"
    Height = 28
    Width = 9
    _1 = .F.
    _2 = .F.
    _3 = .F.
    _4 = .F.
    _5 = .F.
    _6 = .F.
    _7 = .F.
    _8 = .F.
    _9 = .F.
    _0 = .F.

ENDDEFINE

DEFINE CLASS imgTemplate AS image

    Picture = "..\_bitmaps\inf_digit_template.bmp"
    Height = 71
    Width = 38

ENDDEFINE

Mittwoch, 19. Mai 2010

ProzessIDs lesen und beenden / Reading and terminating process IDs (Revisited)

Im letzten Eintrag ging es um das gezielte Beenden von Applikationen. In diesem Posting stelle ich nun eine kleine Abwandlung dieser Vorgehensweise vor. Genauer gesagt für die Aufgabenstellung, dass unsere soeben gestartete Applikation sicherstellen soll, das keine weiteren (zuvor gestarteten) Prozesse von ihr sich im Arbeitsspeicher befinden.

Diese Aufgabe läßt sich mit der Funktion TerminateProcess() des letzten Postings nicht durchführen, da dort die eigene ProzessID nicht verfügbar gemacht wurde.

Die eigene ProzessID herauszufinden ist in VFP nicht weiter schwierig. Das Applikationsobjekt _VFP stellt sie uns als eine seiner Eigenschaften zu Verfügung (_VFP.ProcessID). Die folgende Beispielfunktion prüft nun vor dem Terminierungsvorgang ab, ob der Zielprozess über die selbe ProzessID verfügt wie die aktuelle Applikation. Ist dies der Fall so wird die Terminierung nicht durchgeführt. Eine weitere Sicherheitsüberprüfung ist, ob der ausführende User auch der 'Eigentümer' der zu löschenden Prozesse ist (Diese Vorgehensweise ist analog zum vorherigen Posting).

* // Funktionstest
RUN /n vfp9.exe
RUN /n vfp9.exe

CLEAR 
? [beendete Prozesse:]
?? TerminateOldProcess( [vfp9.exe] )



FUNCTION TerminateOldProcess as Integer 
LPARAMETERS vAppname as String
    * // Funktion zum Löschen gleichnamiger Prozesse übergebener Programme    
    * // oder der aktuellen Applikation                                        
    * //                                                                    
    * // Parameter    Variable    Status                                        
    * // #1           vAppname    optional (default = Aktuelles Programm)        
    * //                          Name der Programmdatei                        
    vAppname = EVL( vAppname , PROGRAM() )

    * // Deklaration und Belegung benötigter Arbeitsvariablen. Hierbei        
    * // erfolgt bei den zwei Objekt-Variablen eine direkte Referenzierung    
    * // auf das WMI-Objekt sowie das Abfrageergebnis                        
    LOCAL    liReturn as Integer, llExit as Boolean, ;
            lcLogname as String , lcComputer as String, ;
            loCIMV2 as Object, loProcCols as Object, lcOwner as String
    liReturn    = 0
    llExit      = .F.
    lcLogname   = ALLTRIM( GETWORDNUM( SYS( 0 ) , 2 , [#] ) )
    lcComputer  = [.]

    TRY 
        loCIMV2    = GETOBJECT( [winmgmts:{impersonationLevel=impersonate}!\\] + lcComputer + [\root\cimv2] )
        loProcCols = loCIMV2.ExecQuery( [select * from Win32_Process where name='] + vAppname + ['] )
    CATCH 
        llExit     = .T.
    ENDTRY 
    
    * // Wenn die Instanziierungen erfolgreich waren, dann    
    * // kann es jetzt losgehen...                            
    IF !llExit

        * // Die gefundenen Prozesse entsorgen                
        FOR EACH objProcess in loProcCols

            * // Sicherstellen, dass nur eigene             
            * // Prozesse gelöscht werden!                    
            lcOwner = SPACE( 256 )
            = objProcess.GetOwner( @lcOwner )

            IF  lcLogname == lcOwner ;
            AND _VFP.ProcessID <> objProcess.ProcessID
                liReturn = liReturn + 1 
                objProcess.Terminate( 0 )
            ENDIF 

        ENDFOR 
        
        * // WMI-Objektreferenzen auflösen                     
        loCIMV2    = .NULL.
        loProcCols = .NULL.
        
    ENDIF 
    
    * // Anzahl der gelöschten Prozesse zurückgeben.        
    RETURN liReturn 
    
ENDFUNC 

Montag, 10. Mai 2010

ProzessIDs lesen und beenden / Reading and terminating process IDs

Wenn wir, aus welchem Grund auch immer, sicherstellen wollen, das eine bestimmte Anwendung nur einmal gestartet sein darf, dann kommt üblicherweise ein Singleton-Pattern zum Einsatz. Bei der Arbeit mit Objekten ist dies für viele sicherlich eine immer wiederkehrende Routine und die Funktion PEMSTATUS() wird in diesem Fall wohl auch oft genug zum Einsatz kommen.

Wollen wir jedoch eine komplette Applikation aus dem Arbeitsspeicher entfernen oder einfach nur überprüfen, ob eine Anwendung bereits aktiv ist, dann können wir diese Prüfung nicht mit PEMSTATUS() durchführen.

Bereits im April und Dezember habe ich in meinen Postings zur Druckerstatus Abfrage die Windows Management Instrumentation eingesetzt. Jetzt kommt sie erneut zum Einsatz, um uns Prozessinformationen zu liefern.

Die unten stehende Demofunktion 'TerminateProcess()' dient dem gezielten Entsorgen von unerwünschten Prozessen. Im Bereich der Singleton Patterns ist dies nicht immer die gewünschte Vorgehensweise. Aus diesem Grund verfügt die Funktion auch über Parameter, mit denen gezielte Abfragen und Ansichten ohne Prozesslöschung durchgeführt werden können.

Wird bspw. als einziger Parameter der Programmname übergeben erfolgt eine automatische Löschung sämtlicher gefunden Prozesse dieser Applikation. Die beiden Funktionstests zeigen mögliche unterschiedliche Parametrisierungen auf.

* // Funktionstest 1
* // - Anzahl vorhandener Prozesse zurückmelden
RUN /n notepad.exe
RUN /n notepad.exe
RUN /n notepad.exe

liAnzahl = TerminateProcess( [notepad.exe] , .T. )

CLEAR 
? [gefundene Prozesse: ]
?? liAnzahl

* // Funktionstest 2
* // - alle gefundenen Prozesse entsorgen
* // Alternativer Aufruf um gefundene Prozesse anzuzeigen
* liAnzahl = TerminateProcess( [notepad.exe] , .F. , .F. , .T. )
liAnzahl = TerminateProcess( [notepad.exe] )
 
? [beendete Prozesse:  ]
?? liAnzahl

FUNCTION TerminateProcess as Integer 
LPARAMETERS vAppname as String, vJustCheck as Boolean, vAllButLast as Boolean, vBrowseLast as Boolean
    * // Funktion zum löschen/melden von Prozessen übergebener Programmnamen
    * //
    * // Parameter    Variable    Status
    * // #1           vAppname    optional (default = Aktuelles Programm)
    * //                          Name der Programmdatei
    * // #2           vJustCheck  optional (default = .F.)
    * //                          Nicht löschen, nur Melden
    * // #3           vAllButLast optional (default = .F.)
    * //                          Letzen Prozess nicht löschen
    * // #4           vBrowseLast optional (default = .F.)
    * //                          Gefundene Prozesse anzeigen
    vAppname    = EVL( vAppname , PROGRAM() )
    vAllButLast = EVL( vAllButLast , .F. )
    vBrowseLast = EVL( vBrowseLast , .F. )

    * // Deklaration und Belegung benötigter Arbeitsvariablen. Hierbei
    * // erfolgt bei den zwei Objekt-Variablen eine direkte Referenzierung
    * // auf das WMI-Objekt sowie das Abfrageergebnis
    LOCAL   liReturn as Integer, liCount as Integer , llExit as Boolean, ;
            lcLogname as String , lcComputer as String, ;
            loCIMV2 as Object, loProcCols as Object, lcOwner as String
    liReturn    = 0
    liCount     = 0
    llExit      = .F.
    lcLogname   = ALLTRIM( GETWORDNUM( SYS( 0 ) , 2 , [#] ) )
    lcComputer  = [.]

    TRY 
        loCIMV2    = GETOBJECT( [winmgmts:{impersonationLevel=impersonate}!\\] + lcComputer + [\root\cimv2] )
        loProcCols = loCIMV2.ExecQuery( [select * from Win32_Process where name='] + vAppname + ['] )
    CATCH 
        llExit     = .T.
    ENDTRY 
    
    IF !llExit
        * // Arbeitscursor erstellen und die WMI Objekte verarbeiten
        CREATE CURSOR crsTasks ( ProgOwner c( 30 ) , ProgName c( 30 ) , ProgPath c( 200 ) )
        FOR EACH objProcess in loProcCols
            liCount     = liCount + 1 
            lcOwner     = SPACE( 256 )
            = objProcess.GetOwner( @lcOwner )
            m.ProgOwner = lcOwner
            m.ProgName  = objProcess.Name
            m.ProgPath  = EVL( objProcess.ExecutablePath , [-] )
            INSERT INTO crsTasks FROM MEMVAR 
        ENDFOR 

        * // Ggf. die gefundenen Prozesse angezeigen (Parameter #4)
        IF vBrowseLast
            BROWSE LAST 
        ENDIF 

        IF !vJustCheck
            * // Die gefundenen Prozesse der Reihe nach entsorgen
            FOR EACH objProcess in loProcCols
                liReturn = liReturn + 1 
                * // Wenn der letzte Prozess beibehalten werden soll (Parm.#3)
                * // dann raus aus der Schleife, andernfalls geht's weiter bis
                * // zum bitteren Ende... ;-)
                IF vAllButLast AND liReturn = liCount 
                    EXIT 
                ELSE 
                    SELECT crsTasks
                    GO ( liReturn )
                    IF ALLTRIM( crsTasks.ProgOwner ) == lcLogname
                        objProcess.Terminate( 0 )
                    ENDIF 
                ENDIF 
            ENDFOR 
        ELSE 
            liReturn = liCount
        ENDIF 
        
        * // Arbeitscursor entsorgen, WMI-Objektreferenzen auflösen
        USE IN SELECT( [crsTasks] )
        loCIMV2    = .NULL.
        loProcCols = .NULL.
        
    ENDIF 
    
    * // Anzahl der gelöschten/gefundenen Prozesse zurückgeben
    RETURN liReturn 
    
ENDFUNC 

Weitere Aufrufmöglichkeiten:

Löscht alle Prozesse des übergebenen Programms, der letzte Prozess bleibt jedoch bestehen

liAnzahl = TerminateProcess( [notepad.exe] , .F. , .T. )

Löscht alle Prozesse des übergebenen Programms, zeigt jedocht zuvor eine Liste der gefundenen Prozesse an

liAnzahl = TerminateProcess( [notepad.exe] , .F. , .F. , .T. )

Dienstag, 4. Mai 2010

Inaktivität des Anwenders über TIMEOUT prüfen / Using TIMEOUT to check user inactivity

Eine unangenehme Eigenschaft von VFP ist, dass eine Applikation, die aus einer EXE heraus gestartet wurde, solange für Updatevorgänge gesperrt bleibt, bis die aufrufende EXE beendet wird.

Jetzt stellt dies nicht wirklich ein Problem dar, denn üblicherweise genügt es, den Anwender zu informieren, das Programm für einen Updatevorgang zu beenden.

Dieser Gedankengang hat allerdings einen kleinen Haken, den Murphy sich nur zu gerne zu Nutzen macht. In einigen Fällen ist der Anwender, der eine Applikation sperrt, gerade nicht an seinem Arbeitsplatz...

Damit unsere Anwendung von sich aus feststellen kann, ob der Anwender eine 'Denkpause' eingelegt hat, benötigen wir eine systemweite Prüfung auf Aktivitäten bzw. in unserem Fall auf Inaktivitäten. Ist bspw. über einen Zeitraum von 15 Minuten keine Benutzereingabe erfolgt, dann können wir mit unserem Programm reagieren, und eine zeitgesteuerte Messagebox einblenden. Welche wiederum nach Ablauf ihres Timeouts ggf. das automatische und geordnete Beenden unserer Anwendung durchführen kann.

Im u.a. Beispiel wird mit einer PUBLIC Variablen gearbeitet. Alternativ kann das Objekt auch in einer Applikationsproperty erzeugt werden. Wichtig ist auf jeden Fall, dass der Timer jederzeit erreichbar ist.

Der Timer kann mit zwei Parametern versehen werden.
Parameter 1 definiert den Timeout Zeitraum in Minuten
Parameter 2 gibt den Timerzyklus in Sekunden vor

Wer die Parameter nicht nutzen möchte kann natürlich die entsprechenden Eigenschaften sozusagen 'ab Werk' vorbesetzen.

* // Funktionstext                                                    
CLEAR 
PUBLIC goTimer as Timer
* // 1 minütiger Timeout mit 15 Sekunden Prüfinterval                
* // Zum Beenden im Befehlsfenster 'Release goTimer' eingeben        
goTimer = CREATEOBJECT( [InactivityTimer] , 1 , 15 )

* // Bemerkt Benutzeraktivitäten und feuert ein Ereignis, nachdem    
* // der definierte Zeitraum für Inaktivität überschritten wurde.    
DEFINE CLASS InactivityTimer as Timer 

    * // Deklaration der API Konstanten                                
    #DEFINE WM_KEYUP        0x0101
    #DEFINE WM_SYSKEYUP     0x0105
    #DEFINE WM_MOUSEMOVE    0x0200
    #DEFINE GWL_WNDPROC     (-4)

    * // Interne Eigenschaften setzen und Timer setzen (5Sek.)        
    _iTimeoutInMinutes      = 0
    _tLastActivity          = {/:}
    Interval                = 5000
    Enabled                 = .T.

    * // Auf API Ereignisse horchen sobald die Form gestartet wurde    
    * // Optional wird ein Timeout Wert als Parameter übergeben        
    * // Zusätzlich kann als weiterer Parameter der Prüfinterval in    
    * // Sekunden übergeben werden.                                    
    PROCEDURE Init ( vTimeoutInMinutes as Integer , vIntervalInSeconds as Integer )

        WITH This
            ._iTimeoutInMinutes  = EVL( vTimeoutInMinutes , 1 )
            .Interval            = EVL( vIntervalInSeconds , 5 ) * 1000
            ._tLastActivity      = DATETIME()
        ENDWITH 
        BINDEVENT( 0 , WM_KEYUP ,     This , [WndProc] )
        BINDEVENT( 0 , WM_SYSKEYUP ,  This , [WndProc] )
        BINDEVENT( 0 , WM_MOUSEMOVE , This , [WndProc] )

    ENDPROC 

    * // mit dem Lauschen aufhören                                    
    PROCEDURE Unload 

        UNBINDEVENTS( 0 , WM_KEYUP )
        UNBINDEVENTS( 0 , WM_SYSKEYUP )
        UNBINDEVENTS( 0 , WM_MOUSEMOVE )

    ENDPROC 

    * // Jedes Ereignis zählt als Aktivität...                        
    PROCEDURE WndProc ( hWnd as Long, Msg as Long, wParam as Long, lParam as Long )

        This._tLastActivity = DATETIME()

    ENDPROC 

    * // Letzte Aktivität mit Timeout abgleichen                    
    PROCEDURE Timer

        WITH This
            LOCAL ltFireEvent as Datetime 
            ltFireEvent = ._tLastActivity + ( 60 * ._iTimeoutInMinutes )
            IF DATETIME() >= ltFireEvent
                .eventTimeout()
            ENDIF
        ENDWITH  

    ENDPROC 

    * // Diese Methode über BINDEVENT übersteuern oder enthaltenen    
    * // Code überschreiben...                                        
    * // Bspw. kann hier der Wert von iTimeoutInMinutes überschrie-    
    * // ben werden um einen mehrstufigen Timeout zu ermöglichen    
    PROCEDURE eventTimeout

        MESSAGEBOX( [<<< TIMEOUT >>>] , 0 , [Inaktiv] )

    ENDPROC 

ENDDEFINE 

Donnerstag, 8. April 2010

Feststellen der aktuellen Farbtiefe / Determine current color depth

Wer in seiner Applikation mit hochauflösenden Grafiken und Fotos arbeitet, der benötigt für eine einwandfreie Anzeige auch eine akzeptable Anzahl an darstellbaren Farben.

Früher war für viele solcher Anwendungen der Zugriff über Terminaldienste (Citrix, Terminalserver, u.ä.) oftmals ein K.O.-Kriterium, da in diesen Umgebungen aus Geschwindigkeitsgründen eine Farbtiefe von 8 Bit (=256 Farben) eingestellt war. Die aktuellen Versionen dieser Serverumgebungen unterstützen mittlerweile auch höhere Farbtiefen, denn um ein Foto in allen Details betrachten zu können sind 256 Farben definitiv nicht ausreichend.

Auch heute kommt es vor, dass Anwender (bspw. wegen Updates des Grafikkartentreibers) plötzlich wieder vor einer 8 oder 16 Bit Farbdarstellung sitzen, ohne dies überhaupt zu bemerken. Eine andere Möglichkeit ist, dass wir in unserer Applikation, je nach eingestellter Farbtiefe, andere Grafiken einblenden.

Der folgende Mustercode gibt uns Aufschluss über die aktuelle Farbtiefe, die verfügbaren Paletten und die darstellbare Anzahl an Farben die unserer Applikation zur Verfügung stehen.


CLEAR 
? [verfügbare Paletten: ]
??GetBitsPerPixel(1)
? [Farbtiefe in Bit   : ] 
??GetBitsPerPixel(2)
? [Anzahl Farben      : ]
??GetBitsPerPixel(3)

FUNCTION GetBitsPerPixel as Integer
LPARAMETERS vVersion as Integer
    * // Mögliche Parameterwerte:                            
    * // 1 = Verfügbare Paletten                                
    * // 2 = Farbtiefe in Bit                                   
    * // 3 = Anzeigbare Farben                                  
    
    * // Wenn kein Parameter übergeben wurde, dann mit        
    * // Defaultwert vorbesetzen...                            
    vVersion = EVL(vVersion,2)
    
    * // liBitsPerPixel beinhaltet die Farbtiefe            
    * // 8        = 8 Bit     = 256 Color                    
    * // 16       = 16 Bit    = High Color                    
    * // 24 / 32  = 24/32 Bit = TrueColor                    
    * // Es gibt noch weitere Wertmöglichkeiten, die o.a.    
    * // aufgezählten stellen jedoch die üblichen             
    * // Varianten dar.                                        
    
    * // Um die Farbtiefe festzustellen benötigen wir        
    * // mehrere API-Funktionen                                
    DECLARE INTEGER GetDC IN WIN32API AS GetDCHandle INTEGER hWnd
    DECLARE INTEGER GetActiveWindow IN WIN32API
    DECLARE INTEGER GetDeviceCaps IN WIN32API INTEGER hDC, INTEGER nIndex
    DECLARE INTEGER ReleaseDC IN WIN32API INTEGER hWnd, INTEGER hDC
    #DEFINE PLANES 14
    #DEFINE BITSPIXEL 12

    LOCAL liDChandle as Integer, liReturn as Integer
    
    * GetDeviceCaps Handle erzeugen + Returnwert vorbesetzen
    liDChandle    = GetDCHandle( GetActiveWindow() )
    liReturn    = 0
    
    DO CASE 
    CASE vVersion = 1
        * // Anzahl der verfügbaren Paletten feststellen 
        liReturn    = GetDeviceCaps( liDChandle , PLANES )
    CASE vVersion = 2
        * // Farbtiefe in Bits feststellen 
        liReturn    = GetDeviceCaps( liDChandle , BITSPIXEL )
    OTHERWISE 
        * // Anzahl darstellbarer Farben feststellen        
        * // Formel: 2 ^ (AnzahlPaletten * BitsProPixel)    
        liReturn    = INT( 2 ^ ( GetDeviceCaps( liDChandle , PLANES ) * GetDeviceCaps( liDChandle , BITSPIXEL ) ) )
    ENDCASE 
    
    * // GetDeviceCaps Handle freigeben                        
    =ReleaseDC( GetActiveWindow() , liDChandle )

    RETURN liReturn
    
ENDFUNC

Dienstag, 6. April 2010

Druckerstatus abfragen - Teil 2 / Query printer status - Part 2

Im Dezember hatte ich einen Eintrag verfasst, in dem es darum ging, den Status der vorhandenen Drucker abzufragen. Im folgenden Codebeispiel habe ich diese Funktionalität dahingehend erweitert, dass nun auch der Standarddrucker des aktuellen Benutzers gefunden und gekennzeichnet wird.

Ermöglicht wird dies durch eine Abfrage des Windows-Spoolertreibers (winspool.drv) der sich üblicherweise im Windows System- und/oder System32-Verzeichnis befindet.

Der u.a. Code baut auf den bereits im Dezember Posting gezeigten Funktionen GetPrinterStatus() und GetPrinterStatusAsText() auf. Neu hinzugekommen sind die Funktionen DisplayPrinterInfos() sowie GetDefaultPrinter() welche innerhalb von GetPrinterStatus() direkt aufgerufen wird. Ebenfalls neu ist, dass nun sämtliche Daten in einem Cursor vorgehalten werden.

DisplayPrinterInfos() erweitert die _SCREEN-Ausgabe um Druckerstandort und Kommentar. GetDefaultPrinter() greift auf die API-Funktion 'GetDefaultPrinter' aus winspool.drv zurück. Hierbei habe ich den API-Funktionsnamen mit einem Alias ( -> MyDefaultPrinter) versehen, damit meine identische interne Funktionsbenamung keine Rekursion verursacht.

LOCAL liFlag as Integer

* // installierte Drucker überprüfen und entsprechenden Cursor erzeugen    
=APRINTERS(laPrn,1)

* // Leeren Cursor erzeugen 
CREATE CURSOR crsprinters ( ;
    prn_type        C(  1), ;
    prn_default     C(  1), ;
    prn_printer     C(250), ;
    prn_port        C( 50), ;
    prn_driver      C(100), ;
    prn_comment     C(250), ;
    prn_location    C(250), ;
    prn_status      C( 30) ;
    )

* // Wurden installierte Drucker gefunden, dann wird nun der Inhalt        
* // des Arrays in einer Schleife verarbeitet und an 'crsPrinters'         
* // übergeben. 
IF !EMPTY(laPrn(1,1))
    FOR liFlag = 1 TO ALEN(laPrn,1)
        IF SUBSTR(laPrn(liFlag,1),1,2) = [\\]
            m.prn_type       = [n]
            m.prn_printer    = [ ] + laPrn(liFlag,1)
        ELSE 
            m.prn_type       = [l]
            m.prn_printer    = laPrn(liFlag,1)
        ENDIF
        m.prn_port      = laPrn(liFlag,2)
        m.prn_driver    = laPrn(liFlag,3)
        m.prn_comment   = laPrn(liFlag,4)
        m.prn_location  = laPrn(liFlag,5)
        m.prn_default   = [ ]
        m.prn_status    = [ ]
        INSERT INTO crsPrinters FROM MEMVAR 
    ENDFOR 
    * // Nun die noch fehlenden Statusinformationen im Cursor            
    * // hinterlegen und die Ausgaberoutine aufrufen. 
    GetPrinterStatus()
    DisplayPrinterInfos()
    USE IN SELECT([crsPrinters])
ELSE 
    * // Ab und an soll es tatsächlich vorkommen, dass überhaupt kein    
    * // Drucker im System vorhanden ist. Dies sollten wir dem Anwender    
    * // natürlich nicht vorenthalten.
    LOCAL lcString as String
    TEXT TO lcString NOSHOW ADDITIVE TEXTMERGE PRETEXT 2
        A C H T U N G ! ! !
        Für Ihr Login sind noch keine Drucker installiert!
        Zum Ausdrucken von Daten werden diese jedoch zwingend
        benötigt. Bitte installieren Sie über
        
        [Start] - [Einstellungen] - [Drucker] - [Neuer Drucker]
        
        einen oder mehrere Drucker!
    ENDTEXT 
    MESSAGEBOX(lcString,0+64+0,[Kein Drucker installiert])
    RELEASE lcString
ENDIF 

RELEASE laPrn

* // ----------------------------------------- DisplayDefaultPrinter
FUNCTION GetDefaultPrinter as String

    * // Wichtig bei dieser Funktion ist, dass der als Referenz        
    * // übergebene String mit CHR(0) Zeichen vorbesetzt wird.        
    LOCAL liBuffSize as Integer, lcPrinter as String
    liBufsize = 250
    lcPrinter = REPLICATE( CHR( 0 ), liBufsize )
    
    * // Über winspool.drv können wir den aktuellen Standarddrucker    
    * // abfragen. Das Ergebnis liefern wir als String zurück, um    
    * // in der nachfolgenden Verarbeitung einen direkten Namens-    
    * // vergleich durchführen zu können.
    TRY 
        DECLARE INTEGER GetDefaultPrinter IN winspool.drv AS MyDefaultPrinter ;
                STRING  @ pszBuffer,;
                INTEGER @ pcchBuffer

        * // Da die API-Funktion genauso heisst, wie die VFP-Funktion
        * // war eine Umbenennung der API-Funktion mit Hilfe eines    
        * // ALIAS notwendig. Somit wurde aus GetDefaultPrinter() die 
        * // Funktion MyDefaultPrinter.
        = MyDefaultPrinter( @lcPrinter, @liBufsize )
        lcPrinter = SUBSTR(lcPrinter, 1, AT( CHR( 0 ), lcPrinter ) - 1 )
    CATCH 
        lcPrinter = [ ]
    ENDTRY 
    
    RETURN lcPrinter

ENDFUNC 

* // ------------------------------------------- DisplayPrinterInfos
FUNCTION DisplayPrinterInfos
    
    * // Diese Funktion zeigt den Inhalt des Druckercursors an.        
    * // hierbei erfolgt die Kennzeichnung des Standarddruckers über
    * // ein kleines 'x' vor dem Druckernamen.
    
    LOCAL lcFont as String, lcDisplay as String
    
    * // VFP Screen vorbereiten                                        
    lcFont              = _screen.Fontname
    _screen.FontName    = [Courier New]
    CLEAR 
    
    SELECT crsPrinters
    GO TOP 
    ??[Status                   Drucker (x=Standarddrucker)              Standort                            Kommentar                                                             ]
     ?[---------------------------------------------------------------------------------------------------------------------------------------------------------------------------]
    DO WHILE !EOF()
        TEXT TO lcDisplay TEXTMERGE NOSHOW PRETEXT 1+2+4+8
            <<SUBSTR( crsPrinters.prn_status,1,20 )>>
            <<IIF(EMPTY(crsPrinters.prn_default),[   ],[ x ])>>
            <<SUBSTR( crsPrinters.prn_printer,1,40 )>>
            <<SUBSTR( crsPrinters.prn_location,1,35 )>>
            <<SUBSTR( crsPrinters.prn_comment,1,70 )>>
        ENDTEXT 
        ? lcDisplay
        SKIP IN ([crsPrinters])
    ENDDO 
         
    * // VFP Screen zurücksetzen            
    _screen.FontName = lcFont
    
ENDFUNC 

* // ---------------------------------------------- GetPrinterStatus
FUNCTION GetPrinterStatus as String

    LOCAL lcComputer as String, loWMIService as Object, ;
          loInstalledPrinters as Object, lcStatus as String, ;
          lcFont as String, lcDefPrn as String

    * // Arbeitsvariablen initialisieren    
    lcComputer          = [.]
    loWMIService        = GETOBJECT([winmgmts:] + [{impersonationLevel=impersonate}!\\] + lcComputer + [\root\cimv2])
    loInstalledPrinters = loWMIService.ExecQuery([SELECT * FROM Win32_Printer])
    lcFont              = _screen.FontName 
    lcDefPrn            = GetDefaultPrinter()

    * // Druckerobjekt auslesen                
    FOR EACH loPrinter IN loInstalledPrinters

        lcStatus = GetPrinterStatusAsText(loPrinter)

        SELECT crsPrinters
        GO TOP 
        LOCATE FOR prn_printer = loPrinter.Name
        IF FOUND()
            IF LEN(ALLTRIM(lcStatus)) > 15
                REPLACE prn_status WITH SUBSTR(lcStatus,16)   IN crsPrinters
            ELSE 
                REPLACE prn_status WITH SUBSTR(lcStatus,1,15) IN crsPrinters
            ENDIF 
            * // Standarddrucker im Cursor kennzeichnen.
            IF ALLTRIM(crsPrinters.prn_printer) == lcDefPrn
                REPLACE prn_default WITH [x] IN crsPrinters
            ENDIF 
        ENDIF 
        
    NEXT 
ENDFUNC 

* // ---------------------------------------- GetPrinterStatusAsText
FUNCTION GetPrinterStatusAsText as String
LPARAMETERS oPrinter as Object

    LOCAL lcReturn as String
    lcReturn = []
    
    DO CASE 
    CASE oPrinter.PrinterStatus = 1
        lcReturn = [anderes        ]    && Other
    CASE oPrinter.PrinterStatus = 2
        lcReturn = [unbekannt      ]    && Unknown
    CASE oPrinter.PrinterStatus = 3
        lcReturn = [bereit         ]    && Idle
    CASE oPrinter.PrinterStatus = 4
        lcReturn = [druckt         ]    && Printing
    CASE oPrinter.PrinterStatus = 5
        lcReturn = [aufwärmen      ]    && Warming Up
    CASE oPrinter.PrinterStatus = 6
        lcReturn = [gestoppt       ]    && Stopped Printing
    CASE oPrinter.PrinterStatus = 7
        lcReturn = [Offline        ]    && Offline
    CASE oPrinter.PrinterStatus = 8
        lcReturn = [pausierend     ]    && Paused
    CASE oPrinter.PrinterStatus = 9
        lcReturn = [Fehler         ]    && Error
    CASE oPrinter.PrinterStatus = 10
        lcReturn = [beschäftigt    ]    && Busy
    CASE oPrinter.PrinterStatus = 11
        lcReturn = [nicht verfügbar]    && Not Available
    CASE oPrinter.PrinterStatus = 12
        lcReturn = [wartend        ]    && Waiting
    CASE oPrinter.PrinterStatus = 13
        lcReturn = [verarbeiten    ]    && Processing
    CASE oPrinter.PrinterStatus = 14
        lcReturn = [initialisieren ]    && Initialization
    CASE oPrinter.PrinterStatus = 15
        lcReturn = [Stromsparmodus ]    && Power Save
    CASE oPrinter.PrinterStatus = 16
        lcReturn = [löscht Druckjob]    && Pending Deletion
    CASE oPrinter.PrinterStatus = 17
        lcReturn = [E/A aktiv      ]    && I/O Active
    CASE oPrinter.PrinterStatus = 18
        lcReturn = [manuelle Zufuhr]    && Manual Feed
    ENDCASE 
    * // Die Liste ggf. nach Bedarf erweitern
    IF INLIST(oPrinter.PrinterStatus,1,9)
        lcReturn = lcReturn + GetDetectedErrorStateAsText(oPrinter.DetectedErrorState)
    ENDIF 
    RETURN lcReturn
    
ENDFUNC 

* // ----------------------------------- GetDetectedErrorStateAsText
FUNCTION GetDetectedErrorStateAsText as String
LPARAMETERS vErrorstate as Integer 

    LOCAL lcReturn as String 
    
    DO CASE
    CASE m.vErrorState = 0
        lcReturn = [Unbekannter Fehler]                 && Unknown
    CASE m.vErrorState = 1
        lcReturn = [Anderer Fehler]                     && Other
    CASE m.vErrorState = 2
        lcReturn = [kein Fehler]                        && No Error
    CASE m.vErrorState = 3
        lcReturn = [zu wenig Papier]                    && Low Paper
    CASE m.vErrorState = 4
        lcReturn = [kein Papier]                        && No Paper
    CASE m.vErrorState = 5
        lcReturn = [zu wenig Toner]                     && Low Toner
    CASE m.vErrorState = 6
        lcReturn = [kein Toner]                         && No Toner
    CASE m.vErrorState = 7
        lcReturn = [Gehäuse geöffnet]                   && Door Open
    CASE m.vErrorState = 8
        lcReturn = [Papierstau]                         && Jammed
    CASE m.vErrorState = 9
        lcReturn = [Kundendienst erforderlich]          && Service Requested
    CASE m.vErrorState = 10
        lcReturn = [Ausgabeschacht ist voll]            && Output Bin Full
    CASE m.vErrorState = 11
        lcReturn = [Papier Problem]                     && Paper Problem
    CASE m.vErrorState = 12
        lcReturn = [Seite kann nicht gedruckt werden]   && Cannot Print Page
    CASE m.vErrorState = 13
        lcReturn = [Benutzereingriff notwendig]         && User Intervention Required
    CASE m.vErrorState = 14
        lcReturn = [Arbeitsspeicher voll]               && Out Of Memory
    CASE m.vErrorState = 15
        lcReturn = [unbekannter Server]                 && Server Unknown
    OTHERWISE
        lcReturn = [Unbekannt]    
    ENDCASE
    RETURN     [(] + ALLTRIM(STR(m.vErrorState)) + [) ] + lcReturn
    
ENDFUNC