Aktuelle Zeit: 26.09.2020 12:45

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]




Ein neues Thema erstellen Auf das Thema antworten  [ 3 Beiträge ] 
Autor Nachricht
 Betreff des Beitrags: Schriftart mit Schneeeffekt erzeugen
BeitragVerfasst: 22.12.2019 19:29 
Offline

Registriert: 16.03.2006 11:20
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/222287-snowty-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:
; 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()


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Schriftart mit Schneeeffekt erzeugen
BeitragVerfasst: 22.12.2019 23:23 
Offline

Registriert: 27.11.2016 18:13
Wohnort: Erzgebirge
Erstelle doch einfach eigene Schriften mit Wolken drauf.

Alles Andere sieht im Endergebnis wahrscheinlich Schei.. aus.

Ansonsten aber ein tolles Projekt.

_________________
Betriebssysteme: MX Linux 19 / Windows 10 / Mac OS 10.15.2 / Android 7.0 ;)


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Schriftart mit Schneeeffekt erzeugen
BeitragVerfasst: 26.12.2019 00:06 
Offline

Registriert: 16.03.2006 11:20
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:
; 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()


Nach oben
 Profil  
Mit Zitat antworten  
Beiträge der letzten Zeit anzeigen:  Sortiere nach  
Ein neues Thema erstellen Auf das Thema antworten  [ 3 Beiträge ] 

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]


Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 11 Gäste


Sie dürfen keine neuen Themen in diesem Forum erstellen.
Sie dürfen keine Antworten zu Themen in diesem Forum erstellen.
Sie dürfen Ihre Beiträge in diesem Forum nicht ändern.
Sie dürfen Ihre Beiträge in diesem Forum nicht löschen.

Suche nach:
Gehe zu:  

 


Powered by phpBB © 2008 phpBB Group | Deutsche Übersetzung durch phpBB.de
subSilver+ theme by Canver Software, sponsor Sanal Modifiye