toolctrlseh.pas

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

    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: TMessage); 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;
  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;

procedure DrawImage(DC: HDC; ARect: TRect; Images: TCustomImageList;
  ImageIndex: Integer; Selected: 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;

implementation

uses DBConsts, Math,
  {$IFDEF EH_LIB_6} VDBConsts, Types, {$ENDIF}
  {$IFDEF EH_LIB_7} Themes, UxTheme, {$ENDIF}
  MultiMon;

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

{$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}

function IsDoubleClickMessage(OldPos, NewPos: TPoint; Interval: Longint): Boolean;
begin
  Result := (Interval <= Longint(GetDoubleClickTime)) and
            (Abs(OldPos.X - NewPos.X) <= GetSystemMetrics(SM_CXDOUBLECLK)) and
            (Abs(OldPos.Y - NewPos.Y) <= GetSystemMetrics(SM_CYDOUBLECLK));
end;

procedure GetCheckSize;
begin
  with TBitmap.Create do
    try
      Handle := LoadBitmap(0, PChar(32759));
      DefaultCheckBoxWidth := Width div 4;
      DefaultCheckBoxHeight := Height div 3;
    finally
      Free;
    end;
end;

function AdjustCheckBoxRect(ClientRect: TRect;  Alignment: TAlignment; Layout: TTextLayout): TRect;
var
  CheckWidth, CheckHeight: Integer;
begin
  if (ClientRect.Right - ClientRect.Left) > DefaultCheckBoxWidth
    then CheckWidth := DefaultCheckBoxWidth
    else CheckWidth := ClientRect.Right - ClientRect.Left;

  if (ClientRect.Bottom - ClientRect.Top) > DefaultCheckBoxHeight
    then CheckHeight := DefaultCheckBoxHeight
    else CheckHeight := ClientRect.Bottom - ClientRect.Top;


  Result := ClientRect;

  if (ClientRect.Right - ClientRect.Left) > DefaultCheckBoxWidth then
    case Alignment of
      taRightJustify: Result.Left := Result.Right - CheckWidth;
      taCenter: Result.Left := Result.Left + (ClientRect.Right - ClientRect.Left) shr 1 - CheckWidth shr 1;
    end;
  Result.Right := Result.Left + CheckWidth;

  if (ClientRect.Bottom - ClientRect.Top) > DefaultCheckBoxHeight then
    case Layout of
      tlBottom: Result.Top := Result.Bottom - CheckWidth;
      tlCenter: Result.Top := Result.Top + (ClientRect.Bottom - ClientRect.Top) shr 1 - CheckHeight shr 1;
    end;
  Result.Bottom := Result.Top + CheckHeight;
end;

procedure DrawCheck(DC: HDC; R: TRect; AState: TCheckBoxState; AEnabled, AFlat, ADown, AActive: Boolean);
var
  DrawState, oldRgn: Integer;
  DrawRect: TRect;
//  OldBrushColor: TColor;
//  OldBrushStyle: TBrushStyle;
//  OldPenColor: TColor;
  Rgn, SaveRgn: HRgn;
{$IFDEF EH_LIB_7}
  ElementDetails: TThemedElementDetails;
{$ENDIF}
//  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;
  if ADown then
    DrawState := DrawState or DFCS_PUSHED;
//  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 + 1, Top + 1, Right - 1, Bottom - 1);
    SelectClipRgn(DC, Rgn);
    DeleteObject(Rgn);
  end;
  if AFlat then InflateRect(DrawRect, 1, 1);

{$IFDEF EH_LIB_7}
  if ThemeServices.ThemesEnabled then
  begin
    case AState of
      cbChecked:
        if AEnabled then
          ElementDetails := ThemeServices.GetElementDetails(tbCheckBoxCheckedNormal)
        else
          ElementDetails := ThemeServices.GetElementDetails(tbCheckBoxCheckedDisabled);
      cbUnchecked:
        if AEnabled then
          ElementDetails := ThemeServices.GetElementDetails(tbCheckBoxUncheckedNormal)
        else
          ElementDetails := ThemeServices.GetElementDetails(tbCheckBoxUncheckedDisabled)
      else // cbGrayed
        if AEnabled then
          ElementDetails := ThemeServices.GetElementDetails(tbCheckBoxMixedNormal)
        else
          ElementDetails := ThemeServices.GetElementDetails(tbCheckBoxMixedDisabled);
    end;
    ThemeServices.DrawElement(DC, ElementDetails, R);
  end
  else
{$ENDIF}
    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);
    if AActive
      then FrameRect(DC, DrawRect, GetSysColorBrush(COLOR_BTNFACE))
      else FrameRect(DC, DrawRect, GetSysColorBrush(COLOR_BTNSHADOW));

    { Caller drow in flat mode
    InflateRect(DrawRect, 1, 1);
    if AActive
      then DrawEdge(DC, DrawRect, BDR_SUNKENOUTER, BF_RECT)
      else 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;
{$IFDEF EH_LIB_7}
  Button: TThemedButton;
  ToolButton: TThemedToolBar;
  Details: TThemedElementDetails;
{$ENDIF}
begin
  ElRect := ARect;

{$IFDEF EH_LIB_7}
  if ThemeServices.ThemesEnabled then
  begin
    if not Enabled then
      Button := tbPushButtonDisabled
    else
      if Pressed then
        Button := tbPushButtonPressed
      else
        if Active
          then Button := tbPushButtonHot
          else Button := tbPushButtonNormal;

    ToolButton := ttbToolbarDontCare;
    if Flat then
    begin
      case Button of
        tbPushButtonDisabled:
          Toolbutton := ttbButtonDisabled;
        tbPushButtonPressed:
          Toolbutton := ttbButtonPressed;
        tbPushButtonHot:
          Toolbutton := ttbButtonHot;
        tbPushButtonNormal:
          Toolbutton := ttbButtonNormal;
      end;
    end;

    if ToolButton = ttbToolbarDontCare then
    begin
      Details := ThemeServices.GetElementDetails(Button);
      ThemeServices.DrawElement(DC, Details, ARect);

//      ARect := ThemeServices.ContentRect(DC, Details, ARect);
      InflateRect(ElRect, -2, -2);
    end else
    begin
      Details := ThemeServices.GetElementDetails(ToolButton);
      ThemeServices.DrawElement(DC, Details, ARect);
      InflateRect(ElRect, -1, -1)
//      ARect := ThemeServices.ContentRect(DC, Details, ARect);
    end;
  end else
{$ENDIF}
  begin
    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;
  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;
{$IFDEF EH_LIB_7}
  Button: TThemedButton;
  ToolButton: TThemedToolBar;
  Details: TThemedElementDetails;
{$ENDIF}
begin
  ElRect := ARect;

{$IFDEF EH_LIB_7}
  if ThemeServices.ThemesEnabled then
  begin
    if not Enabled then
      Button := tbPushButtonDisabled
    else
      if Pressed then
        Button := tbPushButtonPressed
      else
        if Active
          then Button := tbPushButtonHot
          else Button := tbPushButtonNormal;

    ToolButton := ttbToolbarDontCare;
    if Flat then
    begin
      case Button of
        tbPushButtonDisabled:
          Toolbutton := ttbButtonDisabled;
        tbPushButtonPressed:
          Toolbutton := ttbButtonPressed;
        tbPushButtonHot:
          Toolbutton := ttbButtonHot;
        tbPushButtonNormal:
          Toolbutton := ttbButtonNormal;
      end;
    end;

    if ToolButton = ttbToolbarDontCare then
    begin
      Details := ThemeServices.GetElementDetails(Button);
      ThemeServices.DrawElement(DC, Details, ARect);
//      ARect := ThemeServices.ContentRect(DC, Details, ARect);
      InflateRect(ElRect, -2, -2);
    end else
    begin
      Details := ThemeServices.GetElementDetails(ToolButton);
      ThemeServices.DrawElement(DC, Details, ARect);
      InflateRect(ElRect, -1, -1)
//      ARect := ThemeServices.ContentRect(DC, Details, ARect);