unit1.pas

delphi图形开发工具BlockEngine

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ddoc, dviewer, deditor, StdCtrls, ComCtrls, ExtCtrls, gdipobj, gdipapi,
  be_controls, xpman;

type
  TfrmMain = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    Label1: TLabel;
    BlockEditor1: TBlockEditor;
    ListBox1: TListBox;
    Button1: TButton;
    TabSheet2: TTabSheet;
    Memo1: TMemo;
    PageControl2: TPageControl;
    TabSheet3: TTabSheet;
    BlockViewer1: TBlockViewer;
    TabSheet4: TTabSheet;
    BlockEditor2: TBlockEditor;
    TabSheet5: TTabSheet;
    Button2: TButton;
    BlockEditor3: TBlockEditor;
    TabSheet6: TTabSheet;
    Panel1: TPanel;
    Button3: TButton;
    Timer1: TTimer;
    Button4: TButton;
    BlockViewer2: TBlockEditor;
    TabSheet7: TTabSheet;
    BlockEditor4: TBlockEditor;
    GroupBox1: TGroupBox;
    Label2: TLabel;
    beStrokeWidthBox1: TbeStrokeWidthBox;
    beStrokeCapBox1: TbeStrokeCapBox;
    beStrokePatternBox1: TbeStrokePatternBox;
    beStrokeColorBox1: TbeStrokeColorBox;
    beStrokeAlphaBox1: TbeStrokeAlphaBox;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    GroupBox2: TGroupBox;
    beFillColorBox1: TbeFillColorBox;
    beFillStyleBox1: TbeFillStyleBox;
    beFillAlphaBox1: TbeFillAlphaBox;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    TabSheet8: TTabSheet;
    BlockEditor5: TBlockEditor;
    Button5: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure BlockEditor5Paint(Sender: TObject; Graphic: TGPGraphics;
      ARect: FloatRect);
    procedure Button5Click(Sender: TObject);
  private
    { Private declarations }
    Dx, Dy: Float;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.DFM}

procedure TfrmMain.Button1Click(Sender: TObject);
var
  S: Block;
begin
  if BlockEditor1.Document = nil then Exit;
  
  with BlockEditor1.Document do
  begin
    case ListBox1.ItemIndex of
      0: S := Rect.Create(BlockEditor1.Document);
      1: S := Ellipse.Create(BlockEditor1.Document);
    end;
    AddBlock(S);
    S.Bounds := MakeFloatRect2(50 + Random(300), 50 + Random(300), 40 + Random(200), 40 + Random(200));

    S.Stroke.Width := 1 + Random(5);
    S.Stroke.Color := $FF000000 or Random($FFFFFF);

    S.Fill.Style := FillStyleType(Random(5));
    S.Fill.Color := ((100 + Random(155)) shl 24) or Random($FFFFFF);
    S.Fill.Pattern := FillPatternType(Random(52));
    S.Fill.GradientAngle := Random(360);

    S.Text := IntToStr(Random(10000));

    S.Repaint;
  end;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
var
  i: integer;
  S: Block;
begin
  ListBox1.ItemIndex := 0;
  PageControl1.ActivePageIndex := 0;

  BlockViewer1.LoadFromTextFile(ExtractFilePath(ParamStr(0)) + 'group.bed');

  BlockViewer2.LoadFromTextFile(ExtractFilePath(ParamStr(0)) + 'active.bed');

  { Create new shape }
  S := BlockEditor2.Document.AddFromTextFile(ExtractFilePath(ParamStr(0)) + 'group.bed');
  if S <> nil then
  begin
    S.Left := 1;
    S.Top := 1;
    S.Width := 2;
    S.Height := 2;
    S.Text := 'Clone Block';
    S.TextBlockLink.FontSize := 20;
  end;

  S := BlockEditor2.Document.AddFromTextFile(ExtractFilePath(ParamStr(0)) + 'group.bed');
  if S <> nil then
  begin
    S.Text := 'Second Clone Block';
    S.Left := 4;
    S.Top := 1;
    S.Width := 1;
    S.Height := 1;
  end;

  { Controlr Blocks }
  with BlockEditor4.Document do
  begin
    for i := 0 to 10 do
    begin
      case random(2) of
        0: S := Rect.Create(BlockEditor1.Document);
        1: S := Ellipse.Create(BlockEditor1.Document);
      end;
      AddBlock(S);

      S.Stroke.Width := beStrokeWidthBox1.RandomWidth;
      S.Stroke.Color := beStrokeColorBox1.RandomValue;
      S.Stroke.Cap := LineCapType(random(4));
      S.Stroke.Pattern := LinePatternType(random(5));

      S.Fill.Style := FillStyleType(Random(5));
      S.Fill.Color := beFillColorBox1.RandomValue;
      S.Fill.Pattern := FillPatternType(Random(52));
      S.Fill.GradientAngle := Random(360);

      S.Text := IntToStr(Random(10000));

      S.Bounds := MakeFloatRect2(50 + Random(300), 50 + Random(300), 40 + Random(200), 40 + Random(200));
    end;
  end;

  BlockEditor5.LoadFromTextFile(ExtractFilePath(ParamStr(0)) + 'group.bed');
end;

procedure TfrmMain.Button2Click(Sender: TObject);
var
  S, S1: Block;
  LinkLine: Line;
begin
  with BlockEditor3.Document do
  begin
    S := Rect.Create(BlockEditor3.Document);
    AddBlock(S);
    S.Left := 50 + Random(300);
    S.Top := 50 + Random(300);
    S.Width := 40 + Random(200);
    S.Height := 40 + Random(200);

    S.Stroke.Width := 1 + Random(5);
    S.Stroke.Color := $FF000000 or Random($FFFFFF);

{    S.Fill.Style := FillStyleType(Random(5));
    S.Fill.Color := $FF000000 or Random($FFFFFF);
    S.Fill.Pattern := FillPatternType(Random(52));
    S.Fill.GradientAngle := Random(360);}
    S.Text := IntToStr(Random(10000));

    S1 := Ellipse.Create(BlockEditor3.Document);
    AddBlock(S1);
    S1.Left := 50 + Random(300);
    S1.Top := 50 + Random(300);
    S1.Width := 40 + Random(200);
    S1.Height := 40 + Random(200);

    S1.Stroke.Width := 1 + Random(5);
    S1.Stroke.Color := $FF000000 or Random($FFFFFF);

{    S1.Fill.Style := FillStyleType(Random(5));
    S1.Fill.Color := $FF000000 or Random($FFFFFF);
    S1.Fill.Pattern := FillPatternType(Random(52));
    S1.Fill.GradientAngle := Random(360);}
    S1.Text := IntToStr(Random(10000));

    S1.Repaint;

    LinkLine := S.Connect(S1);
    if LinkLine <> nil then
    begin
      LinkLine.Stroke.Width := 1 + Random(5);
      LinkLine.Stroke.Color := $FF000000 or Random($FFFFFF);
    end;
  end;
end;

procedure TfrmMain.Timer1Timer(Sender: TObject);
var
  DockBlock, Ball: Block;
begin
  with BlockViewer2, BlockViewer2.Document do
  begin
    Ball := FindBlockByName('Ball');
    if Ball <> nil then
    begin
      Ball.Left := Ball.Left + Dx;
      Ball.Top := Ball.Top + Dy;

      if (Ball.Left < 0) or (Ball.Left + Ball.Width > Paper.Width) then
        Dx := -Dx;
      if (Ball.Top < 0) or (Ball.Top + Ball.Height > Paper.Height) then
        Dy := -Dy;

      DockBlock := FindBlockByName('Dock');
      if DockBlock <> nil then
      begin
        if (Ball.Top + Ball.Height > DockBlock.Top) and
           (Ball.Top < DockBlock.Top + DockBlock.Height) and
           (Ball.Left + Ball.Width < DockBlock.Left + DockBlock.Width) and
           (Ball.Left > DockBlock.Left )
        then
          Dy := -Dy;
      end;
    end;
  end;
end;

procedure TfrmMain.Button3Click(Sender: TObject);
begin
  Dx := DevicePixel * 2;
  Dy := DevicePixel * 2;
  Timer1.Enabled := true;
  BlockViewer2.ShowRulers := false;
end;

procedure TfrmMain.Button4Click(Sender: TObject);
begin
  Timer1.Enabled := false;
end;

procedure TfrmMain.BlockEditor5Paint(Sender: TObject; Graphic: TGPGraphics;
  ARect: FloatRect);
var
  B : TGPHatchBrush;
begin
  B := TGPHatchBrush.Create(THatchStyle(FillPatternWeave), $FF448855, $FF996633);
  Graphic.FillRectangle(B, ARect.Left, ARect.Top, ARect.Right - ARect.Left, ARect.Bottom - ARect.Top);
  B.Free;
end;

procedure TfrmMain.Button5Click(Sender: TObject);
begin
  BlockEditor1.CanModify:=not BlockEditor1.CanModify;
end;

end.