Rysowanie wykresu funkcji po ukosie

0

Witam,
Zrobiłem sobie coś takiego:

procedure Tforma.wykresPaint(Sender: TObject);
var mx, my, wx, wy: integer;
    i: integer;
    errorinlast: boolean;
const border = 10;
begin
     with wykres do
          begin
               // Obliczanie grubości
               mx := (Width - border*2) div 2;
               my := (Height - border*2) div 2;
               // Obliczanie wielkości
               wx := mx div FFunctionVisibleRange;
               wy := my div FFunctionVisibleRange;

    with Canvas do
    begin
         // Wyczyszczenie wykresu
         brush.Color := clWhite;
         FillRect(ClientRect);

         // Rysowanie
         pen.Color := clBlack; // Czarny kolor dla wykresu
         MoveTo(border, my + border);
         LineTo(wykres.Width-border, my + border);
         MoveTo(border + mx, border);
         LineTo(border + mx, wykres.Height-border);
      for i := -FFunctionVisibleRange to FFunctionVisibleRange do
          begin
               if (i = 0) or ((FFunctionVisibleRange >= 10) and (i mod (FFunctionVisibleRange div 10) <> 0)) then
                  begin
                       continue;
                  end;
               TextOut(border + mx + (i * wx) - (TextWidth(IntToStr(i)) div 2), border + my + 2, IntToStr(i));
        MoveTo(border + mx + (i * wx), border + my - 2);
        LineTo(border + mx + (i * wx), border + my + 2);
      end;

      for i := -FFunctionVisibleRange to FFunctionVisibleRange do
          begin
               if (i = 0) or ((FFunctionVisibleRange >= 10) and (i mod (FFunctionVisibleRange div 10) <> 0)) then
                  begin
                       continue;
                  end;
               TextOut(border + mx + 4, border + my - (i * wy) - (TextHeight(IntToStr(i)) div 2), IntToStr(i));
               MoveTo(border + mx + 2, border + my + (i * wy));
               LineTo(border + mx - 2, border + my + (i * wy));
      end;

      if AFuncTree = nil then
         begin
              Exit; // Zakończenie rysowania jeżeli AFuncTree jest puste
         end;

      try
         pen.Color := clBlue; // Niebieski kolor zaznacza funkcję
        try
           AFuncParser.ConstantValues['x'] := (FFunctionVisibleRange * 2) * 100;
           MoveTo(trunc(border + mx + int(-(FFunctionVisibleRange*2) * wx)), trunc(border + my + int(AFuncParser.CalcTree(AFuncTree) * wy)));
        except
              errorinlast := true;
        end;

        errorinlast := false;

        for i := -(FFunctionVisibleRange * 2) * 100 to (FFunctionVisibleRange * 2) * 100 do
            begin
                 try
                    AFuncParser.ConstantValues['x'] := i / 100;
                    if not errorinlast then
                       begin
                            LineTo(trunc(border + mx + (i / 100 * wx)), trunc(border + my - (AFuncParser.CalcTree(AFuncTree) * wy)));
                       end
                       else
                       begin
                            MoveTo(trunc(border + mx + (i / 100 * wx)), trunc(border + my - (AFuncParser.CalcTree(AFuncTree) * wy)));
                            errorinlast:=false;
                       end;
                 except
                       errorinlast := true;
                 end;
            end;
      except on e: EMathParserException do
             begin
                  AFuncParser.FreeTermTree(AFuncTree);
                  ShowMessage('(Błąd) '+e.ErrorDescription);
                  funkcja.SetFocus;
                  funkcja.SelStart:=e.ErrorPos-1;
                  funkcja.SelLength:=e.ErrorLength;
                  Exit;
             end;
      end;
    end;
  end;
end;

funkcja = wzór funkcji w polu TEdit
wykres = TPaintBox

Dalej główna procedura przycisku rysującego (pominąłem obliczanie funkcji itp.):

 try
     AFuncTree := AFuncParser.ParseTerm(funkcja.Text);
  except on e: EMathParserException do
         begin
              ShowMessage('(BŁĄD) ' + e.ErrorDescription);
              funkcja.SetFocus;
              funkcja.SelStart := e.ErrorPos-1;
              funkcja.SelLength := e.ErrorLength;
         end;
  end;

  if AFuncParser.ParseError = mpeNone then
     begin
          wykres.Repaint;
     end
     else
     begin
          AFuncParser.FreeTermTree(AFuncTree);
     end;

Wszystko działa wporządku, ale mój program potrafi jedynie rysować wykres funkcji w linii prostej (z czego i tak jestem dumny, bo nie pytałem się nikogo jak to zrobić) i teraz moje pytanie - jeżeli funkcja jest taka, że wykresem musi być linia prosta, ale ukośna, to jak to zrobić?

PS: wszystkie obiekty "Parser" to utworzone w OnCreate obiekty z modułu parsera matematycznego

0

A próbowałeś komponentu Chart? Jest on dostępny od wersji 4.0. wybierasz styl wykresu liniowy i rysujesz. To nic prostrzego. Weźmy np wykres funkcji y=sin(x). Wiadomo, że musimy użyć aproksymacji, której wielkość jest uzależniona od szybkości komputera. Mając komponent Chart możesz narysować wykres owej funkcji (każdej zresztą, bo ogólny wzór to y=f(x)). Poza tym, naskrobałem troszeczkę mniej skomplikowany kod (może Ci się przyda):

procedure TForm1.FormCreate(Sender: TObject);
var i :Word;
begin
 for i := 1 to 36 do
  Series1.AddY(sin(i*180/PI));
end;

Kewstia przeskalowania wykresu, ale nawet teraz widać, że owa funkcja przypomina sinusoidę. Poniżej zamiszczam również programik Sinusy napisany w TP. Popatrz i porównaj

PROGRAM Sinusy;

USES Crt, Graph;

CONST
 MargX  = 60;
 MargY  = 30;
 MaxPkt = 1000;

VAR
 WartXY       :ARRAY [0..MaxPkt] OF PointType;
 Wartosci     :ARRAY [0..MaxPkt] OF Real;
 Maksimum     :Integer;
 ZakresX      :Integer;
 X0,Y0, Xm,Ym :Integer;
 Kursor       :Pointer;
 RozmKursora  :Word;

PROCEDURE PowrotPionowy; ASSEMBLER;
ASM
   MOV   DX, 3DAh
 @@1:                     { jest powrot    }
   IN    AL, DX
   TEST  AL, 00001000b
   JNZ   @@1
 @@2:                     { nie ma powrotu }
   IN    AL, DX
   TEST  AL, 00001000b
   JZ    @@2
END; { PowrotPionowy }

PROCEDURE Start;
VAR Driver, Tryb :Integer;
BEGIN
 Driver := Detect;
 InitGraph(Driver, Tryb, 'C:\PASCAL\BGI');
 Xm := GetMaxX;
 Ym := GetMaxY;
 Line(0,6, 20,6);
 Line(10,0, 10,12);
 Circle(10,6, 6);
 RozmKursora := ImageSize(0,0, 20,12);
 GetMem(Kursor, RozmKursora);
 GetImage(0,0, 20,12, Kursor^);
 PutImage(0,0, Kursor^, XorPut);
END;

FUNCTION Zlozenie(x :Real) :Real;
BEGIN
 Zlozenie := sin(3*x) * cos(1.5*x) * sin(6*x) + 2*cos(10*x) * sin(2.5*x);
END;

PROCEDURE ObliczFunkcje;
CONST WartMax :Real = 0.0;

VAR i  :Integer;
    dx :Real;
BEGIN
 ZakresX := Xm - MargY;
 dx := 2*PI / (Xm - MargY);
 FOR i := 0 TO ZakresX DO
  BEGIN
   Wartosci[i] := Zlozenie(dx * i);
   IF Wartosci[i] > WartMax THEN WartMax := Wartosci[i];
  END;
 Maksimum := Trunc(WartMax)+1;
END;

PROCEDURE Ramka;
VAR i, j     :Integer;
    x, y     :Integer;
    lxm, lym :Integer;
    s        :STRING[80];
BEGIN
 ClearViewPort;
 lxm := Xm-MargY;
 lym := Ym-MargX;
 SetColor(LightGray);
 Rectangle(0,0, lxm,lym);
 SetTextJustify(CenterText, CenterText);
 SetLineStyle(DottedLn, 0, NormWidth);
 FOR i := 1 TO 11 DO
  BEGIN
   x := Round(i*lxm/12);
   Line(x,1, x,lym);
  END;
 OutTextXY(5, lym+10, '0');
 OutTextXY(lxm DIV 2, lym+10, '180');
 OutTextXY(lxm, lym+10, '360');
 FOR i := 0 TO 2*Maksimum DO
  BEGIN
   y := Round(i*lym/2/Maksimum);
   Line(1,y, lxm,y);
   Str(Maksimum-i:4, s);
   OutTextXY(lxm+10,Round((y+10)/1.05), s);
  END;
 y := Round(lym/2);
 SetLineStyle(SolidLn, 0, NormWidth);
 Line(0,y, lxm,y);
 SetTextJustify(LeftText, BottomText);
END;

PROCEDURE KreslWykres;
VAR i :Integer;
BEGIN
 SetColor(LightGreen);
 FOR i := 0 TO ZakresX DO
  WITH WartXY[i] DO
   BEGIN
    x := i+2;
    y := Round((Maksimum-Wartosci[i])/Maksimum*(Ym-MargX)/2);
   END;
 DrawPoly(ZakresX, WartXY);
END;

PROCEDURE KreslKursor(x :Integer);
BEGIN
 WITH WartXY[x] DO
  PutImage(X-10,y-6, Kursor^, XorPut);
END;

PROCEDURE PiszWartosci(x :Integer);
VAR s1, s2 :STRING[80];
BEGIN
 Str(x/ZakresX*360:8:4, s1);
 Str(Wartosci[x]:8:4, s2);
 s1 := 'x= '+s1+'  y= '+s2;
 SetColor(YELLOW);
 SetViewPort(0,Ym-9, TextWidth(s1), Ym, ClipOff);
 PowrotPionowy;
 ClearViewPort;
 OutTextXY(0,9, s1);
 SetViewPort(0,0, Xm, Ym, ClipOff);
END;

PROCEDURE Badanie;
CONST kb_LEFT  = #75;
      kb_RIGHT = #77;
      kb_ESC   = #27;

VAR ch :Char;
    x  :Integer;
BEGIN
 x := ZakresX DIV 2;
 KreslKursor(x);
 REPEAT
  ch := ReadKey;
  IF ch = #0 THEN ch := ReadKey;
  KreslKursor(x);
  CASE ch OF
   kb_LEFT  :Dec(x);
   kb_RIGHT :Inc(x);
  END;
  KreslKursor(x);
  PiszWartosci(x);
 UNTIL ch = kb_ESC;
END;

PROCEDURE Stop;
BEGIN
 ClearDevice;
 CloseGraph;
 FreeMem(Kursor, RozmKursora);
END;

BEGIN
 Start;
 ObliczFunkcje;
 Ramka;
 KreslWykres;
 Badanie;
 Stop;
END.
0

Całkiem wporządku, ale niestety mam moduł MathParser i muszę z niego skorzystać, za dużo już w nim nagrzebałem i wszystko działa jak należy prócz tego wykresu po ukosie. To musi być coś z moją procedurą rysującą na PaintBoxie, bo tam wszystko robiłem liniowo i nie mam pojęcia jak to urozmaicić.
Tak czy siak dzięki ;)

0

nie jestem pewien czy dobrze rozumiem. fizycznie wyglądałoby to tak że obracasz kartkę o np 15 stopni w dół przyjmując lewy górny róg za początek układu, a następnie rysujesz wykres liniowo ?
jeśli tak, to myślę że rysowanie należy zostawić tak jak jest, tylko przed naniesieniem punktu na canvas trzeba by go właśnie jeszcze obrócić.

0

Chyba mój problem nie tkwi w samym rysowaniu, a w ... wzorze funkcji. Program mój działa tak, że oblicza już y = ax + b i w wyniku y jest już jakąś liczbą, więc wykres rysowany jest poprawnie - linia prosta, pozioma. Próbowałem podać na sztywno wzór "3x + 4" (jako przykład), ale parser rzucał się, że niepoprawny dla niego jest "x", bo nie jest liczbą. W takim razie parser jest nieco bez sensu, bo nie pozwala podać normalnego wzoru do obliczenia. Mimo to muszę coś z tym zrobić.
W temacie:
http://4programmers.net/Forum/296612
podałem link do kodu parsera. Jeżeli ktoś mógłby rzucić okiem to będę bardzo wdzięczny. Program mam oddać za darmo pewnej osobie, która go potrzebuje do końca maja.

0

Kurcze co to za forum, że sam sobie rozwiązałem problem? :D
Dzięki BatSk8, działa! :D

1 użytkowników online, w tym zalogowanych: 0, gości: 1