Пример приложений на чистом API

Пример приложений на чистом API

program SmallPrg;
uses
 Windows, Messages;
const
 WinName = 'MainWClass';
function MainWndProc(Window: HWnd; AMessage, WParam, LParam: Longint): Longint; stdcall;
begin
 //подпрограмма обработки сообщений
 case AMessage of
  WM_DESTROY:
  begin
  PostQuitMessage(0);
  Result := 0;
  Exit;
  end;
  else
  Result := DefWindowProc(Window, AMessage, WParam, LParam);
 end;
end;
function InitApplication: Boolean;
var
 wcx: TWndClass;
begin
 //Заполняем структуру TWndClass
 // перерисовываем, если размер изменяется
 wcx.style := CS_HREDRAW or CS_VREDRAW;
 // адрес оконной процедуры
 wcx.lpfnWndProc := @MainWndProc;
 wcx.cbClsExtra := 0;
 wcx.cbWndExtra := 0;
 // handle to instance
 wcx.hInstance := hInstance;
 // загружаем стандандартную иконку
 wcx.hIcon := LoadIcon(0, IDI_APPLICATION);
 // загружаем стандартный курсор
 wcx.hCursor := LoadCursor(0, IDC_ARROW);
 // делаем светло-cерый фон
 wcx.hbrBackground := COLOR_WINDOW;
 // пока нет главного меню
 wcx.lpszMenuName := nil;
 // имя класса окна
 wcx.lpszClassName := PChar(WinName);
 // Регистрируем наш класс окна.
 Result := RegisterClass(wcx) <> 0;
end;
function InitInstance: HWND;
begin
 // Создаем главное окно.
 Result := CreateWindow(
 // имя класса окна
 PChar(WinName),
 // заголовок
 'Small program',
 // стандартный стиль окна
 WS_OVERLAPPEDWINDOW,
 // стандартные горизонтальное, вертикальное положение, ширина и высота
 Integer(CW_USEDEFAULT),
 Integer(CW_USEDEFAULT),
 Integer(CW_USEDEFAULT),
 Integer(CW_USEDEFAULT),
 0,//нет родительского окна
 0,//нет меню
 hInstance, // handle to application instance
 nil); // no window-creation data
end;
var
 hwndMain: HWND;
 AMessage: msg;
begin
 if (not InitApplication) then
  MessageBox(0, 'Ошибка регистрации окна', nil, mb_Ok)
 else
 begin
  hwndMain := InitInstance;
  if (hwndMain = 0) then
  MessageBox(0, 'Ошибка создания окна', nil, mb_Ok)
  else
  begin
  // Показываем окно и посылаем сообщение WM_PAINT оконной процедуре
  ShowWindow(hwndMain, CmdShow);
  UpdateWindow(hwndMain);
  while (GetMessage(AMessage, 0, 0, 0)) do
  begin
  TranslateMessage(AMessage);
  DispatchMessage(AMessage);
  end;
  end;
 end;
end.

http://delphiworld.narod.ru/ DelphiWorld 6.0

program WinMin;
uses Windows, Messages;
const AppName = 'WinMin';
Var
Window : HWnd;
Message : TMsg;
WindowClass : TWndClass;
function WindowProc (Window : HWnd; Message, WParam : Word; LParam : LongInt) : LongInt; stdcall;
begin
WindowProc := 0;
case Message of
wm_Destroy :begin
PostQuitMessage (0);
Exit;
end;
end; // case
WindowProc := DefWindowProc (Window, Message, WParam, LParam);
end;
begin
with WindowClass do
begin
Style := cs_HRedraw or cs_VRedraw;
lpfnWndProc := @WindowProc;
cbClsExtra := 0;
cbWndExtra := 0;
hInstance := 0;
hIcon := LoadIcon (0, idi_Application);
hCursor := LoadCursor (0, idc_Arrow);
hbrBackground := GetStockObject (White_Brush);
lpszMenuName := '';
lpszClassName := AppName;
end;
If RegisterClass (WindowClass) = 0 then Halt (255);
Window := CreateWindow(AppName,
'Win_Min',
ws_OverlappedWindow,
cw_UseDefault,
cw_UseDefault,
cw_UseDefault,
cw_UseDefault,
0,
0,
HInstance,
nil);
ShowWindow (Window, CmdShow);
UpdateWindow (Window);
while GetMessage (Message, 0, 0, 0) do
begin
TranslateMessage (Message);
DispatchMessage (Message);
end;
Halt
end.

М. Краснов. "OpenGL и графика в проектах Delphi".
Пример прислан Spawn
Взято с Vingrad.ru http://forum.vingrad.ru
В этом выпуске мы попробуем написать с Вами программу, которая не будет пользоваться VCL, а будет использовать вызовы функций Windows API. Приложения такого типа нужны, когда размер исполняемого файла является критичным. Например, в инсталяторах, деинсталяторах, самораспаковывающихся архивах и т.п. В крайнем случае, для того чтобы посмотреть какую работу выполняет за нас VCL, и что из себя представляет Windows-программа. На самом деле все очень просто...
Для этого нам необходимо:

// 1. Зарегистрировать класс окна для окна главной формы.
function InitApplication: Boolean;
var
 wcx: TWndClass;
begin
//Заполняем структуру TWndClass
  // перерисовываем, если размер изменяется
  wcx.style := CS_HREDRAW or CS_VREDRAW;
  // адрес оконной процедуры
  wcx.lpfnWndProc := @MainWndProc;
  wcx.cbClsExtra := 0;
  wcx.cbWndExtra := 0;
  // handle to instance
  wcx.hInstance := hInstance;
  // загружаем стандандартную иконку
  wcx.hIcon := LoadIcon(0, IDI_APPLICATION);
  // загружаем стандартный курсор
  wcx.hCursor := LoadCursor(0, IDC_ARROW);
  // делаем светло-cерый фон
  wcx.hbrBackground := COLOR_WINDOW;
  // пока нет главного меню
  wcx.lpszMenuName := nil;
  // имя класса окна
  wcx.lpszClassName := PChar(WinName);
  // Регистрируем наш класс окна.
  Result := RegisterClass(wcx) <> 0;
end;
// 2. Написать подпрограмму обработки оконных сообщений.
function MainWndProc(Window: HWnd; AMessage, WParam,
  LParam: Longint): Longint; stdcall; export;
begin
 //подпрограмма обработки сообщений
 case AMessage of
  WM_DESTROY: begin
  PostQuitMessage(0);
  Exit;
  end;
  else
  Result := DefWindowProc(Window, AMessage, WParam, LParam);
 end;
end;

// 3. Создать главное окно приложения.
function InitInstance: HWND;
begin
 // Создаем главное окно.
 Result := CreateWindow(
  // имя класса окна
  PChar(WinName),
  // заголовок
  'Small program',
  // стандартный стиль окна
  WS_OVERLAPPEDWINDOW,
  // стандартные горизонтальное, вертикальное положение, ширина и высота
  Integer(CW_USEDEFAULT),
  Integer(CW_USEDEFAULT),
  Integer(CW_USEDEFAULT),
  Integer(CW_USEDEFAULT),
  0,//нет родительского окна
  0,//нет меню
  hInstance, // handle to application instance
  nil); // no window-creation data
end;

// 4. Написать тело программы.
var
 hwndMain: HWND;
 AMessage: msg;
begin
  if (not InitApplication) then
  begin
  MessageBox(0, 'Ошибка регистрации окна', nil, mb_Ok);
  Exit;
  end;
  hwndMain := InitInstance;
  if (hwndMain = 0) then
  begin
  MessageBox(0, 'Ошибка создания окна', nil, mb_Ok);
  Exit;
  end
  else
  begin
  // Показываем окно и посылаем сообщение WM_PAINT оконной процедуре
  ShowWindow(hwndMain, CmdShow);
  UpdateWindow(hwndMain);
  end;
  while (GetMessage(AMessage, 0, 0, 0)) do
  begin
  //Запускаем цикл обработки сообщений
  TranslateMessage(AMessage);
  DispatchMessage(AMessage);
  end;
  Halt(AMessage.wParam);
end.
// 5. Запустить программу на исполнение. ;)

Наша программа пока только может немногое - отображать форму, и закрываться после нажатия на кнопку закрытия формы... Но посмотрите на размер исполняемого файла - он больше чем на порядок меньше созданного с использованием VCL. Кроме того теперь у нас есть скелет приложения, возможности которого мы будем расширять в следующих выпусках.
Здесь находится полный текст программы.

program SmallPrg;

uses Windows, Messages;

const

 WinName = 'MainWClass';

function MainWndProc(Window: HWnd; AMessage, WParam,

  LParam: Longint): Longint; stdcall; export;

begin

 //подпрограмма обработки сообщений

 case AMessage of

  WM_DESTROY: begin

  PostQuitMessage(0);

  Exit;

  end;

  else

  Result := DefWindowProc(Window, AMessage, WParam, LParam);

 end;

end;

function InitApplication: Boolean;

var

 wcx: TWndClass;

begin

//Заполняем структуру TWndClass

  // перерисовываем, если размер изменяется

  wcx.style := CS_HREDRAW or CS_VREDRAW;

  // адрес оконной процедуры

  wcx.lpfnWndProc := @MainWndProc;

  wcx.cbClsExtra := 0;

  wcx.cbWndExtra := 0;

  // handle to instance

  wcx.hInstance := hInstance;

  // загружаем стандандартную иконку

  wcx.hIcon := LoadIcon(0, IDI_APPLICATION);

  // загружаем стандартный курсор

  wcx.hCursor := LoadCursor(0, IDC_ARROW);

  // делаем светло-cерый фон

  wcx.hbrBackground := COLOR_WINDOW;

  // пока нет главного меню

  wcx.lpszMenuName := nil;

  // имя класса окна

  wcx.lpszClassName := PChar(WinName);

  // Регистрируем наш класс окна.

  Result := RegisterClass(wcx) <> 0;

end;

function InitInstance: HWND;

begin

 // Создаем главное окно.

 Result := CreateWindow(

  // имя класса окна

  PChar(WinName),

  // заголовок

  'Small program',

  // стандартный стиль окна

  WS_OVERLAPPEDWINDOW,

  // стандартные горизонтальное, вертикальное положение, ширина и высота

  Integer(CW_USEDEFAULT),

  Integer(CW_USEDEFAULT),

  Integer(CW_USEDEFAULT),

  Integer(CW_USEDEFAULT),

  0,//нет родительского окна

  0,//нет меню

  hInstance, // handle to application instance

  nil); // no window-creation data

end;

var

 hwndMain: HWND;

 AMessage: msg;

begin

  if (not InitApplication) then

  begin

  MessageBox(0, 'Ошибка регистрации окна', nil, mb_Ok);

  Exit;

  end;

  hwndMain := InitInstance;

  if (hwndMain = 0) then

  begin

  MessageBox(0, 'Ошибка создания окна', nil, mb_Ok);

  Exit;

  end

  else

  begin

  // Показываем окно и посылаем сообщение WM_PAINT оконной процедуре

  ShowWindow(hwndMain, CmdShow);

  UpdateWindow(hwndMain);

  end;

  while (GetMessage(AMessage, 0, 0, 0)) do

  begin

  //Запускаем цикл обработки сообщений

  TranslateMessage(AMessage);

  DispatchMessage(AMessage);

  end;

  Halt(AMessage.wParam);

end.

http://delphiworld.narod.ru/
DelphiWorld 6.0

Построение формы на чистом API

program PlainAPI;

uses

 Windows,

 Messages;

{$R *.res}

function PlainWinProc (hWnd: THandle; nMsg: UINT;

 wParam, lParam: Cardinal): Cardinal; export; stdcall;

var

 hdc: THandle;

 ps: TPaintStruct;

begin

 Result := 0;

 case nMsg of

  wm_lButtonDown:

  MessageBox (hWnd, 'Mouse Clicked',

  'Plain API', MB_OK);

  wm_Paint:

  begin

  hdc := BeginPaint (hWnd, ps);

  Ellipse (hdc, 100, 100, 300, 300);

  EndPaint (hWnd, ps);

  end;

  wm_Destroy:

  PostQuitMessage (0);

  else

  Result := DefWindowProc (hWnd, nMsg, wParam, lParam);

 end;

end;

procedure WinMain;

var

 hWnd: THandle;

 Msg: TMsg;

 WndClassEx: TWndClassEx;

begin

 // initialize the window class structure

 WndClassEx.cbSize := sizeOf (TWndClassEx);

 WndClassEx.lpszClassName := 'PlainWindow';

 WndClassEx.style := cs_VRedraw or cs_HRedraw;

 WndClassEx.hInstance := HInstance;

 WndClassEx.lpfnWndProc := @PlainWinProc;

 WndClassEx.cbClsExtra := 0;

 WndClassEx.cbWndExtra := 0;

 WndClassEx.hIcon := LoadIcon (hInstance,

  MakeIntResource ('MAINICON'));

 WndClassEx.hIconSm := LoadIcon (hInstance,

  MakeIntResource ('MAINICON'));

 WndClassEx.hCursor := LoadCursor (0, idc_Arrow);;

 WndClassEx.hbrBackground := GetStockObject (white_Brush);

 WndClassEx.lpszMenuName := nil;

 // register the class

 if RegisterClassEx (WndClassEx) = 0 then

  MessageBox (0, 'Invalid class registration',

  'Plain API', MB_OK)

 else

 begin

  hWnd := CreateWindowEx (

  ws_Ex_OverlappedWindow, // extended styles

  WndClassEx.lpszClassName, // class name

  'Plain API Demo', // title

  ws_OverlappedWindow, // styles

  cw_UseDefault, 0, // position

  cw_UseDefault, 0, // size

  0, // parent window

  0, // menu

  HInstance, // instance handle

  nil); // initial parameters

  if hWnd = 0 then

  MessageBox (0, 'Window not created',

  'Plain API', MB_OK)

  else

  begin

  ShowWindow (hWnd, sw_ShowNormal);

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

  begin

  TranslateMessage (Msg);

  DispatchMessage (Msg);

  end;

  end;

 end;

end;

begin

 WinMain;

end.

http://delphiworld.narod.ru/
DelphiWorld 6.0
// Put this code in your Project file (*.dpr).

program Project1;

 uses

  windows, messages;



 // Main Window Procedure

function MainWndProc(hWindow: HWND; Msg: UINT; wParam: wParam;

  lParam: lParam): LRESULT; stdcall; export;

 var

  ps: TPaintStruct;

 begin

  Result := 0;

  case Msg of

  WM_PAINT:

  begin

  BeginPaint(hWindow, ps);

  SetBkMode(ps.hdc, TRANSPARENT);

  TextOut(ps.hdc, 10, 10, 'Hello, World!', 13);

  EndPaint(hWindow, ps);

  end;

  WM_DESTROY: PostQuitMessage(0);

  else

  begin

  Result := DefWindowProc(hWindow, Msg, wParam, lParam);

  Exit;

  end;

  end;

 end;

 // Main Procedure

var

  wc: TWndClass;

  hWindow: HWND;

  Msg: TMsg;

 begin

  wc.lpszClassName := 'YourAppClass';

  wc.lpfnWndProc := @MainWndProc;

  wc.Style := CS_VREDRAW or CS_HREDRAW;

  wc.hInstance := hInstance;

  wc.hIcon := LoadIcon(0, IDI_APPLICATION);

  wc.hCursor := LoadCursor(0, IDC_ARROW);

  wc.hbrBackground := (COLOR_WINDOW + 1);

  wc.lpszMenuName := nil;

  wc.cbClsExtra := 0;

  wc.cbWndExtra := 0;

  RegisterClass(wc);

  hWindow := CreateWindowEx(WS_EX_CONTROLPARENT or WS_EX_WINDOWEDGE,

  'YourAppClass',

  'API',

  WS_VISIBLE or WS_CLIPSIBLINGS or

  WS_CLIPCHILDREN or WS_OVERLAPPEDWINDOW,

  CW_USEDEFAULT, 0,

  400, 300,

  0,

  0,

  hInstance,

  nil);

  ShowWindow(hWindow, CmdShow);

  UpDateWindow(hWindow);

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

  begin

  TranslateMessage(Msg);

  DispatchMessage(Msg);

  end;

  Halt(Msg.wParam);

 end.

http://delphiworld.narod.ru/
DelphiWorld 6.0

Создание формы и кнопки на чистом API

program Plain2;

uses

 Windows,

 Messages;

const

 id_Button = 100;

function PlainWinProc (hWnd: THandle; nMsg: UINT;

 wParam, lParam: Cardinal): Cardinal; export; stdcall;

var

 Rect: TRect;

begin

 Result := 0;

 case nMsg of

  wm_Create:

  // create button

  CreateWindowEx (0, // extended styles

  'BUTTON', // predefined class

  '&Click here', // caption

  ws_Child or ws_Visible or ws_Border

  or bs_PushButton, // styles

  0, 0, // position: see wm_Size

  200, 80, // size

  hwnd, // parent

  id_Button, // identifier (not a menu handle)

  hInstance, // application id

  nil); // init info pointer

  wm_Size:

  begin

  // get the size of the client window

  GetClientRect (hWnd, Rect);

  // move the button window

  SetWindowPos (

  GetDlgItem (hWnd, id_Button), // button handle

  0, // zOrder

  Rect.Right div 2 - 100,

  Rect.Bottom div 2 - 40,

  0, 0, // new size

  swp_NoZOrder or swp_NoSize);

  end;

  wm_Command:

  // if it comes from the button

  if LoWord (wParam) = id_Button then

  // if it is a click

  if HiWord (wParam) = bn_Clicked then

  MessageBox (hWnd, 'Button Clicked',

  'Plain API 2', MB_OK);

  wm_Destroy:

  PostQuitMessage (0);

  else

  Result := DefWindowProc (hWnd, nMsg, wParam, lParam);

 end;

end;

procedure WinMain;

var

 hWnd: THandle;

 Msg: TMsg;

 WndClassEx: TWndClassEx;

begin

 // initialize the window class structure

 WndClassEx.cbSize := sizeOf (TWndClassEx);

 WndClassEx.lpszClassName := 'PlainWindow';

 WndClassEx.style := cs_VRedraw or cs_HRedraw;

 WndClassEx.hInstance := HInstance;

 WndClassEx.lpfnWndProc := @PlainWinProc;

 WndClassEx.cbClsExtra := 0;

 WndClassEx.cbWndExtra := 0;

 WndClassEx.hIcon := LoadIcon (hInstance,

  MakeIntResource ('MAINICON'));

 WndClassEx.hIconSm := LoadIcon (hInstance,

  MakeIntResource ('MAINICON'));

 WndClassEx.hCursor := LoadCursor (0, idc_Arrow);;

 WndClassEx.hbrBackground := GetStockObject (white_Brush);

 WndClassEx.lpszMenuName := nil;

 // register the class

 if RegisterClassEx (WndClassEx) = 0 then

  MessageBox (0, 'Invalid class registration',

  'Plain API', MB_OK)

 else

 begin

  hWnd := CreateWindowEx (

  ws_Ex_OverlappedWindow, // extended styles

  WndClassEx.lpszClassName, // class name

  'Plain API Demo', // title

  ws_OverlappedWindow, // styles

  cw_UseDefault, 0, // position

  cw_UseDefault, 0, // size

  0, // parent window

  0, // menu

  HInstance, // instance handle

  nil); // initial parameters

  if hWnd = 0 then

  MessageBox (0, 'Window not created',

  'Plain API', MB_OK)

  else

  begin

  ShowWindow (hWnd, sw_ShowNormal);

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

  begin

  TranslateMessage (Msg);

  DispatchMessage (Msg);

  end;

  end;

 end;

end;

begin

 WinMain;

end.

http://delphiworld.narod.ru/
DelphiWorld 6.0

Отправить комментарий

Проверка
Антиспам проверка
Image CAPTCHA
...