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