Zitat von siffkowitschWenn man mir bitte erklärt wie ich eine Binäruhr lese gerne ._:
ich bin mal so frech Windows Live Gallery
Zitat von siffkowitschWenn man mir bitte erklärt wie ich eine Binäruhr lese gerne ._:
ich bin mal so frech Windows Live Gallery
soweit geil
habe ja schon die version 1 installiert
er hat gefragt ob er es ersetzten soll ... nur ein vorschlag ... evtl. bei den einstellung kleines vorschaubild wenn man z.b. auf LED klickt daneben die LED zeigen
23 ... Bielefeld ... Sje ... oh je verschwöhrung ...
Aber allles gute ![]()
aber dafür das man innerhalb von 10 min schon ein "Spiel" programmieren kann ist doch schon mal ein erfolgserlebnis ![]()
hier falls es jemand bracht ... nach einer idee vom Galileo Openbook
Public Class Form1
' Index des aktuellen Blocks
Dim B As Integer
' Gesamtes Spielfeld inkl. Randfelder
Dim F(14, 9) As Integer
' Zeile und Spalte des aktuellen Blocks
Dim BZe As Integer
Dim BSp As Integer
' Schwierigkeitsstufe
Dim Stufe As Integer
' Eine zunächst leere Liste von Spiel-Blöcken
Dim Block As New List(Of Panel)
' Ein Feld von Farben für die Blöcke
Dim FarbenFeld() As Color = {Color.Red, _
Color.Yellow, Color.Green, Color.Blue, _
Color.Cyan, Color.Magenta, Color.Black, _
Color.White}
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim Ze, Sp As Integer
' Zufallsgenerator initialisieren
Randomize()
' Feld besetzen
For Ze = 1 To 13
F(Ze, 0) = -2
For Sp = 1 To 8
F(Ze, Sp) = -1
Next Sp
F(Ze, 9) = -2
Next Ze
For Sp = 0 To 9
F(14, Sp) = -2
Next Sp
' Initialisierung
Stufe = 1
NächsterBlock()
End Sub
Private Sub NächsterBlock()
Dim Farbe As Integer
' Neuen Block zum Formular hinzufügen
Block.Add(New Panel)
' Nummer des aktuellen Blocks ermitteln
B = Block.Count - 1
' Neuen Block platzieren
Block(B).Location = New Point(100, 80)
Block(B).Size = New Point(20, 20)
' Farbauswahl für neuen Block
Farbe = Math.Floor(Rnd() * 8)
Block(B).BackColor = FarbenFeld(Farbe)
' Zum Formular hinzufügen
Controls.Add(Block(B))
' Aktuelle Zeile, Spalte
BZe = 1
BSp = 5
End Sub
Private Sub TimT_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles timT.Tick
' Falls es nicht mehr weiter geht
If F(BZe + 1, BSp) <> -1 Then
' Oberste Zeile erreicht
If BZe = 1 Then
timT.Enabled = False
MsgBox("Das war's")
Exit Sub
End If
F(BZe, BSp) = B ' Belegen
ReihePrüfen()
NächsterBlock()
Else
' Falls es noch weiter geht
Block(B).Top = Block(B).Top + 20
BZe = BZe + 1
End If
End Sub
Private Sub ReihePrüfen()
Dim Ze, Sp, ZeX, SpX As Integer
Dim Neben, Über As Boolean
Neben = False
Über = False
' Drei gleiche Steine nebeneinander?
For Ze = 13 To 1 Step -1
For Sp = 1 To 6
' Falls drei Felder nebeneinander besetzt
If F(Ze, Sp) <> -1 And F(Ze, Sp + 1) <> -1 _
And F(Ze, Sp + 2) <> -1 Then
' Falls drei Farben gleich
If Block(F(Ze, Sp)).BackColor = _
Block(F(Ze, Sp + 1)).BackColor _
And Block(F(Ze, Sp)).BackColor = _
Block(F(Ze, Sp + 2)).BackColor Then
For SpX = Sp To Sp + 2
' Block aus dem Formular löschen
Controls.Remove(Block(F(Ze, SpX)))
' Feld leeren
F(Ze, SpX) = -1
' Blöcke oberhalb des entladenen
' Blockes absenken
ZeX = Ze - 1
Do While F(ZeX, SpX) <> -1
Block(F(ZeX, SpX)).Top = _
Block(F(ZeX, SpX)).Top + 20
' Feld neu besetzen
F(ZeX + 1, SpX) = F(ZeX, SpX)
F(ZeX, SpX) = -1
ZeX = ZeX - 1
Loop
Next SpX
Neben = True
End If
End If
If Neben Then Exit For
Next Sp
If Neben Then Exit For
Next Ze
' Drei gleiche Steine übereinander?
For Ze = 13 To 3 Step -1
For Sp = 1 To 8
' Falls drei Felder übereinander besetzt
If F(Ze, Sp) <> -1 And F(Ze - 1, Sp) <> -1 _
And F(Ze - 2, Sp) <> -1 Then
' Falls drei Farben gleich
If Block(F(Ze, Sp)).BackColor = _
Block(F(Ze - 1, Sp)).BackColor _
And Block(F(Ze, Sp)).BackColor = _
Block(F(Ze - 2, Sp)).BackColor Then
' 3 Blöcke entladen
For ZeX = Ze To Ze - 2 Step -1
' Block aus dem Formular löschen
Controls.Remove(Block(F(ZeX, Sp)))
' Feld leeren
F(ZeX, Sp) = -1
Next ZeX
Über = True
End If
End If
If Über Then Exit For
Next Sp
If Über Then Exit For
Next Ze
If Neben Or Über Then
' Schneller
Stufe = Stufe + 1
timT.Interval = 5000 / (Stufe + 9)
' Eventuell kann jetzt noch eine Reihe
' entfernt werden
ReihePrüfen()
End If
End Sub
Private Sub cmdLinks_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdLinks.Click
If F(BZe, BSp - 1) = -1 Then
Block(B).Left = Block(B).Left - 20
BSp = BSp - 1
End If
End Sub
Private Sub cmdRechts_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdRechts.Click
If F(BZe, BSp + 1) = -1 Then
Block(B).Left = Block(B).Left + 20
BSp = BSp + 1
End If
End Sub
Private Sub cmdUnten_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdUnten.Click
Do While F(BZe + 1, BSp) = -1
Block(B).Top = Block(B).Top + 20
BZe = BZe + 1
Loop
F(BZe, BSp) = B 'Belegen
ReihePrüfen()
NächsterBlock()
End Sub
Private Sub cmdPause_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdPause.Click
timT.Enabled = Not timT.Enabled
End Sub
Private Sub cmdEnde_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdEnde.Click
' Beenden mit Rückfrage
If MsgBox("Wollen Sie das Programm wirklich " _
& "beenden?", MsgBoxStyle.YesNo, _
"ColorBlocks") = MsgBoxResult.Yes Then
Me.Close()
End If
End Sub
Private Sub cmdInfo_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdInfo.Click
' Beenden mit Rückfrage
MsgBox("Stapeln Sie 3 frabige Blöckr übereinander." & vbCrLf _
& "Taste A bewegt den Block nach links, " & vbCrLf _
& "Taste D bewegt den Block nach rechts, " & vbCrLf _
& "Taste S bewegt den Block nach unten, " & vbCrLf _
& "Taste P ... Pause ;), " & vbCrLf _
& "Taste E ... Programmende mit Abfrage," & vbCrLf _
& "Taste I ... Dieses nervige Info Fenster," & vbCrLf _
& "Programm ist noch Buggy ;)" & vbCrLf _
& "MfG Quasi" & vbCrLf _
& "Programm entstand in einer Nachmittags - langeweile", , "ColorBlocks")
End Sub
End Class
Alles anzeigen
und natürlich die fertige Echse
Index of /proggies
wenn du vorher alles auf standard treiber setzt reicht ne rep install ... aber ne neu install ist immer besser
An den der genauso heisst wie ich Alles Gute und möge die Weltherrschafft mit dir sein ...
Büroklammer geht auch
grün und schwarz kurzschliessen ... sollte dann angehen ...Pin 14 (grün) mit Pin 13 oder 15 oder 16 oder 17 kurzschliessen wenns dann nicht angeht ist es tot ... gehts an kann es trotzdem defekt sein weil man so keine last testet
so das mit sp2 ist jetzt draussen
gut dirk meinte auch schon er würde das mit dem sp2 auch weglassen ... hmm schmeisse ich also noch raus
jo einige wissen es ja ich sitze an einem Update für Dirk's Seite.
hier mal ein entwurf guckt mal bitte nach rechtschreibfehler und lesbarkeit des artikels.
Ja ich weiss das da am anfang und ende fehler sind das er was nicht finden kann. ist aber normal
*hier war der link* <- habe ich offline gestellt
ach was solls ... ich will jetzt keinen flame thread ... aber meint ihr nicht das das alles übertrieben wird die speichern das sowieso schon lange ....nicht erst seit heute
normal ... hatte ich auch
so hier mal ein Desktop den ich gerade gemacht habe ... ich arbeite gerade an der neugestaltung der seite von windows 2008 server für dirk ![]()
hier mal meiner ... bin bissel am basteln
hmm naja man gönnt sich ja sonst nix
... ne ist ein Bug ...den sollte man evtl mal an ms schicken
nur wie?
So jetzt mit Aero ![]()
so hier meiner ![]()