expertcad/SRC/Main/U_BlockEditor.pas

unit U_BlockEditor;

interface

uses
  Windows, U_LNG, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, PCPanel, PCDrawBox, PCDrawing, PowerCad, PCTypesUtils, DrawObjects,
  PCgui, GuiStrings, DrawEngine,
  cxLookAndFeelPainters, StdCtrls, cxButtons, cxControls, cxContainer,
  cxEdit, cxTextEdit, cxMaskEdit, cxSpinEdit, Clipbrd, ShlObj,
  cxShellCommon, cxDropDownEdit, cxShellComboBox, ComCtrls, ShellCtrls,
  RzShellDialogs, RzCmboBx, RzShellCtrls, RzCommon, RzSelDir, siComp,
  siLngLnk;

type
  TF_BlockEditor = class(TForm)
    ToolPanel: TPanel;
    EditorPCad: TPowerCad;
    bPasteFromClipboard: TcxButton;
    bGrouping: TcxButton;
    bCreateBlock: TcxButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    bMakeAll: TcxButton;
    seBlockCounter: TcxSpinEdit;
    Label5: TLabel;
    Label6: TLabel;
    DirToGrab: TcxTextEdit;
    bChangeDir: TcxButton;
    ChangeDialog: TRzSelDirDialog;
    lng_Forms: TsiLangLinked;
    procedure bCreateBlockClick(Sender: TObject);
    procedure bMakeAllClick(Sender: TObject);
    procedure bPasteFromClipboardClick(Sender: TObject);
    procedure bGroupingClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure seBlockCounterPropertiesChange(Sender: TObject);
    procedure seBlockCounterExit(Sender: TObject);
    procedure bChangeDirClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  F_BlockEditor: TF_BlockEditor;
  BlockCount: Integer = 0;

implementation
uses U_BaseCommon, U_Constants;

{$R *.dfm}
procedure TF_BlockEditor.bPasteFromClipboardClick(Sender: TObject);
begin
  try
    EditorPCad.Clear(0);
    EditorPCad.PasteFromClipBoard(0);
  except
    ShowMessage(cBlockEditor_Mes1);
  end;
end;

procedure TF_BlockEditor.bGroupingClick(Sender: TObject);
begin
  try
    EditorPCad.SelectAll(0);
    if EditorPCad.SelectedCount > 1 then
      EditorPCad.GroupSelection
    else
    if EditorPCad.SelectedCount = 1 then
    begin
      if not (TFigure(EditorPCad.Selection[0]) is TFigureGrp) then
        EditorPCad.GroupSelection;
    end;
  except
    on E: Exception do AddExceptionToLogEx('TF_BlockEditor.bGroupingClick', E.Message);
  end;
end;

procedure TF_BlockEditor.bCreateBlockClick(Sender: TObject);
var
  FDir: string;
  FName: string;
  MetaFile: TMetafile;
  Bitmap: TBitmap;
begin
  try
    if EditorPCad.SelectedCount > 0 then
    begin
      MetaFile := TMetafile.Create;
      Bitmap := TBitmap.Create;
      FName := IntToStr(BlockCount + 1);
      FDir := DirToGrab.Text + '\';
      EditorPCad.MakeSelectionBlock(FDir + FName + '.blk');
      MetaFile := EditorPCad.SelectionAsWmf;
      Bitmap.Height := Metafile.Height;
      Bitmap.Width := Metafile.Width;
      Bitmap.Canvas.Draw(0, 0, MetaFile);
      Bitmap.SaveToFile(FDir + FName + '.bmp');
      MetaFile.Free;
      Bitmap.Free;
      // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
      BlockCount := BlockCount + 1;
      seBlockCounter.Value := BlockCount;
    end;
  except
    on E: Exception do AddExceptionToLogEx('TF_BlockEditor.bCreateBlockClick', E.Message);
  end;
end;

procedure TF_BlockEditor.bMakeAllClick(Sender: TObject);
begin
  try
    // 1
    bPasteFromClipboard.Click;
    // 2
    bGrouping.Click;
    // 3
    bCreateBlock.Click;
  except
    on E: Exception do AddExceptionToLogEx('TF_BlockEditor.bMakeAllClick', E.Message);
  end;
end;


procedure TF_BlockEditor.FormShow(Sender: TObject);
begin
  try
    if (GCurrProjUnitOfMeasure = umSM) or (GCurrProjUnitOfMeasure = umM) then
      EditorPCad.RulerSystem := rsMetric
    else
    if (GCurrProjUnitOfMeasure = umIn) or (GCurrProjUnitOfMeasure = umFt) then
      EditorPCad.RulerSystem := rsWhitworth;
    DirToGrab.SelText := GetCurrentDir;
  except
    on E: Exception do AddExceptionToLogEx('TF_BlockEditor.FormShow', E.Message);
  end;
end;

procedure TF_BlockEditor.seBlockCounterPropertiesChange(Sender: TObject);
begin
  try
    BlockCount := seBlockCounter.Value;
  except
    on E: Exception do AddExceptionToLogEx('TF_BlockEditor.seBlockCounterPropertiesChange', E.Message);
  end;
end;

procedure TF_BlockEditor.seBlockCounterExit(Sender: TObject);
begin
  try
    if seBlockCounter.Text = '' then
      seBlockCounter.Text := '0';
  except
    on E: Exception do AddExceptionToLogEx('TF_BlockEditor.seBlockCounterExit', E.Message);
  end;
end;

procedure TF_BlockEditor.bChangeDirClick(Sender: TObject);
var
  FDir: string;
  FName: string;
begin
  try
    FDir := DirToGrab.Text;
    if not DirectoryExists(FDir) then
      FDir := GetCurrentDir;
    ChangeDialog.Caption := cBlockEditor_Mes2;
    ChangeDialog.CaptionOK := cBlockEditor_Mes3;
    ChangeDialog.CaptionCancel := cBlockEditor_Mes4;
    ChangeDialog.Prompt := '';
    ChangeDialog.PromptFolders := '';
    ChangeDialog.Directory := FDir;
    if ChangeDialog.Execute then
    begin
      try
        FName := ChangeDialog.Directory;
        DirToGrab.Text := FName;
      except
        ShowMessage(cBlockEditor_Mes5);
      end;
    end;
  except
    on E: Exception do AddExceptionToLogEx('TF_BlockEditor.bChangeDirClick', E.Message);
  end;
end;

end.