frd_form.pas

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

{******************************************}
{                                          }
{     FastReport v2.4 - Data storage       }
{              Form editor                 }
{                                          }
{ Copyright (c) 1998-2000 by Tzyganenko A. }
{                                          }
{******************************************}

unit FRD_Form;

interface

{$I FR.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, DBCtrls, Db, ExtCtrls, FR_Ctrls, ComCtrls
{$IFDEF RX}
  , Mask, ToolEdit
{$ENDIF};

type
  TfrParamsDialogForm = class(TForm)
    Panel1: TPanel;
    Gr4B: TfrSpeedButton;
    Bevel2: TBevel;
    Gr8B: TfrSpeedButton;
    GrAlignB: TfrSpeedButton;
    CloseB: TfrSpeedButton;
    procedure FormResize(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormHide(Sender: TObject);
    procedure Gr4BClick(Sender: TObject);
    procedure CloseBClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    b: TButton;
    procedure PlaceControls;
    procedure GetControlsInfo;
    procedure ComboBoxDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
  public
    { Public declarations }
    Designing: Boolean;
  end;

  TfrDesignLabel = class(TLabel)
  public
    procedure WndProc(var Message: TMessage); override;
  end;

  TfrDesignEdit = class(TEdit)
  public
    procedure WndProc(var Message: TMessage); override;
  end;

  TfrDesignLookup = class(TDBLookupComboBox)
  public
    procedure WndProc(var Message: TMessage); override;
  end;

  TfrDesignCombo = class(TComboBox)
  public
    procedure WndProc(var Message: TMessage); override;
    procedure ComboWndProc(var Message: TMessage; ComboWnd: HWnd;
      ComboProc: Pointer); override;
  end;

{$UNDEF UseDateEdit}
{$IFDEF RX}
  {$DEFINE UseDateEdit}
{$ELSE}
  {$IFNDEF Delphi2}
    {$DEFINE UseDateEdit}
  {$ENDIF}
{$ENDIF}

{$IFDEF UseDateEdit}
{$IFDEF RX}
  TfrDesignDateEdit = class(TDateEdit)
{$ELSE}
  TfrDesignDateEdit = class(TDateTimePicker)
{$ENDIF}
  public
    procedure WndProc(var Message: TMessage); override;
  end;
{$ENDIF}

var
  frParamsDialogForm: TfrParamsDialogForm;
  ParamFormWidth, ParamFormHeight: Integer;
  SelList: TList;


implementation

uses FR_Class, FRD_Mngr, FRD_Prop, FR_Const, FR_Utils;

{$R *.DFM}

type
  THackControl = class(TControl)
  end;

  TPaintPanel = class(TPanel)
  private
    Down,DClick: Boolean;
    LastX,LastY: Integer;
    procedure DrawSelection(t:TControl);
    procedure ClearSelection;
    procedure MMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure MDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure MUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure MDblClick(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
    procedure Paint; override;
  end;


var
  CT: (ctNone, ct1, ct2, ct3, ct4);  // current mouse cursor (sizing arrows)
  OldRect: TRect;
  PaintPanel: TPaintPanel;
  IsDesigning: Boolean;


function CaptureWndProc(c: TControl; var Message: TMessage): Boolean;
begin
  Result := True;
  if IsDesigning then
    if (Message.Msg >= WM_MOUSEFIRST) and (Message.Msg <= WM_MOUSELAST) then
    begin
      with Message do
      begin
        LParam := (LParam div 65536 + c.Top) * 65536 + LParam mod 65536 + c.Left;
        PaintPanel.Dispatch(Message);
      end;
      Result := False;
    end;
end;

procedure TfrDesignLabel.WndProc(var Message: TMessage);
begin
  if CaptureWndProc(Self, Message) then
    inherited;
end;

procedure TfrDesignEdit.WndProc(var Message: TMessage);
begin
  if CaptureWndProc(Self, Message) then
    inherited;
end;

procedure TfrDesignLookup.WndProc(var Message: TMessage);
begin
  if CaptureWndProc(Self, Message) then
    inherited;
end;

procedure TfrDesignCombo.WndProc(var Message: TMessage);
begin
  if CaptureWndProc(Self, Message) then
    inherited;
end;

procedure TfrDesignCombo.ComboWndProc(var Message: TMessage; ComboWnd: HWnd;
  ComboProc: Pointer);
begin
  if CaptureWndProc(Self, Message) then
    inherited;
end;

{$IFDEF UseDateEdit}
procedure TfrDesignDateEdit.WndProc(var Message: TMessage);
begin
  if CaptureWndProc(Self, Message) then
    inherited;
end;
{$ENDIF}

{-----------------------------------------------------------------------------}
constructor TPaintPanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Parent := AOwner as TWinControl;
  Top := 40;
  Align := alClient;
  BevelInner := bvNone;
  BevelOuter := bvNone;
  OnMouseDown := MDown;
  OnMouseMove := MMove;
  OnMouseUp := MUp;
  OnDblClick := MDblClick;
end;

procedure TPaintPanel.DrawSelection(t: TControl);
var
  px,py: Word;

  procedure DrawPoint(x, y: Word);
  begin
    Canvas.MoveTo(x, y);
    Canvas.LineTo(x, y);
  end;

begin
  if t = nil then Exit;
  with t,Canvas do
  begin
    Pen.Width := 5;
    Pen.Color := clBlack;
    px := Left + Width div 2;
    py := Top + Height div 2;
    DrawPoint(Left - 2, Top - 2); DrawPoint(Left + Width + 2, Top - 2);
    DrawPoint(Left - 2, Top + Height + 2); DrawPoint(Left + Width + 2, Top + Height + 2);
    if SelList.Count = 1 then
    begin
      DrawPoint(px, Top - 2); DrawPoint(px, Top + Height + 2);
      DrawPoint(Left - 2, py); DrawPoint(Left + Width + 2, py);
    end;
    Pen.Mode := pmCopy;
  end;
end;

procedure TPaintPanel.ClearSelection;
var
  i: Integer;
  r: TRect;
begin
  for i := 0 to SelList.Count - 1 do
  begin
    r := TControl(SelList[i]).BoundsRect;
    Dec(r.Left, 10); Dec(r.Top, 10);
    Inc(r.Right, 10); Inc(r.Bottom, 10);
    InvalidateRect(Handle, @r, False);
  end;
end;

procedure TPaintPanel.Paint;
var
  i: Integer;
  Bmp: TBitmap;
begin
  inherited;
  if IsDesigning then
  begin
    Bmp := TBitmap.Create;
    Bmp.Width := 8; Bmp.Height := 8;
    with Bmp.Canvas do
    begin
      Brush.Color := clBtnFace;
      FillRect(Rect(0, 0, 8, 8));
      Pixels[0, 0] := clBlack;
      if frParamsDialogForm.Gr4B.Down then
      begin
        Pixels[0, 4] := clBlack;
        Pixels[4, 0] := clBlack;
        Pixels[4, 4] := clBlack;
      end;
    end;
    Canvas.Brush.Bitmap := Bmp;
    Canvas.FillRect(Rect(0, 0, Width, Height));
    if not Down then
      for i := 0 to SelList.Count - 1 do
        DrawSelection(TControl(SelList[i]));
    Bmp.Free;
  end;
end;

procedure TPaintPanel.MMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  i, kx, ky, w, Right, Bottom: Integer;

  function Cont(px, py, x, y: Integer): Boolean;
  begin
    Result := (x >= px - w) and (x <= px + w + 1) and
      (y >= py - w) and (y <= py + w + 1);
  end;

  function GridCheck: Boolean;
  var
    GridSize: Integer;
  begin
    GridSize := 4;
    if frParamsDialogForm.Gr8B.Down then
      GridSize := 8;
    Result := (kx >= GridSize) or (kx <= -GridSize) or
              (ky >= GridSize) or (ky <= -GridSize);
    if Result then
    begin
      kx := kx - kx mod GridSize;
      ky := ky - ky mod GridSize;
    end;
  end;

begin
  if not IsDesigning then Exit;
  w := 2;
  if not Down then
  begin
    if SelList.Count = 1 then
    with TControl(SelList[0]) do
    begin
      Right := Left + Width;
      Bottom := Top + Height;
      if Cont(Left - 2, Top - 2, x, y) or Cont(Right + 2, Bottom + 2, x, y) then
        Self.Cursor := crSizeNWSE
      else if Cont(Right + 2, Top - 2, x, y) or Cont(Left - 2, Bottom + 2, x, y) then
        Self.Cursor := crSizeNESW
      else if Cont(Left + Width div 2, Top - 2, x, y) or
        Cont(Left + Width div 2, Bottom + 2, x, y) then
        Self.Cursor := crSizeNS
      else if Cont(Left - 2, Top + Height div 2, x, y) or
        Cont(Right + 2, Top + Height div 2, x, y) then
        Self.Cursor := crSizeWE
      else
        Self.Cursor := crArrow;
    end
    else
      Cursor := crArrow;
  end;
  if Down and (Cursor = crArrow) and (SelList.Count > 0) then // moving
  begin
    kx := X - LastX;
    ky := Y - LastY;
    if frParamsDialogForm.GrAlignB.Down and not GridCheck then Exit;
    for i := 0 to SelList.Count-1 do
    with TControl(SelList[i]) do
    begin
      Left := Left + kx;
      Top := Top + ky;
    end;
    Inc(LastX, kx);
    Inc(LastY, ky);
    frDesigner.Modified := True;
    Exit;
  end;
  if Down and (SelList.Count = 0) then // focus rectangle
  begin
    Canvas.DrawFocusRect(OldRect);
    OldRect := Rect(OldRect.Left, OldRect.Top, x, y);
    Canvas.DrawFocusRect(OldRect);
    Exit;
  end;
  if Down and (Cursor <> crArrow) then // sizing
  with TControl(SelList[0]) do
  begin
    kx := x - LastX;
    ky := y - LastY;
    if frParamsDialogForm.GrAlignB.Down and not GridCheck then Exit;
    w := 3;