segunda-feira, 22 de julho de 2019

TVertScrollBox

Para posicionar o item dentro de um TVertScrollBox


  VertScrollBox1.ViewportPosition :=  PointF(VertScrollBox1.ViewportPosition.X, Posicao);

sexta-feira, 12 de julho de 2019

Reduzir tamanho imagem

uses Vcl.Imaging.jpeg;


function CAPAS_REDUZ(ORIG,DEST:string; const fWidth, fHeight: integer):Boolean;
var pTemp: TBitmap;
begin
try
try
pTemp := nil;
ptemp := TBitmap.Create;
pTemp.LoadFromFile(ORIG);
if (pTemp.Width > fWidth) or (pTemp.Height > fHeight) then
begin
pTemp := pTemp.CreateThumbnail(fWidth,fHeight);
pTemp.SaveToFile(DEST);
end
else
CopyFile(PChar(ORIG), PChar(DEST), true);
result := true;
finally
FreeAndNil(pTemp);
end;
except
FreeAndNil(pTemp);
result := false;
end;
end;

terça-feira, 9 de julho de 2019

Modelo de uma thread Delphi XE

var vThread: TThread; begin vThread := TThread.CreateAnonymousThread(procedure () var VReturnVersaoApp: string; VTestConnection: Boolean; begin TThread.Synchronize (TThread.CurrentThread, procedure () begin end); end); vThread.FreeOnTerminate := True; vThread.Start();

segunda-feira, 8 de julho de 2019

Obter o nome da pasta onde esta o executavel

Para  obter a pasta onde esta o executável Delphi

Function ObterNomePastaExecutavel;
begin
   Result := ExtractFilePath(ParamStr(0));
end;


quarta-feira, 3 de julho de 2019

MD5 com Indy

A função/método abaixo dá um exemplo de como implementar MD5:

Inclua na seção "USES" a unit "IdHashMessageDigest"
//uses
//IdHashMessageDigest;



function MD5(const texto:string):string;
var
  idmd5 : TIdHashMessageDigest5;
begin
  idmd5 := TIdHashMessageDigest5.Create;
  try
    result := idmd5.HashStringAsHex(texto);
  finally
    idmd5.Free;
  end;
end;


Para criptografar um arquivo inteiro use a função abaixo.

function MD5(const fileName : string) : string;
var
  idmd5 : TIdHashMessageDigest5;
  fs : TFileStream;
begin
  idmd5 := TIdHashMessageDigest5.Create;

  fs := TFileStream.Create(fileName, fmOpenRead OR fmShareDenyWrite) ;
  try
    result := idmd5.HashStreamAsHex(fs);
  finally
    fs.Free;
    idmd5.Free;
  end;
end;

para usar a função basta chama-la passando o caminho completo do arquivo que queremos criptografar, ela
retornará o hash desse arquivo.

segunda-feira, 17 de junho de 2019

Alterar cor do fonte do Label Firemonkey em tempo de execucao

To enable modifying font color of a TLabel object, you need to change its StyledSettings property.
It's an array defining the different settings that are defined by the current style and cannot be changed by other means.
To be able to change the color of the font, you have to remove the TStyledSetting.FontColor entry from this array.
You can do it programmatically with
Label1.StyledSettings := Label1.StyledSettings - [TStyledSetting.FontColor];
or from the Object Inspector in the designer, select your label, go in StyledSettings and untick FontColor.
Other settings that can be fixed by the current style are
  • TStyledSetting.Family
  • TStyledSetting.Size
  • TStyledSetting.Style
  • TStyledSetting.Other
So, for being able to change the font color and the size, you would write:
Label1.StyledSettings := Label1.StyledSettings - [TStyledSetting.FontColor, TStyledSetting.Size];

sexta-feira, 14 de junho de 2019

Saber se o listview do firemonkey chegou no fim
var
  R: TRectF;
begin
  if TListView(Sender).ItemCount > 0 then // Just in case...
  begin
    // Get the last item's Rect
    R := TListView(Sender).GetItemRect(TListView(Sender).ItemCount - 1);
    // Bottom?
    if R.Bottom = TListView(Sender).Height then
      showmessage('Reached bottom');
  end;
end; 


Basta colocar no evento OnScrollViewChange do listview.

domingo, 24 de fevereiro de 2019

Detectando Memory Leaks - Postado em https://www.devmedia.com.br/forum/detectando-memory-leaks/366404

Detectando Memory Leaks

24/11/2008
17
[b:04b3fe4686]Vamos conversar sobre memory leaks. [/b:04b3fe4686]

Quanto mais programamos Orientado a Objetos, mais temos a necessidade de instanciar componentes sem colá-los na nossa form, ou de instanciá-los dentro de nossas porprias classes. 

Isso pode causar diversos memory – leaks causados por 4 fatores:

1)esquecimento de dar um free no objeto ou componentes sem owner que não são liberados
2)uma exeption, abort, exit, close, halt ou coisa parecida acontecendo antes do free.
3)Instanciar 2 vezes um objeto em uma mesma variável, perdendo a referencia do primeiro.
4)Ponteiros que apontam para estruturas alocadas dinamicamente que você esquece de dar um freemem.

A edição 72 da revista clubedelphi fala sobre isso, e até fala sobre quando usar os owners self, application, formx ou nil. 

Nem sempre estamos dentro de uma form, nem sempre nossa classe é um descendente de TComponent, então passar self, application ou qualquer outra coisa é impossível, certo? Então temos de usar o nil. 

Um outro motivo para se usar o nil é que cada vez que você usa como owner self, outro componente ou application (que também é um Tcomponent), uma referencia a este objeto será adicionada a um array de components do owner. Imagine que cada componente, inclusive application, tem um vetor de componentes. E cada vez que este componente vira owner de uma nova instancia de um outro componente qualquer(quando você instancia um componente com owner diferente de nil), um ponteiro para essa nova instancia (4 bytes, o mesmo tamanho de um integer) é adicionado a esse vetor. Quando esse owner é liberado da memória com free um contador vai percorrendo todo esse vetor dando free para destruir cada um desses outros componentes instanciados. Imagine o tempo e o custo disso, em memória e processador, para liberar da memória um cara que seja owner de 1000000 de objetos, por exemplo.

Se quiser faça o teste: crie uma classe pesada, tipo um form. Faça um loop de 1 a 1000000 instanciando uma copia desse form passando como parâmetro owner ou o application ou uma outra form qualquer. Não precisa dar show. Independente de você liberar da memória depois ou não, veja o tempo que demora. Você pode usar para isso o gettickcount. 

Faça o mesmo teste, só que dessa vez passando nil. Bem mais rápido certo? Isso porque quando você passa nil como owner o componente não tem owner, então você economiza varia operações, como colocar uma referencia a esse objeto no vetor de componentes (sem owner ele não existe).

Mas e para liberar da memória? Agora não vai liberar sozinho....

Sempre que você criar um componente em runtime com owner nil faça da seguinte maneira: 

1
2
3
4
5
6
Try
MinhaQuery := TQuery.Create(nil);
//operações com MinhaQuery......
finally
MinhaQuery.Free;
End;


Ou

1
2
3
4
5
6
7
8
9
10
Try
Try
MinhaQuery := TQuery.Create(nil);
//operações com MinhaQuery......
Except
//tratamento da exceção
end;
finally
MinhaQuery.Free;
End;


Isso garante que o free sempre será executado e o objeto sempre liberado da memória.

Agora, como detectar memory leaks que já existem a um tempão no sistema por falta de atenção e você não sabe exatamente onde?

Você pode usar o CNWizards (conhecido também como CNPack), que é um excelente conjunto de bibliotecas e add-ins para o delphi. Ou você pode usar o FastMM4.

[url]http://www.cnpack.org/[/url]
[url]http://sourceforge.net/projects/fastmm/[/url]

Usando o CNpack:
Numa form qualquer coloque um Button e no onclick dele digite o código abaixo:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
procedure TForm1.btCriaClick(Sender: TObject);
var
  obj: TStringList;
begin
  obj := TStringList.Create;
  obj.Add(´vitor´);
 
  //tirando apenas essa linha podemos criar um tipo de memory leak muito comum, que é instanciar em pontos diferentes do código dois objetos numa mesma variavel e esquecer de libera-los
  //obj.Free;
 
  obj := TStringList.Create;
  obj.Add(´rubio´);
  obj.Free;
 
  //outro tipo comum de memory leak, criar objetos para uso imediato e esquecer de liberar
  {
    with TStringList.Create do
    begin
      //Free;
    end;
 
    with TButton.Create(nil) do
    begin
      Name := ´btZeh´;
      //Free;
    end;
  }
 
 
end;


Repare que o código possui 3 maneiras diferentes de se causar um memory leak, mas duas estão comentadas, usaremos uma só. Fique a vontade para testar as outras.

Se você instalou corretamente o CnPack, agora você tem alguns novos templates de projetos, e o search path do seu delphi aponta para alguns locais onde tem algumas novas units interessantes.

Vá para a unit do seu projeto .dpr (project1.dpr) e adicione em primeiro lugar no uses a unit 

cnMemProf, assim:

1
2
3
4
5
6
7
8
program Project1;
 
uses
  CnMemProf,
  Forms,
  Unit1 in ´Unit1.pas´ ;
 
{$R *.RES}

depois do begin, antes do application.initialize configure o valor dessas 5 variaveis globais:

1
2
3
4
5
mmPopupMsgDlg := True;
mmShowObjectInfo := True;
mmUseObjectList := True;
mmSaveToLogFile := True;
mmErrLogFile := ´D:\vitor\exemplos\CnMemoryProfiler\log.log´.


Seu dpr ficará assim:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
program Project1;
 
uses
  CnMemProf,
  Forms,
  Unit1 in ´Unit1.pas´ ;
 
{$R *.RES}
 
begin
 
  //configuração do CnMemProf
  mmPopupMsgDlg := True;
  mmShowObjectInfo := True;
  mmUseObjectList := True;
  mmSaveToLogFile := True;
  mmErrLogFile := ´D:\vitor\exemplos\CnMemoryProfiler\log.log´;
   
 
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.


Quanto mais informação de debug melhor, então vá a Project  options e na aba compiler marque “use debug DCUs” (desmarcando o “optimization” e marcando o “stack Frames” você tem mais informações de debug, mas essas não vão ser usadas aqui)

Execute a aplicação, clique no botão que cria os objetos sem destruir e feche a aplicação. Você receberá uma mensagem dizendo que ocorreram memory leaks. Veja o log:

::::::::::::::::::::::::::::::::::::::::::::::::::::: 24/11/2008 15:56:43 Application total run time: 0 hour(s) 0 minute(s) 2 second(s)¡& There are 77 allocated before replace memory manager. HeapStatus.TotalAddrSpace: 1024 KB HeapStatus.TotalUncommitted: 992 KB HeapStatus.TotalCommitted: 32 KB HeapStatus.TotalFree: 29 KB HeapStatus.TotalAllocated: 1 KB TotalAllocated div TotalAddrSpace: 0¬ HeapStatus.FreeSmall: 0 KB HeapStatus.FreeBig: 29 KB HeapStatus.Unused: 0 KB HeapStatus.Overhead: 0 KB Objects count in memory: 3 1) 0000000000CA4A8C - 55($0037)Byte - 2) 0000000000CA4AC0 - 38($0026)Byte - 3) 0000000000CA38F0 - 23($0017)Byte –


Certo, quem não manja muito de hexadecimal e nem de assembly, como é meu caso, percebe que há um memory leak, mas não exatamente onde. Vamos ver se conseguimos uma informação mais detalhada. 

Crie um outro projeto igual a esse, descompacte as units da biblioteca FastMM4 na pasta do projeto e edite o arquivo FastMM4Options.inc

Mude a linha {.$define FullDebugMode} para {$define FullDebugMode} e a linha 
{.$define ClearLogFileOnStartup} para {$define ClearLogFileOnStartup} (para limpar o log a cada nova execução).

Adicione a unit FastMM4 como a primeira unit no uses do seu project1.dpr e sete os valores das variáveis:

1
2
FullDebugModeScanMemoryPoolBeforeEveryOperation := True;
SuppressMessageBoxes:=False;


O seu dpr ficará assim:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
program Project1;
uses
  FastMM4,
  Forms,
  Unit1 in ´Unit1.pas´ ;
 
{$R *.RES}
 
begin
 
  //configuração do FastMM4
  FullDebugModeScanMemoryPoolBeforeEveryOperation := True;
  SuppressMessageBoxes:=False;
 
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.



Execute a aplicação, crie o objeto sem destruir (clicando no botão), feche a aplicação e verá que aparecerá uma mensagem de memory leak um pouco mais detalhada. Agora veja o log, atenção para a área em negrito:


--------------------------------2008/11/24 16:11:25-------------------------------- A memory block has been leaked. The size is: 20 This block was allocated by thread 0x2C4, and the stack trace (return addresses) at the time was: 402D38 [system.pas][System][@GetMem][2439] 41B68A [classes.pas][Classes][TStringList.AddObject][4589] 41B60E [classes.pas][Classes][TStringList.Add][4576] [u:04b3fe4686][b:04b3fe4686]460058 [Unit1.pas][Unit1][TForm1.btCriaClick][59][/b:04b3fe4686][/u:04b3fe4686] 4398BC [Controls.pas][Controls][TControl.Click][4705] 4308D4 [StdCtrls.pas][StdCtrls][TButton.Click][3472] 430A3B [StdCtrls.pas][StdCtrls][TButton.CNCommand][3524] 43968E [Controls.pas][Controls][TControl.WndProc][4645] 43D20B [Controls.pas][Controls][TWinControl.WndProc][6342] 430723 [StdCtrls.pas][StdCtrls][TButtonControl.WndProc][3414] 439399 [Controls.pas][Controls][TControl.Perform][4552] The block is currently used for an object of class: Unknown The allocation number is: 504 Current memory dump of 256 bytes starting at pointer address 7FF8F570: 01 00 00 00 05 00 00 00 76 69 74 6F 72 00 EE 00 19 7E 80 80 80 80 80 80 00 00 00 00 D1 F6 F8 7F 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 96 01 00 00 38 2D 40 00 F8 E0 41 00 EF E3 41 00 28 E3 41 00 C7 0B 42 00 AA 6B 43 00 15 B1 43 00 34 58 45 00 EA F1 41 00 3C C3 41 00 AD 95 41 00 C4 02 00 00 63 2D 40 00 8B AF 43 00 87 46 45 00 F0 54 45 00 89 08 42 00 03 31 45 00 76 44 40 00 D7 6F 81 7C 00 00 00 00 00 00 00 00 00 00 00 00 C4 02 00 00 14 00 00 00 00 00 00 00 D4 03 2A 01 84 6C 46 00 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 2B FC D5 FE 00 00 00 00 B1 F3 F8 7F 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 FB 01 00 00 38 2D 40 00 8A B6 41 00 0E B6 41 00 74 00 46 00 BC 98 43 00 D4 08 43 00 3B 0A 43 00 8E 96 43 00 0B D2 43 00 23 07 43 00 99 93 43 00 A memory block has been leaked. The size is: 36 This block was allocated by thread 0x2C4, and the stack trace (return addresses) at the time was: 402DBD [system.pas][System][@ReallocMem][2550] 41BA7D [classes.pas][Classes][TStringList.Grow][4705] 41BB90 [classes.pas][Classes][TStringList.InsertItem][4730] 41B68A [classes.pas][Classes][TStringList.AddObject][4589] 41B60E [classes.pas][Classes][TStringList.Add][4576] [b:04b3fe4686][u:04b3fe4686]460058 [Unit1.pas][Unit1][TForm1.btCriaClick][59][/u:04b3fe4686][/b:04b3fe4686] 4398BC [Controls.pas][Controls][TControl.Click][4705] 4308D4 [StdCtrls.pas][StdCtrls][TButton.Click][3472] 430A3B [StdCtrls.pas][StdCtrls][TButton.CNCommand][3524] 43968E [Controls.pas][Controls][TControl.WndProc][4645] 43D20B [Controls.pas][Controls][TWinControl.WndProc][6342] The block is currently used for an object of class: Unknown The allocation number is: 503 Current memory dump of 256 bytes starting at pointer address 7FF95880: 78 F5 F8 7F 00 00 00 00 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 E4 8D 55 FC 80 80 80 80 00 00 00 00 61 59 F9 7F 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 B1 01 00 00 38 2D 40 00 C1 66 43 00 B8 AD 43 00 C0 05 43 00 4C 08 43 00 04 DF 41 00 39 E1 41 00 EF E3 41 00 28 E3 41 00 C7 0B 42 00 AA 6B 43 00 C4 02 00 00 63 2D 40 00 DF 37 40 00 D2 AF 43 00 8B AF 43 00 87 46 45 00 F0 54 45 00 89 08 42 00 03 31 45 00 76 44 40 00 D7 6F 81 7C 00 00 00 00 C4 02 00 00 24 00 00 00 F8 26 42 00 76 23 F1 01 84 6C 46 00 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 89 DC 0E FE 00 00 00 00 11 5A F9 7F 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 B2 01 00 00 38 2D 40 00 F5 66 43 00 B8 AD 43 00 This block was allocated by thread 0x2C4, and the stack trace (return addresses) at the time was: 402D38 [system.pas][System][@GetMem][2439] 4398BC [Controls.pas][Controls][TControl.Click][4705] 4308D4 [StdCtrls.pas][StdCtrls][TButton.Click][3472] 430A3B [StdCtrls.pas][StdCtrls][TButton.CNCommand][3524] 43968E [Controls.pas][Controls][TControl.WndProc][4645] 43D20B [Controls.pas][Controls][TWinControl.WndProc][6342] 430723 [StdCtrls.pas][StdCtrls][TButtonControl.WndProc][3414] 439399 [Controls.pas][Controls][TControl.Perform][4552] 43D3CD [Controls.pas][Controls][DoControlMsg][6388] 43DBAA [Controls.pas][Controls][TWinControl.WMCommand][6574] 458F35 [Forms.pas][Forms][TCustomForm.WMCommand][4116] The block is currently used for an object of class: TStringList The allocation number is: 502 Current memory dump of 256 bytes starting at pointer address 7FF99870: FC 76 41 00 00 00 00 00 00 00 00 00 00 00 00 00 80 58 F9 7F 01 00 00 00 04 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 EB 89 4A 7A 80 80 80 80 00 00 00 00 01 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 F9 01 00 00 38 2D 40 00 BC 98 43 00 D4 08 43 00 3B 0A 43 00 8E 96 43 00 0B D2 43 00 23 07 43 00 99 93 43 00 CD D3 43 00 AA DB 43 00 35 8F 45 00 C4 02 00 00 63 2D 40 00 DF 37 40 00 BC 98 43 00 D4 08 43 00 3B 0A 43 00 8E 96 43 00 0B D2 43 00 23 07 43 00 99 93 43 00 CD D3 43 00 AA DB 43 00 C4 02 00 00 30 00 00 00 FC 76 41 00 3A F6 FF 85 84 6C 46 00 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 80 C5 09 00 7A 80 80 80 80 00 00 00 00 00 00 00 00 ; . C . Ž – C . . Ò C . # . C . ™ “ C . Í Ó C . ª Û C . 5  E . Ä . . . c - @ . ß 7 @ . ¼ ˜ C . Ô . C . ; . C . Ž – C . . Ò C . . C . ™ “ C . Í Ó C . ª Û C . Ä . . . 0 . . . ü v A . : ö ÿ … „ l F . € € € € € € € € € € € € € € € € € € € € € € € € € € € € € € € € € € € € € € € € € € € € Å . . z € € € € . . . . . . . . --------------------------------2008/11/24 16:11:25-------------------------------- This application has leaked memory. The small block leaks are (excluding expected leaks registered by pointer): 13 - 20 bytes: AnsiString x 1 21 - 36 bytes: Unknown x 1 37 - 52 bytes: TStringList x 1 Note: Memory leak detail is logged to a text file in the same folder as this application. To disable this memory leak check, undefine ´EnableMemoryLeakReporting´.


No caso, no meu projeto o memory leak ficou na unit1, form1 linha 59. Se eu olhar a linha 59 da unit1: obj.Add(´vitor´);
Ou seja, é uma linha muito próxima da onde está acontecendo o memory leak: é um pouco depois da criação do primeiro objeto e um pouco antes da criação do segundo, onde eu crio por cima da mesma variável perdendo a referencia ao meu primeiro objeto, que fica órfão na memória.

Com um pouco de atenção podemos resolver quase todos os problemas olhando nesse log, a menos que sejam problemas de bibliotecas de terceiros as quais desconhecemos.

Espero que tenha ajudado todos a detonar seus memory leaks. Quem tiver uma sugestão ou souber de algum recurso ou melhor uso do CnMemory Profiler ou do FastMM4 por favor poste aqui para um intercâmbio de conhecimento.