Text auf Breite eines TextGadgets zurechtschneiden

[Taurus71]

Hallo alle zusammen,

folgendes Problem:

Ich habe ein TextGadget mit einer Breite von x Pixeln.
In diesem TextGadget soll nun ein kompletter Pfad dargestellt werden.
Ist dieser Pfad aber zu lang, wird er getrennt und 2-zeilig dargestellt.
Ich möchte aber hingegen nur den Pfad 1-zeilig darstellen und Teile des Pfades durch ... ersetzen.

Beispiel:

vorher:
C:\Dokumente und Einstellungen\User\Eigene Dateien\Eigene Programme\
nachher:
C:\...\...\Eigene Dateien\Eigene Programme\

Kann mir jemand bei diesem Problem helfen ?

Danke im voraus

Taurus71

p.s.: sry, hab gerade aber erst angefangen mit pb zu proggen.

[unix]

Wiegesagt musst du die Läge des Textes Ermitteln und mit einer Untilschliefe den Text solang kürzen bis er gerade hineinpasst

Code: Alles auswählen

Text$ = "C:\Hallo\Leute\hier\bin\ich.bmp
[Textlänge ermitteln]
Repeat

 Zeichen = 1
 Repeat
 if Mid(Text$,Zeichen,1) = "\"
  Klar = 1
 endif
 Zeichen + 1
 Until Klar = 1

 Zeichen 2 = Zeichen+1

 Repeat
 if Mid(Text$,Zeichen2,1) = "\"
  Klar = 1
 endif
 Zeichen2 + 1
 Until Klar = 1 
 
 Text1$ = Mid(Text$,1,Zeichen
 Text2$ = "..."
 Text3$ = Mid(Text$,Zeichen2,Len(Text$)-Zeichen2)
 
 Zext4$ = Text1$ + Text2$ + Text4$

 [LängeVonText4ermitteln]

Until Text4Länge < MaxLänge

Oder fast so
[ungetestet]

[Justy]

Hallo!

Auch im CodeArchiv auf PureArea.net gibt es so eine Funktion:

http://www.purearea.net/pb/CodeArchiv/F ... athName.pb


Ich habe mir auch selbst einmal eine konfigurierbare Procedure zu diesem Zweck geschrieben:

Code: Alles auswählen

Procedure.s ShortenStringAdvanced(aString.s, mode.l); - Kürzt lange Dateinamen
  ;Modes:
  ;-1  ---- Das letzte Verzeichnis wird angezeigt
  ; 0  ---- Alle Verzeichnisse werden entfernt
  ; X  ---- X Verzeichnisse werden entfernt
  Protected sLen.l, pos1.l, pos2.l, mode.l, count.l
  Repeat
    count+1
    voString.s=oString.s
    oString.s=aString 
    sLen = Len(aString) 
    pos1 = FindString(aString,"\",1) 
    If pos1 > 0 
      pos2 = FindString(aString,"\",pos1+1) 
      While pos2 > 0 
        If pos2 > 0 
          pos1 = pos2 
          pos2 = FindString(aString,"\",pos1+1) 
        EndIf 
      Wend 
    EndIf 
    If Len(aString) = sLen 
      pos1 = FindString(aString,"\",1) 
      If pos1 > 0 
        pos2 = FindString(aString,"\",pos1+1) 
        While pos2 > 0 
          If pos2 > 0 
            If pos2 - pos1 > 3 
              aString = Left(aString,pos1) + ".." + Right(aString,sLen-pos2+1) 
              Break 
            Else 
              pos1 = pos2 
              pos2 = FindString(aString,"\",pos1+1) 
            EndIf 
          EndIf 
        Wend 
      EndIf 
    EndIf
  Until (oString=aString And mode<1) Or (count=mode And mode>0)
  
  If mode>0
    ProcedureReturn aString 
  ElseIf mode=0
    ProcedureReturn oString
  ElseIf mode=-1
    ProcedureReturn voString
  EndIf
  ProcedureReturn ""
EndProcedure 

test.s = "C:\Programme\Programmierung\Purebasic\213434\gfhgd\dhfhgf\gfhgfj\gfjgfd\gfjghf" 

Debug ShortenStringAdvanced(test,-1)

Ich hoffe ich konnte helfen!
mfg. Justy

[PAMKKKKK]

Eine Möglichkeit ganze Texte in einer Breite zu Formatieren hat JEAR für dich hier:
http://forums.purebasic.com/german/view ... highlight=

[FGK]

Hallo Taurus71,

wenns nur unter Windows laufen soll
lege ich dir die API Funktion

PathCompactPath

aus der shlwapi.dll ans Herz.
Guck dir mal diese Funktion näher an
damit hast du es ganz Windows-like und ohne
großen Aufwand.

Gruß

FGK

Nachtrag Beispielcode:

Code: Alles auswählen

Procedure CompactPath(Path$)
  If OpenLibrary(0,"shlwapi.dll")
    *p = IsFunction(0, "PathCompactPathA")
    If *p
      CallFunctionFast(*p,GetDC_(GadgetID(1)),Path$,GadgetWidth(1))
      SetGadgetText(1,Path$)
    EndIf
    CloseLibrary(0)
  EndIf
EndProcedure
  
If OpenWindow(0, 100, 200, 640,480,#PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_WindowCentered , "PureBasic Window - Klick mich!")
  CreateGadgetList(WindowID(0))
  ButtonGadget(1,10,10,200,25,"C:\\das\ist\wohl\sau\lange\oder\nicht???.txt")

   Repeat
    EventID.l = WaitWindowEvent()
    
    Select EventID
      Case #PB_Event_Gadget
        Select EventGadgetID()
          Case 1 : CompactPath(GetGadgetText(1))
        EndSelect
      Case #PB_Event_CloseWindow           
        Quit = 1
    EndSelect
  Until Quit = 1
  
EndIf
End 

[Taurus71]

Danke nochmals an alle.

Ihr habt mir sehr weiter geholfen.

@FGK: Genau sowas hab ich gesucht (und ja, es soll nur unter Windows laufen). Thx nochmals

[PMV]

Ich hab grad das Problem gehabt, dass die Prozedur nur für Ascii
ausgelegt ist. Nach ein wenig suchen hab ich die Unicode-Version
gefunden. Hier also das ganze Beispiel von FGK als PB 4 mit Unicode
unterstützung. (fals es irgend wann mal wer braucht.)

Code: Alles auswählen

Procedure CompactPath(GadgetID, Path$) 
  Protected Lib.l, *p
  Lib = OpenLibrary(#PB_Any,"shlwapi.dll") 
  If Lib
    CompilerIf #PB_Compiler_Unicode
      *p = GetFunction(Lib, "PathCompactPathW") 
    CompilerElse
      *p = GetFunction(Lib, "PathCompactPathA") 
    CompilerEndIf
    If *p 
      CallFunctionFast(*p,GetDC_(GadgetID(GadgetID)),Path$,GadgetWidth(GadgetID)) 
      SetGadgetText(1,Path$) 
    EndIf 
    CloseLibrary(Lib) 
  EndIf 
EndProcedure

If OpenWindow(0, 100, 200, 640,480, "PureBasic Window - Klick mich!", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_WindowCentered) 
  CreateGadgetList(WindowID(0)) 
  ButtonGadget(1,10,10,200,25,"C:\\das\ist\wohl\sau\lange\oder\nicht???.txt") 

   Repeat 
    EventID.l = WaitWindowEvent() 
    
    Select EventID 
      Case #PB_Event_Gadget 
        Select EventGadget() 
          Case 1 : CompactPath(1, GetGadgetText(1)) 
        EndSelect 
      Case #PB_Event_CloseWindow            
        Quit = 1 
    EndSelect 
  Until Quit = 1 
  
EndIf

MFG PMV