The original version of uSaveClipboard.pas included with the Babelfish COm addin does not save/restore files. Below is the latest version that does. Watch for wraps.
Dmitry Streblechenko (MVP)http://www.dimastr.com/OutlookSpy - Outlook, CDOand MAPI Developer Tool
unit uSaveClipboard;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, RichEdit, Clipbrd, registry, ActiveX, ShellAPI, ShlObj;
type
TSaveClipboard = class(TObject) private FTxt, FRTF, FHTML, FOEMText : string; FUnicodeText : WideString; FBitmap : TBitmap; FMetafile : TMetafile; CF_RTF, CF_HTML : UINT; FFiles : TStringList; procedure ClearBuffer; public constructor Create;reintroduce; destructor Destroy;override; procedure Save; procedure Restore; end;
implementation
{ TSaveClipboard }
procedure TSaveClipboard.ClearBuffer;begin FTxt:=''; FRTF:=''; FHTML:=''; FOEMText:=''; FUnicodeText:=''; FBitmap.Free; FBitmap:=nil; FMetafile.Free; FMetafile:=nil; FFiles.Clear;end;
constructor TSaveClipboard.Create;begin inherited Create; FFiles := TStringList.Create; ClearBuffer; CF_RTF := RegisterClipboardFormat(RichEdit.CF_RTF); CF_HTML := {16;//}RegisterClipboardFormat('HTML Format');end;
destructor TSaveClipboard.Destroy;begin ClearBuffer; FFiles.Free; inherited;end;
procedure CopyClipboardData(Format : UINT; Buffer : pointer; Length : integer);var Data:THandle; DataPtr: Pointer;begin Data := GlobalAlloc(GMEM_MOVEABLE+GMEM_DDESHARE, Length); try DataPtr := GlobalLock(Data); try CopyMemory(DataPtr, Buffer, Length); SetClipboardData(Format, Data); finally GlobalUnlock(Data); end; except GlobalFree(Data); raise; end;end;
procedure TSaveClipboard.Restore;const NULL : Char = #0;var //Data:THandle; //DataPtr: Pointer; DF : TDropFiles; i : integer;begin try Clipboard.Clear; Clipboard.Open; //text if Length(FTxt) > 0 then Clipboard.AsText:=FTxt; //OEM text if Length(FOEMText) > 0 then CopyClipboardData(CF_OEMTEXT, PChar(FOEMText), Length(FOEMText)+1); //HTML text if Length(FHTML) > 0 then CopyClipboardData(CF_HTML, PChar(FHTML), Length(FHTML)+1); //Unicode text if Length(FUnicodeText) > 0 then CopyClipboardData(CF_UNICODETEXT, PWideChar(FUnicodeText), 2*Length(FUnicodeText)+2); //RTF if Length(FRTF) > 0 then CopyClipboardData(CF_RTF, PChar(FRTF), Length(FRTF)+1); //BMP if FBitmap <> nil then Clipboard.Assign(FBitmap); //Metafile if FMetafile <> nil then Clipboard.Assign(FMetafile); //files if FFiles.Count > 0 then begin DF.pFiles:=SizeOf(DF); DF.pt.x:=0; DF.pt.y:=0; DF.fNC:=false; DF.fWide:=false; with TMemoryStream.Create do try Write(DF, SizeOf(DF)); for i:=0 to FFiles.Count-1 do begin Write(FFiles[i][1], Length(FFiles[i])); Write(NULL, SizeOf(NULL)); end; Write(NULL, SizeOf(NULL)); CopyClipboardData(CF_HDROP, Memory, Size); finally Free; end; end; finally Clipboard.Close; end;end;
procedure TSaveClipboard.Save;var Data:THandle; p : pointer; Count, i : integer; Buffer : array[0..MAX_PATH] of Char;begin //GetClipboardFormatName(CF_HTML, @Buffer, SizeOf(Buffer)); {for i:=0 to Clipboard.FormatCount-1 do begin //if Clipboard.Formats[i] = 0 then beep; GetClipboardFormatName(Clipboard.Formats[i], @Buffer, SizeOf(Buffer)); end;} ClearBuffer; //text if Clipboard.HasFormat(CF_TEXT) then FTxt:=Clipboard.AsText; //RTF if Clipboard.HasFormat(CF_RTF) then begin Clipboard.Open; Data := GetClipboardData(CF_RTF); if Data <> 0 then begin FRTF := PChar(GlobalLock(Data)); GlobalUnlock(Data); end; Clipboard.Close; end; //HTML if Clipboard.HasFormat(CF_HTML) then begin Clipboard.Open; Data := GetClipboardData(CF_HTML); if Data <> 0 then begin FHTML := PChar(GlobalLock(Data)); GlobalUnlock(Data); end; Clipboard.Close; end; //OEM Text if Clipboard.HasFormat(CF_OEMTEXT) then begin Clipboard.Open; Data := GetClipboardData(CF_OEMTEXT); if Data <> 0 then begin FOEMText := PChar(GlobalLock(Data)); GlobalUnlock(Data); end; Clipboard.Close; end; //Unicode if Clipboard.HasFormat(CF_UNICODETEXT) then begin Clipboard.Open; Data := GetClipboardData(CF_UNICODETEXT); if Data <> 0 then begin FUnicodeText := PWideChar(GlobalLock(Data)); GlobalUnlock(Data); end; Clipboard.Close; end; //Bitmap if Clipboard.HasFormat(CF_BITMAP) then try FBitmap:=TBitmap.Create; FBitmap.Assign(Clipboard); except FBitmap.Free; end; //metafile if Clipboard.HasFormat(CF_METAFILEPICT) then try FMetafile:=TMetafile.Create; FMetafile.Assign(Clipboard); except FMetafile.Free; end; //files if Clipboard.HasFormat(CF_HDROP) then begin Clipboard.Open; Data := GetClipboardData(CF_HDROP); if Data <> 0 then begin p := PChar(GlobalLock(Data)); Count:=DragQueryFile(HDROP(p), $FFFFFFFF, nil, 0); for i:=0 to Count-1 do begin DragQueryFile(HDROP(p), i, @Buffer, SizeOf(Buffer)); if strlen(PChar(@Buffer)) > 0 then FFiles.Add(PChar(@Buffer)); end; GlobalUnlock(Data); end; Clipboard.Close; end;end;
end.
"nix" <nix@nix.com> wrote in message news:42a77107$2@newsgroups.borland.com...
> Hi>> I've created an Outlook toolbar based on the BabelFish example using an> unmodified BmpToBtn function (together with uSaveClipboard) to handle the> addition of images to the toolbar buttons, then restore the clipboard.>> It works well (thanks in large part to Dmitry's advice).>> However I've had the following issue reported by a user with Outlook 2002.>> "When the toolbar is not installed I can simply copy a file (Ctrl+C) from> Explorer, open a new email in Outlook and paste the file in the new email> (Ctrl+V) as an attachment.>> When the toolbar is installed and I use the above steps I get the toolbar> icon pasted into the new email.">>> I can't reproduce the problem on our test systems, so I am looking for any> advice as to the possible cause.>> Thanks>> nix>>
联系客服
