unit CBManager;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,
StdCtrls, ClipBrd, PrivatClipBrd; //PrivatClipBrd siehe Klasse TDataType;
type
TForm1 = class(TForm)
ListBox1: TListBox;
Button1: TButton;
Button2: TButton;
Button3: TButton;
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
procedure WMDRAWCLIPBOARD(var M: TWMDRAWCLIPBOARD);
message WM_DRAWCLIPBOARD;
procedure WMCHANGECBCHAIN(var M: TWMCHANGECBCHAIN);
message WM_CHANGECBCHAIN;
public
{ Public-Deklarationen }
end;
const PREDEFINED_CLIPBOARD_FORMAT_COUNT = 17; //in Win95, 14 ansonsten
type TClipBrdMem = array[0..0] of Char;
var
Form1: TForm1;
hNextViewer: HWnd;
ClipBrdMem: ^TClipBrdMem;
ClipBrdMemSize: DWord;
ClipBrdFormat: Integer;
FormatNames: array[0..17] of string =('CF_FIRST','CF_TEXT',
'CF_BITMAP','CF_METAFILEPICT',
'CF_SYLK','CF_DIF','CF_TIFF','CF_OEMTEXT',
'CF_DIB','CF_PALETTE','CF_PENDATA','CF_RIFF',
'CF_WAVE','CF_UNICODETEXT','CF_ENHMETAFILE',
//Win95
'CF_HDROP','CF_LOCAL','CF_MAX');
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
hNextViewer:=SetClipboardViewer(Handle);
ReAllocMem(ClipBrdMem, 1);
ClipBrdFormat:=CF_TEXT;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
ReAllocMem(ClipBrdMem, 0);
if (hNextViewer<>0) and not ChangeClipBoardChain(Handle,
hNextViewer) then
MessageBox(0, PChar('Fataler Systemfehler'), PChar('Info'),
MB_OK);
end;
procedure TForm1.WMDRAWCLIPBOARD(var M: TWMDRAWCLIPBOARD);
var cWinText: array[0..255] of char;
hForegroundWindow,
hOwnerWindow: HWND;
begin
inherited;
if hNextViewer<>0 then SendMessage(hNextViewer, WM_DRAWCLIPBOARD, 0, 0);
Form1.caption:='';
hForegroundWindow:=GetForegroundWindow;
hOwnerWindow:=hForegroundWindow;
while GetWindow(hOwnerWindow, GW_OWNER)<>0 do
hOwnerWindow:=GetWindow(hOwnerWindow, GW_OWNER);
if hForegroundWindow<>hOwnerWindow then
begin
GetWindowText(hOwnerWindow, cWinText, 255);
Form1.caption:=cWinText;
end;
GetWindowText(hForegroundWindow, cWinText, 255);
Form1.caption:=Form1.caption+' ---> '+cWinText;
end;
procedure TForm1.WMCHANGECBCHAIN(var M: TWMCHANGECBCHAIN);
begin
inherited;
if M.Remove=hNextViewer then
hNextViewer:=M.Next
else
if hNextViewer<>0 then SendMessage(hNextViewer,
WM_CHANGECBCHAIN, M.Remove, M.Next);
end;
//alle aktuellen ClipBoard Formate ermitteln
procedure TForm1.Button1Click(Sender: TObject);
var cv: Integer;
cName: array[0..64] of Char;
Clipboard: TClipboard;
begin
ListBox1.Items.Clear;
Clipboard:=TClipboard.Create;
for cv := 0 to Clipboard.FormatCount-1 do
begin
if Clipboard.Formats[cv]<=17 then
ListBox1.Items.Add(FormatNames[Clipboard.Formats[cv]])
else
begin
GetClipBoardFormatName(Clipboard.Formats[cv],
@cName, 63);
ListBox1.Items.Add(cName);
end;
end;
Clipboard.Free;
end;
//ClipBoard Inhalt kopieren
procedure TForm1.Button2Click(Sender: TObject);
var hClipMem: THandle;
lpClip: Pointer;
begin
OpenClipBoard(Handle);
//Vorschlag: zunächst alle momentan verfügbaren
CB-Formate feststellen
//und in einer Schleife prüfen welches
gerade in der Zwischenablage vorliegt
//siehe auch Button1Click oben
if IsClipBoardFormatAvailable(ClipBrdFormat) then
begin
hClipMem:=GetClipBoardData(ClipBrdFormat);
ClipBrdMemSize:=GlobalSize(hClipMem); if ClipBrdMemSize=0 then
Exit;
ReAllocMem(ClipBrdMem, ClipBrdMemSize);
lpClip:=GlobalLock(hClipMem);
CopyMemory(ClipBrdMem, lpClip, ClipBrdMemSize);
GlobalUnLock(hClipMem);
end;
CloseClipBoard;
end;
//kopierter ClipBoard Inhalt wieder ins ClipBoard
procedure TForm1.Button3Click(Sender: TObject);
begin
SetPrivatClipBroardData(Handle, ClipBrdFormat, ClipBrdMem);
end;