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 // Формируем список компонентов из системных имен 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; // вычитываем типы компонентов, для которых применяются группы 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; // Список свойств компонентов с названиями 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 // Удаляем типы for i := 0 to OldUseGrpTypeIdents.Count - 1 do begin if UseGrpTypeIdents.IndexOf(OldUseGrpTypeIdents[i]) = -1 then Ini.DeleteKey(scCompTypeGroups, OldUseGrpTypeIdents[i]); end; // Сохраняем то что осталось 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; // Выбираем все свободные типы 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); // Насыпаем cпмсок типов 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); // Сохранение 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; // Сохранение SetCategoriesToCurrGroupType; end; end.