////////////////////////////////////////////////////////////////////////////////

//

//  ****************************************************************************

//  * Unit Name : Access

//  * Purpose   : демо простого приложения на АПИ.

//  * Author    : Александр (Rouse_) Багель

//  * Version   : 1.0

//  ****************************************************************************

//

 

program Access;

 

uses

  Windows,

  Messages;

 

resourcestring

  TXT_CAPTION = 'Ввод пароля';

  TXT_INSTALL = 'Принять';

  TXT_CANCEL = 'Отмена';

  TXT_STATUS = 'Введите пароль:';

  TXT_NEWUSER = 'Значение пароля: ';

 

var

  MainWindow    : TWndClassEx;

  Handle,

  hFontNormal,

  btnOk,

  btnCancel,

  Edit,

  Label1        : HWND;

  Msg           : TMsg;

  Left,

  Top,

  Width,

  Height        : Integer;

 

const

  BTN_APPLY_ID = 100;

  BTN_CANCEL_ID = 105;

  EDIT_ID = 110;

 

// Центрирование формы

// =============================================================================

procedure CenterMainForm;

var

  ScrWidth, ScrHeight: Cardinal;

begin

  ScrWidth := GetSystemMetrics(SM_CXSCREEN);

  ScrHeight := GetSystemMetrics(SM_CYSCREEN);

  Left := (Integer(ScrWidth) - Width) div 2;

  Top := (Integer(ScrHeight) - Height) div 2;

end;

 

 

// Главная оконная процедура

// =============================================================================

function WindowProc(Wnd: HWND; Msg: Integer;

  WParam: WPARAM; LParam: LPARAM): LRESULT; stdcall;

var

  S: String;

  Len: Integer;

  DC: HDC;

begin

  Result := 0;

  case Msg of

    WM_DESTROY:

    begin

      PostQuitMessage(0);

      Result:=0;

    end;

    WM_COMMAND:

    begin

      case LoWord(WParam) of

        BTN_APPLY_ID: // Нажатие на кнопку "Принять"

        begin

          Len := SendMessage(Edit, WM_GETTEXTLENGTH, 0, 0);

          Inc(Len);

          SetLength(S, Len);

          SendMessage(Edit, WM_GETTEXT, Len, Integer(@S[1]));

          MessageBox(Handle, PChar(TXT_NEWUSER + S), PChar(TXT_CAPTION), MB_OK);

          PostQuitMessage(0);

          Result := 0;

        end;

        BTN_CANCEL_ID: // Нажатие на кнопку "Отмена"

        begin

          PostQuitMessage(0);

          Result := 0;

        end;

        EDIT_ID: // Обработчик Edit-а

          // В зависимости от кол-ва символов, включаем/отключаем кнопку "Принять"

          EnableWindow(btnOk, Boolean(SendMessage(Edit, WM_GETTEXTLENGTH, 0, 0)));

      end;

    end;

    WM_CTLCOLORSTATIC: // Изменения цвета STATIC

    begin

      if LParam = Label1 then

      begin

        Result := DefWindowProc(Wnd, Msg, WParam, LParam);

        SetTextColor(WParam, $FF0000);

      end;                                  

    end;

  else

    Result := DefWindowProc(Wnd, Msg, WParam, LParam);

  end;

end;

 

 

// Здесь программа стартует

// =============================================================================

begin

  // Инициализируем оконный класс

  with MainWindow do

  begin

    cbSize := SizeOf(MainWindow);

    style := CS_HREDRAW or CS_VREDRAW;

    lpfnWndProc := @WindowProc;

    cbClsExtra := 0;

    cbWndExtra := 0;

    hIcon := LoadIcon(0, IDI_APPLICATION);

    hCursor  := LoadCursor(0, IDC_ARROW);

    hbrBackground := COLOR_BTNFACE + 1;

    lpszMenuName := nil;

    lpszClassName := 'TAccessForm';

  end;

  MainWindow.hInstance := HInstance;

 

  // Регистрируем оконный класс

  if RegisterClassEx(MainWindow) = 0 then Exit;

 

  // Подготавливаем координаты для центрирования формы

  Width := 360;

  Height := 130;

  CenterMainForm;

 

  // Создаем форму

  Handle := CreateWindow('TAccessForm',

    PChar(TXT_CAPTION), WS_OVERLAPPED or WS_SYSMENU,

    Left, Top, Width, Height, 0, 0, HInstance, nil);

 

  // Создаем кнопку "Принять"

  btnOk := CreateWindow('BUTTON', PChar(TXT_INSTALL),

    BS_PUSHBUTTON or WS_CHILD or WS_VISIBLE or BS_DEFPUSHBUTTON,

    270, 65, 75, 25, Handle, BTN_APPLY_ID, hInstance, nil);

 

  // Отключаем ее до ввода пароля

  EnableWindow(btnOk, False);

 

  // Создаем кнопку "Отмена"

  btnCancel := CreateWindow('BUTTON', PChar(TXT_CANCEL),

    BS_PUSHBUTTON or WS_CHILD or WS_VISIBLE,

    190, 65, 75, 25, Handle, BTN_CANCEL_ID, hInstance, nil);

 

  // Создаем поле ввода

  Edit := CreateWindowEx(WS_EX_CLIENTEDGE, 'EDIT', nil, WS_CHILD or WS_VISIBLE,

    10, 30, 335, 21, Handle, EDIT_ID, HInstance, nil);

 

  // Задаем симфол который будет отображаться ри вводе пароля

  SendMessage(Edit, EM_SETPASSWORDCHAR, Ord('*'), 0);

 

  // Создаем Label

  Label1 := CreateWindow('STATIC', PChar(TXT_STATUS),

    WS_VISIBLE or WS_CHILD, 10, 13, 230, 14, Handle, 0, hInstance, nil);

 

  // Создаем нужный шрифт

  hFontNormal := CreateFont(-11, 0, 0, 0, FW_NORMAL, 0, 0, 0, DEFAULT_CHARSET,

                      OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,

                      DEFAULT_PITCH or FF_DONTCARE, 'MS Sans Serif');

 

  // назначаем этот шрифт всем оконным элементам

  if hFontNormal <> 0 then

  begin

    SendMessage(btnOk, WM_SETFONT, hFontNormal, 0);

    SendMessage(btnCancel, WM_SETFONT, hFontNormal, 0);

    SendMessage(Edit, WM_SETFONT, hFontNormal, 0);

    SendMessage(Label1, WM_SETFONT, hFontNormal, 0);

  end;

 

  // Показываем окно

  ShowWindow(Handle, SW_SHOW);

  // Ставим его поверх всех

  SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0,

    SWP_NOSIZE or SWP_NOMOVE);

  // Ставим фокус в поле ввода

  SetFocus(Edit);

 

  // Начинаем крутить цикл выборки сообщений

  while GetMessage(Msg, 0, 0, 0) do

  begin

    TranslateMessage(Msg);

    DispatchMessage(Msg);

  end;

  

end.