unit1.~pas

delphi图形开发工具BlockEngine

  BlockEditor1.SnapToGrid := actnSnapToGrid.Checked;
end;

procedure TForm1.actnShowPageExecute(Sender: TObject);
begin
  actnShowPage.Checked := not actnShowPage.Checked;

  if actnShowPage.Checked then
    BlockEditor1.ViewKind := vkPage
  else
    BlockEditor1.ViewKind := vkBlank;
end;

procedure TForm1.actnShowRulersExecute(Sender: TObject);
begin
  actnShowRulers.Checked := not actnShowRulers.Checked;
  BlockEditor1.ShowRulers := actnShowRulers.Checked;
end;

procedure TForm1.ScaleBoxChange(Sender: TObject);
begin
  BlockEditor1.Scale := StrToInt(ScaleBox.Text) / 100;
end;

procedure TForm1.actnNewLineExecute(Sender: TObject);
begin
  if BlockEditor1.Document = nil then Exit;

  UncheckAll;
  actnNewLine.Checked := not actnNewLine.Checked;
  BlockEditor1.BlockInsertMode := bimInsertLine;
end;

procedure TForm1.actnNewCircleExecute(Sender: TObject);
begin
  if BlockEditor1.Document = nil then Exit;

  UncheckAll;
  actnNewCircle.Checked := not actnNewCircle.Checked;
  BlockEditor1.BlockInsertMode := bimInsertEllipse;
end;

procedure TForm1.actnNewRectExecute(Sender: TObject);
begin
  if BlockEditor1.Document = nil then Exit;

  UncheckAll;
  actnNewRect.Checked := not actnNewRect.Checked;
  BlockEditor1.BlockInsertMode := bimInsertRect;
end;

procedure TForm1.actnNewRoundRectExecute(Sender: TObject);
begin
  if BlockEditor1.Document = nil then Exit;

  UncheckAll;
  actnNewRoundRect.Checked := not actnNewRoundRect.Checked;
  BlockEditor1.BlockInsertMode := bimInsertRoundRect;
end;

procedure TForm1.actnNewTextExecute(Sender: TObject);
begin
  if BlockEditor1.Document = nil then Exit;

  UncheckAll;
  actnNewText.Checked := not actnNewText.Checked;
  BlockEditor1.BlockInsertMode := bimInsertText;
end;

procedure TForm1.actnStretchTextExecute(Sender: TObject);
begin
  if BlockEditor1.Document = nil then Exit;

  UncheckAll;
  actnStretchText.Checked := not actnStretchText.Checked;
  BlockEditor1.BlockInsertMode := bimInsertStretchText;
end;

procedure TForm1.actnNewArrowExecute(Sender: TObject);
begin
  if BlockEditor1.Document = nil then Exit;

  UncheckAll;
  actnNewArrow.Checked := not actnNewArrow.Checked;
  BlockEditor1.BlockInsertMode := bimInsertBlockClass;
  BlockEditor1.Document.BlockRoot.InsertBlockClass := Arrow;
end;

procedure TForm1.BlockEditor1BlockEditText(Sender: TObject;
  var Text: WideString);
var
  S: string;
begin
  S := Text;
  InputQuery('Text editor', 'Type new text:', S);
  Text := S;

//edit1.Left:=BlockEditor1.FocusedBlock.Points[0].CenterPoint.x;
//edit1.top:=BlockEditor1.FocusedBlock.Points[0].CenterPoint.x;
end;

procedure TForm1.actnNewPolygonExecute(Sender: TObject);
begin
  if BlockEditor1.Document = nil then Exit;

  UncheckAll;
  actnNewPolygon.Checked := true;
  BlockEditor1.BlockInsertMode := bimInsertPolygon;
end;

procedure TForm1.actnNewPolylineExecute(Sender: TObject);
begin
  if BlockEditor1.Document = nil then Exit;

  UncheckAll;
  actnNewPolyline.Checked := true;
  BlockEditor1.BlockInsertMode := bimInsertPolyline;
end;

procedure TForm1.actnNewSplineExecute(Sender: TObject);
begin
  if BlockEditor1.Document = nil then Exit;

  UncheckAll;
  actnNewSpline.Checked := true;
  BlockEditor1.BlockInsertMode := bimInsertSpline;
end;

procedure TForm1.actnNewBezierExecute(Sender: TObject);
begin
  if BlockEditor1.Document = nil then Exit;

  UncheckAll;
  actnNewBezier.Checked := true;
  BlockEditor1.BlockInsertMode := bimInsertBezier;
end;

procedure TForm1.actnNewFillBezierExecute(Sender: TObject);
begin
  if BlockEditor1.Document = nil then Exit;

  UncheckAll;
  actnNewFillBezier.Checked := true;
  BlockEditor1.BlockInsertMode := bimInsertFillBezier;
end;

procedure TForm1.actnNewFillSplineExecute(Sender: TObject);
begin
  if BlockEditor1.Document = nil then Exit;

  UncheckAll;
  actnNewFillSpline.Checked := true;
  BlockEditor1.BlockInsertMode := bimInsertFillSpline;
end;

procedure TForm1.actnBringToFrontExecute(Sender: TObject);
begin
  if BlockEditor1.FocusedBlock <> nil then
    BlockEditor1.FocusedBlock.BringToFront;
end;

procedure TForm1.actnSendToBackExecute(Sender: TObject);
begin
  if BlockEditor1.FocusedBlock <> nil then
    BlockEditor1.FocusedBlock.SendToBack;
end;

procedure TForm1.actnNewSnapPointExecute(Sender: TObject);
begin
  if BlockEditor1.Document = nil then Exit;

  UncheckAll;
  actnNewSnapPoint.Checked := true;
  BlockEditor1.BlockInsertMode := bimInsertSnapPoint;
end;

procedure TForm1.actnNewImageExecute(Sender: TObject);
begin
  { Image }
  if BlockEditor1.Document = nil then Exit;

  UncheckAll;
  actnNewImage.Checked := true;
  BlockEditor1.BlockInsertMode := bimInsertImage;
end;

procedure TForm1.BlockEditor1BlockEditImage(Sender: TObject;
  var Bitmap: TGraphic);
begin
  if OpenPictureDialog1.Execute then
  begin
    Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);

    Bitmap := TGraphic(Image1.Picture.Graphic.ClassType.Create);
    Bitmap.Assign(Image1.Picture.Graphic);
  end;
end;

procedure TForm1.actnFontBoldExecute(Sender: TObject);
begin
  { bold }
  actnFontBold.Checked := not actnFontBold.Checked;

  if (BlockEditor1.FocusedBlock <> nil) and (BlockEditor1.FocusedBlock.TextBlockLink <> nil) then
  begin
    if actnFontBold.Checked and actnFontItalic.Checked then
      BlockEditor1.FocusedBlock.TextBlockLink.Style := TextFontStyleBoldItalic
    else
      if actnFontBold.Checked then
        BlockEditor1.FocusedBlock.TextBlockLink.Style := TextFontStyleBold
      else
        if actnFontItalic.Checked then
          BlockEditor1.FocusedBlock.TextBlockLink.Style := TextFontStyleItalic
        else
          BlockEditor1.FocusedBlock.TextBlockLink.Style := TextFontStyleRegular;
    BlockEditor1.FocusedBlock.Repaint;
  end;
end;

procedure TForm1.actnFontItalicExecute(Sender: TObject);
begin
  { italic }
  actnFontItalic.Checked := not actnFontItalic.Checked;

  if (BlockEditor1.FocusedBlock <> nil) and (BlockEditor1.FocusedBlock.TextBlockLink <> nil) then
  begin
    if actnFontBold.Checked and actnFontItalic.Checked then
      BlockEditor1.FocusedBlock.TextBlockLink.Style := TextFontStyleBoldItalic
    else
      if actnFontBold.Checked then
        BlockEditor1.FocusedBlock.TextBlockLink.Style := TextFontStyleBold
      else
        if actnFontItalic.Checked then
          BlockEditor1.FocusedBlock.TextBlockLink.Style := TextFontStyleItalic
        else
          BlockEditor1.FocusedBlock.TextBlockLink.Style := TextFontStyleRegular;
    BlockEditor1.FocusedBlock.Repaint;
  end;
end;

procedure TForm1.actnTextAlignLeftExecute(Sender: TObject);
begin
  actnTextAlignLeft.Checked := true;
  actnTextAlignCenter.Checked := false;
  actnTextAlignRight.Checked := false;

  if (BlockEditor1.FocusedBlock <> nil) and (BlockEditor1.FocusedBlock.TextBlockLink <> nil) then
  begin
    BlockEditor1.FocusedBlock.TextBlockLink.TextAlign := TextAlignNear;
    BlockEditor1.FocusedBlock.Repaint;
  end;
end;

procedure TForm1.actnTextAlignRightExecute(Sender: TObject);
begin
  actnTextAlignLeft.Checked := false;
  actnTextAlignCenter.Checked := false;
  actnTextAlignRight.Checked := true;

  if (BlockEditor1.FocusedBlock <> nil) and (BlockEditor1.FocusedBlock.TextBlockLink <> nil) then
  begin
    BlockEditor1.FocusedBlock.TextBlockLink.TextAlign := TextAlignFar;
    BlockEditor1.FocusedBlock.Repaint;
  end;
end;

procedure TForm1.actnTextAlignCenterExecute(Sender: TObject);
begin
  actnTextAlignLeft.Checked := false;
  actnTextAlignCenter.Checked := true;
  actnTextAlignRight.Checked := false;

  if (BlockEditor1.FocusedBlock <> nil) and (BlockEditor1.FocusedBlock.TextBlockLink <> nil) then
  begin
    BlockEditor1.FocusedBlock.TextBlockLink.TextAlign := TextAlignCenter;
    BlockEditor1.FocusedBlock.Repaint;
  end;
end;

procedure TForm1.actnTextAlignTopExecute(Sender: TObject);
begin
  actnTextAlignTop.Checked := true;
  actnTextAlignMiddle.Checked := false;
  actnTextAlignBottom.Checked := false;

  if (BlockEditor1.FocusedBlock <> nil) and (BlockEditor1.FocusedBlock.TextBlockLink <> nil) then
  begin
    BlockEditor1.FocusedBlock.TextBlockLink.VerticalTextAlign := TextAlignNear;
    BlockEditor1.FocusedBlock.Repaint;
  end;
end;

procedure TForm1.actnTextAlignMiddleExecute(Sender: TObject);
begin
  actnTextAlignTop.Checked := false;
  actnTextAlignMiddle.Checked := true;
  actnTextAlignBottom.Checked := false;

  if (BlockEditor1.FocusedBlock <> nil) and (BlockEditor1.FocusedBlock.TextBlockLink <> nil) then
  begin
    BlockEditor1.FocusedBlock.TextBlockLink.VerticalTextAlign := TextAlignCenter;
    BlockEditor1.FocusedBlock.Repaint;
  end;
end;

procedure TForm1.actnTextAlignBottomExecute(Sender: TObject);
begin
  actnTextAlignTop.Checked := false;
  actnTextAlignMiddle.Checked := false;
  actnTextAlignBottom.Checked := true;

  if (BlockEditor1.FocusedBlock <> nil) and (BlockEditor1.FocusedBlock.TextBlockLink <> nil) then
  begin
    BlockEditor1.FocusedBlock.TextBlockLink.VerticalTextAlign := TextAlignFar;
    BlockEditor1.FocusedBlock.Repaint;
  end;
end;

procedure TForm1.cbFontColorDrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
begin
  with cbFontColor.Canvas do
  begin
    Brush.Color := StringToColor(cbFontColor.Items[Index]);
    InflateRect(Rect, -1, -1);
    FillRect(Rect);
  end;
end;

procedure TForm1.cbFontColorChange(Sender: TObject);
begin
  if (BlockEditor1.FocusedBlock <> nil) and (BlockEditor1.FocusedBlock.TextBlockLink <> nil) then
  begin
    BlockEditor1.FocusedBlock.TextBlockLink.Fill.Style := FillSolid;
    BlockEditor1.FocusedBlock.TextBlockLink.Fill.Color := FromRGB(ColorToRGB(StringToColor(cbFontColor.Text)) or $FF000000);
    BlockEditor1.FocusedBlock.Repaint;
  end;
end;

procedure TForm1.cbFontSizeChange(Sender: TObject);
begin
  if (BlockEditor1.FocusedBlock <> nil) and (BlockEditor1.FocusedBlock.TextBlockLink <> nil) then
  begin
    BlockEditor1.FocusedBlock.TextBlockLink.FontSize := StrToFloat(cbFontSize.Text);
    BlockEditor1.FocusedBlock.Repaint;
  end;
end;

procedure TForm1.cbFontListChange(Sender: TObject);
begin
  if (BlockEditor1.FocusedBlock <> nil) and (BlockEditor1.FocusedBlock.TextBlockLink <> nil) then
  begin
    BlockEditor1.FocusedBlock.TextBlockLink.FontFamily := cbFontList.Text;
    BlockEditor1.FocusedBlock.Repaint;
  end;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  BlockEditor1.Smooth := CheckBox1.Checked;
end;

procedure TForm1.actnShowArrowExecute(Sender: TObject);
begin
  actnShowArrow.Checked := not actnShowArrow.Checked;
  BlockEditor1.HotArrow := actnShowArrow.Checked;
end;

procedure TForm1.actnHotTrackExecute(Sender: TObject);
begin
  actnHotTrack.Checked := not actnHotTrack.Checked;
  BlockEditor1.HotTrack := actnHotTrack.Checked;
end;


procedure TForm1.actnCopyExecute(Sender: TObject);
begin
  BlockEditor1.Copy;
end;

procedure TForm1.actnPasteExecute(Sender: TObject);
begin
  BlockEditor1.Paste;
end;

procedure TForm1.actnCutExecute(Sender: TObject);
begin
  BlockEditor1.Cut;
end;

procedure TForm1.actnFlipHorzExecute(Sender: TObject);
begin
  if BlockEditor1.FocusedBlock <> nil then BlockEditor1.FocusedBlock.FlipHorz;
end;

procedure TForm1.actnFlipVertExecute(Sender: TObject);
begin
  if BlockEditor1.FocusedBlock <> nil then BlockEditor1.FocusedBlock.FlipVert;
end;

procedure TForm1.actnDeleteExecute(Sender: TObject);
begin
  BlockEditor1.Delete;
end;

procedure TForm1.actnUndoUpdate(Sender: TObject);
begin
  actnUndo.Enabled := BlockEditor1.CanUndo;
end;

procedure TForm1.actnUndoExecute(Sender: TObject);
begin
  { Undo }
  BlockEditor1.Undo;
end;

procedure TForm1.ToolButton76Click(Sender: TObject);
begin
  if BlockEditor1.FocusedBlock <> nil then
  begin
    BlockEditor1.BackgroundBlock := BlockEditor1.FocusedBlock;
    BlockEditor1.BackgroundBlock.DesignState := BlockEditor1.BackgroundBlock.DesignState - [dsFocused];
  end;
end;

procedure TForm1.KSDevHome1Click(Sender: TObject);
begin
  ShellExecute(0, 'open', 'http://www.ksdev.com', nil, nil, SW_SHOWNORMAL);
end;

procedure TForm1.About1Click(Sender: TObject);
begin
  ShowVersion;
end;

procedure TForm1.cbNewStyleClick(Sender: TObject);
begin
  if cbNewStyle.Checked then
  begin
    BlockEditor1.BlockEditMode := bemResizeAndRotate;
    btnRotate.Visible := false;
  end
  else
  begin
    BlockEditor1.BlockEditMode := bemResize;
    btnRotate.Visible := true;
  end;
end;

procedure TForm1.BlockEditor1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if  not (Button = mbLeft)    then
  begin
  showmessage('1232131');
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  BlockEditor1.CanModify:=not BlockEditor1.CanModify
end;

end.