[pascal] Dobieranie odpowiedniej skali

0

Muszę napisać program do rysowania wykresu rzutu ukośnego. Mam problem z wyliczeniem odpowiedniej skali. Mam wyliczoną maksymalną wysokość jaką osiągnie rzucane ciało i muszę dobrać do tej liczby odpowiednią skalę. Np:
Dla 7.21 -> 10. dla 67.41 -> 70. Dla 541 -> 600. Dla 7624 -> 8000.
Chodzi o to, żeby skala dobierała się tak, że wykres nie będzie nigdy za mały ani za duży. Czyli, żeby liczba zaokrąglała się w górę do odpowiedniej wartości. Jak można takie coś napisać?

Już mi się udało to napisac, jakby się komuś kiedyś przydało, to tak to zrobiłem:

Function ZaokrSkale(Wysokosc: Real): Real;
Var
 J : Real;
Begin
 J := 1;
 While Wysokosc > 10 Do
 Begin
  J := J * 10;
  Wysokosc := Wysokosc / 10;
 End;
 ZaokrSkale := Round(Wysokosc + 0.5) * J;
End;
0

To proste. Zakładam, że:

  • rozdzielczość ekranu to 1024x768.

  • width = 1024

  • height = 768

  • Xmin = -100

  • Xmax = 100

  • Ymin = -200

  • Ymax = 300

Czyli teraz dzielenia.
1). Obliczasz długość osi, czyli

Xlen = Xmax - Xmin
Ylen = Ymax - Ymin

Jak masz długość ekranu i długość osi to dzielisz i wyjdą współczynniki

Xwsp = Screen.Width / Xlen
YWsp = Screen.height / Ylen

Potem ja rysujesz wykres to mnozysz otrzymane wartości przez współczynnik

Tu masz mój bardzo stary program do kreślenia wykresu funkcji (jeszcze w pascalu). Oblicza on sobie skalę.

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.

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