DrawText gedreht ausgeben

[Kaeru Gaman]

cooler tip

...ich überleg die ganze zeit, wie man das ohne API lösen könnte,
aber dazu müsste man wohl den text zuerst auf ein buffer-image schreiben,
und dann eine finerotation-routine verwenden, um das image zu drehen.

Stefan hatte mal ne asm-procedure gepostet, um sprites zu drehen (ohne Sprite3D),
müsste sich auch auf images anwenden lassen.

[sobi]

@tobe
Klasse!

Klasse, sage ich nur...
Liebe Grüße, und vielen Dank für die Hilfe!
Simon

PS: hat jemand auf die schnelle einen Link da, wo man sich über die API informieren kann? (habe manches bis jetzt einfach so verwendet, aber nicht wirklich verstanden oder sinnvoll einsetzen können)

[sobi]

So, jetzt wollte ich das ganze praktisch umsetzen... und weiß nicht wie ich mit dem Fehler umgehen soll:

Code: Alles auswählen

Global hdc

Procedure t_senkrecht(x.l,y.l,Text.s) 
  #FONT_SIZE=12 
  NewFont.LOGFONT 
  FontName.s = "Arial"+Chr(0) 
  NewFont\lfFaceName=@FontName 
  NewFont\lfEscapement = 900 
  NewFont\lfHeight = (#FONT_SIZE+2) 
  hFont = CreateFontIndirect_(NewFont) 
  oldFont = SelectObject_(hdc,hFont) 
  ;SetBkMode_(hdc,#TRANSPARENT); erweitert :D 
  SetTextAlign_(hdc, #TA_CENTER) 
  TextOut_(hdc,x,y,Text.s,Len(Text.s)) 
  RetVal = SelectObject_(hdc,oldFont) 
  RetVal=DeleteObject_(hFont) 
EndProcedure 

If OpenWindow(0, 100, 200, 640,480, "PureBasic Window",#PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_WindowCentered ) 
  CreateImage(2,100,100) 
  x_bild=50 : y_bild=50
  hdc = StartDrawing(ImageOutput(2)) 
    DrawingMode(0) 
    Box(0,0,100,200,RGB(255,255,255)) 
    FrontColor(RGB(0,0,0)) 
    DrawingMode(1)
     
    t_senkrecht(30,50,"TEST") 
    DrawText(10+x_bild,60+y_bild,"text")
    
    Box(80,50,10,10,RGB(10, 94, 245))
  StopDrawing() 
  CreateGadgetList(WindowID(0)) 
   ImageGadget(1,x_bild,y_bild,100,100,ImageID(2)) 
  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 

wenn ich nach dem senkrechten Text den "normalen Text" aufrufen will, habe ich ein Problem...

[tobe]

hi sobi,

ich hab dir den code nochmal etwas angepasst

Code: Alles auswählen

Procedure t_senkrecht(x.l,y.l,Text.s)
  Shared hdc
  #FONT_SIZE=12
  NewFont.LOGFONT
  FontName.s = "Arial"+Chr(0)
  NewFont\lfFaceName=@FontName
  NewFont\lfEscapement = 900
  NewFont\lfHeight = (#FONT_SIZE+2)
  hFont = CreateFontIndirect_(NewFont)
  oldFont = SelectObject_(hdc,hFont)
  ;SetBkMode_(hdc,#TRANSPARENT); erweitert :D
  old = GetTextAlign_(hdc) ; <-----------------neu
  SetTextAlign_(hdc, #TA_CENTER)
  TextOut_(hdc,x,y,Text.s,Len(Text.s))
  SetTextAlign_(hdc, old) ; <------------------neu
  RetVal = SelectObject_(hdc,oldFont)
  RetVal=DeleteObject_(hFont)
EndProcedure

If OpenWindow(0, 100, 200, 640,480, "PureBasic Window",#PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_WindowCentered )
  CreateImage(2,200,200)
  x_bild=50 : y_bild=50
  hdc = StartDrawing(ImageOutput(2))
  DrawingMode(0)
  Box(0,0,150,200,RGB(255,255,255))
  FrontColor(RGB(0,0,0))
  DrawingMode(1)
  
  t_senkrecht(30,50,"TEST")
  DrawText(x_bild,y_bild,"text")
  t_senkrecht(50,90,"TEST")
  DrawText(10+x_bild,60+y_bild,"text")
  DrawingMode(0)
  DrawText(140,60+y_bild,"text")
  
  Box(80,50,10,10,RGB(10, 94, 245))
  StopDrawing()
  CreateGadgetList(WindowID(0))
  ImageGadget(1,0,0,200,200,ImageID(2))
  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

[sobi]

hi sobi,

ich hab dir den code nochmal etwas angepasst

Bingo... jetzt verstehe ich es! Vielen Dank für deine Hilfe