 |
Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
|
| Vorheriges Thema anzeigen :: Nächstes Thema anzeigen |
| Autor |
Nachricht |
stevie1401
Anmeldungsdatum: 04.07.2006
Beiträge: 133
|
 Verfasst am: 17.10.2006, 12:36 Titel: eine Fileselectbox (Datei laden/speichern) ohne API |
 |
|
So, hier ist sie nun: die Fileselectbox ohne API und im "Anfängerstil programmiert.
Über Anregungen würde ich mich sehr freuen.
| Code: | 'Eine Fileselectbox unter Freebasic ohne API
'Danke an ytwinky und terminator für die Tips
'Über feedbacks würde ich mich sehr freuen.
'(c) by stevie1401 17.10.2006
'Aufruf ist: auswahl$=fs$(DialogString,DateiendungString)
'Die Function dos_win$ wandelt die ASCII richtig um,
'sodass sie unter Windows richtig angezeigt werden.
'Die Function fs$ läuft unter SCREEN 19 und SCREEN 20
Declare Function fs$(Dialog$,Dateiendung$)
Declare Function dos_win$(t$)
Screen 19,32,2,1
Chdir exepath
auswahl$=fs$(dos_win$("Datei öffnen"),"*.*")
Cls
Print auswahl$
t$="Bitte eine Taste drücken"
print dos_win$(t$)
sleep
Chdir exepath
auswahl$=fs$(dos_win$("Datei speichern unter"),"*.*")
Cls
Print auswahl$
sleep
Function fs$(Dialog$,Dateiendung$)
anz=2000
Dim DateiAnz,OrdnerAnz,Auswahl$,SuchPfad$
Dim O_rdner$(anz),D_atei$(anz)
Dim xordner(anz),yordner(anz),xdatei(anz),ydatei(anz), lw$(30)
Dim ordnerfarbe,dateifarbe,textfarbe,neulesen,MaxDateiLaenge,MaxOrdnerLaenge
Dim Dateidummy$(anz),OrdnerDummy$(anz),rueckgabe,inbox,links,rechts
Dim mx,my,mr,mk
links=1
rechts=2
inbox=rechts
Do
neulesen=0
ordnerfarbe=Rgb(255,255,0)
dateifarbe=Rgb(40,59,80)
Texthintergrund=Rgb(101,150,202)
laufwerkfarbe=Rgb(255,255,255)
Max_FS_Zeilen=25
Line (0,0)-(800,600),Rgb(101,150,202),bf 'obere Box
Line (0,0)-(800,40),Rgb(80,119,161),bf 'linke Box
Line (0,40)-(40,600),Rgb(40,59,80),bf 'Bix in der Mitte
Line (42,524)-(580,546),Rgb(40,59,80),b 'erste untere Dialogbox
Line (42,558)-(580,580),Rgb(40,59,80),b 'zweite untere Dialogbox
Line (585,555)-(650,586),Rgb(40,59,80),b 'Abbruch-Box
Line (680,555)-(770,586),Rgb(40,59,80),b 'Übernehmen-Box
Line (94,70)-(320,500),Rgb(255,255,255),b ' Box für die Ordner
Line (460,70)-(670,500),Rgb(255,255,255),b ' Box für die Dateien
Line (0,0)-(800,600),Rgb(0,0,0),b 'Umrandung
Color Rgb(255,255,255),Rgb(80,119,161)
Locate 2,40
Print Dialog$
Color 0,Texthintergrund
Locate 36,75
Print "Abbruch"
Locate 36,87
Print dos_win$("übernehmen")
Rem aktuellen Pfad anzeigen
Color 0,Rgb(80,119,161)
Locate 2,2
Print Curdir
Color 0,Texthintergrund
Rem Dateiendung anzeigen
Locate 36,10
Print Dateiendung$
rem Laufwerke ermitteln
lwanz=0
For i=Asc("c") To Asc("z")
rem Dateien aller Art ermitteln
FileName$ = Dir$(Chr$(i)+":\*.*", &H20 Or &H02 Or &H04 Or &H01 Or &H10)
If FileName$<>"" Then
lwanz=lwanz+1
lw$(lwanz)=Chr$(i)
End If
Next i
Color laufwerkfarbe,Rgb(40,59,80)
y=3
If lwanz>0 Then
For i=1 To lwanz
Locate y+i,2
Print lw$(i)+":\"
Next i
End If
Suchpfad$=curdir
suche$ = SuchPfad$+"\"+Dateiendung$
Rem doppelte Backslashes entfernen
s=Instr(suche$,"\\")
If s>0 Then
l=Len(suche$)
suche$=Left$(suche$,s)+Right$(suche$,l-s-1)
End If
attrib=1+2+4+16+32+8
filename$= Dir( suche$,attrib,@rueckgabe)
DateiAnz=0
OrdnerAnz=1
O_rdner$(OrdnerAnz)=".."
Do
If filename$ <> "." and filename$<> ".." Then
if rueckgabe and 16 then 'Ist es ein Ordner?
OrdnerAnz=OrdnerAnz+1
rem O_rdner$(OrdnerAnz)=dos_win$(Filename$)
O_rdner$(OrdnerAnz)=Filename$
else
DateiAnz=DateiAnz+1
rem D_atei$(DateiAnz)=dos_win$(FileName$)
D_atei$(DateiAnz)=FileName$
end if
end if
filename$ = Dir(@rueckgabe)
Loop while filename$ > ""
rem Datei-Ausgabelänge kürzen, damit es in die Ausgabebox passt
rem ...und nebenbei die Ausgabe auch noch "Ö" und "Ä" etc richtig anzeigen lassen
rem ...dazu packen wir die Datei in einen Dummy, welche dann angezeigt wird
For i=1 To DateiAnz
If Len(D_atei$(i))>20 Then
DateiDummy$(i)=Left$(D_atei$(i),20)+"..."
Else
DateiDummy$(i)=D_atei$(i)
End If
DateiDummy$(i)=dos_win$(DateiDummy$(i))
Rem ggf. mit Leezeichen auffüllen, um den Rest der Zeile zu löschen
DateiDummy$(i)=DateiDummy$(i)+Space$(23-Len(DateiDummy$(i)))
Next i
Rem keine Daten gefunden?
If DateiAnz=0 Then
DateiAnz=1
D_atei$(DateiAnz)="Keine Daten gefunden"
DateiDummy$(DateiAnz)=D_atei$(DateiAnz)
End If
rem Ordner-Ausgabelänge kürzen, damit es in die Ausgabebox passt
rem ...und nebenbei die Ausgabe auch noch "Ö" und "Ä" etc richtig anzeigen lassen
rem ...dazu packen wir die Datei in einen Dummy, welche dann angezeigt wird
For i=1 To OrdnerAnz
If Len(O_rdner$(i))>20 Then
OrdnerDummy$(i)=Left$(O_rdner$(i),20)+"..."
Else
OrdnerDummy$(i)=O_rdner$(i)
End If
OrdnerDummy$(i)=dos_win$(OrdnerDummy$(i))
Rem ggf. mit Leezeichen auffüllen, um den Rest der Zeile zu löschen
OrdnerDummy$(i)=OrdnerDummy$(i)+Space$(23-Len(OrdnerDummy$(i)))
Next i
rem Ordner anzeigen
y=5
x=15
OrdnerShowStart=0
i=OrdnerShowStart
OrdnerShowEnde=0
Color ordnerfarbe,Texthintergrund
Do
i=i+1
y=y+1
OrdnerShowEnde=OrdnerShowEnde+1
Locate y,x
rem Print dos_win$(O_rdner$(i))
Print Ordnerdummy$(i)
yordner(i)=y
xordner(i)=x
Loop Until OrdnerShowEnde=Max_FS_Zeilen Or i=OrdnerAnz
rem Dateien anzeigen
y=5
x=60
DateiShowStart=0
i=DateiShowStart
DateiShowEnde=0
Color dateifarbe,Texthintergrund
Do
i=i+1
y=y+1
DateiShowEnde=DateiShowEnde+1
Locate y,x
Print DateiDummy$(i)
ydatei(i)=y
xdatei(i)=x
Loop Until DateiShowEnde=Max_FS_Zeilen Or i=DateiAnz
Do
rem Mausabrage
Getmouse mx,my,mr,mk
taste$=Inkey$
If Len(taste$)=2 Then
rem Pfeil nach unten
If Right$(taste$,1)="P" Then
if inbox=links then
taste$="a"
else
taste$="-"
end if
End If
rem Pfeil nach oben
If Right$(taste$,1)="H" Then
if inbox=links then
taste$="q"
else
taste$="+"
end if
End If
rem Pfeil nach rechts
If Right$(taste$,1)="M" Then
if inbox=links then
inbox=rechts
else
inbox=links
end if
End If
rem Pfeil nach links
If Right$(taste$,1)="K" Then
if inbox=links then
inbox=rechts
else
inbox=links
end if
End If
End If
if inbox=links then
Line (92,68)-(322,502),Rgb(255,255,255),b ' Box für die Ordner
Line (94,70)-(320,500),Rgb(255,255,255),b ' Box für die Ordner
Line (458,68)-(672,502),Rgb(255,255,255),b ' Box für die Dateien
Line (460,70)-(670,500),texthintergrund,b ' Box für die Dateien
else
Line (94,70)-(320,500),texthintergrund,b ' Box für die Ordner
Line (92,68)-(322,502),Rgb(255,255,255),b ' Box für die Ordner
Line (458,68)-(672,502),Rgb(255,255,255),b ' Box für die Dateien
Line (460,70)-(670,500),Rgb(255,255,255),b ' Box für die Dateien
end if
If taste$="a" And OrdnerShowStart+OrdnerShowEnde<OrdnerAnz Then 'das "Plus" für Ordner
y=5
x=15
OrdnerShowStart=OrdnerShowStart+1
i=OrdnerShowStart
OrdnerShowEnde=0
Color ordnerfarbe,Texthintergrund
Do
i=i+1
y=y+1
OrdnerShowEnde=OrdnerShowEnde+1
Locate y,x
rem Print dos_win$(O_rdner$(i))+Space$(MaxOrdnerLaenge-Len(O_rdner$(i)))
Print OrdnerDummy$(i)
yordner(i)=y
xordner(i)=x
Loop Until OrdnerShowEnde=Max_FS_Zeilen Or i=OrdnerAnz
End If
If taste$="q" And OrdnerShowStart>0 Then 'das "Minus" für Ordner
y=5
x=15
OrdnerShowStart=OrdnerShowStart-1
i=OrdnerShowStart
OrdnerShowEnde=0
Color ordnerfarbe,Texthintergrund
Do
i=i+1
y=y+1
OrdnerShowEnde=OrdnerShowEnde+1
Locate y,x
rem Print dos_win$(O_rdner$(i))+Space$(MaxOrdnerLaenge-Len(O_rdner$(i)))
Print OrdnerDummy$(i)
yordner(i)=y
xordner(i)=x
Loop Until OrdnerShowEnde=Max_FS_Zeilen Or i=OrdnerAnz
End If
If taste$="-" And DateiShowStart+DateiShowEnde<DateiAnz Then
DateiShowStart=DateiShowStart+1
i=DateiShowStart
y=5
x=60
anz=0
DateiShowEnde=0
Color dateifarbe,Texthintergrund
Do
i=i+1
y=y+1
DateiShowEnde=DateiShowEnde+1
ydatei(i)=y
xdatei(i)=x
Locate y,x
rem Print dos_win$(D_atei$(i))+Space$(MaxDateiLaenge-Len(D_atei$(i)))
Print DateiDummy$(i)
Loop Until DateiShowEnde=Max_FS_Zeilen Or i=DateiAnz
End If
If taste$="+" And DateiShowStart>0 Then
DateiShowStart=DateiShowStart-1
i=DateiShowStart
y=5
x=60
DateiShowEnde=0
Color dateifarbe,Texthintergrund
Do
i=i+1
y=y+1
DateiShowEnde=DateiShowEnde+1
ydatei(i)=y
xdatei(i)=x
Locate y,x
rem Print dos_win$(D_atei$(i))+Space$(MaxDateiLaenge-Len(D_atei$(i)))
Print DateiDummy$(i)
Loop Until DateiShowEnde=Max_FS_Zeilen Or i=DateiAnz
End If
rem Maus auf einem Ordner?
For i=OrdnerShowstart To OrdnerShowstart+OrdnerShowEnde
If mx>xordner(i)*8-8 And mx<xordner(i)*8-8+100 And my>yordner(i)*16-16 And my<yordner(i)*16 Then
If mk=1 Then
Chdir O_rdner$(i)
Do
Getmouse mx,my,mr,mk
taste$=Inkey$
Loop Until taste$="" And mk=0
neulesen=1
End If
End If
Next i
rem Maus auf einer Datei?
For i=DateiShowStart To DateiShowStart+DateiShowEnde
If mx>xdatei(i)*8-8 And mx<xdatei(i)*8+200 And my>ydatei(i)*16-16 And my<ydatei(i)*16 Then
Color Rgb(255,255,255),Texthintergrund
Locate ydatei(i),xdatei(i)
rem Print D_atei$(i)
Print DateiDummy$(i)
If mk=1 Then
Auswahl$=D_atei$(i)
Locate 34,10
Print Auswahl$+Space$(MaxDateiLaenge-Len(Auswahl$))
End If
Else
Color textfarbe,Texthintergrund
Locate ydatei(i),xdatei(i)
rem Print D_atei$(i)
Print DateiDummy$(i)
End If
Next i
Rem Maus auf der Abbruch-Box?
If mx>585 And mx<650 And my>555 And my<586 And mk=1 Then
Auswahl$="Abbruch"
taste$=Chr$(27)
End If
Rem Maus auf der Übernehmen-Box?
If mx>680 And mx<770 And my>555 And my<586 And mk=1 And Auswahl$<>"" Then
Auswahl$=Curdir+"\"+Auswahl$
Rem Doppelte Ba
s=Instr(auswahl$,"\\")
If s>0 Then auswahl$=Left$(auswahl$,s)+Right$(auswahl$,Len(auswahl$)-s-1)
taste$=Chr$(27)
End If
Rem Maus in der zweiten untere Dialogbox?
If mx>42 And mx<580 And my>558 And my<580 And mk=1 Then
Do
Getmouse mx,my,mr,mk
taste$=Inkey$
taste=Asc(taste$)
Loop Until taste$="" And mk=0
Color Rgb(255,255,255),Texthintergrund
Do
Getmouse mx,my,mr,mk
taste$=Inkey$
taste=Asc(taste$)
Locate 36,10
Print Dateiendung$+"| "
If Len (taste$)=1 And taste$<>"" And taste<>13 And taste<>27 And taste<>8 Then
Dateiendung$=Dateiendung$+taste$
Locate 36,10
Print Dateiendung$+"| "
End If
If taste=8 And Len(Dateiendung$)>0 Then
Dateiendung$=Left$(Dateiendung$,Len(Dateiendung$)-1)
Locate 36,10
Print Dateiendung$+"| "
End If
Sleep 1
Loop Until taste$=Chr$(13) Or Len(taste$)>1 Or taste$=Chr$(27) Or mk>0
Color 0, Texthintergrund
Locate 36,10
Print Dateiendung$+" "
neulesen=1
End If
Rem Auf ein Laufwerkbuchstaben geklickt?
For i=1 To lwanz
y=3
If mx>2 And mx<60 And my>(y+i)*16-16 And my<(y+i)*16 Then
rem Color laufwerkfarbe,Rgb(40,59,80)
Color Rgb(255,0,0),Rgb(40,59,80)
Locate y+i,2
Print lw$(i)+":\"
If mk=1 Then
NeuesLaufwerk$=lw$(i)+":\"
Chdir NeuesLaufwerk$
Do
Getmouse mx,my,mr,mk
taste$=Inkey$
Loop Until taste$="" And mk=0
neulesen=1
End If
Else
Color laufwerkfarbe,Rgb(40,59,80)
Locate y+i,2
Print lw$(i)+":\"
End If
Next i
Rem Maus in der Datei-Anzeige-Box?
If mx>42 And mx<580 And my>524 And my<546 Then
If mk=1 Then
Auswahl$=""
Color Rgb(255,0,0),texthintergrund
Locate 34,10
print space$(30)
rem Print auswahl$+"|"
Rem Maus und Tastaturpuffer leeren
Do
Getmouse mx,my,mr,mk
taste$=Inkey$
Loop Until taste$="" And mk=0
Rem Eingabe
Do
Getmouse mx,my,mr,mk
taste$=Inkey$
taste=Asc(taste$)
Locate 34,10
Print Auswahl$+"| "
If Len (taste$)=1 And taste$<>"" And taste<>13 And taste<>27 And taste<>8 Then
Auswahl$=Auswahl$+taste$
Locate 34,10
Print Auswahl$+"| "
End If
If taste=8 And Len(Auswahl$)>0 Then
Auswahl$=Left$(Auswahl$,Len(Auswahl$)-1)
Locate 34,10
Print Auswahl$+"| "
End If
Sleep 1
Loop Until taste$=chr$(13) or mk>0
Color Textfarbe,texthintergrund
Locate 34,10
Print auswahl$
End If
End If
Sleep 1 'Pause für die CPU
Loop Until taste$=Chr$(27) Or Auswahl$="Abbruch" Or neulesen=1
neulesen=0
Loop Until taste$=Chr$(27)
fs$=Auswahl$
Erase lw$
Erase O_rdner$,D_atei$
Erase xordner,yordner,xdatei,ydatei,OrdnerDummy$,Dateidummy$
End Function
Function dos_win$(t$)
For i=1 To Len(t$)
If Mid$(t$,i,1)=Chr$(252) Then
Mid$(t$,i,1)=Chr$(129)
End If
Next i
For i=1 To Len(t$)
If Mid$(t$,i,1)=Chr$(228) Then
Mid$(t$,i,1)=Chr$(132)
End If
Next i
For i=1 To Len(t$)
If Mid$(t$,i,1)=Chr$(196) Then
Mid$(t$,i,1)=Chr$(142)
End If
Next i
For i=1 To Len(t$)
If Mid$(t$,i,1)=Chr$(246) Then
Mid$(t$,i,1)=Chr$(148)
End If
Next i
For i=1 To Len(t$)
If Mid$(t$,i,1)=Chr$(214) Then
Mid$(t$,i,1)=Chr$(153)
End If
Next i
For i=1 To Len(t$)
If Mid$(t$,i,1)=Chr$(220) Then
Mid$(t$,i,1)=Chr$(154)
End If
Next i
dos_win$=t$
End Function
|
Stevie1401 |
|
| Nach oben |
|
 |
Mao
Anmeldungsdatum: 25.09.2005
Beiträge: 4409
Wohnort: /dev/hda1
|
| Verfasst am: 17.10.2006, 12:57 Titel: |
|
|
Zuersteinmal ein nett gemeinter(!) Hinweis:
Wenn das Programm so groß ist, dann lad' doch bitte mal den Source hoch statt ihn zu posten, oder poste ihn in NoPaste auf freebasic.de. 
So, nun zum Programm:
das Ergebnis sieht ser schön aus, funktioniert problemlos. 
Allerdings im Source: du mixt deine Kommentare zwischen ' und REM. Benutz doch nicht mehr REM, das is' soooo alt.
Aber sonst: weiter so! 
_________________
Eine handvoll Glück reicht nie für zwei.
--
 |
|
| Nach oben |
|
|
ytwinky
Anmeldungsdatum: 28.05.2005
Beiträge: 2624
Wohnort: Machteburch
|
| Verfasst am: 17.10.2006, 20:21 Titel: |
|
|
| fbc output hat Folgendes geschrieben: | Command executed:
"D:\Sprachen\FreeBASIC\fbc.exe" "D:\Sprachen\FreeBasic\bas\SelectBox.Bas"
Compiler output:
D:/Sprachen/FreeBasic/bas/SelectBox.Bas(556) : warning level 0: Implicit variable allocation, taste
D:/Sprachen/FreeBasic/bas/SelectBox.Bas(558) : warning level 0: Implicit variable allocation, taste
Results:
Compilation successful
Generated executable: D:\Sprachen\FreeBasic\bas\SelectBox.exe
System:
FBIde: 0.4.6
fbc: FreeBASIC Compiler - Version 0.16 for win32 (target:win32)
OS: Windows XP (build 2600, Service Pack 2) |
das läßt sich aber leicht abfangen mit | Code: | ..
Function fs$(Dialog$,Dateiendung$)
Dim Taste$
.. |
Ich hatte gleich den Verdacht, daß 'Option Explicit' den Fehler aufdecken würde..
..aber da hätte ich alle Variablen dimensionieren müssen, das war mir denn doch zuviel..
Aber so funktionierts mit FB0.16bSE..
..aber weil ich ein fanatischer Mausquäler bin, fehlt mir doch der Doppelclick zur Übernahme.
Läßt sich ja vllt. noch einbauen..
Ansonsten: Ein gelungenes Stück.
[Edit]
Für die Umformung der Umlaute solltest du dir aber mal TransUmlaut.Bas ansehen..
..das scheint mir doch ein ganzes Stück schneller zu gehen als Dos_Win(..)
Gruß
ytwinky
_________________
| v1ctor hat Folgendes geschrieben: | | Yeah, i like INPUT$(n) as much as PRINT USING.. |
..also ungefähr so, wie ich GOTO.. |
|
| Nach oben |
|
|
Michael712
aka anfänger, programmierer
Anmeldungsdatum: 26.03.2005
Beiträge: 1593
|
| Verfasst am: 17.10.2006, 22:09 Titel: |
|
|
Ich gebe direkt mal einen Tipp ab:
Keine Suffixe mehr verwenden (%, $, etc), ALLE Variablen dimensionieren, und auch bei Funktionen die zurückgegebene Variable immer angeben(also Function blubb() As Integer). "Dim Variable" geht auch nicht mehr, es muss immer der Datentyp angegeben werden.
Die neuste CVS Version meckert dann, und dann kommt da sowas raus(ist jetzt dein Prog mit der 0.17 CVS compiliert) :
| Code: | fbc2 test.bas
test.bas(15) error 136: Suffixes are only valid in -lang deprecated or qb, found '(' in 'Declare Function fs$(Dialog$,Dateiendung$)'
test.bas(16) error 136: Suffixes are only valid in -lang deprecated or qb, found '(' in 'Declare Function dos_win$(t$)'
test.bas(20) error 136: Suffixes are only valid in -lang deprecated or qb, found 'auswahl' in 'auswahl$=fs$(dos_win$("Datei öffnen"),"*.*")'
test.bas(20) error 56: Type mismatch, at parameter 1 of FS() in 'auswahl$=fs$(dos_win$("Datei öffnen"),"*.*")'
test.bas(22) error 136: Suffixes are only valid in -lang deprecated or qb, found 'auswahl' in 'Print auswahl$'
test.bas(23) error 136: Suffixes are only valid in -lang deprecated or qb, found 't' in 't$="Bitte eine Taste drücken"'
test.bas(24) error 136: Suffixes are only valid in -lang deprecated or qb, found 't' in 'print dos_win$(t$)'
test.bas(27) error 136: Suffixes are only valid in -lang deprecated or qb, found 'auswahl' in 'auswahl$=fs$(dos_win$("Datei speichern unter"),"*.*")'
test.bas(29) error 136: Suffixes are only valid in -lang deprecated or qb, found 'auswahl' in 'Print auswahl$'
test.bas(34) error 136: Suffixes are only valid in -lang deprecated or qb, found '(' in 'Function fs$(Dialog$,Dateiendung$)'
test.bas(34) error 123: Too many errors, exiting
|
Und den Code immer mit -lang qb kompilieren ist meiner Meinung nach nicht so schön 
Sogar Option Explicit ist auch nur in -lang deprecated, das ist bei der CVS Version standard:
| Code: | error 134: Only valid in -lang deprecated or qb, found 'explicit' in 'option explicit'
|
Und es wird auch nicht kompiliert, wenn eine Variable nicht deklariert ist.
Hab deinen Code schon ein bisschen verbessert, hab aber keine zeit zu testen. Morgen sag ich dann was darüber
_________________
| Code: | | #include "signatur.bi" |
|
|
| Nach oben |
|
|
stevie1401
Anmeldungsdatum: 04.07.2006
Beiträge: 133
|
| Verfasst am: 18.10.2006, 05:29 Titel: |
|
|
Vielen Dank für eure Antworten.
@Mao
Ich habe NoPaste noch nicht verstanden, ich werde versuchen zukünftig den Code dorthin hochzuladen.
@ytwinky
Ja, ich gebe dir vollkommen Recht: Doppelklick muss sein
Auch fehlen mir persönlich noch die Schiebebalken. Aber letztendlich ging es mir erst einmal um das Prinzip der Function und um den Lösungsansatz.
Wie du ja weisst, gibt es mehrere Möglichkeiten eine solche Fileselect-Box zu bauen.
Auch die Grafik finde ich unter aller Kanone, aber auch das ist Absicht, da ich bewusst alles in eine Function packen wollte und es (einigermassen) übersichtlich bleiben sollte.
Dass "taste$" nicht gedimmt war liegt daran, dass ich normalerweise eine Sub namens Maus habe:
| Code: |
Sub Maus
do
getmouse mx,my,mr,mk
taste$=inkey$
loop until taste$="" and mk=0
do
getmouse mx,my,mr,mk
taste$=inkey$
loop until taste$<>"" or mk<>0
end sub
|
...und am Anfang des Programmes mache ich dann:
| Code: | | Dim shared mx,my,mr,mk,taste$ |
@programmierer
Ich habe nur die Hälfte von dem verstanden, was du geschrieben hast.
Wie dem auch sei: ich liebe es Suffixe zu verwenden. Ich finde es sogar übersichtlicher, denn dann weiss ich, welche Variable TEXT und welche eine Zahl beinhaltet.
Deshalb finde ich Freebasic 15b auch angenehmer als die 16er, aber leider gehen bei der 15er einige Dinge nicht.
Sollte die Angabe von Suffixen in zukünftigen FB-Versonen nicht mehr gehen, dann läuft die Entwicklung von FreeBASIC eindeutig in die FALSCHE Richtung.
Zumindest ich möchte in BASIC programmieren und nicht in einer "Hochsprache".
Stevie1401 |
|
| Nach oben |
|
|
Mao
Anmeldungsdatum: 25.09.2005
Beiträge: 4409
Wohnort: /dev/hda1
|
| Verfasst am: 18.10.2006, 10:48 Titel: |
|
|
Hm, also wenn ich was größeres starte, dann verwende ich die ungarische Notation. Sprich, wenn du beispielsweise einen Integer Namens Blubb erzeugen willst, dann:
| Code: |
Dim As Integer iBlubb
|
Mit Pointern:
| Code: |
Dim As Any Ptr pBlubb ' oder besser ptrBlubb
|
So geht's, find ich, eigentlich leichter.
_________________
Eine handvoll Glück reicht nie für zwei.
--
|
|
| Nach oben |
|
|
Michael712
aka anfänger, programmierer
Anmeldungsdatum: 26.03.2005
Beiträge: 1593
|
| Verfasst am: 18.10.2006, 13:52 Titel: |
|
|
Es geht, allerdings muss man dann mit "-lang qb" oder "-lang deprecated" kompilieren(in der FBIDE einfach bei kompilereinstellungen hinzufügen). Und ich finde es so besser, da bei suffixen auch schneller fehler entstehen können, vor allem wenn man variablen nicht deklariert.
@Mao: Genau so mache ich es auch, jedenfalls bei Pointern. immer ein "p" davor, dann erkennt man das schon. Und da ich auch die Variablen veringere, nehme ich oft einfach "text" für String variablen, da ich die meißtens eh nur selten brauche(ausser wenn ich jetzt die taste speichern möchte, dann nehme ich "inky"  ). Bei den meißten Variablen ist es aber klar, das ein Text gemeint ist. Beispiele:
name, dateiname, pfad, ...
Da wäre dann ein Suffix nur überflüssig 
_________________
| Code: | | #include "signatur.bi" |
|
|
| Nach oben |
|
|
Mao
Anmeldungsdatum: 25.09.2005
Beiträge: 4409
Wohnort: /dev/hda1
|
| Verfasst am: 18.10.2006, 14:02 Titel: |
|
|
| programmierer hat Folgendes geschrieben: |
dann nehme ich "inky"
|
Deklarierst du davor auch noch eine "ytw" Variable?  
| programmierer hat Folgendes geschrieben: |
Da wäre dann ein Suffix nur überflüssig
|
Ungarische Notation arbeitet ja auch mit Präfixen. 
_________________
Eine handvoll Glück reicht nie für zwei.
--
|
|
| Nach oben |
|
|
stevie1401
Anmeldungsdatum: 04.07.2006
Beiträge: 133
|
| Verfasst am: 18.10.2006, 20:27 Titel: Neue Version |
|
|
So, ich habe das ganze etwas überarbeitet
Besser so?
Ich habe das in NoPaste hochgeladen, weiss allerdings nicht, wie ich das jetzt hier zeigen soll?
Also hier die Adresse der HP:
http://www.hundertdrei-allerlei.de/freebasic/fs2.bas |
|
| Nach oben |
|
|
ytwinky
Anmeldungsdatum: 28.05.2005
Beiträge: 2624
Wohnort: Machteburch
|
| Verfasst am: 18.10.2006, 21:26 Titel: |
|
|
Wenn du wissen willst, wie sowas geht,
dann schau dir mal den Quelltext von dieser Seite an..
Oder als Anleitung:
[ury=http://www.hundertdrei-allerlei.de/freebasic/fs2.bas] ach, so geht das [/ury]
[ury=http://http://freebasic.de/fbnp/?view=193] ach, so geht das [/ury]
(du mußt aber ury durch url ersetzen..)
Gruß
ytwinky
_________________
| v1ctor hat Folgendes geschrieben: | | Yeah, i like INPUT$(n) as much as PRINT USING.. |
..also ungefähr so, wie ich GOTO.. |
|
| Nach oben |
|
|
Jojo
alter Rang
Anmeldungsdatum: 12.02.2005
Beiträge: 9736
Wohnort: Neben der Festplatte
|
| Verfasst am: 18.10.2006, 22:14 Titel: |
|
|
udn wieso schreibst du nicht gleich url?
_________________
» Die Mathematik wurde geschaffen, um Probleme zu lösen, die es nicht gäbe, wenn die Mathematik nicht erschaffen worden wäre.
 |
|
| Nach oben |
|
|
ytwinky
Anmeldungsdatum: 28.05.2005
Beiträge: 2624
Wohnort: Machteburch
|
| Verfasst am: 18.10.2006, 23:17 Titel: |
|
|
Hi stevie1401,
probier mal dies: | Code: | Function Dos_Win(s As String) As String
Dim As Long i, j
Dim s1 As String=Chr$(252)+Chr$(228)+Chr$(196)+Chr$(246)+Chr$(214)+Chr$(220) 'zur besseren Übersicht
Dim s2 As String=Chr$(129)+Chr$(132)+Chr$(142)+Chr$(148)+Chr$(153)+Chr$(154) 'stehen diese Dim's untereinander
For i=1 To Len(s)
j=Instr(s1, Mid(s, i, 1))
If j Then Mid(s, i, 1)=Mid(s2, j, 1)
Next i
Function=s
End Function |
Es macht schon einen Unterschied, ob die Strings einmal komplett durchlaufen werden oder 6 mal..
Ich war angenehm überrascht
@Jojo:
na, weils dann nicht zusehen gewesen wäre
Gruß
ytwinky
_________________
| v1ctor hat Folgendes geschrieben: | | Yeah, i like INPUT$(n) as much as PRINT USING.. |
..also ungefähr so, wie ich GOTO.. |
|
| Nach oben |
|
|
stevie1401
Anmeldungsdatum: 04.07.2006
Beiträge: 133
|
| Verfasst am: 19.10.2006, 06:43 Titel: Re: Neue Version |
|
|
[quote="stevie1401"]So, ich habe das ganze etwas überarbeitet
Besser so?
Hier ist es:
Ach ja, das Mausrad habe ich jetzt auch eingebaut - langsam bekommt das ganze ja Gesicht
Aber ich muss schon zugeben, für einen einzigen Befehl ist das ´ne ganz schöne fette Angelegenheit.
@ytwinky:
Deine Function dos_win() ist eindeutig übersichtlicher, mir ging es allerdings auch darum, dass ANFÄNGER mit dem Code etwas anfangen können.
Ich denke, gerade Anfänger verstehen hier im Forum meistens nur Bahnhof.
Wollte nicht jemand mal ein schönes Howto schreiben? |
|
| Nach oben |
|
|
ytwinky
Anmeldungsdatum: 28.05.2005
Beiträge: 2624
Wohnort: Machteburch
|
| Verfasst am: 20.10.2006, 10:01 Titel: |
|
|
Guter Vorschlag, kannst es ja hier posten, wenn es fertig ist 
Wenn ich wieder Telefon habe, werde ich mal meine Version deines Programmes hochladen..
(Ich habe zur Zeit irgendein telekomisches Problem: kein Freizeichen-->Kabelfehler, bezahlt is nämlich )
So hatte ich Zeit, mir das mal 'anzusehen'
Gruß
ytwinky
_________________
| v1ctor hat Folgendes geschrieben: | | Yeah, i like INPUT$(n) as much as PRINT USING.. |
..also ungefähr so, wie ich GOTO.. |
|
| Nach oben |
|
|
Sebastian
Administrator
Anmeldungsdatum: 10.09.2004
Beiträge: 5969
Wohnort: Deutschland
|
|
| Nach oben |
|
|
ytwinky
Anmeldungsdatum: 28.05.2005
Beiträge: 2624
Wohnort: Machteburch
|
| Verfasst am: 20.10.2006, 11:49 Titel: |
|
|
@Sebastian:
Es war eine Störung im telekomischen Kabel=>kein Telefon(TAE-F) und kein Modem(TAE-N)
(Deine Vermutung war richtig..
..schließlich mußte ich ja irgendwie meine Mails abfragen!)
@stevie1401:
Die versprochene Datei ist hier..
[Edit]
Achtung: PrintAt(..) geändert, ggfs. neu downloaden..
[Edit2] | Code: | | Dim Anz=2000 'ist 'etwas' knapp bemessen, bei mir müsste es schon 2100 sein |
btw:
Timer liefert Double's..
..in case you didn't know..
[Edit3]
Ooops, 'kleinen' Fehler(meinerseits) berichtigt..
(Deine Änderungen sind da noch nicht eingearbeitet..)
Gruß
ytwinky
_________________
| v1ctor hat Folgendes geschrieben: | | Yeah, i like INPUT$(n) as much as PRINT USING.. |
..also ungefähr so, wie ich GOTO.. |
|
| Nach oben |
|
|
Jojo
alter Rang
Anmeldungsdatum: 12.02.2005
Beiträge: 9736
Wohnort: Neben der Festplatte
|
| Verfasst am: 22.10.2006, 20:42 Titel: |
|
|
Hm, wie lautet denn nun der komplette sourcecode der DirListBox? ich würde sie nämlich gerne in meinem geplanten installer verwenden und evtl. etwas verbessern.
_________________
» Die Mathematik wurde geschaffen, um Probleme zu lösen, die es nicht gäbe, wenn die Mathematik nicht erschaffen worden wäre.
|
|
| Nach oben |
|
|
ytwinky
Anmeldungsdatum: 28.05.2005
Beiträge: 2624
Wohnort: Machteburch
|
| Verfasst am: 22.10.2006, 21:34 Titel: |
|
|
| meinereiner hat Folgendes geschrieben: | Die versprochene Datei ist hier..
|
..oder du nimmst die von stevie1401..
Vielleicht hast du ja auch Interesse an einer ASCII-Box?
Gruß
ytwinky
_________________
| v1ctor hat Folgendes geschrieben: | | Yeah, i like INPUT$(n) as much as PRINT USING.. |
..also ungefähr so, wie ich GOTO.. |
|
| Nach oben |
|
|
Jojo
alter Rang
Anmeldungsdatum: 12.02.2005
Beiträge: 9736
Wohnort: Neben der Festplatte
|
| Verfasst am: 23.10.2006, 20:08 Titel: |
|
|
naja ich bevorzuge die variante oben
_________________
» Die Mathematik wurde geschaffen, um Probleme zu lösen, die es nicht gäbe, wenn die Mathematik nicht erschaffen worden wäre.
|
|
| Nach oben |
|
|
ytwinky
Anmeldungsdatum: 28.05.2005
Beiträge: 2624
Wohnort: Machteburch
|
| Verfasst am: 23.10.2006, 20:23 Titel: |
|
|
Hi,
..kann ich verstehen, bis jetzt kann ich auch nur Laufwerke ermitteln
..und ob ich dabei überhaupt weitermache, weiß ich noch nicht.
Aber die TextBox gefällt mir gut, mal sehen, was sich damit anstellen läßt
Gruß
ytwinky
_________________
| v1ctor hat Folgendes geschrieben: | | Yeah, i like INPUT$(n) as much as PRINT USING.. |
..also ungefähr so, wie ich GOTO.. |
|
| Nach oben |
|
|
|
|
Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
|
|
FAQ
Suchen
Mitgliederliste
Benutzergruppen
Registrieren
Profil
Einloggen, um private Nachrichten zu lesen
Login
oder schreibst du mal wieder aus dem Internetcafé? 
