Informatika gyűjtemény

oszlop.pas (Vissza)

Az alábbi letöltési lehetőségek közül választhatsz: (segítség)

	Karakterkódolás:
	Sortörés:

Típus: text/plain
Tartalmaz szöveget
Karakterkódolás: utf-8
Méret: 1 KB

program oszlop;
uses graph;
const

        N = 500;
        M = 30;
        p = 0.6;

        {világ}
        vb = -1;
        vj = M+1;
        va = -1;
        vf = N/3;

        {kép}
        kb = 50;
        ka = 650;
        kf = 50;
        kj = 650;

function vkx(x:double):integer;
var lambda : double;
begin
    lambda := (x-vb)/(vj-vb);
    vkx := round((1-lambda)*kb+lambda*kj);
end;

function vky(y:double):integer;
var lambda : double;
begin
    lambda := (y-va)/(vf-va);
    vky := round((1-lambda)*ka+lambda*kf);
end;

procedure vonal(x1,y1,x2,y2:double);
var kx1,kx2,ky1,ky2 : integer;
begin
    kx1 := vkx(x1); kx2 := vkx(x2);
    ky1 := vky(y1); ky2 := vky(y2);
    line(kx1,ky1,kx2,ky2);
end;

var t : array[0..M] of word;
    gd,gm : integer;

procedure init;
var i,j,k : integer;
begin
    randomize;

    for i := 0 to M do t[i] := 0;
    for i := 1 to N do
    begin
        j := 0;
        for k := 1 to M do
            if random < p then inc(j);
        inc(t[j]);
    end;


end;

procedure oszlop(i : integer);
begin
    vonal(i-0.5,0,i+0.5,0);
    vonal(i+0.5,0,i+0.5,t[i]);
    vonal(i-0.5,t[i],i+0.5,t[i]);
    vonal(i-0.5,0,i-0.5,t[i]);
end;

procedure oszlopok;
var i : integer;
begin
    for i := 0 to M do oszlop(i);
end;

BEGIN
detectgraph(gd,gm);
initgraph(gd,gm,'');

    init;
    oszlopok;

readln;
closegraph;
END.

(Vissza)