Schriftart mit Schneeeffekt erzeugen

Fragen zu Grafik- & Soundproblemen und zur Spieleprogrammierung haben hier ihren Platz.
Michael Vogel
Beiträge: 71
Registriert: 16.03.2006 11:20

Schriftart mit Schneeeffekt erzeugen

Beitrag von Michael Vogel »

Es gibt verschiedene Schriften mit diversen Verzierungen, wie etwa diese:
- https://www.1001fonts.com/maple-3-cartoon-font.html
- https://www.creativefabrica.com/product/christmas-snow/
- https://fontbundles.net/es/plusstore/22 ... wty-3-font
- https://fontmeme.com/fonts/pw-happy-christmas-font/

...ich überlege, ob man diesen Effekt (etwa vom ersten Font oben) nicht bei beliebigen Schriften nachträglich erzeugen kann. Den Anfang habe ich gemacht, allerdings gelingt es mir nicht so recht, ein hübsches Schneehäubchen per Vektorgrafik zu malen.
Ich denke, so eine Art "Wolke" (Beispiel 1, Beispiel 2) wäre nicht schlecht. Schafft ihr das vielleicht?

Code: Alles auswählen

; Define

	#Text="Frohe Weihnachten"

	#FontName="Segoe UI"
	#FontSize=72
	#FontType=#PB_Font_Bold

	#WX=900
	#WY=200

	#FX=10
	#FY=20


	#Pen=		3

	#ColBack=	$FFFFC0
	#ColBorder=	#Black
	#ColFill=		#Yellow
	#ColSnow=	#White
	#ColShadow=#Black

	#Draw=		$FF000000
	#Color=		$00FFFFFF

	Global Dim Snow(#WX)
	Global Dim Cloud.Rect(0)

; EndDefine

Procedure Init()

	LoadFont (0,#FontName,#FontSize,#FontType)

	OpenWindow(0,0,0,#WX,#WY,"Whiter Font",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
	CanvasGadget(0,0,0,#WX,#WY)

	CreateImage(0,#WX,#WY,32,#Red)
	StartDrawing(ImageOutput(0))
	DrawingMode(#PB_2DDrawing_AllChannels)
	Box(0,0,#WX,#WY,#ColBack)
	StopDrawing()

	CompilerIf 0
		StartDrawing(ImageOutput(0))
		DrawingFont(FontID(0))
		DrawingMode(#PB_2DDrawing_AlphaBlend)
		DrawText(#FX,#FY,#Text,#Draw|#ColFill,0)
		StopDrawing()

	CompilerElse
		StartVectorDrawing(ImageVectorOutput(0))
		VectorFont(FontID(0))
		MovePathCursor(#FX,#FY)
		AddPathText(#Text)
		VectorSourceColor(#Draw|#ColBorder)
		StrokePath(#Pen+3,#PB_Path_Preserve|#PB_Path_RoundCorner)
		VectorSourceColor(#Draw|#ColFill)
		FillPath(#PB_Path_Preserve)
		StopVectorDrawing()

	CompilerEndIf

EndProcedure

Procedure Snowcloud(x,y,w,h)

	If w>10

		MovePathCursor(x,y)
		AddPathArc(w,0,w,h,10,#PB_Path_Relative)
		AddPathArc(-w,0,-w,-h,10,#PB_Path_Relative)

		VectorSourceColor(#Draw|#ColShadow)
		StrokePath(#Pen,#PB_Path_Preserve|#PB_Path_RoundCorner)
		VectorSourceColor(#Draw|#ColSnow)
		FillPath(#PB_Path_Preserve)

	EndIf


EndProcedure
Procedure Snowstorm()

	Protected a,b
	Protected x,y,z

	StartDrawing(ImageOutput(0))
	DrawingFont(FontID(0))

	While x<#WX
		While y<#WY
			If Point(x,y)&#Color=#ColBorder
				Snow(x)=y
				;Box(x,0,1,y,#Blue)
				y=#WY
			Else
				y+1
			EndIf
		Wend
		x+1
		y=0
	Wend

	;DrawingMode(#PB_2DDrawing_AlphaBlend)
	;DrawText(#FX,#FY,#Text,#Draw|#ColFill,0)
	StopDrawing()

	StartVectorDrawing(ImageVectorOutput(0))

	x=0
	y=0
	z=0
	While x<#WX
		;Debug Str(x)+": "+Str(snow(x))
		y=Snow(x)
		If y
			If z=0
				a=x
				b=y
				z=1
			ElseIf Abs(b-y)>5
				Snowcloud(a,Snow((a+x)/2),x-a,5)
				z=0
			EndIf
		Else
			If a>0
				Snowcloud(a,Snow((a+x)/2),x-a,5)
				a=0
			EndIf
			z=0
		EndIf
		x+1
	Wend



	StopVectorDrawing()


EndProcedure

Procedure Main()

	Init()
	Snowstorm()

	StartDrawing(CanvasOutput(0))
	DrawImage(ImageID(0),0,0)
	StopDrawing()

	Repeat
		Select WaitWindowEvent()
		Case #PB_Event_CloseWindow,#WM_CHAR
			End
		EndSelect
	ForEver

EndProcedure

Main()
ccode_new
Beiträge: 1214
Registriert: 27.11.2016 18:13
Wohnort: Erzgebirge

Re: Schriftart mit Schneeeffekt erzeugen

Beitrag von ccode_new »

Erstelle doch einfach eigene Schriften mit Wolken drauf.

Alles Andere sieht im Endergebnis wahrscheinlich Schei.. aus.

Ansonsten aber ein tolles Projekt.
Betriebssysteme: div. Windows, Linux, Unix - Systeme

no Keyboard, press any key
no mouse, you need a cat
Michael Vogel
Beiträge: 71
Registriert: 16.03.2006 11:20

Re: Schriftart mit Schneeeffekt erzeugen

Beitrag von Michael Vogel »

Ein Schneehäubchen habe ich einmal gebastelt - mit ein paar Varianten schaut die Sache sicher etwas besser aus.
Vorher sollte aber die Erkennung verbessert werden, "runde" Buchstaben (e,c,o,...) bekommen keine durchgehende Schneedecke und bei Schrägen (V,W,...) verhält sich die "Snowstorm"-Routine auch etwas ungelenk...

Code: Alles auswählen

; Define

	#Text="Frohe Weihnachten"

	#FontName="Segoe UI"
	#FontSize=72
	#FontType=#PB_Font_Bold

	#WX=900
	#WY=200

	#FX=10
	#FY=20


	#Pen=		3

	#ColBack=	$FFFFC0
	#ColBorder=	#Black
	#ColFill=		#Yellow
	#ColSnow=	#White
	#ColShadow=#Black

	#Draw=		$FF000000
	#Color=		$00FFFFFF

	Global Dim Snow(#WX)
	Global Dim Cloud.Rect(0)

; EndDefine

Procedure Init()

	LoadFont (0,#FontName,#FontSize,#FontType)

	OpenWindow(0,0,0,#WX,#WY,"Whiter Font",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
	CanvasGadget(0,0,0,#WX,#WY)

	CreateImage(0,#WX,#WY,32,#Red)
	StartDrawing(ImageOutput(0))
	DrawingMode(#PB_2DDrawing_AllChannels)
	Box(0,0,#WX,#WY,#ColBack)
	StopDrawing()

	CompilerIf 0
		StartDrawing(ImageOutput(0))
		DrawingFont(FontID(0))
		DrawingMode(#PB_2DDrawing_AlphaBlend|#PB_2DDrawing_Transparent)
		DrawText(#FX,#FY,#Text,#Draw|#ColFill,0)
		StopDrawing()

	CompilerElse
		StartVectorDrawing(ImageVectorOutput(0))
		VectorFont(FontID(0))
		MovePathCursor(#FX,#FY)
		AddPathText(#Text)
		VectorSourceColor(#Draw|#ColBorder)
		StrokePath(#Pen+3,#PB_Path_Preserve|#PB_Path_RoundCorner)
		VectorSourceColor(#Draw|#ColFill)
		FillPath(#PB_Path_Preserve)
		StopVectorDrawing()

	CompilerEndIf

EndProcedure

Procedure Snowcloud(x,y,w,h)

	If w>5

		TranslateCoordinates(x,y-15)
		ScaleCoordinates(w/800,0.05)

		MovePathCursor(33,327)
		AddPathCurve(20,359,33,359,59,366)
		AddPathCurve(151,399,184,353,243,372)
		AddPathCurve(308,405,341,425,420,399)
		AddPathCurve(485,379,518,346,590,366)
		AddPathCurve(656,386,695,379,741,340)
		AddPathCurve(780,300,695,274,669,261)
		AddPathCurve(603,235,524,215,459,215)
		AddPathCurve(420,222,393,228,354,228)
		AddPathCurve(249,235,99,228,33,327)
		ClosePath()
		VectorSourceColor($FFFEFEFE)
		FillPath(#PB_Path_Preserve)
		ResetCoordinates()
		VectorSourceColor($FF292A2B)
		StrokePath(2.7,#PB_Path_RoundCorner|#PB_Path_RoundEnd)

	EndIf


EndProcedure
Procedure Snowstorm()

	Protected a,b
	Protected x,y,z

	StartDrawing(ImageOutput(0))
	DrawingFont(FontID(0))

	While x<#WX
		While y<#WY
			If Point(x,y)&#Color=#ColBorder
				Snow(x)=y
				;Box(x,0,1,y,#Blue)
				y=#WY
			Else
				y+1
			EndIf
		Wend
		x+1
		y=0
	Wend

	;DrawingMode(#PB_2DDrawing_AlphaBlend)
	;DrawText(#FX,#FY,#Text,#Draw|#ColFill,0)
	StopDrawing()

	StartVectorDrawing(ImageVectorOutput(0))

	x=0
	y=0
	z=0
	While x<#WX
		;Debug Str(x)+": "+Str(snow(x))
		y=Snow(x)
		If y
			If z=0
				a=x
				b=y
				z=1
			ElseIf Abs(b-y)>5
				Snowcloud(a-1,Snow((a+x)/2),x-a+2,5)
				z=0
			EndIf
		Else
			If a>0
				Snowcloud(a-1,Snow((a+x)/2),x-a+2,5)
				a=0
			EndIf
			z=0
		EndIf
		x+1
	Wend



	StopVectorDrawing()


EndProcedure

Procedure Main()

	Init()
	Snowstorm()

	StartDrawing(CanvasOutput(0))
	DrawImage(ImageID(0),0,0)
	DrawAlphaImage(ImageID(0),10,55); Test, ob der Hintergrund transparent ist
	StopDrawing()

	Repeat
		Select WaitWindowEvent()
		Case #PB_Event_CloseWindow,#WM_CHAR
			End
		EndSelect
	ForEver

EndProcedure

Main()
Antworten