Listing 1

//Privates ClipBoard Format definieren, setzen bzw. auslesen

program PrivatCBProject1;

uses
  Forms,
  PrivatCB1 in 'PrivatCB1.pas' {Form1};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

/////////////////////////////////////////////////////////////////////////////

unit PrivatCB1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, PrivatClipBrd;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

type
       TRec = record
             cTest:     Char;
             sTest:     string[255];    //Recordgröße muß konstant sein (keine variablen Strings also)
            wTest:     Word;
              iTest:      Integer;
       end;

     //einen Arraytyp bilden
     TRecMem = array[0..0] of TRec;

var
  Form1: TForm1;
  ClipBrdFormat: Integer;
  RecMem: ^TRecMem;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
//Privates ClipBoardFormat registrieren und Formatnummer merken (!)
ClipBrdFormat:=RegisterClipBoardFormat(PChar('Privat'));

//Speicher für Feld mit einem El. reservieren
ReAllocMem(RecMem, sizeof(TRec));

//Arrayelement 0 mit Werten belegen
RecMem^[0].cTest:='A';
RecMem^[0].sTest:='Hallo Welt';
RecMem^[0].wTest:=102;
RecMem^[0].iTest:=45;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
//Daten mit eigenem Format kopieren
SetPrivatClipBroardData(Handle, ClipBrdFormat, RecMem);

//Arrayelement 0 mit neuen Werten belegen
RecMem^[0].cTest:='C';
RecMem^[0].sTest:='';
RecMem^[0].wTest:=0;
RecMem^[0].iTest:=0;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
//Daten mit privatem Format aus dem ClipBoard holen
GetPrivatClipBroardData(Handle, ClipBrdFormat, RecMem, sizeof(TRec));

//Daten anzeigen
caption:=RecMem^[0].cTest+RecMem^[0].sTest+inttostr(RecMem^[0].wTest)+
         inttostr(RecMem^[0].iTest);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
//Speicher freigeben
ReAllocMem(RecMem, 0);
end;

end.

/////////////////////////////////////////////////////////////////////////////

unit PrivatClipBrd;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

function SetPrivatClipBroardData(hWnd: THandle; ClipBrdFormat: Integer; Data: Pointer): Boolean;
function GetPrivatClipBroardData(hWnd: THandle; ClipBrdFormat: Integer; Data: Pointer;
                                  DataSize: Integer): Boolean;

implementation

function SetPrivatClipBroardData(hWnd: THandle; ClipBrdFormat: Integer; Data: Pointer): Boolean;
begin
OpenClipBoard(hWnd); //Zw.'ablage zum Lesen und Schreiben öffnen
EmptyClipBoard; //Inhalt der Zw.'ablage löschen
result:=(SetClipBoardData(ClipBrdFormat, Integer(Data))<>0); //Daten in Zw.'ablage setzen
CloseClipBoard; //Zw.'ablage schließen
end;

function GetPrivatClipBroardData(hWnd: THandle; ClipBrdFormat: Integer; Data: Pointer;
                                  DataSize: Integer): Boolean;
var hClipMem: THandle;
    lpClip: Pointer;

begin
result:=False;

OpenClipBoard(hWnd); //Zw.'ablage zum Lesen und Schreiben öffnen

if IsClipBoardFormatAvailable(ClipBrdFormat) then //Ist mein privates Format in Zw.'ablage
begin                                                                        //vorhanden?
hClipMem:=GetClipBoardData(ClipBrdFormat); //ergibt Handle auf Speicherblock
lpClip:=GlobalLock(hClipMem); //sperrt Speicherblock, ergibt Zeiger auf erstes Byte im Block
CopyMemory(Data, lpClip, DataSize); //Daten kopieren
GlobalUnLock(hClipMem); //gibt Speicherblock frei
result:=True;
end;

CloseClipBoard; //Zw.'ablage schließen

end;

end.

Zurück zur Hauptseite