تنصيب الخطوط برمجيا على الجهاز

[khedimaadl]

جرب هذا الكود..
[

كود :

uses ActiveX, Comobj, ShlObj; {$R *.dfm} function SHCreateFileDataObject(pidlFolder: PItemIDList; cidl: UINT;   apidl: PItemIdList; const pdtInner: IDataObject;   var ppv: IDataObject): HResult; stdcall;  external 'shell32.dll' index 740; procedure FontInstall; const   G: TGUID = '{1a184871-359e-4f67-aad9-5b9905d62232}'; var apidl: array[0..2] of Pointer; DataObject: IDataObject; P: pointer; Menu: IContextMenu; wCmd: TCMInvokeCommandInfo; IExt: IShellExtInit; begin   CoInitialize(nil);   apidl[0] := ILCreateFromPath('C:\Users\Ah\Font1.ttf');   apidl[1] := ILCreateFromPath('C:\Users\Ah\Font2.ttf');   apidl[2] := ILCreateFromPath('C:\Users\Ah\Font3.ttf');   p := nil;   SHCreateFileDataObject(@p, 3, @apidl[0], nil,DataObject);   IExt := CreateComObject(G) as IShellExtInit;   IExt.Initialize(nil, DataObject, 0);   Menu := IExt as IContextMenu;   fillchar(wCmd, Sizeof(wCmd),0);   wCmd.cbSize := Sizeof(wCmd);   wCmd.lpVerb := pAnsichar(Ansistring('Install'));   menu.InvokeCommand(wCmd);   // must free apidl end;

بارك الله فيك أخي العزيز
وجزاك الله كل خير، لقد نجح الأمر
أشكرك شكرا جزيلا على اهتمامك، وحرصك على مساعدتي
شكرا شكرا