Стартовый пул

bgracontrols/test/test_extra/rain-circular/project1.lpi

@@ -0,0 +1,155 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <PathDelim Value="\"/>
+    <General>
+      <Flags>
+        <CompatibilityMode Value="True"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="project1"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+    </General>
+    <i18n>
+      <EnableI18N LFM="False"/>
+    </i18n>
+    <BuildModes Count="3">
+      <Item1 Name="Default" Default="True"/>
+      <Item2 Name="Debug">
+        <CompilerOptions>
+          <Version Value="11"/>
+          <PathDelim Value="\"/>
+          <Target>
+            <Filename Value="project1"/>
+          </Target>
+          <SearchPaths>
+            <IncludeFiles Value="$(ProjOutDir)"/>
+            <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+          </SearchPaths>
+          <Parsing>
+            <SyntaxOptions>
+              <IncludeAssertionCode Value="True"/>
+            </SyntaxOptions>
+          </Parsing>
+          <CodeGeneration>
+            <Checks>
+              <IOChecks Value="True"/>
+              <RangeChecks Value="True"/>
+              <OverflowChecks Value="True"/>
+              <StackChecks Value="True"/>
+            </Checks>
+          </CodeGeneration>
+          <Linking>
+            <Debugging>
+              <DebugInfoType Value="dsDwarf2Set"/>
+              <UseHeaptrc Value="True"/>
+              <UseExternalDbgSyms Value="True"/>
+            </Debugging>
+            <Options>
+              <Win32>
+                <GraphicApplication Value="True"/>
+              </Win32>
+            </Options>
+          </Linking>
+        </CompilerOptions>
+      </Item2>
+      <Item3 Name="Release">
+        <CompilerOptions>
+          <Version Value="11"/>
+          <PathDelim Value="\"/>
+          <Target>
+            <Filename Value="project1"/>
+          </Target>
+          <SearchPaths>
+            <IncludeFiles Value="$(ProjOutDir)"/>
+            <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+          </SearchPaths>
+          <CodeGeneration>
+            <SmartLinkUnit Value="True"/>
+            <Optimizations>
+              <OptimizationLevel Value="3"/>
+            </Optimizations>
+          </CodeGeneration>
+          <Linking>
+            <Debugging>
+              <GenerateDebugInfo Value="False"/>
+            </Debugging>
+            <LinkSmart Value="True"/>
+            <Options>
+              <Win32>
+                <GraphicApplication Value="True"/>
+              </Win32>
+            </Options>
+          </Linking>
+        </CompilerOptions>
+      </Item3>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+      <Modes Count="1">
+        <Mode0 Name="default"/>
+      </Modes>
+    </RunParams>
+    <RequiredPackages Count="2">
+      <Item1>
+        <PackageName Value="bgracontrols"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="LCL"/>
+      </Item2>
+    </RequiredPackages>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="project1.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="unit1.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="Form1"/>
+        <HasResources Value="True"/>
+        <ResourceBaseClass Value="Form"/>
+        <UnitName Value="Unit1"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="project1"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Debugging>
+        <DebugInfoType Value="dsDwarf2Set"/>
+      </Debugging>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

bgracontrols/test/test_extra/rain-circular/project1.lpr

@@ -0,0 +1,21 @@
+program project1;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms, Unit1
+  { you can add units after this };
+
+{$R *.res}
+
+begin
+  RequireDerivedFormResource := True;
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.
+

bgracontrols/test/test_extra/rain-circular/unit1.lfm

@@ -0,0 +1,42 @@
+object Form1: TForm1
+  Left = 422
+  Height = 292
+  Top = 114
+  Width = 373
+  Caption = 'Form1'
+  ClientHeight = 292
+  ClientWidth = 373
+  OnClose = FormClose
+  OnCreate = FormCreate
+  OnDestroy = FormDestroy
+  LCLVersion = '1.0.10.0'
+  object TrackBar1: TTrackBar
+    Left = 0
+    Height = 25
+    Top = 1
+    Width = 372
+    Frequency = 100
+    Max = 1000
+    Position = 0
+    Anchors = [akTop, akLeft, akRight]
+    TabOrder = 0
+  end
+  object vsRain: TBGRAVirtualScreen
+    Left = 0
+    Height = 259
+    Top = 32
+    Width = 372
+    OnRedraw = RainRedraw
+    Alignment = taLeftJustify
+    Anchors = [akTop, akLeft, akRight, akBottom]
+    Color = clBlack
+    ParentColor = False
+    TabOrder = 1
+  end
+  object Timer1: TTimer
+    Interval = 15
+    OnTimer = Timer1Timer
+    left = 108
+    top = 85
+  end
+end

bgracontrols/test/test_extra/rain-circular/unit1.pas

@@ -0,0 +1,245 @@
+unit Unit1;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
+  ComCtrls, BGRAVirtualScreen, BGRABitmap, BGRABitmapTypes;
+
+const
+  wind = -0.5; //1 means 45 degrees rain
+  rainDensity = 2; //strictly positive
+
+type
+
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    vsRain: TBGRAVirtualScreen;
+    Timer1: TTimer;
+    TrackBar1: TTrackBar;
+    procedure RainRedraw(Sender: TObject; Bitmap: TBGRABitmap);
+    procedure FormClose(Sender: TObject; var {%H-}CloseAction: TCloseAction);
+    procedure FormCreate(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
+    procedure Timer1Timer(Sender: TObject);
+  private
+    { private declarations }
+    bkg,stretchedBkg: TBGRABitmap;
+    prevTime: TDateTime;
+    prevTimeDefined: boolean;
+    rainData: array of record
+        x,ystart,yend: single;
+        rainWidth, rainSpeed: single;
+        grad: TBGRACustomGradient;
+        active: boolean;
+        inactiveTime: double;
+      end;
+    procedure ClearRainData;
+    procedure PrepareRainArray(nbRain: integer; ScaleX: single);
+    function PrepareRainDrop(i: integer; rainSizeX, rainSizeY: single): single;
+    procedure NeedRainArray(w, h, rainProba: integer; rainSizeX, rainSizeY: single);
+    procedure RainElapse(elapsed: double; rainProba, w, h: integer);
+    procedure RenderRain(Bitmap: TBGRABitmap);
+  end;
+
+var
+  Form1: TForm1;
+
+implementation
+
+uses BGRAGradientScanner, Math;
+
+{$R *.lfm}
+
+{ TForm1 }
+
+procedure TForm1.RainRedraw(Sender: TObject; Bitmap: TBGRABitmap);
+var
+  elapsed: double;
+  ratio: single;
+  x,y,w,h: integer;
+begin
+  if not prevTimeDefined then
+  begin
+    elapsed := 0;
+  end else
+  begin
+    elapsed := (Now-prevTime)*86400*10;
+    if elapsed < 0 then elapsed := 0;
+  end;
+  prevTime := now;
+  prevTimeDefined := true;
+
+  if Assigned(stretchedBkg) and
+    ((stretchedBkg.Width <> Bitmap.Width) or (stretchedBkg.Height <> Bitmap.Height)) then
+      FreeAndNil(stretchedBkg);
+  if not Assigned(stretchedBkg) then
+  begin
+    ratio := max(Bitmap.Width/bkg.Width,Bitmap.Height/bkg.Height);
+    stretchedBkg := TBGRABitmap.Create(Bitmap.Width,Bitmap.Height,BGRABlack);
+    w := round(bkg.Width*ratio);
+    h := round(bkg.Height*ratio);
+    x := (Bitmap.Width-w) div 2;
+    y := (Bitmap.Height-h) div 2;
+    stretchedBkg.StretchPutImage(rect(x,y,x+w,y+h),bkg,dmDrawWithTransparency);
+  end;
+
+  RainElapse(elapsed,TrackBar1.Position,Bitmap.Width,Bitmap.Height);
+
+  Bitmap.PutImage(0,0,stretchedBkg,dmSet);
+  RenderRain(Bitmap);
+end;
+
+procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
+begin
+  Timer1.Enabled := False;
+end;
+
+procedure TForm1.FormCreate(Sender: TObject);
+begin
+  bkg := TBGRABitmap.Create('Lighthouse.jpg');
+  randomize;
+end;
+
+procedure TForm1.FormDestroy(Sender: TObject);
+begin
+  bkg.Free;
+  FreeAndNil(stretchedBkg);
+  ClearRainData;
+end;
+
+procedure TForm1.Timer1Timer(Sender: TObject);
+begin
+  Timer1.Enabled:= false;
+  vsRain.RedrawBitmap;
+  Timer1.Enabled:= true;
+end;
+
+procedure TForm1.ClearRainData;
+var i: integer;
+begin
+  for i := 0 to high(rainData) do
+    rainData[i].grad.Free;
+  rainData := nil;
+end;
+
+procedure TForm1.RenderRain(Bitmap: TBGRABitmap);
+var
+  i,h2: Integer;
+  scan: TBGRAGradientScanner;
+begin
+  h2 := Bitmap.Height div 2;
+  for i:= 0 to high(rainData) do
+  with rainData[i] do
+  if active then
+  begin
+    scan := TBGRAGradientScanner.Create(grad, gtLinear, PointF(0,ystart),PointF(0,yend));
+    Bitmap.DrawLineAntialias(x+(ystart-h2)*wind,ystart,x+(yend-h2)*wind,yend,scan,rainWidth,true);
+    scan.Free;
+  end;
+end;
+
+//returns raindrop height
+function TForm1.PrepareRainDrop(i: integer; rainSizeX,rainSizeY: single): single;
+var dist: single;
+begin
+  with rainData[i] do
+  begin
+    dist := (random(100)+10)/10;
+    rainSpeed := 1/dist;
+    rainWidth := rainSizeX/dist;
+    if rainWidth < 1 then rainWidth := 1;
+    result := rainSizeY/dist*(random(50)+75)/100;
+  end;
+end;
+
+procedure TForm1.NeedRainArray(w, h, rainProba: integer; rainSizeX,rainSizeY: single);
+var
+  nbRain: Integer;
+  i: Integer;
+begin
+  nbRain := (w+round(abs(wind)*h)) *rainDensity;
+  if length(rainData)<> nbRain then
+  begin
+    PrepareRainArray(nbRain,1/rainDensity);
+    for i := 0 to high(rainData) do
+    with rainData[i] do
+    begin
+      x -= abs(wind)*h/2;
+      if random(1000) < rainProba then
+      begin
+        active := true;
+        ystart := Random(h*2)-h/2;
+        yend := ystart + PrepareRainDrop(i, rainSizeX,rainSizeY);
+      end;
+    end;
+  end;
+end;
+
+procedure TForm1.RainElapse(elapsed: double; rainProba,w,h: integer);
+var
+  i: integer;
+  rainSizeY,rainSizeX: single;
+  delta: single;
+begin
+  rainSizeY := 2+h*TrackBar1.Position/1000;
+  rainSizeX := 7*TrackBar1.Position/1000;
+  if rainSizeX < 4 then rainSizeX := 4;
+
+  NeedRainArray(w,h, rainProba, rainSizeX,rainSizeY);
+  for i := 0 to high(rainData) do
+  with rainData[i] do
+  if active then
+  begin
+    delta := h*rainSpeed*elapsed;
+    ystart += delta;
+    yend += delta;
+    if ystart >= h then
+    begin
+      if random(1000) < rainProba then
+      begin
+        yend := -(ystart-h);
+        ystart := yend - PrepareRainDrop(i, rainSizeX,rainSizeY);
+      end else
+      begin
+        active := false;
+        inactiveTime:= 0;
+      end;
+    end;
+  end else
+  begin
+    inactiveTime+= elapsed;
+    if inactiveTime > 0.5 then
+    begin
+      inactiveTime -= 0.5;
+      if random(1000) < rainProba then
+      begin
+        active := true;
+        ystart := -random(h)/2;
+        yend := ystart + PrepareRainDrop(i, rainSizeX,rainSizeY);
+      end;
+    end;
+  end;
+end;
+
+procedure TForm1.PrepareRainArray(nbRain: integer; ScaleX: single);
+var
+  i: Integer;
+begin
+  ClearRainData;
+  setlength(rainData, nbRain);
+  for i := 0 to high(rainData) do
+  with rainData[i] do
+  begin
+    x := i*scaleX;
+    grad := TBGRAMultiGradient.Create([BGRAPixelTransparent, BGRA(255,255,255,random(20)+50), BGRAPixelTransparent],[0,0.9,1],True);
+    active:= false;
+    inactiveTime := 0;
+  end;
+end;
+
+end.
+