unit U_InputBox; interface uses Windows, U_LNG, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, cxLookAndFeelPainters, StdCtrls, cxButtons, cxControls, cxContainer, cxEdit, cxTextEdit, U_BaseCommon, ExtCtrls, cxRadioGroup, ComCtrls, ActnList, ActnMan, cxGroupBox, U_BaseConstants, U_SCSLists, U_SCSComponent, cxMaskEdit, cxSpinEdit, siComp, siLngLnk, cxDropDownEdit, RzPanel, RzRadGrp, RzButton, RzRadChk, XPMenu, Menus, ToolWin, cxGraphics, cxLookAndFeels, PlatformDefaultStyleActnCtrls; const // ControlTypeApplyForAll ctalCheckBox = 01; ctalRadio = 02; mrSkipAll = $FF + 1; type TItemType = Integer; type TItemListData = Record ID_Compon: Integer; Complects: TStrings; end; PItemListData = ^TItemListData; //type TComponViewKind = (cvkCompon, cvkComponComplect); type TibButton = (ibSkip, ibSkipAll, ibCancel); TibButtons = set of TibButton; type TF_InputBox = class(TForm) Panel_InputText: TPanel; Label_Prompt: TLabel; edText: TcxTextEdit; Panel_ChoiceAddCompl: TPanel; Label_Text: TLabel; Button_Yes: TcxButton; Button_No: TcxButton; Label_ContinueQuast: TLabel; Panel_ComponList: TPanel; Label_Messg: TLabel; ListView_Compons: TListView; ActionManager: TActionManager; Act_YesClick: TAction; Act_Close: TAction; Act_Back: TAction; Label_ContinueConn: TLabel; Panel_ChoiceDelComponMode: TPanel; cxButton1: TcxButton; cxButton2: TcxButton; seValue: TcxSpinEdit; lng_Forms: TsiLangLinked; cbValue: TcxComboBox; RadioGroup_ChoiceDelComponMode: TRzRadioGroup; gbChioceAdd: TRzGroupBox; rbAddComplWithoutInterf: TRzRadioButton; rbFindComplect: TRzRadioButton; meText: TMemo; Button_OK: TRzBitBtn; Button_Cancel: TRzBitBtn; cbComponList: TRzCheckBox; Act_Properties: TAction; PopupMenu1: TPopupMenu; N1: TMenuItem; XPMenu1: TXPMenu; tbObjectList: TToolBar; ToolButton1: TToolButton; pnComponButtons: TPanel; Button_Close: TcxButton; Button_Back: TcxButton; Button_CancelChoice: TcxButton; btSkip: TcxButton; rgComponList: TRzRadioGroup; btSkipAll: TcxButton; cbInputCombo: TRzCheckBox; pnComboInputPrompt: TRzPanel; cbDelConnToPoinCable: TRzCheckBox; procedure FormShow(Sender: TObject); procedure FormHide(Sender: TObject); procedure FormCreate(Sender: TObject); procedure Act_YesClickExecute(Sender: TObject); procedure RadioGroup_ChioceAddPropertiesChange(Sender: TObject); procedure Act_CloseExecute(Sender: TObject); procedure Act_BackExecute(Sender: TObject); procedure ListView_ComponsMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ListView_ComponsMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure ListView_ComponsChange(Sender: TObject; Item: TListItem; Change: TItemChange); procedure Button_CancelChoiceClick(Sender: TObject); procedure Act_PropertiesExecute(Sender: TObject); procedure btSkipClick(Sender: TObject); procedure pnComponButtonsResize(Sender: TObject); procedure btSkipAllClick(Sender: TObject); procedure ListView_ComponsDblClick(Sender: TObject); private { Private declarations } //GIDFindCompon: Integer; //GIDChild: Integer; FComponent: TSCSComponent; FChildComponent: TSCSComponent; FTopComponNode: TTreeNode; GConnectKind: TConnectKind; //*** Вид соединения: МамаПапа... GConnectType: TConnectType; GFormBase: TForm; GWasFindConnCompon: Boolean; public GForm: TForm; GInputFormMode: TInputFormMode; GTreeKind: TTreeKind; GChangeInMainForm: Boolean; GListKind: TInputBoxListKind; //GItemType: TItemType; GPrevListItem: TListItem; GAnswQuatDifferent: TRect; GLastSelID: Integer; FIsSelectionItem: Boolean; FButtons: TibButtons; FTextInPluralMode: Boolean; FChoiceDelComponModes: TstringList; procedure FormView(AHeight, AWidth: Integer); procedure ShowComplectsHint; procedure GotoOnTree; function ChoiceAddCompl(AFormBase: TForm; var AComponNode: TTreeNode; var ACanAdd: Boolean; var AComponent: TSCSComponent; AChild: TSCSComponent; AConnectType: TConnectType; AConnectKind: TConnectKind; AText: String; AShowMessageType: TShowMessageType = smtDisplay): Boolean; function FindConnCompons(AComponent, AChild: TSCSComponent; AConnectType: TConnectType; AShowFinded: Boolean): Boolean; function ChoiceDelComponMode(ACoponName: String; ATextInPluralMode: Boolean=false): TDelComponMode; procedure SelectComponentFromList(const AMessage: String; AComponents: TSCSComponents); constructor Create(AOwner: TComponent; AForm: TForm); destructor Destroy; override; end; { var F_InputBox: TF_InputBox; } implementation Uses U_Main, USCS_Main, Unit_DM_SCS, U_DMCommon, U_Common{, U_BaseCommon}; {$R *.dfm} procedure TF_InputBox.FormView(AHeight, AWidth: Integer); begin Height := AHeight; Width := AWidth; end; // ##### Показать комплектующие компоненты ##### procedure TF_InputBox.ShowComplectsHint; var ListItem: TListItem; Point : TPoint; begin GetCursorPos(Point); Point := ListView_Compons.ScreenToClient(Point); ListItem := ListView_Compons.GetItemAt(Point.X, Point.Y); if GListKind = lkComponComplect then begin if (ListItem <> nil) {and (GPrevListItem <> ListItem)} {and (Button = mbRight)} then begin ListView_Compons.Hint := ' '+cInputBox_Msg1+' ' + #13 + ' "'+ ListItem.Caption +'":' + #13 + PItemListData(ListItem.Data).Complects.Text; ListView_Compons.ShowHint := true; Application.ShowHint := true; end else begin ListView_Compons.ShowHint := false; Application.ShowHint := false; end; GPrevListItem := ListItem; end; end; // ##### Преход по Дереву ##### procedure TF_InputBox.GotoOnTree; var //Item: TListItem; Node: TTreeNode; NodeDat: PObjectData; ID_Node: Integer; IDCompRel: Integer; IsComponSelect: Boolean; ComponID: Integer; ComponItemType: Integer; ComponControlObj: TObject; ptrTemplateData: PTemplateData; //*** переменные для отобр точ. компонентов на каде SCSComponent: TSCSComponent; SCSCatalog: TSCSCatalog; LineComponTrace: TIntList; begin LineComponTrace := nil; try try if ListView_Compons.Selected <> nil then with (GForm as TF_Main) do begin //GItemType := TF_Main(GForm).DM.GItemType; ID_Node := -1; IDCompRel := 0; case GListKind of lkComponObjectData: begin ID_Node := PObjectData(ListView_Compons.Selected.Data).ObjectID; IDCompRel := PObjectData(ListView_Compons.Selected.Data).ID_CompRel; end; lkComponID: ID_Node := Integer(ListView_Compons.Selected.Data); lkComponComplect: ID_Node := PItemListData(ListView_Compons.Selected.Data).ID_Compon; lkBusyInterfaces: ID_Node := PDirectoryTypeRel(ListView_Compons.Selected.Data).ID_DirecoryType; end; Node := nil; IsComponSelect := false; case GTreeKind of trkCatalog: begin pcObjects.ActivePage := tsComponents; if (IDCompRel <> 0) and (FTopComponNode <> nil) then Node := FindChildNodeByIDCompRel(FTopComponNode, IDCompRel) else begin IsComponSelect := true; Node := FindComponOrDirInTree(ID_Node, true); // Выйти на компонент end; end; trkGuide : Node := F_CaseForm.FindNodeByID(ID_Node) end; if (GChangeInMainForm) then case GTreeKind of trkCatalog: begin ComponID := 0; ComponItemType := 0; if Node <> nil then begin SelectNodeDirect(Node); //Tree_catalog.Selected := Node; NodeDat := Node.Data; ComponID := NodeDat.ObjectID; ComponItemType := NodeDat.ItemType; end else begin ComponControlObj := SelectComponInPCObjects(ID_Node); if ComponControlObj <> nil then begin if ComponControlObj is TListItem then begin if TListItem(ComponControlObj).Data <> nil then begin ptrTemplateData := TListItem(ComponControlObj).Data; if ptrTemplateData <> nil then begin ComponID := ptrTemplateData.IDComponent; ComponItemType := GetItemTypeByIsLine(ptrTemplateData.IsLine); end; end; end; end; end; if ComponID <> 0 then begin if ComponItemType = itComponLine then begin //TF_Main(GForm).SelectTraceInCADByIDCompon(NodeDat.ObjectID); if LineComponTrace <> nil then LineComponTrace.Free; //FreeList(LineComponTrace); LineComponTrace := GetComponLineTrace(ComponID); if LineComponTrace <> nil then SelectConnectedCables(TF_Main(GForm).GSCSBase.CurrProject.CurrList.CurrID, LineComponTrace); LineComponTrace.Free; //FreeList(LineComponTrace); LineComponTrace := nil end; if ComponItemType = itComponCon then if TF_Main(GForm).GDBMode = bkProjectManager then begin SCSCatalog := nil; SCSComponent := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(ComponID); if SCSComponent <> nil then SCSCatalog := SCSComponent.GetFirstParentCatalog; if SCSCatalog <> nil then SelectConnectedConnector(SCSCatalog.ListID, SCSCatalog.ScsID); end; end; end; trkGuide: if Node <> nil then begin F_CaseForm.Tree_InterfType.Selected := Node; if GListKind = lkBusyInterfaces then SearchRecord(DM.DataSet_INTERFACE, 'ID', PDirectoryTypeRel(ListView_Compons.Selected.Data).ID_Pointer); end; end; GLastSelID := ID_Node; end; except on E: Exception do AddExceptionToLog('TF_InputBox.GotoOnTree: '+E.Message); end; finally if LineComponTrace <> nil then LineComponTrace.Free; //FreeList(LineComponTrace); end; end; function TF_InputBox.ChoiceAddCompl(AFormBase: TForm; var AComponNode: TTreeNode; var ACanAdd: Boolean; var AComponent: TSCSComponent; AChild: TSCSComponent; AConnectType: TConnectType; AConnectKind: TConnectKind; AText: String; AShowMessageType: TShowMessageType = smtDisplay): Boolean; var KolCompl: Integer; ModalRes: TModalResult; HaveNecessaryCompl: Boolean; ComponVolume: Double; ChildVolume: Double; //ptrFemaleInterface: TSCSInterface; //ptrMaleInterface: TSCSInterface; CanFemaleHaveMaleRes: TCanFemaleHaveMaleRes; InterfFemale: TSCSInterface; InterfMale: TSCSInterface; FemaleHaveMaleRes: Boolean; strMessg: String; AddManual: boolean; CableChannelFullness: Double; //SCSList: TSCSList; procedure AddMessgToStr(AMessg: String); begin if strMessg = '' then strMessg := strMessg + cInputBox_Msg2_1+' "'+AChild.GetNameForVisible+'" '+cInputBox_Msg2_2+' "'+AComponent.GetNameForVisible+'" '+ cInputBox_Msg2_3+':'; strMessg := strMessg + #13+#10 + '-'+AMessg+';'; end; begin FTopComponNode := nil; FIsSelectionItem := false; with TF_Main(GForm) do begin Result := false; ACanAdd := true; HaveNecessaryCompl := false; GFormBase := AFormBase; GConnectKind := AConnectKind; GConnectType := AConnectType; //SCSList := nil; CableChannelFullness := 0; //*** Проверить есть ли комплектующие KolCompl := 0; case TF_Main(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(DM.scsQ, ' SELECT COUNT(*) As Cnt FROM COMPONENT_RELATION '+ ' WHERE (ID_COMPONENT = '''+ IntToStr(AComponent.ID) +''') and '+ ' (Connect_Type = '''+ IntToStr(cntComplect) +''')'); KolCompl := DM.scsQ.GetFNAsInteger('Cnt'); end; bkProjectManager: KolCompl := AComponent.ChildComplects.Count; end; //*** Проверить есть ли подходящие комплектующие if KolCompl > 0 then HaveNecessaryCompl := FindConnCompons(AComponent, AChild, AConnectType, false); if Not HaveNecessaryCompl then case AConnectType of cntComplect: case AComponent.IsLine of biTrue: begin strMessg := ''; InterfFemale := nil; InterfMale := nil; addManual := False; FemaleHaveMaleRes := AComponent.CheckCanalHaveCable(AChild, InterfFemale, InterfMale).CanHave; if (InterfFemale = nil) or (InterfMale = nil) then begin //if InterfFemale = nil then // AddMessgToStr(cInputBox_Msg3_1+' "'+AComponent.GetNameForVisible+'" '+cInputBox_Msg3_2); //if InterfMale = nil then // AddMessgToStr(cInputBox_Msg4_1+' "'+AChild.GetNameForVisible+'" '+cInputBox_Msg4_2); if (AChild.ComponentType.SysName = ctsnCableChannelAccessory) or (AChild.ComponentType.SysName = ctsnAccessory) then begin if GUseVisibleInterfaces then begin if (AShowMessageType <> smtDisplay) or (MessageModal(AText + #13 + #13 + ' '+cInputBox_Msg8_1+'?', cInputBox_Msg8_2, MB_ICONQUESTION or MB_YESNO) = IDNO) then begin if GUseVisibleInterfaces then AddMessgToStr(cInputBox_Msg4_3) else AddMessgToStr(cInputBox_Msg4_3_1); end else AddManual := True; end else AddMessgToStr(cInputBox_Msg4_3_1); end else begin if GUseVisibleInterfaces then AddMessgToStr(cInputBox_Msg4_3) else AddMessgToStr(cInputBox_Msg4_3_1); end; end else begin ComponVolume := InterfFemale.ValueI; //AComponent.GetVolume(gtFemale); ChildVolume := InterfMale.ValueI; //AComponent.GetVolume(gtMale); if ComponVolume = 0 then AddMessgToStr(cInputBox_Msg5_1+' "'+AComponent.GetNameForVisible+'" '+cInputBox_Msg5_2) else begin CableChannelFullness := GetCableCanalFullnessKoef(AComponent, AChild); CanFemaleHaveMaleRes := CanFemaleHaveMale(InterfFemale, InterfMale.ValueI, CableChannelFullness); if Not CanFemaleHaveMaleRes.CanHave then begin strMessg := cInputBox_Msg6_1+' "'+AComponent.GetNameForVisible+'" '+cInputBox_Msg6_2+' '+FloatToStr(RoundCP(FloatInUOM(CanFemaleHaveMaleRes.MaxFemaleFullValue, umSM, TF_Main(GForm).FUOMMin, 2)))+' '+GetNameUOM2(TF_Main(GForm).FUOMMin)+cInputBox_Msg6_31+' '+ ' "'+AChild.GetNameForVisible+' '+cInputBox_Msg6_4+' '+FloatToStr(RoundCP(FloatInUOM(InterfMale.ValueI, umSM, TF_Main(GForm).FUOMMin, 2)))+' '+GetNameUOM2(TF_Main(GForm).FUOMMin)+' '+cInputBox_Msg6_51+'.'+ #13 + cInputBox_Msg6_6+' "'+AComponent.GetNameForVisible+'" '+cInputBox_Msg6_7+' '+FloatToStr(RoundCP(FloatInUOM(CanFemaleHaveMaleRes.MinValueForMales, umSM, TF_Main(GForm).FUOMMin, 2)))+' '+GetNameUOM2(TF_Main(GForm).FUOMMin)+'.'; if CableChannelFullness > 0 then strMessg := strMessg +#13+#10+#13+#10+cInputBox_Msg7+' '+FloatToStr(Round2(CableChannelFullness))+'%'; //ptrFemaleInterface := AComponent.GetInterfaceByTypeAndGender([itConstructive], [gtFemale], biTrue); //ptrMaleInterface := AChild.GetInterfaceByTypeAndGender([itConstructive], [gtMale], biTrue); //if (ptrFemaleInterface <> nil) and (ptrMaleInterface <> nil) then //begin // CanFemaleHaveMaleRes := CanFemaleHaveMale(ptrFemaleInterface, ptrMaleInterface.ValueI,TF_Main(GForm).GSCSBase.CurrProject.CurrList.Setting.CableCanalFullnessKoef); // ShowMessageByType(Self.Handle, smtDisplay, 'Компонет "'+AComponent.Name+'" (с вместимым объемом '+FloatToStr(CanFemaleHaveMaleRes.MaxFemaleFullValue)+' см2) не может вместить в себя компонент '+ // ' "'+AChild.Name+' (с объемом '+FloatToStr(ptrMaleInterface.ValueI)+' см2).'+ #13 + // 'Замените "'+AComponent.Name+'" с объемом не меньше чем '+FloatToStr(CanFemaleHaveMaleRes.MinValueForMales)+' см2.', // 'Добавление комплектующей', MB_ICONINFORMATION or MB_OK); //end; end else Result := true; end; end; if strMessg <> '' then begin ShowMessageByType(Self.Handle, AShowMessageType, strMessg, cInputBox_Msg18_2, MB_ICONINFORMATION or MB_OK); end; ACanAdd := AddManual; end; biFalse: if GUseVisibleInterfaces then begin if Not (AChild.ComponentType.SysName = ctsnPatchCord) and GUseVisibleInterfaces then if (AShowMessageType <> smtDisplay) or (MessageModal(AText + #13 + #13 + ' '+cInputBox_Msg8_1+'?', cInputBox_Msg8_2, MB_ICONQUESTION or MB_YESNO) = IDNO) then ACanAdd := false; end; end; cntUnion: begin if AShowMessageType = smtDisplay then MessageModal(AText, cInputBox_Msg9, MB_ICONQUESTION or MB_OK); ACanAdd := false; end; end; if HaveNecessaryCompl then begin GInputFormMode := imChoiceAddCompl; GListKind := lkComponObjectData; GTreeKind := trkCatalog; GChangeInMainForm := true; //Label_Text.Caption := AText; meText.Lines.Text := AText; //GIDFindCompon := AComponent.ID; //GIDChild := AChild.ID; FComponent := AComponent; FChildComponent := AChild; if FComponent.TreeViewNode <> nil then FTopComponNode := GetTopComponNode(FComponent.TreeViewNode); GLastSelID := 0; case AConnectType of cntComplect: begin Label_ContinueQuast.Caption := cInputBox_Msg10; gbChioceAdd.Visible := true; rbAddComplWithoutInterf.Checked := true; Label_ContinueConn.Visible := false; end; cntUnion: begin rbFindComplect.Checked := true; Label_ContinueConn.Visible := true; if GUseVisibleInterfaces then Label_ContinueConn.Caption := cInputBox_Msg11_1 else Label_ContinueConn.Caption := cInputBox_Msg11_1_1; Label_ContinueQuast.Caption := cInputBox_Msg11_2; end; end; if GIsProgress then PauseProgress(true); try ModalRes := F_InputBox.ShowModal; finally if GIsProgress then PauseProgress(False); end; case ModalRes of mrYes: begin if rbAddComplWithoutInterf.Checked then ACanAdd := true else if rbFindComplect.Checked then begin if GLastSelID > 0 then begin AComponNode := Tree_Catalog.Selected; //AComponent.ID := GLastSelID; case GDBMode of bkNormBase: begin AComponent.Clear; AComponent.IDTopComponent := GetTopComponIDByNode(AComponNode); AComponent.IDCompRel := GetIDCompRelFromNode(AComponNode); AComponent.LoadComponentByID(GLastSelID, true, true, false); AComponent.TreeViewNode := AComponNode; ACanAdd := true; Result := true; end; bkProjectManager: begin AComponent := GSCSBase.CurrProject.GetComponentFromReferences(GLastSelID); if Assigned(AComponent) then begin ACanAdd := true; Result := true; end else begin ACanAdd := false; Result := false; end; end; end; end; end; end; mrNo, mrCancel: ACanAdd := false; end; end; end; end; // ##### Находит подходящие компоненты, кот-е явл. компл-ми в компоненте с AID_Component ##### // ##### для компл-й с ID_Child ##### function TF_InputBox.FindConnCompons(AComponent, AChild: TSCSComponent; AConnectType: TConnectType; AShowFinded: Boolean): Boolean; var ListItem: TListItem; ID_Comp: ^Integer; CanConnect: TCanConnectKind; //KolConInterf: Integer; SCSChild: TSCSComponent; function Search(ACompon: TSCSComponent; AStepIndex: Integer): Boolean; var //ComplIDList: TIntList; //ComplID: Integer; ChildComponents: TSCSComponents; i: Integer; SCSCompon: TSCSComponent; SCSCompl: TSCSComponent; ItemDat: PObjectData; begin Result := false; with TF_Main(GForm) do begin ChildComponents := DM.GetComponChilds(ACompon.ID, AComponent.IDTopComponent, ACompon.IDCompRel, ACompon, ''); for i := 0 to ChildComponents.Count - 1 do begin SCSCompon := ChildComponents[i]; if TF_Main(SCSCompon.ActiveForm).GDBMode = bkNormBase then begin SCSCompon.LoadComplects(AComponent.IDTopComponent, SCSCompon.IDCompRel); SCSCompon.LoadInterfaces; SCSCompon.LoadProperties; end; //if CanConnect <> cckNone then if SCSCompon.CheckComplectWith(SCSChild).CanConnect then begin case AShowFinded of true: begin //GetMem(ID_Comp, SizeOf(Integer)); //ID_Comp^ := SCSCompon.ID; NewData(ItemDat, ttComponents); ItemDat.ObjectID := SCSCompon.ID; ItemDat.ID_CompRel := SCSCompon.IDCompRel; ListItem := ListView_Compons.Items.Add; ListItem.Caption := SCSCompon.GetNameForVisible(false); ListItem.ImageIndex := GetSCSComponType(SCSCompon.IsLine); ListItem.Data := ItemDat; //ID_Comp; Result := true; end; false: begin Result := true; Exit; ///// EXIT ///// end; end; end; if Search(SCSCompon, AStepIndex+1) = true then if Not AShowFinded then begin Result := true; Exit; ///// EXIT //// end; end; FreeAndNil(ChildComponents); end; { with TF_Main(GForm) do begin ComplIDList := TF_Main(GForm).DM.GetComponentChildsID(AID_Compon); for i := 0 to ComplIDList.Count - 1 do begin ComplID := ComplIDList.Items[i]; SCSCompon := nil; case GDBMode of bkNormBase: begin SCSCompon := TSCSComponent.Create(GForm); SCSCompon.LoadComponentByID(ComplID, false); end; bkProjectManager: SCSCompon := GSCSBase.CurrProject.GetComponentFromReferences(ComplID); end; if Assigned(SCSCompon) then begin //CanConnect := CanConnComponByinterf(GFormBase, SCSCompon, SCSChild, GConnectKind, AConnectType); //if CanConnect <> cckNone then if SCSCompon.CheckComplectWith(SCSChild).CanConnect then begin case AShowFinded of true: begin GetMem(ID_Comp, SizeOf(Integer)); ID_Comp^ := ComplID; ListItem := ListView_Compons.Items.Add; ListItem.Caption := SCSCompon.GetNameForVisible(false); ListItem.ImageIndex := GetSCSComponType(SCSCompon.IsLine); ListItem.Data := ID_Comp; Result := true; end; false: begin Result := true; Exit; ///// EXIT ///// end; end; end; end; if GDBMode = bkNormBase then begin if Assigned(SCSCompon) then FreeAndNil(SCSCompon); end; if Search(ComplID) = true then if Not AShowFinded then begin Result := true; Exit; ///// EXIT //// end; end; FreeAndNil(ComplIDList); end; } end; begin Result := false; try SCSChild := nil; case TF_Main(GFormBase).GDBMode of bkNormBase: begin SCSChild := TSCSComponent.Create(GFormBase); SCSChild.Assign(AChild, false, true); //SCSChild.LoadComponentByID(AID_Child, false); end; bkProjectManager: SCSChild := TF_Main(GFormBase).GSCSBase.CurrProject.GetComponentFromReferences(AChild.ID); end; if Assigned(SCSChild) then begin Result := Search(AComponent, 0); if TF_Main(SCSChild.ActiveForm).GDBMode = bkNormBase then FreeAndNil(SCSChild); end; if ListView_Compons.Items.Count > 0 then ListView_Compons.Selected := ListView_Compons.TopItem; except on E: Exception do AddExceptionToLog('TF_InputBox.FindConnCompons: '+E.Message); end; end; // ##### Выбирает способ удаления компоненты ##### function TF_InputBox.ChoiceDelComponMode(ACoponName: String; ATextInPluralMode: Boolean=false): TDelComponMode; var ModRes: TModalResult; IsProgressActive: Boolean; begin // Tolik 01/12/2020 -- если оставить dmNone, то при закрытии формы(крестиком) получится, что вопрос вроде как и не задавался... // потом эта же форма по проверке результата ее вызова снова где-нибудь "всплывет", когда ее не ждешь... //Result := dmNone; Result := dmArea; // IsProgressActive := GetIsActiveFormProgress; // IGOR Fix CAD white screen { Фикс теперь для любых вызовов через FUpdateCountAdd в PCDrawing и через правильную очистку в BeginProgress(ACaption: String = ''; AMaxPos: Integer = -1); и в SetCADsProgressMode списка - FSCS_Main.FCADsInProgress ( if F_Progress.FPauseCount = 0 then FSCS_Main.FCADsInProgress.Clear; ) if Assigned(FSCS_Main) then if FSCS_Main.FCADsInProgress.Count = 0 then IsProgressActive := False; } /////// if IsProgressActive then PauseProgress(true); try FTextInPluralMode := ATextInPluralMode; if Not FTextInPluralMode then RadioGroup_ChoiceDelComponMode.Caption := ' '+cInputBox_Msg12 else RadioGroup_ChoiceDelComponMode.Caption := ' '+cInputBox_Msg12_2; if ACoponName <> '' then RadioGroup_ChoiceDelComponMode.Caption := RadioGroup_ChoiceDelComponMode.Caption + ' "'+ACoponName+'"'; GInputFormMode := imChoiceDelComponMode; RadioGroup_ChoiceDelComponMode.Items.Clear; if ATextInPluralMode then begin RadioGroup_ChoiceDelComponMode.Items.Add(cInputBox_Msg19_1); RadioGroup_ChoiceDelComponMode.Items.Add(cInputBox_Msg19_2); end else RadioGroup_ChoiceDelComponMode.Items.Assign(FChoiceDelComponModes); RadioGroup_ChoiceDelComponMode.ItemIndex := 1; ModRes := ShowModal; if ModRes = mrOK then begin case RadioGroup_ChoiceDelComponMode.ItemIndex of 0: Result := dmArea; 1: Result := dmTrace; end; end else if ModRes = mrCancel then Result := dmNone; finally if IsProgressActive then PauseProgress(false); end; end; procedure TF_InputBox.SelectComponentFromList(const AMessage: String; AComponents: TSCSComponents); var i: Integer; ListItem: TListItem; CurrCompon: TSCSComponent; //ptrID: ^Integer; ItemDat: PObjectData; begin ClearListView(ListView_Compons); for i := 0 to AComponents.Count - 1 do begin CurrCompon := AComponents[i]; ListItem := ListView_Compons.Items.Add; ListItem.Caption := CurrCompon.GetNameForVisible(false); ListItem.ImageIndex := -1; //GetMem(ptrID, SizeOf(Integer)); //ptrID^ := CurrCompon.ID; NewData(ItemDat, ttComponents); ItemDat.ObjectID := CurrCompon.ID; ListItem.Data := ItemDat; //ptrID; end; Label_Messg.Caption := AMessage; GInputFormMode := imListForTree; GTreeKind := trkCatalog; GChangeInMainForm := true; ListView_Compons.OnChange := ListView_ComponsChange; ShowModal; end; // ##### Создание формы ##### constructor TF_InputBox.Create(AOwner: TComponent; AForm: TForm); begin GForm := AForm; inherited Create(AOwner); end; // ##### Удаление формы ##### destructor TF_InputBox.Destroy; begin FChoiceDelComponModes.Free; inherited; end; // ############################################################################# // ############################################################################# // // ##### Создание формы ##### procedure TF_InputBox.FormCreate(Sender: TObject); begin // Tolik 24/05/2021 -- cbDelConnToPoinCable.Parent := Panel_ChoiceDelComponMode; cbDelConnToPoinCable.BringToFront; RadioGroup_ChoiceDelComponMode.Top := 7; cbDelConnToPoinCable.Top := 75; RadioGroup_ChoiceDelComponMode.Width := 360; // FComponent := nil; FChildComponent := nil; FTopComponNode := nil; FIsSelectionItem := false; FChoiceDelComponModes := TStringList.Create; FChoiceDelComponModes.Assign(RadioGroup_ChoiceDelComponMode.Items); {Panel_InputText.Align := alClient; Panel_ChoiceAddCompl.Align := alClient; Panel_ComponList.Align := alClient; } end; // ##### Показать форму ##### procedure TF_InputBox.FormShow(Sender: TObject); var cxCustomEdit: TcxCustomEdit; begin GWasFindConnCompon := false; Panel_InputText.Visible := false; Panel_ChoiceAddCompl.Visible := false; Panel_ComponList.Visible := false; Panel_ChoiceDelComponMode.Visible := false; cbDelConnToPoinCable.Visible := false; // Tolik 24/05/2021 -- case GInputFormMode of imInputText, imInputFloat, imInputCombo: begin Panel_InputText.Visible := true; cxCustomEdit := nil; edText.Visible := false; seValue.Visible := false; cbValue.Visible := false; case GInputFormMode of imInputText: cxCustomEdit := edText; imInputFloat: cxCustomEdit := seValue; imInputCombo: cxCustomEdit := cbValue; end; if cxCustomEdit <> nil then begin cxCustomEdit.Visible := true; cxCustomEdit.SetFocus; end; FormView(150, 257); end; imChoiceAddCompl: begin Caption := cInputBox_Msg13_1; Panel_ChoiceAddCompl.Visible := true; //RadioGroup_ChioceAdd.ItemIndex := 0; {Button_OK.Left := 64; Button_Canxel.Left := 240;} FormView(230, 385); end; imListForTree: begin //Caption := 'Удаление невозможно'; Panel_ComponList.Visible := true; Panel_ComponList.Top := 0; Panel_ComponList.Left := 0; FormView(290+30, 377); //FormView(290, 377); ListView_Compons.SetFocus; Act_Close.Visible := true; Act_Back.Visible := false; btSkip.Visible := ibSkip in FButtons; btSkipAll.Visible := ibSkipAll in FButtons; Button_CancelChoice.Visible := ibCancel in FButtons; Button_Close.ModalResult := mrOk; Button_Close.Cancel := Not FIsSelectionItem; if ListView_Compons.Selected = nil then begin GLastSelID := 0; ListView_Compons.HideSelection := Not FIsSelectionItem; end; if FIsSelectionItem then begin if ListView_Compons.Selected = nil then if ListView_Compons.Items.Count > 0 then ListView_Compons.Selected := ListView_Compons.Items[0]; Act_Close.Caption := cInputBox_Msg17; end else begin Act_Close.Caption := cInputBox_Msg14; end; end; imChoiceDelComponMode: begin if Not FTextInPluralMode then Caption := cInputBox_Msg13_2 else Caption := cInputBox_Msg13_3; Panel_ChoiceDelComponMode.Visible := true; Panel_ChoiceDelComponMode.Height := 180; Panel_ChoiceDelComponMode.Width := 380; //Tolik 24/05/2021 -- //FormView(157, 350); FormView(157, 381); //cbDelConnToPoinCable.Visible := True; cbDelConnToPoinCable.Visible := CheckHasCadSelectedPoints; // end; end; tbObjectList.Visible := GTreeKind = trkCatalog; Act_Properties.Visible := tbObjectList.Visible; pnComponButtonsResize(pnComponButtons); end; procedure TF_InputBox.FormHide(Sender: TObject); var i: Integer; ListItem: TListItem; begin case GInputFormMode of imChoiceAddCompl: begin Act_Close.Caption := cInputBox_Msg14; Act_Back.Visible := false; Button_CancelChoice.Visible := false; end; end; //*** Очистка списка компонентов if GListKind <> lkComponID then for i := 0 to ListView_Compons.Items.Count - 1 do begin ListItem := ListView_Compons.Items[i]; if GListKind = lkComponComplect then FreeAndNil(PItemListData(ListItem.Data).Complects); FreeMem(ListItem.Data); end; ListView_Compons.Items.BeginUpdate; try ListView_Compons.Items.Clear; finally ListView_Compons.Items.EndUpdate; end; Label_Messg.Caption := ''; ListView_Compons.OnChange := ListView_ComponsChange; end; // ##### Изменение RadioGroup_ChioceAdd ##### procedure TF_InputBox.RadioGroup_ChioceAddPropertiesChange( Sender: TObject); begin if rbAddComplWithoutInterf.Checked then Button_Yes.Caption := cInputBox_Msg15_1 else Button_Yes.Caption := cInputBox_Msg15_2; end; // ##### Был нажат "Да" ##### procedure TF_InputBox.Act_YesClickExecute(Sender: TObject); begin if rbAddComplWithoutInterf.Checked then ModalResult := mrYes else if rbFindComplect.Checked then begin //*** Найти комплектующие if Not GWasFindConnCompon then begin GLastSelID := 0; FindConnCompons(FComponent, FChildComponent, GConnectType, true); GWasFindConnCompon := true; if ListView_Compons.Items.Count = 0 then Label_Messg.Caption := cInputBox_Msg16_1 else Label_Messg.Caption := cInputBox_Msg16_2; end; //*** Отобразить панель со списком компонентов if ListView_Compons.Items.Count > 0 then begin Panel_ChoiceAddCompl.Visible := false; Panel_ComponList.Visible := true; Act_Close.Caption := cInputBox_Msg17; Act_Back.Visible := true; Button_CancelChoice.Visible := true; FormView(Panel_ComponList.Height + 30, Panel_ComponList.Width); Update; ListView_Compons.SetFocus; FIsSelectionItem := true; pnComponButtonsResize(pnComponButtons); end else begin if GUseVisibleInterfaces then MessageModal(cInputBox_Msg18_1, cInputBox_Msg18_2, MB_ICONQUESTION or MB_OK) else MessageModal(cInputBox_Msg18_1_1, cInputBox_Msg18_2, MB_ICONQUESTION or MB_OK); end; end; end; // ##### Нажат "Закрыть (Выбрать)" ##### procedure TF_InputBox.Act_CloseExecute(Sender: TObject); //var // CanClose: Boolean; begin //CanClose := true; if GInputFormMode = imChoiceAddCompl then ModalResult := mrYes; if GInputFormMode = imListForTree then begin ModalResult := mrOk; if FIsSelectionItem then if GLastSelID = 0 then begin ModalResult := mrNone; //CanClose := false; MessageModal(cInputBox_Msg20, ApplicationName, MB_ICONINFORMATION or MB_OK); end; end; if Not (fsModal in FormState) then Close; //if CanClose then // Close; end; // ##### Нажат "Назад" ##### procedure TF_InputBox.Act_BackExecute(Sender: TObject); begin FormView(Panel_ChoiceAddCompl.Height + 20, Panel_ChoiceAddCompl.Width); Panel_ComponList.Visible := false; Panel_ChoiceAddCompl.Visible := true; end; // ############################# Обработка списка ############################ // ############################################################################# // // ##### Отпущена кнопка мыши со списка ##### procedure TF_InputBox.ListView_ComponsMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin ShowComplectsHint; end; // ##### Движение мышкой по списку ##### procedure TF_InputBox.ListView_ComponsMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin ShowComplectsHint; end; // ##### Изменение текущей позиции в списке ##### procedure TF_InputBox.ListView_ComponsChange(Sender: TObject; Item: TListItem; Change: TItemChange); begin //GDragPrevTickCount := GetTickCount; GotoOnTree; //GDragCurrTickCount := GetTickCount - GDragPrevTickCount; //GDragCurrTickCount := GetTickCount - GDragPrevTickCount; //MessageModal(Self.Handle, PChar(IntToStr(GetTickCount - GDragPrevTickCount)), '', MB_OK); //GDragPrevTickCount := GetTickCount; //Beep; end; procedure TF_InputBox.Button_CancelChoiceClick(Sender: TObject); begin //beep; end; procedure TF_InputBox.Act_PropertiesExecute(Sender: TObject); begin if GLastSelID <> 0 then TF_Main(GForm).ShowCurrComponProperties; end; procedure TF_InputBox.btSkipClick(Sender: TObject); begin ModalResult := mrIgnore; end; procedure TF_InputBox.pnComponButtonsResize(Sender: TObject); begin SetMiddleControlChilds(TControl(Sender), TControl(Self)); end; procedure TF_InputBox.btSkipAllClick(Sender: TObject); begin ModalResult := mrSkipAll; end; procedure TF_InputBox.ListView_ComponsDblClick(Sender: TObject); begin Act_Properties.Execute; end; end.