home *** CD-ROM | disk | FTP | other *** search
/ Chip 2005 November / CDVD1105.ISO / Software / Freeware / programare / graphics32 / Examples / Clx / LineStippling_Ex / MainUnit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2004-07-15  |  2.3 KB  |  100 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.   SysUtils, Classes, QGraphics, QControls, QForms, QDialogs,
  32.   QStdCtrls, GR32, GR32_Image;
  33.  
  34. type
  35.   TForm1 = class(TForm)
  36.     Image: TImage32;
  37.     ScrollBar1: TScrollBar;
  38.     procedure ScrollBarChange(Sender: TObject);
  39.     procedure FormCreate(Sender: TObject);
  40.   private
  41.     { Private declarations }
  42.   public
  43.     procedure Spiral(X, Y: Integer);
  44.   end;
  45.  
  46. var
  47.   Form1: TForm1;
  48.  
  49. implementation
  50.  
  51. {$R *.xfm}
  52.  
  53. procedure TForm1.ScrollBarChange(Sender: TObject);
  54. var
  55.   Step: Single;
  56. begin
  57.   Step := ScrollBar1.Position / 100;
  58.  
  59.   with Image.Bitmap do
  60.   begin
  61.     BeginUpdate;
  62.     Clear(clBlack32);
  63.     SetStipple([clWhite32, clWhite32, clWhite32, clWhite32, 0, 0, 0, 0]);
  64.     StippleStep := Step;
  65.     Spiral(50, 50);
  66.  
  67.     SetStipple([clWhite32, $00FFFFFF]);
  68.     Spiral(150, 50);
  69.  
  70.     SetStipple([clWhite32, clRed32, clGreen32, 0, 0, 0]);
  71.     Spiral(50, 150);
  72.  
  73.     SetStipple([clGreen32, clGreen32, clGreen32, 0, 0, clWhite32, 0, 0]);
  74.     Spiral(150, 150);
  75.     EndUpdate;
  76.   end;
  77.   Image.Repaint;
  78. end;
  79.  
  80. procedure TForm1.Spiral(X, Y: Integer);
  81. var
  82.   Theta: Single;
  83. begin
  84.   Theta := 0;
  85.   Image.Bitmap.MoveToF(X, Y);
  86.   while Theta < 15 * 3.1415926535 do
  87.   begin
  88.     Image.Bitmap.LineToFSP(X + Cos(Theta) * Theta, Y + Sin(Theta) * Theta);
  89.     Theta := Theta + 0.2;
  90.   end;
  91. end;
  92.  
  93. procedure TForm1.FormCreate(Sender: TObject);
  94. begin
  95.   Image.SetupBitmap;
  96.   ScrollBarChange(Sender);
  97. end;
  98.  
  99. end.
  100.