home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue41 / Clinic / Modal2U2.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-11-30  |  12.4 KB  |  347 lines
  1. unit Modal2U2;
  2.  
  3. {$ifdef Ver80} { Delphi 1.0x }
  4.   {$define DelphiLessThan2}
  5.   {$define DelphiLessThan3}
  6.   {$define DelphiLessThan4}
  7.   {$define DelphiLessThan5}
  8. {$endif}
  9. {$ifdef Ver90} { Delphi 2.0x }
  10.   {$define DelphiLessThan3}
  11.   {$define DelphiLessThan4}
  12.   {$define DelphiLessThan5}
  13. {$endif}
  14. {$ifdef Ver93} { C++ Builder 1.0x }
  15.   {$define DelphiLessThan3}
  16.   {$define DelphiLessThan4}
  17.   {$define DelphiLessThan5}
  18. {$endif}
  19. {$ifdef Ver100} { Delphi 3.0x }
  20.   {$define DelphiLessThan4}
  21.   {$define DelphiLessThan5}
  22. {$endif}
  23. {$ifdef Ver110} { C++ Builder 3.0x }
  24.   {$define DelphiLessThan4}
  25.   {$define DelphiLessThan5}
  26. {$endif}
  27. {$ifdef Ver120} { Delphi 4.0x }
  28.   {$define DelphiLessThan5}
  29. {$endif}
  30.  
  31. interface
  32.  
  33. uses
  34.   WinTypes, WinProcs, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  35.   Dialogs, Buttons, StdCtrls, ExtCtrls;
  36.  
  37. type
  38.   TFrmModalForm = class(TForm)
  39.     Label1: TLabel;
  40.     SpeedButton1: TSpeedButton;
  41.     procedure SpeedButton1Click(Sender: TObject);
  42.   private
  43.     procedure DisplayKeyData(KeyData: Integer; CharCode: Word);
  44.     { Make sure we can see dialog-type keys }
  45.     procedure CMDialogKey(var Msg: TMessage); message cm_Dialogkey;
  46.     { Trap normal keys... }
  47.     procedure WMKeyDown(var Msg: TWMKeyDown); message wm_KeyDown;
  48.     { ...as well as Alt+ keys }
  49.     procedure WMSysKeyDown(var Msg: TWMSysKeyDown); message wm_SysKeyDown;
  50.   public
  51.     function ShowSystemModal: Integer;
  52.   end;
  53.  
  54. var
  55.   FrmModalForm: TFrmModalForm;
  56.  
  57. implementation
  58.  
  59. {$R *.DFM}
  60.  
  61. {$ifdef DelphiLessThan3}
  62. const
  63.   VK_KANA = 21;
  64.   VK_JUNJA = 23;
  65.   VK_FINAL = 24;
  66.   VK_HANJA = 25;
  67.   VK_KANJI = 25;
  68.   VK_CONVERT = 28;
  69.   VK_NONCONVERT = 29;
  70.   VK_ACCEPT = 30;
  71.   VK_MODECHANGE = 31;
  72.   VK_LWIN = 91;
  73.   VK_RWIN = 92;
  74.   VK_APPS = 93;
  75.   VK_LSHIFT = 160;
  76.   VK_RSHIFT = 161;
  77.   VK_LCONTROL = 162;
  78.   VK_RCONTROL = 163;
  79.   VK_LMENU = 164;
  80.   VK_RMENU = 165;
  81.   VK_PROCESSKEY = 229;
  82.   VK_ATTN = 246;
  83.   VK_CRSEL = 247;
  84.   VK_EXSEL = 248;
  85.   VK_EREOF = 249;
  86.   VK_PLAY = 250;
  87.   VK_ZOOM = 251;
  88.   VK_NONAME = 252;
  89.   VK_PA1 = 253;
  90.   VK_OEM_CLEAR = 254;
  91. {$endif}
  92.  
  93. function GetVirtualKeyName(VK: Byte): String;
  94. begin
  95.   case VK of
  96.     VK_LBUTTON: Result := 'VK_LBUTTON';       {1}
  97.     VK_RBUTTON: Result := 'VK_RBUTTON';       {2}
  98.     VK_CANCEL: Result := 'VK_CANCEL';         {3}
  99.     VK_MBUTTON: Result := 'VK_MBUTTON';       {4}
  100.     VK_BACK: Result := 'VK_BACK';             {8}
  101.     VK_TAB: Result := 'VK_TAB';               {9}
  102.     VK_CLEAR: Result := 'VK_CLEAR';           {12}
  103.     VK_RETURN: Result := 'VK_RETURN';         {13}
  104.     VK_SHIFT: Result := 'VK_SHIFT';           {16}
  105.     VK_CONTROL: Result := 'VK_CONTROL';       {17}
  106.     VK_MENU: Result := 'VK_MENU';             {18}
  107.     VK_PAUSE: Result := 'VK_PAUSE';           {19}
  108.     VK_CAPITAL: Result := 'VK_CAPITAL';       {20}
  109.     VK_KANA: Result := 'VK_KANA/VK_HANGUL';   {21}
  110.     VK_JUNJA: Result := 'VK_JUNJA';           {23}
  111.     VK_FINAL: Result := 'VK_FINAL';           {24}
  112.     VK_KANJI: Result := 'VK_HANJA/VK_KANJI';  {25}
  113.     VK_ESCAPE: Result := 'VK_ESCAPE';         {27}
  114.     VK_CONVERT: Result := 'VK_CONVERT';       {28}
  115.     VK_NONCONVERT: Result := 'VK_NONCONVERT'; {29}
  116.     VK_ACCEPT: Result := 'VK_ACCEPT';         {30}
  117.     VK_MODECHANGE: Result := 'VK_MODECHANGE'; {31}
  118.     VK_SPACE: Result := 'VK_SPACE';           {32}
  119.     VK_PRIOR: Result := 'VK_PRIOR';           {33}
  120.     VK_NEXT: Result := 'VK_NEXT';             {34}
  121.     VK_END: Result := 'VK_END';               {35}
  122.     VK_HOME: Result := 'VK_HOME';             {36}
  123.     VK_LEFT: Result := 'VK_LEFT';             {37}
  124.     VK_UP: Result := 'VK_UP';                 {38}
  125.     VK_RIGHT: Result := 'VK_RIGHT';           {39}
  126.     VK_DOWN: Result := 'VK_DOWN';             {40}
  127.     VK_SELECT: Result := 'VK_SELECT';         {41}
  128.     VK_PRINT: Result := 'VK_PRINT';           {42}
  129.     VK_EXECUTE: Result := 'VK_EXECUTE';       {43}
  130.     VK_SNAPSHOT: Result := 'VK_SNAPSHOT';     {44}
  131.     VK_INSERT: Result := 'VK_INSERT';         {45}
  132.     VK_DELETE: Result := 'VK_DELETE';         {46}
  133.     VK_HELP: Result := 'VK_HELP';             {47}
  134.     Ord('0'): Result := 'VK_0';               {48}
  135.     Ord('1'): Result := 'VK_1';               {49}
  136.     Ord('2'): Result := 'VK_2';               {50}
  137.     Ord('3'): Result := 'VK_3';               {51}
  138.     Ord('4'): Result := 'VK_4';               {52}
  139.     Ord('5'): Result := 'VK_5';               {53}
  140.     Ord('6'): Result := 'VK_6';               {54}
  141.     Ord('7'): Result := 'VK_7';               {55}
  142.     Ord('8'): Result := 'VK_8';               {56}
  143.     Ord('9'): Result := 'VK_9';               {57}
  144.     Ord('A'): Result := 'VK_A';               {65}
  145.     Ord('B'): Result := 'VK_B';               {66}
  146.     Ord('C'): Result := 'VK_C';               {67}
  147.     Ord('D'): Result := 'VK_D';               {68}
  148.     Ord('E'): Result := 'VK_E';               {69}
  149.     Ord('F'): Result := 'VK_F';               {70}
  150.     Ord('G'): Result := 'VK_G';               {71}
  151.     Ord('H'): Result := 'VK_H';               {72}
  152.     Ord('I'): Result := 'VK_I';               {73}
  153.     Ord('J'): Result := 'VK_J';               {74}
  154.     Ord('K'): Result := 'VK_K';               {75}
  155.     Ord('L'): Result := 'VK_L';               {76}
  156.     Ord('M'): Result := 'VK_M';               {77}
  157.     Ord('N'): Result := 'VK_N';               {78}
  158.     Ord('O'): Result := 'VK_O';               {79}
  159.     Ord('P'): Result := 'VK_P';               {80}
  160.     Ord('Q'): Result := 'VK_Q';               {81}
  161.     Ord('R'): Result := 'VK_R';               {82}
  162.     Ord('S'): Result := 'VK_S';               {83}
  163.     Ord('T'): Result := 'VK_T';               {84}
  164.     Ord('U'): Result := 'VK_U';               {85}
  165.     Ord('V'): Result := 'VK_V';               {86}
  166.     Ord('W'): Result := 'VK_W';               {87}
  167.     Ord('X'): Result := 'VK_X';               {88}
  168.     Ord('Y'): Result := 'VK_Y';               {89}
  169.     Ord('Z'): Result := 'VK_Z';               {90}
  170.     VK_LWIN: Result := 'VK_LWIN';             {91}
  171.     VK_RWIN: Result := 'VK_RWIN';             {92}
  172.     VK_APPS: Result := 'VK_APPS';             {93}
  173.     VK_NUMPAD0: Result := 'VK_NUMPAD0';       {96}
  174.     VK_NUMPAD1: Result := 'VK_NUMPAD1';       {97}
  175.     VK_NUMPAD2: Result := 'VK_NUMPAD2';       {98}
  176.     VK_NUMPAD3: Result := 'VK_NUMPAD3';       {99}
  177.     VK_NUMPAD4: Result := 'VK_NUMPAD4';       {100}
  178.     VK_NUMPAD5: Result := 'VK_NUMPAD5';       {101}
  179.     VK_NUMPAD6: Result := 'VK_NUMPAD6';       {102}
  180.     VK_NUMPAD7: Result := 'VK_NUMPAD7';       {103}
  181.     VK_NUMPAD8: Result := 'VK_NUMPAD8';       {104}
  182.     VK_NUMPAD9: Result := 'VK_NUMPAD9';       {105}
  183.     VK_MULTIPLY: Result := 'VK_MULTIPLY';     {106}
  184.     VK_ADD: Result := 'VK_ADD';               {107}
  185.     VK_SEPARATOR: Result := 'VK_SEPARATOR';   {108}
  186.     VK_SUBTRACT: Result := 'VK_SUBTRACT';     {109}
  187.     VK_DECIMAL: Result := 'VK_DECIMAL';       {110}
  188.     VK_DIVIDE: Result := 'VK_DIVIDE';         {111}
  189.     VK_F1: Result := 'VK_F1';                 {112}
  190.     VK_F2: Result := 'VK_F2';                 {113}
  191.     VK_F3: Result := 'VK_F3';                 {114}
  192.     VK_F4: Result := 'VK_F4';                 {115}
  193.     VK_F5: Result := 'VK_F5';                 {116}
  194.     VK_F6: Result := 'VK_F6';                 {117}
  195.     VK_F7: Result := 'VK_F7';                 {118}
  196.     VK_F8: Result := 'VK_F8';                 {119}
  197.     VK_F9: Result := 'VK_F9';                 {120}
  198.     VK_F10: Result := 'VK_F10';               {121}
  199.     VK_F11: Result := 'VK_F11';               {122}
  200.     VK_F12: Result := 'VK_F12';               {123}
  201.     VK_F13: Result := 'VK_F13';               {124}
  202.     VK_F14: Result := 'VK_F14';               {125}
  203.     VK_F15: Result := 'VK_F15';               {126}
  204.     VK_F16: Result := 'VK_F16';               {127}
  205.     VK_F17: Result := 'VK_F17';               {128}
  206.     VK_F18: Result := 'VK_F18';               {129}
  207.     VK_F19: Result := 'VK_F19';               {130}
  208.     VK_F20: Result := 'VK_F20';               {131}
  209.     VK_F21: Result := 'VK_F21';               {132}
  210.     VK_F22: Result := 'VK_F22';               {133}
  211.     VK_F23: Result := 'VK_F23';               {134}
  212.     VK_F24: Result := 'VK_F24';               {135}
  213.     VK_NUMLOCK: Result := 'VK_NUMLOCK';       {144}
  214.     VK_SCROLL: Result := 'VK_SCROLL';         {145}
  215.     VK_LSHIFT: Result := 'VK_LSHIFT';         {160}
  216.     VK_RSHIFT: Result := 'VK_RSHIFT';         {161}
  217.     VK_LCONTROL: Result := 'VK_LCONTROL';     {162}
  218.     VK_RCONTROL: Result := 'VK_RCONTROL';     {163}
  219.     VK_LMENU: Result := 'VK_LMENU';           {164}
  220.     VK_RMENU: Result := 'VK_RMENU';           {165}
  221.     $BA: Result := 'VK_SEMICOLON';            {186}
  222.     $BB: Result := 'VK_EQUALS';               {187}
  223.     $BC: Result := 'VK_COMMA';                {188}
  224.     $BD: Result := 'VK_HYPHEN';               {189}
  225.     $BE: Result := 'VK_PERIOD';               {190}
  226.     $BF: Result := 'VK_SLASH';                {191}
  227.     $C0: Result := 'VK_APOSTROPHE';           {192}
  228.     $DB: Result := 'VK_OPENSQUARE';           {219}
  229.     $DC: Result := 'VK_BACKSLASH';            {220}
  230.     $DD: Result := 'VK_CLOSESQUARE';          {221}
  231.     $DE: Result := 'VK_HASH';                 {222}
  232.     $DF: Result := 'VK_BACKAPOSTROPHE';       {223}
  233.     VK_PROCESSKEY: Result := 'VK_PROCESSKEY'; {229}
  234.     VK_ATTN: Result := 'VK_ATTN';             {246}
  235.     VK_CRSEL: Result := 'VK_CRSEL';           {247}
  236.     VK_EXSEL: Result := 'VK_EXSEL';           {248}
  237.     VK_EREOF: Result := 'VK_EREOF';           {249}
  238.     VK_PLAY: Result := 'VK_PLAY';             {250}
  239.     VK_ZOOM: Result := 'VK_ZOOM';             {251}
  240.     VK_NONAME: Result := 'VK_NONAME';         {252}
  241.     VK_PA1: Result := 'VK_PA1';               {253}
  242.     VK_OEM_CLEAR: Result := 'VK_OEM_CLEAR';   {254}
  243.   else Result := Format('Virtual key %d', [VK]);
  244.   end;
  245. end;
  246.  
  247. procedure TFrmModalForm.DisplayKeyData(KeyData: Integer; CharCode: Word);
  248. var
  249.   KeyNameC: array[0..255] of Char;
  250.   KeyName: String;
  251. begin
  252.   if GetKeyNameText(KeyData, KeyNameC, SizeOf(KeyNameC)) > 0 then
  253.     KeyName := StrPas(KeyNameC)
  254.   else
  255.     Keyname := IntToStr(CharCode);
  256.   Label1.Caption := Format(
  257.     '%s (%s) %d $%2:x',
  258.     [GetVirtualKeyName(Ord(CharCode)), KeyName, Ord(CharCode)]);
  259. end;
  260.  
  261. { Make sure we can see dialog-type keys, e.g. Tab and cursors }
  262. procedure TFrmModalForm.CMDialogKey(var Msg: TMessage);
  263. begin
  264.   Msg.Result := 0;
  265. end;
  266.  
  267. { Trap normal keys... }
  268. procedure TFrmModalForm.WMKeyDown(var Msg: TWMKeyDown);
  269. begin
  270.   DisplayKeyData(Msg.KeyData, Msg.CharCode);
  271.   inherited
  272. end;
  273.  
  274. { ...as well as Alt+ keys }
  275. procedure TFrmModalForm.WMSysKeyDown(var Msg: TWMSysKeyDown);
  276. begin
  277.   DisplayKeyData(Msg.KeyData, Msg.CharCode);
  278.   inherited
  279. end;
  280.  
  281. procedure SetKeyboardAndTaskbarSwitching(Enable: Boolean);
  282. var
  283.   OldVal: Bool;
  284. const
  285.   TaskBarWnd: HWnd = 0; { Task bar window handle }
  286.   ShowFlags: array[Boolean] of Integer = (sw_Hide, sw_ShowNoActivate);
  287. {$ifdef Windows}
  288.   spi_ScreenSaverRunning = 97;
  289. {$endif}
  290. begin
  291.   SystemParametersInfo(spi_ScreenSaverRunning, Word(not Enable), @OldVal, 0);
  292. {$ifdef Win32}
  293.   if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then
  294. {$else}
  295.   if GetWinFlags and $4000 = 0 then
  296. {$endif}
  297.   begin
  298.     if TaskBarWnd = 0 then
  299.       TaskBarWnd := FindWindow('Shell_TrayWnd', nil); { Find task bar }
  300.     ShowWindow(TaskBarWnd, ShowFlags[Enable]); { Hide/show task bar }
  301.   end
  302. end;
  303.  
  304. function TFrmModalForm.ShowSystemModal: Integer;
  305. var
  306.   Desktop: TForm;
  307.   DesktopDC: HDC;
  308. begin
  309.   Desktop := TForm.CreateNew(nil);
  310.   try
  311.     { Clear form seems to make less flicker }
  312.     Desktop.Brush.Style := bsClear;
  313.     Desktop.WindowState := wsMaximized;
  314.     Desktop.BorderStyle := bsNone;
  315.     DesktopDC := GetWindowDC(GetDesktopWindow);
  316.     try
  317.       with TImage.Create(Desktop) do
  318.       begin
  319.         Align := alClient;
  320.         Picture.Bitmap.Height := Screen.Height;
  321.         Picture.Bitmap.Width := Screen.Width;
  322.         BitBlt(Canvas.Handle, 0, 0, Screen.Width,
  323.           Screen.Height, DesktopDC, 0, 0, srcCopy);
  324.         Parent := Desktop;
  325.       end
  326.     finally
  327.       ReleaseDC(GetDesktopWindow, DesktopDC)
  328.     end;
  329.     Desktop.Show;
  330.     { Ensure when anyone clicks on what looks like }
  331.     { another window, all they get is a beep }
  332.     Desktop.Enabled := False;
  333.     SetKeyboardAndTaskbarSwitching(False);
  334.     Result := ShowModal;
  335.     SetKeyboardAndTaskbarSwitching(True)
  336.   finally
  337.     Desktop.Free
  338.   end;
  339. end;
  340.  
  341. procedure TFrmModalForm.SpeedButton1Click(Sender: TObject);
  342. begin
  343.   Close
  344. end;
  345.  
  346. end.
  347.