⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit1.pas

📁 this is card CarteChristmas
💻 PAS
字号:
Unit Unit1;
Interface
Uses Windows, Messages, SysUtils, Variants, Classes, Graphics,
  Controls, Forms, Dialogs, ExtCtrls, StdCtrls, Math;

Type
  TForm1 = Class(TForm)
    ClipArt1: TImage;
    ClipArt2: TImage;
    ClipArt3: TImage;
    ClipArt4: TImage;
    ImaFloc: TImage;
    Timer1: TTimer;
    Procedure FormActivate(Sender: TObject);
    Procedure Timer1Timer(Sender: TObject);
  End;

Var
  Form1: TForm1;

{----------------------------------------------------------------}
{                       }Implementation{                         }
{----------------------------------------------------------------}
{$R *.DFM}

Const
  MaxFloc = 100;
  Vent: TPoint = (X: -4; Y: 10);
  ZoomRatio: Array[1..20] Of Byte =
  (2, 2, 2, 2, 3, 3, 3, 3, 4, 4, 4, 5, 5, 5, 6, 6, 7, 8, 9, 10);

Type
  TFloc = Class
    FIma: TBitmap;
    Zoom: Integer;
    PosX: Single;
    PosY: Single;
    RIma: TRect;
    Constructor Create;
    Procedure MoveIt;
  End;

Var
  AFloc: Array[1..MaxFloc] Of TFloc;


{----------------------------------------------------------------}
{ Cr閍tion d'un flocon                                           }
{----------------------------------------------------------------}
Constructor TFloc.Create;
Begin
  Zoom := ZoomRatio[RandomRange(1, 20)];
  FIma := TBitmap.Create;
  FIma.Width := Round(Form1.ImaFloc.Width * (Zoom / 100));
  FIma.Height := Round(Form1.ImaFloc.Height * (Zoom / 100));
  FIma.PixelFormat := pf24bit;
  FIma.Transparent := True;
  FIma.Canvas.StretchDraw(FIma.Canvas.ClipRect, Form1.ImaFloc.Picture.Bitmap);
  PosY := RandomRange(0, Form1.ClientHeight);
  PosX := RandomRange(0, Form1.ClientWidth);
  RIma.Left := Round(PosX);
  RIma.Top := Round(PosY);
  RIma.Right := RIma.Left + FIma.Width;
  RIma.Bottom := RIma.Top + FIma.Height;
End;


{----------------------------------------------------------------}
{ Restaure, d閜lace et d閟sine un flocon                         }
{----------------------------------------------------------------}
Procedure TFloc.MoveIt;
Begin
  Form1.Canvas.CopyRect(RIma, Form1.ImaFloc.Picture.Bitmap.Canvas, RIma);
  PosX := PosX + ((Vent.X * RandomRange(3, 5 * Zoom)) / 30);
  PosY := PosY + ((Vent.Y * RandomRange(3, 5 * Zoom)) / 30);
  RIma.Left := Round(PosX);
  RIma.Top := Round(PosY);
  RIma.Right := RIma.Left + FIma.Width;
  RIma.Bottom := RIma.Top + FIma.Height;
  Form1.Canvas.StretchDraw(RIma, FIma);
  If (PosY > Form1.ClientHeight) And (Vent.Y > 0) Then
  Begin
    PosX := RandomRange(0, Form1.ClientWidth);
    PosY := -FIma.Height;
  End
  ELse
  If (PosY < FIma.Height) And (Vent.Y < 0) Then
  Begin
    PosX := RandomRange(0, Form1.ClientWidth);
    PosY := Form1.ClientHeight;
  End;
  If (PosX > Form1.ClientWidth) And (Vent.X > 0) Then
    PosX := -FIma.Width
  Else
  If (PosX < FIma.Width) And (Vent.X < 0) Then
    PosX :=  Form1.ClientWidth;
End;


{----------------------------------------------------------------}
{ Cr閍tion des 閘閙ents graphiques, sauvegarde de l'arri鑢e-plan }
{----------------------------------------------------------------}
Procedure TForm1.FormActivate(Sender: TObject);
Var
  i, j: Integer;
  R, G, B: Byte;
Begin
  Randomize;
  { Cr閍tion des flocons }
  For i := 1 To MaxFloc Do
    AFloc[i] := TFloc.Create;
  Application.ProcessMessages;
  { Dessin du d間rad

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -