1 unit lr_design_ins_filed;
2
3 {$mode objfpc}{$H+}
4
5 interface
6
7 uses
8 Classes, SysUtils, DB, Forms, Controls, ExtCtrls, StdCtrls, Buttons, ComCtrls,
9 IniFiles, LazFileUtils;
10
11 type
12
13 { TlrFieldsList }
14
15 TlrFieldsList = class(TFrame)
16 cbDSList:TComboBox;
17 lbFieldsList: TListBox;
18 fPanelHeader: TPanel;
19 PageControl1: TPageControl;
20 SpeedButton1: TSpeedButton;
21 SpeedButton2: TSpeedButton;
22 TabSheet1: TTabSheet;
23 TabSheet2: TTabSheet;
24 ValCombo: TComboBox;
25 ValList: TListBox;
26 procedure cbDSListChange(Sender: TObject);
27 procedure fPanelHeaderMouseDown(Sender: TObject; Button: TMouseButton;
28 Shift: TShiftState; X, Y: Integer);
29 procedure fPanelHeaderMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer
30 );
31 procedure fPanelHeaderMouseUp(Sender: TObject; Button: TMouseButton;
32 Shift: TShiftState; X, Y: Integer);
33 procedure SpeedButton1Click(Sender: TObject);
34 procedure SpeedButton2Click(Sender: TObject);
35 procedure ValComboChange(Sender: TObject);
36 private
37 fDown : Boolean;
38 fPt : TPoint;
39 FLastHeight:integer;
40 procedure RestorePos;
41 procedure SavePos;
IniFileNamenull42 function IniFileName:string;
43 procedure FillValCombo;
44 procedure GetVariables;
45 procedure GetSpecValues;
46 procedure GetFRVariables;
CurValSetnull47 function CurValSet: String;
CurValnull48 function CurVal: String;
49 public
50 constructor Create(aOwner : TComponent); override;
51 destructor Destroy; override;
52 procedure RefreshDSList;
SelectedFieldnull53 function SelectedField:string;
54 end;
55
56 var
57 lrFieldsList:TlrFieldsList = nil;
58
59 implementation
60 uses LR_Utils, LR_Class, LR_DBRel, LR_Desgn, LR_Const;
61
62 {$R *.lfm}
63
64 { TlrFieldsList }
65
66 procedure TlrFieldsList.fPanelHeaderMouseDown(Sender: TObject; Button: TMouseButton;
67 Shift: TShiftState; X, Y: Integer);
68 begin
69 if Button=mbLeft then
70 begin
71 fDown:=True;
72 if (x>4) and (x<fPanelHeader.Width-4) and (y<=16) then
73 begin
74 fPanelHeader.Cursor:=crSize;
75 fPt:=Mouse.CursorPos;
76 end;
77 end;
78 end;
79
80 procedure TlrFieldsList.cbDSListChange(Sender: TObject);
81 var
82 DataSet: TDataSet;
83 begin
84 lbFieldsList.Items.Clear;
85 if cbDSList.Items.Count>0 then
86 begin
87 // DataSet := nil;
88 // DataSet := frGetDataSet(cbDSList.Items[cbDSList.ItemIndex]);
89 DataSet := frGetDataSet(cbDSList.Text);
90 if Assigned(DataSet) then
91 begin
92 try
93 frGetFieldNames(TfrTDataSet(DataSet), lbFieldsList.Items);
94 except
95 end;
96 end;
97 end;
98 end;
99
100 procedure TlrFieldsList.fPanelHeaderMouseMove(Sender: TObject; Shift: TShiftState; X,
101 Y: Integer);
102 var
103 NewPt: TPoint;
104 begin
105 if fDown then
106 begin
107 Case fPanelHeader.Cursor of
108 crSize :
109 begin
110 NewPt:=Mouse.CursorPos;
111 //DebugLn(['TfrObjectInspector.HeaderMDown ',dbgs(fPt),' New=',dbgs(NewPt)]);
112 SetBounds(Left+NewPt.X-fPt.X,Top+NewPt.Y-fPt.Y,Width,Height);
113 fPt:=NewPt;
114 end;
115 end;
116 end
117 end;
118
119 procedure TlrFieldsList.fPanelHeaderMouseUp(Sender: TObject; Button: TMouseButton;
120 Shift: TShiftState; X, Y: Integer);
121 begin
122 fDown:=False;
123 fPanelHeader.Cursor:=crDefault;
124 end;
125
126 procedure TlrFieldsList.SpeedButton1Click(Sender: TObject);
127 begin
128 if SpeedButton1.Caption='-' then
129 begin
130 FLastHeight:=Height;
131 Height:=fPanelHeader.Height + 2*BorderWidth + 3;
132 SpeedButton1.Caption:='+';
133 end
134 else
135 begin
136 Height:=FLastHeight;
137 SpeedButton1.Caption:='-';
138 end;
139 end;
140
141 procedure TlrFieldsList.SpeedButton2Click(Sender: TObject);
142 begin
143 TfrDesignerForm(frDesigner).tlsDBFields.Checked:=false;
144 Application.ReleaseComponent(Self);
145 end;
146
147 procedure TlrFieldsList.ValComboChange(Sender: TObject);
148 begin
149 if CurValSet = sFRVariables then
150 GetFRVariables
151 else
152 if CurValSet = sSpecVal then
153 GetSpecValues
154 else
155 GetVariables;
156 end;
157
158 procedure TlrFieldsList.RestorePos;
159 var
160 Ini:TIniFile;
161 begin
162 if FileExistsUTF8(IniFileName) then
163 begin
164 Ini:=TIniFile.Create(IniFileName);
165 Left:=Ini.ReadInteger('Position', 'Left', Left);
166 Top:=Ini.ReadInteger('Position', 'Top', Top);
167 Height:=Ini.ReadInteger('Position', 'Height', Height);
168 Width:=Ini.ReadInteger('Position', 'Width', Width);
169 Ini.Free;
170 end
171 else
172 begin
173 Width :=300;
174 Height :=400;
175 Top :=120;
176 Left :=40;
177 end;
178 end;
179
180 procedure TlrFieldsList.SavePos;
181 var
182 Ini:TIniFile;
183 begin
184 Ini:=TIniFile.Create(IniFileName);
185 Ini.WriteInteger('Position', 'Left', Left);
186 Ini.WriteInteger('Position', 'Top', Top);
187 if SpeedButton1.Caption = '+' then
188 Ini.WriteInteger('Position', 'Height', FLastHeight)
189 else
190 Ini.WriteInteger('Position', 'Height', Height);
191 Ini.WriteInteger('Position', 'Width', Width);
192 Ini.Free;
193 end;
194
TlrFieldsList.IniFileNamenull195 function TlrFieldsList.IniFileName: string;
196 begin
197 Result:=AppendPathDelim(lrConfigFolderName(false))+'lrFieldsList.cfg';
198 end;
199
200 procedure TlrFieldsList.FillValCombo;
201 var
202 s: TStringList;
203 begin
204 s := TStringList.Create;
205 CurReport.GetCategoryList(s);
206 s.Add(sSpecVal);
207 s.Add(sFRVariables);
208 ValCombo.Items.Assign(s);
209 s.Free;
210 end;
211
212 procedure TlrFieldsList.GetVariables;
213 begin
214 CurReport.GetVarList(ValCombo.ItemIndex, ValList.Items);
215 end;
216
217 procedure TlrFieldsList.GetSpecValues;
218 var
219 i: Integer;
220 begin
221 with ValList.Items do
222 begin
223 Clear;
224 for i := 0 to frSpecCount-1 do
225 if i <> 1 then
226 Add(frSpecArr[i]);
227 end;
228 end;
229
230 procedure TlrFieldsList.GetFRVariables;
231 var
232 i: Integer;
233 begin
234 with ValList.Items do
235 begin
236 Clear;
237 for i := 0 to frVariables.Count - 1 do
238 Add(frVariables.Name[i]);
239 end;
240 end;
241
CurValSetnull242 function TlrFieldsList.CurValSet: String;
243 begin
244 Result := '';
245 if ValCombo.ItemIndex <> -1 then
246 Result := ValCombo.Items[ValCombo.ItemIndex];
247 end;
248
TlrFieldsList.CurValnull249 function TlrFieldsList.CurVal: String;
250 begin
251 Result := '';
252 if CurValSet <> sSpecVal then
253 begin
254 if ValList.ItemIndex <> -1 then
255 Result := ValList.Items[ValList.ItemIndex];
256 end
257 else
258 if ValList.ItemIndex > 0 then
259 Result := frSpecFuncs[ValList.ItemIndex + 1]
260 else
261 Result := frSpecFuncs[0];
262 end;
263
264 constructor TlrFieldsList.Create(aOwner: TComponent);
265 begin
266 inherited Create(aOwner);
267 RestorePos;
268 Parent :=TWinControl(aOwner);
269 RefreshDSList;
270 FillValCombo;
271 fPanelHeader.Caption:=sFRDesignerDataInsp;
272 //
273 TabSheet1.Caption := sDataInspFields;
274 TabSheet2.Caption := sDataInspVariables;
275 end;
276
277 destructor TlrFieldsList.Destroy;
278 begin
279 SavePos;
280 lrFieldsList:=nil;
281 inherited Destroy;
282 end;
283
284 procedure TlrFieldsList.RefreshDSList;
285 var
286 Lst : TStringList;
287 begin
288 cbDSList.OnChange:=nil;
289 Lst := TStringList.Create;
290 try
291 if CurReport.DataType = dtDataSet then
292 frGetComponents(CurReport.Owner, TDataSet, Lst, nil)
293 else
294 frGetComponents(CurReport.Owner, TDataSource, Lst, nil);
295 Lst.Sort;
296 cbDSList.Items.Assign(Lst);
297 cbDSList.Enabled:=(Lst.Count>0);
298 finally
299 Lst.Free;
300 end;
301 cbDSList.OnChange:=@cbDSListChange;
302 end;
303
SelectedFieldnull304 function TlrFieldsList.SelectedField: string;
305 begin
306 Result:='';
307 if PageControl1.ActivePageIndex = 0 then
308 begin;
309 if (lbFieldsList.ItemIndex>-1) and (lbFieldsList.ItemIndex<lbFieldsList.Items.Count) then
310 Result:=cbDSList.Text + '."' + lbFieldsList.Items[lbFieldsList.ItemIndex] + '"'
311 end
312 else
313 Result:=CurVal;
314 end;
315
316 end.
317