main.pas

TPicShow是一套图形平滑特效控制组件

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  jpeg, ExtCtrls, StdCtrls, Spin, PicShow;

type
  TMainForm = class(TForm)
    Panel1: TPanel;
    Step: TSpinEdit;
    Style: TSpinEdit;
    Label1: TLabel;
    Label2: TLabel;
    Threaded: TCheckBox;
    Bevel1: TBevel;
    Bevel2: TBevel;
    PicShow: TPicShow;
    Panel2: TPanel;
    Timer: TTimer;
    ManualStyle: TRadioButton;
    TurnStyle: TRadioButton;
    RandomStyle: TRadioButton;
    SelectFolder: TButton;
    RunningFilename: TPanel;
    FreeMemory: TPanel;
    Label3: TLabel;
    Delay: TSpinEdit;
    Panel3: TPanel;
    ScrollBar: TScrollBar;
    Panel4: TPanel;
    Auto: TCheckBox;
    Label4: TLabel;
    ShowPause: TSpinEdit;
    ClearOldImage: TCheckBox;
    Bevel3: TBevel;
    NextFilename: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure PicShowDblClick(Sender: TObject);
    procedure ThreadedClick(Sender: TObject);
    procedure StyleChange(Sender: TObject);
    procedure StepChange(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
    procedure ManualStyleClick(Sender: TObject);
    procedure AutoClick(Sender: TObject);
    procedure SelectFolderClick(Sender: TObject);
    procedure ScrollBarChange(Sender: TObject);
    procedure PicShowProgress(Sender: TObject);
    procedure DelayChange(Sender: TObject);
    procedure PicShowCustomDraw(Sender: TObject; Picture, Screen: TBitmap);
    procedure FormActivate(Sender: TObject);
    procedure PicShowStart(Sender: TObject; Picture, Screen: TBitmap);
    procedure PicShowStop(Sender: TObject);
    procedure ShowPauseChange(Sender: TObject);
    procedure ClearOldImageClick(Sender: TObject);
  private
    PicPath: String;
    Pictures: TStringList;
    FirstActivate: Boolean;
    ShownImage: String;
    LoadedImage: String;
    procedure CheckTimer;
    procedure ShowNextImage;
    procedure LoadNextImage;
    procedure CreateImageList(const Path: String);
    procedure UpdateMemoryStatus(Sender: TObject; var Done: Boolean);
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

uses
  FileCtrl;

procedure CopyGraphicToBitmap(Graphic: TGraphic; Bitmap: TBitmap; 
  MaxWidth, MaxHeight: Integer; ShrinkOnly: Boolean); 
var 
  Width, Height: Integer; 
begin 
  Width := Graphic.Width; 
  Height := Graphic.Height; 
  if not ShrinkOnly or (Width > MaxWidth) or (Height > MaxHeight) then 
  begin 
    if (MaxWidth / Width) < (MaxHeight / Height) then 
    begin 
      Height := MulDiv(Height, MaxWidth, Width); 
      Width := MaxWidth; 
    end 
    else 
    begin 
      Width := MulDiv(Width, MaxHeight, Height); 
      Height := MaxHeight; 
    end; 
  end; 
  Bitmap.Width := Width; 
  Bitmap.Height := Height; 
  with Bitmap.Canvas do StretchDraw(ClipRect, Graphic);
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  Randomize;
  {$IFNDEF VER100}
  ScrollBar.Align := alBottom;
  {$ENDIF}
  // Updates controls by PicShow properties
  Style.MaxValue := High(TShowStyle);
  Style.Value := PicShow.Style;
  Threaded.Checked := PicShow.Threaded;
  Step.Value := PicShow.Step;
  Delay.Value := PicShow.Delay;
  ManualStyle.Checked := PicShow.Manual;
  ScrollBar.Enabled := ManualStyle.Checked;
  ClearOldImage.Checked := not PicShow.OverDraw;
  // On idle time shows percentage of free physical memory
  Application.OnIdle := UpdateMemoryStatus;
  // Creates list of images and fills it by images found in the program path
  Pictures := TStringList.Create;
  if ParamCount > 0 then
    CreateImageList(ParamStr(1))
  else
    CreateImageList(ExtractFilePath(Application.ExeName) + 'Photos');
  // Loads an image into Picshow
  Timer.Interval := ShowPause.Value * 1000;
  LoadNextImage;
  FirstActivate := True;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  Pictures.Free;
end;

procedure TMainForm.FormActivate(Sender: TObject);
begin
  if FirstActivate then
  begin
    FirstActivate := False;
    Update;
    ShowNextImage;
  end;
end;

procedure TMainForm.PicShowDblClick(Sender: TObject);
begin
  PicShow.Enabled := False; // To perevent reentrance
  try
    ShowNextImage;
  finally
    PicShow.Enabled := True;
  end;
end;

procedure TMainForm.StyleChange(Sender: TObject);
{$IFNDEF VER100}
{$IFNDEF VER120}
var
  CursorPos: TPoint;
{$ENDIF}
{$ENDIF}
begin
  PicShow.Style := Style.Value;
  Style.Hint := PicShow.StyleName;
  {$IFNDEF VER100}
  {$IFNDEF VER120}
  GetCursorPos(CursorPos);
  if PtInRect(Style.BoundsRect, Style.Parent.ScreenToClient(CursorPos)) then
    Application.ActivateHint(CursorPos);
  {$ENDIF}
  {$ENDIF}
end;

procedure TMainForm.ThreadedClick(Sender: TObject);
begin
  PicShow.Threaded := Threaded.Checked;
end;

procedure TMainForm.StepChange(Sender: TObject);
begin
  PicShow.Step := Step.Value;
end;

procedure TMainForm.TimerTimer(Sender: TObject);
begin
  ShowNextImage;
end;

procedure TMainForm.PicShowStart(Sender: TObject; Picture, Screen: TBitmap);
begin
  CheckTimer;
  // When PicShow begins transaction, we can load the next image into the
  // control. This is possible because PicShow converts the image to Bitmap
  // and use this copy during its process.
  LoadNextImage;
end;

procedure TMainForm.PicShowStop(Sender: TObject);
begin
  CheckTimer;
end;

procedure TMainForm.ManualStyleClick(Sender: TObject);
begin
  PicShow.Manual := ManualStyle.Checked;
  ScrollBar.Enabled := ManualStyle.Checked;
  if PicShow.Manual then
  begin
    // When PicShow is in manual mode, we must first call execute and after it
    // we can change the progress. If PicShow is already busy, calling execute
    // is not required.
    if not (PicShow.Busy or PicShow.Empty) then
      PicShow.Execute;
    ScrollBar.Position := PicShow.Progress;
  end;
  CheckTimer;
end;

procedure TMainForm.AutoClick(Sender: TObject);
begin
  CheckTimer;
end;

procedure TMainForm.SelectFolderClick(Sender: TObject);
var
  Path: String;
begin
  Path := PicPath;
  if SelectDirectory(Path, [], 0) then
  begin
    CreateImageList(Path);
    CheckTimer;
  end;
end;

procedure TMainForm.ScrollBarChange(Sender: TObject);
begin
  PicShow.Progress := ScrollBar.Position;
end;

procedure TMainForm.PicShowProgress(Sender: TObject);
begin
  if ScrollBar.Enabled then
    ScrollBar.Position := PicShow.Progress;
end;

procedure TMainForm.DelayChange(Sender: TObject);
begin
  PicShow.Delay := Delay.Value;
end;

// This procedure will be called when PicShow.Style is 0
// Picture: This is the image.
// Screen: This is what we should draw on it.
procedure TMainForm.PicShowCustomDraw(Sender: TObject; Picture,
  Screen: TBitmap);
var
  Text: String;
begin
  Text := Format('CUSTOM: PROGRESS = %d%%', [PicShow.Progress]);
  Screen.Canvas.Draw(0, 0, Picture);
  Screen.Canvas.Font.Style := [fsBold];
  SetTextAlign(Screen.Canvas.Handle, TA_CENTER or TA_BASELINE);
  Screen.Canvas.TextOut(Screen.Width div 2, Screen.Height div 2, Text);
end;

// Turns timer on or off according to state of controls
procedure TMainForm.CheckTimer;
begin
  Timer.Enabled := not PicShow.Busy and Auto.Checked and
    not ManualStyle.Checked and (Pictures.Count > 0);
end;

// Begins animating the currently loaded image
procedure TMainForm.ShowNextImage;
begin
  Timer.Enabled := False;
  // if there is not any image in the list exit
  if Pictures.Count = 0 then Exit;
  // if PicShow is playing, stops it
  if PicShow.Busy then
    PicShow.Stop;
  // Sets the animation style according to user sellection
  if RandomStyle.Checked then
    Style.Value := Random(High(TShowStyle))+1
  else if TurnStyle.Checked then
    if Style.Value < High(TShowStyle) then
      Style.Value := Style.Value + 1
    else
      Style.Value := 1;
  // Updates image name status
  ShownImage := LoadedImage;
  RunningFilename.Caption := 'Showing: ' + ShownImage;
  RunningFilename.Update;
  // Begins the animation
  PicShow.Execute;
end;

// Selects randomly an image from the image list and loades it into PicShow
procedure TMainForm.LoadNextImage;
var
  Index: Integer;
begin
  LoadedImage := EmptyStr;
  if Pictures.Count > 0 then
  begin
    repeat
      Index := Random(Pictures.Count);
    until (Pictures.Count <= 1) or (ShownImage <> Pictures[Index]);
    LoadedImage := Pictures[Index];
    PicShow.Picture.LoadFromFile(PicPath + LoadedImage);
  end;
  NextFilename.Caption := 'Next: ' + LoadedImage;
  NextFilename.Update;
end;

// Creates a list of image filenames found in the path
procedure TMainForm.CreateImageList(const Path: String);
var
  FileList: TFileListBox;
begin
  FileList := TFileListBox.Create(nil);
  try
    FileList.Visible := False;
    FileList.Parent := Self;
    FileList.Mask := GraphicFileMask(TGraphic);
    FileList.Directory := Path;
    if FileList.Items.Count > 0 then
    begin
      Pictures.Assign(FileList.Items);
      if (Length(Path) > 0) and (Path[Length(Path)] <> '\') then
        PicPath := Path + '\'
      else
        PicPath := Path;
    end
    else
      MessageDlg(Path + #10#13'does not contain any supported image file',
        mtWarning, [mbOK], 0);
  finally
    FileList.Free;
  end;
end;

// Updates percentage of available physical memory on the screen
procedure TMainForm.UpdateMemoryStatus(Sender: TObject; var Done: Boolean);
var
  MemoryStatus: TMemoryStatus;
begin
  GlobalMemoryStatus(MemoryStatus);
  FreeMemory.Caption := Format('Free Memory: %%%.1f',
    [100. * MemoryStatus.dwAvailPhys / MemoryStatus.dwTotalPhys]);
  FreeMemory.Update;
end;

procedure TMainForm.ShowPauseChange(Sender: TObject);
begin
  Timer.Interval := ShowPause.Value * 1000;
end;

procedure TMainForm.ClearOldImageClick(Sender: TObject);
begin
  PicShow.OverDraw := not ClearOldImage.Checked;
end;

end.