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

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

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 18.11.2011, 03:07   #1
Александра_69
Пользователь
 
Регистрация: 28.10.2011
Сообщений: 22
Злость не стирается часть рисунка при перемещении

тележка на колесах. при нажатии на кнопку рисунок должен перемещаться, а у меня прямоугольник двигается, а колеса нет. почему?

Код:
unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, StdCtrls, ExtCtrls, unit2, Clipbrd;
type
  TForm1 = class(TForm)
    img1: TImage;
    btn1: TButton;
    btn2: TButton;
    btn3: TButton;
    btn4: TBitBtn;
    procedure btn3Click(Sender: TObject);
    procedure btn4Click(Sender: TObject);
    procedure btn1Click(Sender: TObject);
    procedure btn2Click(Sender: TObject);
  private         { Private declarations }
  public          { Public declarations }
  end;
var     Form1: TForm1;
        okno1:Timage;
        pxm,pym,pr,x0,y0,r0:integer;
        kol:tkol;     tel:ttel;
implementation    {$R *.dfm}

procedure TForm1.btn1Click(Sender: TObject);
begin
okno1:=Form1.Img1;
colrBack:=clYellow;
pxm:=okno1.ClientWidth;
pym:=okno1.ClientHeight;
with okno1.canvas do begin
pen.color:=colrBack;
pen.Width:=3;
brush.color:=colrBack;
Rectangle(0,0,Pxm,Pym);
end;
x0:=20; 
y0:=140;
r0:=30;
 tel:=Ttel.Create(x0,y0,clgreen,img1.canvas);
 kol:=Tkol.Create(x0+40,y0,r0,clblack,300,img1.canvas);
 tel.Show;
 kol.Show;
end;

procedure TForm1.btn3Click(Sender: TObject);
begin
  Clipboard.Assign(Img1.Picture);
end;

procedure TForm1.btn4Click(Sender: TObject);
begin
tel.Free;
kol.Free;
end;

procedure TForm1.btn2Click(Sender: TObject);
begin
  okno1.Update;
  tel.MoveTo(4,0);
  kol.MoveTo(4,0);
end;
end.
Код:
unit Unit2;
interface
uses  Graphics;
var   ColrBack:Tcolor;
Type
Tviz=class(Tobject)// Àáñòðàêòíûé ðîäèòåëüñêèé êëàññ
    ColrLine : Tcolor;
    Canvas : Tcanvas;
    x,y,r:integer;
    i,k: integer;
    Procedure Ris;virtual;abstract;// Ïåðåêðûâàåìûé ìåòîä äëÿ ðèñîâàíèÿ
    Procedure Draw(bl:boolean);
    procedure Show;
    procedure Hide;
    procedure MoveTo(dx,dy:integer);  // Ñäâèíóòü
       end;
Ttel=class(Tviz)   // Êëàññ ðèñîâàíèÿ ïðÿìîóãîëüíèêà
    Constructor Create(x0,y0:word; colrLine0:Tcolor;canvas0:Tcanvas);
    Procedure Ris; override;
    end;

TKol=class(Ttel)   // Êëàññ ðèñîâàíèÿ êîëåñ íà òåëåæêå
    ugol:integer;
    Constructor Create(x0,y0,r0,ug0:integer; colrLine0:Tcolor;canvas0:Tcanvas);
    Procedure Ris; override;
    end;

implementation

Procedure Tviz.draw;
begin
  with Canvas do begin
    if bl then  begin
    pen.color:=colrLine;
    brush.color:=colrLine; end
    else begin
    pen.color:=colrBack;
    brush.color:=colrBack; end;
  Ris;
  end;
end;

Procedure Tviz.Show;
begin
 Draw(true);
end;

Procedure Tviz.Hide;
begin
 Draw(false);
end;

procedure Tviz.MoveTo;
begin
  Hide;
  x:=x+dx;
  y:=y+dy;
  Show;
end;

Constructor Ttel.Create;
begin
    colrLine:=colrLine0;
    canvas:=canvas0;
    x:=x0;
    y:=y0;
end;

Procedure ttel.Ris;
Begin
With Canvas do Begin
  rectangle(x,y,x+220,y+120);
end;
end;


Constructor TKol.Create;
begin
  x:=x0;
  y:=y0+120;
  r:=r0;
  ugol:=ug0;
  colrLine:=colrLine0;
  Canvas:=canvas0;
end;

Procedure TKol.ris;
var i,k:integer;  xt,yt,xk,yk:integer;
begin
  k:=0;
  repeat
  k:=k+1;
  Canvas.Brush.Color:=colrBack;
  canvas.Pen.Width:=8;
  Canvas.Ellipse(x-r,y-r,x+r,y+r);
  i:=0;
  Canvas.Pen.Width:=3;
  while i<180 do begin
      xt:=round(r*sin(((i+ugol)*Pi)/180));
      yt:=round(r*cos(((i+ugol)*Pi)/180));
      xk:=x-xt;
      yk:=y-yt;
      xt:=xt+x;
      yt:=yt+y;
      canvas.MoveTo(xt,yt);
      canvas.LineTo(xk,yk);
      i:=i+60;
  end;
  x:=x+140;
  until k=2;
end;
end.
Александра_69 вне форума Ответить с цитированием
Старый 18.11.2011, 10:25   #2
phomm
personality
Старожил
 
Аватар для phomm
 
Регистрация: 28.04.2009
Сообщений: 2,882
По умолчанию

Исправьте процедуру TKol.ris как в моём коде, а то у Вас там менялось поле класса Х, из-за чего отрисовка второго колеса влияла на класс в целом, я сделал через временную перменную, убрал это влияние. Ещё там есть небольшой глитч, стирание колеса на старой позиции чуть-чуть затирает тележку, ну тут уж как-то надо перепроектировать, могу предложить чистить весь канвас, а не за конкретными частями, и рисовать без стираний, тогда вышеописанного не должно быть.
Код:
Procedure TKol.ris;
var i,k,tx:integer;  xt,yt,xk,yk:integer;
begin
  k:=0;
  tx := x;
  repeat
  k:=k+1;
  Canvas.Brush.Color:=colrBack;
  canvas.Pen.Width:=8;
  Canvas.Ellipse(tx-r,y-r,tx+r,y+r);
  i:=0;
  Canvas.Pen.Width:=3;
  while i<180 do begin
      xt:=round(r*sin(((i+ugol)*Pi)/180));
      yt:=round(r*cos(((i+ugol)*Pi)/180));
      xk:=tx-xt;
      yk:=y-yt;
      xt:=xt+tx;
      yt:=yt+y;
      canvas.MoveTo(xt,yt);
      canvas.LineTo(xk,yk);
      i:=i+60;
  end;
  tx:=tx+140;
  until k=2;
end;
А вообще рекомендую поднимать уровень кода - убирать где можно глобальные переменные, вводить константы, четко разделять код на сущности, улучшить стиль кода (отступы, "говорящие" имена) и прочее - всё это очень упростит написание таких задач. Советую почитать GunSmoker'a http://www.gunsmoker.ru/2011/01/blog-post.html

Последний раз редактировалось phomm; 18.11.2011 в 10:35.
phomm вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Зависание CopyFileEx при перемещении формы ProESM Общие вопросы Delphi 2 25.04.2011 16:01
шум при перемещении мыши Lotles Компьютерное железо 6 14.12.2010 21:16
Перезапись при копировании/перемещении Shouldercannon Общие вопросы Delphi 4 12.09.2010 02:32
Моргает label при перемещении Maxs Компоненты Delphi 21 26.11.2009 19:57
Процедура при перемещении формы Alex Cones Общие вопросы Delphi 7 28.07.2009 09:11