Category : Pascal Source Code
Archive   : WINFRN.ZIP
Filename : OPWINFRN.PAS

{$IFDEF Windows}
!! This unit is intended for DOS apps !!
{$ENDIF}

{$IFDEF Ver55}
!! This unit requires TP version 6 or later !!
{$ENDIF}

{*************************************************}
{* OPWINFRN.PAS 1.20 *}
{* Copyright TurboPower Software 1992 *}
{*************************************************}

unit OpWinFrn; {"Windows-friendly" support tools for DOS programs}

interface

{$IFDEF Dpmi} {!!.20 begin}
uses
Dpmi,
WinApi;

type
HiLo =
record
LoWord, HiWord : Word;
end;

SO =
record
O, S : Word;
end;
{$ENDIF} {!!.20 end}

type
{Windows 3.x types: not installed, running Real/Std mode, running Enhanced}
Win3ModeType = (NoWin, RealStd, Enhanced);

type
{record for DPMI version number}
DPMIVersRec =
record
Major, Minor : Word;
end;

const
{format codes for clipboard data types}
wcb_Text = 1;
wcb_Bitmap = 2;
wcb_MetaFile = 3;
wcb_SYLK = 4;
wcb_DIF = 5;
wcb_TIFF = 6;

var
DPMIVers : DPMIVersRec;
WindowsMode : Win3ModeType;

{Windows detection and sharing services...}

function CheckWin3 : Win3ModeType;
{-Determines whether Windows is running and, if so, what version}

function CheckWinOldApp : Boolean;
{-Determines whether the WINOLDAPP services are available}

procedure GetDPMIVers;
{-Get the version info for the current DPMI server}

procedure ReleaseTimeSlice;
{-Give up the current time slice; typically called in keybrd wait loops. If
your program has sections that sit in loops performing complex processing,
calling this service periodically will improve Windows' response to both
it and other running programs. This is especially critical in comm program
terminal loops and other loops that check KeyPressed each time through the
loop.}

procedure BeginCriticalSection;
{-Tell Windows that your process cannot be sliced out. WARNING: Do *NOT*
use this service unless your section *really* is critical, and then only
for the shortest possible time!}

procedure EndCriticalSection;
{-Tell Windows that you are finished with the critical code section}


{Windows clipboard data transfer tools...}

function OpenClipboard : Boolean;
{-Open clipboard; returns TRUE if clipboard available, FALSE otherwise}

procedure CloseClipboard;
{-Release clipboard when finished with it. Never leave the clipboard open
longer than absolutely nessessary.}

function ClearClipboard : Boolean;
{-Clear the contents of the clipboard}

function GetClipboardDataSize(Format : Word) : LongInt;
{-Returns the number of bytes needed to hold the contents of the clipboard}

function GetClipboardData(Format, BufLen : Word; var Buffer) : Boolean;
{-Gets the clipboard's contents. Buffer must be large enough to hold
GetClipboardDataSize bytes, and if compiled for pmode there must be
an equal amount of DOS real-mode memory available. Windows will
sometimes append trash to the end of the actual data, so be prepared
to clean up the returned data.}

function PutClipboardData(Format, BufLen : Word; var Buffer) : Boolean;
{-Put the contents of Buffer onto the clipboard.}

implementation

function CheckWin3 : Win3ModeType; Assembler;
asm
mov ax,1600h
int 2Fh
cmp al,1
jbe @@CheckRealStd
cmp al,80h
jae @@CheckRealStd
mov al,2
jmp @@ExitPoint
@@CheckRealStd:
mov ax,4680h
int 2Fh
or ax,ax
jnz @@NotWin
mov al,1
jmp @@ExitPoint
@@NotWin:
xor al,al
@@ExitPoint:
end;

function CheckWinOldApp : Boolean; Assembler;
asm
mov ax,1700h
int 2Fh
cmp ax,1700h
jne @@Yes
xor al,al
jmp @@Done
@@Yes:
mov al,1
@@Done:
end;

procedure ReleaseTimeSlice; Assembler;
asm
mov ax,1680h
int 2Fh
end;

procedure BeginCriticalSection; Assembler;
asm
mov ax,1681h
int 2Fh
end;

procedure EndCriticalSection; Assembler;
asm
mov ax,1682h
int 2Fh
end;

function OpenClipboard : Boolean; Assembler;
asm
mov ax,1701h
int 2Fh
cmp ax,0
je @@Done
mov ax,1
@@Done:
end;

procedure CloseClipboard; Assembler;
asm
mov ax,1708h
int 2Fh
xor ax,ax
end;

function ClearClipboard : Boolean; Assembler;
asm
mov ax,1702h
int 2Fh
cmp ax,0
je @@Done
mov ax,1
@@Done:
end;

function GetClipboardDataSize(Format : Word) : LongInt; Assembler;
asm
mov ax,1704h
mov dx,Format
int 2Fh
end;

{$IFDEF Dpmi} {!!.20 begin}

function GetClipboardData(Format, BufLen : Word; var Buffer) : Boolean;
{-the address passed in this routine must be a real-mode addr, so
we temporarily alloc a real-mode buffer. Be careful! - there is
a limited supply of DOS real-mode memory when running in pmode or
under Windows, so keep your clipboard contents as small as possible.}
var
R : DPMIRegisters;
P : Pointer;
L : LongInt;
begin
GetClipboardData := False;

{alloc real mode memory temporarily}
L := GlobalDosAlloc(BufLen);
if L = 0 then exit;
SO(P).S := HiLo(L).LoWord;
SO(P).O := 0;

{load DPMIRegisters with values}
FillChar(R, SizeOf(R), 0);
with R do begin
ax := $1705;
es := SO(P).S;
di := SO(P).O;
bx := di;
dx := Format;
end;

{go do the int}
SimulateRealModeInt($2F, R);

GetClipboardData := (R.ax <> 0);
if R.ax <> 0 then
Move(P^, Buffer, BufLen);
GlobalDosFree(HiLo(L).LoWord);
end;

function PutClipboardData(Format, BufLen : Word; var Buffer) : Boolean;
{-the address passed in this routine must be a real-mode addr, so
we temporarily alloc a real-mode buffer}
var
R : DPMIRegisters;
P : Pointer;
L : LongInt;
begin
PutClipboardData := False;

{alloc real mode memory temporarily}
L := GlobalDosAlloc(BufLen);
if L = 0 then exit;
SO(P).S := HiLo(L).LoWord;
SO(P).O := 0;
Move(Buffer, P^, BufLen);

{load DPMIRegisters with values}
FillChar(R, SizeOf(R), 0);
with R do begin
ax := $1703;
es := HiLo(L).HiWord;
di := 0;
bx := 0;
cx := BufLen;
dx := Format;
end;

{go do the int}
SimulateRealModeInt($2F, R);

PutClipboardData := (R.ax <> 0);

GlobalDosFree(HiLo(L).LoWord);
end;

{$ELSE} {!!.20 end}

function GetClipboardData(Format, BufLen : Word; var Buffer) : Boolean; Assembler;
asm
mov ax,1705h
les di,Buffer
mov bx,di
mov dx,Format
int 2Fh
cmp ax,0
je @@Done
mov ax,1
@@Done:
end;

function PutClipboardData(Format, BufLen : Word; var Buffer) : Boolean; Assembler;
asm
mov ax,1703h
mov dx,Format
les di,Buffer
mov bx,di
mov cx,BufLen
xor si,si
int 2Fh
cmp ax,0
je @@Done
mov ax,1
@@Done:
end;

{$ENDIF}

function DPMIPresent : Boolean; Assembler;
asm
mov ax,1687h
int 2Fh
not ax
end;

procedure GetDPMIVers; Assembler;
asm
mov ax,1686h
int 2Fh
cmp ax,0
jne @@Done
mov ax,0400h
int 31h
mov bx,ax
xchg bh,bl
xor bh,bh
xor ah,ah
mov DPMIVers.Major,bx
mov DPMIVers.Minor,ax
@@Done:
end;

begin
FillChar(DPMIVers, SizeOf(DPMIVers), 0);
WindowsMode := CheckWin3;
if DPMIPresent then
GetDPMIVers;
end.