Искажение результатов построения графика

@kshyms · Регистрация: 21.09.2015

Студворк — интернет-сервис помощи студентам

VB.NET
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
  Dim BM As New Bitmap(PictureBox1.Width, PictureBox1.Height)
        Using G As Graphics = Graphics.FromImage(BM)
 
            G.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
 
            'Рисуем шкалу координат
            'По оcи X
            G.DrawLine(Pens.Black, 0, 130, 550, 130)
            'По оcи Y
            G.DrawLine(Pens.Black, 180, 0, 180, 500)
            'Делаем засечки по осям координат
            'По оси X
            For X = 0 To 550 Step 10
                G.DrawLine(Pens.Black, X, 129, X, 131)
            Next X
 
            'По оси Y
            For Y = 0 To 500 Step 10
                G.DrawLine(Pens.Black, 179, Y, 181, Y)
            Next Y
            Dim brush1 As New SolidBrush(Color.Black)
            Dim font1 As New Font("Arial", 6)
            'Рисуем шкалу координат
            'По оcи X
            For X = -180 To 380 Step 90
                G.DrawString(Math.Round(X * 1.39), font1, brush1, X + 180, 130)
            Next X
            'По оcи Y
            For Y = -150 To 150 Step 50
                G.DrawString(Y / 2, font1, brush1, 180, 130 - Y)
            Next Y
              G.DrawLine(Pens.Red, 180, 130, 180, 131) '0 точка
            'Рисуем график
           For j = 2 To 8
                G.DrawLine(Pens.Red, mat(j) + 180, 70 - mat4(j), mat(j + 1) + 180, 70 - mat4(j + 1)) 'кривая 
            Next j
          PictureBox1.Image = BM
            BM.Save("C:\IS.bmp")
            oSheet = Nothing
            oBook = Nothing
            G.Dispose()
 
        End Using

Как исправить искажение?

Добавлено через 11 минут
0,9 55
0,8 30
4,4 27
6,2 30
51,7 35
73,3 10
124,7 7
179,5 6

@ovva · 01.01.2017, 15:28

Вот как примерно это может выглядеть

Кликните здесь для просмотра всего текста

VB.NET
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
Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
    Dim BM As New Bitmap(PictureBox1.Width, PictureBox1.Height)
    'данные
    Dim pnt() As PointF = {New Point(2, 30), New Point(9, 35), New Point(15, 27), New Point(20, 30), New Point(31, 35), _
                           New Point(54, 10), New Point(66, 17), New Point(79.5, 6)}
    Dim xmin As Single = 0, xmax As Single = 100, ymin As Single = 0, ymax = 50
    Dim w As Single = PictureBox1.Width, h As Single = PictureBox1.Height
    Dim scX As Single = w / (xmax - xmin)
    Dim scY As Single = h / (ymax - ymin)
    Dim sc As Single = If(scX > scY, scY, scX) 'одинаковый масштаб по осям
    Dim dd As Integer = 10 'дополнительный сдвиг
    Dim pnGr As New Pen(Brushes.Black, -1), pnLn As New Pen(Brushes.Red, -1)
    Dim divX As Integer = 10, divY As Integer = 10 'шаг по осям координат
    Using G As Graphics = Graphics.FromImage(BM)
        G.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
        G.ScaleTransform(sc, -sc) 'масштабируем и разворачиваем ось Y
        G.TranslateTransform(xmin + dd, -ymax - dd) 'сдвигаем систему координат  + dd
        G.Clear(Color.White)
        'оси координат
        G.DrawLine(pnGr, New PointF(xmin - dd, 0), New PointF(xmax, 0))
        G.DrawLine(pnGr, New PointF(0, ymin - dd), New PointF(0, ymax))
        'шкалы по осям
        For xx As Single = 0 To xmax Step divX
            G.DrawLine(pnGr, New PointF(xx, 0), New PointF(xx, -divY * 0.1))
        Next
        For yy As Single = ymin To ymax Step divY
            G.DrawLine(pnGr, New PointF(0, yy), New PointF(-divX * 0.1, yy))
        Next
        'линия графика
        G.DrawLines(pnLn, pnt)
        'подписи
        G.ResetTransform() 'придется сбросить настройки системы координат
        G.ScaleTransform(1, 1)
        G.TranslateTransform((xmin + dd) * sc, (ymax - dd) * scY)
        Dim txtFont As New Font(FontFamily.GenericMonospace, 9, FontStyle.Regular)
        For xx = 0 To xmax Step divX
            G.DrawString(Format(xx, "0.0"), txtFont, Brushes.Black, (xx - divX * 0.2) * sc, (-divY * 0.2) * sc)
        Next
        For yy = 0 To ymax Step divY
            If yy = 0 Then Continue For
            G.DrawString(Format(yy, "0.0"), txtFont, Brushes.Black, -divX * 0.8 * sc, (-yy - divY * 0.5) * sc)
        Next
        PictureBox1.Image = BM
        G.Dispose()
    End Using
End Sub

Для формирования более общего кода придется еще потрудиться. Лучше оформить все это в виде отдельного класса, где на входе подается массив точек.

@kshyms · 04.01.2017, 07:35 **[ТС]**

VB.NET
1
2
3
4
5
6
7
8
dim mat(100),mat4(100) as single
 
       Dim pnt(100, 5) As PointF
        For i = 1 To 2
            For j = 2 To 9
        pnt(i, j)={New Point mat(i),mat(i))}
            Next j
        Next i

как правильно присвоить значения?

@ovva · 04.01.2017, 13:01

kshyms,
Не очень понял ваш код (назначение массива pnt и что собственно нужно получить).
Вот, на живом примере, как можно заполнить массив точками.

VB.NET
1
2
3
4
5
6
Dim matX() As Single = {10, 20, 33}
Dim matY() As Single = {55, 35, 77}
Dim pnt(matX.Length - 1) As PointF
For i = 0 To matX.Length - 1
    pnt(i) = New PointF(matX(i), matY(i))
Next

@kshyms · 04.01.2017, 14:25 **[ТС]**

ovva,

VB.NET
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
Private Sub Button6_Click_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button6.Click
        Dim BM As New Bitmap(PictureBox1.Width, PictureBox1.Height)
        Dim pnt(mat.Length - 1) As PointF
        For i = 2 To 9
            pnt(i) = New PointF(mat(i), mat4(i))
        Next
        Dim xmin As Single = 0, xmax As Single = 200, ymin As Single = 0, ymax = 55
        Dim w As Single = PictureBox1.Width, h As Single = PictureBox1.Height
        Dim scX As Single = w / (xmax - xmin)
        Dim scY As Single = h / (ymax - ymin)
        Dim sc As Single = If(scX > scY, scY, scX) 'одинаковый масштаб по осям
        Dim dd As Integer = 10 'дополнительный сдвиг
        Dim pnGr As New Pen(Brushes.Black, -1), pnLn As New Pen(Brushes.Red, -1)
        Dim divX As Integer = 10, divY As Integer = 10 'шаг по осям координат
        Using G As Graphics = Graphics.FromImage(BM)
            G.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
            G.ScaleTransform(sc, -sc) 'масштабируем и разворачиваем ось Y
            G.TranslateTransform(xmin + dd, -ymax - dd) 'сдвигаем систему координат  + dd
            G.Clear(Color.White)
            'оси координат
            G.DrawLine(pnGr, New PointF(xmin - dd, 0), New PointF(xmax, 0))
            G.DrawLine(pnGr, New PointF(0, ymin - dd), New PointF(0, ymax))
            'шкалы по осям
            For xx As Single = 0 To xmax Step divX
                G.DrawLine(pnGr, New PointF(xx, 0), New PointF(xx, -divY * 0.1))
            Next
            For yy As Single = ymin To ymax Step divY
                G.DrawLine(pnGr, New PointF(0, yy), New PointF(-divX * 0.1, yy))
            Next
            'линия графика
            G.DrawLines(pnLn, pnt)
            'подписи
            G.ResetTransform() 'придется сбросить настройки системы координат
            G.ScaleTransform(1, 1)
            G.TranslateTransform((xmin + dd) * sc, (ymax - dd) * scY)
            Dim txtFont As New Font(FontFamily.GenericMonospace, 9, FontStyle.Regular)
            For xx = 0 To xmax Step divX
                G.DrawString(Format(xx, ""), txtFont, Brushes.Black, (xx - divX * 0.2) * sc, (-divY * 0.2) * sc)
            Next
            For yy = 0 To ymax Step divY
                If yy = 0 Then Continue For
                G.DrawString(Format(yy, ""), txtFont, Brushes.Black, -divX * 0.8 * sc, (-yy - divY * 0.5) * sc)
            Next
            PictureBox1.Image = BM
            BM.Save("C:\1.png")
            G.Dispose()
        End Using
    End Sub

Уже намного лучше и данные грузятся из ecxel и выводятся графически, но откуда нижняя линяя уходящая в ноль и как шкалу y поднять чуть выше?

@kshyms · 04.01.2017, 14:37 **[ТС]**

124,7 7
179,5 6
Две последние точки отображаются не верно. Почему?

@ovva · 04.01.2017, 15:12

kshyms,
Приведите ваши данные полностью (mat(),mat4()). Непонятно почему For i = 2 To 9. Код рассчитан на то, что pnt заполняется полностью. Если вы хотите от 2 до 9, то нужно так

VB.NET
1
2
3
4
Dim pnt(9-2) As PointF
For i = 2 To 9
    pnt(i-2) = New PointА(mat(i), mat4(i))
Next

@kshyms · 04.01.2017, 16:00 **[ТС]**

уже совсем отлично только шкалу y поднять как и обозначить в вершинах x и y?

@ovva · 04.01.2017, 18:16

Подписи по Y

VB.NET
1
2
3
4
For yy = 0 To ymax Step divY
    If yy = 0 Then Continue For
    G.DrawString(Format(yy, "0.0"), txtFont, Brushes.Black, -divX * 0.8 * sc, (-yy - divY * 0.5) * sc)
Next

Сдвинуть все подписи вверх можно заменив коэффициент 0.5 на, например, 1.2.
По поводу

обозначить в вершинах x и y

постарайтесь все же разобраться самостоятельно.

@kshyms · 04.01.2017, 19:21 **[ТС]**

VB.NET
1
2
3
4
 Dim s As String = "A"
        Dim s1 As String = "B"
    G.DrawString(s, txtFont, Brushes.Black, -15, -150) 'B
            G.DrawString(s1, txtFont, Brushes.Black, 530, -77) 'A

Уже разобрался огромное спасибо!

Новые блоги и статьи Все статьи Все блоги /
моя боль iceja 24.01.2026 Выложила интерполяцию кубическими сплайнами www. iceja. net REST сервисы временно не работают, только через Web. Написала за 56 рабочих часов этот сайт с нуля. При помощи perplexity. ai PRO , при. . .	Модель сукцессии микоризы anaschu 24.01.2026 Решили писать научную статью с неким РОманом	http://iceja.net/ математические сервисы iceja 20.01.2026 Обновила свой сайт http:/ / iceja. net/ , приделала Fast Fourier Transform экстраполяцию сигналов. Однако предсказывает далеко не каждый сигнал (см ограничения http:/ / iceja. net/ fourier/ docs ). Также. . .	http://iceja.net/ сервер решения полиномов iceja 18.01.2026 Выкатила http:/ / iceja. net/ сервер решения полиномов (находит действительные корни полиномов методом Штурма). На сайте документация по API, но скажу прямо VPS слабенький и 200 000 полиномов. . .
Расчёт переходных процессов в цепи постоянного тока igorrr37 16.01.2026 / * Дана цепь(не выше 3-го порядка) постоянного тока с элементами R, L, C, k(ключ), U, E, J. Программа находит переходные токи и напряжения на элементах схемы классическим методом(1 и 2 з-ны. . .	Восстановить юзерскрипты Greasemonkey из бэкапа браузера damix 15.01.2026 Если восстановить из бэкапа профиль Firefox после переустановки винды, то список юзерскриптов в Greasemonkey будет пустым. Но восстановить их можно так. Для этого понадобится консольная утилита. . .	Сукцессия микоризы: основная теория в виде двух уравнений. anaschu 11.01.2026 https:/ / rutube. ru/ video/ 7a537f578d808e67a3c6fd818a44a5c4/	WordPad для Windows 11 Jel 10.01.2026 WordPad для Windows 11 — это приложение, которое восстанавливает классический текстовый редактор WordPad в операционной системе Windows 11. После того как Microsoft исключила WordPad из. . .

@kshyms -4 / 4 / 0 Регистрация: 21.09.2015 Сообщений: 333
	04.01.2017, 14:37 [ТС]
	124,7 7 179,5 6 Две последние точки отображаются не верно. Почему? 0

@kshyms -4 / 4 / 0 Регистрация: 21.09.2015 Сообщений: 333
	04.01.2017, 16:00 [ТС]
	уже совсем отлично только шкалу y поднять как и обозначить в вершинах x и y? Миниатюры 0