Пример приложений на чистом API
Материал из DRKB
Пример приложений на чистом API[править | править код]
Написание программ на чистом WinAPI
ID: 02016
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;
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.
Пример прислан Spawn
Author: М. Краснов. "OpenGL и графика в проектах Delphi".
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 02015
Построение формы на чистом 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.
Source: http://delphiworld.narod.ru/
ID: 02017
Создание формы и кнопки на чистом 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.
Source: http://delphiworld.narod.ru/
ID: 02019
// 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.
Source: http://delphiworld.narod.ru/
ID: 02018