main.pas

免费控件PicShow的最新版本

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  jpeg, ExtCtrls, StdCtrls, Spin, PicShow, Mask, DBCtrls, DBCGrids, Db,
  DBTables, ADODB, ExtDlgs, Buttons;

type
  TMainForm = class(TForm)
    Panel1: TPanel;
    Step: TSpinEdit;
    Style: TSpinEdit;
    Label1: TLabel;
    Label2: TLabel;
    Threaded: TCheckBox;
    Bevel1: TBevel;
    Bevel2: TBevel;
    DBPicShow: TDBPicShow;
    Panel2: TPanel;
    Timer: TTimer;
    ManualStyle: TRadioButton;
    TurnStyle: TRadioButton;
    RandomStyle: TRadioButton;
    FreeMemory: TPanel;
    Label3: TLabel;
    Delay: TSpinEdit;
    ScrollBarPanel: TPanel;
    ScrollBar: TScrollBar;
    Panel4: TPanel;
    Auto: TCheckBox;
    Label4: TLabel;
    ShowPause: TSpinEdit;
    ClearOldImage: TCheckBox;
    Bevel3: TBevel;
    ADOConnection: TADOConnection;
    ADOTable: TADOTable;
    DataSource: TDataSource;
    LoadPicBtn: TSpeedButton;
    OpenPictureDialog: TOpenPictureDialog;
    DBNavigator1: TDBNavigator;
    procedure FormCreate(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure DBPicShowDblClick(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 ScrollBarChange(Sender: TObject);
    procedure DBPicShowProgress(Sender: TObject);
    procedure DelayChange(Sender: TObject);
    procedure DBPicShowCustomDraw(Sender: TObject; Picture, Screen: TBitmap);
    procedure DBPicShowBeforeLoadPicture(Sender: TObject);
    procedure DBPicShowAfterLoadPicture(Sender: TObject);
    procedure DBPicShowComplete(Sender: TObject);
    procedure LoadPicBtnClick(Sender: TObject);
    procedure ShowPauseChange(Sender: TObject);
    procedure ClearOldImageClick(Sender: TObject);
    procedure DBPicShowStart(Sender: TObject; Picture, Screen: TBitmap);
    procedure DBPicShowStop(Sender: TObject);
  private
    procedure CheckTimer;
    procedure ShowNextImage;
    procedure UpdateMemoryStatus(Sender: TObject; var Done: Boolean);
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

procedure TMainForm.FormCreate(Sender: TObject);
begin
  Randomize;
  // Updates controls by DBPicShow properties
  Style.MaxValue := High(TShowStyle);
  Style.Value := DBPicShow.Style;
  Threaded.Checked := DBPicShow.Threaded;
  Step.Value := DBPicShow.Step;
  Delay.Value := DBPicShow.Delay;
  ClearOldImage.Checked := not DBPicShow.OverDraw;
  ManualStyle.Checked := DBPicShow.Manual;
  ScrollBarPanel.Visible := ManualStyle.Checked;
  // On idle time shows percentage of free physical memory
  Application.OnIdle := UpdateMemoryStatus;
  // Updates the timer status
  Timer.Interval := ShowPause.Value * 1000;
  // We want to start the transaction effect when the form is on the screen
  DBPicShow.AutoDisplay := False;
  // Activates the database connection
  ADOConnection.Connected := True;
  ADOTable.Active := ADOConnection.Connected;
end;

procedure TMainForm.FormActivate(Sender: TObject);
begin
  Update;
  DBPicShow.AutoDisplay := True;
  CheckTimer;
end;

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

procedure TMainForm.StyleChange(Sender: TObject);
var
  CursorPos: TPoint;
begin
  DBPicShow.Style := Style.Value;
  Style.Hint := DBPicShow.StyleName;
  GetCursorPos(CursorPos);
  if PtInRect(Style.BoundsRect, Style.Parent.ScreenToClient(CursorPos)) then
    Application.ActivateHint(CursorPos);
end;

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

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

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

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

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

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

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

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

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

// Sets transition effect before loading the image
procedure TMainForm.DBPicShowBeforeLoadPicture(Sender: TObject);
begin
  // Sets the animation style according to the user selection
  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;
end;

// Checks the timer status after loading the image
procedure TMainForm.DBPicShowAfterLoadPicture(Sender: TObject);
begin
  CheckTimer;
end;

// Checks the timer status after completion of the transition
procedure TMainForm.DBPicShowComplete(Sender: TObject);
begin
  CheckTimer;
end;

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

procedure TMainForm.LoadPicBtnClick(Sender: TObject);
begin
  if ADOTable.Active and OpenPictureDialog.Execute then
  begin
    if not (ADOTable.State in [dsEdit, dsInsert]) then
      ADOTable.Edit;
    DBPicShow.Picture.LoadFromFile(OpenPictureDialog.FileName);
  end;
end;

// Shows the next image in the table
procedure TMainForm.ShowNextImage;
begin
  if ADOTable.Active then
  begin
    ADOTable.Next;
    if ADOTable.Eof then
      ADOTable.First;
  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
  DBPicShow.OverDraw := not ClearOldImage.Checked;
end;

procedure TMainForm.DBPicShowStart(Sender: TObject; Picture,
  Screen: TBitmap);
begin
  CheckTimer;
end;

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

end.