PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

Klappbuchstaben Anzeigetafel

https://www.purebasic.fr/german/viewtopic.php?t=25548

Seite 1 von 4

Klappbuchstaben Anzeigetafel

Verfasst: 26.05.2012 22:16
von Mr.L
Ich denke jeder kennt diese klappernden Anzeigetafeln in Flughäfen oder Bahnhöfen...


Hier das ganze gezippt und mit Audiodateien
TurnLetter.zip


- Ich habe den ganzen Code umgestrickt, jetzt kann man jedes Feld individuell gestalten.
- Code nochmal angepasst und den Demo- vom Include-Teil getrennt.
Das Programm sollte jetzt auch CPU-schonender sein. (durch WindowTimer)


Include-Teil als "TurnLetter_Include.pbi" speichern

Code: Alles auswählen

EnableExplicit
UseOGGSoundDecoder()

InitSound()

Structure FieldImage
	upperImage.i
	lowerImage.i
EndStructure

Structure BoardField
	x.l
	y.l
	width.l
	height.l
	
	Array *image.FieldImage(0)
	
	currentImage.l
	targetImage.l
	rotation.l
	speed.l	
EndStructure

Structure Board
	minSpeed.l
	maxSpeed.l
	List Field.BoardField()	
EndStructure

Global NewList Board.Board()
Global Time

Global UseSound = #True, CurrrentSound, SoundTime
Global Dim FlipSound(4)
FlipSound(0) = LoadSound(#PB_Any, "flip1.ogg")
FlipSound(1) = LoadSound(#PB_Any, "flip2.ogg")
FlipSound(2) = LoadSound(#PB_Any, "flip3.ogg")
FlipSound(3) = LoadSound(#PB_Any, "flip4.ogg")
FlipSound(4) = LoadSound(#PB_Any, "flip5.ogg")

Procedure Board_New(minSpeed, maxSpeed)
	AddElement(Board())
	Board()\minSpeed	= minSpeed
	Board()\maxSpeed	= maxSpeed
	ProcedureReturn Board()
EndProcedure

Procedure Board_DrawField(*field.BoardField)
	Protected x, y, width, height, h2, nextImage
	
	x			= *field\x
	y			= *field\y
	width		= *field\width
	height		= Cos(Radian(*field\rotation)) * *field\height * 0.5
	h2			= *field\height / 2	
	nextImage	= (*field\currentImage + 1) % ArraySize(*field\image())
	
	DrawImage( ImageID(*field\image(nextImage)\upperImage), x, y - 1)
	DrawImage( ImageID(*field\image(*field\currentImage)\lowerImage ), x, y + h2 + 1)
	If *field\rotation < 90
		DrawImage(ImageID(*field\image(*field\currentImage)\upperImage), x, y + h2 - height - 1, width, height)
	Else
		DrawImage( ImageID(*field\image(nextImage)\lowerImage), x, y + h2 + 1, width, -height)
	EndIf
	Box(x + 1, y + h2 - 4, 2, 8, 0)
	Box(x + width - 4, y + h2 - 4, 2, 8, 0)
	Box(x + 1, y + h2 - 1, width - 4, 2, RGB(0,0,0))
EndProcedure

Procedure Board_Draw(*board.Board, drawingOutput)
	StartDrawing(drawingOutput)
	Box(0, 0, OutputWidth(), OutputHeight(), RGB(30, 30, 30))
	ForEach *board\Field()
		Board_DrawField(*board\Field())
	Next
	StopDrawing()
EndProcedure

Procedure Board_Update(*board.Board, drawingOutput)
	StartDrawing(drawingOutput)
	
	Protected result = #False, countActive = 0
	
	ForEach *board\Field()
		With *board\Field()
			If \currentImage <> \targetImage
				result = #True
				\speed = Abs(Mod(\currentImage - \targetImage, ArraySize(\image()) - 1)) * *Board\minSpeed
				
				If \speed < *board\minSpeed
					\speed = *board\minSpeed
				ElseIf \speed > *board\maxSpeed
					\speed = *board\maxSpeed
				EndIf					
				If \rotation = 0
					countActive + 1
				EndIf
				\rotation + \speed
				If \rotation > 179						
					\rotation = 0
					\currentImage = (\currentImage + 1) % ArraySize(\image())		
				EndIf
				
				Board_DrawField(*Board\Field())
			EndIf				
		EndWith
	Next
	StopDrawing()
	
	If UseSound And countActive And Time > SoundTime
		If countActive > 4 : countActive = 4 : EndIf
		If IsSound(FlipSound(countActive))
			PlaySound(FlipSound(countActive), #PB_Sound_MultiChannel, 20)
		EndIf
		SoundTime = Time + 50
	EndIf
	
	ProcedureReturn result
EndProcedure

Procedure Board_AddField(*board.Board, x, y, width, height)
	AddElement(*board\Field())
	With *board\Field()
		\x			= x
		\y			= y
		\width		= width
		\height		= height
	EndWith
	ProcedureReturn *board\Field()
EndProcedure

Procedure Field_AddImage(*field.BoardField, image.i)
	Protected nrImages = ArraySize(*field\image())
	ReDim *field\image(nrImages + 1)
	*field\image(nrImages) = image
EndProcedure

Procedure Field_MakeSplitImage(width, height, *fieldImage.FieldImage, image)
	height = Int(height * 0.5) * 2
	*fieldImage\upperImage = CreateImage(#PB_Any, width, height  / 2)
	*fieldImage\lowerImage = CreateImage(#PB_Any, width, height  / 2)
	StartDrawing(ImageOutput(*fieldImage\upperImage))
	DrawImage(ImageID(image), 0, 0)
	StopDrawing()
	StartDrawing(ImageOutput(*fieldImage\lowerImage))
	DrawImage(ImageID(image), 0, -height / 2)
	StopDrawing()	
EndProcedure
Demo 1 - Klapptext Uhr

Code: Alles auswählen

XIncludeFile "TurnLetter_Include.pbi"

Define *myBoard.Board
Define	elapsed, displayUpdateTime, displayRefreshTime, waitTime
Define LetterWidth		= 50
Define LetterHeight	= LetterWidth * 1.6
Define LetterSpacing	= 8

Global NrLetters
Global Dim LetterImage.FieldImage(179)
Global Dim *Board.BoardField(9)

Procedure InitBoard(letterWidth, letterHeight, letterSpacing)
	Protected l, a, x, y, col, font, font1, font2, tempImage, text$
	Protected *board.Board, *field.BoardField
	Dim tempImage(6)
	
		
	*board		= Board_New(15, 90)
	font1		= LoadFont(#PB_Any, "Arial", letterHeight / 1.5, #PB_Font_HighQuality | #PB_Font_Bold)
	font2		= LoadFont(#PB_Any, "Arial", letterHeight / 2.5, #PB_Font_HighQuality | #PB_Font_Bold)
	
	tempImage(1)	= CreateImage(#PB_Any, LetterWidth / 2, letterHeight)
	tempImage(2)	= CreateImage(#PB_Any, LetterWidth * 2, letterHeight)
	tempImage(3)	= CreateImage(#PB_Any, LetterWidth, letterHeight / 2)
	tempImage(4)	= CreateImage(#PB_Any, LetterWidth * 2, letterHeight / 2)
	
	For l = 0 To 179
		Select l
			Case 0 To 59	: text$ = RSet(Str(l), 2, "0") : tempImage = tempImage(2) : font = font1 : col = RGBA(255,255,255,255)
			Case 60			: text$ = ":" : tempImage = tempImage(1)
			Case 61 To 160	: text$ = RSet(Str(l - 60), 2, "0") : tempImage = tempImage(3) : font = font2: col = RGBA(180,200,200,255)	
			Case 161 		: text$ = "JAN"	: tempImage = tempImage(4)
			Case 162		: text$ = "FEB"
			Case 163		: text$ = "MÄR"
			Case 164	 	: text$ = "APR"
			Case 165		: text$ = "MAI"
			Case 166		: text$ = "JUN"
			Case 167		: text$ = "JUL"
			Case 168		: text$ = "AUG"
			Case 169		: text$ = "SEP"
			Case 170		: text$ = "OKT"
			Case 171		: text$ = "NOV"
			Case 172		: text$ = "DEZ"
			Case 173		: text$ = "SO"	: col = RGBA(255, 25, 25,255)	
			Case 174		: text$ = "MO"	: col = RGBA(100,128,255,255)	
			Case 175		: text$ = "DI"
			Case 176		: text$ = "MI"
			Case 177		: text$ = "DO"
			Case 178		: text$ = "FR"
			Case 179		: text$ = "SA"		
		EndSelect
		
		StartDrawing(ImageOutput(tempImage))		
		DrawingFont(FontID(font))
		Box(0, 0, OutputWidth(), OutputHeight(), RGB(30, 30, 30))
 		RoundBox(0, 0, OutputWidth(), OutputHeight(), 10,10, RGB(50,50,50))
		DrawingMode(#PB_2DDrawing_Gradient)
		LinearGradient(0,0,0,OutputHeight())
		GradientColor(0.0, RGB(15,15,15))
		GradientColor(0.5, RGB(50,50,50))
		GradientColor(1.0, RGB(15,15,15))
		RoundBox(0, 0, OutputWidth() - 1, OutputHeight() - 1, 10,10)
		DrawingMode(#PB_2DDrawing_AlphaBlend | #PB_2DDrawing_Transparent)
		RoundBox(5, 5, OutputWidth()-7, OutputHeight()-7, 10,10, RGBA(255,255,255,15))
		DrawText((OutputWidth() - TextWidth(text$)) / 2, (OutputHeight() - TextHeight(text$)) / 2, text$, col)
		Line(0, OutputHeight() / 2, OutputWidth() - 1, 1, RGBA(100, 100, 100, 255))
		StopDrawing()
		Field_MakeSplitImage(ImageWidth(tempImage), ImageHeight(tempImage), @LetterImage(l), tempImage)
	Next
	
	x = LetterSpacing
	y = ImageHeight(tempImage(3)) + LetterSpacing * 2
	*Board(0)	= Board_AddField(*board, x, y, ImageWidth(tempImage(2)), letterHeight)
	x + ImageWidth(tempImage(2)) + LetterSpacing
	*Board(1)	= Board_AddField(*board, x, y, ImageWidth(tempImage(1)), letterHeight)
	x + ImageWidth(tempImage(1)) + LetterSpacing
	*Board(2)	= Board_AddField(*board, x, y, ImageWidth(tempImage(2)), letterHeight)
	x + ImageWidth(tempImage(2)) + LetterSpacing
	*Board(3)	= Board_AddField(*board, x, y, ImageWidth(tempImage(1)), letterHeight)
	x + ImageWidth(tempImage(1)) + LetterSpacing
	*Board(4)	= Board_AddField(*board, x, y, ImageWidth(tempImage(2)), letterHeight)
	
	x = LetterSpacing
	y = LetterSpacing
	*Board(5)	= Board_AddField(*board, x, y, ImageWidth(tempImage(4)), ImageHeight(tempImage(4)))
	x + ImageWidth(tempImage(4)) + LetterSpacing
	*Board(6)	= Board_AddField(*board, x, y, ImageWidth(tempImage(3)), ImageHeight(tempImage(3)))
	x + ImageWidth(tempImage(3)) + LetterSpacing
	*Board(7)	= Board_AddField(*board, x, y, ImageWidth(tempImage(4)), ImageHeight(tempImage(4)))
	x + ImageWidth(tempImage(4)) + LetterSpacing
	*Board(8)	= Board_AddField(*board, x, y, ImageWidth(tempImage(3)), ImageHeight(tempImage(3)))
	x + ImageWidth(tempImage(3)) + LetterSpacing
	*Board(9)	= Board_AddField(*board, x, y, ImageWidth(tempImage(3)), ImageHeight(tempImage(3)))
	
	For l = 0 To 23
		Field_AddImage(*Board(0), LetterImage(l))
	Next
	For l = 0 To 59
		Field_AddImage(*Board(2), LetterImage(l))
		Field_AddImage(*Board(4), LetterImage(l))
	Next	
	Field_AddImage(*Board(1), LetterImage(60))
	Field_AddImage(*Board(3), LetterImage(60))
	For l = 173 To 179
		Field_AddImage(*Board(5), LetterImage(l))
	Next
	For l = 61 To 92
		Field_AddImage(*Board(6), LetterImage(l))
	Next
	For l = 161 To 172
		Field_AddImage(*Board(7), LetterImage(l))
	Next
	For l = 61 To 160
		Field_AddImage(*Board(8), LetterImage(l))
		Field_AddImage(*Board(9), LetterImage(l))
	Next
	
	ProcedureReturn *board
EndProcedure

Procedure SetBoardText()
	Protected d = Date()
	*Board(0)\targetImage = Hour(d)
	*Board(2)\targetImage = Minute(d)
	*Board(4)\targetImage = Second(d)
	*Board(5)\targetImage = DayOfWeek(d)
	*Board(6)\targetImage = Day(d) - 1
	*Board(7)\targetImage = Month(d) - 1
	*Board(8)\targetImage = Year(d) / 100 - 1
	*Board(9)\targetImage = Year(d) - Int(Year(d) / 100.0) * 100 - 1
EndProcedure

OpenWindow(0, 0, 0, 7 * (LetterWidth + LetterSpacing) - LetterSpacing, 1.5 * LetterHeight + LetterSpacing * 3, "KlappText-Uhr", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
CanvasGadget(0, 0, 0, WindowWidth(0), WindowHeight(0) )

*myBoard = InitBoard(LetterWidth, LetterHeight, LetterSpacing)
Board_Draw(*myBoard, CanvasOutput(0))

AddWindowTimer(0, 0, 25)
displayRefreshTime = ElapsedMilliseconds()

Repeat
   Select WaitWindowEvent(15)
      Case #PB_Event_CloseWindow
         Break
      Case #PB_Event_Timer
         Time   = ElapsedMilliseconds()
      
         If Time >= displayRefreshTime
            SetBoardText()
            displayRefreshTime + 1000
         EndIf
         
         Board_Update(*myBoard, CanvasOutput(0))
   EndSelect
ForEver
Demo 2 - Anzeigetafel

Code: Alles auswählen

XIncludeFile "TurnLetter_Include.pbi"

Define *myBoard.Board
Define	elapsed, displayUpdateTime, displayRefreshTime, waitTime
Define BoardWidth		= 12
Define BoardHeight		= 5
Define LetterWidth		= 60
Define LetterHeight	= 80
Define LetterSpacing	= 10

Global Time
Global NrLetters
Global Dim LetterImage.FieldImage(255)
Global Dim *Board.BoardField(BoardWidth, BoardHeight)
Global Dim LetterNr(255)

Procedure InitBoard(boardWidth, boardHeight, letterWidth, letterHeight, letterSpacing, letterList$)
	Protected l, a, x, y, font, tempImage
	Protected *board.Board, *field.BoardField
	
	*board		= Board_New(15, 90)
	font		= LoadFont(#PB_Any, "Arial", letterHeight / 1.8, #PB_Font_HighQuality | #PB_Font_Bold)
	NrLetters	= Len(letterList$)
	tempImage	= CreateImage(#PB_Any, LetterWidth, letterHeight)
	
	For l = 0 To NrLetters - 1
		a = Asc(Mid(letterList$, l + 1, 1))	
		
		StartDrawing(ImageOutput(tempImage))		
		DrawingFont(FontID(font))
		Box(0, 0, OutputWidth(), OutputHeight(), RGB(20, 20, 20))
 		RoundBox(0, 0, OutputWidth(), OutputHeight(),  2, 2, RGB(30,30,30))
		DrawingMode(#PB_2DDrawing_Gradient)
		LinearGradient(0,0,0,OutputHeight())
		GradientColor(0.0, RGB(10,10,10))
		GradientColor(0.5, RGB(50,50,50))
		GradientColor(1.0, RGB(10,10,10))
		RoundBox(0, 0, OutputWidth()- 1, OutputHeight() - 1,  2, 2)
		DrawingMode(#PB_2DDrawing_AlphaBlend | #PB_2DDrawing_Transparent)
		RoundBox(5, 5, OutputWidth()-7, OutputHeight()-7,  2, 2, RGBA(255,255,255,15))
		DrawText((OutputWidth() - TextWidth(Chr(a))) / 2, (OutputHeight() - TextHeight(Chr(a))) / 2, Chr(a), RGBA(255,255, 140,255))
 		Line(0, OutputHeight() / 2, OutputWidth() - 1, 1, RGBA(100, 100, 100, 255))
		StopDrawing()
		LetterNr(a) = l
		Field_MakeSplitImage(ImageWidth(tempImage), ImageHeight(tempImage), @LetterImage(l), tempImage)
	Next
	
	For y = 0 To BoardHeight - 1		
		For x = 0 To BoardWidth - 1
			*field		= Board_AddField(*board, x * (letterWidth + letterSpacing) + letterSpacing, y * (letterHeight + letterSpacing) + letterSpacing, letterWidth, letterHeight)
			*Board(x, y)		= *field
			With *field
				For l = 0 To NrLetters - 1
					Field_AddImage(*field, LetterImage(l))
				Next
				\currentImage	= 0
				\targetImage	= 0
				\speed			= 0
				\rotation		= 0
			EndWith
		Next
	Next
		
	ProcedureReturn *board
EndProcedure

Procedure SetBoardText(boardWidth, rowNr, text$)
	Protected l
	
	Text$ = LSet(text$, boardWidth, " ")
	For l = 1 To Len(text$)
		If l <= boardWidth
			*Board(l - 1, rowNr)\targetImage = LetterNr(Asc(Mid(text$, l, 1)))
		EndIf
	Next
EndProcedure

OpenWindow(0, 0, 0, BoardWidth * (LetterWidth + LetterSpacing) + LetterSpacing, BoardHeight * (LetterHeight + LetterSpacing) + LetterSpacing, "PB Timetable", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
CanvasGadget(0, 0, 0, WindowWidth(0), WindowHeight(0))

*myBoard = InitBoard(BoardWidth, BoardHeight, LetterWidth, LetterHeight, LetterSpacing, " !.0123456789:ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz")
Board_Draw(*myBoard, CanvasOutput(0))

AddWindowTimer(0, 0, 25)

Repeat
	Select WaitWindowEvent()
		Case #PB_Event_CloseWindow
			End
		Case #PB_Event_Timer
			Time	= ElapsedMilliseconds()
			elapsed	= Time - displayUpdateTime
			
			If Time > displayRefreshTime
				If elapsed < 10000
					SetBoardText(BoardWidth, 0, "HELLO WORLD!")
					SetBoardText(BoardWidth, 1, "")
					SetBoardText(BoardWidth, 2, "PureBasic is")
					SetBoardText(BoardWidth, 3, "really cool!")
					SetBoardText(BoardWidth, 4, "")
					displayRefreshTime = Time + 10000
				ElseIf elapsed < 30000
					SetBoardText(BoardWidth, 0, "")
					SetBoardText(BoardWidth, 1, "CURRENT TIME")
					SetBoardText(BoardWidth, 2, "")
					SetBoardText(BoardWidth, 3, "  " + FormatDate("%hh:%ii:%ss", Date()))
					SetBoardText(BoardWidth, 4, "")
					displayRefreshTime + 1000
				ElseIf elapsed < 40000
					SetBoardText(BoardWidth, 0, "    made")
					SetBoardText(BoardWidth, 1, "     by")
					SetBoardText(BoardWidth, 2, "    Mr.L")
					SetBoardText(BoardWidth, 3, "")
					SetBoardText(BoardWidth, 4, "...have fun!")
					displayRefreshTime = Time + 10000
				Else
					displayUpdateTime = Time
				EndIf
			EndIf
		
			Board_Update(*myBoard, CanvasOutput(0))
	EndSelect
ForEver

Re: Klappbuchstaben Anzeigetafel

Verfasst: 26.05.2012 22:18
von RSBasic
Sieht gut aus. :allright:

Re: Klappbuchstaben Anzeigetafel

Verfasst: 26.05.2012 22:38
von ts-soft
Sehr schöne Simulation :allright:

Re: Klappbuchstaben Anzeigetafel

Verfasst: 26.05.2012 22:52
von Falko
Sieht aus wie echt. Prima Code :allright:

Re: Klappbuchstaben Anzeigetafel

Verfasst: 26.05.2012 22:52
von STARGÅTE
Wow :allright:

Als ich den kleinen Code kopierte habe, habe ich wirklich nicht mit sowas gerechnet.
Richtig gut :allright:

Re: Klappbuchstaben Anzeigetafel

Verfasst: 26.05.2012 23:17
von ts-soft
Wenn Du daraus einzelne "KlapperSegmentGadgets" machen würdest, könnte man es individueller Nutzen, indem man
z.B. 5 Nebeneinander setzt für eine Uhr usw.

Nur so als Anregung.

Re: Klappbuchstaben Anzeigetafel

Verfasst: 26.05.2012 23:19
von hjbremer
sehr coole Idee, Klasse :allright:

Re: Klappbuchstaben Anzeigetafel

Verfasst: 26.05.2012 23:52
von Bisonte
:allright:

Re: Klappbuchstaben Anzeigetafel

Verfasst: 27.05.2012 09:34
von Nino
Super, vielen Dank! :allright:
ts-soft hat geschrieben:"KlapperSegmentGadgets"
Na ja, das Klappergeräusch fehlt noch. ;-)

Grüße, Nino

Re: Klappbuchstaben Anzeigetafel

Verfasst: 27.05.2012 09:34
von Mr.L
ts-soft hat geschrieben:Wenn Du daraus einzelne "KlapperSegmentGadgets" machen würdest, könnte man es individueller Nutzen, indem man
z.B. 5 Nebeneinander setzt für eine Uhr usw.
Die Idee ist gut und darüber nachgedacht habe ich auch schon.
Wenn ich Zeit habe werde ich das mal umsetzen.
Nino hat geschrieben:Na ja, das Klappergeräusch fehlt noch. ;-)
Das noch einzubauen hatte ich auch schon auf dem Plan. :lol:
Alle Zeiten sind UTC+02:00
Seite 1 von 4

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de