home *** CD-ROM | disk | FTP | other *** search
/ Chip 1997 October / Chip_1997-10_cd.bin / tema / sw602 / wintext / disk1 / data.1 / MALOVANI.TXT < prev    next >
Text File  |  1997-04-24  |  4KB  |  167 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.   klik_str    =  "Klikni nebo stiskni klávesu...";
  9.   final_str   = "Konec makra";
  10.  
  11. type POINT =
  12.   record
  13.      x, y : integer
  14.   end;
  15. type PPOINT   = ^POINT;
  16. type Hwnd     = integer;
  17. type Hdc      = integer;
  18. type Handle   = integer;
  19.  
  20. type str100 = string[100];
  21.  
  22. function SetWindowPos(h_wnd, h_wnAfter: Hwnd; x, y, cx, cy,
  23. flags: integer): boolean;
  24.   external 'USER32.DLL' name 'SetWindowPos';
  25. function ShowWindow(h_wnd: Hwnd; cmd: integer): boolean;
  26.   external 'USER32.DLL' name 'ShowWindow';
  27. function GetCurrentTime: integer;
  28.   external 'USER32.DLL' name 'GetCurrentTime';
  29. function GetInputState: boolean;
  30.   external 'USER32.DLL' name 'GetInputState';
  31. function GetActiveWindow: Hwnd;
  32.   external 'USER32.DLL' name 'GetActiveWindow';
  33. function GetWindowDC(h_wnd: Hwnd): integer;
  34.   external 'USER32.DLL' name 'GetWindowDC';
  35. function ReleaseDC(h_wnd: Hwnd; dc: Hdc): integer;
  36.   external 'USER32.DLL' name 'ReleaseDC';
  37.  
  38. function TextOut(h_dc: Hdc; x, y: integer; var s: const str100;
  39. len: integer): boolean;
  40.   external 'GDI32.DLL' name 'TextOutA';
  41. function CreatePen(penStyle, width, crColor: integer): integer;
  42.   external 'GDI32.DLL' name 'CreatePen';
  43. function DeleteObject(hObject: Handle): boolean;
  44.   external 'GDI32.DLL' name 'DeleteObject';
  45. function SelectObject(dc: Hdc; hGdiObj: Handle): integer;
  46.   external 'GDI32.DLL' name 'SelectObject';
  47. function MoveToEx(dc: Hdc; x, y: integer; lppoint: PPOINT):
  48. boolean;
  49.   external 'GDI32.DLL' name 'MoveToEx';
  50. function LineTo(dc: Hdc; x, y: integer): boolean;
  51.   external 'GDI32.DLL' name 'LineTo';
  52.  
  53. var
  54.   i, j, is, js, k, l: integer;
  55.   seed: integer;
  56.   str: str100;
  57.   d_start: date;
  58.   t_start: time;
  59.   wnd: Hwnd;
  60.   dc: Hdc;
  61.   hpen, hpenOld: Handle;
  62.  
  63.  
  64.  
  65. function Random(mez: short): short;
  66. const
  67.   c1 = 13849;
  68.   c2 = 27181;
  69.   c3 = 65536;
  70. var
  71.   pom: integer;
  72. begin
  73.   seed:= (c1 + (c2 * seed)) mod c3;
  74.   pom:= Round(seed / (65536 / mez));
  75.   if pom = 0 then pom:= 1;
  76.   Random:= pom;
  77. end;
  78.  
  79. function RGB(r,g,b: short): integer;
  80. begin
  81.   RGB:= (b*256 + g)*256 + r;
  82. end;
  83.  
  84. function konec: boolean;
  85. const
  86.   Miliseconds = 3000;
  87.  
  88. var
  89.   dt: date;
  90.   tm: time;
  91.   limit: boolean;
  92. begin
  93.   dt:= Today;
  94.   tm:= Now;
  95.   limit:= Day(dt) <> Day(d_start);
  96.   if not limit then
  97.     limit:= tm - t_start > Miliseconds;
  98.   konec:= limit and GetInputState;
  99.  end;
  100.  
  101. begin
  102.   d_start:= Today;
  103.   t_start:= Now;
  104.   seed:= Seconds(t_start);
  105.  
  106.   wnd:= GetActiveWindow;
  107.   dc:= GetWindowDC(wnd);
  108.   hpen:= CreatePen(0, Random(penwidth),
  109.             RGB(Random(255), Random(255), Random(255)));
  110.   hpenOld:= SelectObject(dc, hpen);
  111.  
  112.   k:= 0;
  113.   i:= 10;
  114.   j:= 10;
  115.   is:= Random(uroven);
  116.   js:= Random(uroven);
  117.  
  118.   repeat
  119.  
  120.     if (i + is > 640) or (i + is < 0) then
  121.     begin
  122.       SelectObject(dc, hpenOld);
  123.       DeleteObject(hpen);
  124.       hpen:= CreatePen(0, Random(penwidth),
  125.                  RGB(Random(255), Random(255), Random(255)));
  126.       hpenOld:= SelectObject(dc, hpen);
  127.       if is > 0
  128.         then is:= -Random(uroven)
  129.         else is:= Random(uroven);
  130.     end;
  131.  
  132.     if (j + js > 480) or (j + js < 0) then
  133.     begin
  134.       SelectObject(dc, hpenOld);
  135.       DeleteObject(hpen);
  136.       hpen:= CreatePen(0, Random(penwidth),
  137.                 RGB(Random(255), Random(255), Random(255)));
  138.       hpenOld:= SelectObject(dc, hpen);
  139.       if js > 0
  140.         then js:= -Random(uroven)
  141.         else js:= Random(uroven);
  142.     end;
  143.  
  144.     MoveToEx( dc, i, j, NIL);
  145.     inc(i, is);
  146.     inc(j, js);
  147.     LineTo( dc, i, j);
  148.  
  149.     inc(k);
  150.     if (k mod opakovani = 0) and not GetInputState then
  151.     begin
  152.       str := klik_str;
  153.       TextOut(dc, Random(600), Random(400), str, Strlength(str));
  154.     end;
  155.  
  156.   until konec;
  157.  
  158.   SelectObject(dc, hpenOld);
  159.   DeleteObject(hpen);
  160.   ReleaseDC(wnd, dc);
  161. /*
  162.   SetWindowPos(wnd, 1,0,0,0,0, 1 or 2);
  163.   SetWindowPos(wnd, 0,0,0,0,0, 1 or 2 or 64);*/
  164.   ShowWindow(wnd, 2);
  165.   ShowWindow(wnd, 3);
  166.   Info_box("", final_str);
  167. end.