Forum > Beginners
Setting events stored in other unit to controls
Handoko:
--- Quote from: egsuh on May 11, 2021, 04:05:59 am ---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.
--- End quote ---
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 [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit Unit1; {$mode objfpc}{$H+} interface uses Classes, Forms, Graphics, StdCtrls, ExtCtrls, ActionsLib; type { TForm1 } TForm1 = class(TForm) btnStart: TButton; procedure btnStartClick(Sender: TObject); procedure FormDestroy(Sender: TObject); private FShapes: array of TShape; end; var Form1: TForm1; implementation {$R *.lfm} { TForm1 } procedure TForm1.btnStartClick(Sender: TObject);var aShape: TShape; aButton: TButton;begin btnStart.Free; // Create the shapes SetLength(FShapes, 2); aShape := TShape.Create(Self); aShape.Parent := Self; aShape.Left := 40; aShape.Top := 40; aShape.Brush.Color := clMoneyGreen; aShape.Shape := stCircle; FShapes[0] := aShape; aShape := TShape.Create(Self); aShape.Parent := Self; aShape.Left := 130; aShape.Top := 40; aShape.Brush.Color := clYellow; aShape.Shape := stTriangle; FShapes[1] := aShape; aShape := TShape.Create(Self); aShape.Parent := Self; aShape.Left := 220; aShape.Top := 40; aShape.Brush.Color := clSkyBlue; aShape.Shape := stDiamond; FShapes[2] := aShape; // Create the labels with TLabel.Create(Self) do begin Parent := Self; Left := 70; Top := 20; Caption := 'A'; end; with TLabel.Create(Self) do begin Parent := Self; Left := 160; Top := 20; Caption := 'B'; end; with TLabel.Create(Self) do begin Parent := Self; Left := 250; Top := 20; Caption := 'C'; end; // Create buttons aButton := TButton.Create(Self); aButton.Parent := Form1; aButton.Left := 40; aButton.Top := 130; aButton.Width := 240; aButton.Caption := 'AB swap color'; ButtonClickSwapColor(aButton, FShapes[0], FShapes[1]); aButton := TButton.Create(Self); aButton.Parent := Form1; aButton.Left := 40; aButton.Top := 160; aButton.Width := 240; aButton.Caption := 'BC swap color'; ButtonClickSwapColor(aButton, FShapes[1], FShapes[2]); aButton := TButton.Create(Self); aButton.Parent := Form1; aButton.Left := 40; aButton.Top := 190; aButton.Width := 240; aButton.Caption := 'AB swap shape'; ButtonClickSwapShape(aButton, FShapes[0], FShapes[1]); end; procedure TForm1.FormDestroy(Sender: TObject);var i: Integer;begin for i := 0 to Length(FShapes)-1 do FShapes[i].Free; SetLength(FShapes, 0);end; 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 [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit ActionsLib; {$mode objfpc}{$H+} interface uses Classes, SysUtils, Forms, Graphics, StdCtrls, ExtCtrls; procedure ButtonClickSwapColor(Button: TButton; Shape1, Shape2: TShape);procedure ButtonClickSwapShape(Button: TButton; Shape1, Shape2: TShape); implementation const ID_Length = 30; // not sure but 30 should be more than enough type IDstring = string[ID_Length]; TLink = record ID: IDstring; Item1: TShape; Item2: TShape; end; { TTmpShape } TTmpShape = class(TShape) public procedure SwapColor(Sender: TObject); procedure SwapShape(Sender: TObject); end; var TmpShape: TTmpShape; Links: array of TLink; procedure SaveLink(const ID: IDstring; Shape1, Shape2: TShape);var i: Integer;begin i := Length(Links); SetLength(Links, i+1); Links[i].ID := ID; Links[i].Item1 := Shape1; Links[i].Item2 := Shape2;end; procedure GetLink(const ID: IDstring; out Shape1, Shape2: TShape);var i: Integer;begin Shape1 := nil; Shape2 := nil; for i := 0 to Length(Links)-1 do if Links[i].ID = ID then begin Shape1 := Links[i].Item1; Shape2 := Links[i].Item2; Exit; end;end; procedure ButtonClickSwapColor(Button: TButton; Shape1, Shape2: TShape);var S: string;begin S := PtrInt(Button).ToString + 'Click'; SaveLink(S, Shape1, Shape2); Button.OnClick := @TmpShape.SwapColor;end; procedure ButtonClickSwapShape(Button: TButton; Shape1, Shape2: TShape);var S: string;begin S := PtrInt(Button).ToString + 'Click'; SaveLink(S, Shape1, Shape2); Button.OnClick := @TmpShape.SwapShape;end; { TTmpShape } procedure TTmpShape.SwapColor(Sender: TObject);var Shape1, Shape2: TShape; Temp: TColor; S: string;begin if not(Sender is TButton) then Exit; S := PtrInt(Sender).ToString + 'Click'; GetLink(S, Shape1, Shape2); if (Shape1 = nil) or (Shape2 = nil) then Exit; Temp := Shape1.Brush.Color; Shape1.Brush.Color := Shape2.Brush.Color; Shape2.Brush.Color := Temp;end; procedure TTmpShape.SwapShape(Sender: TObject);var Shape1, Shape2: TShape; Temp: TShapeType; S: string;begin if not(Sender is TButton) then Exit; S := PtrInt(Sender).ToString + 'Click'; GetLink(S, Shape1, Shape2); if (Shape1 = nil) or (Shape2 = nil) then Exit; Temp := Shape1.Shape; Shape1.Shape := Shape2.Shape; Shape2.Shape := Temp;end; initialization SetLength(Links, 0); finalization SetLength(Links, 0); 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.
Navigation
[0] Message Index
[*] Previous page