toolctrlseh.pas

最新的 DBGRIDEH4.0

  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: TWMMove); 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: TWMNCPaint); 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;
    function MsgSetDateTime(Value: TSystemTime): 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;

  TListGetImageIndexEventEh = procedure(Sender: TObject; ItemIndex: Integer; var ImageIndex: Integer) of object;

{ TPopupListboxEh }

  TPopupListboxEh = class(TCustomListbox)
  private
    FBorderWidth: Integer;
    FImageList: TCustomImageList;
    FMousePos: TPoint;
    FRowCount: Integer;
    FSearchText: String;
    FSearchTickCount: Longint;
    FSizeGrip: TSizeGripEh;
    FSizeGripResized: Boolean;
    FOnGetImageIndex: TListGetImageIndexEventEh;
    FExtItems: TStrings;
    function CheckNewSize(var NewWidth, NewHeight: Integer): Boolean;
    function GetBorderSize: Integer;
    function GetExtItems: TStrings;
    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 SetExtItems(Value: TStrings);
    procedure SetImageList(const Value: TCustomImageList);
    procedure SetRowCount(Value: Integer);
    procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure WMNCPaint(var Message: TWMNCPaint); 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; ARect: TRect; State: TOwnerDrawState); override;
    procedure KeyPress(var Key: Char); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure UpdateBorderWidth;
    procedure SelfOnGetData(Control: TWinControl; Index: Integer; var Data: string); virtual;
  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 ExtItems: TStrings read GetExtItems write SetExtItems;
    property SizeGrip: TSizeGripEh read FSizeGrip;
    property SizeGripResized: Boolean read FSizeGripResized write FSizeGripResized;
    property OnMouseUp;
    property OnGetImageIndex: TListGetImageIndexEventEh read FOnGetImageIndex write FOnGetImageIndex;
  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;
    FAutoAdd: Boolean;
    FCaseSensitive: Boolean;
    FItems: TStrings;
    FLimit: Integer;
    FOnActiveChanged: TNotifyEvent;
    FOnFilterItem: TFilterMRUItemEventEh;
    FOnSetCloseUpEvent: TSetCloseUpEventEh;
    FOnSetDropDown: TSetDropDownEventEh;
    FOwner: TPersistent;
    FRows: Integer;
    FWidth: Integer;
    FCancelIfKeyInQueue: Boolean;
    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;
    function FilterItemsTo(FilteredItems: TStrings; MaskText: String): Boolean;
    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;
    property CancelIfKeyInQueue: Boolean read FCancelIfKeyInQueue write FCancelIfKeyInQueue default True;
  published
    property AutoAdd: Boolean read FAutoAdd write FAutoAdd default True;
    property Active: Boolean read FActive write SetActive default False;
    property CaseSensitive: Boolean read FCaseSensitive write FCaseSensitive default False;
    property Items: TStrings read FItems write SetItems;
    property Limit: Integer read FLimit write SetLimit default 100;
    property Rows: Integer read FRows write SetRows default 7;
  end;

{ TMRUListboxEh }

  TMRUListboxEh = class(TPopupListboxEh)
  private
    FScrollBar: TScrollBar;
    FScrollBarLockMove: Boolean;
    procedure CMChanged(var Message: TCMChanged); message CM_CHANGED;
    procedure CMMouseWheel(var Message: TCMMouseWheel); message CM_MOUSEWHEEL;
    procedure CMSetSizeGripChangePosition(var Message: TMessage); message cm_SetSizeGripChangePosition;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure ScrollBarScrolled(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
    procedure ScrollBarWindowProc(var Message: TMessage);
  public
    constructor Create(Owner: TComponent); override;
    procedure UpdateScrollBar;
    procedure UpdateScrollBarPos;
    property ParentCtl3D;
    property ScrollBar: TScrollBar read FScrollBar;
    property Sorted;
    property OnMouseUp;
  end;

{$IFNDEF EH_LIB_5} // Delphi 4 doesn't have TObjectList but Delphi 8 required

{ TObjectList class }

  TObjectList = class(TList)
  private
    FOwnsObjects: Boolean;
  protected
    function GetItem(Index: Integer): TObject;
    procedure SetItem(Index: Integer; AObject: TObject);
  public
    constructor Create; overload;
    constructor Create(AOwnsObjects: Boolean); overload;

    function Add(AObject: TObject): Integer;
    function Remove(AObject: TObject): Integer;
    function IndexOf(AObject: TObject): Integer;
    function FindInstanceOf(AClass: TClass; AExact: Boolean = True; AStartAt: Integer = 0): Integer;
    procedure Insert(Index: Integer; AObject: TObject);
    property OwnsObjects: Boolean read FOwnsObjects write FOwnsObjects;
    property Items[Index: Integer]: TObject read GetItem write SetItem; default;
  end;

{$ENDIF}

{$IFNDEF EH_LIB_5}
  TStringListSortCompare = function(List: TStringList; Index1, Index2: Integer): Integer;
{$ENDIF}

   TStringListEh = class(TStringList)
{$IFNDEF EH_LIB_6}
  private
    FCaseSensitive: Boolean;
    function CompareStrings(const S1, S2: string): Integer;
    procedure SetCaseSensitive(const Value: Boolean);
  public
{$IFNDEF EH_LIB_5}
    procedure CustomSort(Compare: TStringListSortCompare);
    procedure QuickSort(L, R: Integer; SCompare: TStringListSortCompare);
{$ENDIF}
    procedure Sort; override;
    property CaseSensitive: Boolean read FCaseSensitive write SetCaseSensitive;
{$ENDIF}
   end;
{ TDataLinkEh }

{$IFDEF CIL}
  TDataEventEh = procedure (Event: TDataEvent; Info: TObject) of object;
{$ELSE}
  TDataEventEh = procedure (Event: TDataEvent; Info: Longint) of object;
{$ENDIF}

  TDataLinkEh = class(TDataLink)
  private
    FOnDataEvent: TDataEventEh;
  protected
{$IFDEF CIL}
    procedure DataEvent(Event: TDataEvent; Info: TObject); virtual;
{$ELSE}
    procedure DataEvent(Event: TDataEvent; Info: Integer); override;
{$ENDIF}
  public
    property OnDataEvent: TDataEventEh read FOnDataEvent write FOnDataEvent;
  end;

{ TDatasetFieldValueListEh }

  TDatasetFieldValueListEh = class(TInterfacedObject, IMemTableDataFieldValueListEh)
  private
    FValues: TStringList;
    FDataObsoleted: Boolean;
    FFieldName: String;
    FDataLink: TDataLinkEh;
    FDataSource: TDataSource;
    function GetValues: TStrings;
    procedure SetFieldName(const Value: String);
    procedure SetDataSet(const Value: TDataSet);
    function GetDataSet: TDataSet;
  protected
    procedure RefreshValues;
{$IFDEF CIL}
    procedure DataSetEvent(Event: TDataEvent; Info: TObject); virtual;
{$ELSE}
    procedure DataSetEvent(Event: TDataEvent; Info: Integer); virtual;
{$ENDIF}
  public
    constructor Create;
    destructor Destroy; override;
    property FieldName: String read FFieldName write SetFieldName;
    property DataSet: TDataSet read GetDataSet write SetDataSet;
    property Values: TStrings read GetValues;
  end;

  TLocateTextEventEh = function (Sender: TObject;
    const FieldName: string; const Text: String; Options: TLocateTextOptionsEh;
    Direction: TLocateTextDirectionEh; Matching: TLocateTextMatchingEh;
    TreeFindRange: TLocateTextTreeFindRangeEh): Boolean of object;

  TDrawButtonControlStyleEh = (bcsDropDownEh, bcsEllipsisEh, bcsUpDownEh,
    bcsCheckboxEh, bcsPlusEh, bcsMinusEh);
  TTreeElementEh = (tehMinusUpDown, tehMinusUp, tehMinusDown,
                   tehPlusUpDown, tehPlusUp, tehPlusDown,
                   tehCrossUpDown, tehCrossUp, tehCrossDown,
                   tehVLine);


procedure PaintButtonControlEh(DC: HDC; ARect: TRect; ParentColor: TColor;
  Style: TDrawButtonControlStyleEh; DownButton: Integer;
  Flat, Active, Enabled: Boolean; State: TCheckBoxState);

function GetDefaultFlatButtonWidth: Integer;

var
  FlatButtonWidth: Integer;

type
 TFieldTypes = set of TFieldType;

const
  ftNumberFieldTypes: TFieldTypes = [ftSmallint, ftInteger, ftWord, ftFloat, ftCurrency,
    ftBCD{$IFDEF EH_LIB_6}, ftFMTBcd{$ENDIF}];

procedure GetFieldsProperty(List: TList; DataSet: TDataSet;
  Control: TComponent; const FieldNames: String); overload;

function GetFieldsProperty(DataSet: TDataSet; Control: TComponent;
  const FieldNames: String): TFieldsArrEh; overload;

procedure DataSetSetFieldValues(DataSet: TDataSet; Fields: String; Value: Variant);

function VarEquals(const V1, V2: Variant): Boolean;

{$IFNDEF EH_LIB_6}
type
  TVariantRelationship = (vrEqual, vrLessThan, vrGreaterThan, vrNotEqual);
{$ENDIF}

function DBVarCompareValue(const A, B: Variant): TVariantRelationship;

var UseButtonsBitmapCache: Boolean = True;

procedure ClearButtonsBitmapCache;

procedure DrawImage(DC: HDC; ARect: TRect; Images: TCustomImageList;
  ImageIndex: Integer; Selected: Boolean);
procedure DrawTreeElement(Canvas: TCanvas; ARect: TRect;
  TreeElement: TTreeElementEh; BackDot: Boolean; ScaleX, ScaleY: Double;
  RightToLeft: Boolean);

function AlignDropDownWindowRect(MasterAbsRect: TRect; DropDownWin: TWinControl; Align: TDropDownAlign): TPoint;
function AlignDropDownWindow(MasterWin, DropDownWin: TWinControl; Align: TDropDownAlign): TPoint;

{$IFNDEF EH_LIB_5}
function Supports(const Instance: IUnknown; const IID: TGUID; out Intf): Boolean; overload;
function Supports(const Instance: TObject; const IID: TGUID; out Intf): Boolean; overload;
{$ENDIF}

var
  DefaultCheckBoxWidth, DefaultCheckBoxHeight: Integer;

function AdjustCheckBoxRect(ClientRect: TRect;  Alignment: TAlignment; Layout: TTextLayout): TRect;

function IsDoubleClickMessage(OldPos, NewPos: TPoint; Interval: Longint): Boolean;
function DefaultEditButtonHeight(EditButtonWidth: Integer; Flat: Boolean): Integer;