Форум программистов, компьютерный форум, киберфорум
Наши страницы
Delphi
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.75/4: Рейтинг темы: голосов - 4, средняя оценка - 4.75
Charlie112
0 / 0 / 0
Регистрация: 04.03.2014
Сообщений: 24
1

Не работает ластик

27.10.2014, 18:20. Просмотров 675. Ответов 2
Метки нет (Все метки)

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
unit Unit4;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ExtDlgs, ComCtrls;
 
type
  TForm4 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    Button2: TButton;
    ColorDialog1: TColorDialog;
    ColorDialog2: TColorDialog;
    Label1: TLabel;
    Button3: TButton;
    Button4: TButton;
    OpenPictureDialog1: TOpenPictureDialog;
    SavePictureDialog1: TSavePictureDialog;
    Button5: TButton;
    Edit2: TEdit;
    UpDown1: TUpDown;
    RadioGroup1: TRadioGroup;
    RadioGroup2: TRadioGroup;
    RadioGroup3: TRadioGroup;
    Edit1: TEdit;
    Button6: TButton;
    Panel1: TPanel;
    Panel2: TPanel;
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
 
 
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
 { Private declarations }
   isEraser,UseEraser:Boolean;
  public
    { Public declarations }
  end;
 
var
  Form4: TForm4;
 
implementation
 uses Unit1;
 
var x1,y1:integer;  c:integer;
 
 
{$R *.dfm}
procedure ris(x,y,a:integer;cv:tcanvas);
var b:integer;
begin
 
end;
 
procedure linija(x,y:integer;cv:tcanvas);
var dx,dy:integer;
begin
with cv do
begin
moveto(x1,y1);
lineto(x,y);
end;
end;
  procedure TForm4.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if iseraser then
begin
image1.Canvas.Brush.Color:=clwhite;
image1.Canvas.Brush.Style:=bssolid;
useeraser:=true;
end
else
begin
x1:=x;
y1:=y;
end;
end;
 
procedure TForm4.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
image1.Canvas.Pen.Width:=strtoint(edit2.Text);
 case radiogroup1.ItemIndex of
 0:linija(x,y,image1.Canvas);
 1:image1.canvas.Rectangle(x1,y1,x,y);
 2:image1.Canvas.Ellipse(x1,y1,x,y);
 3:Image1.Canvas.Polygon([point(x1,y1),point(x1+10,y1+30),point(x1+40,y1+40),point(x1+10,y1+50),point(x1,y1+80),
 point(x1-10,y1+50),point(x1-40,y1+40),point(x1-10,y1+30),point(x1,y1)]);
 4:image1.Canvas.TextOut(x,y,''+edit1.Text);
 end;
 case radiogroup2.ItemIndex of
 0: image1.Canvas.Pen.Style:=pssolid;
 1: image1.Canvas.Pen.Style:=psdot;
 end;
  case radiogroup3.ItemIndex of
   0:  image1.Canvas.Brush.Style:=bssolid;
   1:  image1.Canvas.Brush.Style:=bsbdiagonal;
   2:  image1.Canvas.Brush.Style:=bsvertical;
   3:  image1.Canvas.Brush.Style:=bshorizontal;
  end;
  begin
  if useeraser then
  begin
  useeraser:=false;
  exit;
  end;
end;
 end;
 
 
 
procedure TForm4.Button3Click(Sender: TObject);
begin
if openpicturedialog1.Execute then
 Image1.Picture.LoadFromFile(OpenPicturedialog1.FileName);
end;
 
procedure TForm4.Button4Click(Sender: TObject);
begin
 if SavePictureDialog1.Execute then
begin
image1.Picture.SaveToFile(SavePictureDialog1.FileName+'.jpg');
end;
end;
procedure TForm4.Button5Click(Sender: TObject);
begin
//image1.Canvas.Fillrect(Clientrect);
image1.Canvas.Pen.width:=1;
image1.Canvas.Brush.Color:=clwhite;
image1.Canvas.Rectangle(-5,-5,image1.Width+5,image1.Height+5);
end;
 
 
procedure TForm4.Button1Click(Sender: TObject);
begin
if colordialog1.Execute then
begin
image1.Canvas.Font.Color:=colordialog1.Color;
Panel1.Color:=ColorDialog1.Color;
image1.Canvas.Pen.Color:=colordialog1.color;
 
end;
end;
procedure TForm4.Button2Click(Sender: TObject);
begin
if colordialog2.Execute then
begin
image1.Canvas.Brush.Color:=colordialog2.Color;
Panel2.Color:=colordialog2.Color;
end;
end;
 
procedure TForm4.FormCreate(Sender: TObject);
begin
    Screen.Cursors[5] := LoadCursorFromFile('no.cur');
end;
 
 
procedure TForm4.Button6Click(Sender: TObject);
begin
    if isEraser
    then Image1.Cursor := 1
   else Image1.Cursor := 5;
 
   isEraser := not isEraser
 
end;
 
procedure TForm4.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
  var wid:integer;
begin
if useeraser
then
begin
wid:=strtoint(edit2.Text)div 2;
image1.Canvas.FillRect(Rect(x-wid,y-wid,x+wid,y+wid));
end;
end;
end.
0
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
27.10.2014, 18:20
Ответы с готовыми решениями:

Ластик
Как создать ластик, чтобы он при проведении ним по определенной области стирал...

Программный ластик
Подскажите пожалуйста можно ли создать объект который будет работать как...

ластик(графический редактор)
Здравствуйте,делаю графический редактор на шарпе не знаю как сделать...

Ластик как в Paint
Здравствуйте. Подскажите, пожалуйста, как сделать в C# что-то на подобии ластика

Ластик для canvas
Здравствуйте. Как сделать ластик (как в paint или photoshop) на wpf, чтобы он...

2
NIKOLAYY
820 / 718 / 339
Регистрация: 22.09.2012
Сообщений: 4,995
29.10.2014, 15:36 2
Твой код читать нестал, потому что он и не твой думаю, быстрее самому написать. Весь код расписал внутри. Ластик в форме кружочка с возможностью выбора размера из эдит поля. Цвет белый, если хочеш колор-диалог прикрути на выбор цвета.
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
var
  Form1: TForm1;
  tx, ty: integer; //ловим координаты в имаге
  raz: Integer; //размер ластика
implementation
 
{$R *.dfm}
 
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  //размер ластика
  raz:= StrToInt(Edit1.Text);
 
    //ищем положение курсора в имаге
  Form1.caption := Format('X=%d Y=%d', [X, Y]);
  tx := X;
  ty := Y;
 
  //закрашиваем при нажатии на левую кнопку
  if Shift = [ssLeft] then
  begin
    Image1.Canvas.Pen.Color := clWhite;
    Image1.Canvas.Brush.Color := clWhite;
    Image1.Canvas.Ellipse(tx - raz, ty - raz, tx + raz, ty + raz);
  end;
end;
0
Изображения
 
volvo
Супер-модератор
Эксперт Pascal/DelphiАвтор FAQ
26504 / 17798 / 7043
Регистрация: 22.10.2011
Сообщений: 31,328
Записей в блоге: 6
29.10.2014, 16:23 3
не работает ластик
Сказки рассказывать не надо, прекрасно код, выложенный вот тут: Рисование произвольной линии работает. Если ты не можешь даже произвести элементарные действия, чтобы его вставить в проект правильно - кто тебе виноват?
0
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
29.10.2014, 16:23

Реализовать ластик в графическом редакторе
Как сделать ластик(стирачку) потипу как в пейнте(водиш мышкой и оно стирает всё...

Графический редактор - реализовать масштаб и ластик
Кто подскажет как реализовать такие функции в графическом редакторе как:...

Как сделать ластик в графическом редакторе
Доброго.. :) Подскажите, пожалуйста, как же сделать инструмент "ластик" в...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
3
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru