Türme sortieren

Daphil · Hält's aus hier Beiträge: 8

Hallo,

ich programmiere gerade ein Programm, welches 6 unterschiedlich große Türme zeichnet und diese dann nach der Größe sortiert, nun habe ich aber einen Fehler und weiß nicht wie ich ihn beheben kann, hier ist der code:

markieren

Delphi-Quelltext

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:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure zeichnen;

  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  zahl:array[1..6] of integer;

implementation

{$R *.DFM}

procedure TForm1.zeichnen;
var n,m,k:integer;
begin
n:=1;
m:=1;
while n<7 do
  begin
    with paintbox1.canvas do
      begin
        case zahl[n] of
          1:brush.color:=rgb(0,0,0);
          2:brush.color:=rgb(25,25,112);
          3:brush.color:=rgb(0,100,0);
          4:brush.color:=rgb(255,255,0);
          5:brush.color:=rgb(255,0,0);
          6:brush.color:=rgb(255,255,255);
        while m<=zahl[n] do
          begin
            if m=1 then rectangle(0+40*(m-1),240-40*(m-1),40+40*(m-1),280-40*(m-1))
                   else rectangle(10+40*(m-1),230-40*(m-1),50+40*(m-1),270-40*(m-1));
            m:=m+1;
          end; //Zeile 53
      end;
    n:=n+1;
  end;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var n,m,k,a:integer;
begin
edit1.clear;
randomize;
zahl[1]:=random(6)+1;
n:=2;
while n<7 do
  begin
    a:=random(6)+1;
    k:=0;
    m:=1;
    repeat
      begin
        if zahl[m]<>a then m:=m+1
                      else k:=1;
      end;
    until (m=n) or (k=1);
    if k<>1 then
              begin
                zahl[n]:=a;
                n:=n+1;
              end;

  end;
n:=1;
while n<7 do
  begin
    edit1.text:=edit1.text+inttostr(zahl[n])+'; ';
    n:=n+1
  end;
zeichnen;
end;
end.

Wenn ich das Programm starte dann bekomme ich folgenden Fehler:

[Fehler] Unit1.pas(53): Konstantenausdruck erwartet

hoffe ihr könnt mir irgendwie helfen

Gruß
Daphil

Ironwulf · Beiträge: 733 Erhaltene Danke: 2

ein case block mussu immer noch mit nem end; beenden
sonst hab ihc nix weiter gefunden

EDIT: ich seh grad das du das end; nur an der falschen stelle hast

markieren

Delphi-Quelltext

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:

procedure TForm1.Button1Click(Sender: TObject);
var n,m,k:integer;
    zahl: array[0..3] of Integer;
begin  
n:=1;
m:=1;  
while n<7 do  
  begin
    with canvas do
      begin
        case zahl[n] of
          1:brush.color:=rgb(0,0,0);
          2:brush.color:=rgb(25,25,112);
          3:brush.color:=rgb(0,100,0);
          4:brush.color:=rgb(255,255,0);
          5:brush.color:=rgb(255,0,0);
          6:brush.color:=rgb(255,255,255);
        end;
        while m<=zahl[n] do
          begin
            if m=1 then rectangle(0+40*(m-1),240-40*(m-1),40+40*(m-1),280-40*(m-1))
                   else rectangle(10+40*(m-1),230-40*(m-1),50+40*(m-1),270-40*(m-1));
            m:=m+1;
          end; //Zeile 53
      end;
    n:=n+1;
  end;
end;

so sollts dann ausschaun

Daphil · Hält's aus hier Beiträge: 8

Super danke dir

Daphil · Hält's aus hier Beiträge: 8

Hm, also das funktioniert schon mal

ich habe das Programm jetz soweit, dass es die türme theoretisch zeichnet, allerdings wird immer nur der erste Turm gezeichnet, ich befürchte ich habe einen Logikfehler, den sehe ich selber nur nich, hier ist der Code:

markieren

Delphi-Quelltext

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:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure zeichnen;

  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  zahl:array[1..6] of integer;

implementation

{$R *.DFM}

procedure TForm1.zeichnen;
var n,m,k:integer;
begin
n:=1;
m:=1;
k:=1;

paintbox1.canvas.brush.color:=rgb(212,207,201);
paintbox1.canvas.pen.color:=rgb(212,207,201);
paintbox1.canvas.rectangle(0,0,280,260);
while n<7 do
  begin
    with paintbox1.canvas do
      begin
        case zahl[n] of
            1:brush.color:=rgb(0,0,0);
            2:brush.color:=rgb(25,25,112);
            3:brush.color:=rgb(0,100,0);
            4:brush.color:=rgb(255,255,0);
            5:brush.color:=rgb(255,0,0);
            6:brush.color:=rgb(255,255,255);
          end;
        while k<7 do
          begin
            while m<=zahl[n] do
              begin
                if k=1 then rectangle(40*(k-1),220-40*(m-1),40+40*(k-1),260-40*(m-1))
                       else rectangle(10+40*(k-1),215-40*(m-1),50+40*(k-1),255-40*(m-1));
                m:=m+1;
              end;
            k:=k+1;
          end;
      end;
    n:=n+1;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var n,m,k,a:integer;
begin
edit1.clear;
randomize;
zahl[1]:=random(6)+1;
n:=2;
while n<7 do
  begin
    a:=random(6)+1;
    k:=0;
    m:=1;
    repeat
      begin
        if zahl[m]<>a then m:=m+1
                      else k:=1;
      end;
    until (m=n) or (k=1);
    if k<>1 then
              begin
                zahl[n]:=a;
                n:=n+1;
              end;

  end;
n:=1;
while n<7 do
  begin
    edit1.text:=edit1.text+inttostr(zahl[n])+'; ';
    n:=n+1
  end;
zeichnen;
end;
end.

Ich hänge ein Beispielbild an, die Editfelder braucht ihr nicht beachten, die sind nur für mich zur Kontrolle

Gruß
Daphil

Einloggen, um Attachments anzusehen!

Daphil · Hält's aus hier Beiträge: 8

ich habe es jetzt alleine hinbekommen

Renegade · Beiträge: 358 Win XP Pro, Win 7 Beta BDS 2006

Daphil hat folgendes geschrieben:

ich habe es jetzt alleine hinbekommen

Und warum markierst du den Thread dann nicht entsprechend?
Und warum dürfen andere an deinem Erfolg nicht teilhaben?

_________________
Sokrates (468 v.Chr. - 399 v.Chr.)
"Es ist keine Schande, nichts zu wissen, wohl aber, nichts lernen zu wollen."

Daphil · Hält's aus hier Beiträge: 8

Ok richtig markiert habe ich es

bin neu hier sry

und hier hänge ich die exe an, könnt euch das Programm ja mal anschauen

Gruß
Daphil

Einloggen, um Attachments anzusehen!

Renegade · Beiträge: 358 Win XP Pro, Win 7 Beta BDS 2006

Daphil hat folgendes geschrieben:

und hier hänge ich die exe an, könnt euch das Programm ja mal anschauen

Ich meine - es interessiert mich nicht im geringsten wie du das Problem gelöst hast - aber andere die dieses Forum nutzen können mit einer .exe soziemlich gar nichts anfangen!

Just my 2 cents

_________________
Sokrates (468 v.Chr. - 399 v.Chr.)
"Es ist keine Schande, nichts zu wissen, wohl aber, nichts lernen zu wollen."

Daphil · Hält's aus hier Beiträge: 8

ok ok, dann hänge ich hier den code an für die die es interessiert

Einloggen, um Attachments anzusehen!

Renegade · Beiträge: 358 Win XP Pro, Win 7 Beta BDS 2006

Super - so will ich das sehen

_________________
Sokrates (468 v.Chr. - 399 v.Chr.)
"Es ist keine Schande, nichts zu wissen, wohl aber, nichts lernen zu wollen."

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme