Среда, 19.12.2018, 10:40
Приветствую Вас Гость

LabSoft

Меню сайта
Категории каталога
Статьи по кодингу [24]
Материалы по кодингу
КреатиFF [144]
Рассказы, истории, анекдоты...
Разное [8]
Советы, трюки, полезные рекомендации, статьи о новом и забытом старом...
Наш опрос
Как Вы узнали о нас?
Всего ответов: 27
Главная » Статьи » Статьи по кодингу

APIDemoApp
program APIDemoApp;

uses
Windows,Messages;

var
WndClass: TWndClass;
MainForm, Button1, Edit1: HWND;
HAppInstance: integer;
Msg: TMsg;

procedure Button1Click;
var
EditText: array[0..255] of char;
begin
GetWindowText(Edit1, EditText, 256);
//Вывод сообщения на экран
MessageBox(MainForm,PChar('Ты набрал: ' + EditText),'Сообщение!',
MB_APPLMODAL OR MB_ICONINFORMATION OR MB_OK);
end;

procedure CreateControls;
var
hControlFont: HFONT;
lfControl: TLogFont;
begin
//Создание кнопки Button1 и поля Edit1
Edit1 := CreateWindowEx(WS_EX_CLIENTEDGE, //стиль
'EDIT', //Создание поля
'Текстовое поле', //Имя объекта
WS_CHILD OR WS_VISIBLE OR ES_AUTOHSCROLL OR ES_NOHIDESEL, //флаг стиля
8, 16, 160, 21, //расположение и размер
MainForm, //форма окна
0,
HAppInstance,
nil); //не создаем данные

Button1 := CreateWindow('BUTTON', //Создание кнопки
'Вывод сообщения', //Имя окна
WS_CHILD OR WS_VISIBLE OR BS_PUSHBUTTON OR BS_TEXT, //флаг стиля
8, 40, 120, 25, //расположение и размер
MainForm, //Окно
0,
HAppInstance,
nil);//не создаем данные

//установка шрифта
{Рассчитываем высоту шрифта с точки размера - это не одно и то же!
Первый параметр MulDiv это размер точки.}
lfControl.lfHeight := -MulDiv(8, GetDeviceCaps(GetDC(0), VREFRESH), 96);
lfControl.lfFaceName := 'MS Sans Serif';
lfControl.lfItalic:=0; //нет наклона, 1- есть наклон

//Создание шрифта
hControlFont := CreateFontIndirect(lfControl);

//Передача контролерам созданного шрофта
SendMessage(Edit1, WM_SETFONT, hControlFont, 1);
SendMessage(Button1, WM_SETFONT, hControlFont, 1);
end;

function WindowProc(hwnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM):
LRESULT; stdcall;
begin
//Эта функция сообщеня окна, когда отправленное сообщение было применено

case uMsg of
WM_DESTROY: PostQuitMessage(0);
// ...
WM_ACTIVATE: SetFocus(Edit1);
WM_COMMAND:
begin
Result := 0;
if lParam = Button1 then
case wParam of
BN_CLICKED: Button1Click; //Клик по кнопке
else Result := DefWindowProc(hwnd, uMsg, wParam, lParam);
end;
end; // case: WM_COMMAND
// ...

else Result := DefWindowProc(hwnd, uMsg, wParam, lParam);
end;
end;

begin
HAppInstance := HInstance;

// Set up window class
with WndClass do begin
Style := 0;
lpfnWndProc := @WindowProc;
cbClsExtra := 0;
cbWndExtra := 0;
hInstance := HAppInstance;
hIcon := 0; //Иконка по умолчанию
hCursor := LoadCursor(0, IDC_ARROW); //курсор
hbrBackground := COLOR_WINDOW; //стандартный цвет формы
lpszMenuName := nil; // no menu resource
lpszClassName := 'TMainForm';
end; // with WndClass

Windows.RegisterClass(WndClass);

//Создание формы
MainForm := CreateWindow('TMainForm',
'APIDemoApplication - Jimmy Jonezz', //заголовок окна
WS_OVERLAPPEDWINDOW, //стандартный стиль окна
CW_USEDEFAULT, CW_USEDEFAULT, //позиция по дефолту
320, 200, //размер
0, //нет других окон
0, //нет меню
hInstance,
nil);

CreateControls; //Показываем
ShowWindow(MainForm, SW_SHOWNORMAL); //Показ окна формы

//Создание сообщения
while GetMessage(Msg, 0, 0, 0) <> BOOL(FALSE) do begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;

//Отчищаем

//Я не уверен, что это необходимо
DestroyWindow(Edit1);
DestroyWindow(Button1);
end.

Категория: Статьи по кодингу | Добавил: Jimmy (01.02.2008) | Автор: Jimmy Jonezz
Просмотров: 342 | Рейтинг: 0.0/0 |
Всего комментариев: 0
Имя *:
Email *:
Код *:
Форма входа
Поиск
Друзья сайта
Статистика

Онлайн всего: 1
Гостей: 1
Пользователей: 0