[cybervampire]

Доброго времени суток. Интересует такой вопрос.
Хочется сделать программу, которая будет работать как слайдшоу, но с ефектами переключения, и которая будет сохранять сразу несколько картинок в один файл. Прошу помощи, не знаю с чего начать просто.
заранее спасибо.

[lmikle]

TPaintBox, Canvas.ScanLine, TFileStream.

[NumLock]

Сообщение от cybervampire

которая будет сохранять сразу несколько картинок в один файл.

gif, avi??

[M.A.D.M.A.N.]

mkv
_____

[cybervampire]

Заготовку примерно сделал. Старый исходник
в общем в программе в корневом каталоге, находит все изображения *.jpg *.bmp и выдает в FileListBox смена происходит по таймеру или по нажатию клавиши.

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178

unit Unit4;   interface   uses   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,   Dialogs, ComCtrls, ShellCtrls, Grids, Outline, DirOutln, ExtCtrls,   StdCtrls, FileCtrl, Spin, Buttons, ToolWin, ActnMan, ActnCtrls, jpeg, Menus;   type   TForm4 = class(TForm)     ImgPhoto: TImage;     pnNavigation: TPanel;     DirectoryListBox1: TDirectoryListBox;     FileListBox1: TFileListBox;     CheckBox1: TCheckBox;     SpinEdit1: TSpinEdit;     Slideshow: TCheckBox;     Timer1: TTimer;     Label1: TLabel;     Label2: TLabel;     SpeedButton1: TSpeedButton;     SpeedButton2: TSpeedButton;     SpeedButton3: TSpeedButton;     SpeedButton4: TSpeedButton;     SpeedButton5: TSpeedButton;     procedure FileListBox1Change(Sender: TObject);     procedure CheckBox1Click(Sender: TObject);     procedure SlideshowClick(Sender: TObject);     procedure SpinEdit1Change(Sender: TObject);     procedure Timer1Timer(Sender: TObject);     procedure FormCreate(Sender: TObject);     procedure SpeedButton11Click(Sender: TObject);     procedure SpeedButton1Click(Sender: TObject);     procedure SpeedButton2Click(Sender: TObject);     procedure SpeedButton3Click(Sender: TObject);     procedure SpeedButton4Click(Sender: TObject);     procedure SpeedButton5Click(Sender: TObject);     private   { }   public     { Public declarations }   end;   var   Form4: TForm4;   pathapp:string;   implementation       {$R *.dfm}     procedure TForm4.CheckBox1Click(Sender: TObject); begin imgPhoto.Stretch:=checkbox1.Checked; end;   procedure TForm4.FileListBox1Change(Sender: TObject); Var   Ext:String;   JP:TJPEGImage;   Rect:TRect; begin   Screen.Cursor:=crAppStart; Try   If ((filelistbox1.FileName='') And (filelistbox1.Count<>0)) Then   Begin     filelistbox1.ItemIndex:=0;   End;     Ext:=ExtractFileExt(filelistbox1.FileName);   If ((Ext='.jpg') Or (Ext='.jpeg')) Then   Begin     JP:=TJPEGImage.Create;     JP.LoadFromFile(filelistbox1.FileName);     imgPhoto.Picture.Assign(JP);     JP.Free;   End   Else If Ext='.bmp' Then   Begin     imgPhoto.Picture.LoadFromFile(filelistbox1.FileName);   End   Else Begin     Rect.Left:=0; Rect.Top:=0; Rect.Right:=imgPhoto.Width-1; Rect.Bottom:=imgPhoto.Height-1;     imgPhoto.Picture.Bitmap.Width:=imgPhoto.Width;     imgPhoto.Picture.Bitmap.Height:=imgPhoto.Height;     imgPhoto.Picture.Bitmap.Canvas.Brush.Color:=clGray;     imgPhoto.Picture.Bitmap.Canvas.Brush.Style:=bsSolid;     imgPhoto.Picture.Bitmap.Canvas.FillRect(Rect);     imgPhoto.Picture.Bitmap.Canvas.Refresh;   End;   Except //  ShowMessage('Недопустимый формат файла!'); End;   Screen.Cursor:=crDefault; end;     procedure TForm4.FormCreate(Sender: TObject); begin pnnavigation.Visible:=false; pathapp:=getcurrentdir; Checkbox1.Checked:=false; slideshow.Checked:=false; Timer1.Enabled:=false;   end;     procedure TForm4.SlideshowClick(Sender: TObject); begin   spinedit1Change(Self);   Timer1.Enabled:=SlideShow.Checked; end;   procedure TForm4.SpeedButton11Click(Sender: TObject); begin PnNavigation.Visible:=true;   end;   procedure TForm4.SpeedButton1Click(Sender: TObject); begin timer1.Enabled:=false; end;   procedure TForm4.SpeedButton2Click(Sender: TObject); begin Slideshow.Checked:=true; end;   procedure TForm4.SpeedButton3Click(Sender: TObject); begin filelistbox1.ItemIndex:=filelistbox1.ItemIndex+1;     filelistbox1Change(Self); end;   procedure TForm4.SpeedButton4Click(Sender: TObject); begin filelistbox1.ItemIndex:=filelistbox1.ItemIndex-1;     filelistbox1Change(Self); end;   procedure TForm4.SpeedButton5Click(Sender: TObject); begin if Pnnavigation.Visible=true then Pnnavigation.Visible:=false else Pnnavigation.Visible:=true; if SpeedButton5.Caption='Меню Вкл' then SpeedButton5.Caption:='Меню Выкл' else SpeedButton5.Caption:='Меню Вкл' end;   procedure TForm4.SpinEdit1Change(Sender: TObject); begin Timer1.Interval:=Spinedit1.Value*1000; end;   procedure TForm4.Timer1Timer(Sender: TObject); begin If (filelistbox1.ItemIndex+1<filelistbox1.Count) Then   Begin     filelistbox1.ItemIndex:=filelistbox1.ItemIndex+1;     filelistbox1Change(Self);   End   Else If (filelistbox1.ItemIndex+1=filelistbox1.Count) And (filelistbox1.Count>0) Then   Begin     filelistbox1.ItemIndex:=0;     filelistbox1Change(Self);   End; end;   end.

Как реализовать еффекты, непонятно.
С канвой плохо знаком. Кто может помочь?

[NumLock]

самые простые эффекты это выплывание нового изображения сверху/снизу, слева/справа, мозаикой, постепенное проявление нового над старым.

[cybervampire]

Вот я задался вопросом как это реализовать? я без понятия. читал книжки, но ничего не нашел, подходящего так сказать.

[NumLock]

первые 4 эффекта реализуются копированием части нового изображения на канву старого с соответствующей стороны и позиции. по таймеру происходит изменение позиции копирования и размера копируемой области. 5-ый эффект реализуется выбором случайным образом копируемой области, так же с применением таймера, 6-ой через функцию AlphaBlend (тоже по таймеру изменяя прозрачность).

[poli-smen]

Сообщение от cybervampire

Как реализовать еффекты, непонятно.
С канвой плохо знаком. Кто может помочь?

Посмотри лучше готовые компоненты. Например PicShow Components.

[cybervampire]

спасибо, буду пробовать, результат потом напишу

[cybervampire]

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

Код:

1 2 3 4 5 6 7 8 9 10 11 12

// efflist это listbox if efflist.Enabled=true then   if efflist.ItemIndex=0 then     begin     rect.Left:=0; rect.Top:=-100; rect.Right:=imgphoto.Width-100;    rect.Bottom:=imgphoto.Height-100;     imgphoto.Picture.bitmap.width:=imgphoto.Width;     imgphoto.Picture.Bitmap.Height:=imgphoto.Height;     imgPhoto.Picture.Bitmap.Canvas.Brush.Color:=clblack;     imgPhoto.Picture.Bitmap.Canvas.Brush.Style:=bsSolid;     imgPhoto.Picture.Bitmap.Canvas.FillRect(Rect);     imgPhoto.Picture.Bitmap.Canvas.Refresh;     end;

Как еще и таймер реализовать?
P/S простите за дурацкие вопросы, просто плохо в это еще разбираюсь, но пытаюсь разобраться. Исходник прилагаеться

[YVitaliy]

У тебя уже реализован таймер, просто там где "Пуск слайдов" пропиши

Код:

1	timer1.Enabled:=true;

, а где "Стоп слайдов" -

Код:

1	timer1.Enabled:=False;

Насчет эффектов-тоже решимо, нужно просто подумать как реализовать, ведь размеры изображений разные. Чтобы было меньше проблем, их нужно "подгонять" под один размер при наложении эффекта.

ЗЫ Какие именно эффекты интересуют?

[cybervampire]

Интересуют:
выход слева, справа, сверху, снизу, мозайка, жалюзи)

[YVitaliy]

Сообщение от cybervampire

Интересуют:
выход слева, справа, сверху, снизу, мозайка, жалюзи)

К сожалению, PowerPoint у меня не установлен, так что припомнить не могу, что это такое ( ). Кое-что попробую реализовать, но уже не сегодня. Завтра у меня выходной, похимичу. Кое-что сделаю обязательно (так как неоднократно уже делал )

[cybervampire]

буду весьма благодарен, просто и самому хочеться понять как это делается, чтобы в дальнейшем было чутка попроще