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; // увеличить счетчик сделанных блоков 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.