Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- type
- TAnonFunc = reference to procedure;
- TForm2 = class(TForm)
- Memo1: TMemo;
- Button1: TButton;
- Button2: TButton;
- Button3: TButton;
- procedure Button1Click(Sender: TObject);
- procedure Button2Click(Sender: TObject);
- procedure Button3Click(Sender: TObject);
- private
- F1 : TAnonFunc;
- F2 : TAnonFunc;
- end;
- procedure TForm2.Button1Click(Sender: TObject);
- var
- a : Integer;
- begin
- a := 1;
- F1 := procedure
- begin
- a := a + 1;
- end;
- F2 := procedure
- begin
- Memo1.Lines.Add(IntToStr(a));
- end;
- end;
- procedure TForm2.Button2Click(Sender: TObject);
- begin
- F1;
- end;
- procedure TForm2.Button3Click(Sender: TObject);
- begin
- F2;
- end;
- type
- TDisplayProc = TProc<TCanvas>;
- type
- TFrmExample3 = class(TForm)
- pbxMain: TPaintBox;
- trkZoom: TTrackBar;
- procedure FormCreate(Sender: TObject);
- procedure FormDestroy(Sender: TObject);
- procedure pbxMainClick(Sender: TObject);
- procedure pbxMainMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
- procedure pbxMainPaint(Sender: TObject);
- procedure trkZoomChange(Sender: TObject);
- private
- FDisplayList: TList<TDisplayProc>;
- FMouseX: Integer;
- FMouseY: Integer;
- FZoom: Extended;
- procedure SetZoom(const Value: Extended);
- protected
- procedure CreateCircle(X, Y: Integer);
- procedure CreateRectangle(X, Y: Integer);
- function MakeRect(X, Y, R: Integer): TRect;
- public
- property Zoom: Extended read FZoom write SetZoom;
- end;
- implementation
- {$R *.dfm}
- procedure TFrmExample3.PaintBox1Paint(Sender: TObject);
- var
- displayProc: TDisplayProc;
- begin
- for displayProc in FDisplayList do
- displayProc((Sender as TPaintBox).Canvas);
- end;
- procedure TFrmExample3.CreateCircle(X, Y: Integer);
- begin
- FDisplayList.Add(
- procedure (Canvas: TCanvas)
- begin
- Canvas.Brush.Color := clYellow;
- Canvas.Ellipse(MakeRect(X, Y, 20));
- end
- );
- end;
- procedure TFrmExample3.CreateRectangle(X, Y: Integer);
- begin
- FDisplayList.Add(
- procedure (Canvas: TCanvas)
- begin
- Canvas.Brush.Color := clBlue;
- Canvas.FillRect(MakeRect(X, Y, 20));
- end
- );
- end;
- procedure TFrmExample3.FormCreate(Sender: TObject);
- begin
- FDisplayList := TList<TDisplayProc>.Create;
- end;
- procedure TFrmExample3.FormDestroy(Sender: TObject);
- begin
- FreeAndNil(FDisplayList);
- end;
- function TFrmExample3.MakeRect(X, Y, R: Integer): TRect;
- begin
- Result := Rect(Round(Zoom*(X - R)), Round(Zoom*(Y - R)), Round(Zoom*(X + R)), Round(Zoom*(Y + R)));
- end;
- procedure TFrmExample3.pbxMainClick(Sender: TObject);
- begin
- case Random(2) of
- 0: CreateRectangle(Round(FMouseX/Zoom), Round(FMouseY/Zoom));
- 1: CreateCircle(Round(FMouseX/Zoom), Round(FMouseY/Zoom));
- end;
- pbxMain.Invalidate;
- end;
- procedure TFrmExample3.pbxMainMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
- begin
- FMouseX := X;
- FMouseY := Y;
- end;
- procedure TFrmExample4.SetZoom(const Value: Extended);
- begin
- FZoom := Value;
- trkZoom.Position := Round(2*(FZoom - 1));
- end;
- procedure TFrmExample4.trkZoomChange(Sender: TObject);
- begin
- Zoom := 0.5*(Sender as TTrackBar).Position + 1;
- pbxMain.Invalidate;
- end;
- filter(isOdd, [1, 2, 3, 5, 6, 9, 10]) --> [1, 3, 5, 9]
Add Comment
Please, Sign In to add comment