unit BlockFrm; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, PCFormRoll, ComCtrls, ToolWin, Menus, ExtCtrls, Buttons, StdCtrls, checklst, Grids,DrawObjects,PCtypesUtils,DrawEngine, FileCtrl; Type TCommandEvent = procedure ( comId: integer; values: string; valueI: integer ) of object; type TBlockForm = class(TForm) ScrollBox1: TScrollBox; Panel1: TPanel; Bevel1: TBevel; ComboBox1: TComboBox; ScrollBox2: TScrollBox; BlockLBox: TListBox; PopupMenu1: TPopupMenu; NewLibrary1: TMenuItem; AddBlocksToLibrary1: TMenuItem; RemoveFromLibrary1: TMenuItem; N2: TMenuItem; Cancel1: TMenuItem; OpenDialog1: TOpenDialog; BlockBox: TPaintBox; SpeedButton1: TSpeedButton; SpeedButton2: TSpeedButton; Bevel2: TBevel; FileList: TFileListBox; procedure FormCreate(Sender: TObject); procedure ComboBox1Click(Sender: TObject); procedure BlockPaint(sender: TObject); procedure BlockLBoxClick(Sender: TObject); procedure NewLibrary1Click(Sender: TObject); procedure AddBlocksToLibrary1Click(Sender: TObject); Procedure AddBlockToCurrentLib(BlName:String); procedure RemoveFromLibrary1Click(Sender: TObject); procedure ScrollBox1DblClick(Sender: TObject); procedure SpeedButton1Click(Sender: TObject); procedure SpeedButton2Click(Sender: TObject); private { Private declarations } public { Public declarations } Cad: Pointer; procedure LoadBlockLib; procedure CreateBlockObj; Procedure DeConvertXY(var X,Y,Z: Double); Procedure DeConvertDim(var Dim: Double); Procedure ConvertXY(var X,Y,Z: Double); Procedure ConvertDim(var Dim: Double); end; var BlockForm: TBlockForm; wr: TPCRoller; OnCommand: TCommandEvent; BlckDir : String; FigGrp: TBlock; DEngine : TPCDrawEngine; oldindex: integer; DotsPerMil : integer; vZero: Integer; hZero: Integer; implementation uses PCDrawing; {$R *.DFM} procedure TBlockForm.FormCreate(Sender: TObject); begin wr := TPCRoller.create(self); wr.Enabled := true; BlockBox.OnPaint := BlockPaint; DEngine := TPCDrawEngine.create; DEngine.Canvas := BlockBox.Canvas; DEngine.ConvertPoint := ConvertXY; DEngine.ConvertLen := ConvertDim; DEngine.DeConvertPoint := DeConvertXY; DEngine.DeConvertLen := DeConvertDim; DotsPerMil := 1; oldindex := -1; Cad := nil; end; Procedure TBlockForm.DeConvertXY(var X,Y,Z: Double); Begin x := x; if VZero = 0 then y := BlockBox.Height-y; DeConvertDim(x); DeConvertDim(y); End; Procedure TBlockForm.DeConvertDim(var Dim: Double); Begin Dim := Dim / DotsPerMil; End; Procedure TBlockForm.ConvertXY(var X,Y,Z: Double); Begin ConvertDim(x); ConvertDim(y); if VZero = 0 then y := BlockBox.Height-y; if HZero = 1 then x := BlockBox.Width-x; End; Procedure TBlockForm.ConvertDim(var Dim: Double); Begin Dim := Dim* DotsPerMil; End; Procedure TBlockForm.LoadBlockLib; var i : integer; Begin BlockLBox.Items.Clear; If ComboBox1.ItemIndex = -1 then exit; if (Combobox1.ItemIndex = Combobox1.Items.Count-1) and DirectoryExists(BlckDir) then begin FileList.Directory := Blckdir; BlockLBox.Items.Clear; FileList.Mask := '*.pwb'; FileList.Update; For i := 0 to FileList.Items.Count - 1 do begin BlockLBox.Items.add(Copy(FileList.Items[i],1,Length(FileList.Items[i])-4)); end; end else if DirectoryExists(BlckDir) then begin BlockLBox.Items.LoadFromFile(Blckdir+Combobox1.Items[Combobox1.ItemIndex]+'.pwl'); end; BlockLBox.Sorted := True; if BlockLBox.Items.Count > 0 then BlockLBox.ItemIndex := 0; if self.visible then CreateBlockObj; BlockBox.Repaint; end; Procedure TBlockForm.CreateBlockObj; var BoundRect : TDoubleRect; DistX,DistY,SCPerX,SCPerY,BHeight,BWidth : Double; xStream: Tstream; FileName,sign:string; a: integer; xByte: Byte; Begin // Tolik 05/04/2019 -- sign := ''; BlockBox.Hint := ''; if assigned(FigGrp) then FigGrp.Free; FigGrp := nil; if BlockLBox.ItemIndex = -1 then exit; FileName := BlckDir+BlockLBox.Items[BlockLBox.ItemIndex]+'.pwb'; if not FileExists(FileName) then exit; try xStream := TFileStream.Create(FileName,fmOpenRead or fmShareDenyNone); except exit; end; for a := 1 to 6 do begin xStream.Read(xByte,1); //sign := sign + chr(xByte); // Tolik 05/04/2019 sign := sign + Ansichar(xByte); end; if Sign = 'TBlock' then begin xStream.Position := 0; FigGrp := TBlock(TFigure.CreateFromStream(xStream,-1,mydsNormal,nil)); xStream.free; end; if FigGrp = nil then exit; vZero := Figgrp.OrgVz; hZero := Figgrp.OrgHz; FigGrp.Draw(DEngine,false); Boundrect := FigGrp.GetBoundRect; BWidth := abs (BoundRect.Left - BoundRect.Right); BHeight := abs( BoundRect.Top-BoundRect.Bottom); SCPerX := (BlockBox.Width-1) / BWidth; SCPerY := (BlockBox.Height-1) / BHeight; if ScPerX > ScPerY then ScPerX := ScPerY; FigGrp.scale(SCPerX,SCPerX,DoublePoint(0,0)); Boundrect := FigGrp.GetBoundRect; BWidth := abs (BoundRect.Left - BoundRect.Right); BHeight := abs( BoundRect.Top-BoundRect.Bottom); if BoundRect.Bottom > BoundRect.Top then DistY := BoundRect.Bottom else DistY := BoundRect.Top; if BoundRect.Left > BoundRect.Right then DistX := BoundRect.Left else DistX := BoundRect.Right; FigGrp.Move((BlockBox.Width - BWidth) / 2 + BWidth - DistX, (BlockBox.Height - BHeight) / 2 + BHeight - DistY); BlockBox.Hint := BlckDir+BlockLBox.Items[BlockLBox.ItemIndex]+'.pwb'; BlockBox.Repaint; end; Procedure TBlockForm.BlockPaint(sender: TObject); var a: integer; Begin try if FigGrp = nil then CreateBlockObj; if FigGrp = nil then exit; DEngine.Canvas := BlockBox.Canvas; FigGrp.Draw(Dengine,false); except end; end; procedure TBlockForm.ComboBox1Click(Sender: TObject); begin LoadBlockLib; end; procedure TBlockForm.BlockLBoxClick(Sender: TObject); begin if BlockLBox.ItemIndex = oldindex then exit; oldindex := BlockLBox.ItemIndex; if BlockLBox.ItemIndex > -1 then CreateBlockObj; end; procedure TBlockForm.NewLibrary1Click(Sender: TObject); var NameOfLib : string; a : integer; begin NameOfLib := ''; if InputQuery('Create New Library', 'Enter a name for the new library', NameOfLib) then begin For a := 0 to Combobox1.Items.Count -1 do begin If Combobox1.Items[a] = NameOfLib then begin MessageDlg(NameOfLib + ' already exists', mtError,[mbOk],0); exit; end; end; BlockLBox.clear; BlockLBox.Items.SaveToFile(BlckDir+NameOfLib+'.pwl'); If assigned(OnCommand) then OnCommand(0,'',0); Combobox1.ItemIndex := Combobox1.Items.IndexOf(NameOfLib); LoadBlockLib; BlockBox.Repaint; end; end; procedure TBlockForm.AddBlocksToLibrary1Click(Sender: TObject); var a,b: integer; Found : Boolean; BlkName, BlkPath : string; begin If Combobox1.ItemIndex = -1 then exit; OpenDialog1.InitialDir := BlckDir; If OpenDialog1.Execute then begin For a := 0 to OpenDialog1.Files.Count -1 do begin Found := false; BlkName := ExtractFileName(OpenDialog1.Files[a]); BlkPath := ExtractFilePath(OpenDialog1.Files[a]); BlkName := Copy(BlkName,1,Length(BlkName)-4); For b := 0 to BlockLBox.Items.Count - 1 do begin If BlkName = BlockLBox.Items[b] then found := true; end; if not found then begin BlockLBox.Items.Add(BlkName); end; If BlkPath <> BlckDir then begin CopyFile(Pchar(OpenDialog1.Files[a]),pchar(BlckDir+BlkName+'.pwb'),true); end; end; BlockLBox.Sorted := True; BlockLBox.Items.SaveToFile(BlckDir+Combobox1.Items[Combobox1.ItemIndex]+'.pwl'); end; end; procedure TBlockForm.RemoveFromLibrary1Click(Sender: TObject); var a: integer; begin For a := 0 to BlockLBox.items.Count - 1 do begin if BlockLBox.Selected[a] then begin BlockLBox.Items.Delete(a); BlockLBox.Items.SaveToFile(BlckDir+Combobox1.Items[Combobox1.ItemIndex]+'.pwl'); if BlockLBox.Items.Count > 0 then BlockLBox.ItemIndex := 0; CreateBlockObj; exit; end; end; end; procedure TBlockForm.ScrollBox1DblClick(Sender: TObject); var mf: Tmetafile; filename : String; begin FileName := BlckDir+BlockLBox.Items[BlockLBox.ItemIndex]+'.pwb'; if assigned(Cad) then begin mf := TPCDrawing(Cad).BlockAsWmf(fileName); if assigned(mf) then mf.SaveTofile('c:\'+BlockLBox.Items[BlockLBox.ItemIndex]+'.wmf'); end; end; procedure TBlockForm.SpeedButton1Click(Sender: TObject); begin If assigned(OnCommand) then OnCommand(1,BlockBox.Hint ,0); end; procedure TBlockForm.SpeedButton2Click(Sender: TObject); begin If assigned(OnCommand) then OnCommand(2,'',0); end; procedure TBlockForm.AddBlockToCurrentLib(BlName: String); var b: integer; begin If Combobox1.ItemIndex = -1 then exit; For b := 0 to BlockLBox.Items.Count - 1 do begin If BlName = BlockLBox.Items[b] then BlName := BlName+inttostr(Trunc(Now)); end; BlockLBox.Items.Add(BlName); BlockLBox.Sorted := True; BlockLBox.Items.SaveToFile(BlckDir+Combobox1.Items[Combobox1.ItemIndex]+'.pwl'); end; end.