Delphi下使用Windows GDI绘图

来源:互联网 发布:网站编辑seo是什么 编辑:程序博客网 时间:2024/06/07 22:41
program Project1;uses  Winapi.Windows,  Winapi.Messages, System.Classes;function MyKeyDown(const Key : Integer): Boolean;begin  Result := GetAsyncKeyState(Key) <> 0;end;//callback fucntion//process the messagesfunction MyWndProc(hW: HWnd; messages: UInt; wParams: WPARAM; lParams: LPARAM): LRESULT; stdcall;var  ps : PAINTSTRUCT;  local_hdc : HDC;begin  Result := 0;  case messages of    WM_COMMAND:    begin    end;    WM_PAINT:    begin      local_hdc := BeginPaint(hW, ps);      EndPaint(hW, ps);    end;    WM_DESTROY:    begin      PostQuitMessage(0);    end  else    Result := DefWindowProc(hW, messages, wParams, lParams);  end;end;function MyRegisterClass(hInst : HINST): WORD;var  wclass: TWndClassExW;begin  //Don't forget to set all the properties, or you will failed to register  //you can use Structure 'TWndClassW' and register with function 'RegisterClassW'  wclass.cbSize := SizeOf(WNDCLASSEXW);                                 //set size of this structure  wclass.style := CS_HREDRAW or CS_VREDRAW;                             //set style of general property of this form  wclass.lpfnWndProc := @MyWndProc;                                     //callback function  wclass.cbClsExtra := 0;  wclass.cbWndExtra := 0;  wclass.hInstance := hInst;                                           //set instance  wclass.hIcon := LoadIcon(0, IDI_APPLICATION);  wclass.hCursor := LoadCursor(0, IDC_ARROW);  wclass.hbrBackground := GetStockObject(WHITE_BRUSH);  wclass.lpszMenuName := nil;  wclass.lpszClassName := 'Project';  wclass.hIconSm := LoadIcon(wclass.hInstance, MAKEINTRESOURCE(0));   //set small icon  Result := RegisterClassExW(wclass);end;var  gbl_hW : HWND;function InitInstance(hInst : HINST; nCmdShow : Integer): Boolean;var  hW : HWND;begin  Result := False;  hW := CreateWindowW('Project', 'ProjectOne', WS_OVERLAPPEDWINDOW,      CW_USEDEFAULT, 0, CW_USEDEFAULT, 0, 0, 0, hInst, nil);  if hW <> 0 then  begin    ShowWindow(hW, nCmdShow);    UpdateWindow(hW);    gbl_hW := hW;    Result := True;  end;end;{$R *.res}var  gbl_hInstance : HINST;  gbl_msg : MSG;  gbl_hdc : HDC;var  win_Rect : TRect;  i, x, y : Integer;  color : COLORREF;var  red_Pen : HPEN;  red_Soild_Brush : HBRUSH;  blue_Hatched_Brush : HBRUSH;  sideLen : Integer;  iRect : TRect;begin  gbl_hInstance := GetModuleHandle(nil);  //you can also use global variables HInstance in DELPHI  //HInstance will be initialized in procedure _InitExe(see it in the unit SysInit)  //like: if RegisterClass(HInstance) = 0 then  if MyRegisterClass(gbl_hInstance) = 0 then  begin    MessageBox(0, 'RegisterClass Error', 'Error', MB_OKCANCEL);    Exit;  end;  if not InitInstance(gbl_hInstance, SW_SHOW) then  begin    MessageBox(0, 'InitInstance Error', 'Error', MB_OKCANCEL);    Exit;  end;  //get graphics device context  gbl_hdc := GetDC(gbl_hW);  //create a pen with solid style and red color, one pixel wide  red_Pen := CreatePen(PS_SOLID, 1, RGB(255, 0, 0));  //select then pen into device context  SelectObject(gbl_hdc, red_Pen);  //two ways to create brush  //solid brush  red_Soild_Brush := CreateSolidBrush(RGB(255, 0, 0));  //hatched brush with vertical shadow line  blue_Hatched_Brush := CreateHatchBrush(HS_VERTICAL, RGB(0, 255, 0));  SelectObject(gbl_hdc, red_Soild_Brush);  //get size of form  GetWindowRect(gbl_hW, win_Rect);  Randomize;  //GetMessage will be wait a msg  while GetMessage(gbl_msg, 0, 0, 0) do  begin    TranslateMessage(gbl_msg);    DispatchMessage(gbl_msg);    if MyKeyDown(VK_ESCAPE) then      SendMessage(gbl_hW, WM_CLOSE, 0, 0);    for i := 0 to 100 do    begin      x := Random(1000) * (win_Rect.Right - win_Rect.Left) div 1000;      y := Random(1000) * (win_Rect.Bottom - win_Rect.Top) div 1000;      color := RGB(Random(1000) mod 255, Random(1000) mod 255, Random(1000) mod 255);      //plot a pixel      SetPixel(gbl_hdc, x, y, color);    end;    //plot a triangle    sideLen := Random(20);    MoveToEx(gbl_hdc, x, y, nil);    LineTo(gbl_hdc, x + sideLen, y - sideLen);    LineTo(gbl_hdc, x - sideLen, y - sideLen);    LineTo(gbl_hdc, x, y);    //plot a rectangle    sideLen := Random(30);    //plot a Solid rectangle    //Rectangle(gbl_hdc, x, y, x + sideLen, y + sideLen);    iRect := Rect(x, y, x + 100, y + 100);    //fill a Solid rectangle    //FillRect(gbl_hdc, iRect, red_Soild_Brush);    //draw a rect with brush    //notice we use HS_VERTICAL style,    //you might not be able to see the rectangle    FrameRect(gbl_hdc, iRect, blue_Hatched_Brush);    //or use temporary variable    FrameRect(gbl_hdc, iRect, CreateHatchBrush(HS_VERTICAL, RGB(0, 0, 255)));  end;  //destroy  DeleteObject(red_Pen);  DeleteObject(red_Soild_Brush);  ReleaseDC(gbl_hW, gbl_hdc);  //if you want to keep drawing all the time without  //do other operations to send message to queue,  //use while true with function PeekMessage  //see difference between 'GetMessage()' and 'PeekMessage()'end.

一些简单的注解都用英文写在代码里,边学好英语边学撸代码,不会的API看MSDN Helper,养成一个好习惯。

链接:https://social.msdn.microsoft.com/search/en-US/en_us?query=

原创粉丝点击