Autor |
Beitrag |
Belgerfant
Hält's aus hier
Beiträge: 11
|
Verfasst: Di 11.03.08 14:35
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
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
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
      
Beiträge: 8549
Erhaltene Danke: 478
Windows 7, Windows 10
D7 PE, Delphi XE3 Prof, Delphi 10.3 CE
|
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.
Delphi-Quelltext 1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11:
| type TWertCompare = function(a,b: TWert):Integer;
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
Delphi-Quelltext 1:
| procedure Shellsort(aCompare: TWertCompare); | und ersetzt die vergleiche mit "<" oder ">" durch
Delphi-Quelltext 1:
| if aCompare(Wert1,Wert2) = -1 then... |
Ein Aufruf des Sortierverfahrens sähe dann z.B. so aus:
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
|
Verfasst: Di 11.03.08 17:46
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
      
Beiträge: 8549
Erhaltene Danke: 478
Windows 7, Windows 10
D7 PE, Delphi XE3 Prof, Delphi 10.3 CE
|
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
|
Verfasst: Di 11.03.08 19:07
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
|
Verfasst: Di 11.03.08 19:29
So ich habe jetzt mal versucht das einzurichten. Und muss gestehen ich hab noch zwei Fragen glaube ich^^.
Also erstens
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
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
      
Beiträge: 8549
Erhaltene Danke: 478
Windows 7, Windows 10
D7 PE, Delphi XE3 Prof, Delphi 10.3 CE
|
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
|
Verfasst: Di 11.03.08 19:52
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
      
Beiträge: 101
Erhaltene Danke: 12
WIN XP, WIN 7, WIN 10
Delphi 6 Prof, Delphi 2005, FPC
|
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
|
Verfasst: Di 11.03.08 20:19
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
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
      
Beiträge: 101
Erhaltene Danke: 12
WIN XP, WIN 7, WIN 10
Delphi 6 Prof, Delphi 2005, FPC
|
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
|
Verfasst: Di 11.03.08 20:47
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:
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
|
Verfasst: Di 11.03.08 20:53
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
|
Verfasst: Di 11.03.08 21:43
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
      

Beiträge: 4799
Erhaltene Danke: 1059
Win10
C#, C++ (VS 2017/19/22)
|
Verfasst: Mi 12.03.08 10:49
Du mußt natürlich die richtigen Variablen übergeben:
Delphi-Quelltext 1: 2: 3: 4: 5: 6: 7:
| if aCompare(Wertearray[j], Wertearray[b]) < 0 then 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
|
Verfasst: Mi 12.03.08 18:59
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
|
Verfasst: Fr 14.03.08 11:09
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
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 public
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
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 public 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
|
|
|