/ Forside / Teknologi / Udvikling / VB/Basic / Nyhedsindlæg
Login
Glemt dit kodeord?
Brugernavn

Kodeord


Reklame
Top 10 brugere
VB/Basic
#NavnPoint
berpox 2425
pete 1435
CADmageren 1251
gibson 1230
Phylock 887
gandalf 836
AntonV 790
strarup 750
Benjamin... 700
10  tom.kise 610
Forkorte en sti
Fra : Ole Sørensen


Dato : 29-04-04 13:58

   Hej

   Hvordan forkorter man sti så den ikke fylder så meget i et
label felt / command knap? Jeg ville gerne kunne lave:
C:\Documents and Settings\NeedACoolName\Dokumenter\DVD-cover\large
om til:
C:\Documents and Settings\...\...\DVD-cover\large
eller noget i den stil

Jeg mener der har været et eksembel i gruppen på hvordan man gør.
--
Med Venlig Hilsen
Ole Sørensen

Ved direkte svar: erstat x med o i efternavn

 
 
Jørgen Bondesen (29-04-2004)
Kommentar
Fra : Jørgen Bondesen


Dato : 29-04-04 15:55

Hej Ole.

En meget simpel måder kunne være:
Er testet i Excel XP-UK.

Sub test()

strFullname = "C:\Dokumenter og test\jbotester.xls"
'strFullname = "C:\jb.xls"

leftlen = 10
rightlen = 10

pathlen = Len(strFullname)

If pathlen < leftlen + rightlen Then
If pathlen - leftlen <= 0 Then
newstrFullname = Left(strFullname, leftlen)
GoTo line01
End If
newstrFullname = Left(strFullname, leftlen) _
& Right(strFullname, rightlen)
Else
newstrFullname = Left(strFullname, leftlen) _
& "...." & Right(strFullname, rightlen)
End If
line01:

End Sub


Med venlig hilsen
Jørgen Bondesen


"Ole Sørensen" <ole.sxrensen@adslhome.dk> wrote in message
news:6hr190dq8vbtlmi09n4m14chv73ru14ktf@4ax.com...
> Hej
>
> Hvordan forkorter man sti så den ikke fylder så meget i et
> label felt / command knap? Jeg ville gerne kunne lave:
> C:\Documents and Settings\NeedACoolName\Dokumenter\DVD-cover\large
> om til:
> C:\Documents and Settings\...\...\DVD-cover\large
> eller noget i den stil
>
> Jeg mener der har været et eksembel i gruppen på hvordan man gør.
> --
> Med Venlig Hilsen
> Ole Sørensen
>
> Ved direkte svar: erstat x med o i efternavn



preben nielsen (29-04-2004)
Kommentar
Fra : preben nielsen


Dato : 29-04-04 16:21


"Jørgen Bondesen" <bondesen@cool.dk> skrev i en meddelelse
news:c6r511$29sn$1@news.cybercity.dk...
> Hej Ole.
>
> En meget simpel måder kunne være:
> Er testet i Excel XP-UK.
>
> Sub test()
[Snip]
> End Sub

Nej, nej, nej Funktionaliteten er indbygget i Windows. Brug de
dybe tallerkner, som allerede er opfundet.....

Kig på API-finktionen DrawText() og formatet DT_PATH_ELLIPSIS

http://www.mentalis.org/apilist/DrawText.shtml

Dét er måden Windows gør det på.......


--
/\ preben nielsen
\/\ prel@post.tele.dk



Jørgen Bondesen (29-04-2004)
Kommentar
Fra : Jørgen Bondesen


Dato : 29-04-04 17:41

Hej Preben.

Tak for henvisningen, som jeg desværre ikke forstår så meget af, pga. min
ringe VB viden.

Jeg håber dog, at du kan stille den dybe tallerken på bordet, så jeg kan se
hvordan en prof. gør.

Med venlig hilsen
Jørgen Bondesen


"preben nielsen" <prel@post.tele.dk> wrote in message
news:40911d6d$0$259$edfadb0f@dread12.news.tele.dk...
>
> "Jørgen Bondesen" <bondesen@cool.dk> skrev i en meddelelse
> news:c6r511$29sn$1@news.cybercity.dk...
> > Hej Ole.
> >
> > En meget simpel måder kunne være:
> > Er testet i Excel XP-UK.
> >
> > Sub test()
> [Snip]
> > End Sub
>
> Nej, nej, nej Funktionaliteten er indbygget i Windows. Brug de
> dybe tallerkner, som allerede er opfundet.....
>
> Kig på API-finktionen DrawText() og formatet DT_PATH_ELLIPSIS
>
> http://www.mentalis.org/apilist/DrawText.shtml
>
> Dét er måden Windows gør det på.......
>
>
> --
> /\ preben nielsen
> \/\ prel@post.tele.dk
>
>



Ole Sørensen (30-04-2004)
Kommentar
Fra : Ole Sørensen


Dato : 30-04-04 12:04

On Thu, 29 Apr 2004 18:40:32 +0200, "Jørgen Bondesen"
<bondesen@cool.dk> wrote:

>Hej Preben.
>
>Tak for henvisningen, som jeg desværre ikke forstår så meget af, pga. min
>ringe VB viden.

Jeg takker også...

>Jeg håber dog, at du kan stille den dybe tallerken på bordet, så jeg kan se
>hvordan en prof. gør.

.... men har ligsom Jørgen lidt svært ved at se de dybe tallerkner

Så jeg måtte ty til en hjemmelavet løsning:

Public Function KortSti(ByVal sTmp As String, ByVal lMax As Long) As
String
Dim sTemp() As String
Dim vElement As Variant
Dim sNySti As String
Dim sMangler As String
Dim nI As Integer
Dim nAntalElementer As Integer
Dim nFørsteElement As Integer
Dim bFærdig As Boolean
' Split stien op
sTemp() = Split(sTmp, "\")
' Tæl antal af elementer i sTemp()
nAntalElementer = 0
For Each vElement In sTemp
nAntalElementer = nAntalElementer + 1
Next
' Første element vil være drev (C:) det skal ikke ændres
sNySti = sTemp(0) & "\"
' Ændre så mange elementer i sTemp() til "..." som nødvendigt for
at
' få den totale længde af stien under max længde (lMax)
If nAntalElementer > 2 Then
nFørsteElement = 1
Do
sMangler = ""
bFærdig = False
For nI = nFørsteElement To nAntalElementer - 1
sMangler = sMangler & sTemp(nI) & "\"
Next
If Len(sNySti) + Len(sMangler) > lMax And nFørsteElement <
nAntalElementer - 1 Then ' Sidste element må ikke ændres
' Stadigvæk for lang, ændre aktuel element til "..."
sTemp(nFørsteElement) = "..."
nFørsteElement = nFørsteElement + 1
Else
bFærdig = True
End If
Loop Until bFærdig
End If
' Sammel de ændrede elementer med det føste element

For nI = 1 To nAntalElementer - 1
sNySti = sNySti & sTemp(nI) & "\"
Next
KortSti = sNySti
End Function

Kaldet af funktionen kunne se således ud:

lblSti.Caption = KortSti(dirMapper.Path, MaxStiLængde)

Fukktionen har den svaghed at den ikke kan ændre i det sidste element
i sTemp() med det resultat at man ikke altid når ned på den ønskede
længde.
--
Med Venlig Hilsen
Ole Sørensen

Ved direkte svar: erstat x med o i efternavn

preben nielsen (30-04-2004)
Kommentar
Fra : preben nielsen


Dato : 30-04-04 16:17


"Ole Sørensen" <ole.sxrensen@adslhome.dk> skrev i en meddelelse
news:m9c490tqsnml38m6n4vrprenv0tjo7ff7i@4ax.com...
> On Thu, 29 Apr 2004 18:40:32 +0200, "Jørgen Bondesen"

> >Jeg håber dog, at du kan stille den dybe tallerken på bordet,
så jeg kan se
> >hvordan en prof. gør.
>
> ... men har ligsom Jørgen lidt svært ved at se de dybe
tallerkner
>
> Så jeg måtte ty til en hjemmelavet løsning:

Du håndterer maxlængde i antal tegn, men hvad hvis du skulle vise
din tekst i en label, som var 300 pixel bred og hvor hvert tegn i
font'en ikke var lige bred ?

Dét håndterer DrawText()

Ok, jeg skal lige lave et eksempel......


--
/\ preben nielsen
\/\ prel@post.tele.dk



preben nielsen (30-04-2004)
Kommentar
Fra : preben nielsen


Dato : 30-04-04 16:52


"preben nielsen" <prel@post.tele.dk> skrev i en meddelelse
news:40926df8$0$269$edfadb0f@dread12.news.tele.dk...
>
> Du håndterer maxlængde i antal tegn, men hvad hvis du skulle
vise
> din tekst i en label, som var 300 pixel bred og hvor hvert tegn
i
> font'en ikke var lige bred ?
>
> Dét håndterer DrawText()
>
> Ok, jeg skal lige lave et eksempel......

Ok, så er jeg klar.

Funktionen EllipsisText() tegner ikke teksten ! Den returnerer en
string omformet med "..." enten midti (som i en path) eller i
enden.

DrawText() kan dog også bruges til til at tegne direkte med (i
form, på printer, etc), men så skal man ikke bruge flaget
DT_MODIFYSTRING.

Enjoy

--
/\ preben nielsen
\/\ prel@post.tele.dk

----------Smid dette i et modul -----------------------------
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Const DT_CALCRECT = &H400
Private Const DT_PATH_ELLIPSIS = &H4000
Private Const DT_END_ELLIPSIS = &H8000&
Private Const DT_MODIFYSTRING = &H10000
Private Const DT_EXPANDTABS = &H40
Private Const DT_NOPREFIX = &H800
Private Const DT_WORDBREAK = &H10
Private Const DT_TABSTOP = &H80
Private Const DT_WORD_ELLIPSIS = &H40000

Private Declare Function DrawText Lib "user32" Alias "DrawTextA"
(ByVal hDC As Long, ByVal lpString As String, ByVal nCount As
Long, lpRect As RECT, ByVal uFormat As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As
Long, lpRect As RECT) As Long

Function EllipsisText(hDC As Long, ctl As Control, str As String,
Optional blnEndEllipsis As Boolean = True) As String
Dim rc As RECT
Dim lngStyle As Long
With ctl
EllipsisText = str
If TypeOf ctl Is Label Then
rc.Left = 0
rc.Right = ctl.Width \ Screen.TwipsPerPixelX
Else
GetWindowRect ctl.hwnd, rc
End If
rc.Left = rc.Left * 0.96
rc.Right = rc.Right * 0.96
If blnEndEllipsis Then
lngStyle = DT_END_ELLIPSIS
Else
lngStyle = DT_PATH_ELLIPSIS
End If
Call DrawText(hDC, EllipsisText, -1, rc, DT_CALCRECT Or
DT_MODIFYSTRING Or lngStyle)
End With
End Function


----------Brug det evt sådan her i en
form -----------------------------

Private Sub Command1_Click()
Dim strTmp As String

strTmp =
"D:\Dokumenter\Data\Musik\MP3\DetBedsteAfDetBedsteFra80erne"

Label1.Caption = EllipsisText(Me.hDC, Label1, strTmp, False) '
Giver f.eks. "D:\...DetBedsteAfDetBedsteFra80erne"
Label2.Caption = EllipsisText(Me.hDC, Label1, strTmp, True) '
Giver f.eks. "D:\Dokumenter\Data\Musik\MP3\..."
End Sub




Ole Sørensen (30-04-2004)
Kommentar
Fra : Ole Sørensen


Dato : 30-04-04 18:32

On Fri, 30 Apr 2004 17:51:31 +0200, "preben nielsen"
<prel@post.tele.dk> wrote:

Først, mange tak!

Klip, noget snak
---
Klip, noget kode

>Function EllipsisText(hDC As Long, ctl As Control, str As String,
>Optional blnEndEllipsis As Boolean = True) As String
> Dim rc As RECT
> Dim lngStyle As Long
> With ctl
> EllipsisText = str
> If TypeOf ctl Is Label Then
> rc.Left = 0
> rc.Right = ctl.Width \ Screen.TwipsPerPixelX
> Else
> GetWindowRect ctl.hwnd, rc
> End If

hvis man ændre skrifttypen til Courier New går der et eller andet galt

> rc.Left = rc.Left * 0.96
> rc.Right = rc.Right * 0.96

men ændre man oven stående faktor (0.96) til 0.65 (*), passer det
igen! Er der en formel / forklaring på det ?

> If blnEndEllipsis Then
> lngStyle = DT_END_ELLIPSIS
> Else
> lngStyle = DT_PATH_ELLIPSIS
> End If
> Call DrawText(hDC, EllipsisText, -1, rc, DT_CALCRECT Or
>DT_MODIFYSTRING Or lngStyle)
> End With
>End Function

Klip, noget mere kode

(*) Jeg prøvede mig frem, men syntes at 0.65 passer meget fint.
--
Med Venlig Hilsen
Ole Sørensen

Ved direkte svar: erstat x med o i efternavn

preben nielsen (30-04-2004)
Kommentar
Fra : preben nielsen


Dato : 30-04-04 21:04


"Ole Sørensen" <ole.sxrensen@adslhome.dk> skrev i en meddelelse
news:dt259012k50hgqc2cf6uukeo1lm2dphg3o@4ax.com...
> On Fri, 30 Apr 2004 17:51:31 +0200, "preben nielsen"
> <prel@post.tele.dk> wrote:
>
>
> hvis man ændre skrifttypen til Courier New går der et eller
andet galt

Er du sikker ? Skrifttype i Label eller Form ? Funktionen tager en
hDC som parameter, og jeg giver den Formens hDC, og derfor bruger
den Formens skrifttype til beregningerne. Der er sikkert måder du
kan lave en hDC med den Font du ønsker, men du skal jo også gøre
en del af arbejdet selv

--
/\ preben nielsen
\/\ prel@post.tele.dk



Ole Sørensen (01-05-2004)
Kommentar
Fra : Ole Sørensen


Dato : 01-05-04 11:07

On Fri, 30 Apr 2004 22:03:57 +0200, "preben nielsen"
<prel@post.tele.dk> wrote:

>Er du sikker ? Skrifttype i Label eller Form ? Funktionen tager en
>hDC som parameter, og jeg giver den Formens hDC, og derfor bruger
>den Formens skrifttype til beregningerne.

Du har ret det virker 100% på formen

>Der er sikkert måder du
>kan lave en hDC med den Font du ønsker, men du skal jo også gøre
>en del af arbejdet selv

Det ville jeg også gerne, hvis jeg fattede et klap af det, men derfor
kan jeg godt bruge koden alligevel, bare ikke ændre det helt store i
den
--
Med Venlig Hilsen
Ole Sørensen

Ved direkte svar: erstat x med o i efternavn

Søg
Reklame
Statistik
Spørgsmål : 177557
Tips : 31968
Nyheder : 719565
Indlæg : 6408876
Brugere : 218888

Månedens bedste
Årets bedste
Sidste års bedste