http://www.purebasic.fr/english/viewtopic.php?p=503793#p503793 wrote:Posted: Sat Mar 04, 2017 12:27 pm
How can the first post have a later date than the second post? Mysterious.http://www.purebasic.fr/english/viewtopic.php?p=503810#p503810 wrote:Posted: Sat Mar 04, 2017 9:14 pm
Code: Select all
EnableExplicit
Global.d cX0, cY0
Global.d mX, mY
Global xMax2, yMax2
;{ Simple Graph }
; Еще одна штука для простых "визуальных эффектов"
; 2017 (c) Luna Sole
; v1.0.0.4 (+ взаимодействие с мышью)
; Рисует график с двумя линиями на заданном изображении с использованием векторной библиотеки PB
; hImgOut Изображение PB для рисования может быть любого размера [кроме, возможно, «очень низкого» разрешения ^^]
; xMax, xMin максимальная и максимальная величина X графика
; yMax максимальная величина Y графика
; GridStepX Шаг сетки X [вертикальные линии], измеренное в количестве GraphData (). используйте 0 для отключения
; GridStepY Шаг сетки Y [горизонтальные линии], измеренное в значениях GraphData (). 0 для отключения
; FontSize размер шрифта текстовых меток. используйте 0, чтобы отключить метки
; ColorGrid цвета для элементов графика (RGB)
; RETURN: нет, изображение изменено в случае успеха
Procedure DrawGrid(hImgOut, xMax, xMin, yMax, GridStepX = 10, GridStepY = 10, FontSize = 9, ColorGrid = $BBFFFFFF)
Protected maxValues ; разница между xMax - xMin
Protected t ; переменная цикла для перечисления во времени, по оси Y
If yMax < 1
ProcedureReturn ; выйти, если данные из одной точки, график должен быть из нескольких точек по оси Y
EndIf
yMax2 = yMax ; задаём внешний, чтобы перечислять в цикле
; сделать вещи, чтобы лучше подогнать фоновую сетку
If GridStepY > 0
If xMax >= 0
xMax + GridStepY - xMax % GridStepY
ElseIf xMax
xMax - xMax % GridStepY
EndIf
If xMin > 0
xMin - xMin % GridStepY
ElseIf xMin < 0
xMin - (GridStepY + xMin % GridStepY)
EndIf
EndIf
maxValues = xMax - xMin
If maxValues <= 0
maxValues = 1
EndIf
; минимум значений оси Х
xMax2 = xMax
; загрузить шрифт для текстовых меток
Protected Font
If FontSize > 0
Font = LoadFont(#PB_Any, "arial", FontSize)
If Not IsFont(Font) ; и так далее
Font = LoadFont(#PB_Any, "tahoma", FontSize)
If Not IsFont(Font) ; и так далее.. :)
Font = LoadFont(#PB_Any, "consolas", FontSize)
EndIf
EndIf
EndIf
; рисовать данные в изображение
If StartVectorDrawing(ImageVectorOutput(hImgOut, #PB_Unit_Pixel))
Protected.d oX = 1.0, oY = oX
Protected.d mtW = 1.0, mtH = mtW
; временные переменные, используемые при рисовании
Protected.d cX, cY
Protected.d tLast
; [n] - определить смещения графиков / размеры текстовых меток и т. д.
If IsFont(Font)
VectorFont(FontID(Font), FontSize)
If VectorTextWidth(Str(xMax)) > VectorTextWidth(Str(xMin)) ; задаём ширину текста
oX = VectorTextWidth(Str(xMax)) + 2.0
Else
oX = VectorTextWidth(Str(xMin)) + 2.0
EndIf
oY = VectorTextHeight("0A") + 2.0
If oX > oY
oY = oX
Else
oX = oY
EndIf
mtW = VectorTextWidth(Str(yMax)) * 1.2
mtH = VectorTextHeight(Str(xMax)) * 0.8
EndIf
; множители для масштабирования координат графика
mX = (VectorOutputWidth() - oX * 2.0) / (yMax + Bool(yMax = 0))
mY = (VectorOutputHeight() - oY * 2.0) / maxValues
; [0] - рисовать текстовые метки и линии сетки
VectorSourceColor(ColorGrid) ; цвет меток и сетки шкалы
; горизонтальные линии / метки
tLast = oY + maxValues * mY + 5.0
If GridStepY > 0
For t = maxValues To 0 Step -1
If t % GridStepY = 0 Or t = maxValues
cY = oY + t * mY
; нарисовать текстовую метку
If IsFont(Font) And cY < tLast
MovePathCursor(oX - (2.0 + VectorTextWidth(Str(xMax - t))), cY - VectorTextHeight(Str(xMax - t)) / 2)
DrawVectorText(Str(xMax - t))
tLast = cY - mtH
EndIf
; нарисовать линию сетки
MovePathCursor(oX, oY + mY * t)
AddPathLine(oX + yMax * mX, oY + mY * t)
EndIf
Next
EndIf
; вертикальные линии / метки
tLast = 0.0
If GridStepX > 0
;GridStepX + 1
For t = 0 To yMax
If t % GridStepX = 0 Or t = yMax
cX = oX + t * mX
cY = oY + maxValues * mY
; нарисовать текстовую метку
If IsFont(Font) And cX > tLast
MovePathCursor(cX - VectorTextWidth(Str(t)) / 2, cY + 2.0)
DrawVectorText(Str(t))
tLast = cX + mtW
EndIf
; нарисовать линию сетки
MovePathCursor(cX, oY)
AddPathLine(cX, cY)
EndIf
Next
EndIf
; fin
If GridStepX > 0 Or GridStepY > 0
DashPath(1.0, 3.0)
EndIf
cX0 = oX
cY0 = oY
; StrokePath(LineWidth)
; очистить
StopVectorDrawing()
EndIf
; очистить
If IsFont(Font)
FreeFont(Font)
EndIf
EndProcedure
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Тест / пример
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; используется для обработки кликов мыши по графику
; mapkey - координата X изображения графика, value - соответствующий индекс в массиве GraphData()
Global NewMap GraphGeodata()
; Размеры графика
Global W = 800, H = 600
; Изображение для рисования графика
Global tImg
; Окно и холст для отображения графика
Global tWindow, tCanvas
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; сгенерировать графические данные
; 127 определяет число точек по оси Y
; создать изображение для получения вывода
tImg = CreateImage(#PB_Any, W, H, 32, $1B1B1B) ; цвет фона тут
DrawGrid(tImg, 60, -60, 127, 10, 10, 12)
; нарисовать график на созданном изображении
; Debug mX ; = 5.9
; Debug mY ; = 4
; Debug cX0 ; = 19.34375
; Debug cY0 ; = 19.34375
Define.d tmp, LineWidth = 1
Define t, j
Global Plot_Dot.b = 0
; Color цвет линии графика (RGB)
; LineWidth ширина линии (в пикселях)
; Plot_Dot показывать ли точки на графике
Procedure DrawGraph(tmp.d, t)
; временные переменные, используемые при рисовании
Protected.d cX, cY
cX = cX0 + mX * t
cY = cY0 + mY * (xMax2 - tmp)
If t = 0
MovePathCursor(cX0, cY)
EndIf
AddPathLine(cX, cY) ; добавить линию
If Plot_Dot
AddPathCircle(cX, cY, 2.0) ; добавить точку
EndIf
MovePathCursor(cX, cY) ; восстановить позицию курсора
EndProcedure
If StartVectorDrawing(ImageVectorOutput(tImg, #PB_Unit_Pixel)) ; открываем рисование
; рисуем синусоиду (выпрямленный ток) жёлтая
VectorSourceColor($FF00B1CB) ; задаём цвет линии (с добавлением альфа-канала слева ARGB)
j = 45
For t = 0 To yMax2
tmp = 60 * Abs(Sin(Radian(j-90)))
j+5
DrawGraph(tmp, t)
Next
StrokePath(LineWidth) ; рисует график в заданном цвете
; рисуем поверх косинусоиду
VectorSourceColor($FF80A800)
j = 0
For t = 0 To yMax2
tmp = 60 * Cos(Radian(j-90))
j+5
DrawGraph(tmp, t)
Next
StrokePath(LineWidth)
; рисуем поверх синусоиду
VectorSourceColor($FF9900FF) ; $00A800
j=0
For t = 0 To yMax2
tmp = - 60 * Sin(Radian(j-90))
j+5
DrawGraph(tmp, t)
Next
StrokePath(LineWidth)
; Plot_Dot = 1
; рисуем экпоненту
VectorSourceColor($FF2A04FF)
For t = 0 To yMax2 ; Step 6
; tmp = t * 0.8 - 60 ; линия наклонная
tmp = 60 * Exp(- t / 24) ; экпонента
DrawGraph(tmp, t)
Next
StrokePath(LineWidth)
; рисуем линию
VectorSourceColor($FF00A800)
DrawGraph(- 60, 0) ; начало
DrawGraph(127 * 0.8 - 60, 127) ; и конец линии
; For t = 0 To yMax2 Step 127
; tmp = t * 0.8 - 60 ; линия наклонная
; DrawGraph(tmp, t)
; Next
StrokePath(LineWidth)
; рисуем треугольную
VectorSourceColor($FFFF8C00)
For t = 0 To yMax2
tmp = 20 * (t/10 - 2 * Round((t/10 + 1) / 2, #PB_Round_Down)) * Pow(-1, Round((t/10 + 1) / 2, #PB_Round_Down)) - 40 ; Треугольный
DrawGraph(tmp, t)
Next
StrokePath(LineWidth)
StopVectorDrawing()
EndIf
; показать окно с графиком
tWindow = OpenWindow(#PB_Any, 0, 0, W, H, "График", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
; использовал ImageGadget вместо CanvasGadget, так заработало на Linux
CompilerSelect #PB_Compiler_OS
CompilerCase #PB_OS_Windows
tCanvas = CanvasGadget(#PB_Any, 0, 0, W, H)
SetGadgetAttribute(tCanvas, #PB_Canvas_Image, ImageID(tImg))
CompilerCase #PB_OS_Linux
ImageGadget(#PB_Any, 0, 0, W, H, ImageID(tImg))
CompilerEndSelect
; освободить изображение
FreeImage(tImg)
Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow
The happiness is a road...Code: Select all
;{ Simple Graph }
; Yet another stuff for simple 'visuals'
; 2017 (c) Luna Sole
; v1.0.0.4 (+ mouse interaction)
; Digital32 Updates:
; Original Code - Forum Post: https://www.purebasic.fr/english/viewtopic.php?t=67464&hilit=graph
; 10/18/2023 - Compile and Execute Test with PB 6.03
; 10/18/2023 - IsFont was not working - Added Check for Font = 0
; 10/18/2023 - Added "TextColor" option to control grid and text color
; 10/18/2023 - Changed DrawSimpleGraph() Procedure input: Color1/Color2 to DataPointColor/AvgColor - More Descriptive
; 10/22/2023 - Added Warning and Failure Line Color Changing Option (For Thresholds in the Graph)
; 01/04/2024 - Compile and Execute Test with PB 6.04
; 10/08/2024 - Compile and Execute Test with PB 6.12
; Draws graph with 2 lines on given image using PB vector library
; hImgOut PB image to draw on it, can be any size [except maybe "extremely low" resolutions ^^]
; GraphData() array with items to visualise, should have at least 1 item [starting from 0]
; OutGeoData() map to receive data required to handle mouse interaction. map key = X coordinate on graph image, value = related index of GraphData()
; Average how many items use to calculate averaged value for current item? 2 is minimum, if less it will be disabled
; GridStepX X grid resolution [vertical lines], measured in GraphData() count. use 0 to disable
; GridStepY Y grid resolution [horizontal lines], measured in GraphData() values. 0 to disable
; FontSize font size of text labels. use 0 to disable labels
; DataPointColor color of data points
; AvgColor color of average line
; TextColor color of Grid Lines and Text
; DataPointWarningValue data point >= warning value. use 0 to disable
; DataPointWarningColor color of line and circle if >= DataPointWarningValue
; DataPointFailValue data point >= failure value. use 0 to disable
; DataPointFailColor color of line and circle if >= DataPointFailValue
; RETURN: none, image modified on success
Procedure DrawSimpleGraph(hImgOut, Array GraphData(1), Map OutGeoData(), Average, GridStepX = 10, GridStepY = 10, FontSize = 9, DataPointColor = $00DDDD, AvgColor = $DDDD00, TextColor = $000000, DataPointWarningValue = 0, DataPointWarningColor = $00FFFF,DataPointFailValue = 0, DataPointFailColor = $0000FF)
ClearMap(OutGeoData()) ; reset mouse data
Protected maxItems = ArraySize(GraphData()) ; count of items (X)
Protected maxValues ; count of values (Y)
Protected highValue, lowValue ; highest and lowest GraphData values
Protected t ; generic temp variable
If maxItems < 0 : ProcedureReturn : EndIf ; quit if GraphData array is invalid
; detect higher/lower values
Protected Dim TData(0)
CopyArray(GraphData(), TData())
SortArray(TData(), #PB_Sort_Ascending)
lowValue = TData(0)
highValue = TData(maxItems)
FreeArray(TData())
; do some stuff to better fit background grid
If GridStepY > 0
If highValue >= 0
highValue + GridStepY - highValue % GridStepY
ElseIf highValue
highValue - highValue % GridStepY
EndIf
If lowValue > 0
lowValue - lowValue % GridStepY
ElseIf lowValue < 0
lowValue - (GridStepY + lowValue % GridStepY)
EndIf
EndIf
maxValues = highValue - lowValue
If maxValues <= 0
maxValues = 1
EndIf
; load font for text labels
Protected Font
If FontSize > 0
Font = LoadFont(#PB_Any, "arial", FontSize)
If Not IsFont(Font) ; and so on
Font = LoadFont(#PB_Any, "tahoma", FontSize)
If Not IsFont(Font) ; and so on.. :)
Font = LoadFont(#PB_Any, "consolas", FontSize)
EndIf
EndIf
EndIf
; draw data to image
If StartVectorDrawing(ImageVectorOutput(hImgOut, #PB_Unit_Pixel))
; [n] - define graph offsets / text labels sizes / etc
Protected.d oX = 1.0, oY = oX
Protected.d mtW = 1.0, mtH = mtW
If IsFont(Font) And Font <> 0
VectorFont(FontID(Font), FontSize)
If VectorTextWidth(Str(highValue)) > VectorTextWidth(Str(lowValue))
oX = VectorTextWidth(Str(highValue)) + 2.0
Else
oX = VectorTextWidth(Str(lowValue)) + 2.0
EndIf
oY = VectorTextHeight("0A") + 2.0
If oX > oY
oY = oX
Else
oX = oY
EndIf
mtW = VectorTextWidth(Str(maxItems)) * 1.2
mtH = VectorTextHeight(Str(highValue)) * 0.8
EndIf
; line width (pixels)
Protected.d LineWidth = 1.0
; multipliers to scale graph coordinates
Protected.d mX = (VectorOutputWidth() - oX * 2.0) / (maxItems + Bool(maxItems = 0))
Protected.d mY = (VectorOutputHeight() - oY * 2.0) / maxValues
; tmp variables used in drawing
Protected.d cX, cY
; [0] - draw text labels and grid lines
VectorSourceColor(TextColor | $FF000000)
Protected.d tLast
; horizontal lines/labels
tLast = oY + maxValues * mY + 5.0
If GridStepY > 0
For t = maxValues To 0 Step -1
;Debug("maxValues: " + maxValues)
If t % GridStepY = 0 Or t = maxValues
cY = oY + t * mY
; draw text label
If IsFont(Font) And cY < tLast
MovePathCursor(oX - (2.0 + VectorTextWidth(Str(highValue - t))), cY - VectorTextHeight(Str(highValue - t)) * 0.5)
DrawVectorText(Str(highValue - t))
tLast = cY - mtH
EndIf
; draw grid line
MovePathCursor(oX, oY + mY * t)
AddPathLine(oX + maxItems * mX, oY + mY * t)
EndIf
Next t
EndIf
; vertical lines/labels
tLast = 0.0
If GridStepX > 0
;GridStepX + 1
For t = 0 To maxItems
If t % GridStepX = 0 Or t = maxItems
cX = oX + t * mX
cY = oY + maxValues * mY
; draw text label
If IsFont(Font) And cX > tLast
MovePathCursor(cX - VectorTextWidth(Str(t)) * 0.5, cY + 2.0)
DrawVectorText(Str(t))
tLast = cX + mtW
EndIf
; draw grid line
MovePathCursor(cX, oY)
AddPathLine(cX, cY)
EndIf
Next t
EndIf
; fin
If GridStepX > 0 Or GridStepY > 0
DashPath(1.0, 3.0)
EndIf
; [1] - draw main line/items and form "geodata"
Protected.d gX = oX
Protected.d gX2
VectorSourceColor( DataPointColor | $FF000000)
MovePathCursor(oX, oY + mY * (highValue - GraphData(0)))
For t = 0 To maxItems
cX = oX + mX * t
cY = oY + mY * (highValue - GraphData(t))
; See If Warning Or Failure are > 0 to Color the Line and Circle
If GraphData(t) >= DataPointFailValue And DataPointFailValue > 0
VectorSourceColor(DataPointFailColor | $FF000000)
ElseIf GraphData(t) >= DataPointWarningValue And DataPointWarningValue > 0
VectorSourceColor(DataPointWarningColor | $FF000000)
EndIf
AddPathLine(cX, cY) ; add line
AddPathCircle(cX, cY, 2.0) ; add spot at the edge
If (GraphData(t) >= DataPointWarningValue And GraphData(t) < DataPointWarningValue) And (DataPointWarningValue > 0) ; Fill Circle if Warning
FillPath(#PB_Path_Preserve)
EndIf
If (GraphData(t) >= DataPointFailValue) And (DataPointFailValue > 0) ; Fill Circle if Failure
FillPath(#PB_Path_Preserve)
EndIf
StrokePath(LineWidth)
VectorSourceColor(DataPointColor | $FF000000) ; Reset to Default
MovePathCursor(cX, cY) ; restore cursor pos
; build that "geodata" used to handle mouse
gX2 = gX + (cX - gX) * 0.5
While gX < gX2
OutGeoData(Str(Int(gX))) = t - 1
gX + 1.0
Wend
While gX < cX
OutGeoData(Str(Int(gX))) = t
gX + 1.0
Wend
gX = cX
Next t
StrokePath(LineWidth)
; [2] - draw "trend"/averaged line
Protected NewList Avg() ; stack to store recent values
Protected.d Avg ; to calculate current result
If Average > maxItems + 1
Average = maxItems + 1
EndIf
If Average > 1 ; it makes sense to draw only if it is greater than 1
While ListSize(Avg()) < Average
AddElement(Avg()) ; 'extrapolate' using first item data, without that it looks worst as for me :3
Avg() = GraphData(0)
Wend
MovePathCursor(oX, oY + (highValue - GraphData(0)) * mY)
For t = 0 To maxItems
FirstElement(Avg()) ; this all works like a stack structure, with max deepth = Average
DeleteElement(Avg())
LastElement(Avg())
AddElement(Avg())
Avg() = GraphData(t) ; push new element
Avg = 0.0 ; calculate averaged value from recent elements
ForEach Avg()
Avg + Avg()
Next
cX = oX + mX * t
cY = oY + (highValue - Avg / Average) * mY
AddPathLine(cX, cY)
AddPathCircle(cX, cY, 1.0) ; add spot at the edge
MovePathCursor(cX, cY) ; restore cursor pos
Next t
VectorSourceColor(AvgColor | $FF000000)
StrokePath(LineWidth)
EndIf
; cls
FreeList(Avg())
StopVectorDrawing()
EndIf
; cls
If IsFont(Font)
FreeFont(Font)
EndIf
EndProcedure
;}
Keya wrote: Fri Jan 13, 2017 11:56 pm Zebuddi123 hrmm im not really experiencing any flicker on XP, and youre already using BindEvent to capture the resize which wouldve been my first suggestion anyway hehe. Nice addition btw!
