Fórum Usar propriedade de outra classe em componente. #295450

type
  TOpcoesDown = (odCriarDestino, odAvisarSobrepor, odAvisarFinalizacao);
  TOpcoes = Set of TOpcoesDown;
...
  private
    FOpcoes: TOpcoes;
...
procedure SetOpcoes(const Value: TOpcoes);
...
property Opcoes : TOpcoes read FOpcoes write SetOpcoes default [odCriarDestino];
...
...
...

constructor TDcDownProgress.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
end;

...

procedure TDcDownProgress.SetOpcoes(const Value: TOpcoes);
begin
  FOpcoes := Value;
end;

constructor TDcDownProgress.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FOpcoes := [odCriarDestino];
end;

constructor TDcDownProgress.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FOpcoes := [odCriarDestino];
end;

  if (not DirectoryExists(ExtractFilePath(FDestino))) then
  begin
    if (odCriarDestino in FOpcoes) then
      ForceDirectories(ExtractFilePath(FDestino))
    else
    begin
      MessageDlg(´O diretório destino não existe.´, mtError, [mbOk], 0);
      Exit;
    end;
  end;

  with DcDownProgress1 do
  begin
    Opcoes := [odCriarDestino];//mudando
    Origem := Edit1.Text;
    Destino := Edit2.Text;
    Execute;
  end;

type
  TDcDownProgress = class(TComponent) 
  private 
    ...
     procedure LerOpcoes(Reader: TReader);
     procedure GravarOpcoes(Writer: TWriter);
  protected 
    procedure DefineProperties(Filer: TFiler); override;
...

unit DcDownProgress;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, UrlMon, ShellApi, ActiveX, ComCtrls;

type
  TOpcoesDown = (odCriarDestino, odAvisarSobrepor, odAvisarFinalizacao);
  TOpcoes = Set of TOpcoesDown;

type
  TMeuObjetoInterface = class(TInterfacedObject, IBindStatusCallback)
  private
    FProgress: TProgressBar;
    FLabelInfo: TLabel;
  public
    function OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult; stdcall;
    function GetPriority(out nPriority): HResult; stdcall;
    function OnLowResource(reserved: DWORD): HResult; stdcall;
    function OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG;
      szStatusText: LPCWSTR): HResult; stdcall;
    function OnStopBinding(hresult: HResult; szError: LPCWSTR): HResult;
      stdcall;
    function GetBindInfo(out grfBINDF: DWORD; var bindinfo: TBindInfo): HResult;
      stdcall;
    function OnDataAvailable(grfBSCF: DWORD; dwSize: DWORD; formatetc:
      PFormatEtc;
      stgmed: PStgMedium): HResult; stdcall;
    function OnObjectAvailable(const iid: TGUID; punk: IUnknown): HResult;
      stdcall;
  end;

type
  TDcDownProgress = class(TComponent)
  private
    { Private declarations }
    FProgress: TProgressBar;
    FDestino: String;
    FOrigem: String;
    FOpcoes: TOpcoes;
    FLabelInfo: TLabel;
    function GetDestino: String;
    function GetOrigem: String;
    procedure SetDestino(const Value: String);
    procedure SetOrigem(const Value: String);
    procedure SetOpcoes(const Value: TOpcoes);
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy;override;
    function Execute : Boolean;
  published
    { Published declarations }
    property Origem : String read GetOrigem write SetOrigem;
    property Destino : String read GetDestino write SetDestino;
    property ProgressBar : TProgressBar read FProgress write FProgress;
    property Opcoes : TOpcoes read FOpcoes write SetOpcoes default [odCriarDestino];
    property LabelInfo: TLabel read FLabelInfo write FLabelInfo;
  end;


procedure Register;

implementation

procedure Register;
begin
  RegisterComponents(´Doiscliques ADD´, [TDcDownProgress]);
end;

{ TDcDownProgress }

constructor TDcDownProgress.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
end;

destructor TDcDownProgress.Destroy;
begin
  inherited;
end;

function TDcDownProgress.Execute: Boolean;
var
  MeuEstatus: TMeuObjetoInterface;
begin
  if Trim(FDestino) = ´´ then
  begin
    MessageDlg(´O destino do download não foi especificado.´, mtError, [mbOk], 0);
    Exit;
  end;
  if (not DirectoryExists(ExtractFilePath(FDestino))) then
  begin
    if (odCriarDestino in FOpcoes) then
      ForceDirectories(ExtractFilePath(FDestino))
    else
    begin
      MessageDlg(´O diretório destino não existe.´, mtError, [mbOk], 0);
      Exit;
    end;
  end;

  {Aqui inicia o Download}
  MeuEstatus := TMeuObjetoInterface.Create;
  if FProgress = nil then
  begin
    MessageDlg(´Especifique um componente ProgressBar na propriedade de mesmo nome.´,mtWarning,[mbOK],0);
    Exit;
  end;
  if FLabelInfo = nil then
  begin
    MessageDlg(´Especifique um componente Label na propriedade de mesmo nome.´,mtWarning,[mbOK],0);
    Exit;
  end;
  MeuEstatus.FProgress := FProgress;
  MeuEstatus.FLabelInfo := FLabelInfo;
  {Testa se foi configurado um ProgressBar e um Label}
  if (not (FProgress = Nil)) and (not (FLabelInfo = Nil)) then
    UrlDownloadToFile(nil, PChar(FOrigem), PChar(FDestino), 0, MeuEstatus)
  else
    UrlDownloadToFile(nil, PChar(FOrigem), PChar(FDestino), 0, nil);
  {testa se precisa dar mensagem final}
  if odAvisarFinalizacao in Opcoes then
    Messagedlg(´Download concluído´, mtInformation, [mbOk],0);
end;

function TDcDownProgress.GetDestino: String;
begin
  Result := FDestino;
end;


function TDcDownProgress.GetOrigem: String;
begin
  Result := FOrigem;
end;

procedure TDcDownProgress.SetDestino(const Value: String);
begin
  FDestino := Value;
end;

procedure TDcDownProgress.SetOpcoes(const Value: TOpcoes);
begin
  FOpcoes := Value;
end;

procedure TDcDownProgress.SetOrigem(const Value: String);
begin
  FOrigem := Value;
end;

{ TMeuObjetoInterface }

function TMeuObjetoInterface.GetBindInfo(out grfBINDF: DWORD;
  var bindinfo: TBindInfo): HResult;
begin

end;

function TMeuObjetoInterface.GetPriority(out nPriority): HResult;
begin

end;

function TMeuObjetoInterface.OnDataAvailable(grfBSCF, dwSize: DWORD;
  formatetc: PFormatEtc; stgmed: PStgMedium): HResult;
begin

end;

function TMeuObjetoInterface.OnLowResource(reserved: DWORD): HResult;
begin

end;

function TMeuObjetoInterface.OnObjectAvailable(const iid: TGUID;
  punk: IInterface): HResult;
begin

end;

function TMeuObjetoInterface.OnProgress(ulProgress, ulProgressMax,
  ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult;
begin
  Application.ProcessMessages;
  if FLabelInfo <> nil then
    FLabelInfo.Caption := ´Baixando: ´ + FormatFloat(´#.,´, ulProgress)
      + ´ de ´ + FormatFloat(´.,´, ulProgressMax) + ´ total de bytes´;
  if FProgress <> nil then
  begin
    FProgress.Max := ulProgressMax;
    FProgress.Position := FProgress.Position + (ulProgress div 1024);
  end;
end;

function TMeuObjetoInterface.OnStartBinding(dwReserved: DWORD;
  pib: IBinding): HResult;
begin

end;

function TMeuObjetoInterface.OnStopBinding(hresult: HResult;
  szError: LPCWSTR): HResult;
begin

end;

end.

property Opcoes : TOpcoes read FOpcoes write SetOpcoes default [odCriarDestino];