toolctrlseh.pas

自己做的用delphi开发的学生成绩管理系统。

{*******************************************************}
{                                                       }
{                       EhLib v3.0                      }
{                     Tool controls                     }
{                                                       }
{      Copyright (c) 2001-2003 by Dmitry V. Bolshakov   }
{                                                       }
{*******************************************************}

{$I EhLib.Inc}

{$IFDEF EH_LIB_VCL}
unit ToolCtrlsEh;
{$ELSE}
unit QToolCtrlsEh;
{$ENDIF}

interface

{$IFDEF EH_LIB_VCL}
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
{$IFDEF EH_LIB_6} Variants, {$ENDIF}
  StdCtrls, Mask, Db, DBCtrls, Buttons, ExtCtrls, Menus, ComCtrls, CommCtrl,
  Imglist;
{$ELSE}
uses
  QGraphics, QControls, QForms, QDialogs, Variants, QStdCtrls, QMask,
  QDBCtrls, QButtons, QExtCtrls, QMenus, QComCtrls, QImglist,
  Db, SysUtils, Classes;
{$ENDIF}

const
  CM_IGNOREEDITDOWN = WM_USER + 102;

type

  IComboEditEh = interface
    ['{B64255B5-386A-4524-8BC7-7F49DDB410F4}']
    procedure CloseUp(Accept: Boolean);
  end;

  TFieldsArrEh = array of TField;

{ Standard events }

  TButtonClickEventEh = procedure(Sender: TObject; var Handled: Boolean) of object;
  TButtonDownEventEh = procedure(Sender: TObject; TopButton: Boolean;
    var AutoRepeat: Boolean; var Handled: Boolean) of object;
  TCloseUpEventEh = procedure(Sender: TObject; Accept: Boolean) of object;
  TNotInListEventEh = procedure(Sender: TObject; NewText: String;
    var RecheckInList: Boolean) of object;
  TUpdateDataEventEh = procedure(Sender: TObject; var Handled: Boolean) of object;

{ TEditButtonControlEh }

  TEditButtonStyleEh = (ebsDropDownEh, ebsEllipsisEh, ebsGlyphEh, ebsUpDownEh,
    ebsPlusEh, ebsMinusEh);

  TEditButtonControlEh = class(TSpeedButton)
  private
    FActive: Boolean;
    FAlwaysDown: Boolean;
    FButtonNum: Integer;
    FNoDoClick: Boolean;
    FOnDown: TButtonDownEventEh;
    FStyle: TEditButtonStyleEh;
    FTimer: TTimer;
    function GetTimer: TTimer;
    procedure ResetTimer(Interval: Cardinal);
    procedure SetActive(const Value: Boolean);
    procedure SetAlwaysDown(const Value: Boolean);
    procedure SetStyle(const Value: TEditButtonStyleEh);
    procedure TimerEvent(Sender: TObject);
    procedure UpdateDownButtonNum(X, Y: Integer);
  protected
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure Paint; override;
    property Timer: TTimer read GetTimer;
  public
    procedure Click; override;
    procedure EditButtonDown(TopButton: Boolean; var AutoRepeat: Boolean);
    procedure SetState(NewState: TButtonState; IsActive: Boolean; ButtonNum: Integer);
    procedure SetWidthNoNotify(AWidth: Integer);
    property Active: Boolean read FActive write SetActive;
    property AlwaysDown: Boolean read FAlwaysDown write SetAlwaysDown;
    property Style: TEditButtonStyleEh read FStyle write SetStyle default ebsDropDownEh;
    property OnDown: TButtonDownEventEh read FOnDown write FOnDown;
  end;

  TSpeedButtonEh = class(TEditButtonControlEh)
  published
    property Active;
    property Style;
  end;

  TEditButtonControlLineRec = record
    ButtonLine: TShape;
    EditButtonControl: TEditButtonControlEh;
  end;

  TEditButtonControlList = array of TEditButtonControlLineRec;

{ TEditButtonEh }

  TEditButtonEh = class(TCollectionItem)
  private
    FDropdownMenu: TPopupMenu;
    FEditControl: TWinControl;
    FGlyph: TBitmap;
    FHint: String;
    FNumGlyphs: Integer;
    FOnButtonClick: TButtonClickEventEh;
    FOnButtonDown: TButtonDownEventEh;
    FOnChanged: TNotifyEvent;
    FShortCut: TShortCut;
    FStyle: TEditButtonStyleEh;
    FVisible: Boolean;
    FWidth: Integer;
    function GetGlyph: TBitmap;
    procedure SetGlyph(const Value: TBitmap);
    procedure SetHint(const Value: String);
    procedure SetNumGlyphs(Value: Integer);
    procedure SetStyle(const Value: TEditButtonStyleEh);
    procedure SetVisible(const Value: Boolean);
    procedure SetWidth(const Value: Integer);
  protected
    function CreateEditButtonControl: TEditButtonControlEh; virtual;
    procedure Changed; overload;
  public
    constructor Create(Collection: TCollection); overload; override;
    constructor Create(EditControl: TWinControl); reintroduce; overload;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
  published
    property DropdownMenu: TPopupMenu read FDropdownMenu write FDropdownMenu;
    property Glyph: TBitmap read GetGlyph write SetGlyph;
    property Hint: String read FHint write SetHint;
    property NumGlyphs: Integer read FNumGlyphs write SetNumGlyphs default 1;
    //property ShortCut: TShortCut read FShortCut write FShortCut default 32808; //Menus.ShortCut(VK_DOWN, [ssAlt]);
    property ShortCut: TShortCut read FShortCut write FShortCut default scNone;
    property Style: TEditButtonStyleEh read FStyle write SetStyle default ebsDropDownEh;
    property Visible: Boolean read FVisible write SetVisible default False;
    property Width: Integer read FWidth write SetWidth default 0;
    property OnClick: TButtonClickEventEh read FOnButtonClick write FOnButtonClick;
    property OnDown: TButtonDownEventEh read FOnButtonDown write FOnButtonDown;
  end;

  TEditButtonEhClass = class of TEditButtonEh;

{ TDropDownEditButtonEh }

  TDropDownEditButtonEh = class(TEditButtonEh)
  public
    constructor Create(Collection: TCollection); overload; override;
    constructor Create(EditControl: TWinControl); overload;
  published
    property ShortCut default 32808; //Menus.ShortCut(VK_DOWN, [ssAlt]);
  end;


{ TVisibleEditButtonEh }

  TVisibleEditButtonEh = class(TEditButtonEh)
  public
    constructor Create(Collection: TCollection); overload; override;
    constructor Create(EditControl: TWinControl); overload;
  published
    property ShortCut default 32808; //Menus.ShortCut(VK_DOWN, [ssAlt]);
    property Visible default True;
  end;

{ TEditButtonsEh }

  TEditButtonsEh = class(TCollection)
  private
    FOnChanged: TNotifyEvent;
    function GetEditButton(Index: Integer): TEditButtonEh;
    procedure SetEditButton(Index: Integer; Value: TEditButtonEh);
  protected
    FOwner: TPersistent;
    function GetOwner: TPersistent; override;
    procedure Update(Item: TCollectionItem); override;
  public
    constructor Create(Owner: TPersistent; EditButtonClass: TEditButtonEhClass);
    function Add: TEditButtonEh;
    property Items[Index: Integer]: TEditButtonEh read GetEditButton write SetEditButton; default;
    property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
  end;

{ TSpecRowEh }

  TSpecRowEh = class(TPersistent)
  private
    FCellsStrings: TStrings;
    FCellsText: String;
    FColor: TColor;
    FFont: TFont;
    FOnChanged: TNotifyEvent;
    FOwner: TPersistent;
    FSelected: Boolean;
    FShortCut: TShortCut;
    FShowIfNotInKeyList: Boolean;
    FUpdateCount: Integer;
    FValue: Variant;
    FVisible: Boolean;
    function GetCellText(Index: Integer): String;
    function GetColor: TColor;
    function GetFont: TFont;
    function IsColorStored: Boolean;
    function IsFontStored: Boolean;
    function IsValueStored: Boolean;
    procedure FontChanged(Sender: TObject);
    procedure SetCellsText(const Value: String);
    procedure SetColor(const Value: TColor);
    procedure SetFont(const Value: TFont);
    procedure SetShowIfNotInKeyList(const Value: Boolean);
    procedure SetValue(const Value: Variant);
    procedure SetVisible(const Value: Boolean);
  protected
    FColorAssigned: Boolean;
    FFontAssigned: Boolean;
    function GetOwner: TPersistent; override;
    procedure Changed;
  public
    constructor Create(Owner: TPersistent);
    destructor Destroy; override;
    function DefaultColor: TColor;
    function DefaultFont: TFont;
    function LocateKey(KeyValue: Variant): Boolean;
    procedure Assign(Source: TPersistent); override;
    procedure BeginUpdate;
    procedure EndUpdate;
    property CellText[Index: Integer]: String read GetCellText;
    property Selected: Boolean read FSelected write FSelected;
    property UpdateCount: Integer read FUpdateCount;
    property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
  published
    property CellsText: String read FCellsText write SetCellsText;
    property Color: TColor read GetColor write SetColor stored IsColorStored;
    property Font: TFont read GetFont write SetFont stored IsFontStored;
    property ShortCut: TShortCut read FShortCut write FShortCut default 32814; //Menus.ShortCut(VK_DOWN, [ssAlt]);
    property ShowIfNotInKeyList: Boolean read FShowIfNotInKeyList write SetShowIfNotInKeyList default True;
    property Value: Variant read FValue write SetValue stored IsValueStored;
    property Visible: Boolean read FVisible write SetVisible default False;
  end;

{ TSizeGripEh }

  TSizeGripPostion = (sgpTopLeft, sgpTopRight, sgpBottomRight, sgpBottomLeft);
  TSizeGripChangePosition = (sgcpToLeft, sgcpToRight, sgcpToTop, sgcpToBottom);

  TSizeGripEh = class(TCustomControl)
  private
    FInitScreenMousePos: TPoint;
    FInternalMove: Boolean;
    FOldMouseMovePos: TPoint;
    FParentRect: TRect;
    FParentResized: TNotifyEvent;
    FPosition: TSizeGripPostion;
    FTriangleWindow: Boolean;
    function GetVisible: Boolean;
    procedure SetPosition(const Value: TSizeGripPostion);
    procedure SetTriangleWindow(const Value: Boolean);
    procedure SetVisible(const Value: Boolean);
    procedure WMMove(var Message: TMessage); message WM_MOVE;
  protected
    procedure CreateWnd; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure Paint; override;
    procedure ParentResized; dynamic;
  public
    constructor Create(AOwner: TComponent); override;
    procedure ChangePosition(NewPosition: TSizeGripChangePosition);
    procedure UpdatePosition;
    procedure UpdateWindowRegion;
    property Position: TSizeGripPostion read FPosition write SetPosition default sgpBottomRight;
    property TriangleWindow: Boolean read FTriangleWindow write SetTriangleWindow default True;
    property Visible: Boolean read GetVisible write SetVisible;
    property OnParentResized: TNotifyEvent read FParentResized write FParentResized;
  end;

const
  cm_SetSizeGripChangePosition = WM_USER + 100;

{ TPopupMonthCalendarEh }

const
  CM_CLOSEUPEH = WM_USER + 101;

type

  TPopupMonthCalendarEh = class(TMonthCalendar)
  private
    FBorderWidth: Integer;
    procedure CMCloseUpEh(var Message: TMessage); message CM_CLOSEUPEH;
    procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
    procedure CMWantSpecialKey(var Message: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
    procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
    procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
  protected
    function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override;
    function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
    function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure DrawBorder; virtual;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure PostCloseUp(Accept: Boolean);
    procedure UpdateBorderWidth;
  public
    constructor Create(AOwner: TComponent); override;
    property Color;
    property Ctl3D;
  end;

{ TPopupListboxEh }

  TPopupListboxEh = class(TCustomListbox)
  private
    FBorderWidth: Integer;
    FImageList: TCustomImageList;
    FMousePos: TPoint;
    FRowCount: Integer;
    FSearchText: String;
    FSearchTickCount: Longint;
    FSizeGrip: TSizeGripEh;
    FSizeGripResized: Boolean;
    function CheckNewSize(var NewWidth, NewHeight: Integer): Boolean;
    function GetBorderSize: Integer;
    procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
    procedure CMSetSizeGripChangePosition(var Message: TMessage); message cm_SetSizeGripChangePosition;
    procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
    procedure SetImageList(const Value: TCustomImageList);
    procedure SetRowCount(Value: Integer);
    procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure WMWindowPosChanging(var Message: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING;
  protected
    function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
    function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure DrawBorder; virtual;
    procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
    procedure KeyPress(var Key: Char); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure UpdateBorderWidth;
  public
    constructor Create(Owner: TComponent); override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    function CanFocus: Boolean; {$IFDEF EH_LIB_5} override; {$ENDIF}
    function GetTextHeight: Integer;
    property Color;
    property Ctl3D;
    property Font;
    property ImageList: TCustomImageList read FImageList write SetImageList;
    property IntegralHeight;
    property ItemHeight;
    property RowCount: Integer read FRowCount write SetRowCount;
    property SizeGrip: TSizeGripEh read FSizeGrip;
    property SizeGripResized: Boolean read FSizeGripResized write FSizeGripResized;
  end;

{ TMRUList }
  TFilterMRUItemEventEh = procedure (Sender: TObject; var Accept: Boolean) of object;
  TSetDropDownEventEh = procedure (Sender: TObject) of object;
  TSetCloseUpEventEh = procedure (Sender: TObject; Accept: Boolean) of object;

  TMRUListEh = class(TPersistent)
  private
    FActive: Boolean;
    FCaseSensitive: Boolean;
    FItems: TStrings;
    FLimit: Integer;
    FOnActiveChanged: TNotifyEvent;
    FOnFilterItem: TFilterMRUItemEventEh;
    FOnSetCloseUpEvent: TSetCloseUpEventEh;
    FOnSetDropDown: TSetDropDownEventEh;
    FOwner: TPersistent;
    FRows: Integer;
    FWidth: Integer;
    procedure SetActive(const Value: Boolean);
    procedure SetItems(const Value: TStrings);
    procedure SetLimit(const Value: Integer);
    procedure SetRows(const Value: Integer);
  protected
    FDroppedDown: Boolean;
    procedure UpdateLimit;
  public
    constructor Create(AOwner: TPersistent);
    destructor Destroy; override;
    procedure Add(s: String);
    procedure Assign(Source: TPersistent); override;
    procedure CloseUp(Accept: Boolean); virtual;
    procedure DropDown; virtual;
    property DroppedDown: Boolean read FDroppedDown write FDroppedDown;
    property Width: Integer read FWidth write FWidth;
    property OnActiveChanged: TNotifyEvent read FOnActiveChanged write FOnActiveChanged;
    property OnSetCloseUp: TSetCloseUpEventEh read FOnSetCloseUpEvent write FOnSetCloseUpEvent;
    property OnSetDropDown: TSetDropDownEventEh read FOnSetDropDown write FOnSetDropDown;
    property OnFilterItem: TFilterMRUItemEventEh read FOnFilterItem write FOnFilterItem;
  published