Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Multimedia (https://www.delphipraxis.net/16-multimedia/)
-   -   Delphi koordinatensystem in delphi (https://www.delphipraxis.net/14767-koordinatensystem-delphi.html)

s.carter 15. Jan 2004 11:07


koordinatensystem in delphi
 


hallo leute, :-D
und zwar versuche ich grad mit nem freund in delphi, eine kurvendiskussion inklusive zeichnen eines graphens zu programmieren. :gruebel:

hat jemand von euch schon so etwas gemacht und könnte uns helfen?
wär echt nett von euch, denn wir bekommen dafür in informatik ne note und haben uns diese herausforderung gewählt. :hi:

sollen wir eine PaintBox oder eine Image Komponente nehmen? :roll:

mfg und vielen dank! :coder:

MisterNiceGuy 15. Jan 2004 11:14

Re: koordinatensystem in delphi
 
Ich stell das jetzt mal einfach so in den Raum :)
Haben das in Informatik schon mal gemacht:
Code:
unit UParabel;

interface

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

type
  TFParabel = class(TForm)
    ImParabel: TImage;
    PTop: TPanel;
    PButton: TPanel;
    BSchliessen: TButton;
    Ea: TEdit;
    Eb: TEdit;
    Ec: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    BZeichnen: TButton;
    BLoeschen: TButton;
    BZufall: TButton;
    LScheitelpunkt: TLabel;
    BScheitelpunkt: TButton;
    Label4: TLabel;
    BNullstellen: TButton;
    Label5: TLabel;
    LNullstellen: TLabel;
    BTrainer: TButton;
    BUeberpruefung: TButton;
    LAusgabe: TLabel;
    BAbleitung: TButton;
    BWertetabelle: TButton;
    PTabelle: TPanel;
    SGTabelle: TStringGrid;
    BTabEnde: TButton;
    procedure BSchliessenClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure EaExit(Sender: TObject); {Überträgt die Werte des Editfeldes in die Variable}
    procedure EbExit(Sender: TObject);
    procedure EcExit(Sender: TObject);
    procedure BZeichnenClick(Sender: TObject);
    procedure BLoeschenClick(Sender: TObject);
    procedure BZufallClick(Sender: TObject);
    procedure BScheitelpunktClick(Sender: TObject);
    procedure BNullstellenClick(Sender: TObject);
    procedure BUeberpruefungClick(Sender: TObject);
    procedure BTrainerClick(Sender: TObject);
    procedure BAbleitungClick(Sender: TObject);
    procedure ImParabelMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure ImParabelMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure BTabEndeClick(Sender: TObject);
    procedure BWertetabelleClick(Sender: TObject);
  private
    a, b, c: real; {Koeefizienten der Parabel}
    aa, bb, cc: real;
    dx, dy: integer; {Pixel pro Einheit auf den Achsen}
    x0, y0: integer;
    groesse: integer;
    function f(x:real):real;
    procedure Kreuz;
    function bildxtox(bildx: integer):real; {wandelt Bildschirmkoordinate in}
    function bildytoy(bildy: integer):real; {reale Koodrdinaten um}
    function xtobildx(x: real): integer; {wandelt reale Koodrdinaten in}
    function ytobildy(y: real): integer; {Bildschirmkoordinate um}
    procedure ZeichneParabel;
  public
    procedure BerechneScheitelpunkt(Sa,Sb,Sc: real; var Sx,Sy: real);
    procedure BerechneNullstelle(Na,Nb,Nc: real; var L1,L2: real; var loesbar: boolean);
end;

var
  FParabel: TFParabel;

implementation

{$R *.DFM}

procedure TFParabel.BSchliessenClick(Sender: TObject);
begin
  close;
end;

procedure TFParabel.FormActivate(Sender: TObject);
begin
  ImParabel.canvas.pen.mode:=pmCopy;
  a:=1; b:=0; c:=0;
  groesse:=5;
  dx:=ImParabel.width div 10;
  dy:=ImParabel.height div 10;
  x0:=ImParabel.width div 2;
  y0:=ImParabel.height div 2;
  Kreuz;
end;

procedure TFParabel.Kreuz;
var x,y: integer;
    i: integer; diff: integer;
begin
  ImParabel.canvas.moveto(ImParabel.width div 2,0);
  ImParabel.canvas.lineto(ImParabel.width div 2,ImParabel.height);
  ImParabel.canvas.moveto(0,ImParabel.height div 2);
  ImParabel.canvas.lineto(ImParabel.width,ImParabel.height div 2);
  diff:=groesse div 10 +1;
  if (diff>1) and (groesse mod diff <>0)
    then repeat inc(diff); until (groesse mod diff =0);
  x:=0;
  y:=Imparabel.height div 2;
  i:=-groesse;
  repeat
    if i<>0
      then
        begin
          ImParabel.canvas.moveto(x,y+4);
          ImParabel.canvas.lineto(x,y-4);
          ImParabel.canvas.textout(x+2,y+5,inttostr(i));
        end;
      i:=i+diff;
      x:=x+diff*dx;
    until i>=groesse;
  x:=ImParabel.width div 2;
  y:=0;
  i:=groesse;
  repeat
    if i<>0
      then
        begin
          ImParabel.canvas.moveto(x-4,y);
          ImParabel.canvas.lineto(x+4,y);
          ImParabel.canvas.textout(x+5,y+2,inttostr(i));
        end;

    i:=i-diff;
    y:=y+diff*dy;
  until i<=-groesse;
end;

procedure TFParabel.EaExit(Sender: TObject);
begin
  a:=strtofloat(Ea.text);
end;

procedure TFParabel.EbExit(Sender: TObject);
begin
  b:=strtofloat(Eb.text);
end;

procedure TFParabel.EcExit(Sender: TObject);
begin
  c:=strtofloat(Ec.text);
end;

function TFParabel.f(x:real):real;
begin
  f:=a*sqr(x)+b*x+c;
end;

function TFParabel.bildxtox(bildx: integer):real;
begin
  bildxtox:=(bildx-x0)/dx;
end;

function TFParabel.bildytoy(bildy: integer):real;
begin
  bildytoy:=(x0-bildy)/dy;
end;

function TFParabel.xtobildx(x: real): integer;
begin
  xtobildx:=round(x*dx+x0);
end;

function TFParabel.ytobildy(y: real): integer;
begin
  ytobildy:=round(-y*dy+y0);
end;

procedure TFParabel.ZeichneParabel;
var
  x,y: real;
begin
  x:=-groesse;
  y:=f(x);
  ImParabel.canvas.moveto(xtobildx(x),ytobildy(y));
  repeat
    x:=x+0.1;
    y:=f(x);
    ImParabel.canvas.lineto(xtobildx(x),ytobildy(y));
  until x>=groesse;
end;

procedure TFParabel.BZeichnenClick(Sender: TObject);
var
  x,y: real;
  ok: boolean;
  x1,x2: real;
begin
  ZeichneParabel;
  BerechneScheitelpunkt(a,b,c,x,y);
  LScheitelpunkt.caption:='('+floattostrf(x,ffFixed,4,2)+'|'+floattostrf(y,ffFixed,4,2)+')';
  BerechneNullstelle(a,b,c,x1,x2,ok);
  if ok
    then
      LNullstellen.caption:='('+floattostrf(x1,ffFixed,4,2)+'|'+floattostrf(x2,ffFixed,4,2)+')'
    else
      LNullstellen.caption:='Keine Lösung';
end;

procedure TFParabel.BLoeschenClick(Sender: TObject);
begin
  ImParabel.canvas.brush.style:=bsSolid;
  ImParabel.canvas.brush.color:=clWhite;
  ImParabel.canvas.rectangle(0,0,ImParabel.width,Imparabel.height);
  Kreuz;
end;

procedure TFParabel.BZufallClick(Sender: TObject);
var
  x,y: real;
  ok: boolean;
  x1,x2: real;
begin
  randomize;
  a:=random(6)-3;
  if (random(2)=1) and (a<>0) then a:=1/a;
  b:=random(6)-3;
  c:=random(6)-3;
  Ea.text:=floattostrf(a,ffFixed,5,2);
  Eb.text:=floattostr(b);
  Ec.text:=floattostr(c);
  ZeichneParabel;
  BerechneScheitelpunkt(a,b,c,x,y);
  LScheitelpunkt.caption:='('+floattostrf(x,ffFixed,4,2)+'|'+floattostrf(y,ffFixed,4,2)+')';
  BerechneNullstelle(a,b,c,x1,x2,ok);
  if ok
    then
      LNullstellen.caption:='('+floattostrf(x1,ffFixed,4,2)+'|'+floattostrf(x2,ffFixed,4,2)+')'
    else
      LNullstellen.caption:='Keine Lösung';
end;

procedure TFParabel.BerechneScheitelpunkt(Sa,Sb,Sc: real; var Sx,Sy: real);
begin
  if Sa<>0
    then
      begin
        Sx:=-Sb/(2*Sa);
        Sy:=f(Sx); {ruft f auf, um den y-Wert berechnet}
      end;
end;

procedure TFParabel.BScheitelpunktClick(Sender: TObject);
var x,y: real;
begin
  BerechneScheitelpunkt(a,b,c,x,y);
  LScheitelpunkt.caption:='('+floattostrf(x,ffFixed,4,2)+'|'+floattostrf(y,ffFixed,4,2)+')';
end;

procedure TFParabel.BerechneNullstelle(Na,Nb,Nc: real; var L1,L2: real; var loesbar: boolean);
var
  diskriminante: real;
begin
  loesbar:=true;
  if Na=0 {lineare Gleichung}
    then
      if Nb=0  {Konstante}
        then
          loesbar:=false
        else
          begin
            L1:=-Nc/Nb; {nur eine Lösung}
            L2:=-Nc/Nb;
          end
    else                {Quadratische Gleichung}
      begin
        diskriminante:=(Nb*Nb)/(4*Na*Na)-Nc/Na;
        if diskriminante > 0
          then
            begin
              L1:=-Nb/(2*Na)+sqrt(diskriminante);
              L2:=-Nb/(2*Na)-sqrt(diskriminante);
            end
          else
            loesbar:=false;
      end;
end;

procedure TFParabel.BNullstellenClick(Sender: TObject);
var
  ok: boolean;
  x1,x2: real;
begin
  BerechneNullstelle(a,b,c,x1,x2,ok);
  if ok
    then
      LNullstellen.caption:='('+floattostrf(x1,ffFixed,4,2)+'|'+floattostrf(x2,ffFixed,4,2)+')'
    else
      LNullstellen.caption:='Keine Lösung';
end;

procedure TFParabel.BUeberpruefungClick(Sender: TObject);
begin
  if (abs(aa-strtofloat(Ea.text)) < 0.1) and
     (abs(bb-strtofloat(Eb.text)) < 0.1) and
     (abs(cc-strtofloat(Ec.text)) < 0.1)
    then LAusgabe.caption:='Richtig'
    else LAusgabe.caption:='Falsch';
end;

procedure TFParabel.BTrainerClick(Sender: TObject);
begin
  BLoeschenclick(Sender);
  randomize;
  a:=random(6)-3;
  if (random(2)=0) and (a<>0) then a:=1/a;
  if (random(2)=1) and (a<>0) then a:=1/a;
  b:=random(6)-3;
  c:=random(6)-3;
  Ea.text:='0';
  Eb.text:='0';
  Ec.text:='0';
  ZeichneParabel;
  aa:=a;
  bb:=b;
  cc:=c;
end;

procedure TFParabel.BAbleitungClick(Sender: TObject);
begin
  c:=b;
  b:=2*a;
  a:=0;
  Ea.text:='0';
  Eb.text:=floattostr(b);
  Ec.text:=floattostr(c);
  ZeichneParabel;
end;

procedure TFParabel.ImParabelMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
  if abs(x-x0) < 4
    then ImParabel.cursor:=crvsplit
    else
      if abs(y-y0) < 4
        then ImParabel.cursor:=crhsplit
        else ImParabel.cursor:=crdefault;
end;

procedure TFParabel.ImParabelMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if not ImParabel.cursor <> crdefault
    then
      begin
        if Button = mbLeft
          then
            groesse:=2*groesse;
        if (Button =mbRight) and (groesse>=1.0)
          then
            groesse:=round(groesse/2);
        dx:=ImParabel.width div (2*groesse);
        dy:=ImParabel.height div (2*groesse);
        BLoeschenclick(Sender);
        Kreuz;
        ZeichneParabel;
      end;
end;

procedure TFParabel.BTabEndeClick(Sender: TObject);
begin
  PTabelle.visible:=false;
end;


procedure TFParabel.BWertetabelleClick(Sender: TObject);
var
  x: integer;
  y: real;
begin
  PTabelle.visible:=true;
  SGTabelle.cells[0,0]:='x';
  SGTabelle.cells[1,0]:='y';
  SGTabelle.rowcount:=2*groesse+2; {ANzahl der Elemente}
  for x:=-groesse to groesse do
    begin
      y:=f(x);
        SGTabelle.cells[0,x+groesse+1]:=floattostr(x);
        SGTabelle.cells[1,x+groesse+1]:=floattostrf(y,ffFixed,5,2);
    end;
end;

end.
Viel Spaß damit, das ist schon sehr weit entwickelt. Musste nur noch verstehen und auf alle Funktionen (Nicht nur auf Parabeln) anwendbar machen!

s.carter 15. Jan 2004 11:33

Re: koordinatensystem in delphi
 
man cool, :dancer: vielen vielen dank! super! :dancer2:

klar, wir müssen ja auch aufpassen, wär ja betrug, wenn wir einfach nen fertiges programm nehmen und darauf ne note kriegen würden. :warn:

wir nehmen dein prog einfach als hilfe und anregung. :hi:
also nochmals vielen, vielen dank. :hello:

wir machen jetzt hier mal weiter,
bis bald,
mfg benny!:corky:

ps: nochmal thx!! :cheers:


Alle Zeitangaben in WEZ +1. Es ist jetzt 02:39 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz