|
Badges
Aug 29, 2009 15:18:05 GMT -5
Post by xShadowLordx on Aug 29, 2009 15:18:05 GMT -5
Oh. Well, they look pretty much the same to me, so I think you might as well just use the font since it's easier.
|
|
|
Badges
Sept 11, 2009 15:34:28 GMT -5
Post by artcoursecannon on Sept 11, 2009 15:34:28 GMT -5
I think I've earned my HELP badge (And my midnight post badge!). This one Dan Ball website member (ghako) was giving away one of his very good upload codes via email. He was unaware of this forum and the fact that he could sell his upload code for DanBalls. So I emailedd him with a somewhat brief overview of all the forum threads and topics and whatnot.
|
|
|
Badges
Feb 21, 2010 14:54:31 GMT -5
Post by microfarad on Feb 21, 2010 14:54:31 GMT -5
Oooooo, the Haxor badge definitely suits me. I think I've earned that fair and square (and mind you with great dificulty over many years). CLICK TO SEE MY CODE Public Class Form1 Dim enterKey As String Dim entertext As String Const Length As Integer = 32 Const Num As Integer = 1 Dim OpCodes(Length) As String Dim Modifiers(Length) As String Dim AFieldMods(Length) As String Dim AFieldValues(Length) As Integer Dim BFieldMods(Length) As String Dim BFieldValues(Length) As Integer Dim Threads(Length, Num) As Integer Dim PSpace(Length, Num) As Integer Dim LastChangedBy(Length) As Integer Dim UpperThread(Num) As Integer Dim CurrentThread(Num) As Integer Dim ProgramAlive(Num) As Boolean Dim CurrentProgram As Integer Dim CurrentAddress As Integer Dim PrePrograms(Num) As String Dim Lengths(Num) As Integer Dim Codes(Num) As String Dim Number As Integer = 1 Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load entertext = IO.File.ReadAllText("C:/vb/entertext.txt") enterKey = TextBox1.Text TextBox1.Text = "" Reset() End Sub
' THESE SUBROUTINES PROVIDE WAYS TO NORMALIZE THE VARABLES Sub Reset() For n = 1 To Length For x = 1 To Num Threads(n, x) = 0 UpperThread(x) = 1 PSpace(n, x) = 0 ProgramAlive(x) = False Next OpCodes(n) = "DAT" Modifiers(n) = "$" AFieldMods(n) = "#" BFieldMods(n) = "#" AFieldValues(n) = 0 BFieldValues(n) = 0 Next Setup() End Sub Sub Setup() For n = 1 To Num CurrentProgram = n CurrentThread(CurrentProgram) = 1 UpperThread(CurrentProgram) = 1 Threads(1, CurrentProgram) = 1 Next CurrentThread(0) = 1 CurrentProgram = 1 CurrentAddress = 1 Display2() End Sub 'THESE SUBROUTINES ARE THE MAIN GUTS OF THE PROGRAM Sub StepSimulation() Dim hold As Integer For n = 1 To Num If ProgramAlive(n) = True Then CurrentProgram = n hold = FindNextThread() CurrentThread(CurrentProgram) = hold CurrentThread(0) = hold CurrentAddress = Threads(CurrentThread(0), CurrentProgram) SolveInstruction() Threads(CurrentThread(0), CurrentProgram) = FitInsideRange(Threads(CurrentThread(0), CurrentProgram) + 1) End If Next Display2() End Sub Sub SolveInstruction() ' Decide the address of the instruction to solve given the current program and thread CurrentAddress = Threads(CurrentThread(0), CurrentProgram) ' Outscource the solving to the appropriate OpCode handler If OpCodes(CurrentAddress) = "DAT" Then DAT() 'Data ElseIf OpCodes(CurrentAddress) = "ADD" Then ADD() 'Add ElseIf OpCodes(CurrentAddress) = "SUB" Then SUBt() 'Subtract ElseIf OpCodes(CurrentAddress) = "MUL" Then MUL() 'multiply ElseIf OpCodes(CurrentAddress) = "DIV" Then DIV() 'Divide ElseIf OpCodes(CurrentAddress) = "JMP" Then JMP() 'Jump ElseIf OpCodes(CurrentAddress) = "SEQ" Then SEQ() 'Skip if equal ElseIf OpCodes(CurrentAddress) = "SNE" Then SNE() 'Skip if not equal ElseIf OpCodes(CurrentAddress) = "SLT" Then SLT() 'Skip if lower than ElseIf OpCodes(CurrentAddress) = "SGT" Then SGT() 'Skip if greater than ElseIf OpCodes(CurrentAddress) = "SPL" Then SPL() 'Split ElseIf OpCodes(CurrentAddress) = "LPS" Then LPS() 'Load from p space ElseIf OpCodes(CurrentAddress) = "SPS" Then SPS() 'Save to p space ElseIf OpCodes(CurrentAddress) = "CPY" Then CPY() 'Copy Else End If End Sub 'Operators Sub DAT() DeleteCurrentThread() End Sub Sub ADD() If Modifiers(CurrentAddress) = "A" Then AFieldValues(GetNum(2)) = FitInsideRange(AFieldValues(GetNum(2)) + GetNum(1)) ElseIf Modifiers(CurrentAddress) = "B" Then BFieldValues(GetNum(2)) = FitInsideRange(BFieldValues(GetNum(2)) + GetNum(1)) Else AFieldValues(GetNum(2)) = FitInsideRange(AFieldValues(GetNum(2)) + GetNum(1)) End If Changed(GetNum(2)) End Sub Sub SUBt() If Modifiers(CurrentAddress) = "A" Then AFieldValues(GetNum(2)) = FitInsideRange(AFieldValues(GetNum(2)) - GetNum(1)) ElseIf Modifiers(CurrentAddress) = "B" Then BFieldValues(GetNum(2)) = FitInsideRange(BFieldValues(GetNum(2)) - GetNum(1)) Else AFieldValues(GetNum(2)) = FitInsideRange(AFieldValues(GetNum(2)) - GetNum(1)) End If Changed(GetNum(2)) End Sub Sub MUL() If Modifiers(CurrentAddress) = "A" Then AFieldValues(GetNum(2)) = FitInsideRange(AFieldValues(GetNum(2)) * GetNum(1)) ElseIf Modifiers(CurrentAddress) = "B" Then BFieldValues(GetNum(2)) = FitInsideRange(BFieldValues(GetNum(2)) * GetNum(1)) Else AFieldValues(GetNum(2)) = FitInsideRange(AFieldValues(GetNum(2)) * GetNum(1)) End If Changed(GetNum(2)) End Sub Sub DIV() Try Catch If Modifiers(CurrentAddress) = "A" Then AFieldValues(GetNum(2)) = FitInsideRange(GetNum(1) / AFieldValues(GetNum(2))) ElseIf Modifiers(CurrentAddress) = "B" Then BFieldValues(GetNum(2)) = FitInsideRange(GetNum(1) / BFieldValues(GetNum(2))) Else AFieldValues(GetNum(2)) = FitInsideRange(GetNum(1) / AFieldValues(GetNum(2))) End If Changed(GetNum(2)) End Try End Sub Sub JMP() Threads(CurrentThread(0), CurrentProgram) = FitInsideRange(CurrentAddress + GetNum(1) - 1) End Sub Sub SEQ() If GetNum(1) = GetNum(2) Then Threads(CurrentThread(0), CurrentProgram) = FitInsideRange(CurrentAddress + 1) End If End Sub Sub SNE() If GetNum(1) = GetNum(2) - CurrentAddress Then Else Threads(CurrentThread(0), CurrentProgram) = FitInsideRange(CurrentAddress + 1) End If End Sub Sub SLT() If GetNum(1) < GetNum(2) - CurrentAddress Then Threads(CurrentThread(0), CurrentProgram) = FitInsideRange(CurrentAddress + 1) End If End Sub Sub SGT() If GetNum(1) > GetNum(2) - CurrentAddress Then Threads(CurrentThread(0), CurrentProgram) = FitInsideRange(CurrentAddress + 1) End If End Sub Sub SPL() Threads(CurrentThread(0), CurrentProgram) = FitInsideRange(CurrentAddress + GetNum(1) - 1) AddThread(FitInsideRange(GetNum(2))) End Sub Sub LPS() If Modifiers(CurrentAddress) = "A" Then AFieldValues(GetNum(2)) = PSpace(GetNum(1), CurrentProgram) ElseIf Modifiers(CurrentAddress) = "B" Then BFieldValues(GetNum(2)) = PSpace(GetNum(1), CurrentProgram) Else AFieldValues(GetNum(2)) = PSpace(GetNum(1), CurrentProgram) End If Changed(GetNum(2)) End Sub Sub SPS() PSpace(GetNum(2) - CurrentAddress, CurrentProgram) = GetNum(1) End Sub Sub CPY() If Modifiers(CurrentAddress) = "A" Then AFieldValues(GetNum(2)) = GetNum(1) ElseIf Modifiers(CurrentAddress) = "B" Then BFieldValues(GetNum(2)) = GetNum(1) ElseIf Modifiers(CurrentAddress) = "C" Then AFieldValues(GetNum(2)) = AFieldValues(FitInsideRange(GetNum(1) + CurrentAddress)) AFieldMods(GetNum(2)) = AFieldMods(FitInsideRange(GetNum(1) + CurrentAddress)) BFieldValues(GetNum(2)) = BFieldValues(FitInsideRange(GetNum(1) + CurrentAddress)) BFieldMods(GetNum(2)) = BFieldMods(FitInsideRange(GetNum(1) + CurrentAddress)) OpCodes(GetNum(2)) = OpCodes(FitInsideRange(GetNum(1) + CurrentAddress)) Modifiers(GetNum(2)) = Modifiers(FitInsideRange(GetNum(1) + CurrentAddress)) Else AFieldValues(GetNum(2)) = GetNum(1) End If Changed(GetNum(2)) End Sub 'Useful functions Function GetNum(ByVal Field As Integer) As Integer Dim Value As Integer Dim Modifier As String If Field = 1 Then Value = AFieldValues(CurrentAddress) Modifier = AFieldMods(CurrentAddress) ElseIf Field = 2 Then Value = BFieldValues(CurrentAddress) Modifier = BFieldMods(CurrentAddress) GetNum = CurrentAddress Else Modifier = "It's Really Stupid But I Have To Put This In To Avoid A Green Line!" End If If Modifier = "A" Then GetNum = FitInsideRange(GetNum + AFieldValues(FitInsideRange(CurrentAddress + Value))) ElseIf Modifier = "B" Then GetNum = FitInsideRange(GetNum + BFieldValues(FitInsideRange(CurrentAddress + Value))) Else GetNum = FitInsideRange(GetNum + Value) End If End Function Function FitInsideRange(ByVal value As Integer) As Integer FitInsideRange = value Begining: If FitInsideRange > Length Then FitInsideRange = FitInsideRange - Length ElseIf FitInsideRange < 0 Then FitInsideRange = FitInsideRange + Length Else GoTo SkipReturn End If GoTo Begining SkipReturn: End Function Function FindNextThread() As Integer If CurrentThread(CurrentProgram) = UpperThread(CurrentProgram) Then FindNextThread = 1 Else FindNextThread = CurrentThread(CurrentProgram) + 1 End If End Function Sub AddThread(ByVal Location As Integer) If UpperThread(CurrentProgram) < Length Then Threads(UpperThread(CurrentProgram) + 1, CurrentProgram) = Location UpperThread(CurrentProgram) = UpperThread(CurrentProgram) + 1 End If End Sub Sub DeleteCurrentThread() Dim HeadCount As Integer Dim Living As Integer For n = CurrentThread(0) + 1 To UpperThread(CurrentProgram) Threads(n - 1, CurrentProgram) = Threads(n, CurrentProgram) Next UpperThread(CurrentProgram) = UpperThread(CurrentProgram) - 1 CurrentThread(CurrentProgram) = CurrentThread(CurrentProgram) = -1 If UpperThread(CurrentProgram) = 0 Then ProgramAlive(CurrentProgram) = False End If For n = 1 To Num If ProgramAlive(n) = True Then HeadCount = HeadCount + 1 Living = n End If Next If HeadCount = 1 Then Timer1.Stop() TextBox2.Text = "Program " & Living & " Wins" Button3.Text = "Start" End If End Sub Sub Changed(ByVal RelativeLocation As Integer) LastChangedBy(FitInsideRange(RelativeLocation + CurrentAddress)) = CurrentProgram End Sub 'THE FOLLOWING CODE IS FOR HUMAN INTERFACE 'displays are tricky, that is why there are several versions Sub Display() Dim AValues As String Dim BValues As String TextBox1.Text = "" For n = 1 To 100 AValues = AFieldValues(n) BValues = BFieldValues(n) TextBox1.Text = TextBox1.Text + OpCodes(n) + "." + Modifiers(n) + " " + AFieldMods(n) + AValues + "," + BFieldMods(n) + BValues TextBox1.Text = TextBox1.Text + enterKey Next End Sub Sub Display2() Dim AValues As String Dim BValues As String Dim hold As String hold = "" For n = 1 To Length AValues = AFieldValues(n) BValues = BFieldValues(n) hold = hold + OpCodes(n) + "." + Modifiers(n) + " " + AFieldMods(n) + AValues + "," + BFieldMods(n) + BValues For x = 1 To Num For y = 1 To Length If Threads(y, x) = n Then If y < UpperThread(x) + 1 Then hold = hold + " " hold = hold & x hold = hold + "," hold = hold & y End If End If Next Next hold = hold + entertext Next TextBox2.Text = hold End Sub
Sub Clean(ByVal Code As String, ByVal Place As Integer) Dim HierA(Length) As String Dim HierB(2, Length) As String Dim hold(2) As String Dim Labels(Length) As String Dim Data(Length) As String Dim shold(Length) As String 'Form should be like this 'START '(OpCode).(OpCodeModifier $AB) (AFieldModifier #AB)(AFieldValue or "@Label"),(BField same as A) :(Label) 'END Place = Place Code = Mid(Code, Find(Code, "START") + 7, Find(Code, "END") - Find(Code, "START") - 9) Code = Replace(Code, entertext, ";") HierA = Code.Split(";").Clone For a = 0 To Length If a < HierA.Count Then hold = HierA(a).Split(":") Labels(a) = hold(1) Data(a) = Mid(hold(0), 1, hold(0).Length - 1) End If Next For n = 0 To Length If Data(n) = "" Then GoTo leave Else OpCodes(FitInsideRange(n + Place)) = Mid(Data(n), 1, 3) Modifiers(FitInsideRange(n + Place)) = Mid(Data(n), 5, 1) hold = Mid(Data(n), 7).Split(",").Clone If Mid(hold(0), 2, 1) = "@" Then For a = 0 To Length If "#@" + Labels(a) = hold(0) Then AFieldValues(FitInsideRange(n + Place)) = FitInsideRange(a - n) End If Next Else AFieldValues(FitInsideRange(n + Place)) = TtoI(Mid(hold(0), 2)) End If If Mid(hold(1), 2, 1) = "@" Then For a = 0 To Length If "#@" + Labels(a) = hold(1) Then BFieldValues(FitInsideRange(n + Place)) = FitInsideRange(a - n) End If Next Else BFieldValues(FitInsideRange(n + Place)) = TtoI(Mid(hold(1), 2)) End If AFieldMods(FitInsideRange(n + Place)) = Mid(hold(0), 1, 1) BFieldMods(FitInsideRange(n + Place)) = Mid(hold(1), 1, 1) End If Next leave: ProgramAlive(Number) = True Threads(1, Number) = Place Display2() End Sub Function Find(ByVal Text As String, ByVal Piece As String) As Integer Find = 0 For n = 1 To Text.Length - Piece.Length + 1 If Mid(Text, n, Piece.Length) = Piece Then Find = n GoTo ending End If Next ending: End Function Function TtoI(ByVal text As String) As Integer Dim hold As Integer For n = 1 To text.Length If Mid(text, n, 1) = "0" Then hold = 0 ElseIf Mid(text, n, 1) = "1" Then hold = 1 ElseIf Mid(text, n, 1) = "2" Then hold = 2 ElseIf Mid(text, n, 1) = "3" Then hold = 3 ElseIf Mid(text, n, 1) = "4" Then hold = 4 ElseIf Mid(text, n, 1) = "5" Then hold = 5 ElseIf Mid(text, n, 1) = "6" Then hold = 6 ElseIf Mid(text, n, 1) = "7" Then hold = 7 ElseIf Mid(text, n, 1) = "8" Then hold = 8 ElseIf Mid(text, n, 1) = "9" Then hold = 9 End If TtoI = TtoI + ((10 ^ (text.Length - n)) * hold) Next End Function Sub SetLength(ByVal Code As String, ByVal Program As Integer) Code = Mid(Code, Find(Code, "START") + 7, Find(Code, "END") - Find(Code, "START") - 9) Code = Replace(Code, entertext, ";") Lengths(Program) = Code.Split(";").Length End Sub
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick StepSimulation() End Sub
Private Sub ListBox1_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ListBox1.SelectedIndexChanged End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click OpenFileDialog1.ShowDialog() End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click ListBox1.Items.Remove(ListBox1.Items.Item(ListBox1.SelectedIndex)) If ListBox1.SelectedIndex < ListBox1.Items.Count - 1 Then For n = ListBox1.SelectedIndex To ListBox1.Items.Count - 2 Codes(n) = Codes(n + 1) Next End If Codes(ListBox1.Items.Count) = "" End Sub
Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click If Button3.Text = "Start" Then Timer1.Start() Button3.Text = "Stop" Else Timer1.Stop() Button3.Text = "Start" End If End Sub
Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click StepSimulation() End Sub
Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click Reset() Number = 1 For n = 1 To ListBox1.Items.Count If Codes(n).Split(entertext).Count() < Length / ListBox1.Items.Count Then Clean(Codes(n), FitInsideRange(Length / ListBox1.Items.Count * n)) Number = Number + 1 End If Next
End Sub
Private Sub OpenFileDialog1_FileOk(ByVal sender As System.Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles OpenFileDialog1.FileOk ListBox1.Items.Add(TextBox1.Text) TextBox1.Text = "" Codes(ListBox1.Items.Count) = IO.File.ReadAllText(OpenFileDialog1.FileName) End Sub
Private Sub Button6_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button6.Click ListBox1.Items.Clear() Reset() End Sub End Class
That is visual basic. I can also do some HTML Sooo, is that Haxor badge worthy? -Micro Farad
|
|
|
Badges
Feb 21, 2010 20:29:27 GMT -5
Post by Qwerty on Feb 21, 2010 20:29:27 GMT -5
Alrighty, take the badge.
|
|
|
Badges
Apr 25, 2010 11:00:09 GMT -5
Post by microfarad on Apr 25, 2010 11:00:09 GMT -5
Am I worthy of the Active badge? Also, I'm a chat mod, so can I take that one too?
|
|
|
Badges
Apr 25, 2010 12:43:53 GMT -5
Post by GGoodie on Apr 25, 2010 12:43:53 GMT -5
Yeah go ahead.
|
|
|
Badges
Apr 25, 2010 15:25:22 GMT -5
Post by Qwerty on Apr 25, 2010 15:25:22 GMT -5
Indeed, you are active and a chat mod. And it's not too hard to be a Nonja.
|
|
|
Badges
May 6, 2010 7:31:39 GMT -5
Post by nmagain on May 6, 2010 7:31:39 GMT -5
I know i deserve the veteran badge :3
|
|
|
Badges
May 12, 2010 18:09:33 GMT -5
Post by Qwerty on May 12, 2010 18:09:33 GMT -5
Check, and check.
|
|
|
Badges
May 12, 2010 18:40:29 GMT -5
Post by ownedbyglove on May 12, 2010 18:40:29 GMT -5
Do I get any badges? I don't really know what, but... meh.
|
|
|
Badges
May 12, 2010 19:27:05 GMT -5
Post by Qwerty on May 12, 2010 19:27:05 GMT -5
Well, active and soon to be Nonja for sure. Maybe others.
|
|
|
Badges
May 12, 2010 22:28:33 GMT -5
Post by ownedbyglove on May 12, 2010 22:28:33 GMT -5
yay! active! Can I have it now?
|
|
|
Badges
May 13, 2010 9:14:04 GMT -5
Post by Qwerty on May 13, 2010 9:14:04 GMT -5
Sure, just stick it in whenever.
|
|
|
Badges
May 13, 2010 17:53:49 GMT -5
Post by ownedbyglove on May 13, 2010 17:53:49 GMT -5
where do I get it?
|
|
|
Badges
May 14, 2010 0:05:24 GMT -5
Post by Qwerty on May 14, 2010 0:05:24 GMT -5
Over at the badge list.
|
|
|
Badges
May 14, 2010 0:48:28 GMT -5
Post by nmagain on May 14, 2010 0:48:28 GMT -5
Yes! 6 badges in a row one each day!
|
|
Lag
Site Owner
{S=0}[M:20994]
Posts: 136
|
Badges
May 14, 2010 21:46:11 GMT -5
Post by Lag on May 14, 2010 21:46:11 GMT -5
Good job!
|
|
|
Badges
May 15, 2010 7:53:51 GMT -5
Post by ~Memzak~ on May 15, 2010 7:53:51 GMT -5
Indeed it is. You might one day catch up to me... ^.^
|
|
|
Badges
May 16, 2010 14:19:21 GMT -5
Post by Qwerty on May 16, 2010 14:19:21 GMT -5
Or maybe even me.
And Memzak, I just noticed you only have 19 official badges...
|
|
|
Badges
May 16, 2010 19:39:08 GMT -5
Post by General Veers on May 16, 2010 19:39:08 GMT -5
No, he has 20.
|
|