frxdesgnworkspace.pas

报表源码 FastReport 3 is new generation of the report generators components. It consists of report engin

{******************************************}
{ }
{ FastReport v3.0 }
{ Common designer workspace }
{ }
{ Copyright (c) 1998-2005 }
{ 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
{$IFDEF Delphi6}
, Variants
{$ENDIF};
  

const
  crPencil = 11;

type
  TfrxDesignMode = (dmSelect, dmInsert);
  TfrxDesignMode1 = (dmNone, dmMove, dmSize, dmSizeBand, dmScale,
    dmInplaceEdit, dmSelectionRect, dmInsertObject, dmInsertLine, dmMoveGuide);
  TfrxGridType = (gt1pt, gt1cm, gt1in, gtDialog, gtChar);
  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;
    FBMPBand:TBitmap;
    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:TMemo;
    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);
    procedure DoSize(dx, dy:Extended);
    procedure DoStick(dx, dy:Integer);
    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;

    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;
    destructor Destroy; override;
    procedure Paint; override;
    procedure AdjustBands;
    procedure DeleteObjects; virtual;
    procedure DisableUpdate;
    procedure EnableUpdate;
    procedure EditObject; virtual;
    procedure GroupObjects;
    procedure UngroupObjects;
    procedure SetInsertion(AClass:TfrxComponentClass;
      AWidth, AHeight:Extended; AFlag:Word);
    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(TMemo)
  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 frxDMPClass, frxUtils, frxGraphicUtils, frxCtrls;

const
  DefFontName = 'Tahoma';

type
  TMarginsPanel = class(TPanel)
  protected
    FWorkspace:TfrxDesignerWorkspace;
    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:String;
begin
  FObject:= c;

  s:= c.Text;
  if (s<>'') and (s[Length(s)] = #10) then
    Delete(s, Length(s)-1, 2);
  Lines.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.Memo:= Lines;
    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;

{ 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);
  FBMPBand:= TBitmap.Create;
  FBMPBand.LoadFromResourceName(hInstance, 'frxBAND');

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

destructor TfrxDesignerWorkspace.Destroy;
begin
  FBMPBand.Free;
  inherited;
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;
    if FGridType = gtChar then
    begin
      FInsertion.Left:=-FGridX / 2;
      FInsertion.Top:=-FGridY / 2;
    end
    else
    begin
      FInsertion.Left:=-FGridX;
      FInsertion.Top:=-FGridY;
    end;
  end
  else
  begin
    Cursor:= crCross;
    FMode1:= dmInsertObject;
    FInsertion.Left:=-1000 * FGridX;
    FInsertion.Top:=-1000 * FGridY;
  end;