frxdesgnctrls.pas

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

{******************************************}
{ }
{ FastReport v3.0 }
{ Designer controls }
{ }
{ Copyright (c) 1998-2005 }
{ by Alexander Tzyganenko, }
{ Fast Reports Inc. }
{ }
{******************************************}

unit frxDesgnCtrls;

interface

{$I frx.inc}

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

type
  TfrxRulerUnits = (ruCM, ruInches, ruPixels, ruChars);

  TfrxRuler = class(TPanel)
  private
    FOffset:Integer;
    FScale:Extended;
    FStart:Integer;
    FUnits:TfrxRulerUnits;
    FPosition:Extended;
    procedure SetOffset(const Value:Integer);
    procedure SetScale(const Value:Extended);
    procedure SetStart(const Value:Integer);
    procedure SetUnits(const Value:TfrxRulerUnits);
    procedure SetPosition(const Value:Extended);
    procedure WMEraseBackground(var Message:TMessage); message WM_ERASEBKGND;
  public
    constructor Create(AOwner:TComponent); override;
    procedure Paint; override;
  published
    property Offset:Integer read FOffset write SetOffset;
    property Scale:Extended read FScale write SetScale;
    property Start:Integer read FStart write SetStart;
    property Units:TfrxRulerUnits read FUnits write SetUnits default ruPixels;
    property Position:Extended read FPosition write SetPosition;
  end;

  TfrxScrollBox = class(TScrollBox)
  protected
    procedure WMGetDlgCode(var Message:TWMGetDlgCode); message WM_GETDLGCODE;
    procedure KeyDown(var Key:Word; Shift:TShiftState); override;
    procedure KeyUp(var Key:Word; Shift:TShiftState); override;
    procedure KeyPress(var Key:Char); override;
  end;

  TfrxCustomSelector = class(TPanel)
  protected
    procedure DrawEdge(X, Y:Integer; IsDown:Boolean); virtual; abstract;
    procedure MouseDown(Button:TMouseButton; Shift:TShiftState;
      X, Y:Integer); override;
    procedure MouseMove(Shift:TShiftState; X, Y:Integer); override;
  public
    procedure Paint; override;
    constructor Create(AOwner:TComponent); override;
  end;

  TfrxColorSelector = class(TfrxCustomSelector)
  private
    FColor:TColor;
    FOnColorChanged:TNotifyEvent;
  protected
    procedure DrawEdge(X, Y:Integer; IsDown:Boolean); override;
    procedure MouseUp(Button:TMouseButton; Shift:TShiftState;
      X, Y:Integer); override;
  public
    constructor Create(AOwner:TComponent); override;
    procedure Paint; override;
    property Color:TColor read FColor write FColor;
    property OnColorChanged:TNotifyEvent read FOnColorChanged write FOnColorChanged;
  end;

  TfrxLineSelector = class(TfrxCustomSelector)
  private
    FStyle:Byte;
    FOnStyleChanged:TNotifyEvent;
  protected
    procedure DrawEdge(X, Y:Integer; IsDown:Boolean); override;
    procedure MouseUp(Button:TMouseButton; Shift:TShiftState;
      X, Y:Integer); override;
  public
    constructor Create(AOwner:TComponent); override;
    procedure Paint; override;
    property Style:Byte read FStyle;
    property OnStyleChanged:TNotifyEvent read FOnStyleChanged write FOnStyleChanged;
  end;

  TfrxUndoBuffer = class(TObject)
  private
    FUndo, FRedo:TList;
    function GetRedoCount:Integer;
    function GetUndoCount:Integer;
  public
    constructor Create;
    destructor Destroy; override;
    procedure AddUndo(Report:TfrxReport);
    procedure AddRedo(Report:TfrxReport);
    procedure GetUndo(Report:TfrxReport);
    procedure GetRedo(Report:TfrxReport);
    procedure ClearUndo;
    procedure ClearRedo;
    property UndoCount:Integer read GetUndoCount;
    property RedoCount:Integer read GetRedoCount;
  end;

  TfrxClipboard = class(TObject)
  private
    FDesigner:TfrxCustomDesigner;
    function GetPasteAvailable:Boolean;
  public
    constructor Create(ADesigner:TfrxCustomDesigner);
    procedure Copy;
    procedure Paste;
    property PasteAvailable:Boolean read GetPasteAvailable;
  end;

implementation

uses frxDMPClass, frxPopupForm, frxDsgnIntf, frxCtrls, frxXMLSerializer, Clipbrd;

const
  Colors:Array[0..39] of TColor =
    (clNone, clWhite, clBlack, clMaroon, clGreen, clOlive, clNavy, clPurple,
     clGray, clSilver, clTeal, clRed, clLime, clYellow, clBlue, clFuchsia,
     $CCCCCC, $E4E4E4, clAqua, $00CCFF, $00CC98, $98FFFF, $FFCC00, $FF98CC,
     $D8D8D8, $F0F0F0, $FFFFDC, $CAE4FF, $CCFFCC, $CCFFFF, $FFF4CC, $CC98FF,
     clBtnFace, clBtnFace, clBtnFace, clBtnFace, clBtnFace, clBtnFace, clBtnFace, clBtnFace);

type
  THackControl = class(TWinControl);

{ TfrxRuler }

constructor TfrxRuler.Create(AOwner:TComponent);
begin
  inherited;
  FScale:= 1;
  DoubleBuffered:= True;
end;

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

procedure TfrxRuler.Paint;
var
  fh, oldfh:HFont;

  function CreateRotatedFont(Font:TFont):HFont;
  var
    F:TLogFont;
  begin
    GetObject(Font.Handle, SizeOf(TLogFont), @F);
    F.lfEscapement:= 90 * 10;
    F.lfOrientation:= 90 * 10;
    Result:= CreateFontIndirect(F);
  end;

  procedure Line(x, y, dx, dy:Integer);
  begin
    Canvas.MoveTo(x, y);
    Canvas.LineTo(x+dx, y+dy);
  end;

  procedure DrawLines;
  var
    i, dx, maxi:Extended;
    i1, h, w, w5, w10, maxw, ofs:Integer;
    s:String;
  begin
    with Canvas do
    begin
      Pen.Color:= clBlack;
      Brush.Style:= bsClear;
      w5:= 5;
      w10:= 10;
      if FUnits = ruCM then
        dx:= fr01cm * FScale
      else if FUnits = ruInches then
        dx:= fr01in * FScale
      else if FUnits = ruChars then
      begin
        if Align = alLeft then
          dx:= fr1CharY * FScale / 10 else
          dx:= fr1CharX * FScale / 10
      end
      else
      begin
        dx:= FScale;
        w5:= 50;
        w10:= 100;
      end;

      if Align = alLeft then
        maxi:= Height+FStart else
        maxi:= Width+FStart;

      if FUnits = ruPixels then
        s:= IntToStr(FStart+Round(maxi / dx)) else
        s:= IntToStr((FStart+Round(maxi / dx)) div 10);

      maxw:= TextWidth(s);
      ofs:= FOffset-FStart;
      if FUnits = ruChars then
      begin
        if Align = alLeft then
          Inc(ofs, Round(fr1CharY * FScale / 2)) else
          Inc(ofs, Round(fr1CharX * FScale / 2))
      end;

      i:= 0;
      i1:= 0;
      while i < maxi do
      begin
        h:= 0;
        if i1 = 0 then
          h:= 0
        else if i1 mod w10 = 0 then
          h:= 6
        else if i1 mod w5 = 0 then
          h:= 4
        else if FUnits<>ruPixels then
          h:= 2;

        if (h = 2) and (dx * w10 < 41) then
          h:= 0;
        if (h = 4) and (dx * w10 < 21) then
          h:= 0;

        w:= 0;
        if h = 6 then
        begin
          if maxw > dx * w10 * 1.5 then
            w:= w10 * 4
          else if maxw > dx * w10 * 0.7 then
            w:= w10 * 2
          else
            w:= w10;
        end;

        if FUnits = ruPixels then
          s:= IntToStr(i1) else
          s:= IntToStr(i1 div 10);

        if (w<>0) and (i1 mod w = 0) and (ofs+i >= FOffset) then
          if Align = alLeft then
            TextOut(Width-TextHeight(s)-6, ofs+Round(i)+TextWidth(s) div 2+1, s) else
            TextOut(ofs+Round(i)-TextWidth(s) div 2+1, 4, s)
        else if (h<>0) and (ofs+i >= FOffset) then
          if Align = alLeft then
            Line(3+(13-h) div 2, ofs+Round(i), h, 0) else
            Line(ofs+Round(i), 3+(13-h) div 2, 0, h);

        i:= i+dx;
        Inc(i1);
      end;

      i:= FPosition * dx;
      if FUnits<>ruPixels then
        i:= i * 10;
      if ofs+i >= FOffset then
        if Align = alLeft then
          Line(3, ofs+Round(i), 13, 0) else
          Line(ofs+Round(i), 3, 0, 13);
    end;
  end;

begin
  fh:= 0; oldfh:= 0;
  with Canvas do
  begin
    Brush.Color:= clBtnFace;
    Brush.Style:= bsSolid;
    FillRect(Rect(0, 0, Width, Height));
    Brush.Color:= clWindow;

    Font.Name:= 'Arial';
    Font.Size:= 7;
    if Align = alLeft then
    begin
      FillRect(Rect(3, FOffset, Width-5, Height));
      fh:= CreateRotatedFont(Font);
      oldfh:= SelectObject(Handle, fh);
    end
    else
      FillRect(Rect(FOffset, 3, Width, Height-5));
  end;

  DrawLines;

  if Align = alLeft then
  begin
    SelectObject(Canvas.Handle, oldfh);
    DeleteObject(fh);
  end;
end;

procedure TfrxRuler.SetOffset(const Value:Integer);
begin
  FOffset:= Value;
  Invalidate;
end;

procedure TfrxRuler.SetPosition(const Value:Extended);
begin
  FPosition:= Value;
  Invalidate;
end;

procedure TfrxRuler.SetScale(const Value:Extended);
begin
  FScale:= Value;
  Invalidate;
end;

procedure TfrxRuler.SetStart(const Value:Integer);
begin
  FStart:= Value;
  Invalidate;
end;

procedure TfrxRuler.SetUnits(const Value:TfrxRulerUnits);
begin
  FUnits:= Value;
  Invalidate;
end;

{ TfrxScrollBox }

procedure TfrxScrollBox.KeyDown(var Key:Word; Shift:TShiftState);
var
  i:Integer;
begin
  inherited;
  for i:= 0 to ControlCount-1 do
    if Controls[i] is TWinControl then
      THackControl(Controls[i]).KeyDown(Key, Shift);
end;

procedure TfrxScrollBox.KeyPress(var Key:Char);
var
  i:Integer;
begin
  inherited;
  for i:= 0 to ControlCount-1 do
    if Controls[i] is TWinControl then
      THackControl(Controls[i]).KeyPress(Key);
end;

procedure TfrxScrollBox.KeyUp(var Key:Word; Shift:TShiftState);
var
  i:Integer;
begin
  inherited;
  for i:= 0 to ControlCount-1 do
    if Controls[i] is TWinControl then
      THackControl(Controls[i]).KeyUp(Key, Shift);
end;

procedure TfrxScrollBox.WMGetDlgCode(var Message:TWMGetDlgCode);
begin
  Message.Result:= DLGC_WANTARROWS or DLGC_WANTTAB;
end;

{ TfrxCustomSelector }

constructor TfrxCustomSelector.Create(AOwner:TComponent);
var
  f:TfrxPopupForm;
  p:TPoint;
begin
  f:= TfrxPopupForm.Create(nil);
  f.AutoSize:= True;

  inherited Create(f);
  Parent:= f;
  DoubleBuffered:= True;
  Tag:= AOwner.Tag;

  with TControl(AOwner) do
    p:= ClientToScreen(Point(0, Height+2));
  f.SetBounds(p.X, p.Y, 20, 20);
  f.Show;
end;

procedure TfrxCustomSelector.MouseDown(Button:TMouseButton; Shift:TShiftState;
  X, Y:Integer);
begin
  DrawEdge(X, Y, True);
end;

procedure TfrxCustomSelector.MouseMove(Shift:TShiftState; X, Y:Integer);
begin
  DrawEdge(X, Y, False);
end;

procedure TfrxCustomSelector.Paint;
begin
  DrawButtonFace(Canvas, BoundsRect, 1, bsNew, False, False, False);
end;

{ TfrxColorSelector }

constructor TfrxColorSelector.Create(AOwner:TComponent);
begin
  inherited;
  Width:= 155;
  Height:= 125;
end;

procedure TfrxColorSelector.DrawEdge(X, Y:Integer; IsDown:Boolean);
var
  r:TRect;
begin
  X:= (X-5) div 18;
  if X >= 8 then
    X:= 7;
  Y:= (Y-5) div 18;

  Repaint;
  if Y < 5 then
    r:= Rect(X * 18+5, Y * 18+5, X * 18+23, Y * 18+23) else
    r:= Rect(5, 95, Width-6, Height-6);

  if IsDown then
    Frame3D(Canvas, r, clBtnShadow, clBtnHighlight, 1) else
    Frame3D(Canvas, r, clBtnHighlight, clBtnShadow, 1);
end;

procedure TfrxColorSelector.MouseUp(Button:TMouseButton; Shift:TShiftState;
  X, Y:Integer);
var
  cd:TColorDialog;

  procedure AddCustomColor;