home *** CD-ROM | disk | FTP | other *** search
- {$A-,B-,D-,F-,G-,I+,L-,N-,R-,S-,V+,W+,X+}
- {$M 4096,4096}
- Library Splat;
-
- (* SPLAT.PAS - An AfterDark Module
- * Written by Richard R. Sands 04/91 Copyright ⌐ Richard R. Sands 1991
- *
- * This module "throws" globs of paint onto the screen where they drip
- * down.
- *
- * Written with the object-oriented AfterDark module in Borland's
- * Turbo Pascal for Windows.
- *)
-
- USES WinTypes, WinProcs, Strings, AfterDark;
-
- CONST
- MaxColors = 8;
- Colors : Array[0..MaxColors] of TColorRef =
- ($000000, $0000FF, $00FF00, $FF0000,
- $00FFFF, $FF00FF, $FFFF00, $FFFFFF, $808080);
-
- TYPE
- SplatData = Record { Data for Value Table }
- BrushSize : Integer;
- DripLength: Integer;
- end;
-
- SplatRec = Record { Information regarding Splat State }
- I : Integer; { Drip Index }
- Go : Boolean; { Start the Splat }
- RgbColor : LongInt; { Color }
- Width : Integer; { Width of ellipse rectangle from Center }
- CenterX : Integer; { Center X of Rectangle }
- CenterY : Integer; { Center Y of Rectangle }
- Count : Integer;
- BrushDat : Integer; { Index to splat Data Value Table }
- end;
-
- CONST
- MaxSplats = 10;
- SplatDat : Array[0..2] of SplatData = (
- (BrushSize:4; DripLength:50),
- (BrushSize:8; DripLength:30),
- (BrushSize:12; DripLength:30));
-
- TYPE
- TSplat = object(TAfterDark)
- Splats : Array[1..MaxSplats] of SplatRec; { Each Splat }
- Initted: Boolean; { Are we done splatting these? }
- BlankFirst: Boolean; { Blank screen first? }
- Size : Integer; { What size splats? }
- Max : Integer; { Number of simultanius Splats }
- Cur : Integer; { Current Splat we are splatting }
- function DoInitialize:Integer; virtual;
- function DoBlank:Integer; virtual;
- function DoDrawFrame:Integer; virtual;
- function DoButtonMessage1(Value:Integer):Integer; virtual;
- function DoButtonMessage2(Value:Integer):Integer; virtual;
- function DoButtonMessage3(Value:Integer):Integer; virtual;
- function DoClose:Integer; virtual;
- end;
-
- { ------------------------------------------------------------------------ }
- { TSplat }
- { ------------------------------------------------------------------------ }
- function TSplat.DoInitialize:Integer;
- begin
- Initted := FALSE; { We haven't even begun yet! }
- Max := 3;
- Size := 4; { Random Splats }
- BlankFirst := FALSE;
- DoInitialize := NOERROR
- end;
-
- { ------------------------------------------------------------------------ }
- Function TSplat.DoClose:Integer;
- var Buffer: Array[0..16] of char;
- c1,c2,c3:String[3];
- begin
- Str(lpModule^.iControlValue[0], c1);
- Str(lpModule^.iControlValue[1], c2);
- Str(lpModule^.iControlValue[2], c3);
- StrPCopy(Buffer, c1 + ',' + c2 + ',' + c3);
- WritePrivateProfileString('Splat', 'info', Buffer, 'ad_prefs.ini')
- end;
-
- { ------------------------------------------------------------------------ }
- function TSplat.DoBlank:Integer;
- const rBlank : TRect = (Left:0;Top:0);
- begin
- DoBlank := TAfterDark.DoBlank;
- if BlankFirst then
- begin
- SetRect(rBlank, 0, 0, lpModule^.ptRgnSize.x, lpModule^.ptRgnSize.y);
- FillRect (DC, rBlank, GetStockObject(BLACK_BRUSH))
- end;
- end;
-
- { ------------------------------------------------------------------------ }
- function TSplat.DoDrawFrame:Integer;
- var
- OldPen, Pen : HPen;
- OldBrush, Brush: HBrush;
- LB: TLogBrush;
- HalfBrush: Integer;
-
- procedure Circle(CenterX, CenterY, Width:Integer);
- var x1, y1, x2,y2:Integer;
- begin
- x1 := centerX - Width;
- x2 := centerX + Width;
- y1 := centerY - Width;
- y2 := centerY + Width;
- Ellipse(DC, x1, y1, x2, y2)
- end;
-
- function InRange(I:Integer):Boolean;
- { This function checks the current splat will intersect any of the
- precceding splats }
- var J:Integer;
- CurXL, CurXR : Integer;
- begin
- if I = 1 then EXIT; { OK }
- InRange := FALSE; { Assume the worst }
- CurXL := Splats[i].CenterX - Splats[i].Width; { Left End }
- CurXR := Splats[i].CenterX + Splats[i].Width; { Right End }
- for J:=1 to pred(I) do { each splat }
- begin
- if ((CurXL>=(Splats[j].CenterX - Splats[j].Width)) AND
- (CurXL<=(Splats[j].CenterX + Splats[j].Width))) OR
- ((CurXR>=(Splats[j].CenterX - Splats[j].Width)) AND
- (CurXR<=(Splats[j].CenterX + Splats[j].Width))) then
- begin
- InRange := TRUE;
- EXIT
- end
- end
- end;
-
- procedure CheckFinished;
- var S: Integer;
- begin
- for S := 1 to Max do
- if Splats[S].I <= Splats[S].Count then EXIT;
- Initted := FALSE { Next Frame, we will reinit }
- end;
-
- procedure InitSplats;
- var S,S1 : Integer;
- begin
- for S :=1 to Max do
- begin
- with Splats[S] do
- begin
- I := 1;
- RgbColor:= Colors[random(MaxColors+1)];
- if Size < 4 then
- BrushDat := pred(Size) { User Picked a Splat Size }
- else
- BrushDat:= random(3);
- width := 5 + SplatDat[BrushDat].BrushSize + random(15); { half width of rectangle }
- Count := SplatDat[BrushDat].DripLength + random(25); { length of the drip }
-
- { This next loop -tries- to keep the splats from intersecting
- each other - it makes a very non-splat effect - by checking
- if the current splat intersect the bounds of any previous
- splat. HOWEVER, since it is random, there is a chance of
- some serious delay while it keeps recalculating new bounds.
- This is suppress by only recalculating 7 times and giving
- up, thus once in a while it's possible that an intersect
- might happen. }
- S1 := 1;
- Repeat
- centerX := random(lpModule^.ptRgnSize.X); { center X of rectangle }
- inc(S1);
- Until (Not InRange(S)) OR (S1>7) { Five Hits };
-
- { Calc center Y of rectangle }
- centerY := random(lpModule^.ptRgnSize.Y-(lpModule^.ptRgnSize.Y div 4));
- Go := S = 1
- end
- end;
- Cur := 1; { Reset states }
- Initted := TRUE
- end;
-
- const
- InValidRange: PChar = 'Invalid Range Values';
- begin
- if (Max<1) OR (Max>10) OR (Size<1) OR (Size>4) THEN
- begin
- DoDrawFrame := USER_ERROR;
- lpSystemAD^.lpszErrorMessage := InvalidRange; { POINTER TO ERROR STRING }
- EXIT
- end;
- if NOT Initted then { --- (re)initialize the splats --- }
- InitSplats;
-
- if (Splats[Cur].I <= Splats[Cur].Count) AND (Splats[Cur].Go) then { Continue to splat }
- begin
- With Splats[Cur] do
- begin
- HalfBrush := SplatDat[BrushDat].BrushSize div 2;
-
- Pen := CreatePen(ps_Solid, SplatDat[BrushDat].BrushSize, RgbColor);
- OldPen := SelectObject(DC, Pen);
- LB.lbStyle := bs_solid;
- LB.lbColor := RgbColor;
- LB.lbHatch := bs_solid;
- Brush := CreateBrushIndirect(LB);
- OldBrush := SelectObject(DC, Brush);
-
- { Are we still Drawing the Splat? }
- if Width > SplatDat[BrushDat].BrushSize then
- begin
- Circle(CenterX, CenterY, Width);
- dec(Width, HalfBrush);
- inc(CenterY, SplatDat[BrushDat].BrushSize)
- end
- else
- begin
- { Make the drip }
- Circle(CenterX, CenterY, Width);
- inc(CenterY, HalfBrush);
- inc(I);
- if I = Count div 2 then
- begin
- { Make drip a little smaller if possible }
- if Width > (HalfBrush) then
- dec(Width, HalfBrush);
- end;
- { And Start the next Splat }
- if Cur < 10 then
- if I >= (Count div Max) then
- Splats[Cur+1].Go := TRUE;
- end
- end;
- SelectObject(DC, OldPen);
- SelectObject(DC, OldBrush);
- DeleteObject(Pen);
- DeleteObject(Brush)
- end
- else { Check if we are finished }
- CheckFinished;
- if Cur = Max then Cur := 1
- else
- inc(Cur);
- DoDrawFrame := NOERROR
- end;
-
- { ------------------------------------------------------------------------ }
- function TSplat.DoButtonMessage1(Value:Integer):Integer;
- begin
- case value of
- 0 : Size := 1;
- 25: Size := 2;
- 50: Size := 3;
- else
- Size := 4
- end;
- Initted := FALSE;
- DoButtonMessage1 := NOERROR
- end;
-
- { ------------------------------------------------------------------------ }
- function TSplat.DoButtonMessage2(Value:Integer):Integer;
- begin
- if Value in [1..10] then
- Max := Value
- else
- Max := 3;
- Initted := FALSE;
- DoButtonMessage2 := NOERROR;
- end;
-
- { ------------------------------------------------------------------------ }
- function TSplat.DoButtonMessage3(Value:Integer):Integer;
- begin
- BlankFirst := Value = 1;
- DoButtonMessage3 := NOERROR
- end;
-
- { ------------------------------------------------------------------------ }
- EXPORTS Module;
-
- VAR MySaver : TSplat;
-
- begin
- MySaver.Init { Initialize our Module }
- end.
-