admin/expertcad
1
0
Fork 0
mirror of http://gitlab.expertsoft.com.ua/git/expertcad synced 2026-01-12 00:45:40 +02:00
Code Issues Packages Projects Releases Wiki Activity
expertcad/SRC/Main/U_CAD__.pas
ShevaIV 00e2ad8635 initial commit
2025-05-12 10:07:51 +03:00

11345 lines
407 KiB
ObjectPascal
Raw Blame History

//{$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) or Defined(SCS_PANDUIT)}
{$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);
procedure PCadSurfaceLeave(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;
//Tolik
OnceRefresh : boolean;
CreateOnClick: Boolean;
//
// óñòàíîâêà òåêóùåãî ñëîÿ
procedure SetCurrentLayer(ALNbr: Integer);
// ïðè âûçîâå êîíòåêñòíîãî ìåíþ íà ÊÀÄå
procedure FormCADPopupMenu(X, Y: Double; aAllowSelectInPM: Boolean);
// Óñòàíîâêà ïóíêòîâ ìåíþ äëÿ êîíòåêñòíîãî ìåíþ Òðàññû
procedure SetMenuItemsForOrthoLine(aLine: TOrthoLine);
// Óñòàíîâêà ïóíêòîâ ìåíþ äëÿ êîíòåêñòíîãî ìåíþ êîííåêòîðà
procedure SetMenuItemsForConnector(aConn: TConnectorObject);
// Óñòàíîâêà ïóíêòîâ ìåíþ äëÿ êîíòåêñòíîãî ìåíþ Îáúåêòà
procedure SetMenuItemsForObject(aObject: TConnectorObject);
//D0000006113
//Îòìåíà âûäåëåíèèÿ îáúåêòà ðàìêîé
procedure UnSnapFigure;
//Çàïèñü äàííûõ â ïåðåìåííóþ FCreateObjectOnClick
procedure WriteOnClickParam(Const Value: Boolean);
//Tolik
procedure NewWndProc(var Message: TMessage);
protected
FClickSCSFiguresList: TList; //21.06.2013 - Ñïèñîê îáúåêòîâ ïîä êóðñîðîì íà êëèêå
// FFiguresDelManual: TList; //02.08.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 }
FFiguresDelManual: TList; //02.08.2013 - ÎÁÚÅÊÒÛ ÓÄÀËßÅÌÛÉ ÂÐÓ×ÍÓÞ ÏÎËÜÇÎÂÀÒÅËÅÌ
// Tolik
InGUIEvent: Boolean;
GIsEventWaiting: Boolean;
//
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;
FCheckedFigures: TList;
FNeedUpdateCheckedFigures: boolean;
// ôëàã, ìîæíî ñåé÷àñ äåëàòü ñëåïîê
FCanSaveForUndo: Boolean;
FUndoCount: Integer; //10.09.2010
// äèðåêòîðèÿ äëÿ ñîõðàíåíèÿ ñëåïêà
FUndoDir: string;
FRedoDir: string;
// ëèñò ÑÊÑ îáúåêòîâ äëÿ ïîäíÿòèÿ ñî Ñòðèìà
FUndoFiguresList: TList;
// ñòàòóñ - ïîäíèìàòü ñ ëèñòà FUndoFiguresList
FUndoStatus: Boolean;
// òåêóùåå êîë-âî àêòèâíûõ äåéñòâèé íà ÊÀÄå
FActiveActions: LongInt;
// êîë-âî äåéñòâèé ïîñëå êîòîðûõ ñëåäóåò äåëàòü ñëåïîê
FSaveUndoCount: Integer;
FWasDeleteQuery: Boolean;
FDeleteOnlyUnuseRaisers: Boolean;
FActiveHouse: THouse;
FSCSFigures: TRapObjectList; //04.11.2011
FSCSFiguresLockCount: Integer; //07.11.2011
FPopupScrPoint: TPoint;//04.05.2012
FContinueTrace: boolean;
// Added by Tolik
// ôëàæîê äëÿ îòìåòêè óäàëåíèÿ/íå óäàëåíèÿ ñïóñêîâ-ïîäúåìîâ
// èç ñïèñêà âûäåëåííûõ îáúåêòîâ
// íóæåí ïðè ïåðåñ÷åòå äëèíû âûáðàííûõ òðàññ
FDeselectUpDown : boolean;
//Äëÿ îïðåäåëåíèÿ, íóæíî ëè ïåðåðèñîâûâàòü êàä èëè íåò ïðè äâèæåíèè
XOld,YOld: Double;
CadMove: Boolean;
DownPoints: TDoublePOint;
CanChangeDownCoord: Boolean; //Îòâå÷àåò çà âîçìîæíîñòü èçìåíåíèÿ êîîðäèíàò ïðè ìàóñäàóíå,÷òîá êàêà íå ïîëó÷èëàñü
//23/10/2015
// ôëàæêè âûïîëíåíèÿ ñîáûòèÿ íà ÊÀÄå â òåêóùèé ìîìåíò (íóæíî îïðåäåëÿòü ñîñòîÿíèå ïðè ïîïûòêå
// âûïîëíåíèÿ ñîáûòèÿ, ÷òîáû ñîáûòèÿ íå ïåðåêðûâàëèñü)
// ñîáûòèÿ êëàâèàòóðû
GisKeyDown: Boolean;
GisKeyPress: Boolean;
// ñîáûòèÿ ìûøè
GisMouseDown: Boolean;
GisMouseMove: Boolean;
//06/11/2015
GisDivideLine: Boolean; // true - èäåò ðàçäåëåíèå ëèíèè. Áóäåò þçàòüñÿ ïðè ðàçäåëåíèè ëèíèè, ÷òîáû ïîíèìàòü,
// íóæíà ëè ïîëíàÿ/÷àñòè÷íàÿ ÷èñòêà èíòåðôåéñîâ ïîñëå îïåðàöèè êîïèðîâàíèÿ êîìïîíåíòîâ
//
GisAction: Boolean;
//
property DeselectUpDown : boolean read FDeselectUpDown write FDeselectUpDown default false;
property FCreateObjectOnClick: Boolean read CreateOnClick write WriteOnClickParam; // Àâòîñîçäàâàòü îáúåêòû ïðè êëèêå ìûøêîé
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
procedure UpdateCheckedFigures(aCheckUpdateCount: boolean = True);
// === 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; aOnDropRoute: TFigure = nil; aTraceOnEntireRoute: boolean = False);
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;
procedure SelectTracesAndRaisers;
procedure SelectTraces;
procedure InvertSCSSelection;
procedure InvertAllSelection;
procedure DrawGuidesOnDrop(X,Y: Double);
Procedure ShowHintIFFigInsideCab(X,Y: Double);
procedure FullEndUpdateCad;
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) or Defined(SCS_PANDUIT)}
{$I ToolBarType2.pas}
{$IFEND}
var
F_CAD: TF_CAD;
GBeginPoint: TDoublePoint; // òî÷êà íà÷àëà ëèíèè, ïðè ïîâîðîòå ëèíèè ïîçâîëÿåò àâòîâû÷èñëÿòü óãîë ïîâîðîòà
GTracedFigure: boolean = False; // òàùóò ëè ñåé÷àñ êàêîé òî îáúåêò
GListNode: TTreeNode = nil; // äëÿ ÌÏ - òåêóùàÿ âåòâü â êîòîðóþ êîïèðóåòñÿ îáúåêò (õç ñèëüíî ëè îíî ùàñ íàäî)
// Tolik
// ôëàæîê ðóæåí äëÿ îïðåäåëåíèÿ Ñ/Ï íà êîííåêòîðå, êîãäà äðîï ïðîèñõîäèò, äîïóñòèì íå íå ÊÀÄå, à â ìåðåæäåðå ïðîåêòîâ
// ïðè ïåðåìåùåíèè îáúåêòà â îáúåêò (ñðàáîòàåò DoDragDrop)/ Çàâÿçàíî â ìàñòåðå àâòîòðàññèðîâêè, êîâûðÿòü àêêóðàòíî!!!
GDragOnCAD: Boolean = False;
//
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, U_AutoTraceType, U_AutoTraceConnectOrder,
U_Progress;
{$R *.dfm}
procedure TF_CAD.FormCreate(Sender: TObject);
var
CrLayer: TLayer;
i: integer;
//08.09.2011 Buffer: array[0..1023] of Char;
begin
try
// Tolik
InGUIEvent := False;
GisEventWaiting := False;
//
CanChangeDownCoord := true;
FContinueTrace := False;
FSCSFigures := TRapObjectList.Create(false, false);
FSCSFiguresLockCount := 0;
FClickSCSFiguresList := TList.Create;
FFiguresDelManual := TList.Create; //02.08.2013
//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;
//Tolik
if SCSEngine = nil then
SCSEngine := TSCSEngine.Create(self);
// ñîáûòèÿ êëàâèàòóðû
GisKeyDown := False;
GisKeyPress := False;
// ñîáûòèÿ ìûøè
GisMouseDown := False;
GisMouseMove := False;
//
GisDivideLine := False;
//
GisAction := False;
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;
FCheckedFigures := TList.Create;
FNeedUpdateCheckedFigures := True;
//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) or Defined(SCS_PANDUIT)}
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}
if GReadOnlyMode then
begin
PCad.OnSurfaceDragOver := nil;
PCad.OnSurfaceDragDrop := nil;
end;
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
// Tolik -- 21//12/2015 -- íà çàêðûòèè ïðèëîæåíèÿ ôèãóðû ñ ëèñòîâ ìîæíî
// íå óäàëÿòü, ÷òîáû çàêðûëñÿ ñðàçó, à òî íà áîëüøèõ ïðîåêòàõ áóäåò âèñåòü,
// ïîêà âñå íå ïîóäàëÿåò -- íàõ íå íóæíî
//ClearFiguresOnListDelete(Self);
if Not GExitProg then
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;
//Tolik
if FActiveNet <> nil then
begin
FActiveNet := nil;
end;
if Assigned(FFrameObjects) then
begin
//FFrameObjects.Clear;
FreeAndNil(FFrameObjects);
end;
//GTempJoinedOrtholinesList.Clear;
{ if Assigned(GTempJoinedOrtholinesList) then
GTempJoinedOrtholinesList.Clear;
//GTempJoinedConnectorsList.Clear;
if Assigned(GTempJoinedConnectorsList) then
GTempJoinedConnectorsList.Clear;
//GTempJoinedLinesConnectors.Clear;
if Assigned(GTempJoinedLinesConnectors) then
GTempJoinedLinesConnectors.Clear;
//GSnapFiguresList.Clear;
if Assigned(GSnapFiguresList) then
GSnapFiguresList.Clear;
}
if Assigned(FTracingList) then
FreeAndNil(FTracingList);
if Assigned(FCheckedFigures) then
begin
//FCheckedFigures.Clear;
FreeAndNil(FCheckedFigures);
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;
ModListTmp: TList;
k: integer;
ModExist: boolean;
DropPoints: TDoublePoint;
begin
try
GCurrMousePos.x := X;
GCurrMousePos.y := Y;
//30.06.2010
FCurrX := X;
FCurrY := Y;
//Ðèñóåì ðàìêó îáúåêòîâ Ìèòÿé Ä. 04.02.2014ã.
if GCadForm.FCreateObjectOnClick then
begin
if (PCad.SnapToGrids)or(PCad.SnapToGuides) then
DropPoints := GetCoordsWithSnapToGrid(X, Y)
else
DropPoints := DoublePoint(X,Y);
// if (abs(XOld - X)> 0)or(abs(YOld - Y)> 0) then
begin
if Not Assigned(GShadowObject) then
CreateShadowObject;
GIsDrawShadow := True;
GShadowObject.ShadowCP.x := DropPoints.x;
GShadowObject.ShadowCP.y := DropPoints.y;
GShadowObject.draw(PCad.DEngine, False);
RefreshCAD(PCad);
end;
XOld := X; YOld := Y;
end;
//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
if Not PCAD.IsDragging then
begin
ModListTmp := TList.Create;
TOrthoLine(FigureOnMove).GetModPoints(ModListTmp);
for k := 0 to ModListTmp.Count - 1 do
begin
if TModPoint(ModListTmp.Items[k]).IsPointIn(x, y, 0.3) then
begin
ModExist := True;
PCad.SetCursor(crHandPoint);
break;
end;
end;
for k := 0 to ModListTmp.Count - 1 do
begin
PCad.UnRegisterModPoint(ModListTmp.Items[k]);
end;
ModListTmp.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;
//D0000006113
//=============01.11.2013 ñàìûêîâ===================
{ IGOR Óæå íå íóæíî - ðåôðåø äåëàåòñÿ ïðè ñíÿòèè ôëàæêà isSnap
if GFigureTraceTo=nil then
GPrevFigureTraceTo:=nil;
PCad.Refresh;
}
//=============01.11.2013 ñàìûêîâ===================
end;
if GFigureTraceTo <> nil then
begin
if CheckFigureByClassName(GFigureTraceTo, cTConnectorObject) then
begin //âûäåëåíèå îáúåêòà ðàìêîé
TConnectorObject(GFigureTraceTo).isSnap := true;
//Ýòà ðèñîâàëêà íå íóæíà, ïîòîìó êàê ïðè çàïèñè ñâîéñòâà isSnap
//Âûïîëíÿåòñÿ ðèñîâàíèå
//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;
{*****************************************}
//Êóñîê âûïîëíÿåòñÿ ïðè çàæàòîé êëàâèøå ALT
// Ðåæèì òðåéñà è íåò ðåæèìà ïðèâÿçêè, óáðàòü âûäåëåíèå ñ ïðåäûäóùèõ âûäåëåííûõ
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;
if (DragState = dsPan) then
begin
//if GIsMousePressed then
begin
// 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;
SelectedList: TList;
k: integer;
aNeedRaiserDel: boolean;
RaisersSelected: boolean;
//Tolik
SCSCatalog : TSCSCatalog;
l: integer;
FigClassName: string;
//
begin
FigClassName := '';
FigClassName := Figure.ClassName;
try
if CheckFigureByClassName(Figure, cTRichTextMod) or CheckFigureByClassName(Figure, cTFigureGrpMod) or
CheckFigureByClassName(Figure, cTFigureGrpNotMod) or CheckFigureByClassName(Figure, cTCabinetNumber) then
begin
if Not Figure.LayerHandle = LongInt(PCad.Layers[1]) then
begin
CanDelete := False;
Exit;
end;
end;
if GShadowObject = figure then
begin
CanDelete := False;
Exit;
end;
if not ((Figure is TFigureGrp) and (GAutoDelete)) then
begin
if not FWasDeleteQuery then
begin
mess := cCad_Mes11;
FDeleteOnlyUnuseRaisers := False;
if MessageBox(FSCS_Main.Handle, PAnsiChar(mess), cCad_Mes12, MB_YESNO) = IDYes then
begin
GCanDeleteFigures := True;
FWasDeleteQuery := True;
mess := cCad_Mes11_1;
RaisersSelected := False;
for k := 0 to PCad.Selection.Count - 1 do
begin
if Assigned(TFigure(PCad.Selection[k])) then
begin
//Tolik
{ SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TFigure(PCad.Selection[k]).ID);
if SCSCatalog <> nil then
begin
for l := 0 to SCSCatalog.ComponentReferences.Count -1 do
begin
SCSCatalog.ComponentReferences[l].ServToDelete := true;
SCSCatalog.ComponentReferences[l].ApplyChanges;
end;
end;
//}
if CheckFigureByClassName(TFigure(PCad.Selection[k]), cTOrthoLine) then
begin
if TOrthoLine(TFigure(PCad.Selection[k])).FIsRaiseUpDown then
begin
RaisersSelected := True;
break;
end;
end;
end;
end;
if RaisersSelected then
begin
if MessageBox(FSCS_Main.Handle, PAnsiChar(mess), cCad_Mes12, MB_YESNO) = IDYes then
FDeleteOnlyUnuseRaisers := True;
end
else
FDeleteOnlyUnuseRaisers := True;
end
else
begin
GCanDeleteFigures := False;
FWasDeleteQuery := True;
end;
end;
end
else
GCanDeleteFigures := True;
if GCanDeleteFigures then
begin
FFiguresDelManual.Add(Figure); //02.08.2013
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
SelectedList := TList.Create;
for k := 0 to PCad.Selection.Count - 1 do
begin
if PCad.Selection[k] <> Figure then
SelectedList.Add(PCad.Selection[k]);
end;
aNeedRaiserDel := True;
if FDeleteOnlyUnuseRaisers then
begin
if isRaiseEmptyAndNotNeed(TOrthoLine(Figure)) then
begin
aNeedRaiserDel := True;
end
else
begin
aNeedRaiserDel := False;
end
end;
if aNeedRaiserDel then
begin
if ObjFromRaise.ConnectorType = ct_Clear then
DestroyRaiseOnConnector(ObjFromRaise)
else
DestroyRaiseOnPointObject(ObjFromRaise);
for k := 0 to SelectedList.Count - 1 do
begin
if Assigned(SelectedList[k]) then
if Not TFigure(SelectedList[k]).Deleted then
TFigure(SelectedList[k]).Select;
end;
if SelectedList.Count > 0 then
begin
PCad.ResetRemoveSelection := True;
end;
PCad.RefreshSelection;
end
else
begin
Figure.Selected := False;
PCad.RefreshSelection;
end;
if SelectedList.Count > 0 then
begin
FWasDeleteQuery := True;
FCanSaveForUndo := False;
end;
SelectedList.Clear;
FreeAndNil(SelectedList);
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
GisKeyDown := True;
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
//Tolik
try
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
//D0000006113
UnSnapFigure; //30.10.2013 ñàìûêîâ
// åñëè ìóâàåòñÿ îáúåêò
if Pcad.IsDragging then
begin
PCad.CancelActions;
if GLastConnector <> nil then
begin
GLastConnector.SkipConnectedLinesDrawShadow;
end;
RefreshCAD(PCad);
end
else
// èäåò ñîçäàíèå òðàññû
// Tolik 18/11/2015 -- åñëè GClickIndex = 1, ýòî çíà÷èò, ÷òî âòîðîé êîíåö òðàññû ïîëüçîâàòåëåì íå îáîçíà÷åí
// (ïåðåäóìàë è íàæàë ESCape ) -- â òàêîì ñëó÷àå íå÷åãî ñîçäàâàòü
// if (PCad.ToolInfo = 'TOrthoLine') and (PCad.TraceFigure <> nil) then
begin
if (PCad.ToolInfo = 'TOrthoLine') and (PCad.TraceFigure <> nil) and (GClickIndex > 1) 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;
if PCad.TraceFigure <> nil then
PCad.KillTraceFig;
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;
finally
// Tolik
GisKeyDown := False;
// åñëè îòæàòà íå Shift, Alt èëè Control, òî âûçûâàåì EventEngine
// âäðóã áûëî óäàëåíèå, òî îí ïî÷èñòèò FRemFigures è, ïðè íåîáõîäèìîñòè,
// âûïîëíèò óäàëåíèå ôèãóð
if not (Key in [VK_SHIFT, VK_CONTROL, VK_MENU]) then
PCad.EventEngine(95,1,'',0);
//
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
// Tolik 23/10/2015
GisMouseDown := True;
//
try
if not PCad.Focused then
begin
if PCad.ToolIdx = toSelect then
begin
SendMessage(Self.Handle, WM_ACTIVATE, MakewParam(WA_ACTIVE, 0), 0);
SendMessage(Self.Handle, WM_SETFOCUS, 0, 0);
end;
end;
if (CanChangeDownCoord)and(Button = mbLeft)and(FCreateObjectOnClick) then
begin
DownPoints.x := X;
DownPoints.y := Y;
CanChangeDownCoord := false;
end;
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, False, InsertedObject);
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, False, InsertedObject);
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 PCad.ToolInfo <> 'TOrthoLine' then
begin
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;
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 PCad.ToolInfo <> 'TOrthoLine' 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;
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;
if GReadOnlyMode then
begin
//PCad.Enable := False;
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);
// Tolik -- 30/11/2015 -- ÷òîáû èçìåíåíèå ïðîåêòà íå ïåðåêðûâàëî îáíîâëåíèå ÊÀÄà ïî òàéìåðó
//RefreshCAD_T(PCad);
//SetProjectChanged(True);
SetProjectChanged(True);
RefreshCAD_T(PCad);
//
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 GCadForm.PCad.SnapToGrids then
DropPoints := GetCoordsWithSnapToGrid(X, Y)
else
DropPoints := DoublePoint(X, Y); }
if (PCad.SnapToGuides)or(PCad.SnapToGrids) then
begin
DropPoints := GetCoordsWithSnapToGrid(X, Y)
end
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;
PortCount: integer;
PartComponent: TSCSComponent;
AList: TSCSList;
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;
CheckFigure := CheckBySCSObjects(X, Y);
DoDragDrop(X, Y);
SetProjectChanged(True);
//*****Ðèñîâàíèå íàïðàâëÿþùèõ ïðè äðîïå ôèãóðû íà ÊÀÄ***********************
//************* Ìèòÿé Ä.Â. ************************************
ShowHintIFFigInsideCab(X, Y);
{$IF Not Defined(ES_GRAPH_SC)}
if CheckFigure <> nil then
begin
if CheckFigure.ClassName = 'TOrthoLine' then
CheckFigure := nil;
end;
if (GDropComponent <> nil) and (GDropComponent.IsLine <> 1) and (GFigureSnap = nil) and (CheckFigure = nil) then
begin
if GDropComponent.Interfaces <> nil then
begin
if GDropComponent.Interfaces.Count = 0 then
GDropComponent.LoadInterfaces(-1, false);
GDropComponent.LoadChildComplectsQuick(true, false, true, GDropComponent.IDTopComponent, GDropComponent.IDCompRel);
//PortCount := GetPortsCountReadyToConnectByInterf(GDropComponent, 0, true);
PortCount := GetPortsCount(GDropComponent, 0, true);
if (PortCount < 10) and (PortCount > 0) then
DrawGuidesOnDrop(X, Y)
end;
end;
{$IFEND}
if CheckFigure <> nil then
CheckFigure := nil;
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
try
if (Button = mbMiddle) and (PCad.ToolIdx = TPCTool(toFigure)) then
exit;
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;
// ïîêàç äëèííû îòðåçêà òðàññû (old)
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;
finally
GisMouseDown := False;
end;
end;
procedure TF_CAD.PCadSurfaceDblClick(Sender: TObject);
var
i: integer;
ClickFigure: TFigure;
GlobalClickFigure: TFigure;
GlobalClickFigureTmp: TFigure;
Currline: TOrthoLine;
CheckedFigure: TFigure;
LNbr: Integer;
OldLayer: Integer;
TestLayer: TLayer;
begin
try
if FCreateObjectOnClick then
exit;
if PCad.ToolIdx = TPCTool(toFigure) then
begin
GIsMousePressed := GIsMousePressed;
exit;
end;
GIsMousePressed := False;
if TimerDblClk.Enabled then
exit;
OldLayer := PCad.ActiveLayer;
if PCad.ToolIdx = TPCTool(11) then
begin
TimerDblClk.Enabled := True;
exit;
end;
GlobalClickFigureTmp := nil;
GlobalClickFigure := nil;
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 <> nil then
begin
if GlobalClickFigure is TBlock then
begin
GlobalClickFigureTmp := GlobalClickFigure;
GlobalClickFigure := Nil;
end;
end;
end;
except
GlobalClickFigure := nil;
end;
end
else
GlobalClickFigure := ClickFigure;
if (ClickFigure = nil) and (GlobalClickFigure = nil) and (GlobalClickFigureTmp = nil) then
begin
TimerDblClk.Enabled := True;
exit;
end;
{
if (ClickFigure = nil) and (GlobalClickFigure <> nil) and (GlobalClickFigure.Selected) then
begin
LNbr := GLN(GlobalClickFigure.LayerHandle);
if Lnbr = 1 then
begin
if (Not (GlobalClickFigure is TSCSHDimLine)) and (Not (GlobalClickFigure is TSCSVDimLine)) then
begin
GlobalClickFigure := nil;
TimerDblClk.Enabled := True;
exit;
end;
end;
end;
if (ClickFigure = nil) and (GlobalClickFigure = nil) then
begin
TimerDblClk.Enabled := True;
exit;
end;
}
if (GlobalClickFigure <> nil) and (not GlobalClickFigure.Selected) then
begin
LNbr := GLN(GlobalClickFigure.LayerHandle);
try
TestLayer := Tlayer(PCad.Layers[LNbr]);
// åñëè ýòî ÄÕÔ ñëîé
if TestLayer.IsDxf then
LNbr := 1;
except
end;
{$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 OldLayer = 2 then
begin
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;
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;
IdxManualDel: Integer; //02.08.2013
IsManualDel: Boolean;
aNeedEnd: boolean;
//Tolik
DelIndex: Integer;
WasDel: Boolean;
DelGrpFigure: TFigureGrpMod;
//
begin
if Not InGUIEvent then
begin
InGUIEvent := True;
try
if EventId = 95 then
begin
if ((not GisKeyDown) and (not GisKeyPress) and (not GisMouseDown)) then
begin
if assigned(FRemFigures) and (FRemFigures.Count > 0) and (GTraceStatus = False) (*important!!!*) then
begin
aNeedEnd := False;
if GisProgressCount = 0 then
begin
aNeedEnd := True;
BeginProgress;
end;
try
PCad.OnGUIEvent := nil;
i := 0;
while i < FRemFigures.Count do
begin
FWaitWork := True;
//Application.ProcessMessages;
//02.08.2013
DelFigure := FRemFigures[i];
IdxManualDel := FFiguresDelManual.Remove(DelFigure);
IsManualDel := IdxManualDel <> -1;
if Assigned(FRemFigures[i]) and (TFigure(FRemFigures[i]).ID <> -1) then
begin
try
// óäàëèòü ñâÿçè êîíåêòîðîâ ñ óäàëåííûìè îðòîëèíèÿìè
if CheckFigureByClassName(TFigure(FRemFigures[i]), cTOrthoLine) then
begin
// Tolik
// íàõåð ýòî çäåñü íå íóæíî, ò.ê. âûïîëíèòñÿ íà óäàëåíèè îðòîëèíèè
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, IsManualDel)
// 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, IsManualDel)
// 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
// Tolik
begin
// îáúåêòà Joined1 ìîæåò óæå è íå áûòü, à ñþäà ïîïàäàåì ïðîñòîïî ññûëêå, JoinedOrtholinesList - óæå òîæå
// ìîæåò íå áûòü, ïîýòîìó ñòàâèì ïðîâåðêó
if Joined1.JoinedOrtholinesList <> nil then
begin
//
if Joined1.JoinedOrtholinesList.Count = 0 then
if not Joined1.FIsHouseJoined then
Joined1.Delete(False, False);
end;
end;
//
if Joined2 <> nil then
//Tolik
// òî æå ñàìîå, ÷òî è äëÿ Joined1
if Joined2.JoinedOrtholinesList <> nil then
begin
//
if Joined2.JoinedOrtholinesList.Count = 0 then
if not Joined2.FIsHouseJoined then
Joined2.Delete(False, False);
end;
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;
if aNeedEnd then
EndProgress;
if FRemFigures <> nil then
FRemFigures.Clear;
PCad.OnGUIEvent := PCadGUIEvent;
// if aNeedEnd then
RefreshCAD(PCad);
end;
if F_Navigator <> nil then
RefreshCAD(F_Navigator.PCadNavigator);
end;
if assigned(FRemFigures) and (FRemFigures.Count = 0) and (GTraceStatus = False) (*important!!!*)
and (FFiguresDelManual.Count <> 0) then
FFiguresDelManual.Clear;
// RefreshCAD_T(PCad, true);
GisAction := false;
end
else
GisAction := True;
{
else
begin
if (PCad.UpdateCount = 0) and (assigned(FRemFigures) and (FRemFigures.Count > 0) and (GTraceStatus = False)) (*important!!!*) then
begin
WasDel := false;
for i := FRemFigures.Count - 1 downto 0 do
begin
if Assigned(FRemFigures[i]) and (TFigure(FRemFigures[i]).ID <> -1) then
begin
try
if (CheckFigureByClassName(TFigure(FRemFigures[i]), cTFigureGrpMod)) or (CheckFigureByClassName(TFigure(FRemFigures[i]), cTFigureGrpNotMod)) then
begin
WasDel := True;
break;
end;
except
end;
end;
end;
if WasDel then
begin
aNeedEnd := False;
if PCad.UpdateCount = 0 then
begin
aNeedEnd := True;
end;
PCad.BeginUpdate;
try
//PCad.OnGUIEvent := nil;
for i := FRemFigures.Count - 1 downto 0 do
begin
if Assigned(FRemFigures[i]) and (TFigure(FRemFigures[i]).ID <> -1) then
begin
try
// óäàëèòü ñâÿçè êîíåêòîðîâ ñ óäàëåííûìè îðòîëèíèÿìè
try
if (CheckFigureByClassName(TFigure(FRemFigures[i]), cTFigureGrpMod)) or (CheckFigureByClassName(TFigure(FRemFigures[i]), cTFigureGrpNotMod)) then
begin
FWaitWork := True;
DelGrpFigure := TFigureGrpMod(FRemFigures[i]);
FFiguresDelManual.Remove(DelGrpFigure);
PCad.Figures.Remove(DelGrpFigure);
FRemFigures.Delete(i);
DelGrpFigure.Free;
DelGrpFigure := nil;
end;
except
end;
except
on E: Exception do addExceptionToLogEx('TF_CAD.PCadGUIEvent', E.Message);
end;
end;
end;
finally
FWaitWork := False;
// *UNDO*
//FCanSaveForUndo := True;
FCanSaveForUndo := True;
PCad.EndUpdate(false);
//PCad.OnGUIEvent := PCadGUIEvent;
if aNeedEnd and WasDel then
RefreshCAD(PCad);
end;
if aNeedEnd and WasDel then
if F_Navigator <> nil then
RefreshCAD(F_Navigator.PCadNavigator);
end;
end;
end;
}
GisEventWaiting := False;
end;
except
GisAction := False;
end;
InGUIEvent := False;
end
else
begin
if EventId = 95 then
GisEventWaiting := True;
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;
IdxManualDel: Integer; //02.08.2013
IsManualDel: Boolean;
aNeedEnd: boolean;
//Tolik
DelIndex: Integer;
aNeedRefresh: Boolean;
CanDelFigures: Boolean;
DelGrpFigure: TFigureGrpMod;
//
begin
if EventId = 95 then
begin
//Tolik 23/10/2015
// ðàçðåøèòü ñîáûòèå Êàäà, åñëè íåò òåêóùåé îáðàáîòêè íàæàòèÿ êëàâèø èëè ìûøêè,
// ÷òîáû íå ïåðåêðûâàëèñü ñîáûòèÿ
if ((not GisKeyDown) and (not GisKeyPress) and (not GisMouseDown)) then
begin
aNeedRefresh := False;
//
if assigned(FRemFigures) and (FRemFigures.Count > 0) and (GTraceStatus = False) {important!!!} then
begin
aNeedEnd := False;
if GisProgressCount = 0 then
begin
aNeedEnd := True;
BeginProgress;
end;
try
PCad.OnGUIEvent := nil;
i := 0;
while i < FRemFigures.Count do
begin
FWaitWork := True;
//Application.ProcessMessages;
//02.08.2013
DelFigure := FRemFigures[i];
IdxManualDel := FFiguresDelManual.Remove(DelFigure);
IsManualDel := IdxManualDel <> -1;
if Assigned(FRemFigures[i]) and (TFigure(FRemFigures[i]).ID <> -1) 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, IsManualDel)
// 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, IsManualDel)
// 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
// Tolik
begin
// îáúåêòà Joined1 ìîæåò óæå è íå áûòü, à ñþäà ïîïàäàåì ïðîñòîïî ññûëêå, JoinedOrtholinesList - óæå òîæå
// ìîæåò íå áûòü, ïîýòîìó ñòàâèì ïðîâåðêó
if Joined1.JoinedOrtholinesList <> nil then
begin
//
if Joined1.JoinedOrtholinesList.Count = 0 then
if not Joined1.FIsHouseJoined then
Joined1.Delete(False, False);
end;
end;
//
if Joined2 <> nil then
//Tolik
// òî æå ñàìîå, ÷òî è äëÿ Joined1
if Joined2.JoinedOrtholinesList <> nil then
begin
//
if Joined2.JoinedOrtholinesList.Count = 0 then
if not Joined2.FIsHouseJoined then
Joined2.Delete(False, False);
end;
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;
if aNeedEnd then
EndProgress;
if FRemFigures <> nil then
FRemFigures.Clear;
PCad.OnGUIEvent := PCadGUIEvent;
if aNeedEnd then
RefreshCAD(PCad);
end;
if F_Navigator <> nil then
RefreshCAD(F_Navigator.PCadNavigator);
end;
if assigned(FRemFigures) and (FRemFigures.Count = 0) and (GTraceStatus = False) {important!!!}
and (FFiguresDelManual.Count <> 0) then
FFiguresDelManual.Clear;
end
// åñëè íàæàòà êëàâèøà, óäàëÿåì òîëüêî ôèãóðû îòðèñîâêè (èùåì TFigureGRPMod)
else
begin
aNeedRefresh := False;
//
if assigned(FRemFigures) and (FRemFigures.Count > 0) and (GTraceStatus = False) {important!!!} then
begin
aNeedEnd := False;
if GisProgressCount = 0 then
begin
aNeedEnd := True;
BeginProgress;
end;
try
// PCad.OnGUIEvent := nil;
i := 0;
CanDelFigures := True;
while CanDelFigures do
begin
CanDelFigures := False;
for i := 0 to FRemFigures.Count - 1 do
begin
FWaitWork := True;
//Application.ProcessMessages;
//02.08.2013
{ DelFigure := FRemFigures[i];
IdxManualDel := FFiguresDelManual.Remove(DelFigure);
IsManualDel := IdxManualDel <> -1;}
if Assigned(FRemFigures[i]) and (TFigure(FRemFigures[i]).ID <> -1) then
begin
try
try
if CheckFigureByClassName(TFigure(FRemFigures[i]), cTFigureGrpMod) then
begin
DelGrpFigure := TFigureGrpMod(FRemFigures[i]);
FRemFigures.Remove(DelGrpFigure);
PCad.Figures.Remove(DelGrpFigure);
FFiguresDelManual.Remove(DelGrpFigure);
//DelGrpFigure.Destroy;
if DelGrpFigure <> nil then
FreeAndNil(DelGrpFigure);
if FRemFigures.Count > 0 then
CanDelFigures := True;
break;
end;
except
on E: Exception do addExceptionToLogEx('TF_CAD.PCadGUIEvent', E.Message);
end;
except
on E: Exception do addExceptionToLogEx('TF_CAD.PCadGUIEvent', E.Message);
end;
end;
end;
end;
finally
FWaitWork := False;
// *UNDO*
FCanSaveForUndo := True;
if aNeedEnd then
EndProgress;
// PCad.OnGUIEvent := PCadGUIEvent;
if aNeedEnd then
RefreshCAD(PCad);
end;
if F_Navigator <> nil then
RefreshCAD(F_Navigator.PCadNavigator);
end;
end;
end;
end; *)
procedure TF_CAD.FullEndUpdateCad;
begin
if (Not GIsProgress) and (PCad.UpdateCount > 0) then
begin
PCad.EnableAlign;
while PCad.UpdateCount > 0 do
PCad.EndUpdate(False);
end;
end;
procedure TF_CAD.FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
var
X, Y: Integer;
begin
try
//FullEndUpdateCad; ñäåëàåì ïîêà òîëüêî ïî èçì.ìàñøòàáà ñêðîëîì
Handled := True;
if PCad.ToolIdx = TPCTool(toFigure) then
exit;
PCad.AutoRefresh := False;
// Ìàñøòàá
if ssCtrl in Shift then
begin
FullEndUpdateCad;
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;
if PCad.ToolIdx = TPCTool(toFigure) then
exit;
PCad.AutoRefresh := False;
// Ìàñøòàá
if ssCtrl in Shift then
begin
FullEndUpdateCad;
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;
LineLen : double;
CurFigure: TFigure;
CheckUnselectFigure: TFigure;
LastFigure: TFigure;
FigureHeightStr: String;
CurrParams : TProjectParams;
//Tolik
PointSelectedCount: Integer;
LineSelectedCount: Integer;
CanShow_Act_Magistral_Channel_Index: Boolean;
begin
try
//Tolik
FSCS_Main.Act_ConnectSelectedPoints.Visible := false;
FSCS_Main.Act_ReindexMaster.Visible := false;
FSCS_Main.Act_Magistral_Channel_Index.Visible := False;
CanShow_Act_Magistral_Channel_Index := true;
//
// óáðàòü âûäåëåíèÿ ñ ïîñòîðîííèõ îáúåêòîâ
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;
//
//Added by Tolik
// ïåðåñ÷åò äëèí âûáðàííûõ òðàññ ñðàáîòàåò, åñëè íå âûáðàí
// ïóòü äî êîíå÷íîãî îáúåêòà
// if not GCadForm.FDeselectUpDown then
if GCadForm <> nil then
begin
if not GCadForm.FDeselectUpDown then
begin
if PCad.SelectedCount > 1 then
begin
sbView.Panels[1].Text := '';
LineLen := 0;
for i := 0 to PCad.SelectedCount - 1 do
begin
if CheckFigureByClassName(TFigure(PCad.Selection[i]), cTOrthoLine) then
LineLen := LineLen + TOrthoLine(PCad.Selection[i]).LineLength;
end;
if LineLen > 0 then
sbView.Panels[1].Text := cCad_Mes14_1 + FormatFloat(ffMask, MetreToUOM(LineLen)) + GetUOMString(GCurrProjUnitOfMeasure);
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;
PointSelectedCount := 0;
LineSelectedCount := 0;
if PCad.Selection.Count > 0 then
begin
for i := 0 to PCad.Selection.Count - 1 do
begin
if CheckFigureByClassName(PCad.Selection[i], cTConnectorObject) then
INC(PointSelectedCount);
if CheckFigureByClassName(PCad.Selection[i], cTOrthoLine) then
INC(LineSelectedCount);
end;
end;
if PointSelectedCount > 1 then
begin
FSCS_Main.Act_ConnectSelectedPoints.Visible := true;
end;
if (LineSelectedCount + PointSelectedCount) > 1 then
begin
{f F_ProjMan.GSCSBase.CurrProject.CurrList.Setting.GroupListObjectsByType = False then}
FSCS_Main.Act_ReindexMaster.Visible := true
end;
// åñëè íàæàòà ïðàâàÿ êëàâèøà ìûøè íà ñïóñêå/ïîäúåìå, íå ïîêàçûâàòü ìåíþ èíäåêñà ìàãèñòðàëüíîãî ìàðøðóòà,
// åñëè Ñ/Ï ïðèñîåäèíåí ê òî÷å÷íîìó îáúåêòó
if ((LineSelectedCount = 1) and (PointSelectedCount = 0)) then
begin
curFigure := TFigure(PCad.Selection[0]);
if TOrthoLine(curFigure).FIsRaiseUpDown then
begin
if TConnectorObject(TOrthoLine(curFigure).JoinConnector1) <> nil then
begin
for i := 0 to TConnectorObject(TOrthoLine(curFigure).JoinConnector1).JoinedConnectorsList.Count - 1 do
begin
if TConnectorObject(TConnectorObject(TOrthoLine(curFigure).JoinConnector1).JoinedConnectorsList[i]).ConnectorType = ct_NB then
begin
CanShow_Act_Magistral_Channel_Index := False;
break;
end;
end;
end;
if CanShow_Act_Magistral_Channel_Index then
begin
if TConnectorObject(TOrthoLine(curFigure).JoinConnector1) <> nil then
begin
for i := 0 to TConnectorObject(TOrthoLine(curFigure).JoinConnector2).JoinedConnectorsList.Count - 1 do
begin
if TConnectorObject(TConnectorObject(TOrthoLine(curFigure).JoinConnector2).JoinedConnectorsList[i]).ConnectorType = ct_NB then
begin
CanShow_Act_Magistral_Channel_Index := False;
break;
end;
end;
end;
end;
end;
end
else
CanShow_Act_Magistral_Channel_Index := False;
if CanShow_Act_Magistral_Channel_Index then
FSCS_Main.Act_Magistral_Channel_Index.Visible := True;
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;
HorScroll.Anchors := [akLeft,akBottom]; // îòâÿçàòü îò ïðèâÿçêè è àëèãèíà íà ïðàâûé êðàé
VerScroll.Anchors := [akRight,akTop]; // îòâÿçàòü îò ïðèâÿçêè è àëèãèíà íà ïðàâûé êðàé
// ïîäðåäàêòèðîâàòü ñêðîëáàðû
// òîëüêî ãîðèç.
if IfVisibleHorScrollBar and not ifVisibleVerScrollBar then
begin
HorScroll.Constraints.MaxWidth := PCad.Width - 15 - 7;
if HorScroll.Width <> (PCad.Width - 7) then
HorScroll.Width := PCad.Width - 7;
end;
// òîëüêî âåðòèê.
if not IfVisibleHorScrollBar and ifVisibleVerScrollBar then
begin
VerScroll.Constraints.MaxHeight := PCad.Height - 15 - 7;
if VerScroll.Height <> (PCad.Height - 7) then
VerScroll.Height := PCad.Height - 7;
end;
// îáà
if IfVisibleHorScrollBar and ifVisibleVerScrollBar then
begin
HorScroll.Constraints.MaxWidth := PCad.Width - 15 - 7;
VerScroll.Constraints.MaxHeight := PCad.Height - 15 - 7;
if HorScroll.Width <> (PCad.Width - 15 - 7) then
HorScroll.Width := PCad.Width - 15 - 7;
if VerScroll.Height <> (PCad.Height - 15 - 7) then
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
FullEndUpdateCad;
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
FullEndUpdateCad;
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;
{ PCad.Refresh;
if (CheckFigureByClassName(PCad.TraceFigure, 'TOrthoLine')) then
PCad.TraceFigure.NotNeedToDraw := True;
PCad._DrawTrace; //äëÿ îòðèñîâêè íîâîé trace shadow
if (CheckFigureByClassName(PCad.TraceFigure, 'TOrthoLine')) then
PCad.TraceFigure.NotNeedToDraw := false; }
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;
{ PCad.Refresh;
if (CheckFigureByClassName(PCad.TraceFigure, 'TOrthoLine')) then
PCad.TraceFigure.NotNeedToDraw := True;
PCad._DrawTrace; //äëÿ îòðèñîâêè íîâîé trace shadow
if (CheckFigureByClassName(PCad.TraceFigure, 'TOrthoLine')) then
PCad.TraceFigure.NotNeedToDraw := false; }
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;
tbSnapGrid.Down := 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);
HorScroll.Anchors := [akLeft,akBottom]; // îòâÿçàòü îò ïðèâÿçêè è àëèãèíà íà ïðàâûé êðàé
VerScroll.Anchors := [akRight,akTop]; // îòâÿçàòü îò ïðèâÿçêè è àëèãèíà íà ïðàâûé êðàé
// Ãîðèç. ñêðîëë åñòü
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
begin
HorScroll.Constraints.MaxWidth := PCad.Width - 15 - 7;
if HorScroll.Width <> (PCad.Width - 7) then
HorScroll.Width := PCad.Width - 7;
end;
// òîëüêî âåðòèê.
if not IfVisibleHorScrollBar and ifVisibleVerScrollBar then
begin
VerScroll.Constraints.MaxHeight := PCad.Height - 15 - 7;
if VerScroll.Height <> (PCad.Height - 7) then
VerScroll.Height := PCad.Height - 7;
end;
// îáà
if IfVisibleHorScrollBar and ifVisibleVerScrollBar then
begin
HorScroll.Constraints.MaxWidth := PCad.Width - 15 - 7;
VerScroll.Constraints.MaxHeight := PCad.Height - 15 - 7;
if HorScroll.Width <> (PCad.Width - 15 - 7) then
HorScroll.Width := PCad.Width - 15 - 7;
if VerScroll.Height <> (PCad.Height - 15 - 7) then
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;
//PCad.DisableAlign;
hscroll := PCad.HSCBarPosition;
vscroll := PCad.VSCBarPosition;
(*
PCad.SetHScrollPosition(hscroll + {round(-adeltax * 5)}round(-adeltax) * round(PCad.ZoomScale / 25), true);
PCad.SetVScrollPosition(vscroll + {round(-adeltay * 5)}round(-adeltay) * round(PCad.ZoomScale / 25), true);
*)
PCad.SetHScrollPosition(hscroll + round(-adeltax * PCad.ZoomScale / 25), true);
PCad.SetVScrollPosition(vscroll + round(-adeltay * PCad.ZoomScale / 25), 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
if HorScroll.Width <> (PCad.Width - 7) then
HorScroll.Width := PCad.Width - 7;
// òîëüêî âåðòèê.
if not IfVisibleHorScrollBar and ifVisibleVerScrollBar then
if VerScroll.Height <> (PCad.Height - 7) then
VerScroll.Height := PCad.Height - 7;
// îáà
if IfVisibleHorScrollBar and ifVisibleVerScrollBar then
begin
if HorScroll.Width <> (PCad.Width - 15 - 7) then
HorScroll.Width := PCad.Width - 15 - 7;
if VerScroll.Height <> (PCad.Height - 15 - 7) then
VerScroll.Height := PCad.Height - 15 - 7;
end;
//HorScroll.Refresh;
//VerScroll.Refresh;
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;
//PCad.EnableAlign;
//////ChangeScrollsOnChangeListSize;
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;
*)
step := 10;// / (PCad.ZoomScale / 100);
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;
*)
VRect := PCad.GetVisibleRect;
if (ax < (VRect.Left + 5/(PCad.ZoomScale/100))) then
deltax := - step;
if (ax > (VRect.Right - 5/(PCad.ZoomScale/100))) then
deltax := step;
if (ay < (VRect.Top + 5/(PCad.ZoomScale/100))) then
deltay := - step;
if (ay > (VRect.Bottom - 5/(PCad.ZoomScale/100))) 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
if HorScroll.Width <> (PCad.Width - 7) then
HorScroll.Width := PCad.Width - 7;
// òîëüêî âåðòèê.
if not IfVisibleHorScrollBar and ifVisibleVerScrollBar then
if VerScroll.Height <> (PCad.Height - 7) then
VerScroll.Height := PCad.Height - 7;
// îáà
if IfVisibleHorScrollBar and ifVisibleVerScrollBar then
begin
if HorScroll.Width <> (PCad.Width - 15 - 7) then
HorScroll.Width := PCad.Width - 15 - 7;
if VerScroll.Height <> (PCad.Height - 15 - 7) then
VerScroll.Height := PCad.Height - 15 - 7;
end;
PCad.AutoRefresh := True;
RefreshCAD(PCad);
if PCad.TraceFigure <> nil then
begin
if (CheckFigureByClassName(PCad.TraceFigure, 'TOrthoLine')) then
PCad.TraceFigure.NotNeedToDraw := True;
PCad._DrawTrace; //äëÿ îòðèñîâêè íîâîé trace shadow
if (CheckFigureByClassName(PCad.TraceFigure, 'TOrthoLine')) then
PCad.TraceFigure.NotNeedToDraw := false;
end;
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;
//Tolik
ShadowTrace: TFigure;
//
begin
try
GisKeyPress := True;
GisKeyDown := True;
//inGuiEvent := True;
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
// Tolik 26/10/2015
// ???? íàõ ïðîâåðêà äëÿ êàæäîé ôèãóðû ????
{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;}
if PCad.ActiveLayer = lnArch then
begin
for i := 0 to PCad.Selection.Count - 1 do
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;
CanHandle := True;
if PCad.ActiveLayer = lnSCSCommon then
begin
if (not (ssAlt in Shift)) and (ssShift in Shift) then
begin
CanHandle := False;
SelectTracesAndRaisers;
end
else if (ssAlt in Shift) and (ssShift in Shift) then
begin
CanHandle := False;
SelectTraces;
end
else if (ssAlt in Shift) and (not (ssShift in Shift)) then
begin
CanHandle := False;
InvertSCSSelection;
end;
end
else
begin
if ssAlt in Shift then
begin
CanHandle := False;
InvertAllSelection;
end;
end;
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;
//Tolik 31/10/2015
finally
GisKeyPress := False;
//InGuiEvent := False;
if not ((Key >=37) and (Key <= 40)) then
begin
try
GMoveByArrow := False;
finally
GisKeyDown := False;
GisMouseDown := False;
// åñëè îòæàòà íå Shift, Alt èëè Control, òî âûçûâàåì EventEngine
// âäðóã áûëî óäàëåíèå, òî îí ïî÷èñòèò FRemFigures è, ïðè íåîáõîäèìîñòè,
// âûïîëíèò óäàëåíèå ôèãóð
{ if not (Key in [VK_SHIFT, VK_CONTROL, VK_MENU]) then
begin
// if GisAction then
if GisEventWaiting then
PCad.EventEngine(95,1,'',0);
end;}
//
end;
end;
// Tolik 24/12/2015
if GisEventWaiting then
begin
PCad.EventEngine(95,1,'',0);
PCad.OnGUIEvent := PCadGUIEvent;
end;
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
//Tolik
if not GisMouseDown then
GisMouseDown := True;
//
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
CheckFigure := CheckBySCSObjects(DownPoints.x,DownPoints.y);
// ïîëîæèòü êîìïëåêòóþùóþ
CreateOnClickMode(GFigureTraceTo, F_NormBase.GSCSBase.SCSComponent, GCurrMousePos.x, GCurrMousePos.y);
// DrawGuidesOnDrop(DownPoints.x,DownPoints.y);
ShowHintIFFigInsideCab(DownPoints.x,DownPoints.y);
If CheckFigure <> nil then
CheckFigure := nil;
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;
//if GReadOnlyMode then
//begin
// for i := 0 to PCad.Figures.Count - 1 do
// begin
// TFigure(PCad.Figures[i]).LockModify := True;
// TFigure(PCad.Figures[i]).LockMove := True;
// TFigure(PCad.Figures[i]).LockSelect := True;
// end;
//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.NewWndProc(var Message: TMessage);
begin
{ if Message.msg = WM_SETCURSOR then
beep;}
end;
procedure TF_CAD.DoDragDrop(X, Y: Double; aOnDropRoute: TFigure = nil; aTraceOnEntireRoute: boolean = False);
var
DropFigure: TFigure;
StateType: TCompStateType;
ComponID: integer;
i, j, k, l: 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;
Trace: TOrthoLine;
isBetweenFloor: boolean;
BreakCheck: boolean;
AllConnectedTraces: TList;
RackFound: boolean;
SCSCatalog: TSCSCatalog;
isObjectRack: boolean;
FigureID: integer;
NeedSelFigure: boolean;
FOnDropFigure: TFigure;
NeedExclTraces: boolean;
jj: integer;
//Tolik
Old_proc : TWndMethod;
CableIsMulti: Boolean;
//
begin
if F_NormBase.Tree_Catalog.Tag = 100 then
begin
Screen.Cursor := crDefault;
exit;
end;
try
// äðîï íà Äèçàéí øêàôà, äîáàâèòü â øêàô
GDragOnCAD := True;
Traces := nil;
OldEndPoint := nil;
if FListType = lt_DesignBox then
begin
DoFragDropDesigList;
EndProgress;
//Tolik
Screen.Cursor := crDefault;
exit;
end;
//Tolik
Screen.Cursor := crHourGlass;
F_NormBase.Tree_Catalog.Tag := 100;
// Tolik
Old_proc := F_NormBase.Tree_Catalog.WindowProc;
F_NormBase.Tree_Catalog.WindowProc := NewWndProc;
//
RackFound := False;
AllConnectedTraces := nil;
isObjectRack := False;
{IGOR} //D0000006296
if CheckFigureByClassName(GFigureSnap, cTOrthoLine)
and (GDropComponent <> nil) and (GDropComponent.IsLine = 1)
//and not CheckSysNameIsCableChannel(GDropComponent.ComponentType.SysName) then
and CheckSysNameIsCable(GDropComponent.ComponentType.SysName) then
begin
if FNeedUpdateCheckedFigures then
UpdateCheckedFigures;
for i := 0 to FCheckedFigures.Count - 1 do
begin
if CheckFigureByClassName(FCheckedFigures[i], cTConnectorObject) then
begin
isObjectRack := False;
SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(TF_CAD(TConnectorObject(FCheckedFigures[i]).Owner.Owner).FCADListID).GetCatalogFromReferencesBySCSID(TConnectorObject(FCheckedFigures[i]).ID);
if SCSCatalog <> nil then
begin
for k := 0 to SCSCatalog.SCSComponents.Count - 1 do
begin
if SCSCatalog.SCSComponents[k].ComponentType.SysName = ctsnCupboard then
begin
isObjectRack := true;
break;
end;
if SCSCatalog.SCSComponents[k].ComponentType.SysName = ctsnBox then
begin
isObjectRack := true;
break;
end;
end;
end;
if isObjectRack then
begin
AllConnectedTraces := GetAllTraceInCAD(TConnectorObject(FCheckedFigures[i]), TOrthoLine(GFigureSnap).JoinConnector1);
if AllConnectedTraces <> nil then
begin
if AllConnectedTraces.Count > 0 then
begin
RackFound := True;
break;
end;
freeandnil(AllConnectedTraces);
end;
end;
end;
end;
if AllConnectedTraces <> nil then
freeandnil(AllConnectedTraces);
if RackFound then
begin
F_AutoTraceType.Panel1.Visible := True;
F_AutoTraceType.RzGroupBox1.Visible := False;
if F_AutoTraceType.ShowModal = mrCancel then
begin
F_AutoTraceType.Panel1.Visible := False;
F_AutoTraceType.RzGroupBox1.Visible := True;
//Tolik
Screen.Cursor := crDefault;
F_NormBase.Tree_Catalog.Tag := 0;
F_NormBase.Tree_Catalog.WindowProc := Old_Proc;
exit;
end;
F_AutoTraceType.Panel1.Visible := False;
F_AutoTraceType.RzGroupBox1.Visible := True;
if F_AutoTraceType.cxRadioButton1.Checked then
begin
if (GEndPoint <> nil) then
begin
OldEndPoint := GEndPoint;
TConnectorObject(GEndPoint).AsEndPoint := False;
GEndPoint := nil;
GListWithEndPoint := nil;
end;
FSCS_Main.SetFigureAsEndObject(GCadForm, TConnectorObject(FCheckedFigures[i]));
FOnDropFigure := GFigureSnap;
GFigureSnap := TConnectorObject(FCheckedFigures[i]);
DoDragDrop(0, 0, FOnDropFigure, True);
if OldEndPoint <> nil then
begin
if GEndPoint <> nil then
TConnectorObject(GEndPoint).AsEndPoint := False;
FSCS_Main.SetFigureAsEndObject(TF_CAD(OldEndPoint.Owner.Owner), TConnectorObject(OldEndPoint));
GListWithEndPoint := TF_CAD(OldEndPoint.Owner.Owner);
end;
//Tolik
Screen.Cursor := crDefault;
F_NormBase.Tree_Catalog.Tag := 0;
F_NormBase.Tree_Catalog.WindowProc := Old_Proc;
exit;
end;
end;
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
// if not PCad.SnapToGuides 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;
//Tolik
Screen.Cursor := crHourGlass;
//
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
if Not GCadForm.FCreateObjectOnClick then
begin
FSCS_Main.aCreateObjectOnClickTool.Execute;
if FSCS_Main.tbCADToolsExpert.Visible then
FSCS_Main.tbCreateOnClickModeExpert.Down := true
else
FSCS_Main.tbCreateOnClickModeNoob.Down := true;
end;
end
else
begin
if GCadForm.FCreateObjectOnClick then
begin
FSCS_Main.aCreateObjectOnClickTool.Execute;
if FSCS_Main.tbCADToolsExpert.Visible then
FSCS_Main.tbCreateOnClickModeExpert.Down := true
else
FSCS_Main.tbCreateOnClickModeNoob.Down := true;
end;
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));
// 08.08.2013 Igor
{TODO} // æåëàòåëüíî äîäåëàòü: èñêëþ÷àòü òðàññû âåäóùèå ê ÌÝ åñëè åñòü äðóãèå íå ïóñòûå ÒÎ íà ëèñòå êðîìå òîãî íà êîòîðûé äðîïíóëè
// Èñêëþ÷èì òðàññû ïîäñîåäèíåííûå ê ÌÝ
NeedExclTraces := False;
if GCadForm.FNeedUpdateCheckedFigures then
GCadForm.UpdateCheckedFigures(True);
for jj := 0 to GCadForm.FCheckedFigures.Count - 1 do
begin
if CheckFigureByClassName(TFigure(GCadForm.FCheckedFigures[jj]), cTConnectorObject) then
begin
if TConnectorObject(GCadForm.FCheckedFigures[jj]) <> TConnectorObject(GFigureSnap) then
if TConnectorObject(GCadForm.FCheckedFigures[jj]).ConnectorType <> ct_Clear then
begin
if (TConnectorObject(GCadForm.FCheckedFigures[jj]).JoinedConnectorsList.Count = 0) and
(TConnectorObject(GCadForm.FCheckedFigures[jj]).JoinedFigures.Count = 0) and
(TConnectorObject(GCadForm.FCheckedFigures[jj]).JoinedFigures.Count = 0) then
begin
NeedExclTraces := True;
break;
end;
end;
end;
end;
BreakCheck := False;
if NeedExclTraces then
begin
for i := Traces.Count - 1 downto 0 do
begin
Trace := TOrthoLine(Traces[i]);
isBetweenFloor := False;
if Trace.FIsRaiseUpDown or Trace.FIsVertical then
begin
// ïðîâåðèì åñòü ëè òðàññû ïîäêëþ÷åííûå ê Ñ/Ï íî íå âåäóùèå ê ÌÝ
// ïðîâåðèì ïðîñòî åñòü ëè ó îäíîãî èç êîííåêòîðîâ áîëüøå ÷åì 2 ïîäêëþ÷åííûõ òðàññû
if Trace.JoinConnector1 <> nil then
begin
if TConnectorObject(Trace.JoinConnector1).JoinedOrtholinesList.Count > 2 then
BreakCheck := True;
end;
if Trace.JoinConnector2 <> nil then
begin
if TConnectorObject(Trace.JoinConnector2).JoinedOrtholinesList.Count > 2 then
BreakCheck := True;
end;
if BreakCheck then
break
else
begin
isBetweenFloor := CheckOtherTraceBetwFloor(Trace, False, True);
if isBetweenFloor then
Traces.Delete(i)
end;
(* òàê ïîêà õðåíîâî - ïðîâåðêó íóæíî ïåðåäåëûâàòü ÷òî áû øëà â îäíîì íàïðàâëåíèè, à íå ïî âñåì âîçìîæíûì.
if Trace.JoinConnector1 <> nil then
begin
for j := 0 to TConnectorObject(Trace.JoinConnector1).JoinedOrtholinesList.Count - 1 do
begin
if TConnectorObject(Trace.JoinConnector1).JoinedOrtholinesList.Items[j] <> Trace then
if Not CheckOtherTraceBetwFloor(TOrthoLine(TConnectorObject(Trace.JoinConnector1).JoinedOrtholinesList.Items[j]), False, False) then
begin
BreakCheck := True;
break;
end
else
begin
isBetweenFloor := True;
end;
end;
end;
if (Trace.JoinConnector2 <> nil) and Not BreakCheck then
begin
for j := 0 to TConnectorObject(Trace.JoinConnector2).JoinedOrtholinesList.Count - 1 do
begin
if TConnectorObject(Trace.JoinConnector2).JoinedOrtholinesList.Items[j] <> Trace then
if Not CheckOtherTraceBetwFloor(TOrthoLine(TConnectorObject(Trace.JoinConnector2).JoinedOrtholinesList.Items[j]), False, False) then
begin
BreakCheck := True;
break;
end
else
begin
isBetweenFloor := True;
end;
end;
end;
if BreakCheck then
break
else
if isBetweenFloor then
Traces.Delete(i);
*)
end
else
if CheckConnJoinBetwFloor(TConnectorObject(Trace.JoinConnector1), False) or
CheckConnJoinBetwFloor(TConnectorObject(Trace.JoinConnector2), False) then
Traces.Delete(i)
else
begin
isBetweenFloor := CheckOtherTraceBetwFloor(Trace, False, True);
if isBetweenFloor then
Traces.Delete(i)
end;
end;
// 08.08.2013 END Igor
end;
//ïîëó÷èì êîëè÷åñòâî òðàññ - åñëè íåò ïîäñîåäèíåííûõ - ñáðîñèì âðêìåííî ÊÎ
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;
//Tolik
//âûçûâàåì ìàñòåð ïðîêëàäêè òîëüêî äëÿ êàáåëÿ (à òî ëîæåìåíò - òîæå ëèíåéíûé îáúåêò)
//if (GDropComponent.IsLine = 1) and (Traces <> nil) and (Traces.Count <> 0) then
if (GDropComponent.IsLine = 1) and (Traces <> nil) and (Traces.Count <> 0) and (IsCableComponent(GDropComponent)) then
// çäåñü íåìíîæêî ñîîáùèì, åñëè êàáåëü èìååò ìíîæåñòâåííûå èíòåðôåéñû è äàäèì âûáðàòü äåéñòâèå
begin
CableIsMulti := False;
for l := 0 to GDropComponent.Interfaces.Count - 1 do
begin
if (TSCSInterface(GDropComponent.Interfaces[l]).TypeI = itFunctional) and
(TSCSInterface(GDropComponent.Interfaces[l]).Multiple = biTrue) then
begin
CableIsMulti := True;
Break; //// BREAK ////;
end;
end;
if CableIsMulti then
begin
if GIsProgress then
PauseProgress(true);
if MessageModal(cAttentionCableMultiInterFace,'', mb_YesNo) = 6 then
resChoice := ChoiceAutoTraceConnectOrder(nil, true, GDropComponent);
if GIsProgress then
PauseProgress(False);
end
else
resChoice := ChoiceAutoTraceConnectOrder(nil, true, GDropComponent);
end;
//if (GDropComponent.IsLine = 1) and (Traces <> nil) and (Traces.Count = 0) or resChoice then
if (GDropComponent.IsLine = 1) and (Traces <> nil) and (Traces.Count = 0) and (IsCableComponent(GDropComponent))
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) or
(GEndPoint = GFigureSnap )))
or ((GDropComponent.IsLine = 1) and resChoice and
( F_AutoTraceConnectOrder.rbTraceManualCable.Checked )) 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
// åñëè íåò ÊÎ íî äðîïíóëè íà øêàô, áîêñ - óñòàíîâèòü åãî êàê ÊÎ
isObjectRack := False;
if (GEndPoint = nil) and (GFigureSnap <> nil) then
begin
FigureID := TConnectorObject(GFigureSnap).ID;
SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(TF_CAD(GFigureSnap.Owner.Owner).FCADListID).GetCatalogFromReferencesBySCSID(FigureID);
if SCSCatalog <> nil then
begin
for k := 0 to SCSCatalog.SCSComponents.Count - 1 do
begin
if SCSCatalog.SCSComponents[k].ComponentType.SysName = ctsnCupboard then
begin
isObjectRack := true;
break;
end;
if SCSCatalog.SCSComponents[k].ComponentType.SysName = ctsnBox then
begin
isObjectRack := true;
break;
end;
end;
end;
end;
// ÇÄÅÑÜ ÌÛ ÒÎËÜÊÎ åñëè îïöèÿ ÎÄÈÍ ïîðò è áîëüøå!
// åñëè GFigureSnap íå øêàô/áîêñ à ÊÎ - øêàô/áîêñ âûäåëèì GFigureSnap
// ëó÷øå òàê: åñëè GFigureSnap íå ÊÎ òîãäà âûäåëèì GFigureSnap è âûçîâ òðàññèðîâêè îò âûäåëåíîãî îáúåêòà ê ÊÎ
if GFigureSnap <> GEndPoint then
begin
if isObjectRack then
FSCS_Main.SetFigureAsEndObject(GCadForm, GFigureSnap);
GFigureSnap.Select;
RefreshCAD(PCad);
OldParam := F_ProjMan.GSCSBase.CurrProject.Setting.TraceNoAskParams;
F_ProjMan.GSCSBase.CurrProject.Setting.TraceNoAskParams := True;
try
AutoTraceCableFromNB(GDropComponent.ID, GDropComponent, true, false, FCanSaveForUndo, False, True);
except
end;
F_ProjMan.GSCSBase.CurrProject.Setting.TraceNoAskParams := OldParam;
end
else
begin
// åñëè áûë äðîï íà òðàññó - GFigureSnap = GEndPoint
if aTraceOnEntireRoute then
begin
if FNeedUpdateCheckedFigures then
UpdateCheckedFigures;
for i := 0 to FCheckedFigures.Count - 1 do
begin
if CheckFigureByClassName(FCheckedFigures[i], cTConnectorObject)
and (TConnectorObject(FCheckedFigures[i]).ConnectorType <> ct_Clear)then
begin
if FCheckedFigures[i] <> GFigureSnap then
begin
NeedSelFigure := False;
AllConnectedTraces := GetAllTraceInCAD(TConnectorObject(FCheckedFigures[i]), TConnectorObject(GFigureSnap));
if AllConnectedTraces <> nil then
begin
if AllConnectedTraces.Count > 0 then
begin
for k := 0 to AllConnectedTraces.Count - 1 do
begin
if AllConnectedTraces[k] = aOnDropRoute then
begin
NeedSelFigure := True;
break;
end;
end;
end;
freeandnil(AllConnectedTraces);
end;
if NeedSelFigure then
TConnectorObject(FCheckedFigures[i]).Select;
end;
end;
end;
if AllConnectedTraces <> nil then
freeandnil(AllConnectedTraces);
RefreshCAD(PCad);
OldParam := F_ProjMan.GSCSBase.CurrProject.Setting.TraceNoAskParams;
F_ProjMan.GSCSBase.CurrProject.Setting.TraceNoAskParams := True;
try
AutoTraceCableFromNB(GDropComponent.ID, GDropComponent, true, false, FCanSaveForUndo, False, True);
except
end;
F_ProjMan.GSCSBase.CurrProject.Setting.TraceNoAskParams := OldParam;
end
else
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;
end;
end
else
begin
isObjectRack := False;
if (GEndPoint = nil) and (GFigureSnap <> nil) then
begin
FigureID := TConnectorObject(GFigureSnap).ID;
SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(TF_CAD(GFigureSnap.Owner.Owner).FCADListID).GetCatalogFromReferencesBySCSID(FigureID);
if SCSCatalog <> nil then
begin
for k := 0 to SCSCatalog.SCSComponents.Count - 1 do
begin
if SCSCatalog.SCSComponents[k].ComponentType.SysName = ctsnCupboard then
begin
isObjectRack := true;
break;
end;
if SCSCatalog.SCSComponents[k].ComponentType.SysName = ctsnBox then
begin
isObjectRack := true;
break;
end;
end;
end;
end;
if isObjectRack then
FSCS_Main.SetFigureAsEndObject(GCadForm, GFigureSnap);
AutoTraceCableFromNB(GDropComponent.ID, GDropComponent, true, false, FCanSaveForUndo);
end;
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;
//Tolik
Screen.Cursor := crDefault;
end
else
begin
FSCS_Main.aToolOrthoLine.Execute;
GAutoAddCableAfterDragDrop := True;
end;
PCad.SimulateUp(X, Y);
//Tolik
if F_NormBase.Tree_Catalog.Tag = 100 then
begin
F_NormBase.Tree_Catalog.Tag := 0;
F_NormBase.Tree_Catalog.WindowProc := Old_proc;
end;
Screen.Cursor := crDefault;
//
F_NormBase.Tree_Catalog.Tag := 0;
F_NormBase.Tree_Catalog.WindowProc := Old_Proc;
exit;
end;
if DropFigure <> nil then
begin
DropFigure.Select;
if CheckFigureByClassName(DropFigure, cTConnectorObject) then
DropFigure.Radius := 0;
end
else
if GFigureSnap <> nil then
GFigureSnap.Select;
GFigureSnap := Nil;
GPrevFigureSnap := Nil;
RefreshCAD(PCad);
finally
//Tolik
if F_NormBase.Tree_Catalog.Tag = 100 then
begin
F_NormBase.Tree_Catalog.Tag := 0;
F_NormBase.Tree_Catalog.WindowProc := Old_proc;
end;
Screen.Cursor := crDefault;
//
EndProgress;
end;
end
else
begin
//FSCS_Main.aToolWallRect.Execute;
CreateArchObjWizard(FCADListID, GDropComponent, Self, nil);
end;
//Tolik
if F_NormBase.Tree_Catalog.Tag = 100 then
begin
F_NormBase.Tree_Catalog.Tag := 0;
F_NormBase.Tree_Catalog.WindowProc := Old_proc;
end;
//
except
on E: Exception do
begin
addExceptionToLogEx('TF_CAD.DoDragDrop', E.Message);
//Toilk
if F_NormBase.Tree_Catalog.Tag = 100 then
begin
F_NormBase.Tree_Catalog.Tag := 0;
F_NormBase.Tree_Catalog.WindowProc := Old_proc;
end;
Screen.Cursor := crDefault;
//
end;
end;
GDragOnCAD := False;
if F_NormBase.Tree_Catalog.Tag = 100 then
begin
F_NormBase.Tree_Catalog.Tag := 0;
F_NormBase.Tree_Catalog.WindowProc := Old_proc;
end;
if Traces <> nil then
FreeAndNil(Traces);
//Toilk
Screen.Cursor := crDefault;
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;
//Tolik
isUserLength: Boolean;
LastLineLen: Double;
begin
try
LastLineLen := 0;
// åñëè óñòàíîâëåíà äëèíà òðàññû äëÿ ðàñ÷åòîâ, íóæíî ñðàçó âûñ÷èòàòü äëèíó
// ïîñëåäíåãî êóñêà, åñëè áóäåò ðàçäåëåíèå
if aTrace.UserLength <> -1 then
begin
isUserLength := True;
LastLineLen := aTrace.UserLength;
while LastLineLen > aLength do
LastLineLen := LastLineLen - aLength; // ÎÑÒÀÒÎÊ
end
else
isUserLength := False;
// aLength := 2;
//
Realdelta := aLength * 1000 / PCad.MapScale;
// Tolik -- 12/11/2015 -- ó÷åñòü óñòàíîâêó äëèíû òðàññû äëÿ ðàñ÷åòîâ
if isUserLength then
begin
// TraceLength := aTrace.LineLength * 1000 / PCad.MapScale; // äëèíó áåðåì èç ðàñ÷åòíîé
RealDelta := ((aLength*aTrace.CalculLength)/aTrace.userLength) * 1000 / PCad.MapScale; // äëèíó áëîêà ìàñøòàáèðóåì
end;
//
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);
if Frac(TraceLength / Realdelta) <= 0.01 then
DivCount := DivCount - 1;
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);
// Tolik
if isUserLength then
CurTrace.UserLength := ALength;
//
CurTrace.ReCreateCaptionsGroup(True, True);
CurTrace.ReCreateNotesGroup(True);
TOrthoLine(CurTrace).Move(0.01, 0.01);
TOrthoLine(CurTrace).Move(-0.01, -0.01);
//
for j := 0 to Conn.JoinedOrtholinesList.Count - 1 do
if TOrthoLine(Conn.JoinedOrtholinesList[j]) <> CurTrace then
CurTrace := TOrthoLine(Conn.JoinedOrtholinesList[j]);
end;
// Tolik
// ïîñëåäíèé êóñîê òðàññû (âûñòàâèòü äëèíó, ÷òî îñòàíåòñÿ)
if isUserLength and (DivCount > 0) then
begin
for j := 0 to Conn.JoinedOrtholinesList.Count - 1 do
if TOrthoLine(Conn.JoinedOrtholinesList[j]) <> CurTrace then
CurTrace := TOrthoLine(Conn.JoinedOrtholinesList[j]);
if LastLineLen <> 0 then
CurTrace.UserLength := LastLineLen
else
CurTrace.UserLength := ALength;
CurTrace.ReCreateCaptionsGroup(True, True);
CurTrace.ReCreateNotesGroup(True);
// âûðîâíÿòü ïîäïèñè äëÿ òðàññû
TOrthoLine(CurTrace).Move(0.01, 0.01);
TOrthoLine(CurTrace).Move(-0.01, -0.01);
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;
FSCS_Main.pmiSCSObjAutoDivideLine.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;
FSCS_Main.pmiSCSObjAutoDivideLine.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;
FSCS_Main.pmiSCSObjAutoDivideLine.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;
FSCS_Main.pmiSCSObjAutoDivideLine.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.pmiSCSObjAutoDivideLine.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;
FSCS_Main.pmiSCSObjAutoDivideLine.Visible := False;
end
else
begin
FSCS_Main.pmiSCSObjDivideLine.Visible := True;
FSCS_Main.pmiSCSObjAutoDivideLine.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;
FSCS_Main.pmiSCSObjAutoDivideLine.Visible := True;
end
else
begin
FSCS_Main.pmiSCSObjDivideLine.Visible := False;
FSCS_Main.pmiSCSObjAutoDivideLine.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;
aNeedEnd: boolean;
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;
aNeedEnd := False;
/////if PCad.Figures.Count > 2000 then
///////BeginProgress('',0);// æäåì îêîí÷àíèÿ ñîçäàíèÿ ñëåïêà 08.11.2013 ñàìûêîâ
//IGOR Íóæíî äåëàòü òîëüêî ñ ïðîâåðêîé!!!
if FCheckedFigures.Count > 2000 then
begin
if (GIsProgressCount = 0) and (not F_Progress.Visible) and (Not GIsProgress) and (FFiguresDelManual.Count = 0) and (FRemFigures.Count = 0) then
begin
BeginProgress('',0);
aNeedEnd := True;
end;
end;
PCad.SaveSCSFiguresToFile(SetUndoName);
/////if PCad.Figures.Count > 2000 then
///// EndProgress; //08.11.2013 ñàìûêîâ
if aNeedEnd then
EndProgress;
// *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;
//Tolik
CadFigList: TList;
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;
GNeedReRaiseProperties := False;
//Tolik
CadFigList := TList.Create;
for i := 0 to PCad.FigureCount - 1 do
CadFigList.Add(TFigure(PCad.Figures.Items[i]));
for i := 0 to CadFigList.Count - 1 do
begin
Figure := TFigure(CadFigList[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(CadFigList);
TConnectorObject(Figure).FJoinedListIDForBox := -1;
end
else if CheckFigureByClassName(Figure, cTOrthoLine) then
TOrthoLine(Figure).RaiseProperties(CadFigList)
else if CheckFigureByClassName(Figure, cTSCSFigureGrp) then
TSCSFigureGrp(Figure).RaiseProperties(CadFigList)
else if CheckFigureByClassName(Figure, cTCabinet) then
TCabinet(Figure).RaiseProperties(CadFigList)
else if CheckFigureByClassName(Figure, cTCabinetExt) then
TCabinetExt(Figure).RaiseProperties(CadFigList)
else if CheckFigureByClassName(Figure, cTHouse) then
THouse(Figure).RaiseProperties(CadFigList);
end;
FreeAndNil(CadFigList);
{
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;
if GNeedReRaiseProperties then
begin
i := 0;
while i < PCad.FigureCount do
begin
Figure := TFigure(PCad.Figures.Items[i]);
if CheckFigureByClassName(Figure, cTConnectorObject) then
begin
TConnectorObject(Figure).ReRaiseProperties;
end;
if CheckFigureByClassName(Figure, cTOrthoLine) then
begin
TOrthoLine(Figure).ReRaiseProperties;
end;
i := i + 1;
end;
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(PCad.Figures)
else if CheckFigureByClassName(Figure, cTPlanConnector) then
TPlanConnector(Figure).RaiseProperties(PCad.Figures)
else if CheckFigureByClassName(Figure, cTPlanTrace) then
TPlanTrace(Figure).RaiseProperties(PCad.Figures);
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;
// Tolik
LHandle2: Integer;
LHandle3: Integer;
LHandle4: Integer;
LHandle5: Integer;
LHandle6: Integer;
LHandle8: Integer;
LHandle9: Integer;
LayersList: TIntList;
//
FigList: TList;
Count: Integer;
begin
try
//Tolik
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 PCad.FigureCount - 1 do
begin
FFigure := TFigure(PCad.Figures[i]);
if LayersList.OndexOf(FFigure.LayerHandle)) <> -1 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
//Tolik 26/10/2015 ìîæíî ñìåëî óäàëÿòü, äàæå åñëè ãðóïïîâàÿ ôèãóðà ... ðàíüøå åå óäàëåíèå ìîãëî ïðèâåñòè ê ÀÂ, òàê êàê
// FSingleBlock äëÿ îðòîëèíèè "ñèäåë" êàê íà ÊÀÄå, òàê è â DrawFiruge. Èç-çà äóáëÿæà âîçíèêàëà îøèáêà, ò.ê. ïîëó÷àëîñü
// äâîéíîå óäàëåíèå, íî òàê, êàê áûëî ñîâñåì íå ãîäèòñÿ -- ïîòåíöèàëüíàÿ óòå÷êà ïàìÿòè âñëåäñâèå ÍÅ ÓÄÀËÅÍÈß ÃÐÓÏÏÎÂÛÕ ÔÈÃÓÐ
// if not(FFigure is TFigureGrp) then
FreeAndNil(FFigure);
except
end;
end;
FreeAndNil(FigList);
//Tolik
// 31/10/2015 ÷òîáû ïîñëå Undo/Redo íå âîçíèêëî ñïîíòàííîãî íåïîíÿòíîãî óäàëåíèÿ ôèãóð,
// ñïèñêè óäàëÿåìûõ ôèãóð äî Undo/Redo òîæå íóæíî ïî÷èñòèòü, èíà÷å ïî íèì îòðàáîòàåò PCad.GuiEvent
FRemFigures.Clear;
FFiguresDelManual.Clear;
//
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;
// Tolik
// 31/10/2015 ÷òîáû ïîñëå Undo/Redo íå âîçíèêëî ñïîíòàííîãî íåïîíÿòíîãî óäàëåíèÿ ôèãóð,
// ñïèñêè óäàëÿåìûõ ôèãóð äî Undo/Redo òîæå íóæíî ïî÷èñòèòü, èíà÷å ïî íèì îòðàáîòàåò PCad.GuiEvent
FRemFigures.Clear;
FFiguresDelManual.Clear;
//
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
// Tolik 26/10/2015 -- óäàëÿòü íóæíî âñå
// 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, False) <> GetCabinetAtPos(newx, newy, False) 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;
//Tolik
CadFigList: TList;
//
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;
GNeedReRaiseProperties := False;
// Tolik
CadFiglist := TList.Create;
for i := 0 to PCad.FigureCount - 1 do
CadFigList.Add(TFigure(PCad.Figures.Items[i]));
//
for i := 0 to CadFigList.Count - 1 do
begin
Figure := TFigure(CadFigList[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(CadFigList)
else if CheckFigureByClassName(Figure, cTOrthoLine) then
TOrthoLine(Figure).RaiseProperties(CadFigList)
else if CheckFigureByClassName(Figure, cTSCSFigureGrp) then
TSCSFigureGrp(Figure).RaiseProperties(CadFigList)
else if CheckFigureByClassName(Figure, cTCabinet) then
TCabinet(Figure).RaiseProperties(CadFigList)
else if CheckFigureByClassName(Figure, cTCabinetExt) then
TCabinetExt(Figure).RaiseProperties(CadFigList)
else if CheckFigureByClassName(Figure, cTHouse) then
THouse(Figure).RaiseProperties(CadFigList);
end;
FreeAndNil(CadFigList);
{
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;
if GNeedReRaiseProperties then
begin
i := 0;
while i < PCad.FigureCount do
begin
Figure := TFigure(PCad.Figures.Items[i]);
if CheckFigureByClassName(Figure, cTConnectorObject) then
begin
TConnectorObject(Figure).ReRaiseProperties;
end;
if CheckFigureByClassName(Figure, cTOrthoLine) then
begin
TOrthoLine(Figure).ReRaiseProperties;
end;
i := i + 1;
end;
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(PCad.Figures)
else if CheckFigureByClassName(Figure, cTPlanConnector) then
TPlanConnector(Figure).RaiseProperties(PCad.Figures)
else if CheckFigureByClassName(Figure, cTPlanTrace) then
TPlanTrace(Figure).RaiseProperties(PCad.Figures);
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;
if (FDeltaX <> 0) or (FDeltaY <> 0) then
MoveCADOnPan(FDeltaX, FDeltaY);
end;
procedure TF_CAD.FormDestroy(Sender: TObject);
begin
FreeAndNil(FClickSCSFiguresList);
FreeAndNil(FFiguresDelManual);
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;
{TODO}
// âûâîäèì íà ïàíåëü - äîäåëàòü ÷òî áû íà ïàíåëü òîëüêî äëÿ ÑÊÑ ñëîÿ âûâîä áûë
//sbView.Panels[1].Text:=cCadClasses_Mes34+' '+FormatFloat(ffMask, MetreToUOM(Pcad.GetLineLengthM(CADTraceFigure.ActualPoints[pIdx], CADFigure.ActualPoints[pIdx]))) + GetUOMString(GCurrProjUnitOfMeasure);//ther test
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) or Defined(SCS_PANDUIT)}
{$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;
procedure TF_CAD.PCadSurfaceLeave(Sender: TObject);
begin
if DragState = dsPan then
begin
DragState := 0;
PCAD.SetCursor(crDefault);
Cursor := crDefault;
Screen.Cursor := crDefault;
end;
// if FContinueTrace then
begin
FContinueTrace := False;
if PCad.ToolInfo = 'TOrthoLine' then
begin
FSCS_Main.aToolSelectExecute(nil);
end;
end;
//D0000006113
UnSnapFigure; //30.10.2013 ñàìûêîâ
end;
//D0000006113
procedure TF_CAD.UnSnapFigure; //Îòìåíà âûäåëåíèèÿ îáúåêòà ðàìêîé,30.10.2013 ñàìûêîâ
var
i : shortint;
obj : pointer;
begin
for i:=0 to 2 do begin
case i of
0 : obj:=GPrevFigureTraceTo;
1 : obj:=GPrevFigureSnap;
2 : obj:=GFigureSnap;
end;
if obj<>nil then begin
if CheckFigureByClassName(obj, cTConnectorObject) then
TConnectorObject(obj).isSnap := false
else if CheckFigureByClassName(obj, cTOrthoLine) then
TOrthoLine(obj).isSnap := false
else if CheckFigureByClassName(obj, cTHouse) then begin
THouse(obj).isSnap := false;
THouse(obj).Draw(PCad.DEngine, false);
end;
end;
end;
end;
procedure TF_CAD.UpdateCheckedFigures(aCheckUpdateCount: boolean = True);
var
i: integer;
CurFigure: TFigure;
LHSCSCommon: integer;
LHSCSRoom: integer;
begin
if PCad <> nil then
begin
if (PCad.UpdateCount > 0) and aCheckUpdateCount then
begin
FNeedUpdateCheckedFigures := True;
exit;
end;
FCheckedFigures.Clear;
LHSCSCommon := PCad.GetLayerHandle(lnSCSCommon);
LHSCSRoom := PCad.GetLayerHandle(lnRoom);
for i := 0 to PCad.FigureCount - 1 do
begin
if i < PCad.FigureCount then
begin
CurFigure := TFigure(PCad.Figures[i]);
if Assigned(CurFigure) then
begin
if( (CurFigure.LayerHandle = LHSCSCommon) or (CurFigure.LayerHandle = LHSCSRoom) ) and (CurFigure.DrawStyle <> dsTrace) then
begin
if CheckFigureByClassName(CurFigure, cTConnectorObject) then
begin
FCheckedFigures.Add(CurFigure);
end
else if CheckFigureByClassName(CurFigure, cTOrthoLine) then
begin
FCheckedFigures.Add(CurFigure);
end
else if CheckFigureByClassName(CurFigure, cTHouse) then
begin
FCheckedFigures.Add(CurFigure);
end
else if CheckFigureByClassName(CurFigure, cTCabinet) then
begin
FCheckedFigures.Add(CurFigure);
end
else if CheckFigureByClassName(CurFigure, cTCabinetExt) then
begin
FCheckedFigures.Add(CurFigure);
end;
end;
end;
end;
end;
FNeedUpdateCheckedFigures := False;
end;
end;
procedure TF_CAD.SelectTracesAndRaisers;
var
i, a: integer;
f: TFigure;
invis: Boolean;
layer: TLayer;
LayerNbr: integer;
begin
LayerNbr := PCad.ActiveLayer;
If (LayerNbr < 0) or (LayerNbr > PCad.Layers.Count - 1) then
exit;
for a := 0 to PCad.figures.count - 1 do
begin
f := TFigure(PCad.figures[a]);
invis := false;
if (f.LayerHandle <> 0) then
invis := (TLayer(f.LayerHandle).Visible = lost);
if (not invis) and (not f.InClip) and
((LayerNbr = 0) or (f.LayerHandle = LongInt(PCad.Layers[LayerNbr])))
then
begin
if not f.LockSelect then
begin
if CheckFigureByClassName(f, cTOrthoLine) then
begin
f.Select;
PCad.FAnySelected := true;
end;
end;
end;
end;
PCad.ReDrawSelection;
PCad.SyncEnv;
end;
procedure TF_CAD.SelectTraces;
var
i, a: integer;
f: TFigure;
invis: Boolean;
layer: TLayer;
LayerNbr: integer;
begin
LayerNbr := PCad.ActiveLayer;
If (LayerNbr < 0) or (LayerNbr > PCad.Layers.Count - 1) then
exit;
for a := 0 to PCad.figures.count - 1 do
begin
f := TFigure(PCad.figures[a]);
invis := false;
if (f.LayerHandle <> 0) then
invis := (TLayer(f.LayerHandle).Visible = lost);
if (not invis) and (not f.InClip) and
((LayerNbr = 0) or (f.LayerHandle = LongInt(PCad.Layers[LayerNbr])))
then
begin
if not f.LockSelect then
begin
if CheckFigureByClassName(f, cTOrthoLine) then
begin
if Not TOrthoLine(f).FIsRaiseUpDown then
begin
f.Select;
PCad.FAnySelected := true;
end;
end;
end;
end;
end;
PCad.ReDrawSelection;
PCad.SyncEnv;
end;
procedure TF_CAD.InvertSCSSelection;
var
i, a: integer;
f: TFigure;
invis: Boolean;
layer: TLayer;
LayerNbr: integer;
begin
LayerNbr := PCad.ActiveLayer;
If (LayerNbr < 0) or (LayerNbr > PCad.Layers.Count - 1) then
exit;
for a := 0 to PCad.figures.count - 1 do
begin
f := TFigure(PCad.figures[a]);
invis := false;
if (f.LayerHandle <> 0) then
invis := (TLayer(f.LayerHandle).Visible = lost);
if (not invis) and (not f.InClip) and
((LayerNbr = 0) or (f.LayerHandle = LongInt(PCad.Layers[LayerNbr])))
then
begin
if not f.LockSelect then
begin
if f is Tnet then
begin
TNet(f).SelType := stStruct;
TNet(f).SelIndex := 0;
end;
if f.Selected then
f.Deselect
else
begin
if CheckFigureByClassName(f, cTConnectorObject) then
begin
if TConnectorObject(f).ConnectorType <> ct_Clear then
begin
f.Select;
PCad.FAnySelected := true;
end;
end
else
begin
f.Select;
PCad.FAnySelected := true;
end;
end;
end;
end;
end;
PCad.ReDrawSelection;
PCad.SyncEnv;
end;
procedure TF_CAD.InvertAllSelection;
var
i, a: integer;
f: TFigure;
invis: Boolean;
layer: TLayer;
LayerNbr: integer;
begin
LayerNbr := PCad.ActiveLayer;
If (LayerNbr < 0) or (LayerNbr > PCad.Layers.Count - 1) then
exit;
for a := 0 to PCad.figures.count - 1 do
begin
f := TFigure(PCad.figures[a]);
invis := false;
if (f.LayerHandle <> 0) then
invis := (TLayer(f.LayerHandle).Visible = lost);
if (not invis) and (not f.InClip) and
((LayerNbr = 0) or (f.LayerHandle = LongInt(PCad.Layers[LayerNbr])))
then
begin
if not f.LockSelect then
begin
if f is Tnet then
begin
TNet(f).SelType := stStruct;
TNet(f).SelIndex := 0;
end;
if f.Selected then
f.Deselect
else
begin
f.Select;
PCad.FAnySelected := true;
end;
end;
end;
// åñëè íà ïîäëîæêå, à ôèãóðà íà ÄÕÔ ñëîå
if (not invis) and (not f.InClip) and
((LayerNbr = 1) and TLayer(f.LayerHandle).IsDxf {CheckFigureInDXFLayer(f)})
then
begin
if not f.LockSelect then
begin
if f.Selected then
f.Deselect
else
begin
f.Select;
PCad.FAnySelected := true;
end;
end;
end;
end;
PCad.ReDrawSelection;
PCad.SyncEnv;
end;
procedure TF_CAD.WriteOnClickParam(Const Value: Boolean);
begin
if CreateOnClick = Value then
exit;
CreateOnClick := Value;
if not Value then
begin
DestroyShadowObject;
// Pcad.DestroyCreatedOnDropGuides; //Óäàëÿåò âðåìåííûå íàïðàâëÿþùèå
end;
end;
procedure TF_CAD.DrawGuidesOnDrop(X, Y: Double);
var
Z,hX,hY: Double;
GL: TGuideLine;
begin
try
hX := X; hY := Y;
if not Pcad.CalculateSnapPoint(X,Y) then
// if GCadForm.FCreateObjectOnClick then
begin
if not PCad.SnapToGuides then //Åñëè îòêëþ÷åíâ ïðèâÿçêà
begin
PCad.SnapToGuides := true; //êâëþ÷àåì å¸
FSCS_Main.aSnaptoGuides.Checked := true; //äåëàåì Check êíîïêå
end;
//if not PCad.GuidesVisible then //Åñëè îòêëþ÷åíî îòîáðàæåíèå íàïðÿâëÿþùèõ
//begin
// PCad.GuidesVisible := true; //âêëþ÷àåì èõ
// FSCS_Main.aShowGuideLines.Checked := true;
//end;
Pcad.ConvertXY(X,Y,Z); //êîíâåðòàöèÿ êîîðäèíàò
if not Pcad.CheckForExistGuide(hX,hY,gtHorz) then //åñëè íåò òàêîé íàïðÿâëÿþùåé
begin
DragState := dsHRuler;
Pcad.DrawGuideOnSurface(Round(x),round(y),gtHorz); //ñîçäàåì ãîðèçîíòàëüíóþ íàïðàâëÿþùóþ
//Ìàõíóòü ìåñòàìè Èôû
// if Pcad.CheckAndGetGuideDrop(Round(X),round(Y),GL) then //äîáàâëÿåì èõ â Guides
if Pcad.CheckForGuideDrop(Round(X),round(Y)) then //äîáàâëÿåì èõ â Guides
begin
//Ðàçëî÷èòü, åñëè ïîòðåáóåòñÿ óäàëåíèå íàïðàâëÿþùèõ
// Pcad.GuidesCreatedOnDropCompon.Add(GL); //Çàïîìèíàåì âðåìåííûå íàïðàâëÿþùèå
end;
end;
if not Pcad.CheckForExistGuide(hX,hY,gtVert) then //Âñå òî æå ñàìîå ñ âåðòèêàëüíîé
begin
DragState := dsVRuler;
Pcad.DrawGuideOnSurface(Round(x),round(y),gtVert);
//Ìàõíóòü ìåñòàìè Èôû
// if Pcad.CheckAndGetGuideDrop(Round(X),round(Y),GL) then
if Pcad.CheckForGuideDrop(Round(X),round(Y)) then
begin
//Ðàçëî÷èòü, åñëè ïîòðåáóåòñÿ óäàëåíèå íàïðàâëÿþùèõ
// Pcad.GuidesCreatedOnDropCompon.Add(GL);
dragState := dsNone;
Pcad.Refresh; //ðåôðåøèì
PCad.repaint; //è ïåðåðèñîâûâàåì íà âñÿê ñëó÷àé :)
end;
end;
end;
CanChangeDownCoord := true;
except
end;
end;
procedure TF_CAD.ShowHintIFFigInsideCab(X, Y: Double);
var
DropFigure: TFigure;
begin
if CheckFigure = nil then
begin
DropFigure := CheckBySCSObjects(X, Y);
if DropFigure <> nil then
begin
Pcad.CheckFigureInsideCabinet(Pcad.Figures, DropFigure);
if DropFigure.InsideCabinet then
ShowHintRzR('This is an unroutable area. You cannot place anything here!', 2000);
end;
end;
CanChangeDownCoord := true;
end;
end.
Reference in New Issue View Git Blame Copy Permalink