home *** CD-ROM | disk | FTP | other *** search
/ Chip 2005 November / CDVD1105.ISO / Software / Freeware / programare / graphics32 / Examples / Vcl / PixelCombine_Ex / MainUnit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2004-07-07  |  3.7 KB  |  133 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.  *
  26.  * ***** END LICENSE BLOCK ***** *)
  27.  
  28. interface
  29.  
  30. uses
  31.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  32.   GR32, GR32_Image, GR32_Layers, GR32_Blend, StdCtrls, ExtCtrls;
  33.  
  34. type
  35.   TForm1 = class(TForm)
  36.     ImgView: TImgView32;
  37.     RadioGroup1: TRadioGroup;
  38.     procedure FormCreate(Sender: TObject);
  39.     procedure RadioGroup1Click(Sender: TObject);
  40.   protected
  41.     procedure PC_Add(F: TColor32; var B: TColor32; M: TColor32);
  42.     procedure PC_Sub(F: TColor32; var B: TColor32; M: TColor32);
  43.     procedure PC_Modulate(F: TColor32; var B: TColor32; M: TColor32);
  44.     procedure PC_Min(F: TColor32; var B: TColor32; M: TColor32);
  45.     procedure PC_Max(F: TColor32; var B: TColor32; M: TColor32);
  46.     procedure PC_Difference(F: TColor32; var B: TColor32; M: TColor32);
  47.     procedure PC_Exclusion(F: TColor32; var B: TColor32; M: TColor32);
  48.     procedure PC_Pattern(F: TColor32; var B: TColor32; M: TColor32);
  49.   public
  50.     PatCount: Integer;
  51.     L: TBitmapLayer;
  52.   end;
  53.  
  54. var
  55.   Form1: TForm1;
  56.  
  57. implementation
  58.  
  59. {$R *.DFM}
  60.  
  61. procedure TForm1.FormCreate(Sender: TObject);
  62. var
  63.   I, J: Integer;
  64. begin
  65.   L := TBitmapLayer.Create(ImgView.Layers);
  66.   L.Bitmap.SetSize(200, 200);
  67.   L.Bitmap.DrawMode := dmCustom;
  68.   L.Location := FloatRect(20, 20, 220, 220);
  69.   for J := 0 to 199 do
  70.     for I := 0 to 199 do
  71.       L.Bitmap[I, J] := Gray32(Round(((Sin(I / 10) + Sin(J / 10)) * 0.25 + 0.5) * 255));
  72.   L.Bitmap.OnPixelCombine := nil; // none by default
  73. end;
  74.  
  75. procedure TForm1.PC_Add(F: TColor32; var B: TColor32; M: TColor32);
  76. begin
  77.   B := ColorAdd(F, B);
  78. end;
  79.  
  80. procedure TForm1.PC_Max(F: TColor32; var B: TColor32; M: TColor32);
  81. begin
  82.   B := ColorMax(F, B);
  83. end;
  84.  
  85. procedure TForm1.PC_Min(F: TColor32; var B: TColor32; M: TColor32);
  86. begin
  87.   B := ColorMin(F, B);
  88. end;
  89.  
  90. procedure TForm1.PC_Modulate(F: TColor32; var B: TColor32; M: TColor32);
  91. begin
  92.   B := ColorModulate(F, B);
  93. end;
  94.  
  95. procedure TForm1.PC_Pattern(F: TColor32; var B: TColor32; M: TColor32);
  96. begin
  97.   PatCount := 1 - PatCount;
  98.   if PatCount = 0 then B := F;
  99. end;
  100.  
  101. procedure TForm1.PC_Sub(F: TColor32; var B: TColor32; M: TColor32);
  102. begin
  103.   B := ColorSub(F, B);
  104. end;
  105.  
  106. procedure TForm1.PC_Difference(F: TColor32; var B: TColor32; M: TColor32);
  107. begin
  108.   B := ColorDifference(F, B);
  109. end;
  110.  
  111. procedure TForm1.PC_Exclusion(F: TColor32; var B: TColor32; M: TColor32);
  112. begin
  113.   B := ColorExclusion(F, B);
  114. end;
  115.  
  116. procedure TForm1.RadioGroup1Click(Sender: TObject);
  117. begin
  118.   case RadioGroup1.ItemIndex of
  119.     0: L.Bitmap.OnPixelCombine := nil;
  120.     1: L.Bitmap.OnPixelCombine := PC_Add;
  121.     2: L.Bitmap.OnPixelCombine := PC_Sub;
  122.     3: L.Bitmap.OnPixelCombine := PC_Modulate;
  123.     4: L.Bitmap.OnPixelCombine := PC_Min;
  124.     5: L.Bitmap.OnPixelCombine := PC_Max;
  125.     6: L.Bitmap.OnPixelCombine := PC_Difference;
  126.     7: L.Bitmap.OnPixelCombine := PC_Exclusion;
  127.     8: L.Bitmap.OnPixelCombine := PC_Pattern;
  128.   end;
  129.   L.Bitmap.Changed;
  130. end;
  131.  
  132. end.
  133.