Unit1.pas
上传用户:lizd1980
上传日期:2021-04-29
资源大小:156k
文件大小:6k
源码类别:

屏幕保护

开发平台:

Windows_Unix

  1. unit Unit1;
  2. interface
  3. uses
  4.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  5.   Dialogs;
  6. type
  7.   SnowNode = record
  8.     Point: TPoint;  // 雪点位置
  9.     Color: Integer; // 先前颜色
  10.     Speed: Integer; // 下落速率
  11.     nMove: Integer; // 下落距离
  12.     Stick: Integer; // '粘连'度
  13.   end;
  14. type
  15.   TForm1 = class(TForm)
  16.   private
  17.     { Private declarations }
  18.   public
  19.   // program  Snow;
  20.     { Public declarations }
  21.   end;
  22. const
  23.   SnowNumber = 888; // 雪点数量-1
  24. var
  25.   Form1: TForm1;
  26.   SnowNodes: array[0..SnowNumber] of SnowNode; // 雪点数组
  27.   hTimer: Integer; // '随机风向'时钟句柄
  28.   CrWind: Integer; // 当前'风向' ( -1 ~ 1 )
  29.   CrStep: Integer; // 当前循环步数(用于限速)
  30.   ScreenWidth, ScreenHeight: Integer; // 屏幕尺寸
  31. implementation
  32. {$R *.dfm}
  33.   // 取屏幕尺寸 -> ScreenWidth, ScreenHeight
  34. procedure GetScreenSize;
  35. begin
  36.   ScreenWidth := GetSystemMetrics(SM_CXSCREEN);
  37.   ScreenHeight := GetSystemMetrics(SM_CYSCREEN);
  38. end;
  39.   // '随机风向'时钟
  40. procedure TimerProc(hWnd: HWND; uMsg: UINT; idEvent: UINT; dwTime: DWORD); stdcall;
  41. begin
  42.   SetTimer(0, hTimer, (Random(27)+4) * 500, @TimerProc); // 重设下次风向改变时间
  43.   if (CrWind <> 0) then CrWind := 0 else CrWind := Random(3) - 1; // 修改风向
  44. end;
  45.   // 初始化雪点数组
  46. procedure InitSnowNodes;
  47. var
  48.   hScreenDc, J: Integer;
  49. begin
  50.   hScreenDc := CreateDC('DISPLAY', nil, nil, nil);
  51.   for J := 0 to SnowNumber do
  52.   begin
  53.     SnowNodes[J].Point.X := Random(ScreenWidth);
  54.     SnowNodes[J].Point.Y := Random(ScreenHeight);
  55.     SnowNodes[J].Color := GetPixel(hScreenDc, SnowNodes[J].Point.X, SnowNodes[J].Point.Y);
  56.     SnowNodes[J].Speed := Random(5) + 1; // 几次循环作下落一次 (1~5)
  57.     SnowNodes[J].nMove := Random(SnowNodes[J].Speed)+1; // 每次下落距离(1~5)
  58.     SnowNodes[J].Stick := 30 - Random(SnowNodes[J].Speed); // '粘连'度(几次循环作一次粘连判断)
  59.   end;
  60.   DeleteDC(hScreenDc);
  61. end;
  62.   // 移动雪点 ..
  63. procedure MoveSnowNodes;
  64. var
  65.   hScreenDc, I, X, Y: Integer;
  66. begin
  67.   hScreenDc := CreateDC('DISPLAY', nil, nil, nil);
  68.   for I := 0 to SnowNumber do
  69.   begin
  70.    // 控制雪点下降速率
  71.     if (CrStep mod SnowNodes[I].Speed) <> 0 then Continue;
  72.    // 恢复上次被覆盖点
  73.     if GetPixel(hScreenDc, SnowNodes[I].Point.X, SnowNodes[I].Point.Y) = $FFFFFF then
  74.       SetPixel(hScreenDc, SnowNodes[I].Point.X, SnowNodes[I].Point.Y, SnowNodes[I].Color);
  75.    // 根据风向作随机飘落
  76.     X := SnowNodes[I].Point.X + Random(3) - 1 + CrWind;
  77.     Y := SnowNodes[I].Point.Y + SnowNodes[I].nMove;
  78.    // 积雪(停留)效果处理
  79.     if ( (CrStep mod SnowNodes[I].Stick) = 0 ) // 降低积雪概率 ..
  80.        and ( GetPixel(hScreenDc, X, Y) <> GetPixel(hScreenDc, X, Y+1) ) // '边缘'判断
  81.        and ( GetPixel(hScreenDc, X-1, Y) <> GetPixel(hScreenDc, X-1, Y+1) )
  82.        and ( GetPixel(hScreenDc, X+1, Y) <> GetPixel(hScreenDc, X+1, Y+1) ) then
  83.     begin
  84.      // 稍微调整坐标
  85.       if GetPixel(hScreenDc, X, Y-1) = GetPixel(hScreenDc, X, Y-2) then Dec(Y) // 上边缘
  86.       else if GetPixel(hScreenDc, X, Y+1) = GetPixel(hScreenDc, X, Y+2) then Inc(Y); // 下边缘
  87.       Inc(X, CrWind);
  88.      // 画五个点(雪花)
  89.       SetPixel(hScreenDc, X, Y, $FFFFFF);
  90.       SetPixel(hScreenDc, X+1, Y+1, $FFFFFF);
  91.       SetPixel(hScreenDc, X-1, Y+1, $FFFFFF);
  92.       SetPixel(hScreenDc, X+1, Y-1, $FFFFFF);
  93.       SetPixel(hScreenDc, X-1, Y-1, $FFFFFF);
  94.      // 重生雪点
  95.       SnowNodes[I].Point.Y :=Random(10);
  96.       SnowNodes[I].Point.X := Random(ScreenWidth);
  97.       SnowNodes[I].Color := GetPixel(hScreenDc, SnowNodes[I].Point.X, SnowNodes[I].Point.Y);
  98.     end else
  99.     begin
  100.       if (X < 0) or (X > ScreenWidth) or (Y > ScreenHeight) then // 超出范围则重生雪点
  101.       begin
  102.         SnowNodes[I].Point.Y := Random(10);
  103.         SnowNodes[I].Point.X := Random(ScreenWidth);
  104.         SnowNodes[I].Color := GetPixel(hScreenDc, SnowNodes[I].Point.X, SnowNodes[I].Point.Y);
  105.       end else
  106.       begin
  107.        // 保存颜色并绘制雪点
  108.         SnowNodes[I].Color := GetPixel(hScreenDc, X, Y);
  109.         SetPixel(hScreenDc, X, Y, $FFFFFF);
  110.        // 此时保存新雪点位置
  111.         SnowNodes[I].Point.X := X;
  112.         SnowNodes[I].Point.Y := Y;
  113.       end;
  114.     end;
  115.   end;
  116.   DeleteDC(hScreenDc);
  117.   Inc(CrStep);
  118. end;  
  119. var
  120.   ThreadMsg: TMsg;  // 标准消息结构体
  121.   Frequency: Int64; // 高性能定时器频率
  122.   StartCt, EndCt: Int64; // 高性能定时器计数
  123.   ElapsedTime: Extended; // 时间间隔
  124. begin
  125.   Randomize;  GetScreenSize;  InitSnowNodes; // 初始化
  126.   QueryPerformanceFrequency(Frequency); // 高性能定时器频率
  127.   hTimer := SetTimer(0, 0, Random(5)*500, @TimerProc); // 安装随机风向定时器
  128.   RegisterHotKey(0, 0, 0, ord(vk_Escape)); // 注册退出热键 ESC  RegisterHotKey(0, 0, MOD_CONTROL, ORD('L')) 注册退出热键Ctrl+L
  129.   while TRUE do // 消息循环
  130.   begin
  131.     QueryPerformanceCounter(StartCt); // 执行运算前 计数值
  132.     if PeekMessage(ThreadMsg, 0, 0, 0, PM_REMOVE) then // 取到消息
  133.     begin
  134.       case ThreadMsg.message of
  135.         WM_TIMER:
  136.           TimerProc(0, 0, 0, 0); // 预设风向改变时间已到
  137.         WM_HOTKEY:
  138.           begin
  139.             KillTimer(0, hTimer); // 删除随机风向定时器
  140.             application.Terminate; //结束程序
  141.             UnregisterHotKey(0, 0); // 删除退出热键 ESC
  142.             InvalidateRect(0, nil, TRUE); // 刷新屏幕
  143.             Break; // 跳出消息循环
  144.           end;
  145.         WM_DISPLAYCHANGE:
  146.           begin
  147.             GetScreenSize; // 重新取屏幕尺寸
  148.             InitSnowNodes; // 初始化雪点数组
  149.           end;
  150.       end;
  151.     end;
  152.     MoveSnowNodes; // 移动雪点
  153.     QueryPerformanceCounter(EndCt); // 执行运算后计数值
  154.     ElapsedTime := (EndCt-StartCt)/Frequency; 
  155.     if (ElapsedTime < 0.0005) then Sleep(2) // 简单限速
  156.     else if (ElapsedTime < 0.0010) then Sleep(1)
  157.          else if (ElapsedTime < 0.0015) then Sleep(0);
  158.   end;
  159. end.