unit U_Master_compl; interface uses U_SCSLists, U_SCSComponent, U_BaseCommon, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage, cxEdit, DB, cxDBData, cxGridLevel, cxClasses, cxControls, cxGridCustomView, cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxGrid, RzPanel, RzSplit, StdCtrls, Buttons, cxContainer, cxTextEdit, cxMaskEdit, cxSpinEdit, ComCtrls, ExtCtrls, ToolWin, kbmMemTable, cxCheckBox, cxCurrencyEdit, cxColorComboBox, exgrid, RapTree, FlytreePro, ImgList, ActnList,{ dbftreepro}dbftree, Menus, cxMemo, U_ParamMasterCompl, U_MasterComplCommon, U_Main, U_CAD, PCTypesUtils, PCPanel, PCDrawBox, PCDrawing, PowerCad, cxLookAndFeelPainters, cxLookAndFeels, cxNavigator, XPMenu, siComp, siLngLnk, cxButtons{, XPMenu}, U_BaseConstants, cxDBLookupComboBox; type TF_MasterCompl = class(TForm) ImageList1: TImageList; ActionList1: TActionList; act_AddCompl: TAction; act_CompCompl: TAction; act_DelCompl: TAction; act_ClickOK: TAction; act_ClickCancel: TAction; CatalogPopupMenu1: TPopupMenu; Action11: TMenuItem; ComplectPopupMenu1: TPopupMenu; actDelCompl1: TMenuItem; actCompCompl1: TMenuItem; act_DblClick: TAction; Property_MemTable: TkbmMemTable; DataSource_Property: TDataSource; RzSizePanel2: TRzSizePanel; RzSizePanel3: TRzSizePanel; Panel3: TPanel; RzSizePanel1: TRzSizePanel; ToolBar_Compl: TToolBar; ToolButton1: TToolButton; ToolButton2: TToolButton; ToolButton3: TToolButton; tvComplect: TFlyTreeViewPro; Panel2: TPanel; Label_Kolvo: TLabel; SpinEdit_Kolvo: TcxSpinEdit; Panel_Grid: TPanel; Propertyes_Grid: TcxGrid; GT_Propertyes: TcxGridDBTableView; Propertys_GridName: TcxGridDBColumn; Propertys_GridValue: TcxGridDBColumn; Propertys_GridIzm: TcxGridDBColumn; Propertys_GridTakeIntoConnect: TcxGridDBColumn; Propertys_GridTakeIntoJoin: TcxGridDBColumn; GT_PropertyesDESCRIPTION: TcxGridDBColumn; Propertys_GridID_DATA_TYPE: TcxGridDBColumn; Propertyes_SysName: TcxGridDBColumn; Propertyes_GridLevel1: TcxGridLevel; Panel1: TPanel; tvCatalog: TFlyTreeViewPro; Shelf_Cad: TPowerCad; BitBtn1: TcxButton; BitBtn2: TcxButton; lng_Forms: TsiLangLinked; procedure act_AddComplExecute(Sender: TObject); procedure act_DelComplExecute(Sender: TObject); procedure act_ClickOKExecute(Sender: TObject); procedure act_ClickCancelExecute(Sender: TObject); procedure act_CompComplExecute(Sender: TObject); function CheckChildComplects(Acompon: TSCSComponent): boolean; procedure act_DblClickExecute(Sender: TObject); procedure tvComplectChange(Sender: TObject; Node: TFlyNode); procedure GT_PropertyesDblClick(Sender: TObject); procedure Propertys_GridValueGetDisplayText( Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); procedure Shelf_CadSurfaceDragOver(Sender, Source: TObject; X, Y: Double; State: TDragState; var Accept: Boolean); procedure Shelf_CadSurfaceDragDrop(Sender, Source: TObject; X, Y: Double); procedure tvCatalogDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure FormShow(Sender: TObject); procedure RzSizePanel2Resize(Sender: TObject); procedure BitBtn1Click(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure FormResize(Sender: TObject); private { Private declarations } // Property_MemTable: TkbmMemTable; OldComplectsIdCompRel: TIntList; // CadFormFromBox: TF_CadNB; procedure AddItems(ANode: TFlyNode; AItemsCompon: TSCSComponent); procedure ShowGrid; procedure HideGrid; procedure ShowPropertyesGrid(AComponent: TSCSComponent) ; procedure AddEditProperty(AMakeEdit: TMakeEdit); //procedure FreeBaseTree_CatalogDblClick(Sender: TObject); public WithOutParam: boolean; ListCompon: tSCSComponents; SelectNode: TTreeNode; ComponForCompl: TSCSComponent; ParamSelect: T_ParamSelect; F_FreeNormBase: TF_Main; //Tolik -- 11/11/2017 FCadClose: Boolean; // procedure InitFreeNormBase; procedure InitTreeComplect; Procedure InitDesignList; procedure BuildTree; //построитель дерева { Public declarations } constructor Create(AOwner: TComponent); function BuildSQLText(ACompon: TSCSComponent; AListBusyInters: TIntList): string; function GetCheckedComponForCompl (AGlCompon: TSCSComponent; AListCompon: TSCSComponents): TSCSComponents; // Tolik -- 29/03/2017 -- // перемещать КАД в режиме паноромирования Procedure MoveCADOnPan(ADeltaX, ADeltaY: double); // //procedure ShowPropertyesGrid(AComponent: TSCSComponent) ; end; const StrWithOutInterfaces: String = 'StrWithOutInterfaces'; //var // F_MasterCompl: TF_MasterCompl; procedure NewComponNodeData(ATreeNode: TFlyNode; ACompon: TSCSComponent); procedure NewCatalogNodeData(ATreeNode: TFlyNode; AIDCat: integer ); Function GetConnectedInterfacesOfChild(AParentInters: TSCSInterfaces; AIdCompRel: integer): TIntList; Function ComponsFromIds(AListId: TIntList):TSCSComponents; implementation uses Unit_DM_SCS, fplan, U_ESCadClasess, U_Common, Contnrs, DrawObjects, U_MakeEditPropRel{Tolik 18/03/2017 }, USCS_Main; {$R *.dfm} //-------------------------------------------------------------- procedure TF_MasterCompl.AddItems(ANode: TFlyNode; AItemsCompon: TSCSComponent); var KolSubComplect, i, Kol: integer; ChildCompon: TSCSComponent; Str: String; Node: TFlyNode; begin KolSubComplect := AItemsCompon.ChildComplects.Count; F_NormBase.DM.UpdateCompRelFieldAsInteger(AItemsCompon.IDCompRel, KolSubComplect, fnKolSubComplect); Kol := F_NormBase.DM.GetIntFromTableByID(tnComponentRelation, fnKolvo, AItemsCompon.IDCompRel, qmPhisical); Str := AItemsCompon.Name; if Kol > 1 then Str := Str + ' x ' + IntToStr(Kol); Node := tvComplect.Items.AddChild(ANode, Str); NewComponNodeData(Node, AItemsCompon); for i := 0 to KolSubComplect - 1 do begin AddItems(Node, AItemsCompon.ChildComplects[i]); end; end; //-------------------------------------------------------------- Function GetConnectedInterfacesOfChild(AParentInters: TSCSInterfaces; AIdCompRel: integer): TIntList; var j,i: integer; SCSIOfIRel: TSCSIOfIRel; begin Result := Nil; for i := 0 to AParentInters.Count - 1 do begin for j := 0 to AParentInters[i].IOfIRelOut.Count - 1 do begin SCSIOfIRel := TSCSIOfIRel(AParentInters[i].IOfIRelOut[j]); if SCSIOfIRel.IDCompRel = AIdCompRel then begin if Result = Nil then Result := TIntList.Create; Result.Add(SCSIOfIRel.IDInterfTo); end; end; end; end; Function ComponsFromIds(AListId: TIntList):TSCSComponents; var i: integer; Compon: TSCSComponent; begin Result := Nil; if Assigned(AListId) then begin for i := 0 to AListId.Count - 1 do begin If Result = Nil then Result := TSCSComponents.Create(true); Compon := TSCSComponent.Create(F_NormBase); Compon.LoadComponentByID(AListId[i]); Compon.LoadInterfaces; Compon.LoadProperties; Result.Add(compon); end; end; end; function TF_MasterCompl.BuildSQLText(ACompon: TSCSComponent; AListBusyInters: TIntList): string; var i,j: integer; ListOfIdKonstrInterf: TSCSInterfaces; Interf, operInterf: TSCSInterface; Inters: TSCSInterfaces; FBusyInterf, FExit: Boolean; IDTabu: integer; NewInterf: boolean; begin IDTabu := ACompon.IDTopComponent; Result := ''; Fexit := false; ACompon.LoadInterfaces(-1, true); ListOfIdKonstrInterf := TSCSInterfaces.Create(False); try Inters := ACompon.Interfaces; for i := 0 to Inters.Count - 1 do begin Interf := Inters[i]; if (Interf.TypeI = 1)and (Interf.Multiple = 0) and (Interf.IsBusy = biFalse) then begin FBusyInterf := false; if AListBusyInters <> Nil then for j := 0 to AListBusyInters.Count - 1 do begin FBusyInterf := false; if Interf.ID = AListBusyInters[j] then begin FBusyInterf := true; break; end; end; if Not FBusyInterf then begin NewInterf := True; for j := 0 to ListOfIdKonstrInterf.Count - 1 do begin operInterf := ListOfIdKonstrInterf[j]; if (operInterf.ID_Interface = Interf.ID_Interface) and (operInterf.SideSection = Interf.SideSection) then begin NewInterf := false ; end; end; if NewInterf then begin ListOfIdKonstrInterf.Add(Interf); end; end; end; end; If ListOfIdKonstrInterf.Count = 0 then begin EndProgress; if MessageModal(cMasterCompl_Msg1, cMasterCompl_Msg2, MB_ICONQUESTION or MB_YESNO) = IDYes then begin //ParamSelect.ByInterfaces := false; if not ParamSelect.ByProducer then Result := StrWithOutInterfaces; BeginProgress(); end else FExit := true ; end; if not (Result = StrWithOutInterfaces) then begin Result := 'IsLine = ' + IntToStr(ACompon.IsLine) +' and id_component_type not in (' + IntToStr( F_NormBase.DM.GetIntFromTableByGUID(tnComponentTypes, fnID,'{A1E3766B-4306-4825-AAA8-7385321233EC}', qmPhisical)) + ', ' + IntToStr( F_NormBase.DM.GetIntFromTableByGUID(tnComponentTypes, fnID,'{6C5D9FFE-8F99-49A0-BDB6-F59A778B9C03}', qmPhisical)) + ', ' + IntToStr(ACompon.ComponentType.ID) + ')'; if ParamSelect.ByProducer then begin Result := Result + ' and id_producer = '+ IntToStr(ACompon.ID_Producer); end; if ParamSelect.ByInterfaces then If Assigned(ListOfIdKonstrInterf) then if ListOfIdKonstrInterf.Count > 0 then begin Result := Result + ' and id in (select id_component from interface_relation where '; for i := 0 to ListOfIdKonstrInterf.Count - 1 do begin if i > 0 then Result := Result + ' or '; Result := Result + '(id_interface = ' + IntToStr(ListOfIdKonstrInterf[i].ID_Interface) + ' and ' + 'side_section = ''' + ListOfIdKonstrInterf[i].SideSection + ''')'; end; Result := Result + ')'; end; end; // if Not FExit then // begin // if ComponForCompl.ComponentType.SysName <> ctsnCupboard then // Result := 'id_producer = '+ IntToStr(ACompon.ID_Producer) + 'and '; // Result := Result + 'isLine =' + IntToStr(ACompon.IsLine) + 'and id_component_type not in (36,1,32, 33, ' // + IntToStr(ACompon.ID_ComponentType) + ')' // + ' and (id <> ' + IntToStr(IDTabu) + ')'; // if ListOfIdKonstrInterf.Count > 0 then // begin // Result := Result + ' and id in (select id_component from interface_relation where id_interface in ('; // for i := 0 to ListOfIdKonstrInterf.Count - 2 do // begin // Result := Result + IntToStr(ListOfIdKonstrInterf[i]) + ', ' ; // end; // Result := Result + IntToStr(ListOfIdKonstrInterf[ListOfIdKonstrInterf.Count - 1]) + '))'; // end; // end finally ListOfIdKonstrInterf.Free; end; end; procedure NewCatalogNodeData(ATreeNode: TFlyNode; AIDCat: integer ); var ComplDat: PObjectData; begin NewData(ComplDat, ttComponents); ComplDat.ObjectID := AIDCat; ComplDat.ID_CompRel := 0; ComplDat.ItemType := itDir ; ComplDat.ChildNodesCount := 0; ComplDat.QueryMode := qmPhisical; ComplDat.ComponKind := TComponKind(ckNone); if ATreeNode.Tree <> nil then ComplDat.SortID := TFlyNode(ATreeNode.Tree).Count-1 else ComplDat.SortID := 0; ComplDat.Expanded := false; ComplDat.NBMode := nbmNorm; ComplDat.ListID := 0; ATreeNode.ImageIndex := tciiDir; ATreeNode.SelectedIndex := ATreeNode.ImageIndex; ATreeNode.Data := ComplDat; end; procedure NewComponNodeData(ATreeNode: TFlyNode; ACompon: TSCSComponent); var ComplDat: PObjectData; begin NewData(ComplDat, ttComponents); ComplDat.ObjectID := ACompon.ID; ComplDat.ID_CompRel := 0; if ACompon.IsLine = 1 then ComplDat.ItemType := itComponLine else ComplDat.ItemType := itComponCon; ComplDat.ChildNodesCount := 0; ComplDat.QueryMode := qmPhisical; ComplDat.ComponKind := ckCompon; ComplDat.ID_CompRel := ACompon.IDCompRel; if ATreeNode.Tree <> nil then ComplDat.SortID := TFlyNodes(ATreeNode.Tree).Count-1 else ComplDat.SortID := 0; ComplDat.Expanded := false; ComplDat.NBMode := nbmNorm; ComplDat.ListID := 0; if ComplDat.ItemType = itComponCon then ATreeNode.ImageIndex := tciiComponCon else if ComplDat.ItemType = itComponLine then ATreeNode.ImageIndex := tciiComponLine; ATreeNode.SelectedIndex := ATreeNode.ImageIndex; ATreeNode.Data := ComplDat; end; constructor TF_MasterCompl.Create(AOwner: TComponent); var i: integer; begin // Tolik FCadClose := False; // OldComplectsIdCompRel := Nil; ListCompon := Nil; SelectNode := Nil; ComponForCompl := Nil; // CadFormFromBox := Nil; inherited Create(AOwner); //Property_MemTable := F_NormBase.DM.MemTable_Property; // Property_MemTable.FieldDefs.Assign(F_NormBase.DM.MemTable_Property); for i := 0 to F_NormBase.DM.MemTable_Property.FieldDefs.Count - 1 do Property_MemTable.FieldDefs.Add(F_NormBase.DM.MemTable_Property.FieldDefs[i].Name, F_NormBase.DM.MemTable_Property.FieldDefs[i].DataType, F_NormBase.DM.MemTable_Property.FieldDefs[i].Size); //WithOutInterfaces := False; tvCatalog.Images.Clear; tvCatalog.Images.AddImages(F_NormBase.DM.ImageList_Dir); tvCatalog.Items.Clear; tvComplect.Images.Clear; tvComplect.Images.AddImages(F_NormBase.DM.ImageList_Dir); tvComplect.Items.Clear; // tvCatalog.Columns[0].Width := tvCatalog.Width; GT_Propertyes.DataController.DataSource := DataSource_Property; Propertys_GridValue.OnGetProperties := F_NormBase.GT_PROPERTYVALUEGetProperties; end; procedure TF_MasterCompl.BuildTree; var IComp,i, j : integer; idCatalog: integer; OperListId, ListIdCatalog: TIntList; NewComponNode, ParentNode, NewNode: TFlyNode; ComplectNode: TFlyNode; TextNode: string; ListOfLevelTree, ListOfFlyNode: TObjectList; Function GetParentCatalogIds(AIdComponent: integer): TIntList; var IdList: TIntList; CurrID: integer; begin F_NormBase.DM.Query_Select.Close; IdList := TIntList.Create; CurrID := F_NormBase.DM.GetComponCatalogOwnerID(AIdComponent); F_NormBase.DM.Query_Select.Close; SetSQLToFIBQuery(F_NormBase.DM.Query_Select, GetSQLByParams(qtSelect, tnCatalog, fnID+' = :'+ fnID, nil, fnParentID), false); while CurrID > 0 do begin IDList.Insert(0, CurrID); F_NormBase.DM.Query_Select.Close; F_NormBase.DM.Query_Select.ParamByName(fnID).AsInteger := CurrID; F_NormBase.DM.Query_Select.ExecQuery; CurrID := 0; if F_NormBase.DM.Query_Select.RecordCount > 0 then CurrID := F_NormBase.DM.Query_Select.Fields[0].AsInteger; end; Result := IdList; end; function GetNeedPosition (AObjectId: integer; ALevel: integer; AParent : TFlyNode): TFlyNode; var OperList: tObjectList; CurrNode, OperNode, NewNode: TFlyNode; N: integer; WasCreated: boolean; begin Result := Nil; WasCreated := false; if ListOfLevelTree = Nil then ListOfLevelTree := TObjectList.Create(true); if ListOfLevelTree.Count - 1 < ALevel then begin OperList := TObjectList.Create(true); TextNode := F_NormBase.DM.GetStringFromTableByID(tnCatalog, fnName, AObjectId, qmPhisical); if ALevel = 0 then CurrNode := tvCatalog.Items.Add(nil, TextNode) else CurrNode := tvCatalog.Items.AddChild(AParent, TextNode); NewCatalogNodeData(CurrNode, AObjectID); Result := CurrNode; OperList.Add(CurrNode); ListOfLevelTree.Add(OperList); end else if ListOfLevelTree.Count - 1 >= ALevel then begin For n := 0 to TObjectList(ListOfLevelTree[ALevel]).Count - 1 do begin OperNode := TFlyNode(TObjectList(ListOfLevelTree[ALevel]).Items[n]); if AObjectId = PObjectData(OperNode.Data).ObjectID then begin WasCreated := true; Result := OperNode; break; end; end; if WasCreated = false then begin TextNode := F_NormBase.DM.GetStringFromTableByID(tnCatalog, fnName, AObjectId, qmPhisical); CurrNode := tvCatalog.Items.AddChild(AParent, TextNode); NewCatalogNodeData(CurrNode, AObjectId); Result := CurrNode; TObjectList(ListOfLevelTree[ALevel]).Add(CurrNode); end; end end; begin ListOfLevelTree := nil; //*********************** if Assigned(ListCompon) then begin for IComp := 0 to ListCompon.Count - 1 do begin ParentNode := Nil; OperListId := GetParentCatalogIds(ListCompon[IComp].id); for i := 0 to OperListId.Count - 1 do begin Application.ProcessMessages; ParentNode := GetNeedPosition(OperListId[i], i, ParentNode); end; OperListId.Free; NewComponNode := tvCatalog.Items.AddChild(ParentNode, ListCompon[Icomp].Name); NewComponNodeData(NewComponNode, ListCompon[Icomp]); end; if ListCompon.Count > 0 then tvCatalog.GetFirstVisibleNode.Expand(false); end; //Инициализация дерева комплектующих InitTreeComplect; //if ComponForCompl <> Nil then // begin // ComplectNode := tvComplect.Items.Add(Nil, ComponForCompl.Name); // NewComponNodeData(ComplectNode, ComponForCompl); // For j := 0 to ComponForCompl.ChildComplects.Count - 1 do // AddItems(ComplectNode, ComponForCompl.ChildComplects[j]); // For j := 0 to ComponForCompl.ChildReferences.Count - 1 do // begin // if OldComplectsIdCompRel = Nil then // OldComplectsIdCompRel := TIntList.Create; // OldComplectsIdCompRel.Add(ComponForCompl.ChildReferences[j].IDCompRel); // end; // ComplectNode.Expand(true); // end; end; procedure TF_MasterCompl.act_AddComplExecute(Sender: TObject); var Complect: TSCSComponent; ComponNode, ComplectNode: TFlyNode; Kolvo, KolKompl: integer; IdCompRel, i: integer; ConnectInterfRes: TConnectInterfRes; ParentCatalog: TSCSCatalog; ParentCatalogID: integer; Data: pObjectData; procedure ClearChildFromComplect(ACompon: TSCSComponent); var i: integer; begin Acompon.LoadChildComplectsQuick(true, false, false, ComponForCompl.IDTopComponent, ACompon.IDCompRel); For i := 0 to ACompon.ChildComplects.Count -1 do begin F_NormBase.DelComplect(ACompon.ChildComplects[i].IDCompRel, ComponForCompl.IDTopComponent, ACompon.ID, ACompon.ChildComplects[i].ID, ComponForCompl.TreeViewNode, cntComplect); end; if Assigned(ACompon.TreeViewNode) then begin if Assigned(ACompon.TreeViewNode.data) then begin Pobjectdata(ACompon.TreeViewNode.data).ChildNodesCount := 0; end; end; end; begin Try Kolvo := SpinEdit_Kolvo.Value; IdCompRel := 0; KolKompl := 0; Data := Nil; if Sender = tvCatalog then begin data := pObjectData(tvCatalog.Selected.Data); end; if Assigned(F_FreeNormBase) then begin if Sender = F_FreeNormBase.Tree_Catalog then begin Data := pObjectData(F_FreeNormBase.Tree_Catalog.Selected.Data); end; end; if Data = Nil then begin if Assigned(F_FreeNormBase) then begin Data := pObjectData(F_FreeNormBase.Tree_Catalog.Selected.Data); end else begin Data := pObjectData(tvCatalog.Selected.Data); end; end; if Data <> Nil then begin if Data.ItemType <> itDir then begin if data.ObjectID = ComponForCompl.ID then exit; tvComplect.Items.BeginUpdate; Complect := TSCSComponent.Create(F_NormBase); ComponNode := tvComplect.Items.GetFirstNode; if ComponNode.Expanded then ComponNode.Collapse(false); Complect.LoadComponentByID(Data.ObjectID); // Complect.KolComplect := 0; ClearList(Complect.Complects); // for i := Complect.Complects.Count - 1 downto 0 do; // Complect.Complects[i].Free; if Complect.IsLine <> ComponForCompl.IsLine then begin exit; end; try // Complect.LoadComponentByID(Data.ObjectID); Complect.IDTopComponent := ComponForCompl.IDTopComponent; Complect.LoadInterfaces(-1, false); Complect.LoadProperties; while Kolvo > 0 do begin if IdCompRel = 0 then begin // If WithOutInterfaces then // ConnectInterfRes := ComponForCompl.ConnectWith(Complect, -1,-1, -1, -1, cntComplect, false, false, true, true) // else ConnectInterfRes := ComponForCompl.ConnectWith(Complect, -1,-1, -1, -1, cntComplect, false, false, ParamSelect.ByInterfaces = false, ParamSelect.ByPropertyes = false); end else //If WithOutInterfaces then // ConnectInterfRes := ComponForCompl.ConnectWith(Complect, -1,-1, IdCompRel, -1, cntComplect, false, false, true, true) // else ConnectInterfRes := ComponForCompl.ConnectWith(Complect, -1, -1, IdCompRel, -1, cntComplect, false, false, ParamSelect.ByInterfaces = false, ParamSelect.ByPropertyes = false); If ConnectInterfRes.CanConnect then begin inc(KolKompl); dec(Kolvo); if KolKompl = 1 then begin ComplectNode := tvComplect.Items.AddChild(ComponNode, Complect.Name); NewComponNodeData (ComplectNode, Complect); IdCompRel := ConnectInterfRes.NewIDCompRel; end; Complect.IDCompRel := IdCompRel; SetChildComponInterfacesToNoBusy(ComponForCompl, Complect, IdCompRel); if Kolvo = 0 then begin //почистим чилды у комплектующей ClearChildFromComplect(Complect); // ComponForCompl.SaveComplects(Complect.ID); end; end else begin //какая-то ошибка if KolKompl > 0 then ShowMessage(cMasterCompl_Msg3 + IntToStr(KolKompl) + cMasterCompl_Msg5) else ShowMessage(cMasterCompl_Msg4); Kolvo := 0; end; end; //коректируем название комплектующей if KolKompl > 1 then begin ComplectNode.Text := ComplectNode.Text + ' x ' + IntToStr(KolKompl); end; finally ComponNode.Expand(false); if RzSizePanel2.Visible then begin if ConnectInterfRes.CanConnect then UpdateShelfDesignListNB(Shelf_Cad, ComponForCompl); end; F_NormBase.FillCompl(ComponForCompl.ID, ComponForCompl.TreeViewNode); tvComplect.Items.EndUpdate; //Complect.Free; end; end; end; finally Shelf_Cad.Refresh; end; end; procedure TF_MasterCompl.act_DelComplExecute(Sender: TObject); var ComponNode, OperNode: TFlyNode; ListBusyInterf: TIntList; OperInterfs: TSCSInterfaces; i, j: integer; begin ComponNode := tvComplect.Selected.Parent;// tvComplect.Items.GetFirstNode; OperNode := tvComplect.Selected; if (ComponNode <> OperNode) and (ComponNode <> Nil) then begin tvComplect.Items.BeginUpdate; if ComponNode.Expanded then ComponNode.Collapse(false); try //tvComplect.Items.BeginUpdate; OperInterfs := ComponForCompl.Interfaces; F_NormBase.DelComplect(PObjectData(OperNode.Data).ID_CompRel, ComponForCompl.IDTopComponent, ComponForCompl.ID, PObjectData(opernode.Data).ObjectID, ComponForCompl.TreeViewNode, cntComplect); tvComplect.Items.Delete(OperNode); ComponForCompl.LoadInterfaces; ComponForCompl.LoadChildComplectsQuick(True, True, True); if ComponNode.Count > 0 then ComponNode.Expand(false); finally tvComplect.Items.EndUpdate; if RzSizePanel2.Visible then begin UpdateShelfDesignListNB(Shelf_Cad, ComponForCompl); end; end; end; end; procedure TF_MasterCompl.act_ClickOKExecute(Sender: TObject); begin if ComponForCompl.IDTopComponent = ComponForCompl.ID then ComponForCompl.KolComplect := ComponForCompl.Complects.Count; ComponForCompl.LoadChildComplectsQuick(true, false, true, ComponForCompl.IDTopComponent,ComponForCompl.IDCompRel); if not CheckChildComplects(ComponForCompl) then begin ComponForCompl.SaveComponent; ModalResult := mrOk; end; end; procedure TF_MasterCompl.act_ClickCancelExecute(Sender: TObject); var ChildsList: TSCSComponents; ChildCompon: TSCSComponent; i, j: integer; FCanDelete: boolean; begin // FCanDelete := True; ComponForCompl.LoadChildComplectsQuick(true, false, false, ComponForCompl.IDTopComponent, ComponForCompl.IDCompRel); ChildsList := ComponForCompl.ChildReferences; for i := 0 to ChildsList.Count - 1 do begin FCanDelete := True; ChildCompon := ChildsList[i]; if Assigned(OldComplectsIdCompRel) then for j := 0 to OldComplectsIdCompRel.Count - 1 do begin if OldComplectsIdCompRel[j] = ChildCompon.IDCompRel then begin FCanDelete := false; break; end; end; if FCanDelete then F_NormBase.DelComplect(ChildCompon.IDCompRel, ComponForCompl.IDTopComponent, ComponForCompl.ID, ChildCompon.ID, ComponForCompl.TreeViewNode, cntComplect); end; ModalResult := mrCancel; end; function TF_MasterCompl.GetCheckedComponForCompl (AGlCompon: TSCSComponent; AListCompon: TSCSComponents): TSCSComponents; var i: integer; ComponChild: TSCSComponent; // ConnectResult: TConnectInterfRes; begin Result := Nil; if Assigned(AlistCompon) then begin i := 0; While i <= AListCompon.Count - 1 do begin ComponChild := AListCompon[i]; if AGlCompon.ConnectWith(ComponChild, -1, -1, -1, -1,cntComplect, true, false, false, false).CanConnect = False then AListCompon.Delete(i) else inc(i); end; Result := AListCompon; end; end; procedure TF_MasterCompl.act_CompComplExecute(Sender: TObject); var NodeComponForcompl: TTreeNode; ChildsList,ComponListForCompl: TSCSComponents; ChildCompon, ParentCompon: TSCSComponent; Compon, ComponChild: TSCSComponent; ComponNode, OperNode: TFlyNode; i: integer; ListIdCompon: TIntList; SqlText : string; ListBusyInters: TIntList; NodeData: PObjectData; ///---------------------------- F_MasterCompl_Child: TF_MasterCompl; ///!!!!!!!!!!!!!!!!!!!!!!!! // //-------------------------------------------------------------- // procedure AddItems(ANode: TFlyNode; AItemsCompon: TSCSComponent); // var // KolSubComplect, i, Kol: integer; // ChildCompon: TSCSComponent; // Str: String; // Node: TFlyNode; // // begin // KolSubComplect := AItemsCompon.ChildComplects.Count; // F_NormBase.DM.UpdateCompRelFieldAsInteger(AItemsCompon.IDCompRel, KolSubComplect, fnKolSubComplect); // Kol := F_NormBase.DM.GetIntFromTableByID(tnComponentRelation, fnKolvo, AItemsCompon.IDCompRel, qmPhisical); // Str := AItemsCompon.Name; // if Kol > 1 then // Str := Str + ' x ' + IntToStr(Kol); // Node := tvComplect.Items.AddChild(ANode, Str); // NewComponNodeData(Node, AItemsCompon); // for i := 0 to KolSubComplect - 1 do // begin // AddItems(Node, AItemsCompon.ChildComplects[i]); // end; // end; // //-------------------------------------------------------------- begin ListBusyInters := Nil; try ComponNode := tvComplect.Items.GetFirstNode; OperNode := tvComplect.Selected; if ComponNode <> OperNode then begin BeginProgress; ComponForCompl.LoadChildComplectsQuick(true, false, true, ComponForCompl.IDTopComponent, ComponForCompl.IDCompRel); ComponForCompl.LoadInterfaces(); if PObjectData(tvComplect.Selected.Parent.Data).ObjectID = ComponForCompl.ID then ParentCompon := ComponForCompl else begin ParentCompon := ComponForCompl.GetComponentFromReferences(PObjectData(tvComplect.Selected.Parent.Data).ObjectID); ParentCompon.IDTopComponent := ComponForCompl.IDTopComponent; ParentCompon.LoadChildComplectsQuick(true, false, true, ParentCompon.IDTopComponent, ParentCompon.IDCompRel); ParentCompon.LoadInterfaces(); end; NodeData := PObjectData(tvComplect.Selected.Data); for i := 0 to ComponForCompl.ChildReferences.Count - 1 do begin if ComponForCompl.ChildReferences[i].IDCompRel = NodeData.ID_CompRel then begin Compon := ComponForCompl.ChildReferences[i]; break; end; end; // Compon := ParentCompon.GetComponentFromReferences(PObjectData(tvComplect.Selected.Data).ObjectID); Compon.IDTopComponent := ParentCompon.IDTopComponent; Compon.LoadChildComplectsQuick(true, false, true, Compon.IDTopComponent, Compon.IDCompRel); compon.TreeViewNode := F_NormBase.FindChildNodeByIDCompRel(ParentCompon.TreeViewNode, Compon.IDCompRel); // if (OperNode.Level > 1) then begin if (Not WithOutParam) then begin ListBusyInters := GetConnectedInterfacesOfChild(ParentCompon.Interfaces, Compon.IDCompRel); SqlText := BuildSQLText(Compon, ListBusyInters); if SqlText <> '' then begin ParentCompon.TreeViewNode := F_NormBase.FindComponOrDirInTree(ParentCompon.ID, true); Compon.TreeViewNode := F_NormBase.FindComponOrDirInTree(Compon.ID, true); F_MasterCompl_Child := TF_MasterCompl.Create(Self); F_MasterCompl_Child.ComponForCompl := Compon; if SqlText <> '' then begin If SqlText = StrWithOutInterfaces then begin F_MasterCompl_Child.WithOutParam := true; F_MasterCompl_Child.InitFreeNormBase; F_MasterCompl_Child.ParamSelect := ParamSelect; //F_MasterCompl_Child.ListCompon := ComponsFromIds(ListIDCompon); //F_MasterCompl_Child.WithOutInterfaces := WithOutInterfaces; end else begin ListIdCompon := F_NormBase.DM.GetComponFieldValuesAsInteger (fnId, SqlText); F_MasterCompl_Child.ListCompon := GetCheckedComponForCompl(Compon, ComponsFromIds(ListIDCompon)); F_MasterCompl_Child.ParamSelect := ParamSelect; F_MasterCompl_Child.BuildTree; end; F_MasterCompl_Child.Caption := cMasterCompl_Msg6 + Compon.Name; EndProgress; self.Hide; if F_MasterCompl_Child.ShowModal = mrOk then begin Compon.LoadChildComplectsQuick(true, false, true, Compon.IDTopComponent, Compon.IDCompRel); F_NormBase.DM.UpdateCompRelFieldAsInteger(Compon.IDCompRel, Compon.ChildComplects.Count, fnKolSubComplect); OperNode.DeleteChildren; for i := 0 to Compon.ChildComplects.Count - 1 do begin AddItems(OperNode, Compon.ChildComplects[i]); end; OperNode.Expand(True); end; self.Show; if Assigned(F_MasterCompl_Child) then F_MasterCompl_Child.Free; end; end; end else begin F_MasterCompl_Child := TF_MasterCompl.Create(Self); F_MasterCompl_Child.WithOutParam := true; F_MasterCompl_Child.ParamSelect := ParamSelect; F_MasterCompl_Child.ComponForCompl := Compon; F_MasterCompl_Child.InitFreeNormBase; F_MasterCompl_Child.InitTreeComplect; EndProgress; self.Hide; try if F_MasterCompl_Child.ShowModal = mrOk then begin Compon.LoadChildComplectsQuick(true, false, true, Compon.IDTopComponent, Compon.IDCompRel); F_NormBase.FillCompl(Compon.ID, Compon.TreeViewNode); F_NormBase.DM.UpdateCompRelFieldAsInteger(Compon.IDCompRel, Compon.ChildComplects.Count, fnKolSubComplect); OperNode.DeleteChildren; for i := 0 to Compon.ChildComplects.Count - 1 do begin AddItems(OperNode, Compon.ChildComplects[i]); end; OperNode.Expand(True); end; finally self.Show; SetForegroundWindow(Self.Handle); end; if Assigned(F_MasterCompl_Child) then F_MasterCompl_Child.Free; ////!!!!!!!!!!!!!!!!!!!!!!!! end; end //else // begin // EndProgress; // end; end; finally EndProgress; if ListBusyInters <> nil then ListBusyInters.Free; end; end; function TF_MasterCompl.CheckChildComplects(ACompon: TSCSComponent): boolean; var i, j, k: integer; Inters: TSCSInterfaces; Interj: TSCSInterface; Compon: TSCSComponent; StrWithName, Str: string; ChildNode, CompNode: TFlyNode; BusyInters: TintList; BusyFlag, BusyFlagInterface: boolean; begin CompNode := tvComplect.GetFirstVisibleNode; ChildNode := CompNode.getFirstChild; Result := False; ACompon.LoadInterfaces(); for i := 0 to ACompon.ChildComplects.Count - 1 do begin Compon := ACompon.ChildComplects[i]; Compon.LoadInterfaces; BusyInters := GetConnectedInterfacesOfChild(ACompon.Interfaces, Compon.IDCompRel); BusyFlag := true; BusyFlagInterface := True; Inters := Compon.Interfaces; for j := 0 to Inters.Count - 1 do begin Interj := Inters[j]; if (Interj.TypeI = 1) and (Interj.Multiple = biFalse) and (Interj.IOfIRelOut.Count < 1) then begin BusyFlagInterface := False; if Assigned(BusyInters) then begin For k := 0 to BusyInters.Count - 1 do begin if Interj.ID = BusyInters[k] then begin BusyFlagInterface := True; break; end; end; if Not BusyFlagInterface then BusyFlag := false; end else begin BusyFlag := False; break; end; end; end; if not BusyFlag then begin if Assigned(ChildNode) then begin tvComplect.Selected.Selected := False; tvComplect.Selected := ChildNode; ChildNode.Selected := true; end; Str := cMasterCompl_Msg7; StrWithName := cMasterCompl_Msg8 + Compon.Name + cMasterCompl_Msg9; if MessageModal(StrWithName, str, MB_ICONQUESTION or MB_YESNO) = idYes then begin act_CompComplExecute(Self); Result := True; end; end; ChildNode := ChildNode.GetNextSibling; BusyInters.Free; end; end; procedure TF_MasterCompl.act_DblClickExecute(Sender: TObject); var Data: pObjectData; begin Data := Nil; if Sender = tvCatalog then begin data := pObjectData(tvCatalog.Selected.Data); end; if Assigned(F_FreeNormBase) then begin if Sender = F_FreeNormBase.Tree_Catalog then begin Data := pObjectData(F_FreeNormBase.Tree_Catalog.Selected.Data); end; end; if Assigned(Data) then begin If Data.ItemType = itDir then begin if Sender = tvCatalog then begin if tvCatalog.Selected.Expanded then tvCatalog.Selected.Collapse(false) else tvCatalog.Selected.Expand(false) end; if Sender = F_FreeNormBase then begin F_FreeNormBase.tree_CatalogDblClick(Sender); end; end else if Data.ObjectID <> ComponForCompl.IDTopComponent then begin act_AddComplExecute(Sender) end else begin MessageModal(cMasterCompl_Msg10, cMasterCompl_Msg11, MB_ICONINFORMATION); end; end; end; procedure TF_MasterCompl.ShowGrid; begin RzSizePanel3.Align := alRight; RzSizePanel3.Width := 277; Panel_Grid.Show; Propertyes_Grid.Show; Panel_Grid.Refresh; tvComplectChange(tvComplect, tvComplect.GetFirstVisibleNode); end; procedure TF_MasterCompl.HideGrid; var delta: integer; begin delta := Panel_Grid.Height; Panel_Grid.Visible := false; Panel2.Height := Panel2.Height - delta; Panel2.Top := Panel2.Top + delta; BitBtn1.Top := BitBtn1.Top - delta; BitBtn2.Top := BitBtn2.Top - delta; Label_Kolvo.Top := Label_Kolvo.Top - delta; SpinEdit_Kolvo.Top := SpinEdit_Kolvo.Top - delta; Panel2.Refresh; end; procedure TF_MasterCompl.ShowPropertyesGrid(AComponent: TSCSComponent); begin Property_MemTable := F_NormBase.DM.MemTable_Property; F_NormBase.DM.SelectComponProperty(AComponent); ShowGrid; end; procedure TF_MasterCompl.tvComplectChange(Sender: TObject; Node: TFlyNode); var Data: PObjectData; Compon: TSCSComponent; begin Compon := Nil; // Tolik 03/09/2019 -- if ComponForCompl <> nil then begin // if ComponForCompl.ComponentType.SysName = ctsnCupboard then if Panel_Grid.Visible then begin Data := PobjectData(Node.Data); if Assigned(data) then begin try Compon := TSCSComponent.Create(F_NormBase); Compon.LoadComponentByID(Data.ObjectID, false); Compon.LoadProperties; F_NormBase.DM.FillMemTablePropFromList(Property_MemTable, Compon.Properties, false); finally if Compon <> Nil then Compon.Free; end; end; end; end; end; // ##### Добавить/изменить значение свойства ##### //TF_MAIN.AddEditProperty(AMakeEdit: TMakeEdit) procedure TF_MasterCompl.AddEditProperty(AMakeEdit: TMakeEdit); var PropFromMT: TProperty; Dat: PObjectData; TableKind: TTableKind; OwnerName: String; TableName: String; MasterField: String; PropertyKind: TPropKind; SCSCatalog: TSCSCatalog; SCSComponent: TSCSComponent; ptrProperty: PProperty; i: Integer; JoinedTrunkComponent: TSCSComponent; Sproavochnik: TSpravochnik; begin ZeroMemory(@PropFromMT, SizeOf(TProperty)); TableKind := tkComponent; Dat := tvComplect.Selected.Data; SCSCatalog := nil; SCSComponent := nil; ptrProperty := nil; Sproavochnik := nil; if AMakeEdit = meEdit then begin PropFromMT := F_Normbase.DM.GetPropertyFromTable(DataSource_Property); end; case Dat.ItemType of itComponCon, itComponLine: begin // OwnerName := GSCSBase.SCSComponent.Name; TableName := tnCompPropRelation; MasterField := fnIDComponent; PropertyKind := pkCompon; TableKind := tkComponent; // case GDBMode of // bkNormBase: begin // SCSComponent := GSCSBase.SCSComponent; SCSComponent := TSCSComponent.Create(F_NormBase); SCScomponent.LoadComponentByID(Dat.ObjectID); SCSComponent.LoadProperties; end; // bkProjectManager: // SCSComponent := GSCSBase.CurrProject.GetComponentFromReferences(Dat.ObjectID); // end; if SCSComponent <> nil then begin if PropFromMT.ID <> 0 then ptrProperty := SCSComponent.GetPropertyByID(PropFromMT.ID); end; end; //itDir, itProject, itList, itRoom, itSCSConnector, itSCSLine: // begin // OwnerName := GSCSBase.SCSCatalog.Name; // TableName := tnCatalogPropRelation; // MasterField := fnIDCatalog; // // PropertyKind := pkCatalog; // TableKind := tkCatalog; // case GDBMode of // bkNormBase: // begin // SCSCatalog := GSCSBase.SCSCatalog; // SCSCatalog.LoadProperties; // end; // bkProjectManager: // SCSCatalog := GSCSBase.CurrProject.GetCatalogFromReferences(Dat.ObjectID); // end; // if SCSCatalog <> nil then // if PropFromMT.ID <> 0 then // ptrProperty := SCSCatalog.GetPropertyByID(PropFromMT.ID); // end; end; Sproavochnik := F_NormBase.GSCSBase.NBSpravochnik; // if GDBMode = bkNormBase then // Sproavochnik := GSCSBase.NBSpravochnik // else // if GDBMode = bkProjectManager then // Sproavochnik := GSCSBase.CurrProject.Spravochnik; //*** Корректировка структуры PropFromMT (на всекий який) if (ptrProperty <> nil) and (AMakeEdit = meEdit) then PropFromMT := ptrProperty^; if F_NormBase.CreateFMakeEditPropRel.Execute(AMakeEdit, TableKind, @PropFromMT, Property_MemTable, Dat.ItemType, nil, Sproavochnik) then begin case AMakeEdit of meMake: Property_MemTable.Append; meEdit: Property_MemTable.Edit; end; if Property_MemTable.State <> dsBrowse then begin case TableKind of // tkCatalog: // begin // if AMakeEdit = meMake then // ptrProperty := SCSCatalog.GetPropertyAsNew; // if ptrProperty <> nil then // begin // PropFromMT.IDMaster := ptrProperty.IDMaster; // ptrProperty^ := PropFromMT; // SCSCatalog.SaveProperty(AMakeEdit, ptrProperty); // // SCSCatalog.NotifyChange; // // end; // end; tkComponent: begin if AMakeEdit = meMake then ptrProperty := SCSComponent.GetPropertyAsNew; if ptrProperty <> nil then begin PropFromMT.IDMaster := ptrProperty.IDMaster; ptrProperty^ := PropFromMT; SCSComponent.SaveProperty(AMakeEdit, ptrProperty); // if GDBMode = bkProjectManager then // begin // OnChangeComponProperty(ptrProperty, SCSComponent); // // //*** Значение свойства по всей длине // MakeEditPropertyForWholeComponent(AMakeEdit, SCSComponent, ptrProperty); // end; // SCSComponent.NotifyChange; end; end; end; if ptrProperty <> nil then PropFromMT.ID := ptrProperty.ID; F_NormBase.DM.SetPropertyToTable(DataSource_Property, PropFromMT); Property_MemTable.FieldByName(fnIDDataType).AsInteger := F_NormBase.F_MakeEditPropRel.PropertyData.IDDataType; //F_NormBase.DM.DataSource_Property.DataSet.FieldByName(fnIDDataType).AsInteger := F_MakeEditPropRel.PropertyData.IDDataType; Property_MemTable.Post; //GSCSBase.SCSComponent.NotifyChange; //if AMakeEdit = meMake then // EnableEditDel(itAuto); if SCSComponent.GuidNB = ComponForCompl.GuidNB then begin ComponForCompl.LoadProperties; end; // UpdateDesignListNormBase(CadFormFromBox, ComponForCompl); UpdateShelfDesignListNB(Shelf_Cad, ComponForCompl); end; end; end; procedure TF_MasterCompl.GT_PropertyesDblClick(Sender: TObject); begin AddEditProperty(meEdit); end; procedure TF_MasterCompl.InitFreeNormBase; begin ParamSelect.ByProducer := false; ParamSelect.ByInterfaces := false; ParamSelect.ByPropertyes := false; If F_FreeNormBase = Nil then begin GGDBMode := bkNormBase; // F_FreeNormBase := TF_MAIN.Create(Panel4, bkNormBase, fmView); tvCatalog.Hide; F_FreeNormBase := TF_Main.Create(Self, bkNormBase, fmComplects); // FSavedNBTreeCatalogChange := TF_Main(FNormBase).Tree_Catalog.OnChange; F_FreeNormBase.FNormBase := F_NormBase; F_FreeNormBase.FProjectMan := F_NormBase.FProjectMan; F_FreeNormBase.Visible := false; F_FreeNormBase.Constraints.MinWidth := 0; F_FreeNormBase.ToolBar_Tree.Visible := false; F_FreeNormBase.HideTemplateControls; F_FreeNormBase.Panel_Addition.Visible := false; F_FreeNormBase.Panel_OKCancel.Visible := false; F_FreeNormBase.Parent := Panel1; F_FreeNormBase.Align := alClient; F_FreeNormBase.EnableDisableEdit(false); F_FreeNormBase.Tree_Catalog.PopupMenu := nil; F_FreeNormBase.Tree_Catalog.OnDblClick := act_DblClickExecute; F_FreeNormBase.PopupMenu := CatalogPopupMenu1; FreeAndNil(F_FreeNormBase.PopupMenu_Catalog); //if FComponentTypeSysNames <> nil then // TF_Main(FNormBase).SetFilterBlockForCompType(FComponentTypeSysNames); F_FreeNormBase.Visible := true; end; end; //procedure TF_MasterCompl.FreeBaseTree_CatalogDblClick(Sender: TObject); //begin // //end; procedure TF_MasterCompl.InitTreeComplect; var ComplectNode: TFlyNode; j: integer; begin if ComponForCompl <> Nil then begin tvComplect.Items.Clear; ComplectNode := tvComplect.Items.Add(Nil, ComponForCompl.Name); NewComponNodeData(ComplectNode, ComponForCompl); For j := 0 to ComponForCompl.ChildComplects.Count - 1 do AddItems(ComplectNode, ComponForCompl.ChildComplects[j]); For j := 0 to ComponForCompl.ChildReferences.Count - 1 do begin if OldComplectsIdCompRel = Nil then OldComplectsIdCompRel := TIntList.Create; OldComplectsIdCompRel.Add(ComponForCompl.ChildReferences[j].IDCompRel); end; ComplectNode.Expand(true); end; // СКРОЕМ ОТРАЗИМ ГРИД If ComponForCompl.ComponentType.SysName = ctsnCupboard then begin ShowGrid; InitDesignList; end else begin HideGrid; RzSizePanel2.Hide; Width := Width - RzSizePanel2.Width; RzSizePanel3.Align := alClient; end; end; // Tolik 03/09/2019 -- procedure TF_MasterCompl.Propertys_GridValueGetDisplayText( Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); var DoSetDisplay: boolean; begin DoSetDisplay := True; if ARecord.Values[6] <> null then begin if (ARecord.Values[6] = dtBoolean) or (ARecord.Values[6] = dtCompStateType) or (ARecord.Values[6] = dtColor) or (ARecord.Values[6] = dtCableCanalElementType) then DoSetDisplay := False; end; if DoSetDisplay then // SetDisplayTextToGridTablePropValue(AText, ARecord, 6, 7, F_NormBase.FUOM); end; {procedure TF_MasterCompl.Propertys_GridValueGetDisplayText( Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); begin SetDisplayTextToGridTablePropValue(AText, ARecord, 6, 7, F_NormBase.FUOM); end;} // procedure TF_MasterCompl.InitDesignList; var layer: TLayer; Koef_ScrollPos_Y: Double; MaxCADScroll_X, MaxCADScroll_Y: Integer; SetScrollPos_Y: Integer; Rect: TRect; begin try SpinEdit_Kolvo.hide; Label_Kolvo.Hide; Panel_Grid.Height := Panel_Grid.Height + 25; // self.Width := Width + RzSizePanel2.Width; // Register Classes with Self.Shelf_Cad do begin RangeCheck := True; MapScale := 100; RegisterFigureClass(TOrthoLine); RegisterFigureClass(TConnectorObject); RegisterFigureClass(TFigureGrpMod); RegisterFigureClass(TFigureGrpNotMod); RegisterFigureClass(TTextMod); RegisterFigureClass(TFrame); RegisterFigureClass(TSCSHDimLine); RegisterFigureClass(TSCSVDimLine); RegisterFigureClass(TRichTextMod); RegisterFigureClass(TPlanTrace); RegisterFigureClass(TPlanObject); RegisterFigureClass(TPlanConnector); RegisterFigureClass(TInsertCol); RegisterFigureClass(TWallPath); RegisterFigureClass(TWallRect); // RegisterFigureClass(TCabinet); // RegisterFigureClass(TCabinetNumber); RegisterFigureClass(TCadNorms); RegisterFigureClass(TSCSFigureGrp); Self.Shelf_Cad.OnMouseWheel := Nil; Align := alClient; WorkWidth := 421; WorkHeight := 600; //ZoomScale := 50; Visible := true; end; //rect := Shelf_Cad.GetPageRect; // // позиция CAD // MaxCADScroll_Y := abs(rect.Top - rect.Bottom); // MaxCADScroll_X := abs(rect.Left - rect.Right); // // Sets // if (VerScroll.Max - VerScroll.PageSize) > 0 then // begin // Koef_ScrollPos_Y := VerScroll.Position / (VerScroll.Max - VerScroll.PageSize); // SetScrollPos_Y := round(MaxCADScroll_Y * Koef_ScrollPos_Y); // PCad.SetVScrollPosition(SetScrollPos_Y, True); // end; // except // on E: Exception do addExceptionToLogEx('TF_CAD.Set_PCad_VerScroll', E.Message); // end; //end; //ScrollBars := True; // // Shelf_Cad.ScrollBy.Visible := true; // VertScrollBar.Visible := true; //ZoomScale := 60; layer := TLayer.create('1'); self.Shelf_Cad.Layers.Add(layer); layer := TLayer.create('2'); Shelf_Cad.Layers.Add(layer); RzSizePanel2.Show; // F_MasterCompl.Shelf_Cad.Layers.Add(TLayer.create('')); // F_MasterCompl.Shelf_Cad.Layers.Add(TLayer.create('')); UpdateShelfDesignListNB(Shelf_Cad, ComponForCompl); Shelf_Cad.ZoomScale := 35; except on E: Exception do addExceptionToLogEx('TF_MasterCompl.InitDesignList', E.Message); end; end; procedure TF_MasterCompl.FormMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); var Xx: integer; begin If ssCtrl in Shift then if RzSizePanel2.Visible then begin Xx := Shelf_Cad.ZoomScale; if Xx >= 10 then begin Shelf_Cad.ZoomScale := Xx - 5; Shelf_Cad.Refresh; end; end; end; procedure TF_MasterCompl.FormMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); var xx: integer; begin If ssCtrl in Shift then if RzSizePanel2.Visible then begin Xx := Shelf_Cad.ZoomScale; if Xx <= 95 then begin Shelf_Cad.ZoomScale := Xx + 5; Shelf_Cad.Refresh; end; end; end; procedure TF_MasterCompl.Shelf_CadSurfaceDragOver(Sender, Source: TObject; X, Y: Double; State: TDragState; var Accept: Boolean); begin if (Source = tvCatalog) then begin if PObjectData(tvCatalog.Selected.Data).ItemType = itComponCon then Accept := true else Accept := false; end else if F_FreeNormBase <> Nil then begin if Source = F_FreeNormBase.Tree_Catalog then begin if pobjectData(F_FreeNormBase.Tree_Catalog.Selected.Data).ItemType = itComponCon then Accept := true else Accept := false; end else Accept := false; end else Accept := false; end; procedure TF_MasterCompl.Shelf_CadSurfaceDragDrop(Sender, Source: TObject; X, Y: Double); begin act_AddComplExecute(Source); end; procedure TF_MasterCompl.tvCatalogDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin Accept := false; end; procedure TF_MasterCompl.FormShow(Sender: TObject); var rect: TRect; begin if RzSizePanel2.Visible then begin GetWindowRect(Shelf_Cad.Handle, rect); Shelf_Cad.SetFocus; // Tolik -- 29/03/2017 -- поскольку это практически DoubleClick, то и делаем DoubleClick //mouse_event(MOUSEEVENTF_MIDDLEDOWN, Rect.Top + 40, rect.Left + 40, 0, 0 ); //mouse_event(MOUSEEVENTF_MIDDLEUP, Rect.Top + 40 ,rect.Left + 40, 0, 0 ); //mouse_event(MOUSEEVENTF_MIDDLEDOWN, Rect.Top + 40 ,rect.Left + 40, 0, 0 ); //mouse_event(MOUSEEVENTF_MIDDLEUP, Rect.Top + 40 ,rect.Left + 40, 0, 0 ); //send_message(WM_MBUTTONDBLCLK, Rect.Top + 40, rect.Left + 40, 0, 0); // Shelf_Cad.SurfaceMiddleDblClick(nil); end; end; procedure TF_MasterCompl.RzSizePanel2Resize(Sender: TObject); //VAR // Rect: TRect; begin // if RzSizePanel2.Visible and self.Visible then // begin // GetWindowRect(Shelf_Cad.Handle, rect); // mouse_event(MOUSEEVENTF_MIDDLEDOWN, Rect.Top + 10, rect.Left + 10, 0, 0 ); // mouse_event(MOUSEEVENTF_MIDDLEUP, Rect.Top + 10 ,rect.Left + 10, 0, 0 ); // mouse_event(MOUSEEVENTF_MIDDLEDOWN, Rect.Top + 10 ,rect.Left + 10, 0, 0 ); // end; end; procedure TF_MasterCompl.BitBtn1Click(Sender: TObject); begin if ComponForCompl.ID = ComponForCompl.IDTopComponent then begin ComponForCompl.KolComplect := ComponForCompl.ChildComplects.Count; ComponForCompl.SaveComponent; end; end; // Tolik 28/03/2017 -- чтобы поменялась форма курсора при закрытии формы procedure TF_MasterCompl.FormClose(Sender: TObject; var Action: TCloseAction); begin if FSCS_Main.ActiveMDIChild <> nil then FSCS_Main.aToolSelectExecute(nil); end; // // Tolik 29/03/2017 -- на ресайзе, чтобы спозиционировало Кад procedure TF_MasterCompl.FormResize(Sender: TObject); begin Shelf_Cad.SurfaceMiddleDblClick(nil); // end; procedure TF_MasterCompl.MoveCADOnPan(ADeltaX, ADeltaY: double); var hscroll, vscroll: integer; begin try Shelf_Cad.AutoRefresh := False; hscroll := Shelf_Cad.HSCBarPosition; vscroll := Shelf_Cad.VSCBarPosition; Shelf_Cad.SetHScrollPosition(hscroll + round(-adeltax * Shelf_Cad.ZoomScale / 25), true); Shelf_Cad.SetVScrollPosition(vscroll + round(-adeltay * Shelf_Cad.ZoomScale / 25), true); Shelf_Cad.AutoRefresh := True; Shelf_Cad.ManualRefresh; except on E: Exception do addExceptionToLogEx('TF_MasterCompl.MoveCADOnPan', E.Message); end; end; end.