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

bgrabitmap/test/test4lcl_opengl/opengltest3/opengltest3.lpi

@@ -0,0 +1,88 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <PathDelim Value="\"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="opengltest3"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+      <Icon Value="0"/>
+    </General>
+    <i18n>
+      <EnableI18N LFM="False"/>
+    </i18n>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="3">
+      <Item1>
+        <PackageName Value="BGRABitmapPack"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="lazopenglcontext"/>
+      </Item2>
+      <Item3>
+        <PackageName Value="LCL"/>
+      </Item3>
+    </RequiredPackages>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="opengltest3.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="opengltest3"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <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>

bgrabitmap/test/test4lcl_opengl/opengltest3/opengltest3.lpr

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

bgrabitmap/test/test4lcl_opengl/opengltest3/unit1.lfm

@@ -0,0 +1,101 @@
+object Form1: TForm1
+  Left = 230
+  Height = 705
+  Top = 119
+  Width = 1223
+  Caption = 'Masking'
+  ClientHeight = 705
+  ClientWidth = 1223
+  OnCreate = FormCreate
+  OnShow = FormShow
+  LCLVersion = '1.6.0.4'
+  object Panel1: TPanel
+    Left = 0
+    Height = 705
+    Top = 0
+    Width = 144
+    Align = alLeft
+    ClientHeight = 705
+    ClientWidth = 144
+    TabOrder = 0
+    object RadioGroup1: TRadioGroup
+      Left = 1
+      Height = 79
+      Top = 1
+      Width = 142
+      Align = alTop
+      AutoFill = True
+      Caption = 'Mode'
+      ChildSizing.LeftRightSpacing = 6
+      ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
+      ChildSizing.EnlargeVertical = crsHomogenousChildResize
+      ChildSizing.ShrinkHorizontal = crsScaleChilds
+      ChildSizing.ShrinkVertical = crsScaleChilds
+      ChildSizing.Layout = cclLeftToRightThenTopToBottom
+      ChildSizing.ControlsPerLine = 1
+      ClientHeight = 59
+      ClientWidth = 138
+      Items.Strings = (
+        'Texture'
+        'Mask'
+        'Texture+Mask'
+      )
+      TabOrder = 0
+    end
+    object GroupBox1: TGroupBox
+      Left = 1
+      Height = 64
+      Top = 80
+      Width = 142
+      Align = alTop
+      Caption = 'Masking'
+      ClientHeight = 44
+      ClientWidth = 138
+      TabOrder = 1
+      object TrackBar1: TTrackBar
+        Left = 5
+        Height = 25
+        Top = -1
+        Width = 130
+        Frequency = 15
+        Max = 255
+        Min = 1
+        Position = 128
+        Anchors = [akTop, akLeft, akRight]
+        TabOrder = 0
+      end
+      object Label1: TLabel
+        Left = 7
+        Height = 15
+        Top = 25
+        Width = 22
+        Caption = 'Add'
+        ParentColor = False
+      end
+      object Label2: TLabel
+        Left = 87
+        Height = 15
+        Top = 25
+        Width = 44
+        Anchors = [akTop, akRight]
+        Caption = 'Multiply'
+        ParentColor = False
+      end
+    end
+  end
+  object Panel2: TPanel
+    Left = 144
+    Height = 705
+    Top = 0
+    Width = 1079
+    Align = alClient
+    TabOrder = 1
+  end
+  object Timer1: TTimer
+    Enabled = False
+    Interval = 15
+    OnTimer = Timer1Timer
+    left = 40
+    top = 192
+  end
+end

bgrabitmap/test/test4lcl_opengl/opengltest3/unit1.pas

@@ -0,0 +1,170 @@
+unit Unit1;
+
+{
+-So lets put things together and play with masks
+-Just read the code, it should be clear
+-As you can see this demo will uses more cpu because it create mask every time it paints but still it is very fast
+}
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
+  ComCtrls, StdCtrls, OpenGLContext, BGRABitmap, BGRABitmapTypes, BGRAOpenGL;
+
+type
+
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    GroupBox1: TGroupBox;
+    Label1: TLabel;
+    Label2: TLabel;
+    Panel1: TPanel;
+    Panel2: TPanel;
+    RadioGroup1: TRadioGroup;
+    Timer1: TTimer;
+    TrackBar1: TTrackBar;
+    procedure FormCreate(Sender: TObject);
+    procedure FormShow(Sender: TObject);
+    procedure Timer1Timer(Sender: TObject);
+  private
+    OpenGLControl: TOpenGLControl;
+  public
+    Tex, Mask: IBGLTexture;
+    rectMask: TRect;
+    MainFont: IBGLFont;
+    r: single;
+    GoBack: boolean;
+    procedure OpenGLControlPaint(Sender: TObject);
+    procedure UpdateMask;
+  end;
+
+var
+  Form1: TForm1;
+
+implementation
+
+uses Types,Math;
+
+{$R *.lfm}
+
+{ TForm1 }
+
+procedure TForm1.FormCreate(Sender: TObject);
+begin
+  OpenGLControl := TOpenGLControl.Create(Self);
+  with OpenGLControl do
+  begin
+    Align := alClient;
+    Parent := Panel2;
+    OnPaint := @OpenGLControlPaint;
+    AutoResizeViewport := True;
+  end;
+  RadioGroup1.ItemIndex := 0;
+end;
+
+procedure TForm1.FormShow(Sender: TObject);
+begin
+  //You can not make textures before form show
+  Tex := BGLTexture('Background.jpg');
+  MainFont := BGLFont('Arial',20);
+  Timer1.Enabled := True;
+end;
+
+procedure TForm1.Timer1Timer(Sender: TObject);
+begin
+  if not GoBack then
+  begin
+    if r = 200 then
+      GoBack := True;
+    r += 1;
+  end
+  else
+  begin
+    if r = 50 then
+      GoBack := False;
+    r -= 1;
+  end;
+  OpenGLControl.Invalidate;
+end;
+
+procedure TForm1.OpenGLControlPaint(Sender: TObject);
+begin
+  //Dont forget this
+  BGLViewPort(OpenGLControl.Width, OpenGLControl.Height, BGRABlack);
+
+  case RadioGroup1.ItemIndex of
+    0:
+    begin
+      //Draw just texture
+      //StretchPutImage will resample image to prefered size
+      BGLCanvas.StretchPutImage(0, 0, OpenGLControl.Width, OpenGLControl.Height, Tex);
+    end;
+    1:
+    begin
+      UpdateMask;
+      //See how mask looks
+      if Assigned(Mask) then
+      begin
+        Mask.BlendMode := obmNormal;
+        BGLCanvas.PutImage(rectMask.Left, rectMask.Top, Mask);
+      end;
+    end;
+    2:
+    begin
+      UpdateMask;
+      //Now see them together
+      if Assigned(Mask) then
+      begin
+        //draw only the part of the image that overlaps with the mask
+        BGLCanvas.ClipRect := rectMask;
+        BGLCanvas.StretchPutImage(0, 0, OpenGLControl.Width, OpenGLControl.Height, Tex);
+        BGLCanvas.NoClip;
+
+        //apply the mask
+        Mask.BlendMode := obmMultiply;
+        BGLCanvas.PutImage(rectMask.Left, rectMask.Top, Mask);
+      end;
+
+      //draw the whole picture without mask
+      BGLCanvas.StretchPutImage(0, 0, OpenGLControl.Width, OpenGLControl.Height, Tex, 255-TrackBar1.Position);
+
+      if Assigned(Mask) then
+      begin
+        //draw the mask
+        Mask.BlendMode := obmAdd;
+        BGLCanvas.PutImage(rectMask.Left, rectMask.Top, Mask, (255-TrackBar1.Position) div 4);
+      end;
+    end;
+  end;
+
+  MainFont.TextOut(0,0, inttostr(OpenGLControl.FrameDiffTimeInMSecs) + ' ms');
+
+  //And dont forget this
+  OpenGLControl.SwapBuffers;
+end;
+
+procedure TForm1.UpdateMask;
+var rectEllipse: TRect;
+    mousePos: TPoint;
+    bmp: TBGLBitmap;
+begin
+  mousePos := Panel2.ScreenToControl(Mouse.CursorPos);
+
+  //determine area of the ellipse
+  rectEllipse := Rect(mousePos.x - ceil(r), mousePos.y - ceil(r),
+                 mousePos.x + ceil(r) + 1, mousePos.y + ceil(r) + 1);
+  rectMask := EmptyRect;
+  if IntersectRect(rectMask, rect(0,0, BGLCanvas.Width, BGLCanvas.Height), rectEllipse) then
+  begin
+    //render the ellipse
+    bmp := TBGLBitmap.Create(rectMask.Right-rectMask.Left, rectMask.Bottom-rectMask.Top, BGRABlack);
+    bmp.FillEllipseAntialias(mousePos.x-rectMask.Left, mousePos.y-rectMask.Top, r, r, BGRAWhite);
+    Mask := bmp.MakeTextureAndFree;
+  end else
+    Mask := nil;
+end;
+
+end.