jvbdeprogress.pas

East make Tray Icon in delphi

    FStartTime := 0;
  end;
  Screen.Cursor := crDefault;
  SetCursor(Screen.Cursors[crDefault]); { force update cursor }
end;

procedure TJvDBProgress.StartTimer;
begin
  if FTimer = nil then
  begin
    FTimer := TJvTimer.Create(Self);
    FTimer.Interval := 500;
  end;
  with FTimer do
  begin
    if not Enabled then
      FStartTime := GetTickCount;
    OnTimer := TimerExpired;
    Enabled := True;
  end;
end;

procedure TJvDBProgress.SetPercent(Value: Integer);
begin
  if Gauge <> nil then
  begin
    SetProgressMax(Gauge, 100);
    SetProgressValue(Gauge, Value);
  end;
  if Assigned(FOnPercentChange) then
    FOnPercentChange(Self, Value);
end;

procedure TJvDBProgress.SetMessage(const Value: string);
begin
  if MessageControl <> nil then
  begin
    TLabel(MessageControl).Caption := Value;
    MessageControl.Refresh;
  end;
  if Assigned(FOnMessageChange) then
    FOnMessageChange(Self, Value);
end;

procedure TJvDBProgress.SetActive(Value: Boolean);
begin
  if (FActive <> Value) or FStreamedValue then
  begin
    if not (csDesigning in ComponentState) then
    begin
      if Value then
        AddProgress(Self)
      else
        RemoveProgress(Self);
      if (FGenProgressCallback = nil) and Value then
      begin
        Activate;
        FGenProgressCallback := TJvDBCallback.Create(Self, cbGENPROGRESS,
          Max(SizeOf(CBPROGRESSDesc), SizeOf(DBIPATH) + SizeOf(Integer) * 4),
          GenProgressCallback, dcChain);
        FQryProgressCallback := TJvDBCallback.Create(Self, cbQRYPROGRESS,
          SizeOf(DBIQryProgress), QryProgressCallback, dcChain);
      end
      else
      if not Value and (FGenProgressCallback <> nil) then
      begin
        Sessions.CurrentSession := GetDBSession;
        FGenProgressCallback.Free;
        FGenProgressCallback := nil;
        FQryProgressCallback.Free;
        FQryProgressCallback := nil;
        FreeTimer;
        if not Trace then
          Deactivate;
      end;
    end;
    FActive := Value;
  end;
end;

procedure TJvDBProgress.Activate;
var
  S: TSession;
begin
  if FSessionLink = nil then
  begin
    S := Sessions.List[SessionName];
    S.Open;
    Sessions.CurrentSession := S;
    FSessionLink := TJvSessionLink.Create(S);
    try
      TJvSessionLink(FSessionLink).Temporary := True;
      TJvSessionLink(FSessionLink).KeepConnection := False;
      TJvSessionLink(FSessionLink).FProgress := Self;
    except
      FSessionLink.Free;
      FSessionLink := nil;
      raise;
    end;
  end
  else
    Sessions.CurrentSession := TDatabase(FSessionLink).Session;
end;

procedure TJvDBProgress.Deactivate;
begin
  if FSessionLink <> nil then
  begin
    TJvSessionLink(FSessionLink).FProgress := nil;
    FSessionLink.Free;
    FSessionLink := nil;
  end;
end;

function TJvDBProgress.GetDBSession: TSession;
begin
  Result := Sessions.FindSession(SessionName);
  if Result = nil then
    Result := DBTables.Session;
end;

procedure TJvDBProgress.SetSessionName(const Value: string);
var
  KeepActive, KeepTrace: Boolean;
begin
  if Value <> SessionName then
    if not (csDesigning in ComponentState) then
    begin
      KeepActive := Active;
      KeepTrace := Trace;
      Active := False;
      Trace := False;
      FSessionName := Value;
      Active := KeepActive;
      Trace := KeepTrace;
    end
    else
      FSessionName := Value;
end;

procedure TJvDBProgress.SetTrace(Value: Boolean);
begin
  if (FTrace <> Value) or (FStreamedValue and Value) then
    if not (csDesigning in ComponentState) then
    begin
      if Value then
      begin
        Activate;
        GetDBSession.TraceFlags := FTraceFlags;
        FTraceCallback := TJvDBCallback.Create(Self, cbTRACE,
          smTraceBufSize, TraceCallBack, dcReplace);
      end
      else
      if FTraceCallback <> nil then
      begin
        Sessions.CurrentSession := GetDBSession;
        FTraceCallback.Free;
        FTraceCallback := nil;
        if not Active then
          Deactivate;
      end;
      FTrace := (FTraceCallback <> nil);
    end
    else
      FTrace := Value;
end;

procedure TJvDBProgress.SetTraceFlags(Value: TTraceFlags);
begin
  FTraceFlags := Value;
  if Trace then
    GetDBSession.TraceFlags := FTraceFlags;
end;

function TJvDBProgress.TraceCallBack(CBInfo: Pointer): CBRType;
var
  CurFlag: TTraceFlag;
begin
  Result := cbrUSEDEF;
  if Trace and Assigned(FOnTrace) then
  begin
    case PTraceDesc(CBInfo)^.eTraceCat of
      traceQPREPARE:
        CurFlag := tfQPrepare;
      traceQEXECUTE:
        CurFlag := tfQExecute;
      traceERROR:
        CurFlag := tfError;
      traceSTMT:
        CurFlag := tfStmt;
      traceCONNECT:
        CurFlag := tfConnect;
      traceTRANSACT:
        CurFlag := tfTransact;
      traceBLOB:
        CurFlag := tfBlob;
      traceMISC:
        CurFlag := tfMisc;
      traceVENDOR:
        CurFlag := tfVendor;
      traceDATAIN:
        CurFlag := tfDataIn;
      traceDATAOUT:
        CurFlag := tfDataOut;
    else
      Exit;
    end;
    if CurFlag in TraceFlags then
      FOnTrace(Self, CurFlag, StrPas(PTraceDesc(CBInfo)^.pszTrace));
  end;
end;

procedure TJvDBProgress.SetMessageControl(Value: TControl);
begin
  FMessageControl := Value;
  if Value <> nil then
    Value.FreeNotification(Self);
end;

procedure TJvDBProgress.SetGauge(Value: TControl);
begin
  FGauge := Value;
  if Value <> nil then
    Value.FreeNotification(Self);
end;

procedure TJvDBProgress.Notification(AComponent: TComponent; AOperation: TOperation);
begin
  inherited Notification(AComponent, AOperation);
  if AOperation = opRemove then
    if AComponent = Gauge then
      Gauge := nil
    else
    if AComponent = MessageControl then
      MessageControl := nil;
end;

function TJvDBProgress.GenProgressCallback(CBInfo: Pointer): CBRType;
var
  CallInfo: pCBPROGRESSDesc;
  AbortOp: Boolean;
begin
  CallInfo := CBInfo;
  Result := cbrUSEDEF;
  StartTimer;
  if (FTimer <> nil) and FTimer.Enabled {and (GetTickCount > FStartTime)} then
    SetWaitCursor;
  if Assigned(FOnProgress) then
  begin
    AbortOp := False;
    FOnProgress(Self, AbortOp);
    if AbortOp then
      Result := cbrABORT;
  end;
  if CallInfo^.iPercentDone >= 0 then
    SetPercent(CallInfo^.iPercentDone)
  else
    SetMessage(StrPas(CallInfo^.szMsg));
end;

function TJvDBProgress.QryProgressCallback(CBInfo: Pointer): CBRType;
var
  CallInfo: pDBIQryProgress;
  AbortOp: Boolean;
  PcntDone: Double;
begin
  CallInfo := CBInfo;
  Result := cbrUSEDEF;
  StartTimer;
  {if (FTimer <> nil) and FTimer.Enabled then SetWaitCursor;}
  if Assigned(FOnProgress) then
  begin
    AbortOp := False;
    FOnProgress(Self, AbortOp);
    if AbortOp then
      Result := cbrABORT;
  end;
  with CallInfo^ do
    PcntDone := (stepsCompleted / Max(1, stepsInQry)) *
      (elemCompleted / Max(1, totElemInStep));
  SetPercent(Round(PcntDone * 100));
end;

function TJvDBProgress.ProgressMsgValue(const Msg: string): Longint;
begin
  if Msg <> '' then
    Result := StrToIntDef(Trim(Copy(Msg, Pos(':', Msg) + 1, MaxInt)), -1)
  else
    Result := -1;
end;

{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.