mirror of
http://gitlab.expertsoft.com.ua/git/expertcad
synced 2026-01-11 22:45:39 +02:00
488 lines
13 KiB
ObjectPascal
488 lines
13 KiB
ObjectPascal
unit U_InterfacesAutoTrace;
|
||
|
||
interface
|
||
|
||
uses
|
||
Windows, U_LNG, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
||
Dialogs, ComCtrls, cxLookAndFeelPainters, StdCtrls, cxButtons,
|
||
/// PowerCad
|
||
PCPanel, PCDrawBox, PCDrawing, PowerCad, PCTypesUtils,
|
||
DrawObjects, ExtDlgs, PCLayerDlg, OleCtnrs, PCgui, GuiStrings,
|
||
DrawEngine, U_ESCadClasess, RzTabs, ExtCtrls, siComp, siLngLnk, cxGraphics,
|
||
cxLookAndFeels, Menus;
|
||
|
||
|
||
type
|
||
TF_InterfacesAutoTrace = class(TForm)
|
||
PageAutoTrace: TRzPageControl;
|
||
TabInterfaces: TRzTabSheet;
|
||
TabCables: TRzTabSheet;
|
||
Label1: TLabel;
|
||
ListView_Interfaces: TListView;
|
||
bCancel1: TcxButton;
|
||
bThen: TcxButton;
|
||
Label2: TLabel;
|
||
ListView_Cables: TListView;
|
||
bBack1: TcxButton;
|
||
bCancel2: TcxButton;
|
||
bBack2: TcxButton;
|
||
bOK: TcxButton;
|
||
Label3: TLabel;
|
||
Label4: TLabel;
|
||
lbServerAsDefault: TLabel;
|
||
Label5: TLabel;
|
||
Timer_Hint: TTimer;
|
||
lng_Forms: TsiLangLinked;
|
||
procedure bCancel1Click(Sender: TObject);
|
||
procedure bThenClick(Sender: TObject);
|
||
procedure ListView_InterfacesSelectItem(Sender: TObject;
|
||
Item: TListItem; Selected: Boolean);
|
||
procedure FormShow(Sender: TObject);
|
||
procedure ListView_CablesSelectItem(Sender: TObject; Item: TListItem;
|
||
Selected: Boolean);
|
||
procedure bBack2Click(Sender: TObject);
|
||
procedure bOKClick(Sender: TObject);
|
||
procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
||
procedure FormActivate(Sender: TObject);
|
||
procedure ListView_CablesMouseMove(Sender: TObject; Shift: TShiftState;
|
||
X, Y: Integer);
|
||
procedure Timer_HintTimer(Sender: TObject);
|
||
procedure TabCablesMouseMove(Sender: TObject; Shift: TShiftState; X,
|
||
Y: Integer);
|
||
private
|
||
FLastOnHintListItem: TListItem;
|
||
public
|
||
procedure LoadInterfaces;
|
||
Procedure LoadCables;
|
||
Procedure SelectObjectsWithInterfaces;
|
||
Procedure AutoTrace;
|
||
{ Public declarations }
|
||
end;
|
||
|
||
procedure Show_F_InterfacesAutoTraceForm;
|
||
|
||
var
|
||
F_InterfacesAutoTrace: TF_InterfacesAutoTrace;
|
||
|
||
implementation
|
||
uses USCS_Main, U_CAD, U_Common, U_BaseCommon, U_SCSComponent, U_AutoTraceType, U_Main, U_Constants;
|
||
|
||
{$R *.dfm}
|
||
|
||
procedure Show_F_InterfacesAutoTraceForm;
|
||
begin
|
||
try
|
||
F_InterfacesAutoTrace.PageAutoTrace.ActivePageIndex := 0;
|
||
F_InterfacesAutoTrace.bThen.Enabled := False;
|
||
F_InterfacesAutoTrace.lbServerAsDefault.Caption := GEndPoint.Name;
|
||
F_InterfacesAutoTrace.LoadInterfaces;
|
||
if F_InterfacesAutoTrace.ListView_Interfaces.Items.Count > 0 then
|
||
F_InterfacesAutoTrace.ShowModal;
|
||
F_InterfacesAutoTrace.ListView_Cables.Clear;
|
||
F_InterfacesAutoTrace.ListView_Interfaces.Clear;
|
||
except
|
||
on E: Exception do AddExceptionToLogEx('Show_F_InterfacesAutoTraceForm', E.Message);
|
||
end;
|
||
end;
|
||
|
||
procedure TF_InterfacesAutoTrace.bCancel1Click(Sender: TObject);
|
||
begin
|
||
Close;
|
||
end;
|
||
|
||
procedure TF_InterfacesAutoTrace.bThenClick(Sender: TObject);
|
||
begin
|
||
try
|
||
PageAutoTrace.ActivePageIndex := 1;
|
||
bOK.Enabled := False;
|
||
LoadCables;
|
||
except
|
||
on E: Exception do AddExceptionToLogEx('TF_InterfacesAutoTrace.bThenOKClick', E.Message);
|
||
end;
|
||
end;
|
||
|
||
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
procedure TF_InterfacesAutoTrace.LoadInterfaces;
|
||
var
|
||
i, j: integer;
|
||
ptrInterfItemParam: PIDAndCaption;
|
||
ParamList: TList;
|
||
ListItem: TListItem;
|
||
SubItems: TListItems;
|
||
Caption: string;
|
||
ID: Integer;
|
||
IDInterf: ^integer;
|
||
|
||
begin
|
||
try
|
||
ListView_Interfaces.Clear;
|
||
ParamList := GetFigureInterfacesToConnect(GEndPoint.ID);
|
||
if ParamList <> nil then
|
||
begin
|
||
ListView_Interfaces.Items.BeginUpdate;
|
||
try
|
||
for i := 0 to ParamList.Count - 1 do
|
||
begin
|
||
ptrInterfItemParam := PIDAndCaption(ParamList[i]);
|
||
Caption := ptrInterfItemParam.Caption;
|
||
ID := ptrInterfItemParam.ID;
|
||
ListItem := ListView_Interfaces.Items.Add;
|
||
|
||
ListItem.Caption := Caption;
|
||
New(IDInterf);
|
||
IDInterf^ := ID;
|
||
ListItem.Data := IDInterf;
|
||
end;
|
||
ListView_Interfaces.SortType := stText;
|
||
finally
|
||
ListView_Interfaces.Items.EndUpdate;
|
||
FreeList(ParamList);
|
||
end;
|
||
end
|
||
else
|
||
begin
|
||
if TConnectorObject(GEndPoint).ConnectorType = ct_Clear then
|
||
begin
|
||
ShowMessage(cInterfacesAutoTrace_Mes1);
|
||
end
|
||
else
|
||
begin
|
||
ShowMessage(cInterfacesAutoTrace_Mes2);
|
||
end;
|
||
end;
|
||
except
|
||
on E: Exception do AddExceptionToLogEx('TF_InterfacesAutoTrace.LoadInterfaces', E.Message);
|
||
end;
|
||
end;
|
||
|
||
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
procedure TF_InterfacesAutoTrace.LoadCables;
|
||
var
|
||
i, j: integer;
|
||
ParamList: TList;
|
||
ListItem: TListItem;
|
||
IDInterf: ^integer;
|
||
SCSCompon: TSCSComponent;
|
||
ID: Integer;
|
||
Caption: string;
|
||
ArtNumber: string;
|
||
ProducerName: String;
|
||
|
||
begin
|
||
try
|
||
ListView_Cables.Clear;
|
||
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> ID <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
ListItem := ListView_Interfaces.Selected;
|
||
IDInterf := ListItem.Data;
|
||
ID := IDInterf^;
|
||
|
||
ProcessMessagesEx;
|
||
Screen.Cursor := crHourGlass;
|
||
try
|
||
ParamList := GetIDLineComponFromNBByIDInterface(ID);
|
||
if ParamList.Count > 0 then
|
||
begin
|
||
ListView_Cables.Items.BeginUpdate;
|
||
try
|
||
for i := 0 to ParamList.Count - 1 do
|
||
begin
|
||
SCSCompon := TSCSComponent(ParamList[i]);
|
||
ID := SCSCompon.ID;
|
||
Caption := SCSCompon.Name;
|
||
ArtNumber := SCSCompon.ArticulProducer;
|
||
ProducerName := SCSCompon.GetProducerName;
|
||
|
||
ListItem := ListView_Cables.Items.Add;
|
||
ListItem.Caption := ArtNumber;
|
||
ListItem.SubItems.Add(Caption);
|
||
ListItem.SubItems.Add(ProducerName);
|
||
New(IDInterf);
|
||
IDInterf^ := ID;
|
||
ListItem.Data := IDInterf;
|
||
end;
|
||
finally
|
||
ListView_Cables.Items.EndUpdate;
|
||
end;
|
||
end;
|
||
FreeList(ParamList);
|
||
finally
|
||
Screen.Cursor := crDefault;
|
||
end;
|
||
except
|
||
on E: Exception do AddExceptionToLogEx('TF_InterfacesAutoTrace.LoadCables', E.Message);
|
||
end;
|
||
end;
|
||
|
||
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
procedure TF_InterfacesAutoTrace.SelectObjectsWithInterfaces;
|
||
var
|
||
i: integer;
|
||
ID: Integer;
|
||
IDInterf: ^Integer;
|
||
ObjList: TList;
|
||
InterfIDList: TList;
|
||
LCount, FCount: Integer;
|
||
SelectedList: TList;
|
||
begin
|
||
try
|
||
InterfIDList := TList.Create;
|
||
New(IDInterf);
|
||
IDInterf := ListView_Interfaces.Selected.Data;
|
||
InterfIDList.Add(IDInterf);
|
||
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
ObjList := GetConnectorsByInterfaces(InterfIDList);
|
||
FreeAndNil(InterfIDList);
|
||
if ObjList = nil then
|
||
Exit;
|
||
|
||
// <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
if GCadForm.FAutoTraceBySelected then
|
||
begin
|
||
SelectedList := TList.Create;
|
||
for i := 0 to GCadForm.PCad.SelectedCount - 1 do
|
||
SelectedList.Add(TFigure(GCadForm.PCad.Selection[i]));
|
||
GCadForm.PCad.DeselectAll(2);
|
||
for LCount := 0 to ObjList.Count - 1 do
|
||
begin
|
||
IDInterf := ObjList[LCount];
|
||
ID := IDInterf^;
|
||
for FCount := 0 to SelectedList.Count - 1 do
|
||
begin
|
||
if CheckFigureByClassName(TFigure(SelectedList[FCount]), cTConnectorObject) then
|
||
if TFigure(SelectedList[FCount]).ID = ID then
|
||
TConnectorObject(SelectedList[FCount]).Select;
|
||
end;
|
||
end;
|
||
FreeAndNil(SelectedList);
|
||
end
|
||
else
|
||
// <20><> <20><><EFBFBD><EFBFBD>
|
||
begin
|
||
GCadForm.PCad.DeselectAll(2);
|
||
for LCount := 0 to ObjList.Count - 1 do
|
||
begin
|
||
IDInterf := ObjList[LCount];
|
||
ID := IDInterf^;
|
||
for FCount := 0 to GCadForm.PCad.FigureCount - 1 do
|
||
begin
|
||
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[FCount]), cTConnectorObject) then
|
||
if TFigure(GCadForm.PCad.Figures[FCount]).ID = ID then
|
||
TConnectorObject(GCadForm.PCad.Figures[FCount]).Select;
|
||
end;
|
||
end
|
||
end;
|
||
// Tolik -- 04/10/2017 --
|
||
// FreeAndNil(ObjList); -- <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
FreeList(ObjList);
|
||
//
|
||
RefreshCAD(GCadForm.PCad);
|
||
except
|
||
on E: Exception do AddExceptionToLogEx('TF_InterfacesAutoTrace.SelectObjectsWithInterfaces', E.Message);
|
||
end;
|
||
end;
|
||
|
||
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
procedure TF_InterfacesAutoTrace.AutoTrace;
|
||
var
|
||
i, j: integer;
|
||
ComponID: Integer;
|
||
IDCable: Integer;
|
||
IDInterf: ^Integer;
|
||
TracedList: TList;
|
||
begin
|
||
BeginProgress;
|
||
try
|
||
TracedList := TList.Create;
|
||
New(IDInterf);
|
||
IDInterf := ListView_Cables.Selected.Data;
|
||
IDCable := IDInterf^;
|
||
|
||
for i := 0 to GCadForm.PCad.SelectedCount - 1 do
|
||
begin
|
||
TracedList.Add(TFigure(GCadForm.PCad.Selection[i]));
|
||
end;
|
||
DoAutoTraceCycle(TracedList, IDCable);
|
||
if TracedList <> nil then
|
||
FreeAndNil(TracedList);
|
||
if IDInterf <> nil then
|
||
FreeMem(IDInterf);
|
||
|
||
AddNBComponGUIDToFreqUseObjByID(IDCable);
|
||
except
|
||
on E: Exception do AddExceptionToLogEx('TF_InterfacesAutoTrace.AutoTraceCable', E.Message);
|
||
end;
|
||
EndProgress;
|
||
end;
|
||
|
||
|
||
procedure TF_InterfacesAutoTrace.ListView_InterfacesSelectItem(
|
||
Sender: TObject; Item: TListItem; Selected: Boolean);
|
||
begin
|
||
try
|
||
if ListView_Interfaces.Selected <> nil then
|
||
begin
|
||
bThen.Enabled := True;
|
||
SelectObjectsWithInterfaces;
|
||
end
|
||
else
|
||
begin
|
||
bThen.Enabled := False;
|
||
if not GCadForm.FAutoTraceBySelected then
|
||
GCadForm.PCad.DeselectAll(2);
|
||
end;
|
||
except
|
||
on E: Exception do AddExceptionToLogEx('TF_InterfacesAutoTrace.ListView_InterfacesSelectItem', E.Message);
|
||
end;
|
||
end;
|
||
|
||
procedure TF_InterfacesAutoTrace.FormShow(Sender: TObject);
|
||
begin
|
||
FLastOnHintListItem := nil;
|
||
end;
|
||
|
||
procedure TF_InterfacesAutoTrace.ListView_CablesSelectItem(Sender: TObject;
|
||
Item: TListItem; Selected: Boolean);
|
||
var
|
||
IDInterf: ^Integer;
|
||
ID: Integer;
|
||
begin
|
||
try
|
||
if ListView_Cables.Selected <> nil then
|
||
begin
|
||
bOK.Enabled := True;
|
||
IDInterf := ListView_Cables.Selected.Data;
|
||
ID := IDInterf^;
|
||
SelectComponentInNB(ID);
|
||
end
|
||
else
|
||
bOK.Enabled := False;
|
||
except
|
||
on E: Exception do AddExceptionToLogEx('TF_InterfacesAutoTrace.ListView_CablesSelectItem', E.Message);
|
||
end;
|
||
end;
|
||
|
||
procedure TF_InterfacesAutoTrace.bBack2Click(Sender: TObject);
|
||
begin
|
||
try
|
||
PageAutoTrace.ActivePageIndex := 0;
|
||
except
|
||
on E: Exception do AddExceptionToLogEx('TF_InterfacesAutoTrace.bBack2Click', E.Message);
|
||
end;
|
||
end;
|
||
|
||
procedure TF_InterfacesAutoTrace.bOKClick(Sender: TObject);
|
||
var
|
||
i: integer;
|
||
begin
|
||
try
|
||
AutoTrace;
|
||
Close;
|
||
except
|
||
on E: Exception do AddExceptionToLogEx('TF_InterfacesAutoTrace.bOKClick', E.Message);
|
||
end;
|
||
end;
|
||
|
||
procedure TF_InterfacesAutoTrace.FormClose(Sender: TObject; var Action: TCloseAction);
|
||
begin
|
||
try
|
||
HideHintInCursorPos;
|
||
except
|
||
on E: Exception do AddExceptionToLogEx('TF_InterfacesAutoTrace.FormClose', E.Message);
|
||
end;
|
||
// Action := caFree;
|
||
end;
|
||
|
||
procedure TF_InterfacesAutoTrace.FormActivate(Sender: TObject);
|
||
begin
|
||
try
|
||
Close;
|
||
except
|
||
on E: Exception do AddExceptionToLogEx('TF_InterfacesAutoTrace.FormActivate', E.Message);
|
||
end;
|
||
end;
|
||
|
||
procedure TF_InterfacesAutoTrace.ListView_CablesMouseMove(Sender: TObject;
|
||
Shift: TShiftState; X, Y: Integer);
|
||
const
|
||
Bound = 2;
|
||
var
|
||
ListItem: TListItem;
|
||
begin
|
||
try
|
||
ListItem := nil;
|
||
ListItem := ListView_Cables.GetItemAt(X, Y);
|
||
if ListItem <> nil then
|
||
begin
|
||
if ListItem <> FLastOnHintListItem then
|
||
begin
|
||
HideHintInCursorPos;
|
||
FLastOnHintListItem := ListItem;
|
||
RestartTimer(Timer_Hint);
|
||
end;
|
||
end
|
||
else
|
||
begin
|
||
FLastOnHintListItem := nil;
|
||
HideHintInCursorPos;
|
||
end;
|
||
except
|
||
on E: Exception do AddExceptionToLogEx('TF_InterfacesAutoTrace.ListView_CablesMouseMove', E.Message);
|
||
end;
|
||
end;
|
||
|
||
procedure TF_InterfacesAutoTrace.TabCablesMouseMove(Sender: TObject;
|
||
Shift: TShiftState; X, Y: Integer);
|
||
begin
|
||
try
|
||
if FLastOnHintListItem <> nil then
|
||
begin
|
||
FLastOnHintListItem := nil;
|
||
HideHintInCursorPos;
|
||
end;
|
||
except
|
||
on E: Exception do AddExceptionToLogEx('TF_InterfacesAutoTrace.TabCablesMouseMove', E.Message);
|
||
end;
|
||
end;
|
||
|
||
|
||
procedure TF_InterfacesAutoTrace.Timer_HintTimer(Sender: TObject);
|
||
var
|
||
ListItem: TListItem;
|
||
CursorPos: TPoint;
|
||
|
||
Node: TTreeNode;
|
||
NodeText: String;
|
||
IDCable: Integer;
|
||
TextForHint: String;
|
||
begin
|
||
try
|
||
TTimer(Sender).Enabled := false;
|
||
|
||
GetCursorPos(CursorPos);
|
||
CursorPos := ListView_Cables.ScreenToClient(CursorPos);
|
||
ListItem := ListView_Cables.GetItemAt(CursorPos.X, CursorPos.Y);
|
||
|
||
if ListItem <> nil then
|
||
begin
|
||
Node := nil;
|
||
TextForHint := '';
|
||
IDCable := Integer(ListItem.Data^);
|
||
if IDCable > 0 then
|
||
Node := F_NormBase.FindComponOrDirInTree(IDCable, true);
|
||
while Node <> nil do
|
||
begin
|
||
NodeText := Node.Text;
|
||
CutColFromStr(NodeText);
|
||
TextForHint := '\' + NodeText + TextForHint;
|
||
Node := Node.Parent;
|
||
end;
|
||
if TextForHint <> '' then
|
||
ShowHintInCursorPos(TextForHint, 0);
|
||
end;
|
||
except
|
||
on E: Exception do AddExceptionToLogEx('TF_InterfacesAutoTrace.Timer_HintTimer', E.Message);
|
||
end;
|
||
end;
|
||
|
||
end.
|