home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 March / Chip_2002-03_cd1.bin / zkuste / delphi / kompon / d3456 / PICSHOW.ZIP / Demo / Main.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-12-29  |  8.3 KB  |  308 lines
  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   jpeg, ExtCtrls, StdCtrls, Spin, PicShow;
  8.  
  9. type
  10.   TMainForm = class(TForm)
  11.     Panel1: TPanel;
  12.     Step: TSpinEdit;
  13.     Style: TSpinEdit;
  14.     Label1: TLabel;
  15.     Label2: TLabel;
  16.     Threaded: TCheckBox;
  17.     Bevel1: TBevel;
  18.     Bevel2: TBevel;
  19.     PicShow: TPicShow;
  20.     Panel2: TPanel;
  21.     Timer: TTimer;
  22.     ManualStyle: TRadioButton;
  23.     TurnStyle: TRadioButton;
  24.     RandomStyle: TRadioButton;
  25.     SelectFolder: TButton;
  26.     CurrentFilename: TPanel;
  27.     FreeMemory: TPanel;
  28.     Label3: TLabel;
  29.     Delay: TSpinEdit;
  30.     Panel3: TPanel;
  31.     ScrollBar: TScrollBar;
  32.     Panel4: TPanel;
  33.     Auto: TCheckBox;
  34.     Label4: TLabel;
  35.     ShowPause: TSpinEdit;
  36.     ClearOldImage: TCheckBox;
  37.     Bevel3: TBevel;
  38.     procedure FormCreate(Sender: TObject);
  39.     procedure FormDestroy(Sender: TObject);
  40.     procedure PicShowDblClick(Sender: TObject);
  41.     procedure ThreadedClick(Sender: TObject);
  42.     procedure StyleChange(Sender: TObject);
  43.     procedure StepChange(Sender: TObject);
  44.     procedure TimerTimer(Sender: TObject);
  45.     procedure PicShowComplete(Sender: TObject);
  46.     procedure ManualStyleClick(Sender: TObject);
  47.     procedure AutoClick(Sender: TObject);
  48.     procedure SelectFolderClick(Sender: TObject);
  49.     procedure ScrollBarChange(Sender: TObject);
  50.     procedure PicShowProgress(Sender: TObject);
  51.     procedure DelayChange(Sender: TObject);
  52.     procedure PicShowCustomDraw(Sender: TObject; Picture, Screen: TBitmap);
  53.   private
  54.     PicPath: String;
  55.     Pictures: TStringList;
  56.     procedure CheckTimer;
  57.     procedure ShowNextImage;
  58.     procedure LoadNextImage;
  59.     procedure CreateImageList(const Path: String);
  60.     procedure UpdateMemoryStatus(Sender: TObject; var Done: Boolean);
  61.   end;
  62.  
  63. var
  64.   MainForm: TMainForm;
  65.  
  66. implementation
  67.  
  68. {$R *.DFM}
  69.  
  70. uses
  71.   FileCtrl;
  72.  
  73. procedure TMainForm.FormCreate(Sender: TObject);
  74. begin
  75.   Randomize;
  76.   // Updates controls by PicShow properties
  77.   Style.MaxValue := High(TShowStyle);
  78.   Style.Value := PicShow.Style;
  79.   Threaded.Checked := PicShow.Threaded;
  80.   Step.Value := PicShow.Step;
  81.   Delay.Value := PicShow.Delay;
  82.   ManualStyle.Checked := PicShow.Manual;
  83.   ScrollBar.Enabled := ManualStyle.Checked;
  84.   // On idle time shows percentage of free physical memory
  85.   Application.OnIdle := UpdateMemoryStatus;
  86.   // Creates list of images and fills it by images found in the program path
  87.   Pictures := TStringList.Create;
  88.   CreateImageList(ExtractFilePath(Application.ExeName) + 'Photos');
  89.   // Loads an image to Picshow
  90.   LoadNextImage;
  91.   // Updates the timer status
  92.   CheckTimer;
  93. end;
  94.  
  95. procedure TMainForm.FormDestroy(Sender: TObject);
  96. begin
  97.   Pictures.Free;
  98. end;
  99.  
  100. procedure TMainForm.PicShowDblClick(Sender: TObject);
  101. begin
  102.   ShowNextImage;
  103. end;
  104.  
  105. procedure TMainForm.StyleChange(Sender: TObject);
  106. var
  107.   CursorPos: TPoint;
  108. begin
  109.   PicShow.Style := Style.Value;
  110.   Style.Hint := PicShow.StyleName;
  111.   GetCursorPos(CursorPos);
  112.   if PtInRect(Style.BoundsRect, Style.Parent.ScreenToClient(CursorPos)) then
  113.     Application.ActivateHint(CursorPos);
  114. end;
  115.  
  116. procedure TMainForm.ThreadedClick(Sender: TObject);
  117. begin
  118.   PicShow.Threaded := Threaded.Checked;
  119. end;
  120.  
  121. procedure TMainForm.StepChange(Sender: TObject);
  122. begin
  123.   PicShow.Step := Step.Value;
  124. end;
  125.  
  126. procedure TMainForm.TimerTimer(Sender: TObject);
  127. begin
  128.   ShowNextImage;
  129. end;
  130.  
  131. procedure TMainForm.PicShowComplete(Sender: TObject);
  132. begin
  133.   // When PicShow draws the image completely, we load the next image into it.
  134.   // Of course, we can load the image every time even when PicShow is busy.
  135.   // PicShow converts the image to Bitmap and use this copy in its process.
  136.   LoadNextImage;
  137.   CheckTimer;
  138. end;
  139.  
  140. procedure TMainForm.ManualStyleClick(Sender: TObject);
  141. begin
  142.   PicShow.Manual := ManualStyle.Checked;
  143.   ScrollBar.Enabled := ManualStyle.Checked;
  144.   if PicShow.Manual then
  145.   begin
  146.     // When PicShow is in manual mode, we must first call execute and after it
  147.     // we can change the progress. If PicShow is already busy, calling execute
  148.     // is not required.
  149.     if not (PicShow.Busy or PicShow.Empty) then
  150.       PicShow.Execute;
  151.     ScrollBar.Position := PicShow.Progress;
  152.   end;
  153.   CheckTimer;
  154. end;
  155.  
  156. procedure TMainForm.AutoClick(Sender: TObject);
  157. begin
  158.   CheckTimer;
  159. end;
  160.  
  161. procedure TMainForm.SelectFolderClick(Sender: TObject);
  162. var
  163.   Path: String;
  164. begin
  165.   Path := PicPath;
  166.   if SelectDirectory(Path, [], 0) then
  167.   begin
  168.     CreateImageList(Path);
  169.     CheckTimer;
  170.   end;
  171. end;
  172.  
  173. procedure TMainForm.ScrollBarChange(Sender: TObject);
  174. begin
  175.   PicShow.Progress := ScrollBar.Position;
  176. end;
  177.  
  178. procedure TMainForm.PicShowProgress(Sender: TObject);
  179. begin
  180.   if ScrollBar.Enabled then
  181.     ScrollBar.Position := PicShow.Progress;
  182. end;
  183.  
  184. procedure TMainForm.DelayChange(Sender: TObject);
  185. begin
  186.   PicShow.Delay := Delay.Value;
  187. end;
  188.  
  189. // This procedure will be called when PicShow.Style is 0
  190. // Picture: This is the image.
  191. // Screen: This is what we should draw on it.
  192. procedure TMainForm.PicShowCustomDraw(Sender: TObject; Picture,
  193.   Screen: TBitmap);
  194. var
  195.   Text: String;
  196. begin
  197.   Text := Format('CUSTOM: PROGRESS = %d%%', [PicShow.Progress]);
  198.   Screen.Canvas.Draw(0, 0, Picture);
  199.   SetTextAlign(Screen.Canvas.Handle, TA_CENTER or TA_BASELINE);
  200.   Screen.Canvas.TextOut(Screen.Width div 2, Screen.Height div 2, Text);
  201. end;
  202.  
  203. // Turns timer on or off according to state of controls (UPDATED)
  204. procedure TMainForm.CheckTimer;
  205. var
  206.   EnableTimer: Boolean;
  207. begin
  208.   EnableTimer := not PicShow.Busy and Auto.Checked and
  209.     not ManualStyle.Checked and (Pictures.Count > 0);
  210.   if EnableTimer <> Timer.Enabled then
  211.   begin
  212.     if EnableTimer then
  213.       Timer.Interval := ShowPause.Value * 1000;
  214.     Timer.Enabled := EnableTimer;
  215.   end;
  216. end;
  217.  
  218. // Shows the currently loaded image into PicShow
  219. procedure TMainForm.ShowNextImage;
  220. begin
  221.   // if there is not any image in the list exit
  222.   if Pictures.Count = 0 then Exit;
  223.   // if PicShow is playing, stops it
  224.   if PicShow.Busy then
  225.   begin
  226.     PicShow.Stop;
  227.     // Stop method does not fire OnComplete event then we do it manually
  228.     PicShowComplete(Self);
  229.   end;
  230.   // Sets the animation style according to user sellection
  231.   if RandomStyle.Checked then
  232.     Style.Value := Random(High(TShowStyle))+1
  233.   else if TurnStyle.Checked then
  234.     if Style.Value < High(TShowStyle) then
  235.       Style.Value := Style.Value + 1
  236.     else
  237.       Style.Value := 1;
  238.   // Clears background if it is required (UPDATED)
  239.   if ClearOldImage.Checked then
  240.   begin
  241.     PicShow.Clear;
  242.     PicShow.Update;
  243.   end;
  244.   // Begins the animation
  245.   PicShow.Execute;
  246.   // Checks the timer state, usually turn it off
  247.   CheckTimer;
  248. end;
  249.  
  250. var
  251.   CurrentImage: String = '';
  252.  
  253. // Selects randomly an image from the image list and loades it into PicShow
  254. procedure TMainForm.LoadNextImage;
  255. var
  256.   Index: Integer;
  257. begin
  258.   if Pictures.Count > 0 then
  259.   begin
  260.     repeat
  261.       Index := Random(Pictures.Count);
  262.     until (Pictures.Count <= 1) or (CurrentImage <> Pictures[Index]);
  263.     CurrentImage := Pictures[Index];
  264.     PicShow.Picture.LoadFromFile(PicPath + CurrentImage);
  265.     CurrentFilename.Caption := CurrentImage;
  266.   end;
  267. end;
  268.  
  269. // Creates a list of image filenames found in the path
  270. procedure TMainForm.CreateImageList(const Path: String);
  271. var
  272.   FileList: TFileListBox;
  273. begin
  274.   FileList := TFileListBox.Create(Self);
  275.   try
  276.     FileList.Parent := Self;
  277.     FileList.Visible := False;
  278.     FileList.Mask := GraphicFileMask(TGraphic);
  279.     FileList.Directory := Path;
  280.     if FileList.Items.Count > 0 then
  281.     begin
  282.       Pictures.Assign(FileList.Items);
  283.       if (Length(Path) > 0) and (Path[Length(Path)] <> '\') then
  284.         PicPath := Path + '\'
  285.       else
  286.         PicPath := Path;
  287.     end
  288.     else
  289.       MessageDlg(Path + #10#13'does not contain any supported image file',
  290.         mtWarning, [mbOK], 0);
  291.   finally
  292.     FileList.Free;
  293.   end;
  294. end;
  295.  
  296. // Updates percentage of available physical memory on the screen
  297. procedure TMainForm.UpdateMemoryStatus(Sender: TObject; var Done: Boolean);
  298. var
  299.   MemoryStatus: TMemoryStatus;
  300. begin
  301.   GlobalMemoryStatus(MemoryStatus);
  302.   FreeMemory.Caption := Format('Free Memory: %%%.1f',
  303.     [100. * MemoryStatus.dwAvailPhys / MemoryStatus.dwTotalPhys]);
  304.   FreeMemory.Update;
  305. end;
  306.  
  307. end.
  308.