Наш телеграм (тут все твои друзья)

Кэшированная версия

Извините, ничего не найдено.

Не расстраивайся! Лучше выпей чайку!
Регистрация
Справка
Календарь

Вернуться   forum.boolean.name > Программирование игр для компьютеров > Blitz3D > Библиотеки
Перезагрузить страницу Диаграммы

Библиотеки Сторонние библиотеки для Blitz

Ответ
 
Опции темы
Старый 27.02.2011, 16:36   #1
impersonalis
Зануда с интернетом
 
Аватар для impersonalis
 
Регистрация: 04.09.2005
Сообщений: 14,014
Написано 6,798 полезных сообщений
(для 20,935 пользователей)
Диаграммы
Понадобилось тут оперативно выводить диаграммы для отладочки.
;created by impersonalis (icq: 11-999-51-51)

Const i2DSegment_FillingPointDir%=4

Function iDiagram2DSegmentMaskCreate%(R#,a1#,a2#,AlphaColorR%,AlphaColorG%,AlphaColorB%,BettaColorR%,BettaColorG%,BettaColorB%)
	;создаёт двуцветное изображение (если наложить его на квадрат, получим вписанный сегмент):
	;Alpha		цвет НЕ маски
	;Betta		цвет маски
	;----
	;R#			радиус сегмента
	;a1#,a2#		углы раствора сегмента (a2>a1)
	Local AntiA#=a2+(360-Abs(a2-a1))*0.5
	Local TFP.TFillingPoint
	Local tTFP.TFillingPoint
	Local CurBuff%=GraphicsBuffer()
	Local Mask%=CreateImage(R*2,R*2)
	Local ColorKey%
	Local DX%[i2DSegment_FillingPointDir]
	Local DY%[i2DSegment_FillingPointDir]
	Local NewColorKey%=(0 Shl 24) Or (AlphaColorR Shl 16) Or (AlphaColorG Shl 8) Or AlphaColorB
	DX[0]=-1:DX[1]=1:DX[2]=0:DX[3]=0
	DY[0]=0:DY[1]=0:DY[2]=-1:DY[3]=1
	SetBuffer ImageBuffer(Mask)
	Color AlphaColorR,AlphaColorG,AlphaColorB
	Rect 0,0,2*R,2*R
	Color BettaColorR,BettaColorG,BettaColorB
	Oval 0,0,2*R,2*R
	Color AlphaColorR,AlphaColorG,AlphaColorB
	Line R,R,R+R*Cos(a1),R-R*Sin(a1)
	Line R,R,R+R*Cos(a2),R-R*Sin(a2)	
	Delete Each TFillingPoint
	TFP=New TFillingPoint
	TFP\x=R+0.5*R*Cos(AntiA)
	TFP\y=R-0.5*R*Sin(AntiA)
	LockBuffer (ImageBuffer(Mask))
	ColorKey=ReadPixel(TFP\x,TFP\y)
	While (Last TFillingPoint)<>Null
		tTFP=Last TFillingPoint
		If ReadPixel(tTFP\x,tTFP\y)=ColorKey
			WritePixel(tTFP\x,tTFP\y,NewColorKey)
			For I=0 To i2DSegment_FillingPointDir-1
				TFP=New TFillingPoint
				TFP\x=tTFP\x+DX[i]
				TFP\y=tTFP\y+DY[i]
			Next
		EndIf
		Delete tTFP
	Wend
	UnlockBuffer (ImageBuffer(Mask))
	SetBuffer CurBuff
	MidHandle Mask
	MaskImage Mask,BettaColorR,BettaColorG,BettaColorB
	Return Mask
End Function

Type  TFillingPoint
	Field x%
	Field y%
End Type

Function iDiagram2DSegmentCreate%(R#,a1#,a2#,image%,MASKr%,MASKg%,MASKb%)
	;создаёт имагу-сектор из текстуры*
	;R#								радиус
	;a1#,a2#							углы
	;image%							текстура*
	;MASKr%,MASKg%,MASKb%		цвет маски
	Local AX%,AY%,D%
	AX=ImageWidth(image)*0.5-R
	AY=ImageHeight(image)*0.5-R
	D=2*R
	
	Local IMG%=CreateImage(D,D)
	MaskImage IMG,MASKr,MASKg,MASKb
	Local CurBuff%=GraphicsBuffer()
	Local AnotherColorR%=(MASKr Xor $FFFFFFFF) And $000000FF
	Local AnotherColorG%=(MASKg Xor $FFFFFFFF) And $000000FF
	Local AnotherColorB%=(MASKb Xor $FFFFFFFF) And $000000FF
	Local Mask%=iDiagram2DSegmentMaskCreate%(R,a1,a2,MASKr,MASKg,MASKb,AnotherColorR,AnotherColorG,AnotherColorB)
	
	SetBuffer ImageBuffer(IMG)
	CopyRect AX,AY,D,D,0,0,ImageBuffer(image)
	DrawImage Mask,R,R
	SetBuffer CurBuff
	
	FreeImage Mask
	Return IMG
End Function

Dim iDiagram2D_ANG#(0)
Dim iDiagram2D_IMG%(0)
Dim iDiagram2D_LEG$(0)
Global iDiagram2D_Count%

Function iDiagram2DCreate%(R#,strt_a#,MASKr%,MASKg%,MASKb%,Sr%,Sg%,Sb%)
	;R#								радиус диаграммы
	;strt_a#							угол, от которого строится диаграмма (угол поворота)
	;MASKr%,MASKg%,MASKb%		цвет маски
	;Sr%,Sg%,Sb%					цвет контрастных линий, разделяющих сегменты и обрамляющих диаграмму
	Local CurBuff%=GraphicsBuffer()
	Local a#=strt_a
	Local segm%
	Local ResultIMG%=CreateImage(2*R,2*R)
	SetBuffer ImageBuffer(ResultIMG)
	Color MASKr,MASKg,MASKb
	Rect 0,0,2*R,2*R
	SetBuffer CurBuff
	For i=0 To iDiagram2D_Count-1
		segm%=iDiagram2DSegmentCreate%(R,a,a+iDiagram2D_ANG(i),iDiagram2D_IMG(i),MASKr,MASKg,MASKb)
		MaskImage segm,MASKr,MASKg,MASKb
		SetBuffer ImageBuffer(ResultIMG)
		DrawImage segm,0,0

		Color Sr,Sg,Sb
		Line R,R,R+R*Cos(a),R-R*Sin(a)
		Line R,R,R+R*Cos(a+iDiagram2D_ANG(i)),R-R*Sin(a+iDiagram2D_ANG(i))

		SetBuffer CurBuff
		FreeImage segm
		a=a+iDiagram2D_ANG(i)
	Next
	SetBuffer ImageBuffer(ResultIMG)
	Color Sr,Sg,Sb
	Oval 0,0,2*R,2*R,False 
	SetBuffer CurBuff
	MaskImage ResultIMG,MASKr,MASKg,MASKb
	Return ResultIMG
End Function


Function iHistogram2DCreate%(xs%,ys%,BCr%,BCg%,BCb%,Sep%,Sr%,Sg%,Sb%)
	;xs%,ys%				размеры области, занимаемой гистограммой
	;BCr%,BCg%,BCb%		цвет фона
	;Sep%					обрамлять столбцы
	;Sr%,Sg%,Sb%			цвет обрамления
	Local max#=iDiagram2D_ANG(0)
	For i=1 To iDiagram2D_Count-1
		If max<iDiagram2D_ANG(i)
			max=iDiagram2D_ANG(i)
		EndIf
	Next
	;=
	Local YK#=ys/max
	Local dX#=xs/iDiagram2D_Count
	Local CurBuff%=GraphicsBuffer()
	Local ResultIMG%=CreateImage(xs,ys)
	SetBuffer ImageBuffer(ResultIMG)
	Color BCr,BCg,BCb
	Rect 0,0,xs,ys
	For i=0 To iDiagram2D_Count-1
		Local x#=i*dX
		Local y#=ys-YK*iDiagram2D_ANG(i)
		CopyRect(0,0,dX,YK*iDiagram2D_ANG(i),x,y,ImageBuffer(iDiagram2D_IMG(i)))
		If Sep
			Color Sr,Sg,Sb
			Rect x,y,dX,YK*iDiagram2D_ANG(i),False
		EndIf
	Next
	SetBuffer CurBuff
	MaskImage ResultIMG,BCr,BCg,BCb
	Return ResultIMG
End Function

Function iGramLegendCreate%(BCr%,BCg%,BCb%,TCr%,TCg%,TCb%,Sep%,Sr%,Sg%,Sb%)
	;BCr%,BCg%,BCb%		цвет фона
	;TCr%,TCg%,TCb%		цвет текста
	;Sep%					обрамлять
	;Sr%,Sg%,Sb%			цвет обрмления
	Local SHIFT1%=StringWidth(" ")
	Local D%=FontHeight()
	Local YS%=D*iDiagram2D_Count
	Local XS%=StringWidth(iDiagram2D_LEG(0)+Str(iDiagram2D_ANG(0)))
	For i=1 To iDiagram2D_Count-1
		If XS<StringWidth(iDiagram2D_LEG(i)+Str(iDiagram2D_ANG(i)))
			XS=StringWidth(iDiagram2D_LEG(i)+Str(iDiagram2D_ANG(i)))
		EndIf
	Next
	XS=XS+D+SHIFT1*2
	Local CurBuff%=GraphicsBuffer()
	Local ResultIMG%=CreateImage(XS,YS)
	SetBuffer ImageBuffer(ResultIMG)
	Color BCr,BCg,BCb
	Rect 0,0,XS,YS
	For i=0 To iDiagram2D_Count-1
		Local x#=0
		Local y#=i*D
		CopyRect(0,0,D,D,x,y,ImageBuffer(iDiagram2D_IMG(i)))
		Color TCr,TCg,TCb
		Text x+D,y," "+Str(iDiagram2D_ANG(i))+" "+iDiagram2D_LEG(i)
		If Sep
			Color Sr,Sg,Sb
			Rect x,y,D,D,False
		EndIf
	Next
	SetBuffer CurBuff
	Return ResultIMG
End Function

Function iGramMonoTexCreate%(xs%,ys%,ind%)
	;xs%,ys%		размеры текстуры
	;ind%			номер текстуры 1..14
	Local CurBuff%=GraphicsBuffer()
	Local ResultIMG%=CreateImage(xs,ys)
	SetBuffer ImageBuffer(ResultIMG)
	Local A%,B%
	If ind>7
		ind=ind-7
		A=150
		B=255
	Else
		A=255
		B=0
	EndIf
	Color A,A,A
	Rect 0,0,xs,ys
	Color B,B,B
	Select ind
		Case 1
			;=
		Case 2
			For i=0 To xs Step 5;p
				Line i,0,i,ys
			Next
		Case 3
			For i=0 To ys Step 5;p
				Line 0,i,xs,i
			Next
		Case 4
			For i=0 To xs*2 Step 10;p*2
				Line 0+i,ys,-ys+i,0
			Next
		Case 5
			For i=0 To xs*2 Step 10;p*2
				Line xs-i,ys,xs+ys-i,0
			Next
		Case 6
			For i=0 To xs*2 Step 20;p*2*2
				Line xs-i,ys,xs+ys-i,0
				Line 0+i,ys,-ys+i,0
			Next
		Case 7
			For i=0 To xs Step 10;p*2
				Line i,0,i,ys
				Line 0,i,xs,i
			Next
		Default
		;=
	End Select
	SetBuffer CurBuff
	Return ResultIMG
End Function
;===demo code=======================
Graphics 800,600,32,2
SetBuffer BackBuffer()
SetFont LoadFont("Arial",20)


iDiagram2D_Count=14
Dim iDiagram2D_ANG(iDiagram2D_Count-1)
Dim iDiagram2D_IMG(iDiagram2D_Count-1)
Dim iDiagram2D_LEG(iDiagram2D_Count-1)

Local total%=0
Local pp#=360/Float(iDiagram2D_Count)
For i=0 To iDiagram2D_Count-1
	iDiagram2D_IMG(i)=iGramMonoTexCreate(200,200,i+1)
	iDiagram2D_ANG(i)=Rand(pp*0.5,pp)
	iDiagram2D_LEG(i)=Chr(Rand(65,90))+Chr(Rand(97,122))+Chr(Rand(97,122))
	total=total+iDiagram2D_ANG(i)
Next
iDiagram2D_ANG(iDiagram2D_Count-1)=360-(total-iDiagram2D_ANG(iDiagram2D_Count-1))

Local LEGEND%=iGramLegendCreate%(255,255,255,0,0,0,True,0,0,0)
Local HIST%=iHistogram2DCreate%(200,200,255,0,255,1,255,0,0)
Local DIAGR=iDiagram2DCreate(100,Rand(0,369),255,0,255,0,0,0)




ClsColor 200,200,0
Cls

DrawBlock LEGEND,10,10
DrawImage HIST,10+ImageWidth(LEGEND)+10,10
DrawImage DIAGR,10+ImageWidth(LEGEND)+10,10+ImageHeight(HIST)+10

Flip
WaitKey()
End
iGramMonoTexCreate - создаёт семл простой текстуры, для использования в диаграммах. В коллекции 14 семплов, удобных для вывода на печать ч\б принтером - привет офисная отчётность!
iGramLegendCreate - создаёт картинку-легенду к диаграмме
iHistogram2DCreate - создаёт столбчатую диаграмму
iDiagram2DCreate - создаёт круговую диаграмму
iDiagram2DSegmentCreate - создаёт текстурированный сегмент круговой диаграммы
iDiagram2DSegmentMaskCreate - создаёт маску сегмента. И да - для заливки рекурсия не нужна.

Разумеется, можно использовать в качестве текстур свои image == )
При использовании - указать имя автора в about == )
Миниатюры
Нажмите на изображение для увеличения Название: Буфер обмена02.jpg Просмотров: 1214 Размер: 34.6 Кб ID: 12826  
__________________
http://nabatchikov.com
Мир нужно делать лучше и чище. Иначе, зачем мы живем? tormoz
А я растила сына на преданьях
о принцах, троллях, потайных свиданьях,
погонях, похищениях невест.
Да кто же знал, что сказка душу съест?
(Offline)
 
 Ответить с цитированием
Эти 6 пользователя(ей) сказали Спасибо impersonalis за это полезное сообщение:
Dream (28.02.2011), FireOwl (27.02.2011), moka (28.02.2011), Randomize (28.02.2011), SBJoker (27.02.2011), Tadeus (02.03.2011)
Ответ

« Предыдущая тема | Следующая тема »

Опции темы

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения
BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.


Часовой пояс GMT +4, время: 02:41.


vBulletin® Version 3.6.5.
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Перевод: zCarot
Style crйe par Allan - vBulletin-Ressources.com

Обратная связь - Форум портала www.boolean.name - Вверх