AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Problem Graphik auf dem Tcanvas

Ein Thema von biochip · begonnen am 11. Dez 2004
Antwort Antwort
biochip

Registriert seit: 10. Mai 2004
Ort: Hartha
9 Beiträge
 
Delphi 6 Personal
 
#1

Problem Graphik auf dem Tcanvas

  Alt 11. Dez 2004, 22:50
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
  Mit Zitat antworten Zitat
Antwort Antwort


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 20:08 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz