下雪特效_数组program Snow;

下雪特效_数组

下雪特效_数组uses

下雪特效_数组  Windows, Messages;

下雪特效_数组

下雪特效_数组const

下雪特效_数组  SnowNumber = 500; // 雪点数量-1

下雪特效_数组

下雪特效_数组type

下雪特效_数组  SnowNode = record

下雪特效_数组    Point: TPoint;  // 雪点位置

下雪特效_数组    Color: Integer; // 先前颜色

下雪特效_数组    Speed: Integer; // 下落速率

下雪特效_数组    nMove: Integer; // 下落距离

下雪特效_数组    Stick: Integer; // '粘连'度

下雪特效_数组  end;

下雪特效_数组

下雪特效_数组var

下雪特效_数组  SnowNodes: array[0..SnowNumber] 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[J].Point.X := Random(ScreenWidth);

下雪特效_数组    SnowNodes[J].Point.Y := Random(ScreenHeight);

下雪特效_数组    SnowNodes[J].Color := GetPixel(hScreenDc, SnowNodes[J].Point.X, SnowNodes[J].Point.Y);

下雪特效_数组    SnowNodes[J].Speed := Random(5) + 1; // 几次循环作下落一次 (1~5)

下雪特效_数组    SnowNodes[J].nMove := Random(SnowNodes[J].Speed)+1; // 每次下落距离(1~5)

下雪特效_数组    SnowNodes[J].Stick := 30 - Random(SnowNodes[J].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[I].Speed) <> 0 then Continue;

下雪特效_数组   // 恢复上次被覆盖点

下雪特效_数组    if GetPixel(hScreenDc, SnowNodes[I].Point.X, SnowNodes[I].Point.Y) = $FFFFFF then

下雪特效_数组      SetPixel(hScreenDc, SnowNodes[I].Point.X, SnowNodes[I].Point.Y, SnowNodes[I].Color);

下雪特效_数组   // 根据风向作随机飘落

下雪特效_数组    X := SnowNodes[I].Point.X + Random(3) - 1 + CrWind;

下雪特效_数组    Y := SnowNodes[I].Point.Y + SnowNodes[I].nMove;

下雪特效_数组   // 积雪(停留)效果处理  SnowNodes[J].Stick

下雪特效_数组    if ( (CrStep mod SnowNodes[I].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[I].Point.Y := Random(10);

下雪特效_数组      SnowNodes[I].Point.X := Random(ScreenWidth);

下雪特效_数组      SnowNodes[I].Color := GetPixel(hScreenDc, SnowNodes[I].Point.X, SnowNodes[I].Point.Y);

下雪特效_数组    end else

下雪特效_数组    begin

下雪特效_数组      if (X < 0) or (X > ScreenWidth) or (Y > ScreenHeight) then // 超出范围则重生雪点

下雪特效_数组      begin

下雪特效_数组        SnowNodes[I].Point.Y := Random(10);

下雪特效_数组        SnowNodes[I].Point.X := Random(ScreenWidth);

下雪特效_数组        SnowNodes[I].Color := GetPixel(hScreenDc, SnowNodes[I].Point.X, SnowNodes[I].Point.Y);

下雪特效_数组      end else

下雪特效_数组      begin

下雪特效_数组       // 保存颜色并绘制雪点

下雪特效_数组        SnowNodes[I].Color := GetPixel(hScreenDc, X, Y);

下雪特效_数组        SetPixel(hScreenDc, X, Y, $FFFFFF);

下雪特效_数组       // 此时保存新雪点位置

下雪特效_数组        SnowNodes[I].Point.X := X;

下雪特效_数组        SnowNodes[I].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.