📄 upie.pas

📁 an example of screen savers using delphi
💻 PAS
📖 第 1 页 / 共 2 页
字号:
上一页 12
  END;
WITH tmpExtra DO
  BEGIN
  xSecondsRef		:= 3600;
  END;
allPies[7]		:= TBerlinPie.CreateWithParas( tmpPieParas, tmpExtra );

// Minuten ----------------
WITH tmpPieParas DO
  BEGIN
  ppdStartAngle		:= 1.0/3.0*Pi;
  ppdStopAngle		:= 2.0/3.0*Pi;
  ppdRadiusX		:= 0.2*Int(myBitmap.Width);
  ppdRadiusY		:= 0.2*Int(myBitmap.Height);
  END;
WITH tmpExtra DO
  BEGIN
  xSecondsDec		:= 900;				// 15Min
  xSecondsRef		:= 2700;
  xDimmed		:= false;
  END;
allPies[8]		:= TBerlinPie.CreateWithParas( tmpPieParas, tmpExtra );

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

WITH tmpPieParas DO
  BEGIN
  ppdStartAngle		:= 2.0/3.0*Pi;
  ppdStopAngle		:= 3.0/3.0*Pi;
  END;
WITH tmpExtra DO
  BEGIN
  xSecondsRef		:= 900;
  END;
allPies[10]		:= TBerlinPie.CreateWithParas( tmpPieParas, tmpExtra );

WITH tmpPieParas DO
  BEGIN
  ppdStartAngle		:= 3.0/2.0*Pi;
  ppdStopAngle		:= 4.0/2.0*Pi;
  ppdRadiusX		:= 0.75*Int(myBitmap.Width);
  ppdRadiusY		:= 0.75*Int(myBitmap.Height);
  END;
WITH tmpExtra DO
  BEGIN
  xSecondsDec		:= 300;				// 5Min
  xSecondsRef		:= 600;
  END;
allPies[11]		:= TBerlinPie.CreateWithParas( tmpPieParas, tmpExtra );

WITH tmpPieParas DO
  BEGIN
  ppdStartAngle		:= 2.0/2.0*Pi;
  ppdStopAngle		:= 3.0/2.0*Pi;
  END;
WITH tmpExtra DO
  BEGIN
  xSecondsRef		:= 300;
  END;
allPies[12]		:= TBerlinPie.CreateWithParas( tmpPieParas, tmpExtra );

WITH tmpPieParas DO
  BEGIN
  ppdStartAngle		:= 6.0/4.0*Pi;
  ppdStopAngle		:= 7.0/4.0*Pi;
  ppdRadiusX		:= 0.45*Int(myBitmap.Width);
  ppdRadiusY		:= 0.45*Int(myBitmap.Height);
  END;
WITH tmpExtra DO
  BEGIN
  xSecondsDec		:= 60;				// 1Min
  xSecondsRef		:= 240;
  END;
allPies[13]		:= TBerlinPie.CreateWithParas( tmpPieParas, tmpExtra );

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

WITH tmpPieParas DO
  BEGIN
  ppdStartAngle		:= 7.0/4.0*Pi;
  ppdStopAngle		:= 8.0/4.0*Pi;
  END;
WITH tmpExtra DO
  BEGIN
  xSecondsRef		:= 120;
  END;
allPies[15]		:= TBerlinPie.CreateWithParas( tmpPieParas, tmpExtra );

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

// Sekunden ----------------
WITH tmpPieParas DO
  BEGIN
  ppdStartAngle		:= 7.0/5.0*Pi;
  ppdStopAngle		:= 8.0/5.0*Pi;
  ppdRadiusX		:= 0.35*Int(myBitmap.Width);
  ppdRadiusY		:= 0.35*Int(myBitmap.Height);
  END;
WITH tmpExtra DO
  BEGIN
  xSecondsDec		:= 10;					// 10Sec
  xSecondsRef		:= 50;
  xDimmed		:= false;
  END;
allPies[17]		:= TBerlinPie.CreateWithParas( tmpPieParas, tmpExtra );

WITH tmpPieParas DO
  BEGIN
  ppdStartAngle		:= 8.0/5.0*Pi;
  ppdStopAngle		:= 9.0/5.0*Pi;
  END;
WITH tmpExtra DO
  BEGIN
  xSecondsRef		:= 40;
  END;
allPies[18]		:= TBerlinPie.CreateWithParas( tmpPieParas, tmpExtra );

WITH tmpPieParas DO
  BEGIN
  ppdStartAngle		:= 6.0/5.0*Pi;
  ppdStopAngle		:= 7.0/5.0*Pi;
  END;
WITH tmpExtra DO
  BEGIN
  xSecondsRef		:= 30;
  END;
allPies[19]		:= TBerlinPie.CreateWithParas( tmpPieParas, tmpExtra );

WITH tmpPieParas DO
  BEGIN
  ppdStartAngle		:= 9.0/5.0*Pi;
  ppdStopAngle		:= 10.0/5.0*Pi;
  END;
WITH tmpExtra DO
  BEGIN
  xSecondsRef		:= 20;
  END;
allPies[20]		:= TBerlinPie.CreateWithParas( tmpPieParas, tmpExtra );

WITH tmpPieParas DO
  BEGIN
  ppdStartAngle		:= 5.0/5.0*Pi;
  ppdStopAngle		:= 6.0/5.0*Pi;
  END;
WITH tmpExtra DO
  BEGIN
  xSecondsRef		:= 10;
  END;
allPies[21]		:= TBerlinPie.CreateWithParas( tmpPieParas, tmpExtra );

WITH tmpPieParas DO
  BEGIN
  ppdStartAngle		:= 5.001/5.0*Pi;
  ppdStopAngle		:= 10.0/5.0*Pi;
  ppdRadiusX		:= 0.275*Int(myBitmap.Width);
  ppdRadiusY		:= 0.275*Int(myBitmap.Height);
  END;
WITH tmpExtra DO
  BEGIN
  xSecondsDec		:= 5;					// 5Sec
  xSecondsRef		:= 5;
  END;
allPies[22]		:= TBerlinPie.CreateWithParas( tmpPieParas, tmpExtra );

WITH tmpPieParas DO
  BEGIN
  ppdStartAngle		:= 5.995/4.0*Pi;
  ppdStopAngle		:= 7.0/4.0*Pi;
  ppdRadiusX		:= 0.2*Int(myBitmap.Width);
  ppdRadiusY		:= 0.2*Int(myBitmap.Height);
  END;
WITH tmpExtra DO
  BEGIN
  xSecondsDec		:= 1;					// 1Sec
  xSecondsRef		:= 4;
  END;
allPies[23]		:= TBerlinPie.CreateWithParas( tmpPieParas, tmpExtra );

WITH tmpPieParas DO
  BEGIN
  ppdStartAngle		:= 5.0/4.0*Pi;
  ppdStopAngle		:= 5.995/4.0*Pi;
  END;
WITH tmpExtra DO
  BEGIN
  xSecondsDec		:= 1;					// 1Sec
  xSecondsRef		:= 3;
  END;
allPies[24]		:= TBerlinPie.CreateWithParas( tmpPieParas, tmpExtra );

WITH tmpPieParas DO
  BEGIN
  ppdStartAngle		:= 7.0/4.0*Pi;
  ppdStopAngle		:= 8.0/4.0*Pi;
  END;
WITH tmpExtra DO
  BEGIN
  xSecondsDec		:= 1;					// 1Sec
  xSecondsRef		:= 2;
  END;
allPies[25]		:= TBerlinPie.CreateWithParas( tmpPieParas, tmpExtra );

WITH tmpPieParas DO
  BEGIN
  ppdStartAngle		:= 4.0/4.0*Pi;
  ppdStopAngle		:= 5.0/4.0*Pi;
  END;
WITH tmpExtra DO
  BEGIN
  xSecondsDec		:= 1;					// 1Sec
  xSecondsRef		:= 1;
  END;
allPies[26]		:= TBerlinPie.CreateWithParas( tmpPieParas, tmpExtra );

SetColors( aColors );
END;

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

VAR
  iCount : INTEGER;

BEGIN
WHILE bIsPainting DO
  BEGIN
  AppendText(' was painting' );
  Sleep(100);
  Application.ProcessMessages;
  END;

myBitmap.Free;
FOR iCount := Low(allPies) TO High(allPies) DO
  allPies[iCount].Free;
END;

(*---------------------------------*)
FUNCTION TBerlinUhr.GetBitmap( aDateTime: TDateTime ): TBitmap;

VAR
  wHr, wM, wS, wD	: WORD;
  dwSeconds		: DWORD;
  iCount		: INTEGER;

BEGIN
IF NOT( bIsPainting ) THEN
  BEGIN
  bIsPainting	:= true;
  DecodeTime( aDateTime, wHr, wM, wS, wD );
  dwSeconds	:= wHr*3600+wM*60+wS;
  FOR iCount := Low(allPies) TO High(allPies) DO
    BEGIN
    IF Assigned(allPies[iCount]) THEN
      BEGIN
      WITH allPies[iCount] DO
	BEGIN
	IF GetStateChanged( dwSeconds ) OR bUpdateAll THEN
	  BEGIN
	  myBitmap.Canvas.Brush.Color	:= BrushColor;
	  myBitmap.Canvas.Pen.Color 	:= BorderColor;
	  myBitmap.Canvas.Pen.Width	:= BorderWidth;
	  myBitmap.Canvas.Pie( 	BoundingRect.X1, BoundingRect.Y1, BoundingRect.X2,BoundingRect.Y2,
				PieRect.X1, PieRect.Y1, PieRect.X2, PieRect.Y2
			     );
	  END; {IF GetStateChanged}
	END; {WITH allPies}
      END; {IF Assigned}
    END; {FOR iCount}
  bUpdateAll	:= false;
  bIsPainting	:= false;
  END; {IF NOT( bIsPainting )}

Result 		:= myBitmap;
END;

(*---------------------------------*)
PROCEDURE TBerlinUhr.DimmAll( bDimmed: BOOLEAN );

VAR
  iCount		: INTEGER;

BEGIN
FOR iCount := Low(allPies) TO High(allPies) DO
  IF Assigned(allPies[iCount]) THEN
    allPies[iCount].Dimmed := bDimmed;

Refresh;
END;

(*---------------------------------*)
PROCEDURE TBerlinUhr.Refresh;

BEGIN
bUpdateAll	:= true;
END;

(*---------------------------------*)
PROCEDURE TBerlinUhr.SetColors( aColors: TBerlinUhrColors );

VAR
  iCount		: INTEGER;

BEGIN
myColors := aColors;
FOR iCount := 1 TO 7 DO				//Stunden
  BEGIN
  IF Assigned(allPies[iCount]) THEN
    BEGIN
    WITH allPies[iCount] DO
      BEGIN
      ColorOn		:= aColors.bucHColorOn;
      ColorDim		:= aColors.bucHColorDim;
      ColorOff		:= aColors.bucHColorOff;
      ColorBorder	:= aColors.bucBorderColor;
      State		:= State;     		//!!!! RaRuRick Babatrick !!!
      END;
    END;
  END;

FOR iCount := 8 TO 16 DO			//Minuten
  BEGIN
  IF Assigned(allPies[iCount]) THEN
    BEGIN
    WITH allPies[iCount] DO
      BEGIN
      ColorOn		:= aColors.bucMColorOn;
      ColorDim		:= aColors.bucMColorDim;
      ColorOff		:= aColors.bucMColorOff;
      ColorBorder	:= aColors.bucBorderColor;
      State		:= State;     		//!!!! RaRuRick Babatrick !!!
      END;
    END;
  END;

FOR iCount := 17 TO 26 DO			//Sekunden
  BEGIN
  IF Assigned(allPies[iCount]) THEN
    BEGIN
    WITH allPies[iCount] DO
      BEGIN
      ColorOn		:= aColors.bucSColorOn;
      ColorDim		:= aColors.bucSColorDim;
      ColorOff		:= aColors.bucSColorOff;
      ColorBorder	:= aColors.bucBorderColor;
      State		:= State;     		//!!!! RaRuRick Babatrick !!!
      END;
    END;
  END;

Refresh;
END;

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

BEGIN
WITH myDefColors DO
  BEGIN
  bucBorderColor	:= clSilver;
  bucHColorOn		:= $000000FF;
  bucHColorDim		:= $0000007F;
  bucHColorOff		:= clGray;
  bucMColorOn		:= $0000FF00;
  bucMColorDim 		:= $00007F00;
  bucMColorOff		:= clGray;
  bucSColorOn		:= $00FF0000;
  bucSColorDim		:= $007F0000;;
  bucSColorOff		:= clGray;
  END;

strKey	:= '\Software\UweC\'+Application.Title;
myRegistry := TRegistry.Create;
WITH myRegistry DO
  BEGIN
  RootKey := HKEY_CURRENT_USER;
  IF NOT(OpenKey(strKey, false)) THEN
    BEGIN
    SetBerlinUhrColors( myDefColors );
    CloseKey;
    END;
  END;
END;

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

BEGIN
myRegistry.Free;
END;

(*---------------------------------*)
FUNCTION TBerlinUhrRegEntries.GetBerlinUhrColors: TBerlinUhrColors;

BEGIN
WITH myRegistry DO
  BEGIN
  IF OpenKey( strKey, false ) THEN
    BEGIN
    TRY
      WITH Result DO
	BEGIN
	bucBorderColor	:= ReadInteger( 'BorderColor' );
	bucHColorOn   	:= ReadInteger( 'hColorOn' );
	bucHColorDim  	:= ReadInteger( 'hColorDim' );
	bucHColorOff  	:= ReadInteger( 'hColorOff' );
	bucMColorOn   	:= ReadInteger( 'mColorOn' );
	bucMColorDim  	:= ReadInteger( 'mColorDim' );
	bucMColorOff  	:= ReadInteger( 'mColorOff' );
	bucSColorOn   	:= ReadInteger( 'sColorOn' );
	bucSColorDim  	:= ReadInteger( 'sColorDim' );
	bucSColorOff  	:= ReadInteger( 'sColorOff' );
	END;
     FINALLY
      CloseKey;
      END;
    END
   ELSE
    BEGIN
    Result := myDefColors;
    END; {IF}
  END; {WITH myRegistry}
END;

(*---------------------------------*)
PROCEDURE TBerlinUhrRegEntries.SetBerlinUhrColors( aColors: TBerlinUhrColors );

BEGIN
WITH myRegistry DO
  BEGIN
  IF OpenKey( strKey, true ) THEN
    BEGIN
    TRY
      WITH aColors DO
	BEGIN
	WriteInteger( 'BorderColor', 	bucBorderColor );
	WriteInteger( 'hColorOn',   	bucHColorOn );
	WriteInteger( 'hColorDim',  	bucHColorDim );
	WriteInteger( 'hColorOff',  	bucHColorOff );
	WriteInteger( 'mColorOn',   	bucMColorOn );
	WriteInteger( 'mColorDim',  	bucMColorDim );
	WriteInteger( 'mColorOff',  	bucMColorOff );
	WriteInteger( 'sColorOn',   	bucSColorOn );
	WriteInteger( 'sColorDim',  	bucSColorDim );
	WriteInteger( 'sColorOff',  	bucSColorOff );
	END;
     FINALLY
      CloseKey;
      END;
    END;
  END;
END;

(*+++++++++++++++++++++++++++++++++*)
END.
上一页 12
💿 文件大小 710 K
👤 上传用户 janeljh1
📂 所属分类 Delphi控件源码
🏷️ 相关标签

#example #delphi #screen #savers
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -