Seite 1 von 1

benötige hilfe mit der Api Funktion DrawText_()

Verfasst: 03.09.2014 23:25
von captain_hesse
Hallo
Ich möchte gerne eine Text in einer vorgegebenen Breite und Höhe und beliebigem Winkel auf einem Screen darstellen.
Dazu möchte ich gerne die Funktion DrawText_() verwenden da man damit den Text sehr genau skalieren kann, allerdings kann ich nirgends ein Beispiel finden wie man damit einen gedrehten Text auf den Bildschirm bringt. Ich habe einige versuche mit CreateFont_() gemacht wo man ja den Textwinkel eingeben kann aber bei einem Drehwinkel von 90° ist der Text ziemlich verzerrt. Ich habe hier im Forum irgendwo den nachfolgenden Code gefunden der eigentlich fast das ist was ich brauche es müsste da nur noch möglich sein den Text zu drehen vielleicht kann mir bitte jemand erklären wie man mit der Funktion DrawText_() richtig umgeht bzw. wie man den nachfolgenden Code ändern müsste damit man damit den Text auch zusätzlich noch beliebig drehen kann.

Code: Alles auswählen

#winMain=0

Global TextObject1,TextObject2 

Procedure CreateTextObject(text.s,font,color,align) 
  tdc=CreateEnhMetaFile_(0,0,0,0) 
    SelectObject_(tdc,font) 
    SetBkMode_(tdc,#TRANSPARENT) 
    SetTextColor_(tdc,color) 
    DrawText_(tdc,text,-1,rect.RECT,#DT_CALCRECT) 
    DrawText_(tdc,text,-1,rect.RECT,align) 
  emfhandle=CloseEnhMetaFile_(tdc) 
  ProcedureReturn emfhandle 
EndProcedure 


Procedure ReDrawText(emf,x,y,w,h,dc) 
  set.RECT\left=x:set\top=y:set\right=w:set\bottom=h 
  PlayEnhMetaFile_(dc,emf,set) 
EndProcedure 

Procedure ImageReCreate(w,h) 
  CreateImage(0,w,h) 
  dc=StartDrawing(ImageOutput(0)) 
    Box(0,0,w,h,GetSysColor_(#COLOR_BTNFACE)) 
    ReDrawText(TextObject1,0,0,w,h/2,dc) 
    ReDrawText(TextObject2,w,h,0,h/2,dc) 
  StopDrawing() 
EndProcedure 



Procedure Callback(WindowID, Message, wParam, lParam) 
  Result = #PB_ProcessPureBasicEvents 
  If Message=#WM_SIZE 
    w = WindowWidth(#winMain) 
    h = WindowHeight(#winMain) 
    ImageReCreate(w,h) 
    SetGadgetState(0,ImageID(0)) 
    ResizeGadget(0,#PB_Ignore,#PB_Ignore,w,h) 
  EndIf 
  ProcedureReturn Result 
EndProcedure 


hwnd=OpenWindow(#winMain,0,0,400,300,"ScaleText",#PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_SizeGadget) 
CreateGadgetList(hwnd) 
CreateImage(0,400,300) 
font1=LoadFont(0,"Times New Roman",20) 
font2=LoadFont(1,"Arial",20,#PB_Font_Italic|#PB_Font_Bold) 


Restore text:Read.s Line.s:Repeat:text.s+Line+Chr(13)+Chr(10):Read.s Line:Until Line="End" 

TextObject1=CreateTextObject(text.s,font1,RGB(0,0,160),#DT_CENTER) 
TextObject2=CreateTextObject(text.s,font2,RGB(160,0,0),#DT_CENTER) 
ImageReCreate(400,300) 
ImageGadget(0,0,0,WindowWidth(#winMain),WindowHeight(#winMain),ImageID(0)) 


SetWindowCallback(@Callback()) 
Repeat
  
  
Until WaitWindowEvent()=#PB_Event_CloseWindow 


DeleteEnhMetaFile_(TextObject1) 
DeleteEnhMetaFile_(TextObject2) 
End 

DataSection 
  text: 
  Data.s "Skalierbarer Text Demonstration" 
  Data.s "-------------------------------" 
  Data.s "Dieses Beispiel zeigt eine simple Methode," 
  Data.s "wie man Textblöcke ohne viel Aufwand auf" 
  Data.s "ein gewünschtes Maß bringen kann, ohne das" 
  Data.s "es zu einem ungewünschten Qualitätsverlust" 
  Data.s "kommt. Mischa" 
  Data.s " " 
  Data.s "Bitte das Fenster vergrößern/verkleinern" 
  Data.s "und die Skalierung beurteilen." 
  Data.s "End" 
EndDataSection

Re: benötige hilfe mit der Api Funktion DrawText_()

Verfasst: 03.09.2014 23:41
von NicTheQuick
Schau dir mal GDI Plus von Danilo an.

Re: benötige hilfe mit der Api Funktion DrawText_()

Verfasst: 04.09.2014 18:06
von captain_hesse
Ja das sieht sehr gut aus, ich denke damit kann ich was anfangen.
Allerbesten Dank :allright: