home *** CD-ROM | disk | FTP | other *** search
/ Chip 1997 April / Chip_1997-04_cd.bin / tema / 602propc / disk12 / data.12 / WINTEXT / MAKRA / SOURCES / MALOVANI.TXT < prev    next >
Text File  |  1995-03-13  |  4KB  |  155 lines
  1. Program Malovani;
  2. // p°φklad pou₧itφ externφch funkcφ ze syst. knihoven Windows
  3.  
  4. const 
  5.   uroven = 99;
  6.   opakovani = 130;
  7.   penwidth = 50;
  8.  
  9. function MessageBox(x:short; var s,t:string[20]; y: short) : 
  10. short;
  11.   external 'USER.EXE' name 'MESSAGEBOX';
  12. function TextOut(x,y,z:short; var s:string[1]; v: short) : 
  13. short;
  14.   external 'GDI.EXE' name 'TEXTOUT';
  15. function SetWindowPos(u,v,w,x,y,z,zz:short) : short;
  16.   external 'USER.EXE' name 'SetWindowPos';
  17. function ShowWindow(u,v:short) : short;
  18.   external 'USER.EXE' name 'ShowWindow';
  19.  
  20. function GetCurrentTime : integer;
  21.   external 'USER.EXE' name 'GETCURRENTTIME';
  22. function GetInputState: short;
  23.   external 'USER.EXE' name 'GETINPUTSTATE';
  24. function GetActiveWindow : short;
  25.   external 'USER.EXE' name 'GETACTIVEWINDOW';
  26. function GetWindowDC(x:short) : short;
  27.   external 'USER.EXE' name 'GETWINDOWDC';
  28. function ReleaseDC(x,y:short) : short;
  29.   external 'USER.EXE' name 'RELEASEDC';
  30. function CreatePen(x, y, z : integer): short;
  31.   external 'GDI.EXE' name 'CREATEPEN';
  32. function DeleteObject(x: short): short;
  33.   external 'GDI.EXE' name 'DELETEOBJECT';
  34. function SelectObject(x, y: short): short;
  35.   external 'GDI.EXE' name 'SELECTOBJECT';
  36. function MoveTo(x,y,z: short): short;
  37.   external 'GDI.EXE' name 'MOVETO';
  38. function LineTo(x,y,z: short): short;
  39.   external 'GDI.EXE' name 'LINETO';
  40.  
  41. var 
  42.   d_start : date;
  43.   t_start : time;
  44.   hwnd, hdc, hpen, hpenOld : short;
  45.   i, j, is, js, k, l : short;
  46.   seed : integer;
  47.   s : string[20];
  48.  
  49. function Random(mez : short):short;
  50. const   
  51.   c1 = 13849;
  52.   c2 = 27181;
  53.   c3 = 65536;
  54. var 
  55.   pom : integer;
  56. begin
  57.   seed := (c1 + (c2 * seed)) mod c3;
  58.   pom := Round(seed / (65536 / mez));
  59.   if pom = 0 then pom := 1;
  60.   Random := pom;
  61. end;
  62.  
  63. function RGB(r,g,b : short): integer;
  64. begin
  65.   RGB := (b*256 + g)*256 + r;
  66. end;
  67.  
  68. function konec : boolean;
  69. const
  70.   Miliseconds = 3000;
  71.  
  72. var
  73.   dt : date;
  74.   tm : time;
  75.   limit : boolean;
  76. begin
  77.   dt := Today;
  78.   tm := Now;
  79.   limit := Day(dt) <> Day(d_start);
  80.   if not limit then 
  81.     limit := tm - t_start > Miliseconds;
  82.   if limit 
  83.     then konec := GetInputState <> 0
  84.     else konec := false;
  85. end;
  86.  
  87. begin
  88.   d_start := Today;
  89.   t_start := Now;
  90.   seed := Seconds(t_start);
  91.  
  92.   hwnd := GetActiveWindow;
  93.   hDC := GetWindowDC(hwnd);
  94.   hpen := CreatePen(0, Random(penwidth), 
  95.             RGB(Random(255), Random(255), Random(255)));
  96.   hpenOld := SelectObject(hDC, hpen);
  97.  
  98.   k := 0;
  99.   i := 10;
  100.   j := 10;
  101.   is := Random(uroven);
  102.   js := Random(uroven);
  103.  
  104.   repeat
  105.  
  106.     if (i+is>640) or (i+is<0) then
  107.     begin
  108.       SelectObject(hDC, hpenOld);
  109.       DeleteObject(hpen);
  110.       hpen := CreatePen(0, Random(penwidth), 
  111.                  RGB(Random(255), Random(255), Random(255)));
  112.       hpenOld := SelectObject(hDC, hpen);
  113.       if is > 0 
  114.         then is := -Random(uroven)
  115.         else is := Random(uroven);
  116.     end;
  117.  
  118.     if (j+js>480) or (j+js<0) then
  119.     begin
  120.       SelectObject(hDC, hpenOld);
  121.       DeleteObject(hpen);
  122.       hpen := CreatePen(0, Random(penwidth), 
  123.                 RGB(Random(255), Random(255), Random(255)));
  124.       hpenOld := SelectObject(hDC, hpen);
  125.       if js > 0 
  126.         then js := -Random(uroven)
  127.         else js := Random(uroven);
  128.     end;
  129.  
  130.     MoveTo( hDC, i, j);
  131.     i := i + is;
  132.     j := j + js;
  133.     LineTo( hDC, i, j);
  134.  
  135.     k := k + 1;
  136.     if (k mod opakovani = 0) and (GetInputState = 0) then
  137.     begin
  138.       TextOut(hDC, Random(600), Random(400),
  139.         "Klikni nebo stiskni klßvesu...", 30);
  140.     end;
  141.  
  142.  
  143.   until konec;
  144.  
  145.   SelectObject(hDC, hpenOld);
  146.   DeleteObject(hpen);
  147.   ReleaseDC(hwnd, hDC);
  148.  
  149. /*  SetWindowPos(hwnd, 1,0,0,0,0, 1 or 2);
  150.   SetWindowPos(hwnd, 0,0,0,0,0, 1 or 2 or 64);*/
  151.   ShowWindow(hwnd, 2);
  152.   ShowWindow(hwnd, 3);
  153.   MessageBox(0, "Konec makra", "Makro", 0 or 64 || 8192);
  154. end.
  155.