Muszerskala feliratozo program

[Moczik Gabor]

norbimagan wrote:
> Szia Gabor!
> 
>>Legutobb egy pascal programot gyartottam egy adott skala (csak a
> 
> vonalak) 
> 
>>generalasahoz. PrintScreen gomb, aztan Paint-be beillesztes, es ott 
>>feliratoztam a szamokat meg szovegeket.
> 
> Ez se rossz megoldas, ha nincs komplett util erre. El lehet kerni a
> progidat? Esetleg masokat is erdekelhet, szerintem erdemes lenne
> feltenni FTP-re, ha odaadhato. :)

Na, bocs hogy a listara megy, de most nincs idom FTP-zni ezert, meg amugy 
sem hosszu. Egy konkret skala rajzolasara keszult, ha imsered a pascal-t, 
percek alatt atalakithatod sajat igenyeid szerint...


--------- cut -----------
uses crt,graph;

var
   gd,gm          :integer;
   wmm,pxm,r,mar  :real;
   deg,sdg,xdg    :real;
   wpx,cx,cy      :word;
   ax,ay,bx,by    :word;

   i,j,k          :integer;

function arcsin(x :real) :real;
begin
   arcsin:=arctan(x/sqrt(1-sqr(x)))
end;

function arccos(x :real) :real;
begin
   arccos:=arctan(sqrt(1-sqr(x))/x);
end;


begin
   gd:=VGA;
   gm:=VGAhi;
   initgraph(gd,gm,'d:\bp\bgi');
   setbkcolor(0);
   wpx:=420;                  { width in pixel }
   wmm:=70;                   { width in mm }
   pxm:=wpx/wmm;              { pixel/mm }
   r:=43;                     { scale radius }
   mar:=6;                    { scale margin }

   setcolor(15);
   rectangle(0,0,wpx-1,wpx-1);
   i:=trunc(14*pxm);
   line(0,i,i,0);
   line(wpx-i-1,0,wpx-1,i);

   cx:=trunc(wpx/2);
   cy:=trunc(wpx-12.5*pxm);
   line(cx-5,cy,cx+5,cy);
   line(cx,cy-5,cx,cy+5);

   deg:=2*arcsin((wmm/2-mar)/r);
   sdg:=-deg/2+pi;

   arc(cx,cy,trunc(90-deg/pi*90),trunc(90+deg/pi*90),trunc(r*pxm));

   for i:=0 to 50 do
   begin
     xdg:=sdg+i*deg/50;
     if (i mod 5)=0 then j:=4 else j:=2;
     ax:=trunc(r*pxm*sin(xdg)+cx);
     ay:=trunc(r*pxm*cos(xdg)+cy);
     bx:=trunc((r+j)*pxm*sin(xdg)+cx);
     by:=trunc((r+j)*pxm*cos(xdg)+cy);
     line(ax,ay,bx,by);
   end;

   readkey;
   closegraph;
end.
--------- cut -----------


-- 
((( Móczik Gábor )))--((( hu <- DOT <- freemail <- AT <- progzmaster )))
((( Debian unstable )))-((( Kernel 2.4.20 )))-((( Celeron466 / 128Mb )))
((( -->  Vigyázat! Ön súlyos közlekedési balesetet szenvedett.   <-- )))
((( -->          Kívánja, hogy a légzsák felfúvódjon?            <-- )))