home *** CD-ROM | disk | FTP | other *** search
/ Chip 2005 November / CDVD1105.ISO / Software / Freeware / programare / graphics32 / Examples / Clx / PixelCombine_Ex / MainUnit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2004-07-15  |  3.8 KB  |  134 lines
  1. unit MainUnit;
  2.  
  3. (* ***** BEGIN LICENSE BLOCK *****
  4.  * Version: MPL 1.1
  5.  *
  6.  * The contents of this file are subject to the Mozilla Public License Version
  7.  * 1.1 (the "License"); you may not use this file except in compliance with
  8.  * the License. You may obtain a copy of the License at
  9.  * http://www.mozilla.org/MPL/
  10.  *
  11.  * Software distributed under the License is distributed on an "AS IS" basis,
  12.  * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
  13.  * for the specific language governing rights and limitations under the
  14.  * License.
  15.  *
  16.  * The Original Code is Graphics32
  17.  *
  18.  * The Initial Developer of the Original Code is
  19.  * Alex A. Denisov
  20.  *
  21.  * Portions created by the Initial Developer are Copyright (C) 2000-2004
  22.  * the Initial Developer. All Rights Reserved.
  23.  *
  24.  * Contributor(s):
  25.  *   Mattias Andersson <mattias@centaurix.com>
  26.  *
  27.  * ***** END LICENSE BLOCK ***** *)
  28.  
  29. interface
  30.  
  31. uses
  32.   SysUtils, Classes, QGraphics, QControls, QForms, QDialogs,
  33.   GR32, GR32_Image, GR32_Layers, GR32_Blend, QStdCtrls, QExtCtrls;
  34.  
  35. type
  36.   TForm1 = class(TForm)
  37.     ImgView: TImgView32;
  38.     RadioGroup1: TRadioGroup;
  39.     procedure FormCreate(Sender: TObject);
  40.     procedure RadioGroup1Click(Sender: TObject);
  41.   protected
  42.     procedure PC_Add(F: TColor32; var B: TColor32; M: TColor32);
  43.     procedure PC_Sub(F: TColor32; var B: TColor32; M: TColor32);
  44.     procedure PC_Modulate(F: TColor32; var B: TColor32; M: TColor32);
  45.     procedure PC_Min(F: TColor32; var B: TColor32; M: TColor32);
  46.     procedure PC_Max(F: TColor32; var B: TColor32; M: TColor32);
  47.     procedure PC_Difference(F: TColor32; var B: TColor32; M: TColor32);
  48.     procedure PC_Exclusion(F: TColor32; var B: TColor32; M: TColor32);
  49.     procedure PC_Pattern(F: TColor32; var B: TColor32; M: TColor32);
  50.   public
  51.     PatCount: Integer;
  52.     L: TBitmapLayer;
  53.   end;
  54.  
  55. var
  56.   Form1: TForm1;
  57.  
  58. implementation
  59.  
  60. {$R *.xfm}
  61.  
  62. procedure TForm1.FormCreate(Sender: TObject);
  63. var
  64.   I, J: Integer;
  65. begin
  66.   L := TBitmapLayer.Create(ImgView.Layers);
  67.   L.Bitmap.SetSize(200, 200);
  68.   L.Bitmap.DrawMode := dmCustom;
  69.   L.Location := FloatRect(20, 20, 220, 220);
  70.   for J := 0 to 199 do
  71.     for I := 0 to 199 do
  72.       L.Bitmap[I, J] := Gray32(Round(((Sin(I / 10) + Sin(J / 10)) * 0.25 + 0.5) * 255));
  73.   L.Bitmap.OnPixelCombine := nil; // none by default
  74. end;
  75.  
  76. procedure TForm1.PC_Add(F: TColor32; var B: TColor32; M: TColor32);
  77. begin
  78.   B := ColorAdd(F, B);
  79. end;
  80.  
  81. procedure TForm1.PC_Max(F: TColor32; var B: TColor32; M: TColor32);
  82. begin
  83.   B := ColorMax(F, B);
  84. end;
  85.  
  86. procedure TForm1.PC_Min(F: TColor32; var B: TColor32; M: TColor32);
  87. begin
  88.   B := ColorMin(F, B);
  89. end;
  90.  
  91. procedure TForm1.PC_Modulate(F: TColor32; var B: TColor32; M: TColor32);
  92. begin
  93.   B := ColorModulate(F, B);
  94. end;
  95.  
  96. procedure TForm1.PC_Pattern(F: TColor32; var B: TColor32; M: TColor32);
  97. begin
  98.   PatCount := 1 - PatCount;
  99.   if PatCount = 0 then B := F;
  100. end;
  101.  
  102. procedure TForm1.PC_Sub(F: TColor32; var B: TColor32; M: TColor32);
  103. begin
  104.   B := ColorSub(F, B);
  105. end;
  106.  
  107. procedure TForm1.PC_Difference(F: TColor32; var B: TColor32; M: TColor32);
  108. begin
  109.   B := ColorDifference(F, B);
  110. end;
  111.  
  112. procedure TForm1.PC_Exclusion(F: TColor32; var B: TColor32; M: TColor32);
  113. begin
  114.   B := ColorExclusion(F, B);
  115. end;
  116.  
  117. procedure TForm1.RadioGroup1Click(Sender: TObject);
  118. begin
  119.   case RadioGroup1.ItemIndex of
  120.     0: L.Bitmap.OnPixelCombine := nil;
  121.     1: L.Bitmap.OnPixelCombine := PC_Add;
  122.     2: L.Bitmap.OnPixelCombine := PC_Sub;
  123.     3: L.Bitmap.OnPixelCombine := PC_Modulate;
  124.     4: L.Bitmap.OnPixelCombine := PC_Min;
  125.     5: L.Bitmap.OnPixelCombine := PC_Max;
  126.     6: L.Bitmap.OnPixelCombine := PC_Difference;
  127.     7: L.Bitmap.OnPixelCombine := PC_Exclusion;
  128.     8: L.Bitmap.OnPixelCombine := PC_Pattern;
  129.   end;
  130.   L.Bitmap.Changed;
  131. end;
  132.  
  133. end.
  134.