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:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:

unit Kreis;

interface
uses Forms, Graphics,
      unit1,Windows, Messages, SysUtils, Classes, Controls,  Dialogs,StdCtrls;

type TKreis = class
  private
   z: Integer;
  rx,ry: Integer;
  x0, y0,anfass: Integer;
  cvs: TCanvas;
  dcx,dcy: Integer;
  mycolor:tcolor;
  anz:integer;

  public
  constructor erzeugen(x,y,rdx,rdy: Integer;_mycolor: TColor; f: TForm);
  procedure zeichnen;virtual;
  procedure anfassen(x,y: Integer);virtual;
  procedure ziehen(x,y: Integer);
  procedure loslassen;

end;

 TeckL2 = class(Tkreis)
  public
  procedure zeichnen;override;
  procedure anfassen(x,y: Integer);override;
  end;

  TeckL1 = class(TeckL2)
  public
  procedure zeichnen;override;
  procedure anfassen(x,y: Integer);override;
  end;
  type Tq3 = class(TeckL2)
 procedure zeichnen;override;
 procedure anfassen(x,y: Integer);override;
 end;

implementation

constructor TKreis.erzeugen;
begin
 z:=0;anfass:=2;
 f.Color := clwhite;
 mycolor :=_mycolor;
 x0:=x; y0:=y; rx:=rdx;ry:=rdy;
 cvs:= f.Canvas;
 cvs.Brush.Style := bssolid;  // transparent (kein Füllmuster für Kreis)
 cvs.Pen.Color:=$FFFFFF;
 cvs.Pen.Mode := pmxOR;       // XOR-Zeichenmodus
 dcx := rx div anfass; //dr := 3;
 dcy := ry div anfass;
 zeichnen
 end;

procedure TKreis.zeichnen;
begin
 with cvs do begin
  brush.Color:=mycolor xor clwhite;
  // Zeichenfarbe:=3;
  Pen.Width:=1;
  rectangle(x0-rx,y0-ry,x0+rx,y0+ry);
  dcx := rx div anfass;      // Mittelkreuz anpassen
  dcy := ry div anfass;
  MoveTo(x0-dcx, y0); LineTo(x0+dcx+1, y0);
  MoveTo(x0, y0-dcy); LineTo(x0, y0+dcy+1);
 inc(anz);
 end;
end;



procedure Tq3.zeichnen;
begin
with cvs do begin
  brush.Color:=mycolor xor clwhite;
       // Zeichenfarbe:=3;
  Pen.Width:=1;
  rectangle(x0-rx,y0-ry,x0+rx,y0+ry);
  dcx := rx div anfass;      // Mittelkreuz anpassen
  dcy := ry div anfass;
  MoveTo(x0-dcx, y0); LineTo(x0+dcx+1, y0);
  MoveTo(x0, y0-dcy); LineTo(x0, y0+dcy+1);
  end;
    end;

procedure teckL2.zeichnen;
var k:byte;
begin
k:=10;
 with cvs do begin
  brush.Color:=mycolor xor clwhite;
       // Zeichenfarbe:=3;
  Pen.Width:=7;
  polygon([Point(x0-k, y0-k),Point(x0+50-k, y0-k),Point(x0+50-k,y0+50-k), Point(x0+100-k,y0+50-k), Point(x0+100-k,y0+100-k), Point(x0-k,y0+100-k)]);
  dcx := rx div anfass;      // Mittelkreuz anpassen
  dcy := ry div anfass;
  //       -dcx  -dcy
 { MoveTo(x0, y0); LineTo(x0+dcx+1, y0);
  MoveTo(x0, y0); LineTo(x0, y0+dcy+1);}
 end;
end;


procedure teckL1.zeichnen;
var k:byte;
begin
  k:=10;
  with cvs do begin
   brush.Color:=mycolor xor clwhite;
      // Zeichenfarbe:=3;
  Pen.Width:=3;
  polygon([Point(x0-k, y0-k),Point(x0+100-k,y0-k), Point(x0+100-k,y0+100-k),
  Point(x0+50-k,y0+100-k), Point(x0+50-k,y0+50-k),Point(x0-k,y0+50-k)]);

     //rectangle(x0-rx,y0-ry,x0+rx,y0+ry);
  dcx := rx div anfass;      // Mittelkreuz anpassen
  dcy := ry div anfass;
  //       -dcx  -dcy
 { MoveTo(x0, y0); LineTo(x0+dcx+1, y0);
  MoveTo(x0, y0); LineTo(x0, y0+dcy+1);}
 end;
end;






procedure TKreis.anfassen(x,y:integer);
 function mitteGetroffen: Boolean;  // testet, ob Mausklick den Mittelpunkt des Kreises trifft
 begin
  Result := False;
  if (X > (x0-dcx)) and (X < (x0+dcx+1)) and
     (Y > (y0-dcy)) and (Y < (y0+dcy+1)) then Result := True
  end;
begin
 if mitteGetroffen then z := 1;   // neuer Zustand "Kreis verschieben"
 end;

 procedure Teckl1.anfassen(x,y:integer);
 function mitteGetroffen: Boolean;  // testet, ob Mausklick den Mittelpunkt des Kreises trifft
 begin
  Result := False;
      if ((x>x0) and (X <x0+2*rx)and(Y >y0 ) and (Y < y0+4*ry))
     or ((x>x0+2*rx) and (x<x0+4*rx)and(y>y0+2*ry) and(y<y0+4*ry))
then Result := True
  end;
  begin
 if mitteGetroffen then  begin z := 1;end;   // neuer Zustand "Kreis verschieben"
 end;

   procedure Teckl2.anfassen(x,y:integer);
 function mitteGetroffen: Boolean;  // testet, ob Mausklick den Mittelpunkt des Kreises trifft
 begin
  Result := False;
  if (X > (x0-dcx)) and (X < (x0+dcx+1)) and
     (Y > (y0-dcy)) and (Y < (y0+dcy+1)) then Result := True
  end;
begin
 if mitteGetroffen then z := 1;   // neuer Zustand "Kreis verschieben"
 end;

 procedure Tq3.anfassen(x,y:integer);
 function mitteGetroffen: Boolean;  // testet, ob Mausklick den Mittelpunkt des Kreises trifft
 begin
  Result := False;
  if (X > (x0-dcx)) and (X < (x0+dcx+1)) and
     (Y > (y0-dcy)) and (Y < (y0+dcy+1)) then Result := True
  end;
  begin
 if mitteGetroffen then z := 1;   // neuer Zustand "Kreis verschieben"
 end;

 procedure TKreis.ziehen;
 begin
  if z = 0 then Exit;      // kein Zeichnen im Zustand "Normal"
  zeichnen;                  // alten Kreis löschen durch Überzeichnen
  if z=1 then begin         // Kreis verschieben
   x0 := X; y0 := Y
  end;
  zeichnen                   // Kreis neu zeichnen
end;

procedure TKreis.loslassen;
begin
 z:=0
end;


end.

// Demo für mausgesteuerte Grafikoperationen
// (c) ProfDob, 26.05.01

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls,math;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    procedure FormPaint(Sender: TObject);
    procedure FormCreate(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);
  private
    { Private-Deklarationen }
  public

  end;

var
  Form1: TForm1;
implementation

{$R *.DFM}

uses Kreis;

var klotzL2:teckL2;klotzL1:teckL1; klotz:array[1..4]of tkreis;q1,q3,q3a:tq3;
    var klotzfarbe:tcolor;
procedure TForm1.FormPaint(Sender: TObject);  // regeneriert Zeichnung
var i:byte;
begin
 canvas.Pen.Width:=4;
 canvas.brush.Color:=clred xor clwhite;
 canvas.Pen.Color:=clblue xor clwhite;
 canvas.fillrect(rect(0,0,265,265));
 for i:=1 to 4 do
klotz[i].zeichnen;
klotzL2.zeichnen;
klotzL1.zeichnen;
q1.zeichnen;
q3.zeichnen;
q3a.zeichnen;

showmessage('L');

end;

procedure TForm1.FormCreate(Sender: TObject);
var i,k:byte;
begin
 k:=4;
 canvas.Pen.Width:=4;
 canvas.brush.Color:=clred;
 canvas.Pen.Color:=clblue xor clwhite;
 canvas.fillrect(rect(0,0,265,265));
  klotz[1]:= TKreis.erzeugen(50+k,73 ,50,25,clgreen, Form1);
  klotz[2]:= TKreis.erzeugen(150+k,73 ,50,25,clgreen, Form1);
  klotz[3]:= TKreis.erzeugen(105+k,125,50,25,clgreen, Form1);
  klotz[4]:= TKreis.erzeugen(205+k,125 ,50,25,clgreen, Form1);

  klotzL2:=TeckL2.erzeugen(10+k,110, 25,25,$ff0000, Form1);
  klotzL1:=TeckL1.erzeugen(165+k,5 , 25,25,$ff0000, Form1);
  q1     :=tq3.erzeugen(130+k,230, 25,25,$ff00ff , Form1);

  q3    := Tq3.erzeugen(75+k,15 , 75,30,$00ff00, Form1);
  q3a    := Tq3.erzeugen(180+k,178 , 75,25,$00ff00, Form1);

end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
 var i:byte;
 begin
 for i:=1 to 4 do
 klotz[i].anfassen(X,Y);
 klotzL2.anfassen(x,y);
 klotzL1.anfassen(x,y);
 q1.anfassen(x,y);
 q3.anfassen(x,y);
 q3a.anfassen(x,y);

 end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
 var i:byte;
begin
for i:=1 to 4 do
 klotz[i].ziehen(X,Y);
 klotzL2.ziehen(x,y);
 klotzL1.ziehen(x,y);
 q1.ziehen(x,y);
 q3.ziehen(x,y);
 q3a.ziehen(x,y);
 end;


procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
 var i:byte;
begin
 for i:=1 to 4 do
 klotz[i].loslassen;
 klotzL2.loslassen;
 klotzL1.loslassen;
 q1.loslassen;
 q3.loslassen;
 q3a.loslassen;
 end;
end.