Parsi Coders

باسلام خدمت دوستان عزیزم _ آرزو میکنم موفق و سربلند باشید ...

من سورس تغییر عکس پس زمینه ویندوز به زبان دلفی رو میخام برای پروژه پایانی کارشناسی میخام فقط به زبان دلفی باشه خیلی ممنون میشم لینک دانلودش رو برام بزارید.
با گرفتن عکس از مسیر داریور ها اون عکس رو تو یه پیکچر باکس نشون بده و با انتخاب نوع عکس (Stretch،Tile،Center)اون رو ثت بکنه رو صفحه پس زمینه خیلی ممنون میشم. اگه به صورت تصادفی هم عکس ها رو عوض بکنه خیلی ممنون میشم. با تشکر از سایت خیلی خیلی مفید شما.

کسی نیست ما رو کمک کنه - من یه همچین سورسی به زبان های دیگه دارم مثل C#.net و vb.net دارم اگه کسی بلده میتونه اون رو به زبان دلفی بنویسه یا برنامه هست که کد vb.net یا کدC#.net روبه دلفی تبدیل کنه لطفا کمکم کنید. ...

کد:
// 1.Way:

uses

  Registry;

procedure SetWallpaper(sWallPaperBMPPath: string; bTile: Boolean);

var

  reg: TRegIniFile;

begin

  reg := TRegIniFile.Create('Control Panel\Desktop');

  try

    with reg do

    begin

      WriteString('', 'Wallpaper', sWallPaperBMPPath);

      WriteString('', 'TileWallpaper', IntToStr(Ord(bTile)));

    end;

  finally

    reg.Free;

  end;

  SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, nil, SPIF_SENDWININICHANGE);

end;

// 2. Way:

procedure TForm1.Button1Click(Sender: TObject);

var

  sWallPaperBMPPath: string;

begin

  sWallPaperBMPPath := 'C:\[WinDIR]\wall.bmp';

  if not SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, Pointer(sWallPaperBMPPath),

    SPIF_SENDWININICHANGE) then

    ShowMessage('Succesful.')

  else

    ShowMessage('Failed!');

end;

// 3. Set the wallpaper for the Active Desktop.

{

  You may have noticed that using SystemParametersInfo to change the wallpaper

  when ActiveDesktop is turned on doesn't work. The reason is because you need

  to use the IActiveDesktop COM interface. Using SystemParametersInfo still works,

  but it doesn't update the wallpaper.

  Requires Internet Explorer 4.0 or later).

}

uses

  ShlObj, ComObj;

function ChangeWallpaper(aFile: String): Boolean;

const

  CLSID_ActiveDesktop: TGUID = '{75048700-EF1F-11D0-9888-006097DEACF9}';

var

  hObj: IUnknown;

  ADesktop: IActiveDesktop;

  str: string;

  wstr: PWideChar;

begin

  hObj     := CreateComObject(CLSID_ActiveDesktop);

  ADesktop := hObj as IActiveDesktop;

  wstr := AllocMem(MAX_PATH);

  try

    StringToWideChar(aFile, wstr, MAX_PATH);

    ADesktop.SetWallpaper(wstr, 0);

    ADesktop.ApplyChanges(AD_APPLY_ALL or AD_APPLY_FORCE);

  finally

    FreeMem(wstr);

  end;

end;

واسه بقیه سورس کدها:
http://delphi-kb.blogspot.com/2011/01/ch...-code.html

hpnz

hpnz

Amin_Mansouri