unit U_TestMy; {$J+} interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, PCPanel, PCDrawBox, PCDrawing, PowerCad, StdCtrls, pcMsbar, ComCtrls, ToolWin, PCTypesUtils,DrawObjects,Menus, DlgBase, ExtDlgs, PCLayerDlg, OleCtnrs,buttons, PCgui,GuiStrings, DrawEngine, U_ESCadClasess, U_Common, U_SCSEngineTest; type TForm1 = class(TForm) PowerCad1: TPowerCad; Panel1: TPanel; bOrthoLine: TButton; bSelected: TButton; cbAngle: TComboBox; bDuplicate: TButton; bNormal: TButton; bbComp: TBitBtn; bbServer: TBitBtn; bSetScale: TButton; bLineTest: TButton; bRectTest: TButton; bDisconnect: TButton; bDivideLine: TButton; Bevel1: TBevel; Label1: TLabel; Label2: TLabel; Memo2: TMemo; Memo3: TMemo; Label3: TLabel; Button3: TButton; Button1: TButton; Button2: TButton; Button4: TButton; ComboBox1: TComboBox; Button5: TButton; Memo1: TMemo; procedure FormCreate(Sender: TObject); procedure bOrthoLineClick(Sender: TObject); procedure bFigGroupClick(Sender: TObject); procedure bSelectedClick(Sender: TObject); procedure bLineTestClick(Sender: TObject); procedure PowerCad1SurfaceMove(Sender: TObject; Shift: TShiftState; X, Y: Double); procedure bDuplicateClick(Sender: TObject); procedure FormShow(Sender: TObject); procedure bNormalClick(Sender: TObject); procedure PowerCad1BeforeDelete(Sender: TObject; Figure: TFigure; var CanDelete: Boolean); procedure PowerCad1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure PowerCad1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); procedure bbCompClick(Sender: TObject); procedure bbServerClick(Sender: TObject); procedure bSetScaleClick(Sender: TObject); procedure bRectTestClick(Sender: TObject); procedure PowerCad1FigureMoved(Sender: TObject; Figure: TFigure; dx, dy: Double); procedure bDisconnectClick(Sender: TObject); procedure bDivideLineClick(Sender: TObject); procedure Button3Click(Sender: TObject); procedure Memo2Change(Sender: TObject); procedure cbAngleChange(Sender: TObject); procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button4Click(Sender: TObject); procedure Button5Click(Sender: TObject); procedure PowerCad1GUIEvent(Sender: TObject; EventId, Numval: Integer; StrVal: String; DblVal: Double; CEnable: Boolean); private { Private declarations } public { Public declarations } end; var Form1: TForm1; CurFigure: TFigure; grpNormal, grpComp, grpServer: TFigureGrpMod; Text_str: string; implementation {$R *.dfm} procedure TForm1.bSelectedClick(Sender: TObject); begin PowerCad1.SetTool(toSelect, 'TSelected'); end; procedure TForm1.bOrthoLineClick(Sender: TObject); begin // GDefaultConnectorObject := grpNormal; GCurrentConnectorType := ct_Clear; PowerCad1.SetTool(toFigure, 'TOrthoLine'); end; procedure TForm1.bFigGroupClick(Sender: TObject); begin // GDefaultConnectorObject := grpNormal; GCurrentConnectorType := ct_Clear; PowerCad1.SetTool(toFigure, 'TFigGroup'); end; procedure TForm1.bbCompClick(Sender: TObject); begin // GDefaultConnectorObject := grpComp; GCurrentConnectorType := ct_WorkArea; PowerCad1.SetTool(toFigure, 'TConnectorObject'); end; procedure TForm1.bbServerClick(Sender: TObject); begin // GDefaultConnectorObject := grpServer; GCurrentConnectorType := ct_Server; PowerCad1.SetTool(toFigure, 'TConnectorObject'); end; procedure TForm1.bLineTestClick(Sender: TObject); begin PowerCad1.SetTool(toFigure, 'TLine'); end; procedure TForm1.PowerCad1SurfaceMove(Sender: TObject; Shift: TShiftState; X, Y: Double); begin GCadControl := Sender as TPowercad; if GCadControl.ToolIdx = toSelect then begin CurFigure := GCadControl.CheckByPoint(GCadControl.ActiveLayer, X, Y); if (CurFigure is TOrthoLine) then GCadControl.SetCursor(crSizeAll) else if (CurFigure is TConnectorObject) then GCadControl.SetCursor(crHandPoint) else GCadControl.SetCursor(crDefault); end; if GCadControl.ToolInfo = 'TOrthoLine' then begin FigureTraceTo := GCadControl.CheckByPoint(0, X, Y); if FigureTraceTo <> nil then begin //если найденный обьект - коннектор if (FigureTraceTo is TConnectorObject) then begin GCadControl.DEngine.canvas.pen.Style := psSolid; GCadControl.DEngine.DrawRect(FigureTraceTo.ActualPoints[1].x - TConnectorObject(FigureTraceTo).GrpSizeX/2, FigureTraceTo.ActualPoints[1].y - TConnectorObject(FigureTraceTo).GrpSizeY/2, FigureTraceTo.ActualPoints[1].x + TConnectorObject(FigureTraceTo).GrpSizeX/2, FigureTraceTo.ActualPoints[2].y + TConnectorObject(FigureTraceTo).GrpSizeY/2, GCadControl.DEngine.canvas.pen.Color, 1, integer(GCadControl.DEngine.canvas.pen.Style), GCadControl.DEngine.canvas.Brush.Color, integer(GCadControl.DEngine.canvas.Brush.Style)); end; //Если найденный обьект - ортолиния if (FigureTraceTo is TOrthoLine) then begin // GCadControl.DEngine.DrawLine(FigureTraceTo.ActualPoints[1], FigureTraceTo.ActualPoints[2]); end; end; end; end; procedure TForm1.bDuplicateClick(Sender: TObject); var i: integer; LHandle: integer; Fig: TFigure; c, o, t: integer; Connector: array of TFigure; Ortho: array of TFigure; TextO: array of TFigure; begin LHandle := PowerCad1.GetLayerHandle(0); c := 0; o := 0; t := 0; SetLength(Connector, 10); SetLength(Ortho, 10); SetLength(TextO, 10); if PowerCad1.Selection.Count < 1 then Exit; for i := 0 to PowerCad1.Selection.Count - 1 do begin if TFigure(PowerCad1.Selection[i]) is TConnectorObject then //Connector begin Fig := TConnectorObject(PowerCad1.Selection[i]).Duplicate; PowerCad1.AddCustomFigure(LHandle, Fig, false); inc(c); Connector[c] := Fig; end; if TFigure(PowerCad1.Selection[i]) is TOrthoLine then //OrthoLine begin Fig := TOrthoLine(PowerCad1.Selection[i]).Duplicate; PowerCad1.AddCustomFigure(LHandle, Fig, false); inc(o); Ortho[o] := Fig; end; end; //Connections----------------------------------------------------------------- for i := 1 to c - 1 do begin TOrthoLine(Ortho[i]).SetJFigure1(TConnectorObject(Connector[i])); TOrthoLine(Ortho[i]).SetJFigure2(TConnectorObject(Connector[i + 1])); end; PowerCad1.Refresh; PowerCad1.DeselectAll(0); end; procedure TForm1.FormShow(Sender: TObject); var RectNormal: TRectangle; Bit: TBMPObject; begin { grpNormal := TFigureGrpMod.create(0, nil); grpComp := TFigureGrpMod.create(0, nil); grpserver := TFigureGrpMod.create(0, nil); RectNormal := TRectangle.create(-103,-103,-100,-100,1,ord(psSolid),clBlack,ord(psSolid),clBlack,0,mydsNormal,nil); grpNormal.AddFigure(RectNormal); Bit := TBMPObject.create(-100,-100, 'Pics\Comp.bmp', 0, mydsNormal, nil); Bit.PictureName := ''; Bit.Transparent := True; Bit.Style := ord(psClear); grpComp.AddFigure(Bit); Bit:= TBMPObject.create(-100,-100, 'Pics\Server.bmp', 0, mydsNormal, nil); Bit.PictureName := ''; Bit.Transparent := True; Bit.Style := ord(psClear); grpServer.AddFigure(Bit); with TFigure(PowerCad1.AddCustomFigure(0, grpNormal, false)) do Style := ord(psSolid); with TFigure(PowerCad1.AddCustomFigure(0, GrpComp, false)) do Style := ord(psClear); with TFigure(PowerCad1.AddCustomFigure(0, grpServer, false)) do Style := ord(psClear); } end; procedure TForm1.bNormalClick(Sender: TObject); begin // GDefaultConnectorObject := grpNormal; GCurrentConnectorType := ct_Clear; PowerCad1.SetTool(toFigure, 'TConnectorObject'); end; procedure TForm1.bSetScaleClick(Sender: TObject); var i: integer; begin // PowerCad1.MapScale := StrToInt(MScale.Text); PowerCad1.Refresh; { GCadControl.SelectAll(0); for i := 0 to GCadControl.Selection.Count - 1 do begin if TFigure(GCadControl.Selection[i]) is TOrthoLine then TTextMod(TOrthoLine(GCadControl.Selection[i]).TextBox).Text := TOrthoLine(GCadControl.Selection[i]).LenghtCalc(TOrthoLine(GCadControl.Selection[i]).ActualPoints[1].x, TOrthoLine(GCadControl.Selection[i]).ActualPoints[1].y, TOrthoLine(GCadControl.Selection[i]).ActualZOrder[1], TOrthoLine(GCadControl.Selection[i]).ActualPoints[2].x, TOrthoLine(GCadControl.Selection[i]).ActualPoints[2].y, TOrthoLine(GCadControl.Selection[i]).ActualZOrder[2]); end; Powercad1.Refresh; GCadControl.DeselectAll(0); } end; procedure TForm1.PowerCad1FigureMoved(Sender: TObject; Figure: TFigure; dx, dy: Double); var jf:TFigure; begin end; procedure TForm1.bRectTestClick(Sender: TObject); begin PowerCad1.SetTool(toFigure, 'TRectangle'); end; procedure TForm1.bDisconnectClick(Sender: TObject); var DisConnectFigure: TConnectorObject; ReplaceConnector, NextConnector: TConnectorObject; JoinedLine1, JoinedLine2: TOrthoLine; i: integer; begin if GCadControl.Selection.Count <> 1 then Exit; if Not (TFigure(GCadControl.Selection[0]) is TConnectorObject) then Exit; DisConnectFigure := TConnectorObject(GCadControl.Selection[0]); if DisConnectFigure.JoinedFigures.Count = 1 then begin // GDefaultConnectorObject := grpNormal; GCurrentConnectorType := ct_Clear; if DisConnectFigure.ConnectorType = ct_Clear then Exit; ReplaceConnector := TConnectorObject.Create(DisConnectFigure.ActualPoints[1].x, DisConnectFigure.ActualPoints[1].y, DisConnectFigure.ActualZOrder[1], DisConnectFigure.ActualPoints[2].x, DisConnectFigure.ActualPoints[2].y, DisConnectFigure.ActualZOrder[2], 0, mydsNormal, nil); GCadControl.AddCustomFigure(0, ReplaceConnector, false); if DisConnectFigure = TOrthoLine(DisConnectFigure.JoinedFigures[0]).JoinFigure1 then TOrthoLine(DisConnectFigure.JoinedFigures[0]).SetJFigure1(ReplaceConnector); if DisConnectFigure = TOrthoLine(DisConnectFigure.JoinedFigures[0]).JoinFigure2 then TOrthoLine(DisConnectFigure.JoinedFigures[0]).SetJFigure2(ReplaceConnector); DisConnectFigure.JoinedFigures.Clear; DisConnectFigure.Move(5,2); GCadControl.Refresh; end; if DisConnectFigure.JoinedFigures.Count = 2 then begin JoinedLine1 := TOrthoLine(DisConnectFigure.JoinedFigures[0]); JoinedLine2 := TOrthoLine(DisConnectFigure.JoinedFigures[1]); if JoinedLine2.JoinFigure1 = DisConnectFigure then begin NextConnector := TConnectorObject(JoinedLine2.JoinFigure2); JoinedLine1.SetJFigure2(NextConnector); JoinedLine1.ActualPoints[2] := DoublePoint(NextConnector.ActualPoints[1].x, NextConnector.ActualPoints[1].y); end else if JoinedLine2.JoinFigure2 = DisConnectFigure then begin NextConnector := TConnectorObject(JoinedLine2.JoinFigure1); JoinedLine1.SetJFigure1(NextConnector); JoinedLine1.ActualPoints[1] := DoublePoint(NextConnector.ActualPoints[1].x, NextConnector.ActualPoints[1].y); end; // Удалить вторую линию NextConnector.JoinedFigures.Remove(JoinedLine2); PowerCad1.OnBeforeDelete := nil; GTextHandle := TTextMod(TOrthoLine(JoinedLine2).TextBox); GCadControl.Figures.Delete(GCadControl.Figures.IndexOf(GTextHandle)); TTextMod(TOrthoLine(GTextHandle)).Free; GCadControl.Figures.Delete(GCadControl.Figures.IndexOf(JoinedLine2)); JoinedLine2.Free; PowerCad1.OnBeforeDelete := PowerCad1BeforeDelete; // Переприсвоение связей TOrthoLine(JoinedLine1).Move(0, 0); DisConnectFigure.JoinedFigures.Clear; DisConnectFigure.Move(5,2); GCadControl.Refresh; end; end; procedure TForm1.bDivideLineClick(Sender: TObject); var CurLine: TOrthoLine; AddLine: TOrthoLine; Connector1, Connector2: TConnectorObject; NextConnector: TConnectorObject; ModX, ModY, NextModX, NextModY: Double; TempDefaultNum: integer; begin if GCadControl.Selection.Count <> 1 then Exit; if Not(TFigure(GCadControl.Selection[0]) is TOrthoLine) then Exit; CurLine := TOrthoLine(GCadControl.Selection[0]); // GDefaultConnectorObject := grpNormal; GCurrentConnectorType := ct_Clear; NextConnector := TConnectorObject(CurLine.JoinFigure2); Modx := (CurLine.ActualPoints[1].x + CurLine.ActualPoints[2].x) / 2; Mody := (CurLine.ActualPoints[1].y + CurLine.ActualPoints[2].y) / 2; NextModx := (NextConnector.ActualPoints[1].x + NextConnector.ActualPoints[2].x) / 2; NextMody := (NextConnector.ActualPoints[1].y + NextConnector.ActualPoints[2].y) / 2; Connector1 := TConnectorObject.Create(Modx + 4, Mody + 2, ZOrderInit, Modx + 4, Mody + 2, ZOrderInit, 0, mydsNormal, nil); Connector1.ConnectorType := ct_Clear; Connector2 := TConnectorObject.Create(Modx, Mody, ZOrderInit, Modx, Mody, ZOrderInit, 0, mydsNormal, nil); Connector2.ConnectorType := ct_Clear; GCadControl.AddCustomFigure(0, Connector1, false); GCadControl.AddCustomFigure(0, Connector2, false); // При соединении конектора с линией, создается 2 линии // переназначение связей линии к которой присоединились новому коннектору CurLine.ActualPoints[2] := DoublePoint(Modx + 4, Mody + 2); TOrthoLine(CurLine).SetJFigure2(Connector1); NextConnector.JoinedFigures.Remove(CurLine); // добавить новую ортолинию TempDefaultNum := GDefaultNum; GDefaultNum := TOrthoLine(CurLine).FCount; AddLine := TOrthoLine.Create(Modx, Mody, ZOrderInit, NextModx, NextMody, ZOrderInit, 1,ord(psSolid), clBlack, 0, 0, mydsNormal, nil); GCadControl.AddCustomFigure(0, AddLine, false); GDefaultNum := TempDefaultNum; // присвоить связи новой ортолинии TOrthoLine(AddLine).SetJFigure1(Connector2); TOrthoLine(AddLine).SetJFigure2(NextConnector); Connector1.Select; Connector2.Select; NextConnector.Select; GCadControl.OrderSelection(osFront); GCadControl.DeselectAll(0); // перерасчет длины новой линии Text_str := TOrthoLine(CurLine).LenghtCalc(CurLine.ActualPoints[1].x, CurLine.ActualPoints[1].y, TOrthoLine(CurLine).ActualZOrder[1], CurLine.ActualPoints[2].x, CurLine.ActualPoints[2].y, TOrthoLine(CurLine).ActualZOrder[2]); TOrthoLine(CurLine).Move(0, 0); GCadControl.Refresh; end; procedure TForm1.Memo2Change(Sender: TObject); var s: string; i, code: integer; begin if TMemo(Sender).Text <> '' then begin s := TMemo(Sender).Text; val(s, i, code); if Sender = Memo2 then GDefaultGap := abs(i); if Sender = Memo3 then GDefaultNum := abs(i); end; end; procedure TForm1.cbAngleChange(Sender: TObject); var s: string; i, code: integer; begin if TComboBox(Sender).Text <> '' then begin s := TComboBox(Sender).Text; val(s, i, code); GDefaultAngle := abs(i); if GDefaultAngle = 0 then GDefaultAngle := 1; end; end; procedure TForm1.Button1Click(Sender: TObject); begin PowerCad1.SaveToFile(0, 'testmy'); end; procedure TForm1.Button2Click(Sender: TObject); var tmpstr: string; i: integer; begin PowerCad1.LoadFromFile('testmy'); for i := 0 to PowerCad1.FigureCount - 1 do begin try if TFigure(PowerCad1.Figures.Items[i]) is TConnectorObject then TConnectorObject(PowerCad1.Figures.Items[i]).SetConnections; if TFigure(PowerCad1.Figures.Items[i]) is TOrthoLine then TOrthoLine(PowerCad1.Figures.Items[i]).SetConnections; except end; end; tmpstr := TTextMod(PowerCad1.Figures.Items[2]).Name; end; procedure TForm1.Button4Click(Sender: TObject); var Fig1: TTextMod; LayH: integer; begin LayH := PowerCad1.GetLayerHandle(0); Fig1 := TTextMod.Create(20, 20, 0, 0, 'Test2', 'Arial', 1, clRed, LayH, mydsNormal, PowerCad1); PowerCad1.AddCustomFigure(0, Fig1, True); PowerCad1.Refresh; end; procedure TForm1.Button5Click(Sender: TObject); var Fig: TFigureGrpMod; begin Fig := Nil; case ComboBox1.ItemIndex of 0: Fig := SCSEngine.GetConnectorImg(ct_Clear); 1: Fig := SCSEngine.GetConnectorImg(ct_WorkArea); 2: Fig := SCSEngine.GetConnectorImg(ct_Server); end; end; // Пример глюков if procedure TForm1.Button3Click(Sender: TObject); var StrList: TStringList; i: integer; begin StrList := TStringList.Create; for i := 0 to 99 do StrList.Add(inttostr(i)); try for i := 0 to StrList.Count - 1 do begin StrList.Strings[i] := StrList.Strings[i]; if i = 50 then StrList.Delete(i) end; except Beep; end; i := 0; while i < StrList.Count do begin StrList.Strings[i] := StrList.Strings[i]; if i = 50 then StrList.Delete(i); inc(i); end; end; // Нужные процедуры procedure TForm1.FormCreate(Sender: TObject); begin ZOrderInit := 50; PowerCad1.RegisterFigureClass(TOrthoLine); PowerCad1.RegisterFigureClass(TConnectorObject); PowerCad1.RegisterFigureClass(TFigureGrpMod); PowerCad1.RegisterFigureClass(TTextMod); GCadControl := PowerCad1; GPCDrawing := TPCDrawing(PowerCad1); Memo2.Text := '4'; Memo3.Text := '2'; cbAngle.Text := '45'; GDefaultAngle := 45; LogMemo := Form1.Memo2; SCSEngine := TSCSEngine.Create(self); RemFigures := TList.Create; PowerCad1.OnBeforeDelete := PowerCad1BeforeDelete; PowerCad1.OnBeforeDelete := PowerCad1BeforeDelete; PowerCad1.OnGUIEvent := PowerCad1GUIEvent; PowerCad1.OnKeyDown := PowerCad1KeyDown; PowerCad1.OnKeyUp := PowerCad1KeyUp; end; procedure TForm1.PowerCad1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin GlobalShiftState := Shift; end; procedure TForm1.PowerCad1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); var i: integer; begin GlobalShiftState := Shift; if Key = 27 then begin inc(BackIndex); EscIndex := FClickIndex; end; end; procedure TForm1.PowerCad1BeforeDelete(Sender: TObject; Figure: TFigure; var CanDelete: Boolean); begin CanDelete := False; PowerCad1.OnBeforeDelete := nil; try // Удаление Конектора if Figure is TConnectorObject then begin TConnectorObject(Figure).Delete; end; // Удаление Ортолинии if Figure is TOrthoLine then begin TOrthoLine(Figure).Delete; end; finally PowerCad1.OnBeforeDelete := PowerCad1BeforeDelete; end; end; procedure TForm1.PowerCad1GUIEvent(Sender: TObject; EventId, Numval: Integer; StrVal: String; DblVal: Double; CEnable: Boolean); var i: integer; begin if EventId = 95 then begin if assigned(RemFigures) and (RemFigures.Count > 0) (*important!!!*) then begin i := 0; while i < RemFigures.Count do begin if Assigned(RemFigures[i]) then begin Powercad1.Figures.Remove(RemFigures[i]); TFigure(RemFigures[i]).Free; end; i := i + 1; end; RemFigures.Clear; Powercad1.Refresh; end; end; end; end.