Witam, przedstawiam algorytm, który dzieli podany tekst tak, aby szerokość tekstu w pikselach w każdej linii nie przekraczała podanej wartości. Poszczególne linijki umieszczane są w obiekcie typu TStringList.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 |
procedure TForm1.Dziel(S : String ; Dl : Word ; var Lista : TStringList) ; var i : Integer ; p : String ; aktDl : Word ; ind : Integer ; begin Lista := TStringList.Create ; if Dl <= 10 then Exit ; // ogranicznik aktDl := 0 ; ind := 0 ; while S <> '' do begin for i := 1 to Length(S) do begin if aktDl + Canvas.TextWidth(S) >= Dl then begin if aktDl + Canvas.TextWidth(S) = Dl then ind := i else ind := i - 1 ; p := Copy(S , 1 , ind) ; Delete(S , 1 , ind) ; Lista.Add(p) ; aktDl := 0 ; Break ; end else aktDl := aktDl + Canvas.TextWidth(S) ; end ; if i >= Length(S) then begin Lista.Add(S) ; Break ; end ; end ; end ; |
Procedura przyjmuje trzy parametry:
S – tekst do podzielenia
Dl – maksymalna długość pojedynczej linii wyrażona w pikselach
Lista – w tym obiekcie umieszczamy kolejne linijki
Kod wykonuj się, dopóki string S nie jest pusty. Algorytm zlicza szerokość kolejnych liter używając funkcji TextWidth, jeżeli długość jest równa lub większa od wartości podanej w parametrze, to aktualna cześć tekstu dodawana jest do obiektu Lista. Dodany fragment usuwamy ze stringu S, ponieważ nie jest on już potrzebny. Kod:
|
1 2 3 4 5 6 7 8 9 |
if i >= Length(S) then begin Lista.Add(S); Break; end; |
Potrzebny jest w wypadku, gdy string S zawiera taką ilość liter, że ich szerokość nie będzie już większa od podanej (na końcu działania algorytmu). W takim przypadku pozostaje już tylko tekst znajdujący się w S wpisać do obiektu Lista.
Użycie:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 |
procedure TForm1.Button1Click(Sender: TObject); var St : TStringList; begin Dziel(Edit1.Text , StrToInt(Edit2.Text) , St) ; Memo1.Lines := St; end; |
