GLScene/Externals/Graphics32/Examples/Blending/PixelCombine/MainUnit.pas

unit MainUnit;

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1 or LGPL 2.1 with linking exception
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * Alternatively, the contents of this file may be used under the terms of the
 * Free Pascal modified version of the GNU Lesser General Public License
 * Version 2.1 (the "FPC modified LGPL License"), in which case the provisions
 * of this license are applicable instead of those above.
 * Please see the file LICENSE.txt for additional information concerning this
 * license.
 *
 * The Original Code is PixelCombine Example
 *
 * The Initial Developer of the Original Code is
 * Alex A. Denisov
 *
 * Portions created by the Initial Developer are Copyright (C) 2000-2005
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

interface

{$include GR32.inc}

uses
  {$IFNDEF FPC} Windows, {$ELSE} LCLIntf, LCLType, LResources, {$ENDIF}
  SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls,
  GR32,
  GR32_Image,
  GR32_Layers;

type
  TFormPixelCombine = class(TForm)
    ImgView: TImgView32;
    RadioGroup: TRadioGroup;
    procedure FormCreate(Sender: TObject);
    procedure RadioGroupClick(Sender: TObject);
  protected
    procedure PC_Add(F: TColor32; var B: TColor32; M: Cardinal);
    procedure PC_Sub(F: TColor32; var B: TColor32; M: Cardinal);
    procedure PC_Modulate(F: TColor32; var B: TColor32; M: Cardinal);
    procedure PC_Min(F: TColor32; var B: TColor32; M: Cardinal);
    procedure PC_Max(F: TColor32; var B: TColor32; M: Cardinal);
    procedure PC_Screen(F: TColor32; var B: TColor32; M: Cardinal);
    procedure PC_ColorBurn(F: TColor32; var B: TColor32; M: Cardinal);
    procedure PC_ColorDodge(F: TColor32; var B: TColor32; M: Cardinal);
    procedure PC_Difference(F: TColor32; var B: TColor32; M: Cardinal);
    procedure PC_Exclusion(F: TColor32; var B: TColor32; M: Cardinal);
    procedure PC_Pattern(F: TColor32; var B: TColor32; M: Cardinal);
    procedure PC_Blend(F: TColor32; var B: TColor32; M: Cardinal);
    procedure PC_BlendAdd(F: TColor32; var B: TColor32; M: Cardinal);
    procedure PC_BlendModulate(F: TColor32; var B: TColor32; M: Cardinal);
  private
    FPatCount: Integer;
    FLayer1: TBitmapLayer;
    FLayer2: TBitmapLayer;
  end;

var
  FormPixelCombine: TFormPixelCombine;

implementation

{$R *.dfm}

uses
  Types,
  GR32_Blend,
  GR32_RangeBars,
  GR32.ImageFormats.JPG;

{ TFormPixelCombine }

procedure TFormPixelCombine.FormCreate(Sender: TObject);

  procedure GenerateBitmap(Bitmap: TBitmap32);
  var
    X, Y: Integer;
    SinY, SinX: Double;
    Color: TColor32;
  begin
    // Just a pattern with some variation
    for Y := 0 to Bitmap.Height-1 do
    begin
      SinY := Sin(Y * 0.1);

      for X := 0 to Bitmap.Width-1 do
      begin
        SinX := Sin(X * 0.1);

        Color :=  Gray32(Round(((SinX + SinY) * 0.25 + 0.5) * 255));
        // Alpha gradient
        Color := SetAlpha(Color, MulDiv(255, Y, Bitmap.Height-1));
        
        Bitmap[X, Y] := Color;    
      end;
    end;
  end;

var
  RubberbandLayer: TRubberbandLayer;
  r: TRect;
  Viewport: TRect;
  Location: TFloatRect;
const
  BitmapSize = 200;
  BitmapOffset = 20;
begin
  // Load background picture 'Runner'
  ImgView.Bitmap.LoadFromResourceName(HInstance, 'Runner', RT_RCDATA);

  // Create foreground bitmap layers
  
  // First layer is unscaled
  FLayer1 := TBitmapLayer.Create(ImgView.Layers);
  FLayer1.Visible := False;
  FLayer1.Bitmap.SetSize(BitmapSize, BitmapSize);
  FLayer1.Bitmap.DrawMode := dmCustom;
  GenerateBitmap(FLayer1.Bitmap);
  FLayer1.Scaled := False;
  // Position top-left
  r := FLayer1.Bitmap.BoundsRect;
  r.Offset(BitmapOffset, BitmapOffset);
  if (FLayer1.Scaled) then
    // Location is relative to bitmap
    Location := ImgView.ControlToBitmap(r)
  else
    // Location is relative to viewport
    Location := FloatRect(r);
  FLayer1.Location := Location;

  // Second layer is scaled
  FLayer2 := TBitmapLayer.Create(ImgView.Layers);
  FLayer2.Visible := False;
  FLayer2.Bitmap.Assign(FLayer1.Bitmap);
  FLayer2.Scaled := True;
  // Position bottom-right
  r := FLayer1.Bitmap.BoundsRect;
  Viewport := ImgView.GetViewportRect;
  r.Offset(Viewport.Width-r.Width-BitmapOffset, Viewport.Height-r.Height-BitmapOffset);
  if (FLayer2.Scaled) then
    // Location is relative to bitmap
    Location := ImgView.ControlToBitmap(r)
  else
    // Location is relative to viewport
    Location := FloatRect(r);
  FLayer2.Location := Location;


  // Create rubberband layers so we can move the foreground layers around
  RubberbandLayer := TRubberbandLayer.Create(ImgView.Layers);
  RubberbandLayer.Visible := False;
  RubberbandLayer.ChildLayer := FLayer1;
  RubberbandLayer.Handles := [rhCenter, rhFrame, rhCorners];
  RubberbandLayer.ChildLayer.Visible := True;
  RubberbandLayer.Visible := True;

  RubberbandLayer := TRubberbandLayer.Create(ImgView.Layers);
  RubberbandLayer.Visible := False;
  RubberbandLayer.ChildLayer := FLayer2;
  RubberbandLayer.Handles := [rhCenter, rhFrame, rhCorners];
  RubberbandLayer.ChildLayer.Visible := True;
  RubberbandLayer.Visible := True;
end;

procedure TFormPixelCombine.PC_Add(F: TColor32; var B: TColor32; M: Cardinal);
begin
  B := ColorAdd(F, B);
end;

procedure TFormPixelCombine.PC_Max(F: TColor32; var B: TColor32; M: Cardinal);
begin
  B := ColorMax(F, B);
end;

procedure TFormPixelCombine.PC_Min(F: TColor32; var B: TColor32; M: Cardinal);
begin
  B := ColorMin(F, B);
end;

procedure TFormPixelCombine.PC_Modulate(F: TColor32; var B: TColor32; M: Cardinal);
begin
  B := ColorModulate(F, B);
end;

procedure TFormPixelCombine.PC_Pattern(F: TColor32; var B: TColor32; M: Cardinal);
begin
  FPatCount := 1 - FPatCount;
  if FPatCount = 0 then
    B := F;
end;

procedure TFormPixelCombine.PC_Sub(F: TColor32; var B: TColor32; M: Cardinal);
begin
  B := ColorSub(F, B);
end;

procedure TFormPixelCombine.PC_Screen(F: TColor32; var B: TColor32; M: Cardinal);
begin
  B := ColorScreen(F, B);
end;

procedure TFormPixelCombine.PC_ColorDodge(F: TColor32; var B: TColor32; M: Cardinal);
begin
  B := ColorDodge(F, B);
end;

procedure TFormPixelCombine.PC_ColorBurn(F: TColor32; var B: TColor32; M: Cardinal);
begin
  B := ColorBurn(F, B);
end;

procedure TFormPixelCombine.PC_Difference(F: TColor32; var B: TColor32; M: Cardinal);
begin
  B := ColorDifference(F, B);
end;

procedure TFormPixelCombine.PC_Exclusion(F: TColor32; var B: TColor32; M: Cardinal);
begin
  B := ColorExclusion(F, B);
end;

procedure TFormPixelCombine.PC_Blend(F: TColor32; var B: TColor32; M: Cardinal);
begin
  B := BlendReg(F, B);
end;

procedure TFormPixelCombine.PC_BlendAdd(F: TColor32; var B: TColor32; M: Cardinal);
begin
  B := BlendColorAdd(F, B);
end;

procedure TFormPixelCombine.PC_BlendModulate(F: TColor32; var B: TColor32; M: Cardinal);
begin
  B := BlendColorModulate(F, B);
end;

procedure TFormPixelCombine.RadioGroupClick(Sender: TObject);
begin
  case RadioGroup.ItemIndex of
    0:
      FLayer1.Bitmap.OnPixelCombine := nil;
    1:
      FLayer1.Bitmap.OnPixelCombine := PC_Add;
    2:
      FLayer1.Bitmap.OnPixelCombine := PC_Sub;
    3:
      FLayer1.Bitmap.OnPixelCombine := PC_Modulate;
    4:
      FLayer1.Bitmap.OnPixelCombine := PC_Min;
    5:
      FLayer1.Bitmap.OnPixelCombine := PC_Max;
    6:
      FLayer1.Bitmap.OnPixelCombine := PC_Screen;
    7:
      FLayer1.Bitmap.OnPixelCombine := PC_ColorDodge;
    8:
      FLayer1.Bitmap.OnPixelCombine := PC_ColorBurn;
    9:
      FLayer1.Bitmap.OnPixelCombine := PC_Difference;
    10:
      FLayer1.Bitmap.OnPixelCombine := PC_Exclusion;
    11:
      FLayer1.Bitmap.OnPixelCombine := PC_Pattern;
    12:
      FLayer1.Bitmap.OnPixelCombine := PC_Blend;
    13:
      FLayer1.Bitmap.OnPixelCombine := PC_BlendAdd;
    14:
      FLayer1.Bitmap.OnPixelCombine := PC_BlendModulate;
  end;
  FLayer2.Bitmap.OnPixelCombine := FLayer1.Bitmap.OnPixelCombine;
  
  FLayer1.Changed;
  FLayer2.Changed;
end;

end.