deditor.pas

KSDev.BlockEngine.v3.03.rar 界面控件

unit deditor;

{$I be_define.inc}

interface

uses Windows, Messages, Classes, SysUtils, Controls, Graphics, Forms,
  GdipObj, Gdipapi, GdipUtil, ddoc, dviewer, Dialogs, ImgList;

type

  TOnBlockEditText = procedure (Sender: TObject; var Text: WideString) of object;
  TOnBlockEditImage = procedure (Sender: TObject; var Bitmap: TGraphic) of object;
  TOnBlockChangeFocus = procedure (Sender: TObject) of object;
  TOnBlockNewAdded = procedure (Sender: TObject; ABlock: Block) of object;

  TBlockEditMode = (
    bemResize,
    bemRotate,
    bemSegment,
    bemResizeAndRotate
  );

  TBlockInsertMode = (
    bimSelect,
    bimInsertLine,
    bimInsertRect,
    bimInsertEllipse,
    bimInsertPolygon,
    bimInsertPolyline,
    bimInsertSpline,
    bimInsertFillSpline,
    bimInsertBezier,
    bimInsertFillBezier,
    bimInsertBlockClass,
    bimInsertSnapPoint,
    bimInsertRoundRect,
    bimInsertText,
    bimInsertImage,
    bimInsertStretchText
  );

  TBlockEditor = class(TBlockViewer)
  private
    FBlockEditMode: TBlockEditMode;
    FOnBlockEditText: TOnBlockEditText;
    FSnapToGrid: boolean;
    FBlockInsertMode: TBlockInsertMode;
    FOnBlockEditImage: TOnBlockEditImage;
    FBlockInsertBlockClass: BlockClass;
    FOnBlockChangeFocus: TOnBlockChangeFocus;
    FOnBlockNewAdded: TOnBlockNewAdded;
    FOnBlockInsertEvent: TOnBlockNewAdded;
    FGripSize: integer;
    FHotTrack: boolean;
    FHotArrow: boolean;
    FUndoList: TList;
    FLibs: TList;
    FChangeFocusNotify: TList;
    FChangeFocusNotify2: TList;
    FOnBlockNewInsert: TOnBlockNewAdded;
    procedure SetBlockEditMode(const Value: TBlockEditMode);
    procedure SetSnapToGrid(const Value: boolean);
    procedure SetBlockInsertMode(const Value: TBlockInsertMode);
    function GetFocusedBlock: Block;
    procedure SetInsertBlockClass(const Value: BlockClass);
    function GetSelected(Index: integer): Block;
    function GetSelectedCount: Integer;
    procedure SetGripSize(const Value: integer);
    procedure SetHotArrow(const Value: boolean);
  protected
    procedure PaintPaper; override;
    procedure SetBlockDocument(const Value: BlockDocument); override;
    procedure SetUnitType(const Value: UnitType); override;
    { Events }
    procedure DoSetCursor(Sender: TObject; Cursor: TCursor);
    procedure DoEditText(Sender: TObject; AText: TextBlock);
    procedure DoEditImage(Sender: TObject; AImage: Image);
    procedure DoChangeFocus(Sender: TObject; ABlock: Block);
    procedure DoBlockAddedEvent(Sender: TObject; ABlock: Block);
    procedure DoBlockInsertEvent(Sender: TObject; ABlock: Block);
    procedure DoDrawPoint(Sender: TObject; AGraphics: TGPGraphics; ABlock: Block; X, Y: Float; Point: BlockPoint;
      Redraw: boolean);
    procedure DoGetPointRect(Sender: TObject; ABlock: Block;
      APoint: BlockPoint; var R: FloatRect);
    procedure DoUndoSaveState(Sender: TObject);
    { VCL }
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState;
      var Accept: Boolean); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure DragDrop(Source: TObject; X, Y: Integer); override;
    destructor Destroy; override;
    procedure LoadFromStream(AStream: TStream); override;
    procedure LoadFromTextFile(AFileName: string); override;
    procedure LoadFromFile(AFileName: string); override;
    procedure SaveUndo;
    function CanUndo: boolean;
    procedure Undo;
    procedure Delete;
    procedure ClearUndo;
    procedure Cut;
    procedure Copy;
    procedure Paste;
    procedure AddNotification(ALib: TComponent);
    procedure AddChangeFocusBlockNotify(AOnChangeFocus: TNotifyEvent);
    procedure RemoveChangeFocusBlockNotify(AOnChangeFocus: TNotifyEvent);
    property FocusedBlock: Block read GetFocusedBlock;
    property Selected[Index: integer]: Block read GetSelected;
    property SelectedCount: Integer read GetSelectedCount;
    property BlockInsertBlockClass: BlockClass read FBlockInsertBlockClass write SetInsertBlockClass;
  published
    property BlockEditMode: TBlockEditMode read FBlockEditMode write SetBlockEditMode;
    property BlockInsertMode: TBlockInsertMode read FBlockInsertMode write SetBlockInsertMode;
    property SnapToGrid: boolean read FSnapToGrid write SetSnapToGrid;
    property GripSize: integer read FGripSize write SetGripSize;
    property HotTrack: boolean read FHotTrack write FHotTrack;
    property HotArrow: boolean read FHotArrow write SetHotArrow;

    property OnBlockEditText: TOnBlockEditText read FOnBlockEditText
      write FOnBlockEditText;
    property OnBlockEditImage: TOnBlockEditImage read FOnBlockEditImage
      write FOnBlockEditImage;
    property OnBlockChangeFocus: TOnBlockChangeFocus read FOnBlockChangeFocus
      write FOnBlockChangeFocus;
    property OnBlockNewAdded: TOnBlockNewAdded read FOnBlockNewAdded
      write FOnBlockNewAdded;
    property OnBlockNewInsert: TOnBlockNewAdded read FOnBlockNewInsert
      write FOnBlockNewInsert;
  end;

implementation {===============================================================}

uses dresource, clipbrd, dlib, ddocstore, be_compress;

const
  MaxUndoState = 30;

{ TBlockEditor ====================================================================}

constructor TBlockEditor.Create(AOwner: TComponent);
begin
  inherited;
  FChangeFocusNotify := TList.Create;
  FChangeFocusNotify2 := TList.Create;
  FUndoList := TList.Create;
  ControlStyle := ControlStyle + [csCaptureMouse];
  FGripSize := 8;
  FHotTrack := true;
end;

destructor TBlockEditor.Destroy;
var
  i: integer;
begin
  for i := 0 to FUndoList.Count - 1 do
    TStream(FUndoList[i]).Free;
  FreeAndNil(FUndoList);
  if FLibs <> nil then
    FreeAndNil(FLibs);
  FreeAndNil(FChangeFocusNotify2);
  FreeAndNil(FChangeFocusNotify);
  inherited;
end;

procedure TBlockEditor.DoEditText(Sender: TObject; AText: TextBlock);
var
  S: WideString;
begin
  SaveUndo;
  S := AText.Text;
  if Assigned(FOnBlockEditText) then
    FOnBlockEditText(Self, S);
  AText.Text := S;
end;

procedure TBlockEditor.DoEditImage(Sender: TObject; AImage: Image);
var
  B: TGraphic;
begin
  SaveUndo;
  B := nil;
  if Assigned(FOnBlockEditImage) then
    FOnBlockEditImage(Self, B);
  if (B <> nil) and (not B.Empty) then
  begin
    AImage.Image := B;
    B.Free;
  end;
end;

procedure TBlockEditor.DoSetCursor(Sender: TObject; Cursor: TCursor);
begin
  if not HotTrack then
    Self.Cursor := Cursor;
end;

procedure TBlockEditor.DoChangeFocus(Sender: TObject; ABlock: Block);
var
  i: integer;
  P: TMethod;
begin
  if Assigned(FOnBlockChangeFocus) then
    FOnBlockChangeFocus(Self);

  for i := 0 to FChangeFocusNotify.Count - 1 do
  begin
    P.Code := FChangeFocusNotify[i];
    P.Data := FChangeFocusNotify2[i];
    TNotifyEvent(P)(Sender);
  end;
end;

procedure TBlockEditor.DoBlockAddedEvent(Sender: TObject; ABlock: Block);
begin
  if Assigned(FOnBlockNewAdded) then
    FOnBlockNewAdded(Self, ABlock);
end;

procedure TBlockEditor.DoBlockInsertEvent(Sender: TObject; ABlock: Block);
begin
  if Assigned(OnBlockNewInsert) then
    OnBlockNewInsert(Self, ABlock);
end;

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

procedure TBlockEditor.DoDrawPoint(Sender: TObject; AGraphics: TGPGraphics;
  ABlock: Block; X, Y: Float; Point: BlockPoint; Redraw: boolean);

  procedure DrawImage(ImgsList: TImageList; X, Y: Float; Index: integer);
  var
    B: TBitmap;
    GB: TGPBitmap;
    i, j: integer;
    G: TGPGraphics;
    SaveState: Cardinal;
  begin
    B := TBitmap.Create;
    B.HandleType := bmDIB;
    B.Canvas.Brush.Color := clFuchsia;
    B.Canvas.FillRect(Classes.Rect(0, 0, 100, 100));
    ImgsList.GetBitmap(Index, B);

    GB := TGPBitmap.Create(B.Width, B.Height);
    for i := 0 to B.Width - 1 do
      for j := 0 to B.Height - 1 do
        if B.Canvas.Pixels[i, j] <> clFuchsia then
          GB.SetPixel(i, j, FromRGB(ColorToRGB(B.Canvas.Pixels[i, j])) or $FF000000);

    if AGraphics <> nil then
      AGraphics.DrawImage(GB, X, Y)
    else
    begin
      G := Graphics;
      SaveState := G.Save;
      G.TranslateTransform(PageX, PageY);
      ABlock.SetGraphics(G);
      G.DrawImage(GB, X, Y);
      G.Restore(SaveState);
    end;

    GB.Free;
    B.Free;
  end;

var
  W, H, RW, RH: Float;
  C: TCanvas;
  P: TPoint;
  FP: FloatPoint;
  SaveHot: boolean;
begin
  W := GetRealValue(DResMod.ResizeImgs.Width);
  H := GetRealValue(DResMod.ResizeImgs.Height);
  RW := GetRealValue(DResMod.RotateImgs.Width - 2);
  RH := GetRealValue(DResMod.RotateImgs.Height - 2);

  FP := ABlock.FromBlockCoord(X, Y);
  P := PaperToScreen(FP.X, FP.Y);

  C := Scene.Canvas;

  SaveHot := Point.Hot;
  if not HotTrack then Point.Hot := false;

  case Point.Kind of
    pkLeft:
      if not FHotArrow then
      begin
        if Point.Hot then
          C.Brush.Color := clRed
        else
          if (dsFocused in ABlock.DesignState) then
            C.Brush.Color := clLime
          else
            C.Brush.Color := clAqua;
        C.Brush.Style := bsSolid;
        C.Pen.Color := clBlack;
        C.Pen.Style := psSolid;
        C.Rectangle(P.X - GripSize div 2, P.Y - GripSize div 2, P.X + GripSize div 2, P.Y + GripSize div 2);
      end
      else
        if Point.Hot then
          DrawImage(DResMod.ResizeImgs, X - W, Y - H / 2, 5)
        else
          DrawImage(DResMod.ResizeImgs, X - W, Y - H / 2, 1);
    pkRight:
      if not FHotArrow then
      begin
        if Point.Hot then
          C.Brush.Color := clRed
        else
          if (dsFocused in ABlock.DesignState) then
            C.Brush.Color := clLime
          else
            C.Brush.Color := clAqua;
        C.Brush.Style := bsSolid;
        C.Pen.Color := clBlack;
        C.Pen.Style := psSolid;
        C.Rectangle(P.X - GripSize div 2, P.Y - GripSize div 2, P.X + GripSize div 2, P.Y + GripSize div 2);
      end
      else
        if Point.Hot then
          DrawImage(DResMod.ResizeImgs, X, Y - H / 2, 5)
        else
          DrawImage(DResMod.ResizeImgs, X, Y - H / 2, 1);
    pkTop:
      if not FHotArrow then
      begin
        if Point.Hot then
          C.Brush.Color := clRed
        else
          if (dsFocused in ABlock.DesignState) then
            C.Brush.Color := clLime
          else
            C.Brush.Color := clAqua;
        C.Brush.Style := bsSolid;
        C.Pen.Color := clBlack;
        C.Pen.Style := psSolid;
        C.Rectangle(P.X - GripSize div 2, P.Y - GripSize div 2, P.X + GripSize div 2, P.Y + GripSize div 2);
      end
      else
        if Point.Hot then
          DrawImage(DResMod.ResizeImgs, X - W / 2, Y - H, 7)
        else
          DrawImage(DResMod.ResizeImgs, X - W / 2, Y - H, 3);
    pkBottom:
      if not FHotArrow then
      begin
        if Point.Hot then
          C.Brush.Color := clRed
        else
          if (dsFocused in ABlock.DesignState) then
            C.Brush.Color := clLime
          else
            C.Brush.Color := clAqua;
        C.Brush.Style := bsSolid;
        C.Pen.Color := clBlack;
        C.Pen.Style := psSolid;
        C.Rectangle(P.X - GripSize div 2, P.Y - GripSize div 2, P.X + GripSize div 2, P.Y + GripSize div 2);