unit U_EndPoints; interface uses Windows, U_LNG, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, cxLookAndFeelPainters, StdCtrls, cxButtons, ComCtrls, cxControls, cxContainer, cxEdit, cxLabel, ImgList, U_ESCadClasess, siComp, siLngLnk, ExtCtrls, RzPanel, cxRadioGroup, PowerCad, PCDrawing, U_Cad, {Tolik 22/03/2018}cxClasses, cxGraphics, cxLookAndFeels, Menus; type TF_EndPoints = class(TForm) cxLabel1: TcxLabel; bOK: TcxButton; bCancel: TcxButton; ImageList1: TImageList; lng_Forms: TsiLangLinked; RzPanel1: TRzPanel; ScrollBox1: TScrollBox; ScrollBox2: TScrollBox; lvCadLists: TListView; lvEndPoints: TListView; sp: TSplitter; RzPanel2: TRzPanel; cbBoxes: TcxRadioButton; cbAllRM: TcxRadioButton; procedure lvEndPointsSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean); procedure lvCadListsSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean); procedure cbBoxesClick(Sender: TObject); procedure cbAllRMClick(Sender: TObject); procedure FormShow(Sender: TObject); private { Private declarations } public { Public declarations } function Execute: Boolean; procedure LoadEndPointsByList(aCad: TF_CAD); end; var F_EndPoints: TF_EndPoints; implementation uses USCS_Main, U_Common, U_BaseCommon, U_SCSComponent, U_Constants, U_Main; {$R *.dfm} { TF_EndPoints } function TF_EndPoints.Execute: Boolean; var i: integer; Item, ItemList, ItemObject: TListItem; FList: TF_CAD; EndPointsList: TList; ptrObjectParams: PObjectParams; ID: Integer; EndPoint: TConnectorObject; begin try Result := False; lvCadLists.Items.Clear; // заполнить листы for i := 0 to FSCS_Main.MDIChildCount - 1 do begin FList := TF_CAD(FSCS_Main.MDIChildren[i]); if FList.FListType = lt_Normal then // Tolik 09/11/2021 -- отфильтровать только нормальные листы проекта begin Item := lvCadLists.Items.Add; Item.Caption := FList.FCADListName + ' ' + IntToStr(FList.FCADListIndex); Item.Data := FList; Item.ImageIndex := 0; if i = 0 then begin Item.Selected := True; // заполнить объекты данного листа LoadEndPointsByList(FList); end else begin Item.Selected := False; end; end; end; if GRackToRack then begin cbAllRM.Enabled := False; cbBoxes.Checked := True; end else cbAllRM.Enabled := True; // обработать выбранный Объект //Tolik 27/09/2021 -- Try if GIsProgress then begin PauseProgress(True); end; // if ShowModal = mrOK then begin ItemList := lvCadLists.Selected; ItemObject := lvEndPoints.Selected; FList := TF_CAD(ItemList.Data); ID := PObjectParams(ItemObject.Data).ID; EndPoint := TConnectorObject(GetFigureByID(FList, ID)); if EndPoint <> nil then begin //Tolik 17/08/2021 -- if GRackToRack then begin EndPoint.Select; if TF_CAD(EndPoint.Owner.Owner).FCADListID = TF_Cad(GPopupFigure.Owner.Owner).FCADListID then begin //if Assigned(EndPoint.Owner) then TPCDrawing(EndPoint.Owner).RefreshSelection; if F_ProjMan.GSCSBase.CurrProject.Setting.FirstTraceCreated then SetUserLineHeightForAllProj; FSCS_Main.Act_ConnectSelectedPointsExecute(nil); GCadForm.PCad.Refresh; end; end; // EndPoint.AsEndPoint := True; // сбросить бывший КО if GEndPoint <> nil then begin TConnectorObject(GEndPoint).AsEndPoint := False; if (GListWithEndPoint <> FList) and (GListWithEndPoint <> nil) then begin RefreshCAD(GListWithEndPoint.PCad); end; GListWithEndPoint := Nil; end; RefreshCAD(FList.PCad); FList.mProtocol.Lines.Add(cEndPoints_Mes1 + EndPoint.Name + cEndPoints_Mes2); // переназначить новый GEndPoint := EndPoint; GListWithEndPoint := FList; Result := True; end; end; Finally if GIsProgress then PauseProgress(false); End; except on E: Exception do AddExceptionToLogEx('TF_EndPoints.Execute', E.Message); end; GCadForm.PCad.Refresh; end; procedure TF_EndPoints.FormShow(Sender: TObject); begin //F_EndPoints.TabOrder := 1; bok.SetFocus; end; procedure TF_EndPoints.LoadEndPointsByList(aCad: TF_CAD); var i: Integer; Item: TListItem; EndPointsList: TList; ptrObjectParams: PObjectParams; ID: Integer; EndPoint: TConnectorObject; begin try lvEndPoints.Items.Clear; EndPointsList := GetEndPointParamsFromList(aCad.FCADListID, cbBoxes.Checked); //Tolik 17/08/2021 -- если шкаф к шкафу - исключить первый шкаф(который хотим подключить к другому шкафу) //из списков if EndPointsList.Count > 0 then begin if GRackToRack then begin if GPopupFigure <> nil then begin for i := EndPointsList.Count - 1 downto 0 do begin ptrObjectParams := EndPointsList[i]; if ptrObjectParams.Id = GPopupfigure.ID then begin EndPointsList.delete(i); FreeMem(ptrObjectParams, SizeOf(TObjectParams)); end; end; end; end; end; // for i := 0 to EndPointsList.Count - 1 do begin ptrObjectParams := EndPointsList[i]; Item := lvEndPoints.Items.Add; Item.Caption := ptrObjectParams.Caption; Item.Data := ptrObjectParams; Item.ImageIndex := 0; if i = 0 then Item.Selected := True else Item.Selected := False; end; if EndPointsList.Count > 0 then bOK.Enabled := True else bOK.Enabled := False; //Tolik 17/08/2021 -- утечка памяти //FreeAndNil(EndPointsList); FreeList(EndPointsList); // except on E: Exception do AddExceptionToLogEx('TF_EndPoints.LoadEndPointsByList', E.Message); end; end; procedure TF_EndPoints.lvEndPointsSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean); var ID: Integer; EndPoint: TConnectorObject; begin try if Selected then begin Item.ImageIndex := 1; // ID := PObjectParams(Item.Data).ID; // EndPoint := TConnectorObject(GetFigureByID(GCadForm, ID)); // if EndPoint <> nil then // begin // EndPoint.Select; // ShowObjectInPM(EndPoint.ID, EndPoint.Name); // end; end else begin Item.ImageIndex := 0; end; except on E: Exception do AddExceptionToLogEx('TF_EndPoints.lvEndPointsSelectItem', E.Message); end; end; procedure TF_EndPoints.lvCadListsSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean); var Cad: TF_CAD; begin try if Selected then begin Item.ImageIndex := 1; Cad := TF_CAD(Item.Data); LoadEndPointsByList(Cad); end else begin Item.ImageIndex := 0; end; except on E: Exception do AddExceptionToLogEx('TF_EndPoints.lvCadListsSelectItem', E.Message); end; end; procedure TF_EndPoints.cbBoxesClick(Sender: TObject); var Item: TListItem; FList: TF_CAD; begin try Item := lvCadLists.Selected; FList := TF_CAD(Item.Data); LoadEndPointsByList(FList); except on E: Exception do AddExceptionToLogEx('TF_EndPoints.cbBoxesClick', E.Message); end; end; procedure TF_EndPoints.cbAllRMClick(Sender: TObject); var Item: TListItem; FList: TF_CAD; begin try Item := lvCadLists.Selected; FList := TF_CAD(Item.Data); LoadEndPointsByList(FList); except on E: Exception do AddExceptionToLogEx('TF_EndPoints.cbAllRMClick', E.Message); end; end; end.