upie.pas

an example of screen savers using delphi

UNIT UPie;

INTERFACE

USES
  Windows, SysUtils, ExtCtrls, Graphics, Math, Registry, Forms, Globals;

TYPE
  TPieParas = RECORD
    ppBrushColor,
    ppBorderColor 	: TColor;
    ppBorderWidth   	: INTEGER;
    ppdStartAngle,		// bezogen auf 2 x PI
    ppdStopAngle,
    ppdRadiusX,
    ppdRadiusY,
    ppdOriginX,			// wg. MappingModes und Bitmap
    ppdOriginY,
    ppdMulX,			// wg. MappingModes und Bitmap
    ppdMulY		: DOUBLE;
    END;

  TPieRect = RECORD
    X1,
    Y1,
    X2,
    Y2 			: LONGINT;
    END;

TYPE
  TPie = CLASS( TObject )
   PRIVATE
    { Private declarations }
    myPieParas		: TPieParas;
    myBoundingRect	: TPieRect;
    myPieRect		: TPieRect;
    PROCEDURE SetStartAngle( dValue: DOUBLE );
    PROCEDURE SetStopAngle( dValue: DOUBLE );
    PROCEDURE SetRadiusX( dValue: DOUBLE );
    PROCEDURE SetRadiusY( dValue: DOUBLE );
    PROCEDURE SetOriginX( dValue: DOUBLE );
    PROCEDURE SetOriginY( dValue: DOUBLE );
    FUNCTION  ReCalculate: BOOLEAN;
   PROTECTED
    { Protected declarations }
   PUBLIC
    { Public declarations }
   PUBLISHED
    { Published declarations }
    CONSTRUCTOR Create;
    CONSTRUCTOR CreateWithParas( aTPieParas: TPieParas );			// wg. Copy
    DESTRUCTOR Destroy; OVERRIDE;
    PROPERTY BrushColor: TColor READ myPieParas.ppBrushColor WRITE myPieParas.ppBrushColor;
    PROPERTY BorderColor: TColor READ myPieParas.ppBorderColor WRITE myPieParas.ppBorderColor;
    PROPERTY BorderWidth: INTEGER READ myPieParas.ppBorderWidth WRITE myPieParas.ppBorderWidth;
    PROPERTY StartAngle: DOUBLE READ myPieParas.ppdStartAngle WRITE SetStartAngle;
    PROPERTY StopAngle: DOUBLE READ myPieParas.ppdStopAngle WRITE SetStopAngle;
    PROPERTY RadiusX: DOUBLE READ myPieParas.ppdRadiusX WRITE SetRadiusX;
    PROPERTY RadiusY: DOUBLE READ myPieParas.ppdRadiusY WRITE SetRadiusY;
    PROPERTY OriginX: DOUBLE READ myPieParas.ppdOriginX WRITE SetOriginX;
    PROPERTY OriginY: DOUBLE READ myPieParas.ppdOriginY WRITE SetOriginY;

    PROPERTY PieParas: TPieParas READ myPieParas; 				// read only
    PROPERTY BoundingRect: TPieRect READ myBoundingRect;
    PROPERTY PieRect: TPieRect READ myPieRect;
    END;


  TState	= (stON, stOff);
  TExtra	= RECORD
    xSecondsDec	: DWORD;
    xSecondsRef	: DWORD;
    xOnColor	: TColor;
    xDimColor	: TColor;
    xOffColor	: TColor;
    xBrdColor	: TColor;
    xState	: TState;
    xDimmed	: BOOLEAN;
    END;

  TBerlinPie	= CLASS(TPie)
   PRIVATE
    myExtra	: TExtra;
    PROCEDURE SetState( aState: TState );
    FUNCTION  GetDimmedColor( aColor: TColor ): TColor;
    { Private declarations }
   PROTECTED
    { Protected declarations }
   PUBLIC
    { Public declarations }
   PUBLISHED
    { Published declarations }
    CONSTRUCTOR Create;
    CONSTRUCTOR CreateWithParas( aTPieParas: TPieParas; aExtra: TExtra );	// wg. Copy
    FUNCTION  GetStateChanged( VAR aValue: DWORD ): BOOLEAN;
    PROCEDURE SetDimmed( aValue: BOOLEAN );

    PROPERTY SecondsDecrement: DWORD READ myExtra.xSecondsDec WRITE myExtra.xSecondsDec;
    PROPERTY SecondsReference: DWORD READ myExtra.xSecondsRef WRITE myExtra.xSecondsRef;
    PROPERTY State: TState READ myExtra.xState WRITE SetState;
    PROPERTY ColorOn: TColor READ myExtra.xOnColor WRITE myExtra.xOnColor;
    PROPERTY ColorDim: TColor READ myExtra.xDimColor WRITE myExtra.xDimColor;
    PROPERTY ColorOff: TColor READ myExtra.xOffColor WRITE myExtra.xOffColor;
    PROPERTY ColorBorder: TColor READ myExtra.xBrdColor WRITE myExtra.xBrdColor;
    PROPERTY Dimmed: BOOLEAN READ myExtra.xDimmed WRITE SetDimmed;
    END;


  TBerlinUhrColors = RECORD
    bucBorderColor	: TColor;
    bucHColorOn  	: TColor;
    bucHColorDim 	: TColor;
    bucHColorOff 	: TColor;
    bucMColorOn  	: TColor;
    bucMColorDim 	: TColor;
    bucMColorOff 	: TColor;
    bucSColorOn  	: TColor;
    bucSColorDim 	: TColor;
    bucSColorOff 	: TColor;
    END;

  TBerlinUhr	= CLASS( TObject )
   PRIVATE
    { Private declarations }
    myColors	: TBerlinUhrColors;
    myBitmap	: TBitmap;
    bUpdateAll	: BOOLEAN;
    bIsPainting	: BOOLEAN;
    PROCEDURE SetColors( aColors: TBerlinUhrColors );
   PROTECTED
    allPies	: ARRAY[1 .. 26] OF TBerlinPie;
    { Protected declarations }
   PUBLIC
    { Public declarations }
   PUBLISHED
    { Published declarations }
    CONSTRUCTOR Create( aColors: TBerlinUhrColors; aWidth, aHeight, aBorderWidth: INTEGER );
    DESTRUCTOR	Destroy; OVERRIDE;
    FUNCTION	GetBitmap( aDateTime: TDateTime ): TBitmap;
    PROCEDURE	DimmAll( bDimmed: BOOLEAN );
    PROCEDURE	Refresh;
    PROPERTY	Colors: TBerlinUhrColors READ myColors WRITE SetColors;
    PROPERTY	IsProcessing: BOOLEAN READ bIsPainting;
    END;

  TBerlinUhrRegEntries	= CLASS( TObject )
   PRIVATE
    myRegistry	: TRegistry;
    myDefColors	: TBerlinUhrColors;
    strKey	: STRING;
    { Private declarations }
    FUNCTION	GetBerlinUhrColors: TBerlinUhrColors;
    PROCEDURE	SetBerlinUhrColors( aColors: TBerlinUhrColors );
   PROTECTED
    { Protected declarations }
   PUBLIC
    { Public declarations }
   PUBLISHED
    { Published declarations }
    CONSTRUCTOR Create;
    DESTRUCTOR	Destroy; OVERRIDE;
    PROPERTY	BerlinUhrColors: TBerlinUhrColors READ GetBerlinUhrColors WRITE SetBerlinUhrColors;
    END;


IMPLEMENTATION

(*---------------------------------*)
CONSTRUCTOR TPie.Create;

BEGIN
INHERITED Create;
WITH myPieParas DO	// Standardwerte
  BEGIN
  ppBrushColor		:=  clYellow;
  ppBorderColor		:=  clLime;
  ppBorderWidth		:=  1;
  ppdStartAngle		:=  0.0;
  ppdStopAngle		:=  PI;
  ppdRadiusX		:=  100.0;
  ppdRadiusY		:=  50.0;
  ppdOriginX		:=  0.0;
  ppdOriginY		:=  0.0;
  ppdMulX   		:=  1.0;
  ppdMulY   		:= -1.0
  END;

ReCalculate;
END;

(*---------------------------------*)
CONSTRUCTOR TPie.CreateWithParas( aTPieParas: TPieParas );

BEGIN
INHERITED Create;
myPieParas := aTPieParas;
ReCalculate;
END;

(*---------------------------------*)
DESTRUCTOR TPie.Destroy;

BEGIN
INHERITED Destroy;
END;

(*---------------------------------*)
FUNCTION TPie.ReCalculate: BOOLEAN;

VAR
  eSin,
  eCos : EXTENDED;

BEGIN
WITH myBoundingRect, myPieParas DO
  BEGIN
  X1		:= Round( ppdOriginX-ppdRadiusX*ppdMulX );
  Y1		:= Round( ppdOriginY+ppdRadiusY*ppdMulY );
  X2		:= Round( ppdOriginX+ppdRadiusX*ppdMulX );
  Y2		:= Round( ppdOriginY-ppdRadiusY*ppdMulY );
  END;

WITH myPieRect, myPieParas DO
  BEGIN
  SinCos( ppdStartAngle, eSin, eCos );
  X1		:= Round( ppdOriginX+ppdMulX*(ppdRadiusX*eCos) );
  Y1		:= Round( ppdOriginY+ppdMulY*(ppdRadiusY*eSin) );
  SinCos( ppdStopAngle, eSin, eCos );
  X2		:= Round( ppdOriginX+ppdMulX*(ppdRadiusX*eCos) );
  Y2		:= Round( ppdOriginY+ppdMulY*(ppdRadiusY*eSin) );
  END;

Result := true;
END;

(*---------------------------------*)
PROCEDURE TPie.SetStartAngle( dValue: DOUBLE );

BEGIN
myPieParas.ppdStartAngle := dValue;
ReCalculate;
END;

(*---------------------------------*)
PROCEDURE TPie.SetStopAngle( dValue: DOUBLE );

BEGIN
myPieParas.ppdStopAngle := dValue;
ReCalculate;
END;

(*---------------------------------*)
PROCEDURE TPie.SetRadiusX( dValue: DOUBLE );

BEGIN
myPieParas.ppdRadiusX := dValue;
ReCalculate;
END;

(*---------------------------------*)
PROCEDURE TPie.SetRadiusY( dValue: DOUBLE );

BEGIN
myPieParas.ppdRadiusY := dValue;
ReCalculate;
END;

(*---------------------------------*)
PROCEDURE TPie.SetOriginX( dValue: DOUBLE );

BEGIN
myPieParas.ppdOriginX := dValue;
ReCalculate;
END;

(*---------------------------------*)
PROCEDURE TPie.SetOriginY( dValue: DOUBLE );

BEGIN
myPieParas.ppdOriginY := dValue;
ReCalculate;
END;

(*=================================*)
CONSTRUCTOR TBerlinPie.Create;

BEGIN
INHERITED Create;
WITH myExtra DO
  BEGIN
  xSecondsDec	:= 43200;		// 12Std
  xSecondsRef	:= 43200;               // 12Std
  xOnColor	:= clLime;
  xDimColor	:= clBlue;
  xOffColor	:= clMaroon;
  xState  	:= stOn;
  END;
State := State; //!!
END;

(*---------------------------------*)
CONSTRUCTOR TBerlinPie.CreateWithParas( aTPieParas: TPieParas; aExtra: TExtra );

BEGIN
INHERITED CreateWithParas( aTPieParas );
myExtra := aExtra;
END;


(*---------------------------------*)
FUNCTION  TBerlinPie.GetDimmedColor( aColor: TColor ): TColor;

BEGIN
Result := (aColor AND $FF000000)
	 +(GetBValue(aColor) SHR 1) SHL 16+
	 +(GetGValue(aColor) SHR 1) SHL  8+
	 +(GetRValue(aColor) SHR 1);
END;

(*---------------------------------*)
PROCEDURE TBerlinPie.SetState( aState: TState );

BEGIN
myExtra.xState := aState;
CASE myExtra.xState OF
  stOn	: IF myExtra.xDimmed THEN
	    myPieParas.ppBrushColor := ColorDim
	   ELSE
	    myPieParas.ppBrushColor := ColorOn;
  stOff	: IF myExtra.xDimmed THEN
	    myPieParas.ppBrushColor := GetDimmedColor(ColorOff)
	   ELSE
	    myPieParas.ppBrushColor := ColorOff;
  END;
IF myExtra.xDimmed THEN
  myPieParas.ppBorderColor := GetDimmedColor(ColorBorder)
 ELSE
  myPieParas.ppBorderColor := ColorBorder;
END;

(*---------------------------------*)
PROCEDURE TBerlinPie.SetDimmed( aValue: BOOLEAN );

BEGIN
myExtra.xDimmed := aValue;
SetState( myExtra.xState );
END;

(*---------------------------------*)
FUNCTION  TBerlinPie.GetStateChanged( VAR aValue: DWORD ): BOOLEAN;

BEGIN
IF aValue >= myExtra.xSecondsRef THEN
  BEGIN
  Dec( aValue, myExtra.xSecondsDec );
  IF myExtra.xState = stOff THEN
    BEGIN
    Result := true;
    SetState( stOn );
    END
   ELSE
    BEGIN
    Result := false;
    END;
  END
 ELSE
  BEGIN
  IF myExtra.xState = stOn THEN
    BEGIN
    Result := true;
    SetState( stOff );
    END
   ELSE
    BEGIN
    Result := false;
    END;
  END;
END;

(*=================================*)
CONSTRUCTOR TBerlinUhr.Create( aColors: TBerlinUhrColors; aWidth, aHeight, aBorderWidth: INTEGER );

VAR
  tmpExtra	: TExtra;
  tmpPieParas	: TPieParas;


BEGIN
bIsPainting	:= false;
bUpdateAll	:= true;
FillChar(tmpPieParas, SizeOf(tmpPieParas), 0);		//!!
FillChar(tmpExtra, SizeOf(tmpExtra), 0);		//!!
myBitmap       	:= TBitmap.Create;
myBitmap.Width 	:= aWidth;
myBitmap.Height	:= aHeight;

// Stunden ----------------
WITH tmpPieParas DO
  BEGIN
  ppBorderWidth		:= aBorderWidth;
  ppdStartAngle		:= 0.0;
  ppdStopAngle		:= Pi;
  ppdRadiusX		:= 0.75*Int(myBitmap.Width);
  ppdRadiusY		:= 0.75*Int(myBitmap.Height);
  ppdOriginX		:= 0.5*Int(myBitmap.Width);
  ppdOriginY		:= 0.5*Int(myBitmap.Height);
  ppdMulX  		:=  1.0;
  ppdMulY  		:= -1.0
  END;
WITH tmpExtra DO
  BEGIN
  xSecondsDec		:= 43200;			// 12Std
  xSecondsRef		:= 43200;
  xDimmed		:= false;
  END;
allPies[1]		:= TBerlinPie.CreateWithParas( tmpPieParas, tmpExtra );

WITH tmpPieParas DO
  BEGIN
  ppdStartAngle		:= 0.0;
  ppdStopAngle		:= Pi;
  ppdRadiusX		:= 0.45*Int(myBitmap.Width);
  ppdRadiusY		:= 0.45*Int(myBitmap.Height);
  END;
WITH tmpExtra DO
  BEGIN
  xSecondsDec		:= 21600;			// 6Std
  xSecondsRef		:= 21600;
  END;
allPies[2]		:= TBerlinPie.CreateWithParas( tmpPieParas, tmpExtra );

WITH tmpPieParas DO
  BEGIN
  ppdStartAngle		:= 2.0/5.0*Pi;
  ppdStopAngle		:= 3.0/5.0*Pi;
  ppdRadiusX		:= 0.35*Int(myBitmap.Width);
  ppdRadiusY		:= 0.35*Int(myBitmap.Height);
  END;
WITH tmpExtra DO
  BEGIN
  xSecondsDec		:=  3600;			// 1Std
  xSecondsRef		:= 18000;
  END;
allPies[3]		:= TBerlinPie.CreateWithParas( tmpPieParas, tmpExtra );

WITH tmpPieParas DO
  BEGIN
  ppdStartAngle		:= 1.0/5.0*Pi;
  ppdStopAngle		:= 2.0/5.0*Pi;
  END;
WITH tmpExtra DO
  BEGIN
  xSecondsRef		:= 14400;
  END;
allPies[4]		:= TBerlinPie.CreateWithParas( tmpPieParas, tmpExtra );

WITH tmpPieParas DO
  BEGIN
  ppdStartAngle		:= 3.0/5.0*Pi;
  ppdStopAngle		:= 4.0/5.0*Pi;
  END;
WITH tmpExtra DO
  BEGIN
  xSecondsRef		:= 10800;
  END;
allPies[5]		:= TBerlinPie.CreateWithParas( tmpPieParas, tmpExtra );

WITH tmpPieParas DO
  BEGIN
  ppdStartAngle		:= 0.0/5.0*Pi;
  ppdStopAngle		:= 1.0/5.0*Pi;
  END;
WITH tmpExtra DO
  BEGIN
  xSecondsRef		:= 7200;
  END;
allPies[6]		:= TBerlinPie.CreateWithParas( tmpPieParas, tmpExtra );

WITH tmpPieParas DO
  BEGIN
  ppdStartAngle		:= 4.0/5.0*Pi;
  ppdStopAngle		:= 5.0/5.0*Pi;