123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241 |
- 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
- {$I GR32.inc}
- uses
- {$IFNDEF FPC} Windows, {$ELSE} LCLIntf, LResources, {$ENDIF}
- SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls,
- GR32, GR32_Image, GR32_Layers, GR32_Blend, GR32_RangeBars;
- 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: TColor32);
- procedure PC_Sub(F: TColor32; var B: TColor32; M: TColor32);
- procedure PC_Modulate(F: TColor32; var B: TColor32; M: TColor32);
- procedure PC_Min(F: TColor32; var B: TColor32; M: TColor32);
- procedure PC_Max(F: TColor32; var B: TColor32; M: TColor32);
- procedure PC_Screen(F: TColor32; var B: TColor32; M: TColor32);
- procedure PC_ColorBurn(F: TColor32; var B: TColor32; M: TColor32);
- procedure PC_ColorDodge(F: TColor32; var B: TColor32; M: TColor32);
- procedure PC_Difference(F: TColor32; var B: TColor32; M: TColor32);
- procedure PC_Exclusion(F: TColor32; var B: TColor32; M: TColor32);
- procedure PC_Pattern(F: TColor32; var B: TColor32; M: TColor32);
- procedure PC_Blend(F: TColor32; var B: TColor32; M: TColor32);
- procedure PC_BlendAdd(F: TColor32; var B: TColor32; M: TColor32);
- procedure PC_BlendModulate(F: TColor32; var B: TColor32; M: TColor32);
- public
- PatCount: Integer;
- L: TBitmapLayer;
- end;
- var
- FormPixelCombine: TFormPixelCombine;
- implementation
- {$IFDEF FPC}
- {$R *.lfm}
- {$ELSE}
- {$R *.dfm}
- {$ENDIF}
- uses
- {$IFDEF Darwin}
- MacOSAll,
- {$ENDIF}
- {$IFNDEF FPC}
- JPEG;
- {$ELSE}
- LazJPG;
- {$ENDIF}
- // TFormPixelCombine
- procedure TFormPixelCombine.FormCreate(Sender: TObject);
- var
- I, J: Integer;
- SinJ: Double;
- ResStream: TResourceStream;
- JPEG: TJPEGImage;
- begin
- // Load background picture 'Runner'
- JPEG := TJPEGImage.Create;
- try
- ResStream := TResourceStream.Create(HInstance, 'Runner', RT_RCDATA);
- try
- JPEG.LoadFromStream(ResStream);
- finally
- ResStream.Free;
- end;
- ImgView.Bitmap.Assign(JPEG);
- finally
- JPEG.Free;
- end;
- // Create foreground bitmap layer
- L := TBitmapLayer.Create(ImgView.Layers);
- L.Bitmap.SetSize(200, 200);
- L.Bitmap.DrawMode := dmCustom;
- L.Location := FloatRect(20, 20, 220, 220);
- // Generate Bitmap
- for J := 0 to 199 do
- begin
- SinJ := Sin(J * 0.1);
- for I := 0 to 199 do
- L.Bitmap[I, J] := SetAlpha(
- Gray32(Round(((Sin(I * 0.1) + SinJ) * 0.25 + 0.5) * 255)),
- 255 * J div 199 // alpha value
- );
- end;
- L.Bitmap.OnPixelCombine := nil; // none by default
- end;
- procedure TFormPixelCombine.PC_Add(F: TColor32; var B: TColor32; M: TColor32);
- begin
- B := ColorAdd(F, B);
- end;
- procedure TFormPixelCombine.PC_Max(F: TColor32; var B: TColor32; M: TColor32);
- begin
- B := ColorMax(F, B);
- end;
- procedure TFormPixelCombine.PC_Min(F: TColor32; var B: TColor32; M: TColor32);
- begin
- B := ColorMin(F, B);
- end;
- procedure TFormPixelCombine.PC_Modulate(F: TColor32; var B: TColor32; M: TColor32);
- begin
- B := ColorModulate(F, B);
- end;
- procedure TFormPixelCombine.PC_Pattern(F: TColor32; var B: TColor32; M: TColor32);
- begin
- PatCount := 1 - PatCount;
- if PatCount = 0 then B := F;
- end;
- procedure TFormPixelCombine.PC_Sub(F: TColor32; var B: TColor32; M: TColor32);
- begin
- B := ColorSub(F, B);
- end;
- procedure TFormPixelCombine.PC_Screen(F: TColor32; var B: TColor32; M: TColor32);
- begin
- B := ColorScreen(F, B);
- end;
- procedure TFormPixelCombine.PC_ColorDodge(F: TColor32; var B: TColor32; M: TColor32);
- begin
- B := ColorDodge(F, B);
- end;
- procedure TFormPixelCombine.PC_ColorBurn(F: TColor32; var B: TColor32; M: TColor32);
- begin
- B := ColorBurn(F, B);
- end;
- procedure TFormPixelCombine.PC_Difference(F: TColor32; var B: TColor32; M: TColor32);
- begin
- B := ColorDifference(F, B);
- end;
- procedure TFormPixelCombine.PC_Exclusion(F: TColor32; var B: TColor32; M: TColor32);
- begin
- B := ColorExclusion(F, B);
- end;
- procedure TFormPixelCombine.PC_Blend(F: TColor32; var B: TColor32; M: TColor32);
- begin
- B := BlendReg(F, B);
- end;
- procedure TFormPixelCombine.PC_BlendAdd(F: TColor32; var B: TColor32; M: TColor32);
- begin
- B := BlendColorAdd(F, B);
- end;
- procedure TFormPixelCombine.PC_BlendModulate(F: TColor32; var B: TColor32; M: TColor32);
- begin
- B := BlendColorModulate(F, B);
- end;
- procedure TFormPixelCombine.RadioGroupClick(Sender: TObject);
- begin
- case RadioGroup.ItemIndex of
- 0:
- L.Bitmap.OnPixelCombine := nil;
- 1:
- L.Bitmap.OnPixelCombine := PC_Add;
- 2:
- L.Bitmap.OnPixelCombine := PC_Sub;
- 3:
- L.Bitmap.OnPixelCombine := PC_Modulate;
- 4:
- L.Bitmap.OnPixelCombine := PC_Min;
- 5:
- L.Bitmap.OnPixelCombine := PC_Max;
- 6:
- L.Bitmap.OnPixelCombine := PC_Screen;
- 7:
- L.Bitmap.OnPixelCombine := PC_ColorDodge;
- 8:
- L.Bitmap.OnPixelCombine := PC_ColorBurn;
- 9:
- L.Bitmap.OnPixelCombine := PC_Difference;
- 10:
- L.Bitmap.OnPixelCombine := PC_Exclusion;
- 11:
- L.Bitmap.OnPixelCombine := PC_Pattern;
- 12:
- L.Bitmap.OnPixelCombine := PC_Blend;
- 13:
- L.Bitmap.OnPixelCombine := PC_BlendAdd;
- 14:
- L.Bitmap.OnPixelCombine := PC_BlendModulate;
- end;
- L.Bitmap.Changed;
- end;
- end.
|