Modyfikacja algorytmu

0

Błagam niech mi ktoś pomoże zmodyfikować ten algorytm justowania tekstu do lewego i prawego marginesu na canvasie

function Justify(DC:HDC;text:string;AreaWidth:integer):string;
var
  Canvas   : TCanvas;
  i,j      : integer;
  Len      : integer;
  SpaceLen : integer;
  tmp      : string;
begin
  Canvas:=TCanvas.Create;
  Canvas.Handle:=DC;
  Len:=Canvas.TextWidth(text);
  SpaceLen:=Canvas.TextWidth(#32);
  i:=1;
  while (Len<AreaWidth) do begin
    while(i<Length(text)) do begin
      if text[i]=#32 then begin
        for j:=i+1 to Length(text) do
          if text[j]=#32 then inc(i) else break;
        tmp:='';
        for j:=1 to i do tmp:=tmp+text[j];
        tmp:=tmp+#32;
        for j:=i+1 to length(text) do tmp:=tmp+text[j];
        text:=tmp;
        i:=i+2;
        Len:=Len+SpaceLen;
      end else
        inc(i);
    end;
    i:=1;
  end;
  Result:=text;
end;
0

to może napisz co z nim jest nie tak, że Ci nie odpowiada

0

Źle działa dla wiekszej liczby wyrazów (l>4)

0
procedure Justify(ACanvas: TCanvas; AText: string; x, y: Integer; AreaWidth: integer);
var
  sl: TStringList;
  ATextWidth: Integer;
  ASpcWidth, xx: Double;
  i: Integer;
  s: string;
begin
  xx := x;
  sl := TStringList.Create;
  try
    sl.Delimiter := ' ';
    sl.DelimitedText := AText;
    s := sl.Text;
    while Pos(#13#10, s) <> 0 do
    begin
      Delete(s, Pos(#13#10, s), 2);
    end;

    ATextWidth := ACanvas.TextWidth(s);
    ASpcWidth := (AreaWidth - ATextWidth) / (sl.Count - 1);
    for i := 0 to sl.Count - 1 do
    begin
      Canvas.TextOut(Trunc(xx), y, sl[i]);
      xx := xx + ACanvas.TextWidth(sl[i]) + ASpcWidth;
    end;
  finally
    FreeAndNil(sl);
  end;
end;

dziala na 100%

0

Big thx! [green]

1 użytkowników online, w tym zalogowanych: 0, gości: 1