unit U_MasterComplCommon; interface uses Classes, Contnrs, SysUtils, Windows, Forms, Controls, U_SCSComponent, U_SCSLists, ComCtrls, U_Common, U_BaseCommon, U_BaseConstants, U_Cad, PCTypesUtils, Dialogs, DrawObjects, Graphics, PowerCad, U_Constants, U_ESCadClasess, fplan, U_SCSEngineTest, USCS_Main, FastStrings; const //Tolik 17/08/2021 -- //NameGostFont = 'GOST'; {$IF DEFINED(SCS_PE)} NameGostFont = 'Tahoma'; {$ELSE} NameGostFont = 'GOST'; {$IFEND} type T_ParamSelect = Record ByProducer: boolean; ByInterfaces: boolean; ByPropertyes: boolean; end; Function ComplCompon(ACompon: TSCSComponent): TSCSComponents; Procedure DelAllComplect(Acompon: TSCSComponent; AComponNode: TTreeNode); Procedure StartCompl; //обновление дизайнера шкафа для нормативки procedure UpdateShelfDesignListNB(Acad: TPowerCad; ABox: TSCSComponent); //AList: TF_CadNB; function GetFigureComponGraphicalImageNormBase(ACompon: TSCSComponent): TObjectList; procedure DrawDesignRulerInUnitsNB(Acad: TPowerCad; aRulerHeight, aCadRulerWidth, aCadRulerHeight: Double; aBeginDrawPoint: TDoublePoint); implementation uses U_Main, U_Master_compl, U_ParamMasterCompl, U_ProtectionCommon; Procedure StartCompl; var Compon: TSCSComponent; Node: TTreeNode; Idlist: TIntList; i: integer; begin Node := F_NormBase.Tree_Catalog.Selected; //отключить дерево // LockTreeAndGrid(True); Compon := Nil; TRY Case PobjectData(Node.Data).ItemType of itComponCon, itComponLine: begin F_NormBase.Tree_Catalog.Items.BeginUpdate; try BeginProgress; Compon := TSCSComponent.Create(F_NormBase); Compon.LoadComponentByID(PObjectData(Node.Data).ObjectID); ComplCompon(Compon); F_NormBase.DM.SelectComponProperty(Compon); finally F_NormBase.Tree_Catalog.Items.EndUpdate; end; end; itDir: begin // ShowMessage('Do you have anything in your mind? '); end; end; except if Assigned(Compon) then begin if Assigned(Compon.ChildComplects) then begin for i := 0 to Compon.ChildComplects.Count - 1 do begin Compon.ChildComplects[i].Free; end; end; Compon.Free; end; end; end; Function ComplCompon(ACompon: TSCSComponent): TSCSComponents; var // HarInterface, HarInterface2: ^THarInterface; // HaresInterface, HaresInterface2 : TList; // ListHares: TObjectList; Half, koli, i, j, k, n, l, l2, l3, l4, KolGL: integer; IsRM: integer; IndexOfChild,IndexOfChild2, IndexOfChild3, IndexOfChild4: integer; IndexOfCork, KolIntersOfCork: integer; IdCompRel: Integer; ParentCompon, InterfCompon, Compon, Compon2, OperCompon, OperCompon2, ChildComponent: tSCSComponent; OperComponChild: tSCSComponent; Catalog: TSCSCatalog; CompForCompl, ComponsOper , NewCompons: tSCSComponents; ComponInters, ChildsInterfaces, InterfsForChild, Compon2Inters : tSCSInterfaces; ResultCompons: TSCSComponents; InterfI,InterfJ: tSCSInterface; OperIntList, OperIntList2, ListID, ListIdInterface: TIntList; ListForRazlInterf: TIntList; ListOfIndexChildInterfaces: TIntList; ListComb: TObjectList; Ready: Integer; Flag, FlagSocetKonstr: boolean; ConnectInterfRes: TConnectInterfRes; klist, jlist: integer; ListForNewchild : TSCSComponents; KolKompOfFirstLevel: integer; EmptyChild: TSCSComponent; WasComplected: Boolean; CompForNewRM: TSCSComponent; ListOfIdKonstrInterf: TSCSInterfaces; WithOutParam, ThereAreChilds : boolean; FDialog: TF_MasterCompl; AListIDCompon: TIntList; CreatedF_ParamMasterCompl: boolean; ParamSelect: T_ParamSelect; // Tolik 27/03/2017 -- ProgressPaused: Boolean; // function BuildSQLText: string; var i: integer; begin Result := ''; if AListIDCompon = Nil then begin Result := 'IsLine = ' + IntToStr(Compon.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(Compon.ComponentType.ID) + ')'; if ParamSelect.ByProducer then begin Result := Result + ' and id_producer = '+ IntToStr(Compon.ID_Producer); end; Result := Result + ' and id not in (Select r.id_top_compon from component_relation r)'; 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); if ListOfIdKonstrInterf[i].SideSection <> '' then begin Result := Result + ' and ' + 'side_section = ''' + ListOfIdKonstrInterf[i].SideSection + ''')'; end else begin Result := Result + ')'; end; end; Result := Result + ')'; end; end; end; //получить характеристики всех интерфейсов //Function GetHaresInterface(AInterfaces: TSCSInterfaces): TList; // var // HarInterface: ^THarInterface; // i, j: integer; // OperList: TSCSInterfaces; // Interf: TSCSInterface; // begin // OperList := TSCSInterfaces.Create(false); // OperList.Assign(AInterfaces); // Result := TList.Create; // for i:= 0 to OperList.Count - 1 do // begin // if OperList.Items[i].ID <> -1 then // begin // Interf := OperList.Items[i]; // for j := i + 1 to OperList.Count - 1 do // if OperList.Items[j].ID <> -1 then // if (OperList.Items[j].ID_Interface = OperList.Items[i].ID_Interface) and // (OperList.Items[j].TypeI = OperList.Items[i].TypeI) and // (OperList.Items[j].Kind = OperList.Items[I].Kind) and // (OperList.Items[j].Gender = OperList.Items[i].Gender)and // (OperList.Items[j].IsBusy = 0) and // (OperList.Items[j].SideSection = OperList.Items[i].SideSection) then // begin // OperList.Items[i].Kolvo := OperList.Items[i].Kolvo + OperList.Items[j].Kolvo; // OperList.Items[j].ID := -1; // end; // GetMem(HarInterface, SizeOf(THarInterface)); // HarInterface.Id_interf := OperList.Items[i].ID_Interface; // HarInterface.Kolvo := OperList.Items[i].Kolvo; // HarInterface.Gender := OperList.Items[i].Gender; // HarInterface.Kind := OperList.Items[i].Kind; // HarInterface.Typei := OperList.Items[i].TypeI; // HarInterface.Sidesection := OperList[i].SideSection; // Result.Add(HarInterface); // end; // end; // end; // Проверка: не является ли интерфейс конструктивом сечения для линейной компоненты function NoSechFoCabCan(AInterf: TSCSInterface; ACompon: TSCSComponent): boolean; begin if (AInterf.TypeI = 1) and (Ainterf.Multiple = 1) and (ACompon.IsLine = 1) then Result := False else Result := True; end; //проверка есть ли такой конструктивный интерфейс в списке function NewKonstrInterfInList(AListOfIdKonstrInterf: TSCSInterfaces; AInterf: TSCSInterface): boolean; var i: integer; operInterf: TSCSInterface; begin Result := true; for i := 0 to AListOfIdKonstrInterf.Count - 1 do begin operInterf := AListOfIdKonstrInterf[i]; if (operInterf.ID_Component = AInterf.ID_Component) and (operInterf.SideSection = AInterf.SideSection) then begin Result := False; end; end; end; begin AListIDCompon := Nil; ListOfIdKonstrInterf := nil; WithOutParam := false; Result := TSCSComponents.Create(false); InterfsForChild := nil; ChildsInterfaces := nil; ListIdInterface := nil; OperIntList2 := nil; OperIntList := nil; ComponsOper := Nil; CreatedF_ParamMasterCompl := false; IsRM := 0; InterfCompon := TSCSComponent.Create(F_NormBase); NewCompons := tSCSComponents.Create(False); CompForCompl := TSCSComponents.Create(false); OperCompon := TSCSComponent.Create(F_NormBase); // F_NormBase.Tree_Catalog Catalog := TSCSCatalog.Create(F_NormBase); // if ACatIn <> -1 then // CatalogSrc := TSCSCatalog.Create(Self); InterfsForChild := TSCSInterfaces.Create(false); //If AListChildInterfaces <> nil then // ListOfIndexChildInterfaces := TIntList.Create // else Compon := TSCSComponent.Create(F_NormBase); ListForRazlInterf := TIntList.Create; // Tolik 27/03/2017 -- ProgressPaused := False; Compon2 := Nil; ListId := Nil; // try EndProgress; // if not Assigned(F_ParamMasterCompl) then begin F_ParamMasterCompl := TF_ParamMasterCompl.Create(F_NormBase); CreatedF_ParamMasterCompl := true; end; if F_ParamMasterCompl.ShowModal = mrOk then begin BeginProgress; ParamSelect := F_ParamMasterCompl.ParamSelect; if (ParamSelect.ByProducer = false) and (ParamSelect.ByInterfaces = false) and (ParamSelect.ByPropertyes = false) then WithOutParam := true; ComponInters := tSCSInterfaces.Create(False); //If AListChildInterfaces <> nil then // begin // kolGL := AListChildInterfaces.Count; // ListOfIdKonstrInterf := TIntList.Create; // For i := 1 to KolGL do // ListOfIdKonstrInterf.Add(AListChildInterfaces[i - 1].ID_Interface); // end // else ComponsOper := Nil; ChildComponent := Nil; InterfsForChild := Nil; Compon.Assign(ACompon,false,true); Compon.LoadInterfaces; Compon.LoadChildComplects(true, false, true, Compon.id); // if ADialog then Compon.TreeViewNode := F_NormBase.FindComponOrDirInTree(Compon.ID, true); if (Compon.ChildComplects.Count > 0) then begin EndProgress; if MessageModal(cMasterCompl_Msg12, cMasterCompl_Msg13, MB_ICONQUESTION or MB_YESNO) = IDYES then begin BeginProgress; //Compon.TreeViewNode := FindComponOrDirInTree(Compon.ID, true); DelAllComplect(Compon, Compon.TreeViewNode); Compon.ClearChilds; end else BeginProgress; end; if Not WithOutParam then begin InterfCompon.AssignInterfaces(Compon.Interfaces,true); KolGL := 0; For i := 0 to InterfCompon.Interfaces.Count - 1 do //Проверка наличия конструктивных интерфейсов begin InterfI := InterfCompon.Interfaces.Items[i]; if NoSechFoCabCan(InterfI, Compon) and (InterfI.TypeI = 1) {and InterfI.IOfIRelCount = 0} then begin KolGl := 1; If ListOfIdKonstrInterf = Nil then begin ListOfIdKonstrInterf := TSCSInterfaces.Create(false); end; if NewKonstrInterfInList(ListOfIdKonstrInterf, InterfI) then ListOfIdKonstrInterf.Add(InterfI); end; end; if (KolGL <= 0) and (ParamSelect.ByInterfaces) then begin EndProgress; if MessageModal(cMasterCompl_Msg14, cMasterCompl_Msg15, MB_ICONQUESTION or MB_YESNO) = IDYES then begin ParamSelect.ByInterfaces := False; if (ParamSelect.ByProducer = false) then begin WithOutParam := true; end; BeginProgress; end; end; ListId := TIntList.Create; //Нужно разобраться с интерфейсами и комплектующими if Compon.ChildComplects.Count > 0 then ThereAreChilds := True else ThereAreChilds := False; if Not WithOutParam then begin AListIDCompon := F_NormBase.DM.GetComponFieldValuesAsInteger(fnId, BuildSQLText); if CompForCompl.Count > 0 then begin CompForCompl.Clear; end; Compon.LoadInterfaces; Compon2 := TSCSComponent.Create(F_NormBase); try if not WithOutParam then begin // Tolik -- 27/03/2017 -- if GIsProgress or GIsProgressHandling then begin PauseProgress(True); ProgressPaused := True; end; BeginProgress('', AListIDCompon.Count, true); // For k := 0 to AListIDCompon.Count - 1 do begin Application.ProcessMessages; Compon2.LoadComponentByID(AListIDCompon.Items[k]); // if (Not IsForFO(Compon2)) // если компонент не имеет ничего общего с оптикой // and (Not IsThereLeftPort(Compon2))//если компонент не имеет левых(малоиспользуемых) функционалов // and (Compon2.ComponentType.SysName <> ctsnJoiner) //если компонент не "Соедининтель" // then begin // Compon2.IDTopComponent := Compon.IDTopComponent; Application.ProcessMessages; if (Compon.ConnectWith (Compon2, -1, -1, -1, -1, cntComplect, true, false, ParamSelect.ByInterfaces = false, ParamSelect.ByPropertyes = false, InterfsForChild).CanConnect) then begin CompForCompl.Add(Compon2); Compon2 := TSCSComponent.Create(F_NormBase); end; end; // Tolik 27/03/2017 -- StepProgressRE; // end; EndProgress; // Tolik 27/03/2017 -- if ProgressPaused then PauseProgress(False); end; finally Compon2.Free; //Tolik -- 28/03/2017 -- Compon2 := nil; // // if Assigned(ListHares) then // begin // For n := 0 to ListHares.Count - 1 do // begin // for l := 0 to TList(ListHares.Items[n]).Count - 1 do // begin // //FreeMem (TList(ListHares.Items[n]).Items[l], SizeOf (THarInterface)); // FreeMem (TList(ListHares.Items[n]).Items[l]); // end; // ListHares.Items[n].Free; // end; // ListHares.Free; // end; end; //на даном этапе у нас есть CompForCompl с компонентами которыми нужно укомплектовать основной (главный) компонент //begin //вот сюда и нужно добавить окно мастера компоновки if (CompForCompl.Count < 1) and (not WithOutParam) then {and (KolGL > 0)} begin EndProgress; if MessageModal(cMasterCompl_Msg16, {} cMasterCompl_Msg17, MB_ICONQUESTION or MB_YESNO) = IDYES then begin WithOutParam := true; ParamSelect.ByProducer := false; ParamSelect.ByInterfaces := false; ParamSelect.ByPropertyes := false; BeginProgress; end // Tolik -- 28/03/2017 -- если пользователь сказал "нет", то нах показывать местер комплектации? else begin FreeAndNil(Result); if ListIdInterface <> nil then ListIdInterface.free; if OperIntList2 <> nil then OperIntList2.free; if OperIntList <> nil then OperIntList.free; if ComponsOper <> Nil then ComponsOper.free; if ListId <> nil then ListId.free; InterfCompon.free; NewCompons.free; CompForCompl.free; OperCompon.free; Catalog.free; InterfsForChild.free; if compon <> nil then compon.Free; if Compon2 <> nil then Compon2.free; ListForRazlInterf.free; Exit; end; // end; end; end; //BeginProgress; FDialog := TF_MasterCompl.Create(F_NormBase); FDialog.ParamSelect := ParamSelect; FDialog.WithOutParam := WithOutParam; Compon.IDTopComponent := Compon.ID; FDialog.ComponForCompl := Compon; if WithOutParam then begin FDialog.InitFreeNormBase; FDialog.InitTreeComplect; end else begin FDialog.ListCompon := CompForCompl; FDialog.BuildTree; end; FDialog.Caption := cMasterCompl_Msg18 + Compon.Name; EndProgress; if FDialog.ShowModal = mrOk then begin //здесь надо поставить разбор полётов формы мастера F_NormBase.FillCompl(Compon.ID, Compon.TreeViewNode); //нужно пройтись по дереву и проверить есть ли у компонента комплектующие end; if Assigned(FDialog) then FDialog.Free; // KolGl := 0; WithOutParam := false; ThereAreChilds := False; end; //end; // finally if Assigned(ChildsInterfaces) then ChildsInterfaces.Free; if Assigned(ListIdInterface) then ListIdInterface.Free; // ListForRazlInterf.Free; if Assigned(OperIntList2) then OperIntList2.Free; if Assigned(OperIntList) then OperIntList.Free; ///end; //end; ///////////////////////////// finally endProgress; if CreatedF_ParamMasterCompl then F_ParamMasterCompl.Free; if ListOfIdKonstrInterf <> Nil then ListOfIdKonstrInterf.Free; ListForRazlInterf.Free; If Assigned(InterfsForChild) then InterfsForChild.Free; InterfCompon.Free; if OperCompon <> nil then OperCompon.Free; CompForCompl.Free; NewCompons.Free; // Compon.Free; Catalog.Free; end; end; Procedure DelAllComplect(Acompon: TSCSComponent; AComponNode: TTreeNode); var i, j: integer; Child: TSCSComponent; ChildList: TSCSComponents; begin if Assigned(Acompon.ChildComplects) then begin ChildList := Acompon.ChildComplects; for i := 0 to ChildList.Count - 1 do begin Child := ChildList[i]; Child.TreeViewNode := F_NormBase.FindChildNodeByIDCompRel(AComponNode, Child.IDCompRel); F_NormBase.DelComplect(Child.IDCompRel, Child.IDTopComponent, ACompon.ID, Child.ID, AComponNode, cntComplect); end; end; end; procedure UpdateShelfDesignListNB(Acad: TPowerCad; ABox: TSCSComponent); var i, j: integer; FileName: string; TopIndent, LeftIndent: Double; DesignParams: TComponentDesignParams; aDescription, aName, aSign, aMark, ServiceStr: string; aWidth: Double; aHeightM: Double; aHeightU: Double; OldBoxHeight, OldBoxWidth: Double; NewBoxHeight, NewBoxWidth: Double; BoxHeightKoef, BoxWidthKoef: Double; SlotsWidth: Double; RulerHeight: Double; CadRulerWidth: Double; CadRulerHeight: Double; BegDrawPoint: TDoublePoint; ComponHeight, ComponWidth: Double; ToBoxPoints: TDoublePoint; ListFormatKoef: Double; aTopBound, aBottomBound, aLeftBound, aRightBound: Double; DescrObject: TRichText; DescrPoints: TDoublePoint; DescrLHandle: Integer; BlockFig: TBlock; ComponsList: TObjectList; aGraphicalImage: TMemoryStream; TM: TTextMetric; xCanvas: TMetafileCanvas; h, w: double; FigureGrp: TFigureGrp; ListX: double; // Tolik RefreshFlag: Boolean; // begin RefreshFlag := GCanRefreshCad; ComponsList := nil; // Tolik 18/05/2018 -- try {$if Defined(ES_GRAPH_SC)} FileName := ExeDir + '\.blk\TempStreamNB.pwb'; {$else} FileName := ExtractFileDir(Application.ExeName) + '\.blk\TempStreamNB.pwb'; {$ifend} TopIndent := 2.5 + 10 + 15; LeftIndent := 20 + 2; ToBoxPoints.x := 0; ToBoxPoints.y := 0; Acad.Clear(1); Acad.RecordUndo := false; ComponsList := GetFigureComponGraphicalImageNormBase(ABox); if Assigned(ComponsList) then begin for i := 0 to ComponsList.Count - 1 do begin DesignParams := TComponentDesignParams(ComponsList[i]); aGraphicalImage := TMemoryStream(DesignParams.GraphicalImage); aDescription := DesignParams.Description; aName := DesignParams.Name; aSign := DesignParams.NameShort; aMark := DesignParams.NameMark; ServiceStr := '; '; aWidth := DesignParams.Width * 100; aHeightM := DesignParams.Height * 100; aHeightU := DesignParams.HeightInUnits; // по свойствам Дизайна Шкафа сформировать подписи aDescription := ''; if aName <> '' then aDescription := aDescription + aName; if aName <> '' then begin if aDescription <> '' then aDescription := aDescription + ServiceStr; aDescription := aDescription + aSign; end; if aMark <> '' then begin if aDescription <> '' then aDescription := aDescription + ServiceStr; aDescription := aDescription + aMark; end; if aGraphicalImage <> nil then begin aGraphicalImage.SaveToFile(FileName); BlockFig := TBlock(Acad.InsertBlockwithFileName(1, FileName, LeftIndent, TopIndent)); // Сам ШКАФ if i = 0 then begin aTopBound := DesignParams.TopBound * 100; aBottomBound := DesignParams.BottomBound * 100; aLeftBound := DesignParams.LeftBound * 100; aRightBound := DesignParams.RightBound * 100; ListFormatKoef := 2;////////коэфициент OldBoxWidth := BlockFig.GetBoundRect.Right - BlockFig.GetBoundRect.Left; OldBoxHeight := BlockFig.GetBoundRect.Bottom - BlockFig.GetBoundRect.Top; ReScaleImage(BlockFig, OldBoxWidth, OldBoxHeight, aWidth * ListFormatKoef, aHeightM * ListFormatKoef); NewBoxWidth := BlockFig.GetBoundRect.Right - BlockFig.GetBoundRect.Left; NewBoxHeight := BlockFig.GetBoundRect.Bottom - BlockFig.GetBoundRect.Top; BlockFig.move(BlockFig.CenterPoint.x + NewBoxWidth / 2, BlockFig.CenterPoint.y + NewBoxHeight / 2); BoxHeightKoef := NewBoxHeight / OldBoxHeight; BoxWidthKoef := NewBoxWidth / OldBoxWidth; aTopBound := aTopBound * BoxHeightKoef; aBottomBound := aBottomBound * BoxHeightKoef; aLeftBound := aLeftBound * BoxWidthKoef; aRightBound := aRightBound * BoxWidthKoef; SlotsWidth := NewBoxWidth - aLeftBound - aRightBound; ToBoxPoints.x := BlockFig.CenterPoint.x; ToBoxPoints.y := BlockFig.CenterPoint.y - NewBoxHeight / 2 + aTopBound; // нарисовать линейку RulerHeight := aHeightM; RulerHeight := aHeightU; CadRulerWidth := aRightBound; CadRulerHeight := NewBoxHeight - aTopBound - aBottomBound; BegDrawPoint.x := LeftIndent * 2 + NewBoxWidth - aRightBound; BegDrawPoint.y := TopIndent * 2 + NewBoxHeight - aBottomBound; // DrawDesignRulerInMetres(AList, RulerHeight, CadRulerWidth, CadRulerHeight, BegDrawPoint); DrawDesignRulerInUnitsNB(Acad ,RulerHeight, CadRulerWidth, CadRulerHeight, BegDrawPoint); end else // Его комплектующие begin ComponWidth := BlockFig.GetBoundRect.Right - BlockFig.GetBoundRect.Left; ComponHeight := BlockFig.GetBoundRect.Bottom - BlockFig.GetBoundRect.Top; ReScaleImage(BlockFig, ComponWidth, ComponHeight, SlotsWidth{aWidth * ListFormatKoef}, aHeightM * ListFormatKoef); ComponHeight := BlockFig.GetBoundRect.Bottom - BlockFig.GetBoundRect.Top; ComponWidth := BlockFig.GetBoundRect.Right - BlockFig.GetBoundRect.Left; ToBoxPoints.y := ToBoxPoints.y + ComponHeight / 2; BlockFig.move(ToBoxPoints.x - BlockFig.CenterPoint.x, ToBoxPoints.y - BlockFig.CenterPoint.y); // Вывести описание DescrPoints.x := LeftIndent * 2 + NewBoxWidth + 2; DescrPoints.y := ToBoxPoints.y - 3;{3 * ListFormatKoef}; DescrLHandle := Acad.GetLayerHandle(1); // СОЗДАНИЕ ТЕКСТА ОПИСАНИЯ DescrObject := TRichText.create(-100, -100, -100, -100, 1, ord(psSolid), clBlack, ord(bsClear), clNone, DescrLHandle, mydsNormal, Acad); DescrObject.re.WordWrap := False; DescrObject.re.Font.Name := NameGostFont; DescrObject.re.Font.Size := 14; DescrObject.re.Font.Style := []; DescrObject.re.Lines.Clear; DescrObject.re.Lines.Add(FastReplace(aDescription,#13#10,' ')); // Tolik DescrObject.ttMetaFile:= TMetaFile.Create; DescrObject.ttMetafile.Enhanced := True; xCanvas := TMetafileCanvas.Create(DescrObject.ttMetafile, 0); xCanvas.Font.Name := DescrObject.re.Font.Name; xCanvas.Font.Size := DescrObject.re.Font.Size; xCanvas.Font.Style := DescrObject.re.Font.Style; GetTextMetrics(xCanvas.Handle, TM); h := TM.tmHeight / 4; w := (xCanvas.TextWidth(DescrObject.Re.Lines[0]) + 3) / 4; FreeAndNil(xCanvas); // Tolik DescrObject.ttMetaFile.Free; FreeAndNil(DescrObject); DescrObject := TRichText.create(DescrPoints.x, DescrPoints.y, DescrPoints.x + w, DescrPoints.y + h, 1, ord(psSolid), clBlack, ord(bsClear), clNone, DescrLHandle, mydsNormal, Acad); DescrObject.re.WordWrap := False; DescrObject.re.Font.Name := NameGostFont; DescrObject.re.Font.Size := 14; DescrObject.re.Font.Style := []; DescrObject.re.Lines.Clear; DescrObject.re.Lines.Add(FastReplace(aDescription,#13#10,' ')); Acad.AddCustomFigure(1, DescrObject, False); // === ToBoxPoints.y := ToBoxPoints.y + ComponHeight / 2; end; BlockFig.Deselect; end else if i = 0 then begin ShowMessage(cCommon_Mes12); if ComponsList <> nil then FreeAndNil(ComponsList); Exit; end; end; // Tolik -- 29/03/2017 -- GCanRefreshCaD := True; // for i := 0 to aCad.Figures.count - 1 do begin // TFigure(aCad.Figures[i]).Select; if ((not Tfigure(aCad.Figures[i]).deleted) and (TFigure(aCad.Figures[i]).Id > 0)) then Tfigure(aCad.Figures[i]).Select; end; // Acad.SelectAll(1); Acad.GroupSelection; // Tolik -- 28/03/2017 -- //FigureGrp := TFigureGrp(Acad.Selection[0]) -- тут наебочка, потому что после рефреша Када сбросится Selection if ACad.Selection.Count > 0 then FigureGrp := TFigureGrp(Acad.Selection[0]) else FigureGrp := TFigureGrp(Acad.Figures[Acad.Figures.Count - 1]); // NewBoxWidth := FigureGrp.GetBoundRect.Right - FigureGrp.GetBoundRect.Left; ListX := Acad.WorkWidth - (15 + 10 + 2 * 5) / 2; // сместить полностью if NewBoxWidth > ListX then begin FigureGrp.Scale(ListX / NewBoxWidth, ListX / NewBoxWidth); FigureGrp.move(LeftIndent - FigureGrp.ap1.x, TopIndent - FigureGrp.ap1.y); end else // сместить только вверх begin FigureGrp.move(LeftIndent - FigureGrp.ap1.x, TopIndent - FigureGrp.ap1.y); end; // FigureGrp.draw(Acad.DEngine, False); FigureGrp.Deselect; Acad.FAnySelected := False; end; if ComponsList <> nil then FreeAndNil(ComponsList); // F_MasterCompl.Shelf_Cad.DeselectAll(1); Acad.AutoRefresh := true; // Tolik 29/03/2017 -- // Acad.Refresh; Acad.Refresh; GCanRefreshCad := RefreshFlag; // // RefreshCAD(F_MasterCompl.Shelf_Cad); except on E: Exception do addExceptionToLogEx('U_MastreComplCommon.UpdateDesignListNormBase', E.Message); end; // Tolik 29/03/2017 -- GCanRefreshCad := RefreshFlag; // end; function GetFigureComponGraphicalImageNormBase(ACompon: TSCSComponent): TObjectList; var // SCSObject: TSCSCatalog; ProjectOwner: TSCSProject; CupboardComponent: TSCSComponent; ChildComponent: TSCSComponent; i: Integer; function GetComponentDesignParams(AComponent: TSCSComponent; ATopComponent: Boolean): TComponentDesignParams; var Interfaces: TInterfLists; ptrInterfae: TSCSInterface; //InterfaceInfo: TInterfaceInfo; SprInterface: TNBInterface; Compon: TSCSComponent; begin Result := nil; ptrInterfae := nil; if Assigned(AComponent) then begin Compon := TSCSComponent.Create(F_NormBase); Compon.LoadComponentByID(AComponent.ID); Compon.LoadInterfaces; Compon.LoadProperties; Result := TComponentDesignParams.Create; Result.Name := Compon.Name; Result.NameShort := Compon.NameShort; Result.NameMark := Compon.NameMark; Result.Description := Compon.GetNameForVisible(false); if Compon.Notice <> '' then Result.Description := Result.Description + '-' + Compon.Notice; Result.GraphicalImage := Compon.GetGraphicalImageBlk; Result.Height := Compon.GetPropertyValueAsFloat(pnHeight); Result.HeightInUnits := Compon.GetPropertyValueAsInteger(pnHeightInUnits); Result.Width := Compon.GetPropertyValueAsFloat(pnWidth); Result.BottomBound := Compon.GetPropertyValueAsFloat(pnBottomBound); Result.LeftBound := Compon.GetPropertyValueAsFloat(pnLeftBound); Result.RightBound := Compon.GetPropertyValueAsFloat(pnRightBound); Result.TopBound := Compon.GetPropertyValueAsFloat(pnTopBound); if Not ATopComponent then begin Interfaces := CupboardComponent.GetInterfacesThatConnectComponent(Compon); if Assigned(Interfaces.InterfList1) and Assigned(Interfaces.InterfList2) then begin if Interfaces.InterfList2.Count > 0 then ptrInterfae := Interfaces.InterfList2[0]; SprInterface := nil; if ptrInterfae <> nil then SprInterface := F_NormBase.GSCSBase.NBSpravochnik.GetInterfaceByGUID(ptrInterfae.GUIDInterface); if SprInterface <> nil then Result.Width := SprInterface.ConstructiveWidth; //if ptrInterfae <> nil then // InterfaceInfo := F_NormBase.DM.GetInterfaceInfo(ptrInterfae.ID_Interface); //Result.Width := InterfaceInfo.ConstructiveWidth; // Tolik -- 11/03/2017 -- а если есть хотя бы один? поэтому убить в конце //Interfaces.InterfList1.Free; //Interfaces.InterfList2.Free; end; Interfaces.InterfList1.Free; Interfaces.InterfList2.Free; // end; end; end; begin Result := nil; // SCSObject := nil; CupboardComponent := nil; CupboardComponent := ACompon; if Assigned(CupboardComponent) then begin Result := TObjectList.Create(true); Result.Add(GetComponentDesignParams(CupboardComponent, true)); for i := 0 to CupboardComponent.ChildComplects.Count - 1 do begin ChildComponent := CupboardComponent.ChildComplects[i]; if Assigned(ChildComponent) then Result.Add(GetComponentDesignParams(ChildComponent, false)); end; end; // end; end; { TF_CadNB } procedure DrawDesignRulerInUnitsNB(Acad: TPowerCad; aRulerHeight, aCadRulerWidth, aCadRulerHeight: Double; aBeginDrawPoint: TDoublePoint); var i: integer; Step: Double; MarkCount: Integer; LimitStep: Double; x1, y1, x2, y2: double; textx, texty: double; LHandle: Integer; LineObject: TLine; TextObject: TRichText; aTextHeight: Double; aTextWidth: Double; TextGroupObject: TFigureGrp; TextGroupList: TList; TM: TTextMetric; xCanvas: TMetafileCanvas; h, w: double; begin try LimitStep := 2; Step := aCadRulerHeight / aRulerHeight; MarkCount := Round(aRulerHeight); TextGroupList := TList.Create; for i := 0 to MarkCount - 1 do begin x1 := aBeginDrawPoint.x; y1 := aBeginDrawPoint.y - i * Step; y2 := aBeginDrawPoint.y - i * Step; if (i mod 5) = 0 then begin x2 := aBeginDrawPoint.x + 0.7 * aCadRulerWidth; aTextHeight := 3; aTextWidth := 1.5; end else begin x2 := aBeginDrawPoint.x + 0.5 * aCadRulerWidth; aTextHeight := 2; aTextWidth := 1; end; if Step < LimitStep then begin if (i mod 5) = 0 then begin LHandle := Acad.GetLayerHandle(1); LineObject := TLine.create(x1, y1, x2, y2, 1, ord(psSolid), clBlack, 1, LHandle, mydsNormal, Acad); LineObject.LockModify := True; LineObject.LockMove := True; TextObject := TRichText.create(-100, -100, -100, -100, 0, ord(psSolid), clBlack, ord(bsClear), clNone, LHandle, mydsNormal, Acad); TextObject.re.Font.Name := NameGostFont; //5555555555555555 TextObject.re.Font.Size := 12; TextObject.re.Font.Style := []; TextObject.re.Lines.Clear; TextObject.re.Lines.Add(IntToStr(i)); // Tolik TextObject.ttMetaFile:= TMetaFile.Create; TextObject.ttMetafile.Enhanced := True; xCanvas := TMetafileCanvas.Create(TextObject.ttMetafile, 0); xCanvas.Font.Name := TextObject.re.Font.Name; xCanvas.Font.Size := TextObject.re.Font.Size; xCanvas.Font.Style := TextObject.re.Font.Style; GetTextMetrics(xCanvas.Handle, TM); h := TM.tmHeight / 4; w := (xCanvas.TextWidth(TextObject.Re.Lines[0]) + 3) / 4; FreeAndNil(xCanvas); // Tolik TextObject.ttMetaFile.Free; FreeAndNil(TextObject); TextObject := TRichText.create(x2, y2, x2 + w, y2 + h, 1, ord(psSolid), clBlack, ord(bsClear), clNone, LHandle, mydsNormal, Acad); TextObject.re.Font.Name := NameGostFont; TextObject.re.Font.Size := 12; TextObject.re.Font.Style := []; TextObject.re.Lines.Clear; TextObject.re.Lines.Add(IntToStr(i)); TextObject.Move(- w, - h); TextObject.LockModify := True; TextObject.LockMove := True; TextGroupList.Add(LineObject); TextGroupList.Add(TextObject); end end else begin LHandle := Acad.GetLayerHandle(1); LineObject := TLine.create(x1, y1, x2, y2, 1, ord(psSolid), clBlack, 0, LHandle, mydsNormal, Acad); LineObject.LockModify := True; LineObject.LockMove := True; TextGroupList.Add(LineObject); if (i mod 5) = 0 then begin TextObject := TRichText.create(-100, -100, -100, -100, 1, ord(psSolid), clBlack, ord(bsClear), clNone, LHandle, mydsNormal, Acad); TextObject.re.Font.Name := NameGostFont; TextObject.re.Font.Size := 12; TextObject.re.Font.Style := []; TextObject.re.Lines.Clear; TextObject.re.Lines.Add(IntToStr(i)); // Tolik TextObject.ttMetaFile:= TMetaFile.Create; TextObject.ttMetafile.Enhanced := True; xCanvas := TMetafileCanvas.Create(TextObject.ttMetafile, 0); xCanvas.Font.Name := TextObject.re.Font.Name; xCanvas.Font.Size := TextObject.re.Font.Size; xCanvas.Font.Style := TextObject.re.Font.Style; GetTextMetrics(xCanvas.Handle, TM); h := TM.tmHeight / 4; w := (xCanvas.TextWidth(TextObject.Re.Lines[0]) + 3) / 4; FreeAndNil(xCanvas); TextObject.ttMetaFile.Free; FreeAndNil(TextObject); TextObject := TRichText.create(x2, y2, x2 + w, y2 + h, 1, ord(psSolid), clBlack, ord(bsClear), clNone, LHandle, mydsNormal, Acad); TextObject.re.Font.Name := NameGostFont; TextObject.re.Font.Size := 12; TextObject.re.Font.Style := []; TextObject.re.Lines.Clear; TextObject.re.Lines.Add(IntToStr(i)); TextObject.Move(- w, - h); TextObject.LockModify := True; TextObject.LockMove := True; TextGroupList.Add(TextObject); end; end; end; TextGroupObject := TFigureGrp.create(LHandle, Acad); for i := 0 to TextGroupList.Count - 1 do TextGroupObject.AddFigure(TFigure(TextGroupList[i])); Acad.AddCustomFigure(1, TextGroupObject, False); if TextGroupList <> nil then FreeAndNil(TextGroupList); except on E: Exception do addExceptionToLogEx('U_MasterComplCommon.DrawDesignRulerInUnitsNB', E.Message); end; end; end.