[Notes2-team] =?ISO-8859-1?Q?Re=3A_=5BNotes2-team=5D_Re=3A_=5BNotes2-tea?= =?ISO-8859-1?Q?m=5D_Re=3
Brought to you by:
andersonrb
|
From: Anderson R. B. <no...@ig...> - 2003-12-03 03:06:39
|
Daniel,
n=E3o consegui achar o bug. N=E3o parece ter erro nehum...
Dae fui at=E9 os newgroups da Borland (usando o maravilhoso google)
e consegui achar c=F3digo pra fazer o que tu precisa fazer (depois de mai=
s
de 50 minutos de pesquisa, mas ao menos achei):
Naum testei, mas =E9 de um membro do TeamB, ent=E3o vai funcionar :)
Anderson
{+------------------------------------------------------------
| Unit ClipUtil
|
| Version: 1.0 Created: 05/05/96, 12:56:57
| Last Modified: 05/05/96, 12:56:57
| Author : P. Below
| Project: Common Utilities
| Description:
| Routines to copy string lists and stream to and
| from the clipboard.
+------------------------------------------------------------}
Unit ClipUtil;
Interface
Uses Classes;
Procedure CopyStringsToClipboard( fmt: Cardinal; S: TStrings );
Procedure CopyStreamToClipboard( fmt: Cardinal; S: TStream );
Procedure CopyStringsFromClipboard( fmt: Cardinal; S: TStrings );
Procedure CopyStreamFromClipboard( fmt: Cardinal; S: TStream );
Implementation
Uses WinTypes, WinProcs, SysUtils, Clipbrd;
Procedure CopyStringsToClipboard( fmt: Cardinal; S: TStrings );
Var
MemStr: TMemoryStream;
Begin
MemStr :=3D TMemoryStream.Create;
try
S.SaveToStream(MemStr);
CopyStreamToClipboard( fmt, MemStr );
finally
MemStr.Free;
end;
End; { CopyStringsToClipboard }
Procedure CopyStreamToClipboard( fmt: Cardinal; S: TStream );
Var
hMem: THandle;
pMem: Pointer;
Begin
S.Position :=3D 0;
hMem :=3D GlobalAlloc( GHND or GMEM_DDESHARE, S.Size );
If hMem <> 0 Then Begin
pMem :=3D GlobalLock( hMem );
If pMem <> Nil Then Begin
try
S.Read( pMem^, S.Size );
S.Position :=3D 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 CopyStringsFromClipboard( fmt: Cardinal; S: TStrings );
Var
MemStr: TMemoryStream;
Begin
MemStr:=3D TMemoryStream.Create;
try
CopyStreamFromClipboard( fmt, MemStr );
MemStr.Position :=3D 0;
S.LoadFromStream( MemStr );
finally
MemStr.Free;
end;
End; { CopyStringsFromClipboard }
Procedure CopyStreamFromClipboard( fmt: Cardinal; S: TStream );
Var
hMem: THandle;
pMem: Pointer;
Begin
hMem :=3D Clipboard.GetAsHandle( fmt );
If hMem <> 0 Then Begin
pMem :=3D GlobalLock( hMem );
If pMem <> Nil Then Begin
try
S.Write( pMem^, GlobalSize( hMem ));
S.Position :=3D 0;
finally =20
GlobalUnlock( hMem );
end; =20
End { If }
Else
raise Exception.Create(
'CopyStreamFromClipboard: could not lock global handle '+
'obtained from clipboard!');
End; { If }
End; { CopyStreamFromClipboard }
End. { Unit ClipUtil }
Daniel Roma wrote:
> Segue o c=F3digo completo do Shell at=E9 o momento, mas queria que voc=EA=
s=20
> conseguissem botar a fun=E7=E3o pra trabalhar sozinha hehehe... ela tem=
=20
> que colocar texto na =E1rea de transfer=EAncia independente do restante=
do=20
> c=F3digo.
> Vale lembrar mais uma vez: n=E3o pode usar a unit Clipbrd.. :)
> =20
> Any help, please!
> =20
> []=B4s
> =20
> Daniel Roma
> #Equipe do Notes - Desenvolvimento
> =20
> =20
> =20
> unit uNotesShellExt;
> =20
> interface
> =20
> uses
> Windows, ActiveX, ComObj, ShlObj, Graphics, Classes;
> =20
> type
> TContextMenu =3D class(TComObject, IShellExtInit, IContextMenu)
> private
> fFileName: array[0..MAX_PATH] of Char;
> NotesIcon: TBitMap;
> OpenIcon: TBitMap;
> WWWIcon: TBitMap;
> CopyIcon: TBitMap;
> SaveIcon: TBitMap;
> MakeIcon: TBitMap;
> FavIcon: TBitMap;
> AboutBitMap: TBitMap;
> protected
> //Inicializa=E7=E3o do Shell Extension
> function IShellExtInit.Initialize =3D SEIInitialize;
> function SEIInitialize(pidlFolder: PItemIDList; lpdobj:=20
> IDataObject;hKeyProgID: HKEY): HResult; stdcall;
> //Menu de Contexto do Explorer
> function QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst,=20
> idCmdLast,uFlags: UINT): HResult; stdcall;
> function InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;=20
> stdcall;
> function GetCommandString(idCmd, uType: UINT; pwReserved:=20
> PUINT;pszName: LPSTR; cchMax: UINT): HResult; stdcall;
> end;
> =20
> const
> Class_ContextMenu: TGUID =3D '{173A3318-80D5-41A2-9CC6-DABEB299181D}'=
;
> =20
> implementation
> =20
> {$R NotesShell.res}
> =20
>
> uses ComServ, SysUtils, ShellApi, Registry;
> =20
> function GetNotesPath(aFile:String): string;
> // Esta fun=E7=E3o retorna o caminho para o execut=E1vel do Notes... =E9=
um=20
> dos pontos
> // onde =E9 necess=E1rio usar o Registro do Windows
> var
> Reg: TRegistry;
> begin
> Reg :=3D TRegistry.Create;
> try
> with Reg do begin
> RootKey :=3D HKEY_LOCAL_MACHINE;
> =20
> if OpenKey('\SOFTWARE\Equipe do Notes\NotesSE2004', False) then=20
> //Segundo a chave sugerida pelo Anderson
> Result :=3D ExpandFileName(ReadString('RootDir') + aFile) //=20
> Retorna o path mais o nome do arquivo passado como par=E2metro
> else
> Result :=3D ''; //retorna vazio caso a chave n=E3o exista
> end;
> if AnsiPos(' ', Result) <> 0 then // caso existam espa=E7os no path=
...
> Result :=3D ExtractShortPathName(Result); // Converte o resultado=
=20
> para o formato 8.3 para manter compatibilidade com qquer sistema
> finally
> Reg.Free;
> end;
> end;
> =20
> //fun=E7=E3o que carrega um BitMap a partir do Resource, redimensionand=
o=20
> pro sistema do usu=E1rio
> procedure fLoadImage(out aBitMap: TBitMap;aResourceName:String);
> var tmpBitMap: TBitMap;
> userBitMapSize: integer;
> begin
> if aBitMap =3D nil then
> begin
> tmpBitMap :=3D TBitmap.Create;
> userBitMapSize :=3D GetSystemMetrics(SM_CXMENUCHECK);
> =20
> try
> tmpBitMap.LoadFromResourceName(hInstance,aResourceName);
> aBitMap :=3D TBitmap.Create;
> aBitMap.Width :=3D userBitMapSize;
> aBitMap.Height :=3D userBitMapSize;
> =20
> aBitMap.Canvas.StretchDraw(rect(0,0,userBitMapSize,userBitMapSize),tmpB=
itMap);
> finally
> tmpBitMap.Free;
> end;
> end;
> end;
> =20
>
> //%$&=A8%#&=A8% de fun=E7=E3o que n=E3o funciona!!!
> procedure SetClipboardText(aText:PChar);
> var Data: THandle;
> DataPtr: Pointer;
> begin
> OpenClipboard(GetDesktopWindow);
> try
> Data :=3D GlobalAlloc(GMEM_MOVEABLE+GMEM_DDESHARE, length(aText));
> try
> DataPtr :=3D GlobalLock(Data);
> try
> Move(aText^, DataPtr^, length(aText));
> EmptyClipboard;
> SetClipboardData(CF_TEXT, Data);
> finally
> GlobalUnlock(Data);
> end;
> except
> GlobalFree(Data);
> raise;
> end;
> finally
> CloseClipboard;
> end;
> end;
> =20
> =20
> =20
>
> function TContextMenu.SEIInitialize(pidlFolder: PItemIDList; lpdobj:=20
> IDataObject;
> hKeyProgID: HKEY): HResult;
> var
> StgMedium: TStgMedium;
> FormatEtc: TFormatEtc;
> begin
> if (lpdobj =3D nil) then begin
> Result :=3D E_INVALIDARG;
> Exit;
> end;
> =20
> with FormatEtc do begin
> cfFormat :=3D CF_HDROP;
> ptd :=3D nil;
> dwAspect :=3D DVASPECT_CONTENT;
> lindex :=3D -1;
> tymed :=3D TYMED_HGLOBAL;
> end;
> =20
> fLoadImage(NotesIcon,'NotesIcon');
> fLoadImage(OpenIcon,'OpenIcon');
> fLoadImage(WWWIcon,'WWWIcon');
> fLoadImage(CopyIcon,'CopyIcon');
> fLoadImage(SaveIcon,'SaveIcon');
> fLoadImage(MakeIcon,'MakeIcon');
> fLoadImage(FavIcon,'FavIcon');
> =20
>
> // Abaixo, =E9 criado um BitMap para ser colocado no meio do menu...
> // fiz esse trecho mais para demonstrar o que d=E1 pra fazer, n=E3o s=
ei=20
> se vai
> // ser usado.
> if AboutBitMap =3D nil then
> begin
> AboutBitMap :=3D TBitmap.Create;
> AboutBitMap.Width :=3D 165;
> AboutBitMap.Height :=3D 15;
> AboutBitMap.Canvas.Brush.Color :=3D clCream;
> AboutBitMap.Canvas.Pen.Color :=3D clBlue;
> AboutBitMap.Canvas.Rectangle(0,0,165,15);
> AboutBitMap.Canvas.Font.Color :=3D clNavy;
> AboutBitMap.Canvas.TextOut(7,1,'HomePage do Notes SE 2004');
> end;
> =20
> =20
> =20
> Result :=3D lpdobj.GetData(FormatEtc, StgMedium);
> if Failed(Result) then
> Exit;
> // Os c=F3digos que eu estudei permitem o tratamento de apenas um=20
> arquivo por vez.
> // Assim, caso s=F3 um arquivo esteja selecionado, ele passa o nome d=
o=20
> mesmo para fFileName
> // Caso Contr=E1rio, ele nem chega a chamar o pop-up do Notes.
> if (DragQueryFile(StgMedium.hGlobal, $FFFFFFFF, nil, 0) =3D 1) then b=
egin
> DragQueryFile(StgMedium.hGlobal, 0, fFileName, SizeOf(fFileName));
> Result :=3D NOERROR;
> end
> else begin
> FFileName[0] :=3D #0;
> Result :=3D E_FAIL;
> end;
> ReleaseStgMedium(StgMedium);
> =20
> end;
> =20
> =20
> =20
>
> function TContextMenu.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFir=
st,
> idCmdLast, uFlags: UINT): HResult;
> var mySub: HMENU;
> idCmd: Cardinal;
> begin
> Result :=3D 0;
> =20
> if ((uFlags and $0000000F) =3D CMF_NORMAL) or ((uFlags and=20
> CMF_EXPLORE) <> 0) then
> begin
> idCmd :=3D idCmdFirst; //inicializa o identificador de comando
> =20
> //Editar com o Notes - Posi=E7=E3o inicial (IndexMenu)
> InsertMenu(Menu, indexMenu, MF_STRING or MF_BYPOSITION,idCmd,=20
> 'Editar com o Notes');
> if OpenIcon <> nil then
> =20
> SetMenuItemBitmaps(Menu,indexMenu,MF_BYPOSITION,OpenIcon.Handle,OpenIco=
n.Handle);
> =20
>
> mySub :=3D CreatePopupMenu; //Cria o menu principal, que abriga os=20
> outros.
> // Posi=E7=E3o: IndexMenu + 1
> InsertMenu(Menu, indexMenu+1, MF_STRING or MF_BYPOSITION or=20
> MF_POPUP, mySub, 'Notes SE 2004');
> if NotesIcon <> nil then
> =20
> SetMenuItemBitmaps(Menu,indexMenu+1,MF_BYPOSITION,NotesIcon.Handle,Note=
sIcon.Handle);=20
> //Coloca o =EDcone do notes ao lado do item
> =20
> //O que est=E1 dentro do mySub
> begin
> =20
> //Usar como Template do Notes
> inc(idCmd);
> InsertMenu(mySub, idCmd - idCmdFirst - 1, MF_STRING or=20
> MF_BYPOSITION,idCmd, 'Usar como Template do Notes');
> if OpenIcon <> nil then
> SetMenuItemBitmaps(mySub,idCmd - idCmdFirst -=20
> 1,MF_BYPOSITION,OpenIcon.Handle,OpenIcon.Handle);
> =20
> //Salvar como template do Notes
> inc(idCmd);
> InsertMenu(mySub, idCmd - idCmdFirst - 1, MF_STRING or=20
> MF_BYPOSITION,idCmd, 'Salvar como template do Notes');
> if SaveIcon <> nil then
> SetMenuItemBitmaps(mySub,idCmd - idCmdFirst -=20
> 1,MF_BYPOSITION,SaveIcon.Handle,SaveIcon.Handle);
> =20
> //-----------------Separador----------------------------
> inc(idCmd);
> InsertMenu(mySub, idCmd - idCmdFirst - 1, MF_SEPARATOR,0,nil);
> =20
>
> //Copiar conte=FAdo
> inc(idCmd);
> InsertMenu(mySub, idCmd - idCmdFirst - 1, MF_STRING or=20
> MF_BYPOSITION,idCmd, 'Copiar conte=FAdo');
> if CopyIcon <> nil then
> SetMenuItemBitmaps(mySub,idCmd - idCmdFirst -=20
> 1,MF_BYPOSITION,CopyIcon.Handle,CopyIcon.Handle);
> =20
> //Copiar nome do arquivo
> inc(idCmd);
> InsertMenu(mySub, idCmd - idCmdFirst - 1, MF_STRING or=20
> MF_BYPOSITION,idCmd, 'Copiar nome do arquivo');
> if CopyIcon <> nil then
> SetMenuItemBitmaps(mySub,idCmd - idCmdFirst -=20
> 1,MF_BYPOSITION,CopyIcon.Handle,CopyIcon.Handle);
> =20
>
> //Informa=E7=F5es do arquivo
> inc(idCmd);
> InsertMenu(mySub, idCmd - idCmdFirst - 1, MF_STRING or=20
> MF_BYPOSITION,idCmd, 'Informa=E7=F5es do arquivo');
> =20
>
> //-----------------Separador----------------------------
> inc(idCmd);
> InsertMenu(mySub, idCmd - idCmdFirst - 1, MF_SEPARATOR,0,nil);
> =20
> //Compilar arquivo
> inc(idCmd);
> InsertMenu(mySub, idCmd - idCmdFirst - 1, MF_STRING or=20
> MF_BYPOSITION,idCmd, 'Compilar arquivo');
> if MakeIcon <> nil then
> SetMenuItemBitmaps(mySub,idCmd - idCmdFirst -=20
> 1,MF_BYPOSITION,MakeIcon.Handle,MakeIcon.Handle);
> =20
>
> //Comprimir HTML
> inc(idCmd);
> InsertMenu(mySub, idCmd - idCmdFirst - 1, MF_STRING or=20
> MF_BYPOSITION,idCmd, 'Comprimir HTML');
> =20
> //-----------------Separador----------------------------
> inc(idCmd);
> InsertMenu(mySub, idCmd - idCmdFirst - 1, MF_SEPARATOR,0,nil);
> =20
> //Adicionar aos favoritos do Notes
> inc(idCmd);
> InsertMenu(mySub, idCmd - idCmdFirst - 1, MF_STRING or=20
> MF_BYPOSITION,idCmd, 'Adicionar aos favoritos do Notes');
> if FavIcon <> nil then
> SetMenuItemBitmaps(mySub,idCmd - idCmdFirst -=20
> 1,MF_BYPOSITION,FavIcon.Handle,FavIcon.Handle);
> =20
> //-----------------Separador----------------------------
> inc(idCmd);
> InsertMenu(mySub, idCmd - idCmdFirst - 1, MF_SEPARATOR,0,nil);
> =20
> //HomePage do Notes
> inc(idCmd);
> InsertMenu(mySub, idCmd - idCmdFirst - 1, MF_BITMAP or=20
> MF_BYPOSITION,idCmd, PChar(AboutBitMap.Handle));
> if WWWIcon <> nil then
> SetMenuItemBitmaps(mySub, idCmd - idCmdFirst -=20
> 1,MF_BYPOSITION,WWWIcon.Handle,WWWIcon.Handle);
> end;
> =20
> // o valor de retorno deve ser o n=FAmero de menus que foram criado=
s
> Result :=3D idCmd - idCmdFirst + 1;
> end;
> end;
> =20
> function TContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo):=20
> HResult;
> resourcestring
> sPathError =3D 'Erro ao definir diret=F3rio ativo!';
> =20
> var
> PrevDir: string;
> NotesExe: string;
> cmdLine: String;
> begin
> Result :=3D E_FAIL;
> // Certifica que =E9 o Explorer que est=E1 acessando a DLL, e n=E3o u=
m=20
> aplicativo qquer
> if (HiWord(Integer(lpici.lpVerb)) <> 0) then
> begin
> Exit;
> end;
> =20
> NotesExe :=3D GetNotesPath('NotesSE.exe');
> if ((NotesExe =3D '') or (not FileExists(NotesExe))) then
> begin
> //Chamada abaixo em API, pois tirar o Dialogs.dcu economizou quase=20
> 300kb!
> MessageBox(GetDesktopWindow,'Notes n=E3o instalado corretamente!' +=
=20
> #13 + 'Tente instalar novamente por favor.','Erro de Instala=E7=E3o',MB=
_OK=20
> or MB_ICONERROR);
> exit;
> end;
> =20
> cmdLine :=3D '';
> =20
> case LoWord(Integer(lpici.lpVerb)) of
> 0: // "Editar com o Notes"
> cmdLine :=3D NotesExe + ' "' + fFileName + '"';
> 1: // "Usar como Template do Notes"
> cmdLine :=3D NotesExe + ' -t "' + fFileName + '"';
> //2: //Salvar como template do Notes
> //3: -----------------Separador----------------------------
> //4: //Copiar conte=FAdo
> //5: //Copiar nome do arquivo
> //6: //Informa=E7=F5es do arquivo
> //7: -----------------Separador----------------------------
> //8: //Compilar arquivo
> //9: //Comprimir HTML
> //10:-----------------Separador----------------------------
> //11://Adicionar aos favoritos do Notes
> //12:-----------------Separador----------------------------
> 13: // "HomePage do Notes"
> =20
> ShellExecute(GetDesktopWindow,nil,'http://notes.codigolivre.org.br',nil=
,nil,SW_MAXIMIZE);
> end;
> =20
> if cmdLine <> '' then
> begin
> PrevDir :=3D GetCurrentDir;
> try
> WinExec(PChar(cmdLine), lpici.nShow);
> Result :=3D NOERROR;
> finally
> SetCurrentDir(PrevDir);
> end;
> end;
> end;
> =20
> function TContextMenu.GetCommandString(idCmd, uType: UINT; pwReserved:=20
> PUINT;
> pszName: LPSTR; cchMax: UINT): HRESULT;
> begin
> //Essa fun=E7=E3o descreve o texto da barra de status do explorer
> case idCmd of
> 0: // "Editar com o Notes"
> begin
> if (uType =3D GCS_HELPTEXT) then
> StrCopy(pszName, PChar('Edita o arquivo "' +=20
> ExtractFileName(fFileName) + '" com o Notes SE 2004'));
> Result :=3D NOERROR;
> end;
> =20
> 1: // "Usar como Template do Notes"
> begin
> if (uType =3D GCS_HELPTEXT) then
> StrCopy(pszName, PChar('Usa o arquivo "' +=20
> ExtractFileName(fFileName) + '" como template com o Notes SE 2004'));
> Result :=3D NOERROR;
> end;
> =20
> 3: // "HomePage do Notes SE 2004"
> begin
> if (uType =3D GCS_HELPTEXT) then
> StrCopy(pszName, PChar('HomePage do Notes SE 2004'));
> Result :=3D NOERROR;
> end;
> =20
> else
> Result :=3D E_INVALIDARG;
> end;
> end;
> =20
> type
> TContextMenuFactory =3D class(TComObjectFactory)
> public
> procedure UpdateRegistry(Register: Boolean); override;
> end;
> =20
> procedure TContextMenuFactory.UpdateRegistry(Register: Boolean);
> var
> ClassID: string;
> begin
> //Registra o Menu de contexto
> if Register then begin
> inherited UpdateRegistry(Register);
> =20
> ClassID :=3D GUIDToString(Class_ContextMenu);
> CreateRegKey('*\shellex', '', '');
> CreateRegKey('*\shellex\ContextMenuHandlers', '', '');
> CreateRegKey('*\shellex\ContextMenuHandlers\Notes', '', ClassID);
> =20
> if (Win32Platform =3D VER_PLATFORM_WIN32_NT) then
> with TRegistry.Create do
> try
> RootKey :=3D HKEY_LOCAL_MACHINE;
> OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Shell=20
> Extensions', True);
> OpenKey('Approved', True);
> WriteString(ClassID, 'Notes SE 2004 Shell Extension');
> finally
> Free;
> end;
> end
> else begin
> DeleteRegKey('*\shellex\ContextMenuHandlers\Notes');
> DeleteRegKey('*\shellex\ContextMenuHandlers');
> DeleteRegKey('*\shellex');
> =20
> inherited UpdateRegistry(Register);
> end;
> end;
> =20
> initialization
> TContextMenuFactory.Create(ComServer, TContextMenu,=20
> Class_ContextMenu,'', 'Notes SE 2004 Shell Extension',=20
> ciMultiInstance,tmApartment);
> end.
> =20
>
> ---
> Verifica=E7=E3o de V=EDrus executada:
> Nenhum v=EDrus encontrado!
> Sudeste Seguran=E7a e Transporte de Valores
> Departamento de Tecnologia e Informa=E7=F5es
> Checked by AVG anti-virus system (http://www.grisoft.com).
> Version: 6.0.545 / Virus Database: 339 - Release Date: 27/11/2003
--=20
Anderson Rodrigues Barbieri
--------------------------------------------
#Equipe do Notes - Coordenador/Desenvolvedor
{ TAndInfo }
ICQ #149391850 / no...@ig...
Notes - http://notes.codigolivre.org.br
NotesDev - http://notes2.sf.net/dev
F=F3rum - http://notes2.sf.net/forum
|