home *** CD-ROM | disk | FTP | other *** search
/ Chip 2003 February / Chip_2003-02_cd1.bin / zkuste / delphi / kompon / d3456 / PICSHOW.ZIP / Demo / Main.pas < prev    next >
Pascal/Delphi Source File  |  2002-10-25  |  9KB  |  345 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.     RunningFilename: 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.     NextFilename: TPanel;
  39.     procedure FormCreate(Sender: TObject);
  40.     procedure FormDestroy(Sender: TObject);
  41.     procedure PicShowDblClick(Sender: TObject);
  42.     procedure ThreadedClick(Sender: TObject);
  43.     procedure StyleChange(Sender: TObject);
  44.     procedure StepChange(Sender: TObject);
  45.     procedure TimerTimer(Sender: TObject);
  46.     procedure PicShowStart(Sender: TObject);
  47.     procedure ManualStyleClick(Sender: TObject);
  48.     procedure AutoClick(Sender: TObject);
  49.     procedure SelectFolderClick(Sender: TObject);
  50.     procedure ScrollBarChange(Sender: TObject);
  51.     procedure PicShowProgress(Sender: TObject);
  52.     procedure DelayChange(Sender: TObject);
  53.     procedure PicShowCustomDraw(Sender: TObject; Picture, Screen: TBitmap);
  54.     procedure FormActivate(Sender: TObject);
  55.     procedure PicShowStop(Sender: TObject);
  56.     procedure ShowPauseChange(Sender: TObject);
  57.   private
  58.     PicPath: String;
  59.     Pictures: TStringList;
  60.     FirstActivate: Boolean;
  61.     ShownImage: String;
  62.     LoadedImage: String;
  63.     procedure CheckTimer;
  64.     procedure ShowNextImage;
  65.     procedure LoadNextImage;
  66.     procedure CreateImageList(const Path: String);
  67.     procedure UpdateMemoryStatus(Sender: TObject; var Done: Boolean);
  68.   end;
  69.  
  70. var
  71.   MainForm: TMainForm;
  72.  
  73. implementation
  74.  
  75. {$R *.DFM}
  76.  
  77. uses
  78.   FileCtrl;
  79.  
  80. procedure TMainForm.FormCreate(Sender: TObject);
  81. begin
  82.   Randomize;
  83.   {$IFNDEF VER100}
  84.   ScrollBar.Align := alBottom;
  85.   {$ENDIF}
  86.   // Updates controls by PicShow properties
  87.   Style.MaxValue := High(TShowStyle);
  88.   Style.Value := PicShow.Style;
  89.   Threaded.Checked := PicShow.Threaded;
  90.   Step.Value := PicShow.Step;
  91.   Delay.Value := PicShow.Delay;
  92.   ManualStyle.Checked := PicShow.Manual;
  93.   ScrollBar.Enabled := ManualStyle.Checked;
  94.   // On idle time shows percentage of free physical memory
  95.   Application.OnIdle := UpdateMemoryStatus;
  96.   // Creates list of images and fills it by images found in the program path
  97.   Pictures := TStringList.Create;
  98.   if ParamCount > 0 then
  99.     CreateImageList(ParamStr(1))
  100.   else
  101.     CreateImageList(ExtractFilePath(Application.ExeName) + 'Photos');
  102.   // Loads an image into Picshow
  103.   Timer.Interval := ShowPause.Value * 1000;
  104.   LoadNextImage;
  105.   FirstActivate := True;
  106. end;
  107.  
  108. procedure TMainForm.FormDestroy(Sender: TObject);
  109. begin
  110.   Pictures.Free;
  111. end;
  112.  
  113. procedure TMainForm.FormActivate(Sender: TObject);
  114. begin
  115.   if FirstActivate then
  116.   begin
  117.     FirstActivate := False;
  118.     Update;
  119.     ShowNextImage;
  120.   end;
  121. end;
  122.  
  123. procedure TMainForm.PicShowDblClick(Sender: TObject);
  124. begin
  125.   PicShow.Enabled := False; // To perevent reentrance
  126.   try
  127.     ShowNextImage;
  128.   finally
  129.     PicShow.Enabled := True;
  130.   end;
  131. end;
  132.  
  133. procedure TMainForm.StyleChange(Sender: TObject);
  134. {$IFNDEF VER100}
  135. {$IFNDEF VER120}
  136. var
  137.   CursorPos: TPoint;
  138. {$ENDIF}
  139. {$ENDIF}
  140. begin
  141.   PicShow.Style := Style.Value;
  142.   Style.Hint := PicShow.StyleName;
  143.   {$IFNDEF VER100}
  144.   {$IFNDEF VER120}
  145.   GetCursorPos(CursorPos);
  146.   if PtInRect(Style.BoundsRect, Style.Parent.ScreenToClient(CursorPos)) then
  147.     Application.ActivateHint(CursorPos);
  148.   {$ENDIF}
  149.   {$ENDIF}
  150. end;
  151.  
  152. procedure TMainForm.ThreadedClick(Sender: TObject);
  153. begin
  154.   PicShow.Threaded := Threaded.Checked;
  155. end;
  156.  
  157. procedure TMainForm.StepChange(Sender: TObject);
  158. begin
  159.   PicShow.Step := Step.Value;
  160. end;
  161.  
  162. procedure TMainForm.TimerTimer(Sender: TObject);
  163. begin
  164.   ShowNextImage;
  165. end;
  166.  
  167. procedure TMainForm.PicShowStart(Sender: TObject);
  168. begin
  169.   CheckTimer;
  170.   // When PicShow begins transaction, we can load the next image into the
  171.   // control. This is possible because PicShow converts the image to Bitmap
  172.   // and use this copy during its process.
  173.   LoadNextImage;
  174. end;
  175.  
  176. procedure TMainForm.PicShowStop(Sender: TObject);
  177. begin
  178.   CheckTimer;
  179. end;
  180.  
  181. procedure TMainForm.ManualStyleClick(Sender: TObject);
  182. begin
  183.   PicShow.Manual := ManualStyle.Checked;
  184.   ScrollBar.Enabled := ManualStyle.Checked;
  185.   if PicShow.Manual then
  186.   begin
  187.     // When PicShow is in manual mode, we must first call execute and after it
  188.     // we can change the progress. If PicShow is already busy, calling execute
  189.     // is not required.
  190.     if not (PicShow.Busy or PicShow.Empty) then
  191.       PicShow.Execute;
  192.     ScrollBar.Position := PicShow.Progress;
  193.   end;
  194.   CheckTimer;
  195. end;
  196.  
  197. procedure TMainForm.AutoClick(Sender: TObject);
  198. begin
  199.   CheckTimer;
  200. end;
  201.  
  202. procedure TMainForm.SelectFolderClick(Sender: TObject);
  203. var
  204.   Path: String;
  205. begin
  206.   Path := PicPath;
  207.   if SelectDirectory(Path, [], 0) then
  208.   begin
  209.     CreateImageList(Path);
  210.     CheckTimer;
  211.   end;
  212. end;
  213.  
  214. procedure TMainForm.ScrollBarChange(Sender: TObject);
  215. begin
  216.   PicShow.Progress := ScrollBar.Position;
  217. end;
  218.  
  219. procedure TMainForm.PicShowProgress(Sender: TObject);
  220. begin
  221.   if ScrollBar.Enabled then
  222.     ScrollBar.Position := PicShow.Progress;
  223. end;
  224.  
  225. procedure TMainForm.DelayChange(Sender: TObject);
  226. begin
  227.   PicShow.Delay := Delay.Value;
  228. end;
  229.  
  230. // This procedure will be called when PicShow.Style is 0
  231. // Picture: This is the image.
  232. // Screen: This is what we should draw on it.
  233. procedure TMainForm.PicShowCustomDraw(Sender: TObject; Picture,
  234.   Screen: TBitmap);
  235. var
  236.   Text: String;
  237. begin
  238.   Text := Format('CUSTOM: PROGRESS = %d%%', [PicShow.Progress]);
  239.   Screen.Canvas.Draw(0, 0, Picture);
  240.   SetTextAlign(Screen.Canvas.Handle, TA_CENTER or TA_BASELINE);
  241.   Screen.Canvas.TextOut(Screen.Width div 2, Screen.Height div 2, Text);
  242. end;
  243.  
  244. // Turns timer on or off according to state of controls
  245. procedure TMainForm.CheckTimer;
  246. begin
  247.   Timer.Enabled := not PicShow.Busy and Auto.Checked and
  248.     not ManualStyle.Checked and (Pictures.Count > 0);
  249. end;
  250.  
  251. // Begins animating the currently loaded image
  252. procedure TMainForm.ShowNextImage;
  253. begin
  254.   Timer.Enabled := False;
  255.   // if there is not any image in the list exit
  256.   if Pictures.Count = 0 then Exit;
  257.   // if PicShow is playing, stops it
  258.   if PicShow.Busy then
  259.     PicShow.Stop;
  260.   // Sets the animation style according to user sellection
  261.   if RandomStyle.Checked then
  262.     Style.Value := Random(High(TShowStyle))+1
  263.   else if TurnStyle.Checked then
  264.     if Style.Value < High(TShowStyle) then
  265.       Style.Value := Style.Value + 1
  266.     else
  267.       Style.Value := 1;
  268.   // Clears background if it is required
  269.   if ClearOldImage.Checked then
  270.   begin
  271.     PicShow.Clear;
  272.     PicShow.Update;
  273.   end;
  274.   // Updates image name status
  275.   ShownImage := LoadedImage;
  276.   RunningFilename.Caption := 'Showing: ' + ShownImage;
  277.   RunningFilename.Update;
  278.   // Begins the animation
  279.   PicShow.Execute;
  280. end;
  281.  
  282. // Selects randomly an image from the image list and loades it into PicShow
  283. procedure TMainForm.LoadNextImage;
  284. var
  285.   Index: Integer;
  286. begin
  287.   LoadedImage := EmptyStr;
  288.   if Pictures.Count > 0 then
  289.   begin
  290.     repeat
  291.       Index := Random(Pictures.Count);
  292.     until (Pictures.Count <= 1) or (ShownImage <> Pictures[Index]);
  293.     LoadedImage := Pictures[Index];
  294.     PicShow.Picture.LoadFromFile(PicPath + LoadedImage);
  295.   end;
  296.   NextFilename.Caption := 'Next: ' + LoadedImage;
  297.   NextFilename.Update;
  298. end;
  299.  
  300. // Creates a list of image filenames found in the path
  301. procedure TMainForm.CreateImageList(const Path: String);
  302. var
  303.   FileList: TFileListBox;
  304. begin
  305.   FileList := TFileListBox.Create(Self);
  306.   try
  307.     FileList.Parent := Self;
  308.     FileList.Visible := False;
  309.     FileList.Mask := GraphicFileMask(TGraphic);
  310.     FileList.Directory := Path;
  311.     if FileList.Items.Count > 0 then
  312.     begin
  313.       Pictures.Assign(FileList.Items);
  314.       if (Length(Path) > 0) and (Path[Length(Path)] <> '\') then
  315.         PicPath := Path + '\'
  316.       else
  317.         PicPath := Path;
  318.     end
  319.     else
  320.       MessageDlg(Path + #10#13'does not contain any supported image file',
  321.         mtWarning, [mbOK], 0);
  322.   finally
  323.     FileList.Free;
  324.   end;
  325. end;
  326.  
  327. // Updates percentage of available physical memory on the screen
  328. procedure TMainForm.UpdateMemoryStatus(Sender: TObject; var Done: Boolean);
  329. var
  330.   MemoryStatus: TMemoryStatus;
  331. begin
  332.   GlobalMemoryStatus(MemoryStatus);
  333.   FreeMemory.Caption := Format('Free Memory: %%%.1f',
  334.     [100. * MemoryStatus.dwAvailPhys / MemoryStatus.dwTotalPhys]);
  335.   FreeMemory.Update;
  336. end;
  337.  
  338. procedure TMainForm.ShowPauseChange(Sender: TObject);
  339. begin
  340.   Timer.Interval := ShowPause.Value * 1000;
  341. end;
  342.  
  343. end.
  344.  
  345.