expertcad/POWERCAD30/UNITS/BlockFrm.pas

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.