clear.pp 1.7 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677
  1. {
  2. Ported to FPC by Nikolay Nikolov ([email protected])
  3. }
  4. {
  5. Clear example for OpenPTC 1.0 C++ implementation
  6. Copyright (c) Glenn Fiedler ([email protected])
  7. This source code is in the public domain
  8. }
  9. program ClearExample;
  10. {$MODE objfpc}
  11. uses
  12. SysUtils, ptc;
  13. var
  14. console: IPTCConsole;
  15. format: IPTCFormat;
  16. surface: IPTCSurface;
  17. width, height: Integer;
  18. x, y: Integer;
  19. size: Integer;
  20. area: IPTCArea;
  21. color: IPTCColor;
  22. begin
  23. try
  24. { create console }
  25. console := TPTCConsoleFactory.CreateNew;
  26. { create format }
  27. format := TPTCFormatFactory.CreateNew(32, $00FF0000, $0000FF00, $000000FF);
  28. { open the console }
  29. console.open('Clear example', format);
  30. { create surface matching console dimensions }
  31. surface := TPTCSurfaceFactory.CreateNew(console.width, console.height, format);
  32. { loop until a key is pressed }
  33. while not console.KeyPressed do
  34. begin
  35. { get surface dimensions }
  36. width := surface.width;
  37. height := surface.height;
  38. { get random position }
  39. x := Random(width);
  40. y := Random(height);
  41. { get random area size }
  42. size := Random(width div 8);
  43. { setup clear area }
  44. area := TPTCAreaFactory.CreateNew(x-size, y-size, x+size, y+size);
  45. { create random color }
  46. color := TPTCColorFactory.CreateNew(Random, Random, Random);
  47. { clear surface area with color }
  48. surface.clear(color, area);
  49. { copy to console }
  50. surface.copy(console);
  51. { update console }
  52. console.update;
  53. end;
  54. if Assigned(console) then
  55. console.close;
  56. except
  57. on error: TPTCError do
  58. { report error }
  59. error.report;
  60. end;
  61. end.