Guest User

Untitled

a guest
Nov 20th, 2017
152
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. unit experiment3;
  2.  
  3. interface
  4.  
  5. uses
  6. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7. Dialogs, pngimage, ExtCtrls;
  8.  
  9. type
  10. TForm1 = class(TForm)
  11. Image1: TImage;
  12. Timer1: TTimer;
  13. Shape1: TShape;
  14. Image2: TImage;
  15. procedure OnTick1(Sender: TObject);
  16. procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
  17. procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  18. procedure OnClose(Sender: TObject; var Action: TCloseAction);
  19.  
  20. private
  21. { Private declarations }
  22. public
  23. { Public declarations }
  24. w: boolean;
  25. a: boolean;
  26. s: boolean;
  27. d: boolean;
  28. end;
  29.  
  30. var
  31. Form1: TForm1;
  32. location: TPoint;
  33. x: integer;
  34. y: integer;
  35.  
  36.  
  37. implementation
  38.  
  39. {$R *.dfm}
  40.  
  41. procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  42. Shift: TShiftState);
  43. begin
  44. if Key = 87 then
  45. w := true;
  46. if Key = 65 then
  47. a := true;
  48. if Key = 83 then
  49. s := true;
  50. if Key = 68 then
  51. d := true;
  52. end;
  53.  
  54.  
  55. procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
  56. begin
  57. if Key = 87 then
  58. w := false;
  59. if Key = 65 then
  60. a := false;
  61. if Key = 83 then
  62. s := false;
  63. if Key = 68 then
  64. d := false;
  65.  
  66. end;
  67.  
  68.  
  69. procedure TForm1.OnClose(Sender: TObject; var Action: TCloseAction);
  70. begin
  71. Application.Terminate;
  72. end;
  73.  
  74. procedure TForm1.OnTick1(Sender: TObject);
  75. var IntersectionRect: TRect;
  76. begin
  77.  
  78. begin
  79. if not(((Image1.Width + Image1.BoundsRect.TopLeft.x) >= Shape1.Left-10 ) and ((Image1.Width + Image1.BoundsRect.TopLeft.x) <= Shape1.Left+10 ) and IntersectRect(IntersectionRect, Image1.BoundsRect, Shape1.BoundsRect)) then
  80. begin
  81. if d = true then
  82. Image1.Left := Image1.Left + 5;
  83. end;
  84. if not((Image1.BoundsRect.BottomRight.Y >= Shape1.Top - 10) and (Image1.BoundsRect.BottomRight.Y <= Shape1.Top + 10) and IntersectRect(IntersectionRect, Image1.BoundsRect, Shape1.BoundsRect)) then
  85. begin
  86. if s = true then
  87. Image1.Top := Image1.Top + 5;
  88. end;
  89. if not((Image1.BoundsRect.TopLeft.X - 10 <= (Shape1.Left + Shape1.Width)) and (Image1.BoundsRect.TopLeft.X + 10 >= (Shape1.Left + Shape1.Width)) and IntersectRect(IntersectionRect, Image1.BoundsRect, Shape1.BoundsRect)) then
  90. begin
  91. if a = true then
  92. Image1.Left := Image1.Left - 5;
  93. end;
  94. if not((Image1.BoundsRect.TopLeft.Y <= Shape1.BoundsRect.BottomRight.y + 10) and (Image1.BoundsRect.TopLeft.Y >= Shape1.BoundsRect.BottomRight.y - 10) and IntersectRect(IntersectionRect, Image1.BoundsRect, Shape1.BoundsRect)) then
  95. begin
  96. if w = true then
  97. Image1.Top := Image1.Top - 5;
  98. end;
  99. end;
  100.  
  101.  
  102. end;
  103.  
  104. end.
RAW Paste Data