unit1.~pas

delphi图形开发工具BlockEngine

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, Menus, Buttons, ActnList, ComCtrls, ToolWin, ImgList, StdCtrls,
  ExtDlgs, dviewer, deditor, ddoc, gdipapi, gdipobj, dlib, jpeg, ShellApi,
  bever, xpman, be_controls;

type
  TForm1 = class(TForm)
    BlockEditor1: TBlockEditor;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Exit1: TMenuItem;
    N1: TMenuItem;
    PrintSetup1: TMenuItem;
    Print1: TMenuItem;
    N2: TMenuItem;
    Save1: TMenuItem;
    Open1: TMenuItem;
    New1: TMenuItem;
    ActionList1: TActionList;
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    actnFileNew: TAction;
    actnFileOpen: TAction;
    actnFileSave: TAction;
    actnPrint: TAction;
    actnPrintPreview: TAction;
    actnPageSetup: TAction;
    actnExit: TAction;
    ImageList1: TImageList;
    Preview1: TMenuItem;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolBar2: TToolBar;
    actnPointer: TAction;
    actnRotate: TAction;
    actnNewLine: TAction;
    actnNewCircle: TAction;
    actnNewRect: TAction;
    actnNewText: TAction;
    actnNewRoundRect: TAction;
    actnGroup: TAction;
    actnUngroup: TAction;
    ToolButton9: TToolButton;
    ToolButton10: TToolButton;
    actnZoomIn: TAction;
    actnZoomOut: TAction;
    ToolButton12: TToolButton;
    ScaleBox: TComboBox;
    ToolButton11: TToolButton;
    btnPointer: TToolButton;
    btnRotate: TToolButton;
    ToolButton15: TToolButton;
    ToolButton16: TToolButton;
    ToolButton17: TToolButton;
    ToolButton18: TToolButton;
    ToolButton19: TToolButton;
    ToolButton20: TToolButton;
    ToolButton21: TToolButton;
    PrinterSetupDialog1: TPrinterSetupDialog;
    actnShowGrid: TAction;
    actnSnapToGrid: TAction;
    actnShowPage: TAction;
    actnShowRulers: TAction;
    ToolButton22: TToolButton;
    ToolButton23: TToolButton;
    ToolButton24: TToolButton;
    ToolButton25: TToolButton;
    ToolButton26: TToolButton;
    ToolButton27: TToolButton;
    ToolButton28: TToolButton;
    actnNewArrow: TAction;
    ToolButton29: TToolButton;
    ToolButton31: TToolButton;
    actnSegment: TAction;
    actnNewSnapPoint: TAction;
    ToolButton30: TToolButton;
    ToolButton32: TToolButton;
    ToolButton33: TToolButton;
    actnNewPolygon: TAction;
    actnNewSpline: TAction;
    actnBringToFront: TAction;
    actnSendToBack: TAction;
    ToolButton34: TToolButton;
    ToolButton35: TToolButton;
    ToolButton36: TToolButton;
    actnNewImage: TAction;
    ToolButton37: TToolButton;
    OpenPictureDialog1: TOpenPictureDialog;
    Image1: TImage;
    ToolBar3: TToolBar;
    cbFontList: TComboBox;
    ToolButton38: TToolButton;
    cbFontSize: TComboBox;
    ToolButton39: TToolButton;
    actnFontBold: TAction;
    actnFontItalic: TAction;
    ToolButton40: TToolButton;
    ToolButton41: TToolButton;
    ToolButton42: TToolButton;
    actnTextAlignLeft: TAction;
    actnTextAlignRight: TAction;
    actnTextAlignCenter: TAction;
    actnTextAlignTop: TAction;
    actnTextAlignMiddle: TAction;
    actnTextAlignBottom: TAction;
    ToolButton43: TToolButton;
    ToolButton44: TToolButton;
    ToolButton45: TToolButton;
    ToolButton46: TToolButton;
    ToolButton47: TToolButton;
    ToolButton48: TToolButton;
    ToolButton49: TToolButton;
    ToolButton50: TToolButton;
    cbFontColor: TComboBox;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    ToolBar4: TToolBar;
    ToolButton51: TToolButton;
    ToolButton52: TToolButton;
    actnStokeColor: TAction;
    ToolBar5: TToolBar;
    ToolButton54: TToolButton;
    actnFillColor: TAction;
    actnFillForeColor: TAction;
    ToolButton58: TToolButton;
    ColorDialog1: TColorDialog;
    ToolButton59: TToolButton;
    actnSmooth: TAction;
    ToolButton60: TToolButton;
    CheckBox1: TCheckBox;
    actnShowArrow: TAction;
    actnHotTrack: TAction;
    ToolButton61: TToolButton;
    ToolButton62: TToolButton;
    actnCopy: TAction;
    actnPaste: TAction;
    ToolButton63: TToolButton;
    ToolButton64: TToolButton;
    actnCut: TAction;
    ToolButton65: TToolButton;
    ToolButton66: TToolButton;
    ToolButton67: TToolButton;
    actnFlipHorz: TAction;
    actnFlipVert: TAction;
    ToolButton68: TToolButton;
    ToolButton69: TToolButton;
    actnDelete: TAction;
    actnNewFillSpline: TAction;
    actnNewPolyline: TAction;
    ToolButton70: TToolButton;
    ToolButton71: TToolButton;
    actnNewBezier: TAction;
    actnNewFillBezier: TAction;
    ToolButton72: TToolButton;
    ToolButton73: TToolButton;
    Splitter1: TSplitter;
    ToolButton74: TToolButton;
    ToolButton75: TToolButton;
    actnUndo: TAction;
    ToolButton76: TToolButton;
    ToolButton77: TToolButton;
    Help1: TMenuItem;
    KSDevHome1: TMenuItem;
    N3: TMenuItem;
    About1: TMenuItem;
    ToolButton78: TToolButton;
    actnStretchText: TAction;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    BlockLibrary1: TBlockLibrary;
    TabSheet4: TTabSheet;
    ClassBlockLibrary1: TClassBlockLibrary;
    ClassBlockLibrary2: TClassBlockLibrary;
    ClassBlockLibrary3: TClassBlockLibrary;
    TabSheet5: TTabSheet;
    ClassBlockLibrary4: TClassBlockLibrary;
    TabSheet6: TTabSheet;
    ClassBlockLibrary5: TClassBlockLibrary;
    TabSheet7: TTabSheet;
    ClassBlockLibrary6: TClassBlockLibrary;
    ToolButton80: TToolButton;
    cbNewStyle: TCheckBox;
    beStrokeWidthBox1: TbeStrokeWidthBox;
    beStrokeCapBox1: TbeStrokeCapBox;
    beStrokePatternBox1: TbeStrokePatternBox;
    beStrokeColorBox2: TbeStrokeColorBox;
    ToolButton13: TToolButton;
    beStrokeAlphaBox1: TbeStrokeAlphaBox;
    beFillColorBox1: TbeFillColorBox;
    beFillAlphaBox1: TbeFillAlphaBox;
    beFillStyleBox1: TbeFillStyleBox;
    Edit1: TEdit;
    Button1: TButton;
    procedure actnPointerExecute(Sender: TObject);
    procedure actnRotateExecute(Sender: TObject);
    procedure actnFileNewExecute(Sender: TObject);
    procedure actnFileOpenExecute(Sender: TObject);
    procedure actnFileSaveExecute(Sender: TObject);
    procedure actnGroupExecute(Sender: TObject);
    procedure actnUngroupExecute(Sender: TObject);
    procedure actnZoomInExecute(Sender: TObject);
    procedure actnZoomOutExecute(Sender: TObject);
    procedure actnPageSetupExecute(Sender: TObject);
    procedure actnPrintPreviewExecute(Sender: TObject);
    procedure actnShowGridExecute(Sender: TObject);
    procedure actnSnapToGridExecute(Sender: TObject);
    procedure actnShowPageExecute(Sender: TObject);
    procedure actnShowRulersExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ScaleBoxChange(Sender: TObject);
    procedure actnNewLineExecute(Sender: TObject);
    procedure actnNewCircleExecute(Sender: TObject);
    procedure actnNewRectExecute(Sender: TObject);
    procedure actnNewRoundRectExecute(Sender: TObject);
    procedure actnNewTextExecute(Sender: TObject);
    procedure BlockEditor1BlockEditText(Sender: TObject;
      var Text: WideString);
    procedure actnNewArrowExecute(Sender: TObject);
    procedure actnSegmentExecute(Sender: TObject);
    procedure actnSegmentUpdate(Sender: TObject);
    procedure actnNewPolygonExecute(Sender: TObject);
    procedure actnNewSplineExecute(Sender: TObject);
    procedure actnBringToFrontExecute(Sender: TObject);
    procedure actnSendToBackExecute(Sender: TObject);
    procedure actnNewSnapPointExecute(Sender: TObject);
    procedure actnNewImageExecute(Sender: TObject);
    procedure BlockEditor1BlockEditImage(Sender: TObject;
      var Bitmap: TGraphic);
    procedure actnFontBoldExecute(Sender: TObject);
    procedure actnFontItalicExecute(Sender: TObject);
    procedure actnTextAlignLeftExecute(Sender: TObject);
    procedure actnTextAlignRightExecute(Sender: TObject);
    procedure actnTextAlignCenterExecute(Sender: TObject);
    procedure actnTextAlignTopExecute(Sender: TObject);
    procedure actnTextAlignMiddleExecute(Sender: TObject);
    procedure actnTextAlignBottomExecute(Sender: TObject);
    procedure cbFontColorDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure cbFontColorChange(Sender: TObject);
    procedure cbFontSizeChange(Sender: TObject);
    procedure cbFontListChange(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure actnShowArrowExecute(Sender: TObject);
    procedure actnHotTrackExecute(Sender: TObject);
    procedure actnCopyExecute(Sender: TObject);
    procedure actnPasteExecute(Sender: TObject);
    procedure actnCutExecute(Sender: TObject);
    procedure actnFlipHorzExecute(Sender: TObject);
    procedure actnFlipVertExecute(Sender: TObject);
    procedure actnDeleteExecute(Sender: TObject);
    procedure actnNewFillSplineExecute(Sender: TObject);
    procedure actnNewPolylineExecute(Sender: TObject);
    procedure actnNewBezierExecute(Sender: TObject);
    procedure actnNewFillBezierExecute(Sender: TObject);
    procedure actnUndoUpdate(Sender: TObject);
    procedure actnUndoExecute(Sender: TObject);
    procedure ToolButton76Click(Sender: TObject);
    procedure KSDevHome1Click(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure actnStretchTextExecute(Sender: TObject);
    procedure cbNewStyleClick(Sender: TObject);
    procedure BlockEditor1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    procedure UncheckAll;
    procedure ColorProc(const S: string);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Printers, Clipbrd, Unit2;

{$R *.DFM}

function FromRGB(Color: longword): longword;
asm
  BSWAP   EAX
  MOV     AL, $FF
  ROR     EAX,8
end;

function ToRGB(Color: longword): longword;
asm
  ROL    EAX,8
  XOR    AL,AL
  BSWAP  EAX
end;

procedure TForm1.ColorProc(const S: string);
begin
  cbFontColor.Items.Add(S);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ScaleBox.ItemIndex := 3;
  actnFileNewExecute(Self);

  cbFontList.Items.Assign(Screen.Fonts);
  GetColorValues(ColorProc);
end;

procedure TForm1.UncheckAll;
begin
  actnPointer.Checked := false;
  actnRotate.Checked := false;

  actnNewLine.Checked := false;
  actnNewRect.Checked := false;
  actnNewRoundRect.Checked := false;
  actnNewCircle.Checked := false;
  actnNewText.Checked := false;
  actnNewArrow.Checked := false;
  actnNewSnapPoint.Checked := false;
  actnNewPolygon.Checked := false;
  actnNewSpline.Checked := false;
  actnSegment.Checked := false;
  actnNewImage.Checked := false;
  actnNewFillSpline.Checked := false;
  actnNewPolyline.Checked := false;
  actnNewBezier.Checked := false;
  actnNewFillBezier.Checked := false;
  actnStretchText.Checked := false;
end;

procedure TForm1.actnPointerExecute(Sender: TObject);
begin
  UncheckAll;
  actnPointer.Checked := not actnPointer.Checked;
  if not cbNewStyle.Checked then
    BlockEditor1.BlockEditMode := bemResize
  else
    BlockEditor1.BlockEditMode := bemResizeAndRotate;
end;

procedure TForm1.actnRotateExecute(Sender: TObject);
begin
  UncheckAll;
  actnRotate.Checked := not actnRotate.Checked;
  BlockEditor1.BlockEditMode := bemRotate;
end;

procedure TForm1.actnSegmentUpdate(Sender: TObject);
begin
  actnSegment.Enabled := (BlockEditor1.FocusedBlock <> nil) and (dsCanEditSegment in BlockEditor1.FocusedBlock.DesignState)
end;

procedure TForm1.actnSegmentExecute(Sender: TObject);
begin
  UncheckAll;
  actnSegment.Checked := true;
  BlockEditor1.BlockEditMode := bemSegment;
end;

procedure TForm1.actnFileNewExecute(Sender: TObject);
begin
  BlockEditor1.Document := BlockDocument.Create(nil);
  BlockEditor1.Document.Paper.Orientation := Landscape;
end;

procedure TForm1.actnFileOpenExecute(Sender: TObject);
begin
  { Open }
  if OpenDialog1.Execute then
  begin
    BlockEditor1.LoadFromTextFile(OpenDialog1.FileName);
  end;
end;

procedure TForm1.actnFileSaveExecute(Sender: TObject);
begin
  { Save }
  if SaveDialog1.Execute then
  begin
    BlockEditor1.SaveToTextFile(SaveDialog1.FileName);
  end;
end;

procedure TForm1.actnGroupExecute(Sender: TObject);
begin
  { Group }
  if BlockEditor1.Document = nil then Exit;
  BlockEditor1.Document.GroupSelected;
end;

procedure TForm1.actnUngroupExecute(Sender: TObject);
var
  G: Block;
begin
  { Ungroup }
  if BlockEditor1.Document = nil then Exit;
  G := BlockEditor1.FocusedBlock;
  if (G <> nil) and (G.CanUngroup) then
  begin
    G.Ungroup;
    G.Parent.RemoveBlock(G);
    G.Free;
  end;
end;

procedure TForm1.actnZoomInExecute(Sender: TObject);
begin
  { Zoomin }
  BlockEditor1.Scale := BlockEditor1.Scale + 0.1;
  ScaleBox.Text := IntToStr(Trunc(BlockEditor1.Scale * 100));
end;

procedure TForm1.actnZoomOutExecute(Sender: TObject);
begin
  { Zoomout }
  if BlockEditor1.Scale > 0.2 then
    BlockEditor1.Scale := BlockEditor1.Scale - 0.1;
  ScaleBox.Text := IntToStr(Trunc(BlockEditor1.Scale * 100));
end;

procedure TForm1.actnPageSetupExecute(Sender: TObject);
begin
  if PrinterSetupDialog1.Execute and (BlockEditor1.Document <> nil) then
  begin
    BlockEditor1.Document.Paper.Width := ConvertValue(Inch, (Printer.PageWidth / GetDeviceCaps(Printer.Handle, LOGPIXELSX)), BlockEditor1.Document.UnitType);
    BlockEditor1.Document.Paper.Height := ConvertValue(Inch, (Printer.PageHeight / GetDeviceCaps(Printer.Handle, LOGPIXELSY)), BlockEditor1.Document.UnitType);
    BlockEditor1.Invalidate;
  end;
end;

procedure TForm1.actnPrintPreviewExecute(Sender: TObject);
begin
  Form2 := TForm2.Create(Self);
  try
    Form2.BlockViewer1.SetDocumentCopy(BlockEditor1.Document);
    Form2.BlockViewer1.Scale := 1;
    Form2.ShowModal;
  finally
    Form2.Free;
  end;
end;

procedure TForm1.actnShowGridExecute(Sender: TObject);
begin
  actnShowGrid.Checked := not actnShowGrid.Checked;
  BlockEditor1.ShowGrid := actnShowGrid.Checked;
end;

procedure TForm1.actnSnapToGridExecute(Sender: TObject);
begin
  actnSnapToGrid.Checked := not actnSnapToGrid.Checked;