/examples/speedtest.pp

  1{
  2 ***************************************************************************
  3 *                                                                         *
  4 *   This source is free software; you can redistribute it and/or modify   *
  5 *   it under the terms of the GNU General Public License as published by  *
  6 *   the Free Software Foundation; either version 2 of the License, or     *
  7 *   (at your option) any later version.                                   *
  8 *                                                                         *
  9 *   This code is distributed in the hope that it will be useful, but      *
 10 *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
 11 *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
 12 *   General Public License for more details.                              *
 13 *                                                                         *
 14 *   A copy of the GNU General Public License is available on the World    *
 15 *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
 16 *   obtain it by writing to the Free Software Foundation,                 *
 17 *   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
 18 *                                                                         *
 19 ***************************************************************************
 20}
 21program SpeedTest;
 22
 23{$mode objfpc}{$H+}
 24
 25uses 
 26  Interfaces, Forms, SysUtils, Buttons, Classes, StdCtrls, LCLType,
 27  LCLIntf, Graphics, LazLogger;
 28
 29type
 30  TForm1 = class(TForm)
 31    cmdOK: TButton;
 32    SpeedButton1 : TSpeedButton;
 33    SpeedButton2 : TSpeedButton;
 34    SpeedButton3 : TSpeedButton;
 35    SpeedButton4 : TSpeedButton;
 36  private
 37    FPicture: TPixmap;
 38    procedure ButtonClick(Sender: TObject);
 39  protected
 40    procedure Paint; override;
 41  public
 42    constructor Create(AOwner: TComponent); override;
 43    destructor Destroy; override;
 44  end;
 45  
 46
 47constructor TForm1.Create(AOwner: TComponent); 
 48var
 49  S: TFileStream;
 50begin
 51  inherited CreateNew(AOwner, 1);
 52  Width := 300;
 53  Height := 150;
 54
 55  cmdOK := TButton.Create(Self);
 56  with cmdOK do
 57  begin
 58    top := 0;
 59    left := 0;
 60    Height := 20;
 61    parent := Self;
 62    visible := true;
 63    onClick := @ButtonClick;
 64  end;
 65
 66  SpeedButton1 := TSpeedButton.Create(Self);
 67  with Speedbutton1 do
 68  begin
 69    Parent := self;
 70    Enabled := True;
 71    Top := 25;
 72    Visible := True;
 73   end;
 74
 75  SpeedButton2 := TSpeedButton.Create(Self);
 76  with Speedbutton2 do
 77  begin
 78    Parent := self;
 79    Enabled := True;
 80    Top := 25;
 81    Left := 25;
 82    Visible := True;
 83  end;
 84
 85  SpeedButton3 := TSpeedButton.Create(Self);
 86  with Speedbutton3 do
 87  begin
 88    Parent := self;
 89    Enabled := True;
 90    Top := 50;
 91    Visible := True;
 92    Flat := True;
 93   end;
 94
 95  SpeedButton4 := TSpeedButton.Create(Self);
 96  with Speedbutton4 do
 97  begin
 98    Parent := self;
 99    Enabled := True;
100    Top := 50;
101    Left := 25;
102    Flat := True;
103    Visible := True;
104  end;
105
106  S := TFileStream.Create('../images/penguin.xpm', fmOpenRead);
107  try
108    FPicture := TPixmap.Create;
109    FPicture.TransparentColor := clBtnFace;
110    FPicture.LoadFromStream(S);
111  finally
112    S.Free;
113  end;
114end;
115
116destructor TForm1.Destroy;
117begin
118  FPicture.Free;
119  inherited Destroy;
120end;
121
122procedure TForm1.Paint;
123var
124  r: TRect;
125begin
126  inherited Paint;
127  Canvas.Copyrect(Bounds(100,0,139,160), FPicture.Canvas, Rect(0,0,138,159));
128  
129  with SpeedButton4 do
130  begin
131    Self.Canvas.MoveTo(Left + Width + 2, Top);
132    Self.Canvas.LineTo(Left + Width + 12, Top);
133
134    Self.Canvas.MoveTo(Left + Width + 2, Top + Height);
135    Self.Canvas.LineTo(Left + Width + 12, Top + Height);
136
137    Self.Canvas.MoveTo(Left, Top + Height + 2);
138    Self.Canvas.LineTo(Left, Top + Height + 12);
139    
140    Self.Canvas.MoveTo(Left + Width, Top + Height + 2);
141    Self.Canvas.LineTo(Left + Width, Top + Height + 12);
142
143    R := Bounds(Left + Width + 13, Top, Width, Height);
144  end;
145
146  DrawEdge(Canvas.Handle, R, BDR_RAISEDOUTER, BF_RECT);
147
148  with R do
149  begin
150    Canvas.MoveTo(Left, Bottom + 2);
151    Canvas.LineTo(Left, Bottom + 12);
152
153    Canvas.MoveTo(Right, Bottom + 2);
154    Canvas.LineTo(Right, Bottom + 12);
155  end;
156end;
157
158procedure TForm1.ButtonClick(Sender: TObject);
159begin
160end;
161
162
163var
164  Form1: TForm1;
165  
166  
167begin
168   debugln('------ INIT ------- ');
169   Application.Initialize; { calls InitProcedure which starts up GTK }
170   debugln('------ CREATE ------- ');
171   Application.CreateForm(TForm1, Form1);
172   debugln('------ RUN ------- ');
173   Application.Run;
174   DebugLn('------ DONE ------- ');
175end.
176