home *** CD-ROM | disk | FTP | other *** search
/ Chip 2005 November / CDVD1105.ISO / Software / Freeware / programare / graphics32 / Examples / Vcl / RenderText_Ex / MainUnit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2004-07-05  |  2.7 KB  |  117 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.   StdCtrls, ExtCtrls, GR32, ComCtrls, GR32_Image, Buttons;
  33.  
  34. type
  35.   TForm1 = class(TForm)
  36.     Image: TImage32;
  37.     Panel1: TPanel;
  38.     Edit1: TEdit;
  39.     Label1: TLabel;
  40.     Button1: TButton;
  41.     Label2: TLabel;
  42.     SpeedButton1: TSpeedButton;
  43.     SpeedButton2: TSpeedButton;
  44.     SpeedButton3: TSpeedButton;
  45.     SpeedButton4: TSpeedButton;
  46.     SpeedButton5: TSpeedButton;
  47.     procedure Edit1Change(Sender: TObject);
  48.     procedure FormCreate(Sender: TObject);
  49.     procedure ImageResize(Sender: TObject);
  50.     procedure Button1Click(Sender: TObject);
  51.     procedure SpeedButton1Click(Sender: TObject);
  52.   public
  53.     AALevel: Integer;
  54.     procedure Draw;
  55.   end;
  56.  
  57. var
  58.   Form1: TForm1;
  59.  
  60. implementation
  61.  
  62. {$R *.DFM}
  63.  
  64. procedure TForm1.Draw;
  65. begin
  66.   Image.Bitmap.Clear;
  67.   Image.Bitmap.RenderText(10, 10, Edit1.Text, AALevel, $FFFFFFFF);
  68. end;
  69.  
  70. procedure TForm1.Edit1Change(Sender: TObject);
  71. begin
  72.   Draw;
  73. end;
  74.  
  75. procedure TForm1.FormCreate(Sender: TObject);
  76. begin
  77.   Image.SetupBitmap;
  78.   with Image.Bitmap.Font do
  79.   begin
  80.     Name := 'Tahoma';
  81.     Size := 20;
  82.     Style := [fsBold, fsItalic];
  83.   end;
  84.   Panel1.DoubleBuffered := True;
  85.   Edit1.DoubleBuffered := True;
  86. end;
  87.  
  88. procedure TForm1.ImageResize(Sender: TObject);
  89. begin
  90.   Image.SetupBitmap;
  91.   Draw;
  92. end;
  93.  
  94. procedure TForm1.Button1Click(Sender: TObject);
  95. var
  96.   I: Integer;
  97. begin
  98.   Screen.Cursor := crHourGlass;
  99.   with Image.Bitmap do
  100.     for I := 0 to 100 do
  101.       RenderText(
  102.         Random(Width - 40),
  103.         Random(Height - 40),
  104.         IntToStr(Random(100)),
  105.         AALevel,
  106.         Color32(Random(255), Random(255), Random(255), Random(255)));
  107.   Screen.Cursor := crDefault;
  108. end;
  109.  
  110. procedure TForm1.SpeedButton1Click(Sender: TObject);
  111. begin
  112.   AALevel := TControl(Sender).Tag;
  113.   Draw;
  114. end;
  115.  
  116. end.
  117.