Einzelnen Beitrag anzeigen

Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
43.249 Beiträge
 
Delphi 12 Athens
 
#7

Re: Rectangle zwischen 2 Kästen entfernen

  Alt 22. Nov 2009, 16:09
mal so als kleiner Vorschlag/Tipp

- TZelle wird von TLabyrinth verwaltet
- von außen gibt es auf die Eigenschaften nur Lesezugriffe und Funktionen zum erstellen
- die ganze Speicher/Objektverwaltung landet in der UModel und von außern wird nur gesteuert/gelesen
- im Constructor brauchst du die internen Objektvariablen nicht auf NIL setzen, da sie standardmäßig schon so initialisiert sind (drum hab ich die Konstruktoren weggelassen)
- im Destructor gibt TLabyrinth seine von ihm erstellten TZelle(n) frei
- innerhalb der eigenen Klasse greift man nicht über die globale Variable (CtlView) auf sich selber zu (man ist ja schon in sich selber drinnen)

Zitat:
bekomme ich denn damit auch einen Gang hin??
nja ... nee
es geht da mehr um die Speicherlecks (nicht freigegebene Objekte)

und was den Strich angeht:

nja, schau dir mal Canvas.Pen.Style:=psClear an (oder Ähnliches)
(ich hoff ich hab es jetzt richtig verstanden, was du meintest)
oder Canvas.Pen.Color und Canvas.Brush.Color auf die gleiche Farbe setzen

Delphi-Quellcode:
unit UModel; // Die Unit, die das MODEL des Labyrinth-Projektes implementiert,
               // enthält nur das Labyrinth selbst, keine Darstellung (-> VIEW)
interface

const sMax=50; zMax=50;
      Nord=0; Ost=1; Sued=2; West=3;
type SpBereich=0..sMax; ZlBereich=0..zMax;
     RtgBereich=Nord..West;
     TLabyrinth=class;
     TZelle=class(TObject)
              private
                fOwner: TLabyrinth;
                fRtg: array[RtgBereich] of TZelle;
                function gibtRtg(Bereich: RtgBereich): TZelle;
              public
                property Owner: TLabyrinth read fOwner;
                property Rtg[Bereich: RtgBereich]: TZelle read gibtRtg;
            end;
     TLabyrinth=class(TObject)
                  private
                    fZellen: array[SpBereich, ZlBereich] of TZelle;
                    function gibtZelle(x: SpBereich; y: ZlBereich): TZelle;
                  public
                    //constructor Create;
                    destructor Destroy; override;
                    function erstelleZelle(x: SpBereich; y: ZlBereich): TZelle;
                    property Zelle[x: SpBereich; y: ZlBereich]: TZelle;
                end;

implementation

function TZelle.gibtRtg(Bereich: RtgBereich): TZelle;
begin
  result:=nil;
  if Bereich in [Nord..West] then result:=fRtg[Bereich];
end;

function TLabyrinth.gibtZelle(x: SpBereich; y: ZlBereich): TZelle;
begin
  result:=nil;
  if (x in [0..sMax]) and (y in [0..zMax]) then
     result:=fZelle[x,y];
end;

destructor TLabyrinth.Destroy;
var x: SpBereich; y: ZlBereich;
begin
  // da das Labyrinth die Zellen verwaltet und sie ihm quasi gehören,
  // gibt es diese auch wieder frei, wenn es selber freigegeben wird
  for x := 0 to sMax do
    for y := 0 to zMax do
      fZelle.Free;
end;

function TLabyrinth.erstelleZelle(x: SpBereich; y: ZlBereich): TZelle;
begin
  // da die Zellen in dem Labyrinth verwaltet werden, macht es sich gut, wenn sie dort auch erstellt werden
  result:=nil;
  if (x in [0..sMax]) and (y in [0..zMax]) and not Assigned(fZelle[x,y]) then begin
    result:=TZelle.Create;
    result.Owner:=self;
    if x > 0 then result.fRtg[Ost]:=fZelle[x-1,y];
    if x < sMax then result.fRtg[West]:=fZelle[x+1,y];
    if y > 0 then result.fRtg[Nord]:=fZelle[x,y-1];
    if y > zMax then result.fRtg[Sued]:=fZelle[x,y+1];
  end;
end;

end.
Delphi-Quellcode:
unit UCtlView; // eine VIEW des Labyrinths aus der Vogelperspektive, dient
                // auch als CONTROLER, z.B. zum Erstellen des Labyrinths
interface // per Mausklick...

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, UModel;
const ZW=10; XYOFF=20;
type
  TCtlView = class(TForm)
    ZeigenBtn: TButton;
    procedure ZeigenBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private { Private-Deklarationen }
    lab: TLabyrinth;
    function Zl(y: integer): integer; //ZeilenNummer zur Bildschirmposition
    function Sp(x: integer): integer; //SpaltenNr. zur Bildschirmposition
    function xWert(s: SpBereich): integer; // Bildschirmpos. der Spalte
    function yWert(z: ZlBereich): integer; // Bildschirmpos. der Zeile
    procedure ZeichneLab;
  public { Public-Deklarationen }
  end;

var CtlView: TCtlView;

implementation

{$R *.dfm}

function TCtlView.Zl(y: integer): integer;
  begin Zl:= (y-XYOFF) div ZW end;
function TCtlView.Sp(x: integer): integer;
  begin Sp:= (x-XYOFF) div ZW end;
function TCtlView.xWert(s: SpBereich): integer;
  begin xWert:= s*ZW+XYOFF end;
function TCtlView.yWert(z: ZlBereich): integer;
  begin yWert:= z*ZW+XYOFF end;

procedure TCtlView.ZeichneLab;
var z: ZlBereich; s: SpBereich;
begin
  for z:=0 to zMax do for s:=0 to sMax do
  begin
    if assigned(lab.zelle[s,z]) then Canvas.Brush.Color:=clBtnFace
                                else Canvas.Brush.Color:=clGray;
    Canvas.Pen.Color:=Canvas.Brush.Color;
    Canvas.Rectangle(xWert(s),yWert(z),xWert(s)+ZW,yWert(z)+ZW);
  end;
end;

procedure TCtlView.ZeigenBtnClick(Sender: TObject);
begin
  ZeichneLab;
end;

procedure TCtlView.FormCreate(Sender: TObject);
begin
  lab:= TLabyrinth.neuesLabyrinth;
end;

procedure TCtlView.FormDestroy(Sender: TObject);
begin
  // erstelltes Labyrinth wieder löschen/freigeben
  // das Labyrinth gibt intern die Zellen frei
  lab.Free;
end;

procedure TCtlView.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (Sp(X)<=SMAX) and (Sp(X)>=0) and (Zl(Y)<=ZMAX) and (Zl(Y)>=0)
    and not assigned(lab.Zelle[Sp(X),Zl(Y)]) then
  begin
    lab.erstelleZelle(Sp(X),Zl(Y));
  end;
  ZeichneLab;
end;

end.
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests
  Mit Zitat antworten Zitat