unit lr_design_ins_filed; {$mode objfpc}{$H+} interface uses Classes, SysUtils, DB, Forms, Controls, ExtCtrls, StdCtrls, Buttons, ComCtrls, IniFiles, LazFileUtils; type { TlrFieldsList } TlrFieldsList = class(TFrame) cbDSList:TComboBox; lbFieldsList: TListBox; fPanelHeader: TPanel; PageControl1: TPageControl; SpeedButton1: TSpeedButton; SpeedButton2: TSpeedButton; TabSheet1: TTabSheet; TabSheet2: TTabSheet; ValCombo: TComboBox; ValList: TListBox; procedure cbDSListChange(Sender: TObject); procedure fPanelHeaderMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure fPanelHeaderMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer ); procedure fPanelHeaderMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure SpeedButton1Click(Sender: TObject); procedure SpeedButton2Click(Sender: TObject); procedure ValComboChange(Sender: TObject); private fDown : Boolean; fPt : TPoint; FLastHeight:integer; procedure RestorePos; procedure SavePos; function IniFileName:string; procedure FillValCombo; procedure GetVariables; procedure GetSpecValues; procedure GetFRVariables; function CurValSet: String; function CurVal: String; public constructor Create(aOwner : TComponent); override; destructor Destroy; override; procedure RefreshDSList; function SelectedField:string; end; var lrFieldsList:TlrFieldsList = nil; implementation uses LR_Utils, LR_Class, LR_DBRel, LR_Desgn, LR_Const; {$R *.lfm} { TlrFieldsList } procedure TlrFieldsList.fPanelHeaderMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Button=mbLeft then begin fDown:=True; if (x>4) and (x0 then begin // DataSet := nil; // DataSet := frGetDataSet(cbDSList.Items[cbDSList.ItemIndex]); DataSet := frGetDataSet(cbDSList.Text); if Assigned(DataSet) then begin try frGetFieldNames(TfrTDataSet(DataSet), lbFieldsList.Items); except end; end; end; end; procedure TlrFieldsList.fPanelHeaderMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var NewPt: TPoint; begin if fDown then begin Case fPanelHeader.Cursor of crSize : begin NewPt:=Mouse.CursorPos; //DebugLn(['TfrObjectInspector.HeaderMDown ',dbgs(fPt),' New=',dbgs(NewPt)]); SetBounds(Left+NewPt.X-fPt.X,Top+NewPt.Y-fPt.Y,Width,Height); fPt:=NewPt; end; end; end end; procedure TlrFieldsList.fPanelHeaderMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin fDown:=False; fPanelHeader.Cursor:=crDefault; end; procedure TlrFieldsList.SpeedButton1Click(Sender: TObject); begin if SpeedButton1.Caption='-' then begin FLastHeight:=Height; Height:=fPanelHeader.Height + 2*BorderWidth + 3; SpeedButton1.Caption:='+'; end else begin Height:=FLastHeight; SpeedButton1.Caption:='-'; end; end; procedure TlrFieldsList.SpeedButton2Click(Sender: TObject); begin TfrDesignerForm(frDesigner).tlsDBFields.Checked:=false; Application.ReleaseComponent(Self); end; procedure TlrFieldsList.ValComboChange(Sender: TObject); begin if CurValSet = sFRVariables then GetFRVariables else if CurValSet = sSpecVal then GetSpecValues else GetVariables; end; procedure TlrFieldsList.RestorePos; var Ini:TIniFile; begin if FileExistsUTF8(IniFileName) then begin Ini:=TIniFile.Create(IniFileName); Left:=Ini.ReadInteger('Position', 'Left', Left); Top:=Ini.ReadInteger('Position', 'Top', Top); Height:=Ini.ReadInteger('Position', 'Height', Height); Width:=Ini.ReadInteger('Position', 'Width', Width); Ini.Free; end else begin Width :=300; Height :=400; Top :=120; Left :=40; end; end; procedure TlrFieldsList.SavePos; var Ini:TIniFile; begin Ini:=TIniFile.Create(IniFileName); Ini.WriteInteger('Position', 'Left', Left); Ini.WriteInteger('Position', 'Top', Top); if SpeedButton1.Caption = '+' then Ini.WriteInteger('Position', 'Height', FLastHeight) else Ini.WriteInteger('Position', 'Height', Height); Ini.WriteInteger('Position', 'Width', Width); Ini.Free; end; function TlrFieldsList.IniFileName: string; begin Result:=AppendPathDelim(lrConfigFolderName(false))+'lrFieldsList.cfg'; end; procedure TlrFieldsList.FillValCombo; var s: TStringList; begin s := TStringList.Create; CurReport.GetCategoryList(s); s.Add(sSpecVal); s.Add(sFRVariables); ValCombo.Items.Assign(s); s.Free; end; procedure TlrFieldsList.GetVariables; begin CurReport.GetVarList(ValCombo.ItemIndex, ValList.Items); end; procedure TlrFieldsList.GetSpecValues; var i: Integer; begin with ValList.Items do begin Clear; for i := 0 to frSpecCount-1 do if i <> 1 then Add(frSpecArr[i]); end; end; procedure TlrFieldsList.GetFRVariables; var i: Integer; begin with ValList.Items do begin Clear; for i := 0 to frVariables.Count - 1 do Add(frVariables.Name[i]); end; end; function TlrFieldsList.CurValSet: String; begin Result := ''; if ValCombo.ItemIndex <> -1 then Result := ValCombo.Items[ValCombo.ItemIndex]; end; function TlrFieldsList.CurVal: String; begin Result := ''; if CurValSet <> sSpecVal then begin if ValList.ItemIndex <> -1 then Result := ValList.Items[ValList.ItemIndex]; end else if ValList.ItemIndex > 0 then Result := frSpecFuncs[ValList.ItemIndex + 1] else Result := frSpecFuncs[0]; end; constructor TlrFieldsList.Create(aOwner: TComponent); begin inherited Create(aOwner); RestorePos; Parent :=TWinControl(aOwner); RefreshDSList; FillValCombo; fPanelHeader.Caption:=sFRDesignerDataInsp; // TabSheet1.Caption := sDataInspFields; TabSheet2.Caption := sDataInspVariables; end; destructor TlrFieldsList.Destroy; begin SavePos; lrFieldsList:=nil; inherited Destroy; end; procedure TlrFieldsList.RefreshDSList; var Lst : TStringList; begin cbDSList.OnChange:=nil; Lst := TStringList.Create; try if CurReport.DataType = dtDataSet then frGetComponents(CurReport.Owner, TDataSet, Lst, nil) else frGetComponents(CurReport.Owner, TDataSource, Lst, nil); Lst.Sort; cbDSList.Items.Assign(Lst); cbDSList.Enabled:=(Lst.Count>0); finally Lst.Free; end; cbDSList.OnChange:=@cbDSListChange; end; function TlrFieldsList.SelectedField: string; begin Result:=''; if PageControl1.ActivePageIndex = 0 then begin; if (lbFieldsList.ItemIndex>-1) and (lbFieldsList.ItemIndex