Recent

Author Topic: Setting events stored in other unit to controls  (Read 5040 times)

Handoko

  • Hero Member
  • *****
  • Posts: 5130
  • My goal: build my own game engine using Lazarus
Re: Setting events stored in other unit to controls
« Reply #15 on: May 18, 2021, 08:54:08 pm »
This would not be so difficult if actions are done to "Sender" itself, but  would be difficult if events have to do something on other controls.

Yes, you're right. It is much more challenging. Here I wrote a demo for setting button's OnClick event to control the behavior of 2 shapes.


Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, Forms, Graphics, StdCtrls, ExtCtrls, ActionsLib;
  9.  
  10. type
  11.  
  12.   { TForm1 }
  13.  
  14.   TForm1 = class(TForm)
  15.     btnStart: TButton;
  16.     procedure btnStartClick(Sender: TObject);
  17.     procedure FormDestroy(Sender: TObject);
  18.   private
  19.     FShapes: array of TShape;
  20.   end;
  21.  
  22. var
  23.   Form1: TForm1;
  24.  
  25. implementation
  26.  
  27. {$R *.lfm}
  28.  
  29. { TForm1 }
  30.  
  31. procedure TForm1.btnStartClick(Sender: TObject);
  32. var
  33.   aShape:  TShape;
  34.   aButton: TButton;
  35. begin
  36.  
  37.   btnStart.Free;
  38.  
  39.   // Create the shapes
  40.   SetLength(FShapes, 2);
  41.   aShape              := TShape.Create(Self);
  42.   aShape.Parent       := Self;
  43.   aShape.Left         := 40;
  44.   aShape.Top          := 40;
  45.   aShape.Brush.Color  := clMoneyGreen;
  46.   aShape.Shape        := stCircle;
  47.   FShapes[0]          := aShape;
  48.   aShape              := TShape.Create(Self);
  49.   aShape.Parent       := Self;
  50.   aShape.Left         := 130;
  51.   aShape.Top          := 40;
  52.   aShape.Brush.Color  := clYellow;
  53.   aShape.Shape        := stTriangle;
  54.   FShapes[1]          := aShape;
  55.   aShape              := TShape.Create(Self);
  56.   aShape.Parent       := Self;
  57.   aShape.Left         := 220;
  58.   aShape.Top          := 40;
  59.   aShape.Brush.Color  := clSkyBlue;
  60.   aShape.Shape        := stDiamond;
  61.   FShapes[2]          := aShape;
  62.  
  63.   // Create the labels
  64.   with TLabel.Create(Self) do
  65.   begin
  66.     Parent := Self;
  67.     Left   := 70;
  68.     Top    := 20;
  69.     Caption := 'A';
  70.   end;
  71.   with TLabel.Create(Self) do
  72.   begin
  73.     Parent := Self;
  74.     Left   := 160;
  75.     Top    := 20;
  76.     Caption := 'B';
  77.   end;
  78.   with TLabel.Create(Self) do
  79.   begin
  80.     Parent := Self;
  81.     Left   := 250;
  82.     Top    := 20;
  83.     Caption := 'C';
  84.   end;
  85.  
  86.   // Create buttons
  87.   aButton := TButton.Create(Self);
  88.   aButton.Parent  := Form1;
  89.   aButton.Left    := 40;
  90.   aButton.Top     := 130;
  91.   aButton.Width   := 240;
  92.   aButton.Caption := 'AB swap color';
  93.   ButtonClickSwapColor(aButton, FShapes[0], FShapes[1]);
  94.   aButton         := TButton.Create(Self);
  95.   aButton.Parent  := Form1;
  96.   aButton.Left    := 40;
  97.   aButton.Top     := 160;
  98.   aButton.Width   := 240;
  99.   aButton.Caption := 'BC swap color';
  100.   ButtonClickSwapColor(aButton, FShapes[1], FShapes[2]);
  101.   aButton         := TButton.Create(Self);
  102.   aButton.Parent  := Form1;
  103.   aButton.Left    := 40;
  104.   aButton.Top     := 190;
  105.   aButton.Width   := 240;
  106.   aButton.Caption := 'AB swap shape';
  107.   ButtonClickSwapShape(aButton, FShapes[0], FShapes[1]);
  108.  
  109. end;
  110.  
  111. procedure TForm1.FormDestroy(Sender: TObject);
  112. var
  113.   i: Integer;
  114. begin
  115.   for i := 0 to Length(FShapes)-1 do
  116.     FShapes[i].Free;
  117.   SetLength(FShapes, 0);
  118. end;
  119.  
  120. end.

In the code above, all the visual components on the form are created at run-time except btnStart, line #15.
Setting the OnClick events can be found on the lines #93, #100, #107.


Code: Pascal  [Select][+][-]
  1. unit ActionsLib;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Graphics, StdCtrls, ExtCtrls;
  9.  
  10. procedure ButtonClickSwapColor(Button: TButton; Shape1, Shape2: TShape);
  11. procedure ButtonClickSwapShape(Button: TButton; Shape1, Shape2: TShape);
  12.  
  13. implementation
  14.  
  15. const
  16.   ID_Length = 30; // not sure but 30 should be more than enough
  17.  
  18. type
  19.  
  20.   IDstring = string[ID_Length];
  21.   TLink = record
  22.     ID:    IDstring;
  23.     Item1: TShape;
  24.     Item2: TShape;
  25.   end;
  26.  
  27.   { TTmpShape }
  28.  
  29.   TTmpShape = class(TShape)
  30.   public
  31.     procedure SwapColor(Sender: TObject);
  32.     procedure SwapShape(Sender: TObject);
  33.   end;
  34.  
  35. var
  36.   TmpShape: TTmpShape;
  37.   Links:    array of TLink;
  38.  
  39. procedure SaveLink(const ID: IDstring; Shape1, Shape2: TShape);
  40. var
  41.   i: Integer;
  42. begin
  43.   i := Length(Links);
  44.   SetLength(Links, i+1);
  45.   Links[i].ID    := ID;
  46.   Links[i].Item1 := Shape1;
  47.   Links[i].Item2 := Shape2;
  48. end;
  49.  
  50. procedure GetLink(const ID: IDstring; out Shape1, Shape2: TShape);
  51. var
  52.   i: Integer;
  53. begin
  54.   Shape1 := nil;
  55.   Shape2 := nil;
  56.   for i := 0 to Length(Links)-1 do
  57.     if Links[i].ID = ID then
  58.     begin
  59.       Shape1 := Links[i].Item1;
  60.       Shape2 := Links[i].Item2;
  61.       Exit;
  62.     end;
  63. end;
  64.  
  65. procedure ButtonClickSwapColor(Button: TButton; Shape1, Shape2: TShape);
  66. var
  67.   S: string;
  68. begin
  69.   S := PtrInt(Button).ToString + 'Click';
  70.   SaveLink(S, Shape1, Shape2);
  71.   Button.OnClick := @TmpShape.SwapColor;
  72. end;
  73.  
  74. procedure ButtonClickSwapShape(Button: TButton; Shape1, Shape2: TShape);
  75. var
  76.   S: string;
  77. begin
  78.   S := PtrInt(Button).ToString + 'Click';
  79.   SaveLink(S, Shape1, Shape2);
  80.   Button.OnClick := @TmpShape.SwapShape;
  81. end;
  82.  
  83. { TTmpShape }
  84.  
  85. procedure TTmpShape.SwapColor(Sender: TObject);
  86. var
  87.   Shape1, Shape2: TShape;
  88.   Temp:           TColor;
  89.   S:              string;
  90. begin
  91.   if not(Sender is TButton) then Exit;
  92.   S := PtrInt(Sender).ToString + 'Click';
  93.   GetLink(S, Shape1, Shape2);
  94.   if (Shape1 = nil) or (Shape2 = nil) then Exit;
  95.   Temp               := Shape1.Brush.Color;
  96.   Shape1.Brush.Color := Shape2.Brush.Color;
  97.   Shape2.Brush.Color := Temp;
  98. end;
  99.  
  100. procedure TTmpShape.SwapShape(Sender: TObject);
  101. var
  102.   Shape1, Shape2: TShape;
  103.   Temp:           TShapeType;
  104.   S:              string;
  105. begin
  106.   if not(Sender is TButton) then Exit;
  107.   S := PtrInt(Sender).ToString + 'Click';
  108.   GetLink(S, Shape1, Shape2);
  109.   if (Shape1 = nil) or (Shape2 = nil) then Exit;
  110.   Temp         := Shape1.Shape;
  111.   Shape1.Shape := Shape2.Shape;
  112.   Shape2.Shape := Temp;
  113. end;
  114.  
  115. initialization
  116.   SetLength(Links, 0);
  117.  
  118. finalization
  119.   SetLength(Links, 0);
  120.  
  121. end.
  • This demo only show 2 functions: SwapColor and SwapShape, line #10 & #11.
  • TLink is used to keep track which items to control, line #21.
  • This simplified demo only shows setting the OnClick events, you can expand it to handle other events by changing how the ID generated, see line #69, #78.

 

TinyPortal © 2005-2018