frxctrls.pas

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

{***************************************************}
{ }
{ FastReport v3.0 }
{ Tool controls }
{ }
{ Copyright (c) 1998-2005 }
{ by Alexander Tzyganenko, }
{ Fast Reports Inc. }
{ }
{ }
{ Flat ComboBox, FontComboBox v1.0 }
{ For Delphi 2,3,4,5. Freeware. }
{ }
{ Copyright (c) 1999 by:}
{ Dmitry Statilko ([e-mail]) }
{-Main idea and realisation of Flat ComboBox }
{ inherited from TCustomComboBox }
{ }
{ Vladislav Necheporenko ([e-mail]) }
{-Help in bug fixes }
{-Adaptation to work on Delphi 2 }
{-MRU list in FontComboBox that stored values }
{ in regitry }
{-Font preview box in FontComboBox }
{ }
{***************************************************}

unit frxCtrls;

interface

{$I frx.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, CommCtrl, ExtCtrls, Buttons, Registry, ActiveX
{$IFDEF Delphi6}
, Variants
{$ENDIF};
  

type
  TfrxCustomComboBox = class(TCustomComboBox)
  private
    FUpDropdown:Boolean;
    FButtonWidth:Integer;
    msMouseInControl:Boolean;
    FListHandle:HWND;
    FListInstance:Pointer;
    FDefListProc:Pointer;
    FChildHandle:HWND;
    FSolidBorder:Boolean;
    FReadOnly:Boolean;
    FEditOffset:Integer;
    FListWidth:Integer;
    procedure ListWndProc(var Message:TMessage);
    procedure WMPaint(var Message:TWMPaint); message WM_PAINT;
    procedure CNCommand(var Message:TWMCommand); message CN_COMMAND;
    procedure CMEnabledChanged(var Msg:TMessage); message CM_ENABLEDCHANGED;
    procedure CMMouseEnter(var Message:TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message:TMessage); message CM_MOUSELEAVE;
    procedure CMFontChanged(var Message:TMessage); message CM_FONTCHANGED;
    procedure PaintButtonGlyph(DC:HDC; x:Integer; y:Integer);
    procedure PaintButton(bnStyle:Integer);
    procedure PaintBorder(DC:HDC; const SolidBorder:Boolean);
    procedure PaintDisabled;
    function GetSolidBorder:Boolean;
    function GetListHeight:Integer;
    procedure SetReadOnly(Value:Boolean);
  protected
    procedure CreateParams(var Params:TCreateParams); override;
    procedure ComboWndProc(var Message:TMessage; ComboWnd:HWnd; ComboProc:Pointer); override;
    procedure WndProc(var Message:TMessage); override;
    procedure CreateWnd; override;
    procedure DrawImage(DC:HDC; Index:Integer; R:TRect); dynamic;
    property ListWidth:Integer read FListWidth write FListWidth;
    property ReadOnly:Boolean read FReadOnly write SetReadOnly default False;
    property SolidBorder:Boolean read FSolidBorder;
  public
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
  end;

  TfrxComboBox = class(TfrxCustomComboBox)
  published
    property Color;
    property DragMode;
    property DragCursor;
    property DropDownCount;
    property Enabled;
    property Font;
    property ItemHeight;
    property Items;
    property ListWidth;
    property MaxLength;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Sorted;
    property TabOrder;
    property TabStop;
    property Text;
    property ReadOnly;
    property Visible;
    property ItemIndex;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawItem;
    property OnDropDown;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnStartDrag;
{$IFDEF Delphi4}
    property Anchors;
    property BiDiMode;
    property Constraints;
    property DragKind;
    property ParentBiDiMode;
    property OnEndDock;
    property OnStartDock;
{$ENDIF}
  end;

  TfrxFontPreview = class(TWinControl)
  private
    FPanel:TPanel;
  protected
    procedure CreateParams(var Params:TCreateParams); override;
  public
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
  end;

  TfrxFontComboBox = class(TfrxCustomComboBox)
  private
    frFontViewForm:TfrxFontPreview;
    FRegKey:String;
    FTrueTypeBMP:TBitmap;
    FOnClick:TNotifyEvent;
    FUpdate:Boolean;
    FShowMRU:Boolean;
    Numused:Integer;
    procedure CNCommand(var Message:TWMCommand); message CN_COMMAND;
    procedure CMFontChanged(var Message:TMessage); message CM_FONTCHANGED;
    procedure CMFontChange(var Message:TMessage); message CM_FONTCHANGE;
    procedure SetRegKey(Value:String);
  protected
    procedure Loaded; override;
    procedure Init;
    procedure Reset;
    procedure PopulateList; virtual;
    procedure Click; override;
    procedure DrawItem(Index:Integer; Rect:TRect; State:TOwnerDrawState); override;
    procedure DrawImage(DC:HDC; Index:Integer; R:TRect); override;
  public
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
  published
    property ShowMRU:Boolean read FShowMRU write FShowMRU default True;
    property MRURegKey:String read FRegKey write SetRegKey;
    property Text;
    property Color;
    property DragMode;
    property DragCursor;
    property DropDownCount;
    property Enabled;
    property Font;
{$IFDEF Delphi4}
    property Anchors;
    property BiDiMode;
    property Constraints;
    property DragKind;
    property ParentBiDiMode;
{$ENDIF}
    property ItemHeight;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnChange;
    property OnClick:TNotifyEvent read FOnClick write FOnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDropDown;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnStartDrag;
{$IFDEF Delphi4}
    property OnEndDock;
    property OnStartDock;
{$ENDIF}
  end;

  TfrxComboEdit = class(TComboBox)
  private
    FPanel:TWinControl;
    FButton:TSpeedButton;
    FButtonEnabled:Boolean;
    FOnButtonClick:TNotifyEvent;
    function GetGlyph:TBitmap;
    procedure SetGlyph(Value:TBitmap);
    function GetButtonHint:String;
    procedure SetButtonHint(Value:String);
    procedure SetButtonEnabled(Value:Boolean);
    procedure ButtonClick(Sender:TObject);
    procedure WMSize(var Message:TWMSize); message WM_SIZE;
    procedure CMEnabledChanged(var Message:TMessage); message CM_ENABLEDCHANGED;
    procedure SetPos;
  public
    constructor Create(AOwner:TComponent); override;
    procedure CreateWnd; override;
    procedure KeyPress(var Key:Char); override;
  published
    property Glyph:TBitmap read GetGlyph write SetGlyph;
    property ButtonEnabled:Boolean read FButtonEnabled write SetButtonEnabled default True;
    property ButtonHint:String read GetButtonHint write SetButtonHint;
    property OnButtonClick:TNotifyEvent read FOnButtonClick write FOnButtonClick;
  end;

  TfrxScrollWin = class(TCustomControl)
  private
    FHorzPage:Integer;
    FHorzPosition:Integer;
    FHorzRange:Integer;
    FLargeChange:Integer;
    FSmallChange:Integer;
    FVertPage:Integer;
    FVertPosition:Integer;
    FVertRange:Integer;
    function GetLongPosition(DefValue:Integer; Code:Word):Integer;
    procedure SetHorzPosition(Value:Integer);
    procedure SetHorzRange(Value:Integer);
    procedure SetPosition(Value:Integer; Code:Word);
    procedure SetVertPosition(Value:Integer);
    procedure SetVertRange(Value:Integer);
    procedure UpdateScrollBar(Max, Page, Pos:Integer; Code:Word);
    procedure WMEraseBackground(var Message:TMessage); message WM_ERASEBKGND;
    procedure WMGetDlgCode(var Message:TWMGetDlgCode); message WM_GETDLGCODE;
    procedure WMHScroll(var Message:TWMHScroll); message WM_HSCROLL;
    procedure WMVScroll(var Message:TWMVScroll); message WM_VSCROLL;
    procedure SetHorzPage(const Value:Integer);
    procedure SetVertPage(const Value:Integer);
  protected
    procedure CreateParams(var Params:TCreateParams); override;
    procedure OnHScrollChange(Sender:TObject); virtual;
    procedure OnVScrollChange(Sender:TObject); virtual;
  public
    constructor Create(AOwner:TComponent); override;
    procedure Paint; override;
    property HorzPage:Integer read FHorzPage write SetHorzPage;
    property HorzPosition:Integer read FHorzPosition write SetHorzPosition;
    property HorzRange:Integer read FHorzRange write SetHorzRange;
    property LargeChange:Integer read FLargeChange write FLargeChange;
    property SmallChange:Integer read FSmallChange write FSmallChange;
    property VertPage:Integer read FVertPage write SetVertPage;
    property VertPosition:Integer read FVertPosition write SetVertPosition;
    property VertRange:Integer read FVertRange write SetVertRange;
  end;

implementation

{$R *.RES}
{$IFDEF Delphi6}
{$WARN SYMBOL_DEPRECATED OFF}
{$ENDIF}

uses Printers;

const
  fr01cm = 3.77953;
  fr01in = 96 / 10;

type
  THackScrollBar = class(TScrollBar);

{ Additional functions }

function Min(val1, val2:Word):Word;
begin
  Result:= val1;
  if val1 > val2 then
    Result:= val2;
end;

function GetFontMetrics(Font:TFont):TTextMetric;
var
  DC:HDC;
  SaveFont:HFont;
begin
  DC:= GetDC(0);
  SaveFont:= SelectObject(DC, Font.Handle);
  GetTextMetrics(DC, Result);
  SelectObject(DC, SaveFont);
  ReleaseDC(0, DC);
end;

function GetFontHeight(Font:TFont):Integer;
begin
  Result:= GetFontMetrics(Font).tmHeight;
end;

{ TfrxCustomComboBox }

constructor TfrxCustomComboBox.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  FListInstance:= MakeObjectInstance(ListWndProc);
  FDefListProc:= nil;
  FButtonWidth:= 11;
  ItemHeight:= GetFontHeight(Font);
  Width:= 100;
  FEditOffset:= 0;
end;

destructor TfrxCustomComboBox.Destroy;
begin
  inherited Destroy;
  FreeObjectInstance(FListInstance);
end;

procedure TfrxCustomComboBox.SetReadOnly(Value:Boolean);
begin
  if FReadOnly<>Value then
  begin
    FReadOnly:= Value;
    if HandleAllocated then
      SendMessage(EditHandle, EM_SETREADONLY, Ord(Value), 0);
  end;
end;

procedure TfrxCustomComboBox.CreateParams(var Params:TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
    Style:= (Style and not CBS_DROPDOWNLIST) or CBS_OWNERDRAWFIXED or CBS_DROPDOWN;
end;

procedure TfrxCustomComboBox.CreateWnd;
var
  exStyle:Integer;
begin
  inherited;
  SendMessage(EditHandle, EM_SETREADONLY, Ord(FReadOnly), 0);
  // Desiding, which of the handles is DropDown list handle...
  if FChildHandle<>EditHandle then
    FListHandle:= FChildHandle;
  //.. and superclassing it
  FDefListProc:= Pointer(GetWindowLong(FListHandle, GWL_WNDPROC));
  SetWindowLong(FListHandle, GWL_WNDPROC, Longint(FListInstance));
  // here we setting up the border's edge
  exStyle:= GetWindowLong(FListHandle, GWL_EXSTYLE);
  SetWindowLong(FListHandle, GWL_EXSTYLE, exStyle or WS_EX_CLIENTEDGE);
  exStyle:= GetWindowLong(FListHandle, GWL_STYLE);
  SetWindowLong(FListHandle, GWL_STYLE, exStyle and not WS_BORDER );
end;

procedure TfrxCustomComboBox.ListWndProc(var Message:TMessage);
var
  p:TPoint;

  procedure CallDefaultProc;
  begin
    with Message do
      Result:= CallWindowProc(FDefListProc, FListHandle, Msg, WParam, LParam);
  end;

  procedure PaintListFrame;
  var
    DC:HDC;
    R:TRect;
  begin
    GetWindowRect(FListHandle, R);
    OffsetRect (R,-R.Left,-R.Top);
    DC:= GetWindowDC(FListHandle);
    DrawEdge(DC, R, EDGE_RAISED, BF_RECT);
    ReleaseDC(FListHandle, DC);
  end;

begin
  case Message.Msg of
    WM_NCPAINT:
      begin
        CallDefaultProc;
        PaintListFrame;
      end;
    LB_SETTOPINDEX:
      begin
        if ItemIndex > DropDownCount then
          CallDefaultProc;
      end;
    WM_WINDOWPOSCHANGING:
      with TWMWindowPosMsg(Message).WindowPos^ do
      begin
        // calculating the size of the drop down list
        if FListWidth<>0 then
          cx:= FListWidth else
          cx:= Width-1;
        cy:= GetListHeight;
        p.x:= cx;
        p.y:= cy+GetFontHeight(Font)+6;
        p:= ClientToScreen(p);
        FUpDropdown:= False;
        if p.y > Screen.Height then //if DropDownList showing below
          begin
            y:= y-2;
            FUpDropdown:= True;
          end;
      end;
    else
      CallDefaultProc;
  end;
end;

procedure TfrxCustomComboBox.WndProc(var Message:TMessage);
begin
  case Message.Msg of
    WM_SETTEXT:
      Invalidate;
     WM_PARENTNOTIFY:
       if LoWord(Message.wParam)=WM_CREATE then begin
         if FDefListProc<>nil then