Советы тем, кто программирует на VB & VBA

Листинг 3. Модуль AddProc.bas — вспомогательные процедуры для формы Flood.frm

Option Explicit  
 Private Declare Function GetSysColor Lib "user32" _  
   (ByVal nIndex As Long) As Long  
Function CheckSysColor(ByVal Color As Long) As Long  
   Const HighBit As Long = &H80000000  
   ' Если установлен старший разряд, то берем системный цвет
   If Color And HighBit Then  
      CheckSysColor = GetSysColor(Color And Not HighBit)  
   Else  
      CheckSysColor = Color  
   End If  
End Function  
Sub DrawShapes(pct As PictureBox, cbo As ComboBox) ' Начальная картинка с пересечением разных линий ' на рисунке  
   Dim i As Long  
   Dim x1 As Long, y1 As Long  
   Dim x2 As Long, y2 As Long  
   Dim c As Long  
   Dim MyRnd As Single  
   ' рисуем случайные линии разного цвета
   Randomize Timer  
   With pct  
      .Cls  
      For i = 1 To 20  
         x1 = Rnd * .ScaleWidth  
         y1 = Rnd * .ScaleHeight  
         x2 = Rnd * .ScaleWidth  
         y2 = Rnd * .ScaleHeight  
         If i <= 15 Then  ' для первых 15 выбираем случайные цвета
           MyRnd = Rnd * 7
         Else  ' для последних — фиксированный синий
           MyRnd = 1  'Синий  
         End If  
         c = cbo.ItemData(MyRnd)  ' выбор цвета  
         ' прямая или круг (чет/нечет)
         If i Mod 2 Then  
            pct.Line (x1, y1)-(x2, y2), c, B  
         Else  
            pct.Circle (x1, y1), y2, c  
         End If  
      Next i  
   End With  
End Sub  
Sub FillStyleList(ByVal cbo As ComboBox)  
   ' заполнение списка типом фактуры
   With cbo  
      .AddItem "Сплошная заливка"  
      .ItemData(.NewIndex) = vbFSSolid  
      .AddItem "Горизонтальные линии"  
      .ItemData(.NewIndex) = vbHorizontalLine  
      .AddItem "Вертикальные линии"  
      .ItemData(.NewIndex) = vbVerticalLine  
      .AddItem "Верхняя диагональ"  
      .ItemData(.NewIndex) = vbUpwardDiagonal  
      .AddItem "Нижняя диагональ"  
      .ItemData(.NewIndex) = vbDownwardDiagonal  
      .AddItem "Клетка"  
      .ItemData(.NewIndex) = vbCross  
      .AddItem "Косая клетка"  
      .ItemData(.NewIndex) = vbDiagonalCross  
   End With  
End Sub  
Sub FillColorList(ByVal cbo As ComboBox)  
   ' заполнение списка названиями цветов
   With cbo  
      .AddItem "Черный"  
      .ItemData(.NewIndex) = vbBlack  
      .AddItem "Синий"  
      .ItemData(.NewIndex) = vbBlue  
      .AddItem "Циан"  
      .ItemData(.NewIndex) = vbCyan  
      .AddItem "Зеленый"  
      .ItemData(.NewIndex) = vbGreen  
      .AddItem "Лиловый"  
      .ItemData(.NewIndex) = vbMagenta  
      .AddItem "Красный"  
      .ItemData(.NewIndex) = vbRed  
      .AddItem "Белый"  
      .ItemData(.NewIndex) = vbWhite  
      .AddItem "Желтый"  
      .ItemData(.NewIndex) = vbYellow  
   End With  
End Sub

возврат


Наш канал на Youtube

1999 1 2 3 4 5 6 7 8 9 10 11 12
2000 1 2 3 4 5 6 7 8 9 10 11 12
2001 1 2 3 4 5 6 7 8 9 10 11 12
2002 1 2 3 4 5 6 7 8 9 10 11 12
2003 1 2 3 4 5 6 7 8 9 10 11 12
2004 1 2 3 4 5 6 7 8 9 10 11 12
2005 1 2 3 4 5 6 7 8 9 10 11 12
2006 1 2 3 4 5 6 7 8 9 10 11 12
2007 1 2 3 4 5 6 7 8 9 10 11 12
2008 1 2 3 4 5 6 7 8 9 10 11 12
2009 1 2 3 4 5 6 7 8 9 10 11 12
2010 1 2 3 4 5 6 7 8 9 10 11 12
2011 1 2 3 4 5 6 7 8 9 10 11 12
2012 1 2 3 4 5 6 7 8 9 10 11 12
2013 1 2 3 4 5 6 7 8 9 10 11 12
Популярные статьи
КомпьютерПресс использует