program Project1;
{$mode objfpc}{$H+}
uses
Windows,Messages, SysUtils;
{$R *.res}
const
LPSTR_APP_CLASS = 'native_EditClass';
LPSTR_APP_TITLE = 'Native Edit Control (Windows)';
ID_PASSEDIT = 100;
var
hWin: HWND;
function CreatePasswordEdit(Handle: HWND): HWND;
var
hEdit: HWND;
begin
hEdit := CreateWindowEx(WS_EX_CLIENTEDGE,'EDIT',nil,WS_CHILD or WS_TABSTOP or
WS_CLIPCHILDREN or WS_VISIBLE or ES_PASSWORD,
20,20,270,23,Handle,ID_PASSEDIT,hInstance,nil);
SendMessage(hEdit, WM_SETFONT, GetStockObject(DEFAULT_GUI_FONT), MAKELPARAM(1, 0));
Result := hEdit;
end;
function ApplicationWndProc(Handle: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
case uMsg of
WM_CREATE:
SetFocus(CreatePasswordEdit(Handle));
WM_SYSCOMMAND:
case LOWORD(wParam) of
SC_CLOSE:
DestroyWindow(Handle);
end;
WM_COMMAND:
case LOWORD(wParam) of
IDCANCEL:
SendMessage(Handle,WM_SYSCOMMAND,SC_CLOSE,lParam);
end;
WM_DESTROY:
begin
DestroyWindow(GetDlgItem(Handle,ID_PASSEDIT));
PostQuitMessage(0);
end;
end;
Result := DefWindowProc(Handle,uMsg,wParam,lParam);
end;
{Register windows class}
function ApplicationRegisterClass(const hInst: HINST; lpWndProc: POINTER): BOOL;
var
hwndCls: TWNDCLASS;
begin
hwndCls.style := CS_CLASSDC;
hwndCls.lpfnWndProc := WNDPROC(lpWndProc);
hwndCls.cbClsExtra := 0;
hwndCls.cbWndExtra := 0;
hwndCls.hInstance := hInst;
hwndCls.hIcon := LoadIcon(hInst,'MAINICON');
hwndCls.hCursor := LoadCursor(0,IDC_ARROW);
hwndCls.hbrBackground := COLOR_BTNFACE+1;
hwndCls.lpszMenuName := nil; //MAKEINTRESOURCE(RES_MENU_MAIN);
hwndCls.lpszClassName := LPSTR_APP_CLASS;
Result := (RegisterClass(hwndCls)<>0);
end;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
function ApplicationCreateWindows(const hInst: HINST): BOOL;
begin
hWin := CreateWindow(LPSTR_APP_CLASS,LPSTR_APP_TITLE,WS_SYSMENU,
CW_USEDEFAULT,CW_USEDEFAULT,350,150,
0,0,hInst,nil);
if (hWin<>0) then
begin
ShowWindow(hWin,SW_SHOWNORMAL);
UpdateWindow(hWin);
Result := TRUE;
end
else
Result := FALSE;
end;
{------------------ Main window message loop--------------------}
function ApplicationMessageLoop(const hInst: HINST; const hOwner: HWND): WPARAM;
var
uMsg: TMSG;
begin
while GetMessage(uMsg,0,0,0) do
begin
TranslateMessage(uMsg);
DispatchMessage(uMsg);
end;
Result := uMsg.wParam;
end;
{Program main entry}
begin
if ApplicationRegisterClass(hInstance,@ApplicationWndProc) then
begin
if ApplicationCreateWindows(hInstance) then
Halt(ApplicationMessageLoop(hInstance,hWin))
else
MessageBox(hInstance,'Cannot create application window, call to CREATEWINDOW failed!','Error Starting Program',MB_ICONSTOP)
end
else
MessageBox(hInstance,'Cannot register application class, call to REGISTERCLASS failed!','Error Starting Program',MB_ICONSTOP);
end.