Сменщик обоев Рабочего стола

Хочу Вам честно признаться, что обожаю видеть на своем Рабочем столе не только упорядоченные иконки программ, но и красивую картинку. Каждая картинка у меня задерживается не более чем на одну неделю. И вот как-то вечером сменив, вручную, очередную картинку Рабочего стола я решил написать для этого специальную программу. Почитав несколько статей, найденных в глобальной сети, я нашел необходимую информацию и приступил к работе. И вот что из этого получилось.

Для начала нужно создать новый проект. Затем положить на форму следующие стандартные компоненты:

  • 1. Компонент CheckListBox - для хранения списка файлов;
  • 2. Компонент Image - для отображения текущей картинки;
  • 4. Диалог OpenPictureDialog - для открытия графических файлов.
  • 3. И некоторое количество кнопок SpeedButton;

Информация о картинке Рабочего стола находиться в системном реестре по адресу: HKEY_CURRENT_USER\Control Panel\Desktop. Имя картинки содержится в параметре WallPaper, а информация о положении картинки располагается в параметрах TileWallpaper и WallPaperStyle. Вот список соответствующих значений:

Параметр "По центру" "Растянуть" "Рядом"
TileWallpaper 0 0 1
WallPaperStyle 0 2 0

И начнем мы с процедуры для автозапуска программы при старте Windows. Для этого по соответствующему адресу системного реестра занесем имя программы и ее путь: HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run

...
// Описание глобальных переменных 
Var
  Form1  : TForm1;
  SS     : TSearchRec; // Переменная для поиска файлов
  Path   : String;     // Переменная для указания пути к файлам
  PicPos : String;     // Переменная для задания положения картинки на Рабочем столе
...

procedure TForm1.AutoRun(ProgTitle, Command: String; RunOnce: Boolean);
Var Key : String;
    Reg : TRegIniFile;
begin
  If RunOnce = True Then Key:='Once' Else Key:='';
  Reg:=TRegIniFile.Create;
  Reg.RootKey:=HKEY_LOCAL_MACHINE;
  Reg.WriteString('Software\Microsoft' + '\Windows\CurrentVersion\Run' +
                   Key + #0, ProgTitle, Command);
  Reg.Free;
end;

Процедура для задания необычного фона, который берется из картинки. Если файл был умышленно удален, то программа не будет загружена:

procedure TForm1.FormPaint(Sender: TObject);
Var BMP_Back: TBitmap;
begin
 Try
   BMP_Back:=TBitmap.Create;
   BMP_Back.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Back.bmp');
   Canvas.Draw(-1, -20, BMP_Back);
   BMP_Back.Free;
 Except
   Form1.Visible:=False;
   Application.MessageBox('Файл Back.bmp для фона программы не найден !',
                          'CoolWall - Сменщик обоев Рабочего стола',
                           MB_OK + MB_ICONERROR);
   Form1.Close;
 End;  
end;

В процедуру создания формы мы вызываем процедуру автозапуска программы, задаем форме нестандартный вид, считываем значение пути к графическим файлам и производим их поиск и загрузку в список:

procedure TForm1.FormCreate(Sender: TObject);
Var Rgn1 : HRGN;
    I    : Integer;
    Ini  : TIniFile;
begin
 // Вызов процедуры автозапуска программы
 AutoRun('CoolWall', (ExtractFilePath(Application.ExeName) + 'CoolWall.exe'), False);

 // Делаем форму не стандартного вида, в виде овала без заголовка 
 Rgn1:=CreateRoundRectRgn(5, 22, 640, 380, 180, 180);
 SetWindowRgn(Handle, Rgn1, True);

 // Считываем последний указанный путь с графическими файлами
 Ini:=TIniFile.Create(ExtractFilePath(Application.ExeName) + 'CoolWall.ini');
 Path:=Ini.ReadString('Main', 'LastPath', Path);

 // Последовательно ищем файлы формата .jpg и .bmp 
 If FindFirst(Path + '*.bmp', faAnyFile, SS) = 0
   Then CheckListBox1.Items.Add(Path + SS.Name);

 While FindNext(SS) = 0 Do CheckListBox1.Items.Add(Path + SS.Name);
 FindClose(SS);

 If FindFirst(Path + '*.jpg', faAnyFile, SS) = 0
   Then CheckListBox1.Items.Add(Path + SS.Name);

 While FindNext(SS) = 0 Do CheckListBox1.Items.Add(Path + SS.Name);
 FindClose(SS);

 // Все строки CheckListBox устанавливаем во включенное состояние
 For I:=1 To CheckListBox1.Items.Count Do CheckListBox1.Checked[I-1]:=True;

 // Если список файла не пуст, то загружаем первую картинку и отображаем путь
 If CheckListBox1.Items.Count <> 0 Then
   Begin
     Image1.Picture.LoadFromFile(CheckListBox1.Items.Strings[0]);
     Label2.Caption:=CheckListBox1.Items.Strings[0];
   End;
end;

Так как форма не содержит заголовка, то делаем возможность перетаскивания формы за любое место, а не только за заголовок:

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 If Button = mbLeft Then
   Begin
     ReleaseCapture;
     Form1.Perform(WM_SYSCOMMAND, $F012, 0);
   End;
end;

Кнопка "Открыть". При нажатии на кнопку происходит заполнение списка файлов, и путь к этим файлам автоматически сохраняется в файл инициализации:

procedure TForm1.btnOpenClick(Sender: TObject);
Var I   : Integer;
    Ini : TIniFile;
begin
 If OpenPictureDialog1.Execute Then
   Begin
     CheckListBox1.Clear;
     For I:=0 To OpenPictureDialog1.Files.Count-1
       Do CheckListBox1.Items.Add(OpenPictureDialog1.Files.Strings[I]);
   End;

 For I:=0 To CheckListBox1.Items.Count-1 Do CheckListBox1.Checked[I]:=True;
 Image1.Visible:=True;

 Ini:=TIniFile.Create(ExtractFilePath(Application.ExeName) + 'CoolWall.ini');
 Ini.WriteString('Main', 'LastPath', Path);
 Ini.Free;
end;

Кнопка для указания параметра "По центру":

procedure TForm1.btnCenterClick(Sender: TObject);
begin
 PicPos:='По центру';
end;

Кнопка для указания параметра "Растянуть":

procedure TForm1.btnRastClick(Sender: TObject);
begin
 PicPos:='Растянуть';
end;

Кнопка для указания параметра "Рядом":

procedure TForm1.btnRadClick(Sender: TObject);
begin
 PicPos:='Рядом';
end;

Главная процедура для указания картинки Рабочего стола и положения картинки: 

procedure TForm1.btnOKClick(Sender: TObject);
Var Reg : TRegistry;
    BMP : TBitmap;
    JPG : TJPEGImage;
begin
 If CheckListBox1.Items.Count = 0 Then
   Application.MessageBox('Файл не указан !', 'Ошибка:', MB_OK + MB_ICONERROR)
 Else
   Begin
     BMP:=TBitmap.Create;
     JPG:=TJPEGImage.Create;

     Reg:=TRegistry.Create;
     Reg.RootKey:=HKEY_CURRENT_USER;

     Try
       If Reg.OpenKey('Control Panel\Desktop', False) Then
         Begin
           Reg.WriteString('WallPaper', 'C:\WINDOWS\CoolWall.bmp');
           If PicPos = 'По центру' Then
             Begin
               Reg.WriteString('TileWallpaper', '0');
               Reg.WriteString('WallPaperStyle', '0');
             End
           Else
             If PicPos = 'Растянуть' Then
               Begin
                 Reg.WriteString('TileWallpaper', '0');
                 Reg.WriteString('WallPaperStyle', '2');
               End
             Else
               If PicPos = 'Рядом' Then
                 Begin
                   Reg.WriteString('TileWallpaper', '1');
                   Reg.WriteString('WallPaperStyle', '0');
                 End;
         End;
       Reg.CloseKey;
     Finally
       Reg.Free;
     End;

     // Если файл с списке имеет формат .jpg то переводим его в формат .bmp
     If CheckListBox1.Checked[CheckListBox1.ItemIndex] Then
       If ExtractFileExt(CheckListBox1.Items.Strings[CheckListBox1.ItemIndex]) = '.jpg'
         Then
           Begin
             JPG.LoadFromFile(CheckListBox1.Items.Strings[CheckListBox1.ItemIndex]);
             BMP.Assign(JPG);
             BMP.SaveToFile('C:\WINDOWS\CoolWall.bmp');
           End
       Else
         If ExtractFileExt(CheckListBox1.Items.Strings[CheckListBox1.ItemIndex]) = '.bmp'
           Then
             Begin
               BMP.LoadFromFile(CheckListBox1.Items.Strings[CheckListBox1.ItemIndex]);
               BMP.SaveToFile('C:\WINDOWS\CoolWall.bmp');
             End;

     JPG.Free;
     BMP.Free;

     // А вот самая главная функция всей программы
     SystemParametersInfo(SPI_SETDESKWALLPAPER,
                          0,
                          Nil,
                          SPIF_SENDCHANGE);
   End;
end;

Процедура для навигации по списку файлов. Если текущая строка списка находиться во включенном состоянии, то соответствующая картинка и ее путь будут отображены, если же она находиться в выключенном состоянии, то картинка и ее путь отображена не будет:

procedure TForm1.CheckListBox1Click(Sender: TObject);
begin
 If CheckListBox1.Checked[CheckListBox1.ItemIndex] = False Then
   Begin
     Label2.Caption:='Не активен';
     Image1.Visible:=False;
   End
 Else
   Begin
     Label2.Caption:=CheckListBox1.Items.Strings[CheckListBox1.ItemIndex];
     Image1.Visible:=True;
     Image1.Picture.LoadFromFile(CheckListBox1.Items.Strings[CheckListBox1.ItemIndex]);
   End;
end;

Процедура для очистки списка файлов:

procedure TForm1.btnClearClick(Sender: TObject);
begin
 If CheckListBox1.Items.Count = 0
   Then Application.MessageBox('Список файлов пуст !', 'Внимание:', MB_OK + MB_ICONERROR)
 Else
   Begin
     CheckListBox1.Clear;
     Image1.Visible:=False;
   End;  
end;

Кнопка для навигации по списку файлов вперед:

procedure TForm1.btnNextClick(Sender: TObject);
begin
 If CheckListBox1.Items.Count = 0
   Then Application.MessageBox('Список файлов пуст !', 'Внимание:', MB_OK + MB_ICONERROR)
 Else
   Begin
     If CheckListBox1.ItemIndex = CheckListBox1.Items.Count-1
       Then CheckListBox1.ItemIndex:=-1;

     If CheckListBox1.ItemIndex = -1 Then CheckListBox1.ItemIndex:=0
       Else CheckListBox1.ItemIndex:=CheckListBox1.ItemIndex + 1;

     If CheckListBox1.CanFocus Then CheckListBox1.SetFocus;
     CheckListBox1Click(Sender);
   End;
end;

Кнопка для навигации по списку файлов назад:

procedure TForm1.bntPriorClick(Sender: TObject);
begin
 If CheckListBox1.Items.Count = 0
   Then Application.MessageBox('Список файлов пуст !', 'Внимание:', MB_OK + MB_ICONERROR)
 Else
  Begin
    If CheckListBox1.ItemIndex = -1 Then CheckListBox1.ItemIndex:=0;

    If CheckListBox1.ItemIndex = 0 Then CheckListBox1.ItemIndex:=CheckListBox1.Items.Count-1
      Else CheckListBox1.ItemIndex:=CheckListBox1.ItemIndex-1;
 
    If CheckListBox1.CanFocus Then CheckListBox1.SetFocus;
    CheckListBox1Click(Sender);
  End;  
end;

При выходе из программы сохраняем последний указанный путь к графическим файлам:

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
Var Ini: TIniFile;
begin
 Ini:=TIniFile.Create(ExtractFilePath(Application.ExeName) + 'CoolWall.ini');

 If Path = '' Then Ini.WriteString('Main', 'LastPath', ExtractFilePath(Application.ExeName))
   Else Ini.WriteString('Main', 'LastPath', Path);

 Ini.Free;
end;

Вернуться в оглавление
Вернуться на главную страницу
Hosted by uCoz