Переписываем уроки Iczelion'а о Win32 API на Delphi - Win Api

VladimirVB · 02.06.2012, 21:02

Урок 3. Простое окно --> http://wasm.ru/article.php?article=1001003

Код:

program u3;

uses
  Windows, Messages;
var
  wc: TWndClassEx;
  ps: TPaintStruct;
  MainWnd: HWND;
  Msg: TMsg;

const
  ClassName = 'SimpleWinClass';
  AppName = 'Our First Window';

function WindowProc(Wnd, Msg, WParam, LParam: Integer): Integer; stdcall;
begin
  Result := 0;
  case Msg of
    WM_DESTROY:
      PostQuitMessage(0);
  else
    Result := DefWindowProc(Wnd, Msg, WParam, LParam);
  end;
end;

begin
  wc.cbSize := SizeOf(TWndClassEx);
  wc.style := CS_VREDRAW or CS_HREDRAW;
  wc.lpfnWndProc := @WindowProc;
  wc.cbClsExtra := 0;
  wc.cbWndExtra := 0;
  wc.hInstance := HInstance;
  wc.hCursor := LoadCursor(0, IDC_ARROW);
  wc.hbrBackground := COLOR_WINDOW + 1;
  wc.lpszMenuName := nil;
  wc.lpszClassName := ClassName;
  wc.hIcon := LoadIcon(0, IDI_APPLICATION);

  if RegisterClassEx(wc) = 0 then Exit;

  MainWnd := CreateWindowEx(
                0,
                ClassName,
                AppName,
                WS_OVERLAPPEDWINDOW,
                Integer(CW_USEDEFAULT),
                Integer(CW_USEDEFAULT),
                Integer(CW_USEDEFAULT),
                Integer(CW_USEDEFAULT),
                0,
                0,
                HInstance,
                nil);

  ShowWindow(MainWnd, SW_SHOWNORMAL);
  UpdateWindow(MainWnd);

  while GetMessage(Msg, 0,0,0) do
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;

end.

VladimirVB · 02.06.2012, 21:07

Урок 4. Отрисовка текста --> http://wasm.ru/article.php?article=1001004

Код:

program u4;

uses
  Windows, Messages;
var
  wc: TWndClassEx;
  ps: TPaintStruct;
  MainWnd: HWND;
  Msg: TMsg;
  dc: HDC;
  rect: TRect;

const
  ClassName = 'SimpleWinClass';
  AppName = 'Our First Window';
  OurText = 'Win32 assembly is great and easy!';

function WindowProc(Wnd, Msg, WParam, LParam: Integer): Integer; stdcall;
begin
  Result := 0;
  case Msg of
    WM_DESTROY:
      PostQuitMessage(0);
    WM_PAINT: begin
      dc := BeginPaint(Wnd, ps); // сохранить контекст (дескриптор)
      GetClientRect(Wnd, rect);
      DrawText(dc, PChar(OurText), -1, rect, DT_SINGLELINE or DT_CENTER or DT_VCENTER);
      EndPaint(Wnd, ps);
    end
  else
    Result := DefWindowProc(Wnd, Msg, WParam, LParam);
  end;
end;

begin
  wc.cbSize := SizeOf(wc);
  wc.style := CS_VREDRAW or CS_HREDRAW;
  wc.lpfnWndProc := @WindowProc;
  wc.cbClsExtra := 0;
  wc.cbWndExtra := 0;
  wc.hInstance := HInstance;
  wc.hbrBackground := COLOR_WINDOW + 1;
  wc.hCursor := LoadCursor(0, IDC_ARROW);
  wc.hIcon := LoadIcon(0, IDI_APPLICATION);
  wc.hIconSm := wc.hIcon;
  wc.lpszMenuName := 0;
  wc.lpszClassName := ClassName;

  if RegisterClassEx(wc) = 0 then Exit;

  MainWnd := CreateWindowEx(0, ClassName, AppName, WS_OVERLAPPEDWINDOW,
    Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT),
    Integer(CW_USEDEFAULT), 0, 0, HInstance, nil);

  ShowWindow(MainWnd, SW_SHOWNORMAL);
  UpdateWindow(MainWnd);

  while GetMessage(Msg, 0,0,0) do
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;

end.

VladimirVB · 02.06.2012, 21:21

Урок 5. Больше о тексте --> http://wasm.ru/article.php?article=1001005

Код:

program u5;

uses
  Windows, Messages;
var
  wc: TWndClassEx;
  ps: TPaintStruct;
  MainWnd, hwFont, hwOld: HWND;
  Msg: TMsg;
  dc: HDC;

const
  ClassName = 'SimpleWinClass';
  AppName = 'Our First Window';
  TestString = 'Win32 assembly is great and easy!';

function WindowProc(Wnd, Msg, WParam, LParam: Integer): Integer; stdcall;
begin
  Result := 0;
  case Msg of
    WM_DESTROY:
      PostQuitMessage(0);
    WM_PAINT: begin
      dc := BeginPaint(Wnd, ps); // сохранить контекст (дескриптор)
      hwFont := CreateFont(24, 16, 0, 0, 400, 0, 0, 0, OEM_CHARSET, OUT_DEFAULT_PRECIS,
                            CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH or FF_SCRIPT,
                            'script');    
      hwOld := SelectObject(dc, hwFont);
      SetTextColor(dc, RGB(200, 200, 50)); //цвет текста
      SetBkColor(dc, RGB(0, 0, 255));  //цвет фона
      TextOut(dc, 0, 0, TestString, Length(TestString));
      SelectObject(dc, hwOld);
      EndPaint(Wnd, ps);
    end
  else
    Result := DefWindowProc(Wnd, Msg, WParam, LParam);
  end;
end;

begin
  wc.cbSize := SizeOf(wc);
  wc.style := CS_VREDRAW or CS_HREDRAW;
  wc.lpfnWndProc := @WindowProc;
  wc.cbClsExtra := 0;
  wc.cbWndExtra := 0;
  wc.hInstance := HInstance;
  wc.hbrBackground := COLOR_WINDOW + 1;
  wc.hCursor := LoadCursor(0, IDC_ARROW);
  wc.hIcon := LoadIcon(0, IDI_APPLICATION);
  wc.hIconSm := wc.hIcon;
  wc.lpszMenuName := 0;
  wc.lpszClassName := ClassName;

  if RegisterClassEx(wc) = 0 then Exit;

  MainWnd := CreateWindowEx(0, ClassName, AppName, WS_OVERLAPPEDWINDOW,
    Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT),
    Integer(CW_USEDEFAULT), 0, 0, HInstance, nil);

  ShowWindow(MainWnd, SW_SHOWNORMAL);
  UpdateWindow(MainWnd);

  while GetMessage(Msg, 0,0,0) do
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;

end.

VladimirVB · 02.06.2012, 21:25

Урок 6. Клавиатура --> http://wasm.ru/article.php?article=1001006

Код:

program u6;

uses
  Windows, Messages, SysUtils;
var
  wc: TWndClassEx;
  ps: TPaintStruct;
  MainWnd: HWND;
  Msg: TMsg;
  dc: HDC;
  ch: Char;

const
  ClassName = 'SimpleWinClass';
  AppName = 'Our First Window';

function WindowProc(Wnd, Msg, WParam, LParam: Integer): Integer; stdcall;
begin
  Result := 0;
  case Msg of
    WM_DESTROY:
      PostQuitMessage(0);
    WM_CHAR: begin
      ch := Chr(WParam);
      InvalidateRect(Wnd, nil, True);
    end;
    WM_PAINT: begin
      dc := BeginPaint(Wnd, ps); // сохранить контекст (дескриптор)
      TextOut(dc, 0, 0, @ch, 1);
      EndPaint(Wnd, ps);
    end
  else
    Result := DefWindowProc(Wnd, Msg, WParam, LParam);
  end;
end;

begin
  wc.cbSize := SizeOf(wc);
  wc.style := CS_VREDRAW or CS_HREDRAW;
  wc.lpfnWndProc := @WindowProc;
  wc.cbClsExtra := 0;
  wc.cbWndExtra := 0;
  wc.hInstance := HInstance;
  wc.hbrBackground := COLOR_WINDOW + 1;
  wc.hCursor := LoadCursor(0, IDC_ARROW);
  wc.hIcon := LoadIcon(0, IDI_APPLICATION);
  wc.hIconSm := wc.hIcon;
  wc.lpszMenuName := 0;
  wc.lpszClassName := ClassName;

  if RegisterClassEx(wc) = 0 then Exit;

  MainWnd := CreateWindowEx(0, ClassName, AppName, WS_OVERLAPPEDWINDOW,
    Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT),
    Integer(CW_USEDEFAULT), 0, 0, HInstance, nil);

  ShowWindow(MainWnd, SW_SHOWNORMAL);
  UpdateWindow(MainWnd);

  while GetMessage(Msg, 0,0,0) do
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;

end.

VladimirVB · 03.06.2012, 15:12

Урок 7. Мышь --> http://wasm.ru/article.php?article=1001007

Код:

program u7;

uses
  Windows, Messages, SysUtils;
var
  wc: TWndClassEx;
  ps: TPaintStruct;
  MainWnd: HWND;
  Msg: TMsg;
  dc: HDC;
  bMouseClick: Boolean = False;
  hitpoint: TPoint;

const
  ClassName = 'SimpleWinClass';
  AppName = 'Our First Window';

function WindowProc(Wnd, Msg, WParam, LParam: Integer): Integer; stdcall;
begin
  Result := 0;
  case Msg of
    WM_DESTROY:
      PostQuitMessage(0);
    WM_LBUTTONDOWN: begin
      hitpoint.X := $FFFF and LParam;
      hitpoint.Y := LParam shr 16;
      bMouseClick := True;
      InvalidateRect(MainWnd, nil, True);
    end;
    WM_PAINT: begin
      dc := BeginPaint(Wnd, ps); // сохранить контекст (дескриптор)
      if bMouseClick then
        TextOut(dc, hitpoint.X, hitpoint.Y, AppName, Length(AppName));
      EndPaint(Wnd, ps);
    end
  else
    Result := DefWindowProc(Wnd, Msg, WParam, LParam);
  end;
end;

begin
  wc.cbSize := SizeOf(wc);
  wc.style := CS_VREDRAW or CS_HREDRAW;
  wc.lpfnWndProc := @WindowProc;
  wc.cbClsExtra := 0;
  wc.cbWndExtra := 0;
  wc.hInstance := HInstance;
  wc.hbrBackground := COLOR_WINDOW + 1;
  wc.hCursor := LoadCursor(0, IDC_ARROW);
  wc.hIcon := LoadIcon(0, IDI_APPLICATION);
  wc.hIconSm := wc.hIcon;
  wc.lpszMenuName := 0;
  wc.lpszClassName := ClassName;

  if RegisterClassEx(wc) = 0 then Exit;

  MainWnd := CreateWindowEx(0, ClassName, AppName, WS_OVERLAPPEDWINDOW,
    Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT),
    Integer(CW_USEDEFAULT), 0, 0, HInstance, nil);

  ShowWindow(MainWnd, SW_SHOWNORMAL);
  UpdateWindow(MainWnd);

  while GetMessage(Msg, 0,0,0) do
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;

end.

VladimirVB · 03.06.2012, 18:28

Урок 8. Меню --> http://wasm.ru/article.php?article=1001008

Код:

program u8;

uses
  Windows, Messages, SysUtils;
var
  wc: TWndClassEx;
  MainWnd: HWND;
  Msg: TMsg;

const
  IDM_TEST = 1;
  IDM_HELLO = 2;
  IDM_GOODBYE = 3;
  IDM_EXIT = 4;
  ClassName = 'SimpleWinClass';
  AppName = 'Our First Window';
  MenuName = 'FirstMenu';

  Test_string = 'You selected Test menu item';
  Hello_string = 'Hello, my friend';
  Goodbye_string = 'See you again, bye';

{$R Menu.res} // <--------

function WindowProc(Wnd, Msg, WParam, LParam: Integer): Integer; stdcall;
begin
  Result := 0;
  case Msg of
    WM_DESTROY:
      PostQuitMessage(0);
    WM_COMMAND: begin
      case WParam of
        IDM_TEST: MessageBox(0, Test_string, AppName, MB_OK);
        IDM_HELLO: MessageBox(0, Hello_string, AppName, MB_OK);
        IDM_GOODBYE: MessageBox(0, Goodbye_string, AppName, MB_OK);
      else
        DestroyWindow(MainWnd);
      end;
    end
  else
    Result := DefWindowProc(Wnd, Msg, WParam, LParam);
  end;
end;

begin
  wc.cbSize := SizeOf(wc);
  wc.style := CS_VREDRAW or CS_HREDRAW;
  wc.lpfnWndProc := @WindowProc;
  wc.cbClsExtra := 0;
  wc.cbWndExtra := 0;
  wc.hInstance := HInstance;
  wc.hbrBackground := COLOR_WINDOW + 1;
  wc.hCursor := LoadCursor(0, IDC_ARROW);
  wc.hIcon := LoadIcon(0, IDI_APPLICATION);
  wc.hIconSm := wc.hIcon;
  wc.lpszMenuName := MenuName;   // <--------
  wc.lpszClassName := ClassName;

  if RegisterClassEx(wc) = 0 then Exit;

  MainWnd := CreateWindowEx(0, ClassName, AppName, WS_OVERLAPPEDWINDOW,
    Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT),
    Integer(CW_USEDEFAULT), 0, 0, HInstance, nil);

  ShowWindow(MainWnd, SW_SHOWNORMAL);
  UpdateWindow(MainWnd);

  while GetMessage(Msg, 0,0,0) do
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;

end.

Файл ресурса Menu.rc

Код:

FirstMenu MENU
{
      POPUP "&PopUp"
	{
          MENUITEM "&Say Hello", 2
          MENUITEM "Say &GoodBuy", 3
          MENUITEM SEPARATOR
          MENUITEM "E&xit", 4
      }
	
          MENUITEM "&Test", 1
}

Теперь, когда создан файл ресурса, вы должны скомпилировать его в файл .res, чтобы его можно было скомпоновать в исполняемый файл, Чтобы скомпилировать файл .rс, используйте компилятор ресурсов Resource Compiler (файл brсс32.ехе).

VladimirVB · 07.06.2012, 23:32

Урок 9. Дочерние окна --> http://wasm.ru/article.php?article=1001009

Код:

program u9;

uses
  Windows, Messages;

var
  wc: TWndClassEx;
  MainWnd, hwndButton, hwndEdit: THandle;
  Msg: TMsg;
  buffer: array[0..512] of Char; // buffer to store the text retrieved from the edit box

const
  ButtonID = 11;   // The control ID of the button control
  EditID = 12;     // The control ID of the edit control
  IDM_HELLO = 1;
  IDM_CLEAR = 2;
  IDM_GETTEXT = 3;
  IDM_EXIT = 4;

  ClassName = 'SimpleWinClass';
  AppName = 'Our First Window';
  MenuName = 'FirstMenu';
  ButtonClassName = 'button';
  ButtonText = 'My First Button';
  EditClassName = 'EDIT';
  TestString = 'Wow! I''m in an edit box now';

{$R menu.res}

function WindowProc(Wnd, Msg, WParam, LParam: Integer): Integer; stdcall;
begin
  Result := 0;
  case Msg of
    WM_DESTROY:
      PostQuitMessage(0);
    WM_CREATE: begin
      hwndEdit := CreateWindowEx(WS_EX_CLIENTEDGE, EditClassName, nil,
                                  WS_CHILD or WS_VISIBLE or WS_BORDER or ES_LEFT
                                  or ES_AUTOHSCROLL, 50, 35, 200, 25, Wnd,
                                  EditID, HInstance, nil);
      SetFocus(hwndEdit);
      hwndButton := CreateWindowEx(0, ButtonClassName, ButtonText,
                                  WS_CHILD or WS_VISIBLE or BS_DEFPUSHBUTTON,
                                  75, 70, 140, 25, Wnd, ButtonID, HInstance,
                                  nil);

    end;
    WM_COMMAND: begin
      if lParam = 0 then
        case wParam of
          IDM_HELLO: SetWindowText(hwndEdit, TestString);
          IDM_CLEAR: SetWindowText(hwndEdit, nil);
          IDM_GETTEXT:
            begin
              GetWindowText(hwndEdit, buffer, SizeOf(buffer));
              MessageBox(0, buffer, AppName, MB_OK);
            end
        else
          DestroyWindow(MainWnd);
        end
      else if WParam = ButtonID then
      begin
        WParam := WParam shr 16;
        if WParam = BN_CLICKED then
          SendMessage(MainWnd, WM_COMMAND, IDM_GETTEXT, 0);
      end;
    end
  else
    Result := DefWindowProc(Wnd, Msg, WParam, LParam);
  end;
end;

begin
  wc.cbSize := SizeOf(wc);
  wc.style := CS_VREDRAW or CS_HREDRAW;
  wc.lpfnWndProc := @WindowProc;
  wc.cbClsExtra := 0;
  wc.cbWndExtra := 0;
  wc.hInstance := HInstance;
  wc.hbrBackground := COLOR_WINDOW + 1;
  wc.hCursor := LoadCursor(0, IDC_ARROW);
  wc.hIcon := LoadIcon(0, IDI_APPLICATION);
  wc.hIconSm := wc.hIcon;
  wc.lpszMenuName := MenuName;
  wc.lpszClassName := ClassName;

  if RegisterClassEx(wc) = 0 then Exit;

  MainWnd := CreateWindowEx(WS_EX_CLIENTEDGE, ClassName, AppName, WS_OVERLAPPEDWINDOW,
    Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), 300,
    200, 0, 0, HInstance, nil);

  ShowWindow(MainWnd, SW_SHOWNORMAL);
  UpdateWindow(MainWnd);

  while GetMessage(Msg, 0,0,0) do
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;

end.

Файл ресурса Menu.rc

Код:

FirstMenu MENU
{
      POPUP "&PopUp"
	{
                 MENUITEM "&Say Hello", 1
                 MENUITEM "&Clear Edit Box", 2
                 MENUITEM "&Get Text", 3
                 MENUITEM SEPARATOR
                 MENUITEM "E&xit", 4
      }
}

Теперь, когда создан файл ресурса, вы должны скомпилировать его в файл .res, чтобы его можно было скомпоновать в исполняемый файл. Чтобы скомпилировать файл .rс, используйте компилятор ресурсов Resource Compiler (файл brсс32.ехе).

VladimirVB · 09.06.2012, 21:20

Урок 10. Диалоговое окно как основное --> http://wasm.ru/article.php?article=1001010

Код:

program u10;

uses
  Windows, Messages;

var
  wc: TWndClassEx;
  hDlg: THandle;
  Msg: TMsg;
  buffer: array[0..512] of Char;
  edx: Integer;

const
  IDC_EDIT = 3000;
  IDC_BUTTON = 3001;
  IDC_EXIT = 3002;
  IDM_GETTEXT = 32000;
  IDM_CLEAR = 32001;
  IDM_EXIT = 32002;

  ClassName = 'DLGCLASS';
  AppName = 'Our First Dialog Box';
  DlgName = 'MyDialog';
  MenuName = 'MyMenu';
  TestString = 'Wow! I''m in an edit box now';

{$R dialog.res}

function WindowProc(Wnd, Msg, WParam, LParam: Integer): Integer; stdcall;
begin
  Result := 0;
  case Msg of
    WM_DESTROY:
      PostQuitMessage(0);
    WM_COMMAND: begin
      if lParam = 0 then
        case wParam of
          IDM_CLEAR:
            SetDlgItemText(Wnd, IDC_EDIT, nil);
          IDM_GETTEXT:
            begin
              GetDlgItemText(Wnd, IDC_EDIT, buffer, SizeOf(buffer));
              MessageBox(0, buffer, AppName, MB_OK);
            end
        else
          DestroyWindow(Wnd);
        end
      else
      begin
        edx := WParam shr 16;
        if edx = BN_CLICKED then
          if WParam = IDC_BUTTON then
            SetDlgItemText(Wnd, IDC_EDIT, TestString)
          else if WParam = IDC_EXIT then
            SendMessage(Wnd, WM_COMMAND, IDM_EXIT, 0);
      end;
    end
  else
    Result := DefWindowProc(Wnd, Msg, WParam, LParam);
  end;
end;

begin
  wc.cbSize := SizeOf(wc);
  wc.style := CS_VREDRAW or CS_HREDRAW;
  wc.lpfnWndProc := @WindowProc;
  wc.cbClsExtra := 0;
  wc.cbWndExtra := DLGWINDOWEXTRA;
  wc.hInstance := HInstance;
  wc.hbrBackground := COLOR_BTNFACE + 1;
  wc.hCursor := LoadCursor(0, IDC_ARROW);
  wc.hIcon := LoadIcon(0, IDI_APPLICATION);
  wc.hIconSm := wc.hIcon;
  wc.lpszMenuName := MenuName;
  wc.lpszClassName := ClassName;

  if RegisterClassEx(wc) = 0 then Exit;
  hDlg := CreateDialogParam(HInstance, DlgName, 0, 0, 0);

  ShowWindow(hDlg, SW_SHOWNORMAL);
  UpdateWindow(hDlg);

  SetFocus(GetDlgItem(hDlg, IDC_EDIT));

  while GetMessage(Msg, 0,0,0) do
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;

end.

Файл ресурса dialog.rc

Код:

#define IDC_EDIT     3000
#define IDC_BUTTON   3001
#define IDC_EXIT     3002
#define IDM_GETTEXT  32000
#define IDM_CLEAR    32001
#define IDM_EXIT     32003


MyDialog DIALOG 10, 10, 205, 60

STYLE 0x0004 | DS_CENTER | WS_CAPTION | WS_MINIMIZEBOX |
WS_SYSMENU | WS_VISIBLE | WS_OVERLAPPED | DS_MODALFRAME | DS_3DLOOK

CAPTION "Our First Dialog Box"
CLASS "DLGCLASS"
{
       EDITTEXT         IDC_EDIT,   15,17,111,13, ES_AUTOHSCROLL | ES_LEFT
       DEFPUSHBUTTON   "Say Hello", IDC_BUTTON,    141,10,52,13
       PUSHBUTTON      "E&xit", IDC_EXIT,  141,26,52,13, WS_GROUP
}

MyMenu  MENU
{
       POPUP "Test Controls"
       {
           MENUITEM "Get Text", IDM_GETTEXT
           MENUITEM "Clear Text", IDM_CLEAR
           MENUITEM "", 0x0800
           MENUITEM "E&xit", IDM_EXIT
       }
  }

Теперь, когда создан файл ресурса, вы должны скомпилировать его в файл .res, чтобы его можно было скомпоновать в исполняемый файл. Чтобы скомпилировать файл .rс, используйте компилятор ресурсов Resource Compiler (файл brсс32.ехе).

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Переписываем уроки Iczelion'а о Win32 API на C	8Observer8	Win Api	25	15.09.2012 16:28
win32 API.Visual Studio 2008.Создание проекта Win32	Aleksandr_Yanov	Visual C++	2	12.09.2010 13:09
Win32 API. VS2008. Как создать приложение win32 в vs2008?	Aleksandr_Yanov	Visual C++	4	12.09.2010 00:59
Delphi win32 api отловить нажатие кнопок	revaldo666	Win Api	2	06.07.2010 01:14
[Win32 API/Delphi] Нужна помощь с combobox	ereality	Win Api	8	07.11.2009 22:48