 |
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 |
volta
Anmeldungsdatum: 04.05.2005
Beiträge: 1876
Wohnort: D59192
|
 Verfasst am: 15.11.2006, 11:51 Titel: Berlin Uhr ? |
 |
|
Seit etlichen Jahren habe ich diese 'Berlin Uhr' in fast allen Programmiersprachen die ich benutzte geprogt.
So ... , jetzt auch in freeBASIC 
http://de.wikipedia.org/wiki/Berlin-Uhr
| Code: | '"Berlin Uhr"
'http://de.wikipedia.org/wiki/Berlin-Uhr
Option Explicit
Dim As Integer sec, hr, x, fa, min,Tx
Dim As String Tm, Ik
Screenres 200,200,32,,4
Sub kreis (Ti As Integer Ptr, dif, fa, h, px)
Dim x As Integer
For x = 0 To 3
If *Ti >= dif Then
Circle (45+(40*x),h),15,fa,,,1,F
*Ti-= dif
Else
Circle (45+(40*x),h),15,&H282828,,,1,F
End If
Next
End Sub
Color &HFFFFFF,&H909080
Cls
Do
Tm = Time
sec = Val(Right(Tm,2))
If (sec And 1) Then
Circle (105,20),15,&HFFFF00,,,1,F
Else
Circle (105,20),15,&H282828,,,1,F
End If
hr = Val(Left(Tm,2))
kreis @hr,5,&HFF0000,60,8
kreis @hr,1,&HFF0000,100,13
min = Val(Mid(Tm,4,2))
For x = 1 To 11
If min >=5 Then
fa=&HFFFF00
If (x Mod 3)=0 Then fa =&HFF0000
Line ((13*x)+22,125)-((13*x)+32,155),fa,BF
min-=5
Else
Line ((13*x)+22,125)-((13*x)+32,155),&H282828,BF
End If
Next
kreis @min,1,&HFFFF00,180,23
Do
Ik = Inkey
If Ucase(Ik) = "H" Then
Locate 1, 1:Print " "
Locate 3, 1:Print " 1s "
Locate 8, 1:Print "+5h"
Locate 13,1:Print "+1h"
Locate 18,1:Print "+5m"
Locate 23,1:Print "+1m"
Tx = Timer
End If
If Tx+5 < Timer Then
Locate 1, 1:Print "(Esc)Ende"
Locate 3, 1:Print "(H)ilfe"
Locate 8, 1:Print " "
Locate 13,1:Print " "
Locate 18,1:Print " "
Locate 23,1:Print " "
Tx = Timer
End If
If Ik = Chr(255,107) Then Ik = Chr(27)
If Ik = Chr(27) Then Exit Do
Sleep 10,1
Loop While Time = Tm
Loop Until Ik = Chr(27)
End |
_________________
Warnung an Choleriker:
Dieser Beitrag kann Spuren von Ironie & Sarkasmus enthalten.
Zu Risiken & Nebenwirkungen fragen Sie Ihren Therapeuten oder Psychiater. |
|
| Nach oben |
|
 |
progon
aka bitbender
Anmeldungsdatum: 16.07.2006
Beiträge: 168
Wohnort: Kassel
|
| Verfasst am: 15.11.2006, 14:08 Titel: |
|
|
Interessant wäre auch mal die Linear-Uhr von Kassel [1] in qBasic, Freebasic... umzusetzen. Mein Vater hat die mal als Elektronik Projekt nachgebaut.
Leider funktioniert das Original nicht mehr so gut, weil immer ein paar Glühbirnen fehlen und die Uhr nicht mehr gestellt wird. Das soll sich aber angeblich bald ändern (Laut einer Zeitung).
[1] http://de.wikipedia.org/wiki/Linear-Uhr_%28Kassel%29
EDIT: Link verändert.
_________________
MfG progon
Zuletzt bearbeitet von progon am 15.11.2006, 16:57, insgesamt 2-mal bearbeitet |
|
| Nach oben |
|
|
volta
Anmeldungsdatum: 04.05.2005
Beiträge: 1876
Wohnort: D59192
|
| Verfasst am: 15.11.2006, 16:28 Titel: |
|
|
Hi progon,
richtig, bei dem Link stören die Klammern.
Unter 'Artikel' auf der Seite kannst du diesen Link kopieren http://de.wikipedia.org/wiki/Linear-Uhr_%28Kassel%29
Zu deinem Vorschlag sag ich dir: los prog on
_________________
Warnung an Choleriker:
Dieser Beitrag kann Spuren von Ironie & Sarkasmus enthalten.
Zu Risiken & Nebenwirkungen fragen Sie Ihren Therapeuten oder Psychiater. |
|
| Nach oben |
|
|
progon
aka bitbender
Anmeldungsdatum: 16.07.2006
Beiträge: 168
Wohnort: Kassel
|
| Verfasst am: 15.11.2006, 16:53 Titel: |
|
|
hehe 
würde ich ja gerne machen, leider fehlt mir aber im Moment die Zeit etwas in der Richtung zu machen (Schule, Bewerbungen etc.). Aber vielleicht komme ich ja doch noch dazu
_________________
MfG progon
|
|
| Nach oben |
|
|
Key
Anmeldungsdatum: 03.10.2006
Beiträge: 95
|
| Verfasst am: 15.11.2006, 17:26 Titel: |
|
|
Habs ma versucht zu basteln und folgendes is bei rausgekommen 
| Code: | OPTION EXPLICIT
SCREEN 19,32,2
DIM AS INTEGER hr(1),min(1),sec(1),i
DIM AS STRING tm
SCREENSET 1,0
DO
CLS
tm = TIME
hr(0) = VAL(MID(tm,1,1))
hr(1) = VAL(MID(tm,2,1))
min(0) = VAL(MID(tm,4,1))
min(1) = VAL(MID(tm,5,1))
sec(0) = VAL(MID(tm,7,1))
sec(1) = VAL(MID(tm,8,1))
FOR i = 1 TO hr(0)
CIRCLE (20,20+i*15),5,RGB(255,255,255),,,,F
NEXT i
FOR i = 1 TO hr(1)
CIRCLE (20,70+i*15),5,RGB(255,255,255),,,,F
NEXT i
FOR i = 1 TO min(0)
CIRCLE (50,20+i*15),5,RGB(255,255,255),,,,F
NEXT i
FOR i = 1 TO min(1)
CIRCLE (50,120+i*15),5,RGB(255,255,255),,,,F
NEXT i
FOR i = 1 TO sec(0)
CIRCLE (80,20+i*15),5,RGB(255,255,255),,,,F
NEXT i
FOR i = 1 TO sec(1)
CIRCLE (80,120+i*15),5,RGB(255,255,255),,,,F
NEXT i
SCREENCOPY
LOOP UNTIL INKEY = CHR(27) |
Hoff ma ich hab die Uhr richtig verstanden...
wegen platzmangel std, minuten und sekunden nebeneinander =/ |
|
| Nach oben |
|
|
progon
aka bitbender
Anmeldungsdatum: 16.07.2006
Beiträge: 168
Wohnort: Kassel
|
| Verfasst am: 15.11.2006, 17:44 Titel: |
|
|
Sollte richtig sein
Hab mir grad mal Freebasic runtegeladen. Gefällt mir irgentwie besser als das schon ziehmlich alte qbasic (ist halt moderner). Ich denke mal das ich damit erst mal was machen werde
Mit qbasic kann ich ja immer noch was auf meinem 166Mhz Notebook machen
_________________
MfG progon
|
|
| Nach oben |
|
|
ytwinky
Anmeldungsdatum: 28.05.2005
Beiträge: 2624
Wohnort: Machteburch
|
| Verfasst am: 15.11.2006, 22:13 Titel: |
|
|
Hi,
eigentlich wollte ich nur die Maus da 'rein basteln
..aber so finde ich es auch nicht schlecht.. | Code: | '"Berlin Uhr"
'http://de.wikipedia.org/wiki/Berlin-Uhr
Option Escape
Option Explicit
Const Esc="\27", CtrlC="\03", AltF4="\255k" , Lfs="\n\n\n\n\n"
Const weiss=&HFFFFFF, grau=&H909080, gelb=&HFFFF00, rot=&HFF0000, schwarz=&H282828
Dim As Integer sec, hr, x, fa, min, tx, y=125, mx, my, mb, i
Dim As String tm, ik
Screenres 200, 200, 32,, 4
Sub Kreis(byRef ti As Integer, dif, fa, h)
Dim i As Integer
For i=0 To 3
If ti>=dif Then
Circle (45+(40*i), h), 15, fa,,, 1, F
ti-=dif
Else
Circle(45+(40*i), h), 15, schwarz,,, 1, F
End If
Next
End Sub
Color weiss, grau
Cls
Do
tm=Time
sec=Val(Right(tm, 2))
Circle(y-20, 20), 15, IIF(sec And 1, rot, gelb),,, 1, F
hr=Val(Left(tm, 2))
Kreis hr, 5, gelb, 60
Kreis hr, 1, rot, 100
min=Val(Mid(tm, 4, 2))
For i=1 To 11
x=(13*i)+22
If min>=5 Then
Line (x, y)-(x+10, y+30), IIF((i Mod 3)=0, rot, gelb), BF
min-=5
Else
Line (x, y)-(x+10, y+30), schwarz, BF
End If
Next
Kreis min, 1, gelb, 180
Do
ik=lcase(Inkey)
GetMouse mx, my,, mb
If ik="h" Or (mb=1 And mx-8<0 And my-8<0 And Screen(1, 1, 0)=Asc("H")) Then
Locate 1, 1
?"Esc=Ende\n\n1s" &Lfs &"5h" &Lfs &"1h" &Lfs &"5m" &Lfs &"1m"
tx=Timer
End If
If tx+5<Timer Then
Locate 1, 1
?"H=Hilfe \n\n " &Lfs &" " &Lfs &" " &Lfs &" " &Lfs &" "
tx=Timer
End If
Sleep 10, 1
Loop While Time=tm And Instr(CtrlC+AltF4+Esc, ik)=0
Loop Until Instr(CtrlC+AltF4+Esc, ik)
End |
..danke volta.
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 |
|
|
volta
Anmeldungsdatum: 04.05.2005
Beiträge: 1876
Wohnort: D59192
|
| Verfasst am: 15.11.2006, 22:20 Titel: |
|
|
Hi progon,  gute Entscheidung aber Schule und Bewerbungen nicht aus dem Auge verlieren.
Hi Key,
guter Ansatz aber ich glaube die Anzeige geht von unten nach oben?
Noch ein Tip
| Code: | ..
Do
Ik = Inkey 'Tastaturabfrage
If Ik = CHR(3) Then Ik = chr(27) 'wurde Ctrl+C gedrückt oder
If Ik = CHR(255,107) Then Ik = chr(27) 'wurde X (Alt+F4) gedrückt
If Ik = chr(27) Then Exit Do 'oder ESC dann raus hier
Sleep 10,1 'sorgt für etwas CPU Entlastung
Loop While Time = Tm 'bis zur nächsten Änderung die kleine Schleife
Loop Until Ik = chr(27)
|
Damit kann man auch über den X-Button schließen und die CPU-Last sinkt.
Eine absolut geile Spiral - Uhr 
http://www.freebasic.net/forum/viewtopic.php?p=54239#54239
EDIT/ Hi ytwinky, werde ich gleich mal ausprobieren
_________________
Warnung an Choleriker:
Dieser Beitrag kann Spuren von Ironie & Sarkasmus enthalten.
Zu Risiken & Nebenwirkungen fragen Sie Ihren Therapeuten oder Psychiater. |
|
| Nach oben |
|
|
Key
Anmeldungsdatum: 03.10.2006
Beiträge: 95
|
| Verfasst am: 16.11.2006, 14:58 Titel: |
|
|
Hab die uhr leider noch nie gesehn und im wikipedia text stands (glaub ) auch nich =/ aba sieht schon irgendwie besser aus so
habs mal berichtigt und dein Tip eingebaut (danke auch )
| Code: | OPTION EXPLICIT
SCREEN 19,32
DIM AS INTEGER hr(1),min(1),sec(1),i
DIM AS STRING tm,ik
DO
CLS
tm = TIME
hr(0) = VAL(MID(tm,1,1))
hr(1) = VAL(MID(tm,2,1))
min(0) = VAL(MID(tm,4,1))
min(1) = VAL(MID(tm,5,1))
sec(0) = VAL(MID(tm,7,1))
sec(1) = VAL(MID(tm,8,1))
FOR i = 1 TO hr(0)
CIRCLE (20,50-i*15),5,RGB(255,255,255),,,,F
NEXT i
FOR i = 1 TO hr(1)
CIRCLE (20,230-i*15),5,RGB(255,255,255),,,,F
NEXT i
FOR i = 1 TO min(0)
CIRCLE (50,125-i*15),5,RGB(255,255,255),,,,F
NEXT i
FOR i = 1 TO min(1)
CIRCLE (50,305-i*15),5,RGB(255,255,255),,,,F
NEXT i
FOR i = 1 TO sec(0)
CIRCLE (80,125-i*15),5,RGB(255,255,255),,,,F
NEXT i
FOR i = 1 TO sec(1)
CIRCLE (80,305-i*15),5,RGB(255,255,255),,,,F
NEXT i
DO
ik = INKEY
IF ik = CHR(3) THEN ik = CHR(27)
IF ik = CHR(255,107) THEN ik = CHR(27)
IF ik = CHR(27) THEN EXIT DO
SLEEP 10,1
LOOP WHILE TIME = tm
LOOP UNTIL ik = CHR(27) |
Zuletzt bearbeitet von Key am 16.11.2006, 17:07, insgesamt einmal bearbeitet |
|
| Nach oben |
|
|
volta
Anmeldungsdatum: 04.05.2005
Beiträge: 1876
Wohnort: D59192
|
| Verfasst am: 16.11.2006, 16:55 Titel: |
|
|
Hi Key,
richtig
noch nen TiP:
nehm nur SCREEN 19,32 und lass SCREENSET 1,0 und SCREENCOPY weg.
Und warum geht es so auch?
_________________
Warnung an Choleriker:
Dieser Beitrag kann Spuren von Ironie & Sarkasmus enthalten.
Zu Risiken & Nebenwirkungen fragen Sie Ihren Therapeuten oder Psychiater. |
|
| Nach oben |
|
|
Key
Anmeldungsdatum: 03.10.2006
Beiträge: 95
|
| Verfasst am: 16.11.2006, 17:09 Titel: |
|
|
weil immer eine sekunde gewartet wird bis neu "gezeichnet" wird 
danke |
|
| Nach oben |
|
|
ytwinky
Anmeldungsdatum: 28.05.2005
Beiträge: 2624
Wohnort: Machteburch
|
| Verfasst am: 18.11.2006, 13:03 Titel: |
|
|
Hi,
wie ich bereits androhte, gibt es nun eine Y-Version der Berlin-Uhr von volta
Auschlaggebend war hierbei aber nicht, das Programm von volta zu 'verbessern'.
Dies ist eine freie Programmiersprache und es gibt immer einen anderen Weg
Nein, ich wollte die Uhr aus dem Wikipedia-Artikel nachbauen und da ich bis jetzt
kaum Gelegenheit hatte mit Line.. und Circle.. zu arbeiten, hier bot sich die
Möglichkeit dazu. Ich habe auch einige Sachen ausprobiert, die, wenn sie funktionierten,
natürlich dringeblieben sind
In der Zip-Datei sind außer dem Quellcode noch 2 Icon-Dateien, eine rc-Datei und ein Batch-File,
das eine Exe-Datei erstellen kann. Das alles funktioniert jedoch auch einfach so: | Code: | '"Berlin Uhr" von volta
'http://de.wikipedia.org/wiki/Berlin-Uhr
'in einer 'Y-Version' :D
'funzt mit FB0.16bSE und XPSP2+
Option Escape
Option Explicit
Const Esc="\27", CtrlC="\03", AltF4="\255k" , Lfs="\n\n\n\n\n"
Const weiss=&HFFFFFF, grau=&H909080, gelb=&HFFFF00, rot=&HFF0000, schwarz=&H282828
Dim As Integer i, Stunden, Minuten, mx, my, mb, tx, x, y=104
Dim As String Zeit, ik
ScreenRes 200, 200, 32,, 4
Sub Quader(byRef ti As Long, byVal dif As Long, byVal Farbe As Long, byVal h As Long)
Dim As Integer i
For i=1 To 4
Line (36*i-1, h)-(36*i+31, h+22), IIF(ti>=dif, Farbe, weiss), BF
ti+=dif*(ti>=dif)
Next
End Sub
Color weiss, grau
Cls
Circle(y, 21), 18, schwarz,,, 1, F 'jetz gehts
Line (32, 43)-(178, 71), schwarz, BF '1.Balken
Line (32, 81)-(178, 109), schwarz, BF '2.Balken
Line (32, 119)-(178, 154), schwarz, BF '3.Balken
Line (32, 163)-(178, 191), schwarz, BF '4.Balken
Do
Zeit=Time
Circle(y, 21), 15, IIF(Val(Right(Zeit, 2)) And 1, rot, gelb),,, 1, F 'Sekunden
Stunden=Val(Left(Zeit, 2))
Quader Stunden, 5, gelb, 46
Quader Stunden, 1, rot, 84
Minuten=Val(Mid(Zeit, 4, 2))
For i=1 To 11
Line (13*i+22, y+18)-(13*i+32, y+47), IIF(Minuten>=5, IIF((i Mod 3)=0, rot, gelb), weiss), BF
Minuten+=5*(Minuten>=5)
Next
Quader Minuten, 1, gelb, 166
Do
ik=lcase(Inkey) 'Oder sollte ich lcase GROSS schreiben?
GetMouse mx, my,, mb
Locate 1, 1
If ik="h" Or (mb=1 And mx-8<0 And my-8<0 And Screen(1, 1, 0)=Asc("H")) Then
?"Esc=Ende\n\n1s" &Lfs &"5h" &Lfs &"1h" &Lfs &"5m" &Lfs &"1m"
tx=Timer
End If
If tx+5<Timer Then
?"H=Hilfe \n\n " &Lfs &" " &Lfs &" " &Lfs &" " &Lfs &" "
tx=Timer
End If
Sleep 10, 1
Loop While Time=Zeit And Instr(CtrlC+AltF4+Esc, ik)=0
Loop Until Instr(CtrlC+AltF4+Esc, ik)
End |
..so, und nun viel Spaß damit
[Edit]
..habe das Programm nochmal geändert, wg. 'mußte sein'..
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 |
|
|
volta
Anmeldungsdatum: 04.05.2005
Beiträge: 1876
Wohnort: D59192
|
| Verfasst am: 19.11.2006, 14:54 Titel: |
|
|
Hi ytwinky,
ich hab absolute nichts gegen 'Verbesserungen'
Wie gut man die IIF-Anweisung benutzen kann ist mir vorher nicht aufgefallen.
Ich wollte die Uhr einmal so klein wie es nur geht haben und merkte schnell, dass die Titelzeile dies nicht erlaubte.
Also ein fbgfx-Fenster ohne Titelzeile und das geht, ohne großen Aufwand, nur in FB0.17. | Code: | 'Miniatur "Berlin Uhr" (funktioniert nur in FB0.17)
#include once "windows.bi"
Const breit = 50, hoch = 60, aspekt = 0.9 'der Aspekt ist hier wichtig
Const rot=&HFF0000, gelb=&HFFFF00, swgrau=&H282828
Dim As Integer sekunde, minuten, stunde, x, w, h
Dim As String Tm, Ik
Screeninfo w,h 'Breite und Höhe der Desktops und
Windowtitle "B_uhr" 'den Windowtitel braucht man für SetWindowPos
Screenres breit,hoch,32,,4 Or 8' nur ohne Titelzeile kann man so kleine Fenster erstellen
'Fenster finden und positionieren
SetWindowPos FindWindow( 0, "B_uhr" ), 0, w-breit-2, h-hoch-30, 0, 0, SWP_NOSIZE
Sub kreis (Ti As Integer Ptr, dif As Integer, fa As Integer, h As Integer)
Dim x As Integer
For x = 0 To 3
If *Ti >= dif Then
Circle (7+(12*x),h),4,fa,,,aspekt,F
*Ti-= dif
Else
Circle (7+(12*x),h),4,swgrau,,,aspekt,F
End If
Next
End Sub
Line (0,0)-(breit-1,hoch-1),&H909080 ,BF ' hier besser als CLS
Do
Tm = Time
sekunde = Val(Right(Tm,2))
Circle (25,7),4, Iif(sekunde And 1, swgrau, gelb),,,aspekt,F
stunde = Val(Left(Tm,2))
kreis @stunde,5,rot,17
kreis @stunde,1,rot,27
minuten = Val(Mid(Tm,4,2))
For x = 1 To 11
If minuten >=5 Then
Line (4*x, 35)-((4*x)+2, 45), Iif((x Mod 3)=0, rot, gelb),BF
minuten-=5
Else
Line (4*x, 35)-((4*x)+2, 45),swgrau,BF
End If
Next
kreis @minuten,1,gelb,53
Do
Ik = Inkey 'Tastaturabfrage
If Ik = Chr(3) Then Ik = Chr(27) 'wurde Ctrl+C gedrückt oder
If Ik = Chr(255,107) Then Ik = Chr(27) 'wurde X (Alt+F4) gedrückt
If Ik = Chr(27) Then Exit Do 'oder ESC dann raus hier
Sleep 10,1 'sorgt für etwas CPU Entlastung
Loop While Time = Tm 'bis zur nächsten Änderung die kleine Schleife
Loop Until Ik = Chr(27)
End |
_________________
Warnung an Choleriker:
Dieser Beitrag kann Spuren von Ironie & Sarkasmus enthalten.
Zu Risiken & Nebenwirkungen fragen Sie Ihren Therapeuten oder Psychiater. |
|
| Nach oben |
|
|
ytwinky
Anmeldungsdatum: 28.05.2005
Beiträge: 2624
Wohnort: Machteburch
|
| Verfasst am: 19.11.2006, 16:38 Titel: |
|
|
Hi volta,
..und ich dachte schon, du wärst mir böse 
Btw:
Ich halte IIF() für einen sehr wichtigen Befehl(egal, ob er länger dauert..),
das doppelte IIF habe ich hier zum ersten Mal benutzt(glaub ich..)
Leider kann IIF keine Strings bearbeiten, nur Zahlen..
..aber dabei fällt mir ein: Pointer sind doch auch Zahlen
Schaunwermal..
[Edit]
Dahamwersdoch.. | Code: | Dim As Long i, j, b
Dim As String y, n
y="Yes"
n="No"
Input "Bedingung 1=", b
Input "Dann:", i
Input "Sonst:", j
?IIF(b, i, j)
?IIF(b, i<j, i>j)
?"1=1 ";(1=1)
?"1=0 ";(1=0)
?*IIF(b, @y, @n)
If b Then
?y
Else
?n
End If
?"Datei ";*IIF(b, @"gibt es schon.." , @"fehlt leider :(")
Sleep |
..es eröffnen sich neue Möglichkeiten..
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
