home *** CD-ROM | disk | FTP | other *** search
/ Delphi Programming Unleashed / Delphi_Programming_Unleashed_SAMS_Publishing_1995.iso / misc / wintalk / wintalk.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1995-03-21  |  2.2 KB  |  140 lines
  1. program Talker;
  2.  
  3. { Copyright (c) 1995 by Charles Calvert }
  4. { Module: Talker }
  5.  
  6. { This DOS program is one half of suite of programs 
  7.   that show how a Windows program can talk to a DOS
  8.   program. Compile this program with BP7 or other 
  9.   DOS Pascal compiler before running the Windows
  10.   programming called TALKING. }
  11.  
  12. uses
  13.   Crt,
  14.   Strings;
  15.  
  16. function OpenClipBoard: Boolean; assembler;
  17. asm
  18.   mov ax, $1701
  19.   int $2f
  20. end;
  21.  
  22. function ClearClipBoard: Boolean; assembler;
  23. asm
  24.   mov ax, $1702
  25.   int $2f
  26. end;
  27.  
  28. function CloseClipBoard: Boolean; assembler;
  29. asm
  30.   mov ax, $1708
  31.   int $2f
  32. end;
  33.  
  34. function SetClipboardData(S: String): Boolean;
  35. var
  36.   S1: PChar;
  37.   Len: Integer;
  38. begin
  39.   Len := Length(S) + 1;
  40.   GetMem(S1, Len);
  41.   StrPCopy(S1, S);
  42.   asm
  43.     mov ax, $1703
  44.     mov dx, $1
  45.     mov si, 0
  46.     mov cx, Len
  47.     les bx, S1
  48.     int $2f
  49.   end;
  50.   FreeMem(S1, Len);
  51. end;
  52.  
  53. function GetClipboardDataSize: Integer; assembler;
  54. asm
  55.   mov ax, $1704
  56.   mov dx, 1
  57.   int $2f
  58. end;
  59.  
  60. procedure GetClipBoardData(var S: String; Size: Integer);
  61. var
  62.   S1: PChar;
  63. begin
  64.   GetMem(S1, Size);
  65.   asm
  66.     mov ax, $1705
  67.     mov dx, 1
  68.     les bx, S1
  69.     int $2f
  70.   end;
  71.   S := StrPas(S1);
  72.   FreeMem(S1, Size);
  73. end;
  74.  
  75. function IsWindowsThere: Boolean; assembler;
  76. asm
  77.   mov ax, $1700
  78.   int $2f
  79.   cmp ax, $1700
  80.   jne @@AOK
  81.   mov ax, 0
  82. @@AOK:
  83. end;
  84.  
  85. procedure Opening;
  86. begin
  87.   if not IsWindowsThere then begin
  88.     WriteLn('Windows must be loaded to run this program!');
  89.     Halt(1);
  90.   end;
  91. end;
  92.  
  93. procedure GetClipInfo;
  94. var
  95.   S: String;
  96. begin
  97.   OpenClipBoard;
  98.   GetClipboardData(S, GetClipBoardDataSize);
  99.   WriteLn('Windows says: ', S);
  100.   CloseClipboard;
  101. end;
  102. function GetInput: Char;
  103. var
  104.   Ch: Char;
  105. begin
  106.   repeat
  107.     Ch := ReadKey;
  108.   until Ch in ['1','2'];
  109.   GetInput := Ch;
  110. end;
  111.  
  112. procedure ReplyToWindows;
  113. var
  114.   S, S1: String;
  115.   Ch: Char;
  116. begin
  117.   OpenClipboard;
  118.   ClearClipBoard;
  119.   S := 'The elephant man''s giant parade!';
  120.   S1 := 'Laughable Trees';
  121.   WriteLn('1) ', S);
  122.   WriteLn('2) ', S1);
  123.   Write('Enter choice:');
  124.   Ch := GetInput;
  125.   if Ch = '1' then
  126.     SetClipBoardData(S)
  127.   else
  128.     SetClipBoardData(S1);
  129.   CloseClipBoard;
  130. end;
  131.  
  132. begin
  133.   Opening;
  134.   GetClipInfo;
  135.   ReplyToWindows;
  136. end.
  137.  
  138.  
  139.  
  140.