1 {
2 *****************************************************************************
3 * *
4 * This file is part of the ZCAD *
5 * *
6 * See the file COPYING.modifiedLGPL.txt, included in this distribution, *
7 * for details about the copyright. *
8 * *
9 * This program is distributed in the hope that it will be useful, *
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of *
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
12 * *
13 *****************************************************************************
14 }
15 {
16 @author(Andrey Zubarev <zamtmn@yandex.ru>)
17 }
18 unit uzcctrlpartenabler;
19
20 {$mode objfpc}{$H+}
21
22 interface
23
24 uses
25 StdCtrls,GraphType,LCLIntf,LCLType,
26 Controls,Classes,Graphics,Buttons,ExtCtrls,ComCtrls,Forms,Themes,ActnList,Menus,
27 sysutils;
28
29 type
30 generic TPartEnabler<T>=class(TToolBar)
31 type
32 PT=^T;
onstnull33 TGetCountFunc=function(const value:T):integer of object;
onstnull34 TGetStateFunc=function(const value:T;const nmax,n:integer; out _name:string;out _enabled:boolean):boolean of object;
35 TSetStateProc=procedure(var value:T;const n:integer;state:boolean) of object;
arnull36 TPartsEditFunc=function(var value:T):boolean of object;
37 private
38 var
39 fpvalue:PT;
40 actns:array of taction;
41 fGetCountFunc:TGetCountFunc;
42 fGetStateFunc:TGetStateFunc;
43 fSetStateProc:TSetStateProc;
44 fOnPartChanged:TNotifyEvent;
45 fPartsEditFunc:TPartsEditFunc;
46
47 public
48 constructor Create(TheOwner: TComponent); override;
49 procedure setup(var value:T);
DoGetCountFuncnull50 function DoGetCountFunc(const value:T):integer;
DoGetStateFuncnull51 function DoGetStateFunc(const value:T;const nmax,n:integer; out _name:string;out _enabled:boolean):boolean;
52 procedure DoSetStateProc(var value:T;const n:integer;state:boolean);
53 procedure DoButtonClick(Sender: TObject);
54 procedure DoPartsEditor(Sender: TObject);
ButtonIndex2PartIndexnull55 function ButtonIndex2PartIndex(index:integer):integer;
56
57 property pvalue:PT read fpvalue write fpvalue;
58 property PartsEditFunc:TPartsEditFunc read fPartsEditFunc write fPartsEditFunc;
59 property GetCountFunc:TGetCountFunc read fGetCountFunc write fGetCountFunc;
60 property GetStateFunc:TGetStateFunc read fGetStateFunc write fGetStateFunc;
61 property SetStateProc:TSetStateProc read fSetStateProc write fSetStateProc;
62 property OnPartChanged:TNotifyEvent read fOnPartChanged write fOnPartChanged;
63 end;
64
65 implementation
TPartEnablernull66 generic function TPartEnabler<T>.DoGetCountFunc(const value:T):integer;
67 begin
68 if assigned(fGetCountFunc)then
69 result:=fGetCountFunc(value)
70 else
71 result:=10;
72 end;
TPartEnablernull73 generic function TPartEnabler<T>.DoGetStateFunc(const value:T;const nmax,n:integer; out _name:string;out _enabled:boolean):boolean;
74 begin
75 if assigned(fGetStateFunc)then
76 result:=fGetStateFunc(value,nmax,n,_name,_enabled)
77 else begin
78 result:=true;
79 _enabled:=true;
80 _name:='n'+inttostr(n);
81 end;
82 end;
83 generic procedure TPartEnabler<T>.DoSetStateProc(var value:T;const n:integer;state:boolean);
84 begin
85 if assigned(fSetStateProc)then
86 fSetStateProc(value,n,state);
87 end;
88 constructor TPartEnabler.Create(TheOwner: TComponent);
89 begin
90 inherited Create(TheOwner);
91 ShowCaptions:=true;
92 Wrapable:=false;
93 Transparent:=true;
94 EdgeBorders:=[];
95 fPartsEditFunc:=nil;
96 end;
97
98 generic procedure TPartEnabler<T>.setup(var value:T);
99 var
100 nmax,i:integer;
101 _name:string;
102 _state:boolean;
103 _enabled:boolean;
104 _menu:TPopupMenu;
105 CreatedMenuItem:TMenuItem;
106 begin
107 fpvalue:=@value;
108 for i:=ButtonCount-1 downto 0 do
109 Buttons[i].free;
110 if assigned(fPartsEditFunc)then
111 with TToolButton.create(self) do
112 begin
113 Caption:='Ed';
114 ShowCaption:=false;
115 if length(actns)>0 then begin
116 _menu:=TPopupMenu.Create(self);
117 style:=tbsDropDown;
118 for i:=0 to length(actns)-1 do begin
119 CreatedMenuItem:=TMenuItem.Create(_menu);
120 CreatedMenuItem.Action:=actns[i];
121 _menu.items.Add(CreatedMenuItem);
122 end;
123 end;
124 PopupMenu:=_menu;
125 DropDownMenu:=_menu;
126 Visible:=true;
127 left:=0;
128 parent:=self;
129 onClick:=@DoButtonClick;
130 end;
131 nmax:=DoGetCountFunc(value);
132 for i:=1 to nmax do begin
133 _state:=DoGetStateFunc(value,nmax,i,_name,_enabled);
134 with TToolButton.create(self) do
135 begin
136 Caption:=_name;
137 ShowCaption:=false;
138 ShowHint:=true;
139 Down:=_state;
140 Enabled:=_enabled;
141 style:=tbsCheck;
142 Visible:=true;
143 left:=300*i;
144 parent:=self;
145 onClick:=@DoButtonClick;
146 end;
147 end;
148 end;
149
ButtonIndex2PartIndexnull150 function TPartEnabler.ButtonIndex2PartIndex(index:integer):integer;
151 begin
152 if assigned(fPartsEditFunc)then
153 result:=index
154 else
155 result:=index+1;
156 end;
157
158 procedure TPartEnabler.DoPartsEditor(Sender: TObject);
159 var
160 pts:T;
161 begin
162 if assigned(PartsEditFunc)then begin
163 pts:=fpvalue^;
164 if PartsEditFunc(pts) then begin
165 fpvalue^:=pts;
166 setup(fpvalue^);
167 end;
168 end;
169 end;
170
171 procedure TPartEnabler.DoButtonClick(Sender: TObject);
172 var
173 i:integer;
174 st:boolean;
175 pts:T;
176 begin
177 if sender is TToolButton then begin
178 i:=ButtonIndex2PartIndex((sender as TToolButton).Index);
179 if i=0 then begin
180 DoPartsEditor(Sender);
181 end else begin
182 st:=(sender as TToolButton).Down;
183 DoSetStateProc(fpvalue^,i,st);
184 end;
185 end;
186 if assigned(fOnPartChanged)then
187 fOnPartChanged(self);
188 end;
189
190 end.
191