Перемещение текста по canvas

[Аватар]

Ладно, я сегодня добрый почему-то. Начальное положение текста в левом верхнем углу паинтбокса, фонт текста совпадает с фонтом формы, поэтому не мудрил. Если другой, так не пойдёт. Выгрузка в bmp-файл

var Picture: TPicture;
    Moved: Boolean;
    Xstart,Ystart: Integer;
    TextSize: TSize;
    lPoint: TPoint;
const MyText = 'Мой текст';

procedure TForm1.FormCreate(Sender: TObject);
begin
  Picture:=TPicture.Create;
  Picture.LoadFromFile('Кошак.jpg');
  Moved:=False;
  DoubleBuffered:=True;
  GetTextExtentPoint32(Canvas.Handle,PChar(MyText),Length(MyText),TextSize);
  lPoint:=Point(0,0);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Picture.Free;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  PaintBox1.Canvas.StretchDraw(PaintBox1.ClientRect,Picture.Graphic);
  PaintBox1.Canvas.Brush.Style:=bsClear;
  PaintBox1.Canvas.TextOut(lPoint.X,lPoint.Y,MyText);
end;

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (X>=lPoint.X) and (X<lPoint.X+TextSize.cx) and
     (Y>=lPoint.Y) and (Y<lPoint.Y+TextSize.cy) then begin
    Xstart:=X;
    Ystart:=Y;
    Moved:=True;
  end;
end;

procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Moved:=False;
end;

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var i: Integer;
begin
  if Moved then begin
    i:=lPoint.X-Xstart+X;
    if i<0 then i:=0
    else if i+TextSize.cx>PaintBox1.Width then i:=PaintBox1.Width-TextSize.cx;
    lPoint.X:=i;
    Xstart:=X;
    i:=lPoint.Y-Ystart+Y;
    if i<0 then i:=0
    else if i+TextSize.cy>PaintBox1.Height then i:=PaintBox1.Height-TextSize.cy;
    lPoint.Y:=i;
    Ystart:=Y;
    PaintBox1.Refresh;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var Bitmap: TBitmap;
begin
  Bitmap:=TBitmap.Create;
  Bitmap.Width:=PaintBox1.Width;
  Bitmap.Height:=PaintBox1.Height;
  Bitmap.Canvas.CopyRect(PaintBox1.ClientRect,PaintBox1.Canvas,PaintBox1.ClientRect);
  Bitmap.SaveToFile('e:\sss.bmp');
  Bitmap.Free;
end;

По поводу рект см. TRect. Здесь явно не использовал, TextSize вместе с lPoint почти то же самое по смыслу

[Alex2009]

Спасибо большое.