home *** CD-ROM | disk | FTP | other *** search
/ Chip 2003 February / Chip_2003-02_cd1.bin / zkuste / delphi / kompon / d3456 / PICSHOW.ZIP / DBDemo / Main.pas < prev    next >
Pascal/Delphi Source File  |  2002-09-26  |  7KB  |  261 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, Mask, DBCtrls, DBCGrids, Db,
  8.   DBTables, ADODB, ExtDlgs, Buttons;
  9.  
  10. type
  11.   TMainForm = class(TForm)
  12.     Panel1: TPanel;
  13.     Step: TSpinEdit;
  14.     Style: TSpinEdit;
  15.     Label1: TLabel;
  16.     Label2: TLabel;
  17.     Threaded: TCheckBox;
  18.     Bevel1: TBevel;
  19.     Bevel2: TBevel;
  20.     DBPicShow: TDBPicShow;
  21.     Panel2: TPanel;
  22.     Timer: TTimer;
  23.     ManualStyle: TRadioButton;
  24.     TurnStyle: TRadioButton;
  25.     RandomStyle: TRadioButton;
  26.     FreeMemory: TPanel;
  27.     Label3: TLabel;
  28.     Delay: TSpinEdit;
  29.     Panel3: TPanel;
  30.     ScrollBar: TScrollBar;
  31.     Panel4: TPanel;
  32.     Auto: TCheckBox;
  33.     Label4: TLabel;
  34.     ShowPause: TSpinEdit;
  35.     ClearOldImage: TCheckBox;
  36.     Bevel3: TBevel;
  37.     ADOConnection: TADOConnection;
  38.     ADOTable: TADOTable;
  39.     DataSource: TDataSource;
  40.     LoadPicBtn: TSpeedButton;
  41.     OpenPictureDialog: TOpenPictureDialog;
  42.     DBNavigator1: TDBNavigator;
  43.     procedure FormCreate(Sender: TObject);
  44.     procedure FormActivate(Sender: TObject);
  45.     procedure DBPicShowDblClick(Sender: TObject);
  46.     procedure ThreadedClick(Sender: TObject);
  47.     procedure StyleChange(Sender: TObject);
  48.     procedure StepChange(Sender: TObject);
  49.     procedure TimerTimer(Sender: TObject);
  50.     procedure ManualStyleClick(Sender: TObject);
  51.     procedure AutoClick(Sender: TObject);
  52.     procedure ScrollBarChange(Sender: TObject);
  53.     procedure DBPicShowProgress(Sender: TObject);
  54.     procedure DelayChange(Sender: TObject);
  55.     procedure DBPicShowCustomDraw(Sender: TObject; Picture, Screen: TBitmap);
  56.     procedure DBPicShowBeforeLoadPicture(Sender: TObject);
  57.     procedure DBPicShowAfterLoadPicture(Sender: TObject);
  58.     procedure DBPicShowComplete(Sender: TObject);
  59.     procedure LoadPicBtnClick(Sender: TObject);
  60.     procedure ShowPauseChange(Sender: TObject);
  61.   private
  62.     procedure CheckTimer;
  63.     procedure ShowNextImage;
  64.     procedure UpdateMemoryStatus(Sender: TObject; var Done: Boolean);
  65.   end;
  66.  
  67. var
  68.   MainForm: TMainForm;
  69.  
  70. implementation
  71.  
  72. {$R *.DFM}
  73.  
  74. procedure TMainForm.FormCreate(Sender: TObject);
  75. begin
  76.   Randomize;
  77.   // Updates controls by DBPicShow properties
  78.   Style.MaxValue := High(TShowStyle);
  79.   Style.Value := DBPicShow.Style;
  80.   Threaded.Checked := DBPicShow.Threaded;
  81.   Step.Value := DBPicShow.Step;
  82.   Delay.Value := DBPicShow.Delay;
  83.   ManualStyle.Checked := DBPicShow.Manual;
  84.   ScrollBar.Enabled := ManualStyle.Checked;
  85.   // On idle time shows percentage of free physical memory
  86.   Application.OnIdle := UpdateMemoryStatus;
  87.   // Updates the timer status
  88.   Timer.Interval := ShowPause.Value * 1000;
  89.   CheckTimer;
  90.   // We want to start the transaction effect when the form is on the screen
  91.   DBPicShow.AutoDisplay := False;
  92.   // Activates the database connection
  93.   ADOConnection.Connected := True;
  94.   ADOTable.Active := ADOConnection.Connected;
  95. end;
  96.  
  97. procedure TMainForm.FormActivate(Sender: TObject);
  98. begin
  99.   Update;
  100.   DBPicShow.AutoDisplay := True;
  101. end;
  102.  
  103. procedure TMainForm.DBPicShowDblClick(Sender: TObject);
  104. begin
  105.   ShowNextImage;
  106. end;
  107.  
  108. procedure TMainForm.StyleChange(Sender: TObject);
  109. var
  110.   CursorPos: TPoint;
  111. begin
  112.   DBPicShow.Style := Style.Value;
  113.   Style.Hint := DBPicShow.StyleName;
  114.   GetCursorPos(CursorPos);
  115.   if PtInRect(Style.BoundsRect, Style.Parent.ScreenToClient(CursorPos)) then
  116.     Application.ActivateHint(CursorPos);
  117. end;
  118.  
  119. procedure TMainForm.ThreadedClick(Sender: TObject);
  120. begin
  121.   DBPicShow.Threaded := Threaded.Checked;
  122. end;
  123.  
  124. procedure TMainForm.StepChange(Sender: TObject);
  125. begin
  126.   DBPicShow.Step := Step.Value;
  127. end;
  128.  
  129. procedure TMainForm.TimerTimer(Sender: TObject);
  130. begin
  131.   ShowNextImage;
  132. end;
  133.  
  134. procedure TMainForm.ManualStyleClick(Sender: TObject);
  135. begin
  136.   DBPicShow.Manual := ManualStyle.Checked;
  137.   ScrollBar.Enabled := ManualStyle.Checked;
  138.   if DBPicShow.Manual then
  139.   begin
  140.     // When DBPicShow is in manual mode, we must first call execute and after it
  141.     // we can change the progress. If DBPicShow is already busy, calling execute
  142.     // is not required.
  143.     if not (DBPicShow.Busy or DBPicShow.Empty) then
  144.       DBPicShow.Execute;
  145.     ScrollBar.Position := DBPicShow.Progress;
  146.   end;
  147. end;
  148.  
  149. procedure TMainForm.AutoClick(Sender: TObject);
  150. begin
  151.   CheckTimer;
  152. end;
  153.  
  154. procedure TMainForm.ScrollBarChange(Sender: TObject);
  155. begin
  156.   DBPicShow.Progress := ScrollBar.Position;
  157. end;
  158.  
  159. procedure TMainForm.DBPicShowProgress(Sender: TObject);
  160. begin
  161.   if ScrollBar.Enabled then
  162.     ScrollBar.Position := DBPicShow.Progress;
  163. end;
  164.  
  165. procedure TMainForm.DelayChange(Sender: TObject);
  166. begin
  167.   DBPicShow.Delay := Delay.Value;
  168. end;
  169.  
  170. // This procedure will be called when DBPicShow.Style is 0
  171. // Picture: This is the image.
  172. // Screen: This is what we should draw on it.
  173. procedure TMainForm.DBPicShowCustomDraw(Sender: TObject; Picture,
  174.   Screen: TBitmap);
  175. var
  176.   Text: String;
  177. begin
  178.   Text := Format('CUSTOM: PROGRESS = %d%%', [DBPicShow.Progress]);
  179.   Screen.Canvas.Draw(0, 0, Picture);
  180.   SetTextAlign(Screen.Canvas.Handle, TA_CENTER or TA_BASELINE);
  181.   Screen.Canvas.TextOut(Screen.Width div 2, Screen.Height div 2, Text);
  182. end;
  183.  
  184. // Sets transition effect before loading the image
  185. procedure TMainForm.DBPicShowBeforeLoadPicture(Sender: TObject);
  186. begin
  187.   // Sets the animation style according to the user selection
  188.   if RandomStyle.Checked then
  189.     Style.Value := Random(High(TShowStyle))+1
  190.   else if TurnStyle.Checked then
  191.     if Style.Value < High(TShowStyle) then
  192.       Style.Value := Style.Value + 1
  193.     else
  194.       Style.Value := 1;
  195.   // Clears background if it is required
  196.   if ClearOldImage.Checked then
  197.   begin
  198.     DBPicShow.Clear;
  199.     DBPicShow.Update;
  200.   end;
  201. end;
  202.  
  203. // Checks the timer status after loading the image
  204. procedure TMainForm.DBPicShowAfterLoadPicture(Sender: TObject);
  205. begin
  206.   CheckTimer;
  207. end;
  208.  
  209. // Checks the timer status after completion of the transition
  210. procedure TMainForm.DBPicShowComplete(Sender: TObject);
  211. begin
  212.   CheckTimer;
  213. end;
  214.  
  215. // Turns timer on or off according to state of the controls
  216. procedure TMainForm.CheckTimer;
  217. begin
  218.   Timer.Enabled := not DBPicShow.Busy and Auto.Checked and
  219.     not ManualStyle.Checked and (ADOTable.RecordCount > 0);
  220. end;
  221.  
  222. procedure TMainForm.LoadPicBtnClick(Sender: TObject);
  223. begin
  224.   if ADOTable.Active and OpenPictureDialog.Execute then
  225.   begin
  226.     if not (ADOTable.State in [dsEdit, dsInsert]) then
  227.       ADOTable.Edit;
  228.     DBPicShow.Picture.LoadFromFile(OpenPictureDialog.FileName);
  229.     ADOTable.Post;
  230.   end;
  231. end;
  232.  
  233. // Shows the next image in the table
  234. procedure TMainForm.ShowNextImage;
  235. begin
  236.   if ADOTable.Active then
  237.   begin
  238.     ADOTable.Next;
  239.     if ADOTable.Eof then
  240.       ADOTable.First;
  241.   end;
  242. end;
  243.  
  244. // Updates percentage of available physical memory on the screen
  245. procedure TMainForm.UpdateMemoryStatus(Sender: TObject; var Done: Boolean);
  246. var
  247.   MemoryStatus: TMemoryStatus;
  248. begin
  249.   GlobalMemoryStatus(MemoryStatus);
  250.   FreeMemory.Caption := Format('Free Memory: %%%.1f',
  251.     [100. * MemoryStatus.dwAvailPhys / MemoryStatus.dwTotalPhys]);
  252.   FreeMemory.Update;
  253. end;
  254.  
  255. procedure TMainForm.ShowPauseChange(Sender: TObject);
  256. begin
  257.   Timer.Interval := ShowPause.Value * 1000;
  258. end;
  259.  
  260. end.
  261.