Перейти к содержанию
Fire Monkey от А до Я
  • 0

[TCanvas] Масштабирование и перемещение


Paul Tinnick

Вопрос

Здравствуйте. 

Суть такова: на канве в TImage отрисовываются простейшие геометрические фигуры: (Круг, прямоугольник и треугольник). Как реализовать масштабирование и перемещение при помощи мыши? Собственно, есть код отрисовки фигур

procedure TForm1.DrawEllipseButtonClick(Sender: TObject);
var
  MyRect: TRectF;
  x,y: integer;

begin
  x:=round(image1.Width);
  y:=round(image1.Height);

  MyRect := TRectF.Create(
    x div 2 - strtoint(edit3.Text) / 2,
    y div 2 - strtoint(edit3.Text) / 2,
    x div 2 + strtoint(edit3.Text) / 2,
    y div 2 + strtoint(edit3.Text) / 2
                          );

  Image1.Bitmap.Canvas.BeginScene;
  Image1.Bitmap.Canvas.DrawEllipse(MyRect, 40);
  Image1.Bitmap.Canvas.EndScene;
end;

procedure TForm1.DrawRectButtonClick(Sender: TObject);
var
  MyRect: TRectF;
  x,y: integer;
begin
  x:=round(image1.Width);
  y:=round(image1.Height);

  MyRect := TRectF.Create(
    x div 2 - strtoint(edit2.Text) / 2,
    y div 2 - strtoint(edit1.Text) / 2,
    x div 2 + strtoint(edit2.Text) / 2,
    y div 2 + strtoint(edit1.Text) / 2
                          );
  Image1.Bitmap.Canvas.BeginScene;
  Image1.Bitmap.Canvas.DrawRect(MyRect, 0, 0, AllCorners, 100);
  Image1.Bitmap.Canvas.EndScene;
end;

procedure TForm1.DrawTriangleButtonClick(Sender: TObject);
var
  p1, p2, p3, p4: TPointF;
  MyPolygon: TPolygon;
begin
  p1 := TPointF.Create(16, 40);
  p2 := TPointF.Create(44, 6);
  p3 := TPointF.Create(15,20);
  p4 := TPointF.Create(16,40);
  SetLength(MyPolygon, 4);
  MyPolygon[0] := p1;
  MyPolygon[1] := p2;
  MyPolygon[2] := p3;
  MyPolygon[3] := p4;
  Image1.Bitmap.Canvas.BeginScene;
  Image1.Bitmap.Canvas.DrawPolygon(MyPolygon, 50);
  Image1.Bitmap.Canvas.EndScene;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Image1.Bitmap.SetSize(Round(Image1.Width), Round(Image1.Height));
  Image1.Bitmap.Clear(TAlphaColors.White);
end;

Помогите, пожалуйста.

P.S.: отрисовка треугольника, как можно увидеть, в проекте

Ссылка на комментарий

Рекомендуемые сообщения

  • 0

Доброго дня, а в чем собственно проблема то? Для масштабирования заведите какую нибудь float m_scale = 1.f переменную, в событии OnMouseWheel увеличивайте или уменьшайте ее значение, а потом ваши числовые значения перемножайте на m_scale, да и все. То же и с перемещением: вот код с форума, честно - переписывать леньки, уж простите))

//перемещение формы
bool dragging = false;
POINT MousePnt;
POINT point;
HWND hWnd;
RECT wndrect;

void __fastcall TClock::Image1MouseDown(TObject *Sender,
      TMouseButton Button, TShiftState Shift, int X, int Y)
{
GetCursorPos(&MousePnt);
dragging = true;
SetCapture(hWnd);
 
}
//---------------------------------------------------------------------------
 
void __fastcall TClock::Image1MouseMove(TObject *Sender, TShiftState Shift,
      int X, int Y)
{
if (dragging==true) // Если нажата кнопка, то...
        {
            // Получить текущую позицию курсора
            GetCursorPos(&point);
            // Откорректировать положение окна
            Clock->Left = Clock->Left+(point.x - MousePnt.x);
            Clock->Top  = Clock->Top +(point.y - MousePnt.y);
 
            // Установить новые размеры окна
            //SetWindowPos(hWnd, NULL, wndrect.left, wndrect.top, 0, 0, SWP_NOZORDER | SWP_NOSIZE);
            
            // Запоминаем текущую позицию курсора
            MousePnt=point;
        }
 
 
}
//---------------------------------------------------------------------------
 
void __fastcall TClock::Image1MouseUp(TObject *Sender, TMouseButton Button,
      TShiftState Shift, int X, int Y)
{
if (dragging==true)
        {
            dragging=false;
            ReleaseCapture();
        }
 
}

Код примитивный и немного глуповатый, но смысл думаю поймете. Тут перемещение окна, но вам нужна суть - координаты Clock. Используйте их для отрисовки ваших фигур, и будут они бегать за мышкой.

P.S.Хотя, неблагодарное это дело, плавности не добиться. Наткнувшись на опенсорсную библиотеку (на основе OpenGL), теперь увы на поделки с Timage, да и вообще отрисовка сложных интерфейсов, без слез смотреть невозможно - как по плавности, так и по нагрузке, реализуй хотя бы 50% из того, что там наворотил, на Borland-вской графике, программа бы и не пошевелилась)

Изменено пользователем Gingercat
Ссылка на комментарий

Присоединяйтесь к обсуждению

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

Гость
Ответить на вопрос...

×   Вставлено с форматированием.   Вставить как обычный текст

  Разрешено использовать не более 75 эмодзи.

×   Ваша ссылка была автоматически встроена.   Отображать как обычную ссылку

×   Ваш предыдущий контент был восстановлен.   Очистить редактор

×   Вы не можете вставлять изображения напрямую. Загружайте или вставляйте изображения по ссылке.

  • Последние посетители   0 пользователей онлайн

    • Ни одного зарегистрированного пользователя не просматривает данную страницу
×
×
  • Создать...