expertcad/SRC/SCSNormBase/U_ConfGroups.pas
2025-05-12 10:07:51 +03:00

570 lines
18 KiB
ObjectPascal
Raw Permalink Blame History

unit U_ConfGroups;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, RzPanel, ActnList, RzButton, ComCtrls,
ToolWin, RzLstBox, siComp, siLngLnk, Menus, IniFiles, kbmMemTable,
U_BaseCommon, U_BaseConstants, U_BaseSettings, U_FilterConfigurator,
XPMenu, Buttons, RzChkLst;
type
TF_ConfGroups = class(TForm)
RzPanel1: TRzPanel;
lng_Forms: TsiLangLinked;
pnOkCancel: TRzPanel;
RzPanel3: TRzPanel;
RzPanel4: TRzPanel;
Label1: TLabel;
ToolBar1: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
Splitter1: TSplitter;
RzPanel5: TRzPanel;
RzPanel6: TRzPanel;
Label2: TLabel;
lbGroupType: TRzListBox;
ToolBar2: TToolBar;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
btOk: TRzBitBtn;
btCancel: TRzBitBtn;
ActionList: TActionList;
Act_AddGroupType: TAction;
Act_DelGroupType: TAction;
Act_AddCategory: TAction;
Act_DelCategory: TAction;
pmGroupType: TPopupMenu;
pmGroupCategory: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
XPMenu1: TXPMenu;
ToolButton5: TToolButton;
ToolButton6: TToolButton;
ToolButton7: TToolButton;
Act_CategoryUp: TAction;
Act_CategoryDown: TAction;
clGroupCategory: TRzCheckList;
procedure Act_AddGroupTypeExecute(Sender: TObject);
procedure Act_DelGroupTypeExecute(Sender: TObject);
procedure Act_AddCategoryExecute(Sender: TObject);
procedure Act_DelCategoryExecute(Sender: TObject);
procedure pnOkCancelResize(Sender: TObject);
procedure lbGroupTypeClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Act_CategoryUpExecute(Sender: TObject);
procedure Act_CategoryDownExecute(Sender: TObject);
procedure clGroupCategoryChange(Sender: TObject; Index: Integer;
NewState: TCheckBoxState);
private
GForm: TForm;
FGrpTypeCaptions: TStringList;
FGrpTypeIdents: TStringList;
FCategoryCaptions: TStringList;
FCategoryIdents: TStringList;
FTypeGroupBlock: TFilterBlock;
procedure LoadCategoriesFromCurrGroupType;
procedure MoveGroupCategory(AMoveSteps: Integer);
procedure SetCategoriesToCurrGroupType;
procedure SetControls;
public
Constructor Create(AOwner: TComponent; AForm: TForm);
Destructor Destroy; override;
function Execute(AGrpTypeCaptions, AGrpTypeIdents,
AUseGrpTypeIdents, AUseGrpTypeStrBlocks,
ACategoryCaptions, ACategoryIdents: TStringList; const AGrpTypeIndentToSelect: string): Boolean;
end;
function ExecuteComponGroups(AFormOwner: TForm): Boolean;
//var
// Form1: TForm1;
implementation
uses U_Main, Unit_DM_SCS;
{$R *.dfm}
function ExecuteComponGroups(AFormOwner: TForm): Boolean;
var
i: Integer;
F_ConfGroups: TF_ConfGroups;
MemTableSysName: TkbmMemTable;
Ini: TMemIniFile;
GroupFieldValue: TFilterField;
GrpTypeCaptions, GrpTypeIdents: TStringList;
UseGrpTypeIdents, UseGrpTypeStrBlocks: TStringList;
OldUseGrpTypeIdents: TStringList;
CategoryCaptions, CategoryIdents: TStringList;
StrIndex: Integer;
begin
F_ConfGroups := TF_ConfGroups.Create(AFormOwner, AFormOwner);
try
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
GrpTypeCaptions := TStringList.Create;
GrpTypeIdents := CreateStringListSorted;
MemTableSysName := TF_Main(AFormOwner).F_MakeEditComponentType.mtSysNames;
MemTableSysName.DisableControls;
try
MemTableSysName.First;
while Not MemTableSysName.Eof do
begin
StrIndex := GrpTypeIdents.Add(MemTableSysName.FieldByName(fnSysName).AsString);
GrpTypeCaptions.Insert(StrIndex, MemTableSysName.FieldByName(fnDescription).AsString);
MemTableSysName.Next;
end;
finally
MemTableSysName.EnableControls;
end;
UseGrpTypeIdents := TStringList.Create;
OldUseGrpTypeIdents := TStringList.Create;
UseGrpTypeStrBlocks := TStringList.Create;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
Ini := TMemIniFile.Create(GetPathToNBComponGroups);
Ini.ReadSection(scCompTypeGroups, UseGrpTypeIdents);
OldUseGrpTypeIdents.Assign(UseGrpTypeIdents);
//Ini.ReadSectionValues(scCompTypeGroups, UseGrpTypeStrBlocks);
for i := 0 to UseGrpTypeIdents.Count - 1 do
begin
UseGrpTypeStrBlocks.Add(Ini.ReadString(scCompTypeGroups, UseGrpTypeIdents[i], ''));
end;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
CategoryCaptions := TStringList.Create;
CategoryIdents := CreateStringListSorted;
for i := 0 to TF_Main(AFormOwner).FGroupFieldValues.Count - 1 do
begin
GroupFieldValue := TFilterField(TF_Main(AFormOwner).FGroupFieldValues[i]);
StrIndex := CategoryIdents.Add(GroupFieldValue.FieldName);
CategoryCaptions.Insert(StrIndex, GroupFieldValue.FieldCaption);
end;
if F_ConfGroups.Execute(GrpTypeCaptions, GrpTypeIdents,
UseGrpTypeIdents, UseGrpTypeStrBlocks,
CategoryCaptions, CategoryIdents,
TF_Main(AFormOwner).GetSelectedComponGroups) then
begin
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
for i := 0 to OldUseGrpTypeIdents.Count - 1 do
begin
if UseGrpTypeIdents.IndexOf(OldUseGrpTypeIdents[i]) = -1 then
Ini.DeleteKey(scCompTypeGroups, OldUseGrpTypeIdents[i]);
end;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for i := 0 to UseGrpTypeIdents.Count - 1 do
begin
Ini.WriteString(scCompTypeGroups, UseGrpTypeIdents[i], UseGrpTypeStrBlocks[i]);
end;
Ini.UpdateFile;
TF_Main(AFormOwner).SetComponGroupsToForm('');
end;
FreeAndNil(Ini);
FreeAndNil(CategoryIdents);
FreeAndNil(CategoryCaptions);
FreeAndNil(UseGrpTypeStrBlocks);
FreeAndNil(OldUseGrpTypeIdents);
FreeAndNil(UseGrpTypeIdents);
FreeAndNil(GrpTypeIdents);
FreeAndNil(GrpTypeCaptions);
finally
FreeAndNil(F_ConfGroups);
end;
end;
constructor TF_ConfGroups.Create(AOwner: TComponent; AForm: TForm);
begin
GForm := AForm;
inherited Create(AOwner);
end;
destructor TF_ConfGroups.Destroy;
begin
inherited;
end;
procedure TF_ConfGroups.Act_AddGroupTypeExecute(Sender: TObject);
var
ComboStrings: TStringList;
GuidObject: TIDGuidObject;
SelectedStringItem: TStringItem;
i: Integer;
begin
try
ComboStrings := CreateStringListSorted;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
for i := 0 to FGrpTypeIdents.Count - 1 do
begin
if FGrpTypeIdents[i] <> '' then
if IndexOfGUIDInStrings(FGrpTypeIdents[i], lbGroupType.Items) = -1 then
AddGUIDIDToStrings(FGrpTypeCaptions[i], FGrpTypeIdents[i], 0, ComboStrings);
end;
if ComboStrings.Count > 0 then
begin
SelectedStringItem := InputFormCombo(GForm, cConfGroups_Msg2, cConfGroups_Msg3, ComboStrings[0], '', ComboStrings, nil);
if SelectedStringItem.FObject <> nil then
if TIDGuidObject(SelectedStringItem.FObject).GUID <> '' then
begin
GuidObject := TIDGuidObject(
AddGUIDIDToStrings(SelectedStringItem.FString, TIDGuidObject(SelectedStringItem.FObject).GUID,
0, lbGroupType.Items));
lbGroupType.ItemIndex := lbGroupType.Items.IndexOfObject(GuidObject);
LoadCategoriesFromCurrGroupType;
end;
SetControls;
end
else
MessageInfo(cConfGroups_Msg1);
RemoveGUIDIDFromStrings(ComboStrings);
FreeAndNil(ComboStrings);
except
on E: Exception do AddExceptionToLogExt(ClassName, MethodName(@TF_ConfGroups.Act_AddGroupTypeExecute), E.Message);
end;
end;
procedure TF_ConfGroups.Act_DelGroupTypeExecute(Sender: TObject);
var
GuidObject: TIDGuidObject;
NewItemIndex: Integer;
begin
try
if lbGroupType.ItemIndex <> -1 then
if MessageQuastYN(cConfGroups_Msg4) = IDYES then
begin
GuidObject := TIDGuidObject(lbGroupType.Items.Objects[lbGroupType.ItemIndex]);
if GuidObject <> nil then
GuidObject.Free;
NewItemIndex := lbGroupType.ItemIndex;
lbGroupType.Items.Delete(lbGroupType.ItemIndex);
if lbGroupType.Items.Count > 0 then
begin
if NewItemIndex >= (lbGroupType.Items.Count - 1) then
NewItemIndex := lbGroupType.Items.Count - 1;
end
else
NewItemIndex := -1;
lbGroupType.ItemIndex := NewItemIndex;
LoadCategoriesFromCurrGroupType;
SetControls;
end;
except
on E: Exception do AddExceptionToLogExt(ClassName, MethodName(@TF_ConfGroups.Act_DelGroupTypeExecute), E.Message);
end;
end;
procedure TF_ConfGroups.Act_AddCategoryExecute(Sender: TObject);
var
ComboStrings: TStringList;
i, j: integer;
FindedStr: Boolean;
CategotyBlock: TFilterBlock;
ResComboStringItem: TStringItem;
NewFilterBlock: TFilterBlock;
NewItemIndex: Integer;
begin
try
ComboStrings := CreateStringListSorted;
for i := 0 to FCategoryIdents.Count - 1 do
begin
FindedStr := false;
for j := 0 to clGroupCategory.Items.Count - 1 do
begin
CategotyBlock := TFilterBlock(clGroupCategory.Items.Objects[j]);
if CategotyBlock.Condition.FieldName = FCategoryIdents[i] then
begin
FindedStr := true;
Break; //// BREAK ////
end;
end;
if Not FindedStr then
AddGUIDIDToStrings(FCategoryCaptions[i], FCategoryIdents[i], 0, ComboStrings);
end;
if ComboStrings.Count > 0 then
begin
ResComboStringItem := InputFormCombo(GForm, cConfGroups_Msg6, cConfGroups_Msg7, ComboStrings[0], '', ComboStrings, nil);
if ResComboStringItem.FObject <> nil then
begin
NewFilterBlock := TFilterBlock.Create(FTypeGroupBlock, btCondition);
NewFilterBlock.Condition.FieldName := TIDGuidObject(ResComboStringItem.FObject).GUID;
NewFilterBlock.Condition.UserFieldName := ResComboStringItem.FString;
NewItemIndex := clGroupCategory.Items.AddObject(ResComboStringItem.FString, NewFilterBlock);
clGroupCategory.ItemChecked[NewItemIndex] := NewFilterBlock.IsOn;
clGroupCategory.ItemIndex := NewItemIndex; //clGroupCategory.Items.Count - 1;
SetCategoriesToCurrGroupType;
SetControls;
end;
end
else
MessageInfo(cConfGroups_Msg5);
RemoveGUIDIDFromStrings(ComboStrings);
FreeAndNil(ComboStrings);
except
on E: Exception do AddExceptionToLogExt(ClassName, MethodName(@TF_ConfGroups.Act_AddCategoryExecute), E.Message);
end;
end;
procedure TF_ConfGroups.Act_DelCategoryExecute(Sender: TObject);
var
ItemObject: TObject;
NewItemIndex: integer;
begin
try
if clGroupCategory.ItemIndex <> -1 then
if MessageQuastYN(cConfGroups_Msg8) = IDYES then
begin
ItemObject := TIDGuidObject(clGroupCategory.Items.Objects[clGroupCategory.ItemIndex]);
if ItemObject <> nil then
ItemObject.Free;
NewItemIndex := clGroupCategory.ItemIndex;
clGroupCategory.Items.Delete(clGroupCategory.ItemIndex);
if clGroupCategory.Items.Count > 0 then
begin
if NewItemIndex >= (clGroupCategory.Items.Count - 1) then
NewItemIndex := clGroupCategory.Items.Count - 1;
end
else
NewItemIndex := -1;
clGroupCategory.ItemIndex := NewItemIndex;
SetCategoriesToCurrGroupType;
SetControls;
end;
except
on E: Exception do AddExceptionToLogExt(ClassName, MethodName(@TF_ConfGroups.Act_DelCategoryExecute), E.Message);
end;
end;
procedure TF_ConfGroups.pnOkCancelResize(Sender: TObject);
begin
SetMiddleControlChilds(TControl(Sender), TControl(Self));
end;
function TF_ConfGroups.Execute(AGrpTypeCaptions, AGrpTypeIdents,
AUseGrpTypeIdents, AUseGrpTypeStrBlocks,
ACategoryCaptions, ACategoryIdents: TStringList; const AGrpTypeIndentToSelect: string): Boolean;
var
i: integer;
TypeCaptionIndex: Integer;
TypeCaption: String;
GuidObject: TIDGuidObject;
StrIndex: Integer;
ObjectToSelect: TObject;
begin
Result := false;
try
FGrpTypeCaptions := AGrpTypeCaptions;
FGrpTypeIdents := AGrpTypeIdents;
FCategoryCaptions := ACategoryCaptions;
FCategoryIdents := ACategoryIdents;
RemoveGUIDIDFromStrings(lbGroupType.Items, true);
//RemoveGUIDIDFromStrings(clGroupCategory.Items, true);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> c<><63><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
ObjectToSelect := nil;
for i := 0 to AUseGrpTypeIdents.Count - 1 do
begin
TypeCaption := '';
TypeCaptionIndex := AGrpTypeIdents.IndexOf(AUseGrpTypeIdents[i]);
if TypeCaptionIndex <> -1 then
TypeCaption := AGrpTypeCaptions[TypeCaptionIndex];
GuidObject := TIDGuidObject(AddGUIDIDToStrings(TypeCaption, AUseGrpTypeIdents[i], 0, lbGroupType.Items));
GuidObject.DataStr := AUseGrpTypeStrBlocks[i];
if AGrpTypeIndentToSelect = AUseGrpTypeIdents[i] then
ObjectToSelect := GuidObject;
end;
if ObjectToSelect <> nil then
lbGroupType.ItemIndex := lbGroupType.Items.IndexOfObject(ObjectToSelect)
else
begin
if lbGroupType.Items.Count > 0 then
lbGroupType.ItemIndex := 0;
end;
lbGroupTypeClick(lbGroupType);
SetControls;
pnOkCancelResize(pnOkCancel);
if ShowModal = mrOk then
begin
Result := true;
AUseGrpTypeIdents.Clear;
AUseGrpTypeStrBlocks.Clear;
for i := 0 to lbGroupType.Items.Count - 1 do
begin
GuidObject := TIDGuidObject(lbGroupType.Items.Objects[i]);
StrIndex := AUseGrpTypeIdents.Add(GuidObject.GUID);
AUseGrpTypeStrBlocks.Insert(StrIndex, GuidObject.DataStr);
end;
end;
RemoveGUIDIDFromStrings(lbGroupType.Items, true);
//RemoveGUIDIDFromStrings(clGroupCategory.Items, true);
FTypeGroupBlock.Clear;
except
on E: Exception do AddExceptionToLogExt(ClassName, 'Execute', E.Message);
end;
end;
procedure TF_ConfGroups.LoadCategoriesFromCurrGroupType;
var
GuidObject: TIDGuidObject;
i: Integer;
ChildFilterBlock: TFilterBlock;
ChildFilterBlockCaption: String;
StrIndex: Integer;
NewIndex: Integer;
begin
clGroupCategory.Items.Clear;
FTypeGroupBlock.Clear;
if lbGroupType.ItemIndex <> -1 then
begin
GuidObject := TIDGuidObject(lbGroupType.Items.Objects[lbGroupType.ItemIndex]);
FTypeGroupBlock.LoadFromStr(GuidObject.DataStr, nil, false);
//RemoveGUIDIDFromStrings(clGroupCategory.Items, true);
for i := 0 to FTypeGroupBlock.ChildBlocks.Count - 1 do
begin
ChildFilterBlock := FTypeGroupBlock.ChildBlocks[i];
ChildFilterBlockCaption := '';
StrIndex := FCategoryIdents.IndexOf(ChildFilterBlock.Condition.FieldName);
if StrIndex <> -1 then
ChildFilterBlockCaption := FCategoryCaptions[StrIndex];
NewIndex := clGroupCategory.Items.AddObject(ChildFilterBlockCaption, ChildFilterBlock);
clGroupCategory.ItemChecked[NewIndex] := ChildFilterBlock.IsOn;
end;
if clGroupCategory.Items.Count > 0 then
clGroupCategory.ItemIndex := 0;
SetControls;
end;
end;
procedure TF_ConfGroups.MoveGroupCategory(AMoveSteps: Integer);
var
Itemindex: Integer;
NewItemIndex: Integer;
begin
Itemindex := clGroupCategory.ItemIndex;
if Itemindex <> -1 then
begin
NewItemIndex := Itemindex + AMoveSteps;
if (NewItemIndex >= 0) and (NewItemIndex <= (clGroupCategory.Count - 1)) then
begin
clGroupCategory.Items.Move(ItemIndex, NewItemIndex);
clGroupCategory.ItemIndex := NewItemIndex;
FTypeGroupBlock.ChildBlocks.Move(Itemindex, NewItemIndex);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
SetCategoriesToCurrGroupType;
end;
end;
end;
procedure TF_ConfGroups.SetCategoriesToCurrGroupType;
var
GuidObject: TIDGuidObject;
begin
if lbGroupType.ItemIndex <> -1 then
begin
GuidObject := TIDGuidObject(lbGroupType.Items.Objects[lbGroupType.ItemIndex]);
GuidObject.DataStr := FTypeGroupBlock.GetFilterAsString(false);
end;
end;
procedure TF_ConfGroups.SetControls;
begin
Act_DelGroupType.Enabled := lbGroupType.ItemIndex <> -1; //lbGroupType.Items.Count > 0;
Act_AddCategory.Enabled := lbGroupType.ItemIndex <> -1; //lbGroupType.Items.Count > 0;
Act_DelCategory.Enabled := clGroupCategory.ItemIndex <> -1; //clGroupCategory.Items.Count > 0;
Act_CategoryUp.Enabled := clGroupCategory.ItemIndex <> -1;
Act_CategoryDown.Enabled := clGroupCategory.ItemIndex <> -1;
end;
procedure TF_ConfGroups.FormCreate(Sender: TObject);
begin
ActionCaptionsToHints(ActionList);
FTypeGroupBlock := TFilterBlock.Create(nil, btBlock);
end;
procedure TF_ConfGroups.FormDestroy(Sender: TObject);
begin
FreeAndNil(FTypeGroupBlock);
end;
procedure TF_ConfGroups.lbGroupTypeClick(Sender: TObject);
begin
try
LoadCategoriesFromCurrGroupType;
except
on E: Exception do AddExceptionToLogExt(ClassName, MethodName(@TF_ConfGroups.lbGroupTypeClick), E.Message);
end;
end;
procedure TF_ConfGroups.Act_CategoryUpExecute(Sender: TObject);
begin
MoveGroupCategory(-1);
end;
procedure TF_ConfGroups.Act_CategoryDownExecute(Sender: TObject);
begin
MoveGroupCategory(1);
end;
procedure TF_ConfGroups.clGroupCategoryChange(Sender: TObject;
Index: Integer; NewState: TCheckBoxState);
var
CategotyBlock: TFilterBlock;
begin
CategotyBlock := TFilterBlock(clGroupCategory.Items.Objects[Index]);
if NewState = cbUnchecked then
CategotyBlock.IsOn := false
else
if NewState = cbChecked then
CategotyBlock.IsOn := true;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
SetCategoriesToCurrGroupType;
end;
end.