nodigcls.pas

这一系列是我平时收集的pascal深入核心编程

unit NoDigCls;

interface

uses Windows;

 // 子类化(or还原)编辑框控件
function NoDigitsClass_ConvertEdit(hWnd: HWND; fSubclass: BOOL): BOOL; stdcall;

implementation

uses Messages;

const g_szNoDigitsClassWndProcOrig = 'NoDigitsClassWndProcOrig';

 // 调用标准的编辑框处理过程
function NoDigitsClass_CallOrigWndProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
begin
  Result := CallWindowProc(
    Pointer(GetProp(hWnd, g_szNoDigitsClassWndProcOrig)),
    hWnd, uMsg, wParam, lParam);
end;

 // 编辑框WM_CHAR消息处理过程
procedure NoDigitsClass_OnChar(hWnd: HWND; ch: Char; cRepeat: Integer);
begin
 if (ch < '0') or (ch > '9') then
   NoDigitsClass_CallOrigWndProc(hWnd, WM_CHAR, WPARAM(ch), MakeLParam(cRepeat, 0)) // 放行
 else
   MessageBeep(0); // 仅作响铃
end;

 // 新的编辑框回调(用以拦截、屏蔽某些消息)
function NoDigitsClass_WndProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
  if (uMsg = WM_CHAR) then
  begin
    NoDigitsClass_OnChar(hWnd, Char(wParam), LOWORD(lParam));
    Result := 0;
  end else
    Result := NoDigitsClass_CallOrigWndProc(hWnd, uMsg, wParam, lParam); // 标准处理
end;

 // 子类化(or还原)编辑框控件
function NoDigitsClass_ConvertEdit(hWnd: HWND; fSubclass: BOOL): BOOL; stdcall;
var
  wp: DWORD; // 老的控件过程
begin
  if (fSubclass = FALSE) then
  begin
    wp := RemoveProp(hWnd, g_szNoDigitsClassWndProcOrig);
    if (wp <> 0) then
      Result := SetWindowLong(hWnd, GWL_WNDPROC, wp) <> 0
    else
      Result := FALSE;
  end else
  begin
    Result := SetProp(hWnd, g_szNoDigitsClassWndProcOrig,
      SetWindowLong(hWnd, GWL_WNDPROC, Integer(@NoDigitsClass_WndProc)));
  end;
end;

end.