Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 20.09.2015, 16:27   #1
Mr.Dmitry
Пользователь
 
Аватар для Mr.Dmitry
 
Регистрация: 18.12.2006
Сообщений: 50
По умолчанию Перемещение нарисованного объекта

Рисую на TImage эллипс, нужно при помощи мыши, перемещать его по Timage. У меня эллипс перемещается но оставляет за собой "След". Как от этого следа избавиться? Вот пример кода.

PS Перерисовка всего image не подойдет т.к эллипсов будет несколько.


Код:
var
MLeft:true;
X0,Y0:integer;
procedure TForm1.FormShow(Sender: TObject);
begin
Image1.Canvas.Ellipse(50, 50, 75, 75);
end;
function TForm1.GetPostion(X, Y: Integer): Boolean;
begin
  if (X > 50) and (X < 75) and
   (Y > 50) and (Y < 75) then
    result:=true
 else
  result:=false;
end;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if (Button=mbLeft) and (GetPostion(X, Y)=true) then
  MLeft:=true;
end;
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
//Меняем стиль курсора
if GetPostion(X, Y)=true then
 image1.Cursor:=crHandPoint
else
 image1.Cursor:=crDefault;
//Перемещаем эллипс
if MLeft=true then
  DrawImage(X,Y,X0,Y0);
 X0:=X;
 Y0:=y;
end;
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if MLeft=true then
MLeft:=false;
end;
//Перерисовываем Image
Procedure TForm1.DrawImage(X,Y,X0,Y0:integer);
begin
 //Стираем
 image1.Canvas.Pen.Style:=psClear;
 image1.Canvas.Ellipse(X0,Y0,X0+25,Y0+25);
 //Рисуем
 image1.Canvas.Pen.Style:=psSolid;
 image1.Canvas.Ellipse(x, y, x + 25, y + 25);
end;
Mr.Dmitry вне форума Ответить с цитированием
Старый 20.09.2015, 17:25   #2
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,792
По умолчанию

Цитата:
(X0,Y0,X0+25,Y0+25);
Оп-па! А чего это стирание так делается? Запоминай предидущие координаты эллипса и стирай там.
Цитата:
Перерисовка всего image не подойдет т.к эллипсов будет несколько.
А я бы как раз перерисовкой делал. Причем в событии OnPaint.
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 20.09.2015, 20:49   #3
Mr.Dmitry
Пользователь
 
Аватар для Mr.Dmitry
 
Регистрация: 18.12.2006
Сообщений: 50
По умолчанию

Ну так X0 Y0 это же вроде бы предыдущие координаты так что по сути и должно стираться предыдущая, или я чего то не понимаю?
А события onPaint у image нет. А как им пользоваться в PaintBox для перерисовки я не понял.
Mr.Dmitry вне форума Ответить с цитированием
Старый 20.09.2015, 21:43   #4
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,792
По умолчанию

Давай я тебе поясню что я предлагаю, а ты уже сам решишь. Без обид но твой код мну приводит к диарее
Код:
unit Unit1;

{$mode objfpc}{$H+}

interface

uses  Contnrs,
      Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs;

type

			{ TFig }
//Объявляем класс фигуры
      TFig=class
        private
          px,py,Rad:Integer;
          canv:TCanvas;
          Procedure Draw;
          Function Fix(ax,ay:Integer):Boolean;
          Constructor Create(ax,ay,ar:Integer;Canvas:TCanvas);
			end;

			{ TForm1 }

      TForm1 = class(TForm)
						procedure FormCreate(Sender: TObject);
						procedure FormDestroy(Sender: TObject);
						procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
									Shift: TShiftState; X, Y: Integer);
						procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
									Y: Integer);
						procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
									Shift: TShiftState; X, Y: Integer);
						procedure FormPaint(Sender: TObject);
      private
          figs:TObjectList; //Список для фигур
            { private declarations }
      public
            { public declarations }
      end;

var   CurFig:TFig; //Захваченная мышкой фигура
      Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
 //Создаем фигуры
      figs:=TObjectList.create(true);
      figs.Add(TFig.Create(10,10,50,Canvas));
      figs.Add(TFig.Create(100,100,50,Canvas));
      figs.Add(TFig.Create(200,200,50,Canvas));
      CurFig:=nil;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
      figs.Free; //Убираем фигуры
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
			Shift: TShiftState; X, Y: Integer);
var i:integer;
begin
 if CurFig=nil then   //Ищем фигуру, которая захвачена мышкой
  with figs do for i:=0 to Count-1 do
   if TFig(Items[i]).Fix(x,y) then begin CurFig:=TFig(Items[i]); break; end;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
			Y: Integer);
begin
 //Если нашли и перемещаем - то менять ее координаты и перерисовывать канву
 if CurFig<>nil then with CurFig do begin
   px:=x; py:=y; Repaint;
 end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
			Shift: TShiftState; X, Y: Integer);
begin
   CurFig:=nil;
end;

procedure TForm1.FormPaint(Sender: TObject);
var i:integer;
begin
  //Рисование массива фигур на канве формы
  with figs do for i:=0 to Count-1 do TFig(Items[i]).Draw;
end;

{ TFig }

procedure TFig.Draw;
begin
    canv.Ellipse(px-Rad,py-Rad,px+Rad,py+rad);
end;

function TFig.Fix(ax, ay: Integer): Boolean;
begin
  Result:=sqrt(sqr(ax-px)+sqr(ay-py))<=Rad;
end;

constructor TFig.Create(ax, ay, ar: Integer; Canvas: TCanvas);
begin
      px:=ax ;py:=ay; Rad:=ar;
      canv:=Canvas;
end;

end.
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 20.09.2015, 22:07   #5
Mr.Dmitry
Пользователь
 
Аватар для Mr.Dmitry
 
Регистрация: 18.12.2006
Сообщений: 50
По умолчанию

Что означает вот эта строчка?

Код:
{$mode objfpc}{$H+}
И почему вам так не нравиться мой код? Что в нем не так? )


И еще, а разве если переменная класса обявлена в секции Private то мы можем к ней обратиться из программы?
Код:
 if CurFig<>nil then with CurFig do begin
   px:=x; py:=y; Repaint;
У меня тоже сделано через классы создание множества эллипсов, но для того чтоб менять значение x y есть специальная процедура входящими параметрами которой является x y и которая уже присваивает приватным переменным новые координаты

Последний раз редактировалось Mr.Dmitry; 20.09.2015 в 22:13.
Mr.Dmitry вне форума Ответить с цитированием
Старый 21.09.2015, 00:52   #6
northener
ПШП
Участник клуба
 
Регистрация: 15.07.2013
Сообщений: 1,859
По умолчанию

Цитата:
Сообщение от Mr.Dmitry Посмотреть сообщение
Что означает вот эта строчка?

Код:
{$mode objfpc}{$H+}
Stilet давно забил на Дельфи и пишет примеры на Лазарусе.. Что в данном случае одно и то же.

Цитата:
Сообщение от Mr.Dmitry Посмотреть сообщение
И еще, а разве если переменная класса обявлена в секции Private то мы можем к ней обратиться из программы?
Код:
 if CurFig<>nil then with CurFig do begin
   px:=x; py:=y; Repaint;
Из программы никак ни к чему обратится невозможно, кроме как к юзеру. В методе класса - сколько угодно.
northener вне форума Ответить с цитированием
Старый 21.09.2015, 07:18   #7
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,792
По умолчанию

Цитата:
почему вам так не нравиться мой код? Что в нем не так? )
Дюже сложно по сравнению с моим, и к тому же не решает твою задачу )
Цитата:
разве если переменная класса обявлена в секции Private то мы можем к ней обратиться из программы?
В рамках одного модуля можем.
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 21.09.2015, 15:00   #8
min@y™
Цифровой кот
Старожил
 
Аватар для min@y™
 
Регистрация: 29.08.2014
Сообщений: 7,656
По умолчанию

Вот, нарисовал на заборе за 20 минут...



Скачать.

Одмины! Опять я вынужден юзать левую файлопомойку.
Разрешите, хотя б архивы 7-zip до 1 Мб закачивать во вложения. Ну чо за безобразие?!
Расскажу я вам, дружочки, как выращивать грибочки: нужно в поле утром рано сдвинуть два куска урана...
min@y™ вне форума Ответить с цитированием
Старый 22.09.2015, 18:21   #9
Mr.Dmitry
Пользователь
 
Аватар для Mr.Dmitry
 
Регистрация: 18.12.2006
Сообщений: 50
По умолчанию

Цитата:
Сообщение от min@y™ Посмотреть сообщение
Вот, нарисовал на заборе за 20 минут...



Скачать.

Одмины! Опять я вынужден юзать левую файлопомойку.
Разрешите, хотя б архивы 7-zip до 1 Мб закачивать во вложения. Ну чо за безобразие?!
Круто спасибо! буду разбираться )

Цитата:
Сообщение от Stilet Посмотреть сообщение
Дюже сложно по сравнению с моим, и к тому же не решает твою задачу )

В рамках одного модуля можем.
Извиняюсь за еще 1 вопрос. Но вот я видел видео и читал в источниках что нужно делать так.


Код:
Type
 Ttest = class
   private
    Name:String;
   public
    constructor Create(Str:String);
    Function GetName():string;
 end;

constructor TTest.Create(Str:String);
begin
Name:=Str;
end;

Function TTest.GetName():string;
begin
 result:=name;
end;

procedure TForm2.Button1Click(Sender: TObject);
var
 test:Ttest;
begin
 Test:=Ttest.Create('Тест');
 with test do
  ShowMessage(GetName);
end;

Но я только что проверил и действительно обращение на прямую к приватной переменной проходит "На прямую"

Код:
procedure TForm2.Button1Click(Sender: TObject);
var
 test:Ttest;
begin
 Test:=Ttest.Create('Тест');
 with test do
  ShowMessage(name);
end;
Но если так, то зачем нужно делать функцию?

Последний раз редактировалось Stilet; 22.09.2015 в 18:46.
Mr.Dmitry вне форума Ответить с цитированием
Старый 22.09.2015, 18:28   #10
min@y™
Цифровой кот
Старожил
 
Аватар для min@y™
 
Регистрация: 29.08.2014
Сообщений: 7,656
По умолчанию

Цитата:
Круто спасибо! буду разбираться )
никакой крутоты там нет, это только прототип – 2 класса, на основе которых можно написать примитивный графический редактор и натянуть на него курсач или диплом.

Вот, сюда почитай ещё. Это я так скуку разгоняю.
Кстати, да, и вот так - тоже.
Расскажу я вам, дружочки, как выращивать грибочки: нужно в поле утром рано сдвинуть два куска урана...

Последний раз редактировалось min@y™; 22.09.2015 в 18:43.
min@y™ вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Перемещение графического объекта woorribin Помощь студентам 0 10.05.2015 15:21
Перемещение объекта мыщью palyach Паскаль, Turbo Pascal, PascalABC.NET 20 03.05.2013 14:58
Перемещение объекта по форме.(Управление с клавиатуры) gralex10 Помощь студентам 1 28.03.2011 15:57
перемещение объекта за курсором мышки eu8cc Общие вопросы Delphi 2 28.09.2009 22:48