Показать сообщение отдельно
  #5  
Старый 10.10.2012, 14:37
cybervampire cybervampire вне форума
Прохожий
 
Регистрация: 22.03.2012
Сообщения: 12
Репутация: 10
По умолчанию

Заготовку примерно сделал. Старый исходник
в общем в программе в корневом каталоге, находит все изображения *.jpg *.bmp и выдает в FileListBox смена происходит по таймеру или по нажатию клавиши.
Код:
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.
Как реализовать еффекты, непонятно.
С канвой плохо знаком. Кто может помочь?
Ответить с цитированием