Autor |
Beitrag |
MG94
Hält's aus hier
Beiträge: 8
|
Verfasst: Do 19.04.12 16:49
Hallo Leute,
ich bin in der 12 Klasse und bin immoment damit beschäftigt eine Facharbeit in Mathematik/Informatik zu schreiben. Meine Aufgabe ist es, die Fouriersynthese und die Fourieranalyse in Delphi zu programmieren. Ich bin schon relativ weit gekommen, aber ich habe jetzt ein Problem, für das ich einfach keine Lösung finde.
Was ich habe:
-eine Prozedur, die ein Integral ausrechnet
-eine Datenbank für die Fourierkoeffizienten
-eine Maske für die Eingabe der Funktion, die analysiert werden soll
-ein Spinedit, mit dem die Genauigkeit festgelegt werden kann. Also wie viele Koeffizienten ausgerechnet werden sollen.
Und genau da liegt das Problem. Wenn ich die Anzahl der Koeffizienten etwas erhöhe, so an die 50 Stück, wird die Fourieranalyse sehr ungenau und der Graph franst aus. Ich frage mich nun, warum das so ist.
Ein weiters Problem ist, wenn ich die Periodenlänge sehr hoch setze, wird das ganze ebenfalls sehr ungenau.
Ich weiß, das ist alles sehr mathematisch, aber ich hoffe mir kann jemand helfen, oder Lösungsansätze geben.
Vielen Dank im Voraus
Gruß MG94
PS: Da ist noch ein kleiner Fehler im Quelltext, denn immoment kann man keine Analyse durchführen. Da muss ich noch suchen, aber vielleicht findet ihr trotzdem ein Lösung.
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:
| procedure TfFourier.seAnzahlKoeffClick(Sender: TObject); var dummy : TObject; begin AnzahlKoeff := fFourier.seAnzahlKoeff.Value; fFunktionen.bImportierenClick(dummy); Kosy_neu; KoeffSchreiben; Graph_zeichnen; end;
procedure TfFourier.seAnzahlKoeffChange(Sender: TObject); var dummy : TObject; begin if (fFourier.seAnzahlKoeff.Value <> 0) then AnzahlKoeff := fFourier.seAnzahlKoeff.Value else AnzahlKoeff := 0; fFunktionen.bImportierenClick(dummy); Kosy_neu; KoeffSchreiben; Graph_zeichnen; end;
procedure TfFourier.bAnalyseClick(Sender: TObject); begin fFunktionen.Showmodal; Kosy_neu; KoeffSchreiben; Graph_zeichnen; end;
implementation
uses uFourier; {$R *.dfm}
function Eingabeueberpruefung (Key : Char) : boolean; begin result := false; if not (Key in ['0'..'9',',','-',Chr(08),Chr(127),Chr(13)]) then Exit else result := true; end;
procedure Tastendruck (var Key : Char); var dummy : TObject; begin if (Eingabeueberpruefung(Key) = false) then begin Showmessage('FEHLER!'); Key := chr(00); end; end;
procedure TfFunktionen.eX3KeyPress(Sender: TObject; var Key: Char); begin Tastendruck(Key); end;
procedure TfFunktionen.eX2KeyPress(Sender: TObject; var Key: Char); begin Tastendruck(Key); end;
procedure TfFunktionen.eX1KeyPress(Sender: TObject; var Key: Char); begin Tastendruck(Key); end;
procedure TfFunktionen.eX0KeyPress(Sender: TObject; var Key: Char); begin Tastendruck(Key); end;
function keX3 : single; begin if (fFunktionen.eX3.Text = '') then keX3 := 0 else keX3 := StrToFloat(fFunktionen.eX3.Text); end;
function keX2 : single; begin if (fFunktionen.eX2.Text = '') then keX2 := 0 else keX2 := StrToFloat(fFunktionen.eX2.Text); end;
function keX1 : single; begin if (fFunktionen.eX1.Text = '') then keX1 := 0 else keX1 := StrToFloat(fFunktionen.eX1.Text); end;
function keX0 : single; begin if (fFunktionen.eX0.Text = '') then keX0 := 0 else keX0 := StrToFloat(fFunktionen.eX0.Text); end;
function Fkt1 (x : single) : single; begin Fkt1 := keX3*x*x*x + keX2*x*x + keX1*x + keX0; end;
function FourierCos0(x,T : single; f : integer) : single; begin FourierCos0 := Fkt1(x)*cos(2*pi*f*x/T); end;
function FourierCos (x,T : single; f : integer) : single; begin FourierCos := Fkt1(x)*cos(2*pi*f*x/T); end;
function FourierSin (x,T : single; f : integer) : single; begin FourierSin := Fkt1(x)*sin(2*pi*f*x/T); end;
function IntegralKoeff (a,b,T: single; n,f,Funktion: integer) : single; var x,h : single; gerade : boolean; begin h := (b-a)/n; case Funktion of 1: Result := FourierCos0(a,T,f); 2: Result := FourierCos(a,T,f); 3: Result := FourierSin(a,T,f); end; gerade := false; x := a; repeat x := x+h; case gerade of false : begin case Funktion of 1: Result := Result+4*FourierCos0(x,T,f); 2: Result := Result+4*FourierCos(x,T,f); 3: Result := Result+4*FourierSin(x,T,f); end; gerade := true; end; true : begin case Funktion of 1: Result := Result+2*FourierCos0(x,T,f); 2: Result := Result+2*FourierCos(x,T,f); 3: Result := Result+2*FourierSin(x,T,f); end; gerade := false; end; end; until (x >= b-h); case Funktion of 1: Result := Result+FourierCos0(b,T,f); 2: Result := Result+FourierCos(b,T,f); 3: Result := Result+FourierSin(b,T,f); end; Result := (h/3)*Result; end;
procedure Funktion1; var f: integer; T : single; begin T := 10; Funktion.T := T; for f := 0 to KoeffDatenbankGroesse do begin Funktion.Koeffizienten[0,f] := 0; Funktion.Koeffizienten[1,f] := 0; end; Funktion.Koeffizienten[0,0] := (1/T)*IntegralKoeff(0,T,T,100,0,1); for f := 1 to AnzahlKoeff do Funktion.Koeffizienten[0,f] := (2/T)*IntegralKoeff(0,T,T,100,f,2); for f := 1 to AnzahlKoeff do Funktion.Koeffizienten[1,f] := (2/T)*IntegralKoeff(0,T,T,100,f,3); end;
procedure TfFunktionen.bImportierenClick(Sender: TObject); begin if (not fFunktionen.rbFunktion1.Checked) and (not fFunktionen.rbFunktion2.Checked) and (not fFunktionen.rbFunktion3.Checked) and (not fFunktionen.rbFunktion4.Checked) then ShowMessage('Sie haben keine Funktion ausgwählt!'); if fFunktionen.rbFunktion1.Checked then begin Funktion1; Funktion.FktVorschrift := 'f(x)= '+FloatToStr(keX3)+'x³+'+FloatToStr(keX2)+'x²+' +FloatToStr(keX1)+'x+'+FloatToStr(keX0); end; fFourier.lVorschrift.Caption := Funktion.FktVorschrift; fFunktionen.close; end; end. | Moderiert von Narses: Topic aus Delphi Language (Object-Pascal) / CLX verschoben am Do 19.04.2012 um 18:05
|
|
Mathematiker
Beiträge: 2622
Erhaltene Danke: 1447
Win 7, 8.1, 10
Delphi 5, 7, 10.1
|
Verfasst: Do 19.04.12 17:36
Hallo MG94,
ich würde Dir ja gern helfen, allerdings sehe ich im Moment kaum eine Chance.
Was geschieht in der unit UFourier, was macht Kosy_neu, wie sieht die Datenstruktur aus? Gerade die entscheidenden Programmteile sind leider nicht sichtbar.
Aus dem angegebenen Programmteil kann man nicht viel herauslesen.
Eine Vermutung möchte ich aber doch geben. Die Simpson-Regel zur näherungsweisen Integration ist für ganzrationale Funktionen geringen Grades gut geeignet. Für komplexere Funktionen sollte man höherwertige Quadraturverfahren (z.B. Gauß-Legendre-Formeln oder Newton-Cotes-Formeln (mindestens 5.Grades)) verwenden. Andernfalls können sich die kleinen Abweichungen bei vielen Teilintervallen zu großen Gesamtabweichungen addieren.
Der Datentyp single ist auch nicht gerade günstig, da er nur 8 signifikante Ziffern besitzt. Verwende evtl. double (16 Stellen) oder extended (20 Stellen).
Wie gesagt, sind das nur Vermutungen. Für eine genauere Analyse benötigt man mehr Informationen.
Beste Grüße
Mathematker
|
|
Tranx
Beiträge: 648
Erhaltene Danke: 85
WIN 2000, WIN XP
D5 Prof
|
Verfasst: Do 19.04.12 18:04
Gebe Mathematiker Recht. Wenn Du genaue Ergebnisse haben möchtest, dann kommst Du um Extended nicht drum rum. Ich habe zwar nicht viel Ahnung, wie das mit Fourier genau aussieht, ich weiß aber einiges über Fehlerfortpflanzung gerade bei Summen und Differenzen. Wenn Du da mit ungenauen Werten arbeitest, kann das Ergebnis schnell stark abweichen.
_________________ Toleranz ist eine Grundvoraussetzung für das Leben.
|
|
mandras
Beiträge: 430
Erhaltene Danke: 107
Win 10
Delphi 6 Prof, Delphi 10.4 Prof
|
Verfasst: Do 19.04.12 20:25
Allgemeine Anmerkung:
Die Fourier-Transformierte einer nicht-periodischen Funktion sieht niemals schön aus, das hat nichts mit Genauigkeiten und Intervallbreiten zu tun.
Du machst eine diskrete Fourier-Analyse, das ist zwar anschaulicher aber i.a. diffiziler als eine kontinuierliche. Anders geht es aber per Rechner kaum, da dieser keine Integrale mit Abtastbreite gegen 0 wirklich "berechnen" kann
Wenn ich richtig sah hast Du da u.a. ein Polynom als zu analysierende Funktion. Da kannst Du die Genauigkeiten der Wertebereiche und Intervallbreiten beliebig erhöhen, es wird immer überall ein Spektralanteil zu finden sein.
Mach mal folgendes zum Prüfen Deines Programms:
Nimm eine periodische Funktion (z.B. Rechteck, in linker Intervallhälfte 0, in rechter 1). Herauskommnen muß ein Spektrum welches zu höheren Frequenzen hin abnimmt.. siehe de.wikipedia.org/wiki/Rechteckschwingung
Oder bastel aus zB 3 Sinussen eine periodische Schwingung und laß sie analysieren. So kannst Du sehen ob Dein Programm innerhalb der gegebenen Grenzen des Verfahrens richtig arbeitet.
|
|
MG94
Hält's aus hier
Beiträge: 8
|
Verfasst: Sa 21.04.12 14:37
Hallo,
erstmal ein großes Danke für die schnellen Reaktionen. Ich habe das mit der Rechteckschwingung ausprobiert. Mein Proramm rechnet soweit richtig. Die Parabeln sind soweit auch gut zu erkennen, aber sobald ich die Anzahl der Koeffizienten auf über 47 oder 48 erhöhe, franst der Graph aus.
Ich habe jetzt den ganzen Quelltext hinzugefügt:
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: 367: 368: 369: 370: 371: 372: 373: 374: 375: 376: 377: 378: 379: 380: 381: 382: 383: 384: 385: 386: 387: 388: 389: 390: 391: 392: 393: 394: 395: 396: 397: 398: 399: 400: 401: 402: 403: 404: 405: 406: 407: 408: 409: 410: 411: 412: 413: 414: 415: 416: 417: 418: 419: 420: 421: 422: 423: 424: 425: 426: 427: 428: 429: 430: 431: 432: 433: 434: 435: 436: 437: 438: 439: 440: 441: 442: 443: 444: 445: 446: 447: 448: 449: 450: 451: 452: 453: 454: 455: 456: 457: 458: 459: 460: 461: 462: 463: 464: 465: 466: 467: 468: 469: 470: 471: 472: 473: 474: 475: 476: 477: 478: 479: 480: 481: 482: 483: 484: 485: 486: 487: 488: 489: 490: 491: 492: 493: 494: 495: 496: 497: 498: 499: 500: 501: 502: 503: 504: 505: 506: 507: 508: 509: 510: 511: 512: 513: 514: 515: 516: 517: 518: 519: 520: 521: 522: 523: 524: 525: 526: 527: 528: 529: 530: 531: 532: 533: 534: 535: 536: 537: 538: 539: 540: 541: 542: 543: 544: 545: 546: 547: 548: 549: 550: 551: 552: 553: 554: 555: 556: 557: 558: 559: 560: 561: 562: 563: 564: 565: 566: 567: 568: 569: 570: 571: 572: 573: 574: 575: 576: 577: 578: 579: 580: 581: 582: 583: 584: 585: 586: 587: 588: 589: 590: 591: 592: 593: 594: 595: 596: 597: 598: 599: 600: 601: 602: 603: 604: 605: 606: 607: 608: 609: 610: 611: 612: 613: 614: 615: 616: 617: 618: 619: 620: 621: 622: 623: 624: 625: 626: 627: 628: 629: 630: 631: 632: 633: 634: 635: 636: 637: 638: 639: 640: 641: 642: 643: 644: 645: 646: 647: 648: 649: 650: 651: 652: 653: 654: 655: 656: 657: 658: 659: 660: 661: 662: 663: 664: 665: 666: 667: 668: 669: 670: 671: 672: 673: 674: 675: 676: 677: 678: 679: 680: 681: 682: 683: 684: 685: 686: 687: 688: 689: 690: 691: 692: 693: 694: 695: 696: 697: 698: 699: 700: 701: 702: 703: 704: 705: 706: 707: 708: 709: 710: 711: 712: 713: 714: 715: 716: 717: 718: 719: 720: 721: 722: 723: 724: 725: 726: 727: 728: 729: 730: 731: 732: 733: 734: 735: 736: 737: 738: 739: 740: 741: 742: 743: 744: 745: 746: 747: 748: 749: 750: 751: 752: 753: 754: 755: 756: 757: 758: 759: 760: 761: 762: 763: 764: 765: 766: 767: 768: 769: 770: 771: 772: 773: 774: 775: 776: 777: 778: 779: 780: 781: 782: 783: 784: 785: 786: 787: 788: 789: 790: 791: 792: 793: 794: 795: 796: 797: 798: 799: 800: 801: 802: 803: 804: 805: 806: 807: 808: 809: 810: 811: 812: 813: 814: 815: 816: 817: 818: 819: 820: 821: 822: 823: 824: 825: 826: 827: 828: 829: 830: 831: 832: 833: 834: 835: 836: 837: 838: 839: 840: 841: 842: 843: 844: 845: 846: 847: 848: 849: 850: 851: 852: 853: 854: 855: 856: 857: 858: 859: 860: 861: 862: 863: 864: 865: 866: 867: 868: 869: 870: 871: 872: 873: 874: 875: 876: 877: 878: 879: 880: 881: 882: 883: 884: 885: 886: 887: 888: 889: 890: 891: 892: 893: 894: 895: 896: 897: 898: 899: 900: 901: 902: 903: 904: 905: 906: 907: 908: 909: 910: 911: 912: 913: 914: 915: 916: 917: 918: 919: 920: 921: 922: 923: 924: 925: 926: 927: 928: 929: 930: 931: 932: 933: 934: 935: 936: 937: 938: 939: 940: 941: 942: 943: 944: 945: 946: 947: 948: 949: 950: 951: 952: 953: 954: 955: 956: 957: 958: 959: 960: 961: 962: 963: 964: 965: 966: 967: 968: 969: 970: 971: 972: 973: 974: 975: 976: 977: 978: 979: 980: 981: 982: 983: 984: 985: 986: 987: 988: 989: 990: 991: 992: 993: 994: 995: 996: 997: 998: 999: 1000: 1001: 1002: 1003: 1004: 1005: 1006: 1007: 1008: 1009: 1010: 1011: 1012: 1013: 1014: 1015: 1016: 1017: 1018: 1019: 1020: 1021: 1022: 1023: 1024: 1025: 1026: 1027: 1028: 1029: 1030: 1031: 1032: 1033: 1034: 1035: 1036: 1037: 1038: 1039: 1040: 1041: 1042: 1043: 1044: 1045: 1046:
| unit uFourier;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Spin, ExtCtrls, Buttons, Menus, ComCtrls, Sharemem;
type TfFourier = class(TForm) iKosy: TImage; gbCosinus: TGroupBox; lCos0: TLabel; lCos1: TLabel; lCos2: TLabel; lCos3: TLabel; lCos4: TLabel; lCos5: TLabel; lCos6: TLabel; lCos7: TLabel; lCos8: TLabel; lCos9: TLabel; gbSinus: TGroupBox; lSin1: TLabel; lSin2: TLabel; lSin3: TLabel; lSin4: TLabel; lSin5: TLabel; lSin6: TLabel; lSin7: TLabel; lSin8: TLabel; lSin9: TLabel; lbFunktionen: TListBox; bSpeichern: TButton; bLoeschen: TButton; gbSynthese: TGroupBox; sbZoomIn: TSpeedButton; sbZoomOut: TSpeedButton; sbZoomNormal: TSpeedButton; bZeichnen: TButton; bClear: TButton; bAnalyse: TButton; MainMenu1: TMainMenu; Funktion1: TMenuItem; Speichern1: TMenuItem; Loeschen1: TMenuItem; Zeichnen1: TMenuItem; Analysieren1: TMenuItem; Hilfe1: TMenuItem; ZurSynthese1: TMenuItem; ZurAnalyse1: TMenuItem; ZurEingabe1: TMenuItem; ZumKoordinatensystem1: TMenuItem; bSynthese: TButton; udCos0: TUpDown; eCos0: TEdit; eCos1: TEdit; eCos2: TEdit; eCos3: TEdit; eCos4: TEdit; eCos5: TEdit; eCos6: TEdit; eCos7: TEdit; eCos8: TEdit; eCos9: TEdit; udCos2: TUpDown; udCos3: TUpDown; udCos4: TUpDown; udCos5: TUpDown; udCos6: TUpDown; udCos7: TUpDown; udCos8: TUpDown; udCos9: TUpDown; udCos1: TUpDown; eSin1: TEdit; udSin1: TUpDown; eSin2: TEdit; eSin3: TEdit; eSin4: TEdit; eSin5: TEdit; eSin6: TEdit; eSin7: TEdit; eSin8: TEdit; eSin9: TEdit; udSin2: TUpDown; udSin3: TUpDown; udSin4: TUpDown; udSin5: TUpDown; udSin6: TUpDown; udSin7: TUpDown; udSin8: TUpDown; udSin9: TUpDown; ePeriodenlaenge: TEdit; udPeriodenlaenge: TUpDown; lPeriodenlaenge: TLabel; gbAnalyse: TGroupBox; seAnzahlKoeff: TSpinEdit; lAnzahlKoeff: TLabel; lFktVorschrift: TLabel; lVorschrift: TLabel; bReset: TButton; procedure sbZoomInClick(Sender: TObject); procedure sbZoomOutClick(Sender: TObject); procedure sbZoomNormalClick(Sender: TObject); procedure bClearClick(Sender: TObject); procedure bSyntheseClick(Sender: TObject); procedure eCos0KeyPress(Sender: TObject; var Key: Char); procedure eCos1KeyPress(Sender: TObject; var Key: Char); procedure eCos2KeyPress(Sender: TObject; var Key: Char); procedure eCos3KeyPress(Sender: TObject; var Key: Char); procedure eCos4KeyPress(Sender: TObject; var Key: Char); procedure eCos5KeyPress(Sender: TObject; var Key: Char); procedure eCos6KeyPress(Sender: TObject; var Key: Char); procedure eCos7KeyPress(Sender: TObject; var Key: Char); procedure eCos8KeyPress(Sender: TObject; var Key: Char); procedure eCos9KeyPress(Sender: TObject; var Key: Char); procedure eSin1KeyPress(Sender: TObject; var Key: Char); procedure eSin2KeyPress(Sender: TObject; var Key: Char); procedure eSin3KeyPress(Sender: TObject; var Key: Char); procedure eSin4KeyPress(Sender: TObject; var Key: Char); procedure eSin5KeyPress(Sender: TObject; var Key: Char); procedure eSin6KeyPress(Sender: TObject; var Key: Char); procedure eSin7KeyPress(Sender: TObject; var Key: Char); procedure eSin8KeyPress(Sender: TObject; var Key: Char); procedure eSin9KeyPress(Sender: TObject; var Key: Char); procedure udCos0Click(Sender: TObject; Button: TUDBtnType); procedure udCos1Click(Sender: TObject; Button: TUDBtnType); procedure udCos2Click(Sender: TObject; Button: TUDBtnType); procedure udCos3Click(Sender: TObject; Button: TUDBtnType); procedure udCos4Click(Sender: TObject; Button: TUDBtnType); procedure udCos5Click(Sender: TObject; Button: TUDBtnType); procedure udCos6Click(Sender: TObject; Button: TUDBtnType); procedure udCos7Click(Sender: TObject; Button: TUDBtnType); procedure udCos8Click(Sender: TObject; Button: TUDBtnType); procedure udCos9Click(Sender: TObject; Button: TUDBtnType); procedure udSin1Click(Sender: TObject; Button: TUDBtnType); procedure udSin2Click(Sender: TObject; Button: TUDBtnType); procedure udSin3Click(Sender: TObject; Button: TUDBtnType); procedure udSin4Click(Sender: TObject; Button: TUDBtnType); procedure udSin5Click(Sender: TObject; Button: TUDBtnType); procedure udSin6Click(Sender: TObject; Button: TUDBtnType); procedure udSin7Click(Sender: TObject; Button: TUDBtnType); procedure udSin8Click(Sender: TObject; Button: TUDBtnType); procedure udSin9Click(Sender: TObject; Button: TUDBtnType); procedure FormCreate(Sender: TObject); procedure bSpeichernClick(Sender: TObject); procedure bZeichnenClick(Sender: TObject); procedure bLoeschenClick(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure bAnalyseClick(Sender: TObject); procedure ePeriodenlaengeKeyPress(Sender: TObject; var Key: Char); procedure udPeriodenlaengeClick(Sender: TObject; Button: TUDBtnType); procedure seAnzahlKoeffClick(Sender: TObject); procedure seAnzahlKoeffChange(Sender: TObject); procedure bResetClick(Sender: TObject); private public end;
type tFunktion = record Koeffizienten : array[0..1 , 0..99] of extended; T : extended; Name : string[40]; FktVorschrift : string[40]; end; tDatei = file of tFunktion;
var fFourier: TfFourier; KoeffDatenbankGroesse : integer = 100; zoom : integer = 5; AnzahlKoeff : integer = 10; Funktion : tFunktion; Datenbank : array of tFunktion;
implementation
uses uSpeichern, uFunktionen;
{$R *.dfm}
function x_Pixel (xWert:extended) : integer; begin x_Pixel := Round((fFourier.iKosy.Width/(2*zoom))*xWert +(fFourier.iKosy.Width div 2)); end;
function y_Pixel (yWert:extended) : integer; begin y_Pixel := Round((fFourier.iKosy.Height/(zoom))*(-yWert) +(fFourier.iKosy.Height div 2)); end;
function Synthese (x : extended) : extended; var f : integer; Ergebnis : single; begin Ergebnis := 0; for f := 0 to AnzahlKoeff do Ergebnis := Ergebnis + Funktion.Koeffizienten[0,f]*cos(2*pi*x*f/Funktion.T); for f := 1 to AnzahlKoeff do Ergebnis := Ergebnis + Funktion.Koeffizienten[1,f]*sin(2*pi*x*f/Funktion.T); Synthese := Ergebnis;
end;
procedure Kosy_leeren; begin fFourier.iKosy.Canvas.Pen.Color := clwhite; fFourier.iKosy.Canvas.MoveTo(0,0); fFourier.iKosy.Canvas.Rectangle(0,0,fFourier.iKosy.Width,fFourier.iKosy.Height); end;
procedure Kosy_zeichnen; begin fFourier.iKosy.Canvas.pen.color := clblack; fFourier.iKosy.Canvas.pen.Width := 1; fFourier.iKosy.canvas.MoveTo(0,fFourier.iKosy.Height div 2); fFourier.iKosy.canvas.LineTo(fFourier.iKosy.Width,fFourier.iKosy.Height div 2); fFourier.iKosy.canvas.MoveTo(fFourier.iKosy.Width div 2,0); fFourier.iKosy.canvas.LineTo(fFourier.iKosy.Width div 2,fFourier.iKosy.Height); end;
procedure Kosy_Einheiten; var x,y,zoom_temp : integer; begin fFourier.iKosy.Canvas.pen.color := clblack; fFourier.iKosy.Canvas.pen.Width := 1; zoom_temp := zoom; for x := -zoom_temp to zoom_temp do begin fFourier.iKosy.Canvas.MoveTo(x_Pixel(x),(fFourier.iKosy.Height div 2)+2); fFourier.iKosy.Canvas.LineTo(x_Pixel(x),(fFourier.iKosy.Height div 2)-2); end; for y := (-zoom_temp div 2) to (zoom_temp div 2)do begin fFourier.iKosy.Canvas.MoveTo((fFourier.iKosy.Width div 2)+2,y_Pixel(y)); fFourier.iKosy.Canvas.LineTo((fFourier.iKosy.Width div 2)-2,y_Pixel(y)); end; end;
procedure Graph_zeichnen; var x : extended; begin fFourier.iKosy.Canvas.Pen.Color := clred; fFourier.iKosy.Canvas.Pen.Width := 1; x := -zoom; fFourier.iKosy.Canvas.MoveTo(x_Pixel(x),y_Pixel(Synthese(x))); repeat x := x+0.001; fFourier.iKosy.Canvas.LineTo(x_Pixel(x),y_Pixel(Synthese(x))); until x > zoom; end;
procedure Rahmen; begin fFourier.iKosy.Canvas.Pen.Color := clblack; fFourier.iKosy.Canvas.Pen.Width := 2; fFourier.iKosy.Canvas.MoveTo(0,0); fFourier.iKosy.Canvas.LineTo(fFourier.iKosy.Width,0); fFourier.iKosy.Canvas.LineTo(fFourier.iKosy.Width,fFourier.iKosy.Height); end;
procedure Kosy_neu; begin Kosy_leeren; Rahmen; Kosy_zeichnen; Kosy_Einheiten; end;
procedure TfFourier.sbZoomInClick(Sender: TObject); begin if zoom > 5 then zoom := zoom-5; if zoom <=5 then if zoom >2 then zoom := zoom-1; Kosy_neu; Graph_zeichnen; end;
procedure TfFourier.sbZoomOutClick(Sender: TObject); begin if zoom < 5 then zoom := zoom+1 else if zoom <= 100 then zoom := zoom+5; Kosy_neu; Graph_zeichnen; end;
procedure TfFourier.sbZoomNormalClick(Sender: TObject); begin zoom := 5; Kosy_neu; Graph_zeichnen; end;
function Komma (EString : string) : boolean; var i,Anzahl : integer; begin Anzahl := 0; for i := 1 to length(EString) do if EString[i] = ',' then inc(Anzahl); if Anzahl <= 1 then Komma := true else Komma := false; end;
function Minus (EString : string) : boolean; var i,Anzahl : integer; begin Anzahl := 0; for i := 1 to length(EString) do if EString[i] = '-' then inc(Anzahl); if (Anzahl = 0) then begin Minus := true; Exit; end; if (Anzahl = 1) then begin if (EString[1] = '-') then Minus := true else Minus := false end else Minus := false; end;
function Koeffizient (Eingabestring : string) : extended; begin if Komma(Eingabestring) and Minus(Eingabestring) then if ((Eingabestring <> '') and (Eingabestring <> ',') and (Eingabestring <> '-')) then Koeffizient := StrToFloat(Eingabestring) else Koeffizient := 0 else begin ShowMessage('Sie haben einen Fehler in der Eingabe.' +' Zum Beispiel darf nur ein Komma und ein Minuszeichen verwendet' +' werden oder das Minuszeichen muss am Anfang stehen.'); Koeffizient := 0; end; end;
function Periodenlaenge (Eingabestring : string) : extended; begin if Komma(Eingabestring) then begin if (Eingabestring <> '') then Result := StrToFloat(Eingabestring) else Result := 1; if (Result = 0) then begin ShowMessage('Die Periodenlänge kann ich 0 sein!'); Result := 1; end; if (Result > 100) then Result := 100; end else begin ShowMessage('Es ist nur ein Komma erlaubt!'); Result := 1; end; end;
procedure KoeffLesen; begin Funktion.T := Periodenlaenge(fFourier.ePeriodenlaenge.Text);
Funktion.Koeffizienten[0,0] := Koeffizient(fFourier.eCos0.Text); Funktion.Koeffizienten[0,1] := Koeffizient(fFourier.eCos1.Text); Funktion.Koeffizienten[0,2] := Koeffizient(fFourier.eCos2.Text); Funktion.Koeffizienten[0,3] := Koeffizient(fFourier.eCos3.Text); Funktion.Koeffizienten[0,4] := Koeffizient(fFourier.eCos4.Text); Funktion.Koeffizienten[0,5] := Koeffizient(fFourier.eCos5.Text); Funktion.Koeffizienten[0,6] := Koeffizient(fFourier.eCos6.Text); Funktion.Koeffizienten[0,7] := Koeffizient(fFourier.eCos7.Text); Funktion.Koeffizienten[0,8] := Koeffizient(fFourier.eCos8.Text); Funktion.Koeffizienten[0,9] := Koeffizient(fFourier.eCos9.Text);
Funktion.Koeffizienten[1,0] := 0; Funktion.Koeffizienten[1,1] := Koeffizient(fFourier.eSin1.Text); Funktion.Koeffizienten[1,2] := Koeffizient(fFourier.eSin2.Text); Funktion.Koeffizienten[1,3] := Koeffizient(fFourier.eSin3.Text); Funktion.Koeffizienten[1,4] := Koeffizient(fFourier.eSin4.Text); Funktion.Koeffizienten[1,5] := Koeffizient(fFourier.eSin5.Text); Funktion.Koeffizienten[1,6] := Koeffizient(fFourier.eSin6.Text); Funktion.Koeffizienten[1,7] := Koeffizient(fFourier.eSin7.Text); Funktion.Koeffizienten[1,8] := Koeffizient(fFourier.eSin8.Text); Funktion.Koeffizienten[1,9] := Koeffizient(fFourier.eSin9.Text); end;
procedure KoeffSchreiben; begin fFourier.ePeriodenlaenge.Text := FloatToStrF(Funktion.T, ffFixed,4,2);
fFourier.eCos0.Text := FloatToStrF(Funktion.Koeffizienten[0,0],ffFixed,4,2); fFourier.eCos1.Text := FloatToStrF(Funktion.Koeffizienten[0,1],ffFixed,4,2); fFourier.eCos2.Text := FloatToStrF(Funktion.Koeffizienten[0,2],ffFixed,4,2); fFourier.eCos3.Text := FloatToStrF(Funktion.Koeffizienten[0,3],ffFixed,4,2); fFourier.eCos4.Text := FloatToStrF(Funktion.Koeffizienten[0,4],ffFixed,4,2); fFourier.eCos5.Text := FloatToStrF(Funktion.Koeffizienten[0,5],ffFixed,4,2); fFourier.eCos6.Text := FloatToStrF(Funktion.Koeffizienten[0,6],ffFixed,4,2); fFourier.eCos7.Text := FloatToStrF(Funktion.Koeffizienten[0,7],ffFixed,4,2); fFourier.eCos8.Text := FloatToStrF(Funktion.Koeffizienten[0,8],ffFixed,4,2); fFourier.eCos9.Text := FloatToStrF(Funktion.Koeffizienten[0,9],ffFixed,4,2);
fFourier.eSin1.Text := FloatToStrF(Funktion.Koeffizienten[1,1],ffFixed,4,2); fFourier.eSin2.Text := FloatToStrF(Funktion.Koeffizienten[1,2],ffFixed,4,2); fFourier.eSin3.Text := FloatToStrF(Funktion.Koeffizienten[1,3],ffFixed,4,2); fFourier.eSin4.Text := FloatToStrF(Funktion.Koeffizienten[1,4],ffFixed,4,2); fFourier.eSin5.Text := FloatToStrF(Funktion.Koeffizienten[1,5],ffFixed,4,2); fFourier.eSin6.Text := FloatToStrF(Funktion.Koeffizienten[1,6],ffFixed,4,2); fFourier.eSin7.Text := FloatToStrF(Funktion.Koeffizienten[1,7],ffFixed,4,2); fFourier.eSin8.Text := FloatToStrF(Funktion.Koeffizienten[1,8],ffFixed,4,2); fFourier.eSin9.Text := FloatToStrF(Funktion.Koeffizienten[1,9],ffFixed,4,2); end;
procedure TfFourier.bSyntheseClick(Sender: TObject); begin KoeffLesen; KoeffSchreiben; Kosy_neu; Graph_zeichnen; end;
function Eingabeueberpruefung (Key : Char) : boolean; begin result := false; if not (Key in ['0'..'9',',','-',Chr(08),Chr(127),Chr(13)]) then Exit else result := true; end;
procedure Tastendruck (var Key : Char); var dummy : TObject; begin if Key = Chr(13) then fFourier.bSyntheseClick(dummy); if (Eingabeueberpruefung(Key) = false) then begin Showmessage('FEHLER!'); Key := chr(00); end; end;
procedure TfFourier.eCos0KeyPress(Sender: TObject; var Key: Char); begin Tastendruck(Key); end;
procedure TfFourier.eCos1KeyPress(Sender: TObject; var Key: Char); begin Tastendruck(Key); end;
procedure TfFourier.eCos2KeyPress(Sender: TObject; var Key: Char); begin Tastendruck(Key); end;
procedure TfFourier.eCos3KeyPress(Sender: TObject; var Key: Char); begin Tastendruck(Key); end;
procedure TfFourier.eCos4KeyPress(Sender: TObject; var Key: Char); begin Tastendruck(Key); end;
procedure TfFourier.eCos5KeyPress(Sender: TObject; var Key: Char); begin Tastendruck(Key); end;
procedure TfFourier.eCos6KeyPress(Sender: TObject; var Key: Char); begin Tastendruck(Key); end;
procedure TfFourier.eCos7KeyPress(Sender: TObject; var Key: Char); begin Tastendruck(Key); end;
procedure TfFourier.eCos8KeyPress(Sender: TObject; var Key: Char); begin Tastendruck(Key); end;
procedure TfFourier.eCos9KeyPress(Sender: TObject; var Key: Char); begin Tastendruck(Key); end;
procedure TfFourier.eSin1KeyPress(Sender: TObject; var Key: Char); begin Tastendruck(Key); end;
procedure TfFourier.eSin2KeyPress(Sender: TObject; var Key: Char); begin Tastendruck(Key); end;
procedure TfFourier.eSin3KeyPress(Sender: TObject; var Key: Char); begin Tastendruck(Key); end;
procedure TfFourier.eSin4KeyPress(Sender: TObject; var Key: Char); begin Tastendruck(Key); end;
procedure TfFourier.eSin5KeyPress(Sender: TObject; var Key: Char); begin Tastendruck(Key); end;
procedure TfFourier.eSin6KeyPress(Sender: TObject; var Key: Char); begin Tastendruck(Key); end;
procedure TfFourier.eSin7KeyPress(Sender: TObject; var Key: Char); begin Tastendruck(Key); end;
procedure TfFourier.eSin8KeyPress(Sender: TObject; var Key: Char); begin Tastendruck(Key); end;
procedure TfFourier.eSin9KeyPress(Sender: TObject; var Key: Char); begin Tastendruck(Key); end;
procedure TfFourier.ePeriodenlaengeKeyPress(Sender: TObject; var Key: Char); begin Tastendruck(Key); end;
procedure UpDown (var Koeffizient : extended; Button: TUDBtnType); var dummy : TObject; begin KoeffLesen; case Button of btNext: Koeffizient := Koeffizient + 0.01; btPrev: Koeffizient := Koeffizient - 0.01; end; KoeffSchreiben; fFourier.bSyntheseClick(dummy); end;
procedure TfFourier.udCos0Click(Sender: TObject; Button: TUDBtnType); begin UpDown(Funktion.Koeffizienten[0,0],Button); end;
procedure TfFourier.udCos1Click(Sender: TObject; Button: TUDBtnType); begin UpDown(Funktion.Koeffizienten[0,1],Button); end;
procedure TfFourier.udCos2Click(Sender: TObject; Button: TUDBtnType); begin UpDown(Funktion.Koeffizienten[0,2],Button); end;
procedure TfFourier.udCos3Click(Sender: TObject; Button: TUDBtnType); begin UpDown(Funktion.Koeffizienten[0,3],Button); end;
procedure TfFourier.udCos4Click(Sender: TObject; Button: TUDBtnType); begin UpDown(Funktion.Koeffizienten[0,4],Button); end;
procedure TfFourier.udCos5Click(Sender: TObject; Button: TUDBtnType); begin UpDown(Funktion.Koeffizienten[0,5],Button); end;
procedure TfFourier.udCos6Click(Sender: TObject; Button: TUDBtnType); begin UpDown(Funktion.Koeffizienten[0,6],Button); end;
procedure TfFourier.udCos7Click(Sender: TObject; Button: TUDBtnType); begin UpDown(Funktion.Koeffizienten[0,7],Button); end;
procedure TfFourier.udCos8Click(Sender: TObject; Button: TUDBtnType); begin UpDown(Funktion.Koeffizienten[0,8],Button); end;
procedure TfFourier.udCos9Click(Sender: TObject; Button: TUDBtnType); begin UpDown(Funktion.Koeffizienten[0,9],Button); end;
procedure TfFourier.udSin1Click(Sender: TObject; Button: TUDBtnType); begin UpDown(Funktion.Koeffizienten[1,1],Button); end;
procedure TfFourier.udSin2Click(Sender: TObject; Button: TUDBtnType); begin UpDown(Funktion.Koeffizienten[1,2],Button); end;
procedure TfFourier.udSin3Click(Sender: TObject; Button: TUDBtnType); begin UpDown(Funktion.Koeffizienten[1,3],Button); end;
procedure TfFourier.udSin4Click(Sender: TObject; Button: TUDBtnType); begin UpDown(Funktion.Koeffizienten[1,4],Button); end;
procedure TfFourier.udSin5Click(Sender: TObject; Button: TUDBtnType); begin UpDown(Funktion.Koeffizienten[1,5],Button); end;
procedure TfFourier.udSin6Click(Sender: TObject; Button: TUDBtnType); begin UpDown(Funktion.Koeffizienten[1,6],Button); end;
procedure TfFourier.udSin7Click(Sender: TObject; Button: TUDBtnType); begin UpDown(Funktion.Koeffizienten[1,7],Button); end;
procedure TfFourier.udSin8Click(Sender: TObject; Button: TUDBtnType); begin UpDown(Funktion.Koeffizienten[1,8],Button); end;
procedure TfFourier.udSin9Click(Sender: TObject; Button: TUDBtnType); begin UpDown(Funktion.Koeffizienten[1,9],Button); end;
procedure TfFourier.udPeriodenlaengeClick(Sender: TObject; Button: TUDBtnType); begin UpDown(Funktion.T,Button); end;
procedure ListboxLaden; var i : integer; begin fFourier.lbFunktionen.Clear; for i := 0 to length(Datenbank)-1 do fFourier.lbFunktionen.Items.Add(Datenbank[i].Name); end;
procedure DatenbankAdd; begin setlength(Datenbank,(length(Datenbank)+1)); Datenbank[length(Datenbank)-1].Koeffizienten := Funktion.Koeffizienten; fSpeichern.Showmodal; end;
procedure TfFourier.bSpeichernClick(Sender: TObject); begin DatenbankAdd; ListboxLaden; end;
procedure ListboxSelected (var index : integer; var gefunden : boolean); var i : integer; begin gefunden := false; index := 0; for i := 0 to fFourier.lbFunktionen.Items.Count-1 do if fFourier.lbFunktionen.Selected[i] then begin index := i; gefunden := true; end; end;
procedure TfFourier.bZeichnenClick(Sender: TObject); var index : integer; gefunden : boolean; begin ListboxSelected (index,gefunden); if gefunden then begin Funktion.Name := fFourier.lbFunktionen.Items.Strings[index]; Funktion.Koeffizienten := Datenbank[index].Koeffizienten; Kosy_neu; KoeffSchreiben; Graph_zeichnen; end else ShowMessage('Sie haben kein Funktion ausgewählt'); end;
procedure DatenbankLoeschen (index: integer); var i : integer; begin if (index < (length(Datenbank)-1)) then for i:= index to length(Datenbank)-2 do Datenbank[i] := Datenbank[i+1]; setlength(Datenbank, (length(Datenbank)-1)); end;
procedure TfFourier.bLoeschenClick(Sender: TObject); var index : integer; gefunden : boolean; begin ListboxSelected (index,gefunden); if gefunden = true then begin DatenbankLoeschen(index); ListboxLaden; end else ShowMessage('Sie haben keine Funktion ausgewählt'); end;
procedure DatenbankLaden; var Datensatz : tFunktion; datei : tDatei; begin if FileExists('Speicherung.fas') then begin AssignFile(datei, 'Speicherung.fas'); Reset(datei); setlength(Datenbank, 0); while (not Eof(datei)) do begin Read(datei, Datensatz); setlength(Datenbank, length(Datenbank)+1); Datenbank[length(Datenbank)-1] := Datensatz; end; Closefile(datei); end; end;
procedure TfFourier.FormCreate(Sender: TObject); begin DatenbankLaden; Kosy_neu; KoeffLesen; KoeffSchreiben; ListboxLaden; Graph_zeichnen; end;
procedure TfFourier.FormClose(Sender: TObject; var Action: TCloseAction); var i : integer; datei : tDatei; begin AssignFile(datei, 'Speicherung.fas'); Rewrite(datei); for i := 0 to length(Datenbank)-1 do Write(datei, Datenbank[i]); CloseFile(datei); end;
procedure TfFourier.seAnzahlKoeffClick(Sender: TObject); var dummy : TObject; begin AnzahlKoeff := fFourier.seAnzahlKoeff.Value; fFunktionen.bImportierenClick(dummy); Kosy_neu; KoeffSchreiben; Graph_zeichnen; end;
procedure TfFourier.seAnzahlKoeffChange(Sender: TObject); var dummy : TObject; begin if (fFourier.seAnzahlKoeff.Value <> 0) then AnzahlKoeff := fFourier.seAnzahlKoeff.Value else AnzahlKoeff := 0; fFunktionen.bImportierenClick(dummy); Kosy_neu; KoeffSchreiben; Graph_zeichnen; end;
procedure TfFourier.bAnalyseClick(Sender: TObject); begin fFunktionen.Showmodal; Kosy_neu; KoeffSchreiben; Graph_zeichnen; end;
procedure TfFourier.bClearClick(Sender: TObject); var i : integer; begin for i := 0 to AnzahlKoeff do begin Funktion.Koeffizienten[0,i] := 0; Funktion.Koeffizienten[1,i] := 0; end; Funktion.T := 1; Funktion.Name := ''; Funktion.FktVorschrift := ''; KoeffSchreiben; Kosy_neu; DatenbankLaden; ListboxLaden; fFourier.lVorschrift.Caption := ''; end;
procedure TfFourier.bResetClick(Sender: TObject); var dummy : TObject; begin DeleteFile('Speicherung.fas'); fFourier.bClearClick(dummy); end;
end.
unit uFunktionen;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Spin;
type TfFunktionen = class(TForm) lFunktion1: TLabel; lFunkion2: TLabel; lFunktion3: TLabel; lFunktion4: TLabel; lX3: TLabel; lX2: TLabel; lX1: TLabel; rbFunktion1: TRadioButton; rbFunktion2: TRadioButton; rbFunktion3: TRadioButton; rbFunktion4: TRadioButton; eX3: TEdit; eX2: TEdit; eX1: TEdit; eX0: TEdit; bImportieren: TButton; procedure bImportierenClick(Sender: TObject); procedure eX3KeyPress(Sender: TObject; var Key: Char); procedure eX2KeyPress(Sender: TObject; var Key: Char); procedure eX1KeyPress(Sender: TObject; var Key: Char); procedure eX0KeyPress(Sender: TObject; var Key: Char); private public end;
var fFunktionen: TfFunktionen;
implementation
uses uFourier; {$R *.dfm}
function Eingabeueberpruefung (Key : Char) : boolean; begin result := false; if not (Key in ['0'..'9',',','-',Chr(08),Chr(127),Chr(13)]) then Exit else result := true; end;
procedure Tastendruck (var Key : Char); var dummy : TObject; begin if (Eingabeueberpruefung(Key) = false) then begin Showmessage('FEHLER!'); Key := chr(00); end; end;
procedure TfFunktionen.eX3KeyPress(Sender: TObject; var Key: Char); begin Tastendruck(Key); end;
procedure TfFunktionen.eX2KeyPress(Sender: TObject; var Key: Char); begin Tastendruck(Key); end;
procedure TfFunktionen.eX1KeyPress(Sender: TObject; var Key: Char); begin Tastendruck(Key); end;
procedure TfFunktionen.eX0KeyPress(Sender: TObject; var Key: Char); begin Tastendruck(Key); end;
function keX3 : extended; begin if (fFunktionen.eX3.Text = '') then keX3 := 0 else keX3 := StrToFloat(fFunktionen.eX3.Text); end;
function keX2 : extended; begin if (fFunktionen.eX2.Text = '') then keX2 := 0 else keX2 := StrToFloat(fFunktionen.eX2.Text); end;
function keX1 : extended; begin if (fFunktionen.eX1.Text = '') then keX1 := 0 else keX1 := StrToFloat(fFunktionen.eX1.Text); end;
function keX0 : extended; begin if (fFunktionen.eX0.Text = '') then keX0 := 0 else keX0 := StrToFloat(fFunktionen.eX0.Text); end;
function Fkt1 (x : extended) : extended; begin if x < 0 then Fkt1 := 1 else Fkt1 := 0; end;
function FourierCos0(x,T : extended; f : integer) : extended; begin FourierCos0 := Fkt1(x)*cos(2*pi*f*x/T); end;
function FourierCos (x,T : extended; f : integer) : extended; begin FourierCos := Fkt1(x)*cos(2*pi*f*x/T); end;
function FourierSin (x,T : extended; f : integer) : extended; begin FourierSin := Fkt1(x)*sin(2*pi*f*x/T); end;
function IntegralKoeff (a,b,T: extended; n,f,Funktion: integer) : extended; var x,h : extended; gerade : boolean; begin h := (b-a)/n; case Funktion of 1: Result := FourierCos0(a,T,f); 2: Result := FourierCos(a,T,f); 3: Result := FourierSin(a,T,f); end; gerade := false; x := a; repeat x := x+h; case gerade of false : begin case Funktion of 1: Result := Result+4*FourierCos0(x,T,f); 2: Result := Result+4*FourierCos(x,T,f); 3: Result := Result+4*FourierSin(x,T,f); end; gerade := true; end; true : begin case Funktion of 1: Result := Result+2*FourierCos0(x,T,f); 2: Result := Result+2*FourierCos(x,T,f); 3: Result := Result+2*FourierSin(x,T,f); end; gerade := false; end; end; until (x >= b-h); case Funktion of 1: Result := Result+FourierCos0(b,T,f); 2: Result := Result+FourierCos(b,T,f); 3: Result := Result+FourierSin(b,T,f); end; Result := (h/3)*Result; end;
procedure Funktion1; var f: integer; T : extended; begin for f := 0 to KoeffDatenbankGroesse do begin Funktion.Koeffizienten[0,f] := 0; Funktion.Koeffizienten[1,f] := 0; end; T := 10; Funktion.T := T; Funktion.Koeffizienten[0,0] := (1/T)*IntegralKoeff(-T/2,T/2,T,100,0,1); for f := 1 to AnzahlKoeff do Funktion.Koeffizienten[0,f] := (2/T)*IntegralKoeff(-T/2,T/2,T,100,f,2); for f := 1 to AnzahlKoeff do Funktion.Koeffizienten[1,f] := (2/T)*IntegralKoeff(-T/2,T/2,T,100,f,3); end;
procedure TfFunktionen.bImportierenClick(Sender: TObject); begin if (not fFunktionen.rbFunktion1.Checked) and (not fFunktionen.rbFunktion2.Checked) and (not fFunktionen.rbFunktion3.Checked) and (not fFunktionen.rbFunktion4.Checked) then ShowMessage('Sie haben keine Funktion ausgwählt!'); if fFunktionen.rbFunktion1.Checked then begin Funktion1; Funktion.FktVorschrift := 'f(x)= '+FloatToStr(keX3)+'x³+'+FloatToStr(keX2)+'x²+' +FloatToStr(keX1)+'x+'+FloatToStr(keX0); end; fFourier.lVorschrift.Caption := Funktion.FktVorschrift; fFunktionen.close; end;
end. |
Gruß MG94
|
|
mandras
Beiträge: 430
Erhaltene Danke: 107
Win 10
Delphi 6 Prof, Delphi 10.4 Prof
|
Verfasst: Sa 21.04.12 15:09
Könntest Du bitte noch den Quelltext Deiner Forms hinzufügen (ALT-F12 zum anschauen), dann kann ich das Programm mal übersetzen und mir ansehen.
|
|
MG94
Hält's aus hier
Beiträge: 8
|
Verfasst: Sa 21.04.12 15:27
Bitteschön. Jetzt ist mein ganzes Programm online. Es sind noch ein paar Fehler im Quelltext. Sie beeinflussen aber nicht das Programm. Außer beim Schließen ist noch ein Fehler, da bin ich aber noch auf der Suche.
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: 367: 368: 369: 370: 371: 372: 373: 374: 375: 376: 377: 378: 379: 380: 381: 382: 383: 384: 385: 386: 387: 388: 389: 390: 391: 392: 393: 394: 395: 396: 397: 398: 399: 400: 401: 402: 403: 404: 405: 406: 407: 408: 409: 410: 411: 412: 413: 414: 415: 416: 417: 418: 419: 420: 421: 422: 423: 424: 425: 426: 427: 428: 429: 430: 431: 432: 433: 434: 435: 436: 437: 438: 439: 440: 441: 442: 443: 444: 445: 446: 447: 448: 449: 450: 451: 452: 453: 454: 455: 456: 457: 458: 459: 460: 461: 462: 463: 464: 465: 466: 467: 468: 469: 470: 471: 472: 473: 474: 475: 476: 477: 478: 479: 480: 481: 482: 483: 484: 485: 486: 487: 488: 489: 490: 491: 492: 493: 494: 495: 496: 497: 498: 499: 500: 501: 502: 503: 504: 505: 506: 507: 508: 509: 510: 511: 512: 513: 514: 515: 516: 517: 518: 519: 520: 521: 522: 523: 524: 525: 526: 527: 528: 529: 530: 531: 532: 533: 534: 535: 536: 537: 538: 539: 540: 541: 542: 543: 544: 545: 546: 547: 548: 549: 550: 551: 552: 553: 554: 555: 556: 557: 558: 559: 560: 561: 562: 563: 564: 565: 566: 567: 568: 569: 570: 571: 572: 573: 574: 575: 576: 577: 578: 579: 580: 581: 582: 583: 584: 585: 586: 587: 588: 589: 590: 591: 592: 593: 594: 595: 596: 597: 598: 599: 600: 601: 602: 603: 604: 605: 606: 607: 608: 609: 610: 611: 612: 613: 614: 615: 616: 617: 618: 619: 620: 621: 622: 623: 624: 625: 626: 627: 628: 629: 630: 631: 632: 633: 634: 635: 636: 637: 638: 639: 640: 641: 642: 643: 644: 645: 646: 647: 648: 649: 650: 651: 652: 653: 654: 655: 656: 657: 658: 659: 660: 661: 662: 663: 664: 665: 666: 667: 668: 669: 670: 671: 672: 673: 674: 675: 676: 677: 678: 679: 680: 681: 682: 683: 684: 685: 686: 687: 688: 689: 690: 691: 692: 693: 694: 695: 696: 697: 698: 699: 700: 701: 702: 703: 704: 705: 706: 707: 708: 709: 710: 711: 712: 713: 714: 715: 716: 717: 718: 719: 720: 721: 722: 723: 724: 725: 726: 727: 728: 729: 730: 731: 732: 733: 734: 735: 736: 737: 738: 739: 740: 741: 742: 743: 744: 745: 746: 747: 748: 749: 750: 751: 752: 753: 754: 755: 756: 757: 758: 759: 760: 761: 762: 763: 764: 765: 766: 767: 768: 769: 770: 771: 772: 773: 774: 775: 776: 777: 778: 779: 780: 781: 782: 783: 784: 785: 786: 787: 788: 789: 790: 791: 792: 793: 794: 795: 796: 797: 798: 799: 800: 801: 802: 803: 804: 805: 806: 807: 808: 809: 810: 811: 812: 813: 814: 815: 816: 817: 818: 819: 820: 821: 822: 823: 824: 825: 826: 827: 828: 829: 830: 831: 832: 833: 834: 835: 836: 837: 838: 839: 840: 841: 842: 843: 844: 845: 846: 847: 848: 849: 850: 851: 852: 853: 854: 855: 856: 857: 858: 859: 860: 861: 862: 863: 864: 865: 866: 867: 868: 869: 870: 871: 872: 873: 874: 875: 876: 877: 878: 879: 880: 881: 882: 883: 884: 885: 886: 887: 888: 889: 890: 891: 892: 893: 894: 895: 896: 897: 898: 899: 900: 901: 902: 903: 904: 905: 906: 907: 908: 909: 910: 911: 912: 913: 914: 915: 916: 917: 918: 919: 920: 921: 922: 923: 924: 925: 926: 927: 928: 929: 930: 931: 932: 933: 934: 935: 936: 937: 938: 939: 940: 941: 942: 943: 944: 945: 946: 947: 948: 949: 950: 951: 952: 953: 954: 955: 956: 957: 958: 959: 960: 961: 962: 963: 964: 965: 966: 967: 968: 969: 970: 971: 972: 973: 974: 975: 976: 977: 978: 979: 980: 981: 982: 983: 984: 985: 986: 987: 988: 989: 990: 991: 992: 993: 994: 995: 996: 997: 998: 999: 1000: 1001: 1002: 1003: 1004: 1005: 1006: 1007: 1008: 1009: 1010: 1011: 1012: 1013: 1014: 1015: 1016: 1017: 1018: 1019: 1020: 1021: 1022: 1023: 1024: 1025: 1026: 1027: 1028: 1029: 1030: 1031: 1032: 1033: 1034: 1035: 1036: 1037: 1038: 1039: 1040: 1041: 1042: 1043: 1044: 1045: 1046: 1047: 1048: 1049: 1050: 1051: 1052: 1053: 1054: 1055: 1056: 1057: 1058: 1059: 1060: 1061: 1062: 1063: 1064: 1065: 1066: 1067: 1068: 1069: 1070: 1071: 1072: 1073: 1074: 1075: 1076: 1077: 1078: 1079: 1080: 1081: 1082: 1083: 1084:
| object fFourier: TfFourier Left = 697 Top = 103 Width = 1037 Height = 614 VertScrollBar.Position = 156 Caption = 'Fourieranalyse und -synthese (c) Marek Götten' Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] Menu = MainMenu1 OldCreateOrder = False OnClose = FormClose OnCreate = FormCreate PixelsPerInch = 96 TextHeight = 13 object iKosy: TImage Left = 8 Top = -140 Width = 801 Height = 521 Transparent = True end object sbZoomOut: TSpeedButton Left = 811 Top = -116 Width = 23 Height = 22 Caption = '-' OnClick = sbZoomOutClick end object sbZoomNormal: TSpeedButton Left = 811 Top = -92 Width = 23 Height = 22 Caption = '0' OnClick = sbZoomNormalClick end object sbZoomIn: TSpeedButton Left = 811 Top = -140 Width = 23 Height = 22 Caption = '+' OnClick = sbZoomInClick end object lbFunktionen: TListBox Left = 848 Top = 284 Width = 201 Height = 121 Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -16 Font.Name = 'MS Sans Serif' Font.Style = [] ItemHeight = 20 ParentFont = False TabOrder = 0 end object bSpeichern: TButton Left = 1056 Top = 284 Width = 177 Height = 33 Caption = 'Funktion speichern' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -19 Font.Name = '@Arial Unicode MS' Font.Style = [] ParentFont = False TabOrder = 1 OnClick = bSpeichernClick end object bLoeschen: TButton Left = 1056 Top = 324 Width = 177 Height = 33 Caption = 'Funktion löschen' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -19 Font.Name = '@Arial Unicode MS' Font.Style = [] ParentFont = False TabOrder = 2 OnClick = bLoeschenClick end object gbSynthese: TGroupBox Left = 848 Top = -148 Width = 385 Height = 425 Caption = 'Synthese' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -13 Font.Name = '@Arial Unicode MS' Font.Style = [] ParentFont = False TabOrder = 3 object lPeriodenlaenge: TLabel Left = 264 Top = 24 Width = 82 Height = 18 Caption = 'Periodenlänge' end object gbCosinus: TGroupBox Left = 8 Top = 24 Width = 185 Height = 345 Caption = 'Frequenzen des Cosinus' TabOrder = 0 object lCos0: TLabel Left = 72 Top = 24 Width = 92 Height = 18 Caption = 'Cos Frequenz 0' end object lCos1: TLabel Left = 72 Top = 56 Width = 92 Height = 18 Caption = 'Cos Frequenz 1' end object lCos2: TLabel Left = 72 Top = 88 Width = 92 Height = 18 Caption = 'Cos Frequenz 2' end object lCos3: TLabel Left = 72 Top = 120 Width = 92 Height = 18 Caption = 'Cos Frequenz 3' end object lCos4: TLabel Left = 72 Top = 152 Width = 92 Height = 18 Caption = 'Cos Frequenz 4' end object lCos5: TLabel Left = 72 Top = 184 Width = 92 Height = 18 Caption = 'Cos Frequenz 5' end object lCos6: TLabel Left = 72 Top = 216 Width = 92 Height = 18 Caption = 'Cos Frequenz 6' end object lCos7: TLabel Left = 72 Top = 248 Width = 92 Height = 18 Caption = 'Cos Frequenz 7' end object lCos8: TLabel Left = 72 Top = 280 Width = 92 Height = 18 Caption = 'Cos Frequenz 8' end object lCos9: TLabel Left = 72 Top = 312 Width = 92 Height = 18 Caption = 'Cos Frequenz 9' end object eCos0: TEdit Left = 8 Top = 24 Width = 41 Height = 26 TabOrder = 0 OnKeyPress = eCos0KeyPress end object eCos1: TEdit Left = 8 Top = 56 Width = 41 Height = 26 TabOrder = 1 OnKeyPress = eCos1KeyPress end object eCos2: TEdit Left = 8 Top = 88 Width = 41 Height = 26 TabOrder = 2 OnKeyPress = eCos2KeyPress end object eCos3: TEdit Left = 8 Top = 120 Width = 41 Height = 26 TabOrder = 3 OnKeyPress = eCos3KeyPress end object eCos4: TEdit Left = 8 Top = 152 Width = 41 Height = 26 TabOrder = 4 OnKeyPress = eCos4KeyPress end object eCos5: TEdit Left = 8 Top = 184 Width = 41 Height = 26 TabOrder = 5 OnKeyPress = eCos5KeyPress end object eCos6: TEdit Left = 8 Top = 216 Width = 41 Height = 26 TabOrder = 6 OnKeyPress = eCos6KeyPress end object eCos7: TEdit Left = 8 Top = 248 Width = 41 Height = 26 TabOrder = 7 OnKeyPress = eCos7KeyPress end object eCos8: TEdit Left = 8 Top = 280 Width = 41 Height = 26 TabOrder = 8 OnKeyPress = eCos8KeyPress end object eCos9: TEdit Left = 8 Top = 312 Width = 41 Height = 26 TabOrder = 9 OnKeyPress = eCos9KeyPress end object udCos0: TUpDown Left = 49 Top = 24 Width = 17 Height = 26 Min = -10000 Max = 10000 TabOrder = 10 OnClick = udCos0Click end object udCos1: TUpDown Left = 49 Top = 56 Width = 17 Height = 26 Min = -10000 Max = 10000 TabOrder = 11 OnClick = udCos1Click end object udCos2: TUpDown Left = 48 Top = 88 Width = 17 Height = 25 Min = -10000 Max = 10000 TabOrder = 12 OnClick = udCos2Click end object udCos3: TUpDown Left = 48 Top = 120 Width = 17 Height = 25 Min = -10000 Max = 10000 TabOrder = 13 OnClick = udCos3Click end object udCos4: TUpDown Left = 48 Top = 152 Width = 17 Height = 25 Min = -10000 Max = 10000 TabOrder = 14 OnClick = udCos4Click end object udCos5: TUpDown Left = 48 Top = 184 Width = 17 Height = 25 Min = -10000 Max = 10000 TabOrder = 15 OnClick = udCos5Click end object udCos6: TUpDown Left = 48 Top = 216 Width = 17 Height = 25 Min = -10000 Max = 10000 TabOrder = 16 OnClick = udCos6Click end object udCos7: TUpDown Left = 48 Top = 248 Width = 17 Height = 25 Min = -10000 Max = 10000 TabOrder = 17 OnClick = udCos7Click end object udCos8: TUpDown Left = 48 Top = 280 Width = 17 Height = 25 Min = -10000 Max = 10000 TabOrder = 18 OnClick = udCos8Click end object udCos9: TUpDown Left = 48 Top = 312 Width = 17 Height = 25 Min = -10000 Max = 10000 TabOrder = 19 OnClick = udCos9Click end end object gbSinus: TGroupBox Left = 192 Top = 56 Width = 185 Height = 313 Caption = 'Frequenzen des Sinus' TabOrder = 1 object lSin1: TLabel Left = 72 Top = 24 Width = 88 Height = 18 Caption = 'Sin Frequenz 1' end object lSin2: TLabel Left = 72 Top = 56 Width = 88 Height = 18 Caption = 'Sin Frequenz 2' end object lSin3: TLabel Left = 72 Top = 88 Width = 88 Height = 18 Caption = 'Sin Frequenz 3' end object lSin4: TLabel Left = 72 Top = 120 Width = 88 Height = 18 Caption = 'Sin Frequenz 4' end object lSin5: TLabel Left = 72 Top = 152 Width = 88 Height = 18 Caption = 'Sin Frequenz 5' end object lSin6: TLabel Left = 72 Top = 184 Width = 88 Height = 18 Caption = 'Sin Frequenz 6' end object lSin7: TLabel Left = 72 Top = 216 Width = 88 Height = 18 Caption = 'Sin Frequenz 7' end object lSin8: TLabel Left = 72 Top = 248 Width = 88 Height = 18 Caption = 'Sin Frequenz 8' end object lSin9: TLabel Left = 72 Top = 280 Width = 88 Height = 18 Caption = 'Sin Frequenz 9' end object eSin1: TEdit Left = 8 Top = 24 Width = 41 Height = 26 TabOrder = 0 OnKeyPress = eSin1KeyPress end object udSin1: TUpDown Left = 48 Top = 24 Width = 17 Height = 25 Min = -10000 Max = 10000 TabOrder = 1 OnClick = udSin1Click end object eSin2: TEdit Left = 8 Top = 56 Width = 41 Height = 26 TabOrder = 2 OnKeyPress = eSin2KeyPress end object eSin3: TEdit Left = 8 Top = 88 Width = 41 Height = 26 TabOrder = 3 OnKeyPress = eSin3KeyPress end object eSin4: TEdit Left = 8 Top = 120 Width = 41 Height = 26 TabOrder = 4 OnKeyPress = eSin4KeyPress end object eSin5: TEdit Left = 8 Top = 152 Width = 41 Height = 26 TabOrder = 5 OnKeyPress = eSin5KeyPress end object eSin6: TEdit Left = 8 Top = 184 Width = 41 Height = 26 TabOrder = 6 OnKeyPress = eSin6KeyPress end object eSin7: TEdit Left = 8 Top = 216 Width = 41 Height = 26 TabOrder = 7 OnKeyPress = eSin7KeyPress end object eSin8: TEdit Left = 8 Top = 248 Width = 41 Height = 26 TabOrder = 8 OnKeyPress = eSin8KeyPress end object eSin9: TEdit Left = 8 Top = 280 Width = 41 Height = 26 TabOrder = 9 OnKeyPress = eSin9KeyPress end object udSin2: TUpDown Left = 48 Top = 56 Width = 17 Height = 25 Min = -10000 Max = 10000 TabOrder = 10 OnClick = udSin2Click end object udSin3: TUpDown Left = 48 Top = 88 Width = 17 Height = 25 Min = -10000 Max = 10000 TabOrder = 11 OnClick = udSin3Click end object udSin4: TUpDown Left = 48 Top = 120 Width = 17 Height = 25 Min = -10000 Max = 10000 TabOrder = 12 OnClick = udSin4Click end object udSin5: TUpDown Left = 48 Top = 152 Width = 17 Height = 25 Min = -10000 Max = 10000 TabOrder = 13 OnClick = udSin5Click end object udSin6: TUpDown Left = 48 Top = 184 Width = 17 Height = 25 Min = -10000 Max = 10000 TabOrder = 14 OnClick = udSin6Click end object udSin7: TUpDown Left = 48 Top = 216 Width = 17 Height = 25 Min = -10000 Max = 10000 TabOrder = 15 OnClick = udSin7Click end object udSin8: TUpDown Left = 48 Top = 248 Width = 17 Height = 25 Min = -10000 Max = 10000 TabOrder = 16 OnClick = udSin8Click end object udSin9: TUpDown Left = 48 Top = 280 Width = 17 Height = 25 Min = -10000 Max = 10000 TabOrder = 17 OnClick = udSin9Click end end object ePeriodenlaenge: TEdit Left = 200 Top = 24 Width = 41 Height = 26 TabOrder = 2 OnKeyPress = ePeriodenlaengeKeyPress end object udPeriodenlaenge: TUpDown Left = 240 Top = 24 Width = 17 Height = 25 Min = -10000 Max = 10000 TabOrder = 3 OnClick = udPeriodenlaengeClick end end object bZeichnen: TButton Left = 1056 Top = 364 Width = 177 Height = 41 Caption = 'Funktion zeichnen' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -19 Font.Name = '@Arial Unicode MS' Font.Style = [] ParentFont = False TabOrder = 4 OnClick = bZeichnenClick end object bClear: TButton Left = 16 Top = 420 Width = 185 Height = 61 Caption = 'Clear' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -19 Font.Name = '@Arial Unicode MS' Font.Style = [] ParentFont = False TabOrder = 5 OnClick = bClearClick end object bSynthese: TButton Left = 856 Top = 228 Width = 369 Height = 41 Caption = 'Funktion synthetisieren' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -19 Font.Name = '@Arial Unicode MS' Font.Style = [] ParentFont = False TabOrder = 6 OnClick = bSyntheseClick end object gbAnalyse: TGroupBox Left = 216 Top = 412 Width = 1018 Height = 129 Caption = 'Analyse' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -13 Font.Name = 'Arial Unicode MS' Font.Style = [] ParentFont = False TabOrder = 7 object lAnzahlKoeff: TLabel Left = 88 Top = 88 Width = 205 Height = 22 Caption = 'Anzahl der Koeffizienten' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -19 Font.Name = 'Arial' Font.Style = [] ParentFont = False end object lFktVorschrift: TLabel Left = 280 Top = 32 Width = 163 Height = 22 Caption = 'Funktionsvorschrift:' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -19 Font.Name = 'Arial' Font.Style = [] ParentFont = False end object lVorschrift: TLabel Left = 448 Top = 32 Width = 5 Height = 22 Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -19 Font.Name = 'Arial' Font.Style = [] ParentFont = False end object bAnalyse: TButton Left = 8 Top = 24 Width = 193 Height = 41 Caption = 'Funktion analysieren' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -19 Font.Name = '@Arial Unicode MS' Font.Style = [] ParentFont = False TabOrder = 0 OnClick = bAnalyseClick end object seAnzahlKoeff: TSpinEdit Left = 8 Top = 80 Width = 73 Height = 32 EditorEnabled = False Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -19 Font.Name = 'Arial' Font.Style = [] MaxValue = 100 MinValue = 1 ParentFont = False TabOrder = 1 Value = 10 OnChange = seAnzahlKoeffChange OnClick = seAnzahlKoeffClick end end object bReset: TButton Left = 16 Top = 488 Width = 185 Height = 53 Caption = 'Reset' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -19 Font.Name = '@Arial Unicode MS' Font.Style = [] ParentFont = False TabOrder = 8 OnClick = bResetClick end object MainMenu1: TMainMenu object Funktion1: TMenuItem Caption = 'Funktion' object Speichern1: TMenuItem Caption = 'Speichern' end object Loeschen1: TMenuItem Caption = 'Löschen' end object Zeichnen1: TMenuItem Caption = 'Zeichnen' end object Analysieren1: TMenuItem Caption = 'Analysieren' end end object Hilfe1: TMenuItem Caption = 'Hilfe' object ZurSynthese1: TMenuItem Caption = 'Zur Synthese' end object ZurAnalyse1: TMenuItem Caption = 'Zur Analyse' end object ZurEingabe1: TMenuItem Caption = 'Zur Eingabe' end object ZumKoordinatensystem1: TMenuItem Caption = 'Zum Koordinatensystem' end end end end
object fFunktionen: TfFunktionen Left = 457 Top = 153 Width = 577 Height = 280 Caption = 'Funktionseingabe' Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -13 Font.Name = 'Arial' Font.Style = [] OldCreateOrder = False PixelsPerInch = 96 TextHeight = 16 object lFunktion1: TLabel Left = 104 Top = 40 Width = 38 Height = 22 Caption = 'f(x)=' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -19 Font.Name = 'Arial' Font.Style = [] ParentFont = False end object lFunkion2: TLabel Left = 104 Top = 72 Width = 38 Height = 22 Caption = 'f(x)=' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -19 Font.Name = 'Arial' Font.Style = [] ParentFont = False end object lFunktion3: TLabel Left = 104 Top = 104 Width = 38 Height = 22 Caption = 'f(x)=' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -19 Font.Name = 'Arial' Font.Style = [] ParentFont = False end object lFunktion4: TLabel Left = 104 Top = 136 Width = 38 Height = 22 Caption = 'f(x)=' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -19 Font.Name = 'Arial' Font.Style = [] ParentFont = False end object lX3: TLabel Left = 192 Top = 40 Width = 36 Height = 22 Caption = 'x³ + ' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -19 Font.Name = 'Arial' Font.Style = [] ParentFont = False end object lX2: TLabel Left = 280 Top = 40 Width = 36 Height = 22 Caption = 'x² + ' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -19 Font.Name = 'Arial' Font.Style = [] ParentFont = False end object lX1: TLabel Left = 368 Top = 40 Width = 30 Height = 22 Caption = 'x + ' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -19 Font.Name = 'Arial' Font.Style = [] ParentFont = False end object rbFunktion1: TRadioButton Left = 16 Top = 48 Width = 81 Height = 17 Caption = 'Funktion 1' Checked = True TabOrder = 0 TabStop = True end object rbFunktion2: TRadioButton Left = 16 Top = 80 Width = 81 Height = 17 Caption = 'Funktion 2' TabOrder = 1 end object rbFunktion3: TRadioButton Left = 16 Top = 112 Width = 81 Height = 17 Caption = 'Funktion 3' TabOrder = 2 end object rbFunktion4: TRadioButton Left = 16 Top = 144 Width = 81 Height = 17 Caption = 'Funktion 4' TabOrder = 3 end object eX3: TEdit Left = 144 Top = 40 Width = 49 Height = 26 Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -16 Font.Name = 'Arial' Font.Style = [] ParentFont = False TabOrder = 4 Text = '0' OnKeyPress = eX3KeyPress end object eX2: TEdit Left = 232 Top = 40 Width = 49 Height = 26 Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -16 Font.Name = 'Arial' Font.Style = [] ParentFont = False TabOrder = 5 Text = '0' OnKeyPress = eX2KeyPress end object eX1: TEdit Left = 320 Top = 40 Width = 49 Height = 26 Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -16 Font.Name = 'Arial' Font.Style = [] ParentFont = False TabOrder = 6 Text = '0' OnKeyPress = eX1KeyPress end object eX0: TEdit Left = 400 Top = 40 Width = 49 Height = 26 Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -16 Font.Name = 'Arial' Font.Style = [] ParentFont = False TabOrder = 7 Text = '0' OnKeyPress = eX0KeyPress end object bImportieren: TButton Left = 24 Top = 184 Width = 121 Height = 33 Caption = 'Importieren' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -19 Font.Name = 'Arial' Font.Style = [] ParentFont = False TabOrder = 8 OnClick = bImportierenClick end end
object fSpeichern: TfSpeichern Left = 373 Top = 147 Width = 564 Height = 202 Caption = 'Speichern' Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] OldCreateOrder = False OnCreate = FormCreate PixelsPerInch = 96 TextHeight = 13 object lName: TLabel Left = 16 Top = 56 Width = 63 Height = 27 Caption = 'Name' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -24 Font.Name = 'Arial' Font.Style = [] ParentFont = False end object eName: TEdit Left = 88 Top = 56 Width = 441 Height = 32 Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -21 Font.Name = 'Arial' Font.Style = [] ParentFont = False TabOrder = 0 Text = 'Geben Sie bitte den Namen ihrer Funktion ein' end object bSpeichern: TButton Left = 88 Top = 104 Width = 161 Height = 33 Caption = 'Speichern' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -21 Font.Name = 'Arial' Font.Style = [] ParentFont = False TabOrder = 1 OnClick = bSpeichernClick end end |
|
|
MG94
Hält's aus hier
Beiträge: 8
|
Verfasst: Sa 21.04.12 15:38
Entschuldigung, da habe ich noch einen Teil vergessen. Die uSpeichern habe ich hier noch angehängt.
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:
| unit uSpeichern;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type TfSpeichern = class(TForm) eName: TEdit; lName: TLabel; bSpeichern: TButton; procedure bSpeichernClick(Sender: TObject); procedure FormCreate(Sender: TObject); private public end;
var fSpeichern: TfSpeichern;
implementation
uses uFourier; {$R *.dfm}
function Vorhanden (Name : string) : boolean; var i : integer; begin i := 0; Result := false; if fFourier.lbFunktionen.Items.Count <> 0 then repeat if Name = fFourier.lbFunktionen.Items.Strings[i] then Result := true; inc(i); until ((Result = true) or (i = fFourier.lbFunktionen.Items.Count)); end;
procedure Speichern (Name : string); begin if Vorhanden(Name) = true then Showmessage('ds') else uFourier.Datenbank[length(Datenbank)-1].Name := Name; end;
procedure TfSpeichern.bSpeichernClick(Sender: TObject); begin Speichern(fSpeichern.eName.Text); fSpeichern.Close; end;
procedure TfSpeichern.FormCreate(Sender: TObject); begin fSpeichern.eName.Text := 'Geben Sie bitte den Namen ihrer Funktion ein'; end;
end. |
|
|
mandras
Beiträge: 430
Erhaltene Danke: 107
Win 10
Delphi 6 Prof, Delphi 10.4 Prof
|
Verfasst: Sa 21.04.12 17:59
Ich habe das Programm nun kurz überflogen (und nicht alles verstanden *g*)
Was mir auffiel ist daß das von Dir beschriebene Problem genau ab 49/50 Faktoren auftritt.
Du hast im Programm die Zahl 100 fest kodiert, also tritt das Problem bei 100/2=50 Faktoren auf.
Nun habe ich die Arrays von 100 auf 200er Größe geändert und die festkodierte 100 auf 200 gesetzt. Folge: Das Problem bleibt, tritt aber erst bei 100 Faktoren auf (also wieder N/2).
Da ich das Programm nicht voll verstanden habe tendiere ich zu folgender Aussage:
Das Programm arbeitet korrekt, das Phänomen resultiert aus Spiegelfrequenzen/Abtasttheorem: Mit N Punkten kann ich max. N/2 Freuqenzen analysieren, in Umkehrung: N Punkte lassen sich aus max. N/2 Frequenzen synthetisieren.
Dementsprechend müßtest Du einfach als Obergrenze für die Faktorenzahl 49 setzen..
Für diesen Beitrag haben gedankt: MG94
|
|
MG94
Hält's aus hier
Beiträge: 8
|
Verfasst: Sa 21.04.12 22:04
Also bei mir funktioniert das mit der Verdopplung irgendwie nicht. Aber wenn das so stimmt, dann wird meine Facharbeit noch komplizierter als sie schon ist .
|
|
bernd2011
Hält's aus hier
Beiträge: 6
|
Verfasst: Sa 21.04.12 22:48
|
|
Martok
Beiträge: 3661
Erhaltene Danke: 604
Win 8.1, Win 10 x64
Pascal: Lazarus Snapshot, Delphi 7,2007; PHP, JS: WebStorm
|
Verfasst: Sa 21.04.12 22:49
_________________ "The phoenix's price isn't inevitable. It's not part of some deep balance built into the universe. It's just the parts of the game where you haven't figured out yet how to cheat."
|
|
FinnO
Beiträge: 1331
Erhaltene Danke: 123
Mac OSX, Arch
TypeScript (Webstorm), Kotlin, Clojure (IDEA), Golang (VSCode)
|
Verfasst: Sa 21.04.12 22:56
Moin,
finde ich höchst verwundernswert, dass Dinge mit Fouriertransformation kompliziert werden können . Aus dem Code werde ich leider nicht schlau, allerdings muss ich dazu sagen, dass ich von Fouriertransformation nicht besonders viel verstehe, wenn es um die Implementierung geht. Vielleicht hilft es ja, mal eine funktionierende Implementierung der FastFourierTransformation anzugucken:
www.simdesign.nl/fft.html
LG
€: Falscher Link.
|
|
mandras
Beiträge: 430
Erhaltene Danke: 107
Win 10
Delphi 6 Prof, Delphi 10.4 Prof
|
Verfasst: Sa 21.04.12 23:05
Laß' die FFT hier mal schnell weg! Das verkompliziert alles nur
|
|
MG94
Hält's aus hier
Beiträge: 8
|
Verfasst: Sa 21.04.12 23:29
Ich wollte gerade sagen, dass das mit der FFT hier vielleicht etwas zu weit geht.
Vielleich etwas allgemeines zur Facharbeit.
Ich soll die Fouriersynthese und die Fourieranalyse erarbeiten und dann mit Hilfe von Delphi programmieren. Deswegen geht das Programm die Rechenschritte durch, die man auch per Hand ausführen würde.
Leider funktioniert das mit der doppelten Koeffizientenanzahl bei mir nicht. Ich frage mich nur warum. Es wäre natürlich schön, wenn es nur daran liegen würde. Dann müsste ich nur noch das ganze erklären können. Das sprengt so langsam den Rahmen einer Facharbeit. Aber das Programm soll ja funktionieren.
Also, weiß vielleicht jemand, warum das mit der doppelten Koeffizientenanzahl bei mir nicht funktioniert. Vielleicht habe ich das auch falsch verstanden. Ich habe die Datenbank für die Koeffizienten auf 200 erweitert, aber geändert hat sich dadurch nichts.
Das Programm mit der FFT verstehe ich immoment noch nicht so ganz, aber vielleicht schaue ich morgen genauer rein.
Gruß
MG94
|
|
mandras
Beiträge: 430
Erhaltene Danke: 107
Win 10
Delphi 6 Prof, Delphi 10.4 Prof
|
Verfasst: So 22.04.12 00:07
ich hatte in uFunktionen / Funktion1 die Zahl 100 durch 200 ersetzt, weiterhin in uFourier die Deklaration der tFunktion:
Koeffizienten : array[0..1 , 0..99] of extended;
auf 0..199.
- vergiß alles mit FFT. ich habe damals 2 Wochen gebraucht die nachvollziehen zu können. Sie ist eine schnellere FT, aber nur für Daten mit N=2^a Abtastpunkten, wenn man mehr Gehirnschmalz investiert für Daten mit N=a*b (a,b natürliche Zahlen). Das hilft Dir hier nicht weiter.
- "Die Rechenschritte per Hand".. Da hat mich Dein Programm verwundert mit der Simpson-Regel. Eigentlich ist diese nicht erforderlich. Es gibt kontinuierliche FT (also alles per Integral, das kann ein Computer nicht, da die Intervalle hier auch gegen 0 streben. Und dann kämen wir zu Distributionstheorie.. Unendlich hohe Ausschläge mit unendlich schmalem Fenster.. ist kein Bereich einer Facharbeit.)
Die diskrete FT im Gegensatz geht einfach Abtastwerte durch, multipliziert Reihen und kommt zur Lösung. Ohne Simpson. Normal ist hier daß mit zunehmender Koeffizientenzahl das Ergebnis sich der Vorgabe immer weiter nähert aber (siehe Beispiel Rechteck) an den Rändern dann immer mehr überschwingt.
- Ja, es liegt nur an der "doppelten Koeffizientenzahl". Das Programm funktioniert. Erlaube den Hinweis wie vorhin im Thread genannt: "Nyquist-Theorem". Ich verpiesel mich hier ganz geschickt aus der genauen Begründung da es erstens spät ist und diese Sache zwar mal Prüfungsthema bei mir war aber schon so lange zurückliegt daß ich es leider zum Glück vergessen habe
Für diesen Beitrag haben gedankt: MG94
|
|
MG94
Hält's aus hier
Beiträge: 8
|
Verfasst: So 22.04.12 00:56
Ein vorläufiger Abschluss:
-ich habe die 100 in uFunktion Funktion1 vergessen, deswegen ging es nicht, jetzt funktioniert es bei mir auch und ab 97 Koeffizienten merkt man wieder die Ungenauigkeit
-das mit der FFT schaue ich mir vielleicht bei Gelegenheit an. Sie ist mir schon öfter über den Weg gelaufen, aber wirklich verstanden habe ich sie nicht. Für die Facharbeit ist sie höchstens ein Blick in die Zukunft.
-mit den "Rechenschritten per Hand" meinte ich, dass das Programm den selben Weg wählt wie ich per Hand. Das Simpsonverfahren habe ich angewendet, da der Computer keine Integrale mit der herkömmlichen Weise ausrechnen kann. Deswegen musste ich auf ein numerisches Integrationsverfahren zurückgreifen. das Simpsonverfahren haben wir schon einmal behandelt und es war das genaueste, das wir hatten.
-das Nyquist-Theorem werde ich dann nur kurz anschneiden in der Facharbeit, aber nicht genauer erklären.
Alles in allem ist das Programm dazu da um zu lernen, wie man dem Computer das "Rechnen" beibringen kann. Also wie ich meine Rechenschritte dem Computer beibringe. Natürlich gibt es deutlich bessere Methoden für die Fourieranalyse, aber ich musste möglichst auf dem Niveau der 12. Klasse bleiben, denn ich soll das ganze auch den Schülern erklären können. Mein Programm ist also nicht dafür gedacht "kommerziell" vertrieben zu werden. Stattdessen kann man im Programm Denkanstöße für andere Projekte finden. Komplett ausgereift ist es natürlich auch nicht, aber das kann man innerhalb von 3 Monaten auch nicht erwarten, denke ich.
Ich bedanke mich bei allen, die mir geholfen haben.
Weitere Tipps zum Programm nehme ich natürlich gerne an insbesondere was die Verständlichkeit angeht.
MG94
|
|
JDKDelphi
Beiträge: 115
Erhaltene Danke: 22
WIN2000, XP, WIN 7 , UNIX, LINUX
Assembler für (Z8x, 68xxx,R6000,Intel), DELPHI 6 Enterprise, MAGIC eDeveloper V9+V10, C++, C#,VB, .NET, zertifizierter iBOLT-Programmierer
|
Verfasst: Mo 23.04.12 09:55
Hallo,
ich hatte vor 2 Jahren mal eine komplette FFT-Unit ins Forum gestellt.
Vielleicht hilft das
Gruß
_________________ Wo andere aufhören, fange ich erst an..
|
|
Delphi-Laie
Beiträge: 1600
Erhaltene Danke: 232
Delphi 2 - RAD-Studio 10.1 Berlin
|
Verfasst: Mo 23.04.12 11:02
JDKDelphi hat folgendes geschrieben : | ich hatte vor 2 Jahren mal eine komplette FFT-Unit ins Forum gestellt. |
Und ich zog mal aus einem der Delphiforen (weiß nicht mehr, aus welchem) vor geraumer Weile die beiden angehängten Dateien. Sind also nicht von mir!
Einloggen, um Attachments anzusehen!
|
|
MG94
Hält's aus hier
Beiträge: 8
|
Verfasst: Do 26.04.12 17:42
Hallo,
also das Programm läuft jetzt soweit. Ich habe aber noch eine Frage. Bei dem Problem, dass aufgetreten ist, wurde ich auf das Nyquist-Shannon-Abtasttheorem verwiesen. Das habe ich auch verstanden, in der Theorie. Aber ich verstehe nicht, wie ich das Theorem anhand meines Programms erklären kann. Könnte das mir vielleicht jemand kurz erläutern?
Gruß MG94
PS. Da das Programm soweit funktioniert werde ich mir vielleicht später die FFT Programme angucken. Diese habe aber nicht so viel mit der Facharbeit zutun. Trotzdem dankeschön.
|
|
|