toolctrlseh.pas

1、开发环境 d6 up2,sqlserver2000, win2000 server 1024*768（笔记本电脑） c/s 2、数据库配置方法

    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
  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;
    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;

{ TPopupDataListEh }
const
    cm_SetSizeGripChangePosition = WM_USER + 100;

type
  TPopupDataListEh = class(TDBLookupListBoxEh)
  private
    FOnUserKeyValueChange: TNotifyEvent;
    FSizeGrip:TSizeGripEh;
    FSizeGripResized:Boolean;
    FUserKeyValueChanged:Boolean;
    function CheckNewSize(var NewWidth, NewHeight: Integer): Boolean;
    procedure CMSetSizeGripChangePosition(var Message:TMessage); message cm_SetSizeGripChangePosition;
    procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
    procedure WMMouseActivate(var Message: TMessage); message WM_MOUSEACTIVATE;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure WMWindowPosChanging(var Message: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyValueChanged; override;
    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;
  public
    constructor Create(AOwner: TComponent); override;
    property SizeGrip: TSizeGripEh read FSizeGrip;
    property SizeGripResized:Boolean read FSizeGripResized write FSizeGripResized;
    property OnUserKeyValueChange: TNotifyEvent read FOnUserKeyValueChange write FOnUserKeyValueChange;
  end;

{ TPopupMonthCalendarEh }

const
 CM_CLOSEUPEH =  WM_USER + 101;

type

  TPopupMonthCalendarEh = class(TMonthCalendar)
  private
    procedure CMCloseUpEh(var Message: TMessage); message CM_CLOSEUPEH;
    procedure CMWantSpecialKey(var Message: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
    procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    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);
  public
    constructor Create(AOwner: TComponent); override;
    property Color;
  end;

  TDrawButtonControlStyleEh = (bcsDropDownEh, bcsEllipsisEh, bcsUpDownEh,
                               bcsCheckboxEh, bcsPlusEh, bcsMinusEh);
  procedure PaintButtonControlEh(DC: HDC;ARect:TRect;ParentColor:TColor;
               Style:TDrawButtonControlStyleEh; DownButton:Integer;
               Flat,Active,Enabled:Boolean; State: TCheckBoxState);

  function GetDefaultFlatButtonWidth:Integer;

var
  FlatButtonWidth: Integer;

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;

var UseButtonsBitmapCache: Boolean = True;

procedure ClearButtonsBitmapCache;

implementation

uses DBConsts {$IFDEF EH_LIB_6} ,VDBConsts, Types {$ENDIF};

type
  TWinControlCracker = class(TWinControl) end;
  TControlCracker = class(TControl) end;

var
  SearchTickCount: Integer = 0;

{$IFNDEF EH_LIB_5}

function Supports(const Instance: IUnknown; const IID: TGUID; out Intf): Boolean; overload;
begin
  Result := (Instance <> nil) and (Instance.QueryInterface(IID, Intf) = 0);
end;

function Supports(const Instance: TObject; const IID: TGUID; out Intf): Boolean; overload;
var
  LUnknown: IUnknown;
begin
  Result := (Instance <> nil) and
            ((Instance.GetInterface(IUnknown, LUnknown) and Supports(LUnknown, IID, Intf)) or
             Instance.GetInterface(IID, Intf));
end;

{$ENDIF}

procedure DrawCheck(DC: HDC; R: TRect; AState: TCheckBoxState; AEnabled, AFlat: Boolean);
var
  DrawState,oldRgn: Integer;
  DrawRect: TRect;
//  OldBrushColor: TColor;
//  OldBrushStyle: TBrushStyle;
//  OldPenColor: TColor;
  Rgn, SaveRgn: HRgn;
//  Brush,SaveBrush: HBRUSH;
begin
  SaveRgn := 0;
  oldRgn := 0;
  DrawRect := R;
  with DrawRect do
    if (Right - Left) > (Bottom - Top) then
    begin
     Left := Left + ((Right - Left) - (Bottom - Top)) div 2;
     Right := Left + (Bottom - Top);
    end else if (Right - Left) < (Bottom - Top) then
    begin
     Top := Top + ((Bottom - Top) - (Right - Left)) div 2;
     Bottom := Top + (Right - Left);
    end;
  case AState of
    cbChecked:
      DrawState := DFCS_BUTTONCHECK or DFCS_CHECKED;
    cbUnchecked:
      DrawState := DFCS_BUTTONCHECK;
    else // cbGrayed
      DrawState := DFCS_BUTTON3STATE or DFCS_CHECKED;
  end;
  if not AEnabled then
    DrawState := DrawState or DFCS_INACTIVE;
//  with Canvas do
//  begin
    if AFlat then
    begin
      { Remember current clipping region }
      SaveRgn := CreateRectRgn(0,0,0,0);
      oldRgn := GetClipRgn(DC, SaveRgn);
      { Clip 3d-style checkbox to prevent flicker }
      with DrawRect do
        Rgn := CreateRectRgn(Left + 2, Top + 2, Right - 2, Bottom - 2);
      SelectClipRgn(DC, Rgn);
      DeleteObject(Rgn);
    end;
    if AFlat then InflateRect(DrawRect,1,1);
    DrawFrameControl(DC, DrawRect, DFC_BUTTON, DrawState);
    if AFlat then
    begin
      //SelectClipRgn(Handle, SaveRgn);
      if oldRgn = 0 then
        SelectClipRgn(DC, 0)
      else
        SelectClipRgn(DC, SaveRgn);
      DeleteObject(SaveRgn);
      { Draw flat rectangle in-place of clipped 3d checkbox above }
      InflateRect(DrawRect,-1,-1);
      FrameRect(DC,DrawRect,GetSysColorBrush(COLOR_BTNSHADOW));

      InflateRect(DrawRect,1,1);
      FrameRect(DC,DrawRect,GetCurrentObject(DC,OBJ_BRUSH));
    end;
//  end;
end;

const
  DownFlags: array [Boolean] of Integer = (0,DFCS_PUSHED);
  FlatFlags: array [Boolean] of Integer = (0,DFCS_FLAT);
  EnabledFlags: array [Boolean] of Integer = (DFCS_INACTIVE,0);
  IsDownFlags: array [Boolean] of Integer = (DFCS_SCROLLUP, DFCS_SCROLLDOWN);
  PressedFlags: array [Boolean] of Integer = (EDGE_RAISED, EDGE_SUNKEN);

procedure DrawEllipsisButton(DC: HDC; ARect: TRect; Enabled, Active, Flat, Pressed: Boolean);
var InterP,PWid,W,H:Integer;
    ElRect:TRect;
    Brush,SaveBrush: HBRUSH;
begin
  ElRect := ARect;
  Brush := GetSysColorBrush(COLOR_BTNFACE);
  if Flat then
  begin
    Windows.FillRect(DC, ElRect, Brush);
    InflateRect(ElRect,-1,-1)
  end else
  begin
    DrawEdge(DC, ElRect, PressedFlags[Pressed], BF_RECT or BF_MIDDLE);
    InflateRect(ElRect,-2,-2);
    //Windows.FillRect(DC, ElRect, Brush);
  end;
  InterP := 2;
  PWid := 2;
  W := ElRect.Right - ElRect.Left ;//+ Ord(not Active and Flat);
  if W < 12 then InterP := 1;
  if W < 8 then PWid := 1;
  W := ElRect.Left + W div 2 - PWid div 2 + Ord(Pressed) ;//- Ord(not Active and Flat);
  H := ElRect.Top + (ElRect.Bottom - ElRect.Top) div 2 - PWid div 2 + Ord(Pressed);

  if not Enabled then
  begin
    Inc(W);Inc(H);
    Brush := GetSysColorBrush(COLOR_BTNHILIGHT);
    SaveBrush := SelectObject(DC, Brush);
    PatBlt(DC, W, H, PWid, PWid, PATCOPY);
    PatBlt(DC, W - InterP - PWid, H, PWid, PWid, PATCOPY);
    PatBlt(DC, W + InterP + PWid, H, PWid, PWid, PATCOPY);
    Dec(W);Dec(H);
    SelectObject(DC, SaveBrush);
    Brush := GetSysColorBrush(COLOR_BTNSHADOW);
  end else
    Brush := GetSysColorBrush(COLOR_BTNTEXT);

  SaveBrush := SelectObject(DC, Brush);
  PatBlt(DC, W, H, PWid, PWid, PATCOPY);
  PatBlt(DC, W - InterP - PWid, H, PWid, PWid, PATCOPY);
  PatBlt(DC, W + InterP + PWid, H, PWid, PWid, PATCOPY);
  SelectObject(DC, SaveBrush);
end;

procedure DrawPlusMinusButton(DC: HDC; ARect: TRect; Enabled, Active, Flat, Pressed, Plus: Boolean);
var PWid,PHet,W,H,PlusInd,MinWH:Integer;
    ElRect:TRect;
    Brush,SaveBrush: HBRUSH;
begin
  ElRect := ARect;
  Brush := GetSysColorBrush(COLOR_BTNFACE);
  if Flat then
  begin
    Windows.FillRect(DC, ElRect, Brush);
    InflateRect(ElRect,-1,-1)
  end else
  begin
    DrawEdge(DC, ElRect, PressedFlags[Pressed], BF_RECT or BF_MIDDLE);
    InflateRect(ElRect,-2,-2);
    Windows.FillRect(DC, ElRect, Brush);
  end;

  MinWH := ElRect.Right - ElRect.Left;//+ Ord(not Active and Flat);
  if  ElRect.Bottom - ElRect.Top < MinWH then
    MinWH := ElRect.Bottom - ElRect.Top;
  PWid := MinWH * 4 div 7;
  if PWid = 0 then PWid := 1;
  PHet := PWid div 3;
  if PHet = 0 then PHet := 1;
  if Flat then Dec(PWid);
  if PWid mod 2 <> MinWH mod 2 then Inc(PWid);
  if Plus and (PWid mod 2 <> PHet mod 2) then
    if (MinWH < 12) then Inc(PWid) else Dec(PWid);
  PlusInd := PWid div 2 - PHet div 2;

  W := ElRect.Left + (ElRect.Right - ElRect.Left - PWid) div 2;//- Ord(not Active and Flat);
  //if W * 2 + PWid > (ElRect.Right - ElRect.Left) then Dec(W);
  Inc(W,Ord(Pressed));
  H := ElRect.Top + (ElRect.Bottom - ElRect.Top - PHet) div 2 + Ord(Pressed);

  if not Enabled then
  begin
    Inc(W);Inc(H);
    Brush := GetSysColorBrush(COLOR_BTNHILIGHT);
    SaveBrush := SelectObject(DC, Brush);
    PatBlt(DC, W, H, PWid, PHet, PATCOPY);
    if Plus then  PatBlt(DC, W + PlusInd, H - PlusInd, PHet, PWid, PATCOPY);
    Dec(W);Dec(H);
    SelectObject(DC, SaveBrush);
    Brush := GetSysColorBrush(COLOR_BTNSHADOW);
  end else
    Brush := GetSysColorBrush(COLOR_BTNTEXT);

  SaveBrush := SelectObject(DC, Brush);
  PatBlt(DC, W, H, PWid, PHet, PATCOPY);
  if Plus then  PatBlt(DC, W + PlusInd, H - PlusInd, PHet, PWid, PATCOPY);
  SelectObject(DC, SaveBrush);
end;

procedure DrawOneButton(DC: HDC; Style: TDrawButtonControlStyleEh;
  ARect: TRect; Enabled, Flat, Active, Down, DownDirection: Boolean);
var Rgn, SaveRgn: HRgn;
    r:Integer;
    Flags:Integer;
    IsClipRgn:Boolean;
    DRect:TRect;
//    Brush: HBRUSH;
begin
  DRect := ARect;
  LPtoDP(DC,DRect,2);

  IsClipRgn := Flat and Active;
  r := 0; SaveRgn := 0;
  if IsClipRgn then
  begin
    SaveRgn := CreateRectRgn(0,0,0,0);
    r := GetClipRgn(DC, SaveRgn);
    with DRect do
      Rgn := CreateRectRgn(Left+1, Top+1, Right-1, Bottom-1);
    SelectClipRgn(DC, Rgn);
    DeleteObject(Rgn);
  end;

  if Flat then
    if not Active {and not (Style=bcsUpDownEh)}
      then InflateRect(ARect,2,2)
      else InflateRect(ARect,1,1);
  Flags := DownFlags[Down] or FlatFlags[Flat] or EnabledFlags[Enabled];
  case Style of
    bcsDropDownEh: DrawFrameControl(DC, ARect, DFC_SCROLL, Flags or DFCS_SCROLLCOMBOBOX);
    bcsEllipsisEh: DrawEllipsisButton(DC, ARect, Enabled, Active, Flat, Down);
    bcsUpDownEh: DrawFrameControl(DC, ARect, DFC_SCROLL, Flags or IsDownFlags[DownDirection]);
    bcsMinusEh, bcsPlusEh: DrawPlusMinusButton(DC, ARect, Enabled, Active, Flat, Down, bcsPlusEh = Style);
  end;
  if Flat then
    if not Active {and not (Style=bcsUpDownEh)}
      then InflateRect(ARect,-2,-2)
      else InflateRect(ARect,-1,-1);

  if IsClipRgn then
  begin
    if r = 0
      then SelectClipRgn(DC, 0)
      else SelectClipRgn(DC, SaveRgn);
    DeleteObject(SaveRgn);
    if Down
      then DrawEdge(DC, ARect, BDR_SUNKENOUTER, BF_RECT)
      else DrawEdge(DC, ARect, BDR_RAISEDINNER, BF_RECT)
  end;
end;

type
  PPoints = ^TPoints;
  TPoints = array[0..0] of TPoint;

  TButtonBitmapInfoEh = record
    Size:TPoint;
    BitmapType: TDrawButtonControlStyleEh;
    Flat:Boolean;
    case TDrawButtonControlStyleEh of
      bcsDropDownEh, bcsEllipsisEh, bcsUpDownEh,
      bcsPlusEh, bcsMinusEh: (Pressed, Active, Enabled, DownDirect:Boolean);
      bcsCheckboxEh: (State: TCheckBoxState);
  end;

  { TButtonsBitmapCache }

  TButtonBitmapInfoBitmapEh = record
    BitmapInfo: TButtonBitmapInfoEh;
    Bitmap: TBitmap;
  end;

  PButtonBitmapInfoBitmapEh = ^TButtonBitmapInfoBitmapEh;

  TButtonsBitmapCache = class(TList)
  private
    function Get(Index: Integer): PButtonBitmapInfoBitmapEh;
//    procedure Put(Index: Integer; const Value: PButtonBitmapInfoBitmapEh);
  public
    procedure Clear; override;
    function GetButtonBitmap(ButtonBitmapInfo: TButtonBitmapInfoEh):TBitmap;
    property Items[Index: Integer]: PButtonBitmapInfoBitmapEh read Get {write Put}; default;
  end;

var ButtonsBitmapCache: TButtonsBitmapCache;

procedure ClearButtonsBitmapCache;
begin
  ButtonsBitmapCache.Clear;
end;

function RectSize(ARect:TRect):TSize;
begin
  Result.cx := ARect.Right-ARect.Left;