qreditor.pas

delphi7报表打印控件源码 可以设计报表

{ :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  :: QuickReport 3.5 for Delphi and C++Builder               ::
  ::                                                         ::
  :: QREDIT - END USER REPORT EDITOR                         ::
  ::                                                         ::
  :: Copyright (c) 2001 A Lochert                            ::
  :: All Rights Reserved                                     ::
  ::                                                         ::
  :: web: http://www.qusoft.no                               ::
  ::                                                         ::
  ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: }

{$I QRDEFS.INC}

unit QREditor;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, Menus, QuickRpt, QRCtrls, StdCtrls, ComCtrls, ToolWin, Buttons, DB,
  DBTables, ImgList;

type
  TCustomEditor = class;

  TGrabPosition = (gpN, gpNE, gpE, gpSE, gpS, gpSW, gpW, gpNW);
  TGrabHandle = class(TCustomControl)
  private
    FPosition : TGrabPosition;
    FSize : integer;
    FParentControl : TControl;
    FDim : boolean;
    Offset : integer;
    procedure SetSize(Value : integer);
    procedure SetDim(Value : boolean);
    procedure SetCursor;
  protected
    procedure Paint; override;
  public
    constructor CreateGrab(AOwner : TComponent; ParentControl : TControl; Position : TGrabPosition);
    property Size : integer read FSize write SetSize;
    property Dim : boolean read FDim write SetDim;
    procedure UpdatePosition;
  end;

  TFocusFrameState = (fsNormal, fsDim, fsFrame);
  TFocusFrame = class(TWinControl)
  private
    CurrentRect : TRect;
    GrabHandles : TList;
    FParentControl : TControl;
    FState : TFocusFrameState;
    procedure SetState(Value : TFocusFrameState);
    procedure PaintFrame;
  public
    constructor CreateParented(AOwner : TComponent; ParentControl : TControl);
    destructor Destroy; override;
    procedure SizeFrame(ALeft, AUp, ARight, ADown : integer);
    procedure MoveFrame(ALeft, AUp : integer);
    procedure UpdateGrabHandles;
    property State : TFocusFrameState read FState write SetState;
  end;

  TSelectionList = class
  private
    ControlList : TList;
    FocusList : TList;
    FState : TFocusFrameState;
    FEditor : TCustomEditor;
    MovedUp : integer;
    MovedLeft : integer;
    SizedUp : integer;
    SizedDown : integer;
    SizedLeft : integer;
    SizedRight : integer;
  protected
    procedure SetState(Value : TFocusFrameState);
    procedure FindMaxValues(var ALeft, ATop, ARight, ABottom : integer);
    procedure AlignTo(Position : TGrabPosition);
    function GetCount : integer;
    function GetItem(Index : integer) : TControl;
  public
    constructor Create;
    destructor Destroy; override;
    procedure AlignLefts;
    procedure AlignRights;
    procedure AlignTops;
    procedure AlignBottoms;
    procedure Add(AControl : TControl);
    procedure Remove(AControl : TControl);
    procedure Clear;
    procedure Size(ALeft, AUp, ARight, ADown : integer);
    procedure Move(ALeft, AUp : integer);
    procedure BringToFront;
    procedure SendToBack;
    procedure Copy(var Stream : TStream);
    procedure UnselectChildren;
    function UpdateControls : boolean;
    function IsSelected(AControl : TControl) : boolean;
    property Items[index : integer] : TControl read GetItem; default;
    property State : TFocusFrameState read FState write SetState;
    property Count : integer read GetCount;
    property Editor : TCustomEditor read FEditor write FEditor;
  end;

  TNewComponentClass = class of TComponent;
  TEditorState = (esNormal, esResize, esMove, esAdd);

  TCustomEditor = class(TCustomPanel)
  private
    FSelectionList : TSelectionList;
    FEditing : boolean;
    MouseIsDown : boolean;
    Clipboard : TStream;
    SizeUp : boolean;
    SizeDown : boolean;
    SizeLeft : boolean;
    SizeRight : boolean;
    Origin : TPoint;
    NewComponentClass : TNewComponentClass;
    FClipboardAvailable : boolean;
    FMainControl : TWinControl;
    FState : TEditorState;
    FOnAddedControl : TNotifyEvent;
    FOnSelectControl : TNotifyEvent;
    FOnUnselectControl : TNotifyEvent;
    FOnClipboardStateChange : TNotifyEvent;
    FOnModified : TNotifyEvent;
    FModified : boolean;
  protected
    procedure DoAdd(X, Y : integer); virtual;
    procedure DoPopup(X, Y : integer); virtual;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure SetEditing(Value : boolean); virtual;
    procedure MouseDownHandler(Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : integer); virtual;
    procedure MouseMoveHandler(Sender : TObject; Shift : TShiftState; X, Y : integer); virtual;
    procedure MouseUpHandler(Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : integer); virtual;
    procedure StartResize(Position : TGrabPosition; APoint : TPoint); virtual;
    procedure ResizeTo(APoint : TPoint); virtual;
    procedure EndResize(APoint : TPoint); virtual;
    procedure StartMove(APoint : TPoint); virtual;
    procedure MoveTo(APoint : TPoint); virtual;
    procedure EndMove(APoint : TPoint); virtual;
    procedure SetModified(Value : boolean); virtual;
    property State : TEditorState read FState;
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    procedure AddClass(ComponentClass : TNewComponentClass);
    procedure Add(AComponent : TComponent; AParent : TWinControl);
    procedure ClearAll;
    procedure Select(AControl : TControl; MultiSelect : boolean); virtual;
    procedure Unselect(AControl : TControl); virtual;
    procedure UnselectAll; virtual;
    procedure DeleteSelected; virtual;
    procedure CopySelected;
    procedure CutSelected;
    procedure Paste;
    procedure SaveToStream(Stream : TStream);
    procedure Save(Filename : string);
    procedure SetEvents(AControl : TWinControl);
    procedure LoadFromStream(Stream : TStream);
    procedure Load(Filename : string);
    property ClipboardAvailable : boolean read FClipboardAvailable;
    property SelectionList : TSelectionList read FSelectionList;
    property Editing : boolean read FEditing write SetEditing;
    property MainControl : TWinControl read FMainControl write FMainControl;
    property Modified : boolean read FModified write SetModified;
  published
    property OnAddedControl : TNotifyEvent read FOnAddedControl write FOnAddedControl;
    property OnSelectControl : TNotifyEvent read FOnSelectControl write FOnSelectControl;
    property OnUnselectControl : TNotifyEvent read FOnUnselectControl write FOnUnselectControl;
    property OnClipboardStateChange : TNotifyEvent read FOnClipboardStateChange write FOnClipboardStateChange;
    property OnModified : TNotifyEvent read FOnModified write FOnModified;
  end;

  TQRCustomComponentEditor = class
  protected
    function GetName : string; virtual; abstract;
    function GetBitmap : TBitmap; virtual; abstract;
  public
    procedure Popup; virtual; abstract;
    procedure Edit; virtual; abstract;
    procedure Settings; virtual; abstract;
    property Name : string read GetName;
    property Bitmap : TBitmap read GetBitmap;
  end;

  TQRCustomEditor = class(TCustomEditor)
  published
    property Align;
    property OnSelectControl;
    property OnUnselectControl;
    property OnClipboardStateChange;
    property OnModified;
  end;

  TQReportEditor = class(TForm)
    MainPanel: TPanel;
    ScrollArea: TScrollBox;
    CoolBar1: TCoolBar;
    FileTB: TToolBar;
    NewBtn: TToolButton;
    OpenBtn: TToolButton;
    SaveBtn: TToolButton;
    ToolButton4: TToolButton;
    PrintBtn: TToolButton;
    PreviewBtn: TToolButton;
    ToolButton7: TToolButton;
    CutBtn: TToolButton;
    CopyBtn: TToolButton;
    PasteBtn: TToolButton;
    AttributeTB: TToolBar;
    FontNameCB: TComboBox;
    ToolButton12: TToolButton;
    FontSizeCB: TComboBox;
    ToolButton13: TToolButton;
    BoldBtn: TToolButton;
    ItalicBtn: TToolButton;
    UnderLnBtn: TToolButton;
    ToolButton17: TToolButton;
    LeftAlBtn: TToolButton;
    CenterAlBtn: TToolButton;
    RightAlBtn: TToolButton;
    ToolButton21: TToolButton;
    ComponentsTB: TToolBar;
    ControlTB: TToolBar;
    ControlOKBtn: TToolButton;
    ControlCancelBtn: TToolButton;
    ToolButton6: TToolButton;
    ControlValue: TEdit;
    ControlEditBtn: TToolButton;
    ToolButton1: TToolButton;
    StatusBar: TStatusBar;
    MainMenu: TMainMenu;
    Insert1: TMenuItem;
    NewMI: TMenuItem;
    OpenMI: TMenuItem;
    SaveMI: TMenuItem;
    SaveAsMI: TMenuItem;
    load1: TMenuItem;
    ReportSetupMI: TMenuItem;
    PreviewMI: TMenuItem;
    PrintMI: TMenuItem;
    N1: TMenuItem;
    ExitMI: TMenuItem;
    View1: TMenuItem;
    CutMI: TMenuItem;
    CopyMI: TMenuItem;
    PasteMI: TMenuItem;
    N2: TMenuItem;
    ClearMI: TMenuItem;
    SelectAllMI: TMenuItem;
    Data1: TMenuItem;
    SelectDataMI: TMenuItem;
    AddChildtable1: TMenuItem;
    NormalImages: TImageList;
    ToolButton2: TToolButton;
    SettingsBtn: TToolButton;
    DataSetupBtn: TToolButton;
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure OpenMIClick(Sender: TObject);
    procedure EditorSelectControl(Sender: TObject);
    procedure EditorClipboardStateChange(Sender: TObject);
    procedure ControlTBResize(Sender: TObject);
    procedure ControlValueEnter(Sender: TObject);
    procedure ControlValueExit(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BtnClick(Sender: TObject);
    procedure EditorAddedControl(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FontNameCBChange(Sender: TObject);
    procedure ControlValueKeyPress(Sender: TObject; var Key: Char);
  private
    FFilename : string;
    FDesignTime : boolean;
    ControlEditors : TList;
    function GetFormEditor: TQRCustomEditor;
  protected
    Editor: TQRCustomEditor;
    procedure SetFilename(Value : String);
    procedure EnableAndDisable;
    procedure CreateComponentButtons;
    procedure AddControlClick(Sender : TObject);
    procedure SetStyle(Sender : TObject);
    procedure SetValue;
    procedure CancelValue;
    procedure SetDesignTime(Value : boolean);
    function EditControl(AQRPrintable : TQRPrintable) : boolean;
    function PrintableEditor : TQRPrintableEditor;
  public
    property DesignTime : boolean read FDesignTime write SetDesignTime;
    property Filename : string read FFilename write SetFilename;
    property FormEditor : TQRCustomEditor read GetFormEditor;
    procedure ShowEditor;
    procedure NewReport;
    procedure OpenReport;
    procedure SaveReport;
    procedure PrintReport;
    procedure PreviewReport;
    procedure SaveReportAs;
    procedure ReportSettings;
    procedure SelectData;
    procedure Cut;
    procedure Copy;
    procedure Paste;
  end;

  TQREditor = class(TWinControl)
  private
    QReportEditorForm : TQReportEditor;
    FShowMenu: boolean;
    function GetShowStatusLine: boolean;
    function GetFilename : string;
    procedure SetFilename(const Value: string);
    function GetReportEditor: TQReportEditor;
  protected
    procedure SetParent(AControl : TWinControl); override;
    procedure SetShowMenu(Value : boolean);
    procedure SetShowStatusLine(Value : boolean);
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    property Filename : string read GetFilename write SetFilename;
    property ReportEditor : TQReportEditor read GetReportEditor;
  published
    property ShowMenu : boolean read FShowMenu write SetShowMenu;
    property ShowStatusLine : boolean read GetShowStatusLine write SetShowStatusLine;
    property Align;
    procedure ShowEditor;
    procedure NewReport;
    procedure OpenReport;
    procedure SaveReport;
    procedure PrintReport;
    procedure PreviewReport;
    procedure SaveReportAs;
    procedure ReportSettings;
    procedure SelectData;
    procedure Cut;
    procedure Copy;
    procedure Paste;
    procedure Show;
    procedure OpenReportFile(AFilename : string);
  end;

  procedure RegisterEditorControl(APrintableClass : TQRPrintableClass);

implementation

{$R *.DFM}
{$R QREDITOR.RES}

uses
  QRPrntr, QRExtra, QRWizard, QRCompEd, QRDatasu;

var
  EditorClassList : TList;

function CalcOffset(AControl : TControl) : TPoint;
begin
  Result := Point(AControl.Left, AControl.Top);
  AControl := AControl.Parent;
  while not (AControl is TCustomEditor) and (AControl <> nil) do
  begin
    Result.X := Result.X + AControl.Left;
    Result.Y := Result.Y + AControl.Top;
    AControl := AControl.Parent;
  end;
end;

constructor TGrabHandle.CreateGrab(AOwner : TComponent; ParentControl : TControl; Position : TGrabPosition);
begin
  Create(AOwner);
  FParentControl := ParentControl;
  FPosition := Position;
  Parent := TWinControl(AOwner);
  Dim := false;
  Size := 5;
  OnMouseMove := TCustomEditor(Owner).MouseMoveHandler;
  OnMouseDown := TCustomEditor(Owner).MouseDownHandler;
  OnMouseUp := TCustomEditor(Owner).MouseUpHandler;
end;

procedure TGrabHandle.SetCursor;
begin
  if Dim then Cursor := crDefault
  else
    case FPosition of
      gpN, gpS : Cursor := crSizeNS;
      gpE, gpW : Cursor := crSizeWE;
      gpNE, gpSW : Cursor := crSizeNESW;
      gpNW, gpSE : Cursor := crSizeNWSE;
    end;
end;

procedure TGrabHandle.SetSize(Value : integer);
begin
  FSize := Value;
  Height := Size;
  Width := Size;
  Offset := FSize div 2;
  UpdatePosition;
end;

procedure TGrabHandle.SetDim(Value : boolean);
begin
  FDim := Value;
  SetCursor;
  Invalidate;
  UpdatePosition;
end;

procedure TGrabHandle.UpdatePosition;
var
  TopLeft : TPoint;
begin
  TopLeft := CalcOffset(FParentControl);
  if not Dim then
  begin
    case FPosition of
      gpNW : begin
               Top := TopLeft.Y - Offset;
               Left := TopLeft.X - Offset;
             end;
      gpN  : begin
               Top := TopLeft.Y - Offset;
               Left := TopLeft.X + (FParentControl.Width div 2) - Offset;
             end;
      gpNE : begin
               Top := TopLeft.Y - Offset;
               Left := TopLeft.X + FParentControl.Width - Offset - 1;
             end;
      gpE  : begin
               Top := TopLeft.Y + (FParentControl.Height div 2) - Offset;
               Left := TopLeft.X + FParentControl.Width - Offset - 1;
             end;
      gpSE : begin
               Top := TopLeft.Y + FParentControl.Height - Offset - 1;
               Left := TopLeft.X + FParentControl.Width - Offset - 1;
             end;
      gpS  : begin
               Top := TopLeft.Y + FParentControl.Height - Offset - 1;
               Left := TopLeft.X + (FParentControl.Width div 2) - Offset;
             end;
      gpSW : begin
               Top := TopLeft.Y + FParentControl.Height - Offset - 1;
               Left := TopLeft.X - Offset;
             end;
      gpW  : begin
               Top := TopLeft.Y + (FParentControl.Height div 2) - Offset;
               Left := TopLeft.X - Offset;
             end;
    end;
    Visible := true;
  end else
    case FPosition of
      gpNW : begin
               Top := TopLeft.Y;
               Left := TopLeft.X;
               Visible := true;
             end;
      gpNE : begin
               Top := TopLeft.Y;
               Left := TopLeft.X + FParentControl.Width - Size;
               Visible := true;
             end;
      gpSE : begin
               Top := TopLeft.Y + FParentControl.Height - Size;
               Left := TopLeft.X + FParentControl.Width - Size;
               Visible := true;
             end;
      gpSW : begin
               Top := TopLeft.Y + FParentControl.Height - Size;
               Left := TopLeft.X;
               Visible := true;