home *** CD-ROM | disk | FTP | other *** search
/ Chip: Shareware for Win 95 / Chip-Shareware-Win95.bin / ostatni / delphi / delphi2 / wowsrc.exe / CODEBALL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-09-14  |  7.5 KB  |  145 lines
  1. unit Codeball;
  2. {$N+}
  3. interface
  4.  
  5. Uses Graphics, WinProcs, WinTypes, Messages, Classes;
  6.  
  7. Const
  8.   PALSIZE = 236;
  9.   PALSEG  = 39;
  10.  
  11. Var
  12.   hPal         : HPalette;                                 { Handle to a Palette }
  13.   pLogPal      : ^TLOGPALETTE;                             { Pointer to a palette }
  14.   MaxSize      : Integer;                                  { Max size of a sphere }
  15.   Rc1          : TRect;                                    { Rectangle surrounding a sphere }
  16.   xr,xl,yt,yb  : Integer;                                  { Position vars }
  17.   nBars, Which : Integer;                                  { Number and which is the current bar }
  18.   hPalMem      : THandle;                                  { Handle to memory for palette }
  19.   PalOff       : Integer;                                  { current offsaet in the palette }
  20.   NumDone      : Word;                                     { Number of spheres displayed }
  21.   OldPalette   : HPalette;                                 { the prevous palette }
  22.   iNumSpheres  : Integer;                                  { the number of spheres on screen }
  23.   OldBrush     : TBrush;                                   { the previous Brush }
  24.   OldPen       : TPen;                                     { the Previous Pen }
  25.  
  26. Procedure InitBalls;                                       { Startup }
  27. Procedure FreeBalls;                                       { Free any resources }
  28.  
  29. Procedure BallDisplay;                                     { Display a Sphere }
  30. Procedure ReadBallDefaults;                                { Read the defaults }
  31.  
  32. implementation
  33.  
  34. Uses
  35.   Ssave, Globals, IniFiles;
  36.  
  37. Procedure MakePalette(PalOff,Rs,Ri,Gs,Gi,Bs,Bi : Integer); { Construct a palette section }
  38. Var
  39.   Pal : Integer;                                           { Local Looper }
  40. begin
  41.   for Pal := PalOff to PalOff + PALSEG do begin            { For each member }
  42.     pLogPal^.palPalEntry[Pal].peRed := Rs;                 { Set Red }
  43.     pLogPal^.palPalEntry[Pal].peGreen := Gs;               { Set Green }
  44.     pLogPal^.palPalEntry[Pal].peBlue := Bs;                { Set Blue }
  45.     Inc(Rs,Ri);                                            { Bump Red }
  46.     Inc(Gs,Gi);                                            { Bump Green }
  47.     Inc(Bs,Bi);                                            { Bump Blue }
  48.     pLogPal^.palPalEntry[Pal].peFlags := 0;                { Set Flags }
  49.  
  50.     end;
  51. end;
  52.  
  53. Procedure InitBalls;
  54. Begin
  55.   ReadBallDefaults;                                        { Read Ball defaults }
  56.   iNumSpheres := BallMax;                                  { Get Num Circles }
  57.   MaxSize := BallSize;                                     { Get ball Size }
  58.   Randomize;                                               { True random }
  59.   OldPen := Scrn.Canvas.Pen;                               { Remember the Pen }
  60.   OldBrush := Scrn.Canvas.Brush;                           { Remember the Brush }
  61.   hPalMem := LocalAlloc(LMEM_FIXED,
  62.                     sizeof(TLOGPALETTE)
  63.                     + PALSIZE * sizeof(TPALETTEENTRY));    { Grab the Memory }
  64.   pLogPal := LocalLock(hPalMem);                           { Lock the memory }
  65.   pLogPal^.palVersion := 768;                              { bloody mysterious }
  66.   pLogPal^.palNumEntries := PALSIZE;                       { Set Num Entries}
  67.   MakePalette(  0,21,6,0,0,0,0);
  68.   MakePalette( 39,0,0,21,6,0,0);
  69.   MakePalette( 78,0,0,0,0,21,6);
  70.   MakePalette(117,138,3,64,4,21,4);
  71.   MakePalette(156,99,4,21,6,99,4);
  72.   MakePalette(195,21,6,99,4,21,6);                         { Make the pallettes }
  73.   hPal := CreatePalette(pLogPal^);                         { Create the master pallette }
  74.   LocalUnlock(hPalMem);                                    { Unlock it}
  75.   LocalFree(hPalMem);                                      { free it}
  76.   OldPalette := SelectPalette(Scrn.Canvas.Handle,
  77.                                hPal, False);               { select the pallette }
  78. end;
  79.  
  80. Procedure FreeBalls;
  81. Begin
  82.   Scrn.Canvas.Pen := OldPen;                               { Remember the Pen }
  83.   Scrn.Canvas.Brush := OldBrush;                           { Remember the Brush }
  84.   SelectPalette(Scrn.Canvas.Handle,
  85.                                OldPalette, False);         { select the pallette }
  86.   RealizePalette(Scrn.Canvas.Handle);                      { realize it }
  87.   DeleteObject(hPal);                                      { Kill the Palette }
  88. End;
  89.  
  90. Procedure BallDisplay;
  91. Var
  92.   Rct : TRect;                                             { Clearing screen rect }
  93.   Radius, ThisPal : Integer;                               { Local Vars }
  94.   PalInc : Single;                                         { Local Vars }
  95.   ThisOne : TColor;                                        { Local Vars }
  96.  
  97. Begin
  98.   SelectPalette(Scrn.Canvas.Handle, hPal, False);          { Select the Palette }
  99.   RealizePalette(Scrn.Canvas.Handle);                      { realize it }
  100.   Inc(NumDone);
  101.   if NumDone = iNumSpheres then begin                      { If Clear the Screen }
  102.     Scrn.Canvas.Brush.Color := clBlack;                    { Black Please }
  103.     Rct := Rect(0,0,ScreenWd + 2, ScreenHt +2);            { Get the Rectangle }
  104.     Scrn.Canvas.FillRect(Rct);                             { Fill It }
  105.     NumDone := 0;                                          { Reset Count }
  106.     end;
  107.  
  108.   nBars := Random(MaxSize);                                { Get the Number of Bars }
  109.   if nBars = 0 then                                        { If None }
  110.      nBars := 1;                                           { Make it al least 1 }
  111.   Which := Random(7);                                      { Get the Colour Palette }
  112.   if Which = 0 then                                        { Check for Palette 0 }
  113.      Which := 1;                                           { Make it 1 }
  114.   PalInc := PALSEG / nBars;                                { Set the Palette Incrementer }
  115.   PalOff := Which * PALSEG;                                { Set the Palette offset }
  116.   xl := Random(ScreenWd)-64;                               { Set Screen Pos X }
  117.   yt := Random(ScreenHt)-64;                               { Set Screen Pos Y }
  118.   xr := xl + nBars * 2;                                    { Set LEFT extremity }
  119.   yb := yt + nBars * 2;                                    { Set BOTTOM extremeity }
  120.   for Radius := nBars downto 1 do begin                    { For each colour bar in the Circle }
  121.     ThisPal := Integer(Trunc(PalInc * Radius));            { Calc Palette }
  122.      if ThisPal = 0 then                                   { Get the palette index }
  123.         ThisPal := 1;                                      { If impossible then reset }
  124.      ThisOne := PaletteIndex(PalOff - ThisPal);            { Get the RGB Palette }
  125.      Scrn.Canvas.Pen.Color := ThisOne;                     { Set Pen }
  126.      Scrn.Canvas.Brush.Color := ThisOne;                   { Set Brush }
  127.      Scrn.Canvas.Chord(xl,yt,xr,yb,xl,yt,xl,yt);           { Draw the Circle }
  128.      Inc(xl); Inc(yt); Dec(xr); Dec(yb);                   { Bump Vars }
  129.      end;
  130. End;
  131.  
  132. Procedure ReadBallDefaults;
  133. Var
  134.   Ini : TIniFile;
  135. Begin
  136.   Ini := TIniFile.Create('Wow.Ini');                   { Open the Ini File }
  137.   Apptitle := 'Screen Saver.Delphi Balls';                 { Set title }
  138.   PwdType := Ini.ReadInteger(AppTitle,'PwdType',0);        { Get the Password Type }
  139.   BallMax := Ini.ReadInteger(AppTitle,'MaxBalls',64);      { Get Max Balls B4 clear Screen }
  140.   BallSize := Ini.ReadInteger(AppTitle,'BallSize',128);    { Get Ball Size }
  141.  
  142. End;
  143.  
  144. end.
  145.