ActiveDelphi - Índice do Fórum ActiveDelphi
.: O site do programador Delphi! :.
 
 FAQFAQ   PesquisarPesquisar   MembrosMembros   GruposGrupos   RegistrarRegistrar 
 PerfilPerfil   Entrar e ver Mensagens ParticularesEntrar e ver Mensagens Particulares   EntrarEntrar 

[Dica] Thumbs de um diretório

 
Novo Tópico   Responder Mensagem    ActiveDelphi - Índice do Fórum -> Off-Topic
Exibir mensagem anterior :: Exibir próxima mensagem  
Autor Mensagem
an.der.son
Colaborador
Colaborador


Registrado: Quarta-Feira, 26 de Mai de 2004
Mensagens: 2275
Localização: Itaocara - RJ

MensagemEnviada: Qua Mai 09, 2007 9:09 am    Assunto: [Dica] Thumbs de um diretório Responder com Citação

Basta colocar um ScrollBox no form!!

Código:
implementation

uses StrUtils, Jpeg, ExtCtrls;

{$R *.dfm}

function ListaArq(Caminho, Filtro: String): TStrings;
var
  SR : TSearchRec;
  I  : integer;
begin
  Result := TStringList.create;
  I := FindFirst(Caminho+Filtro, faAnyFile, SR);
  while I = 0 do
    begin
      if (SR.Attr and faDirectory) <> faDirectory then
         Result.Add(SR.Name);
      I := FindNext(SR);
    end;
end;

procedure CreateThumbs(Diretorio: String; ThumbSize: Word; Owner: TWinControl);
var
  i: Word;
  Img: TImage;
  Arqs: TStrings;
  wTop, wLeft: Word;
  Obj: TObject;
  FileName, Ext: String;
begin
  //-- Listar arquivos do diretorio
  Diretorio := IfThen(RightStr(Diretorio,1) <Diretorio> 0 then
    begin
      for i := Owner.ComponentCount-1 downto 0 do
        begin
          if (Owner.Components[i] is TImage) then
            if (Owner.Components[i] as TImage).Tag = 785 then
              begin
                Obj := Owner.Components[i];
                FreeAndNil(Obj);
              end;
        end;
    end;

  //-- Exibir imagens
  if Arqs.Count > 0 then
    begin
      for i := 0  to Arqs.Count -1 do
        begin
          FileName := Diretorio + Arqs[i];

          Ext := UpperCase(ExtractFileExt(FileName));

          if (Ext = '.BMP') or (Ext = '.JPG') or (Ext = '.WMF') or (Ext = '.JPEG') then
            begin
              Img := TImage.Create(Owner);
              Img.Parent := Owner;
              Img.Stretch := True;
              Img.Proportional := True;
              Img.Center := True;
              Img.Tag := 785;
              Img.Picture.LoadFromFile(FileName);
              Img.SetBounds(wLeft,wTop,ThumbSize,ThumbSize);

              //-- Pular linha qdo ultrapassar o width do scrollbox
              wLeft := ThumbSize + 8 + wLeft;
              if wLeft > Owner.Width then
                begin
                  wLeft := 8;
                  wTop := ThumbSize + 8 + wTop;
                end
            end;

        end;
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  CreateThumbs('D:\Nosredna\Meus documentos\Minhas imagens',50,ScrollBox1);
end;

end.


Espero que sirva para alguem um dia Wink
_________________
Estou de volta!!!
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular Enviar E-mail Visitar a homepage do Usuário Yahoo Messenger MSN Messenger
Mostrar os tópicos anteriores:   
Novo Tópico   Responder Mensagem    ActiveDelphi - Índice do Fórum -> Off-Topic Todos os horários são GMT - 3 Horas
Página 1 de 1

 
Ir para:  
Enviar Mensagens Novas: Proibido.
Responder Tópicos Proibido
Editar Mensagens: Proibido.
Excluir Mensagens: Proibido.
Votar em Enquetes: Proibido.


Powered by phpBB © 2001, 2005 phpBB Group
Traduzido por: Suporte phpBB