📄 secedit.pas
字号:
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 + -