String nach x Leerzeichen trennen

LokutusvB · Beiträge: 74 WinXP Delphi 5, Delphi XE

Guten Morgen,

ich habe einen String einer Länge X. Dieser String soll nach einer bestimmten Anzahl Zeichen getrennt werden. Das Trennzeichen soll dabei das Leerzeichen sein. Die Trennposition hat zusätzlich ein bestimmte Trenngrenze, in der nach dem Leerzeichen gesucht wird. Dafür habe ich mir eine Funktion gebastelt, die soweit funktioniert. Allerdings bin ich mir nicht sicher, ob es vielleicht nicht auch eine bessere Lösung gibt. Hier mal meine Funktion:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:

function CutString(txtPos, delta: Integer; txt: String): TStringList;
var
  sTmp: String;
  iTmp, ii: integer;  
begin  
  While  (Length(txt) > txtPos) do begin
    sTmp := Copy(txt, txtPos - delta, delta);
    iTmp := Pos(' ', sTmp);
    if ( iTmp = 0) then iTmp := txtPos else iTmp := txtPos - delta - 1 + iTmp;
    resTxt.Add(Copy(txt, 1, iTmp));
    txt := Copy(txt, iTmp + 1, Length(txt));
  end;
  if (Length(txt) > 0) then resTxt.Add(txt);
  for ii := 0 to resTxt.Count - 1 do begin
    txt := resTxt.Strings[ii];
    if  (Copy(txt, 1, 1) = ' ')
      then resTxt.Strings[ii] := Copy(txt, 2, Length(txt) - 1);
  end;
  Result := resTxt;
end;

Der Aufruf wäre z.B:

markieren

Delphi-Quelltext

1:	txtList := CutString(10, 4, 'ABCDEFG HIJK LMNOP QRS TUVW XYZ 1234 56789');

bummi · Verfasst: Mo 17.01.11 12:40

markieren

Delphi-Quelltext

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:

function CutString2(txt: String;txtPos:Integer ): TStringList;
var
  lasti,i:Integer;
begin
  Result := TStringList.Create;
  lasti := 1;
  i := txtPos;
  while i < (Length(txt) -1) do
    begin
      While  (txt[i]<>' ') and (i>lastI) do dec(i);
      if not (i>LastI) then i := Lasti + txtPos;
      Result.Add(TRIM(copy(txt,lasti,i-lasti)));
      lasti := i;
      i := i + txtPos;
      if i >  (Length(txt)-1) then i := (Length(txt)-1);
    end;
  if lasti < (Length(txt) -1) then Result.Add(TRIM(copy(txt,lasti,txtPos)));
end;

procedure TForm2.Button2Click(Sender: TObject);
var
  txtList:TStringList;
begin
  txtList := CutString2('ABCDEFG HIJK LMNOP QRS TUVW XYZ 1234 56789',10);
  memo1.text :=  txtList.Text;
  txtList.Free;
end;

_________________
Das Problem liegt üblicherweise zwischen den Ohren H₂♂
DRY DRY KISS

LokutusvB · Beiträge: 74 WinXP Delphi 5, Delphi XE

Hallo bummi!

Oh, diese ist ja bei weitem nicht so umständlich wie meine Funktion. Aber wie sieht es bei deiner Funktion mit dem Delta aus? Wenn ein Wort länger als z.B. das gewählte Delta von 4 ist, wird bei dir keine Zwangstrennung durchgeführt. Sehe ich das richtig?

bummi · Verfasst: Mo 17.01.11 15:08

ich habe den Sinn des Delta nicht verstanden und mich auf das vermeiden von Kopieraktionen beschränkt, gegf. mßt Du da noch Hand anlegen....

_________________
Das Problem liegt üblicherweise zwischen den Ohren H₂♂
DRY DRY KISS

LokutusvB · Beiträge: 74 WinXP Delphi 5, Delphi XE

Danke für Alternative! Das Delta ist notwendig, da die Strings für einen Ausdruck bestimmt sind und das Formular dafür nur Stellen bestimmter Größe bereitstellt. Ich werde daran noch ein wenig basteln.

bummi · Verfasst: Mo 17.01.11 17:21

bei meiner Variante schränkt txtPos auf max. Zeichen ein.

_________________
Das Problem liegt üblicherweise zwischen den Ohren H₂♂
DRY DRY KISS

LokutusvB · Beiträge: 74 WinXP Delphi 5, Delphi XE

Es hat sich noch einmal eine Änderung ergeben. Da die Schriftfamilie geändert wurde, nimmt nun nicht mehr jedes Zeichen den selben Platz ein. So habe ich deine Funktion als Vorlage genommen, und sie abgeändert. Das schaut mir jedoch wieder recht umständlich aus. Könntest du abermals einen Blick darauf werfen?

DruckVS ist vom Typ TPrintPreview.

markieren

Delphi-Quelltext

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:

function TF_Druck.CutString(txtWidth, txtDelta: Integer; txt: String):TStringList;
var
  aktPos, tmpPos: Integer;
  cut: Boolean;
  function getAktPos: Integer;
  var
    ii: Integer;
  begin
    Result := 0;
    for ii := 2 to Length(txt) do begin
      if (DruckVS.Canvas.TextWidth(Copy(txt, 1, ii)) >= txtWidth) then begin
        Result := ii;
        break;
      end;
    end;
  end;
begin
  Result := TStringList.Create;
  aktPos := getAktPos;
  if (aktPos = 0) then Result.Add(txt) else begin
    while (Length(txt) > aktPos) do begin
      cut := False;
      tmpPos := aktPos + 1;
      while (tmpPos >= aktPos - txtDelta) do begin
        if txt[tmpPos] = ' ' then begin
          cut := True;
          Result.Add(Trim(Copy(txt, 1, tmpPos)));
          txt := Copy(txt, tmpPos, Length(txt) - tmpPos + 1);
          break;
        end else Dec(tmpPos);
      end;
      if (cut = False) then begin
        Result.Add(Trim(Copy(txt, 1, aktPos)));
        txt := Copy(txt, tmpPos, Length(txt) - tmpPos);
      end;
      aktPos := getAktPos;
      if (aktPos = 0) then begin
        Result.Add(Trim(txt));
        Exit;
      end;
    end;
  end;
end;

Der Aufruf wäre wieder z.B.

markieren

Delphi-Quelltext

1:	txtList := CutString(6150, 6, 'abc defgh ijklmno pq rstuvw xyz 1234567 890');

bummi · Verfasst: Mi 19.01.11 12:21

Hier würde ich einen ganz anderen Ansatz wählen:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:

var
  r:TRect;
  s:String;
begin
   r.Left := 100;
   r.top := 100;
   r.Right := 150;
   r.Bottom := 200;
   s :=   'abc defgh ijklmno pq rstuvw xyz 1234567 890';
   canvas.TextRect(r,s,[tfWordBreak,tfModifyString,tfCalcRect]);
   canvas.Textrect(r,s,[tfWordBreak]);
end;

_________________
Das Problem liegt üblicherweise zwischen den Ohren H₂♂
DRY DRY KISS

LokutusvB · Beiträge: 74 WinXP Delphi 5, Delphi XE

Daran dachte ich zu allererst. jedoch geht das wohl leider so mit meiner Delphi-5-Version nicht. Alles, was außerhalb des Rects ist, wird nicht in einer neue Zeile geschrieben, sondern einfach abgetrennt.

markieren

Delphi-Quelltext

1:	procedure TextRect(Rect: TRect; X, Y: Integer; const Text: string);

Description

Use TextRect to write a string within a limited rectangular region. Any portions of the string that fall outside the rectangle passed in the Rect parameter are clipped and don't appear. The upper left corner of the text is placed at the point (X, Y).

So dei Beschreibung der Hilfe. Allerdings arbeite ich zum ersten Mal mit diesen Sachsen. Verstehe ich das nur falsch bzw. mache da was falsch oder geht das in Delphi 5 mit TextRect so nicht?

Ich wollte das z.B. so machen:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:

r.Left := 200;
r.top := 11400;
r.Right := 6150;
r.Bottom := 15600;     
s :=   'abc defgh ijklmno pq rstuvw xyz 1234567 890 abc defgh ijklmno pq rstuvw xyz 1234567 890';
DruckVS.Canvas.TextRect(r,205, 11405, s);

bummi · Verfasst: Mi 19.01.11 13:16

wenn ich die Funktion aus Delphi XE analysiere meine ich Du müsstest, so zum Ziel kommen

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:

var
  r:TRect;
  s:String;
  Format:Integer;
begin
   r.Left := 100;
   r.top := 100;
   r.Right := 150;
   r.Bottom := 200;
   s :=   'abc defgh ijklmno pq rstuvw xyz 1234567 890';
   Format :=  $10000 + $400 + $10;
   DrawTextEx(canvas.Handle, PChar(s), Length(s), r, Format, nil);
   Format :=   $10;
   DrawTextEx(canvas.Handle, PChar(s), Length(s), r, Format, nil);

//   canvas.TextRect(r,s,[tfWordBreak,tfModifyString,tfCalcRect]);
//   canvas.Textrect(r,s,[tfWordBreak]);
end;

EDIT: Du müsstest jetzt nur noch eine Zwangstrennung für Wörter mit einer Länge>Canvas.Textwidth (#13#10 dazwischenkleben) einfügen.

markieren

Delphi-Quelltext

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:

  {$EXTERNALSYM DT_TOP}
  DT_TOP = 0;
  {$EXTERNALSYM DT_LEFT}
  DT_LEFT = 0;
  {$EXTERNALSYM DT_CENTER}
  DT_CENTER = 1;
  {$EXTERNALSYM DT_RIGHT}
  DT_RIGHT = 2;
  {$EXTERNALSYM DT_VCENTER}
  DT_VCENTER = 4;
  {$EXTERNALSYM DT_BOTTOM}
  DT_BOTTOM = 8;
  {$EXTERNALSYM DT_WORDBREAK}
  DT_WORDBREAK = $10;
  {$EXTERNALSYM DT_SINGLELINE}
  DT_SINGLELINE = $20;
  {$EXTERNALSYM DT_EXPANDTABS}
  DT_EXPANDTABS = $40;
  {$EXTERNALSYM DT_TABSTOP}
  DT_TABSTOP = $80;
  {$EXTERNALSYM DT_NOCLIP}
  DT_NOCLIP = $100;
  {$EXTERNALSYM DT_EXTERNALLEADING}
  DT_EXTERNALLEADING = $200;
  {$EXTERNALSYM DT_CALCRECT}
  DT_CALCRECT = $400;
  {$EXTERNALSYM DT_NOPREFIX}
  DT_NOPREFIX = $800;
  {$EXTERNALSYM DT_INTERNAL}
  DT_INTERNAL = $1000;
  {$EXTERNALSYM DT_HIDEPREFIX}
  DT_HIDEPREFIX = $00100000;
  {$EXTERNALSYM DT_PREFIXONLY}
  DT_PREFIXONLY = $00200000;

  {$EXTERNALSYM DT_EDITCONTROL}
  DT_EDITCONTROL = $2000;
  {$EXTERNALSYM DT_PATH_ELLIPSIS}
  DT_PATH_ELLIPSIS = $4000;
  {$EXTERNALSYM DT_END_ELLIPSIS}
  DT_END_ELLIPSIS = $8000;
  {$EXTERNALSYM DT_MODIFYSTRING}
  DT_MODIFYSTRING = $10000;
  {$EXTERNALSYM DT_RTLREADING}
  DT_RTLREADING = $20000;
  {$EXTERNALSYM DT_WORD_ELLIPSIS}
  DT_WORD_ELLIPSIS = $40000;

_________________
Das Problem liegt üblicherweise zwischen den Ohren H₂♂
DRY DRY KISS

LokutusvB · Beiträge: 74 WinXP Delphi 5, Delphi XE

Guten Morgen!

Danke dir für deine Mühen! Das sieht mir jedoch recht umfangreich aus, da brauche ich erst einmal eine ruhige Minute, in der ich mir das alles mal in Ruhe anschauen kann.

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme