{************************************************************}
{                                                            }
{ Sample source for Invert screen saver for Intermission     }
{ This should be compiled with Turbo Pascal for Windows.     }
{                                                            }
{ Copyright (C) 1991 Anthony Andersen                        }
{                                                            }
{ All rights reserved.                                       }
{                                                            }
{ The author grants permission for registered owners of      }
{ Intermission to modify this code to create new screen      }
{ savers and to distribute the modified savers freely.       }
{ This sample code is only legally available to registered   }
{ users of Intermission.                                     }
{                                                            }
{ To create and use INVERT.IMX from this source,             }
{    1) select Compile|Make from the menu bar.               }
{       this will create INVERT.DLL in your source directory }
{    2) go to a DOS command prompt and rename INVERT.DLL to  }
{       INVERT.IMX.                                          }
{    3) Use the "Add Saver..." button in the main dialog to  }
{       add INVERT.IMX.                                      }
{                                                            }
{************************************************************}


library Invert;

{$R INVERT.RES}

uses WinTypes, WinProcs;

const
	savername  = 'Invert';
	blankprof  = 'Blank First';
	usecolprof = 'Use Color';
	profname   = 'ANTSW.INI';
	zerostr    = '0';
	onestr     = '1';

var
	cliprect   : TRect;
	blankfirst : Integer;
	dir        : Integer;
	currindx   : Integer;
	seed1      : Longint;
	seed2      : Longint;
	usecolor   : Integer;
	numbits    : Integer;
	memdc      : HDC;

{ this procedure may be called MANY times - don't allocate anything }

function saverinit(var realize: Integer): PChar; export;
begin

	{ tell Intermission you don't want a color palette realized }
	{ set realize to 2 if you want a primary color palette      }
	{ set realize to 1 if you want a RGB palette                }
	{ set realize to 0 if you want an HSV palette               }

	if (usecolor = 1) then realize := 1
	else realize := 0;

	{ tell Intermission the name of your module                 }

	saverinit := savername;
end;

{ this procedure centers the dialog on its parent }

procedure centerdlg(hdlg: HWnd);

var
	ourrect   : TRect;
	parentrect: TRect;

begin
	GetWindowRect(hdlg,ourrect);
	GetWindowRect(GetParent(hdlg),parentrect);
	parentrect.left := (parentrect.right+parentrect.left-ourrect.right+ourrect.left) div 2;
	if (parentrect.left < 0) then parentrect.left := 0;
	if (parentrect.left > GetSystemMetrics(SM_CXSCREEN)-ourrect.right+ourrect.left) then
		parentrect.left := GetSystemMetrics(SM_CXSCREEN)-ourrect.right+ourrect.left;
	parentrect.top := (parentrect.bottom+parentrect.top-ourrect.bottom+ourrect.top) div 2;
	if (parentrect.top < 0) then parentrect.top := 0;
	if (parentrect.top > GetSystemMetrics(SM_CYSCREEN)-ourrect.bottom+ourrect.top) then
		parentrect.top := GetSystemMetrics(SM_CYSCREEN)-ourrect.bottom+ourrect.top;
	SetWindowPos(hdlg,0,parentrect.left,parentrect.top,0,0,
		SWP_NOACTIVATE or SWP_NOSIZE or SWP_NOREDRAW or SWP_NOZORDER);
end;

{ the user customization dialog procedure }

function saverdlgproc(Dialog: HWnd; Message, WParam: Word;LParam: Longint): Bool; export;
begin
	saverdlgproc := True;

	case Message of

		wm_InitDialog:
		begin
			centerdlg(Dialog);
			SendDlgItemMessage(Dialog,10,BM_SETCHECK,blankfirst,0);
			SendDlgItemMessage(Dialog,11,BM_SETCHECK,usecolor,0);
			if (numbits = 1) then EnableWindow(GetDlgItem(Dialog,11),FALSE);
			Exit;
		end;

		wm_Command:
		if (WParam = id_Ok) then begin

			blankfirst := SendDlgItemMessage(Dialog,10,BM_GETCHECK,0,0);
			if (blankfirst = 0) then begin
				WritePrivateProfileString(savername,blankprof,zerostr,profname);
			end
			else begin
				WritePrivateProfileString(savername,blankprof,onestr,profname);
			end;

			usecolor := SendDlgItemMessage(Dialog,11,BM_GETCHECK,0,0);
			if (usecolor = 0) then begin
				WritePrivateProfileString(savername,usecolprof,zerostr,profname);
			end
			else begin
				WritePrivateProfileString(savername,usecolprof,onestr,profname);
			end;

			EndDialog(Dialog, 1);
			Exit;
		end
		else if (WParam = id_Cancel) then begin
			EndDialog(Dialog, 0);
			Exit;
		end;

	end;

	saverdlgproc := False;
end;

{ this routine is where you draw what your module draws }

procedure saverdraw(hwnd:HWnd;hdc:HDC;hinst:Word;hpal:HPalette;opcode:Integer); export;

var
	invrect  : TRect;
	brush    : HBrush;
	oldbrush : HBrush;
	pen      : HPen;
	oldpen   : HPen;
	oldrop   : Integer;
	red      : Byte;
	green    : Byte;
	blue     : Byte;
	red2     : Byte;
	green2   : Byte;
	blue2    : Byte;
	penwid   : Integer;

begin
	if (opcode = 1) then begin
		{ Initialize }
		GetClipBox(hdc,cliprect);
		dir := 1;
		currindx := 0;
		if (blankfirst = 1) then FillRect(hdc,cliprect,GetStockObject(BLACK_BRUSH));
		seed1 := GetTickCount;
		seed2 := seed1;
		RandSeed := seed1;
	end

	else if (opcode = 0) then begin
		{ Normal Draw }

		invrect.left := Random(cliprect.right-cliprect.left+40)+cliprect.left-20;
		invrect.top := Random(cliprect.bottom-cliprect.top+40)+cliprect.top-20;
		invrect.right := Random(cliprect.right-invrect.left+20)+invrect.left;
		invrect.bottom := Random(cliprect.bottom-invrect.top+20)+invrect.top;

		if (usecolor <> 0) then begin
			red := Random(256);
			green := Random(256);
			blue := Random(256);
			red2 := Random(256);
			green2 := Random(256);
			blue2 := Random(256);
			penwid := Random(30)+1;
		end;

		if (dir = 1) then begin
			if (currindx = 99) then begin
				dir := 0;
				RandSeed := seed2;
			end
			else currindx := currindx + 1;
		end
		else begin
			if (currindx = 0) then begin
				dir := 1;
				seed1 := GetTickCount;
				seed2 := seed1;
				RandSeed := seed1;
			end
			else currindx := currindx - 1;
		end;
		if (usecolor = 1) then begin
			if (numbits = 4) then brush := CreateSolidBrush(GetNearestColor(hdc,red or green shl 8 or blue shl 16))
			else brush := CreateSolidBrush(PaletteRGB(red,green,blue));
			pen := CreatePen(ps_Solid,penwid,PaletteRGB(red2,green2,blue2));
			if (brush <> 0) then oldbrush := SelectObject(hdc,brush)
			else oldbrush := 0;
			if (pen <> 0) then oldpen := SelectObject(hdc,pen)
			else oldpen := 0;
			oldrop := SetROP2(hdc,r2_XorPen);
			Rectangle(hdc,invrect.left,invrect.top,invrect.right,invrect.bottom);
			if (oldbrush <> 0) then SelectObject(hdc,oldbrush);
			if (brush <> 0) then DeleteObject(brush);
			if (oldpen <> 0) then SelectObject(hdc,oldpen);
			if (pen <> 0) then DeleteObject(pen);
			SetROP2(hdc,oldrop);
		end
		else InvertRect(hdc,invrect);
	end

	else if (opcode = 2) then begin
		{ Cleanup }
	end;
end;

exports
	saverinit,
	saverdlgproc,
	saverdraw;

begin
	{ load any necessary profile information here }

	memdc := CreateCompatibleDC(0);
	if (memdc <> 0) then begin
		numbits := GetDeviceCaps(memdc,BITSPIXEL)*GetDeviceCaps(memdc,PLANES);
		DeleteDC(memdc);
	end;
	blankfirst := GetPrivateProfileInt(savername,blankprof,0,profname);
	usecolor := GetPrivateProfileInt(savername,usecolprof,0,profname);
	if (numbits = 1) then usecolor := 0;
end.