/examples/speedtest.pp

http://github.com/graemeg/lazarus · Puppet · 176 lines · 149 code · 27 blank · 0 comment · 1 complexity · d49ed8cbb33d444d64f2095798835756 MD5 · raw file

  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. }
  21. program SpeedTest;
  22. {$mode objfpc}{$H+}
  23. uses
  24. Interfaces, Forms, SysUtils, Buttons, Classes, StdCtrls, LCLType,
  25. LCLIntf, Graphics, LazLogger;
  26. type
  27. TForm1 = class(TForm)
  28. cmdOK: TButton;
  29. SpeedButton1 : TSpeedButton;
  30. SpeedButton2 : TSpeedButton;
  31. SpeedButton3 : TSpeedButton;
  32. SpeedButton4 : TSpeedButton;
  33. private
  34. FPicture: TPixmap;
  35. procedure ButtonClick(Sender: TObject);
  36. protected
  37. procedure Paint; override;
  38. public
  39. constructor Create(AOwner: TComponent); override;
  40. destructor Destroy; override;
  41. end;
  42. constructor TForm1.Create(AOwner: TComponent);
  43. var
  44. S: TFileStream;
  45. begin
  46. inherited CreateNew(AOwner, 1);
  47. Width := 300;
  48. Height := 150;
  49. cmdOK := TButton.Create(Self);
  50. with cmdOK do
  51. begin
  52. top := 0;
  53. left := 0;
  54. Height := 20;
  55. parent := Self;
  56. visible := true;
  57. onClick := @ButtonClick;
  58. end;
  59. SpeedButton1 := TSpeedButton.Create(Self);
  60. with Speedbutton1 do
  61. begin
  62. Parent := self;
  63. Enabled := True;
  64. Top := 25;
  65. Visible := True;
  66. end;
  67. SpeedButton2 := TSpeedButton.Create(Self);
  68. with Speedbutton2 do
  69. begin
  70. Parent := self;
  71. Enabled := True;
  72. Top := 25;
  73. Left := 25;
  74. Visible := True;
  75. end;
  76. SpeedButton3 := TSpeedButton.Create(Self);
  77. with Speedbutton3 do
  78. begin
  79. Parent := self;
  80. Enabled := True;
  81. Top := 50;
  82. Visible := True;
  83. Flat := True;
  84. end;
  85. SpeedButton4 := TSpeedButton.Create(Self);
  86. with Speedbutton4 do
  87. begin
  88. Parent := self;
  89. Enabled := True;
  90. Top := 50;
  91. Left := 25;
  92. Flat := True;
  93. Visible := True;
  94. end;
  95. S := TFileStream.Create('../images/penguin.xpm', fmOpenRead);
  96. try
  97. FPicture := TPixmap.Create;
  98. FPicture.TransparentColor := clBtnFace;
  99. FPicture.LoadFromStream(S);
  100. finally
  101. S.Free;
  102. end;
  103. end;
  104. destructor TForm1.Destroy;
  105. begin
  106. FPicture.Free;
  107. inherited Destroy;
  108. end;
  109. procedure TForm1.Paint;
  110. var
  111. r: TRect;
  112. begin
  113. inherited Paint;
  114. Canvas.Copyrect(Bounds(100,0,139,160), FPicture.Canvas, Rect(0,0,138,159));
  115. with SpeedButton4 do
  116. begin
  117. Self.Canvas.MoveTo(Left + Width + 2, Top);
  118. Self.Canvas.LineTo(Left + Width + 12, Top);
  119. Self.Canvas.MoveTo(Left + Width + 2, Top + Height);
  120. Self.Canvas.LineTo(Left + Width + 12, Top + Height);
  121. Self.Canvas.MoveTo(Left, Top + Height + 2);
  122. Self.Canvas.LineTo(Left, Top + Height + 12);
  123. Self.Canvas.MoveTo(Left + Width, Top + Height + 2);
  124. Self.Canvas.LineTo(Left + Width, Top + Height + 12);
  125. R := Bounds(Left + Width + 13, Top, Width, Height);
  126. end;
  127. DrawEdge(Canvas.Handle, R, BDR_RAISEDOUTER, BF_RECT);
  128. with R do
  129. begin
  130. Canvas.MoveTo(Left, Bottom + 2);
  131. Canvas.LineTo(Left, Bottom + 12);
  132. Canvas.MoveTo(Right, Bottom + 2);
  133. Canvas.LineTo(Right, Bottom + 12);
  134. end;
  135. end;
  136. procedure TForm1.ButtonClick(Sender: TObject);
  137. begin
  138. end;
  139. var
  140. Form1: TForm1;
  141. begin
  142. debugln('------ INIT ------- ');
  143. Application.Initialize; { calls InitProcedure which starts up GTK }
  144. debugln('------ CREATE ------- ');
  145. Application.CreateForm(TForm1, Form1);
  146. debugln('------ RUN ------- ');
  147. Application.Run;
  148. DebugLn('------ DONE ------- ');
  149. end.