rm_desgn.pas

report machine 2.3 功能强大

    procedure btnAlignVCenterClick(Sender: TObject);
    procedure padPrintClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure itmFileFile9Click(Sender: TObject);
    procedure edtPreviewPageKeyPress(Sender: TObject; var Key: Char);
    procedure padpopFrameClick(Sender: TObject);
  private
    { Private declarations }
  //WHF Add
    FGridBitmap: TBitmap;
  //old
    FPageForm: TForm;
    FPageView: TRMDesignerPage;
    FInspForm: TRMInspForm;
    FItemWidths: TStringList;
    FCurPage: Integer;
    FGridSizeX, FGridSizeY: Integer;
    FGridShow, FGridAlign: Boolean;
    FUnits: TRMSizeUnits;
    FUndoBuffer, FRedoBuffer: TRMUndoBuffer;
    FUndoBufferLength, FRedoBufferLength: Integer;
    FAutoOpenLastFile: Boolean;
    FFirstTime: Boolean;
    Fld: array[0..63] of string;
    FEditAfterInsert: Boolean;
    FCurDocName, FCaption: string;
    FShapeMode: TRMShapeMode;
    FPagePosition: TAlign;
    FPageType: TRMPageType;
    FMDown, FChangeUnits: Boolean;
    FUnlimitedHeight: Boolean;
    FBtnFontColor: TRMColorPickerButton;
    FBtnBackColor: TRMColorPickerButton;
    FBtnFrameColor: TRMColorPickerButton;
    FUseTableName: Boolean;
    FEditorForm: TRMEditorForm;

    //WHF Add
    FFieldsDialogVisible: Boolean;
    FInspFormVisible: Boolean;
    FReportViewer: TRMPreview;
    FcmbFont: TRMFontComboBox;
    FcmbFontSize: TRMComboBox;
    FOpenFiles: TStringList;

    //WHF Add
    procedure OnpadCheckInspFormClick(Sender: TObject);
    procedure OnpadAutoArrangeClick(Sender: TObject);
    procedure OpenFile(aFileName: string);
    //old
    procedure SetCurPage(Value: Integer);
    procedure SetGridSize(Value: Integer);
    procedure SetGridShow(Value: Boolean);
    procedure SetGridAlign(Value: Boolean);
    procedure SetUnits(Value: TRMSizeUnits);
    procedure SetCurDocName(Value: string);
    procedure SelectionChanged;
    procedure ShowPosition;
    procedure ShowContent;
    procedure EnableControls;
    procedure ResetSelection;
    procedure DeleteObjects(aAddUndoAction: Boolean);
    procedure AddPage;
    procedure RemovePage(n: Integer);
    procedure SetPageTitles;

    procedure DefFrameEditor(Sender: TObject);
    procedure DefMemoEditor(Sender: TObject);
    procedure DefPictureEditor(Sender: TObject);
    procedure DefbkPictureEditor(Sender: TObject);
    procedure DefTagEditor(Sender: TObject);
    procedure DefRestrEditor(Sender: TObject);
    procedure DefHighlightEditor(Sender: TObject);
    procedure DefFieldEditor(Sender: TObject);
    procedure DefDataSourceEditor(Sender: TObject);
    procedure DefCrossDataSourceEditor(Sender: TObject);
    procedure DefGroupEditor(Sender: TObject);
    procedure DefFontEditor(Sender: TObject);
    procedure DefCalcMemoEditor(Sender: TObject);
    procedure DefScript_BeforePrintEditor(Sender: TObject);
    procedure DefScript_AfterPrintEditor(Sender: TObject);

    procedure FillInspFields;
    function RectTypEnabled: Boolean;
    function FontTypEnabled: Boolean;
    function ZEnabled: Boolean;
    function CutEnabled: Boolean;
    function CopyEnabled: Boolean;
    function PasteEnabled: Boolean;
    function DelEnabled: Boolean;
    function EditEnabled: Boolean;
    procedure MoveObjects(dx, dy: Integer; Resize: Boolean);
    procedure SelectAll;
    procedure Unselect;
    procedure CutToClipboard;
    procedure CopyToClipboard;
    procedure SaveState;
    procedure RestoreState;
    procedure SetOpenFileMenuItems(const aNewFile: string);
    procedure ClearBuffer(Buffer: TRMUndoBuffer; var BufferLength: Integer);
    procedure ClearUndoBuffer;
    procedure ClearRedoBuffer;
    procedure Undo(Buffer: PRMUndoBuffer);
    procedure ReleaseAction(ActionRec: TRMUndoRec);
    procedure AddAction(Buffer: PRMUndoBuffer; a: TRMUndoAction; List: TList);
    procedure AddUndoAction(a: TRMUndoAction);
    procedure InsFieldsClick(Sender: TObject);
    procedure GetDefaultSize(var dx, dy: Integer);
    function SelStatus: TRMSelectionStatus;
    procedure OnModify(Item: Integer);
    procedure PageFormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure PageFormResize(Sender: TObject);
    procedure PageFormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    function BeforeEdit: Boolean;
    procedure AfterEdit;
    procedure DoEdit(ClassRef: TClass);
    procedure ShowFieldsDialog(Show: Boolean);
    procedure HeightChanged(Sender: TObject);
    procedure InspSelectionChanged(ObjName: string);
    procedure InspGetObjects(List: TStrings);
    procedure NotifyParentBands(OldName, NewName: string);
    procedure NotifySubReports(OldIndex, NewIndex: Integer);
    procedure AssignDefEditors;
{$IFDEF Delphi4}
    procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
    procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
{$ENDIF}
    procedure OnPreviewPageChange(Sender: TObject);
    procedure Localize;
  protected
    function GetDesignerPage: TWinControl; override;
  public
    { Public declarations }
    function GetModified: Boolean; override;
    procedure SetModified(Value: Boolean); override;
    procedure RegisterObject(ButtonBmp: TBitmap; const ButtonHint: string; ButtonTag: Integer; IsControl: Boolean); override;
    procedure RegisterTool(MenuCaption: string; ButtonBmp: TBitmap; OnClick: TNotifyEvent); override;
    procedure BeforeChange; override;
    procedure AfterChange; override;
    procedure SelectObject(ObjName: string); override;
    function InsertDBField: string; override;
    function InsertExpression: string; override;
    procedure ShowMemoEditor(Sender: TObject);
    procedure ShowEditor;
    procedure RedrawPage; override;
    function PointsToUnits(x: Double): Double;
    function UnitsToPoints(x: Double): Double;

    property CurDocName: string read FCurDocName write SetCurDocName;
    property CurPage: Integer read FCurPage write SetCurPage;
    property GridSizeX: Integer read FGridSizeX write SetGridSize;
    property GridSizeY: Integer read FGridSizeY write SetGridSize;
    property ShowGrid: Boolean read FGridShow write SetGridShow;
    property GridAlign: Boolean read FGridAlign write SetGridAlign;
    property Units: TRMSizeUnits read FUnits write SetUnits;
    property PageType: TRMPageType read FPageType;
    property UseTableName: Boolean read FUseTableName write FUseTableName;
  end;

//old
function RMCheckBand(b: TRMBandType): Boolean;

var
  RMTemplateDir: string;
  DesignerRestrictions: TRMDesignerRestrictions;

implementation

{$R *.DFM}
{$R *.RES}
{$R RM_LNG2.RES}
{$R RM_LNG3.RES}

uses
  Commctrl, Registry, RM_CmpReg, RM_Pgopt, RM_GEdit,
  RM_Templ, RM_Newrp, RM_DsOpt, RM_Const, RM_Const1, RM_Prntr, RM_Hilit, RM_Flds, RM_flds1,
  RM_Dict, RM_BndEd, RM_VBnd, RM_BTyp, RM_Utils, RM_GrpEd, RM_About,
  RM_IFlds, RM_Restr, RM_Pars, RM_DBRel, RM_DBSet, RM_CalcEditor, RM_fmted, RM_FrameProp,
  RM_DlgExpr, RM_PageF, rm_Wizard, rm_RptWiz, DB;

type
  THackView = class(TRMView)
  end;

var
  FirstSelected: TRMView;
  SelNum: Integer; // number of objects currently selected
  MRFlag: Boolean; // several objects was selected
  ObjRepeat: Boolean; // was pressed Shift + Insert Object
  WasOk: Boolean; // was Ok pressed in dialog
  OldRect, OldRect1: TRect; // object rect after mouse was clicked
  Busy: Boolean; // busy flag. need!
  ShowSizes: Boolean;
  LastFontName: string;
  LastFrameWidth, LastLineWidth: Single;
  LastFrameTyp, LastFontStyle, LastCharset: Word;
  LastFrameColor, LastFillColor, LastFontColor: TColor;
  LastFontSize, LastAlignment: Integer;
  FirstChange: Boolean;
  ClipRgn: HRGN;
  DesignerComp: TRMDesigner;
  InspBusy: Boolean;

  FClipBd: TList; // clipboard

//===========================================================================
//WHF Add

function ClipBd: TList;
begin
  if FClipBd = nil then
    FClipBd := TList.Create;
  Result := FClipBd;
end;

//===========================================================================
//old

function Objects: TList;
begin
  Result := RMDesigner.Page.Objects;
end;

function TopSelected: Integer;
var
  i: Integer;
begin
  Result := Objects.Count - 1;
  for i := Objects.Count - 1 downto 0 do
  begin
    if TRMView(Objects[i]).Selected then
    begin
      Result := i;
      Break;
    end;
  end;
end;

function RMCheckBand(b: TRMBandType): Boolean;
var
  i: Integer;
  t: TRMView;
begin
  Result := False;
  for i := 0 to Objects.Count - 1 do
  begin
    t := Objects[i];
    if t.Typ = gtBand then
    begin
      if b = TRMBandView(t).BandType then
      begin
        Result := True;
        Break;
      end;
    end;
  end;
end;

function GetUnusedBand: TRMBandType;
var
  b: TRMBandType;
begin
  Result := btNone;
  for b := btReportTitle to btNone do
  begin
    if not RMCheckBand(b) then
    begin
      Result := b;
      Break;
    end;
  end;
  if Result = btNone then Result := btMasterData;
end;

procedure SendBandsToDown;
var
  i, j, n, k: Integer;
  t: TRMView;
begin
  n := Objects.Count; j := 0; i := n - 1;
  k := 0;
  while j < n do
  begin
    t := Objects[i];
    if t.Typ = gtBand then
    begin
      Objects.Delete(i);
      Objects.Insert(0, t);
      Inc(k);
    end
    else
      Dec(i);
    Inc(j);
  end;

  for i := 0 to n - 1 do // sends btOverlay to back
  begin
    t := Objects[i];
    if (t.Typ = gtBand) and (TRMBandView(t).BandType = btOverlay) then
    begin
      Objects.Delete(i);
      Objects.Insert(0, t);
      Break;
    end;
  end;
  i := 0; j := 0;
  while j < n do // sends btCrossXXX to RMont
  begin
    t := Objects[i];
    if (t.Typ = gtBand) and (TRMBandView(t).BandType in [btCrossHeader..btCrossFooter]) then
    begin
      Objects.Delete(i);
      Objects.Insert(k - 1, t);
    end
    else
      Inc(i);
    Inc(j);
  end;
end;

procedure ClearClipBoard;
var
  m: TMemoryStream;
begin
  if Assigned(FClipBd) then
  begin
    with FClipBd do
    begin
      while Count > 0 do
      begin
        m := Items[0];
        m.Free;
        Delete(0);
      end;
    end;
  end;
end;

procedure GetRegion;
var
  i: Integer;
  t: TRMView;
  R: HRGN;
begin
  ClipRgn := CreateRectRgn(0, 0, 0, 0);
  for i := 0 to Objects.Count - 1 do
  begin
    t := Objects[i];
    if t.Selected then
    begin
      R := t.GetClipRgn(rtExtended);
      CombineRgn(ClipRgn, ClipRgn, R, RGN_OR);
      DeleteObject(R);
    end;
  end;
  FirstChange := False;
end;

function IsBandsSelect(var Value: TRMView): Boolean;
var
  i: Integer;
begin
  Result := False;
  Value := nil;
  for i := 0 to Objects.Count - 1 do
  begin
    Value := Objects[i];
    if Value.Selected and (Value.Typ = gtBand) then
    begin
      Result := True;
      Break;
    end;
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMDesigner}

constructor TRMDesigner.Create(AOwner: TComponent);
begin
//  if Assigned(DesignerComp) then
//    raise Exception.Create('You already have one TRMDesigner component');
  inherited Create(AOwner);
  FCloseQuery := True;
  DesignerComp := Self;
  HideDisabledButtons := True;
  FHelpFile := 'rmuser.hlp';
  FOpenFileCount := 4;
end;

destructor TRMDesigner.Destroy;
begin
  DesignerComp := nil;
  inherited Destroy;
end;

procedure TRMDesigner.SetOpenFileCount(Value: Integer);
begin
  if (Value >= 0) and (Value <= 9) then
    FOpenFileCount := Value;
end;

{----------------------------------------------------------------------------}
{----------------------------------------------------------------------------}
{TRMDesignerPage}

constructor TRMDesignerPage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Parent := AOwner as TWinControl;
  BevelInner := bvNone;
  BevelOuter := bvNone;
  Color := clWhite;
  BorderStyle := bsNone;
  OnMouseDown := MDown;
  OnMouseUp := MUp;
  OnMouseMove := MMove;
  OnDblClick := DClick;
  OnDragOver := DoDragOver;
  OnDragDrop := DoDragDrop;
end;

procedure TRMDesignerPage.Init;
begin
  FDown := False; FDFlag := False; FRFlag := False;
  Cursor := crDefault; FCT := ctNone;
end;

procedure TRMDesignerPage.SetPage;
var
  Pgw, Pgh, Pgl, Pgt: Integer;
begin
  Pgw := FDesigner.Page.PrnInfo.Pgw;
  Pgh := FDesigner.Page.PrnInfo.Pgh;
  if FDesigner.FUnlimitedHeight then
    Pgh := Pgh * 3;
  Pgt := 10;
  if (Pgw > Parent.ClientWidth - 11) or (FDesigner.FPagePosition = alLeft) then
    Pgl := 10
  else if FDesigner.FPagePosition = alClient then
    Pgl := (Parent.ClientWidth - Pgw) div 2
  else
    Pgl := Parent.ClientWidth - Pgw - 11;

  if FDesigner.PageType = ptDialog then