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

📄 progressor.pas

📁 odac for oralce 8i,10g,11g easy to connect to oralce from delphi
💻 PAS
字号:
unit Progressor;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  DBCtrls, ExtCtrls, Grids, DBGrids, StdCtrls, ToolWin, ComCtrls, Buttons,
  OdacVcl, Db, OraAlerter, DBAccess, Ora, OdacDemoFrame, OdacDemoForm;

type
  TProgressorFrame = class(TOdacDemoFrame)
    OraSQL: TOraSQL;
    OraAlerter: TOraAlerter;
    OraSession2: TOraSession;
    Panel1: TPanel;
    Panel2: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    edTime: TEdit;
    btStart: TSpeedButton;
    btBreak: TSpeedButton;
    cbSmooth: TCheckBox;
    Panel3: TPanel;
    Panel4: TPanel;
    lbTime: TLabel;
    lbPercent: TLabel;
    ProgressBar: TProgressBar;
    Panel5: TPanel;
    procedure btStartClick(Sender: TObject);
    procedure OraSQLAfterExecute(Sender: TObject; Result: Boolean);
    procedure btBreakClick(Sender: TObject);
    procedure OraAlerterEvent(Sender: TObject; Event, Message: String);
    procedure cbSmoothClick(Sender: TObject);
    procedure OraAlerterTimeOut(Sender: TObject; var Continue: Boolean);
    procedure FrameResize(Sender: TObject);
  private
    { Private declarations }
    FCount:integer;
    FTime:integer;
    T1:TDateTime;
  public
    procedure SetDirect(Value: Boolean); override;
    procedure Initialize; override;
  end;

implementation

uses
  OraCall;

{$IFDEF CLR}
{$R *.nfm}
{$ENDIF}
{$IFDEF WIN32}
{$R *.dfm}
{$ENDIF}

procedure TProgressorFrame.SetDirect(Value: Boolean);
begin
  inherited;
  OraSession2.Options.Direct := Value;
end;

procedure TProgressorFrame.Initialize;
begin
  inherited;

  OraSQL.Connection := Connection;

  edTime.Text := IntToStr(OraSQL.ParamByName('Time').AsInteger);
  cbSmooth.Checked := ProgressBar.Smooth;
end;

procedure TProgressorFrame.btStartClick(Sender: TObject);
begin
  ODACForm.OraSession.Connect;
  if not OraSession2.Connected then begin
    AssignConnectionTo(OraSession2);
    OraSession2.Connect;
  end;
  FTime := StrToInt(edTime.Text);
  FCount := 0;
  OraSQL.ParamByName('Time').AsInteger := FTime;
  ProgressBar.Position := 0;
  OraAlerter.Start;
  T1 := Time;
  OraSQL.Execute;
end;

procedure TProgressorFrame.btBreakClick(Sender: TObject);
begin
  //OraSQL.Break; don't work with PL/SQL
  OraAlerter.SendEvent('evBreak', '');
end;

procedure TProgressorFrame.OraSQLAfterExecute(Sender: TObject; Result: Boolean);
begin
  //OraAlerter.Stop;
  MessageBeep(1);
  if Result then
    MessageBox(0, 'Success!', 'Message', MB_OK)
  else
    MessageBox(0, 'Fail...', 'Message', MB_OK)
end;

procedure TProgressorFrame.OraAlerterEvent(Sender: TObject; Event, Message: String);
begin
  if not (csDestroying in ComponentState) then begin
    Inc(FCount);
    ProgressBar.Position := Trunc(FCount/FTime*20);
    lbTime.Caption := TimeToStr(Time - T1);
    lbPercent.Caption := IntToStr(Trunc(FCount/FTime*20)) + '%';
  end;
end;

procedure TProgressorFrame.cbSmoothClick(Sender: TObject);
begin
  ProgressBar.Smooth := cbSmooth.Checked;
end;

procedure TProgressorFrame.OraAlerterTimeOut(Sender: TObject;
  var Continue: Boolean);
begin
  MessageBox(0, 'TimeOut', 'Message', MB_OK)
end;

procedure TProgressorFrame.FrameResize(Sender: TObject);
begin
  inherited;
  Panel3.Left := 30;
  Panel3.Width := Panel3.Parent.ClientWidth - 30 * 2;
  Panel3.Top := (Panel3.Parent.ClientHeight - Panel3.ClientHeight - 30) div 2;
  lbTime.Left := lbTime.Parent.ClientWidth div 2 - lbTime.ClientWidth - 30;
  lbPercent.Left := lbPercent.Parent.ClientWidth div 2 + 30;
end;

end.

⌨️ 快捷键说明

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