503 lines
14 KiB
ObjectPascal
503 lines
14 KiB
ObjectPascal
|
|
{******************************************}
|
|
{ }
|
|
{ FastReport VCL }
|
|
{ Report datasets selector }
|
|
{ }
|
|
{ Copyright (c) 1998-2021 }
|
|
{ by Fast Reports Inc. }
|
|
{ }
|
|
{******************************************}
|
|
|
|
unit frxEditReportData;
|
|
|
|
interface
|
|
|
|
{$I frx.inc}
|
|
|
|
uses
|
|
{$IFNDEF FPC}
|
|
Windows, Messages,
|
|
{$ENDIF}
|
|
SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
|
StdCtrls, frxClass, CheckLst, frxBaseForm, frxComCtrls, Menus, ExtCtrls
|
|
{$IFDEF FPC}
|
|
, LCLType
|
|
{$ENDIF}
|
|
{$IFDEF Delphi6}
|
|
, Variants
|
|
{$ENDIF}
|
|
{$IFDEF Delphi16}
|
|
, System.Types
|
|
{$ENDIF}
|
|
;
|
|
|
|
|
|
|
|
type
|
|
TfrxDataSetsActions = ( dsaSortSelectedData = 59, dsaSortData = 60,
|
|
dsaUnsorted = 127, dsaAscending = 125, dsaDescending = 126,
|
|
dsaUnselected = 113, dsaAll = 128, dsaSelected = 129);
|
|
|
|
TfrxDataSetsSortType = (dssUnsorted, dssAscending, dssDescending);
|
|
TfrxDataSetsSortSelectedType = (dsssAll, dsssSelected, dsssUnselected);
|
|
|
|
TfrxReportDataForm = class(TfrxBaseForm)
|
|
OKB: TButton;
|
|
CancelB: TButton;
|
|
DatasetsLB: TCheckListBox;
|
|
SelAllCB: TCheckBox;
|
|
DSPanel: TPanel;
|
|
FooterPanel: TPanel;
|
|
procedure FormShow(Sender: TObject);
|
|
procedure FormHide(Sender: TObject);
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure DatasetsLBClickCheck(Sender: TObject);
|
|
procedure FormKeyDown(Sender: TObject; var Key: Word;
|
|
Shift: TShiftState);
|
|
procedure SelAllCBClick(Sender: TObject);
|
|
private
|
|
FStandalone: Boolean;
|
|
FToolWithFilterPanel: TfrxToolWithFilterPanel;
|
|
FSortButton: TfrxToolPanelButton;
|
|
FSortSelectedButton: TfrxToolPanelButton;
|
|
FDataSetsSortType: TfrxDataSetsSortType;
|
|
FDataSetsSortSelectedType: TfrxDataSetsSortSelectedType;
|
|
FSortPopUp: TPopupMenu;
|
|
FSortSelectedPopUp: TPopupMenu;
|
|
FFilter: String;
|
|
procedure BuildConnectionList;
|
|
procedure BuildDatasetList;
|
|
procedure UpdateCBState;
|
|
procedure UpdateSelectedDS;
|
|
procedure ToolOnClick(Sender: TObject);
|
|
procedure CreatefrxToolWithFilterPanel(var ToolWithFilterPanel: TfrxToolWithFilterPanel);
|
|
procedure CreateSortPopup;
|
|
procedure CreateSortSelectedPopup;
|
|
procedure EditChange(Sender: TObject);
|
|
public
|
|
Report: TfrxReport;
|
|
procedure UpdateResouces; override;
|
|
end;
|
|
|
|
implementation
|
|
|
|
{$IFDEF FPC}
|
|
{$R *.lfm}
|
|
{$ELSE}
|
|
{$R *.DFM}
|
|
{$ENDIF}
|
|
|
|
uses frxDesgn, frxRes
|
|
{$IFNDEF FPC} , frxUtils ,IniFiles , Registry{$ENDIF};
|
|
|
|
var
|
|
PrevWidth: Integer = 0;
|
|
PrevHeight: Integer = 0;
|
|
|
|
procedure TfrxReportDataForm.FormCreate(Sender: TObject);
|
|
begin
|
|
FStandalone := (frxDesignerComp <> nil) and frxDesignerComp.Standalone;
|
|
if UseRightToLeftAlignment then
|
|
FlipChildren(True);
|
|
FFilter := '';
|
|
CreatefrxToolWithFilterPanel(FToolWithFilterPanel);
|
|
FSortButton := FToolWithFilterPanel.ToolPanel.AddButton(ord(dsaUnsorted), frxGet(4117), ord(dsaSortData), fbsDropDownButton);
|
|
FSortSelectedButton := FToolWithFilterPanel.ToolPanel.AddButton(ord(dsaAll), frxGet(3104), ord(dsaSortSelectedData), fbsDropDownButton);
|
|
FToolWithFilterPanel.ToolPanel.AddCustomButton(fbkSeparator);
|
|
{$IFNDEF FPC}
|
|
FToolWithFilterPanel.BevelKind := bkNone;
|
|
{$ENDIF}
|
|
CreateSortPopup;
|
|
CreateSortSelectedPopup;
|
|
end;
|
|
|
|
procedure TfrxReportDataForm.UpdateSelectedDS;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if FStandalone then
|
|
Report.ReportOptions.ConnectionName := ''
|
|
else
|
|
if (FDataSetsSortSelectedType = dsssAll) then
|
|
Report.Datasets.Clear;
|
|
|
|
for i := 0 to DatasetsLB.Items.Count - 1 do
|
|
if DatasetsLB.Checked[i] then
|
|
begin
|
|
if FStandalone then
|
|
Report.ReportOptions.ConnectionName := DatasetsLB.Items[i]
|
|
else
|
|
if Report.DataSets.Find(TfrxDataSet(DatasetsLB.Items.Objects[i])) = nil then
|
|
Report.DataSets.Add(TfrxDataSet(DatasetsLB.Items.Objects[i]))
|
|
end
|
|
else
|
|
Report.DataSets.Delete(DatasetsLB.Items[i]);
|
|
end;
|
|
|
|
procedure TfrxReportDataForm.FormShow(Sender: TObject);
|
|
begin
|
|
if PrevWidth <> 0 then
|
|
begin
|
|
Width := PrevWidth;
|
|
Height := PrevHeight;
|
|
end;
|
|
|
|
if FStandalone then
|
|
BuildConnectionList
|
|
else
|
|
BuildDatasetList;
|
|
UpdateCBState;
|
|
end;
|
|
|
|
procedure TfrxReportDataForm.UpdateResouces;
|
|
begin
|
|
inherited;
|
|
if FStandalone then
|
|
Caption := frxGet(5800)
|
|
else
|
|
Caption := frxGet(2800);
|
|
OKB.Caption := frxGet(1);
|
|
CancelB.Caption := frxGet(2);
|
|
SelAllCB.Caption := frxGet(2414);
|
|
end;
|
|
|
|
procedure TfrxReportDataForm.FormHide(Sender: TObject);
|
|
begin
|
|
PrevWidth := Width;
|
|
PrevHeight := Height;
|
|
if ModalResult <> mrOk then Exit;
|
|
|
|
UpdateSelectedDS;
|
|
end;
|
|
|
|
procedure TfrxReportDataForm.BuildConnectionList;
|
|
{$IFNDEF FPC}
|
|
var
|
|
i: Integer;
|
|
ini: TRegistry;
|
|
sl: TStringList;
|
|
s2: TStringList;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFNDEF FPC}
|
|
ini := TRegistry.Create;
|
|
try
|
|
sl := TStringList.Create;
|
|
s2 := TStringList.Create;
|
|
try
|
|
ini.RootKey := HKEY_LOCAL_MACHINE;
|
|
if ini.OpenKeyReadOnly(DEF_REG_CONNECTIONS) then
|
|
begin
|
|
ini.GetValueNames(sl);
|
|
ini.CloseKey;
|
|
end;
|
|
|
|
ini.RootKey := HKEY_CURRENT_USER;
|
|
if ini.OpenKeyReadOnly(DEF_REG_CONNECTIONS) then
|
|
begin
|
|
ini.GetValueNames(s2);
|
|
ini.CloseKey;
|
|
end;
|
|
|
|
sl.AddStrings(s2);
|
|
|
|
for i := 0 to sl.Count - 1 do
|
|
begin
|
|
DataSetsLB.Items.Add(sl[i]);
|
|
DataSetsLB.Checked[i] := CompareText(sl[i], Report.ReportOptions.ConnectionName) = 0;
|
|
end;
|
|
finally
|
|
sl.Free;
|
|
s2.Free;
|
|
end;
|
|
finally
|
|
ini.Free;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TfrxReportDataForm.BuildDatasetList;
|
|
var
|
|
i, nInc, nDSCount: Integer;
|
|
ds: TfrxDataSet;
|
|
dsList: TStringList;
|
|
lFilter: String;
|
|
begin
|
|
lFilter := AnsiUpperCase(FFilter);
|
|
case FDataSetsSortType of
|
|
dssUnsorted: FSortButton.ImageIndex := Ord(dsaUnsorted);
|
|
dssAscending: FSortButton.ImageIndex := Ord(dsaAscending);
|
|
dssDescending: FSortButton.ImageIndex := Ord(dsaDescending);
|
|
end;
|
|
|
|
case FDataSetsSortSelectedType of
|
|
dsssAll:
|
|
begin
|
|
FSortSelectedButton.ImageIndex := Ord(dsaAll);
|
|
FSortSelectedButton.Hint := frxGet(3104);
|
|
end;
|
|
dsssSelected:
|
|
begin
|
|
FSortSelectedButton.ImageIndex := Ord(dsaSelected);
|
|
FSortSelectedButton.Hint := frxGet(3105);
|
|
end;
|
|
dsssUnselected:
|
|
begin
|
|
FSortSelectedButton.ImageIndex := Ord(dsaUnselected);
|
|
FSortSelectedButton.Hint := frxGet(3106);
|
|
end;
|
|
end;
|
|
dsList := TStringList.Create;
|
|
|
|
if Report.EnabledDataSets.Count > 0 then
|
|
begin
|
|
for i := 0 to Report.EnabledDataSets.Count - 1 do
|
|
begin
|
|
ds := Report.EnabledDataSets[i].DataSet;
|
|
if ds <> nil then
|
|
dsList.AddObject(ds.UserName, ds);
|
|
end;
|
|
end
|
|
else
|
|
Report.GetActiveDataSetList(dsList);
|
|
|
|
if FDataSetsSortType <> dssUnsorted then dsList.Sort;
|
|
|
|
i := 0;
|
|
nDSCount := dsList.Count - 1;
|
|
nInc := 1;
|
|
|
|
if FDataSetsSortType = dssDescending then
|
|
begin
|
|
i := dsList.Count - 1;
|
|
nDSCount := 0;
|
|
nInc := -1;
|
|
end;
|
|
|
|
DataSetsLB.Items.Clear;
|
|
while i * nInc <= nDSCount do
|
|
begin
|
|
ds := TfrxDataSet(dsList.Objects[i]);
|
|
if (csDesigning in Report.ComponentState) and
|
|
((ds.Owner is TForm) or (ds.Owner is TDataModule){$IFDEF Delphi5} or (ds.Owner is TFrame){$ENDIF}) then
|
|
if lFilter <> '' then
|
|
begin
|
|
if Pos(lFilter, AnsiUpperCase(ds.UserName + ' (' + ds.Owner.Name + '.' + ds.Name + ')')) > 0 then
|
|
DataSetsLB.Items.AddObject(ds.UserName + ' (' + ds.Owner.Name + '.' + ds.Name + ')', ds);
|
|
end
|
|
else
|
|
DataSetsLB.Items.AddObject(ds.UserName + ' (' + ds.Owner.Name + '.' + ds.Name + ')', ds)
|
|
else
|
|
begin
|
|
if not (ds.Owner is TfrxReport) or (ds.Owner = Report) then
|
|
if lFilter <> '' then
|
|
begin
|
|
if Pos(lFilter, AnsiUpperCase(ds.UserName)) > 0 then
|
|
DataSetsLB.Items.AddObject(ds.UserName, ds);
|
|
end
|
|
else
|
|
DataSetsLB.Items.AddObject(ds.UserName, ds);
|
|
end;
|
|
if DataSetsLB.Items.Count <> 0 then
|
|
if Report.Datasets.Find(ds) <> nil then
|
|
DataSetsLB.Checked[DataSetsLB.Items.Count - 1] := True;
|
|
Inc(i, nInc);
|
|
end;
|
|
|
|
nDSCount := DataSetsLB.Items.Count;
|
|
i := 0;
|
|
if (DataSetsLB.Items.Count <> 0) and (FDataSetsSortSelectedType <> dsssAll) then
|
|
while i < nDSCount do
|
|
begin
|
|
if (FDataSetsSortSelectedType = dsssSelected) and (not DataSetsLB.Checked[i]) then
|
|
begin
|
|
DataSetsLB.Items.Delete(i);
|
|
nDSCount := nDSCount - 1;
|
|
Dec(i, 1);
|
|
end
|
|
else if (FDataSetsSortSelectedType = dsssUnselected) and (DataSetsLB.Checked[i]) then
|
|
begin
|
|
DataSetsLB.Items.Delete(i);
|
|
nDSCount := nDSCount - 1;
|
|
Dec(i, 1);
|
|
end;
|
|
Inc(i, 1);
|
|
end;
|
|
dsList.Free;
|
|
end;
|
|
|
|
procedure TfrxReportDataForm.DatasetsLBClickCheck(Sender: TObject);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if FStandalone then
|
|
for i := 0 to DatasetsLB.Items.Count - 1 do
|
|
if i <> DatasetsLB.ItemIndex then
|
|
DatasetsLB.Checked[i] := False;
|
|
UpdateCBState;
|
|
end;
|
|
|
|
procedure TfrxReportDataForm.EditChange(Sender: TObject);
|
|
begin
|
|
FFilter := FToolWithFilterPanel.FilterEdit.EditControl.Text;
|
|
BuildDatasetList;
|
|
end;
|
|
|
|
procedure TfrxReportDataForm.FormKeyDown(Sender: TObject; var Key: Word;
|
|
Shift: TShiftState);
|
|
begin
|
|
if Key = VK_F1 then
|
|
frxResources.Help(Self);
|
|
end;
|
|
|
|
procedure TfrxReportDataForm.SelAllCBClick(Sender: TObject);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if SelAllCB.State = cbGrayed then Exit;
|
|
for i := 0 to DatasetsLB.Items.Count - 1 do
|
|
DatasetsLB.Checked[i] := SelAllCB.Checked;
|
|
UpdateSelectedDS;
|
|
end;
|
|
|
|
procedure TfrxReportDataForm.UpdateCBState;
|
|
var
|
|
i: Integer;
|
|
cbs: TCheckBoxState;
|
|
begin
|
|
cbs := cbUnchecked;
|
|
for i := 0 to DatasetsLB.Items.Count - 1 do
|
|
begin
|
|
if (i = 0) and DatasetsLB.Checked[i] then
|
|
cbs := cbChecked;
|
|
if (i > 0) and (not DatasetsLB.Checked[i] and (cbs = cbChecked)) or
|
|
(DatasetsLB.Checked[i] and (cbs = cbUnchecked)) then
|
|
begin
|
|
cbs := cbGrayed;
|
|
break;
|
|
end;
|
|
end;
|
|
SelAllCB.State := cbs;
|
|
UpdateSelectedDS;
|
|
end;
|
|
|
|
procedure TfrxReportDataForm.ToolOnClick(Sender: TObject);
|
|
var
|
|
BtnID: TfrxDataSetsActions;
|
|
SenderBtn: TfrxToolPanelButton;
|
|
NewSortType: TfrxDataSetsSortType;
|
|
NewSortSelectedType: TfrxDataSetsSortSelectedType;
|
|
pt: TPoint;
|
|
begin
|
|
if Sender is TMenuItem then
|
|
begin
|
|
BtnID := TfrxDataSetsActions(TMenuItem(Sender).Tag);
|
|
NewSortType := dssUnsorted;
|
|
NewSortSelectedType := dsssAll;
|
|
case BtnID of
|
|
dsaUnsorted: NewSortType := dssUnsorted;
|
|
dsaAscending: NewSortType := dssAscending;
|
|
dsaDescending: NewSortType := dssDescending;
|
|
dsaAll: NewSortSelectedType := dsssAll;
|
|
dsaSelected: NewSortSelectedType := dsssSelected;
|
|
dsaUnselected: NewSortSelectedType := dsssUnselected;
|
|
end;
|
|
|
|
if (FDataSetsSortType <> NewSortType) and
|
|
((BtnID = dsaUnsorted)
|
|
or (BtnID = dsaAscending)
|
|
or (BtnID = dsaDescending))
|
|
then
|
|
FDataSetsSortType := NewSortType;
|
|
|
|
if (FDataSetsSortSelectedType <> NewSortSelectedType) and
|
|
((BtnID = dsaAll)
|
|
or (BtnID = dsaSelected)
|
|
or (BtnID = dsaUnselected))
|
|
then
|
|
FDataSetsSortSelectedType := NewSortSelectedType;
|
|
BuildDatasetList;
|
|
Exit;
|
|
end;
|
|
|
|
if not Sender.InheritsFrom(TfrxToolPanelButton) then Exit;
|
|
SenderBtn := TfrxToolPanelButton(Sender);
|
|
BtnID := TfrxDataSetsActions(TComponent(Sender).Tag);
|
|
pt := SenderBtn.ClientToScreen(Point(0, SenderBtn.Height));
|
|
case BtnID of
|
|
dsaSortData: FSortPopUp.Popup(pt.X, pt.Y);
|
|
dsaSortSelectedData : FSortSelectedPopUp.Popup(pt.X, pt.Y);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxReportDataForm.CreatefrxToolWithFilterPanel(var ToolWithFilterPanel: TfrxToolWithFilterPanel);
|
|
begin
|
|
ToolWithFilterPanel := TfrxToolWithFilterPanel.Create(Self);
|
|
ToolWithFilterPanel.Parent := Self;
|
|
ToolWithFilterPanel.BorderStyle := bsNone;
|
|
ToolWithFilterPanel.BorderWidth := 0;
|
|
{$IFNDEF FPC}
|
|
ToolWithFilterPanel.BevelKind := bkFlat;
|
|
ToolWithFilterPanel.BevelWidth := 1;
|
|
ToolWithFilterPanel.ToolPanel.BevelKind := bkNone;
|
|
{$ENDIF}
|
|
ToolWithFilterPanel.AutoSize := False;
|
|
ToolWithFilterPanel.ToolPanel.AutoSize := False;
|
|
ToolWithFilterPanel.ToolPanel.BorderStyle := bsNone;
|
|
ToolWithFilterPanel.ToolPanel.ImageList := frxResources.MainButtonImages;
|
|
ToolWithFilterPanel.FilterActiveImageIndex := 121;
|
|
ToolWithFilterPanel.FilterUnactiveImageIndex := 122;
|
|
ToolWithFilterPanel.ToolPanel.OnBtnClick := ToolOnClick;
|
|
ToolWithFilterPanel.FilterColor := clWindow;
|
|
ToolWithFilterPanel.Align := alTop;
|
|
ToolWithFilterPanel.Height := 30;
|
|
ToolWithFilterPanel.OnFilterChanged := EditChange;
|
|
end;
|
|
|
|
procedure TfrxReportDataForm.CreateSortPopup;
|
|
var
|
|
m: TMenuItem;
|
|
procedure CreateItem(sName: String; ImgIdx: Integer);
|
|
begin
|
|
m := TMenuItem.Create(FSortPopUp);
|
|
FSortPopUp.Items.Add(m);
|
|
m.RadioItem := True;
|
|
m.Caption := sName;
|
|
m.ImageIndex := ImgIdx;
|
|
m.Tag := ImgIdx;
|
|
m.OnClick := ToolOnClick;
|
|
end;
|
|
begin
|
|
FSortPopUp := TPopupMenu.Create(Self);
|
|
FSortPopUp.Alignment := paLeft;
|
|
FSortPopUp.Images := frxResources.MainButtonImages;
|
|
CreateItem(frxGet(4330), ord(dsaUnsorted));
|
|
CreateItem(frxGet(4328), ord(dsaAscending));
|
|
CreateItem(frxGet(4329), ord(dsaDescending));
|
|
end;
|
|
|
|
procedure TfrxReportDataForm.CreateSortSelectedPopup;
|
|
var
|
|
m: TMenuItem;
|
|
procedure CreateItem(sName: String; ImgIdx: Integer);
|
|
begin
|
|
m := TMenuItem.Create(FSortSelectedPopUp);
|
|
FSortSelectedPopUp.Items.Add(m);
|
|
m.RadioItem := True;
|
|
m.Caption := sName;
|
|
m.ImageIndex := ImgIdx;
|
|
m.Tag := ImgIdx;
|
|
m.OnClick := ToolOnClick;
|
|
end;
|
|
begin
|
|
FSortSelectedPopUp := TPopupMenu.Create(Self);
|
|
FSortSelectedPopUp.Alignment := paLeft;
|
|
FSortSelectedPopUp.Images := frxResources.MainButtonImages;
|
|
CreateItem(frxGet(3104), ord(dsaAll));
|
|
CreateItem(frxGet(3105), ord(dsaSelected));
|
|
CreateItem(frxGet(3106), ord(dsaUnselected));
|
|
end;
|
|
|
|
end.
|