unit ClipBrd;

{ Unit Clipboard, Version 1.10,
  Copyright 1994,1997 Matthias K"oppe.

  $Id: clipbrd.pas 1.3 1999/02/09 11:13:46 mkoeppe Exp $
 
  This library is free software; you can redistribute it and/or
  modify it under the terms of the GNU Library General Public
  License as published by the Free Software Foundation; either
  version 2 of the License, or (at your option) any later version.

  This library is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  Library General Public License for more details.

  You should have received a copy of the GNU Library General Public
  License along with this library; if not, write to the Free
  Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
}

{$G+,X+}

interface

{ Clipboard format identifiers
}
const
  cf_Text         = 1;
  cf_Bitmap       = 2;
  cf_MetaFilePict = 3;
  cf_SYLK         = 4;
  cf_DIF          = 5;
  cf_TIFF         = 6;
  cf_OEMText      = 7;
  cf_DIB          = 8;
  cf_Palette      = 9;

{ Clipboard functions
}
function OpenClipboard: Boolean;
function CloseClipboard: Boolean;
function EmptyClipboard: Boolean;
function SetClipboardData(Format: Word; var Data; Size: LongInt): Boolean;
function GetClipboardDataSize(Format: Word): LongInt;
function GetClipboardData(Format: Word; var Data): Boolean;
function PeekClipboardDataSize(Format: Word): LongInt;

{ Emulation control
}
procedure ForceEmulation;

{ WinOldAp-present flag
}
var
  WinOldAp: Boolean;

implementation

type
  PFormatEntry = ^TFormatEntry;
  TFormatEntry = record
    feNext: PFormatEntry;
    feFormat: Word;
    feData: pointer;
    feSize: LongInt
  end;

const
  EmClipboard: PFormatEntry = nil;

var
  SaveExit: pointer;

{$ifdef DPMI}
type
  PRealModeRegs = ^TRealModeRegs;
  TRealModeRegs = record
    case Integer of
      0: (
	EDI, ESI, EBP, EXX, EBX, EDX, ECX, EAX: Longint;
	Flags, ES, DS, FS, GS, IP, CS, SP, SS: Word);
      1: (
	DI, DIH, SI, SIH, BP, BPH, XX, XXH: Word;
	case Integer of
	  0: (
	    BX, BXH, DX, DXH, CX, CXH, AX, AXH: Word);
	  1: (
	    BL, BH, BLH, BHH, DL, DH, DLH, DHH,
	    CL, CH, CLH, CHH, AL, AH, ALH, AHH: Byte));
  end;

var
  RealRegs: TRealModeRegs absolute System.RealModeRegs;
{$endif DPMI}

procedure DetectWinOldAp; near; assembler;
Asm
	MOV	AX, 1700H
	INT	2FH
	CMP	AX, 1700H
	JZ	@@1
	MOV	AL, 1
@@1:	MOV	WinOldAp, AL
End;

procedure FindEntry; near; assembler;
{ In  DX    format id
  Out ES:SI PFormatEntry
}
Asm
	LES	SI, EmClipboard
@@2:	MOV	AX, ES
	OR	AX, SI
	JZ	@@1
	CMP	DX, ES:[SI].TFormatEntry.feFormat
	JE	@@1
	LES	SI, ES:[SI].TFormatEntry.feNext
	JMP	@@2
@@1:
End;

procedure FreeMemProc(p: pointer; Size: Word); near;
Begin
  FreeMem(p, Size)
End;

function GetMemProc(Size: Word): pointer; near;
var
  p: pointer;
Begin
  GetMem(p, Size);
  GetMemProc := p
End;

function OpenClipboard; assembler;
Asm
	CMP	WinOldAp, 0
	JZ	@em
	MOV	AX, 1701H
	INT	2FH
	OR	AX, AX
	JZ	@end
@em:	MOV	AL, 1
@end:
End;

function CloseClipboard; assembler;
Asm
	CMP	WinOldAp, 0
	JZ	@em
	MOV	AX, 1708H
	INT	2FH
	OR	AX, AX
	JZ	@end
@em:	MOV	AL, 1
@end:
End;

function EmptyClipboard; assembler;
Asm
	CMP	WinOldAp, 0
	JZ	@em
	MOV	AX, 1702H
	INT	2FH
	OR	AX, AX
	JNZ	@@1
	JMP	@end
@em:	LES	SI, EmClipboard
	MOV	EmClipboard.Word, 0
	MOV	EmClipboard.2.Word, 0
@@2:	MOV	AX, ES
	OR	AX, SI
	JZ	@@1
	PUSH	ES:[SI].TFormatEntry.feNext.2.Word
	PUSH	ES:[SI].TFormatEntry.feNext.Word
	PUSH	ES
	PUSH	SI
	PUSH	ES:[SI].TFormatEntry.feData.2.Word
	PUSH	ES:[SI].TFormatEntry.feData.Word
	PUSH	ES:[SI].TFormatEntry.feSize.Word
	CALL	FreeMemProc
	PUSH	TYPE TFormatEntry
	CALL	FreeMemProc
	POP	SI
	POP	ES
	JMP	@@2
@@1:	MOV	AL, 1
@end:
End;

function SetClipboardData; assembler;
Asm
	MOV	DX, Format
	CMP	WinOldAp, 0
	JZ	@em
{$ifndef DPMI}
	MOV	AX, 1703H
	LES	BX, Data
	MOV	CX, Size.Word
	MOV	SI, Size.2.Word
	INT	2FH
{$else}
	mov	ax, 0100H		{ DPMI: Allocate DOS Mem Block }
	mov	bx, Size.Word
	mov	si, Size.2.Word
	add	bx, 15
	adc	si, 0
	shl	si, 12
	shr	bx, 4
	or	bx, si			{ bx par count }
	push	bx
	int	31h                     { int DPMI }
	pop	cx
	mov	RealRegs.&ax, 0
	jc	@@10			{ Error, leave }
	mov	es, dx			{ Selector }
	mov	di, 0
	mov	bx, ds
	lds	si, Data
	mov	cx, Size.Word
	cld
	rep	movsb
	mov	ds, bx
	mov	RealRegs.&ax, 1703H
	mov	RealRegs.&bx, 0
	mov	RealRegs.&es, ax
	mov	ax, Size.Word
	mov	dx, Size.2.Word
	mov	RealRegs.&cx, ax
	mov	RealRegs.&si, dx
	mov	ax, Format
	mov	RealRegs.&dx, ax
	push	es			{ Selector }
	mov	ax, ds
	mov	es, ax
	mov	di, OFFSET RealRegs
	mov	ax, 0300h		{ DPMI: Sim Real Mode Int }
	mov	bx, 2Fh
	mov	cx, 0
	int	31h
	pop	dx			{ Selector }
	pushf
	mov	ax, 0101h		{ DPMI: Free DOS Mem Block }
	int	31h
	popf
	mov	ax, 0
	jc	@@10			{ Error, leave }
@@10:
	mov	ax, RealRegs.&ax
{$endif}
	OR	AX, AX
	JZ	@end
	PUSH	Data.2.Word		{ Destroy original data }
	PUSH	Data.Word
	PUSH	Size.Word
	CALL	FreeMemProc
	JMP	@@3
@em:	CALL	FindEntry
	MOV	AX, ES
	OR	AX, SI
	JZ	@@1
	PUSH	ES
	PUSH	SI
	PUSH	ES:[SI].TFormatEntry.feData.2.Word
	PUSH	ES:[SI].TFormatEntry.feData.Word
	PUSH	ES:[SI].TFormatEntry.feSize.Word
	CALL    FreeMemProc
	POP	DI
	POP	ES
	ADD	DI, TFormatEntry.feData
	CLD
	JMP	@@2
@@1:	PUSH	TYPE TFormatEntry
	CALL	GetMemProc
	MOV	ES, DX
	MOV	DI, AX
	CLD
	XCHG	AX, EmClipboard.Word
	STOSW
	MOV	AX, DX
	XCHG	AX, EmClipboard.2.Word
	STOSW
	MOV	AX, Format
	STOSW
@@2:	MOV	AX, Data.Word
	STOSW
	MOV	AX, Data.2.Word
	STOSW
	MOV	AX, Size.Word
	STOSW
	MOV	AX, Size.2.Word
	STOSW
@@3:	MOV	AL, 1
@end:
End;

function GetClipboardDataSize; assembler;
Asm
	MOV	DX, Format
	CMP	WinOldAp, 0
	JZ	@em
	MOV	AX, 1704H
	INT	2FH
	JMP	@end
@em:	CALL	FindEntry
	MOV	AX, ES
	MOV	DX, SI
	OR	AX, DX
	JZ	@end
	MOV	AX, ES:[SI].TFormatEntry.feSize.Word
	MOV	DX, ES:[SI].TFormatEntry.feSize.2.Word
@end:
End;

function PeekClipboardDataSize(Format: Word): LongInt; assembler;
asm
	cmp	WinOldAp, 0
	jnz	@@1
	leave
	jmp	GetClipboardDataSize
@@1:
	MOV	AX, 1701H		{ Open Clipboard }
	INT	2FH
	or	ax, ax
	jnz	@@3
	push	-1			{ return -1 if clipboard is open }
	push	-1
	jmp	@@2
@@3:
	mov	dx, Format
	mov	ax, 1704h		{ Clipboard Data Size }
	int	2fh
	push	dx
	push	ax
	mov	ax, 1708h		{ Close Clipboard }
	int	2fh
@@2:
	pop	ax
	pop	dx
	sti
end;

function GetClipboardData; assembler;
Asm
	MOV	DX, Format
	CMP	WinOldAp, 0
	JZ	@em
{$ifndef DPMI}
	MOV	AX, 1705H
	LES	BX, Data
	INT	2FH
	OR	AX, AX
	JNZ	@@2
	JMP	@end
{$else DPMI}
	MOV	AX, 1704H		{ data size }
	INT	2FH
	mov	bx, ax
	mov	si, dx
	mov	ax, 0100H		{ DPMI: Allocate DOS Mem Block }
	push	bx
	add	bx, 15
	adc	si, 0
	shl	si, 12
	shr	bx, 4
	or	bx, si			{ bx par count }
	int	31h                     { int DPMI }
	mov	RealRegs.&es, ax
	mov	ax, 0
	pop	bx
	jc	@end			{ Error, leave }
	push	bx
	push	dx			{ Selector }
	mov	RealRegs.&ax, 1705H
	mov	RealRegs.&bx, 0
	mov	ax, Format
	mov	RealRegs.&dx, ax
	mov	ax, ds
	mov	es, ax
	mov	di, OFFSET RealRegs
	mov	ax, 0300h		{ DPMI: Sim Real Mode Int }
	mov	bx, 2Fh
	mov	cx, 0
	int	31h
	jnc	@@10
	mov	RealRegs.&ax, 0
	jmp	@@11
@@10:
	mov	bx, ds
	pop	ds			{ Selector }
	mov	si, 0
	les	di, Data
	pop	cx
	cld
	rep	movsb
@@11:
	mov	dx, ds
	mov	ds, bx
	mov	ax, 0101h		{ DPMI: Free DOS Mem Block }
	int	31h

	mov	ax, RealRegs.&ax
	jmp	@end
{$endif DPMI}
@em:	CALL	FindEntry
	MOV	AX, ES
	OR	AX, SI
	JZ	@end
	MOV	CX, ES:[SI].TFormatEntry.feSize.Word
	SHR	CX, 1
	PUSH	DS
	PUSHF
	LDS	SI, ES:[SI].TFormatEntry.feData
	LES	DI, Data
	CLD
	REP	MOVSW
	POPF
	JNC	@@1
	MOVSB
@@1:	POP	DS
@@2:	MOV	AL, 1
@end:
End;

procedure ClipExit; far;
Begin
  EmptyClipboard;
  ExitProc := SaveExit
End;

procedure InstallExit; near;
Begin
  SaveExit := ExitProc;
  ExitProc := @ClipExit
End;

procedure ForceEmulation;
Begin
  If WinOldAp then Begin
    InstallExit;
    WinOldAp := false
  End
End;

Begin
  DetectWinOldAp;
  CloseClipboard;
  If not WinOldAp then InstallExit
End.
