⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 secedit.pas

📁 一个基于不需引擎的文件管理系统,使用了许多界面比较好的控件
💻 PAS
📖 第 1 页 / 共 3 页
字号:
unit SecEdit;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, StdCtrls, Buttons, Graphics,
  Forms, Dialogs, ExtCtrls, ComCtrls, CommCtrl;

type
  TSecCustomBtnStyle = (cbsEllipsis, cbsDownArrow, cbsCustom);
  TSecComboStyle = (csDropDown, csDropDownList);
  TSecComboCloseUpEvent = procedure(Sender: TObject; Select: boolean) of object;
  TSecCheckValidItemEvent = procedure(Sender: TObject; Node: TTreeNode; var Accept: Boolean) of object;

  TSecCustomTreeCombo=class;

  TSecCustomBtn=class(TSpeedButton)
  private
    FBtnStlye: TSecCustomBtnStyle;
    procedure DrawDropDownArrow(Canvas: TCanvas; R: TRect;
      State: TButtonState; Enabled: Boolean; ControlState: TControlState);
    procedure DrawEllipsis(Canvas: TCanvas; R: TRect; State: TButtonState;
      Enabled: Boolean;Transparent: boolean;FlatButtonTransparent: boolean;
      ControlState: TControlState);
    procedure SetBtnStlye(const Value: TSecCustomBtnStyle);
  protected
    procedure Paint; override;
  public
    property BtnStlye:TSecCustomBtnStyle read FBtnStlye write SetBtnStlye default cbsDownArrow;
  end;

  TSecPopupTreeView=class(TTreeView)
  private
    FClickedInControl: Boolean;
    FCloseOnUp: Boolean;
    FTimerOn: Boolean;
    FTreeCombo: TSecCustomTreeCombo;
    procedure WMMouseActivate(var Message: TMessage); message WM_MOUSEACTIVATE;
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMTimer(var Message: TWMTimer); message WM_TIMER;
    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;

    function GetItemHeight: ShortInt;
    procedure SetItemHeight(const Value: ShortInt);
  protected
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure KillTimer; virtual;
    procedure SetTimer; virtual;
    procedure WndProc(var Message: TMessage); override;
    property TreeCombo: TSecCustomTreeCombo read FTreeCombo;
    property ItemHeight: ShortInt read GetItemHeight write SetItemHeight;
  public
    constructor Create(AOwner: TComponent); override;
    function ValidNode(Node: TTreeNode): Boolean;
    function MovePage(Node: TTreeNode; Down: Boolean): TTreeNode;
    function GetLastVisible: TTreeNode;
    function GetLastNode: TTreeNode;
    function SelectValidNode(StartingNode: TTreeNode; SelectedNode: TTreeNode; Key: Word): Boolean;
  end;

  TSecPanel=class(TPanel)
  private
    procedure DoMeContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean);
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TSecCustomEdit=class(TEdit)
  private
    FControl:TWinControl;
    FButton:TSecCustomBtn;
    FOnDropDown: TNotifyEvent;
    FDropDownCount: Integer;
    FStyle: TSecComboStyle;
    FOnCloseUp: TSecComboCloseUpEvent;
    procedure SetEditRect;
    function GetEditRect:TRect;

    procedure SetShowButton(const Value: Boolean);
    function GetShowButton:Boolean;
    procedure SetOnButtonClick(const Value: TNotifyEvent);
    function GetOnButtonClick:TNotifyEvent;
    procedure SetButtonStyle(const Value: TSecCustomBtnStyle);
    function GetButtonStyle:TSecCustomBtnStyle;
    procedure SetOnDropDown(const Value: TNotifyEvent);
    procedure SetDropDownCount(const Value: Integer);
    procedure SetStyle(const Value: TSecComboStyle);
    procedure SetOnCloseUp(const Value: TSecComboCloseUpEvent);

    procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
  protected
    procedure UpdateButtonPosition;
    procedure loaded;override;
    procedure CreateWnd; override;
    procedure DoDropDown; virtual;
    procedure DoCloseUp(Accept: Boolean); virtual;
    procedure DropDown;virtual;
    procedure CloseUp(Accept: Boolean); virtual;
    procedure ShowCaret;virtual;
    procedure HideCaret; virtual;
    function GetDropDownContainer: TWinControl; virtual; abstract;
    function GetDropDownControl: TWinControl; virtual; abstract;
    function GetItemSize: TSize; virtual; abstract;
    function GetItemCount: Integer; virtual; abstract;

    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure BtnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); virtual;
    function IsDroppedDown: Boolean;virtual;
    procedure WndProc(var Message: TMessage); override;
    procedure CheckCancelMode; virtual;

    property OnDropDown:TNotifyEvent read FOnDropDown write SetOnDropDown;
    property OnCloseUp:TSecComboCloseUpEvent read FOnCloseUp write SetOnCloseUp;
    property ShowButton:Boolean read GetShowButton write SetShowButton default true;
    property ButtonStyle:TSecCustomBtnStyle read GetButtonStyle write SetButtonStyle;
    property OnButtonClick:TNotifyEvent read GetOnButtonClick write SetOnButtonClick;
    property DropDownContainer: TWinControl read GetDropDownContainer;
    property DropDownControl: TWinControl read GetDropDownControl;
    property ItemSize: TSize read GetItemSize;
    property ItemCount: Integer read GetItemCount;
    property DropDownCount: Integer read FDropDownCount write SetDropDownCount;
    property Style: TSecComboStyle read FStyle write SetStyle;
  public
    constructor create(AOwner:TComponent);override;
    destructor destroy;override;
    procedure CreateParams(var Params: TCreateParams); override;
  end;

  TSecCustomTreeCombo=class(TSecCustomEdit)
  private
    FPanel:TSecPanel;
    FOriginalNode: TTreeNode;
    FOriginalText: String;
    FTreeView:TSecPopupTreeView;
    FDropDownWidth: integer;
    FSelectedNode: TTreeNode;
    FOnCheckValidItem: TSecCheckValidItemEvent;
    procedure SetItems(const Value: TTreeNodes);
    function GetItems:TTreeNodes;
    procedure SetDropDownWidth(const Value: integer);
    procedure SetOnCheckValidItem(const Value: TSecCheckValidItemEvent);
  protected
    procedure CreateWnd;override;
    function GetDropDownContainer: TWinControl;override;
    function GetDropDownControl: TWinControl;override;
    function GetItemSize: TSize;override;
    function GetItemCount: Integer; override;

    function IsValidNode(Node: TTreeNode): Boolean; virtual;
    function IsDroppedDown: Boolean;override;
    procedure BtnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
  public
    constructor create(AOwner:TComponent);override;
    destructor destroy;override;
    procedure DropDown;override;
    procedure CloseUp(Accept: Boolean); override;
    property Items:TTreeNodes read GetItems write SetItems;
    property SelectedNode: TTreeNode read FSelectedNode;
    property TreeView:TSecPopupTreeView read FTreeView;
    property DropDownWidth:integer read FDropDownWidth write SetDropDownWidth default 0;
    property OnCheckValidItem: TSecCheckValidItemEvent read FOnCheckValidItem write SetOnCheckValidItem;
  end;

  TSecEdit = class(TSecCustomEdit)
  private
    { Private declarations }
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor create(AOwner:TComponent);override;
  published
    { Published declarations }
    property ShowButton;
    property ButtonStyle;
    property OnButtonClick;
  end;

  TSecTreeCombo=class(TSecCustomTreeCombo)
  protected

  published
    property DropDownCount;
    property OnDropDown;
    property OnCheckValidItem;
    property Items;
    property Style;
  end;

implementation

var
  COMBOHOOK: HHOOK = 0;
  WM_SEC_CALLDROPDOWN: UINT = 0;

const
  SECPOPUPTIMERID = 1000;
  SECPOPUPINTERVAL = 50;

function min(Int1, Int2: Integer): Integer;
begin
  if Int1 < Int2 then
    result := Int1
  else
    result := Int2;
end;

function Max(Int1, Int2: Integer): Integer;
begin
  if Int1 > Int2 then
    result := Int1
  else
    result := Int2;
end;

function ThisThat(const Clause: Boolean; TrueVal, FalseVal: Integer): Integer;
begin
  if Clause then
    result := TrueVal
  else
    Result := FalseVal;
end;

function ComboHookProc(nCode: Integer; wParam: Integer; lParam: Integer): LResult; stdcall;
var
  r1, r2: TRect;
  CurHandle: HWND;
  parentForm: TCustomForm;
begin
  result := CallNextHookEx(COMBOHOOK, nCode, wParam, lParam);
  with PMouseHookStruct(lParam)^ do
  begin
    case wParam of
      WM_LBUTTONDOWN, WM_NCLBUTTONDOWN, WM_MOUSEMOVE, WM_LBUTTONUP:
      begin
        if (Screen.ActiveControl <> nil) and (Screen.ActiveControl is TSecCustomEdit) then
          with (Screen.ActiveControl as TSecCustomEdit) do
          begin
            if IsDroppedDown then
            begin
              GetWindowRect(DropDownControl.Handle, r1);
              if (wParam = WM_LBUTTONDOWN) or (wParam = WM_NCLBUTTONDOWN) then
              begin
                GetWindowRect(Handle, r2);
                with r1 do
                begin
                  Right := Left + DropDownControl.Width;
                  Bottom := Top + DropDownControl.Height;
                end;
                CurHandle := Handle;
                if wParam = WM_LBUTTONDOWN then
                  CurHandle := DropDownControl.Handle;

                parentForm:= GetParentForm(Screen.ActiveControl);
                if ((parentForm<>nil) and (parentForm.Handle=hwnd)) or
                 (GetParent(hwnd)<>0) then
                begin
                  if not PtInRect(r1, pt) then with DropDownControl.ScreenToClient(Point(pt.x, pt.y)) do
                    PostMessage(CurHandle, wParam, 0, MakeLParam(WORD(ThisThat(x >= 0, x, -1)),WORD(ThisThat(y >= 0, y, -1))));
                end
                end
                else if (hwnd = DropDownControl.handle) and
                 ((wParam = WM_MOUSEMOVE) or (wParam = WM_LBUTTONUP)) then
                begin
                if not PtInRect(r1, pt) then
                  with DropDownControl.ScreenToClient(Point(pt.x, pt.y)) do
                    PostMessage(DropDownControl.Handle, wParam, 0, MakeLParam(WORD(ThisThat(x >= 0, x, -1)),WORD(ThisThat(y >= 0, y, -1))));
                  end;
              end ;
          end;
      end;
    end;
  end;
end;

{ TSecBtn }

procedure TSecCustomBtn.DrawDropDownArrow(Canvas: TCanvas; R: TRect;
  State: TButtonState; Enabled: Boolean; ControlState: TControlState);
var
  Flags: Integer;
begin
  if not Enabled then
    Flags := DFCS_SCROLLCOMBOBOX or DFCS_INACTIVE
  else if (State=bsUp) or (csPaintCopy in ControlState) then
    Flags := DFCS_SCROLLCOMBOBOX
  else
    Flags := DFCS_SCROLLCOMBOBOX or DFCS_FLAT or DFCS_PUSHED;
  DrawFrameControl(Canvas.Handle, R, DFC_SCROLL, Flags);
end;

procedure TSecCustomBtn.DrawEllipsis(Canvas: TCanvas; R: TRect;
  State: TButtonState; Enabled, Transparent,
  FlatButtonTransparent: boolean; ControlState: TControlState);
var
  Flags: Integer;
  DC: HDC;
  w: integer;
  LeftIndent, TopIndent: integer;
begin
  Flags:= 0;
  if (State = bsDown) and not (csPaintCopy in ControlState) then
    Flags := BF_FLAT;
  if not FlatButtonTransparent then Flags:= Flags or BF_MIDDLE;
  DC:= Canvas.Handle;
  if not Transparent then
      DrawEdge(DC, R, EDGE_RAISED, BF_RECT or Flags);

  LeftIndent:= ((R.Right - R.Left) shr 1) - 1 + Ord(State=bsDown);
  TopIndent:= ((R.Bottom+1-R.Top) shr 1) - 1 + Ord(State=bsDown);
  W := (R.Right+1 - R.Left) shr 3;
  if W = 0 then W := 1;
  PatBlt(DC, R.Left + LeftIndent, R.Top + TopIndent, W, W, BLACKNESS);
  PatBlt(DC, R.Left + LeftIndent - (W * 2), R.Top + TopIndent, W, W, BLACKNESS);
  PatBlt(DC, R.Left + LeftIndent + (W * 2), R.Top + TopIndent, W, W, BLACKNESS);
end;

procedure TSecCustomBtn.Paint;
var
  r:TRect;
  DoPaint:Boolean;
begin
  SetRect(R, 0, 0, ClientWidth, ClientHeight);
  DoPaint:=true;
  if FBtnStlye=cbsDownArrow then
  begin
    DrawDropDownArrow(canvas,r,FState,DoPaint,ControlState);
    DoPaint:=false;
  end
  else if FBtnStlye=cbsEllipsis then
  begin
    DrawEllipsis(canvas,r,FState,true,false,false,ControlState);
    DoPaint:=false;
  end;
  if DoPaint then
    inherited Paint;
  if FState=bsDown then
    DrawEdge(Canvas.Handle, r, EDGE_SUNKEN, BF_RECT)
  else
    DrawEdge(Canvas.Handle, r, EDGE_RAISED, BF_RECT) ;
end;

procedure TSecCustomBtn.SetBtnStlye(const Value: TSecCustomBtnStyle);
begin
  if FBtnStlye <> Value then
  begin
    FBtnStlye := Value;
    Invalidate;
  end;
end;

{ TSecCustomEdit }

procedure TSecCustomEdit.BtnMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin

end;

procedure TSecCustomEdit.CheckCancelMode;
var
  p, p2: TPoint;
  wndRect: TRect;
begin
  GetCursorPos(p);
  p2 := DropDownControl.ClientToScreen(Point(0, 0));
  GetWindowRect(Handle, wndRect);
  with p2 do
  begin
    if (not PtInRect(Rect(x, y, x + DropDownControl.Width, y + DropDownControl.Height), p)) and
      (not PtInRect(wndRect, p)) then
      CloseUp(False);
  end;
end;

procedure TSecCustomEdit.CloseUp(Accept: Boolean);
begin
  try
    SelectAll;
    if IsDroppedDown then
    begin
      SetWindowPos(DropDownContainer.Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or
        SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
      DropDownContainer.Visible := False;
      Invalidate;
      if DropDownControl.Focused then
        SetFocus;
    end;
    if Style = csDropDownList then
      HideCaret;
  finally
    if COMBOHOOK <> 0 then
    begin

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -