⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 screensafe.pas

📁 销售帐目管理
💻 PAS
字号:
unit ScreenSafe;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, PicShow, ExtCtrls, FileCtrl ;

const WM_ExitMessage = WM_USER + 1;

type
  TFrmScreenSafe = class(TForm)
    PicShow: TPicShow;
    Timer: TTimer;
    procedure PicShowStart(Sender: TObject; Picture, Screen: TBitmap);
    procedure PicShowStop(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure PicShowDblClick(Sender: TObject);
    procedure FormKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    Pictures: TStringList;
    FirstActivate: Boolean;
    ShownImage: String;
    LoadedImage: String;
    procedure CheckTimer;
    procedure LoadNextImage;//导入下一幅图片
    procedure ShowNextImage;//显示下一幅图片
    procedure CreateImageList(const Path: String);//通过指定路径创建图像列表
  public
    { Public declarations }
  end;

var
  FrmScreenSafe: TFrmScreenSafe;

implementation

uses PubUnit;

{$R *.dfm}

procedure TFrmScreenSafe.CheckTimer;
var T : Boolean ;
begin
  T := ((not PicShow.Busy) and (P_AutoStyle) and
        (not P_ManualStyle) and (Pictures.Count > 0));
  Timer.Enabled := T ;
    {not PicShow.Busy and P_AutoStyle and
    not P_ManualStyle and (Pictures.Count > 0);}
end;

procedure TFrmScreenSafe.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;

procedure TFrmScreenSafe.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 P_RandomStyle then
    P_StyleValue := Random(High(TShowStyle))+1
  else if P_TurnStyle then
    if P_StyleValue < High(TShowStyle) then
      Inc(P_StyleValue)
//      Style.Value := Style.Value + 1
    else
      P_StyleValue := 1;
//      Style.Value := 1;
  PicShow.Style := P_StyleValue ;
  // Updates image name status
{  ShownImage := LoadedImage;
  RunningFilename.Caption := 'Showing: ' + ShownImage;
  RunningFilename.Update;}
  // Begins the animation
  PicShow.Execute;
end;

// Creates a list of image filenames found in the path
procedure TFrmScreenSafe.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'没有找到所需要显示的图片文件!',
        mtWarning, [mbOK], 0);
  finally
    FileList.Free;
  end;
end;

procedure TFrmScreenSafe.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 TFrmScreenSafe.PicShowStop(Sender: TObject);
begin
  CheckTimer;
end;

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

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

procedure TFrmScreenSafe.FormShow(Sender: TObject);
begin
  ShowCursor(false);//隐藏鼠标
  {构造相册菜单}
  PicShow.Style := P_StyleValue ;
  PicShow.Threaded := P_Threaded ;
  PicShow.Step := P_StepValue ;
  PicShow.Delay := P_DelayValue ;
  PicShow.OverDraw := not P_ClearOldImage ;
  Pictures := TStringList.Create;
  if DirectoryExists(PicPath) then
     CreateImageList(PicPath)
  else
     CreateImageList(ExtractFilePath(Application.ExeName));
  // Loads an image into Picshow
  Timer.Interval := P_ShowPause * 1000;
  LoadNextImage;
  FirstActivate := True;
end;

procedure TFrmScreenSafe.FormDestroy(Sender: TObject);
begin
  ShowCursor(True);//显示鼠标
  Pictures.Free ;
end;

procedure TFrmScreenSafe.FormCreate(Sender: TObject);
begin
  Top := 0 ;
  Left := 0 ;
  Width := Screen.Width ;
  Height := Screen.Height ;
end;

procedure TFrmScreenSafe.PicShowDblClick(Sender: TObject);
begin
  Timer.Enabled := False ;
  PicShow.Stop ;
  Close ;
end;

procedure TFrmScreenSafe.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if ((key = VK_ESCAPE) or (Key =VK_RETURN)) then Close ;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -