точках полігону For i = 1 To UBound (arr) 'підсумовуємо координати sX = sX + arr (i). x sY = sY + arr (i). y Next' знаходимо середнє значення getCM.x = sX/UBound (arr) getCM.y = sY/UBound (arr)
End Function
Процедура малювання
Sub paint_field () pic.Cls 'очищаємо' робочі змінні для точок Dim dot As pointapi, nextDot As pointapi 'тимчасова рядок Dim tmpS As String' довжина сторін полігону Dim length As Single 'тимчасова змінна для точки Dim tmpDot As pointapi 'проходимо по всіх точках в масиві For i = 1 To UBound (dots)' колір синій col = vbYellow 'беремо першу точку dot = dots (i)' відзначаємо на полі зеленим кольором pic.Circle (dot.x, dot.y), 10, vbGreen j = i + 1 'наступна точка If j> UBound (dots) Then j = 1' якщо раптом наступна точка виявилася неіснуючої _ значить переходимо на першу col = vbGreen End If nextDot = dots (j ) 'визначаємо координати для наступної точки' малюємо лінію символізує бік полігону pic.Line (nextDot.x, nextDot.y) - (dot.x, dot.y), col Next 'якщо є точки то If UBound (dots)> 1 Then 'визначаємо центр мас, записуємо в глобальну змінну cm = getCM ()' малюємо цей центр мас як червону закрашеної точку pic.FillStyle = 0 pic.FillColor = vbRed pic.Circle (cm.x, cm.y), 4, vbRed pic.FillStyle = 1 'розраховуємо лінію Dim y2 As Single, x2 As Single y2 = (pic.ScaleWidth) * Sin (angle) x2 = pic.ScaleWidth * Cos (angle) pic.Line (cm.x, cm.y ) - (cm.x + x2, cm.y + y2) pic.Line (cm.x, cm.y) - (cm.x - x2, cm.y - y2) 'читаємо рядок яку треба вивести Dim s As String s = txtText.Text 'шрифт Dim apiFont As LOGFONT' бітовий масив Dim bytBuf () As Byte 'мінлива ітератор Dim intI As Integer' ім'я шрифту з коммондіалога Dim strFontName As String strFontName = pic.Font.Name 'наводимо ім'я шрифту в кошерний вид bytBuf = StrConv (strFontName & Chr $ (0), vbFromUnicode) 'побайтово записуємо в змінну для передачі API функції For intI = 0 To UBound (bytBuf) apiFont.ifFaseName (intI) = bytBuf (intI) Next intI' записуємо параметри шрифту apiFont.ifHeight = pic.Font.Size * GetDeviceCaps (pic.hdc, LOGPIXELSY) 72
apiFont.ifItalic = Switch (pic.Font.Italic = True, 1, pic.Font.Italic = False, 0 apiFont.ifUnderline = Switch (pic.Font . Underline = True, 1, pic.Font.Underline = False, 0). ifStrikeOut = Switch (pic.Font.Strikethrough = True, 1, pic.Font.Strikethrough = False, 0) apiFont.ifWeight = pic.Font.Weight 'визначаємо поворот apiFont.ifEscapement = - (angle) * 1800/pi apiFont.ifOrientation = apiFont.ifEscapement Dim fontObject As Long, oldFont As Long Dim ingRes As Long' створюємо об'єкт шрифту fontObject = CreateFontIndirect (apiFont) 'вибираємо створений шрифт для даного пристрою (піктчербокс) _ при цьому функція повертає посилання а старий шрифт oldFont ...
