相关代码
procedure TFm1Main.Button1Click(Sender: TObject);/////这是存入过程
var ms: TMemoryStream;
var t1: OleVariant;
begin
t1:=WordControl.WordDocument.Tables.Item(1);
t1.cell(2,1).range.copy;
try
ms := TMemoryStream.Create;
SaveClipboard(ms);
qTopic.Append;
TBlobField(qTopic.FieldByName('content')).LoadFromStream(Ms);
qTopic.Post;
finally
ms.Free;
end; { Finally}
end;
procedure TFm1Main.Button2Click(Sender: TObject); //读出过程
var MemStream : TMemoryStream;
var t1: OleVariant;
begin
screen.Cursor:=crHourGlass;
Qtopic.close;
Qtopic.SQL.Clear;
Qtopic.SQL.Add('select * from tbTopic where id='+edit1.Text+'');
Qtopic.Open;
//Clipboard.Open;
//Clipboard.Clear;
try
MemStream := TMemoryStream.Create;
MemStream.Clear;
TBlobField(Qtopic.FieldByName('Content')).SaveToStream(MemStream);
MemStream.Position := 0;
LoadClipboard(MemStream);
t1:=WordControl.WordDocument.Tables.Item(1);
t1.cell(4,1).range.Paste;
finally
MemStream.Free;
end;
// Clipboard.Close;
screen.Cursor:=crDefault;
end;
procedure TFm1Main.LoadClipboard(S: TStream);
var
reader: TReader;
begin
Assert(Assigned(S));
reader := TReader.Create(S, 4096);
try
Clipboard.Open;
try
clipboard.Clear;
reader.ReadListBegin;
while not reader.EndOfList do //
begin
// showmessage(inttostr(reader.Position));
LoadClipboardFormat(reader);
end;
reader.ReadListEnd;
finally
Clipboard.Close;
end; { Finally }
finally
reader.Free
end; { Finally }
end; { LoadClipboard }
procedure TFm1Main.SaveClipboard(S:TStream);
var
writer: TWriter;
i: integer;
begin
Assert(Assigned(S));
writer := TWriter.Create(S, 4096);
try
Clipboard.Open;
try
writer.WriteListBegin;
for i := 0 to Clipboard.formatcount - 2 do
begin
//showmessage(inttostr( ClipBoard.Formats));
SaveClipboardFormat(Clipboard.Formats, writer);
end;
writer.WriteListEnd; //可以删除
finally
Clipboard.Close;
end; { Finally }
finally
writer.Free
end; { Finally }
end; { SaveClipboard }
procedure TFm1Main.CopyStreamToClipboard(fmt: cardinal; S: TStream);
var
hMem: THandle;
pMem: Pointer;
begin
Assert(Assigned(S));
S.Position := 0;
hMem := GlobalAlloc(GHND or GMEM_DDESHARE, S.Size);
if hMem <> 0 then
begin
pMem := GlobalLock(hMem);
if pMem <> nil then
begin
try
S.Read(pMem^, S.Size);
S.Position := 0;
finally
GlobalUnlock(hMem);
end;
Clipboard.Open;
try
Clipboard.SetAsHandle(fmt, hMem);
finally
Clipboard.Close;
end;
end { If }
else
begin
GlobalFree(hMem);
OutOfMemoryError;
end;
end { If }
else
OutOfMemoryError;
end; {CopyStreamToClipboard}
procedure TFm1Main.CopyStreamFromClipboard(fmt: cardinal; S: TStream);
Var hMem: THandle;
pMem: Pointer;
Begin
hMem := Clipboard.GetAsHandle(fmt );
If hMem <> 0 Then
Begin
pMem := GlobalLock( hMem );
If pMem <> Nil Then
Begin
S.Write( pMem^, GlobalSize( hMem ));
S.Position := 0;
GlobalUnlock( hMem );
End { If }
Else
raise Exception.Create(
'CopyStreamFromClipboard: could not lock global handle '+
'obtained from clipboard!');
End; { If }
end; { CopyStreamFromClipboard }
procedure TFm1Main.LoadClipboardFormat(reader: TReader);
var
fmt: integer;
fmtname: string;
size: integer;
ms: TMemoryStream;
begin
Assert(Assigned(reader));
fmt := reader.ReadInteger;
fmtname := reader.ReadString;
size := reader.ReadInteger;
ms := TmemoryStream.Create;
try
ms.Size := size;
reader.Read(ms.memory^, size);
if Length(fmtname) > 0 then
fmt := RegisterCLipboardFormat(PChar(fmtname));
if fmt <> 0 then
CopyStreamToClipboard(fmt, ms);
finally
ms.Free;
end; { Finally }
end; { LoadClipboardFormat }
procedure TFm1Main.SaveClipboardFormat(fmt: word; writer: TWriter);
var
fmtname: array[0..128] of char;
ms: TMemoryStream;
begin
Assert(Assigned(writer));
if 0 = GetClipboardFormatName(fmt, fmtname, sizeof(fmtname)) then
fmtname[0] := #0;
ms := TMemoryStream.Create;
try
CopyStreamFromClipboard(fmt, ms);
if ms.Size > 0 then
begin
writer.WriteInteger(fmt);
writer.WriteString(fmtname);
writer.WriteInteger(ms.Size);
writer.Write(ms.Memory^, ms.Size);
end; { If }
finally
ms.Free
end; { Finally }
end; { SaveClipboardFormat }
