fr_desgn.pas

FASTREPORT报表工具,可以迅速制作报表.

    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 ColorSelected(Sender: TObject);
    procedure MoveObjects(dx, dy: Integer; Resize: Boolean);
    procedure SelectAll;
    procedure Unselect;
    procedure CutToClipboard;
    procedure CopyToClipboard;
    procedure SaveState;
    procedure RestoreState;
    procedure ClearBuffer(Buffer: TfrUndoBuffer; var BufferLength: Integer);
    procedure ClearUndoBuffer;
    procedure ClearRedoBuffer;
    procedure Undo(Buffer: PfrUndoBuffer);
    procedure ReleaseAction(ActionRec: TfrUndoRec);
    procedure AddAction(Buffer: PfrUndoBuffer; a: TfrUndoAction; List: TList);
    procedure AddUndoAction(a: TfrUndoAction);
    procedure DoDrawText(Canvas: TCanvas; Caption: string;
      Rect: TRect; Selected, Enabled: Boolean; Flags: Longint);
    procedure MeasureItem(AMenuItem: TMenuItem; ACanvas: TCanvas;
      var AWidth, AHeight: Integer);
    procedure DrawItem(AMenuItem: TMenuItem; ACanvas: TCanvas;
      ARect: TRect; Selected: Boolean);
    procedure InsFieldsClick(Sender: TObject);
    function FindMenuItem(AMenuItem: TMenuItem): TfrMenuItemInfo;
    procedure SetMenuItemBitmap(AMenuItem: TMenuItem; ABtn:TfrSpeedButton);
    procedure FillMenuItems(MenuItem: TMenuItem);
    procedure DeleteMenuItems(MenuItem: TMenuItem);
    procedure GetDefaultSize(var dx, dy: Integer);
    function SelStatus: TfrSelectionStatus;
    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 NotifyParentBands(OldName, NewName: String);
    procedure NotifySubReports(OldIndex, NewIndex: Integer);
    procedure InspSelectionChanged(ObjName: String);
    procedure InspGetObjects(List: TStrings);
    procedure AssignDefEditors;
    procedure Localize;
{$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}
  public
    { Public declarations }
    function GetModified: Boolean; override;
    procedure SetModified(Value: Boolean); override;
    procedure WndProc(var Message: TMessage); override;
    procedure RegisterObject(ButtonBmp: TBitmap; ButtonHint: String;
      ButtonTag: Integer; IsControl: Boolean);
    procedure RegisterTool(MenuCaption: String; ButtonBmp: TBitmap;
      OnClick: TNotifyEvent);
    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: TfrReportUnits read FUnits write SetUnits;
    property GrayedButtons: Boolean read FGrayedButtons write SetGrayedButtons;
    property PageType: TfrPageType read FPageType;
  end;


procedure frSetGlyph(Color: TColor; sb: TfrSpeedButton; n: Integer);
function frCheckBand(b: TfrBandType): Boolean;

var
  frTemplateDir: String;
  DesignerRestrictions: TfrDesignerRestrictions;


implementation

{$R *.DFM}
{$R *.RES}
{$R FR_Lng2.RES}
{$R FR_Lng3.RES}

uses
  FR_Pgopt, FR_GEdit, FR_Templ, FR_Newrp, FR_DsOpt, FR_Const, FR_AttrE,
  FR_Prntr, FR_Hilit, FR_Dopt, FR_Dict, FR_BndEd, FR_VBnd, FR_Flds,
  FR_BTyp, FR_Utils, FR_GrpEd, FR_About, FR_IFlds, FR_Pars, FR_DBRel,
  FR_Restr, FR_DBSet, FR_PageF, FR_Expr, Registry, CommCtrl, FR_Funcs
{$IFDEF Delphi6}
, Variants
{$ENDIF};

type
  THackView = class(TfrView)
  end;

var
  FirstSelected: TfrView;
  SelNum: Integer;               // number of objects currently selected
  MRFlag,                        // several objects was selected
  ObjRepeat,                     // 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;
  LastFontSize, LastAlignment: Integer;
  LastFrameWidth, LastLineWidth: Single;
  LastFrameTyp, LastFontStyle, LastCharset: Word;
  LastFrameColor, LastFillColor, LastFontColor: TColor;
  ClrButton: TfrSpeedButton;
  FirstChange: Boolean;
  ClipRgn: HRGN;
  DesignerComp: TfrDesigner;
  InspBusy: Boolean;

// globals
  ClipBd: TList;                 // clipboard
  GridBitmap: TBitmap;           // for drawing grid in design time


{----------------------------------------------------------------------------}
// miscellaneous routines
function Objects: TList;
begin
  Result := frDesigner.Page.Objects;
end;

procedure frSetGlyph(Color: TColor; sb: TfrSpeedButton; n: Integer);
var
  b: TBitmap;
  r: TRect;
  i, j: Integer;
begin
  b := TBitmap.Create;
  b.Width := 32;
  b.Height := 16;
  with b.Canvas do
  begin
    r := Rect(n * 32, 0, n * 32 + 32, 16);
    CopyRect(Rect(0, 0, 32, 16), TfrDesignerForm(frDesigner).Image1.Picture.Bitmap.Canvas, r);
    for i := 0 to 32 do
      for j := 0 to 16 do
        if Pixels[i, j] = clRed then
          Pixels[i, j] := Color;
    if Color = clNone then
      for i := 1 to 14 do
        Pixels[i, 13] := clBtnFace;
  end;
  sb.Glyph.Assign(b);
  sb.NumGlyphs := 2;
  b.Free;
end;

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

function frCheckBand(b: TfrBandType): Boolean;
var
  i: Integer;
  t: TfrView;
begin
  Result := False;
  for i := 0 to Objects.Count - 1 do
  begin
    t := Objects[i];
    if t.Typ = gtBand then
      if b = TfrBandType(t.FrameTyp) then
      begin
        Result := True;
        break;
      end;
  end;
end;

function GetUnusedBand: TfrBandType;
var
  b: TfrBandType;
begin
  Result := btNone;
  for b := btReportTitle to btNone do
    if not frCheckBand(b) then
    begin
      Result := b;
      break;
    end;
  if Result = btNone then Result := btMasterData;
end;

procedure SendBandsToDown;
var
  i, j, n, k: Integer;
  t: TfrView;
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 (t.FrameTyp = Integer(btOverlay)) then
    begin
      Objects.Delete(i);
      Objects.Insert(0, t);
      break;
    end;
  end;
  i := 0; j := 0;
  while j < n do // sends btCrossXXX to front
  begin
    t := Objects[i];
    if (t.Typ = gtBand) and
       (TfrBandType(t.FrameTyp) 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(ClipBd) then
    with ClipBd do
    while Count > 0 do
    begin
      m := Items[0];
      m.Free;
      Delete(0);
    end;
end;

procedure GetRegion;
var
  i: Integer;
  t: TfrView;
  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: TfrView): 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;


{----------------------------------------------------------------------------}
constructor TfrDesigner.Create(AOwner: TComponent);
begin
  if Assigned(DesignerComp) then
    raise Exception.Create('You already have one TfrDesigner component');
  inherited Create(AOwner);
  FCloseQuery := True;
  DesignerComp := Self;
  HideDisabledButtons := True;
end;

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


{--------------------------------------------------}
constructor TfrDesignerPage.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 TfrDesignerPage.Init;
begin
  Down := False; DFlag := False; RFlag := False;
  Cursor := crDefault; CT := ctNone;
end;

procedure TfrDesignerPage.SetPage;
var
  Pgw, Pgh, Pgl, Pgt: Integer;
begin
  if (FDesigner.Page = nil) or DisableDraw then Exit;
  Pgw := FDesigner.Page.PrnInfo.Pgw;
  Pgh := FDesigner.Page.PrnInfo.Pgh;
  if FDesigner.UnlimitedHeight then
    Pgh := Pgh * 3;
  Pgt := 10;
  if (Pgw > Parent.ClientWidth - 11) or (FDesigner.PagePosition = alLeft) then
    Pgl := 10
  else if FDesigner.PagePosition = alClient then
    Pgl := (Parent.ClientWidth - Pgw) div 2
  else
    Pgl := Parent.ClientWidth - Pgw - 11;

  if FDesigner.PageType = ptDialog then
  begin
    FDesigner.PageForm.OnResize := nil;
    Align := alClient;
    FDesigner.PageForm.OnResize := FDesigner.PageFormResize;
  end
  else
  begin
    Align := alNone;
    SetBounds(Pgl, Pgt, Pgw, Pgh);
    TScrollBox(Parent).VertScrollBar.Range := Top + Height + 10;
    TScrollBox(Parent).HorzScrollBar.Range := Left + Width + 10
{$IFDEF Delphi2}
{$ELSE}
{$IFDEF Delphi3}
{$ELSE}
     - GetSystemMetrics(SM_CXVSCROLL)
{$ENDIF}
{$ENDIF};
  end;
end;

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

procedure TfrDesignerPage.Paint;
begin
  Draw(10000, 0);
end;

procedure TfrDesignerPage.NormalizeCoord(t: TfrView);
begin
  if t.dx < 0 then
  begin
    t.dx := -t.dx;
    t.x := t.x - t.dx;
  end;
  if t.dy < 0 then
  begin
    t.dy := -t.dy;
    t.y := t.y - t.dy;
  end;
end;

procedure TfrDesignerPage.NormalizeRect(var r: TRect);
var
  i: Integer;
begin
  with r do
  begin
    if Left > Right then begin i := Left; Left := Right; Right := i end;
    if Top > Bottom then begin i := Top; Top := Bottom; Bottom := i end;
  end;
end;

procedure TfrDesignerPage.DrawHSplitter(Rect: TRect);
begin
  with Canvas do
  begin
    Pen.Mode := pmXor;
    Pen.Color := clSilver;
    Pen.Width := 1;
    MoveTo(Rect.Left, Rect.Top);
    LineTo(Rect.Right, Rect.Bottom);
    Pen.Mode := pmCopy;
  end;
end;

procedure TfrDesignerPage.DrawRectLine(Rect: TRect);
begin
  with Canvas do
  begin
    Pen.Mode := pmNot;
    Pen.Style := psSolid;
    Pen.Width := Round(LastLineWidth);
    with Rect do
      if Abs(Right - Left) > Abs(Bottom - Top) then
      begin
        MoveTo(Left, Top);