XProfan

English

Wilfried
Friebe

-Begin------------------------------------------------------------------
Declare Anzahl%, i%, Name$, Browse$, länge%
Cls
TextColor @RGB(255, 0, 100), -1
Set(CharSet, 0)
UseFont ARIAL, 15, 10, 1, 0, 0
@db(Open, #1,Musik.DBF)
@db(Use, #1)
Print db-Struktur von Musik.DBF
Print Datensätze:      ;&dbRecCount
Print Felder:          ;%dbFCount
Print Satzgröße:       ;%dbRecSize; Byte
Print Headergröße:     ;%dbHeader; Byte
Print Letzte Änderung: ;$dbLUpdate
Anzahl% = %dbFCount
i% = 1

WhileNot i% > Anzahl%

    @db(GetField, i%)
    Print $dbFName,$dbFType,%dbFLen,%dbFDecs
    Print
    Print
    Inc i%

EndWhile

@db(Close, #1)
Waitinput
Name$ = @LoadFile$(Welche Datei,*.DBF)
print Name$
@db(Open, #1,Name$)
@db(Use, #1)
Anzahl% = %dbFCount
i% = 1

WhileNot i% > Anzahl%

    @db(GetField, i%)
    länge%=%dbFLen
    länge%= länge%*5
    @set(Decimals,0)
    Browse$=Browse$+$dbFName+;+$dbFName+;+str$(länge%)+;
    Inc i%

EndWhile

@db(Browse, 10,10,ADRESS-TABELLE,10,  Browse$ ,3)
print   &dbRecCount
@db(AppendBlank)
@dbPack()
@dbClose(#1)
/../funzione-riferimenti/XProfan/end/'>End

I have X Profan and Windows XP
Bildschirmauflösung 1280-1024 and tested too with 1024-768
with both Auflösungen is the same Error aufgetreten
me are missing under with the Toolbar a couple Pixel (see anhängendes Image)
the same Program on one Notebook with windows ME with of/ one
dissolution of 1024-768 correct
who can me there help

bildschirm 030-1.jpg	208 kB

Hochgeladen:	04/22/07

Downloadcounter:
		Download

Board MSI B450M BAZOOKA CPU AMD Ryzen 7 2700x 8 Core 3,7-4,2 GH 32 Gb Ram NVIDIA GeForce GTX 3060 12 GB Ram Window 11 Prof 64 Bit

Sun-Guru-Barebone CPU I7-9750H 16 GB Ram NVIDIA GeForce GTX1660TI 6 GB Ram Window 11 Hom 64 Bit

Profan 4.5 bis Xprofan 14
Ein frisch geschriebenes Programm hat meistens einen großen Fehler.Sollte man versuchen diesen großen Fehler zu beseitigen, hat man viele kleine Fehler "Grins"

04/22/07 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

- Page 2 -

Jojo - functions tuts. nevertheless know too RGH over ands over again hereon there such instructions To clinging. in the principle have hierbei only Happiness that the first less on the right place sits. would You z.B. Parameter 4 and 3 swap (Sinnhaftigkeit be dahingestellt) would it already failure. and this is denk I time one very guter Info on a ebend incorrect Syntax.

I personally set me one for abolition of - and ; as Parametertrennzeichen.

only and on my own the , ought to this necessary his. Perhaps bring Roland the seinem Parser with.

04/22/07 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Wilfried
Friebe

Sorry
I thought the X to Profan sufficient
I have XProfan 10
to that %CyCaption
I can it now of course read its 30
and %Cymenu = 20
but How change I these values ?
so well be I in programieren not
on The sys-variables have I yet not getraut
:--/

04/22/07 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

no trouble! These values are not virtual to that change - only benefit should You these!

If you z.B. one Window with a Innenbereich of 400 Pixel in Höhe want then must You, the Window means at least with window 0,0, x,400+%cycaption create. there the but too balderdash is because Fensterrahmen & Co. too add go müssten you can easily here so ne old function of me using:
Compile Mark Separation

proc setinnersize

    parameters x%,y%
    setwindowpos %Hwnd = %winleft,%wintop - ((%winright-%winleft)-(width(%hwnd)-x%)),((%winbottom-%wintop)-(height(%hwnd)-y%));0

endpr

the goes then so:
Compile Mark Separation

window 0,0 - 640,480
setinnersize 640,480
print Fensterinnenraum is:,width(%hwnd),x,height(%hwnd),Pixel large.
waitinput
end

proc setinnersize

    parameters x%,y%
    setwindowpos %Hwnd = %winleft,%wintop - ((%winright-%winleft)-(width(%hwnd)-x%)),((%winbottom-%wintop)-(height(%hwnd)-y%));0

endproc

After Setinnersize has your HWND then guaranteeing a Anzeigebreich of 640x480 Pixeln.

04/22/07 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Wilfried
Friebe

OK so far so well
normal Window are no trouble
eigendlich goes it around the commands

@db(Browse,X,Y, s1,n1,s2,n2)

with of/ one GridBOX I had whom Error already once
have through more x/y maße but hinbekommen

with @db(Browse,X,Y, s1,n1,s2,n2) does it but not
whether one there matter can this is my eigendliche question

Greeting
Wilfried

04/22/07 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

I faith (ldr. not know) the dialog stick as Ressource in the Runtime. means Reshacker procure and dialogue in the prfrun32.exe Change (and the profane.exe for Interpretermodus).

04/23/07 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

RGH

I faith (ldr. not know) the dialog stick as Ressource in the Runtime. means Reshacker procure and dialogue in the prfrun32.exe Change (and the profane.exe for Interpretermodus).

I fürchte, here becomes the Reshacker not wealthy, separate I must it me on The ToDo-list for next XProfan-Version take. for db(Edit,...) results already The automatic Anpassung, for db(Browse,...) unfortunately not yet.

Greeting
Roland

Intel Duo E8400 3,0 GHz / 4 GB RAM / 1000 GB HDD - ATI Radeon HD 4770 512 MB - Windows 7 Home Premium 32Bit - XProfan X4

04/23/07 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

OK, what about me werd later time try this dialog as an afterthought To Change. Erstmal look How one whom DLG (whom I yet never called have

) at all To Gesichte get.

04/23/07 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Wilfried
Friebe

well well
Erstmal thanks
anyway lying not with empty restricted programierfähigkeiten
GRINS
will be me means gedulden
wasn't allzuleicht The umgewöhnung of profane 4,5 on X Prfan 10
but slow GEHTS

Greeting
Wilfried

04/23/07 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

so habs and of course must one only downstairs procedure integrate - if one instead of dbbrowse rather _dbbrowse types then becomes the window on korrekte 514x265 Pixel Innengrösse brought. naturally is the unsauberes Schummeln!

Hierfür simply following function in the Source platzieren: (XPSE-original-Variante! / under The not-XPSE-Variante)
Compile Mark Separation

_dbbrowse (long a,b,string c,long d,string e,long f) {

    long err
    string sid=str$(gettickcount)
    long timer=external(user32.dll,SetTimer,0,0,250,ProcAddr(_dbbrowse_internal,0))
    dbbrowse(a,b,sid,d,e,f)

    _dbbrowse_internal {

        long h=findwindow(sid)
        string s=gettext$(h)

        if (substr$(s,1, )==sid) {

            external(user32.dll,KillTimer,0,timer)
            settext h,c+ +substr$(s,2, )
            setwindowpos h=a,b - 320,200;0
            setwindowpos h=a,b - ((320-width(h))+514),((200-height(h))+265);0

        } else {

            err+
            case (err==40) : external(user32.dll,KillTimer,0,timer)

        }

    }

color=#0000FF>}

not-XPSE-Variante:
Compile Mark Separation

proc _DBBROWSE

    PARAMETERS A&,B&,C$,D&,E$,F&
    var ERR&=0
    var SID$=STR$(&GETTICKCOUNT)
    var TIMER&=EXTERNAL(user32.dll,SetTimer,0,0,250,PROCADDR(_dbbrowse_internal,0))
    DBBROWSE(A&,B&,SID$,D&,E$,F&)

    proc _DBBROWSE_INTERNAL

        var H&=FINDWINDOW(SID$)
        var s$=GETTEXT$(H&)

        IF (SUBSTR$(s$,1, )=SID$)

            EXTERNAL(user32.dll,KillTimer,0,TIMER&)
            SETTEXT H&,C$+ +SUBSTR$(s$,2, )
            SETWINDOWPOS H&=A&,B& - 320,200;0
            SETWINDOWPOS H&=A&,B& - ((320-WIDTH(H&))+514),((200-HEIGHT(H&))+265);0

        ELSE

            INC ERR&

            IF (ERR&=40)

                EXTERNAL(user32.dll,KillTimer,0,TIMER&)

            ENDIF

        ENDIF

    endproc

endproc

and here my Testprogramm (deference XPSE!)
Compile Mark Separation

cls
Assign #1, ADRESS.STR
Rewrite #1
Print #1, NAME;    C; 30; 0
Print #1, FIRST NAME; C; 30; 0
Print #1, STREET; C; 30; 0
Print #1, PLZ_ORT; C; 30; 0
Print #1, TELEFON; C; 20; 0
Print #1, GEBURT;  D;  8; 0
Print #1, GEHALT;  n; 10; 2
Print #1, NOTIZ;   M; 10; 0
Close #1
db(Create, ADRESS.STR, ADRESS.DBF)
@dbOpen(#1,ADRESS.DBF)
@dbUse(#1)
dbCreateIndex name+First name > iName
@dbIndex(iName)
_dbbrowse(100,10,Adressen,10,NAME;name:;100,3)
@dbPack()
@dbClose(#1)

_dbbrowse (long a,b,string c,long d,string e,long f) {

    long err
    string sid=st$(gettickcount)
    long timer=external(user32.dll,SetTimer,0,0,250,ProcAddr(_dbbrowse_internal,0))
    dbbrowse(a,b,sid,d,e,f)

    _dbbrowse_internal {

        long h=findwindow(sid)
        string s=gettext$(h)

        if (substr$(s,1, )==sid) {

            external(user32.dll,KillTimer,0,timer)
            settext h,c+ +substr$(s,2, )
            setwindowpos h=a,b - 320,200;0
            setwindowpos h=a,b - ((320-width(h))+514),((200-height(h))+265);0

        } else {

            err+
            case (err==40) : external(user32.dll,KillTimer,0,timer)

        }

    }

}

and in the attachment a lauffähige Exe.

dbbrowserdlg.exe	727 kB

Hochgeladen:	04/23/07

Downloadcounter:
		Download

04/23/07 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Yes, Yes - the iF

04/23/07 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Wilfried
Friebe

Compile Mark Separation

declare anzahlspalten& ,Dateiname$ ,Spaltenname$
Declare Text$ ,Z& ,Dateiname1$ ,Dateiname2$
cls
anzahlspalten&=0

WhileNot  anzahlspalten&

    anzahlspalten& = @Input$(Wert eingeben:, Wieviele Spalten ?, anzahlspalten&)

EndWhile

Dateiname$ = @Input$(Namen eingeben:, Welcher Dateiname ? , Dateiname$)
Dateiname1$=Dateiname$+.STR
Assign #1, Dateiname1$
Rewrite #1
print Bitte nach ein ander den Namen des Feldes, dessen Typ,
print dessen Länge und die Anzahl der Dezimalstellen
print getrennt durch ein  ;
print die Feldtypen C=Text, D=Datum, N=Zahlen, L=Ja/Nein und M=Memo-Feld
print NAME;    C; 30; 0

WhileLoop anzahlspalten&

    Spaltenname$ = @Input$(Namen eingeben:, Welcher Spaltenname ? , &loop)
    Print #1, Spaltenname$

endwhile

Close #1
Dateiname2$=Dateiname$+.DBF
db(Create, Dateiname1$ , Dateiname2$)
Waitinput

Compile Mark Separation

-Begin------------------------------------------------------------------

proc _DBBROWSE

    PARAMETERS A&,B&,C$,D&,E$,F&
    var ERR&=0
    var SID$=STR$(&GETTICKCOUNT)
    var TIMER&=EXTERNAL(user32.dll,SetTimer,0,0,250,PROCADDR(_dbbrowse_internal,0))
    DBBROWSE(A&,B&,SID$,D&,E$,F&)

    proc _DBBROWSE_INTERNAL

        var H&=FINDWINDOW(SID$)
        var s$=GETTEXT$(H&)

        IF (SUBSTR$(s$,1, )=SID$)

            EXTERNAL(user32.dll,KillTimer,0,TIMER&)
            SETTEXT H&,C$+ +SUBSTR$(s$,2, )
            SETWINDOWPOS H&=A&,B& - 320,200;0
            SETWINDOWPOS H&=A&,B& - ((320-WIDTH(H&))+514),((200-HEIGHT(H&))+265);0

        ELSE

            INC ERR&

            IF (ERR&=40)

                EXTERNAL(user32.dll,KillTimer,0,TIMER&)

            ENDIF

        ENDIF

    endproc

endproc

Declare amount%, i%, name$, Browse$, length%, cy%, cy1%
Cls
Name$ = @LoadFile $(which File,*.DBF)
@db(Open, #1,name$)
@db(Use, #1)
Anzahl% = %dbFCount
i% = 1

WhileNot i% > amount%

    @db(GetField, i%)
    length%=%dbFLen
    length%= length%*5
    @set(Decimals,0)
    Browse$=Browse$+$dbFName+;+$dbFName+;+st$(length%)+;
    Inc i%

EndWhile

_dbbrowse  (10,10,Adress-scheduler,10,  Browse$ ,3)
@db(Browse, 10,10,ADRESS-TABELLE,10,  Browse$ ,3)
print   &dbRecCount
@db(AppendBlank)
@dbPack()
@dbClose(#1)
End

somehow GEHTS still well not
with the first Program create I a DB File
with the second read I these File then from and machine tappt im dunkeln
I have The MUSIK.DBF File as MUSIK.txt in the attachment dazugetan
The EXE and the others File walk only as long as How only a slot is
with several shows the Prog wrong on
is eigendlich indeed only one blemish
in the second Program are both command drin _dbbrownse and @db(brownse)
and the new Procedur