bas/DIBUJO.bas

   1 Attribute VB_Name = "GUI"
   2 Option Explicit
   3 '   Este archivo es parte del programa "reseter", el cúal es pertenece a SVCommunity.org y a Todosv.com
   4 '   Mantenedores principales:
   5 '    *Vlad
   6 Rem Detener la actualización de las ventanas
   7 Public Declare Function LockWindowUpdate _
   8                Lib "user32" (ByVal hwndLock As Long) As Long
   9 Private Type tagInitCommonControlsEx
  10     lngSize As Long
  11     lngICC As Long
  12 End Type
  13 Private Declare Function InitCommonControlsEx _
  14                 Lib "comctl32.dll" (iccex As tagInitCommonControlsEx) As Boolean
  15 Private Const ICC_USEREX_CLASSES = &H200
  16
  17 Public Sub Colorear(Destino As Object)
  18     '<EhHeader>
  19     On Error GoTo Colorear_Err
  20     '</EhHeader>
  21     Dim c As Control
  22     Dim cControles As Object
  23     LockWindowUpdate Destino.hdc
  24     Destino.BackColor = vbWhite
  25     Set cControles = Destino.Controls
  26
  27     With c
  28
  29         For Each c In cControles
  30
  31             If c.Tag = -1 Then GoTo NoProcesar
  32
  33             Select Case TypeName(c)
  34
  35                 Case "Label"
  36
  37                     Select Case c.Tag
  38
  39                         Case ""
  40                             c.ForeColor = &HC00000
  41                             c.BackColor = vbWhite
  42                             c.BorderStyle = 0
  43                             c.Font = "Verdana"
  44                             c.FontBold = True
  45                             c.FontSize = 12
  46                             c.BackStyle = 0
  47
  48                         Case 1
  49                             c.ForeColor = &H777777
  50                             c.BackColor = vbWhite
  51                             c.BorderStyle = 0
  52                             c.Font = "Arial"
  53                             c.FontBold = False
  54                             c.FontSize = 10
  55
  56                         Case 2
  57                             c.ForeColor = vbBlack
  58                             c.BackColor = vbWhite
  59                             c.BorderStyle = 1
  60                             c.Font = "Courier New"
  61                             c.FontBold = False
  62                             c.FontSize = 8
  63
  64                         Case 3
  65                             c.ForeColor = vbBlack
  66                             c.BackColor = vbWhite
  67                             c.BorderStyle = 0
  68                             c.Font = "Courier New"
  69                             c.FontBold = False
  70                             c.FontSize = 8
  71
  72                         Case 4
  73                             c.ForeColor = vbBlue
  74                             c.BackColor = vbWhite
  75                             c.BorderStyle = 0
  76                             c.Font = "MS Sans Serif"
  77                             c.FontBold = True
  78                             c.FontSize = 8
  79
  80                         Case 5
  81                             c.ForeColor = vbBlack
  82                             c.BackColor = vbWhite
  83                             c.BorderStyle = 0
  84                             c.Font = "Arial"
  85                             c.FontBold = False
  86                             c.FontSize = 8
  87                     End Select
  88
  89                 Case "CheckBox"
  90                     c.Alignment = 1
  91                     c.Appearance = 1
  92                     c.BackColor = vbWhite
  93
  94                 Case "OptionButton"
  95                     c.Alignment = 1
  96                     c.Appearance = 1
  97                     c.BackColor = vbWhite
  98
  99                 Case "CommandButton"
 100
 101                     Select Case c.Tag
 102
 103                         Case ""
 104                             c.BackColor = &HAAAAAA
 105                             c.Font = "Courier New"
 106                             c.FontBold = True
 107                             c.Font.Size = 10
 108
 109                         Case 1
 110                             c.Font = "Courier New"
 111                             c.FontBold = False
 112                             c.Font.Size = 8
 113                     End Select
 114
 115                 Case "TextBox"
 116
 117                     Select Case c.Tag
 118
 119                         Case ""
 120                             c.Font = "Courier New"
 121                             c.FontSize = 10
 122                             c.FontBold = False
 123                             c.ForeColor = &HC00000
 124                             c.BackColor = &HFFFAFA
 125                             c.BorderStyle = 1
 126
 127                         Case 1
 128                             c.ForeColor = vbRed
 129                             c.BackColor = &HFFFAFA
 130                             c.BorderStyle = 1
 131                             c.Appearance = 1
 132                             c.Font = "Courier New"
 133                             c.FontBold = False
 134                             c.FontSize = 8
 135                     End Select
 136
 137                 Case "Frame"
 138                     c.Font = "Arial"
 139                     c.BorderStyle = 1
 140                     c.ForeColor = &HC00000
 141                     c.BackColor = vbWhite
 142                     c.FontSize = 12
 143                     c.FontBold = False
 144
 145                 Case "ListView"
 146                     c.Font = "Courier New"
 147                     c.Font.Size = 9
 148                     c.Font.Bold = False
 149                     c.ForeColor = &HC00000
 150                     c.BackColor = &HFFFAFA
 151                     c.BorderStyle = 1
 152
 153                 Case "PictureBox"
 154                     c.BackColor = vbWhite
 155
 156                 Case "ComboBox"
 157                     c.ForeColor = &H777777
 158                     c.BackColor = vbWhite
 159                     c.Font = "Arial"
 160                     c.FontBold = False
 161                     c.FontSize = 10
 162             End Select
 163
 164 NoProcesar:
 165         Next
 166
 167     End With
 168
 169     LockWindowUpdate 0
 170     '<EhFooter>
 171     Exit Sub
 172 Colorear_Err:
 173     Controlar_Error Erl, Err.Description, "Reseter.GUI.Colorear"
 174     Resume Next
 175     '</EhFooter>
 176 End Sub
 177
 178 Public Sub Mostrar_Datos()
 179     '<EhHeader>
 180     On Error GoTo Mostrar_Datos_Err
 181
 182     '</EhHeader>
 183     With frmPrincipal
 184         .txtCodigos.Text = Replace(m_Datos.codigo, Chr(254), vbNewLine)
 185     End With
 186
 187     '<EhFooter>
 188     Exit Sub
 189 Mostrar_Datos_Err:
 190     Controlar_Error Erl, Err.Description, "Reseter.GUI.Mostrar_Datos"
 191     Resume Next
 192     '</EhFooter>
 193 End Sub
 194
 195 Public Sub lpActualizar()
 196     '<EhHeader>
 197     On Error GoTo lpActualizar_Err
 198     '</EhHeader>
 199     Dim Buff As Double
 200     Buff = Tiempo.Elapsed
 201     frmPrincipal.lblTW.Caption = Fix((Umbral_EsperarInternetMax - Buff) / 1000)
 202
 203     If Buff > Umbral_EsperarInternetMax Or NetError Then pSocket.error = True
 204     '<EhFooter>
 205     Exit Sub
 206 lpActualizar_Err:
 207     Controlar_Error Erl, Err.Description, "Reseter.GUI.lpActualizar"
 208     Resume Next
 209     '</EhFooter>
 210 End Sub
 211
 212 Public Sub Registrar(ByVal Texto As String, _
 213                      Optional compat As Integer = 0)
 214     '<EhHeader>
 215     On Error GoTo Registrar_Err
 216
 217     '</EhHeader>
 218     If compat > 2 Then Exit Sub
 219     frmPrincipal.txtSalida.Text = frmPrincipal.txtSalida & Time$ & " " & Texto & vbNewLine
 220     frmPrincipal.txtSalida.SelStart = Len(frmPrincipal.txtSalida.Text)
 221     '<EhFooter>
 222     Exit Sub
 223 Registrar_Err:
 224     Controlar_Error Erl, Err.Description, "Reseter.GUI.Registrar"
 225     Resume Next
 226     '</EhFooter>
 227 End Sub