delphi - How to create Picture and HTML formats all together on the clipboard? -

i need create following formats on clipboard:

cf_bitmap
cf_dib
cf_dib5
html format

this console program can create either picture formats or html format, not on clipboard:

program copyimagefromfile;  {$apptype console} {$r *.res}  uses   winapi.windows,   vcl.clipbrd,   vcl.extctrls,   vcl.imaging.pngimage,   system.sysutils;  function formathtmlclipboardheader(htmltext: string): string; const   crlf = #13#10; begin   result := 'version:0.9' + crlf;   result := result + 'starthtml:-1' + crlf;   result := result + 'endhtml:-1' + crlf;   result := result + 'startfragment:000081' + crlf;   result := result + 'endfragment:°°°°°°' + crlf;   result := result + htmltext + crlf;   result := stringreplace(result, '°°°°°°', format('%.6d', [length(result)]), []); end;  procedure copyhtmlandimagetoclipboard(const str, apngfile: ansistring; const htmlstr: ansistring = ''); var   gmem: hglobal;   lp: pchar;   strings: array[0..1] of ansistring;   formats: array[0..1] of uint;   i: integer;    thisimage: timage;   myformat: word;   bitmap: tbitmap;   adata: thandle;   apalette: hpalette; begin   gmem := 0;   //{$ifndef usevclclipboard}   //win32check(openclipboard(0));   //{$endif}   clipboard.open;   try     //most descriptive first per api docs     strings[0] := formathtmlclipboardheader(htmlstr);     strings[1] := str;     formats[0] := registerclipboardformat('html format');     formats[1] := cf_text;     {$ifndef usevclclipboard}     win32check(emptyclipboard);     {$endif}     := 0 high(strings)     begin       if strings[i] = '' continue;       //an "1" null terminator       gmem := globalalloc(gmem_ddeshare + gmem_moveable, length(strings[i]) + 1);       {succeeded, read stream contents memory pointer points at}       try         win32check(gmem <> 0);         lp := globallock(gmem);         win32check(lp <> nil);         copymemory(lp, pchar(strings[i]), length(strings[i]) + 1);               globalunlock(gmem);       end;       win32check(gmem <> 0);       setclipboarddata(formats[i], gmem);       win32check(gmem <> 0);       gmem := 0;     end;      thisimage := timage.create(nil);     try       thisimage.picture.loadfromfile(apngfile);       // comment out copy html format:       clipboard.assign(thisimage.picture);       {myformat := cf_picture;       thisimage.picture.savetoclipboardformat(myformat, adata, apalette);       clipboard.setashandle(myformat, adata);}           thisimage.free;     end;       //{$ifndef usevclclipboard}     //win32check(closeclipboard);     //{$endif}     clipboard.close;   end; end;  var   html: string;  begin   try     // usage: copyimagefromfile.exe test.png     // test.png 32 bit alpha channel     if paramcount = 1     begin       if fileexists(paramstr(1))       begin         if lowercase(extractfileext(paramstr(1))) = '.png'         begin           html := '<img border="0" src="file:///' + paramstr(1) + '">';           copyhtmlandimagetoclipboard('test', paramstr(1), html);         end;       end;     end;   except     on e: exception     begin       writeln(e.classname, ': ', e.message);       readln;     end;   end;  end.   

so how can create these formats on clipboard?

tclipboard empties clipboard first time use tclipboard method put data on clipboard (tclipboard.assign(), tclipboard.setbuffer(), tclipboard.setashandle(), etc) after calling open(). tclipboard expects use methods accessing clipboard, use of setclpboarddata() directly store string data bypassing tclipboard's internal logic, call assign() seen first clipboard write , tclipboard wipes out data stored setclipboarddata().

to avoid that, have few choices:

1. assign() image clipboard first, save string items setclipboarddata() afterwards.

2. don't use assign() @ all. use tpicture.savetoclipboardformat() directly , call setclipboarddata().

3. don't use setclipboarddata() directly unless usevclclipboard not defined. use tclipboard.setashandle() instead.

i suggest #3. let tclipboard of work:

var   cf_html: uint = 0;  // tclipboard.setbuffer() allows format , arbitrary buffer // specified , handles global memory allocation. // however, protected, using accessor class reach it. // // tclipboard.astext , tclipboard.settextbuf() use // cf_(unicode)text, , tclipboard.setashandle() requires manual // allocation... // type   tclipboardaccess = class(tclipboard)   end;  procedure copyhtmlandimagetoclipboard(const str, apngfile: ansistring; const htmlstr: ansistring = ''); var   tmphtmlstr: ansistring;   thisimage: tpicture; begin   clipboard.open;   try     //most descriptive first per api docs      tmphtmlstr := formathtmlclipboardheader(htmlstr);     tclipboardaccess(clipboard).setbuffer(cf_html, pansichar(tmphtmlstr)^, length(tmphtmlstr) + 1);     tclipboardaccess(clipboard).setbuffer(cf_text, pansichar(str)^, length(str) + 1);      thisimage := tpicture.create;     try       thisimage.loadfromfile(apngfile);       clipboard.assign(thisimage);           thisimage.free;     end;       clipboard.close;   end; end;  initialization   cf_html := registerclipboardformat('html format'); 

if need support {$ifndef usevclclipboard} cannot use tclipboard @ all, eg:

var   cf_html: uint = 0;  {$ifdef usevclclipboard} // tclipboard.setbuffer() allows format , arbitrary buffer // specified , handles global memory allocation. // however, protected, using accessor class reach it. // // tclipboard.astext , tclipboard.settextbuf() use // cf_(unicode)text, , tclipboard.setashandle() requires manual // allocation... // type   tclipboardaccess = class(tclipboard)   end; {$endif}  procedure copyhtmlandimagetoclipboard(const str, apngfile: ansistring; const htmlstr: ansistring = ''); var   thisimage: tpicture;   {$ifndef usevclclipboard}   imgdata: thandle;   imgformat: word;   imgpalette: hpalette;   {$endif}    procedure setastext(format: uint; const s: ansistring);   {$ifndef usevclclipboard}   var     gmem: hglobal;     lp: pansichar;   {$endif}   begin     {$ifdef usevclclipboard}     tclipboardaccess(clipboard).setbuffer(format, pansichar(s)^, length(s) + 1);     {$else}     //an "1" null terminator     gmem := globalalloc(gmem_ddeshare + gmem_moveable, length(s) + 1);     win32check(gmem <> 0);     try       {succeeded, read stream contents memory pointer points at}       lp := globallock(gmem);       win32check(lp <> nil);       try         copymemory(lp, pansichar(s), length(s) + 1);               globalunlock(gmem);       end;     except       globalfree(gmem);       raise;     end;     setclipboarddata(format, gmem);     {$endif}   end;  begin   {$ifdef usevclclipboard}   clipboard.open;   {$else}   win32check(openclipboard(0));   {$endif}   try     //most descriptive first per api docs     setastext(cf_html, formathtmlclipboardheader(htmlstr));     setastext(cf_text, str);      thisimage := tpicture.create;     try       thisimage.loadfromfile(apngfile);        {$ifdef usevclclipboard}       clipboard.assign(thisimage);       {$else}       imgpalette := 0;       thisimage.savetoclipboardformat(imgformat, imgdata, imgpalette);       setclipboarddata(imgformat, imgdata);       if imgpalette <> 0         setclipboarddata(cf_palette, imgpalette);       {$endif}           thisimage.free;     end;       {$ifdef usevclclipboard}     clipboard.close;     {$else}     win32check(closeclipboard);     {$endif}   end; end;  initialization   cf_html := registerclipboardformat('html format');