捐赠 | 广告 | 注册 | 发布 | 上传 | 关于我们    
  粤ICP备10103342号-1 DELPHI盒子 | 盒子文章 | 盒子问答悬赏 | 最新更新 | 盒子检索 | 下载中心 | 高级搜索    
  精品专区 | 繁體中文 | 奖励公告栏 | 直通车账号登陆 | 关闭GOOGLE广告 | 临时留言    
 
广告
评论：初步实现在屏幕上‘下雪’的效果
woundedsoul 12031 2005/1/23 9:56:52
爽！
beejump 10935 2004/12/25 19:54:05
多谢高手帮助！谢谢：）
nihaoqiang 10918 2004/12/24 21:09:13
我改成了线程执行的方式，只要在项目里加入该单元，即可实现下雪效果，加入窗口就很简单了。
unit SnowUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics;

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

  procedure StartSnow;
  procedure StopSnow;
implementation

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

  TSnowThread=class(TThread)
  public
    procedure Execute; override;
  end;

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

  procedure StartSnow;
  begin
    if SnowThread=nil then
      SnowThread:=TSnowThread.Create(false);

  end;

  procedure StopSnow;
  begin
    if SnowThread<>nil then
    begin
      SnowThread.Terminate;
      SnowThread.WaitFor;
      SnowThread.free;
      SnowThread:=nil;
    end;
  end;



  // 取屏幕尺寸 -> ScreenWidth, ScreenHeight
procedure GetScreenSize;
begin
  ScreenWidth := GetSystemMetrics(SM_CXSCREEN);
  ScreenHeight := GetSystemMetrics(SM_CYSCREEN);
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 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 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;
   // 积雪(停留)效果处理
    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);
  Inc(CrStep);
end;  


{ TSnowThread }
procedure TSnowThread.Execute;
var
  ThreadMsg: TMsg;  // 标准消息结构体
  Frequency: Int64; // 高性能定时器频率
  StartCt, EndCt: Int64; // 高性能定时器计数
  ElapsedTime: Extended; // 时间间隔
begin
  Randomize;  GetScreenSize;  InitSnowNodes; // 初始化
  QueryPerformanceFrequency(Frequency); // 高性能定时器频率
  hTimer := SetTimer(0, 0, Random(5)*500, @TimerProc); // 安装随机风向定时器
  repeat // 消息循环
    QueryPerformanceCounter(StartCt); // 执行运算前 计数值
    if PeekMessage(ThreadMsg, 0, 0, 0, PM_REMOVE) then // 取到消息
    begin
      case ThreadMsg.message of
        WM_TIMER:
          TimerProc(0, 0, 0, 0); // 预设风向改变时间已到

        WM_DISPLAYCHANGE:
          begin
          GetScreenSize; // 重新取屏幕尺寸
          InitSnowNodes; // 初始化雪点数组
          end;
      end;
    end;
    MoveSnowNodes; // 移动雪点
    QueryPerformanceCounter(EndCt); // 执行运算后计数值
    ElapsedTime := (EndCt-StartCt)/Frequency;
    if (ElapsedTime < 0.0005) then Sleep(2) // 简单限速
    else if (ElapsedTime < 0.0010) then Sleep(1)
         else if (ElapsedTime < 0.0015) then Sleep(0);
  until Terminated;
  KillTimer(0, hTimer); // 删除随机风向定时器
  InvalidateRect(0, nil, TRUE); // 刷新屏幕
end;

initialization
  StartSnow;

finalization
  StopSnow;
end.
beejump 10860 2004/12/23 16:45:00
哪位大虾帮个忙，我想在这个代码里面在下雪的同时显示一个窗体，由窗体里面显示图片，关闭窗体后下雪停止。

由于本人初学，所以请各位大虾帮帮忙
kongshanxuelin 10838 2004/12/23 10:45:08
设置字体颜色请使用以下函数，以下函数把字体设置成白色：
SetTextColor(hdc,$00ffffff);
动动脑筋，怎么把字体设置成渐变色，呵呵
你可以根据需要修改，至于MID资源文件，请使用工具：Resource Builder先把midi音乐编译成资源文件就可以在DELPHI中直接调用了。
另外这个程序的雪花还是不够逼真，谁有功夫再美化一下，呵呵
madbo 10822 2004/12/22 22:31:33
//使用资源文件，导入声音，《笑傲江湖》
{$R 1.RES}
搞不懂啊，佩服得俺五体投地了！
老大们赐教啊，怎么样把MID导入资源文件？？
tim001 10816 2004/12/22 18:15:44
实在是看不懂啊!!老大就是老大啊
arichman 10804 2004/12/22 14:38:34
显示的文字怎么设置颜色？ 怎么可以不管背景什么颜色都能显示？

还有点阵都怎么计算出来的？
kongshanxuelin 10777 2004/12/21 20:06:55
加上文本信息和背景音乐更佳，如下，MID音乐占用空间小，做成资源文件就OK了：

program Snow;

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, MPlayer,mmsystem;

const
  SnowNumber = 260; // 雪点数量-1
  SnowColor = $FFFFFF;

  num = 11;//组成的点数
  //组成的点相对中心的偏移
  SnowShapeX: array[0..num] of integer = (1, -1, 1, -1, 0, 1, 0, -1, 0, 2, 0, -2);
  SnowShapeY: array[0..num] of integer = (1, -1, -1, 1, 1, 0, -1, 0, 2, 0, -2, 0);

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

var
  SnowNodes: array[0..SnowNumber] of SnowNode; // 雪点数组
  hTimer: Integer; // '随机风向'时钟句柄
  hTimer1:integer;//卡片动态时钟句柄
  hc:integer=0;
  CrWind: Integer; // 当前'风向' ( -1 ~ 1 )
  CrStep: Integer; // 当前循环步数(用于限速)
  ScreenWidth, ScreenHeight: Integer; // 屏幕尺寸
  isshowtext:boolean=false;
  curhi:integer=100;
  curwi:integer=0;
  ARStream: TResourceStream;
  TempFile: string;
//使用资源文件，导入声音，《笑傲江湖》
{$R 1.RES}

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

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


procedure PrintInfo;
var
i,hdc:integer;
hi,wi:integer;
begin

 hi:=ScreenHeight div 2;
 wi:=screenWidth div 2;
 hdc := CreateDC('DISPLAY', nil, nil, nil);
 SetBkMode(hdc, TRANSPARENT);
 for I := wi-200 to wi+200 do
 begin
  setPixel(hdc,i,hi-100,$FF0000);
  setPixel(hdc,i,hi+100,$FF0000);
 end;
 for i:=hi-100 to hi+100 do
 begin
  setPixel(hdc,wi-200,i,$FF0000);
  setPixel(hdc,wi+200,i,$FF0000);
 end;
 if(hc mod 4=0) then
 begin
 textout(hdc,wi-200+20,hi-100+30, '祝我的朋友圣诞快乐，在新的一年赚钱多多',38);
 textout(hdc,wi-200+20,hi-100+60,'永远不要忘了我这个远方的老朋友，好盼望下雪的味道',48);
 textout(hdc,wi-200+20,hi-100+90,'你远方的朋友：薛林浩，网名：空山雪林',36);
 textout(hdc,wi-200+40,hi-100+130,'请戴上你的耳机，欣赏这首天澜之音！！！',38);
 textout(hdc,wi-200+20,hi-100+180,'【按CTRL+N看下一条信息，按CTRL+Q退出，DELPHI开发】',50);
 end
 else if(hc mod 4=1) then
 begin
 textout(hdc,wi-200+20,hi-100+30, '有句话一直想对你说，可你知道它的分量，一旦说出，',46);
 textout(hdc,wi-200+20,hi-100+60,'可能咱连朋友都没法做了，但我控制不住感情，混出头那天',52);
 textout(hdc,wi-200+20,hi-100+90,'一定请我吃饭。这顿饭我一定能等到。老哥，圣诞快乐！',50);
 textout(hdc,wi-200+20,hi-100+180,'【按CTRL+N看下一条信息，按CTRL+Q退出，DELPHI开发】',50);
 end
 else if(hc mod 4=2) then
 begin
 textout(hdc,wi-200+20,hi-100+30, '做坏事叫坏蛋，脑袋空空叫傻蛋，炒鱿鱼叫滚蛋，',44);
 textout(hdc,wi-200+20,hi-100+60,'骂人叫混蛋，呜呼哀哉叫完蛋，',28);
 textout(hdc,wi-200+20,hi-100+90,'啃不到骨头的去吃乌鸡白凤蛋，正在看短信的快乐圣诞！',50);
 textout(hdc,wi-200+20,hi-100+180,'【按CTRL+N看下一条信息，按CTRL+Q退出，DELPHI开发】',50);
 end
 else
 begin
 textout(hdc,wi-200+20,hi-100+30, '女人二十是半成品，三十是成品，',30);
 textout(hdc,wi-200+20,hi-100+60, '四十是精品，五十是极品，',24);
 textout(hdc,wi-200+20,hi-100+90, '六十是上品，七十是废品，八十是纪念品。',38);
 textout(hdc,wi-200+20,hi-100+120, '你永远是我心中的精品。老搭档，圣诞快乐！',40);
 textout(hdc,wi-200+20,hi-100+180,'【按CTRL+N看下一条信息，按CTRL+Q退出，DELPHI开发】',50);
 end;
 DeleteDC(hdc);
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 TimerProc1(hwnd:HWND;uMsg:UINT;idEvent:UINT;dwtime:Dword);stdcall;
begin
  SetTimer(0, hTimer1, 10, @TimerProc1);
end;

procedure moveText;
var
i:integer;
curwii:integer;
hdc:integer;
begin
  hdc := CreateDC('DISPLAY', nil, nil, nil);
  SetBkMode(hdc, TRANSPARENT);
  curhi:=screenHeight div 2;
  curwii:=screenWidth div 2;
  setPixel(hdc,curwi,curhi-100,$FF0000);
  setPixel(hdc,curwii-200+curwi,curhi+100,$FF0000);
  curwi:=curwi+1;
  DeleteDC(hdc);
end;
  // 初始化雪点数组

procedure InitSnowNodes;
var
j,k,hScreenDc: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);
    for k := 0 to num do
      SnowNodes[J].Color[k] := GetPixel(hScreenDc, SnowNodes[J].Point.X + SnowShapeX[k], SnowNodes[J].Point.Y + SnowShapeY[k]);
    SnowNodes[J].Speed := Random(5) + 1; // 几次循环作下落一次 (1~5)
    SnowNodes[J].nMove := Random(SnowNodes[J].Speed) + 3; // 每次下落距离(1~5)
    SnowNodes[J].Stick := 30 - Random(SnowNodes[J].Speed); // '粘连'度(几次循环作一次粘连判断)
  end;
    DeleteDC(hScreenDc);
end;

  // 移动雪点 ..

procedure MoveSnowNodes;
var
  hScreenDc, I, X, Y, k: Integer;
begin
  hScreenDc := CreateDC('DISPLAY', nil, nil, nil);
  for I := 0 to SnowNumber do
  begin
   // 控制雪点下降速率
    if (CrStep mod SnowNodes[I].Speed) <> 0 then Continue;
   // 恢复上次被覆盖点
    for k := 0 to num do
      if GetPixel(hScreenDc, SnowNodes[I].Point.X + SnowShapeX[k], SnowNodes[I].Point.Y + SnowShapeY[k]) = SnowColor then
        SetPixel(hScreenDc, SnowNodes[I].Point.X + SnowShapeX[k], SnowNodes[I].Point.Y + SnowShapeY[k], SnowNodes[I].Color[k]);
   // 根据风向作随机飘落
    X := SnowNodes[I].Point.X + Random(3) - 1 + CrWind;
    Y := SnowNodes[I].Point.Y + SnowNodes[I].nMove;
   // 积雪(停留)效果处理
    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);
     // 画三个点(雪花)
      for k := 0 to num do
        SetPixel(hScreenDc, X + SnowShapeX[k], Y + SnowShapeY[k], SnowColor);
     // 重生雪点
      SnowNodes[I].Point.Y := Random(10);
      SnowNodes[I].Point.X := Random(ScreenWidth);
      for k := 0 to num do
        SnowNodes[I].Color[k] := GetPixel(hScreenDc, SnowNodes[I].Point.X + SnowShapeX[k], SnowNodes[I].Point.Y + SnowShapeY[k]);
    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);
        for k := 0 to num do
          SnowNodes[I].Color[k] := GetPixel(hScreenDc, SnowNodes[I].Point.X + SnowShapeX[k], SnowNodes[I].Point.Y + SnowShapeY[k]);
      end else
      begin
       // 保存颜色并绘制雪点
        for k := 0 to num do
        begin
          SnowNodes[I].Color[k] := GetPixel(hScreenDc, X + SnowShapeX[k], Y + SnowShapeY[k]);
          SetPixel(hScreenDc, X + SnowShapeX[k], Y + SnowShapeY[k], SnowColor);
        end;
       // 此时保存新雪点位置
        SnowNodes[I].Point.X := X;
        SnowNodes[I].Point.Y := Y;
      end;
    end;
  end;
  DeleteDC(hScreenDc);
  Inc(CrStep);
end;

var
  ThreadMsg: TMsg; // 标准消息结构体
  Frequency: Int64; // 高性能定时器频率
  StartCt, EndCt: Int64; // 高性能定时器计数
  ElapsedTime: Extended; // 时间间隔
begin
  Randomize; GetScreenSize; InitSnowNodes; // 初始化
  QueryPerformanceFrequency(Frequency); // 高性能定时器频率
  hTimer := SetTimer(0, 0, Random(5) * 500, @TimerProc); // 安装随机风向定时器
  hTimer1 := SetTimer(0, 0, 10, @TimerProc1);

  RegisterHotKey(0, 0, MOD_CONTROL, ORD('Q')); // 注册退出热键 Ctrl+L
  RegisterHotKey(0, 1, MOD_CONTROL, ORD('N')); // 注册退出热键 Ctrl+N
  //播放音乐

  ARStream := TResourceStream.Create(HInstance, 'MDI_0', 'MDI'); // 找资源
  TempFile := 'xajh.MID';
  ARStream.SaveToFile(TempFile);
  MCISendString(pchar('OPEN '+tempfile+' TYPE SEQUENCER ALIAS NN'), ', 0, 0);
  MCISendString('PLAY NN FROM 0', ', 0, 0);
  MCISendString('CLOSE ANIMATION', ', 0, 0);

  while TRUE do // 消息循环
  begin
    PrintInfo;
    if(curwi>=((screenWidth div 2)+200)) then
    begin
    KillTimer(0, hTimer1);
    end;
    Sleep(20);
    QueryPerformanceCounter(StartCt); // 执行运算前 计数值
    if PeekMessage(ThreadMsg, 0, 0, 0, PM_REMOVE) then // 取到消息
    begin
      case ThreadMsg.message of
        WM_TIMER:
        begin
          TimerProc(0, 0, 0, 0); // 预设风向改变时间已到
          timerProc1(0,0,0,0);
        end;
        WM_HOTKEY:
          begin
          KillTimer(0, hTimer); // 删除随机风向定时器
          if(ThreadMsg.wParam=1) then
          begin
          InvalidateRect(0, nil, TRUE); // 刷新屏幕
          hc:=(hc+1) mod 4;
          end
          else
          begin
          InvalidateRect(0, nil, TRUE); // 刷新屏幕
          Break; // 跳出消息循环
          end;
          end;

        WM_DISPLAYCHANGE:
          begin
          GetScreenSize; // 重新取屏幕尺寸
          InitSnowNodes; // 初始化雪点数组
          PrintInfo;
          end;
      end;
    end;
    MoveSnowNodes; // 移动雪点
 //   moveText;
    QueryPerformanceCounter(EndCt); // 执行运算后计数值
    ElapsedTime := (EndCt - StartCt) / Frequency;
    if (ElapsedTime < 0.0005) then Sleep(2) // 简单限速
    else if (ElapsedTime < 0.0010) then Sleep(1)
    else if (ElapsedTime < 0.0015) then Sleep(0);
  end;
  DeleteFile(TempFile); // 删除临时文件
  ARStream.Free;
end.
tintin1943 10753 2004/12/21 12:35:41
To liumazi :
   我用的是AMD2500+,256M内存，FX5500显卡。AMD的CPU真的性价比很高。
   我经常在Delphiun活动，帐号是TinTin，希望liumazi也常去那里！
jiceyang 10741 2004/12/21 9:32:50
呵呵，谢谢楼上的各位， 调用 DispatchMessage(ThreadMsg);或者把取消息的那段用个TIMER控件代替 效果多不错。 我试着将
const
  SnowNumber = 250; // 雪点数量-1  
数量改了多次， 当SnowNumber=250-300的时候效果最好，CPU占用几乎为0，一到500CPU就直线飙升了。
各位，圣诞到了，用这个作个逗MM的东东， 呵呵，效果肯定不错。
kkg 10717 2004/12/20 20:11:59
to jiceyang 

窗口有消息队列就不用循环取了，会自己分派的
把取消息的那段用个TIMER控件代替
kkg 10716 2004/12/20 20:09:24
厉害，这个ILOVE的点镇不是要算半天啊
liumazi 10706 2004/12/20 15:41:30
调用 DispatchMessage(ThreadMsg);
jiceyang 10703 2004/12/20 14:50:56
请教各位高手， 如果我显示窗口，应该怎样使他能够正常响应其他事件呢？
lovefox 10701 2004/12/20 12:45:18
sox兄弟，把修改版本发出来，让大家学习学习吧。
liumazi 10689 2004/12/20 7:46:19
不错,学习. :)
sox 10688 2004/12/20 7:28:46
  num = 59; //组成的点数
  //组成的点相对中心的偏移
  SnowShapeX: array[0..num] of integer = (
    0, 1, 2, 1, 1, 1, 0, 1, 2 //9 I
    , 6, 6, 6, 6, 6, 7, 8 //7 L
    , 10, 11, 9, 9, 9, 12, 12, 12, 10, 11 //10 O
    , 13, 13, 14, 14, 15, 16, 16, 17, 17 //9 V
    , 18, 18, 18, 18, 18, 19, 20, 21, 19, 20, 21, 19, 20 //13 E
    , 25, 25, 25, 25, 25, 26, 27, 28, 28, 28, 28, 28 //12 U
    );
  SnowShapeY: array[0..num] of integer = (
    0, 0, 0, 1, 2, 3, 4, 4, 4
    , 0, 1, 2, 3, 4, 4, 4
    , 0, 0, 1, 2, 3, 1, 2, 3, 4, 4
    , 0, 1, 2, 3, 4, 3, 2, 1, 0
    , 0, 1, 2, 3, 4, 0, 0, 0, 4, 4, 4, 2, 2
    , 0, 1, 2, 3, 4, 4, 4, 4, 3, 2, 1, 0
    );
sox 10687 2004/12/20 6:40:37
//在前辈的基础上面加了雪花形状的设定部分
program Snow;

uses
  Windows, Messages;

const
  SnowNumber = 260; // 雪点数量-1
  SnowColor = $FFFFFF;
  num = 11;//组成的点数
  //组成的点相对中心的偏移
  SnowShapeX: array[0..num] of integer = (1, -1, 1, -1, 0, 1, 0, -1, 0, 2, 0, -2);
  SnowShapeY: array[0..num] of integer = (1, -1, -1, 1, 1, 0, -1, 0, 2, 0, -2, 0);


type
  SnowNode = record
    Point: TPoint; // 雪点位置
    Color: array[0..num] of 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 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 InitSnowNodes;
var
  hScreenDc, J, k: 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);
    for k := 0 to num do
      SnowNodes[J].Color[k] := GetPixel(hScreenDc, SnowNodes[J].Point.X + SnowShapeX[k], SnowNodes[J].Point.Y + SnowShapeY[k]);
    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 MoveSnowNodes;
var
  hScreenDc, I, X, Y, k: Integer;
begin
  hScreenDc := CreateDC('DISPLAY', nil, nil, nil);
  for I := 0 to SnowNumber do
  begin
   // 控制雪点下降速率
    if (CrStep mod SnowNodes[I].Speed) <> 0 then Continue;
   // 恢复上次被覆盖点
    for k := 0 to num do
      if GetPixel(hScreenDc, SnowNodes[I].Point.X + SnowShapeX[k], SnowNodes[I].Point.Y + SnowShapeY[k]) = SnowColor then
        SetPixel(hScreenDc, SnowNodes[I].Point.X + SnowShapeX[k], SnowNodes[I].Point.Y + SnowShapeY[k], SnowNodes[I].Color[k]);
   // 根据风向作随机飘落
    X := SnowNodes[I].Point.X + Random(3) - 1 + CrWind;
    Y := SnowNodes[I].Point.Y + SnowNodes[I].nMove;
   // 积雪(停留)效果处理
    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);
     // 画三个点(雪花)
      for k := 0 to num do
        SetPixel(hScreenDc, X + SnowShapeX[k], Y + SnowShapeY[k], SnowColor);
     // 重生雪点
      SnowNodes[I].Point.Y := Random(10);
      SnowNodes[I].Point.X := Random(ScreenWidth);
      for k := 0 to num do
        SnowNodes[I].Color[k] := GetPixel(hScreenDc, SnowNodes[I].Point.X + SnowShapeX[k], SnowNodes[I].Point.Y + SnowShapeY[k]);
    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);
        for k := 0 to num do
          SnowNodes[I].Color[k] := GetPixel(hScreenDc, SnowNodes[I].Point.X + SnowShapeX[k], SnowNodes[I].Point.Y + SnowShapeY[k]);
      end else
      begin
       // 保存颜色并绘制雪点
        for k := 0 to num do
        begin
          SnowNodes[I].Color[k] := GetPixel(hScreenDc, X + SnowShapeX[k], Y + SnowShapeY[k]);
          SetPixel(hScreenDc, X + SnowShapeX[k], Y + SnowShapeY[k], SnowColor);
        end;
       // 此时保存新雪点位置
        SnowNodes[I].Point.X := X;
        SnowNodes[I].Point.Y := Y;
      end;
    end;
  end;
  DeleteDC(hScreenDc);
  Inc(CrStep);
end;

var
  ThreadMsg: TMsg; // 标准消息结构体
  Frequency: Int64; // 高性能定时器频率
  StartCt, EndCt: Int64; // 高性能定时器计数
  ElapsedTime: Extended; // 时间间隔
begin
  Randomize; 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(2) // 简单限速
    else if (ElapsedTime < 0.0010) then Sleep(1)
    else if (ElapsedTime < 0.0015) then Sleep(0);
  end;
end.
vagrant 10654 2004/12/18 11:30:28
高。。。
第一页 上一页 下一页 最后页 有 34 条纪录 共2页 1 - 20
 用户名：
 密　码：
自动登陆(30天有效)
 
  DELPHI盒子版权所有 技术支持:深圳市麟瑞科技有限公司 1999-2024 V4.01 粤ICP备10103342号-1 更新RSS列表