DUzun's Web
Programare, proiecte personale, divertisment

Unit GrpSdk;

Interface

Uses Graph,SDKKrnl,crt,keyboard,mouse;

​

var i,j,h:integer;

    ex,ey,mx,my:integer;

    Page:boolean;

    cl:array[0..25] of dword;

    fer:record uw,uh,x1,x2,y1,y2:integer;gr:byte;c:array[domen,domen]of dword;

    cs:array[domen,domen]of dom0;end;

    key: byte;

​

Function Keypress:boolean;

procedure drmouse(x,y:word);

procedure init(way:byte);

procedure ChangePage;

Function tex(s:longint):string;

Procedure PCs(x,y,z:byte;cl:word);

Procedure Fereastra(cl:dword);

Procedure atcl(cl:dword);

Procedure transfer(t:Tsdk);

Procedure Delete;

Procedure Done;

​

Implementation

​

   Function Keypress:boolean;

var i:byte;

 begin

   Keypress:=false;i:=0;

   while not testkey(i)and(i<255) do inc(i);

   Keypress:=testkey(i);

   if testkey(i) then key:=i;

 end;

​

  procedure drmouse(x,y:word);

begin

putpixel(x,y,cl[2]);

line(x,y-10,x,y-5);

line(x,y+10,x,y+5);

line(x-10,y,x-5,y);

line(x+10,y,x+5,y);

end;

​

 procedure init(way:byte);

begin

way:=way-1;

  Repeat

way:=way+1;

 case way of

1:SetSVGAMode(1280, 1024, 16, LfbOrBanked);

2:SetSVGAMode(800, 600, 16, LfbOrBanked);

3:SetSVGAMode(800, 600, 8, LfbOrBanked);

4:SetSVGAMode(640, 480, 32, LfbOrBanked);

5:SetSVGAMode(640, 480, 16, LfbOrBanked);

6:SetSVGAMode(640, 480, 8, LfbOrBanked);

 end;

  Until (GraphResult=0)or(way>6);

 If way>6 then writeln('Sorry, but there was an error while initializing graphic mode');

drawborder:=false;

mx:=getmaxx+1;my:=getmaxy+1;

ex:=mx div 2;ey:=my div 2;

SetTextJustify(CenterText, CenterText);

InitMouse;MultikeysInit;

HideMouse;

 SetMouseRange(0, 0, mx,my);

 SetWriteMode(XorPut);

 SetMousePos(ex,ey);

{OutTextXY(ex-100, ey-10, 'Please wait...'); }

end;

​

procedure ChangePage;

begin

  if Page then begin

    SetActivePage(0);SetVisualPage(1,true);

    Page:=false;

  end else begin

    SetActivePage(1);SetVisualPage(0,true);

    Page:=true;

  end;

  ClearPage;

end;

​

Function tex(s:longint):string;

var  c:string;

begin

str(s,c);tex:=c;

end;

​

Procedure PCs(x,y,z:byte;cl:word);

var ch:string[1];

begin

setcolor(cl);

with fer do begin

outtextxy(x1+(x-1)*uw+(uw) div 2,y1+(y-1)*uh+(uh) div 2,HexChr(z));

end;

end;

​

Procedure Fereastra(cl:dword);

 var i,j:byte;

    begin

setcolor(cl);

with fer do begin

gr:=4;

uw:=(x2-x1)div(nn);uh:=(y2-y1)div(nn);

x2:=x1+nn*uw;

y2:=y1+nn*uh;

rectangle(x1-gr div 2,y1-gr div 2,x2+gr div 2,y2+gr div 2);

rectangle(x1+gr div 2,y1+gr div 2,x2-gr div 2,y2-gr div 2);

for i:=1 to n-1 do begin

 line(x1+i*uw*n-gr div 2, y1,x1+i*uw*n-gr div 2, y2);

 line(x1+i*uw*n+gr div 2, y1,x1+i*uw*n+gr div 2, y2);

 line(x1, y1+i*uh*n-gr div 2, x2, y1+i*uh*n-gr div 2);

 line(x1, y1+i*uh*n+gr div 2, x2, y1+i*uh*n+gr div 2);

 for j:=1 to n do begin

  line(x1+((j-1)*n+i)*uw, y1, x1+((j-1)*n+i)*uw, y2);

  line(x1, y1+((j-1)*n+i)*uh, x2, y1+((j-1)*n+i)*uh);

 end;

end;

for i:=1 to nn do for j:=1 to nn do pcs(i,j,cs[i,j],c[i,j]);

end;

end;

​

   Procedure atcl(cl:dword);

begin

for i:=1 to nn do for j:=1 to nn do fer.c[i,j]:=cl;

end;

​

   Procedure Delete;

  var i,j,h:domen;

Begin

for i:=1 to nn do for j:=1 to nn do fer.cs[i,j]:=0;

End;

​

   Procedure transfer(t:Tsdk);

var i,j,h:domen;

 begin

  with t do

  for i:=1 to nn do for j:=1 to nn do with fer do

   begin

    cs[i,j]:= GetXY(i,j);

    c[i,j] := cl[val[i,j]];

   end;

 end;

​

Procedure Done;

begin

 MultikeysDone;

 donemouse;

 closegraph;

 halt(0);

end;

​

end.

​