字体和壁纸合并后再更改壁纸--《用delphi开发共享软件》-15.2桌面提示器

 procedure TFrmPlay.mnDeskPicClick(Sender: TObject);
 Var s:String; i:Integer;
 begin
   //s:=Path+'SetPic.exe';
   //EnableDebugPrivilege(True);
   //ShellExecute(GetDesktopWindow ,'open',Pchar(s), nil,Pchar(Path),SW_SHow);  Exit;
   i:=sgPic.Row;
   s:=sgPic.Cells[,i];  //原始图片文件
   if pos(':',s)= then  s:=Path+s; //==相对路径
   if FileExists(s) then MakeWallPic(s); //产生并设置壁纸
   //SetWallPaper(s,2);
 end;

 procedure TFrmPlay.MakeWallPic(sPic:String); //合并新墙纸
 Var sBMP,sJPG:String; img,imgTmp:TImage;
     JpegImage:TJpegImage;
     udtblender:TBlendFunction;//图片效果处理参数
 begin
   with udtblender do
   begin
       Blendop:=AC_SRC_OVER;
       Blendflags:=;
       SourceConstantAlpha:=-spTransparent.Value;//透明度
       AlphaFormat:=;
   end;

   //s:=WinPath+'\'+ChangeFileExt(ExtractFileName(sPic),'.JPG');
   sBmp:=Path+'DeskPic\'+ChangeFileExt(ExtractFileName(sPic),'.BMP');
   sJPG:=Path+'DeskPic\'+ChangeFileExt(ExtractFileName(sPic),'.JPG');
   img:=TImage.Create(nil);
   imgTmp:=TImage.Create(nil);    //创建BMP图片
   JpegImage:=TJpegImage.Create;  //创建JPG图片
   try
     img.AutoSize :=True;
     img.Picture.LoadFromFile(sPic); //装载原始图片 //img.Picture.Assign(nil);
     LoadBMPJPG(img,sPic);
     //imgTmp.Picture.Assign(img.Picture);
     imgTmp.Width :=img.Width;
     imgTmp.Height :=img.Height;
     imgTmp.Canvas.Draw(,,img.Picture.Graphic);//绘制到临时图片中
     ShowHint(img);//在临时图片中绘制 提示文字信息
     windows.AlphaBlend(imgTmp.Canvas.Handle,,,imgTmp.Width,imgTmp.Height,
                         img.Canvas.Handle,,,img.Width,img.Height,
                               udtblender); //关键调用api

     imgTmp.Picture.Bitmap.SaveToFile(sBMP);//保存临时文件到磁盘

 //保存最终的JPG的壁纸文件：
     JpegImage.Assign(imgtmp.Picture.Graphic); //JpegImage.CompressionQuality:=100;
     JpegImage.PixelFormat:=jf24Bit;
     JpegImage.Compress;
     JpegImage.SaveToFile(sJPG);
   finally
     img.Free;
     imgTmp.Free;
     JpegImage.Free; //edFile.Text :=sBMP;
     if Fileexists(sBMP) then  SetRegWallPaper(sBMP);//设置壁纸
     sleep();
     if Fileexists(sJPG) then  SetWallPaper(sJPG,); //设置壁纸
     //MyDeleteFile(sBMP);  //==不需要了!??
   end;
 end;

 procedure TFrmPlay.ShowHint(img:TImage); //合成文字
 Var i,n,h,w,size:Integer;  s,s2,sHint,sfmt:String;
 begin
   sHint:=''; //需要回执的特殊格式的文字；
   if chkShowDate.Checked then  sHint:=MyDatestr(SysUtils.Date,True); //显示日期
   if chkShowWeek.Checked then //显示星期
     sHint:=sHint+' '+Days[DayofWeek(SysUtils.Date)];
   if sHint<>'' then sHint:=sHint+'^^';

   for i:=sgHint.RowCount - downto  do //计算文字行数
     if sgHint.Cells[,i]<>'' then
       begin
         n:=i;
         Break;
       end;

   for i:= to n do //填加文字
     sHint:=sHint+sgHint.Cells[,i]+'^^';

   n:=ItemsOfStr(sHint,'^^');
   //img.Canvas.Font.Size:=24; //max(24,img.Height div 20) ;//==字体大小
   img.Canvas.Font:=plHintFont.Font;

   h:=img.Canvas.TextHeight('jy');
   {while h*10>img.Height do
     begin
       img.Canvas.Font.Size:=img.Canvas.Font.Size-1;
       if img.Canvas.Font.Size<10 then Break;
       h:=img.Canvas.TextHeight('jy');
     end; }
   //h:=img.Canvas.TextHeight('jy');
   size:=img.Canvas.Font.Size;
   SetFontSmooth(True); //设置文字平滑绘制

   sFmt:=FontToStr(plHintFont.font)+';~~'+colortostr(pledgeColor.Font.Color)+';~~'+inttostr(spedgeWidth.Value);//合成特定格式
   ShowFmtTxt(img.Canvas,'　~~0~~0~~0~~'+sFmt,'');
   for i:= to min(n,) do //最多显示11行提示文字
     begin
       s2:=TextOfIndex(sHint,'^^',i);
       s2:=Trim(s2);
       w:=img.Canvas.TextWidth(s2);
       s:='~~'+inttostr(img.Width-w-)+'~~'+intTostr(i*h-h);
 //    s:=s+'~~0~~楷体_BG2312;'+inttostr(h)+';255;255;255;fsItalic~~16;16;16;~~1';
       s:=s+'~~0~~'+sFmt;
       ShowFmtTxt(img.Canvas,s2+s,'');
       if chkSHowLine.Checked then
         DrawLineH3(img.Width-w-,i*h-,w,img.Canvas,plLineColor.Font.Color,dRight);
     end;
   SetFontSmooth(oldTFONTSMOOTHING); //恢复原来的文字平滑方式
 end;

 Procedure TFrmPlay.SetRegWallPaper(StrFile:String);
 Var Reg:TRegistry;
 begin
   Reg:=Tregistry.Create;{创建Tregistry对象的实例}
   Reg.Rootkey:= Hkey_Current_User;{设置根键名称}
   try
     if Reg.OpenKey('Control Panel\Desktop',False) then {打开Control Panel\Desktop 路径对应的主键}
       begin
         //ShowMessage('打开注册表成功');
         Reg.WriteString('TileWallPaper','');
         Reg.WriteString('WallpaperStyle','');
         Reg.WriteString('Wallpaper',StrFile);{向TileWallpaper 和Wallpaper串覆盖写入新值}
         Reg.WriteString('ConvertedWallpaper',StrFile);
         Reg.WriteString('OriginalWallpaper',StrFile);
         Reg.CloseKey;{将更改内容写入注册表并关闭}
         Systemparametersinfo(SPI_SETDESKWallpaper,,Pchar(StrFile),
            SPIF_upDateINIFIle Or SPIF_SENDWININICHANGE); // or SPIF_SendChange);{向Windows发送消息，通知Windows更换壁纸}
       end;
   finally
     Reg.Free;
   end;
 end;

SetRegWallPaper通知windows改变壁纸

 Procedure TFrmPlay.SetWallPaper(StrFile: String; Style: Integer);
 Var DT: IActiveDesktop;
     WPO: TWallpaperOpt;
     WS: WideString;
 begin
   DT := CreateComObject(CLSID_ActiveDesktop) As IActiveDesktop;
   WS := StrFile;
   Case Style Of
     : WPO.dwStyle := WPSTYLE_CENTER; {居中}
     : WPO.dwStyle := WPSTYLE_TILE; {平铺}
     : WPO.dwStyle := WPSTYLE_STRETCH; {拉伸}
   else WPO.dwStyle := WPSTYLE_CENTER;
   end;
   WPO.dwSize := SizeOf(WPO);
   DT.SetWallpaperOptions(WPO, );
   DT.SetWallPaper(PwideChar(WS),);
   DT.ApplyChanges(AD_APPLY_ALL);
 end;

SetWallPaper用指定方式改变壁纸