//{$A+,B-,C+,D+,E-,F-,G+,H+,I-,J-,K-,L+,M-,N+,O-,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1} //{$MINSTACKSIZE $00004000} //{$MAXSTACKSIZE $00100000} //{$IMAGEBASE $00400000} //{$APPTYPE GUI} unit U_CAD; interface uses Windows, U_LNG, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, PCPanel, PCDrawBox, PCDrawing, PowerCad, StdCtrls, pcMsbar, XP_Panel, ComCtrls, ToolWin, PCTypesUtils,DrawObjects,Menus, DlgBase, ExtDlgs, CommCtrl, PCLayerDlg, OleCtnrs, Buttons, PCgui, GuiStrings, DrawEngine, U_ESCadClasess, U_BaseCommon, U_SCSEngineTest, U_SCSComponent, U_SCSLists, cxLookAndFeelPainters, cxButtons, Mask, Math, AppEvnts, ShellCtrls, cxControls, cxContainer, cxEdit, cxTextEdit, cxMemo, Clipbrd, FPlan, siComp, siLngLnk, Jpeg, ActnList, U_HouseClasses, U_ArchCommon, XPMenu, ImgList; type {$IF Defined(SCS_PE)} {$I ToolBarType.pas} {$IFEND} TProjectUndoAction = class; TListUndoAction = class; TLinkUndoObject = class; TListUndoActionType = (uat_None, uat_Floor); TCheckBySelectedType = (cst_Move, cst_Delete); TListStampFields = record Margins: TDoubleRect; Developer: string[255]; //15.11.2011 - разработал Checker: string[255]; //15.11.2011 - проверил ListSign: string[255]; //02.10.2012 - Обозначение док-та MainEngineer: string[255]; //02.10.2012 - Главный инженер проекта Approved: string[255]; //02.10.2012 - Утвердил DesignStage: string[255]; //02.10.2012 - Стадия проектир. end; TF_CAD = class(TForm) panView: TPanel; tbView: TToolBar; tbShowRuler: TToolButton; tbShowGrid: TToolButton; tbShowGuides: TToolButton; tbSnapGrid: TToolButton; tbSnapGuides: TToolButton; tbSnapNearObject: TToolButton; tbIncView: TToolButton; tbDecView: TToolButton; tbActualsize: TToolButton; PCad: TPowerCad; HorScroll: TScrollBar; VerScroll: TScrollBar; panProtocol: TPanel; mProtocol: TcxMemo; sbView: TStatusBar; ToolButton4: TToolButton; ToolButton5: TToolButton; tbShowConnFullness: TToolButton; tbShowCableFullness: TToolButton; tbShowCableChannelFullness: TToolButton; sDiv: TSplitter; ApplicationEvents1: TApplicationEvents; tbShowTracesLengthLimit: TToolButton; tbNoMoveConnectedObjects: TToolButton; lng_Forms: TsiLangLinked; tbShowDisconnectedObjects: TToolButton; ToolButton2: TToolButton; tbShowDefectObjects: TToolButton; TimerFindSnap: TTimer; ToolButton1: TToolButton; tbShowPathLengthType: TToolButton; tbShowPathTraceLengthType: TToolButton; TimerMovePan: TTimer; LabelHighlight: TLabel; XPMenu: TXPMenu; PopupMenuDisconected: TPopupMenu; MItem_ConnPoints: TMenuItem; Highlightdisconnected1: TMenuItem; Listofconnecteddisconnected1: TMenuItem; MItem_ConnLine: TMenuItem; MItem_NotConnPoint: TMenuItem; MItem_NotConnLine: TMenuItem; MItem_CableNoCanal: TMenuItem; TimerDblClk: TTimer; // Обработчик на закрытии формы с КАДом procedure FormCreate(Sender: TObject); // Обработчик на активации формы с КАДом procedure FormActivate(Sender: TObject); // Обработчик при закрытии формы с КАДом procedure FormClose(Sender: TObject; var Action: TCloseAction); // Обработчик выдачи запроса при попытке закрыть форму с КАДом procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); // Обработчик нажатия клавиши на КАДе procedure PCadKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); // Обработчик отжатия нажатой клавиши на КАДе procedure PCadKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); // Обработчик при клике на КАДе procedure PCadSurfaceClick(Sender: TObject); // Обработчик при двойном клике на КАде procedure PCadSurfaceDblClick(Sender: TObject); // Обработчик при попытке вызвать контекстное меню КАДа (специально перекрыто, так как у нас свое) procedure PCadPopMenuClicked(Sender: TObject; MenuIndex: Integer); // Обработчик нажатия кнопки мыши на КАДе procedure PCadSurfaceMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Double); // Обработчик отжатия нажатой кнопки мыши на КАДе procedure PCadSurfaceMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Double); // Обработчик скроллирования вниз на форме с КАДом procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); // Обработчик скроллирования вверх на форме с КАДом procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); // Обработчик при перемещении мыши на КАДе procedure PCadSurfaceMove(Sender: TObject; Shift: TShiftState; X, Y: Double); // Обработчик при перемещении объекта на КАДе procedure PCadFigureMoved(Sender: TObject; Figure: TFigure; dx, dy: Double); // Обработчик после модификации объекта на КАДе procedure PCadFigureModify(Sender: TObject; Figure: TFigure); // Обработчик после выделения объекта на КАДе procedure PCadFigureSelect(Sender: TObject; Figure: TFigure); // Обработчик после смены выделения на КАДе procedure PCadSelectionChange(Sender: TObject); // Обработчик после вставки объекта на КАД (или просто создание или скажем вставка картинки/блока) procedure PCadObjectInserted(Sender: TObject; Reason: TInsertReason); // Обработчик перед физическим удалением объекта с КАДа procedure PCadBeforeDelete(Sender: TObject; Figure: TFigure; var CanDelete: Boolean); // Обработчик при возникновения какого либо события на КАДе (оброботка по ID события) procedure PCadGUIEvent(Sender: TObject; EventId, Numval: Integer; StrVal: String; DblVal: Double; CEnable: Boolean); // Обработчик на ресайзе форма с КАДом procedure FormResize(Sender: TObject); // Обработчик DragOver (тащишь c НБ что то и ведешь над КАДом) procedure PCadSurfaceDragOver(Sender, Source: TObject; X, Y: Double; State: TDragState; var Accept: Boolean); // Обработчик DragDrop (Бросаешь на КАДом, то что ты тащил) procedure PCadSurfaceDragDrop(Sender, Source: TObject; X, Y: Double); // Обрабочик изменения масштаба КАДа procedure PCadScaleChanged(Sender: TObject); // Уставновка горизонтального скролла PowerCad procedure HorScrollScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer); // Уставновка вертикального скролла PowerCad procedure VerScrollScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer); // Обработчик на деактивации формы с КАДом procedure FormDeactivate(Sender: TObject); // Обработчик отлавливания событий на КАДе (прописаны нужные нам события) procedure ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean); // Обработчик на скроллировании на форме с КАДом procedure FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); // перемещение сплитера изменяющего размеры поля протокола procedure sDivMoved(Sender: TObject); // Обработчик на Refresh КАДа procedure FCADOnRefresh(Sender: TObject); // Обработчик при нажатии клавиши на КАДе (нажатие и отжатие) Procedure FCADOnKeyStroke(Sender:TObject;Key:Word;Shift:TShiftState; var CanHandle:Boolean); // Обработчик на изменении MapScale на КАДе procedure PCadMapScaleChanged(Sender: TObject); // Обработчик на проверке ресайза сплита для протокола procedure sDivCanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); procedure FOnBeforeMove(Sender: TObject; Figure: TFigure; aDeltaX: double = -999999; aDeltaY: double = -999999); procedure FOnMoveByArrows(Sender: TObject; dx, dy: Double; var CanMove: Boolean); procedure PCadAfterDelete(Sender: TObject); procedure TimerFindSnapTimer(Sender: TObject); procedure tbDropDownClick(Sender: TObject); procedure TimerMovePanTimer(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormCanResize(Sender: TObject; var NewWidth, NewHeight: Integer; var Resize: Boolean); procedure PopupMenuDisconectedPopup(Sender: TObject); procedure TimerDblClkTimer(Sender: TObject); private { Private declarations } FCurrentLayer: Integer; // текущий слой, для чтения свойства FCurrX: Double; // drag-drop X FCurrY: Double; // drag-drop Y FDragX: Double; // drag-drop X FDragY: Double; // drag-drop Y FDeltaX: Double; // Mouse delta X FDeltaY: Double; // Mouse delta Y FPanLastRefeshTick: Cardinal; FDragOverTick: Cardinal; FFirstActivate: boolean; // установка текущего слоя procedure SetCurrentLayer(ALNbr: Integer); // при вызове контекстного меню на КАДе procedure FormCADPopupMenu(X, Y: Double; aAllowSelectInPM: Boolean); // Установка пунктов меню для контекстного меню Трассы procedure SetMenuItemsForOrthoLine(aLine: TOrthoLine); // Установка пунктов меню для контекстного меню коннектора procedure SetMenuItemsForConnector(aConn: TConnectorObject); // Установка пунктов меню для контекстного меню Объекта procedure SetMenuItemsForObject(aObject: TConnectorObject); protected FClickSCSFiguresList: TList; //21.06.2013 - Список объектов под курсором на клике // Обработчик получения объекта для выделения procedure PCadGetFigureToSelect(Sender: Tobject; var Figure: TFigure; x, y: double); //#From Oleg# //04.10.2010 procedure PCadGetModPointToSelect(Sender: Tobject; var ModPoint: TModPoint; x, y: double); //#From Oleg# //23.08.2011 procedure PCadBeforeEndTrace(Sender: TObject); //25.11.2011 function PCadCheckPrnWithOffset(Sender: Tobject): Boolean; //29.11.2011 procedure PCadTraceDraw(Sender: TObject; Figure: TFigure; DeltaX: double = -999999; DeltaY: double = -999999); procedure PCadFigureEdit(Sender: TObject; Figure: TFigure; DeltaX: double = -999999; DeltaY: double = -999999); public { Public declarations } FNeedDelete: Boolean; FWaitWork: Boolean; // приостановка работы, пока не выполниться цикл операций (применяется для удаления объектов) FShowLinesLength: Boolean; // показывать длинну линии FShowConnectorsCaptions: Boolean; // показывать подписи к коннекторам FShowLinesNotes: Boolean; // показывать выноски к линиям FShowConnectorsNotes: Boolean; // показывать выноски к коннекторам FShowLinesCaptions: Boolean; // показывать подписи к линиям FAutoSelectTrace: Boolean; // автовыделять трассу до сервера // показывать заполненность объектов на КАДе FShowConnFullness: Boolean; FShowCableFullness: Boolean; FShowCableChannelFullness: Boolean; FShowDefectObjects: Boolean; FShowDisconnectedObjects: Boolean; // показывать объекты, которые ни к чему не присоединены FShowTracesLengthLimit: Boolean; // показывать трассы с превышающей длиной FAutoTraceBySelected: Boolean; // автотрассировать по выбранным объектам FNoMoveConnectedObjects: Boolean; // Не перемещать подсоединенные объекты FCreateObjectOnClick: Boolean; // Автосоздавать объекты при клике мышкой FGroupListObjectsByType: Boolean; // группировать FPutCableOnTrace: Boolean; // Ложить кабель на участки трассы FShowRaise: Boolean; // отображать/не отображать с-п //FShowRaiseDrawFigure: Boolean; // Отображать УГО на с-п FKeepLineTypesRules: Boolean; // соблюдать правила для всех трасс LastSnapGridStatus: Boolean; // последний сохраненный статус привязки к сетке FShowCabinetsNumbers: Boolean; // отображать номера кабинетов на КАД FShowCabinetsBounds: Boolean; // отображать границы кабинетов на КАД FCADListID: Integer; // ID КАД листа FCADListIndex: Integer; // Индекс КАД листа FJoinedBoxIDForDesignList: Integer; // для листа - Дизайна шкафа, ID Шкафа с которого сделан лист FJoinedListIDForDesignList: Integer; // для листа - Дизайна шкафа, ID листа с которого сделан лист FDesignListShowName: Boolean; // для листа - Дизайна шкафа, показывать наименование FDesignListShowSign: Boolean; // для листа - Дизайна шкафа, показывать обозначение FDesignListShowMark: Boolean; // для листа - Дизайна шкафа, показывать маркировку FShowCableChannelsOnly: Boolean; // показывать на КАДе только объекты с кабельными каналами FAllowSuppliesKind: Boolean; // учитывать вид поставки при прокладке кабеля (разделять трассы) FDefaultTraceWidth: Integer; // ширина трассы по умолчанию FDefaultTraceStepRotate: Integer; // шаг угла поворота по умолчанию FRoomHeight: Double; // высота этажа FFalseFloorHeight: Double; // высота подвесного потолка FConnHeight: Double; // высота ТО (точ. объект) FLineHeight: Double; // высота ЛО (лин. объект) FLengthKoef: Double; // процент запаса длины кабеля FCableChannelFullnessKoef: Double; // Коэффициент заполненности кабельных каналов FPortReserv: Double; // резерв со стороны порта FMultiportReserv: Double; // рензерв со стороны мультипорта FTwistedPairMaxLength: Double; // ограничение по длине кабеля для витой пары FDefaultBlockStep: Double; // шаг УГО трассы по умолчанию FCADProjectName: String; // имя проекта FCADListName: String; // имя листа FCADListFileName: String; // имя файла для отката FNotePrefix: string; // префикс отображения для кол-ва (в подписи) FFontName: string; // Имя шрифта FListSettings: TListSettingRecord; FRemFigures: TList; // лист удаленных объектов (удаляются объекты все вместе на обработчике из этого листа) FActiveNet: TNet; // текущий FPlan FListType: TListType; // Тип листа (обычный или дизайн шкафа) FLineTracingType: TLineTracingType; // Тип прокладки трассы/кабеля/короба // показ полные/краткие подписи к объектам FShowObjectCaptionsType: TShowType; FShowLineCaptionsType: TShowKind; // показ полные/краткие выноски к объектам FShowObjectNotesType: TShowType; FShowLineNotesType: TShowKind; FCadStampType: TStampType; // тип рамки листа (простой, расширенный ...) FCadStampLang: TStampLang; // язык для рамки листа (рус, укр) //FCadStampMargins: TDoubleRect; //10.11.2011 - отступы рамки листа //FCADStampDeveloper: string; //15.11.2011 - разработал //FCADStampChecker: String; //15.11.2011 - проверил FStampFields: TListStampFields; FShowNetworkTypes: TObjectNetworkTypes; // отображение по типам сетей FDefaultTraceColor: TColor; // текущий цвет отображения участков трассы FDefaultTraceStyle: TPenStyle; // текущий стиль отображения участков трассы FClickType: TClickType; // тип клика (уже не юзается) FDefaultCornerType: TCornerType; // тип уголка по умолчанию // рамка листа FFrameFileName: string; // имя файла с которого загружена рамка листа FFrameProjectName: TRichText; // на рамке листа, объект - название проекта FFrameListName: TRichText; // на рамке листа, объект - название листа FFrameCodeName: TRichText; // на рамке листа, объект - код FFrameIndexName: TRichText; // на рамке листа, объект - код FFrameStampDeveloper: TRichText; // на рамке листа, объект - разработал FFrameStampChecker: TRichText; // на рамке листа, объект - проверил FFrameObjects: TStringList; FShowMainStamp: Boolean; // показывать основной штамп на рамке листа FShowUpperStamp: Boolean; // показывать верхний штамп на рамке листа FShowSideStamp: Boolean; // показывать боковой штамп на рамке листа FShowPathLengthType: TShowPathLengthType; // sltPoints, sltInner, sltOuter FShowPathTraceLengthType: TShowPathLengthType; // --- FCurrPCadScrollX: Integer; // текущая позиция скролла по Х FCurrPCadScrollY: Integer; // текущая позиция скролла по Y FDimLinesType: TDimLinesType; // тип размерных линий FLinesCaptionsColor: Integer; // цвет подписей к линиям FConnectorsCaptionsColor: Integer; // цвет подписи к коннекторам FLinesNotesColor: Integer; // цвет выносок к линиям FConnectorsNotesColor: Integer; // цвет выносок к коннекторам FLinesCaptionsFontSize: Integer; // размер шрифта для подписей к линиям FConnectorsCaptionsFontSize: Integer; // размер шрифта для подписей к коннекторам FLinesNotesFontSize: Integer; // размер шрифта для выносок к линиям FConnectorsNotesFontSize: Integer; // размер шрифта для выносок к коннекторам FLinesCaptionsFontBold: Boolean; // жирность подписи к линиям FCrossATSFontSize: Integer; // размер шрифта для подписей к кросс АТС FCrossATSFontBold: Boolean; // жирность для подписи к кросс АТС FDistribCabFontSize: Integer; // размер шрифта для подписей к РШ FDistribCabFontBold: Boolean; // жирность для подписи к РШ FPrintType: TPrintType; // тип печати (цветная, ч-б) FSCSType: TSCSType; // тип СКС (внутренняя, внешняя) FNewTraceLengthType: TTraceLengthType; // новые фичи (Автокад) FAutoCadMouse: Boolean; // мышь автокад FScaleByCursor: Boolean; // позиционировать по курсору FAutoPosTraceBetweenRM: Boolean; // автопозиционирование трасс между двумя РМ (на их высоте) // для трассировки по отмеченным FTracingList: TList; // лист с текущим путем при трассировке FTracingListIndex: Integer; // текущий порядковый номер пути из всех возможных путей трассировки FIsDragOver: Boolean; // если сейчас режиим DragOver // кол-во листов FListCountX: Integer; // кол-во листов по горизонтали FListCountY: Integer; // кол-во листов по вертикали // для Ctrl+Z и Ctrl+Y // лист в котором хранятся слепки для Ctrl+Z FSCSUndoList: TList; // лист в котором хранятся слепки для Ctrl+Y FSCSRedoList: TList; // флаг, можно сейчас делать слепок FCanSaveForUndo: Boolean; FUndoCount: Integer; //10.09.2010 // директория для сохранения слепка FUndoDir: string; FRedoDir: string; // лист СКС объектов для поднятия со Стрима FUndoFiguresList: TList; // статус - поднимать с листа FUndoFiguresList FUndoStatus: Boolean; // текущее кол-во активных действий на КАДе FActiveActions: LongInt; // кол-во действий после которых следует делать слепок FSaveUndoCount: Integer; FWasDeleteQuery: Boolean; FActiveHouse: THouse; FSCSFigures: TRapObjectList; //04.11.2011 FSCSFiguresLockCount: Integer; //07.11.2011 FPopupScrPoint: TPoint;//04.05.2012 property CurrentLayer: Integer read FCurrentLayer write SetCurrentLayer; // текущий слой property CurrX: Double read FCurrX write FCurrX; property CurrY: Double read FCurrY write FCurrY; property DragX: Double read FDragX write FDragX; // drag-drop X property DragY: Double read FDragY write FDragY; // drag-drop Y // === ScrollBars === // если есть горизонтальные скроллы Function IfVisibleHorScrollBar: Boolean; // если есть вертикальные скроллы Function ifVisibleVerScrollBar: Boolean; // максимальная позиция скроллов PCAD Function GetMaxScrollsPosition: TPoint; // получение размера скроллов PCAD Function GetPageSizesScrolls: TPoint; // установка позиции скроллов PCAD Procedure Set_PCad_HorScroll; Procedure Set_PCad_VerScroll; // установка позиции наших скроллов Procedure Set_SCS_HorScroll; Procedure Set_SCS_VerScroll; // изменение скролов при изменении размеров листа КАД Procedure ChangeScrollsOnChangeListSize; // перемещать КАД в режиме паноромирования Procedure MoveCADOnPan(ADeltaX, ADeltaY: double); // проверка на скроллирование КАДа при Шедоу трассы или перемещение за ТО, если подводит в краю КАДа Function CheckScrollingOnTracing(ax, ay: double): Boolean; // скроллирование КАДа при Шедоу трассы или перемещение за ТО, если подводит в краю КАДа Procedure ScrollCADOnTracing(adeltax, adeltay: double); // установить масштаб КАДа Procedure SetZoomScale(aScale: Integer); // Событие на выделение объекта на КАД (если вариантов несколько то выбор что именно выделить) procedure SelectFigureEvent(Sender: TObject); // Событие на Дропе объекта на КАД (с НБ) procedure DropFigureEvent(Sender: TObject); // Событие на привязке к Объекту procedure SnapFigureEvent(Sender: TObject); // процедура после DragDrop procedure DoDragDrop(X, Y: Double); procedure DoFragDropDesigList; procedure AutoDivideTraceOnAppendCable(aTrace: TOrthoLine; aLength: Double); // для масштабирования - получение коэффициентов для формулы function GetScaleKoefs: TDoublePoint; // получение угла объекта Function GetFigureAngle(AP1x, AP1y, AP2x, AP2y: Double): Double; // получить последний выделенный на КАДе СКС объект (орттолиния или коннектор) function GetLastSelectedSCSObject: TFigure; // повернуть группу объектов на 5 градусов вперед или назад через клаву procedure RotateObjectsByKeyboard(aObjects: TList; aAngle: Double); // Ctrl+Z ... // сохранить текущее состояние в темповый файл function SaveForUndo(aType: TListUndoActionType; aSavePM: Boolean; aIsProject: Boolean; aProjectIndex: Integer = 0): TListUndoAction; function SaveForUndoNormalList(aType: TListUndoActionType; aSavePM: Boolean; aIsProject: Boolean; aProjectIndex: Integer = 0): TListUndoAction; function SaveForUndoProjectPlan(aType: TListUndoActionType; aSavePM: Boolean; aIsProject: Boolean; aProjectIndex: Integer = 0): TListUndoAction; function SaveForUndoDesignList(aType: TListUndoActionType; aSavePM: Boolean; aIsProject: Boolean; aProjectIndex: Integer = 0): TListUndoAction; // поднять предыдущее состояние из темпового файла procedure SCSUndoNormalList; procedure SCSUndoProjectPlan; procedure SCSUndoDesignList; procedure OnAfterUndo; // очистить UndoList procedure ClearUndoList(AFreeList: Boolean=true); function BeginSaveForUndo(aType: TListUndoActionType; aSavePM: Boolean; aIsProject: Boolean; aProjectIndex: Integer = 0): TListUndoAction; procedure EndSaveForUndo; // Ctrl+Y ... // сохранить текущее состояние в темповый файл function SaveForRedo(aType: TListUndoActionType; aSavePM: Boolean; aIsProject: Boolean; aProjectIndex: Integer = 0): TListUndoAction; function SaveForRedoNormalList(aType: TListUndoActionType; aSavePM: Boolean; aIsProject: Boolean; aProjectIndex: Integer = 0): TListUndoAction; function SaveForRedoProjectPlan(aType: TListUndoActionType; aSavePM: Boolean; aIsProject: Boolean; aProjectIndex: Integer = 0): TListUndoAction; function SaveForRedoDesignList(aType: TListUndoActionType; aSavePM: Boolean; aIsProject: Boolean; aProjectIndex: Integer = 0): TListUndoAction; procedure SetShowPathLengthType(AShowPathLengthType: TShowPathLengthType); procedure SetShowPathTraceLengthType(AShowPathLengthType: TShowPathLengthType); procedure SetParamsByShowPathLengthType(AToolButton: TToolButton; AShowPathLengthType: TShowPathLengthType; APoints, AInner, AOuter: TCustomAction); // поднять предыдущее состояние из темпового файла procedure SCSRedoNormalList; procedure SCSRedoProjectPlan; procedure SCSRedoDesignList; // очистить UndoList procedure ClearRedoList(AFreeList: Boolean=true); // очистить все СКС объекты procedure ClearSCSFigures; procedure ClearPlanFigures; // проверить делать ли сейчас слепок function CheckMakeSaveForUndo: boolean; procedure BuildPopupFiguresByLevel(AFiguresList:TList; AOnClick: TNotifyEvent; AX: Double=-1; AY: Double=-1); function RemoveFigureFromSelected(AFigure: TFigure): Integer; procedure RemoveSelectedWithoutCheck; //13.03.2012 - удалить все выделенные, без проверки событием OnFigureDel //function OnGetShowPathLength(Sender: TObject): Double; //function OnGetShowPathTraceLength(Sender: TObject): Double; function OnGetShowPathLengthType(Sender: TObject): TShowPathLengthType; function OnGetShowPathTraceLengthType(Sender: TObject): TShowPathLengthType; procedure AddSCSFigure(AFigure: TFigure); procedure RemoveSCSFigure(AFigure: TFigure); procedure LockSCSFigures; procedure UnLockSCSFigures; procedure ClearFrameFigures; //17.11.2011 procedure SetFrameFigures; //18.11.2011 procedure DeleteLayerAllObjects(aLayerNumber: Integer; aQuast: Boolean); procedure DeleteSelection(aQuast: Boolean); procedure View3D; function Get3DModel: TObject; function GetMsgLengthToPoint(const aLen: Double): String; function CreateConnector(x,y,z: Double; aLayerHandle: Integer; aConnectorType: TConnectorType; const aName: string): TConnectorObject; function CreateConnForFloorRaise(x,y,z: Double; aLayerHandle: Integer): TConnectorObject; end; TProjectUndoAction = class(TMyObject) FLinkUndoObject: TList; Constructor Create; Destructor Destroy; override; end; TListUndoAction = class(TMyObject) ActionType: TListUndoActionType; FIndex: Integer; FProjectUndoAction: TProjectUndoAction; FCadFileName: string; FBasePath: string; FIsProject: Boolean; FSavePM: Boolean; Constructor Create(aType: TListUndoActionType; aSavePM: Boolean); Destructor Destroy; override; end; TLinkUndoObject = class(TMyObject) FCad: TF_CAD; FListUndoAction: TListUndoAction; Constructor Create; Destructor Destroy; override; end; {$IF Defined(SCS_PE)} {$I ToolBarType2.pas} {$IFEND} var F_CAD: TF_CAD; GBeginPoint: TDoublePoint; // точка начала линии, при повороте линии позволяет автовычислять угол поворота GTracedFigure: boolean = False; // тащут ли сейчас какой то объект GListNode: TTreeNode = nil; // для МП - текущая ветвь в которую копируется объект (хз сильно ли оно щас надо) implementation uses USCS_main, U_MAIN, Types, U_Navigator, U_SizePos, U_Layers, U_SCSObjectsProp, U_TrunkSCS, U_Constants, U_BaseConstants, U_Common, U_DimLineDialog, U_ObjsProp, U_BlockParams, U_InputMark; {$R *.dfm} procedure TF_CAD.FormCreate(Sender: TObject); var CrLayer: TLayer; i: integer; //08.09.2011 Buffer: array[0..1023] of Char; begin try FSCSFigures := TRapObjectList.Create(false, false); FSCSFiguresLockCount := 0; FClickSCSFiguresList := TList.Create; //17.11.2011 объекты рамки листа FFrameProjectName := nil; FFrameListName := nil; FFrameCodeName := nil; FFrameIndexName := nil; FFrameStampDeveloper := nil; FFrameStampChecker := nil; FFrameObjects := TStringList.Create; FFirstActivate := True; for i := 1 to ctFrameTypeCount do FFrameObjects.Add(IntToStr(i*100)); // от 100 до 600 PCad.RangeCheck := True; WindowState := wsMinimized; GNowRefresh := False; GIsDrawShadow := False; FWaitWork := False; Self.Tag := Self.Handle; PCAD.MaxScale := cntCADMaxScale; // PCad.MapScale := 100; // Register Classes PCad.RegisterFigureClass(TOrthoLine); PCad.RegisterFigureClass(TConnectorObject); PCad.RegisterFigureClass(TFigureGrpMod); PCad.RegisterFigureClass(TFigureGrpNotMod); PCad.RegisterFigureClass(TTextMod); PCad.RegisterFigureClass(TFrame); PCad.RegisterFigureClass(TSCSHDimLine); PCad.RegisterFigureClass(TSCSVDimLine); PCad.RegisterFigureClass(TRichTextMod); PCad.RegisterFigureClass(TPlanTrace); PCad.RegisterFigureClass(TPlanObject); PCad.RegisterFigureClass(TPlanConnector); PCad.RegisterFigureClass(TInsertCol); PCad.RegisterFigureClass(TWallPath); //PCad.RegisterFigureClass(TWallDivPath); PCad.RegisterFigureClass(TWallRect); PCad.RegisterFigureClass(TCabinet); PCad.RegisterFigureClass(TCabinetExt); PCad.RegisterFigureClass(TCabinetNumber); PCad.RegisterFigureClass(TCadNorms); PCad.RegisterFigureClass(TSCSFigureGrp); PCad.RegisterFigureClass(THouse); PCad.RegisterFigureClass(THouseTool); PCad.RegisterFigureClass(TApproachTool); GCadForm := Self; SCSEngine := TSCSEngine.Create(self); FRemFigures := TList.Create; PCad.OnBeforeDelete := PCadBeforeDelete; PCad.OnGUIEvent := PCadGUIEvent; PCad.OnKeyDown := PCadKeyDown; PCad.OnKeyUp := PCadKeyUp; PCad.Font.Charset := ANSI_CHARSET; PCad.OnMouseWheel := nil; // при обновлении КАДа PCad.OnRefresh := FCADOnRefresh; // при нажатии клавиши PCad.OnKeyStroke := FCADOnKeyStroke; // перед тем как передвинуть группу объектов PCad.OnBeforeMove := FOnBeforeMove; // перед тем как передвинуть группу объектов стрелками курсора PCad.OnMoveByArrows := FOnMoveByArrows; // создать слои // Слой - подложка (для инструментов PowerCad) - 1 CrLayer := TLayer.create(cCad_Mes1); PCad.Layers.Add(CrLayer); // Слой - СКС (для инструментов СКС) - 2 CrLayer := TLayer.create(cCad_Mes2); PCad.Layers.Add(CrLayer); // Слой - подписи к линейным обьектам СКС - 3 CrLayer := TLayer.Create(cCad_Mes3); PCad.Layers.Add(CrLayer); // Слой - подписи к точечным обьектам СКС - 4 CrLayer := TLayer.Create(cCad_Mes4); PCad.Layers.Add(CrLayer); // Слой - выноски к линейным объектам СКС - 5 CrLayer := TLayer.Create(cCad_Mes5); PCad.Layers.Add(CrLayer); // Слой - выноски к точечным объектам СКС - 6 CrLayer := TLayer.Create(cCad_Mes6); PCad.Layers.Add(CrLayer); // Слой - рамка листа - 7 CrLayer := TLayer.create(cCad_Mes7); PCad.Layers.Add(CrLayer); // Слой - Архитектурное проектирование - 8 CrLayer := TLayer.create(cCad_Mes8); PCad.Layers.Add(CrLayer); FActiveNet := Tnet.create(8, PCTypesUtils.mydsNormal, PCad); PCad.AddCustomFigure(8, FActiveNet, False); ActiveNet := FActiveNet; // Слой - Кабинеты - 9 CrLayer := TLayer.create(cCad_Mes29); PCad.Layers.Add(CrLayer); // Engine if F_Navigator <> nil then begin F_Navigator.PCadNavigator.Figures := PCad.Figures; ReAssignNavigatorParams; end; GListNode := Nil; // Текущий удаленный обьект из МП GDeletedFromPMFigure := Nil; // GPopupFigure := Nil; GFigureSnap := Nil; GPrevFigureSnap := nil; GFigureTraceTo := Nil; GPrevFigureTraceTo := Nil; GClickIndex := 0; // ПАРАМЕТРЫ ЛИСТА FRoomHeight := GRoomHeight; FFalseFloorHeight := GFalseFloorHeight; FConnHeight := GConnHeight; FLineHeight := GLineHeight; FLineTracingType := ltt_FromFloor; // переменные для хранения настроек FShowLinesLength := True; FShowLinesCaptions := False; FShowConnectorsCaptions := True; FAutoSelectTrace := True; FShowConnFullness := False; FShowCableFullness := False; FShowCableChannelFullness := False; FShowDefectObjects := False; FShowTracesLengthLimit := False; FPutCableOnTrace := False; // показ полное/краткое название объектов FShowObjectCaptionsType := st_Short; // группировать FGroupListObjectsByType := False; FNoMoveConnectedObjects := False; FAutoTraceBySelected := False; // тип отображения сетей FShowNetworkTypes := [nt_All]; LastSnapGridStatus := True; FClickType := ct_Single; // отображать с-п FShowRaise := True; // FJoinedBoxIDForDesignList := -1; FJoinedListIDForDesignList := -1; FDesignListShowName := False; FDesignListShowSign := False; FDesignListShowMark := False; GSavedZoomScale := PCad.ZoomScale; // LIST GTempJoinedOrtholinesList := TList.Create; GTempJoinedConnectorsList := TList.Create; GTempJoinedLinesConnectors := TList.Create; GSnapFiguresList := TList.Create; try PCad.RulerVisible := True; except end; FCadStampLang := stl_ukr; //FCadStampMargins := DoubleRect(20,5,5,5); //10.11.2011 //FCADStampDeveloper := ''; //15.11.2011 - разработал //FCADStampChecker := ''; //15.11.2011 - проверил ZeroMemory(@FStampFields, SizeOf(FStampFields)); //02.10.2012 - поля рамки - разработал, проверил ... FFontName := 'GOST'; Font.Name := FFontName; // лист хранения выбранных объектов FCurrPCadScrollX := 0; // текущая позиция скролла по Х FCurrPCadScrollY := 0; // текущая позиция скролла по Y GLastTracedLinePoints1 := DoublePoint(-10000, -10000); GLastTracedLinePoints2 := DoublePoint(-10000, -10000); SetLength(GTempDrawFigureAP, 4); FTracingList := nil; FTracingListIndex := 0; FIsDragOver := False; FShowCableChannelsOnly := False; FListSettings := GetDefaultListSettings(true); //28.05.2013 - чтобы не переписывать набор параметров на объект листа FSCSUndoList := TList.Create; FSCSRedoList := TList.Create; //08.09.2011 SetString(FUndoDir, Buffer, GetTempPath(Sizeof(Buffer) - 1, Buffer)); //08.09.2011 FUndoDir := FUndoDir + 'Undo\'; //08.09.2011 if not DirectoryExists(FUndoDir) then //08.09.2011 CreateDir(FUndoDir); FUndoDir := GetPathToUndoDir; //08.09.2011 SetString(FRedoDir, Buffer, GetTempPath(Sizeof(Buffer) - 1, Buffer)); //08.09.2011 FRedoDir := FRedoDir + 'Redo\'; //08.09.2011 if not DirectoryExists(FRedoDir) then //08.09.2011 CreateDir(FRedoDir); FRedoDir := GetPathToRedoDir; FCanSaveForUndo := True; FUndoCount := 0;//10.09.2010 FUndoFiguresList := TList.Create; FUndoStatus := False; FWasDeleteQuery := False; FAllowSuppliesKind := True; FNeedDelete := False; if (GCurrProjUnitOfMeasure = umSM) or (GCurrProjUnitOfMeasure = umM) then PCad.RulerSystem := rsMetric else if (GCurrProjUnitOfMeasure = umIn) or (GCurrProjUnitOfMeasure = umFt) then PCad.RulerSystem := rsWhitworth; FCADListFileName := GetUniqueFileName('', enTmp); tbShowConnFullness.PopupMenu := FSCS_Main.pmConnectedPoints; tbShowCableFullness.PopupMenu := FSCS_Main.pmConnectedLines; //FSCS_Main.XPMenu.Active := false; //FSCS_Main.XPMenu.Active := True; FActiveHouse := nil; FDragX := 0; FDragY := 0; FPanLastRefeshTick := 0; FDragOverTick := 0; PCad.OnGetFigureToSelect := PCadGetFigureToSelect; PCad.OnGetModPointToSelect := PCadGetModPointToSelect; PCad.OnBeforeEndTrace := PCadBeforeEndTrace; PCad.OnCheckPrnWithOffset := PCadCheckPrnWithOffset; //29.11.2011 PCad.OnTraceDraw := PCadTraceDraw; PCad.OnFigureEdit := PCadFigureEdit; // OPTIMIZATION //PCad.FResetRegionsOnZoomScroll := false; //PCad.Container.OnResize := nil; //07.08.2012 except on E: Exception do addExceptionToLogEx('TF_CAD.FormCreate', E.Message); end; {$if Defined(ES_GRAPH_SC)} tbShowConnFullness.Visible := False; tbShowCableFullness.Visible := False; tbShowCableChannelFullness.Visible := False; tbShowDefectObjects.Visible := False; tbShowDisconnectedObjects.Visible := False; tbShowTracesLengthLimit.Visible := False; tbNoMoveConnectedObjects.Visible := False; {$ifend} MItem_ConnPoints.Action := F_ProjMan.Act_ConnectedConCompons; MItem_ConnLine.Action := F_ProjMan.Act_ConnectedLineCompons; MItem_NotConnPoint.Action := F_ProjMan.Act_NoConnectedConCompons; MItem_NotConnLine.Action := F_ProjMan.Act_NoConnectedLineCompons; MItem_CableNoCanal.Action := F_ProjMan.Act_CablesNoHitToCanals; {$IF Defined(SCS_PE)} Listofconnecteddisconnected1.Caption := 'List of connected/disconnected'; FSCS_Main.aShowDisconnectedObjects.Caption := 'Highlight disconnected'; for i := 0 to tbView.ControlCount - 1 do begin if tbView.Controls[i].ClassName = 'TToolButton' then begin //if Assigned(TToolButton(tbView.Controls[i]).Action) then // TAction(TToolButton(tbView.Controls[i]).Action).Caption := ''; TToolButton(tbView.Controls[i]).Caption := ''; end; if tbView.Controls[i] <> LabelHighlight then begin TToolButton(tbView.Controls[i]).AutoSize := True; end; end; tbView.Font.Name := 'MS Sans Serif'; tbView.AutoSize := True; tbView.ShowCaptions := True; tbShowConnFullness.AutoSize := True; tbShowCableFullness.AutoSize := True; tbShowCableChannelFullness.AutoSize := True; tbShowDisconnectedObjects.AutoSize := True; tbShowConnFullness.Caption := 'Jacks'; tbShowCableFullness.Caption := 'Cables'; tbShowCableChannelFullness.Caption := 'Conduits'; tbShowDisconnectedObjects.Caption := 'Disconnected'; ToolButton4.AutoSize := False; ToolButton4.Width := 8; ToolButton1.AutoSize := False; ToolButton1.Width := 8; ToolButton2.AutoSize := False; ToolButton2.Width := 8; ToolButton5.AutoSize := False; ToolButton5.Width := 8; {$ELSE} FSCS_Main.aShowDisconnectedObjects.Caption := 'Выделить отключенные'; Listofconnecteddisconnected1.Caption := 'Список подключенных/не подключенных'; LabelHighlight.Visible := False; {$IFEND} end; procedure TF_CAD.FormClose(Sender: TObject; var Action: TCloseAction); var i, j: integer; GetTag: integer; FileName: String; begin try GetTag := Self.Tag; //06.08.2012 GrayedColor := DefGrayedColor; if F_LayersDialog.Showing then F_LayersDialog.Unload; // удалить переключатель листов for i := 0 to FSCS_Main.pageCADList.PageCount - 1 do begin if FSCS_Main.pageCADList.Pages[i].Tag = GetTag then break; end; if i < FSCS_Main.pageCADList.PageCount then begin if Assigned(FSCS_Main.pageCADList.Pages[i]) then begin try FSCS_Main.pageCADList.Pages[i].Free; except end; end; end; // удалить листы из меню for i := 0 to FSCS_Main.mainWindow.Count - 1 do begin if FSCS_Main.mainWindow.Items[i].Tag = GetTag then break; end; if i < FSCS_Main.mainWindow.Count then begin if Assigned(FSCS_Main.mainWindow.Items[i]) then begin try FSCS_Main.mainWindow.Delete(i); except end; end; end; // удалить все if Self <> nil then begin try ClearFiguresOnListDelete(Self); except end; if Self = GListWithEndPoint then begin GListWithEndPoint := Nil; GEndPoint := Nil; end; end; Action := caFree; // UndoList if FSCSUndoList <> nil then begin ClearUndoList; end; if FUndoFiguresList <> nil then FreeAndNil(FUndoFiguresList); // RedoList if FSCSRedoList <> nil then begin ClearRedoList; end; if FSCS_Main.MDIChildCount = 1 then begin FSCS_Main.cbLayers.Enabled := False; if FSCS_Main.tbCADToolsExpert.Visible then FSCS_Main.cbScaleExpert.Enabled := False else FSCS_Main.cbScaleNoob.Enabled := False end; // автозакрытие листа в МП AfterCloseListInCAD(FCADListID); except on E: Exception do addExceptionToLogEx('TF_CAD.FormClose', E.Message); end; end; procedure TF_CAD.FormCloseQuery(Sender: TObject; var CanClose: Boolean); var i: integer; ListStream: TMemoryStream; SavedGCadForm: TF_CAD; AListParams: TListParams; fFileName: string; begin // ручное закрытие if not GNotNeedCheckRaisesBeforeClose then if CheckExistBetweenFloorOnList(TF_CAD(Sender)) then begin ShowMessage(cCad_Mes32); CanClose := False; Exit; end; if Not GExitProg then begin CanClose := False; GExitProg := True; exit; end; try if (F_NormBase <> nil) and (F_ProjMan <> nil) then begin ListStream := TMemoryStream.Create; SavedGCadForm := GCadForm; GCadForm := Self; try if not ListToDeleting(FCADListID) then begin if Not GCloseProg then begin fFileName := GetCadFileNameForSaveToPM(FCADListID); PCad.SaveToFile(0, fFileName); //PCad.SaveToStream(ListStream); //SetCadDataToPM(FCADListID, ListStream); end; end; except on E: Exception do addExceptionToLogEx(cCad_Mes9 + Self.FCADListName + cCad_Mes10, E.Message); end; AListParams := GetListParams(FCADListID); AListParams.Settings.CADShowRuler := PCad.RulerVisible; AListParams.Settings.CADShowGrid := PCad.Grids; AListParams.Settings.CADShowGuides := PCad.GuidesVisible; AListParams.Settings.CADSnapGrid := PCad.SnapToGrids; AListParams.Settings.CADSnapGuides := PCad.SnapToGuides; AListParams.Settings.CADSnapNearObject := PCad.SnapToNearPoint; SaveCADListParams(FCADListID, AListParams); if ListStream <> nil then FreeAndNil(ListStream); GCadForm := SavedGCadForm; end; except on E: Exception do addExceptionToLogEx('TF_CAD.FormCloseQuery', E.Message); end; end; //////////////////////////////////////////////////////////////////////////////// //// ПРОЦЕДУРЫ В ПРОЕКТ /////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////// procedure TF_CAD.PCadSurfaceMove(Sender: TObject; Shift: TShiftState; X, Y: Double); var i: integer; Len: String; LenSize: Double; FullLenSize: Double; Degree: Double; FigureOnMove: TFigure; deltax, deltay: double; coordX, coordY: double; HintStrList: TStringList; FullName: string; ModList: TList; k: integer; ModExist: boolean; begin try GCurrMousePos.x := X; GCurrMousePos.y := Y; //30.06.2010 FCurrX := X; FCurrY := Y; //mProtocol.Lines.Insert(0, 'x='+FloatToStr(X)+', y='+FloatToStr(Y)+''); FigureOnMove := nil; //#From Oleg# //14.09.2010 deltax := (X - GLastSurfaceMoveX); deltay := (Y - GLastSurfaceMoveY); FDeltaX := deltax; FDeltaY := deltay; // SELECT if (PCad.ToolIdx = toSelect) and not (FCreateObjectOnClick) then begin try if PCad.ActiveLayer <> 8 then begin if PCad.ActiveLayer = 2 then FigureOnMove := CheckBySCSObjects(X, Y) else FigureOnMove := PCad.CheckByPoint(PCad.ActiveLayer, X, Y); end else begin FigureOnMove := TFigure(GetNetObjInPoint(PCad, PCad.ActiveLayer, X, Y, true)); if FigureOnMove = nil then FigureOnMove := GCadForm.FActiveNet; end; except FigureOnMove := nil; end; if (FigureOnMove <> nil) and (FigureOnMove is TFigure) then begin if PCad.ActiveLayer = 2 then begin if CheckFigureByClassName(FigureOnMove, cTSCSFigureGrp) then PCad.SetCursor(crHandPoint) else if CheckFigureByClassName(FigureOnMove, cTConnectorObject) then PCad.SetCursor(crNewMoveCross) else if CheckFigureByClassName(FigureOnMove, cTOrthoLine) then begin ModExist := False; //if TOrthoLine(FigureOnMove).Select then begin ModList := TList.Create; TOrthoLine(FigureOnMove).GetModPoints(ModList); for k := 0 to ModList.Count - 1 do begin if TModPoint(ModList.Items[k]).IsPointIn(x, y, 0.3) then begin ModExist := True; PCad.SetCursor(crHandPoint); break; end; end; for k := 0 to ModList.Count - 1 do begin PCad.UnRegisterModPoint(ModList.Items[k]); end; ModList.Free; end; if Not ModExist then PCad.SetCursor(crSizeAll); end else if CheckFigureByClassName(FigureOnMove, cTHouse) then PCad.SetCursor(crNewMoveCross) else PCad.SetCursor(crDefault); PCad.ShowHint := True; // считать StringList HintStrList := GetFigureComponNames(TFigure(FigureOnMove).ID); if HintStrList <> nil then begin if HintStrList.Count = 0 then PCad.Hint := GetFullFigureName(FigureOnMove, X,Y) else begin PCad.Hint := ''; for i := 0 to HintStrList.Count - 1 do begin PCad.Hint := PCad.Hint + HintStrList[i]; if i <> HintStrList.Count - 1 then PCad.Hint := PCad.Hint + #13#10; end; end; // Добавить стринг с номером магистрали if GCadForm.FShowLineCaptionsType = skExternalSCS then begin if CheckFigureByClassName(FigureOnMove, cTOrthoLine) then begin TOrthoLine(FigureOnMove).FTrunkNumber := GetTrunkNumber(TOrthoLine(FigureOnMove)); if TOrthoLine(FigureOnMove).FTrunkNumber <> '' then begin PCad.Hint := PCad.Hint + #13#10 + cCad_Mes31 + TOrthoLine(FigureOnMove).FTrunkNumber; end; end; end; end; end // else begin PCad.SetCursor(crHandPoint); PCad.ShowHint := False; // считать StringList HintStrList := GetFigureComponNames(FigureOnMove.ID); if HintStrList <> nil then begin if HintStrList.Count = 0 then PCad.Hint := FullName else begin PCad.Hint := ''; for i := 0 to HintStrList.Count - 1 do begin PCad.Hint := PCad.Hint + HintStrList[i]; if i <> HintStrList.Count - 1 then PCad.Hint := PCad.Hint + #13#10; end; end; end; if CheckFigureByClassName(FigureOnMove, cTPlanConnector) or CheckFigureByClassName(FigureOnMove, cTPlanObject) then PCad.SetCursor(crNewMoveCross) else if CheckFigureByClassName(FigureOnMove, cTPlanTrace) then PCad.SetCursor(crSizeAll); end; end else begin PCad.SetCursor(crDefault); PCad.ShowHint := False; end; end else if (PCad.ToolIdx = toSelect) and (FCreateObjectOnClick) then begin PCad.SetCursor(crDrag); end; {****************************************************************************} // Режим привязки в режиме трейса трассы или режим создания объекта при нажатии if ((PCad.ToolIdx = toFigure) and (PCad.ToolInfo = 'TOrthoLine')) AND Not(ssAlt in GGlobalShiftState) OR (FCreateObjectOnClick) then begin if (GCurrShadowTraceX = -1) and (GCurrShadowTraceY = -1) then begin try GFigureTraceTo := CheckBySCSObjects(X, Y); except GFigureTraceTo := Nil; end; end else begin try if GOrthoStatus then begin GFigureTraceTo := CheckBySCSObjects(X, Y); if (GFigureTraceTo <> nil) and CheckFigureByClassName(GFigureTraceTo, cTOrthoLine) then GFigureTraceTo := CheckBySCSObjects(GCurrShadowTraceX, GCurrShadowTraceY); end else GFigureTraceTo := CheckBySCSObjects(GCurrShadowTraceX, GCurrShadowTraceY); except GFigureTraceTo := Nil; end; end; // Найденные объекты if GFigureTraceTo <> nil then begin // Коннектор if CheckFigureByClassName(GFigureTraceTo, cTConnectorObject) then begin if TConnectorObject(GFigureTraceTo).ConnectorType = ct_Clear then if (TConnectorObject(GFigureTraceTo).JoinedConnectorsList.Count > 0) then GFigureTraceTo := nil; if GFigureTraceTo <> nil then begin if CheckTrunkObject(TConnectorObject(GFigureTraceTo)) then GFigureTraceTo := nil; end; if GFigureTraceTo <> nil then begin if GFigureTraceTo <> nil then if not GCadForm.FShowRaise then if TConnectorObject(GFigureTraceTo).FConnRaiseType <> crt_None then GFigureTraceTo := nil; end; end // Линия else if CheckFigureByClassName(GFigureTraceTo, cTOrthoLine) then begin if (TOrthoLine(GFigureTraceTo).FIsRaiseUpDown) then GFigureTraceTo := nil; if FCreateObjectOnClick then if not FPutCableOnTrace then GFigureTraceTo := nil; if GFigureTraceTo <> nil then begin if not FCreateObjectOnClick then if TOrthoLine(GFigureTraceTo).FConnectingLine then GFigureTraceTo := nil; end; end // House else if CheckFigureByClassName(GFigureTraceTo, cTHouse) then begin end; end; ////////////// if (GPrevFigureTraceTo <> nil) AND (GPrevFigureTraceTo <> GFigureTraceTo) then begin if CheckFigureByClassName(GPrevFigureTraceTo, cTConnectorObject) then begin TConnectorObject(GPrevFigureTraceTo).isSnap := false; TConnectorObject(GPrevFigureTraceTo).Draw(PCad.DEngine, false); end else if CheckFigureByClassName(GPrevFigureTraceTo, cTOrthoLine) then begin TOrthoLine(GPrevFigureTraceTo).isSnap := false; TOrthoLine(GPrevFigureTraceTo).Draw(PCad.DEngine, false); end else if CheckFigureByClassName(GPrevFigureTraceTo, cTHouse) then begin THouse(GPrevFigureTraceTo).isSnap := false; THouse(GPrevFigureTraceTo).Draw(PCad.DEngine, false); end; end; if GFigureTraceTo <> nil then begin if CheckFigureByClassName(GFigureTraceTo, cTConnectorObject) then begin TConnectorObject(GFigureTraceTo).isSnap := true; TConnectorObject(GFigureTraceTo).Draw(PCad.DEngine, false); end else if CheckFigureByClassName(GFigureTraceTo, cTOrthoLine) then begin TOrthoLine(GFigureTraceTo).isSnap := true; TOrthoLine(GFigureTraceTo).Draw(PCad.DEngine, false); end else if CheckFigureByClassName(GFigureTraceTo, cTHouse) then begin THouse(GFigureTraceTo).isSnap := true; THouse(GFigureTraceTo).Draw(PCad.DEngine, false); end; GPrevFigureTraceTo := GFigureTraceTo; end; end; {*****************************************} // Режим трейса и нет режима привязки, убрать выделение с предыдущих выделенных if ((PCad.ToolIdx = toFigure) and (PCad.ToolInfo = 'TOrthoLine')) AND (ssAlt in GGlobalShiftState) then begin // GReDrawAfterRefresh := True; GFigureTraceTo := nil; if GPrevFigureTraceTo <> nil then begin if CheckFigureByClassName(GPrevFigureTraceTo, cTConnectorObject) then begin TConnectorObject(GPrevFigureTraceTo).isSnap := false; TConnectorObject(GPrevFigureTraceTo).Draw(PCad.DEngine, false); end else if CheckFigureByClassName(GPrevFigureTraceTo, cTOrthoLine) then begin TOrthoLine(GPrevFigureTraceTo).isSnap := false; TOrthoLine(GPrevFigureTraceTo).Draw(PCad.DEngine, false); end else if CheckFigureByClassName(GPrevFigureTraceTo, cTHouse) then begin THouse(GPrevFigureTraceTo).isSnap := false; THouse(GPrevFigureTraceTo).Draw(PCad.DEngine, false); end; GPrevFigureTraceTo := nil; end; end; {****************************************************************************} //// Если режим трейса то выводить угол и размеры текущей фигуры if GTracedFigure then begin if PCad.ActiveLayer <> 2 then begin // --- размеры LenSize := SQRT(SQR(X - GBeginPoint.x) + SQR(Y - GBeginPoint.y)); FullLenSize := 0; Degree := GetFigureAngle(GBeginPoint.x, GBeginPoint.y, X, Y); // if PCad.RulerMode = rmPage then // begin // LenSize := LenSize / 10; // Len := FormatFloat(ffMask, LenSize); // sbView.Panels[1].Text := cCadClasses_Mes4 + Len + cCadClasses_Mes6; // end; if PCad.RulerMode = rmWorld then begin LenSize := LenSize / 1000 * Pcad.MapScale; Len := FormatFloat(ffMask, MetreToUOM(LenSize)); sbView.Panels[1].Text := cCadClasses_Mes4 + Len + GetUOMString(GCurrProjUnitOfMeasure); end; sbView.Panels[2].Text := '> ' + FormatFloat(ffMask, Degree) + cCadClasses_Mes8 + // Радиус '; '+cCadClasses_Mes33+': ' + FormatFloat(ffMask, MetreToUOM(GetLineLength(GBeginPoint, Doublepoint(X, Y)) * GCadForm.PCad.MapScale / 1000)) + ' '+GetUOMString(GCurrProjUnitOfMeasure); end; end; //// Выводить координаты курсора на панель // if PCad.RulerMode = rmPage then // begin // sbView.Panels[0].Text := 'X=' + FormatFloat(ffMask, X) + ' ' + 'Y=' + FormatFloat(ffMask, Y); // end; if PCad.RulerMode = rmWorld then begin coordX := X * PCad.MapScale / 1000; coordY := Y * PCad.MapScale / 1000; if GDraggedFigureZOrder = -1 then begin sbView.Panels[0].Text := 'X=' + FormatFloat(ffMask, MetreToUOM(coordX)) + ' ' + 'Y=' + FormatFloat(ffMask, MetreToUOM(coordY)); end else begin sbView.Panels[0].Text := 'X=' + FormatFloat(ffMask, MetreToUOM(coordX)) + ' ' + 'Y=' + FormatFloat(ffMask, MetreToUOM(coordY)) + ' ' + 'Z=' + FormatFloat(ffMask, MetreToUOM(GDraggedFigureZOrder)); end; if FigureOnMove <> nil then begin if CheckFigureByClassName(FigureOnMove, cTConnectorObject) then begin sbView.Panels[0].Text := 'X=' + FormatFloat(ffMask, MetreToUOM(coordX)) + ' ' + 'Y=' + FormatFloat(ffMask, MetreToUOM(coordY)) + ' ' + 'Z=' + FormatFloat(ffMask, MetreToUOM(TConnectorObject(FigureOnMove).ActualZOrder[1])); end else if CheckFigureByClassName(FigureOnMove, cTOrthoLine) then if TOrthoLine(FigureOnMove).ActualZOrder[1] = TOrthoLine(FigureOnMove).ActualZOrder[2] then sbView.Panels[0].Text := 'X=' + FormatFloat(ffMask, MetreToUOM(coordX)) + ' ' + 'Y=' + FormatFloat(ffMask, MetreToUOM(coordY)) + ' ' + 'Z=' + FormatFloat(ffMask, MetreToUOM(TOrthoLine(FigureOnMove).ActualZOrder[1])); if PCad.SelectedCount = 0 then begin sbView.Panels[2].Text := GetFullFigureName(FigureOnMove, X,Y); if FigureOnMove is TNet then sbView.Panels[1].Text := GetFullFigureLenName(FigureOnMove, X,Y); end; end; end; // ПЕРЕТАСКИВАНИЕ КАДа if (FSCS_Main.tbPanExpert.Down) or (FSCS_Main.tbPanNoob.Down) then begin PCad.SetCursor(crHandPoint); if GIsMousePressed then begin //deltax := (X - GLastSurfaceMoveX); //deltay := (Y - GLastSurfaceMoveY); //30.09.2011 MoveCADOnPan(deltax, deltay); TimerMovePan.Enabled := true; end; end; //20.06.2013 if ((PCad.ToolIdx = toFigure) and (PCad.ToolInfo = 'TOrthoLine')) and (GClickIndex > 0) then //20.06.2013 CheckScrollingOnTracing(X, Y); if (PCad.ToolIdx = toFigure) and ((PCad.ToolInfo = TOrthoLine.ClassName) and (GClickIndex > 0)) or (PCad.ToolInfo = TBetweenFloorDownVertex.ClassName) or (PCad.ToolInfo = TBetweenFloorUpVertex.ClassName) then CheckScrollingOnTracing(X, Y); GLastSurfaceMoveX := X; GLastSurfaceMoveY := Y; except on E: Exception do addExceptionToLogEx('TF_CAD.PCadSurfaceMove', E.Message); end; end; procedure TF_CAD.PCadBeforeDelete(Sender: TObject; Figure: TFigure; var CanDelete: Boolean); var i, j: integer; mess: string; ObjFromRaise: TConnectorObject; vList: TList; vIntList: TIntList; old, new: Cardinal; ListID: Integer; FigID: Integer; InFigure: TFigure; begin try if CheckFigureByClassName(Figure, cTRichTextMod) or CheckFigureByClassName(Figure, cTFigureGrpMod) or CheckFigureByClassName(Figure, cTFigureGrpNotMod) or CheckFigureByClassName(Figure, cTCabinetNumber) then begin CanDelete := False; Exit; end; if not ((Figure is TFigureGrp) and (GAutoDelete)) then begin if not FWasDeleteQuery then begin mess := cCad_Mes11; if MessageBox(FSCS_Main.Handle, PAnsiChar(mess), cCad_Mes12, MB_YESNO) = IDYes then begin GCanDeleteFigures := True; FWasDeleteQuery := True; end else begin GCanDeleteFigures := False; FWasDeleteQuery := True; end; end; end else GCanDeleteFigures := True; if GCanDeleteFigures then begin if (PCad.ActiveLayer = lnArch) or CheckOneOfSCSlayers(PCad.ActiveLayer) then begin // *UNDO* if FCanSaveForUndo then begin if FListType = lt_Normal then begin vList := GetRelatedListsBySelected(PCad.Selection, cst_Delete); // !!! // vIntList := TIntList.Create; // for i := 0 to vList.Count - 1 do // begin // ListID := TF_CAD(vList[i]).FCADListID; // vIntList.Add(ListID); // end; // FigID := Figure.ID; // BeforeDelObjectFromPM(cfCAD, FCADListID, FigID, vIntList); // !!! if vList.Count = 1 then SaveForUndo(uat_None, True, False) else begin vIntList := GetListsIDRelatedToFigures(FCADListID, FiguresToIntFigures(PCad.Selection)); vList := IntCadsToCads(vIntList); SaveForProjectUndo(vList, True, False); end; end else if FListType = lt_ProjectPlan then begin SaveForUndo(uat_None, True, False); end; FCanSaveForUndo := False; end; if PCad.ActiveLayer = lnArch then begin if Figure is TFigureGrp then //26.09.2011 for i := 0 to TFigureGrp(Figure).InFigures.Count - 1 do begin InFigure := TFigure(TFigureGrp(Figure).InFigures[i]); if InFigure is TNet then TNet(InFigure).DoDelete; end; end; end; if (Figure is TFigureGrp) and not CheckFigureByClassName(Figure, cTSCSFigureGrp) then begin RemoveInFigureGrp(TFigureGrp(Figure)); end; if CheckFigureByClassName(Figure, cTConnectorObject) or CheckFigureByClassName(Figure, cTOrthoLine) or CheckFigureByClassName(Figure, cTCabinet) or CheckFigureByClassName(Figure, cTCabinetExt) or CheckFigureByClassName(Figure, cTPlanObject) or CheckFigureByClassName(Figure, cTPlanConnector) or CheckFigureByClassName(Figure, cTPlanTrace) or CheckFigureByClassName(Figure, cTSCSFigureGrp) or CheckFigureByClassName(Figure, cTHouse) then begin CanDelete := False; PCad.OnBeforeDelete := nil; try if Assigned(Figure) then begin if CheckFigureByClassName(Figure, cTConnectorObject) then begin if CheckCannotDelete(Figure) then begin CanDelete := False; Exit; end; TConnectorObject(Figure).Delete; end; end; if Assigned(Figure) then begin if CheckFigureByClassName(Figure, cTOrthoLine) then begin if CheckCannotDelete(Figure) then begin CanDelete := False; Exit; end; if TOrthoLine(Figure).FIsRaiseUpDown then begin ObjFromRaise := TOrthoLine(Figure).FObjectFromRaisedLine; if ObjFromRaise <> nil then begin if ObjFromRaise.ConnectorType = ct_Clear then DestroyRaiseOnConnector(ObjFromRaise) else DestroyRaiseOnPointObject(ObjFromRaise); Exit; end else TOrthoLine(Figure).Delete; end else TOrthoLine(Figure).Delete; end; end; if Assigned(Figure) then begin if CheckFigureByClassName(Figure, cTCabinet) then begin TCabinet(Figure).Delete; end; end; if Assigned(Figure) then begin if CheckFigureByClassName(Figure, cTCabinetExt) then begin TCabinetExt(Figure).Delete; end; end; if Assigned(Figure) then begin if CheckFigureByClassName(Figure, cTPlanObject) then begin TPlanObject(Figure).Delete; end; end; if Assigned(Figure) then begin if CheckFigureByClassName(Figure, cTPlanConnector) then begin TPlanConnector(Figure).Delete; end; end; if Assigned(Figure) then begin if CheckFigureByClassName(Figure, cTPlanTrace) then begin TPlanTrace(Figure).Delete; end; end; if Assigned(Figure) then begin if CheckFigureByClassName(Figure, cTSCSFigureGrp) then begin TSCSFigureGrp(Figure).Delete; end; end; if Assigned(Figure) then begin if CheckFigureByClassName(Figure, cTHouse) then begin THouse(Figure).Delete; end; end; finally PCad.OnBeforeDelete := PCadBeforeDelete; end; end; SetProjectChanged(True); end else begin CanDelete := False; end; except on E: Exception do addExceptionToLogEx('TF_CAD.PCadBeforeDelete', E.Message); end; end; procedure TF_CAD.PCadKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin GGlobalShiftState := Shift; // if (GOrthoStatus) then // if (PCad.ToolInfo = 'TOrthoLine') and (PCad.TraceFigure <> nil) and CheckFigureByClassName(PCad.TraceFigure, cTOrthoLine) then // if (GFigureTraceTo <> nil) and CheckFigureByClassName(GFigureTraceTo, cTConnectorObject) then // if Key = VK_CONTROL then // begin // // end; end; procedure TF_CAD.PCadKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); var ShadowTrace: TFigure; begin try GGlobalShiftState := Shift; // сбросить привязку при нажатии Альт if ((PCad.ToolIdx = toFigure) and (PCad.ToolInfo = 'TOrthoLine')) and (ssAlt in GGlobalShiftState) then begin if GPrevFigureTraceTo <> nil then begin TConnectorObject(GPrevFigureTraceTo).DrawSnapFigures(GPrevFigureTraceTo, False); GPrevFigureTraceTo := nil; RefreshCAD(PCad); end; end; // в режиме Выборки нажатие Альт - сброс предыдущих выделенных объектов if (ssAlt in GGlobalShiftState) then begin if GPrevFigureSnap <> nil then begin TConnectorObject(GPrevFigureSnap).DrawSnapFigures(GPrevFigureSnap, False); GPrevFigureSnap := nil; RefreshCAD(PCad); end; end; if Key = VK_Escape then begin // если мувается объект if Pcad.IsDragging then begin PCad.CancelActions; if GLastConnector <> nil then begin GLastConnector.SkipConnectedLinesDrawShadow; end; RefreshCAD(PCad); end else // идет создание трассы if (PCad.ToolInfo = 'TOrthoLine') and (PCad.TraceFigure <> nil) then begin begin // мышь автокад if GCadForm.FAutoCadMouse then begin GClickIndex := GClickIndex + 1; PCad.TraceFigure.ShadowClick(GClickIndex, GCurrMousePos.x, GCurrMousePos.y); ShadowTrace := TOrthoLine.CreateFromShadow(PCad, PCad.GetLayerHandle(2), PCad.TraceFigure); if ShadowTrace = nil then begin RefreshCAD(PCad); PCad.SetTool(toSelect, 'TSelected'); GAutoAddCableAfterDragDrop := false; if FSCS_Main.tbCADToolsExpert.Visible then FSCS_Main.tbSelectExpert.Down := True else FSCS_Main.tbSelectNoob.Down := True; FCreateObjectOnClick := False; GCurrShadowTraceX := -1; GCurrShadowTraceY := -1; if GSnapFiguresList <> nil then begin GSnapFiguresList.Clear; end; end; end else // мышь скс begin if GClickIndex >= 1 then begin GClickIndex := GClickIndex - 1; GSnapFiguresList.Delete(GSnapFiguresList.Count - 1); SetLength(GTempActualPoints, GClickIndex + 1); PCad.ClickIndex := GClickIndex; PCad.TraceFigure.OriginalPoints[3] := PCad.TraceFigure.ActualPoints[GClickIndex]; PCad.TraceFigure.OriginalPoints[2] := PCad.TraceFigure.ActualPoints[GClickIndex]; PCad.TraceFigure.OriginalPoints[1] := PCad.TraceFigure.OriginalPoints[3]; GReDrawAfterRefresh := True; // если последний !!! if GClickIndex <= 1 then begin PCad.SetTool(toSelect, 'TSelected'); GAutoAddCableAfterDragDrop := false; if FSCS_Main.tbCADToolsExpert.Visible then FSCS_Main.tbSelectExpert.Down := True else FSCS_Main.tbSelectNoob.Down := True; FCreateObjectOnClick := False; GCurrShadowTraceX := -1; GCurrShadowTraceY := -1; if GSnapFiguresList <> nil then begin GSnapFiguresList.Clear; end; end; RefreshCAD(Pcad); end; end; end; end else begin //if ActiveMDIChild <> nil then begin Self.FCreateObjectOnClick := False; PCad.SetTool(toSelect, 'TSelected'); GCadForm.FCreateObjectOnClick := False; GCadForm.PCad.SetTool(toSelect, 'TSelected'); FSCS_Main.tbCreateOnClickModeExpert.Down := False; FSCS_Main.tbCreateOnClickModeNoob.Down := False; FSCS_Main.tbSelectExpert.Down := True; FSCS_Main.tbSelectNoob.Down := True; FSCS_Main.tbPrintRect.Down := False; end; Cursor := crDefault; RefreshCAD(PCad); PCad.SetTool(toSelect, 'TSelected'); if FSCS_Main.tbCADToolsExpert.Visible then FSCS_Main.tbSelectExpert.Down := True else FSCS_Main.tbSelectNoob.Down := True; FCreateObjectOnClick := False; GCurrShadowTraceX := -1; GCurrShadowTraceY := -1; if GSnapFiguresList <> nil then begin GSnapFiguresList.Clear; end; end; end; // при DragOver и наведении на объект - по ТАБ переключать пути трассировки if Key = VK_TAB then begin if (FIsDragOver) and (GFigureSnap <> nil) then begin PCad.DeselectAll(2); FTracingListIndex := FTracingListIndex + 1; FSCS_Main.aSelectTracetoServer.Execute; RefreshCAD(PCad); end; end; if (ssCtrl in Shift) and (Key in [48,96]) then //22.09.2011 begin SetZoomScale(100); RefreshCAD_T(PCad); end; GMoveByArrow := False; // *UNDO* if not FCanSaveForUndo then FCanSaveForUndo := True; except on E: Exception do addExceptionToLogEx('TF_CAD.PCadKeyUp', E.Message); end; end; procedure TF_CAD.PCadSurfaceMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Double); var CursorPos: TPoint; CursorX, CursorY: Integer; ClickedX, ClickedY: Double; MovedP: TPoint; MovedX, MovedY: Double; SetCur: TPoint; CurFigure: TFigure; begin try if Button = mbLeft then GIsMousePressed := True; if Button = mbRight then begin if GCadForm.FCreateObjectOnClick or Self.FCreateObjectOnClick then begin GCadForm.FCreateObjectOnClick := False; Self.FCreateObjectOnClick := False; PCad.SetTool(toSelect, 'TSelected'); FSCS_Main.tbCreateOnClickModeExpert.Down := False; FSCS_Main.tbCreateOnClickModeNoob.Down := False; FSCS_Main.tbSelectExpert.Down := True; FSCS_Main.tbSelectNoob.Down := True; end; end; GTracedFigure := False; if PCad.ToolIdx = toFigure then begin GBeginPoint.X := X; GBeginPoint.Y := Y; sbView.Panels[1].Text := ''; sbView.Panels[2].Text := ''; GTracedFigure := True; end else if PCad.ToolIdx = toSelect then begin GBeginPoint.x := 0; GBeginPoint.y := 0; sbView.Panels[1].Text := ''; sbView.Panels[2].Text := ''; end; if ((PCad.ToolInfo = 'TOrthoLine') Or (PCad.ToolInfo = 'TConnectorObject')) and (GObjectStatus = False) then begin GObjectStatus := true; if F_LayersDialog.Showing then F_LayersDialog.lbCurLayer.Caption := PCad.GetLayerName(PCad.ActiveLayer); end else if (PCad.ToolIdx = toFigure) and (GObjectStatus = False) then begin GObjectStatus := true; if F_LayersDialog.Showing then F_LayersDialog.lbCurLayer.Caption := PCad.GetLayerName(PCad.ActiveLayer); end; // GlobalPos GMouseDownPos.x := X; GMouseDownPos.y := Y; except on E: Exception do addExceptionToLogEx('TF_CAD.PCadSurfaceMouseDown', E.Message); end; end; procedure TF_CAD.PCadObjectInserted(Sender: TObject; Reason: TInsertReason); var i: integer; InsertedObject: TFigure; GetIDFigure: Integer; ObjKind: TSCSObjectKind; ObjParams: TObjectParams; LHandle1: Integer; LHandle7: Integer; Cabinet: TFigure; CabinetID: Integer; Jpeg: TJpegImage; xStream: TmemoryStream; begin try CabinetID := -1; //#From Oleg# //14.09.2010 GTracedFigure := False; GObjectStatus := False; InsertedObject := TFigure(PCad.Figures[PCad.Figures.Count - 1]); PCadFigureSelect(Sender, InsertedObject); // добавить Обьект в менеджер проектов if (F_NormBase <> Nil) and (F_ProjMan <> Nil) and (InsertedObject <> nil) then begin {****************************************************************************} if (InsertedObject.Cname = 'TSCSHDimLine') or (InsertedObject.Cname = 'TSCSVDimLine') then begin RefreshCAD_T(PCad); if InsertedObject.Edit then RefreshCAD_T(PCad); end; // добавить Конектор на CAD if CheckFigureByClassName(InsertedObject, cTConnectorObject) and (not TConnectorObject(InsertedObject).FIsApproach) then begin GetIDFigure := GenNewSCSObjectID; InsertedObject.ID := GetIDFigure; AddSCSFigure(InsertedObject); //07.11.2011 if TConnectorObject(InsertedObject).ConnectorType = ct_Clear then begin InsertedObject.Name := cCadClasses_Mes12; ObjKind := okConnector; end else begin InsertedObject.Name := cCadClasses_Mes21; ObjKind := okPointObject; end; // Определить кабинет Cabinet := GetCabinetAtPos(TConnectorObject(InsertedObject).ActualPoints[1].x, TConnectorObject(InsertedObject).ActualPoints[1].y); if Cabinet <> nil then begin if CheckFigureByClassName(Cabinet, cTCabinet) then CabinetID := TCabinet(Cabinet).FSCSID else if CheckFigureByClassName(Cabinet, cTCabinetExt) then CabinetID := TCabinetExt(Cabinet).FSCSID; end else CabinetID := -1; if (not TConnectorObject(InsertedObject).FIsApproach) and (not TConnectorObject(InsertedObject).FIsHouseJoined) then begin if GListNode = Nil then GListNode := SendObjectToPrjManager(InsertedObject.ID, FCADListID, CabinetID, InsertedObject.Name, ObjKind) else SendObjectToPrjManager(InsertedObject.ID, FCADListID, CabinetID, InsertedObject.Name, ObjKind); end; ObjParams := GetFigureParams(InsertedObject.ID); TConnectorObject(InsertedObject).Name := ObjParams.Name; TConnectorObject(InsertedObject).FIndex := ObjParams.MarkID; TConnectorObject(InsertedObject).FCabinetID := CabinetID; // поставить высоту для коннектора SetConFigureCoordZInPM(InsertedObject.ID, TConnectorObject(InsertedObject).ActualZOrder[1]); end // добавить Ортолинию на CAD else if CheckFigureByClassName(InsertedObject, cTOrthoLine) then begin GetIDFigure := GenNewSCSObjectID; InsertedObject.ID := GetIDFigure; InsertedObject.Name := cCadClasses_Mes20; AddSCSFigure(InsertedObject); //07.11.2011 ObjKind := okLine; // Определить кабинет Cabinet := GetCabinetAtPos(TOrthoLine(InsertedObject).ActualPoints[1].x, TOrthoLine(InsertedObject).ActualPoints[1].y); if Cabinet <> nil then begin if CheckFigureByClassName(Cabinet, cTCabinet) then CabinetID := TCabinet(Cabinet).FSCSID else if CheckFigureByClassName(Cabinet, cTCabinetExt) then CabinetID := TCabinetExt(Cabinet).FSCSID; end else CabinetID := -1; if GListNode = Nil then GListNode := SendObjectToPrjManager(InsertedObject.ID, FCADListID, CabinetID, InsertedObject.Name, ObjKind) else SendObjectToPrjManager(InsertedObject.ID, FCADListID, CabinetID, InsertedObject.Name, ObjKind); ObjParams := GetFigureParams(InsertedObject.ID); TOrthoLine(InsertedObject).Name := ObjParams.Name; TOrthoLine(InsertedObject).FIndex := ObjParams.MarkID; TOrthoLine(InsertedObject).FCabinetID := CabinetID; // поставить высоту для линии SetLineFigureCoordZInPM(InsertedObject.ID, 1, TOrthoLine(InsertedObject).ActualZOrder[1]); SetLineFigureCoordZInPM(InsertedObject.ID, 2, TOrthoLine(InsertedObject).ActualZOrder[2]); SetLineFigureLengthInPM(InsertedObject.ID, TOrthoLine(InsertedObject).LineLength); end; {**************************************************************************} RefreshCAD_T(PCad); if F_Navigator <> nil then RefreshCAD(F_Navigator.PCadNavigator); end; if Not (InsertedObject is TNet) then PCad.SetTool(toSelect, 'TSelected'); if FSCS_Main.tbCADToolsExpert.Visible then begin if FSCS_Main.tbCreateOnClickModeExpert.Down = False then begin FSCS_Main.tbSelectExpert.Down := True; end; end else begin if FSCS_Main.tbCreateOnClickModeNoob.Down = False then begin FSCS_Main.tbSelectNoob.Down := True; end; end; if CheckFigureByClassName(InsertedObject, 'TWMFObject') then begin LHandle1 := PCad.GetLayerHandle(1); LHandle7 := PCad.GetLayerHandle(7); if PCad.ActiveLayer = 1 then InsertedObject.LayerHandle := LHandle1 else if PCad.ActiveLayer = 7 then InsertedObject.LayerHandle := LHandle7 else InsertedObject.LayerHandle := LHandle1; if InsertedObject.Selected then InsertedObject.Deselect; end else if CheckFigureByClassName(InsertedObject, 'TNet') then begin InsertedObject.Deselect; end // BMP Object Insert else if CheckFigureByClassName(InsertedObject, 'TBMPObject') then begin PCad.DeselectAll(1); InsertedObject.Select; RefreshCAD(PCad); PCad.OrderSelection(osBack); end; SetProjectChanged(True); except on E: Exception do addExceptionToLogEx('TF_CAD.PCadObjectInserted', E.Message); end; end; procedure TF_CAD.PCadPopMenuClicked(Sender: TObject; MenuIndex: Integer); begin end; ///////////////////////////////////////////////////////// procedure TF_CAD.FormActivate(Sender: TObject); var i: integer; CurLayer: TLayer; //06.08.2012 Params: TListParams; begin try Application.OnMessage := nil; GCadForm := Self; ActiveNet := FActiveNet; if GCadForm <> GLastCadForm then begin //06.08.2012 Params := GetListParams(Self.FCADListID); //06.08.2012 GrayedColor := Params.Settings.CADGrayedColor; // переключить переключатель листов for i := 0 to FSCS_Main.pageCADList.PageCount - 1 do begin if FSCS_Main.pageCADList.Pages[i].Tag = Self.Tag then FSCS_Main.pageCADList.ActivePage := FSCS_Main.pageCADList.Pages[i]; end; // переключить листы из меню for i := 0 to FSCS_Main.mainWindow.Count - 1 do begin if FSCS_Main.mainWindow.Items[i].Tag = Self.Tag then FSCS_Main.mainWindow.Items[i].Checked := True; end; if (F_NormBase <> nil) and (F_ProjMan <> nil) then if (FCADListID <> 0) and (FCADListName <> '') then SwitchListInPM(FCADListID, FCADListName); // последний CAD GLastCadForm := GCadForm; // восстоновить по параметры листа if FSCS_Main.ActiveMDIChild <> nil then ReturnListParams; // НАВИГАТОР if F_Navigator <> nil then begin F_Navigator.PCadNavigator.Figures := PCad.Figures; ReAssignNavigatorParams; end; // Перезаписать список слоев if FSCS_Main.cbLayers.Enabled = False then FSCS_Main.cbLayers.Enabled := True; FSCS_Main.cbLayers.Properties.BeginUpdate; try FSCS_Main.cbLayers.Properties.Items.Clear; for i := 1 to PCad.LayerCount - 1 do begin // CurLayer := TLayer(PCad.Layer[i]); // if not CurLayer.IsDxf then FSCS_Main.cbLayers.Properties.Items.Add(PCad.GetLayerName(i)); end; finally FSCS_Main.cbLayers.Properties.EndUpdate; end; if PCad.ActiveLayer > 0 then FSCS_Main.cbLayers.ItemIndex := PCad.ActiveLayer - 1; // Перезаписать масштабы if FSCS_Main.tbCADToolsExpert.Visible then begin if FSCS_Main.cbScaleExpert.Enabled = False then FSCS_Main.cbScaleExpert.Enabled := True; FSCS_Main.cbScaleExpert.Text := IntToStr(PCad.ZoomScale) + '%'; end else begin if FSCS_Main.cbScaleNoob.Enabled = False then FSCS_Main.cbScaleNoob.Enabled := True; FSCS_Main.cbScaleNoob.Text := IntToStr(PCad.ZoomScale) + '%'; end; if FListType = lt_Normal then begin EnableOptionsForNormalList; end else if FListType = lt_DesignBox then begin DisableOptionsForDesignList; end else if FListType = lt_ProjectPlan then begin DisableOptionsForProjectPlan; end; // обновить навигатор if F_Navigator <> nil then RefreshCAD(F_Navigator.PCadNavigator); // if F_LayersDialog.Showing then F_LayersDialog.LoadFromCADForm(Self); end; // FSCS_Main.cbLayers.Enabled := True; if FSCS_Main.tbCADToolsExpert.Visible then FSCS_Main.cbScaleExpert.Enabled := True else FSCS_Main.cbScaleNoob.Enabled := True; if CurrentLayer <> PCad.ActiveLayer then CurrentLayer := PCad.ActiveLayer; if FCreateObjectOnClick then begin if FSCS_Main.tbCADToolsExpert.Visible then begin FSCS_Main.tbSelectExpert.Down := False; FSCS_Main.tbCreateOnClickModeExpert.Down := True; end else begin FSCS_Main.tbSelectNoob.Down := False; FSCS_Main.tbCreateOnClickModeNoob.Down := True; end; FSCS_Main.SkipCADPanelChecked; end else begin if FSCS_Main.ActiveMDIChild <> nil then begin if FSCS_Main.tbCADToolsExpert.Visible then begin FSCS_Main.tbSelectExpert.Click; FSCS_Main.tbSelectExpert.Down := True; FSCS_Main.tbCreateOnClickModeExpert.Down := False; end else begin FSCS_Main.tbSelectNoob.Click; FSCS_Main.tbSelectNoob.Down := True; FSCS_Main.tbCreateOnClickModeNoob.Down := False; end; { if FFirstActivate then begin if FSCS_Main.tbCADToolsExpert.Visible then begin FSCS_Main.tbPanExpert.Click; FSCS_Main.tbPanExpert.Down := True; FSCS_Main.tbCreateOnClickModeExpert.Down := False; end else begin FSCS_Main.tbPanNoob.Click; FSCS_Main.tbPanNoob.Down := True; FSCS_Main.tbCreateOnClickModeNoob.Down := False; end; FSCS_Main.aToolPan.Execute; FFirstActivate := False; end else begin if FSCS_Main.tbCADToolsExpert.Visible then begin FSCS_Main.tbSelectExpert.Click; FSCS_Main.tbSelectExpert.Down := True; FSCS_Main.tbCreateOnClickModeExpert.Down := False; end else begin FSCS_Main.tbSelectNoob.Click; FSCS_Main.tbSelectNoob.Down := True; FSCS_Main.tbCreateOnClickModeNoob.Down := False; end; end; } end; end; except on E: Exception do addExceptionToLogEx('TF_CAD.FormActivate', E.Message); end; end; procedure TF_CAD.PCadFigureMoved(Sender: TObject; Figure: TFigure; dx, dy: Double); var CurrPointObject: TConnectorObject; CheckedBreak: Boolean; i: integer; begin try if CheckFigureByClassName(Figure, cTConnectorObject) then begin if TConnectorObject(Figure).ConnectorType = ct_Clear then begin for i := 0 to TConnectorObject(Figure).JoinedConnectorsList.Count - 1 do begin CurrPointObject := TConnectorObject(TConnectorObject(Figure).JoinedConnectorsList[i]); if not CurrPointObject.Selected then begin CheckedBreak := CheckByBreakConnector(TConnectorObject(Figure), CurrPointObject); if CheckedBreak then UnsnapConnectorFromPointObject(TConnectorObject(Figure), CurrPointObject); end; end; end; end; if (FSCS_Main.aViewCADObjectsProp.Checked) OR (GObjectProperty = True) then F_SizePos.DefineObjectSizePos; if F_Navigator <> nil then RefreshCAD(F_Navigator.PCadNavigator); SetProjectChanged(True); except on E: Exception do addExceptionToLogEx('TF_CAD.PCadFigureMoved', E.Message); end; end; procedure TF_CAD.PCadFigureModify(Sender: TObject; Figure: TFigure); begin try if (FSCS_Main.aViewCADObjectsProp.Checked) OR (GObjectProperty = True) then F_SizePos.DefineObjectSizePos; if F_Navigator <> nil then RefreshCAD(F_Navigator.PCadNavigator); RefreshCAD_T(PCad); SetProjectChanged(True); except on E: Exception do addExceptionToLogEx('TF_CAD.PCadFigureModify', E.Message); end; end; // При Драге найти линии на которые ложиться кабель! procedure TF_CAD.PCadSurfaceDragOver(Sender, Source: TObject; X, Y: Double; State: TDragState; var Accept: Boolean); var i: integer; DropPoints: TDoublePoint; vList: TF_CAD; vBox: TConnectorObject; SDDrawed: Boolean; begin try if Abs(GetTickCount - FDragOverTick) < 40 then Exit; ///// EXIT ///// FDragOverTick := GetTickCount; SDDrawed := false; FIsDragOver := True; FDragX := X; FDragY := Y; if not PCad.Focused then if PCad.ToolIdx = toSelect then begin SendMessage(Self.Handle, WM_ACTIVATE, MakewParam(WA_ACTIVE, 0), 0); SendMessage(Self.Handle, WM_SETFOCUS, 0, 0); end; if FListType <> lt_Normal then begin GCanCopyComponToCAD := False; if GDropComponent.IsLine = 0 then begin vList := GetListByID(FJoinedListIDForDesignList); if vList <> nil then begin vBox := TConnectorObject(GetFigureByID(vList, FJoinedBoxIDForDesignList)); if vBox <> nil then begin if ComplectNBComponToProjObj(vBox.ID, GDropComponent, True) then begin GCanCopyComponToCAD := True; exit; end; end; end; end; end; if not GCanCopyComponToCAD then begin if (GListWithEndPoint <> nil) and (GListWithEndPoint <> Self) then begin try GListWithEndPoint.PCad.DeselectAll(2); except end; RefreshCAD(GListWithEndPoint.PCad); end; try PCad.DeselectAll(2); except end; RefreshCAD(PCad); Accept := False; Exit; end; // при движении над CAD попытка привязки if GDropComponent <> Nil then begin Accept := True; // тянеться коннектор отобразить Shadow if GDropComponent.IsLine = 0 then begin if PCad.SnapToGrids then DropPoints := GetCoordsWithSnapToGrid(X, Y) else DropPoints := DoublePoint(X, Y); /// -------------- GIsDrawShadow := True; GShadowObject.ShadowCP.x := DropPoints.x; GShadowObject.ShadowCP.y := DropPoints.y; GShadowObject.draw(PCad.DEngine, False); {GIsDrawShadow := False;} {PCad.DrawTrace; GShadowObject.Move(DropPoints.x - GShadowObject.ShadowCP.x, DropPoints.y - GShadowObject.ShadowCP.y); GShadowObject.ShadowCP.x := DropPoints.x; GShadowObject.ShadowCP.y := DropPoints.y; PCad.DrawTrace; } SDDrawed := true; /// -------------- end; // искать обьект в режиме перетаскивания if not (ssAlt in GGlobalShiftState) then GFigureSnap := FindAutoSnapObject(X, Y, GDropComponent) else GFigureSnap := nil; if not SCSClassDetect(GFigureSnap) then GFigureSnap := nil; // убрать выделение всех трасс на которые мог проложиться кабель if (GPrevFigureSnap <> nil) AND (GPrevFigureSnap <> GFigureSnap) then begin TConnectorObject(GFigureSnap).DrawSnapFigures(GPrevFigureSnap, False); for i := 0 to PCad.SelectedCount - 1 do if CheckFigureByClassName(TFigure(PCad.Selection[i]), cTOrthoLine) then TConnectorObject(GFigureSnap).DrawSnapFigures(TFigure(PCad.Selection[i]), False); end; // Есть объект для дропа if GFigureSnap <> nil then begin // ложить обьект на ортолинию if CheckFigureByClassName(GFigureSnap, cTOrthoLine) then begin // поставить выделение для всех трасс на которые прокладываеться кабель TConnectorObject(GFigureSnap).DrawSnapFigures(GFigureSnap, True); RefreshCAD(PCad); GPrevFigureSnap := GFigureSnap; if GDropComponent.IsLine = 1 then // тянеться кабель begin for i := 0 to PCad.SelectedCount - 1 do if CheckFigureByClassName(TFigure(PCad.Selection[i]), cTOrthoLine) then TConnectorObject(GFigureSnap).DrawSnapFigures(TFigure(PCad.Selection[i]), True); end; end else if CheckFigureByClassName(GFigureSnap, cTConnectorObject) then begin TConnectorObject(GFigureSnap).DrawSnapFigures(GFigureSnap, True); if GDropComponent.IsLine = 1 then FSCS_Main.aSelectTracetoServer.Execute; RefreshCAD(PCad); GPrevFigureSnap := GFigureSnap; end; if GDropComponent.IsLine = 0 then if GShadowObject <> nil then GShadowObject.draw(PCad.DEngine, False); end else // Нет объекта для дропа begin if (GListWithEndPoint <> nil) and (GListWithEndPoint <> Self) then begin //if GListWithEndPoint.PCad.FAnySelected then begin try GListWithEndPoint.PCad.DeselectAll(2); except end; RefreshCAD(GListWithEndPoint.PCad); end; end; //if PCad.FAnySelected then begin try PCad.DeselectAll(2); except end; RefreshCAD(PCad); end; if GDropComponent.IsLine = 1 then Accept := True; end; if GFigureSnap = nil then GDraggedFigureZOrder := FConnHeight else begin if CheckFigureByClassName(GFigureSnap, cTConnectorObject) then GDraggedFigureZOrder := TConnectorObject(GFigureSnap).ActualZOrder[1] else if CheckFigureByClassName(GFigureSnap, cTOrthoLine) then GDraggedFigureZOrder := TOrthoLine(GFigureSnap).ActualZOrder[1]; end; end; except on E: Exception do addExceptionToLogEx('TF_CAD.PCadSurfaceDragOver', E.Message); end; end; // Про Дропе объекта на CAD! procedure TF_CAD.PCadSurfaceDragDrop(Sender, Source: TObject; X, Y: Double); var i: integer; FiguresList: TList; Item: TMenuItem; FFigure: TFigure; Point: TPoint; FHeightStr: string; begin try FIsDragOver := False; GIsDrawShadow := False; FDragX := X; FDragY := Y; if not GCanCopyComponToCAD then Exit; if GFigureSnap <> nil then if PCad.SelectedCount = 0 then begin FiguresList := GetFiguresByLevel(GFigureSnap, X, Y, False{True}, true); // формировать список объектов if FiguresList.Count > 1 then begin GFigureSnap := nil; GetCursorPos(Point); //07.02.2011 //FSCS_Main.pmFiguresByLevel.Items.Clear; // for i := 0 to FiguresList.Count - 1 do // begin // FFigure := TFigure(FiguresList[i]); // Item := TMenuItem.Create(FSCS_Main.pmFiguresByLevel); // FHeightStr := ''; // if CheckFigureByClassName(FFigure, cTOrthoLine) then // if TOrthoLine(FFigure).ActualZOrder[1] = TOrthoLine(FFigure).ActualZOrder[2] then // FHeightStr := FormatFloat(ffMask, MetreToUOM(TOrthoLine(FFigure).ActualZOrder[1])) // else // FHeightStr := FormatFloat(ffMask, MetreToUOM(TOrthoLine(FFigure).ActualZOrder[1])) + '-' + // FormatFloat(ffMask, MetreToUOM(TOrthoLine(FFigure).ActualZOrder[2])); // if CheckFigureByClassName(FFigure, cTConnectorObject) then // FHeightStr := FormatFloat(ffMask, MetreToUOM(TConnectorObject(FFigure).ActualZOrder[1])); // Item.Caption := GetFullFigureName(FFigure, X,Y) + ' (' + FHeightStr + GetUOMString(GCurrProjUnitOfMeasure) + ')'; // FSCS_Main.pmFiguresByLevel.Items.Add(Item); // Item.Tag := FFigure.ID; // Item.OnClick := DropFigureEvent; // end; BuildPopupFiguresByLevel(FiguresList, DropFigureEvent, X,Y); FSCS_Main.pmFiguresByLevel.Popup(Point.X, Point.Y); FreeAndNil(FiguresList); exit; end; if FiguresList <> nil then FreeAndNil(FiguresList); end; DoDragDrop(X, Y); SetProjectChanged(True); except on E: Exception do addExceptionToLogEx('TF_CAD.PCadSurfaceDragDrop', E.Message); end; end; procedure TF_CAD.PCadSurfaceMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Double); var i: integer; Point: TPoint; FigureProperty: TFigure; CurrentWA: TConnectorObject; CurrentServer: TConnectorObject; AllTraceProp: TTraceWithProperties; LineLen: Double; FIsRaiseLineFigure: TFigure; AllCablesTraces: TList; //17.01.2013 AllCables: TList; begin try GIsMousePressed := False; // Контекстное меню GListNode := Nil; CurrentServer := nil; //#From Oleg# //14.09.2010 if Button = mbRight then begin // сбросить Шедоу с перемещения if GLastConnector <> nil then begin if CheckFigureByClassName(GLastConnector, cTConnectorObject) then GLastConnector.SkipConnectedLinesDrawShadow; end; // сбросить выделенные для привязки if GPrevFigureSnap <> nil then begin TConnectorObject(GPrevFigureSnap).DrawSnapFigures(GPrevFigureSnap, False); GPrevFigureSnap := nil; end; // сбросить выделенные для привязки if GFigureSnap <> nil then begin TConnectorObject(GFigureSnap).DrawSnapFigures(GFigureSnap, False); GFigureSnap := nil; end; end; if PCad.IsDragging then begin if GLastConnector <> nil then begin if CheckFigureByClassName(GLastConnector, cTConnectorObject) then GLastConnector.SkipConnectedLinesDrawShadow; end; end; if (Button = mbRight) and (PCad.ToolIdx = toSelect) then begin FormCADPopupMenu(X, Y, true); //16.12.2011 - Выделяем объект в МП if GPopupFigure <> nil then begin if (GPopupFigure is TOrthoLine) or (GPopupFigure is TConnectorObject) then ShowObjectInPM(GPopupFigure.ID, '') else if GPopupFigure is TNet then SelectComponInPM(FCADListID, GPopupFigure.ID); end; end; // показ длинны отрезка трассы if (Button = mbLeft) and (PCad.ToolIdx = toSelect) then begin if PCad.SelectedCount = 1 then if CheckFigureByClassName(TFigure(PCad.Selection[0]), cTOrthoLine) then begin LineLen := TOrthoLine(PCad.Selection[0]).LineLength; if TOrthoLine(PCad.Selection[0]).FIsRaiseUpDown then sbView.Panels[1].Text := cCad_Mes13 + FormatFloat(ffMask, MetreToUOM(LineLen)) + GetUOMString(GCurrProjUnitOfMeasure) else sbView.Panels[1].Text := cCad_Mes14 + FormatFloat(ffMask, MetreToUOM(LineLen)) + GetUOMString(GCurrProjUnitOfMeasure); end; end; // проверка - есть ли выделенный обьект if (FSCS_Main.aViewCADObjectsProp.Checked) OR (GObjectProperty = True) then begin if PCad.Selection.Count = 1 then begin FigureProperty := TFigure(PCad.Selection[0]); F_SizePos.DefineObjectSizePos; F_SizePos.edObjectName.Text := GetFullFigureName(FigureProperty, X,Y); end else begin F_SizePos.edWidth.Clear; F_SizePos.edHeight.Clear; F_SizePos.edAngle.Clear; F_SizePos.edX.Clear; F_SizePos.edY.Clear; F_SizePos.edZ.Clear; F_SizePos.edObjectName.Clear; end; end; if F_Navigator <> nil then RefreshCAD(F_Navigator.PCadNavigator); {********** ОБРАБОТКА ТРАССЫ (SELECT & UNSELECT) **************************} // Убрать предыдущее выделение трассы if GExistsSelectTrace then begin DeselectTraceInCAD; GExistsSelectTrace := False; end; // есть конечный объект if GEndPoint <> nil then begin // Выделить всю трассу если она есть if (PCad.ToolIdx = toSelect) and (FAutoSelectTrace = True) and (PCad.SelectedCount = 1) then begin if CheckFigureByClassName(TFigure(PCad.Selection[0]), cTConnectorObject) and (TFigure(PCad.Selection[0]) <> GEndPoint) then begin if TConnectorObject(PCad.Selection[0]).ConnectorType <> ct_Clear then begin CurrentWA := TConnectorObject(PCad.Selection[0]); if CheckFigureByClassName(GEndPoint, cTConnectorObject) then CurrentServer := TConnectorObject(GEndPoint) else if CheckFigureByClassName(GEndPoint, cTHouse) then CurrentServer := GetEndPointByHouse(THouse(GEndPoint), CurrentWA); // получить трассу if CurrentServer <> nil then begin AllTraceProp := GetAllTraceWithProperties(CurrentServer.ID, CurrentWA.ID); if AllTraceProp.Trace <> nil then begin AllTraceProp.Length := SelectTraceInCAD(AllTraceProp.Trace); sbView.Panels[1].Text := GetMsgLengthToPoint(AllTraceProp.Length); //cCad_Mes15 + FormatFloat(ffMask, MetreToUOM(AllTraceProp.Length)) + GetUOMString(GCurrProjUnitOfMeasure); end; FreeAndNil(AllTraceProp.Trace); GExistsSelectTrace := True; end; end; end; end; end else // нет конечного объекта begin // Выделить всю трассу если она есть if (PCad.ToolIdx = toSelect) and (FAutoSelectTrace = True) and (PCad.SelectedCount = 1) then begin if CheckFigureByClassName(TFigure(PCad.Selection[0]), cTConnectorObject) then begin if TConnectorObject(PCad.Selection[0]).ConnectorType <> ct_Clear then begin CurrentWA := TConnectorObject(PCad.Selection[0]); // получить трассу AllCablesTraces := GetConnectedTracesToConFigure(CurrentWA.ID); if AllCablesTraces <> nil then SelectTraceInCAD(AllCablesTraces); FreeAndNil(AllCablesTraces); GExistsSelectTrace := True; end; end; end; end; // PCad.SnapToGrids := True; except on E: Exception do addExceptionToLogEx('TF_CAD.PCadSurfaceMouseUp', E.Message); end; end; procedure TF_CAD.PCadSurfaceDblClick(Sender: TObject); var i: integer; ClickFigure: TFigure; GlobalClickFigure: TFigure; Currline: TOrthoLine; CheckedFigure: TFigure; LNbr: Integer; begin try if TimerDblClk.Enabled then exit; if PCad.ToolIdx = TPCTool(11) then begin TimerDblClk.Enabled := True; exit; end; try ClickFigure := CheckBySCSObjects(GCurrMousePos.x, GCurrMousePos.y); except ClickFigure := nil; end; if ClickFigure = nil then begin try GlobalClickFigure := PCad.CheckByPoint(PCad.ActiveLayer, GCurrMousePos.x, GCurrMousePos.y); if GlobalClickFigure = nil then begin GlobalClickFigure := PCad.CheckByPoint(0, GCurrMousePos.x, GCurrMousePos.y); if GlobalClickFigure is TBlock then GlobalClickFigure := Nil; end; except GlobalClickFigure := nil; end; end else GlobalClickFigure := ClickFigure; if (GlobalClickFigure <> nil) and (not GlobalClickFigure.Selected) then begin LNbr := GLN(GlobalClickFigure.LayerHandle); {$IF Not Defined(ES_GRAPH_SC)} if LNbr <> 1 then begin {$IFEND} if CurrentLayer <> LNbr then begin PCad.DeselectAll(CurrentLayer); RefreshCAD(PCad); CurrentLayer := LNbr; GlobalClickFigure.Select; RefreshCAD(PCad); end else begin CheckByCaptionsNotes(GCurrMousePos.x, GCurrMousePos.y); end; {$IF Not Defined(ES_GRAPH_SC)} end else begin ClickFigure := nil; GlobalClickFigure := nil; end; {$IFEND} end; if ClickFigure <> nil then begin if PCad.ActiveLayer = 2 then begin GPopupFigure := ClickFigure; if not CheckFigureByClassName(GPopupFigure, cTHouse) then begin if CheckEmptyFigure(GPopupFigure.ID) then begin if CheckFigureByClassName(GPopupFigure, cTConnectorObject) then begin if not TConnectorObject(GPopupFigure).FIsApproach then FSCS_Main.aObjProperties.Execute; end else FSCS_Main.aObjProperties.Execute; end else FSCS_Main.aComponProperties.Execute; end; end; // выделить всю трассу на CAD if CheckFigureByClassName(ClickFigure, cTConnectorObject) then begin if PCad.ActiveLayer = 2 then if FAutoSelectTrace then if GEndPoint <> nil then FSCS_Main.aSelectTracetoServer.Execute; end; end; if (ClickFigure = nil) and (GlobalClickFigure = nil) then begin {$IF Defined(ES_GRAPH_SC)} CurrentLayer := 8; {$else} if PCad.ActiveLayer <> 2 then CurrentLayer := 2 else TimerDblClk.Enabled := True; {$ifend} end; except on E: Exception do addExceptionToLogEx('TF_CAD.PCadSurfaceDblClick', E.Message); end; end; function TF_CAD.GetFigureAngle(AP1x, AP1y, AP2x, AP2y: Double): Double; var Len_X, Len_Y: Double; AngleRad: Double; AddAngle: Double; begin Result := 0; try Len_X := Abs(AP1x - AP2x); Len_Y := Abs(AP1y - AP2y); // проверки и вычиление угла в градусах AngleRad := 0; AddAngle := 0; // для неортогональных линий if (AP1x < AP2x) and (AP1y < AP2y) then // 1 begin AngleRad := ArcTan2(Len_Y, Len_X); // угол в радианах AddAngle := 0; end; if (AP1x > Ap2x) and (AP1y < AP2y) then //2 begin AngleRad := ArcTan2(Len_X, Len_Y); // угол в радианах AddAngle := 90; end; if (AP1x > AP2x) and (AP1y > AP2y) then //3 begin AngleRad := ArcTan2(Len_Y, Len_X); // угол в радианах AddAngle := 180; end; if (AP1x < AP2x) and (AP1y > AP2y) then //4 begin AngleRad := ArcTan2(Len_X, Len_Y); // угол в радианах AddAngle := 270; end; Result := Round(AngleRad * 180 / pi) + AddAngle; // для ортогональных линий if (AP1y = AP2y) and (AP1x < AP2x) then Result := 0; if (AP1y = AP2y) and (AP1x > AP2x) then Result := 180; if (AP1x = AP2x) and (AP1y < AP2y) then Result := 90; if (AP1x = AP2x) and (AP1y > AP2y) then Result := 270; except on E: Exception do addExceptionToLogEx('TF_CAD.GetFigureAngle', E.Message); end; end; procedure TF_CAD.PCadFigureSelect(Sender: TObject; Figure: TFigure); begin {//02.04.2012 try except on E: Exception do addExceptionToLogEx('TF_CAD.PCadFigureSelect', E.Message); end;} end; procedure TF_CAD.PCadGUIEvent(Sender: TObject; EventId, Numval: Integer; StrVal: String; DblVal: Double; CEnable: Boolean); var i, j: integer; RemJoinedFigure: TFigure; Joined1: TConnectorObject; Joined2: TConnectorObject; DelFigure: TFigure; begin if EventId = 95 then begin if assigned(FRemFigures) and (FRemFigures.Count > 0) and (GTraceStatus = False) (*important!!!*) then begin BeginProgress; try PCad.OnGUIEvent := nil; i := 0; while i < FRemFigures.Count do begin FWaitWork := True; //Application.ProcessMessages; if Assigned(FRemFigures[i]) then begin try // удалить связи конекторов с удаленными ортолиниями if CheckFigureByClassName(TFigure(FRemFigures[i]), cTOrthoLine) then begin Joined1 := TConnectorObject(TOrthoLine(FRemFigures[i]).JoinConnector1); Joined2 := TConnectorObject(TOrthoLine(FRemFigures[i]).JoinConnector2); try if (Joined1 <> nil) and (Joined1.RemJoined <> nil) then begin for j := 0 to Joined1.RemJoined.Count - 1 do begin RemJoinedFigure := TFigure(Joined1.RemJoined[j]); Joined1.JoinedOrtholinesList.Remove(RemJoinedFigure); end; end; except end; try if (Joined2 <> nil) and (Joined2.RemJoined <> nil) then begin for j := 0 to Joined2.RemJoined.Count - 1 do begin RemJoinedFigure := TFigure(Joined2.RemJoined[j]); Joined2.JoinedOrtholinesList.Remove(RemJoinedFigure); end; end; except end; end; {******************************************************************} if (F_NormBase <> nil) and (F_ProjMan <> nil) then begin // Ortholine & Connector if CheckFigureByClassName(TFigure(FRemFigures[i]), cTOrthoLine) or (CheckFigureByClassName(TFigure(FRemFigures[i]), cTConnectorObject) and (not TConnectorObject(TFigure(FRemFigures[i])).fisApproach)) then DeleteObjectFromPM(TFigure(FRemFigures[i]).ID, TFigure(FRemFigures[i]).Name) // Cabinet else if CheckFigureByClassName(TFigure(FRemFigures[i]), cTCabinet) then DeleteRoomFromCADToPM(TCabinet(FRemFigures[i]).FSCSID) // CabinetExt else if CheckFigureByClassName(TFigure(FRemFigures[i]), cTCabinetExt) then DeleteRoomFromCADToPM(TCabinetExt(FRemFigures[i]).FSCSID) // House else if CheckFigureByClassName(TFigure(FRemFigures[i]), cTHouse) then DeleteObjectFromPM(THouse(FRemFigures[i]).ID, THouse(FRemFigures[i]).Name) // Approach else if CheckFigureByClassName(TFigure(FRemFigures[i]), cTConnectorObject) and (TConnectorObject(TFigure(FRemFigures[i])).fisApproach) then DeleteComponInPM(FCADListID, TConnectorObject(FRemFigures[i]).FComponID); end; try if CheckFigureByClassName(TFigure(FRemFigures[i]), cTFigureGrpMod) or CheckFigureByClassName(TFigure(FRemFigures[i]), cTFigureGrpNotMod) then RemoveInFigureGrp(TFigureGrp(FRemFigures[i])) // запомнить присоединенные коннекторы чтобы удалить (с-п) // (они не выделяются потому и не удаляются вместе с группой) else if CheckFigureByClassName(TFigure(FRemFigures[i]), cTOrthoLine) then begin Joined1 := TConnectorObject(TOrthoLine(FRemFigures[i]).JoinConnector1); Joined2 := TConnectorObject(TOrthoLine(FRemFigures[i]).JoinConnector2); if Joined1 <> nil then if Joined1.JoinedOrtholinesList.Count = 0 then if not Joined1.FIsHouseJoined then Joined1.Delete(False, False); if Joined2 <> nil then if Joined2.JoinedOrtholinesList.Count = 0 then if not Joined2.FIsHouseJoined then Joined2.Delete(False, False); end; PCad.Figures.Remove(FRemFigures[i]); TFigure(FRemFigures[i]).Destroy; FRemFigures[i] := Nil; except end; except on E: Exception do addExceptionToLogEx('TF_CAD.PCadGUIEvent', E.Message); end; end; i := i + 1; end; finally FWaitWork := False; // *UNDO* FCanSaveForUndo := True; EndProgress; if FRemFigures <> nil then FRemFigures.Clear; PCad.OnGUIEvent := PCadGUIEvent; RefreshCAD(PCad); end; if F_Navigator <> nil then RefreshCAD(F_Navigator.PCadNavigator); end; end; end; procedure TF_CAD.FormMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); var X, Y: Integer; begin try Handled := True; PCad.AutoRefresh := False; // Масштаб if ssCtrl in Shift then begin FSCS_Main.aInc1pt.Execute; end else // Scrolls (Horiz) if (ssShift in Shift) and not (ssCtrl in Shift) then begin X := PCad.HSCBarPosition; PCad.SetHScrollPosition(X - 10, True); end else // Scrolls (Vert) if Shift = [] then begin Y := PCad.VSCBarPosition; PCad.SetVScrollPosition(Y - 10, True); end; // скролл Set_SCS_HorScroll; Set_SCS_VerScroll; PCad.AutoRefresh := True; RefreshCAD_T(PCad); except on E: Exception do addExceptionToLogEx('TF_CAD.FormMouseWheelUp', E.Message); end; end; procedure TF_CAD.FormMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); var X, Y: Integer; begin try Handled := True; PCad.AutoRefresh := False; // Масштаб if ssCtrl in Shift then begin FSCS_Main.aDec1pt.Execute; end else // Scrolls (Horiz) if (ssShift in Shift) and not (ssCtrl in Shift) then begin X := PCad.HSCBarPosition; PCad.SetHScrollPosition(X + 10, True); end else // Scrolls (Vert) if Shift = [] then begin Y := PCad.VSCBarPosition; PCad.SetVScrollPosition(Y + 10, True); end; // сколл Set_SCS_HorScroll; Set_SCS_VerScroll; PCad.AutoRefresh := True; RefreshCAD_T(PCad); except on E: Exception do addExceptionToLogEx('TF_CAD.FormMouseWheelDown', E.Message); end; end; procedure TF_CAD.FormResize(Sender: TObject); begin //26.12.2011 try ChangeScrollsOnChangeListSize; //26.12.2011 except //26.12.2011 on E: Exception do addExceptionToLogEx('TF_CAD.FormResize', E.Message); //26.12.2011 end; end; procedure TF_CAD.PCadSelectionChange(Sender: TObject); var i: integer; CurFigure: TFigure; CheckUnselectFigure: TFigure; LastFigure: TFigure; FigureHeightStr: String; begin try // убрать выделения с посторонних объектов if not assigned(PCad) then exit; PCad.AutoRefresh := False; UnSelectFiguresOnSelectedChange(PCad.Selection); PCad.AutoRefresh := True; if PCad.SelectedCount > 0 then begin // LastFigure := TFigure(PCad.Selection[PCad.Selection.Count - 1]); LastFigure := GetLastSelectedSCSObject; if not CheckFigureByClassName(LastFigure, cTFigureGrpMod) and not CheckFigureByClassName(LastFigure, cTFigureGrpNotMod) then begin //08.08.2012 sbView.Panels[1].Text := ''; //08.08.2012 sbView.Panels[2].Text := ''; end; // Выводить имя обьекта! if CheckFigureByClassName(LastFigure, cTConnectorObject) or CheckFigureByClassName(LastFigure, cTOrthoLine) or (LastFigure is TNet) then begin sbView.Panels[2].Text := ''; FigureHeightStr := ''; if CheckFigureByClassName(LastFigure, cTOrthoLine) then begin if TOrthoLine(LastFigure).ActualZOrder[1] = TOrthoLine(LastFigure).ActualZOrder[2] then FigureHeightStr := '(' + FormatFloat(ffMask, MetreToUOM(TOrthoLine(LastFigure).ActualZOrder[1])) + ')' else FigureHeightStr := '(' + FormatFloat(ffMask, MetreToUOM(TOrthoLine(LastFigure).ActualZOrder[1])) + '-' + FormatFloat(ffMask, MetreToUOM(TOrthoLine(LastFigure).ActualZOrder[2])) + ')'; end else if CheckFigureByClassName(LastFigure, cTConnectorObject) then begin FigureHeightStr := '(' + FormatFloat(ffMask, MetreToUOM(TConnectorObject(LastFigure).ActualZOrder[1])) + ')'; end; if FigureHeightStr <> '' then FigureHeightStr := ' '+ FigureHeightStr; sbView.Panels[2].Text := GetFullFigureName(LastFigure) + FigureHeightStr; if LastFigure is TNet then sbView.Panels[1].Text := GetFullFigureLenName(LastFigure); end; end else begin LastFigure := nil; end; if GCanRefreshProperties then begin // при открытом окне свойств заполнить их if FSCS_Main.aViewSCSObjectsProp.Checked then begin if PCad.SelectedCount > 0 then begin GPropertiesObject := LastFigure; if GPropertiesObject <> nil then begin if CheckFigureByClassName(GPropertiesObject, cTConnectorObject) then begin if not TConnectorObject(GPropertiesObject).FIsApproach then F_SCSObjectsProp.Execute(GPropertiesObject); end else F_SCSObjectsProp.Execute(GPropertiesObject); end else begin F_SCSObjectsProp.Height := F_SCSObjectsProp.FNormalModeSize; F_SCSObjectsProp.ClearAllProperties; end; end else begin GPropertiesObject := nil; F_SCSObjectsProp.Height := F_SCSObjectsProp.FNormalModeSize; F_SCSObjectsProp.gbTypes.Visible := False; F_SCSObjectsProp.ClearAllProperties; end; end; end; // if PCad.ActiveLayer in [lnSubstrate, lnSCSCommon, lnArch] then //30.05.2011 if PCad.ActiveLayer = 2 then begin if FSCS_Main.tbCADToolsExpert.Visible then begin FSCS_Main.tbBlkUpExpert.Enabled := True; FSCS_Main.tbBlkDownExpert.Enabled := True; FSCS_Main.tbBlkLeftExpert.Enabled := True; FSCS_Main.tbBlkRightExpert.Enabled := True; end else begin FSCS_Main.tbBlkUpNoob.Enabled := True; FSCS_Main.tbBlkDownNoob.Enabled := True; FSCS_Main.tbBlkLeftNoob.Enabled := True; FSCS_Main.tbBlkRightNoob.Enabled := True; end; end else begin if FSCS_Main.tbCADToolsExpert.Visible then begin FSCS_Main.tbBlkUpExpert.Enabled := False; FSCS_Main.tbBlkDownExpert.Enabled := False; FSCS_Main.tbBlkLeftExpert.Enabled := False; FSCS_Main.tbBlkRightExpert.Enabled := False; end else begin FSCS_Main.tbBlkUpNoob.Enabled := False; FSCS_Main.tbBlkDownNoob.Enabled := False; FSCS_Main.tbBlkLeftNoob.Enabled := False; FSCS_Main.tbBlkRightNoob.Enabled := False; end; end; except on E: Exception do addExceptionToLogEx('TF_CAD.PCadSelectionChange', E.Message); end; end; procedure TF_CAD.PCadScaleChanged(Sender: TObject); var NewScrollPosX: Double; NewScrollPosY: Double; SetScrollPosX: Integer; SetScrollPosY: Integer; NewZoomScale: Integer; CalcedZoomKoef: Double; CalcedZoomDelta: Double; Koefs: TDoublePoint; begin try // Гориз. скролл есть NewZoomScale := PCad.ZoomScale; CalcedZoomKoef := (GSavedZoomScale / NewZoomScale); CalcedZoomDelta := (NewZoomScale - GSavedZoomScale); Koefs := GetScaleKoefs; if IfVisibleHorScrollBar then begin // CORRECT!!! if PCad.SelectedCount = 0 then begin if (GSavedScrollPosX <> -1) then begin SetScrollPosX := Round(GSavedScrollPosX / CalcedZoomKoef + Koefs.x / GSavedZoomScale * CalcedZoomDelta); PCad.SetHScrollPosition(SetScrollPosX, PCad.AutoRefresh); end; end; HorScroll.Visible := True; Set_SCS_HorScroll; end else HorScroll.Visible := False; // Вертик. скролл есть if ifVisibleVerScrollBar then begin if PCad.SelectedCount = 0 then begin if (GSavedScrollPosY <> -1) then begin SetScrollPosY := Round(GSavedScrollPosY / CalcedZoomKoef + Koefs.y / GSavedZoomScale * CalcedZoomDelta); PCad.SetVScrollPosition(SetScrollPosY, PCad.AutoRefresh); end; end; VerScroll.Visible := True; Set_SCS_VerScroll; end else VerScroll.Visible := False; // подредактировать скролбары // только гориз. if IfVisibleHorScrollBar and not ifVisibleVerScrollBar then HorScroll.Width := PCad.Width - 7; // только вертик. if not IfVisibleHorScrollBar and ifVisibleVerScrollBar then VerScroll.Height := PCad.Height - 7; // оба if IfVisibleHorScrollBar and ifVisibleVerScrollBar then begin HorScroll.Width := PCad.Width - 15 - 7; VerScroll.Height := PCad.Height - 15 - 7; end; if FSCS_Main.tbCADToolsExpert.Visible then FSCS_Main.cbScaleExpert.Text := IntToStr(PCad.ZoomScale) + '%' else FSCS_Main.cbScaleNoob.Text := IntToStr(PCad.ZoomScale) + '%' except on E: Exception do addExceptionToLogEx('TF_CAD.PCadScaleChanged', E.Message); end; end; function TF_CAD.IfVisibleHorScrollBar: Boolean; var Client_Width: Integer; Page: TRect; begin Result := False; try Client_Width := PCad.ClientWidth; Page := PCad.GetPageRect; if (Page.Left < 0) or (Page.Right > Client_Width) then Result := True else Result := False; except on E: Exception do addExceptionToLogEx('TF_CAD.IfVisibleHorScrollBar', E.Message); end; end; function TF_CAD.IfVisibleVerScrollBar: Boolean; var Client_Height: Integer; Page: TRect; begin Result := False; try Client_Height := PCad.ClientHeight; Page := PCad.GetPageRect; if (Page.Top < 0) or (Page.Bottom > Client_Height) then Result := True else Result := False; except on E: Exception do addExceptionToLogEx('TF_CAD.IfVisibleVerScrollBar', E.Message); end; end; procedure TF_CAD.HorScrollScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer); begin try if ScrollCode = scEndScroll then Set_PCad_HorScroll; PCad.SetFocus; except on E: Exception do addExceptionToLogEx('TF_CAD.HorScrollScroll', E.Message); end; end; procedure TF_CAD.VerScrollScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer); begin try if ScrollCode = scEndScroll then Set_PCad_VerScroll; PCad.SetFocus; except on E: Exception do addExceptionToLogEx('TF_CAD.VerScrollScroll', E.Message); end; end; function TF_CAD.GetMaxScrollsPosition: TPoint; var Page: TRect; PageX, PageY: Integer; ClientX, ClientY: Integer; begin try Result := Point(0, 0); Page := PCad.GetPageRect; PageX := abs(Page.Right - Page.Left); PageY := abs(Page.Bottom - page.Top); ClientX := PCad.ClientWidth; ClientY := PCad.ClientHeight; Result.x := PageX - ClientX + 59; Result.y := PageY - ClientY + 59; except on E: Exception do addExceptionToLogEx('TF_CAD.GetMaxScrollsPosition', E.Message); end; end; function TF_CAD.GetPageSizesScrolls: TPoint; var Page: TRect; PageX, PageY: Integer; ClientX, ClientY: Integer; begin try Result := Point(0, 0); Page := PCad.GetPageRect; PageX := abs(Page.Right - Page.Left); PageY := abs(Page.Bottom - page.Top); ClientX := PCad.ClientWidth; ClientY := PCad.ClientHeight; Result.x := Round(ClientX / PageX * 100); Result.y := Round(ClientY / PageY * 100); except on E: Exception do addExceptionToLogEx('TF_CAD.GetPageSizesScrolls', E.Message); end; end; procedure TF_CAD.Set_PCad_HorScroll; var Koef_ScrollPos_X: Double; MaxCADScroll_X: Integer; SetScrollPos_X: Integer; begin try // позиция CAD MaxCADScroll_X := GetMaxScrollsPosition.X; // Sets if (HorScroll.Max - HorScroll.PageSize) > 0 then begin Koef_ScrollPos_X := HorScroll.Position / (HorScroll.Max - HorScroll.PageSize); SetScrollPos_X := round(MaxCADScroll_X * Koef_ScrollPos_X); PCad.SetHScrollPosition(SetScrollPos_X, True); //PCad.SetHScrollPosition(SetScrollPos_X, False); //PCad.SurfacePaint; end; except on E: Exception do addExceptionToLogEx('TF_CAD.Set_PCad_HorScroll', E.Message); end; end; procedure TF_CAD.Set_PCad_VerScroll; var Koef_ScrollPos_Y: Double; MaxCADScroll_Y: Integer; SetScrollPos_Y: Integer; begin try // позиция CAD MaxCADScroll_Y := GetMaxScrollsPosition.Y; // 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); //PCad.SetVScrollPosition(SetScrollPos_Y, false); //PCad.SurfacePaint; end; except on E: Exception do addExceptionToLogEx('TF_CAD.Set_PCad_VerScroll', E.Message); end; end; procedure TF_CAD.Set_SCS_HorScroll; var MaxCADScroll_X: Integer; CurScrollPos_X: Integer; begin try // позиция CAD CurScrollPos_X := PCad.HSCBarPosition; MaxCADScroll_X := GetMaxScrollsPosition.X; // Sets HorScroll.PageSize := GetPageSizesScrolls.X; if MaxCADScroll_X > 0 then begin HorScroll.Position := round(CurScrollPos_X / MaxCADScroll_X * (HorScroll.Max - HorScroll.PageSize + 1)); try if Self.Visible then PCad.SetFocus; except end; end; except on E: Exception do addExceptionToLogEx('TF_CAD.Set_SCS_HorScroll', E.Message); end; end; procedure TF_CAD.Set_SCS_VerScroll; var MaxCADScroll_Y: Integer; CurScrollPos_Y: Integer; begin try // позиция CAD CurScrollPos_Y := PCad.VSCBarPosition; MaxCADScroll_Y := GetMaxScrollsPosition.Y; // Sets pos VerScroll.PageSize := GetPageSizesScrolls.Y; if MaxCADScroll_Y > 0 then begin VerScroll.Position := round(CurScrollPos_Y / MaxCADScroll_Y * (VerScroll.Max - VerScroll.PageSize + 1)); try if self.Visible then PCad.SetFocus; except end; end; except on E: Exception do addExceptionToLogEx('TF_CAD.Set_SCS_VerScroll', E.Message); end; end; procedure TF_CAD.SetCurrentLayer(ALNbr: Integer); var OldActLayer: integer; LayerName: string; PrjCaption: string; ListCaption: string; Item: TListItem; Layer: TLayer; begin try OldActLayer := PCad.ActiveLayer; PCad.DeselectAll(OldActLayer); PCad.ActiveLayer := ALNbr; if F_LayersDialog.Showing then begin F_LayersDialog.lbCurLayer.Caption := PCad.GetLayerName(ALNbr); Layer := PCad.GetLayer(ALNbr); Item := F_LayersDialog.FinditemByLayer(ALNbr, Layer); if Item <> nil then Item.Selected := true; end; LayerName := PCad.GetLayerName(PCad.ActiveLayer); try PrjCaption := GetCurrProjectParams.Caption; ListCaption := GetListParams(FCADListID).Caption; Caption := PrjCaption + ' - ' + ListCaption + cCad_Mes17 + LayerName; except Caption := ''; end; if OldActLayer <> ALNbr then begin if ALNbr = 0 then mProtocol.Lines.Add(cCad_Mes18); if ALNbr = 1 then mProtocol.Lines.Add(cCad_Mes19); if ALNbr = 2 then mProtocol.Lines.Add(cCad_Mes20); if ALNbr = 3 then mProtocol.Lines.Add(cCad_Mes21); if ALNbr = 4 then mProtocol.Lines.Add(cCad_Mes22); if ALNbr = 5 then mProtocol.Lines.Add(cCad_Mes23); if ALNbr = 6 then mProtocol.Lines.Add(cCad_Mes24); if ALNbr = 7 then mProtocol.Lines.Add(cCad_Mes25); if ALNbr = 8 then mProtocol.Lines.Add(cCad_Mes26); if ALNbr = 9 then mProtocol.Lines.Add(cCad_Mes30); if (ALNbr >= 0) and (ALNbr <= 1) then begin FSCS_Main.UnRegisteredCADHotKeys; FSCS_Main.aSnaptoGrid.Enabled := True; FSCS_Main.aSnaptoGrid.Checked := LastSnapGridStatus; PCad.SnapToGrids := LastSnapGridStatus; end; // SCS if (ALNbr >= 2) and (ALNbr <= 9) then begin FSCS_Main.RegisteredCADHotKeys; // FSCS_Main.aSnaptoGrid.Checked := True; // PCad.SnapToGrids := True; end; if (ALNbr = lnSCSCommon) or (ALNbr = lnSubstrate) or (ALNbr = lnArch) then begin FSCS_Main.aShiftUpObject.Enabled := True; FSCS_Main.aShiftDownObject.Enabled := True; FSCS_Main.aShiftLeftObject.Enabled := True; FSCS_Main.aShiftRightObject.Enabled := True; end else begin FSCS_Main.aShiftUpObject.Enabled := False; FSCS_Main.aShiftDownObject.Enabled := False; FSCS_Main.aShiftLeftObject.Enabled := False; FSCS_Main.aShiftRightObject.Enabled := False; end; if (ALNbr = 1) or (ALNbr = 7) or (ALNbr >= 10) then begin PCad.RecordUndo := True; PCad.UndoCount := 0; end else begin PCad.RecordUndo := False; PCad.UndoCount := 0; end; // if PCad.ToolIdx <> toSelect then begin RefreshCAD(PCad); PCad.SetTool(toSelect, 'TSelected'); // if FSCS_Main.tbCADToolsExpert.Visible then // FSCS_Main.tbSelectExpert.Down := True // else // FSCS_Main.tbSelectNoob.Down := True; FCreateObjectOnClick := False; end; end; if ALNbr > 0 then FSCS_Main.cbLayers.ItemIndex := ALNbr - 1; FCurrentLayer := ALNbr; except on E: Exception do addExceptionToLogEx('TF_CAD.SetCurrentLayer', E.Message); end; end; procedure TF_CAD.FormDeactivate(Sender: TObject); begin try GGlobalShiftState := []; FCurrPCadScrollX := PCad.HSCBarPosition; FCurrPCadScrollY := PCad.VSCBarPosition; except on E: Exception do addExceptionToLogEx('TF_CAD.FormDeactivate', E.Message); end; end; procedure TF_CAD.ChangeScrollsOnChangeListSize; var PCadAutoRefresh: Boolean; begin if PCad.UpdateCount <> 0 then Exit; ///// EXIT ///// PCadAutoRefresh := PCad.AutoRefresh; //DisableAlign; //26.12.2011 try PCad.Color := PCad.PageColor; //07.08.2012 - чтобы при растягивании не появлялись внизу/справа серые поля PCad.DisableAlign; try PCad.AutoRefresh := False; PCad.SetHScrollPosition(FCurrPCadScrollX, False); PCad.SetVScrollPosition(FCurrPCadScrollY, False); // Гориз. скролл есть if IfVisibleHorScrollBar then begin HorScroll.Visible := True; Set_SCS_HorScroll; end else HorScroll.Visible := False; // Вертик. скролл есть if ifVisibleVerScrollBar then begin VerScroll.Visible := True; Set_SCS_VerScroll; end else VerScroll.Visible := False; // подредактировать скролбары // только гориз. if IfVisibleHorScrollBar and not ifVisibleVerScrollBar then HorScroll.Width := PCad.Width - 7; // только вертик. if not IfVisibleHorScrollBar and ifVisibleVerScrollBar then VerScroll.Height := PCad.Height - 7; // оба if IfVisibleHorScrollBar and ifVisibleVerScrollBar then begin HorScroll.Width := PCad.Width - 15 - 7; VerScroll.Height := PCad.Height - 15 - 7; end; finally PCad.EnableAlign; end; //PCad.BeginUpdate; //PCad.SurfacePaint; //PCad.EndUpdate; PCad.AutoRefresh := PCadAutoRefresh; SetZoomScale(Pcad.ZoomScale); RefreshCAD_T(PCad); //RefreshCAD(PCad); except on E: Exception do addExceptionToLogEx('TF_CAD.ChangeScrollsOnChangeListSize', E.Message); end; //EnableAlign; //26.12.2011 end; procedure TF_CAD.MoveCADOnPan(ADeltaX, ADeltaY: double); var hscroll, vscroll: integer; begin try PCad.AutoRefresh := False; hscroll := PCad.HSCBarPosition; vscroll := PCad.VSCBarPosition; PCad.SetHScrollPosition(hscroll + round(-adeltax * 5){round(-adeltax) * round(PCad.ZoomScale / 50)}, true); PCad.SetVScrollPosition(vscroll + round(-adeltay * 5){round(-adeltay) * round(PCad.ZoomScale / 50)}, true); // Гориз. скролл есть if IfVisibleHorScrollBar then begin HorScroll.Visible := True; Set_SCS_HorScroll; end else HorScroll.Visible := False; // Вертик. скролл есть if ifVisibleVerScrollBar then begin VerScroll.Visible := True; Set_SCS_VerScroll; end else VerScroll.Visible := False; // подредактировать скролбары // только гориз. if IfVisibleHorScrollBar and not ifVisibleVerScrollBar then HorScroll.Width := PCad.Width - 7; // только вертик. if not IfVisibleHorScrollBar and ifVisibleVerScrollBar then VerScroll.Height := PCad.Height - 7; // оба if IfVisibleHorScrollBar and ifVisibleVerScrollBar then begin HorScroll.Width := PCad.Width - 15 - 7; VerScroll.Height := PCad.Height - 15 - 7; end; PCad.AutoRefresh := True; if Abs(FPanLastRefeshTick - GetTickCount) > 50 then begin FPanLastRefeshTick := GetTickCount; //PCad.Repaint; //RefreshCAD(PCad); //RefreshCAD_T(PCad); //PCad.ManualRefresh; //PCad.RefreshSelection; end; PCad.ManualRefresh; except on E: Exception do addExceptionToLogEx('TF_CAD.MoveCADOnPan', E.Message); end; end; procedure TF_CAD.ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean); begin try if Msg.message = WM_MOUSEWHEEL then begin Handled := True; ApplicationEvents1.OnMessage := nil; SendMessage(Self.Handle, msg.message, Msg.wParam, msg.lParam); ApplicationEvents1.OnMessage := ApplicationEvents1Message; end; if FWaitWork then Handled := True else inherited; except on E: Exception do addExceptionToLogEx('TF_CAD.ApplicationEvents1Message', E.Message); end; end; Function TF_CAD.CheckScrollingOnTracing(ax, ay: double): Boolean; var //top, bottom, left, right: double; deltax, deltay: double; scrollw, scrollh: integer; step: double; VRect: TDoubleRect; begin Result := False; try deltax := 0; deltay := 0; // if PCad.ZoomScale < 50 then // SetZoomScale(50); step := 10 * 100 / PCad.ZoomScale; if step < 1 then step := 1; if IfVisibleHorScrollBar and ifVisibleVerScrollBar then begin //20.06.2013 //top := PCad.GetVisibleRect.Top; //bottom := PCad.GetVisibleRect.Bottom; //left := PCad.GetVisibleRect.Left; //right := PCad.GetVisibleRect.Right; //if (ax < left + 5{ * 100 / PCad.ZoomScale}) then // deltax := - step; //if (ax > right - 5{ * 100 / PCad.ZoomScale}) then // deltax := step; //if (ay < top + 5{ * 100 / PCad.ZoomScale}) then // deltay := - step; //if (ay > bottom - 5{ * 100 / PCad.ZoomScale}) then // deltay := step; VRect := PCad.GetVisibleRect; if (ax < VRect.Left + 5{ * 100 / PCad.ZoomScale}) then deltax := - step; if (ax > VRect.Right - 5{ * 100 / PCad.ZoomScale}) then deltax := step; if (ay < VRect.Top + 5{ * 100 / PCad.ZoomScale}) then deltay := - step; if (ay > VRect.Bottom - 5{ * 100 / PCad.ZoomScale}) then deltay := step; if (deltax <> 0) or (deltay <> 0) then begin ScrollCADOnTracing(deltax, deltay); Result := True; end; end; except on E: Exception do addExceptionToLogEx('TF_CAD.CheckScrollingOnTracing', E.Message); end; end; procedure TF_CAD.FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); var Res1: TWinControl; Pt: TPoint; begin try GetCursorPos(Pt); Res1 := FindControl(WindowFromPoint(Pt)); if not PCad.Focused then if Res1.Parent.Name = 'PCad' then begin if (PCad.ToolIdx = toSelect) and (PCad.SelectedCount = 0) then begin SendMessage(Self.Handle, WM_ACTIVATE, MakewParam(WA_ACTIVE, 0), 0); SendMessage(Self.Handle, WM_SETFOCUS, 0, 0); RefreshCAD_T(PCAd); end; end; except end; if ((PCad.ToolIdx = toFigure) and (PCad.ToolInfo = 'TOrthoLine')) and (GClickIndex > 0) then GReDrawAfterRefresh := True; end; procedure TF_CAD.SetZoomScale(aScale: Integer); var r1: TRect; Rect: TDoubleRect; pt: TPoint; ConvX, ConvY, ConvZ, DeconvX, DeconvY, DeconvZ: double; ConvX1, ConvY1, ConvZ1, DeconvX1, DeconvY1, DeconvZ1: double; begin try if aScale <> PCad.ZoomScale then begin GSavedScrollPosX := PCad.HSCBarPosition; GSavedScrollPosY := PCad.VSCBarPosition; GSavedZoomScale := PCad.ZoomScale; if PCad.AutoRefresh then begin PCad.AutoRefresh := False; try PCad.ZoomScale := aScale; except end; PCad.AutoRefresh := True; end else begin try PCad.ZoomScale := aScale; except end; end; GSavedScrollPosX := -1; GSavedScrollPosY := -1; GSavedZoomScale := PCad.ZoomScale; end else PCad.ResetRegions; except on E: Exception do addExceptionToLogEx('TF_CAD.SetZoomScale', E.Message); end; end; procedure TF_CAD.sDivMoved(Sender: TObject); begin try ChangeScrollsOnChangeListSize; GCadForm.PCad.AutoRefresh := True; except on E: Exception do addExceptionToLogEx('TF_CAD.FormResize', E.Message); end; end; procedure TF_CAD.ScrollCADOnTracing(adeltax, adeltay: double); var hscroll, vscroll: integer; begin try PCad.AutoRefresh := False; hscroll := PCad.HSCBarPosition; vscroll := PCad.VSCBarPosition; if adeltax <> 0 then PCad.SetHScrollPosition(hscroll + round(adeltax), true); if adeltay <> 0 then PCad.SetVScrollPosition(vscroll + round(adeltay), true); // Гориз. скролл есть if IfVisibleHorScrollBar then begin HorScroll.Visible := True; Set_SCS_HorScroll; end else HorScroll.Visible := False; // Вертик. скролл есть if ifVisibleVerScrollBar then begin VerScroll.Visible := True; Set_SCS_VerScroll; end else VerScroll.Visible := False; // подредактировать скролбары // только гориз. if IfVisibleHorScrollBar and not ifVisibleVerScrollBar then HorScroll.Width := PCad.Width - 7; // только вертик. if not IfVisibleHorScrollBar and ifVisibleVerScrollBar then VerScroll.Height := PCad.Height - 7; // оба if IfVisibleHorScrollBar and ifVisibleVerScrollBar then begin HorScroll.Width := PCad.Width - 15 - 7; VerScroll.Height := PCad.Height - 15 - 7; end; PCad.AutoRefresh := True; RefreshCAD(PCad); except on E: Exception do addExceptionToLogEx('TF_CAD.ScrollCADOnTracing', E.Message); end; end; procedure TF_CAD.FCADOnRefresh(Sender: TObject); begin try if PCad <> nil then begin if FWasDeleteQuery then FWasDeleteQuery := False; if ((PCad.ToolIdx = toFigure) and (PCad.ToolInfo = 'TOrthoLine')) and (GClickIndex > 0) then begin GReDrawAfterRefresh := True; end; end; except on E: Exception do addExceptionToLogEx('TF_CAD.OnRefreshCAD', E.Message); end; end; procedure TF_CAD.FCADOnKeyStroke(Sender: TObject; Key: Word; Shift: TShiftState; var CanHandle: Boolean); var i: Integer; ObjList: TList; begin try // When the user press DEL key, you should bypass it from Powercad and // send to TNet just to delete the selected element of the figure CanHandle := True; if (Key = vk_Delete) and (ssCtrl in Shift) then begin if PCad.ActiveLayer = lnArch then begin if PCad.SelectedCount > 0 then begin if CheckFigureByClassName(TFigure(PCad.Selection[0]), 'TNet') then begin CanHandle := False; FSCS_Main.aDeleteWallRect.Execute; RefreshCAD(PCad); end; end; end; end else if Key = vk_Delete then begin for i := 0 to PCad.Selection.Count - 1 do begin if PCad.ActiveLayer = lnArch then begin if CheckFigureByClassName(TFigure(PCad.Selection[i]), 'TNet') then begin CanHandle := False; FSCS_Main.aDeleteWallPath.Execute; FSCS_Main.aDeleteColumn.Execute; RefreshCAD(PCad); end; end; end; end; // Если на Арх.плане Ctrl+Z или Ctrl+Y - перевести в режим селекта, чтобы отработать if (PCad.ToolIdx = toFigure) and (PCad.ActiveLayer = lnArch) then if ((Key = 89) or (Key = 90)) and (ssCtrl in Shift) then PCad.SetTool(toSelect, 'TSelected'); if (PCad.ToolIdx = toSelect) then begin // CTRL + A if (Key = 65) and (ssCtrl in Shift) then begin PCad.DrawFigures; RefreshCAD_T(PCad); GCanRefreshProperties := True; end; // CTRL + X if (Key = 88) and (ssCtrl in Shift) then begin if (FListType <> lt_Normal) or (PCad.ActiveLayer = lnArch) or CheckOneOfSCSlayers(PCad.ActiveLayer) then begin Clipboard.Clear; CanHandle := False; end else SetProjectChanged(True); end; // CTRL + C if (Key = 67) and (ssCtrl in Shift) then begin if (FListType <> lt_Normal) or (PCad.ActiveLayer = lnArch) or CheckOneOfSCSlayers(PCad.ActiveLayer) then begin Clipboard.Clear; CanHandle := False; end else SetProjectChanged(True); end; // CTRL + V if (Key = 86) and (ssCtrl in Shift) then begin if (FListType <> lt_Normal) or ((PCad.ActiveLayer <> 1) and (PCad.ActiveLayer <> 7)) then begin CurrentLayer := 1; end; end; // CTRL + Y if (Key = 89) and (ssCtrl in Shift) then begin // CTRL + Y для слоя СКС if (FListType = lt_Normal) and ((PCad.ActiveLayer = lnArch) or CheckOneOfSCSlayers(PCad.ActiveLayer)) then begin SCSRedoNormalList; SetProjectChanged(True); end else // CTRL + Y для листа схемы проекта if (FListType = lt_ProjectPlan) then begin SCSRedoProjectPlan; SetProjectChanged(True); CanHandle := False; end else // CTRL + Y для листа дизайна шкафа if (FListType = lt_DesignBox) then begin SCSRedoDesignList; SetProjectChanged(True); CanHandle := False; end // это не обычный лист и слои на нем левые else if (FListType <> lt_Normal) or ((PCad.ActiveLayer <> 1) and (PCad.ActiveLayer <> 7) and (PCad.ActiveLayer < 10)) then begin CanHandle := False; end else SetProjectChanged(True); end; // CTRL + Z if (Key = 90) and (ssCtrl in Shift) then begin // CTRL + Z для слоя СКС if (FListType = lt_Normal) and ((PCad.ActiveLayer = lnArch) or CheckOneOfSCSlayers(PCad.ActiveLayer)) then begin SCSUndoNormalList; SetProjectChanged(True); end else // CTRL + Z для листа схемы проекта if (FListType = lt_ProjectPlan) then begin SCSUndoProjectPlan; SetProjectChanged(True); CanHandle := False; end else // CTRL + Z для листа дизайна шкафа if (FListType = lt_DesignBox) then begin SCSUndoDesignList; SetProjectChanged(True); CanHandle := False; end // это не обычный лист и слои на нем левые else if (FListType <> lt_Normal) or ((PCad.ActiveLayer <> 1) and (PCad.ActiveLayer <> 7) and (PCad.ActiveLayer < 10)) then begin CanHandle := False; end else SetProjectChanged(True); end; // CTRL + D // Создать дубликаты выделенных объектов if (Key = 68) and (ssCtrl in Shift) then begin if FListType = lt_Normal then begin if (PCad.ActiveLayer = lnSCSCommon) or (PCad.ActiveLayer = lnArch) then begin FSCS_Main.aCreateDuplicates.Execute; end; end; end; // Увеличить масштаб "+" if (Key = 187) or (Key = 107) then begin FSCS_Main.aInc1pt.Execute; end; // Уменьшить масштаб "-" if (Key = 189) or (Key = 109) then begin FSCS_Main.aDec1pt.Execute; end; // поворот выделенных объектов на +-5 грудусов if (ssCtrl in Shift) and ((Key = VK_NUMPAD6) or (Key = VK_NUMPAD4)) then begin if (PCad.ActiveLayer = 2) then begin ObjList := TList.Create; for i := 0 to PCad.SelectedCount - 1 do begin if CheckFigureByClassName(TFigure(PCad.Selection[i]), cTConnectorObject) then if TConnectorObject(PCad.Selection[i]).ConnectorType <> ct_Clear then ObjList.Add(TConnectorObject(PCad.Selection[i])); end; if ObjList.Count > 0 then begin if Key = VK_NUMPAD6 then RotateObjectsByKeyboard(ObjList, 5); if Key = VK_NUMPAD4 then RotateObjectsByKeyboard(ObjList, -5); end; FreeAndNil(ObjList); end; end; end; if (Key >=37) and (Key <= 40) then begin GMoveByArrow := True; end; except on E: Exception do addExceptionToLogEx('TF_CAD.FCADOnKeyStroke', E.Message); end; end; procedure TF_CAD.PCadMapScaleChanged(Sender: TObject); begin try ReCalcAllLinesLength; if Assigned(FActiveNet) and Not FActiveNet.Deleted then FActiveNet.SetMapScale(PCad.MapScale); //FActiveNet.MapScale := PCad.MapScale; if Assigned(ActiveNet) and Not ActiveNet.Deleted then ActiveNet.SetMapScale(PCad.MapScale); //ActiveNet.MapScale := PCad.MapScale; SetMapScaleToNets(Self); SetProjectChanged(True); except on E: Exception do addExceptionToLogEx('TF_CAD.PCadMapScaleChanged', E.Message); end; end; procedure TF_CAD.sDivCanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); begin try GCadForm.PCad.AutoRefresh := False; except on E: Exception do addExceptionToLogEx('TF_CAD.sDivCanResize', E.Message); end; end; procedure TF_CAD.FormCADPopupMenu(X, Y: Double; aAllowSelectInPM: Boolean); var i: Integer; Point: TPoint; Conn: TConnectorObject; Net: TNet; ArchObj: TSCSComponent; ArchSubObj: TSCSComponent; Path: TNetPath; TNetCount: Integer; procedure pmObjectsPrepare; var IsPolyline: Boolean; PolyLine: TPolyline; Seg: TPLSegment; PenPattern:TPattern; begin FSCS_Main.aObjProperties.Visible := True; FSCS_Main.pmiObjectSplit0.Visible := True; FSCS_Main.aFreeRotate.Visible := True; FSCS_Main.pmiObjectSplit1.Visible := True; FSCS_Main.aBackwards.Visible := True; FSCS_Main.aForward.Visible := True; FSCS_Main.aGrouping.Visible := True; FSCS_Main.aUngrouping.Visible := True; FSCS_Main.aLock.Visible := True; FSCS_Main.aUnlock.Visible := True; FSCS_Main.pmiObjectSplit2.Visible := True; FSCS_Main.aCreateBlockToFile.Visible := True; FSCS_Main.aCreateBlockToNB.Visible := True; FSCS_Main.pmiObjectSplit3.Visible := False; FSCS_Main.aDesignBoxCaptionHeight.Visible := False; FSCS_Main.aDesignBoxCaptionWidth.Visible := False; FSCS_Main.pmiObjectSplit4.Visible := False; FSCS_Main.aBlockParams.Visible := True; //16.05.2011 False; FSCS_Main.aCabinetFalseFloor.Visible := False; FSCS_Main.aConvertSegmentToArc.Visible := False; FSCS_Main.aInsertKnotForCabinet.Visible := False; FSCS_Main.aDeleteKnotForCabinet.Visible := False; FSCS_Main.aInvertArcSegment.Visible := False; FSCS_Main.aRotatePointObject90.Visible := True; FSCS_Main.aRotatePointObject180.Visible := True; FSCS_Main.aRotatePointObject270.Visible := True; FSCS_Main.aMirrorFigure.Visible := True; if Assigned(GPopupFigure) then begin FSCS_Main.aConvertToPolygon.Visible := GPopupFigure is TCircle; FSCS_Main.aLinesToTraces.Visible := (GPopupFigure is TLine) or (GPopupFigure is TPolyline) or (GPopupFigure is TFigureGrp); FSCS_Main.aTransparentFigure.Visible := GPopupFigure is TBMPObject; if FSCS_Main.aTransparentFigure.Visible then FSCS_Main.aTransparentFigure.Checked := TBMPObject(GPopupFigure).Transparent; end else begin FSCS_Main.aConvertToPolygon.Visible := false; FSCS_Main.aLinesToTraces.Visible := false; FSCS_Main.aTransparentFigure.Visible := False; end; // Для полилинии PolyLine := nil; Seg := nil; //PenPattern := nil; IsPolyline := (GPopupFigure <> nil) and (GPopupFigure is TPolyline); if IsPolyline then begin PolyLine := TPolyline(GPopupFigure); Seg := TPLSegment(PolyLine.Segments[PolyLine.SelectedPoint-1]); end; FSCS_Main.pmiObjectSplitPoly.Visible := IsPolyline; FSCS_Main.aSegCurveAll.Visible := IsPolyline; FSCS_Main.aSegLineAll.Visible := IsPolyline; FSCS_Main.aSegInsertKnot.Visible := IsPolyline; FSCS_Main.aSegDeleteKnot.Visible := IsPolyline; FSCS_Main.pmiObjSegment.Visible := IsPolyline; FSCS_Main.aSegDivTo3.Visible := IsPolyline; FSCS_Main.aSegRoundCornerByArc.Visible := IsPolyline; FSCS_Main.aSegDimLine.Visible := IsPolyline; FSCS_Main.pmiSegPenPattern.Visible := IsPolyline; if Assigned(PolyLine) then begin FSCS_Main.aSegClose.Visible := Not PolyLine.Closed; FSCS_Main.aSegOpen.Visible := PolyLine.Closed; if Assigned(Seg) then begin FSCS_Main.aSegLine.Checked := (Seg.SType = sLine); FSCS_Main.aSegCurve.Checked := (Seg.SType = sCurve); FSCS_Main.aSegArc.Checked := (Seg.SType = sArc); FSCS_Main.aSegDimLine.Checked := Seg.ShowDim; end else begin FSCS_Main.aSegLine.Checked := false; FSCS_Main.aSegCurve.Checked := false; FSCS_Main.aSegArc.Checked := false; FSCS_Main.aSegDimLine.Checked := Seg.ShowDim; end; FSCS_Main.aSegInverArc.Visible := FSCS_Main.aSegArc.Checked; FSCS_Main.aSegPenNone.Checked := Not Assigned(PolyLine.PenPattern); if Assigned(PolyLine.PenPattern) then begin FSCS_Main.aSegPenZigZag.Checked := (PolyLine.PenPattern.PatName = pnZigZag); FSCS_Main.aSegPenFlower.Checked := (PolyLine.PenPattern.PatName = pnFlower); FSCS_Main.aSegPenSinus.Checked := (PolyLine.PenPattern.PatName = pnSinus); FSCS_Main.aSegPenButtons.Checked := (PolyLine.PenPattern.PatName = pnButtons); FSCS_Main.aSegPenSquare.Checked := (PolyLine.PenPattern.PatName = pnSquare); FSCS_Main.aSegPenMiniSinus.Checked := (PolyLine.PenPattern.PatName = pnMiniSinus); end else begin FSCS_Main.aSegPenZigZag.Checked := false; FSCS_Main.aSegPenFlower.Checked := false; FSCS_Main.aSegPenSinus.Checked := false; FSCS_Main.aSegPenButtons.Checked := false; FSCS_Main.aSegPenSquare.Checked := false; FSCS_Main.aSegPenMiniSinus.Checked := false; end; end else begin FSCS_Main.aSegClose.Visible := false; FSCS_Main.aSegOpen.Visible := false; FSCS_Main.aSegInverArc.Visible := false; end; end; procedure pmObjectsForArchPrepare; begin //FSCS_Main.pmiArchTurn.Visible FSCS_Main.aObjProperties.Visible := False; //True; FSCS_Main.pmiObjectSplit0.Visible := False; //True; FSCS_Main.aFreeRotate.Visible := False; //True; FSCS_Main.pmiObjectSplit1.Visible := False; //True; FSCS_Main.aBackwards.Visible := False; //True; FSCS_Main.aForward.Visible := False; //True; FSCS_Main.aGrouping.Visible := True; FSCS_Main.aUngrouping.Visible := True; FSCS_Main.aLock.Visible := False; FSCS_Main.aUnlock.Visible := false; FSCS_Main.pmiObjectSplit2.Visible := False; //True; FSCS_Main.aCreateBlockToFile.Visible := False; //True; FSCS_Main.aCreateBlockToNB.Visible := False; //True; FSCS_Main.pmiObjectSplit3.Visible := False; FSCS_Main.aDesignBoxCaptionHeight.Visible := False; FSCS_Main.aDesignBoxCaptionWidth.Visible := False; FSCS_Main.pmiObjectSplit4.Visible := False; FSCS_Main.aBlockParams.Visible := True; FSCS_Main.aCabinetFalseFloor.Visible := False; FSCS_Main.aConvertSegmentToArc.Visible := False; FSCS_Main.aInsertKnotForCabinet.Visible := False; FSCS_Main.aDeleteKnotForCabinet.Visible := False; FSCS_Main.aInvertArcSegment.Visible := False; FSCS_Main.aRotatePointObject90.Visible := True; FSCS_Main.aRotatePointObject180.Visible := True; FSCS_Main.aRotatePointObject270.Visible := True; FSCS_Main.aMirrorFigure.Visible := True; //FSCS_Main.aConvertToPolygon.Visible := Assigned(GPopupFigure) and (GPopupFigure is TNet) and end; begin GPopupFigure := nil; //16.05.2011 ArchObj := nil; ArchSubObj := nil; GetCursorPos(FPopupScrPoint); //04.05.2012 try GetCursorPos(Point); if PCad.CheckByPoint(PCad.ActiveLayer, X, Y) = nil then begin //21.05.2012 for i := 0 to 14 do //21.05.2012 FSCS_Main.pmList.Items[i].Visible := True; FSCS_Main.pmiListProperties.Visible := True; FSCS_Main.pmiListAllScreen.Visible := True; FSCS_Main.pmiList50.Visible := True; FSCS_Main.pmiList75.Visible := True; FSCS_Main.pmiList100.Visible := True; FSCS_Main.pmiList150.Visible := True; FSCS_Main.pmiList200.Visible := True; FSCS_Main.pmiList400.Visible := True; FSCS_Main.pmiListGridStep.Visible := True; FSCS_Main.pmiListInc.Visible := True; FSCS_Main.pmiListInc1pt.Visible := True; FSCS_Main.pmiListDec1pt.Visible := True; FSCS_Main.pmiListPageColor.Visible := True; FSCS_Main.pmiListBackgroundColor.Visible := True; FSCS_Main.pmiListClearGuides.Visible := True; if FListType = lt_DesignBox then begin //21.05.2012 FSCS_Main.pmList.Items[15].Visible := True; //21.05.2012 FSCS_Main.pmList.Items[16].Visible := True; FSCS_Main.pmiListDesignBoxParams.Visible := True; FSCS_Main.pmiListRefreshDesignList.Visible := True; end else begin //21.05.2012 FSCS_Main.pmList.Items[15].Visible := False; //21.05.2012 FSCS_Main.pmList.Items[16].Visible := False; FSCS_Main.pmiListDesignBoxParams.Visible := False; FSCS_Main.pmiListRefreshDesignList.Visible := False; end; FSCS_Main.pmList.Popup(Point.X, Point.Y); end else begin // для обьектов PowerCad if PCad.ActiveLayer = 1 then begin GPopupFigure := PCad.CheckByPoint(PCad.ActiveLayer, X, Y); if GPopupFigure = nil then Exit; if CheckFigureByClassName(GPopupFigure, cTCadNorms) then begin FSCS_Main.pmiCNNormsEdit.Visible := True; FSCS_Main.pmiCNNormsProp.Visible := True; FSCS_Main.pmCadNorms.Popup(Point.X, Point.Y); end else begin //16.05.2011 //FSCS_Main.pmObject.Items[0].Visible := True; //FSCS_Main.pmObject.Items[1].Visible := True; //FSCS_Main.pmObject.Items[2].Visible := True; //FSCS_Main.pmObject.Items[3].Visible := True; //FSCS_Main.pmObject.Items[4].Visible := True; //FSCS_Main.pmObject.Items[5].Visible := True; //FSCS_Main.pmObject.Items[6].Visible := True; //FSCS_Main.pmObject.Items[7].Visible := True; //FSCS_Main.pmObject.Items[8].Visible := True; //FSCS_Main.pmObject.Items[9].Visible := True; //FSCS_Main.pmObject.Items[10].Visible := True; //FSCS_Main.pmObject.Items[11].Visible := True; //FSCS_Main.pmObject.Items[12].Visible := True; //FSCS_Main.pmObject.Items[13].Visible := False; //FSCS_Main.pmObject.Items[14].Visible := False; //FSCS_Main.pmObject.Items[15].Visible := False; //FSCS_Main.pmObject.Items[16].Visible := False; //FSCS_Main.pmObject.Items[17].Visible := False; //FSCS_Main.pmObject.Items[18].Visible := False; //FSCS_Main.pmObject.Items[19].Visible := False; //FSCS_Main.pmObject.Items[20].Visible := False; //FSCS_Main.pmObject.Items[21].Visible := False; //FSCS_Main.pmObject.Items[22].Visible := False; pmObjectsPrepare; if GCadForm.FListType = lt_DesignBox then begin if PCad.SelectedCount > 0 then begin if CheckFigureByClassName(TFigure(PCad.Selection[0]), 'TText') then begin //16.05.2011 //FSCS_Main.pmObject.Items[13].Visible := False; //FSCS_Main.pmObject.Items[14].Visible := False; //FSCS_Main.pmObject.Items[15].Visible := False; FSCS_Main.pmiObjectSplit3.Visible := False; FSCS_Main.aDesignBoxCaptionHeight.Visible := False; FSCS_Main.aDesignBoxCaptionWidth.Visible := False; end; end; end; if CheckFigureByClassName(GPopupFigure, 'TBlock') or CheckFigureByClassName(GPopupFigure, 'TFigureGrp') or CheckFigureByClassName(GPopupFigure, 'TWMFObject') then begin //16.05.2011 //FSCS_Main.pmObject.Items[16].Visible := True; //FSCS_Main.pmObject.Items[17].Visible := True; FSCS_Main.pmiObjectSplit4.Visible := True; FSCS_Main.aBlockParams.Visible := True; end; FSCS_Main.pmObject.Popup(Point.X, Point.Y); end; end; // для кабинетов if PCad.ActiveLayer = 9 then begin GPopupFigure := PCad.CheckByPoint(PCad.ActiveLayer, X, Y); if GPopupFigure = nil then Exit; if CheckFigureByClassName(GPopupFigure, cTCabinet) then begin //16.05.2011 //for i := 0 to 17 do // FSCS_Main.pmObject.Items[i].Visible := False; //FSCS_Main.pmObject.Items[18].Visible := True; //FSCS_Main.pmObject.Items[19].Visible := False; //FSCS_Main.pmObject.Items[20].Visible := False; //FSCS_Main.pmObject.Items[21].Visible := False; //FSCS_Main.pmObject.Items[22].Visible := False; //FSCS_Main.pmObject.Popup(Point.X, Point.Y); ShowHideMenuItems(FSCS_Main.pmObject, false); FSCS_Main.aCabinetFalseFloor.Visible := True; FSCS_Main.pmObject.Popup(Point.X, Point.Y); end else if CheckFigureByClassName(GPopupFigure, cTCabinetExt) then begin //for i := 0 to 17 do // FSCS_Main.pmObject.Items[i].Visible := False; //FSCS_Main.pmObject.Items[18].Visible := True; //FSCS_Main.pmObject.Items[19].Visible := True; //FSCS_Main.pmObject.Items[20].Visible := True; //FSCS_Main.pmObject.Items[21].Visible := True; //FSCS_Main.pmObject.Items[22].Visible := True; //FSCS_Main.pmObject.Popup(Point.X, Point.Y); ShowHideMenuItems(FSCS_Main.pmObject, false); FSCS_Main.aCabinetFalseFloor.Visible := True; FSCS_Main.aConvertSegmentToArc.Visible := True; FSCS_Main.aInsertKnotForCabinet.Visible := True; FSCS_Main.aDeleteKnotForCabinet.Visible := True; FSCS_Main.aInvertArcSegment.Visible := True; FSCS_Main.pmObject.Popup(Point.X, Point.Y); end; end; // для архитектурного проектирования if PCad.ActiveLayer = lnArch then begin if PCad.SelectedCount = 1 then begin // TNET if CheckFigureByClassName(TFigure(PCad.Selection.Items[0]), 'TNet') then begin //07.06.2010 Переход на имена Экшнов //// Для сегмента // if TNet(PCad.Selection[0]).SelPath <> nil then // begin // FSCS_Main.pmArchDesign.Items[0].Visible := True; // FSCS_Main.pmArchDesign.Items[1].Visible := True; // FSCS_Main.pmArchDesign.Items[2].Visible := True; // FSCS_Main.pmArchDesign.Items[3].Visible := True; // FSCS_Main.pmArchDesign.Items[4].Visible := True; // FSCS_Main.pmArchDesign.Items[5].Visible := True; // FSCS_Main.pmArchDesign.Items[6].Visible := True; // FSCS_Main.pmArchDesign.Items[7].Visible := True; // FSCS_Main.pmArchDesign.Items[9].Visible := False; // FSCS_Main.pmArchDesign.Items[11].Visible := False; // FSCS_Main.pmArchDesign.Items[12].Visible := False; // FSCS_Main.pmArchDesign.Items[13].Visible := False; // FSCS_Main.pmArchDesign.Items[14].Visible := True; // FSCS_Main.pmArchDesign.Items[15].Visible := True; // FSCS_Main.pmArchDesign.Items[16].Visible := True; // FSCS_Main.pmArchDesign.Items[17].Visible := True; // // FSCS_Main.pmArchDesign.Items[18].Visible := True; // if TNet(PCad.Selection[0]).SelPath.ActiveDoor <> nil then // begin // FSCS_Main.pmArchDesign.Items[8].Visible := True; // FSCS_Main.pmArchDesign.Items[10].Visible := True; // end // else // begin // FSCS_Main.pmArchDesign.Items[8].Visible := False; // FSCS_Main.pmArchDesign.Items[10].Visible := False; // end; // if TNet(PCad.Selection[0]).SelPath.FShowLength then // begin // FSCS_Main.pmArchDesign.Items[18].Checked := True; // end // else // begin // FSCS_Main.pmArchDesign.Items[18].Checked := False; // end; // FSCS_Main.pmArchDesign.Popup(Point.X, Point.Y); // end; // // Для колонны // if TNet(PCad.Selection[0]).SelCol <> nil then // begin // FSCS_Main.pmArchDesign.Items[0].Visible := False; // FSCS_Main.pmArchDesign.Items[1].Visible := True; // FSCS_Main.pmArchDesign.Items[2].Visible := False; // FSCS_Main.pmArchDesign.Items[3].Visible := False; // FSCS_Main.pmArchDesign.Items[4].Visible := False; // FSCS_Main.pmArchDesign.Items[5].Visible := False; // FSCS_Main.pmArchDesign.Items[6].Visible := False; // FSCS_Main.pmArchDesign.Items[7].Visible := False; // FSCS_Main.pmArchDesign.Items[8].Visible := False; // FSCS_Main.pmArchDesign.Items[9].Visible := True; // FSCS_Main.pmArchDesign.Items[10].Visible := False; // FSCS_Main.pmArchDesign.Items[11].Visible := True; // FSCS_Main.pmArchDesign.Items[12].Visible := True; // FSCS_Main.pmArchDesign.Items[13].Visible := True; // FSCS_Main.pmArchDesign.Items[14].Visible := False; // FSCS_Main.pmArchDesign.Items[15].Visible := False; // FSCS_Main.pmArchDesign.Items[16].Visible := False; // FSCS_Main.pmArchDesign.Items[17].Visible := False; // FSCS_Main.pmArchDesign.Items[18].Visible := False; // FSCS_Main.pmArchDesign.Popup(Point.X, Point.Y); // end; FSCS_Main.aConvertToPolygon.Visible := false; FSCS_Main.aLinesToTraces.Visible := false; Net := TNet(PCad.Selection[0]); ArchObj := GetArchObjByCADObj(Net); Path := Net.SelPath; // Для сегмента if Path <> nil then begin ArchSubObj := GetArchObjByCADObj(Path); FSCS_Main.aDeleteWallPath.Visible := True; FSCS_Main.aDeleteWallRect.Visible := True; FSCS_Main.aDivSelPath.Visible := True; FSCS_Main.aSetWallPathWidth.Visible := True; FSCS_Main.aSetAllWallPathWidth.Visible := True; FSCS_Main.aAddWindow.Visible := True; FSCS_Main.aAddDoor.Visible := True; FSCS_Main.aAddColumn.Visible := (Net.SelPath.FComponID = 0); //FSCS_Main.aAddColumn.Visible := True; FSCS_Main.aDeleteColumn.Visible := False; FSCS_Main.aSetColumnAngle.Visible := False; FSCS_Main.aSetColumnHeight.Visible := False; FSCS_Main.aSetColumnWidth.Visible := False; FSCS_Main.aSetPathLineWidth.Visible := True; FSCS_Main.aSetPathLineStyle.Visible := True; FSCS_Main.aSetAllPathLineWidth.Visible := True; FSCS_Main.aSetAllPathLineStyle.Visible := True; FSCS_Main.aWallPathShowLength.Visible := True; // Перевернуть объекта FSCS_Main.pmiArchTurn.Visible := Path.ExistsPerpendPt; //(Path.epl1<>nil)or(Path.epl2<>nil)or(Path.epr1<>nil) or (Path.epr2<>nil); if Path.WStyle = wsLine then begin FSCS_Main.aSetAllPathLineWidth.Visible := False; FSCS_Main.aAddWindow.Visible := False; FSCS_Main.aAddDoor.Visible := False; FSCS_Main.aAddColumn.Visible := False; FSCS_Main.aSetWallPathWidth.Visible := false; FSCS_Main.aSetAllWallPathWidth.Visible := false; end; if Net.SelPath.ActiveDoor <> nil then begin FSCS_Main.aDeleteWindowDoor.Visible := True; FSCS_Main.aSetSizeWindowDoor.Visible := True; if Net.SelPath.ActiveDoor.DoorObjType = dotNiche then FSCS_Main.pmiArchTurn.Visible := true; end else begin FSCS_Main.aDeleteWindowDoor.Visible := False; FSCS_Main.aSetSizeWindowDoor.Visible := False; end; if Net.SelPath.FShowLength then FSCS_Main.aWallPathShowLength.Checked := True else FSCS_Main.aWallPathShowLength.Checked := False; // сегмент в дугу FSCS_Main.aNetPathToArc.Visible := false; //if Not Path.isArc and // ((Path.FComponID = 0) or (TSCSComponent(GetArchObjByCADObj(Path)).IsLine = ctArhWall)) then if Not Path.isArc and ((Path.FComponID = 0) or Assigned(ArchSubObj)) then FSCS_Main.aNetPathToArc.Visible := true; // инвертировать дугу FSCS_Main.aInvertNetPathArc.Visible := false; if Path.isArc then begin FSCS_Main.aInvertNetPathArc.Visible := true; FSCS_Main.aConvertToPolygon.Visible := true; end; if Assigned(ArchObj) then begin if ArchObj.IsLine = ctArhRoofSeg then FSCS_Main.aNetProps.Visible := true else FSCS_Main.aNetProps.Visible := false; end else FSCS_Main.aNetProps.Visible := false; if Assigned(ArchSubObj) then begin if (ArchSubObj.IsLine = ctArhRoofHip) then begin FSCS_Main.DefinePMItemsRoofHipTypes; ShowHideMenuItemsList(FSCS_Main.FPMItemsRoofHipTypes, true); SetCheckToMenuItemList(FSCS_Main.FPMItemsRoofHipTypes, ArchSubObj.GetPropertyValueAsInteger(pnRoofHipType)); end else ShowHideMenuItemsList(FSCS_Main.FPMItemsRoofHipTypes, false); end else ShowHideMenuItemsList(FSCS_Main.FPMItemsRoofHipTypes, false); SelectComponInPM(FCADListID, Path.FComponID); //16.12.2011 FSCS_Main.pmArchDesign.Popup(Point.X, Point.Y); end else begin if ((ArchSubObj = nil) or (ArchSubObj.IsLine <> ctArhRoofHip)) and (FSCS_Main.FPMItemsRoofHipTypes <> nil) then ShowHideMenuItemsList(FSCS_Main.FPMItemsRoofHipTypes, false); end; // Для колонны if Net.SelCol <> nil then begin FSCS_Main.aDeleteWallPath.Visible := False; FSCS_Main.aDeleteWallRect.Visible := True; FSCS_Main.aDivSelPath.Visible := False; FSCS_Main.aSetWallPathWidth.Visible := False; FSCS_Main.aSetAllWallPathWidth.Visible := False; FSCS_Main.aAddWindow.Visible := False; FSCS_Main.aAddDoor.Visible := False; FSCS_Main.aAddColumn.Visible := False; FSCS_Main.aDeleteWindowDoor.Visible := False; FSCS_Main.aDeleteColumn.Visible := True; FSCS_Main.aSetSizeWindowDoor.Visible := False; FSCS_Main.aSetColumnAngle.Visible := True; FSCS_Main.aSetColumnHeight.Visible := True; FSCS_Main.aSetColumnWidth.Visible := True; FSCS_Main.aSetPathLineWidth.Visible := False; FSCS_Main.aSetPathLineStyle.Visible := False; FSCS_Main.aSetAllPathLineWidth.Visible := False; FSCS_Main.aSetAllPathLineStyle.Visible := False; FSCS_Main.aWallPathShowLength.Visible := False; FSCS_Main.pmArchDesign.Popup(Point.X, Point.Y); end; end else begin GPopupFigure := PCad.CheckByPoint(PCad.ActiveLayer, X, Y); //pmObjectsForArchPrepare; //FSCS_Main.aFreeRotate.Visible := True; pmObjectsPrepare; FSCS_Main.pmObject.Popup(Point.X, Point.Y); end; end else begin TNetCount := 0; // Проверяем все ли объекты TNet for i := 0 to PCad.SelectedCount - 1 do if CheckFigureByClassName(TFigure(PCad.Selection.Items[i]), 'TNet') then TNetCount := TNetCount + 1; if TNetCount = PCad.SelectedCount then begin pmObjectsForArchPrepare; //FSCS_Main.aFreeRotate.Visible := True; FSCS_Main.pmObject.Popup(Point.X, Point.Y); end else begin pmObjectsPrepare; FSCS_Main.pmObject.Popup(Point.X, Point.Y); end; end; end; // для обьектов СКС if PCad.ActiveLayer = 2 then begin try if GCadForm.PCad.SelectedCount = 1 then GPopupFigure := TFigure(GCadForm.PCad.Selection[0]) else GPopupFigure := CheckBySCSObjects(X, Y); except GPopupFigure := nil; exit; end; if GPopupFigure <> nil then begin GPopupFigure.Select; if aAllowSelectInPM then ShowObjectInPM(GPopupFigure.ID, ''); RefreshCAD(PCad); end else exit; if CheckFigureByClassName(GPopupFigure, cTOrthoLine) then begin SetMenuItemsForOrthoLine(TOrthoLine(GPopupFigure)); FSCS_Main.pmSCSObject.Popup(Point.X, Point.Y); FSCS_Main.pmSCSObject.HelpContext := 74001; end else if CheckFigureByClassName(GPopupFigure, cTConnectorObject) and (not TConnectorObject(GPopupFigure).FIsApproach) then begin FSCS_Main.pmiSCSObjDivTracesOnRoowWalls.Visible := false; //13.03.2013 FSCS_Main.aDivTracesOnRoowWalls.Visible := false; FSCS_Main.pmiSCSObjAutoCreateTraces.Visible := true; //13.03.2013 FSCS_Main.aAutoCreateTraces.Visible := true; if (TConnectorObject(GPopupFigure).ConnectorType = ct_Clear) then begin if (not TConnectorObject(GPopupFigure).FIsHouseJoined) then begin SetMenuItemsForConnector(TConnectorObject(GPopupFigure)); FSCS_Main.pmSCSObject.Popup(Point.X, Point.Y); end; end else begin SetMenuItemsForObject(TConnectorObject(GPopupFigure)); FSCS_Main.pmSCSObject.Popup(Point.X, Point.Y); end; FSCS_Main.pmSCSObject.HelpContext := 74004; end // THOUSE else if CheckFigureByClassName(GPopupFigure, cTHouse) then begin FSCS_Main.pmiHDInsertKnotForHouse.Visible := True; FSCS_Main.pmiHDDeleteKnotForHouse.Visible := True; FSCS_Main.pmiHDAddApproach.Visible := True; FSCS_Main.pmiHDEditApproach.Visible := False; FSCS_Main.pmiHDRotateApproach.Visible := False; FSCS_Main.pmiHDModApproach.Visible := False; FSCS_Main.pmiHDDeleteHouse.Visible := True; if THouse(GPopupFigure).AsEndPoint then begin FSCS_Main.pmiHDServerAsDefault.Visible := False; FSCS_Main.pmiHDNotAsServerDefault.Visible := True; end else begin FSCS_Main.pmiHDServerAsDefault.Visible := True; FSCS_Main.pmiHDNotAsServerDefault.Visible := False; end; FSCS_Main.pmHouseDesign.Popup(Point.X, Point.Y); end // TApproach else if CheckFigureByClassName(GPopupFigure, cTConnectorObject) and (TConnectorObject(GPopupFigure).FIsApproach) then begin FSCS_Main.pmiHDInsertKnotForHouse.Visible := False; FSCS_Main.pmiHDDeleteKnotForHouse.Visible := False; FSCS_Main.pmiHDAddApproach.Visible := False; FSCS_Main.pmiHDEditApproach.Visible := True; FSCS_Main.pmiHDRotateApproach.Visible := True; FSCS_Main.pmiHDModApproach.Visible := True; FSCS_Main.pmiHDDeleteHouse.Visible := False; if TConnectorObject(GPopupFigure).AsEndPoint then begin FSCS_Main.pmiHDServerAsDefault.Visible := False; FSCS_Main.pmiHDNotAsServerDefault.Visible := True; end else begin FSCS_Main.pmiHDServerAsDefault.Visible := True; FSCS_Main.pmiHDNotAsServerDefault.Visible := False; end; FSCS_Main.pmHouseDesign.Popup(Point.X, Point.Y); end else if CheckFigureByClassName(GPopupFigure, cTSCSFigureGrp) then begin //SetMenuItemsForConnector(TConnectorObject(GPopupFigure)); ShowHideMenuItems(FSCS_Main.pmSCSObject, false, false); FSCS_Main.pmiSCSObjFreeRotate.Visible := true; FSCS_Main.pmiSCSObjRotatePointObject90.Visible := true; FSCS_Main.pmiSCSObjRotatePointObject180.Visible := true; FSCS_Main.pmiSCSObjRotatePointObject270.Visible := true; FSCS_Main.pmiSCSObjProperties.Visible := true; FSCS_Main.pmSCSObject.Popup(Point.X, Point.Y); end; end; end; except on E: Exception do addExceptionToLogEx('TF_CAD.FormCADPopupMenu', E.Message); end; end; procedure TF_CAD.PCadSurfaceClick(Sender: TObject); var IDCompon: integer; isNormalMode: Boolean; ClickFigure: TFigure; //21.06.2013 FiguresList: TList; Item: TMenuItem; i: integer; FFigure: TFigure; Point: TPoint; FHeightStr: string; Button: TMouseButton; SelList: TList; FIsRaiseLineFigure: TFigure; Coord1, Coord2: Double; Net: TNet; begin try GCanRefreshProperties := True; if not PCad.Focused then if (PCad.ToolIdx = toSelect) {and (PCad.SelectedCount = 0)} then begin SelList := TList.Create; for i := 0 to PCad.SelectedCount - 1 do SelList.Add(TFigure(PCad.Selection[i])); if FSCS_Main.tbCADToolsExpert.Visible then begin if FSCS_Main.cbScaleExpert.Enabled then FSCS_Main.cbScaleExpert.SetFocus end else begin if FSCS_Main.cbScaleNoob.Enabled then FSCS_Main.cbScaleNoob.SetFocus; end; SendMessage(Self.Handle, WM_ACTIVATE, MakewParam(WA_ACTIVE, 0), 0); SendMessage(Self.Handle, WM_SETFOCUS, 0, 0); for i := 0 to SelList.Count - 1 do TFigure(SelList[i]).Select; RefreshCAD_T(PCad); FreeAndNil(SelList); end; if (GetKeyState(VK_LBUTTON) and 128) = 0 then //14.03.2011 Button := mbLeft; //14.03.2011 // нажата левая кнопка, для выделения с-п !!! if ((GetKeyState(VK_LBUTTON) and 128) = 0) and (PCad.ToolIdx = toSelect) and (not PCad.IsDragging) then begin try FIsRaiseLineFigure := CheckBySCSObjects(GCurrMousePos.x, GCurrMousePos.y); except FIsRaiseLineFigure := nil; end; if FIsRaiseLineFigure <> nil then begin if PCad.ActiveLayer = 2 then if CheckFigureByClassName(FIsRaiseLineFigure, cTOrthoLine) then if TOrthoLine(FIsRaiseLineFigure).FIsRaiseUpDown then begin FIsRaiseLineFigure.Select; RefreshCAD(PCad); end; end; end; // SELECT IN PM if FClickType = ct_Single then begin try ClickFigure := CheckBySCSObjects(GCurrMousePos.x, GCurrMousePos.y); except ClickFigure := nil; end; // поиск других объектов на данной высоте //21.06.2013 - поиск объектов в одной точке выполняется в TF_CAD.PCadGetFigureToSelect // if GFigureSnap = nil then // if (PCad.ToolIdx = toSelect) and (not GCadForm.FCreateObjectOnClick) then // if PCad.SelectedCount = 1 then // begin // FiguresList := GetFiguresByLevel(ClickFigure, GCurrMousePos.x, GCurrMousePos.y, False, true); // // формировать список объектов // if FiguresList.Count > 1 then // begin // GetCursorPos(Point); // //FSCS_Main.pmFiguresByLevel.Items.Clear; // // for i := 0 to FiguresList.Count - 1 do // // begin // // FFigure := TFigure(FiguresList[i]); // // Item := TMenuItem.Create(FSCS_Main.pmFiguresByLevel); // // FHeightStr := ''; // // if CheckFigureByClassName(FFigure, cTOrthoLine) then // // if TOrthoLine(FFigure).ActualZOrder[1] = TOrthoLine(FFigure).ActualZOrder[2] then // // FHeightStr := FormatFloat(ffMask, MetreToUOM(TOrthoLine(FFigure).ActualZOrder[1])) // // else // // FHeightStr := FormatFloat(ffMask, MetreToUOM(TOrthoLine(FFigure).ActualZOrder[1])) + '-' + // // FormatFloat(ffMask, MetreToUOM(TOrthoLine(FFigure).ActualZOrder[2])); // // if CheckFigureByClassName(FFigure, cTConnectorObject) then // // FHeightStr := FormatFloat(ffMask, MetreToUOM(TConnectorObject(FFigure).ActualZOrder[1])); // // Item.Caption := GetFullFigureName(FFigure) + ' (' + FHeightStr + GetUOMString(GCurrProjUnitOfMeasure) + ')' ; // // FSCS_Main.pmFiguresByLevel.Items.Add(Item); // // Item.Tag := FFigure.ID; // // Item.OnClick := SelectFigureEvent; // // end; // BuildPopupFiguresByLevel(FiguresList, SelectFigureEvent); // FSCS_Main.pmFiguresByLevel.Popup(Point.X, Point.Y); // end; // FreeAndNil(FiguresList); // end; //21.06.2013 if ClickFigure <> nil then if FClickSCSFiguresList.Count > 1 then if FClickSCSFiguresList.IndexOf(ClickFigure) <> -1 then begin BuildPopupFiguresByLevel(FClickSCSFiguresList, SelectFigureEvent); FClickSCSFiguresList.Clear; GetCursorPos(Point); FSCS_Main.pmFiguresByLevel.Popup(Point.X, Point.Y); end; // просто компонента if ClickFigure <> nil then begin if PCad.ActiveLayer = 2 then if (F_ProjMan <> nil) and (F_NormBase <> nil) then if PCad.ToolIdx = toSelect then begin if CheckFigureByClassName(ClickFigure, cTConnectorObject) and (TConnectorObject(ClickFigure).FIsApproach) then SelectComponInPM(FCADListID, TConnectorObject(ClickFigure).FComponID) else ShowObjectInPM(ClickFigure.ID, ClickFigure.Name); end; end; // if PCad.ActiveLayer = lnArch then if (F_ProjMan <> nil) and (F_NormBase <> nil) then if PCad.ToolIdx = toSelect then begin ClickFigure := nil; //if (PCad.Selection.Count = 1) and (TObject(PCad.Selection[0]) is TNet) then //begin // Net := TNet(PCad.Selection[0]); // if (Net.SelPath <> nil) and (Net.SelPath.IsPointIn(GCurrMousePos.x, GCurrMousePos.y)) then // ClickFigure := Net; //end; if ClickFigure = nil then ClickFigure := PCad.CheckByPoint(8, GCurrMousePos.x, GCurrMousePos.y); if ClickFigure <> nil then begin SelectComponInPM(FCADListID, ClickFigure.ID); if ClickFigure is TNet then begin TNet(ClickFigure).DoClick(GCurrMousePos.x, GCurrMousePos.y); end; end; end; end; // Создавать объекты при клике isNormalMode := False; if PCad.ToolIdx = toSelect then if IsClickOnFigure then isNormalMode := True; // РЕЖИМ СОЗДАНИЯ ОБЪЕКТОВ ПРИ КЛИКЕ if FCreateObjectOnClick and isNormalMode then begin IDCompon := F_NormBase.GSCSBase.SCSComponent.ID; if IDCompon <> 0 then begin // положить комплектующую CreateOnClickMode(GFigureTraceTo, F_NormBase.GSCSBase.SCSComponent, GCurrMousePos.x, GCurrMousePos.y); end else begin ShowMessage(cCad_Mes16); mProtocol.Lines.Add(cCad_Mes16); end; end; if (PCad.ToolIdx = toSelect) and (Button = mbLeft) then begin RefreshCAD_T(PCad); end; except on E: Exception do addExceptionToLogEx('TF_CAD.PCadSurfaceClick', E.Message); end; end; procedure TF_CAD.SelectFigureEvent(Sender: TObject); var ID: Integer; FFigure: TFigure; begin try ID := TMenuItem(Sender).Tag; FFigure := GetFigureByID(GCadForm, ID); PCad.DeselectAll(2); FFigure.Select; PCad.RecordUndo := True; PCad.OrderSelection(osFront); PCad.RecordUndo := False; ShowObjectInPM(FFigure.ID, FFigure.Name); except on E: Exception do addExceptionToLogEx('TF_CAD.SelectFigureEvent', E.Message); end; end; procedure TF_CAD.DropFigureEvent(Sender: TObject); var ID: Integer; FFigure: TFigure; X, Y: Double; begin try ID := TMenuItem(Sender).Tag; FFigure := GetFigureByID(GCadForm, ID); GFigureSnap := FFigure; ShowObjectInPM(FFigure.ID, FFigure.Name); X := GCurrMousePos.x; Y := GCurrMousePos.y; DoDragDrop(X, Y); except on E: Exception do addExceptionToLogEx('TF_CAD.DropFigureEvent', E.Message); end; end; procedure TF_CAD.DoDragDrop(X, Y: Double); var DropFigure: TFigure; StateType: TCompStateType; ComponID: integer; i, j: integer; isConnected: Boolean; GetRaiseLine: TOrthoLine; CurGCadForm: TF_CAD; IDLine: Integer; SaveSnapToGrid: Boolean; TracingCount: Integer; SelList: TList; NearTracedLine: TOrthoLine; TraceIDs: TIntList; //#From Oleg# ListOfLists: TIntList; vLists: TList; vList: TF_CAD; RaiseConn: TConnectorObject; EndPoint: TConnectorObject; Traces: TList; OldEndPoint: TFigure; IsCreateObjectOnClickTool: Boolean; SCSList: TSCSList; SCSCompon: TSCSComponent; InputMarkRes: Integer; PrevMark: string; SnapFigureConnected: boolean; resChoice: boolean; OldParam: boolean; begin try // дроп на Дизайн шкафа, добавить в шкаф OldEndPoint := nil; if FListType = lt_DesignBox then begin DoFragDropDesigList; EndProgress; exit; end; StateType := stProjectible; //#From Oleg# //14.09.2010 EndPoint := nil; //#From Oleg# //14.09.2010 SelList := TList.Create; for i := 0 to PCad.SelectedCount - 1 do SelList.Add(TFigure(PCad.Selection[i])); //26.01.2011 SaveSnapToGrid := PCad.SnapToGrids; //26.01.2011 if GFigureSnap = nil then //26.01.2011 PCad.SnapToGrids := True; //26.01.2011 CurrentLayer := 2; // убрать выделеные обьекты со слоя подложки PCad.DeselectAll(1); // при отпускании компоненты - воссоздать ее на CAD GListNode := Nil; if Not IsArchComponByIsLine(GDropComponent.IsLine) then begin SaveSnapToGrid := PCad.SnapToGrids; if GFigureSnap = nil then PCad.SnapToGrids := True; CurrentLayer := 2; BeginProgress; try // создать фигуру на CAD if GDropComponent.IsLine = 0 then begin // *UNDO* if FCanSaveForUndo then begin SaveForUndo(uat_None, True, False); FCanSaveForUndo := False; end; end; DropFigure := GetComponentFromNormBase(X, Y, GDropComponent, GFigureSnap, StateType); // скопирование компоненту NormBase -> ProjectManager if DropFigure <> nil then begin ComponID := CopyComponentToPrjManager(GListNode, DropFigure.ID, FCADListID, GDropComponent, False, True); // Дропнулся точечный обьект! if CheckFigureByClassName(DropFigure, cTConnectorObject) then begin SetConnNameInCaptionOnCAD(TConnectorObject(DropFigure)); // положить точечный объект на другой обьект if GFigureSnap <> Nil then begin // на ортолинию if CheckFigureByClassName(GFigureSnap, cTOrthoLine) then CheckingSnapPointObjectToOrthoLine(TConnectorObject(DropFigure), TOrthoLine(GFigureSnap)) // на пустой конектор else if CheckFigureByClassName(GFigureSnap, cTConnectorObject) then CheckingSnapPointObjectToConnector(TConnectorObject(DropFigure), TConnectorObject(GFigureSnap)); end; SetConnObjectSelectHightPriority(TConnectorObject(DropFigure)); //#From Oleg# //29.09.2010 if GFigureSnap = Nil then //25.06.2013 begin //25.06.2013 - если простой точ. объект, то спрашивать нужно ли такие устанавливать в 1 клик (режим "ложить без Drag&Drop") if (GDropComponent.ComponentType.SysName = ctsnWorkPlace) or (GCompTypeSysNameModules.IndexOf(GDropComponent.ComponentType.SysName) <> -1) then begin if GIsProgress then PauseProgress(true); try IsCreateObjectOnClickTool := MessageQuastYN(cMain_Mes140) = IDYES; SCSList := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(FCADListID); if SCSList <> nil then if SCSList.FNewComponNameMarkAsk then if GDropComponent.IsUserMark = biFalse then begin SCSCompon := F_ProjMan.GSCSBase.CurrProject.GetComponentFromReferences(ComponID); if SCSCompon <> nil then begin PrevMark := SCSCompon.NameMark; if SCSList.FNewComponNameMarkSaved = '' then SCSList.FNewComponNameMarkSaved := PrevMark; end; InputMarkRes := InputMark(ApplicationName, cMain_Mes141, SCSList.FNewComponNameMarkSaved); if InputMarkRes = mrOk then begin if trim(PrevMark) <> trim(SCSList.FNewComponNameMarkSaved) then begin SCSList.FNewComponNameMark := SCSList.FNewComponNameMarkSaved; //SCSCompon := F_ProjMan.GSCSBase.CurrProject.GetComponentFromReferences(ComponID); if SCSCompon <> nil then begin SCSCompon.IsUserMark := biTrue; SCSCompon.NameMark := SCSList.FNewComponNameMark; SCSCompon.ApplyChanges; end; end else begin SCSList.FNewComponNameMarkSaved := ''; end; end else begin SCSList.FNewComponNameMarkSaved := ''; if InputMarkRes = mrIgnore then begin SCSList.FNewComponNameMark := ''; SCSList.FNewComponNameMarkAsk := false; end; end; end; if IsCreateObjectOnClickTool then begin FSCS_Main.aCreateObjectOnClickTool.Execute; if FSCS_Main.tbCADToolsExpert.Visible then FSCS_Main.tbCreateOnClickModeExpert.Down := true else FSCS_Main.tbCreateOnClickModeNoob.Down := true; end; finally if GIsProgress then PauseProgress(false); end; end; end; end; end else // компонента(ы) (ортолиния!!!) вбрасываеться в трассу! if (GDropComponent <> nil) and (DropFigure = Nil) and (GFigureSnap <> nil) then begin if CheckFigureByClassName(GFigureSnap, cTConnectorObject) then begin if GCadForm.FCreateObjectOnClick or Self.FCreateObjectOnClick then begin GCadForm.FCreateObjectOnClick := False; Self.FCreateObjectOnClick := False; PCad.SetTool(toSelect, 'TSelected'); FSCS_Main.tbCreateOnClickModeExpert.Down := False; FSCS_Main.tbCreateOnClickModeNoob.Down := False; FSCS_Main.tbSelectExpert.Down := True; FSCS_Main.tbSelectNoob.Down := True; end; // на РТ ComponID := CopyComponentToSCSObject(GFigureSnap.ID, GDropComponent.ID, True); if (GDropComponent.IsLine = 1) and (TConnectorObject(GFigureSnap).ConnectorType <> ct_Clear) then begin //29.06.2013 - Если нету трасс, то предлагаем создать автоматом Traces := GetAllConnectedTraces(TConnectorObject(GFigureSnap)); //получим количество трасс - если нет подсоединенных - сбросим вркменно КО if (Traces.Count = 0) and (GEndPoint <> nil) then begin //if GEndPoint <> PCad then // в принципе может быть что и на том же каде КО сделал пользователь уже begin OldEndPoint := GEndPoint; TConnectorObject(GEndPoint).AsEndPoint := False; GEndPoint := nil; GListWithEndPoint := nil; end; end; end; // Прокладывать автоматически трассы и по новому алгоритму будет автотрассировка если не было КО // если трасс не было - КО на время сбрасывается. // если объект на который дропнули уже подключен - юзать старый алгоритм. SnapFigureConnected := False; if TConnectorObject(GFigureSnap).ConnectorType <> ct_Clear then begin if TConnectorObject(GFigureSnap).JoinedConnectorsList.Count > 0 then SnapFigureConnected := True; end else SnapFigureConnected := True; resChoice := False; if Traces.Count <> 0 then resChoice := ChoiceAutoTraceConnectOrder(nil, true, GDropComponent); if (Traces.Count = 0) or resChoice then begin //if ((GDropComponent.IsLine = 1) and (GEndPoint = Nil)) or ((GDropComponent.IsLine = 1) and (SnapFigureConnected)) then if ((GDropComponent.IsLine = 1) and (GEndPoint = Nil)) or ((GDropComponent.IsLine = 1) and resChoice and (Not F_ProjMan.GSCSBase.CurrProject.Setting.TraceOnePortToOne)) then begin //24.06.2013 mProtocol.Lines.Add(cCad_Mes27) //24.06.2013 - устанавливаем обїект как конечный, и делаем с него авттрассировку if TConnectorObject(GFigureSnap).ConnectorType <> ct_Clear then begin //29.06.2013 - Если нету трасс, то предлагаем создать автоматом if Traces.Count = 0 then begin PCad.DeselectAll(0); PCad.SelectAll(lnSCSCommon); if PCad.Selection.Count > 1 then begin AutoCreateTracesMaster(TConnectorObject(GFigureSnap)); PCad.DeselectAll(0); RefreshCAD(PCad); FreeAndNil(Traces); Traces := GetAllConnectedTraces(TConnectorObject(GFigureSnap)); FCanSaveForUndo := false; end; end; // Если есть трассі от обїекта, то трассируем кабелем if Traces.Count > 0 then begin if (GEndPoint = nil) or not SnapFigureConnected then FSCS_Main.SetFigureAsEndObject(GCadForm, TConnectorObject(GFigureSnap)); if resChoice { SnapFigureConnected} then begin OldParam := F_ProjMan.GSCSBase.CurrProject.Setting.TraceNoAskParams; F_ProjMan.GSCSBase.CurrProject.Setting.TraceNoAskParams := True; try AutoTraceCableFromNB(GDropComponent.ID, GDropComponent, true, false, FCanSaveForUndo); except end; F_ProjMan.GSCSBase.CurrProject.Setting.TraceNoAskParams := OldParam; end else AutoTraceCableFromNB(GDropComponent.ID, GDropComponent, true, false, FCanSaveForUndo); end; FreeAndNil(Traces); // вернем назад КО if OldEndPoint <> nil then begin if GEndPoint <> nil then TConnectorObject(GEndPoint).AsEndPoint := False; //GEndPoint := OldEndPoint; //TConnectorObject(GEndPoint).AsEndPoint := True; //PCad.Refresh; FSCS_Main.SetFigureAsEndObject(TF_CAD(OldEndPoint.Owner.Owner), TConnectorObject(OldEndPoint)); GListWithEndPoint := TF_CAD(OldEndPoint.Owner.Owner); end; end; end // вброс в трассу по прежнему алгоритму - если был КО уже какой то и были уже ранее подключены трассы // к объекту на который дрег был. // {TODO} если были трассы но не было КО - сюда не попадаем - будет работать по флажку автотрассировка // возможно еще дополнительно проверять что-то (новый алгоритм (по флажку aFromDropConnObj) по идеи должен работать только при дреге на шкаф или бокс) else begin if (GDropComponent.IsLine = 1) and (GEndPoint <> nil) and {FROM IGOR ChoiceAutoTraceConnectOrder(nil, true, GDropComponent) and } //#FROM OLEG CheckCanJoinNBComponWithPointObjects(GDropComponent, //#FROM OLEG TConnectorObject(GEndPoint), //#FROM OLEG TConnectorObject(GFigureSnap)) then //#FROM OLEG begin if (TConnectorObject(GFigureSnap).ConnectorType = ct_Clear) and (TConnectorObject(GFigureSnap).JoinedOrtholinesList.Count > 1) then begin NearTracedLine := nil; for i := 0 to TConnectorObject(GFigureSnap).JoinedOrtholinesList.Count - 1 do if not CheckNoFigureInList(TOrthoLine(TConnectorObject(GFigureSnap).JoinedOrtholinesList[i]), SelList) then NearTracedLine := TOrthoLine(TConnectorObject(GFigureSnap).JoinedOrtholinesList[i]); EndProgress; TracingCount := MirrorCables(TConnectorObject(GFigureSnap), NearTracedLine); BeginProgress; if TracingCount > 0 then begin // получить список листов через которые будет проведена автотрассировка ListOfLists := TIntList.create; if GListWithEndPoint <> nil then begin ListOfLists := GetSortedListIDsByBounds(GListWithEndPoint.FCADListID, FCADListID); end else ListOfLists.Add(FCADListID); vLists := TList.Create; for i := 0 to ListOfLists.Count - 1 do begin vList := GetListByID(ListOfLists[i]); if vList <> nil then vLists.Add(vList); end; SaveForProjectUndo(vLists, True, False); // *** if CheckFigureByClassName(GEndPoint, cTConnectorObject) then EndPoint := TConnectorObject(GEndPoint) else if CheckFigureByClassName(GEndPoint, cTHouse) then EndPoint := GetEndPointByHouse(THouse(GEndPoint), TConnectorObject(GFigureSnap)); // *** for i := 0 to TracingCount - 1 do TracingToEndPoint(TConnectorObject(GFigureSnap), EndPoint, GDropComponent.ID); end; end else begin // получить список листов через которые будет проведена автотрассировка ListOfLists := TIntList.create; if GListWithEndPoint <> nil then begin ListOfLists := GetSortedListIDsByBounds(GListWithEndPoint.FCADListID, FCADListID); end else ListOfLists.Add(FCADListID); vLists := TList.Create; for i := 0 to ListOfLists.Count - 1 do begin vList := GetListByID(ListOfLists[i]); if vList <> nil then vLists.Add(vList); end; SaveForProjectUndo(vLists, True, False); // *** if CheckFigureByClassName(GEndPoint, cTConnectorObject) then EndPoint := TConnectorObject(GEndPoint) else if CheckFigureByClassName(GEndPoint, cTHouse) then EndPoint := GetEndPointByHouse(THouse(GEndPoint), TConnectorObject(GFigureSnap)); // *** TracingToEndPoint(TConnectorObject(GFigureSnap), EndPoint, GDropComponent.ID); end; end; end; end; end else if CheckFigureByClassName(GFigureSnap, cTOrthoLine) then begin if not TOrthoLine(GFigureSnap).FIsRaiseUpDown then begin // *UNDO* if FCanSaveForUndo then begin SaveForUndo(uat_None, True, False); FCanSaveForUndo := False; end; end else // на с-п ложится begin RaiseConn := GetRaiseByRaiseLine(TOrthoLine(GFigureSnap)); if RaiseConn <> nil then begin // м-э if (RaiseConn.FConnRaiseType = crt_BetweenFloorUp) or (RaiseConn.FConnRaiseType = crt_BetweenFloorDown) or (RaiseConn.FConnRaiseType = crt_TrunkUp) or (RaiseConn.FConnRaiseType = crt_TrunkDown)then begin vLists := TList.Create; vLists.Add(GCadForm); vList := GetListByID(RaiseConn.FID_ListToPassage); if vList <> nil then vLists.Add(vList); SaveForProjectUndo(vLists, True, False); end else // обычный begin // *UNDO* if FCanSaveForUndo then begin SaveForUndo(uat_None, True, False); FCanSaveForUndo := False; end; end; end; end; end; if (GFigureSnap <> nil) and (not GFigureSnap.Selected) then if CheckFigureByClassName(GFigureSnap, cTOrthoLine) then begin GetRaiseLine := GetBetweenFloorRaiseLine(TOrthoLine(GFigureSnap)); DisableMarking; //15.01.2011 - Отключаем генерацию маркировки для кабеля try if GetRaiseLine <> nil then begin ComponID := CopyComponentToSCSObject(GetRaiseLine.ID, GDropComponent.ID, True); AutoConnectOnAppendCable(FCADListID, GetRaiseLine.ID); //#From Oleg# end; ComponID := CopyComponentToSCSObject(GFigureSnap.ID, GDropComponent.ID, True); AutoConnectOnAppendCable(FCADListID, TOrthoLine(GFigureSnap).ID); //#From Oleg# if GetRaiseLine <> nil then begin TraceIDs := TIntList.Create; TraceIDs.Add(TOrthoLine(GFigureSnap).ID); TraceIDs.Add(GetRaiseLine.ID); EnableMarking; //15.01.2011 ConnectObjectsInPMByWay(TraceIDs, nil, nil, nil); FreeAndNil(TraceIDs); end else begin EnableMarking; //15.01.2011 F_ProjMan.GSCSBase.CurrProject.FinishMarkingCompons; end; finally EnableMarking; //15.01.2011 end; //#From Oleg# end; // if FSCSType = st_Internal then // if GDropComponent.IsLine <> 0 then // if FAllowKindDelivery then // AutoDivideTraceOnAppendCable(TOrthoLine(GFigureSnap), 2); end; // убрать выделение всех выделенных фигур! if GPrevFigureSnap <> nil then begin TConnectorObject(DropFigure).DrawSnapFigures(GPrevFigureSnap, False); for i := 0 to PCad.SelectedCount - 1 do begin if CheckFigureByClassName(TFigure(PCad.Selection[i]), cTOrthoLine) and (TFigure(PCad.Selection[i]).Selected) then TConnectorObject(DropFigure).DrawSnapFigures(TFigure(PCad.Selection[i]), False); end; end; GListNode := Nil; GDraggedFigureZOrder := -1; PCad.SnapToGrids := SaveSnapToGrid; if SelList <> nil then FreeAndNil(SelList); // *UNDO* FCanSaveForUndo := True; // компонента(ы) кабель/КК вбрасываеться на пустое место if (GDropComponent <> nil) and (DropFigure = Nil) and (GFigureSnap = nil) then begin EndProgress; //24.06.2013 - Если Дроп Каб.канала, то віделяем все для дальнейшей прокладки if CheckSysNameIsCableChannel(GDropComponent.ComponentType.SysName) then begin PCad.DeselectAll(0); PCad.SelectAll(lnSCSCommon); PCad.Refresh; Application.ProcessMessages; F_NormBase.Act_TraceLineComponlBySelectedLines.Execute; end else begin FSCS_Main.aToolOrthoLine.Execute; GAutoAddCableAfterDragDrop := True; end; PCad.SimulateUp(X, Y); exit; end; if DropFigure <> nil then DropFigure.Select else if GFigureSnap <> nil then GFigureSnap.Select; GFigureSnap := Nil; GPrevFigureSnap := Nil; RefreshCAD(PCad); finally EndProgress; end; end else begin //FSCS_Main.aToolWallRect.Execute; CreateArchObjWizard(FCADListID, GDropComponent, Self, nil); end; except on E: Exception do addExceptionToLogEx('TF_CAD.DoDragDrop', E.Message); end; end; procedure TF_CAD.DoFragDropDesigList; var ComponID: integer; i, j: integer; isConnected: Boolean; vList: TF_CAD; vBox: TConnectorObject; vLists: TLIst; begin try vList := GetListByID(FJoinedListIDForDesignList); if vList <> nil then begin vBox := TConnectorObject(GetFigureByID(vList, FJoinedBoxIDForDesignList)); if vBox <> nil then begin vLists := TList.Create; vLists.Add(GCadForm); vLists.Add(vList); SaveForProjectUndo(vLists, True, False); ComplectNBComponToProjObj(vBox.ID, GDropComponent, False); UpdateDesignList(Self, vBox); end; end; except on E: Exception do addExceptionToLogEx('TF_CAD.DoFragDropDesigList', E.Message); end; end; procedure TF_CAD.AutoDivideTraceOnAppendCable(aTrace: TOrthoLine; aLength: Double); var i, j: Integer; x1, x2, y1, y2, z1, z2: double; ang: double; nextx, nexty: double; Conn: TConnectorObject; Realdelta: double; Length_X, Length_Y, Length_Z, TraceLength: Double; CurTrace: TOrthoLine; DivCount: integer; GetPointObject: TConnectorObject; begin try // aLength := 2; Realdelta := aLength * 1000 / PCad.MapScale; if TConnectorObject(aTrace.JoinConnector1).JoinedConnectorsList.Count = 0 then begin x1 := aTrace.ActualPoints[1].x; y1 := aTrace.ActualPoints[1].y; end else begin GetPointObject := TConnectorObject(aTrace.JoinConnector1).JoinedConnectorsList[0]; begin X1 := GetPointObject.ActualPoints[1].x; Y1 := GetPointObject.ActualPoints[1].y; end; end; Z1 := aTrace.ActualZOrder[1]; if TConnectorObject(aTrace.JoinConnector2).JoinedConnectorsList.Count = 0 then begin x2 := aTrace.ActualPoints[2].x; y2 := aTrace.ActualPoints[2].y; end else begin GetPointObject := TConnectorObject(aTrace.JoinConnector2).JoinedConnectorsList[0]; begin X2 := GetPointObject.ActualPoints[2].x; Y2 := GetPointObject.ActualPoints[2].y; end; end; Z2 := aTrace.ActualZOrder[1]; Length_X := abs(X1 - X2); Length_Y := abs(Y1 - Y2); Length_Z := abs(Z1 - Z2); TraceLength := SQRT(SQR(Length_X) + SQR(Length_Y) + SQR(Length_Z)); ang := aTrace.GetAngleInRad(x1, y1, x2, y2); DivCount := Trunc(TraceLength / Realdelta); CurTrace := aTrace; FAllowSuppliesKind := False; for i := 1 to DivCount do begin nextx := x1 + i * Realdelta * Cos(ang); nexty := y1 + i * Realdelta * Sin(ang); Conn := TConnectorObject.Create(nextx, nexty, CurTrace.ActualZOrder[1], CurTrace.LayerHandle, PCTypesUtils.mydsNormal, PCad); Conn.ConnectorType := ct_Clear; PCad.AddCustomFigure (GLN(aTrace.LayerHandle), Conn, false); SnapConnectorToOrtholine(Conn, CurTrace); for j := 0 to Conn.JoinedOrtholinesList.Count - 1 do if TOrthoLine(Conn.JoinedOrtholinesList[j]) <> CurTrace then CurTrace := TOrthoLine(Conn.JoinedOrtholinesList[j]); end; FAllowSuppliesKind := True; RefreshCAD(PCad); except on E: Exception do addExceptionToLogEx('TF_CAD.AutoDivideTraceOnAppendCable', E.Message); end; end; procedure TF_CAD.SnapFigureEvent(Sender: TObject); var ID: Integer; FFigure: TFigure; aSelf: TConnectorObject; begin try ID := TMenuItem(Sender).Tag; FFigure := GetFigureByID(GCadForm, ID); GFigureSnap := FFigure; if GLastConnector <> nil then aSelf := GLastConnector else exit; if (GetRaiseConn(aSelf) = nil) then begin if not CheckTrunkObject(aSelf) then begin if not aSelf.FIsApproach then begin //// To Connector ////////////////////////// if CheckFigureByClassName(GFigureSnap, cTConnectorObject) then begin if (aSelf.ConnectorType = ct_Clear) and (TConnectorObject(GFigureSnap).ConnectorType = ct_Clear) then SnapConnectorToConnector(aSelf, TConnectorObject(GFigureSnap)) else if (aSelf.ConnectorType = ct_Clear) and (TConnectorObject(GFigureSnap).ConnectorType <> ct_Clear) then SnapConnectorToPointObject(aSelf, TConnectorObject(GFigureSnap), True) else if (aSelf.ConnectorType <> ct_Clear) and (TConnectorObject(GFigureSnap).ConnectorType = ct_Clear) then SnapPointObjectToConnector(aSelf, TConnectorObject(GFigureSnap)); end else //// To Ortholine ////////////////////////// if CheckFigureByClassName(GFigureSnap, cTOrthoLine) then begin if aSelf.ConnectorType = ct_Clear then begin if TOrthoLine(GFigureSnap).FIsVertical then SnapConnectorToVertical(aSelf, TOrthoLine(GFigureSnap)) else SnapConnectorToOrtholine(aSelf, TOrthoLine(GFigureSnap)); end else begin if TOrthoLine(GFigureSnap).FIsVertical then SnapPointObjectToVertical(aSelf, TOrthoLine(GFigureSnap)) else SnapPointObjectToOrthoLine(aSelf, TOrthoLine(GFigureSnap)); end; end else //// To Ortholine ////////////////////////// if CheckFigureByClassName(GFigureSnap, cTHouse) then begin if aSelf.ConnectorType = ct_Clear then SnapConnectorToHouse(aSelf, THouse(GFigureSnap)); end; end; end; end else if GetRaiseConn(aSelf) <> nil then GCadForm.mProtocol.Lines.Add(cCadClasses_Mes11); if GPrevFigureSnap <> nil then aSelf.DrawSnapFigures(GPrevFigureSnap, False); GFigureSnap := Nil; GPrevFigureSnap := Nil; RefreshCAD(PCad); except on E: Exception do addExceptionToLogEx('TF_CAD.SnapFigureEvent', E.Message); end; end; procedure TF_CAD.SetMenuItemsForConnector(aConn: TConnectorObject); var i: integer; Conn: TConnectorObject; PObject: TConnectorObject; begin try if GCadForm.FShowLineCaptionsType = skExternalSCS then begin FSCS_Main.pmiSCSObjProperties.Visible := True; FSCS_Main.pmiSCSObjComponProperties.Visible := True; FSCS_Main.pmiSCSObjRealignLine.Visible := False; FSCS_Main.pmiSCSObjDivideLine.Visible := False; //22.08.2012 FSCS_Main.pmiSCSObjServerAsDefault.Visible := True; //22.08.2012 FSCS_Main.pmiSCSObjNotAsServerDefault.Visible := True; FSCS_Main.pmiSCSObjDisconnect.Visible := True; for i := 0 to aConn.JoinedOrtholinesList.Count - 1 do if TOrthoLine(aConn.JoinedOrtholinesList[i]).FConnectingLine then begin FSCS_Main.pmiSCSObjDisconnect.Visible := False; break; end; FSCS_Main.pmiSCSObjSelectTracetoServer.Visible := True; FSCS_Main.pmiSCSObjMakeCabling.Visible := False; //22.08.2012 FSCS_Main.pmiSCSObjCreateRaise.Visible := False; //22.08.2012 FSCS_Main.pmiSCSObjDestroyRaise.Visible := False; FSCS_Main.pmiSCSObjRaiseLine.Visible := False; FSCS_Main.pmiSCSObjDeleteSCSObject.Visible := True; FSCS_Main.pmiSCSObjCreateFloorRaiseUp.Visible := False; FSCS_Main.pmiSCSObjCreateFloorRaiseDown.Visible := False; FSCS_Main.pmiSCSObjRotatePointObject90.Visible := False; FSCS_Main.pmiSCSObjRotatePointObject180.Visible := False; FSCS_Main.pmiSCSObjRotatePointObject270.Visible := False; FSCS_Main.pmiSCSObjDisconnectPointObject.Visible := False; FSCS_Main.pmiSCSObjDesignBox.Visible := False; FSCS_Main.pmiSCSObjRealignLine2.Visible := False; FSCS_Main.pmiSCSObjRealignObject.Visible := True; FSCS_Main.pmiSCSObjChangeRaiseHeight.Visible := False; FSCS_Main.pmiSCSObjDisconnectAllConnectors.Visible := False; FSCS_Main.pmiSCSObjDisconnectFromRM.Visible := False; //22.08.2012 FSCS_Main.pmiSCSObjRemoveObjectOnHeight.Visible := False; FSCS_Main.pmiSCSObjShowConfigurator.Visible := True; FSCS_Main.pmiSCSObjMirrorView.Visible := False; FSCS_Main.pmiSCSObjCreateDuplicates.Visible := False; // !!! if (aConn.FConnRaiseType = crt_None) and (GetRaiseConn(aConn) = nil) then begin if aConn.JoinedOrtholinesList.Count > 1 then FSCS_Main.pmiSCSObjDisconnectTraces.Visible := True else FSCS_Main.pmiSCSObjDisconnectTraces.Visible := False; end else FSCS_Main.pmiSCSObjDisconnectTraces.Visible := False; FSCS_Main.pmiSCSObjRotateTraceDrawFigure180.Visible := False; FSCS_Main.pmiSCSObjMirrorBlock.Visible := False; FSCS_Main.pmiSCSObjMarkForTracing.Visible := False; FSCS_Main.pmiSCSObjMarkForDisableTracing.Visible := False; FSCS_Main.pmiSCSObjCreateTrunk.Visible := False; FSCS_Main.pmiSCSObjCreateVertical.Visible := False; end else begin if aConn.JoinedConnectorsList.Count = 0 then begin FSCS_Main.pmiSCSObjProperties.Visible := True; FSCS_Main.pmiSCSObjComponProperties.Visible := True; FSCS_Main.pmiSCSObjRealignLine.Visible := False; FSCS_Main.pmiSCSObjDivideLine.Visible := False; {//22.08.2012 if aConn.AsEndPoint then begin FSCS_Main.pmiSCSObjServerAsDefault.Visible := False; FSCS_Main.pmiSCSObjNotAsServerDefault.Visible := True; end else begin FSCS_Main.pmiSCSObjServerAsDefault.Visible := True; FSCS_Main.pmiSCSObjNotAsServerDefault.Visible := False; end; } FSCS_Main.pmiSCSObjDisconnect.Visible := True; FSCS_Main.pmiSCSObjSelectTracetoServer.Visible := true; //08.08.2012 False; FSCS_Main.pmiSCSObjMakeCabling.Visible := True; FSCS_Main.pmiSCSObjRaiseLine.Visible := False; FSCS_Main.pmiSCSObjDeleteSCSObject.Visible := True; {//22.08.2012 if aConn.FConnRaiseType <> crt_None then begin FSCS_Main.pmiSCSObjCreateRaise.Visible := False; FSCS_Main.pmiSCSObjDestroyRaise.Visible := False; end else begin if CheckRaise(aConn) then begin FSCS_Main.pmiSCSObjCreateRaise.Visible := False; FSCS_Main.pmiSCSObjDestroyRaise.Visible := True; end else begin FSCS_Main.pmiSCSObjCreateRaise.Visible := True; FSCS_Main.pmiSCSObjDestroyRaise.Visible := False; end; end;} if (aConn.FConnRaiseType = crt_None) and (GetRaiseConn(aConn) = nil) then begin FSCS_Main.pmiSCSObjCreateFloorRaiseUp.Visible := True; FSCS_Main.pmiSCSObjCreateFloorRaiseDown.Visible := True; end else begin FSCS_Main.pmiSCSObjCreateFloorRaiseUp.Visible := False; FSCS_Main.pmiSCSObjCreateFloorRaiseDown.Visible := False; end; FSCS_Main.pmiSCSObjRotatePointObject90.Visible := False; FSCS_Main.pmiSCSObjRotatePointObject180.Visible := False; FSCS_Main.pmiSCSObjRotatePointObject270.Visible := False; FSCS_Main.pmiSCSObjDisconnectPointObject.Visible := False; FSCS_Main.pmiSCSObjDesignBox.Visible := False; FSCS_Main.pmiSCSObjRealignLine2.Visible := False; if (aConn.FConnRaiseType = crt_None) then FSCS_Main.pmiSCSObjRealignObject.Visible := True else FSCS_Main.pmiSCSObjRealignObject.Visible := False; FSCS_Main.pmiSCSObjChangeRaiseHeight.Visible := False; FSCS_Main.pmiSCSObjDisconnectAllConnectors.Visible := False; FSCS_Main.pmiSCSObjDisconnectFromRM.Visible := False; // *** {//22.08.2012 if (aConn.FConnRaiseType <> crt_None) then begin Conn := aConn.FObjectFromRaise; FSCS_Main.aRemoveObjectOnHeight.Caption := cCad_Mes28 +' '+ FormatFloat(ffMask, MetreToUOM(Conn.ActualZOrder[1])) + GetUOMString(GCurrProjUnitOfMeasure); FSCS_Main.pmiSCSObjRemoveObjectOnHeight.Visible := True; end else if (GetRaiseConn(aConn) <> nil) then begin Conn := GetRaiseConn(TConnectorObject(GPopupFigure)); FSCS_Main.aRemoveObjectOnHeight.Caption := cCad_Mes28 +' '+ FormatFloat(ffMask, MetreToUOM(Conn.ActualZOrder[1])) + GetUOMString(GCurrProjUnitOfMeasure); FSCS_Main.pmiSCSObjRemoveObjectOnHeight.Visible := True; end else FSCS_Main.pmiSCSObjRemoveObjectOnHeight.Visible := False;} if aConn.JoinedOrtholinesList.Count > 0 then FSCS_Main.pmiSCSObjShowConfigurator.Visible := True else FSCS_Main.pmiSCSObjShowConfigurator.Visible := False; FSCS_Main.pmiSCSObjMirrorView.Visible := False; FSCS_Main.pmiSCSObjCreateDuplicates.Visible := True; // !!! if (aConn.FConnRaiseType = crt_None) and (GetRaiseConn(aConn) = nil) then begin if aConn.JoinedOrtholinesList.Count > 1 then FSCS_Main.pmiSCSObjDisconnectTraces.Visible := True else FSCS_Main.pmiSCSObjDisconnectTraces.Visible := False; end else FSCS_Main.pmiSCSObjDisconnectTraces.Visible := False; FSCS_Main.pmiSCSObjRotateTraceDrawFigure180.Visible := False; FSCS_Main.pmiSCSObjMirrorBlock.Visible := False; FSCS_Main.pmiSCSObjMarkForTracing.Visible := False; FSCS_Main.pmiSCSObjMarkForDisableTracing.Visible := False; if (aConn.FConnRaiseType = crt_None) and (GetRaiseConn(aConn) = nil) then begin FSCS_Main.pmiSCSObjCreateTrunk.Visible := True; end else begin FSCS_Main.pmiSCSObjCreateTrunk.Visible := False; end; if GUseVerticalTraces then begin if (aConn.FConnRaiseType = crt_None) and (GetRaiseConn(aConn) = nil) then FSCS_Main.pmiSCSObjCreateVertical.Visible := True else FSCS_Main.pmiSCSObjCreateVertical.Visible := False; end else begin FSCS_Main.pmiSCSObjCreateVertical.Visible := False; end; end else begin FSCS_Main.pmiSCSObjProperties.Visible := False; FSCS_Main.pmiSCSObjComponProperties.Visible := False; FSCS_Main.pmiSCSObjRealignLine.Visible := False; FSCS_Main.pmiSCSObjDivideLine.Visible := False; //22.08.2012 FSCS_Main.pmiSCSObjServerAsDefault.Visible := False; //22.08.2012 FSCS_Main.pmiSCSObjNotAsServerDefault.Visible := False; FSCS_Main.pmiSCSObjDisconnect.Visible := False; FSCS_Main.pmiSCSObjSelectTracetoServer.Visible := False; FSCS_Main.pmiSCSObjMakeCabling.Visible := False; //22.08.2012 FSCS_Main.pmiSCSObjCreateRaise.Visible := False; //22.08.2012 FSCS_Main.pmiSCSObjDestroyRaise.Visible := False; FSCS_Main.pmiSCSObjRaiseLine.Visible := False; FSCS_Main.pmiSCSObjDeleteSCSObject.Visible := False; FSCS_Main.pmiSCSObjCreateFloorRaiseUp.Visible := False; FSCS_Main.pmiSCSObjCreateFloorRaiseDown.Visible := False; FSCS_Main.pmiSCSObjRotatePointObject90.Visible := False; FSCS_Main.pmiSCSObjRotatePointObject180.Visible := False; FSCS_Main.pmiSCSObjRotatePointObject270.Visible := False; FSCS_Main.pmiSCSObjDisconnectPointObject.Visible := False; FSCS_Main.pmiSCSObjDesignBox.Visible := False; FSCS_Main.pmiSCSObjRealignLine2.Visible := False; FSCS_Main.pmiSCSObjRealignObject.Visible := False; FSCS_Main.pmiSCSObjChangeRaiseHeight.Visible := False; FSCS_Main.pmiSCSObjDisconnectAllConnectors.Visible := False; if GetRaiseLine(aConn) = nil then FSCS_Main.pmiSCSObjDisconnectFromRM.Visible := True else FSCS_Main.pmiSCSObjDisconnectFromRM.Visible := False; //22.08.2012 FSCS_Main.pmiSCSObjRemoveObjectOnHeight.Visible := False; FSCS_Main.pmiSCSObjShowConfigurator.Visible := False; FSCS_Main.pmiSCSObjMirrorView.Visible := False; FSCS_Main.pmiSCSObjCreateDuplicates.Visible := False; FSCS_Main.pmiSCSObjDisconnectTraces.Visible := False; FSCS_Main.pmiSCSObjRotateTraceDrawFigure180.Visible := False; FSCS_Main.pmiSCSObjMirrorBlock.Visible := False; FSCS_Main.pmiSCSObjMarkForTracing.Visible := False; FSCS_Main.pmiSCSObjMarkForDisableTracing.Visible := False; FSCS_Main.pmiSCSObjCreateTrunk.Visible := False; FSCS_Main.pmiSCSObjCreateVertical.Visible := False; end; end; //------------------------------------------------------------------ if aConn.JoinedConnectorsList.Count = 0 then begin if aConn.AsEndPoint then begin FSCS_Main.pmiSCSObjServerAsDefault.Visible := False; FSCS_Main.pmiSCSObjNotAsServerDefault.Visible := True; end else begin FSCS_Main.pmiSCSObjServerAsDefault.Visible := True; FSCS_Main.pmiSCSObjNotAsServerDefault.Visible := False; end; end else begin FSCS_Main.pmiSCSObjServerAsDefault.Visible := False; FSCS_Main.pmiSCSObjNotAsServerDefault.Visible := False; end; //22.08.2012 Общие пункты для скс и распределительной сети if (GCadForm.FShowLineCaptionsType <> skExternalSCS) or GAllowExternalListCoordZ then begin if aConn.JoinedConnectorsList.Count = 0 then begin if aConn.FConnRaiseType <> crt_None then begin FSCS_Main.pmiSCSObjCreateRaise.Visible := False; FSCS_Main.pmiSCSObjDestroyRaise.Visible := False; end else begin if CheckRaise(aConn) then begin FSCS_Main.pmiSCSObjCreateRaise.Visible := False; FSCS_Main.pmiSCSObjDestroyRaise.Visible := True; end else begin FSCS_Main.pmiSCSObjCreateRaise.Visible := True; FSCS_Main.pmiSCSObjDestroyRaise.Visible := False; end; end; Conn := nil; if (aConn.FConnRaiseType <> crt_None) then Conn := aConn.FObjectFromRaise else if (GetRaiseConn(aConn) <> nil) then Conn := GetRaiseConn(TConnectorObject(GPopupFigure)) else FSCS_Main.pmiSCSObjRemoveObjectOnHeight.Visible := False; if Conn <> nil then begin FSCS_Main.aRemoveObjectOnHeight.Caption := cCad_Mes28 +' '+ FormatFloat(ffMask, MetreToUOM(Conn.ActualZOrder[1])) + GetUOMString(GCurrProjUnitOfMeasure); FSCS_Main.pmiSCSObjRemoveObjectOnHeight.Visible := True; end; end else begin FSCS_Main.pmiSCSObjCreateRaise.Visible := False; FSCS_Main.pmiSCSObjDestroyRaise.Visible := False; FSCS_Main.pmiSCSObjRemoveObjectOnHeight.Visible := False; end; end else begin FSCS_Main.pmiSCSObjCreateRaise.Visible := False; FSCS_Main.pmiSCSObjDestroyRaise.Visible := False; FSCS_Main.pmiSCSObjRemoveObjectOnHeight.Visible := False; end; except on E: Exception do addExceptionToLogEx('TF_CAD.SetMenuItemsForConnector', E.Message); end; end; procedure TF_CAD.SetMenuItemsForObject(aObject: TConnectorObject); var Conn: TConnectorObject; begin try if GCadForm.FShowLineCaptionsType = skExternalSCS then begin FSCS_Main.pmiSCSObjProperties.Visible := True; FSCS_Main.pmiSCSObjComponProperties.Visible := True; FSCS_Main.pmiSCSObjRealignLine.Visible := False; FSCS_Main.pmiSCSObjDivideLine.Visible := False; //22.08.2012 FSCS_Main.pmiSCSObjServerAsDefault.Visible := True; //22.08.2012 FSCS_Main.pmiSCSObjNotAsServerDefault.Visible := True; FSCS_Main.pmiSCSObjDisconnect.Visible := False; FSCS_Main.pmiSCSObjSelectTracetoServer.Visible := True; FSCS_Main.pmiSCSObjMakeCabling.Visible := False; //22.08.2012 FSCS_Main.pmiSCSObjCreateRaise.Visible := False; //22.08.2012 FSCS_Main.pmiSCSObjDestroyRaise.Visible := False; FSCS_Main.pmiSCSObjRaiseLine.Visible := False; FSCS_Main.pmiSCSObjDeleteSCSObject.Visible := True; FSCS_Main.pmiSCSObjCreateFloorRaiseUp.Visible := False; FSCS_Main.pmiSCSObjCreateFloorRaiseDown.Visible := False; FSCS_Main.pmiSCSObjRotatePointObject90.Visible := True; FSCS_Main.pmiSCSObjRotatePointObject180.Visible := True; FSCS_Main.pmiSCSObjRotatePointObject270.Visible := True; if CheckTrunkObject(aObject) then FSCS_Main.pmiSCSObjDisconnectPointObject.Visible := False else FSCS_Main.pmiSCSObjDisconnectPointObject.Visible := True; if HaveObjectCupboardComponent(aObject.ID) then FSCS_Main.pmiSCSObjDesignBox.Visible := True else FSCS_Main.pmiSCSObjDesignBox.Visible := False; FSCS_Main.pmiSCSObjRealignLine2.Visible := False; FSCS_Main.pmiSCSObjRealignObject.Visible := True; FSCS_Main.pmiSCSObjChangeRaiseHeight.Visible := False; FSCS_Main.pmiSCSObjDisconnectAllConnectors.Visible := False; FSCS_Main.pmiSCSObjDisconnectFromRM.Visible := False; //22.08.2012 FSCS_Main.pmiSCSObjRemoveObjectOnHeight.Visible := False; FSCS_Main.pmiSCSObjShowConfigurator.Visible := True; if CheckTrunkObject(aObject) then FSCS_Main.pmiSCSObjMirrorView.Visible := True else FSCS_Main.pmiSCSObjMirrorView.Visible := False; FSCS_Main.pmiSCSObjCreateDuplicates.Visible := True; FSCS_Main.pmiSCSObjDisconnectTraces.Visible := False; FSCS_Main.pmiSCSObjRotateTraceDrawFigure180.Visible := False; if CheckTrunkObject(aObject) then FSCS_Main.pmiSCSObjMirrorBlock.Visible := False else FSCS_Main.pmiSCSObjMirrorBlock.Visible := True; FSCS_Main.pmiSCSObjMarkForTracing.Visible := False; FSCS_Main.pmiSCSObjMarkForDisableTracing.Visible := False; FSCS_Main.pmiSCSObjCreateTrunk.Visible := False; FSCS_Main.pmiSCSObjCreateVertical.Visible := False; end else begin FSCS_Main.pmiSCSObjProperties.Visible := True; FSCS_Main.pmiSCSObjComponProperties.Visible := True; FSCS_Main.pmiSCSObjRealignLine.Visible := False; FSCS_Main.pmiSCSObjDivideLine.Visible := False; FSCS_Main.pmiSCSObjDisconnect.Visible := False; FSCS_Main.pmiSCSObjSelectTracetoServer.Visible := True; FSCS_Main.pmiSCSObjMakeCabling.Visible := False; FSCS_Main.pmiSCSObjRaiseLine.Visible := False; FSCS_Main.pmiSCSObjDeleteSCSObject.Visible := True; {//22.08.2012 if TConnectorObject(aObject).AsEndPoint then begin FSCS_Main.pmiSCSObjServerAsDefault.Visible := False; FSCS_Main.pmiSCSObjNotAsServerDefault.Visible := True; end else begin FSCS_Main.pmiSCSObjServerAsDefault.Visible := True; FSCS_Main.pmiSCSObjNotAsServerDefault.Visible := False; end;} {//22.08.2012 if aObject.FConnRaiseType <> crt_None then begin FSCS_Main.pmiSCSObjCreateRaise.Visible := False; FSCS_Main.pmiSCSObjDestroyRaise.Visible := False; end else if CheckRaise(aObject) then begin FSCS_Main.pmiSCSObjCreateRaise.Visible := False; FSCS_Main.pmiSCSObjDestroyRaise.Visible := True; end else begin FSCS_Main.pmiSCSObjCreateRaise.Visible := True; FSCS_Main.pmiSCSObjDestroyRaise.Visible := False; end;} if (aObject.FConnRaiseType = crt_None) and (GetRaiseConn(aObject) = nil) then begin FSCS_Main.pmiSCSObjCreateFloorRaiseUp.Visible := True; FSCS_Main.pmiSCSObjCreateFloorRaiseDown.Visible := True; end else begin FSCS_Main.pmiSCSObjCreateFloorRaiseUp.Visible := False; FSCS_Main.pmiSCSObjCreateFloorRaiseDown.Visible := False; end; FSCS_Main.pmiSCSObjRotatePointObject90.Visible := True; FSCS_Main.pmiSCSObjRotatePointObject180.Visible := True; FSCS_Main.pmiSCSObjRotatePointObject270.Visible := True; if aObject.FConnRaiseType = crt_None then FSCS_Main.pmiSCSObjDisconnectPointObject.Visible := True else FSCS_Main.pmiSCSObjDisconnectPointObject.Visible := False; if HaveObjectCupboardComponent(aObject.ID) then FSCS_Main.pmiSCSObjDesignBox.Visible := True else FSCS_Main.pmiSCSObjDesignBox.Visible := False; FSCS_Main.pmiSCSObjRealignLine2.Visible := False; if (aObject.FConnRaiseType = crt_None) then FSCS_Main.pmiSCSObjRealignObject.Visible := True else FSCS_Main.pmiSCSObjRealignObject.Visible := False; FSCS_Main.pmiSCSObjChangeRaiseHeight.Visible := False; if aObject.JoinedConnectorsList.Count = 0 then FSCS_Main.pmiSCSObjDisconnectAllConnectors.Visible := False else FSCS_Main.pmiSCSObjDisconnectAllConnectors.Visible := True; FSCS_Main.pmiSCSObjDisconnectFromRM.Visible := False; {//22.08.2012 if (aObject.FConnRaiseType <> crt_None) then begin Conn := aObject.FObjectFromRaise; FSCS_Main.aRemoveObjectOnHeight.Caption := cCad_Mes28 +' '+ FormatFloat(ffMask, MetreToUOM(Conn.ActualZOrder[1])) + GetUOMString(GCurrProjUnitOfMeasure); FSCS_Main.pmiSCSObjRemoveObjectOnHeight.Visible := True; end else if (GetRaiseConn(aObject) <> nil) then begin Conn := GetRaiseConn(aObject); FSCS_Main.aRemoveObjectOnHeight.Caption := cCad_Mes28 +' '+ FormatFloat(ffMask, MetreToUOM(Conn.ActualZOrder[1])) + GetUOMString(GCurrProjUnitOfMeasure); FSCS_Main.pmiSCSObjRemoveObjectOnHeight.Visible := True; end else FSCS_Main.pmiSCSObjRemoveObjectOnHeight.Visible := False;} if aObject.JoinedConnectorsList.Count > 0 then FSCS_Main.pmiSCSObjShowConfigurator.Visible := True else FSCS_Main.pmiSCSObjShowConfigurator.Visible := False; if CheckTrunkObject(aObject) then FSCS_Main.pmiSCSObjMirrorView.Visible := True else FSCS_Main.pmiSCSObjMirrorView.Visible := False; FSCS_Main.pmiSCSObjCreateDuplicates.Visible := True; FSCS_Main.pmiSCSObjDisconnectTraces.Visible := False; FSCS_Main.pmiSCSObjRotateTraceDrawFigure180.Visible := False; if CheckTrunkObject(aObject) then begin FSCS_Main.pmiSCSObjMirrorBlock.Visible := False; end else begin if aObject.DrawFigure.InFigures.Count > 0 then FSCS_Main.pmiSCSObjMirrorBlock.Visible := True else FSCS_Main.pmiSCSObjMirrorBlock.Visible := False; end; FSCS_Main.pmiSCSObjMarkForTracing.Visible := False; FSCS_Main.pmiSCSObjMarkForDisableTracing.Visible := False; if (aObject.FConnRaiseType = crt_None) and (GetRaiseConn(aObject) = nil) then begin FSCS_Main.pmiSCSObjCreateTrunk.Visible := True; end else begin FSCS_Main.pmiSCSObjCreateTrunk.Visible := False; end; if GUseVerticalTraces then begin if (aObject.FConnRaiseType = crt_None) and (GetRaiseConn(aObject) = nil) then FSCS_Main.pmiSCSObjCreateVertical.Visible := True else FSCS_Main.pmiSCSObjCreateVertical.Visible := False; end else begin FSCS_Main.pmiSCSObjCreateVertical.Visible := False; end; end; //------------------------------------------------------------ if TConnectorObject(aObject).AsEndPoint then begin FSCS_Main.pmiSCSObjServerAsDefault.Visible := False; FSCS_Main.pmiSCSObjNotAsServerDefault.Visible := True; end else begin FSCS_Main.pmiSCSObjServerAsDefault.Visible := True; FSCS_Main.pmiSCSObjNotAsServerDefault.Visible := False; end; //22.08.2012 Общие пункты для скс и распределительной сети if (GCadForm.FShowLineCaptionsType <> skExternalSCS) or GAllowExternalListCoordZ then begin if aObject.FConnRaiseType <> crt_None then begin FSCS_Main.pmiSCSObjCreateRaise.Visible := False; FSCS_Main.pmiSCSObjDestroyRaise.Visible := False; end else if CheckRaise(aObject) then begin FSCS_Main.pmiSCSObjCreateRaise.Visible := False; FSCS_Main.pmiSCSObjDestroyRaise.Visible := True; end else begin FSCS_Main.pmiSCSObjCreateRaise.Visible := True; FSCS_Main.pmiSCSObjDestroyRaise.Visible := False; end; if (aObject.FConnRaiseType <> crt_None) then begin Conn := aObject.FObjectFromRaise; FSCS_Main.aRemoveObjectOnHeight.Caption := cCad_Mes28 +' '+ FormatFloat(ffMask, MetreToUOM(Conn.ActualZOrder[1])) + GetUOMString(GCurrProjUnitOfMeasure); FSCS_Main.pmiSCSObjRemoveObjectOnHeight.Visible := True; end else if (GetRaiseConn(aObject) <> nil) then begin Conn := GetRaiseConn(aObject); FSCS_Main.aRemoveObjectOnHeight.Caption := cCad_Mes28 +' '+ FormatFloat(ffMask, MetreToUOM(Conn.ActualZOrder[1])) + GetUOMString(GCurrProjUnitOfMeasure); FSCS_Main.pmiSCSObjRemoveObjectOnHeight.Visible := True; end else FSCS_Main.pmiSCSObjRemoveObjectOnHeight.Visible := False; end else begin FSCS_Main.pmiSCSObjCreateRaise.Visible := False; FSCS_Main.pmiSCSObjDestroyRaise.Visible := False; end; except on E: Exception do addExceptionToLogEx('TF_CAD.SetMenuItemsForObject', E.Message); end; end; procedure TF_CAD.SetMenuItemsForOrthoLine(aLine: TOrthoLine); begin try if GCadForm.FShowLineCaptionsType = skExternalSCS then begin FSCS_Main.pmiSCSObjProperties.Visible := True; FSCS_Main.pmiSCSObjComponProperties.Visible := True; FSCS_Main.pmiSCSObjRealignLine.Visible := False; if aLine.FConnectingLine then begin FSCS_Main.pmiSCSObjDivideLine.Visible := False; end else begin FSCS_Main.pmiSCSObjDivideLine.Visible := True; end; FSCS_Main.pmiSCSObjServerAsDefault.Visible := False; FSCS_Main.pmiSCSObjNotAsServerDefault.Visible := False; FSCS_Main.pmiSCSObjDisconnect.Visible := False; FSCS_Main.pmiSCSObjSelectTracetoServer.Visible := False; FSCS_Main.pmiSCSObjMakeCabling.Visible := False; FSCS_Main.pmiSCSObjCreateRaise.Visible := False; FSCS_Main.pmiSCSObjDestroyRaise.Visible := False; FSCS_Main.pmiSCSObjRaiseLine.Visible := GAllowExternalListCoordZ and not aLine.FIsRaiseUpDown and not aLine.FIsVertical; //22.08.2012 False; FSCS_Main.pmiSCSObjDeleteSCSObject.Visible := True; FSCS_Main.pmiSCSObjCreateFloorRaiseUp.Visible := False; FSCS_Main.pmiSCSObjCreateFloorRaiseDown.Visible := False; FSCS_Main.pmiSCSObjRotatePointObject90.Visible := False; FSCS_Main.pmiSCSObjRotatePointObject180.Visible := False; FSCS_Main.pmiSCSObjRotatePointObject270.Visible := False; FSCS_Main.pmiSCSObjDisconnectPointObject.Visible := False; FSCS_Main.pmiSCSObjDesignBox.Visible := False; FSCS_Main.pmiSCSObjRealignLine2.Visible := True; FSCS_Main.pmiSCSObjRealignObject.Visible := False; FSCS_Main.pmiSCSObjChangeRaiseHeight.Visible := False; FSCS_Main.pmiSCSObjDisconnectAllConnectors.Visible := False; FSCS_Main.pmiSCSObjDisconnectFromRM.Visible := False; FSCS_Main.pmiSCSObjRemoveObjectOnHeight.Visible := False; FSCS_Main.pmiSCSObjShowConfigurator.Visible := False; FSCS_Main.pmiSCSObjMirrorView.Visible := False; FSCS_Main.pmiSCSObjCreateDuplicates.Visible := False; FSCS_Main.pmiSCSObjDisconnectTraces.Visible := False; FSCS_Main.pmiSCSObjRotateTraceDrawFigure180.Visible := True; FSCS_Main.pmiSCSObjMirrorBlock.Visible := False; if not aLine.FIsRaiseUpDown then begin if aLine.FMarkTracing then FSCS_Main.pmiSCSObjMarkForTracing.Caption := cMain_Mes100 else FSCS_Main.pmiSCSObjMarkForTracing.Caption := cMain_Mes99; FSCS_Main.pmiSCSObjMarkForTracing.Visible := True; if aLine.FDisableTracing then FSCS_Main.pmiSCSObjMarkForDisableTracing.Caption := cMain_Mes113 else FSCS_Main.pmiSCSObjMarkForDisableTracing.Caption := cMain_Mes112; FSCS_Main.pmiSCSObjMarkForDisableTracing.Visible := True; end else begin FSCS_Main.pmiSCSObjMarkForTracing.Visible := False; FSCS_Main.pmiSCSObjMarkForDisableTracing.Visible := False; end; FSCS_Main.pmiSCSObjCreateTrunk.Visible := False; FSCS_Main.pmiSCSObjCreateVertical.Visible := False; FSCS_Main.pmiSCSObjDivTracesOnRoowWalls.Visible := false; //13.03.2013 FSCS_Main.aDivTracesOnRoowWalls.Visible := false; end else begin FSCS_Main.pmiSCSObjProperties.Visible := True; FSCS_Main.pmiSCSObjComponProperties.Visible := True; FSCS_Main.pmiSCSObjRealignLine.Visible := False; if not aLine.FIsRaiseUpDown then begin FSCS_Main.pmiSCSObjDivideLine.Visible := True; end else begin FSCS_Main.pmiSCSObjDivideLine.Visible := False; end; FSCS_Main.pmiSCSObjServerAsDefault.Visible := False; FSCS_Main.pmiSCSObjNotAsServerDefault.Visible := False; FSCS_Main.pmiSCSObjDisconnect.Visible := False; FSCS_Main.pmiSCSObjSelectTracetoServer.Visible := False; FSCS_Main.pmiSCSObjMakeCabling.Visible := False; FSCS_Main.pmiSCSObjCreateRaise.Visible := False; FSCS_Main.pmiSCSObjDestroyRaise.Visible := False; if (not aLine.FIsRaiseUpDown) and (not aLine.FIsVertical) then begin FSCS_Main.pmiSCSObjRaiseLine.Visible := True end else begin FSCS_Main.pmiSCSObjRaiseLine.Visible := False; end; FSCS_Main.pmiSCSObjDeleteSCSObject.Visible := True; // создание мэ перехода if not aLine.FIsRaiseUpDown then begin FSCS_Main.pmiSCSObjCreateFloorRaiseUp.Visible := True; FSCS_Main.pmiSCSObjCreateFloorRaiseDown.Visible := True; end else begin FSCS_Main.pmiSCSObjCreateFloorRaiseUp.Visible := False; FSCS_Main.pmiSCSObjCreateFloorRaiseDown.Visible := False; end; FSCS_Main.pmiSCSObjRotatePointObject90.Visible := False; FSCS_Main.pmiSCSObjRotatePointObject180.Visible := False; FSCS_Main.pmiSCSObjRotatePointObject270.Visible := False; FSCS_Main.pmiSCSObjDisconnectPointObject.Visible := False; FSCS_Main.pmiSCSObjDesignBox.Visible := False; if not aLine.FIsRaiseUpDown then FSCS_Main.pmiSCSObjRealignLine2.Visible := True else FSCS_Main.pmiSCSObjRealignLine2.Visible := False; FSCS_Main.pmiSCSObjRealignObject.Visible := False; if aLine.FIsRaiseUpDown then FSCS_Main.pmiSCSObjChangeRaiseHeight.Visible := True else FSCS_Main.pmiSCSObjChangeRaiseHeight.Visible := False; FSCS_Main.pmiSCSObjDisconnectAllConnectors.Visible := False; FSCS_Main.pmiSCSObjDisconnectFromRM.Visible := False; FSCS_Main.pmiSCSObjRemoveObjectOnHeight.Visible := False; FSCS_Main.pmiSCSObjShowConfigurator.Visible := False; FSCS_Main.pmiSCSObjMirrorView.Visible := False; FSCS_Main.pmiSCSObjCreateDuplicates.Visible := True; FSCS_Main.pmiSCSObjDisconnectTraces.Visible := False; FSCS_Main.pmiSCSObjRotateTraceDrawFigure180.Visible := True; FSCS_Main.pmiSCSObjMirrorBlock.Visible := False; if not aLine.FIsRaiseUpDown then begin if aLine.FMarkTracing then FSCS_Main.pmiSCSObjMarkForTracing.Caption := cMain_Mes100 else FSCS_Main.pmiSCSObjMarkForTracing.Caption := cMain_Mes99; FSCS_Main.pmiSCSObjMarkForTracing.Visible := True; if aLine.FDisableTracing then FSCS_Main.pmiSCSObjMarkForDisableTracing.Caption := cMain_Mes113 else FSCS_Main.pmiSCSObjMarkForDisableTracing.Caption := cMain_Mes112; FSCS_Main.pmiSCSObjMarkForDisableTracing.Visible := True; end else begin FSCS_Main.pmiSCSObjMarkForTracing.Visible := False; FSCS_Main.pmiSCSObjMarkForDisableTracing.Visible := False; end; // создание магистрали if not aLine.FIsRaiseUpDown then begin FSCS_Main.pmiSCSObjCreateTrunk.Visible := True; end else begin FSCS_Main.pmiSCSObjCreateTrunk.Visible := False; end; FSCS_Main.pmiSCSObjCreateVertical.Visible := False; FSCS_Main.pmiSCSObjDivTracesOnRoowWalls.Visible := true; //13.03.2013 FSCS_Main.aDivTracesOnRoowWalls.Visible := true; end; FSCS_Main.aAutoCreateTraces.Visible := false; except on E: Exception do addExceptionToLogEx('TF_CAD.SetMenuItemsForOrthoLine', E.Message); end; end; function TF_CAD.GetLastSelectedSCSObject: TFigure; var FFigure: TFigure; i, SelCount: integer; begin Result := nil; try SelCount := PCad.SelectedCount - 1; Result := TFigure(PCad.Selection[SelCount]); if CheckFigureByClassName(Result, cTConnectorObject) or CheckFigureByClassName(Result, cTOrthoLine) then Exit; for i := SelCount downto 0 do begin FFigure := TFigure(PCad.Selection[i]); if CheckFigureByClassName(FFigure, cTConnectorObject) or CheckFigureByClassName(FFigure, cTOrthoLine) then begin Result := FFigure; exit; end; end; except on E: Exception do addExceptionToLogEx('TF_CAD.GetLastSelectedSCSObject', E.Message); end; end; function TF_CAD.GetScaleKoefs: TDoublePoint; var pt: TPoint; VisRect: TDoubleRect; Rect: TRect; MPos: TDoublePoint; koefposx, koefposy: double; x1, x2, y1, y2: double; begin try Result.x := 0; Result.y := 0; Rect := PCad.ClientRect; x1 := Rect.Left; x2 := Rect.Right; y1 := Rect.Top; y2 := Rect.Bottom; if FScaleByCursor then begin GetCursorPos(pt); pt := Self.ScreenToClient(pt); // pt.x := pt.x - 35 - 27; // pt.y := pt.y - 35; // koefposx := (pt.x - x1) / (x2 - x1); // koefposy := (pt.y - y1) / (y2 - y1); // Result.x := (x2 - x1) * koefposx; // Result.y := (y2 - y1) * koefposy; Result.x := pt.x; Result.y := pt.y; end else begin Result.x := (x2 - x1) / 2; Result.y := (y2 - y1 - 10) / 2; end; except on E: Exception do addExceptionToLogEx('TF_CAD.GetScaleKoefs', E.Message); end; end; procedure TF_CAD.RotateObjectsByKeyboard(aObjects: TList; aAngle: Double); var i: integer; PointObject: TConnectorObject; AngleRad: Double; AngleDeg: Double; Bnd: TDoubleRect; NewAngleDegree: Double; begin try if aObjects.Count > 0 then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := False; end; for i := 0 to aObjects.Count - 1 do begin PointObject := TConnectorObject(aObjects[i]); if CheckTrunkObject(PointObject) then begin RotateTrunkObject(PointObject, aAngle); Exit; end; AngleRad := aAngle / 180 * pi; PointObject.Rotate(AngleRad, PointObject.ActualPoints[1]); PointObject.DrawFigure.Rotate(AngleRad, PointObject.CenterPoint); PointObject.FDrawFigureAngle := PointObject.FDrawFigureAngle + AngleRad; if PointObject.FDrawFigureAngle >= 2 * pi then PointObject.FDrawFigureAngle := PointObject.FDrawFigureAngle - 2 * pi; Bnd := PointObject.DrawFigure.GetBoundRect; PointObject.GrpSizeX := Bnd.Right - Bnd.Left; PointObject.GrpSizeY := Bnd.Bottom - Bnd.Top; // NewAngleDegree := PointObject.FDrawFigureAngle * 180 / pi; if (NewAngleDegree >= 0) and (NewAngleDegree <= 45) then PointObject.FCaptionsViewType := cv_Right else if (NewAngleDegree > 45) and (NewAngleDegree < 135) then PointObject.FCaptionsViewType := cv_Down else if (NewAngleDegree >= 135) and (NewAngleDegree <= 225) then PointObject.FCaptionsViewType := cv_Left else if (NewAngleDegree > 225) and (NewAngleDegree < 315) then PointObject.FCaptionsViewType := cv_Up else if (NewAngleDegree >= 315) and (NewAngleDegree <= 360) then PointObject.FCaptionsViewType := cv_Right; PointObject.DefRaizeDrawFigurePos; // RefreshCAD(GCadForm.PCad); PointObject.ReCreateCaptionsGroup(false, false); end; SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := True; end; except on E: Exception do addExceptionToLogEx('TF_CAD.RotateObjectsByKeyboard', E.Message); end; end; function TF_CAD.SaveForUndo(aType: TListUndoActionType; aSavePM: Boolean; aIsProject: Boolean; aProjectIndex: Integer = 0): TListUndoAction; var SavedGCadForm: TF_CAD; begin Result := nil; try SavedGCadForm := GCadForm; GCadForm := Self; // очистить REDO Лист if FSCSRedoList <> nil then ClearRedoList; if FListType = lt_Normal then Result := SaveForUndoNormalList(aType, aSavePM, aIsProject, aProjectIndex); if FListType = lt_ProjectPlan then Result := SaveForUndoProjectPlan(aType, aSavePM, aIsProject, aProjectIndex); if FListType = lt_DesignBox then Result := SaveForUndoDesignList(aType, aSavePM, aIsProject, aProjectIndex); GCadForm := SavedGCadForm; except on E: Exception do addExceptionToLogEx('TF_CAD.SaveForUndo', E.Message); end; end; function TF_CAD.SaveForUndoNormalList(aType: TListUndoActionType; aSavePM: Boolean; aIsProject: Boolean; aProjectIndex: Integer = 0): TListUndoAction; var i, j: integer; Count: Integer; OldFName, FName: string; SetUndoName: string; ListUndoAction: TListUndoAction; tmpCad: TPowerCad; Stream: TMemoryStream; size: integer; CanProcess: Boolean; BasePath: string; begin Result := nil; try CanProcess := true; // *UNDO ProjectManager* BasePath := ''; if (aSavePM) and ((not aIsProject) or (aProjectIndex = 0)) then begin BasePath := SavePMForUndo(FCADListID, aIsProject); CanProcess := BasePath <> ''; end; if CanProcess then begin // проверить нужно ли сейчас делать слепок if not CheckMakeSaveForUndo then begin // Прибавить активное действие FActiveActions := FActiveActions + 1; // выйти exit; end; // Прибавить активное действие FActiveActions := FActiveActions + 1; // кол-во откатов переполнено, сместить. if FSCSUndoList.Count = 10 then begin // удалить первый файл в списке ListUndoAction := TListUndoAction(FSCSUndoList[0]); FName := ListUndoAction.FCadFileName; // удалить файл if FileExists(FName) then DeleteFile(FName); // удалить элемент из списка файлов FSCSUndoList.Delete(0); // *UNDO ProjectManager* DeleteUndoFromPM(FCADListID, ListUndoAction.FBasePath, ListUndoAction.FIsProject); // удалить объект UndoAction if ListUndoAction.ActionType = uat_Floor then begin // завязки на другие этажи - удалить всю цепочку DeleteProjectUndoActions(Self, ListUndoAction); end; FreeAndNil(ListUndoAction); // переприсвоить имена файлов с учетом смещения for i := 0 to FSCSUndoList.Count - 1 do begin ListUndoAction := TListUndoAction(FSCSUndoList[i]); // FName := FUndoDir + FCADListName + IntTostr(FCADListIndex) + '_' + IntToStr(i); FName := FUndoDir + FCADListFileName + '_' + IntToStr(i); OldFName := ListUndoAction.FCadFileName; RenameFile(OldFName, FName); ListUndoAction.FCadFileName := FName; end; end; ListUndoAction := TListUndoAction.Create(aType, aSavePM); // записать последнее изменение в файл, название в FUndoList Count := FSCSUndoList.Count; // SetUndoName := FUndoDir + FCADListName + IntTostr(FCADListIndex) + '_' + IntToStr(Count); SetUndoName := FUndoDir + FCADListFileName + '_' + IntToStr(Count); // сохранить в список файлов ListUndoAction.FCadFileName := SetUndoName; ListUndoAction.FIndex := Count; ListUndoAction.FIsProject := aIsProject; FSCSUndoList.Add(ListUndoAction); // сохранить в темповый файл FUndoFiguresList.Clear; PCad.SaveSCSFiguresToFile(SetUndoName); // *UNDO ProjectManager* //16.08.2011 if (aSavePM) and ((not aIsProject) or (aProjectIndex = 0)) then //16.08.2011 BasePath := SavePMForUndo(FCADListID, ListUndoAction.FIsProject) //16.08.2011 else //16.08.2011 BasePath := ''; ListUndoAction.FBasePath := BasePath; Result := ListUndoAction; end; except on E: Exception do addExceptionToLogEx('TF_CAD.SaveForUndoNormalList', E.Message); end; end; function TF_CAD.SaveForUndoProjectPlan(aType: TListUndoActionType; aSavePM: Boolean; aIsProject: Boolean; aProjectIndex: Integer = 0): TListUndoAction; var i, j: integer; Count: Integer; OldFName, FName: string; SetUndoName: string; ListUndoAction: TListUndoAction; tmpCad: TPowerCad; Stream: TMemoryStream; size: integer; BasePath: string; begin Result := nil; try // проверить нужно ли сейчас делать слепок if not CheckMakeSaveForUndo then begin // Прибавить активное действие FActiveActions := FActiveActions + 1; exit; end; // Прибавить активное действие FActiveActions := FActiveActions + 1; // кол-во откатов переполнено, сместить. if FSCSUndoList.Count = 10 then begin // удалить первый файл в списке ListUndoAction := TListUndoAction(FSCSUndoList[0]); FName := ListUndoAction.FCadFileName; // удалить файл if FileExists(FName) then DeleteFile(FName); // удалить элемент из списка файлов FSCSUndoList.Delete(0); // удалить объект UndoAction FreeAndNil(ListUndoAction); // переприсвоить имена файлов с учетом смещения for i := 0 to FSCSUndoList.Count - 1 do begin ListUndoAction := TListUndoAction(FSCSUndoList[i]); // FName := FUndoDir + FCADListName + IntTostr(FCADListIndex) + '_' + IntToStr(i); FName := FUndoDir + FCADListFileName + '_' + IntToStr(i); OldFName := ListUndoAction.FCadFileName; RenameFile(OldFName, FName); ListUndoAction.FCadFileName := FName; end; end; ListUndoAction := TListUndoAction.Create(aType, aSavePM); // записать последнее изменение в файл, название в FUndoList Count := FSCSUndoList.Count; // SetUndoName := FUndoDir + FCADListName + IntTostr(FCADListIndex) + '_' + IntToStr(Count); SetUndoName := FUndoDir + FCADListFileName + '_' + IntToStr(Count); // сохранить в список файлов ListUndoAction.FCadFileName := SetUndoName; ListUndoAction.FIndex := Count; ListUndoAction.FIsProject := aIsProject; FSCSUndoList.Add(ListUndoAction); // сохранить в темповый файл FUndoFiguresList.Clear; PCad.SavePlanFiguresToFile(SetUndoName); ListUndoAction.FBasePath := ''; Result := ListUndoAction; except on E: Exception do addExceptionToLogEx('TF_CAD.SaveForUndoProjectPlan', E.Message); end; end; function TF_CAD.SaveForUndoDesignList(aType: TListUndoActionType; aSavePM: Boolean; aIsProject: Boolean; aProjectIndex: Integer = 0): TListUndoAction; var i, j: integer; Count: Integer; OldFName, FName: string; SetUndoName: string; ListUndoAction: TListUndoAction; tmpCad: TPowerCad; Stream: TMemoryStream; size: integer; BasePath: string; begin Result := nil; try // проверить нужно ли сейчас делать слепок if not CheckMakeSaveForUndo then begin // Прибавить активное действие FActiveActions := FActiveActions + 1; // выйти exit; end; // Прибавить активное действие FActiveActions := FActiveActions + 1; // кол-во откатов переполнено, сместить. if FSCSUndoList.Count = 10 then begin // удалить первый файл в списке ListUndoAction := TListUndoAction(FSCSUndoList[0]); FName := ListUndoAction.FCadFileName; // удалить файл if FileExists(FName) then DeleteFile(FName); // удалить элемент из списка файлов FSCSUndoList.Delete(0); // *UNDO ProjectManager* DeleteUndoFromPM(FCADListID, ListUndoAction.FBasePath, ListUndoAction.FIsProject); // удалить объект UndoAction if ListUndoAction.ActionType = uat_Floor then begin // завязки на другие этажи - удалить всю цепочку DeleteProjectUndoActions(Self, ListUndoAction); end; FreeAndNil(ListUndoAction); // переприсвоить имена файлов с учетом смещения for i := 0 to FSCSUndoList.Count - 1 do begin ListUndoAction := TListUndoAction(FSCSUndoList[i]); // FName := FUndoDir + FCADListName + IntTostr(FCADListIndex) + '_' + IntToStr(i); FName := FUndoDir + FCADListFileName + '_' + IntToStr(i); OldFName := ListUndoAction.FCadFileName; RenameFile(OldFName, FName); ListUndoAction.FCadFileName := FName; end; end; ListUndoAction := TListUndoAction.Create(aType, aSavePM); // записать последнее изменение в файл, название в FUndoList Count := FSCSUndoList.Count; // SetUndoName := FUndoDir + FCADListName + IntTostr(FCADListIndex) + '_' + IntToStr(Count); SetUndoName := FUndoDir + FCADListFileName + '_' + IntToStr(Count); // сохранить в список файлов ListUndoAction.FCadFileName := SetUndoName; ListUndoAction.FIndex := Count; ListUndoAction.FIsProject := aIsProject; FSCSUndoList.Add(ListUndoAction); // сохранить в темповый файл FUndoFiguresList.Clear; PCad.SavePlanFiguresToFile(SetUndoName); ListUndoAction.FBasePath := ''; Result := ListUndoAction; except on E: Exception do addExceptionToLogEx('', E.Message); end; end; procedure TF_CAD.SCSUndoNormalList; var FName: string; Figure: TFigure; i, j: integer; ListUndoAction: TListUndoAction; LinkUndoObject: TLinkUndoObject; Stream: TMemoryStream; size: integer; CountInPrj: Integer; OldTick1, OldTick2, OldTick3, CurTick1, CurTick2, CurTick3: Cardinal; CurListParams: TListParams; ListOfLists: TList; SavedGCadForm: TF_CAD; NetObj: TNet; begin try BeginProgress; if FSCSUndoList.Count > 0 then begin ListUndoAction := TListUndoAction(FSCSUndoList[FSCSUndoList.Count - 1]); FName := ListUndoAction.FCadFileName; // есть файл if FileExists(FName) then begin // Перед UNDO, создается слепок текущего состояния для REDO if ListUndoAction.ActionType = uat_Floor then begin CountInPrj := 0; ListOfLists := TList.Create; for i := 0 to ListUndoAction.FProjectUndoAction.FLinkUndoObject.Count - 1 do begin LinkUndoObject := TLinkUndoObject(ListUndoAction.FProjectUndoAction.FLinkUndoObject[i]); if LinkUndoObject.FCad.FListType = lt_Normal then begin CountInPrj := CountInPrj + 1; ListOfLists.Add(LinkUndoObject.FCad); end; end; SaveForProjectRedo(ListOfLists, ListUndoAction.FSavePM, ListUndoAction.FIsProject); FreeAndNil(ListOfLists); end else begin CountInPrj := 1; SaveForRedo(ListUndoAction.ActionType, ListUndoAction.FSavePM, ListUndoAction.FIsProject, CountInPrj); end; // ClearSCSFigures; PCad.OnObjectInserted := nil; FUndoFiguresList.Clear; PCad.LoadSCSFiguresFromFile(FName); PCad.OnObjectInserted := PCadObjectInserted; FUndoStatus := True; try if GListWithEndPoint = Self then begin GEndPoint := nil; GListWithEndPoint := nil; end; for i := 0 to PCad.FigureCount - 1 do begin Figure := TFigure(PCad.Figures.Items[i]); if CheckFigureByClassName(Figure, 'TNet') then begin NetObj := TNet(PCad.Figures.Items[i]); if NetObj.FComponID = 0 then begin FActiveNet := NetObj; ActiveNet := FActiveNet; end; end else if CheckFigureByClassName(Figure, cTConnectorObject) then begin TConnectorObject(Figure).RaiseProperties; TConnectorObject(Figure).FJoinedListIDForBox := -1; end else if CheckFigureByClassName(Figure, cTOrthoLine) then TOrthoLine(Figure).RaiseProperties else if CheckFigureByClassName(Figure, cTSCSFigureGrp) then TSCSFigureGrp(Figure).RaiseProperties else if CheckFigureByClassName(Figure, cTCabinet) then TCabinet(Figure).RaiseProperties else if CheckFigureByClassName(Figure, cTCabinetExt) then TCabinetExt(Figure).RaiseProperties else if CheckFigureByClassName(Figure, cTHouse) then THouse(Figure).RaiseProperties; end; finally FUndoStatus := False; end; FindObjectsForConvertClasses; PCad.DrawFigures(True); // удалить файл if FileExists(FName) then DeleteFile(FName); // удалить последний который поднимается из спика FSCSUndoList.Delete(FSCSUndoList.Count - 1); // *UNDO ProjectManager* UndoListInPM(FCADListID, ListUndoAction.FBasePath, ListUndoAction.FIsProject, 0, CountInPrj); // есть связи с другими этажами - поднять со всех связанных листов if ListUndoAction.ActionType = uat_Floor then begin LoadProjectUndoActions(Self, ListUndoAction); end; // List Params CurListParams := GetListParams(FCADListID); FCanSaveForUndo := False; LoadSettingsForListByParams(CurListParams, True); SetVisibleCabinetsNumbers(FShowCabinetsNumbers); SetVisibleCabinetsBounds(FShowCabinetsBounds); FCanSaveForUndo := True; OnAfterUndo; end else FSCSUndoList.Remove(ListUndoAction); // удалить объект UndoAction FreeAndNil(ListUndoAction); end; except on E: Exception do addExceptionToLogEx('TF_CAD.SCSUndoNormalList', E.Message); end; EndProgress; end; procedure TF_CAD.SCSUndoProjectPlan; var FName: string; i, j: integer; ListUndoAction: TListUndoAction; Stream: TMemoryStream; size: integer; CountInPrj: Integer; CurListParams: TListParams; SavedGCadForm: TF_CAD; Figure: TFigure; begin try BeginProgress; if FSCSUndoList.Count > 0 then begin ListUndoAction := TListUndoAction(FSCSUndoList[FSCSUndoList.Count - 1]); FName := ListUndoAction.FCadFileName; // есть файл if FileExists(FName) then begin // Перед UNDO, создается слепок текущего состояния для REDO SaveForRedo(ListUndoAction.ActionType, ListUndoAction.FSavePM, ListUndoAction.FIsProject, 1); ClearPlanFigures; PCad.OnObjectInserted := nil; FUndoFiguresList.Clear; PCad.LoadSCSFiguresFromFile(FName); PCad.OnObjectInserted := PCadObjectInserted; FUndoStatus := True; try for i := 0 to PCad.FigureCount - 1 do begin Figure := TFigure(PCad.Figures.Items[i]); if CheckFigureByClassName(Figure, cTPlanObject) then TPlanObject(Figure).RaiseProperties else if CheckFigureByClassName(Figure, cTPlanConnector) then TPlanConnector(Figure).RaiseProperties else if CheckFigureByClassName(Figure, cTPlanTrace) then TPlanTrace(Figure).RaiseProperties; end; finally FUndoStatus := False; end; // удалить файл if FileExists(FName) then DeleteFile(FName); // удалить последний который поднимается из спика FSCSUndoList.Delete(FSCSUndoList.Count - 1); CurListParams := GetListParams(FCADListID); FCanSaveForUndo := False; LoadSettingsForListByParams(CurListParams, True); FCanSaveForUndo := True; end else FSCSUndoList.Remove(ListUndoAction); // удалить объект UndoAction FreeAndNil(ListUndoAction); end; except on E: Exception do addExceptionToLogEx('TF_CAD.SCSUndoProjectPlan', E.Message); end; EndProgress; end; procedure TF_CAD.SCSUndoDesignList; var FName: string; i, j: integer; ListUndoAction: TListUndoAction; LinkUndoObject: TLinkUndoObject; Stream: TMemoryStream; size: integer; CountInPrj: Integer; OldTick1, OldTick2, OldTick3, CurTick1, CurTick2, CurTick3: Cardinal; CurListParams: TListParams; ListOfLists: TList; SavedGCadForm: TF_CAD; begin try BeginProgress; if FSCSUndoList.Count > 0 then begin ListUndoAction := TListUndoAction(FSCSUndoList[FSCSUndoList.Count - 1]); FName := ListUndoAction.FCadFileName; // есть файл if FileExists(FName) then begin // Перед UNDO, создается слепок текущего состояния для REDO if ListUndoAction.ActionType = uat_Floor then begin ListOfLists := TList.Create; CountInPrj := ListUndoAction.FProjectUndoAction.FLinkUndoObject.Count; for i := 0 to ListUndoAction.FProjectUndoAction.FLinkUndoObject.Count - 1 do begin LinkUndoObject := TLinkUndoObject(ListUndoAction.FProjectUndoAction.FLinkUndoObject[i]); ListOfLists.Add(LinkUndoObject.FCad); end; SaveForProjectRedo(ListOfLists, ListUndoAction.FSavePM, ListUndoAction.FIsProject); FreeAndNil(ListOfLists); end else begin CountInPrj := 1; SaveForRedo(ListUndoAction.ActionType, ListUndoAction.FSavePM, ListUndoAction.FIsProject, CountInPrj); end; // ClearPlanFigures; PCad.OnObjectInserted := nil; FUndoFiguresList.Clear; PCad.LoadSCSFiguresFromFile(FName); PCad.OnObjectInserted := PCadObjectInserted; FUndoStatus := True; if GListWithEndPoint = Self then begin GEndPoint := nil; GListWithEndPoint := nil; end; FUndoStatus := False; // удалить файл if FileExists(FName) then DeleteFile(FName); // удалить последний который поднимается из спика FSCSUndoList.Delete(FSCSUndoList.Count - 1); // есть связи с другими этажами - поднять со всех связанных листов if ListUndoAction.ActionType = uat_Floor then begin LoadProjectUndoActions(Self, ListUndoAction); end; // List Params CurListParams := GetListParams(FCADListID); FCanSaveForUndo := False; LoadSettingsForListByParams(CurListParams, True); FCanSaveForUndo := True; end else FSCSUndoList.Remove(ListUndoAction); // удалить объект UndoAction FreeAndNil(ListUndoAction); end; except on E: Exception do addExceptionToLogEx('TF_CAD.SCSUndoDesignList', E.Message); end; EndProgress; end; procedure TF_CAD.OnAfterUndo; var i, j: integer; Figure, InFigure: TFigure; begin for i := 0 to PCad.FigureCount - 1 do begin Figure := TFigure(PCad.Figures.Items[i]); if Assigned(Figure.FAfterUndo) then Figure.FAfterUndo(Figure); if Figure is TFigureGrp then for j := 0 to TFigureGrp(Figure).InFigures.Count - 1 do begin InFigure := TFigure(TFigureGrp(Figure).InFigures[j]); if Assigned(InFigure.FAfterUndo) then InFigure.FAfterUndo(InFigure); end; end; end; procedure TF_CAD.ClearSCSFigures; var i: integer; FigureCount: Integer; FFigure: TFigure; LHandle2: Integer; LHandle3: Integer; LHandle4: Integer; LHandle5: Integer; LHandle6: Integer; LHandle8: Integer; LHandle9: Integer; FigList: TList; Count: Integer; begin try LHandle2 := PCad.GetLayerHandle(2); LHandle3 := PCad.GetLayerHandle(3); LHandle4 := PCad.GetLayerHandle(4); LHandle5 := PCad.GetLayerHandle(5); LHandle6 := PCad.GetLayerHandle(6); LHandle8 := PCad.GetLayerHandle(8); LHandle9 := PCad.GetLayerHandle(9); FigList := TList.Create; for i := 0 to PCad.FigureCount - 1 do begin FFigure := TFigure(PCad.Figures[i]); if (FFigure.LayerHandle = LHandle2) or (FFigure.LayerHandle = LHandle3) or (FFigure.LayerHandle = LHandle4) or (FFigure.LayerHandle = LHandle5) or (FFigure.LayerHandle = LHandle6) or (FFigure.LayerHandle = LHandle8) or (FFigure.LayerHandle = LHandle9) then FigList.Add(FFigure); end; for i := 0 to FigList.Count - 1 do begin FFigure := TFigure(FigList[i]); if FFigure is TFigureGrp then RemoveInFigureGrp(TFigureGrp(FFigure)); PCad.Figures.Remove(FFigure); try if not(FFigure is TFigureGrp) then FreeAndNil(FFigure); except end; end; FreeAndNil(FigList); FSCSFigures.Clear; RefreshCAD(PCad); except // on E: Exception do addExceptionToLogEx('TF_CAD.ClearSCSFigures', E.Message); end; end; procedure TF_CAD.ClearPlanFigures; var i: integer; FigureCount: Integer; FFigure: TFigure; LHandle1: Integer; FigList: TList; Count: Integer; begin try LHandle1 := PCad.GetLayerHandle(1); FigList := TList.Create; for i := 0 to PCad.FigureCount - 1 do begin FFigure := TFigure(PCad.Figures[i]); if (FFigure.LayerHandle = LHandle1) then FigList.Add(FFigure); end; for i := 0 to FigList.Count - 1 do begin FFigure := TFigure(FigList[i]); if FFigure is TFigureGrp then RemoveInFigureGrp(TFigureGrp(FFigure)); PCad.Figures.Remove(FFigure); try if not(FFigure is TFigureGrp) then FreeAndNil(FFigure); except end; end; FreeAndNil(FigList); RefreshCAD(PCad); except // on E: Exception do addExceptionToLogEx('TF_CAD.ClearPlanFigures', E.Message); end; end; procedure TF_CAD.ClearUndoList(AFreeList: Boolean=true); var i: Integer; FileName: string; ListUndoAction: TListUndoAction; begin try if FSCSUndoList <> nil then begin for i := 0 to FSCSUndoList.Count - 1 do begin ListUndoAction := TListUndoAction(FSCSUndoList[i]); FileName := ListUndoAction.FCadFileName; if FileExists(FileName) then DeleteFile(FileName); // очистить ссылки на других этажах if ListUndoAction.ActionType = uat_Floor then begin // завязки на другие этажи - удалить всю цепочку DeleteProjectUndoActions(Self, ListUndoAction); end; // удалить объект UndoAction FreeAndNil(ListUndoAction); end; if AFreeList then //13.03.2012 FreeAndNil(FSCSUndoList) else FSCSUndoList.Clear; end; except on E: Exception do addExceptionToLogEx('TF_CAD.ClearUndoList', E.Message); end; end; function TF_CAD.BeginSaveForUndo(aType: TListUndoActionType; aSavePM: Boolean; aIsProject: Boolean; aProjectIndex: Integer = 0): TListUndoAction; begin Result := nil; if FUndoCount = 0 then begin FUndoCount := FUndoCount + 1; Result := SaveForUndo(aType, aSavePM, aIsProject, aProjectIndex); end; end; procedure TF_CAD.EndSaveForUndo; begin if FUndoCount > 0 then FUndoCount := FUndoCount - 1; end; procedure TF_CAD.FOnBeforeMove(Sender: TObject; Figure: TFigure; aDeltaX: double = -999999; aDeltaY: double = -999999); var i: Integer; vList: TList; vSavePM: Boolean; Conn, PointObject: TConnectorObject; BreakedPoints: TDoublePoint; vFigure: TFigure; oldx, oldy, newx, newy: double; begin try if (PCad.ActiveLayer = lnArch) or CheckOneOfSCSlayers(PCad.ActiveLayer) then begin // *UNDO* if FCanSaveForUndo then begin vList := GetRelatedListsBySelected(PCad.Selection, cst_Move); if vList.Count = 1 then begin vSavePM := false; // будет привязка if GFigureSnap <> nil then vSavePM := True; // будет отвязка соединителя if Pcad.SelectedCount = 1 then if CheckFigureByClassName(TFigure(PCad.Selection[0]), cTConnectorObject) then if TConnectorObject(PCad.Selection[0]).ConnectorType = ct_Clear then if TConnectorObject(PCad.Selection[0]).JoinedConnectorsList.Count = 1 then begin Conn := TConnectorObject(PCad.Selection[0]); PointObject := TConnectorObject(Conn.JoinedConnectorsList[0]); BreakedPoints.x := Conn.ActualPoints[1].x + aDeltaX; BreakedPoints.y := Conn.ActualPoints[1].y + aDeltaY; if CheckByBreakConnectorByCoords(BreakedPoints, PointObject) then vSavePM := True; end; // проверить на смену нахождения в/вне кабинетов for i := 0 to PCad.SelectedCount - 1 do begin vFigure := TFigure(PCad.Selection[i]); if CheckFigureByClassName(vFigure, cTConnectorObject) or CheckFigureByClassName(vFigure, cTOrthoLine) then begin oldx := vFigure.ActualPoints[1].x; oldy := vFigure.ActualPoints[1].y; newx := vFigure.ActualPoints[1].x + aDeltaX; newy := vFigure.ActualPoints[1].y + aDeltaY; if GetCabinetAtPos(oldx, oldy) <> GetCabinetAtPos(newx, newy) then begin vSavePM := True; Break; end; end else if vFigure is TNet then //24.01.2011 begin // Если меняем размер окна/двери за мод.поинт то сохраняем МП чтобі сохранились параметры откосов if (DragState = dsMod) and (TNet(vFigure).FComponID <> 0) then vSavePM := True; end; end; if ssCtrl in GGlobalShiftState then begin vSavePM := True; end; // двигаются кабинеты if PCad.ActiveLayer = 9 then if Figure <> nil then if CheckFigureByClassName(Figure, cTCabinet) or CheckFigureByClassName(Figure, cTCabinetExt) then vSavePM := True; SaveForUndo(uat_None, vSavePM, False); end else begin if GFigureSnap = nil then SaveForProjectUndo(vList, False, False) else SaveForProjectUndo(vList, True, False); end; end; end else if FListType = lt_ProjectPlan then begin SaveForUndo(uat_None, False, False); end; except on E: Exception do addExceptionToLogEx('TF_CAD.FOnBeforeMove', E.Message); end; end; procedure TF_CAD.FOnMoveByArrows(Sender: TObject; dx, dy: Double; var CanMove: Boolean); var vSavePM: Boolean; Conn, PointObject: TConnectorObject; BreakedPoints: TDoublePoint; begin try if (PCad.ActiveLayer = lnArch) or CheckOneOfSCSlayers(PCad.ActiveLayer) then begin vSavePM := false; // будет отвязка соединителя if Pcad.SelectedCount = 1 then if CheckFigureByClassName(TFigure(PCad.Selection[0]), cTConnectorObject) then if TConnectorObject(PCad.Selection[0]).ConnectorType = ct_Clear then if TConnectorObject(PCad.Selection[0]).JoinedConnectorsList.Count = 1 then begin Conn := TConnectorObject(PCad.Selection[0]); PointObject := TConnectorObject(Conn.JoinedConnectorsList[0]); BreakedPoints.x := Conn.ActualPoints[1].x + dx; BreakedPoints.y := Conn.ActualPoints[1].y + dy; if CheckByBreakConnectorByCoords(BreakedPoints, PointObject) then vSavePM := True; end; // *UNDO* if FCanSaveForUndo then begin SaveForUndo(uat_None, vSavePM, False); FCanSaveForUndo := False; end; end; except on E: Exception do addExceptionToLogEx('TF_CAD.FOnMoveByArrows', E.Message); end; end; constructor TListUndoAction.Create(aType: TListUndoActionType; aSavePM: Boolean); begin ActionType := aType; FSavePM := aSavePM; FProjectUndoAction := nil; FCadFileName := ''; FBasePath := ''; FIsProject := False; end; destructor TListUndoAction.Destroy; begin inherited; end; { TProjectUndoAction } constructor TProjectUndoAction.Create; begin FLinkUndoObject := TList.Create; end; destructor TProjectUndoAction.Destroy; begin inherited; end; { TLinkUndoObject } constructor TLinkUndoObject.Create; begin FCad := nil; FListUndoAction := nil; end; destructor TLinkUndoObject.Destroy; begin inherited; end; function TF_CAD.CheckMakeSaveForUndo: boolean; begin Result := False; try if (FActiveActions = 0) or (FActiveActions mod FSaveUndoCount = 0) then Result := True else Result := False; except on E: Exception do addExceptionToLogEx('TF_CAD.CheckMakeSaveForUndo', E.Message); end; end; procedure TF_CAD.BuildPopupFiguresByLevel(AFiguresList:TList; AOnClick: TNotifyEvent; AX: Double=-1; AY: Double=-1); var i: Integer; FFigure: TFigure; FHeightStr: String; Coord1, Coord2: Double; Item: TMenuItem; begin FSCS_Main.pmFiguresByLevel.Items.Clear; for i := 0 to AFiguresList.Count - 1 do begin FFigure := TFigure(AFiguresList[i]); Item := TMenuItem.Create(FSCS_Main.pmFiguresByLevel); FHeightStr := ''; if CheckFigureByClassName(FFigure, cTOrthoLine) then begin if TOrthoLine(FFigure).ActualZOrder[1] = TOrthoLine(FFigure).ActualZOrder[2] then FHeightStr := FormatFloat(ffMask, MetreToUOM(TOrthoLine(FFigure).ActualZOrder[1])) else begin //07.02.2011 FHeightStr := FormatFloat(ffMask, MetreToUOM(TOrthoLine(FFigure).ActualZOrder[1])) + '-' + //07.02.2011 FormatFloat(ffMask, MetreToUOM(TOrthoLine(FFigure).ActualZOrder[2])); Coord1 := TOrthoLine(FFigure).ActualZOrder[1]; Coord2 := TOrthoLine(FFigure).ActualZOrder[2]; if Coord2 < Coord1 then ExchangeDouble(Coord1, Coord2); FHeightStr := FormatFloat(ffMask, MetreToUOM(Coord1)) +'-'+ FormatFloat(ffMask, MetreToUOM(Coord2)); end; end else if CheckFigureByClassName(FFigure, cTConnectorObject) then FHeightStr := FormatFloat(ffMask, MetreToUOM(TConnectorObject(FFigure).ActualZOrder[1])); Item.Caption := GetFullFigureName(FFigure, AX, AY) + ' (' + FHeightStr + GetUOMString(GCurrProjUnitOfMeasure) + ')' ; FSCS_Main.pmFiguresByLevel.Items.Add(Item); Item.Tag := FFigure.ID; Item.OnClick := AOnClick; end; end; function TF_CAD.RemoveFigureFromSelected(AFigure: TFigure): Integer; begin Result := PCad.Selection.IndexOf(AFigure); if Result <> -1 then begin AFigure.Selected := false; PCad.Selection.Delete(Result); end; end; procedure TF_CAD.RemoveSelectedWithoutCheck; //var //SavedAutoDelete: Boolean; begin FWasDeleteQuery := true; GCanDeleteFigures := true; //SavedAutoDelete := GAutoDelete; //GAutoDelete := False; //try //PCad.OnBeforeDelete := nil; PCad.RemoveSelection; //finally //GAutoDelete := SavedAutoDelete; //end; end; //function TF_CAD.OnGetShowPathLength(Sender: TObject): Double; //begin // Result := TNetPath(Sender).GetLenForShow(FShowPathLineType); //end; function TF_CAD.OnGetShowPathLengthType(Sender: TObject): TShowPathLengthType; begin Result := FShowPathLengthType; if TNetPath(Sender).WStyle = wsLine then Result := sltPoints; end; function TF_CAD.OnGetShowPathTraceLengthType(Sender: TObject): TShowPathLengthType; begin Result := FShowPathTraceLengthType; if TNetPath(Sender).WStyle = wsLine then Result := sltPoints; end; procedure TF_CAD.AddSCSFigure(AFigure: TFigure); begin if FSCSFiguresLockCount = 0 then FSCSFigures.Insert(AFigure, @AFigure.ID); end; procedure TF_CAD.RemoveSCSFigure(AFigure: TFigure); begin if FSCSFiguresLockCount = 0 then FSCSFigures.Remove(AFigure.ID); end; procedure TF_CAD.LockSCSFigures; begin Inc(FSCSFiguresLockCount); end; procedure TF_CAD.UnLockSCSFigures; begin if FSCSFiguresLockCount > 0 then Dec(FSCSFiguresLockCount); end; procedure TF_CAD.ClearFrameFigures; var i: integer; begin Self.FFrameProjectName := nil; Self.FFrameListName := nil; Self.FFrameCodeName := nil; Self.FFrameIndexName := nil; Self.FFrameStampDeveloper := nil; Self.FFrameStampChecker := nil; for i := 0 to Self.FFrameObjects.Count - 1 do Self.FFrameObjects.Objects[i] := nil; end; procedure TF_CAD.SetFrameFigures; //18.11.2011 var i: Integer; Figure: TRichText; ObjIdx: integer; begin for i := 0 to FFrameObjects.Count - 1 do begin Figure := TRichText(FFrameObjects.Objects[i]); ObjIdx := StrToInt(FFrameObjects[i]); case ObjIdx of ftProjectName: FFrameProjectName := Figure; ftListName: FFrameListName := Figure; ftCodeName: FFrameCodeName := Figure; ftIndexName: FFrameIndexName := Figure; ftDeveloperName: FFrameStampDeveloper := Figure; ftCheckerName: FFrameStampChecker := Figure; end; end; end; procedure TF_CAD.DeleteLayerAllObjects(aLayerNumber: Integer; aQuast: Boolean); begin Self.PCad.DeselectAll(0); Self.PCad.SelectAll(aLayerNumber); Self.DeleteSelection(aQuast); end; procedure TF_CAD.DeleteSelection(aQuast: Boolean); var SavedAutoDelete: Boolean; begin if Self.PCad.SelectedCount > 0 then begin SavedAutoDelete := GAutoDelete; if Not aQuast then begin GAutoDelete := false; GCanDeleteFigures := True; FWasDeleteQuery := True; end; try Self.PCad.RemoveSelection; RefreshCAD(Self.PCad); SetProjectChanged(True); finally GAutoDelete := SavedAutoDelete; end; end; end; procedure TF_CAD.View3D; var File3D: String; begin File3D := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(FCADListID).File3D; PCad.View3D(File3D); end; function TF_CAD.Get3DModel: TObject; begin Result := PCad.Get3DModel(F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(FCADListID).File3D); end; function TF_CAD.GetMsgLengthToPoint(const aLen: Double): String; begin Result := cCad_Mes15 + FormatFloat(ffMask, MetreToUOM(aLen)) + GetUOMString(GCurrProjUnitOfMeasure); end; function TF_CAD.CreateConnector(x,y,z: Double; aLayerHandle: Integer; aConnectorType: TConnectorType; const aName: string): TConnectorObject; var ObjParams: TObjectParams; begin Result := TConnectorObject.Create(x, y, z, aLayerHandle, PCTypesUtils.mydsNormal, PCad); Result.ConnectorType := ct_Clear; PCad.AddCustomFigure (GLN(aLayerHandle), Result, False); Result.Name := cCadClasses_Mes12; SetNewObjectNameInPM(Result.ID, Result.Name); ObjParams := GetFigureParams(Result.ID); Result.Name := ObjParams.Name; Result.FIndex := ObjParams.MarkID; end; function TF_CAD.CreateConnForFloorRaise(x,y,z: Double; aLayerHandle: Integer): TConnectorObject; //var // RaiseOnFigure: TConnectorObject; // ObjParams: TObjectParams; begin //RaiseOnFigure := TConnectorObject.Create(x, y, z, aLayerHandle, mydsNormal, PCad); // RaiseOnFigure.ConnectorType := ct_Clear; // PCad.AddCustomFigure (GLN(aLayerHandle), RaiseOnFigure, False); // RaiseOnFigure.Name := cCadClasses_Mes12; // SetNewObjectNameInPM(RaiseOnFigure.ID, RaiseOnFigure.Name); // ObjParams := GetFigureParams(RaiseOnFigure.ID); // RaiseOnFigure.Name := ObjParams.Name; // RaiseOnFigure.FIndex := ObjParams.MarkID; // // Result := RaiseOnFigure; Result := CreateConnector(x,y,z, aLayerHandle, ct_Clear, cCadClasses_Mes12); end; procedure TF_CAD.ClearRedoList(AFreeList: Boolean=true); var i: Integer; FileName: string; ListUndoAction: TListUndoAction; begin try if FSCSRedoList <> nil then begin for i := 0 to FSCSRedoList.Count - 1 do begin ListUndoAction := TListUndoAction(FSCSRedoList[i]); FileName := ListUndoAction.FCadFileName; if FileExists(FileName) then DeleteFile(FileName); // очистить ссылки на других этажах if ListUndoAction.ActionType = uat_Floor then begin // завязки на другие этажи - удалить всю цепочку //17.08.2012 - почемуто UndoActions, хотя здесь Redo //17.08.2012 DeleteProjectUndoActions(Self, ListUndoAction); DeleteProjectRedoActions(Self, ListUndoAction); end; // удалить объект UndoAction FreeAndNil(ListUndoAction); end; if AFreeList then FreeAndNil(FSCSRedoList) //13.03.2012 else FSCSRedoList.Clear; end; except on E: Exception do AddExceptionToLogEx('TF_CAD.ClearRedoList', E.Message); end; end; function TF_CAD.SaveForRedo(aType: TListUndoActionType; aSavePM, aIsProject: Boolean; aProjectIndex: Integer): TListUndoAction; var SavedGCadForm: TF_CAD; begin Result := nil; try SavedGCadForm := GCadForm; GCadForm := Self; if FListType = lt_Normal then Result := SaveForRedoNormalList(aType, aSavePM, aIsProject, aProjectIndex); if FListType = lt_ProjectPlan then Result := SaveForRedoProjectPlan(aType, aSavePM, aIsProject, aProjectIndex); if FListType = lt_DesignBox then Result := SaveForRedoDesignList(aType, aSavePM, aIsProject, aProjectIndex); GCadForm := SavedGCadForm; except on E: Exception do AddExceptionToLogEx('TF_CAD.SaveForRedo', E.Message); end; end; function TF_CAD.SaveForRedoDesignList(aType: TListUndoActionType; aSavePM, aIsProject: Boolean; aProjectIndex: Integer): TListUndoAction; var i, j: integer; Count: Integer; OldFName, FName: string; SetUndoName: string; ListUndoAction: TListUndoAction; tmpCad: TPowerCad; Stream: TMemoryStream; size: integer; BasePath: string; begin Result := nil; try if FSCSRedoList = nil then FSCSRedoList := TList.Create; // кол-во откатов переполнено, сместить. if FSCSRedoList.Count = 10 then begin // удалить первый файл в списке ListUndoAction := TListUndoAction(FSCSRedoList[0]); FName := ListUndoAction.FCadFileName; // удалить файл if FileExists(FName) then DeleteFile(FName); // удалить элемент из списка файлов FSCSRedoList.Delete(0); // *UNDO ProjectManager* DeleteUndoFromPM(FCADListID, ListUndoAction.FBasePath, ListUndoAction.FIsProject); // удалить объект UndoAction if ListUndoAction.ActionType = uat_Floor then begin // завязки на другие этажи - удалить всю цепочку DeleteProjectRedoActions(Self, ListUndoAction); end; FreeAndNil(ListUndoAction); // переприсвоить имена файлов с учетом смещения for i := 0 to FSCSRedoList.Count - 1 do begin ListUndoAction := TListUndoAction(FSCSRedoList[i]); // FName := FRedoDir + FCADListName + IntTostr(FCADListIndex) + '_' + IntToStr(i); FName := FRedoDir + FCADListFileName + '_' + IntToStr(i); OldFName := ListUndoAction.FCadFileName; RenameFile(OldFName, FName); ListUndoAction.FCadFileName := FName; end; end; ListUndoAction := TListUndoAction.Create(aType, aSavePM); // записать последнее изменение в файл, название в FUndoList Count := FSCSRedoList.Count; // SetUndoName := FRedoDir + FCADListName + IntTostr(FCADListIndex) + '_' + IntToStr(Count); SetUndoName := FRedoDir + FCADListFileName + '_' + IntToStr(Count); // сохранить в список файлов ListUndoAction.FCadFileName := SetUndoName; ListUndoAction.FIndex := Count; ListUndoAction.FIsProject := aIsProject; FSCSRedoList.Add(ListUndoAction); // сохранить в темповый файл FUndoFiguresList.Clear; PCad.SavePlanFiguresToFile(SetUndoName); ListUndoAction.FBasePath := ''; Result := ListUndoAction; except on E: Exception do AddExceptionToLogEx('TF_CAD.SaveForRedoDesignList', E.Message); end; end; procedure TF_CAD.SetShowPathLengthType(AShowPathLengthType: TShowPathLengthType); begin FShowPathLengthType := AShowPathLengthType; SetParamsByShowPathLengthType(tbShowPathLengthType, AShowPathLengthType, FSCS_Main.aPathLengthTypePoints, FSCS_Main.aPathLengthTypeInner, FSCS_Main.aPathLengthTypeOuter); end; procedure TF_CAD.SetShowPathTraceLengthType(AShowPathLengthType: TShowPathLengthType); begin FShowPathTraceLengthType := AShowPathLengthType; SetParamsByShowPathLengthType(tbShowPathTraceLengthType, AShowPathLengthType, FSCS_Main.aPathTraceLengthTypePoints, FSCS_Main.aPathTraceLengthTypeInner, FSCS_Main.aPathTraceLengthTypeOuter); end; procedure TF_CAD.SetParamsByShowPathLengthType(AToolButton: TToolButton; AShowPathLengthType: TShowPathLengthType; APoints, AInner, AOuter: TCustomAction); var SrcAct: TCustomAction; begin SrcAct := nil; case AShowPathLengthType of sltPoints: SrcAct := APoints; sltInner: SrcAct := AInner; sltOuter: SrcAct := AOuter; end; if SrcAct <> nil then begin SrcAct.Checked := true; AToolButton.ImageIndex := SrcAct.ImageIndex; AToolButton.Hint := AToolButton.Caption + ' - '+ SrcAct.Hint; end; end; function TF_CAD.SaveForRedoNormalList(aType: TListUndoActionType; aSavePM, aIsProject: Boolean; aProjectIndex: Integer): TListUndoAction; var i, j: integer; Count: Integer; OldFName, FName: string; SetUndoName: string; ListUndoAction: TListUndoAction; tmpCad: TPowerCad; Stream: TMemoryStream; size: integer; CanProcess: Boolean; BasePath: string; begin Result := nil; try CanProcess := true; // *UNDO ProjectManager* BasePath := ''; if (aSavePM) and ((not aIsProject) or (aProjectIndex = 0)) then begin BasePath := SavePMForUndo(FCADListID, aIsProject); CanProcess := BasePath <> ''; end; if CanProcess then begin if FSCSRedoList = nil then FSCSRedoList := TList.Create; // кол-во откатов переполнено, сместить. if FSCSRedoList.Count = 10 then begin // удалить первый файл в списке ListUndoAction := TListUndoAction(FSCSRedoList[0]); FName := ListUndoAction.FCadFileName; // удалить файл if FileExists(FName) then DeleteFile(FName); // удалить элемент из списка файлов FSCSRedoList.Delete(0); // *UNDO ProjectManager* DeleteUndoFromPM(FCADListID, ListUndoAction.FBasePath, ListUndoAction.FIsProject); // удалить объект UndoAction if ListUndoAction.ActionType = uat_Floor then begin // завязки на другие этажи - удалить всю цепочку DeleteProjectRedoActions(Self, ListUndoAction); end; FreeAndNil(ListUndoAction); // переприсвоить имена файлов с учетом смещения for i := 0 to FSCSRedoList.Count - 1 do begin ListUndoAction := TListUndoAction(FSCSRedoList[i]); // FName := FRedoDir + FCADListName + IntTostr(FCADListIndex) + '_' + IntToStr(i); FName := FRedoDir + FCADListFileName + '_' + IntToStr(i); OldFName := ListUndoAction.FCadFileName; RenameFile(OldFName, FName); ListUndoAction.FCadFileName := FName; end; end; ListUndoAction := TListUndoAction.Create(aType, aSavePM); // записать последнее изменение в файл, название в FUndoList Count := FSCSRedoList.Count; // SetUndoName := FRedoDir + FCADListName + IntTostr(FCADListIndex) + '_' + IntToStr(Count); SetUndoName := FRedoDir + FCADListFileName + '_' + IntToStr(Count); // сохранить в список файлов ListUndoAction.FCadFileName := SetUndoName; ListUndoAction.FIndex := Count; ListUndoAction.FIsProject := aIsProject; FSCSRedoList.Add(ListUndoAction); // сохранить в темповый файл FUndoFiguresList.Clear; PCad.SaveSCSFiguresToFile(SetUndoName); // *UNDO ProjectManager* //16.08.2011 if (aSavePM) and ((not aIsProject) or (aProjectIndex = 0)) then //16.08.2011 BasePath := SavePMForUndo(FCADListID, ListUndoAction.FIsProject) //16.08.2011 else //16.08.2011 BasePath := ''; ListUndoAction.FBasePath := BasePath; Result := ListUndoAction; end; except on E: Exception do AddExceptionToLogEx('TF_CAD.SaveForRedoNormalList', E.Message); end; end; function TF_CAD.SaveForRedoProjectPlan(aType: TListUndoActionType; aSavePM, aIsProject: Boolean; aProjectIndex: Integer): TListUndoAction; var i, j: integer; Count: Integer; OldFName, FName: string; SetUndoName: string; ListUndoAction: TListUndoAction; tmpCad: TPowerCad; Stream: TMemoryStream; size: integer; BasePath: string; begin Result := nil; try if FSCSRedoList = nil then FSCSRedoList := TList.Create; // кол-во откатов переполнено, сместить. if FSCSRedoList.Count = 10 then begin // удалить первый файл в списке ListUndoAction := TListUndoAction(FSCSUndoList[0]); FName := ListUndoAction.FCadFileName; // удалить файл if FileExists(FName) then DeleteFile(FName); // удалить элемент из списка файлов FSCSRedoList.Delete(0); // удалить объект UndoAction FreeAndNil(ListUndoAction); // переприсвоить имена файлов с учетом смещения for i := 0 to FSCSRedoList.Count - 1 do begin ListUndoAction := TListUndoAction(FSCSRedoList[i]); // FName := FRedoDir + FCADListName + IntTostr(FCADListIndex) + '_' + IntToStr(i); FName := FRedoDir + FCADListFileName + '_' + IntToStr(i); OldFName := ListUndoAction.FCadFileName; RenameFile(OldFName, FName); ListUndoAction.FCadFileName := FName; end; end; ListUndoAction := TListUndoAction.Create(aType, aSavePM); // записать последнее изменение в файл, название в FUndoList Count := FSCSRedoList.Count; // SetUndoName := FRedoDir + FCADListName + IntTostr(FCADListIndex) + '_' + IntToStr(Count); SetUndoName := FRedoDir + FCADListFileName + '_' + IntToStr(Count); // сохранить в список файлов ListUndoAction.FCadFileName := SetUndoName; ListUndoAction.FIndex := Count; ListUndoAction.FIsProject := aIsProject; FSCSRedoList.Add(ListUndoAction); // сохранить в темповый файл FUndoFiguresList.Clear; PCad.SavePlanFiguresToFile(SetUndoName); ListUndoAction.FBasePath := ''; Result := ListUndoAction; except on E: Exception do AddExceptionToLogEx('TF_CAD.SaveForRedoProjectPlan', E.Message); end; end; procedure TF_CAD.SCSRedoDesignList; var FName: string; i, j: integer; ListUndoAction: TListUndoAction; LinkUndoObject: TLinkUndoObject; Stream: TMemoryStream; size: integer; CountInPrj: Integer; OldTick1, OldTick2, OldTick3, CurTick1, CurTick2, CurTick3: Cardinal; CurListParams: TListParams; ListOfLists: TList; SavedGCadForm: TF_CAD; begin try if FSCSRedoList = nil then exit; BeginProgress; if FSCSRedoList.Count > 0 then begin ListUndoAction := TListUndoAction(FSCSRedoList[FSCSRedoList.Count - 1]); FName := ListUndoAction.FCadFileName; // есть файл if FileExists(FName) then begin // Перед UNDO, создается слепок текущего состояния для REDO if ListUndoAction.ActionType = uat_Floor then begin ListOfLists := TList.Create; CountInPrj := ListUndoAction.FProjectUndoAction.FLinkUndoObject.Count; for i := 0 to ListUndoAction.FProjectUndoAction.FLinkUndoObject.Count - 1 do begin LinkUndoObject := TLinkUndoObject(ListUndoAction.FProjectUndoAction.FLinkUndoObject[i]); ListOfLists.Add(LinkUndoObject.FCad); end; SaveForProjectUndo(ListOfLists, ListUndoAction.FSavePM, ListUndoAction.FIsProject); FreeAndNil(ListOfLists); end else begin CountInPrj := 1; SaveForUndoDesignList(ListUndoAction.ActionType, ListUndoAction.FSavePM, ListUndoAction.FIsProject, CountInPrj); end; // ClearPlanFigures; PCad.OnObjectInserted := nil; FUndoFiguresList.Clear; PCad.LoadSCSFiguresFromFile(FName); PCad.OnObjectInserted := PCadObjectInserted; FUndoStatus := True; if GListWithEndPoint = Self then begin GEndPoint := nil; GListWithEndPoint := nil; end; FUndoStatus := False; // удалить файл if FileExists(FName) then DeleteFile(FName); // удалить последний который поднимается из спика FSCSRedoList.Delete(FSCSRedoList.Count - 1); // есть связи с другими этажами - поднять со всех связанных листов if ListUndoAction.ActionType = uat_Floor then begin LoadProjectRedoActions(Self, ListUndoAction); end; // List Params CurListParams := GetListParams(FCADListID); FCanSaveForUndo := False; LoadSettingsForListByParams(CurListParams, True); FCanSaveForUndo := True; end else FSCSRedoList.Remove(ListUndoAction); // удалить объект UndoAction FreeAndNil(ListUndoAction); end; except on E: Exception do AddExceptionToLogEx('TF_CAD.SCSRedoDesignList', E.Message); end; EndProgress; end; procedure TF_CAD.SCSRedoNormalList; var FName: string; i, j: integer; ListUndoAction: TListUndoAction; LinkUndoObject: TLinkUndoObject; Stream: TMemoryStream; size: integer; CountInPrj: Integer; OldTick1, OldTick2, OldTick3, CurTick1, CurTick2, CurTick3: Cardinal; CurListParams: TListParams; ListOfLists: TList; SavedGCadForm: TF_CAD; NetObj: TNet; Figure: TFigure; begin try if FSCSRedoList = nil then exit; BeginProgress; if FSCSRedoList.Count > 0 then begin ListUndoAction := TListUndoAction(FSCSRedoList[FSCSRedoList.Count - 1]); FName := ListUndoAction.FCadFileName; // есть файл if FileExists(FName) then begin // Перед REDO, создается слепок текущего состояния для UNDO if ListUndoAction.ActionType = uat_Floor then begin ListOfLists := TList.Create; CountInPrj := 0; for i := 0 to ListUndoAction.FProjectUndoAction.FLinkUndoObject.Count - 1 do begin LinkUndoObject := TLinkUndoObject(ListUndoAction.FProjectUndoAction.FLinkUndoObject[i]); if LinkUndoObject.FCad.FListType = lt_Normal then begin CountInPrj := CountInPrj + 1; ListOfLists.Add(LinkUndoObject.FCad); end; end; SaveForProjectUndo(ListOfLists, ListUndoAction.FSavePM, ListUndoAction.FIsProject); FreeAndNil(ListOfLists); end else begin CountInPrj := 1; SaveForUndoNormalList(ListUndoAction.ActionType, ListUndoAction.FSavePM, ListUndoAction.FIsProject, CountInPrj); end; // ClearSCSFigures; PCad.OnObjectInserted := nil; FUndoFiguresList.Clear; PCad.LoadSCSFiguresFromFile(FName); PCad.OnObjectInserted := PCadObjectInserted; FUndoStatus := True; try if GListWithEndPoint = Self then begin GEndPoint := nil; GListWithEndPoint := nil; end; for i := 0 to PCad.FigureCount - 1 do begin Figure := TFigure(PCad.Figures.Items[i]); if CheckFigureByClassName(Figure, 'TNet') then begin NetObj := TNet(Figure); if NetObj.FComponID = 0 then begin FActiveNet := NetObj; ActiveNet := FActiveNet; end; end else if CheckFigureByClassName(Figure, cTConnectorObject) then TConnectorObject(Figure).RaiseProperties else if CheckFigureByClassName(Figure, cTOrthoLine) then TOrthoLine(Figure).RaiseProperties else if CheckFigureByClassName(Figure, cTSCSFigureGrp) then TSCSFigureGrp(Figure).RaiseProperties else if CheckFigureByClassName(Figure, cTCabinet) then TCabinet(Figure).RaiseProperties else if CheckFigureByClassName(Figure, cTCabinetExt) then TCabinetExt(Figure).RaiseProperties else if CheckFigureByClassName(Figure, cTHouse) then THouse(Figure).RaiseProperties; end; finally FUndoStatus := False; end; FindObjectsForConvertClasses; PCad.DrawFigures(True); // удалить файл if FileExists(FName) then DeleteFile(FName); // удалить последний который поднимается из спика FSCSRedoList.Delete(FSCSRedoList.Count - 1); // *UNDO ProjectManager* UndoListInPM(FCADListID, ListUndoAction.FBasePath, ListUndoAction.FIsProject, 0, CountInPrj); // есть связи с другими этажами - поднять со всех связанных листов if ListUndoAction.ActionType = uat_Floor then begin LoadProjectRedoActions(Self, ListUndoAction); end; // List Params CurListParams := GetListParams(FCADListID); FCanSaveForUndo := False; LoadSettingsForListByParams(CurListParams, True); SetVisibleCabinetsNumbers(FShowCabinetsNumbers); SetVisibleCabinetsBounds(FShowCabinetsBounds); FCanSaveForUndo := True; end else FSCSRedoList.Remove(ListUndoAction); // удалить объект UndoAction FreeAndNil(ListUndoAction); end; except on E: Exception do AddExceptionToLogEx('TF_CAD.SCSRedoNormalList', E.Message); end; EndProgress; end; procedure TF_CAD.SCSRedoProjectPlan; var FName: string; i, j: integer; ListUndoAction: TListUndoAction; Stream: TMemoryStream; size: integer; CountInPrj: Integer; CurListParams: TListParams; SavedGCadForm: TF_CAD; Figure: TFigure; begin try if FSCSRedoList = nil then exit; BeginProgress; if FSCSRedoList.Count > 0 then begin ListUndoAction := TListUndoAction(FSCSRedoList[FSCSRedoList.Count - 1]); FName := ListUndoAction.FCadFileName; // есть файл if FileExists(FName) then begin // Перед UNDO, создается слепок текущего состояния для REDO SaveForUndoProjectPlan(ListUndoAction.ActionType, ListUndoAction.FSavePM, ListUndoAction.FIsProject, 1); // ClearPlanFigures; PCad.OnObjectInserted := nil; FUndoFiguresList.Clear; PCad.LoadSCSFiguresFromFile(FName); PCad.OnObjectInserted := PCadObjectInserted; FUndoStatus := True; try for i := 0 to PCad.FigureCount - 1 do begin Figure := TFigure(PCad.Figures.Items[i]); if CheckFigureByClassName(Figure, cTPlanObject) then TPlanObject(Figure).RaiseProperties else if CheckFigureByClassName(Figure, cTPlanConnector) then TPlanConnector(Figure).RaiseProperties else if CheckFigureByClassName(Figure, cTPlanTrace) then TPlanTrace(Figure).RaiseProperties; end; finally FUndoStatus := False; end; // удалить файл if FileExists(FName) then DeleteFile(FName); // удалить последний который поднимается из спика FSCSRedoList.Delete(FSCSRedoList.Count - 1); CurListParams := GetListParams(FCADListID); FCanSaveForUndo := False; LoadSettingsForListByParams(CurListParams, True); FCanSaveForUndo := True; end else FSCSRedoList.Remove(ListUndoAction); // удалить объект UndoAction FreeAndNil(ListUndoAction); end; except on E: Exception do AddExceptionToLogEx('TF_CAD.SCSRedoProjectPlan', E.Message); end; EndProgress; end; procedure TF_CAD.PCadAfterDelete(Sender: TObject); var i: integer; Figure: TFigure; begin try {//17.11.2011 if FFrameProjectName <> nil then if FFrameProjectName.Deleted then FFrameProjectName := nil; if FFrameListName <> nil then if FFrameListName.Deleted then FFrameListName := nil; if FFrameCodeName <> nil then if FFrameCodeName.Deleted then FFrameCodeName := nil; if FFrameIndexName <> nil then if FFrameIndexName.Deleted then FFrameIndexName := nil;} for i := 0 to Self.FFrameObjects.Count - 1 do begin Figure := TFigure(Self.FFrameObjects.Objects[i]); if Figure <> nil then if Figure.Deleted then Self.FFrameObjects.Objects[i] := nil; end; except on E: Exception do AddExceptionToLogEx('TF_CAD.PCadAfterDelete', E.Message); end; end; procedure TF_CAD.TimerFindSnapTimer(Sender: TObject); begin TTimer(Sender).Enabled := false; end; procedure TF_CAD.PCadGetFigureToSelect(Sender: Tobject; var Figure: TFigure; x, y: double); var //Net: TNet; SelPath: TNetPath; FigureIndex: Integer; i: Integer; f: TFigure; FigureChanged: Boolean; FiguresList: TList; FigureI: TFigure; //ClickFigure: TFigure; ExistsSelected: Boolean; begin //21.06.2013 - на TF_CAD.PCadSurfaceMove эти координаты могут не всегда определятся, например если висит PopupMenu GCurrMousePos.x := X; GCurrMousePos.y := Y; if Figure <> nil then begin try FigureChanged := false; if Figure is TNet then begin // Если Figure просто сегмент (без дочернего объекта), а в этой точке есть окно/дверь другого сегмента //Net := TNet(Figure); if TNet(Figure).GetSelPathChild = nil then begin FigureIndex := TPCDrawing(Sender).Figures.IndexOf(Figure); for i := FigureIndex -1 downto 0 do begin f := TFigure(TPCDrawing(Sender).Figures[i]); if (f.LayerHandle = Figure.LayerHandle) and (f is TNet) then begin // Если на этих координатах есть объект с окном if (TNet(f).GetSelPathChild <> nil) and f.isPointIn(x, y) then begin Figure := f; FigureChanged := true; FigureBringToFront(Figure); Break; //// BREAK //// end; end; end; end; if Not FigureChanged And (TNet(Figure).SelPath <> nil) then begin // Если кликаем по сегменту с Alt, то даем возможность выбрать сегмент другого TNet if (ssAlt in GGlobalShiftState) {and (GArchEngine.FPrevSelCADObj = TNet(Figure).SelPath)} then begin // Если не нашли следующий сегмент по этим координатам, то ищем в других TNet if Not TNet(Figure).SelectNextPathByPt(x,y) then begin for i := 0 to TPCDrawing(Sender).Figures.Count -1 do begin f := TFigure(TPCDrawing(Sender).Figures[i]); if (f.LayerHandle = Figure.LayerHandle) and (f is TNet) and (Figure <> f) then begin // Если на этих координатах есть объект с окном if f.isPointIn(x, y) and (TNet(f).SelPath <> nil) then begin Figure := f; FigureChanged := true; FigureBringToFront(Figure); //TPCDrawing(Sender).OrderFigureToFront(Figure); Break; //// BREAK //// end; end; end; if Not FigureChanged then begin // Выделяем первый сегмент TNet(Figure).SelectPath(0); if Not TNet(Figure).SelectNextPathByPt(x,y) then FigureChanged := true; end; end else FigureChanged := true; end; end; // Если изменений небыло, вернуть все внутренние селекты if Not FigureChanged then Figure.isPointIn(x, y); end else if (Figure is TConnectorObject) or (Figure is TOrtholine) then //21.06.2013 begin FClickSCSFiguresList.Clear; // Если в точке есть несколько объектов, которые будут отображены через popupMenu, и нету выделенного среди их, // тогда вернем nil чтобы ничего не выделять if FClickType = ct_Single then begin //try // ClickFigure := CheckBySCSObjects(GCurrMousePos.x, GCurrMousePos.y); //except // ClickFigure := nil; //end; //if ClickFigure <> Figure then // EmptyProcedure; // поиск других объектов на данной высоте if GFigureSnap = nil then if (PCad.ToolIdx = toSelect) and (not GCadForm.FCreateObjectOnClick) then begin // формировать список объектов //FiguresList := GetFiguresByLevel(ClickFigure, GCurrMousePos.x, GCurrMousePos.y, False, true); FiguresList := GetFiguresByLevel(Figure, GCurrMousePos.x, GCurrMousePos.y, False, true); if FiguresList.Count > 1 then begin ExistsSelected := false; for i := 0 to FiguresList.Count - 1 do begin FigureI := TFigure(FiguresList[i]); if FigureI.Selected then //23.06.2013 - Если была выделена трасса, и кликнули по коннектору, то эту выделенную трассу не оставляем для следующего выделения, оставляем только однотипніе if FigureI.ClassName = Figure.ClassName then begin ExistsSelected := true; Figure := FigureI; Break; //// BREAK //// end; end; {//23.06.2013 - пока оставляем объект, т.к. бывают случаи когда нужно сразу потянуть за него} if Not ExistsSelected then begin FClickSCSFiguresList.Assign(FiguresList); //23.06.2013 Figure := nil; end;{} end; FreeAndNil(FiguresList); end; end; end; except on E: Exception do AddExceptionToLogExt(ClassName, 'PCadGetFigureToSelect', E.Message); end; end; end; procedure TF_CAD.PCadGetModPointToSelect(Sender: Tobject; var ModPoint: TModPoint; x, y: double); var i: Integer; f: TFigure; NewFigure: TFigure; NewModPoint: TModPoint; FigureChanged: Boolean; begin try FigureChanged := false; NewFigure := nil; if Assigned(ModPoint.Figure) and (ModPoint.Figure is TNet) then begin if (ssAlt in GGlobalShiftState) then begin if Not TNet(ModPoint.Figure).SelectNextPointByPt(x,y) then begin for i := 0 to TPCDrawing(Sender).Figures.Count -1 do begin f := TFigure(TPCDrawing(Sender).Figures[i]); if (f.LayerHandle = ModPoint.Figure.LayerHandle) and (f is TNet) and (ModPoint.Figure <> f) then begin // Если на этих координатах есть объект с окном if f.isPointIn(x, y) and (TNet(f).SelPt <> nil) then begin NewFigure := f; FigureChanged := true; FigureBringToFront(NewFigure); //TPCDrawing(Sender).OrderFigureToFront(Figure); Break; //// BREAK //// end; end; end; if Not FigureChanged then begin // Выделяем первую точку TNet(ModPoint.Figure).SelectPt(nil); if Not TNet(ModPoint.Figure).SelectNextPointByPt(x,y) then begin NewFigure := ModPoint.Figure; FigureChanged := true; end; end; end else begin NewFigure := ModPoint.Figure; FigureChanged := true; end; end; if NewFigure <> nil then begin //TNet(NewFigure.SelPoints.Add( // CControl.RegisterModPoint(self, ptArcControl, ptRect, clGreen, 3, path.ArcCenter.x, path.ArcCenter.y, i)); if ModPoint.Figure <> NewFigure then begin ModPoint.Figure.deselect; NewFigure.Select; end; //?? NewModPoint := NewFigure.GetModPointBySeqNbr(TNet(NewFigure).FSelPtIdx, x, y); if NewModPoint <> nil then ModPoint := NewModPoint; end; end; except on E: Exception do AddExceptionToLogExt(ClassName, 'PCadGetModPointToSelect', E.Message); end; end; procedure TF_CAD.PCadBeforeEndTrace(Sender: TObject); //25.11.2011 begin if Sender = PCad then begin if PCad.SnapInfo = TPrintRect.ClassName then begin //FSCS_Main.aPrintRect.Checked := false; FSCS_Main.tbPrintRect.Down := false; FSCS_Main.aToolSelect.Execute; end; end; end; function TF_CAD.PCadCheckPrnWithOffset(Sender: Tobject): Boolean; var CurListParams: TListParams; begin CurListParams := GetListParams(FCADListID); Result := Not CurListParams.Settings.CADStampForPrinter; end; procedure TF_CAD.tbDropDownClick(Sender: TObject); var tb: TToolButton; MenuItem: TMenuItem; NextMenuItem: TMenuItem; i: Integer; begin if Sender is TToolButton then begin tb := TToolButton(Sender); if tb.DropdownMenu <> nil then begin NextMenuItem := nil; for i := 0 to tb.DropdownMenu.Items.Count - 1 do begin MenuItem := TMenuItem(tb.DropdownMenu.Items[i]); if MenuItem.ImageIndex = tb.ImageIndex then begin if i < (tb.DropdownMenu.Items.Count-1) then NextMenuItem := TMenuItem(tb.DropdownMenu.Items[i+1]) else NextMenuItem := TMenuItem(tb.DropdownMenu.Items[0]); Break; //// BREAK //// end; end; if NextMenuItem <> nil then begin NextMenuItem.Click; end; end; end; end; procedure TF_CAD.TimerMovePanTimer(Sender: TObject); begin TTimer(Sender).Enabled := false; MoveCADOnPan(FDeltaX, FDeltaY); end; procedure TF_CAD.FormDestroy(Sender: TObject); begin FreeAndNil(FClickSCSFiguresList); FreeAndNil(FSCSFigures); end; procedure TF_CAD.PCadTraceDraw(Sender: TObject; Figure: TFigure; DeltaX: double = -999999; DeltaY: double = -999999); var p: TDoublePoint; pIdx: Integer; pDist, MinDist: Double; i: integer; PolySeg: TPlSegment; FRect: TDoubleRect; CADTraceFigure: TFigure; CADFigure: TFigure; FigurePointCount: Integer; Procedure CADDrawTraceText(x,y:Integer;Color, BColor:TColor; Text,FontName:String;FontSize:Integer;Canvas:TCanvas); var bmp: Graphics.Tbitmap; begin bmp := Graphics.Tbitmap.Create; bmp.Canvas.Font.Name := FontName; bmp.Canvas.Font.Size := FontSize; bmp.Width := bmp.Canvas.TextWidth(text)+10; bmp.Height := bmp.Canvas.TextHeight(text)+2;//10; bmp.Canvas.Brush.Color := BColor; //clSilver; //clGray; //clBlack; bmp.Canvas.Brush.Style := bsSolid; bmp.Canvas.FillRect(Rect(0,0,bmp.Width,bmp.Height)); bmp.Canvas.Font.Color := Color; //clBlack; //Color; bmp.Canvas.TextOut(2,0,Text); Canvas.CopyMode := SRCINVERT; //GTestCopyMode; //SRCINVERT; Canvas.Draw(x,y,bmp); bmp.Free; Canvas.CopyMode := SRCCOPY; end; procedure TraceTextDrawPt(p1, p2, xp: TDoublePoint; const aTextPrefix: String=''; aShowZero: Boolean=true; aWithBrush: Boolean=false); var Len: Double; Text: String; z:Double; Color, bcolor: TColor; begin Len := Pcad.GetLineLengthM(p1, p2); //GetLineLenght(p1, p2) / 1000 * Pcad.MapScale; if Not CmpFloatByPrecision(Len, 0, 3) or aShowZero then begin Text := FormatFloat(ffMask, MetreToUOM(Len)) + GetUOMString(GCurrProjUnitOfMeasure); z := 0; Pcad.Dengine.ConvertCoord(xp.x, xp.y,z); Color := clLime; bcolor := clBlack; Pcad.DEngine.Canvas.pen.mode := pmXor; if aWithBrush then begin Color := clBlack; bcolor := clSilver; Pcad.DEngine.Canvas.pen.mode := pmCopy; end; CADDrawTraceText(Round(xp.x),Round(xp.y), color, bcolor, aTextPrefix + Text, 'Arial', 8, Pcad.Dengine.Canvas); end; end; procedure TraceTextDraw(p1, p2: TDoublePoint; const aTextPrefix: String=''; aShowZero: Boolean=true; aWithBrush: Boolean=false); var xp: TDoublePoint; begin // смещаем влево p1.x := p1.x + 1; p2.x := p2.x + 1; xp := MPoint(p1, p2); TraceTextDrawPt(p1, p2, xp, aTextPrefix, aShowZero, aWithBrush); end; {procedure TraceTextDrawOld(p1, p2: TDoublePoint; const aTextPrefix: String=''; aShowZero: Boolean=true; aWithBrush: Boolean=false); var Len: Double; xp: TDoublePoint; Text: String; z:Double; Color, bcolor: TColor; begin // смещаем влево p1.x := p1.x + 1; p2.x := p2.x + 1; Len := GetLineLenght(p1, p2) / 1000 * Pcad.MapScale; if Not CmpFloatByPrecision(Len, 0, 3) or aShowZero then begin Text := FormatFloat(ffMask, MetreToUOM(Len)) + GetUOMString(GCurrProjUnitOfMeasure); xp := MPoint(p1, p2); //ang := GetRadOfLine(p1, p2); //if EQD(ang , pi) then // ang := 0; //if EQD(ang, 3 * pi / 2) then // ang := pi / 2; //Pcad.DEngine.Canvas.pen.mode := pmXor; //Pcad.DEngine.DrawCenteredText(xp, clLime, Text, 'Arial', 8, ang); //DEngine.DrawCenteredText(xp, clBlack, Info, 'Verdana', 2.5, ang); //Pcad.Dengine.TraceText(xp, clLime, aTextPrefix + Text, 'Arial', 8); z := 0; Pcad.Dengine.ConvertCoord(xp.x,xp.y,z); Color := clLime; bcolor := clBlack; Pcad.DEngine.Canvas.pen.mode := pmXor; if aWithBrush then begin Color := clBlack; bcolor := clSilver; Pcad.DEngine.Canvas.pen.mode := pmCopy; end; CADDrawTraceText(Round(xp.x),Round(xp.y), color, bcolor, aTextPrefix + Text, 'Arial', 8, Pcad.Dengine.Canvas); end; end;} begin //if DragState <> dsMove then begin if Figure.ClassName = TLine.ClassName then TraceTextDraw(Figure.ap1, Figure.ap2) else if Figure.ClassName = TRectangle.ClassName then begin TraceTextDraw(Figure.ap1, Figure.ap2); TraceTextDraw(Figure.ap2, Figure.ap3); end else if Figure.ClassName = TCircle.ClassName then begin p := Figure.ap1; p.x := p.x - 4; // чучть смещаем чтобы текст сдвигался к средине TraceTextDraw(p, DoublePoint(p.x + TCircle(Figure).radius, p.y), cCadClasses_Mes33+' '); end else if Figure.ClassName = TEllipse.ClassName then begin p := Figure.ap1; p.x := p.x - 4; // чучть смещаем чтобы текст сдвигался к средине TraceTextDraw(p, DoublePoint(p.x + TEllipse(Figure).alen, p.y), cCadClasses_Mes33+'1 '); TraceTextDraw(p, DoublePoint(p.x, p.y + TEllipse(Figure).blen), cCadClasses_Mes33+'2 '); end else if Figure.ClassName = TArc.ClassName then begin p := Figure.ap1; p.x := p.x - 4; // чучть смещаем чтобы текст сдвигался к средине TraceTextDraw(p, DoublePoint(p.x + TArc(Figure).radius, p.y), cCadClasses_Mes33+' '); // длина между точками дуги TraceTextDraw(TArc(Figure).actualpoints[2], TArc(Figure).actualpoints[3], '', false); end else if Figure.ClassName = TElpArc.ClassName then begin p := Figure.ap1; p.x := p.x - 4; // чучть смещаем чтобы текст сдвигался к средине TraceTextDraw(p, DoublePoint(p.x + TElpArc(Figure).alen, p.y), cCadClasses_Mes33+'1 '); TraceTextDraw(p, DoublePoint(p.x, p.y + TElpArc(Figure).blen), cCadClasses_Mes33+'2 '); // длина между точками дуги TraceTextDraw(TElpArc(Figure).actualpoints[2], TElpArc(Figure).actualpoints[3], '', false); end; if DragState = dsNone then begin if Figure.ClassName = TOrthoLine.ClassName then TraceTextDraw(Figure.ap1, Figure.ap2) else if Figure.ClassName = TPolyline.ClassName then begin PolySeg := nil; if TPolyline(Figure).Segments.Count > 0 then PolySeg := TPlSegment(TPolyline(Figure).Segments[TPolyline(Figure).Segments.Count - 1]); if PolySeg <> nil then begin if Figure.PointCount > 1 then TraceTextDraw(Figure.actualpoints[Figure.PointCount-1], Figure.actualpoints[Figure.PointCount]); if PolySeg.SType = sArc then begin TraceTextDraw(PolySeg.CPoint1, PolySeg.Cpoint2); end; end; end; end; end; if DragState = dsMove then begin //FRect := Figure.GetBoundRect; //p := DoublePoint(FRect.Left, FRect.Top); //TraceTextDraw(p, DoublePoint(p.x + (FCurrX-DragStartX+dragDeltaX), p.y + (FCurrY-DragStartY+dragDeltaY))); //TraceTextDraw(p, DoublePoint(p.x - (DragStartX+dragDeltaX - FCurrX), p.y - (DragStartY+dragDeltaY - FCurrY))); //TraceTextDraw(DoublePoint(DragStartX, DragStartY), Doublepoint(FCurrX, FCurrY)); if PCad.Selection.Count = 1 then begin //TraceTextDraw(Figure.ActualPoints[1], TFigure(PCad.Selection[0]).ActualPoints[1], cCadClasses_Mes34+' ', true, true); pIdx := 0; MinDist := -1; CADTraceFigure := Figure; CADFigure := TFigure(PCad.Selection[0]); {if PCad.Selection.Count = 1 then CADFigure := TFigure(PCad.Selection[0]) else CADFigure := GetFigureByOrign(PCad.Selection);} FigurePointCount := CADTraceFigure.PointCount; // если попытка переместить TNet, то не выводим инфу if (Figure.ClassName = TPathTrace.ClassName) or (CADFigure.ClassName = TNet.ClassName) then FigurePointCount := 0 else if (Figure.ClassName = TConnectorObject.ClassName) and (Figure.ClassName = CADFigure.ClassName) then begin //CADTraceFigure := TConnectorObject(Figure).DrawFigure; //CADFigure := TConnectorObject(PCad.Selection[0]).DrawFigure; FigurePointCount := 4; end; if FigurePointCount > 0 then begin for i := 1 to FigurePointCount do begin pDist := GetLineLenght(CADTraceFigure.ActualPoints[i], DoublePoint(0,0)); if (MinDist = -1) or (pDist < MinDist) then begin MinDist := pDist; pIdx := i; end; end; //p := CADTraceFigure.ActualPoints[pIdx]; //MPoint(CADTraceFigure.ActualPoints[1], TFigure(PCad.Selection[0]).ActualPoints[1], 5); //p.y := p.y - 5; FRect := CADTraceFigure.GetBoundRect; p := DoublePoint(FRect.Left, FRect.Top-5); //TraceTextDraw(CADTraceFigure.ActualPoints[1], p, cCadClasses_Mes34+' ', true, true); TraceTextDrawPt(CADTraceFigure.ActualPoints[pIdx], CADFigure.ActualPoints[pIdx], p, cCadClasses_Mes34+' ', false, true); end; end; end; end; procedure TF_CAD.PCadFigureEdit(Sender: TObject; Figure: TFigure; DeltaX: double = -999999; DeltaY: double = -999999); var ObjProps: TSCSComponent; ObjOldProps: TSCSComponent; EnterStr: String; Res: Boolean; p1Idx, p2Idx: Integer; FloatOldVal, FloatNewVal: Double; i: Integer; PName: String; begin TPowerCad(Sender).OnFigureEdit := nil; try Res := true; ObjProps := nil; ObjOldProps := nil; if Figure.ClassName = TRectangle.ClassName then begin {ObjProps := TSCSComponent.Create(F_ProjMan); //ObjProps.AddSimpleProperty(pnLength, cArchParams_Msg01, FloatToStr(GetLineLength(Figure.ap1, Figure.ap2) / 1000 * PCad.MapScale), dtFloat); //ObjProps.AddSimpleProperty(pnWidth, cArchParams_Msg02, FloatToStr(GetLineLength(Figure.ap2, Figure.ap3) / 1000 * PCad.MapScale), dtFloat); ObjProps.AddSimpleProperty(pnLength, cArchParams_Msg01, FloatToStr(GetLineLength(Figure.ap1, Figure.ap2)), dtFloat); ObjProps.AddSimpleProperty(pnWidth, cArchParams_Msg02, FloatToStr(GetLineLength(Figure.ap2, Figure.ap3)), dtFloat);} F_BlockParams.Execute(Figure, false, false, cDrawObjects_Mes14); end else if Figure.ClassName = TEllipse.ClassName then begin ObjProps := TSCSComponent.Create(F_ProjMan); ObjProps.AddSimpleProperty(pnLength, cCadClasses_Mes33+' 1', FloatToStr(TEllipse(Figure).alen), dtFloat); ObjProps.AddSimpleProperty(pnWidth, cCadClasses_Mes33+' 2', FloatToStr(TEllipse(Figure).blen), dtFloat); end else if Figure.ClassName = TElpArc.ClassName then begin ObjProps := TSCSComponent.Create(F_ProjMan); ObjProps.AddSimpleProperty(pnLength, cDrawObjects_Mes15_1+' 1', FloatToStr(TElpArc(Figure).alen), dtFloat); ObjProps.AddSimpleProperty(pnWidth, cDrawObjects_Mes15_1+' 2', FloatToStr(TElpArc(Figure).blen), dtFloat); end; if ObjProps = nil then begin if Figure.ClassName = Tline.ClassName then begin //ObjProps := TSCSComponent.Create(F_ProjMan); //ObjProps.AddSimpleProperty(pnLength, cCadClasses_Mes4, , dtFloat); FloatOldVal := GetLineLength(Figure.ap1, Figure.ap2); //EnterStr := FloatToStr(RoundX(MetreToUOM(FloatOldVal / 1000 * PCad.MapScale), 4)); //if InputQuery(cDrawObjects_Mes13_1, cDrawObjects_Mes13_2+ ', '+GetNameUOM(GCurrProjUnitOfMeasure, true), EnterStr) then //begin // FloatNewVal := UOMToMetre(StrToFloat_My(EnterStr))*1000/PCad.MapScale; if F_DimLineDialog.Execute(cDrawObjects_Mes13_1, cDrawObjects_Mes13_2, FloatOldVal / 1000 * PCad.MapScale) then begin FloatNewVal := F_DimLineDialog.ResValM * 1000/PCad.MapScale; p1Idx := 1; p2Idx := 2; // Если вторая точка ближе к началу координат if GetLineLength(Figure.ActualPoints[2], Doublepoint(0,0)) < GetLineLength(Figure.ActualPoints[1], Doublepoint(0,0)) then begin p1Idx := 2; p2Idx := 1; end; Figure.ActualPoints[p2Idx] := MPoint(Figure.ActualPoints[p2Idx], Figure.ActualPoints[p1Idx], -1*(FloatNewVal-FloatOldVal)); Res := true; end; end else if Figure.ClassName = TCircle.ClassName then begin FloatOldVal := TCircle(Figure).Radius; if F_DimLineDialog.Execute(cDrawObjects_Mes1, cDrawObjects_Mes2, FloatOldVal / 1000 * PCad.MapScale) then begin FloatNewVal := F_DimLineDialog.ResValM * 1000/PCad.MapScale; if FloatNewVal < 0 then FloatNewVal := 0; TCircle(Figure).Radius := FloatNewVal; Res := true; end; end else if Figure.ClassName = TArc.ClassName then begin FloatOldVal := TArc(Figure).Radius; if F_DimLineDialog.Execute(cDrawObjects_Mes15_1, cDrawObjects_Mes15_2, FloatOldVal / 1000 * PCad.MapScale) then begin FloatNewVal := F_DimLineDialog.ResValM * 1000/PCad.MapScale; if FloatNewVal < 0 then FloatNewVal := 0; TArc(Figure).Radius := FloatNewVal; Res := true; end; end else Res := Figure.Edit; end else begin ObjOldProps := TSCSComponent.Create(F_ProjMan); ObjOldProps.AssignProperties(ObjProps.Properties); // From Cad To Metr for i := 0 to ObjProps.Properties.Count - 1 do begin PName := PProperty(ObjProps.Properties[i])^.SysName; ObjProps.SetPropertyValueAsFloat(PName, Round3(ObjProps.GetPropertyValueAsFloat(PName) / 1000 * PCad.MapScale)); end; if EditObjectProps(F_ProjMan, ObjProps, false) then begin // From Metr To Cad for i := 0 to ObjProps.Properties.Count - 1 do begin PName := PProperty(ObjProps.Properties[i])^.SysName; ObjProps.SetPropertyValueAsFloat(PName, ObjProps.GetPropertyValueAsFloat(PName) * 1000/PCad.MapScale); end; {if Figure.ClassName = TRectangle.ClassName then begin // размер по длине FloatOldVal := ObjOldProps.GetPropertyValueAsFloat(pnLength); FloatNewVal := ObjProps.GetPropertyValueAsFloat(pnLength); Figure.ActualPoints[2] := MPoint(Figure.ActualPoints[2], Figure.ActualPoints[1], -1*(FloatNewVal-FloatOldVal)); Figure.ActualPoints[3] := MPoint(Figure.ActualPoints[3], Figure.ActualPoints[4], -1*(FloatNewVal-FloatOldVal)); // размер по ширине FloatOldVal := ObjOldProps.GetPropertyValueAsFloat(pnWidth); FloatNewVal := ObjProps.GetPropertyValueAsFloat(pnWidth); Figure.ActualPoints[4] := MPoint(Figure.ActualPoints[4], Figure.ActualPoints[1], -1*(FloatNewVal-FloatOldVal)); Figure.ActualPoints[3] := MPoint(Figure.ActualPoints[3], Figure.ActualPoints[2], -1*(FloatNewVal-FloatOldVal)); end;} if Figure.ClassName = TEllipse.ClassName then begin TEllipse(Figure).alen := ObjProps.GetPropertyValueAsFloat(pnLength); TEllipse(Figure).blen := ObjProps.GetPropertyValueAsFloat(pnWidth); end else if Figure.ClassName = TElpArc.ClassName then begin TElpArc(Figure).alen := ObjProps.GetPropertyValueAsFloat(pnLength); TElpArc(Figure).blen := ObjProps.GetPropertyValueAsFloat(pnWidth); end; end; FreeAndNil(ObjProps); FreeAndNil(ObjOldProps); end; if Res then TPowerCad(Sender).Refresh; finally TPowerCad(Sender).OnFigureEdit := PCadFigureEdit; end; end; procedure TF_CAD.FormCanResize(Sender: TObject; var NewWidth, NewHeight: Integer; var Resize: Boolean); begin // end; {$IF Defined(SCS_PE)} {$I ToolBar.pas} {$IFEND} procedure TF_CAD.PopupMenuDisconectedPopup(Sender: TObject); begin // F_ProjMan.Act_ConnectedConCompons.; end; procedure TF_CAD.TimerDblClkTimer(Sender: TObject); begin if not TimerDblClk.Enabled then exit; TimerDblClk.Enabled := False; if PCad.ToolIdx <> toSelect then begin FSCS_Main.tbSelectExpert.Down := True; FSCS_Main.tbSelectNoob.Down := True; FSCS_Main.tbPanExpert.Down := False; FSCS_Main.tbPanNoob.Down := False; FSCS_Main.aToolSelect.Execute; end else begin FSCS_Main.tbSelectExpert.Down := False; FSCS_Main.tbSelectNoob.Down := False; FSCS_Main.tbPanExpert.Down := True; FSCS_Main.tbPanNoob.Down := True; FSCS_Main.aToolPan.Execute; end; end; end.