[Lazarus]使用Lazarus编写的桌面下雪小程序
pascal吧
全部回复
仅看楼主
level 4
bigbryant 楼主
参考了C语言吧的海边的小男孩前辈的那个,但是没有考虑堆积问题,而且还有些想实现的功能没有完成,但是大概雏形已经有了~
http://ishare.iask.sina.com.cn/f/13859848.html
2楼给代码。

2011年03月09日 08点03分 1
level 4
bigbryant 楼主
代码清单:
unit Main;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
ExtCtrls, Menus, Windows;
type
{ TfmMainForm }
TfmMainForm = class(TForm)
    IDM_Exit: TMenuItem;
    TrayPopupMenu: TPopupMenu;
    TrayIcon: TTrayIcon;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure IDM_ExitClick(Sender: TObject);
private
    { private declarations }
public
    { public declarations }
end;
var
fmMainForm: TfmMainForm;
implementation
{ TfmMainForm }
const
SNOWCOL = $FEFFFE;
SNOWNUM = 20;
FAL
LSP
D = 4;
type
Flake = record
    x, y:integer;
    size:boolean;
    increment:boolean;
    counter:integer;
end;
var
pData:array[1..SNOWNUM] of Flake;
hdlDC:HDC;
hDesktop:HWND;
hdlPen:HPEN;
ScrWidth, ScrHeight:integer;
procedure DrawFlake(handle:THandle; msg:longword; idtimer:longword; dwtime:longword); stdcall;
var
x, y, i:integer;
rc:RECT;
begin
i := idtimer;
rc.Left := pData[i].x;
rc.Right := pData[i].x + 15;
rc.Top := pData[i].y;
rc.Bottom := pData[i].y + 15;
if(pData[i].y < ScrHeight - 15) then
    RedrawWindow(hDesktop, @rc, 0, RDW_INVALIDATE or RDW_ERASE or RDW_UPDATENOW);
if(pData[i].counter = 15) then begin
    pData[i].increment := (random(10) > 5);
    pData[i].counter := 0;
end else
    inc(pData[i].counter);
if(pData[i].x + 15 > ScrWidth) then begin
    pData[i].increment := false;
    pData[i].counter := 0;
end else if(pData[i].x <= 0) then begin
    pData[i].increment := true;
    pData[i].counter := 0;
end;
if(pData[i].increment) then
    inc(pData[i].x)
else
    dec(pData[i].x);
inc(pData[i].y, FALLSPD);
if(pData[i].y > ScrHeight) then begin
    pData[i].x := random(ScrWidth);
    pData[i].y := 0;
end;
x := pData[i].x;
y := pData[i].y;
if(pData[i].size) then begin
    MoveToEx(hdlDC, x + 7, y, nil);
    LineTo(hdlDC, x + 7, y + 15);
    MoveToEx(hdlDC, x , y + 7, nil);
    LineTo(hdlDC, x + 15, y + 7);
    MoveToEx(hdlDC, x + 2, y + 2, nil);
    LineTo(hdlDC, x + 13, y + 13);
    MoveToEx(hdlDC, x + 2, y + 12, nil);
    LineTo(hdlDC, x + 13, y + 1);
    MoveToEx(hdlDC, x + 6, y + 2, nil);

2011年03月09日 08点03分 2
level 4
bigbryant 楼主
    LineTo(hdlDC, x + 9, y + 2);
    MoveToEx(hdlDC, x + 6, y + 12, nil);
    LineTo(hdlDC, x + 9, y + 12);
    MoveToEx(hdlDC, x + 2, y + 6, nil);
    LineTo(hdlDC, x + 2, y + 9);
    MoveToEx(hdlDC, x + 12, y + 6, nil);
    LineTo(hdlDC, x + 12, y + 9);
end else begin
    MoveToEx(hdlDC, x + 7, y + 2, nil);
    LineTo(hdlDC, x + 7, y + 13);
    MoveToEx(hdlDC, x + 2, y + 7, nil);
    LineTo(hdlDC, x + 13, y + 7);
    MoveToEx(hdlDC, x + 4, y + 4, nil);
    LineTo(hdlDC, x + 11, y + 11);
    MoveToEx(hdlDC, x + 4, y + 10, nil);
    LineTo(hdlDC, x + 11, y + 3);
    MoveToEx(hdlDC, x + 6, y + 3, nil);
    LineTo(hdlDC, x + 9, y + 3);
    MoveToEx(hdlDC, x + 6, y + 11, nil);
    LineTo(hdlDC, x + 9, y + 11);
    MoveToEx(hdlDC, x + 3, y + 6, nil);
    LineTo(hdlDC, x + 3, y + 9);
    MoveToEx(hdlDC, x + 11, y + 6, nil);
    LineTo(hdlDC, x + 11, y + 9);
end;
end;
procedure TfmMainForm.FormCreate(Sender: TObject);
var
i, nTimer:integer;
h:longint;
rcWorkArea:RECT;
hProgMan, hShellDefView:HWND;
begin
Application.ShowMainForm := false;
{
h := GetWindowLong(fmMainForm.Handle, GWL_EXSTYLE);
h := h or WS_EX_LAYERED;
SetWindowLong(fmMainForm.Handle, GWL_EXSTYLE, h);
SetLayeredWindowAttributes(fmMainForm.Handle, 0, 0, LWA_ALPHA);
}
randomize;
SystemParametersInfo(SPI_GETWORKAREA, 0, @rcWorkArea, 0);
hProgMan := FindWindow('ProgMan', nil);
if(hProgMan <> 0) then begin
    hShellDefView := FindWindowEx(hProgMan, 0, 'SHELLDLL_DefView', nil);
    if(hShellDefView <> 0) then
      hDesktop := FindWindowEx(hShellDefView, 0, 'SysListView32', nil);
end;
ScrWidth := abs(rcWorkArea.Right - rcWorkArea.Left);
ScrHeight := abs(rcWorkArea.Bottom - rcWorkArea.Top);
for i := 1 to SNOWNUM do begin
    pData[i].x := random(ScrWidth);
    pData[i].y := 0;
    pData[i].size := (random(10) > 5);
    pData[i].increment := (random(10) > 5);
    nTimer := 10 + random(70);
    SetTimer(fmMainForm.Handle, i, nTimer, @DrawFlake);
end;
hdlDC := GetDC(hDesktop);
hdlPen := CreatePen(PS_SOLID, 1, SNOWCOL);
SelectObject(hdlDC, hdlPen);
end;
procedure TfmMainForm.FormDestroy(Sender: TObject);
var
i:integer;
begin
for i := 1 to SNOWNUM do KillTimer(fmMainForm.Handle, i);
InvalidateRect(0, nil, true);
DeleteObject(hdlPen);
ReleaseDC(fmMainForm.Handle, hdlDC);
end;
procedure TfmMainForm.IDM_ExitClick(Sender: TObject);
begin
Application.Terminate;
end;
initialization
{$I main.lrs}
end.

2011年03月09日 08点03分 3
level 4
bigbryant 楼主
嗯,用lazarus可以编译的,源码和成品的下载在1楼
2011年03月09日 16点03分 6
1