簡單的Windows API示例

原创 2003年11月13日 00:08:00

說明:
    一:新建一個工程,移除Form1。選擇Project/View source,拷貝下面的源代碼覆蓋已
有的代碼。保存(如:D:/Projects/Source/WinAPI/WinAPI.dpr)。
    二:新建WinAPI.inc文件到保存工程的目錄,用記事本打開,鍵入如下代碼:
        const
          cm_About    = 101; //此處一定要回車,否則BRCC32 編譯時不能通過
        保存(如:D:/Projects/Source/WinAPI/WinAPI.inc)。
    三:新建AddRes.rc文件到保存工程的目錄,用記事本打開,鍵入如下代碼:
        #include "WinAPI.inc"

        WndMenu MENU
        BEGIN
          POPUP "Help"
          BEGIN
            MENUITEM "&About", cm_About
          END
        END

        AboutDialog DIALOG 18, 18, 141, 58
        STYLE DS_MODALFRAME  | WS_POPUP | WS_CAPTION | WS_SYSMENU
        CAPTION "About"
        BEGIN
          PUSHBUTTON "OK", IDOK, 45, 40, 50, 12,
                           WS_CHILD | WS_VISIBLE | WS_TABSTOP
          CTEXT " Disigned by Swayi.F ", -1, 1, 9, 140, 8,
                           WS_CHILD | WS_VISIBLE | WS_GROUP    
        END
        保存。
        打開MS-DOS(Win9X: command; NT,2000: cmd)程序,輸入下列命令以編譯資源文件  BRCC32 -r FileName(如:D:/Projects/Source/WinAPI/addres.rc)回車。這時會在
你輸入的文件名路徑下產生一個叫AddRes.res的文件。這是程序正常運行需要用到的資源文件。
  四:編譯第一步保存的工程。運行。
    五:程序運行時,你可以按鍵,其鍵值或相應提示會在窗口上有顯示﹔在移動鼠標時嘗
試按住Shift, Ctrl,或左鍵,或右鍵,會顯示不同的顏色﹔雙擊﹔再嘗試調整窗口的大小看看效果。
  六:如有疑問,歡迎與我討論:
swayi@tom.com
       

program WinAPI;

uses
  Windows, Messages, SysUtils;

{$R *.RES}
{$R AddRes.res}
{$I WinAPI.inc}

const
  sCLS_NAME         = 'WinAPI';
  sSPACE            = '                    ';

  sERR_REGISTER     = 'Register instance failed.';
  sERR_CREAT        = 'Create instance failed.';

  sON_CHAR          = 'Char:  %s ;  Repeat:  %d.' + sSPACE;
  sON_SYS_KEY_DOWN  = 'Alt key:  %d ;  Repeat:  %d.' + sSPACE;
  sON_KEY_DOWN      = 'Key:  %d ;  Repeat:  %d.' + sSPACE;
  sON_MOUSE_MOVE    = 'XPos:  %d ;  YPos:  %d;  Flags:  %d' + sSPACE;
  sON_LBTN_DBL_CLK  = 'Double click pos:  %d,  %d;  Flags:  %d.' + sSPACE;

  sMSG_TITLE        = 'Window API program';
  sMSG_TEXT_OUT     = 'Press, move, double click and resize now! ';
  sMSG_DRAW_TEXT    = 'Printed out by DrawText.';
  sMSG_HOME         = 'Home key is pressed right now.' + sSPACE;
  sMSG_LEFT         = 'Left key is pressed right now.' + sSPACE;
  sMSG_DELETE       = 'Delete key is pressed right now.' + sSPACE;
  sMSG_LWIN         = 'Left Win key is pressed right now.' + sSPACE;
  sMSG_F1           = 'F1 key is pressed right now.' + sSPACE;

  nSYS_X            = 100;
  nSYS_Y            = 100;
  nWIDTH            = 500;
  nHEIGHT           = 360;
  nX                = 20;
  nY                = 40;
  nTOP              = 240;

var
  S: string;

procedure OnPaint(AHnd: HWND; var AMsg: TWMPaint);
var
  DC: HDC;
  AStruct: TPaintStruct;
  ARect: TRect;
  OldFont: HFont;
begin
  DC := BeginPaint(AHnd,AStruct);
  OldFont := SelectObject(DC, GetStockObject(SYSTEM_FIXED_FONT));
  GetClientRect(AHnd, ARect);
  SetBkMode(DC, TRANSPARENT);
  ARect.Top := nTOP;
  TextOut(DC, 5, 5, sMSG_TEXT_OUT, Length(sMSG_TEXT_OUT));
  DrawText(DC, sMSG_DRAW_TEXT, -1, ARect, DT_SINGLELINE or DT_RIGHT);
  SelectObject(DC, OldFont);
  EndPaint(AHnd, AStruct);
end;

procedure OnChar(AHnd: HWND; var AMsg: TWMChar);
var
  DC: HDC;
begin
  DC := GetDC(AHnd);
  S := Format(sON_CHAR, [Char(AMsg.CharCode), LoWord(AMsg.KeyData)]);
  SetBkColor(DC, GetSysColor(COLOR_BTNFACE));
  TextOut(DC, nX, nY, PChar(S), Length(S));
  ReleaseDC(AHnd, DC);
end;

procedure OnSysKeyDown(AHnd: HWND; var AMsg: TWMSysKeyDown);
var
  DC: HDC;
begin
  DC := GetDC(AHnd);
  S := Format(sON_SYS_KEY_DOWN, [AMsg.CharCode, LoWord(AMsg.KeyData)]);
  SetBkColor(DC, GetSysColor(COLOR_BTNFACE));
  TextOut(DC, nX, nY + 20, PChar(S), Length(S));
  ReleaseDC(AHnd, DC);
end;

procedure OnKeyDown(AHnd: HWND; var AMsg: TWMKeyDown);
var
  DC: HDC;
begin
  DC := GetDC(AHnd);
  case AMsg.CharCode of
    VK_HOME:      S := sMSG_HOME;
    VK_LEFT:      S := sMSG_LEFT;
    VK_DELETE:    S := sMSG_DELETE;
    VK_LWIN:      S := sMSG_LWIN;
    VK_F1:        S := sMSG_F1;
    else
      S := Format(sON_KEY_DOWN, [AMsg.CharCode, LoWord(AMsg.KeyData)]);
  end;
  SetBkColor(DC, GetSysColor(COLOR_BTNFACE));
  TextOut(DC, nX, nY + 40, PChar(S), Length(S));
  ReleaseDC(AHnd, DC);
end;

procedure OnMouseMove(AHnd: HWND; var AMsg: TWMMouseMove);
var
  DC: HDC;
begin
  DC := GetDC(AHnd);
  S := Format(sON_MOUSE_MOVE, [AMsg.XPos, AMsg.YPos, AMsg.Keys]);

  if ((AMsg.Keys and MK_CONTROL) = MK_CONTROL) then
    SetTextColor(DC, RGB(0, 0, 255));
  if ((AMsg.Keys and MK_LBUTTON) = MK_LBUTTON) then
    SetTextColor(DC, RGB(127, 127, 0));
  if ((AMsg.Keys and MK_RBUTTON) = MK_RBUTTON) then
    SetTextColor(DC, RGB(255, 0, 0));
  if ((AMsg.Keys and MK_SHIFT) = MK_SHIFT) then
    SetTextColor(DC, RGB(255, 0, 255));

  SetBkColor(DC, GetSysColor(COLOR_BTNFACE));
  TextOut(DC, nX, nY + 60, PChar(S), Length(S));
  ReleaseDC(AHnd, DC);
end;

procedure OnDblClk(AHnd: HWND; var AMsg: TWMLButtonDblClk);
var
  DC: HDC;
begin
  DC := GetDC(AHnd);
  S := Format(sON_LBTN_DBL_CLK, [AMsg.XPos, AMsg.YPos, AMsg.Keys]);
  SetBkColor(DC, GetSysColor(COLOR_BTNFACE));
  SetTextColor(DC, RGB(127, 127, 127));
  TextOut(DC, nX, nY + 80, PChar(S), Length(S));
  ReleaseDC(AHnd, DC);
end;

function WndAbout(HndAbout: HWND; AMsg, WParam, LParam: LongInt): BOOL; stdcall;
begin
  Result := True;
  case AMsg of
    WM_INITDIALOG: Exit;

    WM_COMMAND:
      if (WParam = idOK) or (WParam = idCancel) then
      begin
        EndDialog(HndAbout, 1);
        Exit;
      end;
  end;
  Result := False;
end;

function WndProc(HndWnd: HWND; AMsg, WParam, LParam: LongInt): LongInt; stdcall;
var
  AMessage: TMessage;
begin
  AMessage.Msg := AMsg;
  AMessage.WParam := WParam;
  AMessage.LParam := LParam;
  AMessage.Result := 0;

  case AMsg of
    WM_PAINT:         OnPaint(HndWnd, TWMPaint(AMessage));
    WM_CHAR:          OnChar(HndWnd, TWMChar(AMessage));
    WM_SYSKEYDOWN:    OnSysKeyDown(HndWnd, TWMSysKeyDown(AMessage));
    WM_KEYDOWN:       OnKeyDown(HndWnd, TWMKeyDown(AMessage));
    WM_MOUSEMOVE:     OnMouseMove(HndWnd, TWMMouseMove(AMessage));
    WM_LBUTTONDBLCLK: OnDblClk(HndWnd, TWMLButtonDblClk(AMessage));

    WM_COMMAND:
      if WParam = cm_About then
      begin
        DialogBox(HInstance, 'AboutDialog', HndWnd, @WndAbout);
        Result := DefWindowProc(HndWnd, AMsg, WParam, LParam);
        Exit;
      end;

    WM_DESTROY:       PostQuitMessage(WM_QUIT);
    else begin
      Result := DefWindowProc(HndWnd, AMsg, WParam, LParam);
      Exit;
    end;
  end;
  Result := AMessage.Result;
end;

function RegisterInstance: Boolean;
var
  AWndCls: TWndClass;
begin
  AWndCls.style := CS_VREDRAW or CS_HREDRAW or CS_DBLCLKS;
  AWndCls.lpfnWndProc := @WndProc;
  AWndCls.cbClsExtra := 0;
  AWndCls.cbWndExtra := 0;
  AWndCls.hInstance := HInstance;
  AWndCls.hIcon := LoadIcon(0, IDI_WINLOGO);
  AWndCls.hCursor := LoadCursor(0, IDC_ARROW);
  AWndCls.hbrBackground := HBrush(Color_Window);
  AWndCls.lpszMenuName := 'WndMenu';
  AWndCls.lpszClassName := sCLS_NAME;

  Result := RegisterClass(AWndCls) <> 0;
end;

function CreateInstance: THandle;
var
  AHnd: THandle;
begin
  AHnd := CreateWindow(sCLS_NAME, sMSG_TITLE, WS_OVERLAPPEDWINDOW, nSYS_X,
nSYS_Y,
                         nWIDTH, nHEIGHT, 0, 0, HInstance, nil);
  if AHnd <> 0 then
  begin
    ShowWindow(AHnd, SW_SHOW );
    UpdateWindow(AHnd);
  end;

  Result := AHnd;
end;


var
  AMsg: TMsg;
begin
  if not RegisterInstance then
  begin
    MessageBox(0, sERR_REGISTER, nil, MB_OK);
    Exit;
  end;

  if CreateInstance = 0 then
  begin
    MessageBox(0, sERR_CREAT, nil, MB_OK);
    Exit;
  end;

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

精简菜单和完整菜单之间进行切换

初始显示精简菜单: 点击显示全部品牌之后,将隐藏的品牌显示,并高亮显示推荐的品牌,并且此时按钮的文字变为“显示精简品牌” show you code: jquery test .c...
  • QianShouYuZhiBo
  • QianShouYuZhiBo
  • 2014年06月06日 09:29
  • 984

【图像处理】简单的图像处理软件

http://blog.sina.com.cn/s/blog_6df50e1a01019z95.html
  • ayuee1992
  • ayuee1992
  • 2014年08月08日 16:43
  • 313

Linux服务器教程之路5--ProFtpd服务器设置篇

引言:Linux下的ftp服务器的配置方法网上的教程很多,以下我选了一篇介绍ProFTPD的教程,这篇教程对入门者很有帮助。在此,先谢谢原文作者鸟哥:-)簡易 FTP Server 架設 -- ...
  • jwsh1984
  • jwsh1984
  • 2006年04月22日 20:10
  • 3054

异步编程Promise的简单实现

promise模式-那么多中异步编程的方式,为什么选择promise, 因为前面几种方式不够灵活,用起来不够痛快,不优雅。为了降低异步编程的复杂性,所以promise。promise的核心是有一个pr...
  • jl244981288
  • jl244981288
  • 2015年07月31日 10:14
  • 1176

超详细实用ExpandableListView教程(有图有真相)

先上效果图: 看到很多关于ExpandableListView的教程都是用一些简单的String[]字符串数组数据来填充列表项,这在实际项目运用中并不是很实用,下面容笔者来介绍一下如何高效有序地实用自...
  • sara_loveyou
  • sara_loveyou
  • 2013年05月02日 21:59
  • 1495

AR模型方法

AR模型是ORM方式的一种,其将SQL查询进行封装,使得数据库读写更加方便便捷。其中一个AR类代表数据库中的一张表。 1.类的定义(Model模型) 定义方式如下: class ...
  • wide288
  • wide288
  • 2014年04月24日 12:19
  • 1480

簡單示例,包括安裝,

.net Windows服务程序和安装程序制作图解(转)默认分类2010-05-24 16:55:05阅读46评论0  字号:大中小 订阅 最近项目中用到 window服务程序,以前没接触过,比较陌生...
  • Houluoxuan_168
  • Houluoxuan_168
  • 2010年11月11日 09:57
  • 323

簡單的橫向菜單

制作簡單方便的橫向菜單: function show(eo){     if (eo.style.display=="none"){         eo.style.display="block";...
  • kathyhan03
  • kathyhan03
  • 2007年08月16日 19:19
  • 309

JSP簡單文件管理

 相信下面幾個頁面很少有人愿意放到自己的網站上,寫出來僅供消遣了。 1.主頁面,List所有文件及文件夾%@ page language="java" contentType="text/html; ...
  • sunshinestation
  • sunshinestation
  • 2008年08月04日 11:43
  • 962

Python 簡單Singleton

class Singleton(object): instance = None def __init__(self): pass @classmethod def getIn...
  • jungle0127
  • jungle0127
  • 2014年05月06日 10:54
  • 466
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:簡單的Windows API示例
举报原因:
原因补充:

(最多只允许输入30个字)