code_junkie

Can someone explain Anonymous methods to me?

Nov 12th, 2011
88
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 3.16 KB | None | 0 0
  1. type
  2. TAnonFunc = reference to procedure;
  3. TForm2 = class(TForm)
  4. Memo1: TMemo;
  5. Button1: TButton;
  6. Button2: TButton;
  7. Button3: TButton;
  8. procedure Button1Click(Sender: TObject);
  9. procedure Button2Click(Sender: TObject);
  10. procedure Button3Click(Sender: TObject);
  11. private
  12. F1 : TAnonFunc;
  13. F2 : TAnonFunc;
  14. end;
  15.  
  16. procedure TForm2.Button1Click(Sender: TObject);
  17. var
  18. a : Integer;
  19. begin
  20. a := 1;
  21.  
  22. F1 := procedure
  23. begin
  24. a := a + 1;
  25. end;
  26.  
  27. F2 := procedure
  28. begin
  29. Memo1.Lines.Add(IntToStr(a));
  30. end;
  31. end;
  32.  
  33. procedure TForm2.Button2Click(Sender: TObject);
  34. begin
  35. F1;
  36. end;
  37.  
  38. procedure TForm2.Button3Click(Sender: TObject);
  39. begin
  40. F2;
  41. end;
  42.  
  43. type
  44. TDisplayProc = TProc<TCanvas>;
  45.  
  46. type
  47. TFrmExample3 = class(TForm)
  48. pbxMain: TPaintBox;
  49. trkZoom: TTrackBar;
  50. procedure FormCreate(Sender: TObject);
  51. procedure FormDestroy(Sender: TObject);
  52. procedure pbxMainClick(Sender: TObject);
  53. procedure pbxMainMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
  54. procedure pbxMainPaint(Sender: TObject);
  55. procedure trkZoomChange(Sender: TObject);
  56. private
  57. FDisplayList: TList<TDisplayProc>;
  58. FMouseX: Integer;
  59. FMouseY: Integer;
  60. FZoom: Extended;
  61. procedure SetZoom(const Value: Extended);
  62. protected
  63. procedure CreateCircle(X, Y: Integer);
  64. procedure CreateRectangle(X, Y: Integer);
  65. function MakeRect(X, Y, R: Integer): TRect;
  66. public
  67. property Zoom: Extended read FZoom write SetZoom;
  68. end;
  69.  
  70. implementation
  71.  
  72. {$R *.dfm}
  73.  
  74. procedure TFrmExample3.PaintBox1Paint(Sender: TObject);
  75. var
  76. displayProc: TDisplayProc;
  77. begin
  78. for displayProc in FDisplayList do
  79. displayProc((Sender as TPaintBox).Canvas);
  80. end;
  81.  
  82. procedure TFrmExample3.CreateCircle(X, Y: Integer);
  83. begin
  84. FDisplayList.Add(
  85. procedure (Canvas: TCanvas)
  86. begin
  87. Canvas.Brush.Color := clYellow;
  88. Canvas.Ellipse(MakeRect(X, Y, 20));
  89. end
  90. );
  91. end;
  92.  
  93. procedure TFrmExample3.CreateRectangle(X, Y: Integer);
  94. begin
  95. FDisplayList.Add(
  96. procedure (Canvas: TCanvas)
  97. begin
  98. Canvas.Brush.Color := clBlue;
  99. Canvas.FillRect(MakeRect(X, Y, 20));
  100. end
  101. );
  102. end;
  103.  
  104. procedure TFrmExample3.FormCreate(Sender: TObject);
  105. begin
  106. FDisplayList := TList<TDisplayProc>.Create;
  107. end;
  108.  
  109. procedure TFrmExample3.FormDestroy(Sender: TObject);
  110. begin
  111. FreeAndNil(FDisplayList);
  112. end;
  113.  
  114. function TFrmExample3.MakeRect(X, Y, R: Integer): TRect;
  115. begin
  116. Result := Rect(Round(Zoom*(X - R)), Round(Zoom*(Y - R)), Round(Zoom*(X + R)), Round(Zoom*(Y + R)));
  117. end;
  118.  
  119. procedure TFrmExample3.pbxMainClick(Sender: TObject);
  120. begin
  121. case Random(2) of
  122. 0: CreateRectangle(Round(FMouseX/Zoom), Round(FMouseY/Zoom));
  123. 1: CreateCircle(Round(FMouseX/Zoom), Round(FMouseY/Zoom));
  124. end;
  125. pbxMain.Invalidate;
  126. end;
  127.  
  128. procedure TFrmExample3.pbxMainMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
  129. begin
  130. FMouseX := X;
  131. FMouseY := Y;
  132. end;
  133.  
  134. procedure TFrmExample4.SetZoom(const Value: Extended);
  135. begin
  136. FZoom := Value;
  137. trkZoom.Position := Round(2*(FZoom - 1));
  138. end;
  139.  
  140. procedure TFrmExample4.trkZoomChange(Sender: TObject);
  141. begin
  142. Zoom := 0.5*(Sender as TTrackBar).Position + 1;
  143. pbxMain.Invalidate;
  144. end;
  145.  
  146. filter(isOdd, [1, 2, 3, 5, 6, 9, 10]) --> [1, 3, 5, 9]
Add Comment
Please, Sign In to add comment