Advertisement
Guest User

Untitled

a guest
Aug 27th, 2016
55
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.61 KB | None | 0 0
  1. const
  2. HighCursor = 13;
  3.  
  4. type
  5. TForm1 = class(TForm)
  6. Timer1: TTimer;
  7. Label1: TLabel;
  8. procedure FormCreate(Sender: TObject);
  9. procedure Timer1Timer(Sender: TObject);
  10. private
  11. FCursorHandles: array [0..HighCursor] of HCURSOR;
  12. public
  13. end;
  14.  
  15. var
  16. Form1: TForm1;
  17.  
  18. implementation
  19.  
  20. {$R *.dfm}
  21.  
  22. const
  23. OEMCursors: array [0..HighCursor] of Integer = (OCR_NORMAL, OCR_IBEAM,
  24. OCR_WAIT, OCR_CROSS, OCR_UP, OCR_SIZENWSE, OCR_SIZENESW, OCR_SIZEWE,
  25. OCR_SIZENS, OCR_SIZEALL, OCR_NO, OCR_HAND, OCR_APPSTARTING,
  26. 32651 {OCR_HELP?});
  27.  
  28. CursorNames: array [0..HighCursor] of string = ('OCR_NORMAL', 'OCR_IBEAM',
  29. 'OCR_WAIT', 'OCR_CROSS', 'OCR_UP', 'OCR_SIZENWSE', 'OCR_SIZENESW',
  30. 'OCR_SIZEWE', 'OCR_SIZENS', 'OCR_SIZEALL', 'OCR_NO', 'OCR_HAND',
  31. 'OCR_APPSTARTING', 'OCR_HELP');
  32.  
  33. procedure TForm1.FormCreate(Sender: TObject);
  34. var
  35. i: Integer;
  36. begin
  37. for i := 0 to HighCursor do
  38. FCursorHandles[i] := LoadImage(0, MakeIntResource(OEMCursors[i]),
  39. IMAGE_CURSOR, 0, 0, LR_DEFAULTCOLOR or LR_DEFAULTSIZE or LR_SHARED);
  40. end;
  41.  
  42. procedure TForm1.Timer1Timer(Sender: TObject);
  43.  
  44. function GetCursorName(Cursor: HCURSOR): string;
  45. var
  46. i: Integer;
  47. begin
  48. for i := 0 to HighCursor do
  49. if Cursor = FCursorHandles[i] then begin
  50. Result := CursorNames[i];
  51. Exit;
  52. end;
  53. Result := 'Unknown Cursor'; // A custom cursor.
  54. end;
  55.  
  56. var
  57. CursorInfo: TCursorInfo;
  58. begin
  59. CursorInfo.cbSize := SizeOf(CursorInfo);
  60. if GetCursorInfo(CursorInfo) then
  61. Label1.Caption := GetCursorName(CursorInfo.hCursor)
  62. else
  63. Label1.Caption := 'Fail: ' + SysErrorMessage(GetLastError);
  64. end;
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement