DrawText gedreht ausgeben

[Sven]

Hallo!

Ich möchte auf einem Image einen Text (einfarbig) um einen bestimmten Winkel gedreht ausgeben. Bisher schreibe ich den Text mit DrawText horizontal.

Wie kann ich möglichst einfach eine Drehung beim Schreiben (Parameter für DrawText?) oder auch danach (Image-Bereich drehen?) erreichen? PB scheint dafür keine Funktionen zu haben?

Sven

[ts-soft]

Eine Funktion zum rotieren von Text ist mir leider auch nicht bekannt. Sowas würde ich mir auch wünschen .

[AndyX]

Wenn du mit Sprites arbeiten würdest, könntest du mit Sprite3D und RotateSprite3D arbeiten. Aber bei Images...

[ts-soft]

Es gibt ja im GDI irgendeine Funktion um TrueType Fonts zu rotieren, kenne sie leider nicht. In der 2D Drawing Lib wäre sie auch sehr sinnvoll.

[Morty]

Folgende Funktion nutze ich immer. Ist von purearea.net:

Code: Alles auswählen

Procedure DrawRText(DC.l,x,y,Text.s,fFont.s,fangle.l,fHeight) 
  Font = CreateFont_(fHeight,0,fangle*10,0,0,0,0,0,0,0,0,0,0,fFont) 
  GetWindowRect_(WindowID(),r.RECT) 
  OldFont = SelectObject_(DC,Font) 
  SetTextAlign_(DC,#TA_BASELINE) 
  SetBKMode_(DC,#TRANSPARENT) 
  ExtTextOut_(DC, x,y,0 ,r,Text,Len(Text),0 ) 
  SelectObject_(DC,OldFont) 
  DeleteObject_(Font) 
EndProcedure 

Folgender Aufruf:

Code: Alles auswählen

OpenScreen(1024,768,16,"") 
For i = 0 To 255 
    ClearScreen(0,0,0) 
    DC = StartDrawing(ScreenOutput()) 
    FrontColor(255-i,i,0) 
    DrawRText(DC,Int(10+3*i),Int(100+2*i),"Testtext "+Str(i),"Arial",Int(i/6),20+Int(i/10)) 
    ;Parameter 
    ;1 = DeviceContext 
    ;2 = StartX 
    ;3 = StartY 
    ;4 = Text$ 
    ;5 = Font$ 
    ;6 = Angle 
    ;7 = FontHeight 
    FlipBuffers() 
    StopDrawing() 
Next 
Delay(2000) 
End 

Funktioniert bei mir immer und kann auch auf alle anderen Outputs angewandt werden.

Morty

[ts-soft]

Funzt erst nach Änderungen:

Code: Alles auswählen

Procedure DrawRText(DC.l,x,y,Text.s,fFont.s,fangle.l,fHeight)
  Font = CreateFont_(fHeight,0,fangle*10,0,0,0,0,0,0,0,0,0,0,fFont)
  GetWindowRect_(WindowID(),r.RECT)
  OldFont = SelectObject_(DC,Font)
  SetTextAlign_(DC,#TA_BASELINE)
  SetBkMode_(DC,#TRANSPARENT)
  ExtTextOut_(DC, x,y,0 ,r,Text,Len(Text),0 )
  SelectObject_(DC,OldFont)
  DeleteObject_(Font)
EndProcedure 
InitSprite()
OpenScreen(1024,768,16,"")
For i = 0 To 255
    ClearScreen(0,0,0)
    DC = StartDrawing(ScreenOutput())
    FrontColor(255-i,i,0)
    DrawRText(DC,Int(10+3*i),Int(100+2*i),"Testtext "+Str(i),"Arial",Int(i/6),20+Int(i/10))
    ;Parameter
    ;1 = DeviceContext
    ;2 = StartX
    ;3 = StartY
    ;4 = Text$
    ;5 = Font$
    ;6 = Angle
    ;7 = FontHeight
    StopDrawing()
    FlipBuffers()
Next
Delay(2000)
End 

Ist aber nicht so ganz das richtige

[FGK]

Hi Leute,

verdammt ihr seid immer so schnell mit dem posten!
Ich würd es so lösen. Kommt dem gezeichneten Bild von
ts-Soft am nähesten. Viel Spaß damit

Code: Alles auswählen

#FONT_SIZE=12
If OpenWindow(0, 100, 200, 640,480,#PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_WindowCentered , "PureBasic Window")
  hdc = GetDC_(WindowID(0))
  NewFont.LOGFONT
  FontName.s = "Arial"+Chr(0)
  text.s = "Purebasic dreht durch..."
  NewFont\lfFaceName=@FontName
  For n =0 To 3600 Step 200
    s.f=s.f +0.15
    NewFont\lfEscapement = n
    NewFont\lfHeight = (#FONT_SIZE*-s.f)
    hFont = CreateFontIndirect_(NewFont)
    oldFont = SelectObject_(hdc,hFont)
    Textout_(hdc,WindowWidth()/2-75,WindowHeight()/2-75,text.s,Len(text.s))
    retval = SelectObject_(hdc,oldFont)
    retval=DeleteObject_(hFont)
  Next n  
   
  Repeat
    EventID.l = WaitWindowEvent()
   If EventID = #PB_Event_CloseWindow  ; If the user has pressed on the close button
      Quit = 1
    EndIf
   Until Quit = 1
EndIf
End 

Gruß
FGK

[ts-soft]

>> Kommt dem gezeichneten Bild von ts-Soft am nähesten

Das stimmt , jedoch ist das Bild nicht gezeichnet sondern programmiert in Profan. Hab lediglich einen SnapShot des Fensters gemacht.

[Falko]

Naja, um Ähnlichkeit liesse sich ja streiten. Ein bisschen Transparent dazu sowie den Text und die Schleife etwas angepasst und es sieht ausser dem Textfont schon fast ähnlicher

Code: Alles auswählen

#FONT_SIZE=12
If OpenWindow(0, 100, 200, 640,480,#PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_WindowCentered , "PureBasic Window")
  OutputID = WindowOutput()
StartDrawing(OutputID) ; Endlich wird der Hintergrund weis :D
   FillArea(5, 5,RGB(254,254,254),RGB(254,254,254))
StopDrawing()
  hdc = GetDC_(WindowID(0))
  
  NewFont.LOGFONT
  FontName.s = "Arial"+Chr(0)
  text.s = "..............PureBasic ist klasse!"
  NewFont\lfFaceName=@FontName
  For n =0 To 3600 Step 156
    s.f=s.f +0.10
    NewFont\lfEscapement = n
    NewFont\lfHeight = (#FONT_SIZE*-s.f)
    hFont = CreateFontIndirect_(NewFont)
    oldFont = SelectObject_(hdc,hFont)
    SetBkMode_(hdc,#TRANSPARENT); erweitert :D
    TextOut_(hdc,WindowWidth()/2-75,WindowHeight()/2-75,text.s,Len(text.s))
    retval = SelectObject_(hdc,oldFont)
    retval=DeleteObject_(hFont)
  Next n
  Repeat
    EventID.l = WaitWindowEvent()
    If EventID = #PB_Event_CloseWindow  ; If the user has pressed on the close button
      Quit = 1
    EndIf
   Until Quit = 1
EndIf
End

[FGK]

@Falko

Danke für den zum "Verständnis" sooo wichtigen weißen Hintergrund und die Transparenz. Wichtig ist doch eigentlich nur daß die Anwendung des API-Aufrufs klar wird. Tut mir leid wenn du meine
flapsige Meldung "zur Ähnlichkeit" als Auslöser für ein möglichst
akribisches Imitat empfunden hast. Ich hatte dies ja nur auf den vorherigen Post von Morty bezogen da dessen Ergebnis völlig an dem Wunsch von Sven vorbei ging.

Nix für ungut

FGK