Работа с canvas. Delphi

[MihalNik]

rect1, rect2: TRect;
D: Integer;
...
  rect1:= Form1.ClientRect;
  rect2:= rect1;
  rect1.Bottom:= rect1.Bottom - D;
  rect2.Top:= rect2.Top + D;
  Form1.Canvas.CopyRect(rect1, Form1.Canvas, rect2);

[McFrey]

MihalNik, огромное спасибо, вот так вот работает, т.е. все сдвигается так как нужно! Только после сдвига, выводится одна и таже строчка постоянно, ну последняя на которой и произошел сдвиг, не знаете как устранить?

procedure TForm1.outtxt;
var
  q: integer;
      rect1, rect2: TRect;
  D: Integer;
begin
  with Form1.Canvas do
  begin
    for q := 1 to N do
    begin
      TextOut(PenPos.X, PenPos.Y, a[q]);
      if PenPos.X + TextWidth(a[i]) > 250 then begin
        Form1.Canvas.MoveTo(Form1.Canvas.PenPos.X - (240 + TextWidth(a[i])),
                       Form1.Canvas.PenPos.Y + 20);
          if PenPos.Y>275 then begin
      D:=20;
      rect1:= Form1.ClientRect;
      rect2:= rect1;
      rect1.Bottom:= rect1.Bottom - D;
      rect2.Top:= rect2.Top + D;
      Form1.Canvas.CopyRect(rect1, Form1.Canvas, rect2);
      end;
      end;
      sleep(10);
    end;
  end;
end;

[MihalNik]

Возможно TextOut в конце идти должен

[McFrey]

procedure TForm1.outtxt;
var
  q: integer;
      rect1, rect2: TRect;
  D: Integer;
begin
  with Form1.Canvas do
  begin
    for q := 1 to N do
    begin
      if PenPos.X + TextWidth(a[i]) > 250 then begin
        Form1.Canvas.MoveTo(Form1.Canvas.PenPos.X - (240 + TextWidth(a[i])),
                       Form1.Canvas.PenPos.Y + 20);
          if PenPos.Y>275 then begin
      D:=20;
      rect1:=Rect(0,0,255,283);
      rect2:= rect1;
      rect1.Bottom:= rect1.Bottom - D;
      rect2.Top:= rect2.Top + D;
      Form1.Canvas.CopyRect(rect1, Form1.Canvas, rect2);
      Form1.Canvas.MoveTo(Form1.Canvas.PenPos.X - (240 + TextWidth(a[i])),
                       Form1.Canvas.PenPos.Y - 20);
      end;
      end;
      TextOut(PenPos.X, PenPos.Y, a[q]);
      sleep(10);
    end;
  end;
end;

Вот конечный вариант, немного коряво, но работает, может "потомкам" пригодится =)
Отдельное, большое спасибо MihalNik

[phomm]

Успешно применяю:

function AddMultiLineText(aText: string; Canv: TCanvas; Bound: Tpoint): Integer;
var
  i, c, res: Word;
  sl: TStringList;
  s: string;
  TH: Integer;

  function AddRow(astr: string): Boolean;
  begin
    Canv.TextOut(Bound.X, res * TH + Bound.Y, astr);
  end;

  function Addline(astr, aword: string): Boolean;
  begin
    Result := Canv.TextWidth(astr + aword) >= Canv.ClipRect.Right - Bound.X;
    if Result then
    begin
      AddRow(astr);
      inc(res)
    end;
  end;

  procedure WordDivider;
  begin
    StringReplace(atext, '  ', ' ', [rfReplaceAll]); // kill all double-space
    SL.Delimiter := ' ';
    SL.DelimitedText := aText; // divide all Text into words
  end;

begin
  SL := TStringList.Create;
  WordDivider;
  Res := 0;
  s := '';
  TH := Canv.TextHeight('1') - 10;
  c := SL.Count - 1;
  for i := 0 to c do
  begin
    if Addline(s, sl[i]) then // if string fits then inscribe it
      s := ''; // and Clear it
    s := s + sl[i] + ' '; // and Add a word
    if (i = c) and (s <> '') then // if needed Add last string
    begin
      AddRow(s);
      inc(res);
    end;
  end;
  Result := res;
  FreeAndNil(SL);
end;

Даём текст и канвас куда выводить, также отступ в виде тпоинт (по х и по у с каждой края канваса). Возращает кол-во строк полученных при разбиении. При превышении текстом размеров канваса, ессно строки просто не отрисуются.

[McFrey]

phomm, я правильно понимаю, что если текст не влезет в отведенную для него "канву" то его и не отобразит??или уже ночь и мой мозг спит?

Если б все было так просто....а бился я над тем как раз, что если текст не влезет то все равно должен отображать...

Все равно, спасибо что откликнулись

[MihalNik]

Конечно, не отобразит.

[New man]

вот проект похожий, только рисует на DC=0
Выходить Alt+F4