mirror of
http://gitlab.expertsoft.com.ua/git/expertcad
synced 2026-01-11 22:45:39 +02:00
366 lines
11 KiB
ObjectPascal
366 lines
11 KiB
ObjectPascal
unit Unit1;
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
|
pcGUI, ExtCtrls, PCPanel, PCDrawBox, PCDrawing, PowerCad,FileCtrl,pcPluginDlg,
|
|
StdCtrls,PCTypesUtils, PCBlockDlg, PCLayerDlg, DlgBase, PCMacroDlg,DrawObjects,
|
|
StripedText,zHint,richedit2,Buttons, Menus,PCFillDlg;
|
|
|
|
type
|
|
TForm1 = class(TForm)
|
|
CadInterface1: TCadInterface;
|
|
PCMacroDialog1: TPCMacroDialog;
|
|
PCLayerDlg1: TPCLayerDlg;
|
|
PCBlockDlg1: TPCBlockDlg;
|
|
PCPluginDlg1: TPCPluginDlg;
|
|
PowerCad1: TPowerCad;
|
|
PCFillDlg1: TPCFillDlg;
|
|
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
|
procedure PowerCad1FileNameChange(Sender: TObject);
|
|
procedure PowerCad1UserDraw(Sender: TObject; CName: String; DC,
|
|
Figure: Integer; isGrayed: Boolean; var drawed: Boolean);
|
|
procedure PowerCad1UserHitTest(Sender: TObject; CName: String;
|
|
Figure: Integer; x, y: Double; var Test, Tested: Boolean);
|
|
procedure PowerCad1PopMenuClicked(Sender: TObject; MenuIndex: Integer);
|
|
procedure FormKeyDown(Sender: TObject; var Key: Word;
|
|
Shift: TShiftState);
|
|
procedure PowerCad1FigureEdit(Sender: TObject; Figure: TFigure);
|
|
function PowerCad1SnapToFigure(Sender: TObject; SnapFigure: TFigure;
|
|
var x, y: Double): Boolean;
|
|
procedure PowerCad1CustomCommand(Sender: TObject; ComName: String);
|
|
procedure Button1Click(Sender: TObject);
|
|
private
|
|
{ Private declarations }
|
|
public
|
|
{ Public declarations }
|
|
Procedure ImageCopy;
|
|
Procedure PrintPageAsWmf;
|
|
end;
|
|
|
|
var
|
|
Form1: TForm1;
|
|
|
|
implementation
|
|
|
|
uses DataForm;
|
|
|
|
{$R *.DFM}
|
|
|
|
procedure TForm1.FormCreate(Sender: TObject);
|
|
var PlgDir,MacroDir,BlockDir: String;
|
|
begin
|
|
PlgDir := '';
|
|
//RegRead('PlgDir',PlgDir);
|
|
//RegRead('MacroDir',MacroDir);
|
|
//RegRead('BlockDir',BlockDir);
|
|
|
|
//Powercad1.Brushlist.Add(TBitmap.Create);
|
|
//TBitmap(Powercad1.Brushlist[0]).LoadFromFile(extractfilepath(application.ExeName)+'brush1.bmp');
|
|
|
|
if (BlockDir = '') then
|
|
begin
|
|
if (not DirectoryExists(extractfilepath(application.ExeName)+'blocks')) then
|
|
CreateDir(extractfilepath(application.ExeName)+'blocks');
|
|
BlockDir := extractfilepath(application.ExeName)+'blocks'
|
|
end;
|
|
|
|
if (plgDir = '') then
|
|
begin
|
|
if (not DirectoryExists(extractfilepath(application.ExeName)+'plugins')) then
|
|
CreateDir(extractfilepath(application.ExeName)+'plugins');
|
|
PlgDir := extractfilepath(application.ExeName)+'plugins';
|
|
end;
|
|
if (MacroDir = '') then
|
|
begin
|
|
if (not DirectoryExists(extractfilepath(application.ExeName)+'macros')) then
|
|
CreateDir(extractfilepath(application.ExeName)+'macros');
|
|
MacroDir := extractfilepath(application.ExeName)+'macros';
|
|
end;
|
|
PCPluginDlg1.PluginsDirectory := plgDir;
|
|
PCBlockDlg1.BlockDirectory := BlockDir;
|
|
PCMacroDialog1.MacroDirectory := MacroDir;
|
|
|
|
if not FileExists(ExtractFilePath(application.exeName)+'Normal.dat') then begin
|
|
CadInterface1.RefreshAllInterface;
|
|
CadInterface1.SaveToFile(ExtractFilePath(application.exeName)+'Normal.dat');
|
|
end else begin
|
|
CadInterface1.LoadFromFile(ExtractFilePath(application.exeName)+'Normal.dat');
|
|
end;
|
|
|
|
Powercad1.RegisterFigureClass(TStripedText);
|
|
Powercad1.AutoTilePrint := False;
|
|
Powercad1.CustomPopItems := 'Draw Compass,Draw Striped Text,Clear Guides,Interbreak,Clear GuideLines,About';
|
|
Powercad1.Updated := False;
|
|
|
|
end;
|
|
|
|
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
|
|
begin
|
|
CadInterface1.SaveToFile(ExtractFilePath(application.exeName)+'Normal.dat');
|
|
if not Powercad1.ExitApplication then Action := caNone;
|
|
end;
|
|
|
|
procedure TForm1.PowerCad1FileNameChange(Sender: TObject);
|
|
begin
|
|
Caption := 'PowerDraw-'+Powercad1.ActiveFile;
|
|
end;
|
|
|
|
procedure TForm1.PowerCad1UserDraw(Sender: TObject; CName: String; DC,
|
|
Figure: Integer; isGrayed: Boolean; var drawed: Boolean);
|
|
var fig: TCircle;
|
|
rad: Double;
|
|
cp,p1,p2,p3,p4,p12,p23,p34,p41: TDoublePoint;
|
|
p: TPoint;
|
|
cnt: Integer;
|
|
pArr: Array [0..7] of TPOint;
|
|
xCanvas:TCanvas;
|
|
pen,oldpen:HPEN;
|
|
Brush,oldBrush:HBRUSH;
|
|
logb: TLogBrush;
|
|
Angle: Double;
|
|
z: Double;
|
|
mur: TVertex;
|
|
d1,d2: String;
|
|
procedure Line(l1,l2:TDoublePoint);
|
|
begin
|
|
MovetoEx(dc,round(l1.x),round(l1.y),@p);
|
|
LineTo(dc,round(l2.x),round(l2.y));
|
|
end;
|
|
begin
|
|
z := 0;
|
|
if Cname = 'Compass' then begin
|
|
fig := TCircle(Figure);
|
|
rad := fig.Radius;
|
|
cp := fig.ap1;
|
|
Angle := Fig.AngleToPoint;
|
|
p1 := DoublePoint(cp.x-rad,cp.y);
|
|
p2 := DoublePoint(cp.x,cp.y-rad);
|
|
p3 := DoublePoint(cp.x+rad,cp.y);
|
|
p4 := DoublePoint(cp.x,cp.y+rad);
|
|
p12 := DoublePoint(cp.x-rad,cp.y-rad);
|
|
p23 := DoublePoint(cp.x+rad,cp.y-rad);
|
|
p34 := DoublePoint(cp.x+rad,cp.y+rad);
|
|
p41 := DoublePoint(cp.x-rad,cp.y+rad);
|
|
p12 := MPOint(cp,p12,2);
|
|
p23 := MPOint(cp,p23,2);
|
|
p34 := MPOint(cp,p34,2);
|
|
p41 := MPOint(cp,p41,2);
|
|
p12 := MPOint(p12,cp,2);
|
|
p23 := MPOint(p23,cp,2);
|
|
p34 := MPOint(p34,cp,2);
|
|
p41 := MPOint(p41,cp,2);
|
|
|
|
p1 := RotatePoint(cp,p1,Angle);
|
|
p2 := RotatePoint(cp,p2,Angle);
|
|
p3 := RotatePoint(cp,p3,Angle);
|
|
p4 := RotatePoint(cp,p4,Angle);
|
|
p12 := RotatePoint(cp,p12,Angle);
|
|
p23 := RotatePoint(cp,p23,Angle);
|
|
p34 := RotatePoint(cp,p34,Angle);
|
|
p41 := RotatePoint(cp,p41,Angle);
|
|
|
|
Powercad1.ConvertXY(cp.x,cp.y,z);
|
|
Powercad1.ConvertXY(p1.x,p1.y,z);
|
|
Powercad1.ConvertXY(p2.x,p2.y,z);
|
|
Powercad1.ConvertXY(p3.x,p3.y,z);
|
|
Powercad1.ConvertXY(p4.x,p4.y,z);
|
|
|
|
Powercad1.ConvertXY(p12.x,p12.y,z);
|
|
Powercad1.ConvertXY(p23.x,p23.y,z);
|
|
Powercad1.ConvertXY(p34.x,p34.y,z);
|
|
Powercad1.ConvertXY(p41.x,p41.y,z);
|
|
|
|
Pen :=CreatePen(fig.Style,fig.width,fig.color);
|
|
logB.lbStyle := BS_NULL;
|
|
logb.lbColor := fig.brc;
|
|
logb.lbHatch := HS_CROSS;
|
|
if fig.Brs = ord(bsSolid) then logB.lbStyle := BS_SOLID
|
|
else if fig.Brs = ord(bsClear) then logB.lbStyle := BS_NULL
|
|
else begin
|
|
logB.lbStyle := BS_HATCHED;
|
|
case fig.Brs of
|
|
ord(bsHorizontal): logb.lbHatch := HS_HORIZONTAL;
|
|
ord(bsVertical): logb.lbHatch := HS_VERTICAL;
|
|
ord(bsFDiagonal): logb.lbHatch := HS_FDIAGONAL;
|
|
ord(bsBDiagonal): logb.lbHatch := HS_BDIAGONAL;
|
|
ord(bsCross): logb.lbHatch := HS_CROSS;
|
|
ord(bsDiagCross): logb.lbHatch := HS_DIAGCROSS;
|
|
end;
|
|
end;
|
|
|
|
Brush := CreateBrushIndirect(logB);
|
|
oldPen := SelectObject(dc,pen);
|
|
oldBrush := SelectObject(dc,brush);
|
|
|
|
pArr[0] := Point(round(p1.x),round(p1.y));
|
|
pArr[1] := Point(round(p12.x),round(p12.y));
|
|
pArr[2] := Point(round(p2.x),round(p2.y));
|
|
pArr[3] := Point(round(p23.x),round(p23.y));
|
|
pArr[4] := Point(round(p3.x),round(p3.y));
|
|
pArr[5] := Point(round(p34.x),round(p34.y));
|
|
pArr[6] := Point(round(p4.x),round(p4.y));
|
|
pArr[7] := Point(round(p41.x),round(p41.y));
|
|
Polygon(dc,pArr,8);
|
|
Line(p1,p3);
|
|
Line(p2,p4);
|
|
Line(p12,p34);
|
|
Line(p23,p41);
|
|
if fig.RegHandle <> 0 then DeleteObject(fig.RegHandle);
|
|
Fig.RegHandle := CreatePolygonRgn(parr,8,WINDING);
|
|
drawed := true;
|
|
SelectObject(dc,oldPen);
|
|
SelectObject(dc,oldBrush);
|
|
DeleteObject(pen);
|
|
DeleteObject(brush);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
procedure TForm1.PowerCad1UserHitTest(Sender: TObject; CName: String;
|
|
Figure: Integer; x, y: Double; var Test, Tested: Boolean);
|
|
var z: Double;
|
|
begin
|
|
z := 0;
|
|
if CName = 'Compass' then begin
|
|
Powercad1.ConvertXY(x,y,z);
|
|
Test := PtInRegion(Tfigure(figure).RegHandle,round(x),round(y));
|
|
tested := true;
|
|
end;
|
|
end;
|
|
|
|
procedure TForm1.PowerCad1PopMenuClicked(Sender: TObject;
|
|
MenuIndex: Integer);
|
|
var i: Integer;
|
|
r: Trichtext;
|
|
begin
|
|
Case MenuIndex of
|
|
0: Powercad1.SetTool(toFigure,'TUserCircle>Compass');
|
|
1: Powercad1.SetTool(toFigure,'TStripedText');
|
|
2: Powercad1.ClearGuides;
|
|
3: Powercad1.InterBreakSelection;
|
|
4: Powercad1.ClearGuides;
|
|
5: ShowMessage('PowerDraw V'+inttostr(Powercad1.GetVersion)+' developed with PowerCad. www.tekhnelogos.com');
|
|
end;
|
|
end;
|
|
|
|
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
|
|
Shift: TShiftState);
|
|
begin
|
|
Powercad1.DoKeyStroke(Key,DelphiSetToOleShift(Shift));
|
|
end;
|
|
|
|
procedure TForm1.PowerCad1FigureEdit(Sender: TObject; Figure: TFigure);
|
|
begin
|
|
if figure is Tline then begin
|
|
// Raise Line Form
|
|
end else if figure is TRectangle then begin
|
|
// Raise Rectangle Form
|
|
end else if figure is TCircle then begin
|
|
// Raise Circle Form
|
|
end;
|
|
end;
|
|
|
|
function TForm1.PowerCad1SnapToFigure(Sender: TObject; SnapFigure: TFigure;
|
|
var x, y: Double): Boolean;
|
|
var circle: TCircle;
|
|
d: Double;
|
|
dInt: Integer;
|
|
p,cp: TDoublePOint;
|
|
|
|
begin
|
|
result := false;
|
|
if SnapFigure is TCircle then begin
|
|
circle := TCircle(SnapFigure);
|
|
p := DoublePOint(x,y);
|
|
cp := circle.ap1;
|
|
d := GetLineLenght(p,cp);
|
|
d := abs(d-circle.Radius);
|
|
Powercad1.DEngine.ConvertDim(d);
|
|
if d < 24 then begin // close to the border
|
|
p := MPoint(cp,p,Circle.Radius); // calculate border point
|
|
x := p.x;
|
|
y := p.y;
|
|
result := true;
|
|
end else begin
|
|
|
|
end;
|
|
end;
|
|
|
|
if SnapFigure is TLine then begin
|
|
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
procedure TForm1.PowerCad1CustomCommand(Sender: TObject; ComName: String);
|
|
begin
|
|
//ShowMessage(ComName);
|
|
//if comname = 'areaedit' then begin
|
|
// FrmData.ShowModal;
|
|
//end;
|
|
end;
|
|
|
|
procedure TForm1.ImageCopy;
|
|
var pLine: TPolyline;
|
|
i: Integer;
|
|
fig: TFigure;
|
|
bmpObject:TBMpObject;
|
|
r1,r2: TDoubleRect;
|
|
xBmp: TBitmap;
|
|
begin
|
|
if Powercad1.Selection.Count = 0 then exit;
|
|
if TFigure(Powercad1.Selection[0]) is TPolyline then begin
|
|
pLine := TPolyline(Powercad1.Selection[0]);
|
|
bmpObject := nil;
|
|
r1 := pLine.GetBoundRect;
|
|
for i := 0 to Powercad1.Figures.Count-1 do
|
|
begin
|
|
fig := TFigure(Powercad1.Figures[i]);
|
|
if fig is TBmpObject then begin
|
|
r2 := fig.GetBoundRect;
|
|
if RectOverLaps(r1,r2) then begin
|
|
bmpObject := TBMpObject(fig);
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
if assigned(bmpObject) then begin
|
|
Powercad1.DeselectAll(0);
|
|
Powercad1.SelectByFigure(0,bmpObject.Handle,False);
|
|
Powercad1.SelectByFigure(0,pLine.Handle,True);
|
|
Powercad1.DuplicateSelection(0,0);
|
|
Powercad1.DeSelectFigure(bmpObject.Handle);
|
|
Powercad1.DeSelectFigure(pLine.Handle);
|
|
Powercad1.ClipSelBitmapToSelFigure;
|
|
xBmp := Powercad1.SelectionAsBitmap(80);
|
|
if assigned(xBmp) then begin
|
|
xBmp.SaveToFile('c:\deneme.bmp');
|
|
xBmp.Free;
|
|
end;
|
|
Powercad1.RemoveSelection;
|
|
Powercad1.SelectByFigure(0,pLine.Handle,True);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TForm1.Button1Click(Sender: TObject);
|
|
begin
|
|
Powercad1.SetHScrollPosition(Powercad1.HSCBarPosition+10 ,True);
|
|
end;
|
|
|
|
procedure TForm1.PrintPageAsWmf;
|
|
begin
|
|
Powercad1.ActualSize;
|
|
Powercad1.WmfPrinting := True;
|
|
Powercad1.ExecuteTBCommand(cPrint);
|
|
|
|
end;
|
|
|
|
end.
|