powered by simpleCommunicator - 2.0.55     © 2025 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Помогите пож
12 сообщений из 12, страница 1 из 1
Помогите пож
    #37240019
lebrance
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
готовлюсь к ЕГЭ,экзамен 9-10 классов
нужно сделать прогу которая начертит систему координат и контур 270 градусов,и определить входит ли точка в заданный контур.
делаю систему координат а контур в этой же команде добавить не могу не чертить!!
попробовал две линии сделать и контур-получилось!
задать координаты надо с помощью inputbox вот текст который я написал до остального допереть не могу (((


Dim x As String
Dim y As String

Private Sub Command1_Click()
P1.Line (20, 238)-(450, 238)
P1.Line (318, 20)-(318, 450)
P1.Circle (318, 238), 100, QBColor(3), 0 * 3.1415 / 180, 270 * 3.1415 / 180
End Sub

Private Sub Command2_Click()
P1.Cls
End Sub

Private Sub Command3_Click()
P1.PSet (x, y)
x = Val(InputBox(" ââåäèòå x"))
y = Val(InputBox(" ââåäèòå y"))
If (P1.PSet = P1.Circle) = True Then
MsgBox ("òî÷êà âõîäèò â êîíòóð!")
End If
If (P1.PSet = P1.Circle) = False Then
MsgBox ("òî÷êà íå âõîäèò â êîíòóð!")
End If
End Sub
ПОМОГИТЕ ПОЖ СРОЧНО НАДО!
ЗАРАНЕЕ СПАСИБО
...
Рейтинг: 0 / 0
Помогите пож
    #37240077
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
если P1.PSet = P1.Circle
классно. Почему бы сразу не написать "если точка внутри круга"

А вообще, как сделать такой расчет, тебе должны были рассказать на уроках математики, а не программирования. Написать пару формул несложно, ты только скажи, каких )))

Всякое видал:
Код: plaintext
1.
If a=True
If not a=b
но такого
Код: plaintext
If (a=b)=False
не прислилось бы и в страшном сне
...
Рейтинг: 0 / 0
Помогите пож
    #37240081
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Код: plaintext
1.
2.
P1.PSet (x, y)
x = Val(InputBox(" ââåäèòå x"))
y = Val(InputBox(" ââåäèòå y"))
хех.
сначала копаем ямурисуем точку, а потом выясняем, где надо было
...
Рейтинг: 0 / 0
Помогите пож
    #37240089
Фотография Konst_One
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Код: plaintext
Public Declare Function PtInRegion Lib "gdi32" Alias "PtInRegion" (ByVal hRgn As Long, ByVal x As Long, ByVal y As Long) As Long

ищи примеры с использованием этой ф-ии API, рисовать регионами надо
...
Рейтинг: 0 / 0
Помогите пож
    #37240117
AndrF
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Konst_Oneищи примеры с использованием этой ф-ии API, рисовать регионами надо

Да вы что - это же школа и экзамен - какое АPI! Не ставьте в тупик преподавателей!
...
Рейтинг: 0 / 0
Помогите пож
    #37240128
Фотография Konst_One
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
AndrFKonst_Oneищи примеры с использованием этой ф-ии API, рисовать регионами надо

Да вы что - это же школа и экзамен - какое АPI! Не ставьте в тупик преподавателей!

да, что-то я не обратил внимания. ну не важно, пусть преподаватель немного понапрягает извилины =)
...
Рейтинг: 0 / 0
Помогите пож
    #37240187
Фотография Konst_One
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
нарисовали квадрат и проверили, дальше сами дерзайте

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
Option Explicit

Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function PtInRegion Lib "gdi32" (ByVal hRgn As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function CreateHatchBrush Lib "gdi32" (ByVal nIndex As Long, ByVal crColor As Long) As Long
Private Declare Function FrameRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long

Private Type POINTAPI
X As Long
Y As Long
End Type

Dim P( 4 ) As POINTAPI
Dim Rgn As Long
'

Private Sub Form_Load()
Dim hHbr As Long

Me.ScaleMode = vbPixels
Me.AutoRedraw = True

'создаём полигон
P( 0 ).X =  5 : P( 0 ).Y =  5 
P( 1 ).X =  25 : P( 1 ).Y =  5 
P( 2 ).X =  25 : P( 2 ).Y =  25 
P( 3 ).X =  5 : P( 3 ).Y =  25 
P( 4 ).X =  5 : P( 4 ).Y =  5 
Rgn = CreatePolygonRgn(P( 0 ), UBound(P) +  1 ,  1 )

'отрисовываем
Form1.Cls
'hHbr = CreateHatchBrush(3, vbRed)  'штрих-заливка
hHbr = CreateSolidBrush(vbRed)  'сплошная заливка области
FrameRgn Me.hdc, Rgn, hHbr, Me.ScaleHeight, Me.ScaleWidth
'удаляем объект
DeleteObject hHbr


End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'проверяем координаты точки
    If PtInRegion(Rgn, X, Y) Then
        MsgBox "точка внутри области", vbExclamation
    Else
        MsgBox "точка вне области", vbInformation
    End If
End Sub
...
Рейтинг: 0 / 0
Помогите пож
    #37240216
Фотография Konst_One
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
вот готовый пример:
надо только на форму кинуть PictureBox

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
Option Explicit
Private Enum HT
 htNone =  0 
 htRectangle =  16 
 htTriangle =  32 
 htCircle =  48 
 htLine =  64 
 htArc =  80 
 htCurve =  96 
End Enum

Private Type POINTAPI
   X As Long
   Y As Long
End Type

Private Declare Function PolyBezier Lib "gdi32.dll" (ByVal hdc As Long, _
               lppt As POINTAPI, ByVal cPoints As Long) As Long

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim test As Long, cap As String
 test = Picture1.Point(X, Y)
 Select Case test
 Case HT.htNone: cap = ""
 Case HT.htArc: cap = "Arc"
 Case HT.htCircle: cap = "Circle"
 Case HT.htCurve: cap = "Curve"
 Case HT.htLine: cap = "Line"
 Case HT.htRectangle: cap = "Rectangle"
 Case HT.htTriangle: cap = "Triangle"
 Case Else: cap = "OUT OF RANGE"
 End Select
 If Me.Caption <> cap Then 
     Me.Caption = cap
     Debug.Print cap
 End If
End Sub

Private Sub Form_Load()
 Me.AutoRedraw = True
 Me.ScaleMode = vbPixels
 Picture1.ScaleMode = vbPixels
 Picture1.AutoRedraw = True
 Picture1.BorderStyle =  0 
 Picture1.BackColor = vbBlack
 Picture1.Move  0 ,  210 ,  315 ,  210 
 Picture1.FillStyle = vbSolid
 Picture1.Visible = False
 DrawRect
 DrawTri
 DrawCircle
 Picture1.DrawWidth =  3 
 DrawLine
 DrawArc
 DrawCurve
End Sub

Sub DrawCurve()
Dim Polys( 0  To  6 ) As POINTAPI
 Polys( 0 ).X =  230 : Polys( 0 ).Y =  120 
 Polys( 1 ).X =  300 : Polys( 1 ).Y =  120 
 Polys( 2 ).X =  250 : Polys( 2 ).Y =  150 
 Polys( 3 ).X =  230 : Polys( 3 ).Y =  200 
 Polys( 4 ).X =  250 : Polys( 4 ).Y =  220 
 Polys( 5 ).X =  250 : Polys( 5 ).Y =  200 
 Polys( 6 ).X =  310 : Polys( 6 ).Y =  150 
 PolyBezier Me.hdc, Polys( 0 ),  7 
 Picture1.ForeColor = htCurve
 PolyBezier Picture1.hdc, Polys( 0 ),  7 
End Sub

Sub DrawArc()
 Me.Circle ( 160 ,  160 ),  40 , vbBlack, Atn( 1 ) *  2 , Atn( 1 ) *  6 
 Picture1.Circle ( 160 ,  160 ),  40 , htArc, Atn( 1 ) *  2 , Atn( 1 ) *  6 
End Sub

Sub DrawLine()
 Me.Line ( 90 ,  120 )-( 10 ,  200 )
 Me.Line -( 90 ,  200 )
 Picture1.Line ( 90 ,  120 )-( 10 ,  200 ), htLine
 Picture1.Line -( 90 ,  200 ), htLine
End Sub

Sub DrawCircle()
 Me.Circle ( 270 ,  50 ),  40 
 Picture1.FillColor = htCircle
 Picture1.Circle ( 270 ,  50 ),  40 , htCircle
End Sub

Sub DrawTri()
Dim ln As Single, Y As Long
 Me.Line ( 170 ,  10 )-( 120 ,  90 )
 Me.Line -( 220 ,  90 )
 Me.Line -( 170 ,  10 )
 ln =  0 . 5 
 For Y =  10  To  90 
   Picture1.Line ( 171  - ln, Y)-( 170  + ln, Y), HT.htTriangle
   ln = ln +  0 . 63 
 Next
End Sub

Sub DrawRect()
 Me.Line ( 10 ,  10 )-( 70 ,  10 )
 Me.Line -( 70 ,  30 )
 Me.Line -( 90 ,  30 )
 Me.Line -( 90 ,  90 )
 Me.Line -( 10 ,  90 )
 Me.Line -( 10 ,  10 )
 Picture1.Line ( 10 ,  10 )-( 70 ,  90 ), htRectangle, BF
 Picture1.Line ( 10 ,  30 )-( 90 ,  90 ), htRectangle, BF
End Sub
...
Рейтинг: 0 / 0
Помогите пож
    #37240975
bac
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Опять что-то накотило. Это стандартными средствами VB

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
Dim CX, CY, Radius
Private Sub drawGraph()
    Dim i, j, h
    ScaleMode =  3 
    CX = ScaleWidth /  2 
    CY = ScaleHeight /  2 
    DrawWidth =  1 
    ForeColor = RGB(O, O, O)
    Line ( 0 , CY)-(ScaleWidth, CY), , BF
    Line (CX,  0 )-(CX, ScaleHeight), , BF
    j =  1 
    For i =  10  To ScaleWidth Step  10 
        If j =  10  Then
            j =  1 
            h =  10 
        ElseIf j =  5  Then
            h =  5 
        Else
            h =  3 
        End If
        Line (CX + i, CY)-(CX + i, CY + h), , BF
        Line (CX - i, CY)-(CX - i, CY + h), , BF
        j = j +  1 
    Next
    
    j =  1 
    For i =  10  To ScaleHeight Step  10 
        If j =  10  Then
            h =  10 
            j =  1 
        ElseIf j =  5  Then
            h =  5 
        Else
            h =  3 
        End If
        Line (CX, CY + i)-(CX + h, CY + i), , BF
        Line (CX, CY - i)-(CX + h, CY - i), , BF
        j = j +  1 
    Next
    
    
    If CX > CY Then Radius = CY /  3  *  2  Else Radius = CX /  3  *  2 
    DrawWidth =  3 
    Circle (CX, CY), Radius, RGB( 50 ,  100 ,  200 ), - 0 . 00001 , -( 3 . 1415  /  2 #) *  3 

End Sub


Private Sub Form_Load()
    drawGraph
End Sub

Private Sub Form_Resize()
    Cls
    drawGraph
    txtX_Change
End Sub

Private Sub txtX_Change()
    If IsNumeric(txtX) And IsNumeric(txtY) Then
        Cls
        drawGraph
        DrawWidth =  10 
        PSet (CX + txtX *  10 , CY - txtY *  10 ), RGB( 200 ,  50 ,  50 )
        Dim r
        r = Int(Sqr(txtX * txtX + txtY * txtY)) *  10 
        lblEnter.Visible = False
        If r < Radius Then
            If Not (txtX >  0  And txtY <  0 ) Then
                lblEnter.Visible = True
            End If
        End If
    End If
End Sub

Private Sub txtY_Change()
    txtX_Change
End Sub

...
Рейтинг: 0 / 0
Помогите пож
    #37240978
bac
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
...
Рейтинг: 0 / 0
Помогите пож
    #37241140
lebrance
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Shocker.Proесли P1.PSet = P1.Circle
классно. Почему бы сразу не написать "если точка внутри круга"

А вообще, как сделать такой расчет, тебе должны были рассказать на уроках математики, а не программирования. Написать пару формул несложно, ты только скажи, каких )))

+
Всякое видал:
Код: plaintext
1.
If a=True
If not a=b
но такого
Код: plaintext
If (a=b)=False
не прислилось бы и в страшном сне


спасибо большое за поддержку
...
Рейтинг: 0 / 0
Помогите пож
    #37241142
lebrance
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
bacОпять что-то накотило. Это стандартными средствами VB

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
Dim CX, CY, Radius
Private Sub drawGraph()
    Dim i, j, h
    ScaleMode =  3 
    CX = ScaleWidth /  2 
    CY = ScaleHeight /  2 
    DrawWidth =  1 
    ForeColor = RGB(O, O, O)
    Line ( 0 , CY)-(ScaleWidth, CY), , BF
    Line (CX,  0 )-(CX, ScaleHeight), , BF
    j =  1 
    For i =  10  To ScaleWidth Step  10 
        If j =  10  Then
            j =  1 
            h =  10 
        ElseIf j =  5  Then
            h =  5 
        Else
            h =  3 
        End If
        Line (CX + i, CY)-(CX + i, CY + h), , BF
        Line (CX - i, CY)-(CX - i, CY + h), , BF
        j = j +  1 
    Next
    
    j =  1 
    For i =  10  To ScaleHeight Step  10 
        If j =  10  Then
            h =  10 
            j =  1 
        ElseIf j =  5  Then
            h =  5 
        Else
            h =  3 
        End If
        Line (CX, CY + i)-(CX + h, CY + i), , BF
        Line (CX, CY - i)-(CX + h, CY - i), , BF
        j = j +  1 
    Next
    
    
    If CX > CY Then Radius = CY /  3  *  2  Else Radius = CX /  3  *  2 
    DrawWidth =  3 
    Circle (CX, CY), Radius, RGB( 50 ,  100 ,  200 ), - 0 . 00001 , -( 3 . 1415  /  2 #) *  3 

End Sub


Private Sub Form_Load()
    drawGraph
End Sub

Private Sub Form_Resize()
    Cls
    drawGraph
    txtX_Change
End Sub

Private Sub txtX_Change()
    If IsNumeric(txtX) And IsNumeric(txtY) Then
        Cls
        drawGraph
        DrawWidth =  10 
        PSet (CX + txtX *  10 , CY - txtY *  10 ), RGB( 200 ,  50 ,  50 )
        Dim r
        r = Int(Sqr(txtX * txtX + txtY * txtY)) *  10 
        lblEnter.Visible = False
        If r < Radius Then
            If Not (txtX >  0  And txtY <  0 ) Then
                lblEnter.Visible = True
            End If
        End If
    End If
End Sub

Private Sub txtY_Change()
    txtX_Change
End Sub



Спасибо большое)не очень понял и у меня 5.0 версия может поэтому не знаю но все равно помогло))))спасибо
...
Рейтинг: 0 / 0
12 сообщений из 12, страница 1 из 1
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Помогите пож
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]