Active News - Nº 39  - www.activedelphi.com.br 

             Terça-feira, 07 de maio de 2002

       Não deixe de enviar sua dica de Programação Delphi para nós a publicarmos no ActiveNews, a equipe do ActiveDelphi e todos os assinantes ficarão agradecidos com a sua contribuição.
 
          1- Permite que seu DBF ignore o índice MDX e recrie-o.

 

  Declare a units  dbtables  na cláusula uses.

  

  Function CriaIndiceDBF(FrForm:TComponent;FIndexName,fTableName,PFFieldName,SFFieldName,SsFFieldName:String):         Boolean;
  var
    f: file of byte;
    b: byte;
    Tab : TTable;
  begin
    try
      assignFile(f, FTableName);
    except
      Result := False;
    end;
    try
      reset(f);
    except
      Result := False;
    end;
    seek(f, 28);
    b := 0;
    try
      write(f,b);
    except
      Result := False;
    end;
    closefile(f);
    Tab := TTable.Create(FrForm);
    with Tab do
    begin
      TableName := FTableName;
      AddIndex(PFFieldName,PFFieldName,[]);
      if not (SFFieldName = '') then
      begin
        try
          AddIndex(SFFieldName,SFFieldName,[]);
        except
          result := False;
        end;
      end;
      if not (SsFFieldName = '') then
      begin
        try
          AddIndex(SsFFieldName,SsFFieldName,[]);
        except
          result := False;
        end;
      end;
    end;
    Tab.Free;
    Result := True;
end;

     Seja um colaborador do ActiveDelphi. Saiba como...

-

          2- Remove caracteres de uma string deixando apenas números.

 

  function RemoveChar(Const Texto:String):String;
  var
    I: integer;
    S: string;
  begin
    S := '';
    for I := 1 To Length(Texto) Do
    begin
      if (Texto[I] in ['0'..'9']) then
      begin
        S := S + Copy(Texto, I, 1);
      end;
    end;
    result := S;
  end;

          Suporte em Delphi. cadastre-se já 

          Este serviço tem por finalidade oferecer aos associados um suporte técnico na linguagem de programação Delphi, nas versões Standard, Professional e Client/Server.   

          Atualmente, contamos com uma equipe de profissionais qualificados e prontos pra lhe atender e ajudá-lo da melhor forma possível.  

          Nosso atendimento é feito através de e-mail e formulário web, de segunda à sexta das 08:00h às 18:00h.

-
          3- Obtendo as conexões de rede.

 

  var
    I : Integer;
    Caminho, Drive : String;
    Tamanho : Cardinal;
  begin
    SetLength(Caminho,255);
    Tamanho:=255;
    For I:=0 to 25 do
    begin
      Drive := Chr(Ord('A')+I)+':';
      if WNetGetConnection(PChar(Drive),PChar(Caminho) ,Tamanho) = NO_ERROR then
        ListBox1.Items.Add(Drive + ' - '+Caminho);
    end;
  end; 

          Várias Apostilaswww.activedelphi.com.br/apostilas.htm
          4- Remove a linha selecionada de uma StringGrid.

 

  function DeleteGridRow(AGrid: TStringGrid; ARow: Integer): boolean;
  var
    i: Integer;
    j: Integer;
  begin
    if (ARow < AGrid.FixedRows) or (ARow >= AGrid.RowCount) then
      begin
        Exception.Create('Tentativa de deletar uma linha acima do intervalo ');
      end;
    if (ARow < AGrid.RowCount - 1) then
    begin
      for i := ARow + 1 to AGrid.RowCount - 1 do
      begin
        for j := 0 to AGrid.ColCount - 1 do
          AGrid.Cells[i - 1, j] := AGrid.Cells[i, j];
      end;
    end;
    AGrid.RowCount := AGrid.RowCount - 1;
  end;

 

            Visite nosso Fórum de discussões sobre Delphi, é gratuito e não precisa se cadastrar. Clique Aqui
-
          5- Usando o Word de dentro do Delphi.


    {Ao invés de usar o shellexecuite tente criar um objeto OLE do tipo msword.}

  procedure TFrmFactoring.ActnContratoExecute(Sender: TObject);
  var
     MSWord : variant;
  begin
    Msword:=createoleObject('Word.Basic');
    Msword.AppShow;
    Msword.fileopen('c: actoringdocscontrato.doc');
  end;
  //Não esqueça de incluir ComObj na cláusula Uses. 

 

          Não deixe de enviar sua dica de Programação Delphi para nós a publicarmos no ActiveNews, a equipe do ActiveDelphi e   todos os assinantes ficarão agradecidos com a sua contribuição.  

-
          6- Retorna um Path em formato de nome curto (8 Caracteres).

 

  function LongToShortPath(Long: string): string;
  // Requer a filectrl declarada na clausula uses da unit
  var
    ActualLength: Longint;
  begin
    if directoryexists(Long) then
    begin
      SetLength(Result, Length(Long) + 1);
      ActualLength := GetShortPathName(PChar(Long), PChar(Result), Length(Result));
      SetLength(Result, ActualLength);
    end
    else
    begin
      result := 'Caminho inválido ou não encontrado';
    end;
  end;

 

          Suporte em Delphi. cadastre-se já 

          Este serviço tem por finalidade oferecer aos associados um suporte técnico na linguagem de programação Delphi, nas versões 1, 2, 3, 4 e 5 Standard, Professional e Client/Server.   

          Atualmente, contamos com uma equipe de profissionais qualificados e prontos pra lhe atender e ajudá-lo da melhor forma possível.  

          Nosso atendimento é feito através de e-mail e formulário web, de segunda à sexta das 08:00h às 18:00h.

-
          7- Efetua um pack em tabelas Dbase.

 

  procedure DBasePack(Ntable :TTable);
  var
    Error: DbiResult;
    ErrorMsg: String;
    Special: DBIMSG;
  begin
    Ntable.Active := False;
    try
      Ntable.Exclusive := True;
      Ntable.Active := True;
      Error := DbiPackTable(Ntable.DBHandle, Ntable.Handle, nil, szdBASE, True);
      Ntable.Active := False;
      Ntable.Exclusive := False;
    finally
      Ntable.Active := True;
    end;
    case Error of
      DBIERR_NONE: ErrorMsg:= 'Pack efetuado com Successo';
      DBIERR_INVALIDPARAM: ErrorMsg:= 'A especificação da tabela ou seu ponteiro é nulo ou inválido';
      DBIERR_INVALIDHNDL: ErrorMsg:= 'O Cabeçalho da tabela ou seu cursor é nulo ou inválido';
      DBIERR_NOSUCHTABLE: ErrorMsg:= 'Nome da tabela não encontrado ou inválido';
      DBIERR_UNKNOWNTBLTYPE:ErrorMsg:= 'Tipo de tabela desconhecido';
      DBIERR_NEEDEXCLACCESS:ErrorMsg:= 'A tabela não foi aberta em modo exclusivo';
    else
      DbiGetErrorString(Error, Special);
      ErrorMsg := '[' + IntToStr(Error) + ']: ' + Special;
    end;
    MessageDlg(ErrorMsg, mtWarning, [mbOk], 0);
  end;

 

-

          Pensamento:

           A verdadeira felicidade é podermos proporcionar felicidade aos nossos semelhantes. Não se irrite com seus problemas tampouco com as injustiças que venha a sofrer. Mantendo a calma, tenha certeza que será compensado pelas injustiças e encontrará a solução para os problemas do cotidiano."

-

          Repasse este News para seus amigos(as)...

 

          Até a próxima semana !

 

          EQUIPE  ACTIVEDELPHI

          www.activedelphi.com.br

          info@activedelphi.com.br

 

 Este é um serviço gratuito oferecido pelo site www.activedelphi.com.br

 Para cancelar sua assinatura, basta responder esse e-mail, colocando no campo assunto "Cancelar".