|
Registriert seit: 10. Mai 2004 Ort: Hartha 9 Beiträge Delphi 6 Personal |
#1
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 |
Zitat |
Ansicht |
Linear-Darstellung |
Zur Hybrid-Darstellung wechseln |
Zur Baum-Darstellung wechseln |
ForumregelnEs 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
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
LinkBack URL |
About LinkBacks |