Progress bar anzeige

[Mackhack]

Hab ich grad noch auf Platte gefunden:

Delphi-Quellcode:

// -----------------------------------------------------------------------------

function TForm1.OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult; stdcall;
begin
  Result := E_NOTIMPL;
end; {end function}

// -----------------------------------------------------------------------------

function TForm1.GetPriority(out nPriority): HResult; stdcall;
begin
  Result := E_NOTIMPL;
end; {end function}

// -----------------------------------------------------------------------------

function TForm1.OnLowResource(reserved: DWORD): HResult; stdcall;
begin
  Result := E_NOTIMPL;
end; {end function}

// -----------------------------------------------------------------------------

function TForm1.OnStopBinding(hresult: HResult; szError: LPCWSTR)
  : HResult; stdcall;
begin
  Result := E_NOTIMPL;
end; {end function}

// -----------------------------------------------------------------------------

function TForm1.GetBindInfo(out grfBINDF: DWORD; var bindinfo: TBindInfo)
  : HResult; stdcall;
begin
  Result := E_NOTIMPL;
end; {end function}

// -----------------------------------------------------------------------------

function TForm1.OnDataAvailable(grfBSCF: DWORD; dwSize: DWORD;
  formatetc: PFormatEtc; stgmed: PStgMedium): HResult; stdcall;
begin
  Result := E_NOTIMPL;
end;  {end function}

// -----------------------------------------------------------------------------

function TForm1.OnObjectAvailable(const iid: TGUID; punk: IUnknown)
  : HResult; stdcall;
begin
  Result := E_NOTIMPL;
end; {end function}

// -----------------------------------------------------------------------------

function TForm1.OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG;
      szStatusText: LPCWSTR): HResult; stdcall;
begin
  with ProgressBar1 do
  begin
    Max := ulProgressMax;
    Position := ulProgress;
  end; {end with}
  Result := NOERROR;
end; {end function}

function cDownloadStatusCallback.OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult;
var
  szST : String;
begin
  case ulStatusCode of
    BINDSTATUS_BEGINDOWNLOADDATA:
      begin
        // reset progressbar
        SendMessage(GetDlgItem(hDlg, IDC_PROGRESS), PBM_SETPOS, 0, 0);

        // show current action
        szST := szStatusText;
        SendMessage(GetDlgItem(hDlg, IDC_ACTIONTEXT), WM_SETTEXT, 0,Integer(szST));

        // download exit by the user?
        if ( m_fUserCancel ) then
        begin
          Result := E_ABORT;
          Exit;
        end;
      end;
    BINDSTATUS_DOWNLOADINGDATA:
      begin
        // update progress
        SendMessage(GetDlgItem(hDlg, IDC_PROGRESS), PBM_SETPOS, MulDiv(ulProgress, 100, ulProgressMax), 0);

        // download exit by the user?
        if(m_fUserCancel) then
        begin
          Result := E_ABORT;
          Exit;
        end;
      end;
    BINDSTATUS_ENDDOWNLOADDATA:
      SendMessage(hDlg, WM_CLOSE, 0, 0); // close Download dialog
  end;

  // message pump
  if ( PeekMessage(msg, hDlg, 0, 0, PM_REMOVE) ) then
  begin
    IsDialogMessage(hDlg,msg);
  end;
  Result := S_OK; // default result
end;


function DownloadFile(Source, Dest: String): Boolean;
begin
  try
    Result := ( UrlDownloadToFile(Nil, PChar(Source), PChar(Dest), 0, Nil) = 0 );
  except
    Result := False;
  end;
end;