frxdesgnworkspace.pas

这个是功能强大的报表软件

{******************************************}
{                                          }
{             FastReport v4.0              }
{       Common designer workspace          }
{                                          }
{         Copyright (c) 1998-2008          }
{         by Alexander Tzyganenko,         }
{            Fast Reports Inc.             }
{                                          }
{******************************************}

unit frxDesgnWorkspace;

interface

{$I frx.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Buttons, frxClass, frxUnicodeCtrls
{$IFDEF Delphi6}
, Variants
{$ENDIF};


const
  crPencil = 11;

type
  TfrxDesignMode = (dmSelect, dmInsert, dmDrag);
  TfrxDesignMode1 = (dmNone, dmMove, dmSize, dmSizeBand, dmScale,
    dmInplaceEdit, dmSelectionRect, dmInsertObject, dmInsertLine,
    dmMoveGuide, dmContainer);
  TfrxGridType = (gt1pt, gt1cm, gt1in, gtDialog, gtChar, gtNone);
  TfrxCursorType = (ct0, ct1, ct2, ct3, ct4, ct5, ct6, ct7, ct8, ct9, ct10);
  TfrxNotifyPositionEvent = procedure (ARect: TfrxRect) of object;

  TfrxInsertion = packed record
    ComponentClass: TfrxComponentClass;
    Left: Extended;
    Top: Extended;
    Width: Extended;
    Height: Extended;
    OriginalWidth: Extended;
    OriginalHeight: Extended;
    Flags: Word;
  end;

  TfrxDesignerWorkspace = class(TPanel)
  protected
    FBandHeader: Extended;
    FCanvas: TCanvas;
    FColor: TColor;
    FCT: TfrxCursorType;
    FDblClicked: Boolean;
    FDisableUpdate: Boolean;
    FFreeBandsPlacement: Boolean;
    FGapBetweenBands: Integer;
    FGridAlign: Boolean;
    FGridLCD: Boolean;
    FGridType: TfrxGridType;
    FGridX: Extended;
    FGridY: Extended;
    FInplaceMemo: TUnicodeMemo;
    FInplaceObject: TfrxCustomMemoView;
    FInsertion: TfrxInsertion;
    FLastMousePointX: Extended;
    FLastMousePointY: Extended;
    FMargins: TRect;
    FMarginsPanel: TPanel;
    FMode: TfrxDesignMode;
    FMode1: TfrxDesignMode1;
    FModifyFlag: Boolean;
    FMouseDown: Boolean;
    FObjects: TList;
    FOffsetX: Extended;
    FOffsetY: Extended;
    FPage: TfrxPage;
    FPageHeight: Integer;
    FPageWidth: Integer;
    FScale: Extended;
    FScaleRect: TfrxRect;
    FScaleRect1: TfrxRect;
    FSelectedObjects: TList;
    FSelectionRect: TfrxRect;
    FShowBandCaptions: Boolean;
    FShowEdges: Boolean;
    FShowGrid: Boolean;
    FSizedBand: TfrxBand;
    FOnModify: TNotifyEvent;
    FOnEdit: TNotifyEvent;
    FOnInsert: TNotifyEvent;
    FOnNotifyPosition: TfrxNotifyPositionEvent;
    FOnSelectionChanged: TNotifyEvent;
    FOnTopLeftChanged: TNotifyEvent;
    procedure DoModify;
    procedure AdjustBandHeight(Bnd: TfrxBand);
    procedure CheckGuides(var kx, ky: Extended; var Result: Boolean); virtual;
    procedure DoNudge(dx, dy: Extended; Smooth: Boolean);
    procedure DoSize(dx, dy: Extended);
    procedure DoStick(dx, dy: Integer);
    procedure DoTab;
    procedure DrawBackground;
    procedure DrawCross(Down: Boolean);
    procedure DrawInsertionRect;
    procedure DrawObjects; virtual;
    procedure DrawSelectionRect;
    procedure FindNearest(dx, dy: Integer);
    procedure MouseLeave;
    procedure NormalizeCoord(c: TfrxComponent);
    procedure NormalizeRect(var R: TfrxRect);
    procedure SelectionChanged;
    procedure SetScale(Value: Extended);
    procedure SetShowBandCaptions(const Value: Boolean);
    procedure UpdateBandHeader;

    procedure DblClick; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure WMMove(var Message: TWMMove); message WM_MOVE;
    procedure WMEraseBackground(var Message: TMessage); message WM_ERASEBKGND;

    // debug
    procedure PrepareShiftTree(Band: TfrxBand);

    procedure SetColor(const Value: TColor);
    procedure SetGridType(const Value: TfrxGridType);
    procedure SetOrigin(const Value: TPoint);
    procedure SetParent(AParent: TWinControl); override;
    procedure SetShowGrid(const Value: Boolean);
    function GetOrigin: TPoint;
    function GetRightBottomObject: TfrxComponent;
    function GetSelectionBounds: TfrxRect;
    function ListsEqual(List1, List2: TList): Boolean;
    function SelectedCount: Integer;
  public
    constructor Create(AOwner: TComponent); override;
    procedure Paint; override;
    procedure AdjustBands(AttachObjects: Boolean = True);
    procedure DeleteObjects; virtual;
    procedure DisableUpdate;
    procedure EnableUpdate;
    procedure EditObject; virtual;
    procedure GroupObjects;
    procedure UngroupObjects;
    procedure SetInsertion(AClass: TfrxComponentClass;
      AWidth, AHeight: Extended; AFlag: Word); virtual;
    procedure SetPageDimensions(AWidth, AHeight: Integer; AMargins: TRect);
    procedure UpdateView;

    property BandHeader: Extended read FBandHeader write FBandHeader;
    property Color: TColor read FColor write SetColor;
    property FreeBandsPlacement: Boolean read FFreeBandsPlacement write FFreeBandsPlacement;
    property GapBetweenBands: Integer read FGapBetweenBands write FGapBetweenBands;
    property GridAlign: Boolean read FGridAlign write FGridAlign;
    property GridLCD: Boolean read FGridLCD write FGridLCD;
    property GridType: TfrxGridType read FGridType write SetGridType;
    property GridX: Extended read FGridX write FGridX;
    property GridY: Extended read FGridY write FGridY;
    property Insertion: TfrxInsertion read FInsertion;
    property IsMouseDown: Boolean read FMouseDown;
    property Mode: TfrxDesignMode1 read FMode1;
    property Objects: TList read FObjects write FObjects;
    property OffsetX: Extended read FOffsetX write FOffsetX;
    property OffsetY: Extended read FOffsetY write FOffsetY;
    property Origin: TPoint read GetOrigin write SetOrigin;
    property Page: TfrxPage read FPage write FPage;
    property Scale: Extended read FScale write SetScale;
    property SelectedObjects: TList read FSelectedObjects write FSelectedObjects;
    property ShowBandCaptions: Boolean read FShowBandCaptions write SetShowBandCaptions;
    property ShowEdges: Boolean read FShowEdges write FShowEdges;
    property ShowGrid: Boolean read FShowGrid write SetShowGrid;
    property OnModify: TNotifyEvent read FOnModify write FOnModify;
    property OnEdit: TNotifyEvent read FOnEdit write FOnEdit;
    property OnInsert: TNotifyEvent read FOnInsert write FOnInsert;
    property OnNotifyPosition: TfrxNotifyPositionEvent read FOnNotifyPosition write
      FOnNotifyPosition;
    property OnSelectionChanged: TNotifyEvent read FOnSelectionChanged write
      FOnSelectionChanged;
    property OnTopLeftChanged: TNotifyEvent read FOnTopLeftChanged write
      FOnTopLeftChanged;
  end;

  TInplaceMemo = class(TUnicodeMemo)
  private
    FDesigner: TfrxDesignerWorkspace;
    FObject: TfrxCustomMemoView;
    FOriginalSize: TSize;
    procedure LinesChange(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
    procedure Edit(c: TfrxCustomMemoView);
    procedure EditDone;
    procedure KeyPress(var Key: Char); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
  end;


implementation

{$R *.res}

uses frxRes, frxDMPClass, frxUtils, frxCtrls;

const
  DefFontName = 'Tahoma';


type
  TMarginsPanel = class(TPanel)
  protected
    FWorkspace: TfrxDesignerWorkspace;
    procedure WMEraseBackground(var Message: TMessage); message WM_ERASEBKGND;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure Paint; override;
  end;

  THackComponent = class(TfrxComponent);


{ TInplaceMemo }

constructor TInplaceMemo.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDesigner := TfrxDesignerWorkspace(AOwner);
  Parent := FDesigner;
  Visible := False;
  WordWrap := False;
  OnChange := LinesChange;
end;

procedure TInplaceMemo.Edit(c: TfrxCustomMemoView);
var
  s: WideString;
begin
  FObject := c;

  s := c.Text;
  if (s <> '') and (s[Length(s)] = #10) then
    Delete(s, Length(s) - 1, 2);
  Text := s;

  SetBounds(Round(c.AbsLeft * FDesigner.Scale), Round(c.AbsTop * FDesigner.Scale),
    Round(c.Width * FDesigner.Scale + 1), Round(c.Height * FDesigner.Scale + 1));
  FOriginalSize.cx := Width;
  FOriginalSize.cy := Height;

  Font.Assign(c.Font);
  Font.Height := Round(Font.Height * FDesigner.Scale);
  if c.Color = clNone then
    Color := clWhite else
    Color := c.Color;
  Ctl3D := False;
  BorderStyle := bsNone;

  Show;
  SetFocus;
  SelectAll;
end;

procedure TInplaceMemo.EditDone;
begin
  if Modified then
  begin
    FObject.Text := Text;
    if FOriginalSize.cx <> Width then
      FObject.Width := (Width + 5) / FDesigner.Scale;
    if FOriginalSize.cy <> Height then
      FObject.Height := (Height + 5) / FDesigner.Scale;
    FDesigner.FModifyFlag := True;
    FDesigner.DoModify;
  end;
  Hide;
  FDesigner.Repaint;
  FDesigner.Cursor := crDefault;
end;

procedure TInplaceMemo.KeyPress(var Key: Char);
begin
  if Key = #27 then
  begin
    Modified := False;
    EditDone;
  end;
end;

procedure TInplaceMemo.LinesChange(Sender: TObject);
var
  i, w0, w, h: Integer;
begin
  h := (-Font.Height + 3) * Lines.Count + 4;
  if h > Height - Font.Height then
    Height := h;

  FDesigner.Canvas.Font := Font;

  w := Width;
  for i := 0 to Lines.Count - 1 do
  begin
    w0 := FDesigner.Canvas.TextWidth(Lines[i]) + 6;
    if w0 > w then
      w := w0;
  end;

  if w > Width then
    Width := w;
end;

procedure TInplaceMemo.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  EditDone;
end;


{ TMarginsPanel }

constructor TMarginsPanel.Create(AOwner: TComponent);
begin
  inherited;
  Color := clWindow;
  BevelInner := bvNone;
  BevelOuter := bvNone;
end;

procedure TMarginsPanel.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited;
  FWorkspace.MouseDown(Button, Shift, X - (FWorkspace.Left - Left),
    Y - (FWorkspace.Top - Top));
end;

procedure TMarginsPanel.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited;

  if FWorkspace.FMode = dmSelect then
    FWorkspace.MouseMove(Shift, X - (FWorkspace.Left - Left),
      Y - (FWorkspace.Top - Top)) else
    FWorkspace.MouseLeave;
  Cursor := FWorkspace.Cursor;
end;

procedure TMarginsPanel.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited;
  FWorkspace.MouseUp(Button, Shift, X - (FWorkspace.Left - Left),
    Y - (FWorkspace.Top - Top));
end;

procedure TMarginsPanel.Paint;
var
  r: TRect;
begin
  with Canvas do
  begin
    Brush.Color := Color;
    Pen.Color := $505050;
    Pen.Width := 1;
    Pen.Style := psSolid;

    Rectangle(0, 0, Width - 1, Height - 1);
    Polyline([Point(1, Height - 1), Point(Width - 1, Height - 1), Point(Width - 1, 0)]);

    Pixels[0, Height - 1] := clGray;
    Pixels[Width - 1, 0] := clGray;


    Pen.Color := clSilver;
    Pen.Style := psDot;
    with FWorkspace, FWorkspace.FMargins do
      r := Rect(Round(Left * FScale), Round(Top * FScale),
        Self.Width - Round(Right * FScale) + 1,
        Self.Height - Round(Bottom * FScale) + 1);

    Polyline([Point(r.Left - 1, r.Top - 1),
      Point(r.Left - 1, r.Bottom),
      Point(r.Right, r.Bottom),
      Point(r.Right, r.Top - 1),
      Point(r.Left - 1, r.Top - 1)]);
  end;
end;

procedure TMarginsPanel.WMEraseBackground(var Message: TMessage);
begin
//
end;


{ TfrxDesignerWorkspace }

constructor TfrxDesignerWorkspace.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FullRepaint := False;
  Screen.Cursors[crPencil] := LoadCursor(hInstance, 'frxPENCIL');

  FMarginsPanel := TMarginsPanel.Create(AOwner);
  TMarginsPanel(FMarginsPanel).FWorkspace := Self;
  FInplaceMemo := TInplaceMemo.Create(Self);

  FBandHeader := fr01cm * 5;
  FColor := clWhite;
  FGridAlign := True;
  FGridType := gt1cm;
  FGridX := fr01cm;
  FGridY := fr01cm;
  FMode := dmSelect;
  FMode1 := dmNone;
  FScale := 1;
  FShowGrid := True;
  FShowEdges := True;
end;

procedure TfrxDesignerWorkspace.SetParent(AParent: TWinControl);
begin
  if not (csDestroying in ComponentState) then
    FMarginsPanel.Parent := AParent;
  inherited;
end;

procedure TfrxDesignerWorkspace.DisableUpdate;
begin
  FDisableUpdate := True;
  FMode := dmSelect;
  FMode1 := dmNone;
end;

procedure TfrxDesignerWorkspace.EnableUpdate;
begin
  FDisableUpdate := False;
end;

procedure TfrxDesignerWorkspace.UpdateView;
var
  NotifyRect: TfrxRect;
begin
  Invalidate;
  if SelectedCount = 0 then
    NotifyRect := frxRect(0, 0, 0, 0) else
    NotifyRect := GetSelectionBounds;
  if Assigned(FOnNotifyPosition) then
    FOnNotifyPosition(NotifyRect);
end;

procedure TfrxDesignerWorkspace.WMMove(var Message: TWMMove);
begin
  inherited;
  if Assigned(FOnTopLeftChanged) then
    FOnTopLeftChanged(Self);
end;

procedure TfrxDesignerWorkspace.SetInsertion(AClass: TfrxComponentClass;
  AWidth, AHeight: Extended; AFlag: Word);
begin
  with FInsertion do
  begin
    ComponentClass := AClass;
    Width := AWidth;
    Height := AHeight;
    OriginalWidth := AWidth;
    OriginalHeight := AHeight;
    Flags := AFlag;
  end;

  FMode := dmInsert;
  if AClass = nil then
  begin
    FMode := dmSelect;
    FMode1 := dmNone;
  end
  else if AClass.InheritsFrom(TfrxCustomLineView) then
  begin
    Cursor := crPencil;
    FMode1 := dmInsertLine;