Мегабайты отдыхают

Автор: Alex Storm

• Постановка задачи.
• Пример решения с исходным кодом.
• Выгода при использовании данного решения.
• Заключение.

1. Постановка задачи

2.Пример решения с исходным кодом

uses windows, messages;

{$R *.res}

var
  WinClass : TWndClass; //переменная класса TWndClass для создания главного окна
  hInst : HWND; //хандлер приложения
  Handle : HWND; //хандлер
  hMsgBtn : HWND; //Хандлер кнопки
  hMsgEdit : HWND; //Хандлер эдита
  hMsgLabel : HWND; //Хандлер лабы
  hFont : HWND; //Хандлер шрифта
  Msg : TMSG; //Сообщение
  pr_Click : pointer; //Указатель на процедуру

procedure Resize; //Демонстрация изменения размеров и положения компонентов программным способом, если мы изменяем окно
  var Rect:TRect;
begin
  GetWindowRect(Handle,Rect); // Цепляем окошко
  MoveWindow(hMsgEdit,30,90, Rect.Right-Rect.Left-100,22,True); // А тут можно изменить его размеры или положение
end;

procedure ShutDown; // Выключение
begin
  DeleteObject(hFont); //Удаляем шрифты
  UnRegisterClass('Sample Class', hInst); //Удаляем наше окно
  ExitProcess(hInst); // Выходим из проги
end;

procedure Click; // Задача для кнопки
  var Label_Text:PCHAR; // Определяем переменные для текста и его длины
  LText:integer;
begin
  LText:=GetWindowTextLength(hMsgEdit)+1; // Получим длину текста и не забудем его последний символ (+1)
  GetMem(Label_Text,LText); // Выделим память под переменную текста
  GetWindowText(hMsgEdit,Label_Text,LText); //Захватим текст из едит-бокса
  SetWindowText(hMsgLabel,Label_Text); //Назначим текст метке
end;

function ClickProc(hwnd,msg,wparam,lParam:longint):longint;stdcall; // Обработка каждого сообщения, посланного кнопке
begin
  Result:=CallWindowProc(pr_Click,hWnd,Msg,wParam,lParam);
  case Msg of
    WM_KEYDOWN : if wparam=9 then SetFocus(hMsgBtn); //Если юзверь нажал на кнопку, то дадим ей фокус ввода
  end;
end;

function WindowProc(hwnd, msg, wparam, lparam:longint):longint;stdcall; //То же самое для окна
begin
  Result:=DefWindowProc(hwnd,msg,wparam,lparam);
  case Msg of
    WM_SIZE : Resize; // Если изменяем окно, значит, надо его изменить ;)
    WM_COMMAND : if lparam=hMsgBtn then Click; // Если есть нужная команда, выполним процедуру щелчка мыши
    WM_DESTROY : ShutDown; // Если поступило сообщение уничтожения винды, то выполним его.
  end;
end;

begin
  hInst:=GetModuleHandle(nil); // Получим хандлер приложения

  //А теперь задаем свойства окна

  with WinClass do
  begin
    Style:= CS_PARENTDC; //Это - родитель компонентов.
    hIcon:= LoadIcon(hInst,'MAINICON'); //Икона
    lpfnWndProc:= @WindowProc; //Процедура обработки сообщений
    hInstance:= hInst; //Хандлер окна
    hbrBackground:= COLOR_BTNFACE+1; //Цвет окна
    lpszClassName:= 'Sample Class'; //Имя класса
    hCursor:= LoadCursor(0,IDC_ARROW); //Курсор
    end;

  //Регистрируем наш класс
  RegisterClass(WinClass);

  //Собственно создание нашего окна.
  Handle:=CreateWindow(
    'Sample Class', // Зарегистрированное имя класса
    'Маленький проект', // Заголовок окна
    WS_OVERLAPPEDWINDOW or // Стиль окна
    WS_VISIBLE, // Оно видимое
    10, // Левый
    10, // верхний угол окна
    400, // Длина
    300, // Высота
    0, // Хандлер окна
    0, // Хандлер менюшки
    hInst, // Хандлер приложения
    nil
  );

  // Создаем кнопку
  hMsgBtn:=CreateWindow(
    'Button',
    'Message',
    WS_VISIBLE or WS_CHILD or BS_PUSHLIKE or BS_TEXT,
    5,5,65,24,Handle,0,hInst,nil
   );

  // Создаем эдит-бокс
  hMsgEdit:=CreateWindowEx(
    WS_EX_CLIENTEDGE,
    'Edit',
    '',
    WS_VISIBLE or WS_CHILD or ES_LEFT or ES_AUTOHSCROLL,
    30,90,155,24,Handle,0,hInst,nil
   );

  //Создаем label
   hMsgLabel:=CreateWindow(
    'Static',
    '',
    WS_VISIBLE or WS_CHILD or SS_LEFT,
    160,10,170,50,Handle,0,hInst,nil
   );

  //Создаем шрифт
  hFont:=CreateFont(
    -12, // Высота
    0, // Длина
    0, // Угол поворота
    0, // Ориентация
    0, // Жирность
    0, // Курсивность
    0, // Подчеркнутость
    0, // Зачеркнутость
    DEFAULT_CHARSET, // Char Set
    OUT_DEFAULT_PRECIS, // Precision
    CLIP_DEFAULT_PRECIS, // Clipping
    DEFAULT_QUALITY, // Render Quality
    DEFAULT_PITCH or FF_DONTCARE, // Pitch & Family
    'MS Sans Serif' // Имя шрифта
   );

  SendMessage(hMsgBtn,WM_SETFONT,hFont,0); //Назначаем наш шрифт кнопке, эдит-боксу, лабе
  SendMessage(hMsgEdit,WM_SETFONT,hFont,0);
  SendMessage(hMsgLabel,WM_SETFONT,hFont,0);

  //Назначаем кнопке процедуру
  pr_Click:=Pointer(GetWindowLong(hMsgBtn,GWL_WNDPROC));
  SetWindowLong(hMsgBtn,GWL_WNDPROC,Longint(@ClickProc));

  //Установка фокуса ввода на кнопку
  SetFocus(hMsgBtn);

  while(GetMessage(Msg,Handle,0,0))do
  begin
    TranslateMessage(Msg); //Переводим все сообщения...
    DispatchMessage(Msg); //...к черту!!! :))))))))))
  end;

end.

3.Выгода при использовании данного решения.

4. Заключение.