能让雪下得更快更多点并在前台显示吗？

冥界3大法王 发表于 2024-1-31 23:20

{:301_974:}

program Project6;

uses
Windows,
Messages;

const
SnowNumber = 500; // 雪点数量-1

type
SnowNode = record
Point: TPoint;// 雪点位置
Color: Integer; // 先前颜色
Speed: Integer; // 下落速率
nMove: Integer; // 下落距离
Stick: Integer; // '粘连'度
end;

var
SnowNodes: array of SnowNode; // 雪点数组
hTimer: Integer; // '随机风向'时钟句柄
CrWind: Integer; // 当前风向 ( -1 ~ 1 )
CrStep: Integer; // 当前循环步数(用于限速)
ScreenWidth, ScreenHeight: Integer; // 屏幕尺寸

// 取屏幕尺寸 -> ScreenWidth, ScreenHeight

procedure GetScreenSize;
begin
ScreenWidth := GetSystemMetrics(SM_CXSCREEN);
ScreenHeight := GetSystemMetrics(SM_CYSCREEN);
end;

// 初始化雪点数组
procedure InitSnowNodes;
var
hScreenDc, J: Integer;
begin
hScreenDc := CreateDC('DISPLAY', nil, nil, nil);
for J := 0 to SnowNumber do
begin
SnowNodes.Point.X := Random(ScreenWidth);
SnowNodes.Point.Y := Random(ScreenHeight);
SnowNodes.Color := GetPixel(hScreenDc, SnowNodes.Point.X, SnowNodes.Point.Y);
SnowNodes.Speed := Random(5) + 1; // 几次循环作下落一次 (1~5)
SnowNodes.nMove := Random(SnowNodes.Speed) + 1; // 每次下落距离(1~5)
SnowNodes.Stick := 30 - Random(SnowNodes.Speed); // '粘连'度
end;
DeleteDC(hScreenDc);
end;

// '随机风向'时钟
procedure TimerProc(hWnd: hWnd; uMsg: UINT; idEvent: UINT; dwTime: DWORD); stdcall;
begin
SetTimer(0, hTimer, (Random(27) + 4) * 500, @TimerProc); // 重设下次风向改变时间
if (CrWind <> 0) then
CrWind := 0
else
CrWind := Random(3) - 1; // 修改风向
end;

// 移动雪点
procedure MoveSnowNodes;
var
hScreenDc, I, X, Y: Integer;
begin
hScreenDc := CreateDC('DISPLAY', nil, nil, nil);
for I := 0 to SnowNumber do
begin
// 控制雪点下降速率
if (CrStep mod SnowNodes.Speed) <> 0 then
   Continue;
// 恢复上次被覆盖点
if GetPixel(hScreenDc, SnowNodes.Point.X, SnowNodes.Point.Y) = $FFFFFF then
   SetPixel(hScreenDc, SnowNodes.Point.X, SnowNodes.Point.Y, SnowNodes.Color);
// 根据风向作随机飘落
X := SnowNodes.Point.X + Random(3) - 1 + CrWind;
Y := SnowNodes.Point.Y + SnowNodes.nMove;
// 积雪(停留)效果处理SnowNodes.Stick
if ((CrStep mod SnowNodes.Stick) = 0) // 降低积雪概率 ..
   and (GetPixel(hScreenDc, X, Y) <> GetPixel(hScreenDc, X, Y + 1)) // '边缘'判断
   and (GetPixel(hScreenDc, X - 1, Y) <> GetPixel(hScreenDc, X - 1, Y + 1)) and (GetPixel(hScreenDc, X + 1, Y) <> GetPixel(hScreenDc, X + 1, Y + 1)) then
begin
// 稍微调整坐标
   if GetPixel(hScreenDc, X, Y - 1) = GetPixel(hScreenDc, X, Y - 2) then
   Dec(Y) // 上边缘
   else if GetPixel(hScreenDc, X, Y + 1) = GetPixel(hScreenDc, X, Y + 2) then
   Inc(Y); // 下边缘
   Inc(X, CrWind);
// 画三个点表示雪花
   SetPixel(hScreenDc, X, Y, $FFFFFF);
   SetPixel(hScreenDc, X + 1, Y + 1, $FFFFFF);
   SetPixel(hScreenDc, X - 1, Y + 1, $FFFFFF);
// 重生雪点
   SnowNodes.Point.Y := Random(10);
   SnowNodes.Point.X := Random(ScreenWidth);
   SnowNodes.Color := GetPixel(hScreenDc, SnowNodes.Point.X, SnowNodes.Point.Y);
end
else
begin
   if (X < 0) or (X > ScreenWidth) or (Y > ScreenHeight) then // 超出范围则重生雪点
   begin
   SnowNodes.Point.Y := Random(10);
   SnowNodes.Point.X := Random(ScreenWidth);
   SnowNodes.Color := GetPixel(hScreenDc, SnowNodes.Point.X, SnowNodes.Point.Y);
   end
   else
   begin
   // 保存颜色并绘制雪点
   SnowNodes.Color := GetPixel(hScreenDc, X, Y);
   SetPixel(hScreenDc, X, Y, $FFFFFF);
   // 此时保存新雪点位置
   SnowNodes.Point.X := X;
   SnowNodes.Point.Y := Y;
   end;
end;
end;
DeleteDC(hScreenDc);
CrStep := CrStep + 1;
end;

var
ThreadMsg: TMsg;// 标准消息结构体
Frequency: Int64; // 高性能定时器频率
StartCt, EndCt: Int64; // 高性能定时器计数
ElapsedTime: Extended; // 时间间隔

begin
GetScreenSize; // 预置屏幕范围
InitSnowNodes; // 初始化雪点数组
QueryPerformanceFrequency(Frequency); // 高性能定时器频率
hTimer := SetTimer(0, 0, Random(5) * 500, @TimerProc); // 安装随机风向定时器
RegisterHotKey(0, 0, MOD_CONTROL, ORD('L')); // 注册退出热键 Ctrl+L
while TRUE do // 消息循环
begin
QueryPerformanceCounter(StartCt); // 执行运算前计数值
if PeekMessage(ThreadMsg, 0, 0, 0, PM_REMOVE) then // 取到消息
begin
   case ThreadMsg.message of
   WM_TIMER:
      TimerProc(0, 0, 0, 0); // 取到时钟消息说明时间已到

   WM_HOTKEY:
      begin
         KillTimer(0, hTimer); // 删除随机风向定时器
         UnregisterHotKey(0, 0); // 删除退出热键 Ctrl+L
         InvalidateRect(0, nil, TRUE); // 刷新屏幕
         Break; // 跳出消息循环
      end;

   WM_DISPLAYCHANGE:
      begin
         GetScreenSize; // 重新取屏幕范围
         InitSnowNodes; // 初始化雪点数组
      end;
   end;
end;
MoveSnowNodes; // 移动雪点
QueryPerformanceCounter(EndCt); // 执行运算后计数值
ElapsedTime := (EndCt - StartCt) / Frequency;

if (ElapsedTime < 0.0005) then
   Sleep(3)
else if (ElapsedTime < 0.0010) then
   Sleep(2)
else if (ElapsedTime < 0.0015) then
   Sleep(1);
end;

end.

小明无敌 发表于 2024-2-1 03:44

SnowNodes.Speed := Random(5) + 1; // 几次循环作下落一次 (1~5)
Random改成3或者1试试随机数小一点
SnowNodes.nMove := Random(SnowNodes.Speed) + 1; // 每次下落距离(1~5)
这个也+1改成+2或者更高他每次下落的距离更长

alongzhenggang 发表于 2024-2-1 06:20

眨巴眨巴{:1_927:}

tl;dr 发表于 2024-2-1 06:51

不知道改成啥 发表于 2024-2-1 08:42

还以为是人工降雪没想到是代码问答
上面不是有个Speed下落速度控制吗改下就行吧

yang0318 发表于 2024-2-1 09:28

完全没看懂这是什么。

airball23 发表于 2024-2-1 13:09

楼主，可以试试让AI回答你，也许会有不错的结果

ljzbox 发表于 2024-2-1 13:47

发布个成品看看呗，喜欢工作时，操作屏幕时，能看到桌面下雪

liguanlin 发表于 2024-2-1 13:49

喜欢，就是没有见到成品~~~~

冥界3大法王 发表于 2024-2-1 16:43

liguanlin 发表于 2024-2-1 13:49
喜欢，就是没有见到成品~~~~

大婶，源码全给呢了。。。

页: [1] 2

吾爱破解 - 52pojie.cn's Archiver

能让雪下得更快更多点并在前台显示吗？