purebasic.info

PureBasic forum
Текущее время: Ср окт 17, 2018 9:39 pm

Часовой пояс: UTC + 3 часа




Начать новую тему Ответить на тему  [ Сообщений: 3 ] 
Автор Сообщение
 Заголовок сообщения: Линейный график
СообщениеДобавлено: Пт окт 05, 2018 12:39 pm 
Не в сети
профессор

Зарегистрирован: Чт сен 22, 2011 6:21 pm
Сообщений: 257
Благодарил (а): 34 раз.
Поблагодарили: 25 раз.
Пункты репутации: 0
Линейный график с авто-масштабом, многоканальный.(модуль)
зы. возможно подобные были... тогда еще один лисапед.

Обновление:
* Теперь данных может быть меньше размера окна.
* Правильно показывает когда нет данных (например все 0)
Код:
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
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
;*********************************
; Module:   CHART
; Author:   void
; Compiler: PB546
; Ver:      003
;
; линейный график с авто-масштабом на несколько линий.
;*********************************
DeclareModule CHART
  EnableExplicit
  #GridColor    = $E0E0E0
  #WidthBorder  = 50
  #HeightBorder = 20
  #WidthGrid    = 20
  #HeightGrid   = 20
  #MinDouble    = -1e308
  #MaxDouble    = 1e308
 
  ;Параметры: Заголовок, Ширина, Высота, Массив_Значений, Массив_Цветов, Флаг_глобального_масштаба(масштаб по всему диапозону)
  Declare Open(Name$,Width,Height,Array d.d(2), Array c.l(2), GlobMinMax = #False)
 
EndDeclareModule
Module CHART
  EnableExplicit
 
  Procedure DrawGraph(Canvas, StartIdx, Interval, Font, Array d.d(2), Array c.l(2), GlobMinMax)
    Protected Max.d,  Min.d, Multipler.d, Shifter.d
    Protected i, j, EndIdx, Width, Height, y1.d, y2.d, m.d, s$, strw, e
   
    StartDrawing(CanvasOutput(Canvas))
    DrawingFont(FontID(Font))
   
    Width = OutputWidth()-#WidthBorder
    Height = OutputHeight()-#HeightBorder
   
    ;рисуем экран и рамку
    Box(0, 0, OutputWidth(), OutputHeight(), #White)
    LineXY(0, 0, Width, 0, #Black)
    LineXY(0, 0, 0, Height, #Black)
    LineXY(Width,Height, Width, 0, #Black)
    LineXY(Width,Height, 0, Height, #Black)
   
    ;корректируем начальный индекс, на выход из диапазона
    If StartIdx > ArraySize(d(),2) - Width / Interval - 1
      StartIdx = ArraySize(d(),2) - Width / Interval - 1
    EndIf
    If StartIdx < 0
      StartIdx = 0
    EndIf
   
    EndIdx = StartIdx + Width / Interval
   
    ;ищем минимальное и максимальное значение
    ;при глобальном масштабе вычисляем по всему массиву
    ;иначе, по видимым данным
    Max = #MinDouble
    Min = #MaxDouble
    For j = 0 To ArraySize(d(),1)
      If GlobMinMax
        For i = 0 To ArraySize(d(),2)
          If Max < d(j,i)
            Max = d(j,i)
          EndIf
          If Min > d(j,i)
            Min = d(j,i)
          EndIf
        Next    
      Else
        For i = StartIdx To EndIdx
          If Max < d(j,i)
            Max = d(j,i)
          EndIf
          If Min > d(j,i)
            Min = d(j,i)
          EndIf
        Next
      EndIf
    Next    
   
    ;вычисляем текущий масштаб для вписывания в окно
    If Min <> Max
      Multipler = (Height - #HeightGrid * 2) / (Max - Min)
    Else
      Multipler = (Height - #HeightGrid * 2)
    EndIf
    Shifter = Min * Multipler + Height - #HeightGrid        
   
    ;рисуем вертикальные линии сетки и подписи снизу
    i = #WidthGrid * Interval
    While i < Width
      LineXY(i,1,i,Height-1,#GridColor)
      s$ = Str(i/Interval + StartIdx)
      strw = TextWidth(s$)/2
      DrawText(i-strw,Height+5,s$,#Black,#White)
      i + (#WidthGrid * Interval)
    Wend
   
    ;рисуем горизонтальные линии сетки и подписи справа
    For i = #HeightGrid  To Height - #HeightGrid  Step #HeightGrid
      LineXY(1,i,Width-1,i,#GridColor)
      m = (Shifter-i)/Multipler
      If m < 0
        s$ = StrD(m,5)
      Else
        s$ = " "+StrD(m,5)
      EndIf
      DrawText(Width+4,i-5,s$,#Black,#White)
    Next
   
    ;если данных меньше ширины окна
    e = Width / Interval - 1
    If e > ArraySize(d(),2) - 1
      e = ArraySize(d(),2) - 1
    EndIf
   
    ;рисуем сам график
    For j = 0 To ArraySize(d(),1)
      For i = 0 To e
        y1 = Shifter - d(j, StartIdx + i) * Multipler
        y2 = Shifter - d(j, StartIdx + i + 1) * Multipler
        LineXY(Interval * i , y1, Interval * (i + 1), y2, c(j,StartIdx + i))
      Next
    Next
   
    StopDrawing()
    ProcedureReturn StartIdx
  EndProcedure
 
  Procedure Open(Name$,Width,Height,Array d.d(2), Array c.l(2),GlobMinMax=#False)
    Protected hwnd,canvas,Event,drawed,curx,oldx,lkndwn,deltax,Interval=1,curidx,Font,OldInt
    hwnd = OpenWindow(#PB_Any, 0, 0, Width, Height, Name$ + " (Use: 1,2,3,4,Left,Right,Up,Down,Mouse drag,Wheel)",
                      #PB_Window_SizeGadget|#PB_Window_SystemMenu|#PB_Window_MinimizeGadget|
                      #PB_Window_MaximizeGadget|#PB_Window_ScreenCentered)
    canvas = CanvasGadget(#PB_Any, 0, 0, WindowWidth(hwnd), WindowHeight(hwnd), #PB_Canvas_Keyboard)
    SetGadgetAttribute(canvas,#PB_Canvas_Cursor,#PB_Cursor_Cross)
    SetActiveGadget(canvas)
    Font=LoadFont(#PB_Any,"Proggy",7)
    Repeat
      Event = WaitWindowEvent()
      Select Event
        Case #PB_Event_SizeWindow
          ResizeGadget(canvas, 0, 0, WindowWidth(hwnd), WindowHeight(hwnd))
          drawed = #False
        Case  #PB_Event_Gadget
          Select  EventType()
            Case #PB_EventType_LeftButtonDown
              oldx = GetGadgetAttribute(canvas, #PB_Canvas_MouseX)
              lkndwn = #True
            Case #PB_EventType_LeftButtonUp
              lkndwn = #False
            Case #PB_EventType_MouseMove
              curx = GetGadgetAttribute(canvas, #PB_Canvas_MouseX)
            Case #PB_EventType_MouseWheel
              deltax = GetGadgetAttribute(canvas, #PB_Canvas_WheelDelta) * 100
            Case #PB_EventType_KeyDown
              Select GetGadgetAttribute(canvas, #PB_Canvas_Key)
                Case #PB_Shortcut_Left
                  deltax - 10
                Case #PB_Shortcut_Right  
                  deltax + 10
                Case #PB_Shortcut_Up
                  deltax - WindowWidth(hwnd) + #WidthBorder
                Case #PB_Shortcut_Down
                  deltax + WindowWidth(hwnd) - #WidthBorder
                Case #PB_Shortcut_1  
                  Interval = 1
                Case #PB_Shortcut_2
                  Interval = 2
                Case #PB_Shortcut_3
                  Interval = 3
                Case #PB_Shortcut_4
                  Interval = 4
              EndSelect
          EndSelect
      EndSelect
      If lkndwn And oldx <> curx
        deltax =  oldx - curx
        oldx = curx
      EndIf
      If deltax Or OldInt <> Interval
        curidx + deltax  
        deltax = 0
        OldInt = Interval
        drawed = #False
      EndIf
      If Not drawed
        curidx = DrawGraph(canvas, curidx, Interval, Font, d(), c(), GlobMinMax)
        drawed = #True
      EndIf
    Until Event = #PB_Event_CloseWindow
    FreeFont(Font)
    FreeGadget(canvas)
    CloseWindow(hwnd)
  EndProcedure
 
EndModule
;Test Module
CompilerIf #PB_Compiler_IsMainFile
  Dim d.d(1,5000)
  Dim c.l(1,5000)
 
  For i = 0 To 5000
   
    d(0,i) = Sin(Radian(i))
    If d(0,i) > 0
      c(0,i) = #Red
    Else
      c(0,i) = #Blue
    EndIf
   
    d(1,i) = Cos(Radian(i))
    If d(1,i) > 0
      c(1,i) = #Green
    Else
      c(1,i) = #Magenta
    EndIf
   
  Next
 
  CHART::Open("Sin - Cos Global Scale ",800,620,d(),c(),#True)
 
  Dim d.d(0,5000)
  Dim c.l(0,5000)
 
  For i = 0 To 5000
    d(0,i) = i
  Next
 
  CHART::Open("Linear Local Scale ",800,620,d(),c(),#False)
 
CompilerEndIf
 



Последний раз редактировалось Kuzmat Чт окт 11, 2018 12:52 pm, всего редактировалось 2 раз(а).

Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: Линейный график
СообщениеДобавлено: Пт окт 05, 2018 4:10 pm 
Не в сети
профессор

Зарегистрирован: Вс июл 05, 2009 5:55 pm
Сообщений: 220
Благодарил (а): 1 раз.
Поблагодарили: 7 раз.
Пункты репутации: 0
прикольно.
Правда нет ноля и его линии, она гуляет везде при маштабировании.
Сетка должна также маштабироваться и менять шаг если слишком мелкий шаг получился.
Вертикальная сетка(шаг) должна быть кратна какимто числам например
0.0
0.5
10.

или
0.0
0.125
.25
.5
.075
1.0
или гуще так проще считать параметры иначе без калькулятора никак :roll: .
По горизонту особо несмотрел, но бросается в глаза что когда числа большие получается слитная строка без пробелов.
А так ничё получилось :) , правда гдето видел велосипед на пурике и даже неодин.

_________________
искатель истины


Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: Линейный график
СообщениеДобавлено: Пт окт 05, 2018 4:18 pm 
Не в сети
профессор

Зарегистрирован: Чт сен 22, 2011 6:21 pm
Сообщений: 257
Благодарил (а): 34 раз.
Поблагодарили: 25 раз.
Пункты репутации: 0
Для моих целей, ноль не нужен (он вне диапазона), а нужно отслеживать относительные изменения, без особой привязки к уровням.

зы. макет - есть, раздел - "OpenSource", кому надо - тот допилит под свои хотелки...


Вернуться наверх
 Профиль  
 
Показать сообщения за:  Сортировать по:  
Начать новую тему Ответить на тему  [ Сообщений: 3 ] 

Часовой пояс: UTC + 3 часа


Кто сейчас на форуме

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 1


Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

Найти:
Перейти:  
Создано на основе phpBB® Forum Software © phpBB Group (блог о phpBB)
Сборка создана CMSart Studio
Русская поддержка phpBB