Eugeniusz Jakubas
programy źródłowe w Pascalu

Stąd można pobrać teksty źródłowe poniższych 57 programów w Pascalu pr-pascal.zip - 34 kB

21. Pola figur płaskich.

Program Pole_figury_plaskiej;
uses Graph;
var karta,tryb,x,y,k,n,bialy,czarny,siatka:integer;
    psw,psz:longint;
const czworokat:array[1..5,1..2] of integer=
    ((50,120),(400,100),(500,285),(210,420),(50,120));
    j:integer = 64;
begin
  karta:=vga; tryb:=vgaHi; initGraph(karta,tryb,'');
  fillPoly(4,czworokat);
  setColor(cyan);
  siatka:=16; psw:=0; psz:=0;
  for n:=0 to 440 div siatka do
  for k:=0 to 560 div siatka do
  begin
    bialy:=0;
    czarny:=0;
    for x:=k*siatka to (k+1)*siatka-1 do
    for y:=n*siatka to (n+1)*siatka-1 do
      if getPixel(x,y)=white then bialy:=1 else czarny:=1;
    rectangle(k*siatka-1,n*siatka-1,(k+1)*siatka-1,(n+1)*siatka-1);
    if (bialy=1) and (czarny=0) then
    begin
      inc(psw);
      setFillStyle(1,lightRed);
      bar(k*siatka,n*siatka,(k+1)*siatka-1,(n+1)*siatka-1);
    end;
    if (bialy=1) and (czarny=1) then
    begin
      inc(psz);
      setFillStyle(1,lightBlue);
      bar(k*siatka,n*siatka,(k+1)*siatka-1,(n+1)*siatka-1);
    end;
  end;
  setColor(black);
  drawPoly(5,czworokat);
  writeLn('P.s.z.=',(psz+psw)/j/j*siatka*siatka:6:4,
               '  P.s.w.=',psw/j/j*siatka*siatka:6:4);
  readLn; closeGraph;
end.