Hi, Ich habe im Buch von Herrn Dr. Doberenz ein kleines
OOP Demo wo auf dem Canvas mit dem Elipsenbefehl 2 Kreise gezeichnet und mit der Maus verschoben werden können.
Mit dieser Grundlage habe ich versucht ein Puzzlespiel mit Quadraten,Recchtecken,und PolygonFlächen anzufangen und damit
OOP-Kenntnisse(Vererbung) und mausgesteuerte Graphicenntnise zu erhalten.
Kann einer mein kleines Programm analysieren und mir helfen und sagen so gehts nicht oder zu umständlich!!
Ich weis nicht wie ich euch effizient fragen soll
Jedes Object hat seine Form u. Farbe die überschrieben wird die bewegung ist für ale ojecte gleich.
--brush.Color:=mycolor xor clwhite; Problem der kräftigen Farben
--
cvs.Brush.Style := bssolid; im demo nur bsclear keine Farbe ist das das Gleiche wie Transparent?
Praktische Verständnis für Formpaint wird es nur aktiv beim Konstructoraufruf oder auch bei jeder Graphikanweisung auf dem Canvas oder beides.
Herr Dr. Doberenz hat hier von der Urklasse(Einsteigerdemo) abgeleitet deshalb Maus u. Paint-Ereignise von der Tformklasse.
In der Praxis wird wohl von den sichtbaren Graphikklassen (zBTcontroll )abgeleitet die haben die Maus u- paintereigisse an Bord(viel mehr Overhead) da find ich kein Demo.
Jede Fensterklasse hat einen Recteckigen Nutzbereich.Da habe ich auch ein Puzzleprogramm geschrieben bringe aber nur Rechteckige Graphikflächen(z.B Tpanel)
Ich kann das Programm nur mailen(brauche ein der es auf seine Hompage läd)
Aber maskentechnik(nur mit Hilfsbitmap)sind Demos(Animation mit Bitblt) ja ohne Mausteuerung sind im Buch .
Also kein Demo mit integrierten Maussteuerung+ Maskenentechnik,Hilfbitmap,Bitbln(
API) wo mann das Problem durcharbeiten kann und auf eigene Bedürfnise erwitern kann.
Der Qellcode erweitertes Demo hier bleibt dann nur Democharakter.
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 tpuzzle;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;
//unit1.form1.label1.caption:=inttostr(strtoint(
unit 1.form1.label1.caption)+1);
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]:= TPuzzle.erzeugen(50+k,73 ,50,25,clgreen, Form1);
klotz[2]:= TPuzzle.erzeugen(150+k,73 ,50,25,clgreen, Form1);
klotz[3]:= TPuzzle.erzeugen(105+k,125,50,25,clgreen, Form1);
klotz[4]:= TPuzzle.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;
// 1. Kreiselement anklicken:
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;
// 2. Kreiselement bei gedrückter Maustaste "ziehen":
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;
// 3. Maustaste loslassen:
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.
unit Kreis;
interface
uses Forms, Graphics,
unit1,Windows, Messages, SysUtils, Classes, Controls, Dialogs,StdCtrls;
type TPuzzle = class
private
z: Integer; // Zustand (0, 1, 2)
rx,ry: Integer; // Radius
x0, y0,anfass: Integer;
cvs: TCanvas;
dcx,dcy: Integer; // Größe des Mittelkreuzes
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(TPuzzle)
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 TPuzzle.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 TPuzzle.zeichnen;
begin
with
cvs do begin
brush.Color:=mycolor xor clwhite;
// Zeichenfarbe:=3;
Pen.Width:=3;
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:=3;
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:=3;
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+15); LineTo(x0+dcx+1, y0+15);
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 TPuzzle.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 TPuzzle.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 TPuzzle.loslassen;
begin
z:=0
end;
end.
Gruß
biochip