home *** CD-ROM | disk | FTP | other *** search
/ Chip Hitware 10 / Chip_Hitware_Vol_10.iso / chiphit / multmedi / 95licht / install.dll / 1001 / 1 / BLANKER.DPR < prev    next >
Text File  |  1997-04-04  |  7KB  |  254 lines
  1. {$A+,B-,C-,D+,E-,F-,G+,H-,I-,J+,K-,L+,M-,N+,O+,P-,Q-,R-,S-,T-,U-,V+,W-,X+,Y-,Z1}
  2. { $MINSTACKSIZE $00004000}
  3. { $MAXSTACKSIZE $00100000}
  4. {$APPTYPE GUI}
  5.  
  6. { $define INTERNAL}
  7. { $define DEBUG}
  8. { $define COL256}
  9.  
  10. {$ifdef INTERNAL}
  11. unit Blanker;
  12.  
  13. interface
  14.  
  15. uses WinTypes, LgdApi;
  16.  
  17. Function ScrInfo (var lisInfo: TLgdInfoStruct): bool; stdcall;
  18. Function ScrAbout (hwndParent: HWND): bool; stdcall;
  19. Function ScrInit (var mdModuleData: TModuleData): bool; stdcall;
  20. Procedure ScrDone (var mdModuleData: TModuleData); stdcall;
  21. Procedure ScrIdle (var mdModuleData: TModuleData); stdcall;
  22. Procedure ScrTimer (var mdModuleData: TModuleData); stdcall;
  23. Function ScrConfig (var mdModuleData: TModuleData; hwndParent: HWND): integer; stdcall;
  24.  
  25. implementation
  26.  
  27. {$else}
  28.  {$ifdef DEBUG}
  29.  {$IMAGEBASE $00400000}
  30.  Program Blanker;
  31.  {$else}
  32.  {$IMAGEBASE $02000000}
  33.  library Blanker;
  34.  {$endif}
  35. {$endif}
  36.  
  37. uses
  38. {  SysUtils,
  39.   Classes;}
  40. {$ifndef INTERNAL}
  41.   WinTypes,
  42.   LGDAPI,
  43. {$endif}
  44. {  SysUtils,}
  45. {$ifdef DEBUG}
  46.   LGDDEBUG,
  47. {$endif}
  48.   LGDUTI;
  49.  
  50. const HELPFILE = 'LGD95.HLP';
  51.       HELPKEY:array[0..31]of char = 'Blackness';
  52.  
  53.        { requests information about screen saver }
  54. {$ifdef INTERNAL}
  55. Function ScrInfo (var lisInfo: TLgdInfoStruct): bool; stdcall;
  56. {$else}
  57. Function ScrInfo (var lisInfo: TLgdInfoStruct): bool; stdcall; export;
  58. {$endif}
  59. begin
  60.   ScrInfo := FALSE;
  61.   with lisInfo do
  62.     begin
  63.       if cBytes < sizeof (lisInfo) then
  64.         exit;
  65.       if cMagic <> lMagic then
  66.         exit;
  67.       afSaverFlags := SCR_LEAVESBLANK {+ SCR_MUSTHAVENONBLANK} +
  68.                  {SCR_CONFIGDIALOG +} SCR_HELPAVAILABLE;
  69. {$ifdef ENGLISH}
  70.       StrCopy (@strTitle[1], 'zBlackness');
  71.       StrCopy (@strInfo[1], 'Blackness Screen Saver'#10#10+
  72.                  'Screen Saver module for'#10#10+
  73.                  '95 Lights Go Down');
  74. {$else}
  75.       StrCopy (@strTitle[1], 'zBlackness');
  76.       StrCopy (@strInfo[1], 'Blackness Bildschirmschoner'#10#10+
  77.                  'Bildschirmschonermodul fⁿr'#10#10+
  78.                  '95 Lichter gehen aus');
  79. {$endif}
  80.       StrCopy (@strHelpFile[1], HELPFILE);
  81.       StrCopy (@strHelpKey[1], HELPKEY);
  82.     end;
  83.   ScrInfo := TRUE;
  84. end;
  85.  
  86.        { display information about screen saver }
  87. {$ifdef INTERNAL}
  88. Function ScrAbout (hwndParent: HWND): bool; stdcall;
  89. {$else}
  90. Function ScrAbout (hwndParent: HWND): bool; stdcall; export;
  91. {$endif}
  92. begin
  93.   ScrAbout := TRUE;
  94.   LgdAboutBox (hwndParent, 0,
  95.                        'Blackness',
  96.                        '⌐ 1992-97 Thomas H÷vel Software'#10+
  97.                        'Saturnstr. 45, 53842 Troisdorf, Germany'#10+
  98.                        'All Rights reserved!',
  99.   {$ifdef SHARE}
  100.                        FALSE,
  101.   {$else}
  102.                        TRUE,
  103.   {$endif}
  104.                        3);
  105. {  MessageBox (hwndParent, 'Hello, World!', 'About', mb_ok);}
  106. end;
  107.  
  108.        { these functions are called to execute the screen saver }
  109.        { init screen saver - should save pointer to structure }
  110. {$ifdef INTERNAL}
  111. Function ScrInit (var mdModuleData: TModuleData): bool; stdcall;
  112. {$else}
  113. Function ScrInit (var mdModuleData: TModuleData): bool; stdcall; export;
  114. {$endif}
  115. {var dc: hdc;}
  116. begin
  117.   Randomize;
  118.   with mdModuleData.pms^ do
  119.     begin
  120.       fSupportsIdleFunction := TRUE;
  121.       lCallDelay := 1;
  122.       lTimerDelay := 100; { max. speed }
  123.       {pss^.iBPP}
  124. {      dc := GetDC (hwndSaver);
  125.       ReleaseDC (hwndSaver, dc);}
  126.     end;
  127.   ScrInit := TRUE;
  128. end;
  129.  
  130. {$ifdef INTERNAL}
  131. Procedure ScrDone (var mdModuleData: TModuleData); stdcall;
  132. {$else}
  133. Procedure ScrDone (var mdModuleData: TModuleData); stdcall; export;
  134. {$endif}
  135. begin
  136. end;
  137.  
  138. {$ifdef INTERNAL}
  139. Procedure ScrIdle (var mdModuleData: TModuleData); stdcall;
  140. {$else}
  141. Procedure ScrIdle (var mdModuleData: TModuleData); stdcall; export;
  142. {$endif}
  143.    { called at maximum rate if requested by saver }
  144. var dc: hdc;
  145. {$ifdef COL256}
  146.     hpalOld: HPalette;
  147. {$endif}
  148.     x, y: integer;
  149. begin
  150.   with mdModuleData.pms^ do
  151.     begin
  152.       dc := GetDC (hwndSaver);
  153. {$ifdef COL256}
  154.       if pss^.iBPP >= 8 then
  155.         begin
  156.           hpalOld := SelectPalette (dc, pss^.hpalModule, FALSE);
  157.           RealizePalette (dc);
  158.         end;
  159. {$endif}
  160.       x := random (cxScreen);
  161.       y := random (cyScreen);
  162. (*      SetPixel (dc, x-1, y, RGB (192, 0, 0));
  163.       SetPixel (dc, x+1, y, RGB (192, 0, 0));
  164.       SetPixel (dc, x, y-1, RGB (192, 0, 0));
  165.       SetPixel (dc, x, y+1, RGB (192, 0, 0));
  166.       SetPixel (dc, x, y, RGB (255, 0, 0));*)
  167.       SetPixel (dc, x-1, y, RGB (0, 0, 0));
  168.       SetPixel (dc, x+1, y, RGB (0, 0, 0));
  169.       SetPixel (dc, x, y-1, RGB (0, 0, 0));
  170.       SetPixel (dc, x, y+1, RGB (0, 0, 0));
  171.       SetPixel (dc, x, y, RGB (0, 0, 0));
  172. {$ifdef COL256}
  173.       if pss^.iBPP >= 8 then
  174.         begin
  175.           SelectPalette (dc, hpalOld, FALSE);
  176.         end;
  177. {$endif}
  178.       ReleaseDC (hwndSaver, dc);
  179.     end;
  180. end;
  181.  
  182. {$ifdef INTERNAL}
  183. Procedure ScrTimer (var mdModuleData: TModuleData); stdcall;
  184. {$else}
  185. Procedure ScrTimer (var mdModuleData: TModuleData); stdcall; export;
  186. {$endif}
  187.    { called by timer with selected interval }
  188. var dc: hdc;
  189. {$ifdef COL256}
  190.     hpalOld: HPalette;
  191. {$endif}
  192.     x, y: integer;
  193. begin
  194.   with mdModuleData.pms^ do
  195.     begin
  196.       dc := GetDC (hwndSaver);
  197. {$ifdef COL256}
  198.       if pss^.iBPP >= 8 then
  199.         begin
  200.           hpalOld := SelectPalette (dc, pss^.hpalModule, FALSE);
  201.           RealizePalette (dc);
  202.         end;
  203. {$endif}
  204.       x := random (cxScreen);
  205.       y := random (cyScreen);
  206.       SetPixel (dc, x-1, y, RGB (192, 192, 192));
  207.       SetPixel (dc, x+1, y, RGB (192, 192, 192));
  208.       SetPixel (dc, x, y-1, RGB (192, 192, 192));
  209.       SetPixel (dc, x, y+1, RGB (192, 192, 192));
  210.       SetPixel (dc, x, y, RGB (255, 255, 255));
  211. {$ifdef COL256}
  212.       if pss^.iBPP >= 8 then
  213.         begin
  214.           SelectPalette (dc, hpalOld, FALSE);
  215.         end;
  216. {$endif}
  217.       ReleaseDC (hwndSaver, dc);
  218.     end;
  219. end;
  220.  
  221.    {  display configuration dialog }
  222. {$ifdef INTERNAL}
  223. Function ScrConfig (var mdModuleData: TModuleData; hwndParent: HWND): integer; stdcall;
  224. {$else}
  225. Function ScrConfig (var mdModuleData: TModuleData; hwndParent: HWND): integer; stdcall; export;
  226. {$endif}
  227. begin
  228.   ScrConfig := 0;
  229. {$ifdef ENGLISH}
  230.   MessageBox (hwndParent, 'No options available!', 'Blackness', mb_ok);
  231. {$else}
  232.   MessageBox (hwndParent, 'Keine Optionen verfⁿgbar!', 'Blackness', mb_ok);
  233. {$endif}
  234. end;
  235.  
  236. {$ifndef DEBUG}
  237. {$ifndef INTERNAL}
  238. exports
  239.   ScrInfo index 11,
  240.   ScrAbout index 12,
  241.   ScrInit index 13,
  242.   ScrDone index 14,
  243.   ScrIdle index 15,
  244.   ScrTimer index 16,
  245.   ScrConfig index 17;
  246. {$endif}
  247. {$endif}
  248.  
  249. begin { library }
  250. {$ifdef DEBUG}
  251.   DebugMain (@ScrInfo, @ScrAbout, @ScrInit, @ScrDone, @ScrIdle, @ScrTimer, @ScrConfig);
  252. {$endif}
  253. end.
  254.