Sortierprozedur zum Sortieren von Typisierten Arrays

Belgerfant · Hält's aus hier Beiträge: 11

Hallo liebe Gemeinde^^,
Ich habe nun Google und die Sufu solange gequält bis ich mich dazu entschlossen habe doch mal zu fragen.
Ich habe folgendes Problem wir sollen nun zum Abschluss eine Projektarbeit in Delphi machen, ich bilde mir ein das ich die Grundlagen in Delphi sicher beherrsche, und weiß nun nicht weiter. Ich habe eine Datenbank zur Speicherung von Rechnungen programmiert und bin nun bei dem Sortieren angelangt. Ich verwende als Datentyp einen Record und habe mir gedacht ich werde die Daten in ein Array laden welches ich dann mittels Shellsort sortieren lassen will und dann abspeichern. Soweit so gut Shellsort und sowas kein Ding,nun habe ich mir aber gedacht es ist einfach umständlich für jeden Typ im Record also fürs Datum, für den Rechnungsteller immer wieder die gleiche Prozedur nur mit anderen Kriterien zu schreiben und habe überlegt ob es nicht möglich ist über eine allgemeine Prozedur das Array sortieren zu lassen und die Kriterien über eine Case of Sache zu definieren und genau da hänge ich hat jmd eine idee wie dieses umzusetzen ist? Ich poste einfach mal mein Shellsort wäre für Anregungen dankbar.

P.S. bin bei meiner Suche auf Pointer gestoßen weiß aber nicht viel mit Anzufangen und habe nix verständliches dazu gefunden also wenn es nur über Pointer geht könnte mir jemand ein Beispiel auf meine Bedürfnisse zugeschnitten Posten mit erklärungen?

Hier mein Shellsort

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:

procedure Shellsort;
var Done : Boolean;
    Merke: Twerte;
begin
zaehle;
Abstand:=i;
While (Abstand > 1 ) do
 begin
  Abstand:= Abstand div 2;
  repeat
    Done:=true;
    for j:= 1 to i - Abstand do
    begin
      b:=j+ Abstand;
      if (sort1 > sort2) then
      begin
        Merke:= Wertearray[j];
        Wertearray[j]:= Wertearray[b];
        Wertearray[b]:=Merke;
        Done:=false;
      end;
    end;
  until done;
 end;
end;

und hier noch die Global deklarieten Variablen

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:

procedure zaehle;
procedure lesen;
procedure tabloschen;
procedure Shellsort;
var
  Form1: TForm1;
  i,a,b, j, Abstand: integer;
  filename: string;
  Dateida: Boolean;
  Rechnungsbuch: file of Twerte;
  Wertearray: array of Twerte;
  Suchearray: array of Twerte;
  sort1, sort2 : String;

Moderiert von Narses: Code- durch Delphi-Tags ersetzt

Gausi · Verfasst: Di 11.03.08 14:52

Hallo und

in der Entwickler-Ecke!

Zuerstmal ne Kleinigkeit zu deinem Variablen-Konzept. Globale Variable i oder j, die nur irgendwo in einer Schleife verwendet werden, sind äußerst ungünstig. Sowas braucht man nur lokal, also deklariert man das auch lokal.

Du willst also ein Array of TWerte nach unterschiedlichen Kriterien sortiern? Das könnte man so machen. Zunächst definiert man einen Vergleichsfunktion-Typ und verschiedene Vergleichsfunktionen, die ermitteln, ob ein Wert größer, kleiner oder gleich einem anderen bzgl. eines bestimmten Attributs ist.

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:

// Eine Vergleichsfunktion
type TWertCompare = function(a,b: TWert):Integer;

// z.B.
function CompareName(a,b: TWert):Integer;
begin
  if a.Name = b.Name then result := 0
  else
    if a.Name < b.Name then result := -1
      else result := 1;
end;

Dann erweitert man die Sortierfunktion Shellsort um einen Parameter

markieren

Delphi-Quelltext

1:	procedure Shellsort(aCompare: TWertCompare);

und ersetzt die vergleiche mit "<" oder ">" durch

markieren

Delphi-Quelltext

1:	if aCompare(Wert1,Wert2) = -1 then...

Ein Aufruf des Sortierverfahrens sähe dann z.B. so aus:

markieren

Delphi-Quelltext

1:	Shellsort(CompareName);

Durch Ändern der Vergleichsfunktion kann man dann beliebige Sortierungen mit demselben Code durchführen.

_________________
We are, we were and will not be.

Belgerfant · Hält's aus hier Beiträge: 11

Hey danke für die schnelle Antwort. Werde es gleich ausprobieren und meine Ergebnisse mitteilen.^^ Zu den Variablen ich verwende i noch andersweitig bei anderen Prozeduren^^ deswegen die Global i ist nämlich immer die Filesize von der Datei und wird durch zaehlen bestimmt i ist nur einfach weniger zu tippen^^

Gausi · Verfasst: Di 11.03.08 17:59

Belgerfant hat folgendes geschrieben:

Hey danke für die schnelle Antwort. Werde es gleich ausprobieren und meine Ergebnisse mitteilen.^^ Zu den Variablen ich verwende i noch andersweitig bei anderen Prozeduren^^ deswegen die Global i ist nämlich immer die Filesize von der Datei und wird durch zaehlen bestimmt i ist nur einfach weniger zu tippen^^

Das ist jetzt wirklich nicht böse gemeint, aber wenn du deine Programme so schreibst, wie diesen Beitrag, und außerdem exzessiv globale Variablen wie i und j benutzt, dann wünsche ich dir viel Spaß bei der Fehlersuche in etwas größeren Programmen ;-)

.

_________________
We are, we were and will not be.

Belgerfant · Hält's aus hier Beiträge: 11

Programm ist ja schon etwas größer und hast recht mit der Fehlersuche ists wirklich nicht einfach aber es ist mir zuviel Arbeit das umzustellen da nicht alles in einer Unit ist wobei ich mich schon bemüht habe alle Prozeduren in unit1 zu packen. Also ich bin dir dankbar für deine Tips;) werds beim nächsten Mal auch anders machen schätz ich^^

Belgerfant · Hält's aus hier Beiträge: 11

So ich habe jetzt mal versucht das einzurichten. Und muss gestehen ich hab noch zwei Fragen glaube ich^^.

Also erstens

markieren

Delphi-Quelltext

1:	procedure Shellsort(aCompare: TWertCompare);

das aCompare was bewirkt das und wo kommt das her das ist doch ne Objekt bezeichnung oder?

Und 2tens beim einbinden in die Prozedur

markieren

Delphi-Quelltext

1:	if aCompare(Wert1,Wert2) = -1 then

Wert1 und Wert2 sind wie deklariert sind das die Arrays? Weil eigentlich muss er ja die Arraywerte miteinander vergleichen.

Moderiert von Christian S.: Code- durch Delphi-Tags ersetzt

Gausi · Verfasst: Di 11.03.08 19:44

Wert1 und Wert2 sind zwei Elemente aus dem Array, die miteinander verglichen werden sollen. Das aCompare ist eine Variable vom Typ TwertCompare, der als Funktion definiert ist. Eine Funktion dieses Typs vergleicht zwei TWerte und gibt als Ergebnis zurück, ob a kleiner, gleich oder größer als b ist. Was "kleiner" genau bedeutet, wird in dieser Funktion definiert.

_________________
We are, we were and will not be.

Belgerfant · Hält's aus hier Beiträge: 11

aber das heißt doch das ich für Wert eins und zwei wieder sowas in der richtung wie Wertearray[i].Datum und für wert2 sowas wie Wertearray[b].Datum schreiben muss dann kann ich mir doch den rest schenken oder wie meinst du das?

icho2099 · Verfasst: Di 11.03.08 19:58

Vielleicht hilft der Hinweis, dass man Funktionen als Typ deklarieren und als
Parameter übergeben kann.
In diesem Fall deklariert man den Funktionstyp und für jeden Vergleich dazu
eine konkrete Funktion des selben Typs (gleiche Parameter, gleicher Ergebnistyp).

An die Sortierfunktion übergibt man dann die Vergleichsfunktion. Dadurch arbeitet
die Sortierfunktion mit variablen Vergleichen.

Belgerfant · Hält's aus hier Beiträge: 11

Hm ich glaube ich hab das noch nicht so Verstanden hier mal mein Code aber ergibt für mich keinen Sinn denk ich also bestimmt falsch

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:

procedure zaehle;
procedure lesen;
procedure tabloschen;
procedure Shellsort;
type TwerteCompare= function(m,n: Twerte): Integer;
var

  Form1: TForm1;
  i,a,b, j, Abstand: integer;
  filename: string;
  Dateida: Boolean;
  Rechnungsbuch: file of Twerte;
  Wertearray: array of Twerte;
  Suchearray: array of Twerte;
  sort1, sort2 : String;

implementation

uses Unit2, Unit3, Unit4, Unit5, Unit6;

{$R *.dfm}
function CompareDatum(Werte1, Werte2 :Twerte): Integer;
begin
 if Werte1.Datum = Werte2.Datum then result :=0
 else
  if Werte1.Datum < Werte2.Datum then result:=-1
    else result:= 1
end;

procedure Shellsort(aCompare: TwerteCompare);
var Done : Boolean;
    Merke: Twerte;
begin
zaehle;
Abstand:=i;
While (Abstand > 1 ) do
 begin
  Abstand:= Abstand div 2;
  repeat
    Done:=true;
    for j:= 1 to i - Abstand do
    begin
      b:=j+ Abstand;
      if aCompare(Werte1,Werte2)= -1 then
      begin
        Merke:= Wertearray[j];
        Wertearray[j]:= Wertearray[b];
        Wertearray[b]:=Merke;
        Done:=false;
      end;
    end;
  until done;
 end;
end;

Moderiert von Tino: Code- durch Delphi-Tags ersetzt

icho2099 · Verfasst: Di 11.03.08 20:29

nö, genau so war das gedacht.

Mit weiteren Vergleichsfunktionen z.B CompareName():Integer, CompareXY():Integer

kannst du dein Shellsort dann doch nach Belieben sortieren lassen

Shellsort(CompareDatum) oder ShellSort(CompareName) oder ShellSort(CompareXY)

und das war's dann auch schon.

Belgerfant · Hält's aus hier Beiträge: 11

naja aber dann brauch ich doch das ganze mit der Vergeleichs Funktion nicht weil ich wollte es ja so haben das ich nur einen Universal Schellsort brauche und sich in der Vergleichsanweisung die Argumente Variabel gestalten lassen weil so kann ich doch auch einfach meinetwegen 5 Shells schreiben die nur ne andere Vergleichs anweisung haben bsp fürs Datum:

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:

procedure zaehle;
procedure lesen;
procedure tabloschen;
procedure Shellsort;
var
  Form1: TForm1;
  i,a,b, j, Abstand: integer;
  filename: string;
  Dateida: Boolean;
  Rechnungsbuch: file of Twerte;
  Wertearray: array of Twerte;
  Suchearray: array of Twerte;


implementation

uses Unit2, Unit3, Unit4, Unit5, Unit6;

{$R *.dfm}


procedure Shellsort;
var Done : Boolean;
    Merke: Twerte;
begin
zaehle;
Abstand:=i;
While (Abstand > 1 ) do
 begin
  Abstand:= Abstand div 2;
  repeat
    Done:=true;
    for j:= 1 to i - Abstand do
    begin
      b:=j+ Abstand;
      if Wertearray[i].Datum<Wertearray[b].datum then
      begin
        Merke:= Wertearray[j];
        Wertearray[j]:= Wertearray[b];
        Wertearray[b]:=Merke;
        Done:=false;
      end;
    end;
  until done;
 end;
end;

Moderiert von Tino: Code- durch Delphi-Tags ersetzt

Belgerfant · Hält's aus hier Beiträge: 11

ach nee das eben waren die aufrufe klar die hab ich total vernachlässigt man manchmal ist man auch wie vernagelt srry hat sich erledigt klar^^

Belgerfant · Hält's aus hier Beiträge: 11

ok eine frage noch ist es dabei nun egal wieviele werte das DynArray hat weil so wie ichs 3 beiträger vorher geschrieben hatte werden doch nur 2 werte verglichen und das sind doch immer die ersten oder muss da noch nen Index an Werte1 oder werte2 ran?

Th69 · Verfasst: Mi 12.03.08 10:49

Du mußt natürlich die richtigen Variablen übergeben:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:

if aCompare(Wertearray[j], Wertearray[b]) < 0 then // statt Werte1, Werte2
      begin  
        Merke:= Wertearray[j];  
        Wertearray[j]:= Wertearray[b];  
        Wertearray[b]:=Merke;  
        Done:=false;  
      end;

Ich habe die Abfrage auch noch auf '< 0' statt '= -1' geändert, da dies universeller ist...

Evtl. mußt du 'j' und 'b' noch tauschen (je nachdem wie du deine Vergleichasfunktionen implementierst).

Belgerfant · Hält's aus hier Beiträge: 11

Ja so wies da steht gehts aber nicht man kann keine Indexwerte übergeben zumindest meckert er bie mir immer hab es jetzt so gelößst das ich die Array stellen vorher an eine Feste Variable ausgebe und dann es übergeben lasse. et voila alles spitze^^ Danke für eure schnelle und gute hilfe

Belgerfant · Hält's aus hier Beiträge: 11

so an sich startet das Programm ohne das der Debugger meckert. Aber wenn ich nun die Sortieren Prozedur aufrufe dann schmeißt er erstmal den Wert der an 2ter Stelle stehen müsste raus und ersetzt diesen durch irgend ein Nonsen. Wenn ich dann die Datei ein Zweites mal öffne dann sortiert er ohne Probleme aber wenn ich dann das Programm zurücksetzte dann kommen nen Haufen Exceptionerror Meldungen. Ich weiß echt nicht woran es liegt habe mir Struktogramme zur dem Sortieralgorythmus angefertigt es auch soweit Verstanden aber wo ist der Fehler hier mal meine Codes:

Einmal wo sich alle Prozeduren befinden

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:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, Menus, ExtCtrls, Buttons, ToolWin, ComCtrls;
Const tem = 'tempfile.tempo';
type
  TWerte = record
     Datensatznummer: integer;
     Datum: TDateTime;
     Rechnungssteller: string[20];
     Verwendungszweck: string[25];
     Betrag: Real;
     end;
type TwerteCompare= function(Wert1,Wert2: Twerte): Integer;
    TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    MainMenu1: TMainMenu;
    Datei1: TMenuItem;
    Beenden1: TMenuItem;
    N1: TMenuItem;
    ffnen1: TMenuItem;
    Neu1: TMenuItem;
    Bearbeiten1: TMenuItem;
    Gehezu1: TMenuItem;
    Ersetzen1: TMenuItem;
    Suchen1: TMenuItem;
    N3: TMenuItem;
    Hilfe1: TMenuItem;
    Info1: TMenuItem;
    Inhalt1: TMenuItem;
    ToolBar1: TToolBar;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    Splitter1: TSplitter;
    SpeedButton3: TSpeedButton;
    Splitter3: TSplitter;
    SpeedButton4: TSpeedButton;
    SpeedButton5: TSpeedButton;
    NachDatum1: TMenuItem;
    nachRechnungssteller1: TMenuItem;
    nachVerwendungszweck1: TMenuItem;
    Hinzufgen1: TMenuItem;
    Lschen1: TMenuItem;
    Sortieren1: TMenuItem;
    nachdatum2: TMenuItem;
    nachDatensatznummer1: TMenuItem;
    Label1: TLabel;
    SpeedButton8: TSpeedButton;
    SpeedButton10: TSpeedButton;
    SpeedButton12: TSpeedButton;
    SpeedButton13: TSpeedButton;
    Splitter2: TSplitter;
    Splitter4: TSplitter;
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure Neu1Click(Sender: TObject);
    procedure Hinzufgen1Click(Sender: TObject);
    procedure Beenden1Click(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure ffnen1Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure Lschen1Click(Sender: TObject);
    procedure SpeedButton13Click(Sender: TObject);
    procedure SpeedButton10Click(Sender: TObject);
    procedure SpeedButton8Click(Sender: TObject);
    procedure SpeedButton12Click(Sender: TObject);
    procedure Ersetzen1Click(Sender: TObject);
    procedure NachDatum1Click(Sender: TObject);
    procedure nachRechnungssteller1Click(Sender: TObject);
    procedure nachVerwendungszweck1Click(Sender: TObject);
    procedure nachdatum2Click(Sender: TObject);
    procedure nachDatensatznummer1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }

  end;
procedure zaehle;
procedure lesen;
procedure tabloschen;
procedure Shellsort(aCompare: TwerteCompare);
function CompareDatum(Wert1, Wert2 :Twerte): Integer;
var
  Form1: TForm1;
  i,a: integer;
  filename: string;
  Dateida: Boolean;
  Rechnungsbuch: file of Twerte;
  Wertearray: array of Twerte;
  Suchearray: array of Twerte;
  Wert1, Wert2: Twerte;
implementation

uses Unit2, Unit3, Unit4, Unit5, Unit6;

{$R *.dfm}
procedure zaehle;
begin
AssignFile(Rechnungsbuch, Filename);
Reset(Rechnungsbuch);
i:=Filesize(Rechnungsbuch);
CloseFile(Rechnungsbuch);
end;

function CompareDatum(Wert1 , Wert2 :Twerte): Integer;
begin
 if Wert1.Datum = Wert2.Datum then result :=0
 else
  if Wert1.Datum > Wert2.Datum then result:=-1
    else result:= 1
end;

procedure Shellsort(aCompare: TwerteCompare);
var b, j, Abstand: integer;
    Done : Boolean;
    Merke: Twerte;
begin
zaehle;
Abstand:=i;
While (Abstand > 1 ) do
 begin
  Abstand:= Abstand div 2;
  repeat
  Done:=true;
  for j:= 1 to i - Abstand do
  begin
  b:=j+ Abstand;
  Wert1:=Wertearray[j];
  Wert2:=Wertearray[b];
  if acompare(Wert1 ,Wert2)=-1 then
  begin
  Merke:= Wertearray[j];
  Wertearray[j]:= Wertearray[b];
  Wertearray[b]:=Merke;
  Done:=false;
  end;
  end;
until done=true;
end;
end;

procedure lesen;
var Werte: Twerte;
begin
AssignFile(Rechnungsbuch, Filename);
Reset(Rechnungsbuch);
If Filesize(Rechnungsbuch)>0 then
  begin
    form1.Stringgrid1.rowcount:=Filesize(rechnungsbuch)+1;
    repeat
      Read(Rechnungsbuch, Werte);
      i:=Werte.Datensatznummer;
      With Form1.Stringgrid1 do
        begin
          cells[0,i]:=IntToStr(Werte.Datensatznummer);
          Cells[1,i]:=DatetoStr(Werte.Datum);
          Cells[2,i]:=Werte.Rechnungssteller;
          Cells[3,i]:=Werte.Verwendungszweck;
          Cells[4,i]:=FloatToStr(Werte.Betrag);
        end;
    until EOF(Rechnungsbuch);
  end
else
  tabloschen;
closefile(Rechnungsbuch);
end;

procedure tabloschen;
var a: integer;
begin
zaehle;
If IntToStr(i)>''then
  begin
    a:=1;
    With form1.StringGrid1 do
      repeat
        Cells[0,a]:='';
        Cells[1,a]:='';
        Cells[2,a]:='';
        Cells[3,a]:='';
        Cells[4,a]:='';
        Inc(a);
      until a>i+1;
  end;
end;

procedure erstelle;
begin
  AssignFile(Rechnungsbuch, Filename);
  Rewrite(Rechnungsbuch);
  closefile(Rechnungsbuch);
  form1.Label1.Caption:='Datei: ' + Filename;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
close;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
with Stringgrid1 do
  begin
    Cells[0,0]:='DsNr.';
    Cells[1,0]:='Datum';
    Cells[2,0]:='Rechnungssteller';
    Cells[3,0]:='Verwendungszweck';
    Cells[4,0]:='Rechnungsbetrag';
    rowcount:=2;
  end;
end;


procedure TForm1.N3Click(Sender: TObject);
begin
Showmessage('Diese Programm wurde von Tobias Belger Geschrieben. Viel Spaß damit ;)!');
end;

procedure TForm1.Neu1Click(Sender: TObject);
begin
 repeat
  Dateida:= false;
  Filename:='';
  if SaveDialog1.Execute then
    begin
      FileName:= SaveDialog1.FileName;
        if FileExists(FileName) then
          If (messagedlg(' Datei existiert bereits, wollen sie sie ersetzten?',mtWarning,[mbYes,mbNo],0) = mrNo)then
            Dateida:=true
          else
            Dateida:= false;
    end
  else
    begin
      exit;
    end;
 until Dateida = false;
If (Filename>'') and (Dateida=False) then
  begin
    erstelle;
    Hinzufgen1.Click;
  end;
end;

procedure TForm1.Hinzufgen1Click(Sender: TObject);
begin
If Filename ='' then
    If (MessageDlg('Es wurde keine Datei geladen, soll eine neue erstellt werden?' ,mtConfirmation,[mbYes,mbNo],0) = mrYes) then
    neu1.Click
    else exit
else
Form2.Show;
end;

procedure TForm1.Beenden1Click(Sender: TObject);
begin
close;
end;

procedure TForm1.SpeedButton5Click(Sender: TObject);
begin
Beenden1.Click;
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
hinzufgen1.click;
end;

procedure TForm1.ffnen1Click(Sender: TObject);
var    Werte: Twerte;
begin
if OpenDialog1.Execute then
  FileName := OpenDialog1.FileName
else exit;
form1.Label1.Caption:='Datei: ' + Filename;
lesen;
end;

procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
ffnen1.Click;
end;


procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
neu1.Click;
end;

procedure TForm1.SpeedButton4Click(Sender: TObject);
begin
lschen1.Click;
end;

procedure TForm1.Lschen1Click(Sender: TObject);
begin
form3.showmodal;
end;

procedure TForm1.SpeedButton13Click(Sender: TObject);
begin
ersetzen1.Click;
end;

procedure TForm1.SpeedButton10Click(Sender: TObject);
begin
nachdatum1.Click;
end;

procedure TForm1.SpeedButton8Click(Sender: TObject);
begin
nachdatum2.Click;
end;


procedure TForm1.SpeedButton12Click(Sender: TObject);
begin
nachdatensatznummer1.click;
end;

procedure TForm1.Ersetzen1Click(Sender: TObject);
begin
form4.show;
end;

procedure TForm1.NachDatum1Click(Sender: TObject);
begin
a:=1;
Form5.Show;
end;

procedure TForm1.nachRechnungssteller1Click(Sender: TObject);
begin
a:=2;
Form5.show;
end;

procedure TForm1.nachVerwendungszweck1Click(Sender: TObject);
begin
a:=3;
Form5.Show;
end;


procedure TForm1.nachdatum2Click(Sender: TObject);
begin
Form6.Show;
end;

procedure TForm1.nachDatensatznummer1Click(Sender: TObject);
begin
Form6.Show;
end;

end.

und hier nochmal das Form welches alles aufruft

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:

 
unit Unit6;

interface

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

type
  TForm6 = class(TForm)
    RadioGroup1: TRadioGroup;
    Button1: TButton;
    Button2: TButton;
    ListBox1: TListBox;
    procedure Button2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form6: TForm6;

implementation

uses Unit1;

{$R *.dfm}

procedure TForm6.Button2Click(Sender: TObject);
begin
close;
end;

procedure TForm6.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Form1.Show;
end;

procedure TForm6.Button1Click(Sender: TObject);
var k: integer;
begin
Shellsort(comparedatum);
zaehle;
For k:=1 to i-1 do
With Form1.Stringgrid1 do
begin
 cells[0,k]:=Inttostr(Wertearray[k].Datensatznummer);
 Cells[1,k]:=Datetostr(Wertearray[k].Datum);
 Cells[2,k]:=Wertearray[k].Rechnungssteller;
 cells[3,k]:=Wertearray[k].Verwendungszweck;
 cells[4,k]:=Floattostr(Wertearray[k].Betrag);

 end;
end;


procedure TForm6.FormActivate(Sender: TObject);
var Werte: Twerte;
begin
If Filename>'' then
  begin
    AssignFile(Rechnungsbuch, Filename);
    Reset(Rechnungsbuch);
    i:=1;
    Setlength(Wertearray, Filesize(Rechnungsbuch));
    repeat
      Read(Rechnungsbuch, Werte);
      Wertearray[i]:=werte;
      Inc(i);
    until Eof(Rechnungsbuch);
    closeFile(Rechnungsbuch);
  end
else
  begin
    Showmessage('Sie haben keine Datei Ausgewählt!');
    Button1.Enabled:=false;
  end;
end;

end.

Moderiert von Gausi: Code- durch Delphi-Tags ersetzt

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme