MainUnit.pas 6.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241
  1. unit MainUnit;
  2. (* ***** BEGIN LICENSE BLOCK *****
  3. * Version: MPL 1.1 or LGPL 2.1 with linking exception
  4. *
  5. * The contents of this file are subject to the Mozilla Public License Version
  6. * 1.1 (the "License"); you may not use this file except in compliance with
  7. * the License. You may obtain a copy of the License at
  8. * http://www.mozilla.org/MPL/
  9. *
  10. * Software distributed under the License is distributed on an "AS IS" basis,
  11. * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
  12. * for the specific language governing rights and limitations under the
  13. * License.
  14. *
  15. * Alternatively, the contents of this file may be used under the terms of the
  16. * Free Pascal modified version of the GNU Lesser General Public License
  17. * Version 2.1 (the "FPC modified LGPL License"), in which case the provisions
  18. * of this license are applicable instead of those above.
  19. * Please see the file LICENSE.txt for additional information concerning this
  20. * license.
  21. *
  22. * The Original Code is PixelCombine Example
  23. *
  24. * The Initial Developer of the Original Code is
  25. * Alex A. Denisov
  26. *
  27. * Portions created by the Initial Developer are Copyright (C) 2000-2005
  28. * the Initial Developer. All Rights Reserved.
  29. *
  30. * Contributor(s):
  31. *
  32. * ***** END LICENSE BLOCK ***** *)
  33. interface
  34. {$I GR32.inc}
  35. uses
  36. {$IFNDEF FPC} Windows, {$ELSE} LCLIntf, LResources, {$ENDIF}
  37. SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls,
  38. GR32, GR32_Image, GR32_Layers, GR32_Blend, GR32_RangeBars;
  39. type
  40. TFormPixelCombine = class(TForm)
  41. ImgView: TImgView32;
  42. RadioGroup: TRadioGroup;
  43. procedure FormCreate(Sender: TObject);
  44. procedure RadioGroupClick(Sender: TObject);
  45. protected
  46. procedure PC_Add(F: TColor32; var B: TColor32; M: TColor32);
  47. procedure PC_Sub(F: TColor32; var B: TColor32; M: TColor32);
  48. procedure PC_Modulate(F: TColor32; var B: TColor32; M: TColor32);
  49. procedure PC_Min(F: TColor32; var B: TColor32; M: TColor32);
  50. procedure PC_Max(F: TColor32; var B: TColor32; M: TColor32);
  51. procedure PC_Screen(F: TColor32; var B: TColor32; M: TColor32);
  52. procedure PC_ColorBurn(F: TColor32; var B: TColor32; M: TColor32);
  53. procedure PC_ColorDodge(F: TColor32; var B: TColor32; M: TColor32);
  54. procedure PC_Difference(F: TColor32; var B: TColor32; M: TColor32);
  55. procedure PC_Exclusion(F: TColor32; var B: TColor32; M: TColor32);
  56. procedure PC_Pattern(F: TColor32; var B: TColor32; M: TColor32);
  57. procedure PC_Blend(F: TColor32; var B: TColor32; M: TColor32);
  58. procedure PC_BlendAdd(F: TColor32; var B: TColor32; M: TColor32);
  59. procedure PC_BlendModulate(F: TColor32; var B: TColor32; M: TColor32);
  60. public
  61. PatCount: Integer;
  62. L: TBitmapLayer;
  63. end;
  64. var
  65. FormPixelCombine: TFormPixelCombine;
  66. implementation
  67. {$IFDEF FPC}
  68. {$R *.lfm}
  69. {$ELSE}
  70. {$R *.dfm}
  71. {$ENDIF}
  72. uses
  73. {$IFDEF Darwin}
  74. MacOSAll,
  75. {$ENDIF}
  76. {$IFNDEF FPC}
  77. JPEG;
  78. {$ELSE}
  79. LazJPG;
  80. {$ENDIF}
  81. // TFormPixelCombine
  82. procedure TFormPixelCombine.FormCreate(Sender: TObject);
  83. var
  84. I, J: Integer;
  85. SinJ: Double;
  86. ResStream: TResourceStream;
  87. JPEG: TJPEGImage;
  88. begin
  89. // Load background picture 'Runner'
  90. JPEG := TJPEGImage.Create;
  91. try
  92. ResStream := TResourceStream.Create(HInstance, 'Runner', RT_RCDATA);
  93. try
  94. JPEG.LoadFromStream(ResStream);
  95. finally
  96. ResStream.Free;
  97. end;
  98. ImgView.Bitmap.Assign(JPEG);
  99. finally
  100. JPEG.Free;
  101. end;
  102. // Create foreground bitmap layer
  103. L := TBitmapLayer.Create(ImgView.Layers);
  104. L.Bitmap.SetSize(200, 200);
  105. L.Bitmap.DrawMode := dmCustom;
  106. L.Location := FloatRect(20, 20, 220, 220);
  107. // Generate Bitmap
  108. for J := 0 to 199 do
  109. begin
  110. SinJ := Sin(J * 0.1);
  111. for I := 0 to 199 do
  112. L.Bitmap[I, J] := SetAlpha(
  113. Gray32(Round(((Sin(I * 0.1) + SinJ) * 0.25 + 0.5) * 255)),
  114. 255 * J div 199 // alpha value
  115. );
  116. end;
  117. L.Bitmap.OnPixelCombine := nil; // none by default
  118. end;
  119. procedure TFormPixelCombine.PC_Add(F: TColor32; var B: TColor32; M: TColor32);
  120. begin
  121. B := ColorAdd(F, B);
  122. end;
  123. procedure TFormPixelCombine.PC_Max(F: TColor32; var B: TColor32; M: TColor32);
  124. begin
  125. B := ColorMax(F, B);
  126. end;
  127. procedure TFormPixelCombine.PC_Min(F: TColor32; var B: TColor32; M: TColor32);
  128. begin
  129. B := ColorMin(F, B);
  130. end;
  131. procedure TFormPixelCombine.PC_Modulate(F: TColor32; var B: TColor32; M: TColor32);
  132. begin
  133. B := ColorModulate(F, B);
  134. end;
  135. procedure TFormPixelCombine.PC_Pattern(F: TColor32; var B: TColor32; M: TColor32);
  136. begin
  137. PatCount := 1 - PatCount;
  138. if PatCount = 0 then B := F;
  139. end;
  140. procedure TFormPixelCombine.PC_Sub(F: TColor32; var B: TColor32; M: TColor32);
  141. begin
  142. B := ColorSub(F, B);
  143. end;
  144. procedure TFormPixelCombine.PC_Screen(F: TColor32; var B: TColor32; M: TColor32);
  145. begin
  146. B := ColorScreen(F, B);
  147. end;
  148. procedure TFormPixelCombine.PC_ColorDodge(F: TColor32; var B: TColor32; M: TColor32);
  149. begin
  150. B := ColorDodge(F, B);
  151. end;
  152. procedure TFormPixelCombine.PC_ColorBurn(F: TColor32; var B: TColor32; M: TColor32);
  153. begin
  154. B := ColorBurn(F, B);
  155. end;
  156. procedure TFormPixelCombine.PC_Difference(F: TColor32; var B: TColor32; M: TColor32);
  157. begin
  158. B := ColorDifference(F, B);
  159. end;
  160. procedure TFormPixelCombine.PC_Exclusion(F: TColor32; var B: TColor32; M: TColor32);
  161. begin
  162. B := ColorExclusion(F, B);
  163. end;
  164. procedure TFormPixelCombine.PC_Blend(F: TColor32; var B: TColor32; M: TColor32);
  165. begin
  166. B := BlendReg(F, B);
  167. end;
  168. procedure TFormPixelCombine.PC_BlendAdd(F: TColor32; var B: TColor32; M: TColor32);
  169. begin
  170. B := BlendColorAdd(F, B);
  171. end;
  172. procedure TFormPixelCombine.PC_BlendModulate(F: TColor32; var B: TColor32; M: TColor32);
  173. begin
  174. B := BlendColorModulate(F, B);
  175. end;
  176. procedure TFormPixelCombine.RadioGroupClick(Sender: TObject);
  177. begin
  178. case RadioGroup.ItemIndex of
  179. 0:
  180. L.Bitmap.OnPixelCombine := nil;
  181. 1:
  182. L.Bitmap.OnPixelCombine := PC_Add;
  183. 2:
  184. L.Bitmap.OnPixelCombine := PC_Sub;
  185. 3:
  186. L.Bitmap.OnPixelCombine := PC_Modulate;
  187. 4:
  188. L.Bitmap.OnPixelCombine := PC_Min;
  189. 5:
  190. L.Bitmap.OnPixelCombine := PC_Max;
  191. 6:
  192. L.Bitmap.OnPixelCombine := PC_Screen;
  193. 7:
  194. L.Bitmap.OnPixelCombine := PC_ColorDodge;
  195. 8:
  196. L.Bitmap.OnPixelCombine := PC_ColorBurn;
  197. 9:
  198. L.Bitmap.OnPixelCombine := PC_Difference;
  199. 10:
  200. L.Bitmap.OnPixelCombine := PC_Exclusion;
  201. 11:
  202. L.Bitmap.OnPixelCombine := PC_Pattern;
  203. 12:
  204. L.Bitmap.OnPixelCombine := PC_Blend;
  205. 13:
  206. L.Bitmap.OnPixelCombine := PC_BlendAdd;
  207. 14:
  208. L.Bitmap.OnPixelCombine := PC_BlendModulate;
  209. end;
  210. L.Bitmap.Changed;
  211. end;
  212. end.