[mAnah]

Надо сделать, чтобы в зимний период (1 дек - 29 фев) при открытии формы отображался падающий снег.
В качестве исходников использую "Исходник программы, показывающей пример генерации снега (заметает снегом рабочий стол) - Автор VirEx." (http://www.delphisources.ru/pages/so..._by_virex.html).
Но не могу переделать алгоритм для работы именно на форме.
Спасибо.

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  StdCtrls, ComCtrls, ExtCtrls,ShellAPI;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormResize(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
    
  end;
type
  MyPoint = record
  X:integer;
  Y:integer;
  lastColor:COLORREF;
  speed:byte;//скорость
  crazy:integer;//степень сумасшедшести снежинки :)  integer для того чтобы она могла быть отрицательной
end;

var
  Form1: TForm1;
  screenW,screenH:integer;//высота и ширина экрана
  points : array of MyPoint;
  desktop:hDC;
  wind:integer; //ветер
  show_color:COLORREF;
implementation

{$R *.dfm}

procedure ShowGradient2(prmDC:hDC;prmRed,prmGreen,prmBlue:byte;ClientWidth,ClientHeight:integer);
var
Row:Word ;
wrkPenNew:hPen;

//[23:53 24.10.2005]
wrkDelta:integer;

begin

wrkDelta:=100 div (1+ClientHeight);
if wrkDelta=0 then wrkDelta:=1;

for Row := 0 to 1+(ClientHeight) do begin
wrkPenNew:=CreatePen(PS_SOLID,1,RGB(prmRed, prmGreen, prmBlue));
SelectObject(prmDC,wrkPenNew);

MoveToEx(prmDC,0,Row,nil);
LineTo(prmDC,ClientWidth,Row);


DeleteObject(wrkPenNew);

if prmRed > wrkDelta then Dec(prmRed,wrkDelta);
if prmGreen > wrkDelta then Dec(prmGreen,wrkDelta);
if prmBlue  > wrkDelta then Dec(prmBlue,wrkDelta);

end;
end;

function IsContrast(Color1,Color2:COLORREF):boolean;
var
  r1,g1,b1:byte;
  r2,g2,b2:byte;
begin
result:=false;
r1:=GetRValue(Color1);
g1:=GetGValue(Color1);
b1:=GetBValue(Color1);
r2:=GetRValue(Color2);
g2:=GetGValue(Color2);
b2:=GetBValue(Color2);

if ((r1-r2)+(g1-g2)+(b1-b2))>100 then result:=true;

end;

procedure paintSnow(h:hDC);
var
  i:integer;
  x,y:integer;
  color_1,color_2:COLORREF;//два цвета для сравнения

  down_snow:byte;
begin

case 2-random(2) of
1:inc(wind);
2:dec(wind);
end;
if wind>5 then dec(wind);
if wind<-5 then inc(wind);

for i:=0 to high(points) do begin
//узнаем координаты движения снежинки
x:=points[i].X+points[i].crazy+wind;
y:=points[i].Y+1+points[i].speed;

if (y > screenH) then y:=1;//если долетела до низа экрана то отображаем сверху
if (x > screenW) then x:=1;
if (x < 0) then x:=screenW;
//if points[i].lastColor=show_color then y:=random(screenH);// избавляемся от шлейфов

color_1:=GetPixel(h,x,y);//цвет будущей точки
color_2:=GetPixel(h,x,y+1);

if (IsContrast(color_1,color_2)) and (color_1<>show_color) //если контраст большой то снежинка упала
then begin

down_snow:=random(1);
points[i].Y:=points[i].Y+down_snow;
points[i].X:=points[i].X;
case (random(2)) of
  1: begin // .
     SetPixelV(h,points[i].X,points[i].Y,show_color);
     end;
  2: begin // ..
     SetPixelV(h,points[i].X-1,points[i].Y,show_color);
     SetPixelV(h,points[i].X,points[i].Y,show_color);
     end;
  0: begin // .'.
     points[i].Y:=points[i].Y-random(3);
     SetPixelV(h,points[i].X+1,points[i].Y+1,show_color);
     SetPixelV(h,points[i].X,points[i].Y,show_color);
     SetPixelV(h,points[i].X-1,points[i].Y+1,show_color);
     end;

end;
y:=random(screenH div 4);

end else begin //снежинка продолжает лететь
if GetPixel(h,points[i].X,points[i].Y)=show_color then
SetPixelV(h,points[i].X,points[i].Y,points[i].lastColor);//восстанавливаем цвет предыдущей точки, ранее затертой
points[i].lastColor:=GetPixel(h,x,y);//запоминаем цвет точки который скоро затерем
SetPixelV(h,x,y,show_color);
end;
points[i].X:=x;
points[i].Y:=y;
points[i].crazy:=-points[i].crazy;//добиваюсь того чтобы снежинка летела влево-вправо
end;

end;


procedure TForm1.Timer1Timer(Sender: TObject);
begin
paintSnow(desktop);
end;

procedure init;
var
  i:integer;
begin
for i:=0 to high(points) do begin
  points[i].X:=screenW-random(screenW);
  points[i].Y:=screenH-random(screenH);
  points[i].speed:=3-random(2);
  points[i].crazy:=1-random(1);
  points[i].lastColor:=GetPixel(desktop,points[i].X+1,points[i].Y);
end;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
show_color:=rgb(234,234,255);
wind:=1;
form1.WindowState:=wsNormal;
desktop:=CreateDC('DISPLAY',nil,nil,nil);
screenW:=Form1.Width;
screenH:=Form1.Height;
randomize;
setlength(points,801);
init;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
DeleteDC(desktop);
invalidaterect(WindowFromDC(desktop),nil,true);
timer1.Enabled:=false;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
form1.Paint;
end;

end.

[The Shadow]

попробуй замени

Код:

desktop:=CreateDC('DISPLAY',nil,nil,nil);

на

Код:

desktop:=GetDC(Form1.Handle);

[mAnah]

_Спасибо._