Рисование на картинке мышью

[LexGam]

Всем привет.

Возникла необходимость рисовать на картинке в компоненте TImage.
У Image1 установлено свойство Stretch и Proportional в true.

На пустом компоненте рисуется без проблем в том месте где проходит курсор мыши следующим образом:

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  with Image1.Canvas do begin
   Pen.Color:= clNavy;
   Pen.Width:= 10;
   MoveTo(X, Y);
 end;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if ssLeft in Shift then Image1.Canvas.LineTo(X, Y);
end;

Проблема возникает тогда, когда в компонент Image1 загружается какая-то картинка, реальный размер которой не равен размеру Image1. Благодаря установленным свойствам она подгоняется под размеры компонента, но при этом линии перестают рисоваться в том месте где находится курсор и той тощиной, которая была установлена. К примеру рисую в центре Image, а на картинке рисуется сбоку.

Я понял, что при загрузке картинки и рисовании на ней нужно посылать не координаты курсора над компонентом Image а координаты как бы курсора над картинкой, но как это сделать, не пойму.

Прошу помощи.

[LexGam]

В принципе, можно сделать так, но это работает только при Proportional=false. Всётаки как это правильно сделать?

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  XX,YY:double;
begin
  XX:=Image1.Picture.Width/Image1.Width;
  YY:=Image1.Picture.Height/Image1.Height;

  with Image1.Canvas do begin
   Pen.Color:= clNavy;
   Pen.Width:= 10;
   MoveTo(Round(X*XX), Round(Y*YY));
 end;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  XX,YY:double;
begin
  XX:=Image1.Picture.Width/Image1.Width;
  YY:=Image1.Picture.Height/Image1.Height;

  if ssLeft in Shift then Image1.Canvas.LineTo(Round(X*XX), Round(Y*YY));

  Label1.Caption:=IntToStr(X);
  Label2.Caption:=IntToStr(Y);
end;

И ещё один вопрос. Если у Image свойство Proportional или AutoSize установлено в True, при рисовании на картинке она начинает жёстко мигать. Как от этого избавиться?

[LexGam]

Почему нет ответов, неужели никто не сталкивался?

[jester81]

Получилось.
Пользуйтесь.

procedure TForm1.Image2MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var xx,yy:real;
    a,b :real;
begin
     if Shift = [ssRight] then
          begin
             a:= ((Form1.Image2.Picture.Width)/Form1.Image2.Width);
             b:= ((Form1.Image2.Picture.Height)/Form1.Image2.Height);

            if a<=b then
            begin
                  xx:= x*b;
                  yy:= y*b;
            end else
            begin
                  xx:= x*a;
                  yy:= y*a;

            end;

          Image2.Canvas.Pen.Color:=clRed;
          Image2.Canvas.Pen.Width:=8;
           Image2.Picture.Bitmap.Canvas.MoveTo(Trunc(xx),Trunc(yy));
           Image2.Picture.Bitmap.Canvas.LineTo(Trunc(xx),Trunc(yy));
     end;
end;