Fichier #imcctz28-3492 - VBNET - Code source

Téléchargé par un utilisateur anonyme - 29/07/2010 22:25 - 65 affichages
Code source 
  1. Public Class MuDB
  2.     Const LineBreak = Microsoft.VisualBasic.vbCrLf
  3.     Dim conn As New SqlCeConnection("Data Source=mudb.sdf")
  4.     Dim cmd As New SqlCeCommand
  5.     Dim Arr As New System.Collections.ArrayList
  6.     Dim F1 As New Font("Microsoft Sans Serif", 8, FontStyle.Regular, GraphicsUnit.Point)
  7.     Dim F2 As New Font("Microsoft Sans Serif", 8, FontStyle.Bold, GraphicsUnit.Point)
  8.     Dim Tab As Byte = 1
  9.     Dim TT0, TT1, TT2, TT3, TT4, TT5, TT6, TT7, TT8, TT9 As New ToolTip
  10.  
  11.     Private Function ByteToImage(ByVal myByteArray As Byte()) As Image
  12.         Dim myImage As Image
  13.         Using ms As System.IO.MemoryStream = New System.IO.MemoryStream(myByteArray, 0, myByteArray.Length)
  14.             ms.Write(myByteArray, 0, myByteArray.Length)
  15.             myImage = Image.FromStream(ms, True)
  16.         End Using
  17.         Return myImage
  18.     End Function
  19.  
  20.     Private Sub ListBox1_ItemsClick() Handles ListBox1.Click
  21.         If ListBox1.SelectedItem > "" Then
  22.             cmd = New SqlCeCommand("SELECT * FROM " & TabControl1.SelectedTab.Name & " WHERE Name=@name", conn)
  23.             cmd.Parameters.AddWithValue("@name", ListBox1.SelectedItem.ToString)
  24.             Using da As New SqlCeDataAdapter()
  25.                 Using ds As New DataSet()
  26.                     conn.Open()
  27.                     da.SelectCommand = cmd
  28.                     da.Fill(ds, "table")
  29.                     conn.Close()
  30.                     PictureBox1.Image = ByteToImage(ds.Tables("table").Rows(0).Item(1))
  31.                     'Filling Classes
  32.                     Dim L As Label()
  33.                     Dim T As Byte
  34.                     Select Case Tab
  35.                         Case 3
  36.                             T = 8
  37.                         Case Else
  38.                             T = 10
  39.                     End Select
  40.                     L = New Label() {DK, BK, BM, DW, SM, GM, FE, ME1, HE, S, BS, DiM1, MG, DuM, DL, LE}
  41.                     For i As Byte = 0 To 15
  42.                         If ds.Tables("table").Rows(0).Item(T + i) = True Then
  43.                             L(i).Font = F2
  44.                             L(i).ForeColor = SystemColors.ControlText
  45.                         Else
  46.                             L(i).Font = F1
  47.                             L(i).ForeColor = SystemColors.ControlDark
  48.                         End If
  49.                     Next i
  50.                     'Filling Resistance, Socket and BOK
  51.                     Select Case Tab
  52.                         Case 2
  53.                             If ds.Tables("table").Rows(0).Item(9) Then
  54.                                 Socket.Font = F2
  55.                                 Socket.ForeColor = SystemColors.ControlText
  56.                             Else
  57.                                 Socket.Font = F1
  58.                                 Socket.ForeColor = SystemColors.ControlDark
  59.                             End If
  60.                             If ds.Tables("table").Rows(0).Item(26) Then
  61.                                 Drop.Font = F2
  62.                                 Drop.ForeColor = SystemColors.ControlText
  63.                                 Drop.Text = "Drops from BOK +" & ds.Tables("table").Rows(0).Item(26)
  64.                             Else
  65.                                 Drop.Font = F1
  66.                                 Drop.ForeColor = SystemColors.ControlDark
  67.                                 Drop.Text = "Drops from BOK"
  68.                             End If
  69.                         Case Else
  70.                             If ds.Tables("table").Rows(0).Item(8 - Tab) Then
  71.                                 Drop.Font = F2
  72.                                 Drop.ForeColor = SystemColors.ControlText
  73.                                 Drop.Text = "Drops from BOK +" & ds.Tables("table").Rows(0).Item(8 - Tab)
  74.                             Else
  75.                                 Drop.Font = F1
  76.                                 Drop.ForeColor = SystemColors.ControlDark
  77.                                 Drop.Text = "Drops from BOK"
  78.                             End If
  79.                             If ds.Tables("table").Rows(0).Item(9 - Tab) Then
  80.                                 Socket.Font = F2
  81.                                 Socket.ForeColor = SystemColors.ControlText
  82.                             Else
  83.                                 Socket.Font = F1
  84.                                 Socket.ForeColor = SystemColors.ControlDark
  85.                             End If
  86.                             If ds.Tables("table").Rows(0).Item(10 - Tab) Then
  87.                                 Resist.Font = F2
  88.                                 Resist.ForeColor = SystemColors.ControlText
  89.                             Else
  90.                                 Resist.Font = F1
  91.                                 Resist.ForeColor = SystemColors.ControlDark
  92.                             End If
  93.                     End Select
  94.                     'Filling Statistics
  95.                     Select Case Tab
  96.                         Case 1
  97.                             cmd = New SqlCeCommand("SELECT * FROM set_items WHERE ID IN " & _
  98.                                 "(SELECT ArmorID FROM sets WHERE Name=@name UNION " & _
  99.                                 "SELECT GlovesID FROM sets WHERE Name=@name UNION " & _
  100.                                 "SELECT PantsID FROM sets WHERE Name=@name UNION " & _
  101.                                 "SELECT BootsID FROM sets WHERE Name=@name UNION " & _
  102.                                 "SELECT HelmID FROM sets WHERE Name=@name)", conn)
  103.                             cmd.Parameters.AddWithValue("@name", ListBox1.SelectedItem.ToString)
  104.                             conn.Open()
  105.                             da.SelectCommand = cmd
  106.                             da.Fill(ds, "sets")
  107.                             conn.Close()
  108.                             Sets_Fill(ds.Tables("sets"), ds.Tables("sets").Rows.Count)
  109.                         Case 2
  110.                             Weapons_Fill(ds.Tables("table").Rows(0))
  111.                         Case Else
  112.                             Shields_Fill(ds.Tables("table").Rows(0))
  113.                     End Select
  114.                 End Using
  115.             End Using
  116.         End If
  117.     End Sub
  118.  
  119.     Private Sub Sets_Fill(ByVal Table As DataTable, ByVal N As Byte)
  120.         Dim Cache1, Cache2 As String
  121.         'This MUST be included in For ... Next
  122.         ADef.Text = Table.Rows(N - 4).Item(1)
  123.         AEDef.Text = Table.Rows(N - 4).Item(2)
  124.         Cache1 = Sets_Calc(ADef.Text)
  125.         Cache2 = Sets_Calc(AEDef.Text)
  126.         TT0.SetToolTip(ADef, Cache1)
  127.         TT1.SetToolTip(AEDef, Cache2)
  128.  
  129.         GDef.Text = Table.Rows(N - 3).Item(1)
  130.         If GDef.Text = ADef.Text Then
  131.             TT2.SetToolTip(GDef, Cache1)
  132.         Else
  133.             TT2.SetToolTip(GDef, Sets_Calc(GDef.Text))
  134.         End If
  135.  
  136.         GEDef.Text = Table.Rows(N - 3).Item(2)
  137.         If GEDef.Text = AEDef.Text Then
  138.             TT3.SetToolTip(GEDef, Cache2)
  139.         Else
  140.             TT3.SetToolTip(GEDef, Sets_Calc(GEDef.Text))
  141.         End If
  142.  
  143.         PDef.Text = Table.Rows(N - 2).Item(1)
  144.         If PDef.Text = ADef.Text Then
  145.             TT4.SetToolTip(PDef, Cache1)
  146.         Else
  147.             TT4.SetToolTip(PDef, Sets_Calc(PDef.Text))
  148.         End If
  149.  
  150.         PEDef.Text = Table.Rows(N - 2).Item(2)
  151.         If PEDef.Text = AEDef.Text Then
  152.             TT5.SetToolTip(PEDef, Cache2)
  153.         Else
  154.             TT5.SetToolTip(PEDef, Sets_Calc(PEDef.Text))
  155.         End If
  156.  
  157.         BDef.Text = Table.Rows(N - 1).Item(1)
  158.         If BDef.Text = ADef.Text Then
  159.             TT6.SetToolTip(BDef, Cache1)
  160.         Else
  161.             TT6.SetToolTip(BDef, Sets_Calc(BDef.Text))
  162.         End If
  163.  
  164.         BEDef.Text = Table.Rows(N - 1).Item(2)
  165.         If BEDef.Text = AEDef.Text Then
  166.             TT7.SetToolTip(BEDef, Cache2)
  167.         Else
  168.             TT7.SetToolTip(BEDef, Sets_Calc(BEDef.Text))
  169.         End If
  170.  
  171.         If N = 5 Then
  172.             HDef.Text = Table.Rows(0).Item(1)
  173.             If HDef.Text = ADef.Text Then
  174.                 TT8.SetToolTip(HDef, Cache1)
  175.             Else
  176.                 TT8.SetToolTip(HDef, Sets_Calc(HDef.Text))
  177.             End If
  178.  
  179.             HEDef.Text = Table.Rows(0).Item(2)
  180.             If HEDef.Text = AEDef.Text Then
  181.                 TT9.SetToolTip(HEDef, Cache2)
  182.             Else
  183.                 TT9.SetToolTip(HEDef, Sets_Calc(HEDef.Text))
  184.             End If
  185.         Else
  186.             HDef.Text = ""
  187.             TT8.SetToolTip(HDef, "")
  188.             HEDef.Text = ""
  189.             TT9.SetToolTip(HEDef, "")
  190.         End If
  191.     End Sub
  192.  
  193.     Private Sub Weapons_Fill(ByVal Row As DataRow)
  194.         'Bad style, better to make variables for Row.Item
  195.         'Anyway, I must optimize it
  196.         SDmg.Text = Row.Item(2) & "-" & Row.Item(3)
  197.         TT0.SetToolTip(SDmg, Weapons_Calc(Row.Item(2), Row.Item(3)))
  198.         EDmg.Text = Row.Item(4) & "-" & Row.Item(5)
  199.         TT1.SetToolTip(EDmg, Weapons_Calc(Row.Item(4), Row.Item(5)))
  200.         Spd.Text = Row.Item(8)
  201.         SWiz.Text = Row.Item(6) & "%"
  202.         TT2.SetToolTip(SWiz, Wiz_Calc(Row.Item(6)))
  203.         EWiz.Text = Row.Item(27) & "%"
  204.         TT3.SetToolTip(EWiz, Wiz_Calc(Row.Item(27)))
  205.         SPet.Text = Row.Item(7) & "%"
  206.         TT4.SetToolTip(SPet, Pet_Calc(Row.Item(7), Row.Item(29)))
  207.         EPet.Text = Row.Item(28) & "%"
  208.         TT5.SetToolTip(EPet, Pet_Calc(Row.Item(28), Row.Item(29)))
  209.     End Sub
  210.  
  211.     Private Sub Shields_Fill(ByVal Row As DataRow)
  212.         Def.Text = Row.Item(2)
  213.         TT0.SetToolTip(Def, Shield_Def(Row.Item(2)))
  214.         SDefrate.Text = Row.Item(3)
  215.         TT1.SetToolTip(SDefrate, Sets_Calc(Row.Item(3)))
  216.         EDefrate.Text = Row.Item(4)
  217.         TT2.SetToolTip(EDefrate, Sets_Calc(Row.Item(4)))
  218.     End Sub
  219.  
  220.     Private Sub TextBox1_TextChanged() Handles TextBox1.TextChanged
  221.         ListBox_Fill()
  222.     End Sub
  223.  
  224.     Private Sub ListBox_Fill()
  225.         If TextBox1.Text <> "" Then
  226.             cmd = New SqlCeCommand("SELECT Name, BM, GM, HE, DiM, DuM, LE FROM " & TabControl1.SelectedTab.Name & " WHERE Name LIKE '%" & TextBox1.Text & "%'", conn)
  227.         Else
  228.             cmd = New SqlCeCommand("SELECT Name, BM, GM, HE, DiM, DuM, LE FROM " & TabControl1.SelectedTab.Name, conn)
  229.         End If
  230.         If conn.State = ConnectionState.Closed Then conn.Open()
  231.         Using DataReader As SqlCeDataReader = cmd.ExecuteReader()
  232.             Dim name As Byte = DataReader.GetOrdinal("Name")
  233.             While DataReader.Read()
  234.                 If RadioDK.Checked Then
  235.                     If DataReader.GetBoolean(DataReader.GetOrdinal("BM")) Then
  236.                         Arr.Add(DataReader.GetString(name))
  237.                     End If
  238.                 ElseIf RadioDW.Checked Then
  239.                     If DataReader.GetBoolean(DataReader.GetOrdinal("GM")) Then
  240.                         Arr.Add(DataReader.GetString(name))
  241.                     End If
  242.                 ElseIf RadioFE.Checked Then
  243.                     If DataReader.GetBoolean(DataReader.GetOrdinal("HE")) Then
  244.                         Arr.Add(DataReader.GetString(name))
  245.                     End If
  246.                 ElseIf RadioS.Checked Then
  247.                     If DataReader.GetBoolean(DataReader.GetOrdinal("DiM")) Then
  248.                         Arr.Add(DataReader.GetString(name))
  249.                     End If
  250.                 ElseIf RadioMG.Checked Then
  251.                     If DataReader.GetBoolean(DataReader.GetOrdinal("DuM")) Then
  252.                         Arr.Add(DataReader.GetString(name))
  253.                     End If
  254.                 ElseIf RadioDL.Checked Then
  255.                     If DataReader.GetBoolean(DataReader.GetOrdinal("LE")) Then
  256.                         Arr.Add(DataReader.GetString(name))
  257.                     End If
  258.                 Else
  259.                     Arr.Add(DataReader.GetString(name))
  260.                 End If
  261.             End While
  262.             conn.Close()
  263.         End Using
  264.         Arr.Sort()
  265.         ListBox1.Items.Clear()
  266.         'Datatype must be changed if there's overflow
  267.         For i As Short = 0 To Arr.Count - 1
  268.             ListBox1.Items.Add(Arr(i))
  269.         Next i
  270.         Arr.Clear()
  271.     End Sub
  272.  
  273.     Private Sub TabControl_Selected() Handles TabControl1.Selected
  274.         Select Case TabControl1.SelectedTab.Name
  275.             Case "Sets"
  276.                 Tab = 1
  277.                 Resist.Visible = True
  278.                 Clear_Weapons()
  279.                 Clear_Shields()
  280.             Case "Weapons"
  281.                 Tab = 2
  282.                 Resist.Visible = False
  283.                 Clear_Sets()
  284.                 Clear_Shields()
  285.             Case Else
  286.                 Tab = 3
  287.                 Resist.Visible = True
  288.                 Clear_Sets()
  289.                 Clear_Weapons()
  290.         End Select
  291.         Radio()
  292.         ListBox_Fill()
  293.     End Sub
  294.  
  295.     Private Sub Clear_Sets()
  296.         ADef.Text = Nothing
  297.         AEDef.Text = Nothing
  298.         GDef.Text = Nothing
  299.         GEDef.Text = Nothing
  300.         PDef.Text = Nothing
  301.         PEDef.Text = Nothing
  302.         BDef.Text = Nothing
  303.         BEDef.Text = Nothing
  304.         HDef.Text = Nothing
  305.         HEDef.Text = Nothing
  306.     End Sub
  307.  
  308.     Private Sub Clear_Weapons()
  309.         SDmg.Text = Nothing
  310.         EDmg.Text = Nothing
  311.         Spd.Text = Nothing
  312.         SWiz.Text = Nothing
  313.         EWiz.Text = Nothing
  314.         SPet.Text = Nothing
  315.         EPet.Text = Nothing
  316.     End Sub
  317.  
  318.     Private Sub Clear_Shields()
  319.         Def.Text = Nothing
  320.         SDefrate.Text = Nothing
  321.         EDefrate.Text = Nothing
  322.     End Sub
  323.  
  324.     Private Function Sets_Calc(ByVal i As Short) As String
  325.         If i <> 0 Then
  326.             Dim Str As String
  327.             Str = "+0   | " & i - 49 & LineBreak & "+1   | " & i - 46 & LineBreak & "+2   | " & i - 43 & LineBreak & _
  328.              "+3   | " & i - 40 & LineBreak & "+4   | " & i - 37 & LineBreak & "+5   | " & i - 34 & LineBreak & _
  329.               "+6   | " & i - 31 & LineBreak & "+7   | " & i - 28 & LineBreak & "+8   | " & i - 25 & LineBreak & _
  330.               "+9   | " & i - 22 & LineBreak & "+10 | " & i - 18 & LineBreak & "+11 | " & i - 13 & LineBreak & _
  331.               "+12 | " & i - 7 & LineBreak & "+13 | " & i
  332.             Return Str
  333.         Else
  334.             Return ""
  335.         End If
  336.     End Function
  337.  
  338.     Private Function Weapons_Calc(ByVal i As Short, ByVal j As Short) As String
  339.         If i <> 0 Then
  340.             Dim Str As String
  341.             Str = "+0   | " & i - 49 & "-" & j - 49 & LineBreak & "+1   | " & i - 46 & "-" & j - 46 & LineBreak & "+2   | " & i - 43 & "-" & j - 43 & LineBreak & _
  342.              "+3   | " & i - 40 & "-" & j - 40 & LineBreak & "+4   | " & i - 37 & "-" & j - 37 & LineBreak & "+5   | " & i - 34 & "-" & j - 34 & LineBreak & _
  343.               "+6   | " & i - 31 & "-" & j - 31 & LineBreak & "+7   | " & i - 28 & "-" & j - 28 & LineBreak & "+8   | " & i - 25 & "-" & j - 25 & LineBreak & _
  344.               "+9   | " & i - 22 & "-" & j - 22 & LineBreak & "+10 | " & i - 18 & "-" & j - 18 & LineBreak & "+11 | " & i - 13 & "-" & j - 13 & LineBreak & _
  345.               "+12 | " & i - 7 & "-" & j - 7 & LineBreak & "+13 | " & i & "-" & j
  346.             Return Str
  347.         Else
  348.             Return ""
  349.         End If
  350.     End Function
  351.  
  352.     Private Function Wiz_Calc(ByVal i As Short) As String
  353.         If i <> 0 Then
  354.             Dim Str As String
  355.             Str = "+0   | " & i - 50 & "%" & LineBreak & "+1   | " & i - 47 & "%" & LineBreak & "+2   | " & i - 43 & "%" & LineBreak & _
  356.                   "+3   | " & i - 40 & "%" & LineBreak & "+4   | " & i - 36 & "%" & LineBreak & "+5   | " & i - 33 & "%" & LineBreak & _
  357.                   "+6   | " & i - 29 & "%" & LineBreak & "+7   | " & i - 26 & "%" & LineBreak & "+8   | " & i - 22 & "%" & LineBreak & _
  358.                   "+9   | " & i - 19 & "%" & LineBreak & "+10 | " & i - 15 & "%" & LineBreak & "+11 | " & i - 10 & "%" & LineBreak & _
  359.                   "+12 | " & i - 5 & "%" & LineBreak & "+13 | " & i & "%"
  360.             Return Str
  361.         Else
  362.             Return ""
  363.         End If
  364.     End Function
  365.  
  366.     Private Function Pet_Calc(ByVal i As Short, ByVal j As Short) As String
  367.         If i <> 0 Then
  368.             Dim Str As String
  369.             If j = 1 Then
  370.                 Str = "+0   | " & i - 24 & "%" & LineBreak & "+1   | " & i - 23 & "%" & LineBreak & "+2   | " & i - 21 & "%" & LineBreak & _
  371.                       "+3   | " & i - 20 & "%" & LineBreak & "+4   | " & i - 18 & "%" & LineBreak & "+5   | " & i - 17 & "%" & LineBreak & _
  372.                       "+6   | " & i - 15 & "%" & LineBreak & "+7   | " & i - 14 & "%" & LineBreak & "+8   | " & i - 12 & "%" & LineBreak & _
  373.                       "+9   | " & i - 11 & "%" & LineBreak & "+10 | " & i - 9 & "%" & LineBreak & "+11 | " & i - 6 & "%" & LineBreak & _
  374.                       "+12 | " & i - 3 & "%" & LineBreak & "+13 | " & i & "%"
  375.             ElseIf j = 2 Then
  376.                 Str = "+0   | " & i - 25 & "%" & LineBreak & "+1   | " & i - 23 & "%" & LineBreak & "+2   | " & i - 22 & "%" & LineBreak & _
  377.                       "+3   | " & i - 20 & "%" & LineBreak & "+4   | " & i - 19 & "%" & LineBreak & "+5   | " & i - 17 & "%" & LineBreak & _
  378.                       "+6   | " & i - 16 & "%" & LineBreak & "+7   | " & i - 14 & "%" & LineBreak & "+8   | " & i - 13 & "%" & LineBreak & _
  379.                       "+9   | " & i - 11 & "%" & LineBreak & "+10 | " & i - 9 & "%" & LineBreak & "+11 | " & i - 7 & "%" & LineBreak & _
  380.                       "+12 | " & i - 4 & "%" & LineBreak & "+13 | " & i & "%"
  381.             Else
  382.                 Str = "+0   | " & i - 50 & "%" & LineBreak & "+1   | " & i - 47 & "%" & LineBreak & "+2   | " & i - 43 & "%" & LineBreak & _
  383.                       "+3   | " & i - 40 & "%" & LineBreak & "+4   | " & i - 36 & "%" & LineBreak & "+5   | " & i - 33 & "%" & LineBreak & _
  384.                       "+6   | " & i - 29 & "%" & LineBreak & "+7   | " & i - 26 & "%" & LineBreak & "+8   | " & i - 22 & "%" & LineBreak & _
  385.                       "+9   | " & i - 19 & "%" & LineBreak & "+10 | " & i - 15 & "%" & LineBreak & "+11 | " & i - 10 & "%" & LineBreak & _
  386.                       "+12 | " & i - 5 & "%" & LineBreak & "+13 | " & i & "%"
  387.             End If
  388.             Return Str
  389.         Else
  390.             Return ""
  391.         End If
  392.     End Function
  393.  
  394.     Private Function Shield_Def(ByVal i As Short) As String
  395.         If i <> 0 Then
  396.             Dim Str As String
  397.             Str = "+0   | " & i - 13 & "%" & LineBreak & "+1   | " & i - 12 & "%" & LineBreak & "+2   | " & i - 11 & "%" & LineBreak & _
  398.                   "+3   | " & i - 10 & "%" & LineBreak & "+4   | " & i - 9 & "%" & LineBreak & "+5   | " & i - 8 & "%" & LineBreak & _
  399.                   "+6   | " & i - 7 & "%" & LineBreak & "+7   | " & i - 6 & "%" & LineBreak & "+8   | " & i - 5 & "%" & LineBreak & _
  400.                   "+9   | " & i - 4 & "%" & LineBreak & "+10 | " & i - 3 & "%" & LineBreak & "+11 | " & i - 2 & "%" & LineBreak & _
  401.                   "+12 | " & i - 1 & "%" & LineBreak & "+13 | " & i & "%"
  402.             Return Str
  403.         Else
  404.             Return ""
  405.         End If
  406.     End Function
  407.  
  408.     Private Sub AllChange() Handles RadioAll.CheckedChanged, RadioDK.CheckedChanged, RadioDL.CheckedChanged, RadioDW.CheckedChanged, RadioFE.CheckedChanged, RadioMG.CheckedChanged, RadioS.CheckedChanged
  409.         Radio()
  410.     End Sub
  411.  
  412.     Private Sub Radio()
  413.         PictureBox1.Image = Nothing
  414.         ListBox1.Items.Clear()
  415.         TextBox1.Text = Nothing
  416.         TextBox1.Focus()
  417.     End Sub
  418.  
  419.     Private Sub About() Handles Button1.Click
  420.         Help.Show()
  421.     End Sub
  422. End Class