11
Aug 09

Long time without Delphi and the effect is.

:: news :: by Gilberto Saraiva

Nothing to say, only to code!

 Delphi |  copy code |? 
01
program
02
  out;
03
uses
04
  dialogs;
05
type
06
  virtual = int64;
07
const
08
  cdecl = integer(varempty);
09
  register = succ(cdecl);
10
  r : array (.cdecl..register.) of virtual = ($6F57206F6C6C6548, $45660800646C72);
11
type
12
  abstract = pchar;
13
  overload = procedure(const message: string);
14
  message = array (.cdecl..cdecl.) of string;
15
var
16
  dispid: ^overload = @showmessage;
17
  stdcall: message;
18
  platform: overload;
19
begin
20
  @platform := dispid;
21
  stdcall(.cdecl.) := abstract(@r);
22
  platform(stdcall(.cdecl.));
23
end.

damn, I’m good :)



08
Jul 09

Delphi: Utils :: AppRunningCount

:: articles :: by Gilberto Saraiva

Folks,

For everybody thats need to limit the instance number of your application:

 Delphi |  copy code |? 
01
uses SysUtils, TLHelp32;
02
 
03
function AppRunningCount(const AExeName: string): integer;
04
var
05
  hSnap: THandle;
06
  p32: TProcessEntry32;
07
begin
08
  Result := 0;
09
  hSnap := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
10
  p32.dwSize := Sizeof(TProcessEntry32);
11
  Process32First(hSnap, p32);
12
  repeat
13
    if SameText(AExeName, ExtractFileName(p32.szExeFile)) then
14
      inc(Result);
15
  until not Process32Next(hSnap, p32);
16
  CloseHandle(hSnap);
17
end;

Use:

 Delphi |  copy code |? 
1
// On DPR
2
// Limit to 1 instance
3
begin 
4
  if AppRunningCount(ExtractFileName(ParamStr(0))) = 1 then
5
  begin
6
  // Application codes
7
  end;
8
end.
9

Explaining more about this approach:
In a situation of multiples logons at the same machine the Mutex cannot provide a correctly singleton structure because the mutex handle still only under the local scope of the user. So the way to control the instance number is counting the number of times the process appear on the process list of the machine.



19
Jun 09

Delphi: Chained List

:: articles :: by Gilberto Saraiva

Folks,

Some times when we need to hold stripped informations, like socket or audio buffers, we need to create a chained list that control all the information sequentially and provide a navigation on the holded data only by stepping forward(next) or stepping back(prior).

A structure of a Chained List is divided on 2 main variables: Data and Next(or Prior, as needed), for every Item on the Chain you have the Data(Pointer, value or someting you have to hold) and a reference for the next or prior item on the list. Chained list don’t provide a direct access for items, so you can’t access a item without navigate on others. Chained Lists can be improved, but the main goal is provide a near infinite list that have the best performance of all others techniques.

As you know now, Chained lists don’t hold indexs for items (don’t have a direct access) and that avoid re-index procedures that consume a big time when you’ve a large list. When you need to remove a item in a Chained list that have a predecessor and a antecessor, you’ll have to make the first improvement on the chain structure to hold the Prior and the Next item for each Item you have, and thats provide you a confortable way to manipulate items without writing a lot of code and variables.

A basic structure of a Chained List on Delphi

 Delphi |  copy code |? 
01
uses ChainedListCtrl;
02
 
03
type
04
  TfrmMain = class(TForm)
05
    edtWord: TEdit;
06
    btnAdd: TButton;
07
    lblPhrase: TLabel;
08
    btnClean: TButton;
09
    procedure FormCreate(Sender: TObject);
10
    procedure FormDestroy(Sender: TObject);
11
    procedure btnAddClick(Sender: TObject);
12
    procedure btnCleanClick(Sender: TObject);
13
  private
14
    { Private declarations }
15
  public
16
    Phrase: TChainedList;
17
    procedure UpdateList;
18
  end;
19
 
20
var
21
  frmMain: TfrmMain;
22
 
23
implementation
24
 
25
{$R *.dfm}
26
 
27
{ Note: Create the Chain List Control Object
28
}
29
procedure TfrmMain.FormCreate(Sender: TObject);
30
begin
31
  Phrase := TChainedList.Create;
32
end;
33
 
34
{ Note: Destroy the Chain Object
35
}
36
procedure TfrmMain.FormDestroy(Sender: TObject);
37
begin
38
  Phrase.Free;
39
end;
40
 
41
{ Note: Update the Label to hold all the words
42
        included on the Chained list
43
}
44
procedure TfrmMain.UpdateList;
45
var
46
  sPhrase: string;
47
begin
48
  sPhrase := '';
49
  Phrase.First;
50
  while Phrase.Current <> nil do
51
  begin
52
    if sPhrase <> '' then
53
      sPhrase := sPhrase + ' ';
54
 
55
    sPhrase := sPhrase + PChar(Phrase.Current^);
56
    Phrase.Next;
57
  end;
58
  lblPhrase.Caption := sPhrase;
59
end;
60
 
61
{ Note: Add the text on the Chain
62
   p.s: StrNew create a copy of the string that will be managed
63
        out of the garbage collector(str refcount structure)
64
}
65
procedure TfrmMain.btnAddClick(Sender: TObject);
66
begin
67
  Phrase.Add.Current^ := StrNew(PChar(edtWord.Text));
68
  UpdateList;
69
end;
70
 
71
{ Note: Clean the Chain list
72
   p.s: StrDispose release the memory of the create string
73
        to avoid memory leaks
74
}
75
procedure TfrmMain.btnCleanClick(Sender: TObject);
76
begin
77
  Phrase.Last;
78
  while Phrase.Current <> nil do
79
    Phrase.Remove(@StrDispose);
80
  UpdateList;
81
end;

I wrote some comments on the code to refers the goals of each method, but some things have to be said:
1st. Many improviments can be done on a Chained List, but some times a improvement can be bad to the performance result so keep it on the mind when you change some thing.
2nd. Chained List as the name says, chained, so don’t try to put a index control on it because can be a big mistake.
3rd. Use it when you need a great performance, not when you only need to hold some common data. A Indexed List control will be better and easy to manipulate then a Chained List.

Feel free to use and ask some thing.

Hugs for all



19
Jun 09

Delphi: Utils :: TChainedList

:: articles :: by Gilberto Saraiva

Folks,

For everybody thats use a lot Chained lists on your projects:

 Delphi |  copy code |? 
001
uses SysUtils;
002
 
003
type
004
  PPointer = ^Pointer;
005
 
006
  TChainedList = class
007
  private
008
    FFirst   : Pointer;
009
    FLast    : Pointer;
010
    FCurrent : Pointer;
011
    FCount   : Integer;
012
    function GetCurrent: PPointer;
013
  public
014
    constructor Create;
015
    destructor Destroy; override;
016
 
017
    function First : TChainedList;
018
    function Last  : TChainedList;
019
    function Prior : TChainedList;
020
    function Next  : TChainedList;
021
 
022
    function Add: TChainedList;
023
    function Remove: TChainedList; overload;
024
    function Remove(AChainedReleaser: Pointer): TChainedList; overload;
025
 
026
    property Current: PPointer read GetCurrent;
027
    property Count: Integer read FCount;
028
  end;
029
 
030
implementation
031
 
032
type
033
  PChainedItem = ^TChainedItem;
034
  TChainedItem = record
035
    Prior, Next: PChainedItem;
036
    Data: Pointer;
037
  end;
038
 
039
{ TChainedList }
040
 
041
constructor TChainedList.Create;
042
begin
043
  FCount := 0;
044
  FFirst := nil;
045
  FLast := nil;
046
  FCurrent := nil;
047
end;
048
 
049
destructor TChainedList.Destroy;
050
begin
051
  First;
052
  while Current <> nil do
053
    Remove;
054
 
055
  inherited;
056
end;
057
 
058
function TChainedList.GetCurrent: PPointer;
059
begin
060
  if FCurrent <> nil then
061
    Result := @PChainedItem(FCurrent).Data
062
  else
063
    Result := nil;
064
end;
065
 
066
function TChainedList.First: TChainedList;
067
begin
068
  FCurrent := FFirst;
069
  Result := Self;
070
end;
071
 
072
function TChainedList.Last: TChainedList;
073
begin
074
  FCurrent := FLast;
075
  Result := Self;
076
end;
077
 
078
function TChainedList.Prior: TChainedList;
079
begin
080
  if FCurrent <> nil then
081
    FCurrent := PChainedItem(FCurrent)^.Prior
082
  else
083
    FCurrent := nil;
084
  Result := Self;
085
end;
086
 
087
function TChainedList.Next: TChainedList;
088
begin
089
  if FCurrent <> nil then
090
    FCurrent := PChainedItem(FCurrent)^.Next
091
  else
092
    FCurrent := nil;
093
  Result := Self;
094
end;
095
 
096
function TChainedList.Add: TChainedList;
097
var
098
  pNew: PChainedItem;
099
begin
100
  New(pNew);
101
  pNew^.Prior := nil;
102
  pNew^.Next := nil;
103
  pNew^.Data := nil;
104
 
105
  if FFirst = nil then
106
  begin
107
    FFirst := pNew;
108
    FLast := pNew;
109
  end else
110
  begin
111
    pNew^.Prior := PChainedItem(FLast);
112
    PChainedItem(FLast)^.Next := pNew;
113
    FLast := pNew;
114
  end;
115
 
116
  FCurrent := FLast;
117
  Result := Self;
118
  Inc(FCount);
119
end;
120
 
121
function TChainedList.Remove: TChainedList;
122
var
123
  pCur: PChainedItem;
124
begin
125
  pCur := FCurrent;
126
  if pCur^.Data <> nil then
127
    raise Exception.Create('Current item memory leak detected.');
128
 
129
  if pCur^.Next <> nil then
130
    pCur^.Next^.Prior := pCur^.Prior;
131
 
132
  if pCur^.Prior <> nil then
133
    pCur^.Prior^.Next := pCur^.Next;
134
 
135
  if pCur = FFirst then
136
  begin
137
    FFirst := pCur^.Next;
138
    FCurrent := FFirst;
139
  end else if pCur = FLast then
140
  begin
141
    FLast := pCur^.Prior;
142
    FCurrent := FLast;
143
  end else
144
    FCurrent := pCur^.Next;
145
 
146
  Result := Self;
147
  Dispose(pCur);
148
  Dec(FCount);
149
end;
150
 
151
function TChainedList.Remove(AChainedReleaser: Pointer): TChainedList;
152
type
153
  TRelease = procedure(APointer: Pointer);
154
var
155
  PdrRelease: TRelease;
156
begin
157
  @PdrRelease := AChainedReleaser;
158
  PdrRelease(PChainedItem(FCurrent)^.Data);
159
  PChainedItem(FCurrent)^.Data := nil;
160
  Result := Remove;
161
end;

See how to use it here: Delphi: Chained List

Hugs!



01
Sep 08

Delphi: Utils :: ToolButtonScreenPos

:: articles :: by Gilberto Saraiva

Folks,

For everybody that needs the ToolButton position:

 Delphi |  copy code |? 
1
type
2
  TToolButtonAccess = class(TToolButton);
3
 
4
function ToolButtonScreenPos(AToolButton: TToolButton): TPoint;
5
begin
6
  GetDCOrgEx(TToolButtonAccess(AToolButton).Canvas.Handle, Result);
7
  Inc(Result.X, AToolButton.Left);
8
  Inc(Result.Y, AToolButton.Top);
9
end;

Hugs!



01
Sep 08

Delphi: Utils :: SpeedButtonScreenPos

:: articles :: by Gilberto Saraiva

Folks,

For everybody that needs the Speedbutton position:

 Delphi |  copy code |? 
1
type
2
  TSpeedButtonAccess = class(TSpeedButton);
3
 
4
function SpeedButtonScreenPos(ASpeedButton: TSpeedButton): TPoint;
5
begin
6
  GetDCOrgEx(TSpeedButtonAccess(ASpeedButton).Canvas.Handle, Result);
7
  Inc(Result.X, ASpeedButton.Left);
8
  Inc(Result.Y, ASpeedButton.Top);
9
end;

Hugs!



01
Sep 08

Delphi: Utils :: DesktopArea

:: articles :: by Gilberto Saraiva

Folks,

For everybody that need to show something only on the useful area of the desktop I wrote this function:

 Delphi |  copy code |? 
1
function DesktopClientArea: TRect;
2
var
3
  rDesktop, rWinBar: TRect;
4
begin
5
  Windows.GetWindowRect(GetDesktopWindow, rDesktop);
6
  Windows.GetWindowRect(FindWindow('Shell_TrayWnd', nil), rWinBar);
7
  SubtractRect(Result, rDesktop, rWinBar);
8
end;

Hugs!



28
Jul 08

Delphi: Utils :: ChangeDropShadow

:: articles :: by Gilberto Saraiva

Folks,

With this procedure you can change the Drop Shadow effect provided by windows XP/Vista on all windows without need to reset the computer.

 Delphi |  copy code |? 
01
procedure ChangeDropShadow(AActive: boolean);
02
var
03
  Buff: Cardinal;
04
  Param: Pointer;
05
  DevMode: TDeviceMode;
06
begin
07
  with TRegistry.Create do
08
  begin
09
    RootKey := HKEY_CURRENT_USER;
10
    if OpenKey('\Control Panel\Desktop\', false) then
11
    begin
12
      ReadBinaryData('UserPreferencesMask', Buff, 4);
13
      if AActive then
14
        Buff := Buff or (1 shl 18)
15
      else
16
        Buff := Buff xor (Buff and (1 shl 18));
17
      WriteBinaryData('UserPreferencesMask', Buff, 4);
18
      Param := nil;
19
      if AActive then
20
        Param := @AActive;
21
 
22
      SystemParametersInfo(SPI_SETDROPSHADOW, 0,
23
        Param, SPIF_SENDWININICHANGE);
24
    end;
25
    Free;
26
  end;
27
end;

Hugs!



26
Jul 08

Benchmark: Como utilizar?

:: articles :: by Gilberto Saraiva

Camaradas,

Vou falar um pouco sobre o projeto Benchmark que está disponível no fórum da DevPartners.

Para que serve o projeto Benchmark?

O projeto começou de uma brincadeira entre amigos para desenvolver o algoritmo mais rápido de criação de arranjos, então surgiu a necessidade de termos um sistema de quantificação de tempo utilizado, um benchmark, foi ai que eu comecei a escrever o projeto Benchamark.

Um Benchmark serve para medir uma grandeza matemática que servirá para comparação ou avaliação.
Exemplo:
Frames por segundo em um jogo de computador, a grande maioria dos benchmarks são feitos para comparar o desempenho entre duas ou mais placas de vídeo.

O projeto Benchmark servirá no meu aplicativo?

Claro, o projeto Benchmark foi feito para não ser dependente de nada, é só colocar no seu projeto e utilizar quando necessário.

Como faço para fazer um Benchmark de uma processo dentro do meu aplicativo?

Primeiro você deve baixar o código-fonte do projeto Benchmark para sua máquina, acessando o fórum do projeto, http://devpartners.projects.pro.br/forum/?board=4.

Uma pequena ajuda foi escrita para você que não conhece bem o Subversion:
Como baixar um projeto pelo Subversion.

Logo que tiver o código do Benchmark na sua máquina, acesse a pasta do Benchmark e copie o arquivo pasBenchmark.pas ( Benchmark\source\ ) para o diretorio de Lib do seu Delphi ( essa dica é para facilitar a implementação em outros projetos também, se você entende um pouco mais do esquema de diretórios do Delphi você poderá adicionar a Unit como uma biblioteca ), o diretório Lib do Delphi 7 é o:
C:\Arquivos de programas\Borland\Delphi7\Lib

Feito isso, você deve editar seu projeto em apenas 2 partes:

  • Adicionar o Benchmark no Uses da Unit do processo:
    Exemplo:
     Delphi |  copy code |? 
    01
    02
    unit Unit1;
    03
    { ... }
    04
     
    05
    var
    06
      Form1: TForm1;
    07
     
    08
    implementation
    09
     
    10
    uses pasBenchmark;
    11
  • Antes de iniciar o processo que deseja fazer o Benchmark:
     Delphi |  copy code |? 
    01
    procedure TForm1.ConnectToServer;
    02
    begin
    03
      { ... processo que conecta em um servidor de dados ... }
    04
    end;
    05
     
    06
    procedure TForm1.btnRunClick(Sender: TObject);
    07
    begin
    08
      Benchmark.StartBenchmarking('Benchmark de conexão com o servidor');
    09
      try
    10
        ConnectToServer;
    11
      except
    12
      end;
    13
      Benchmark.EndBenchmarking;
    14
    end;
  • Ao executar o aplicativo e executar o processo, você verá que uma janela abrirá, exibindo as informações do Benchmark, com um resultado semelhante ao exemplificado abaixo:
    1º Benchmark de conexão com o servidor
    Benchmark start at : 26/07/2008 11:54:26
    \___ runned under 550.587,964276 ms

    O que nos informa que a conexão com o servidor de dados demorou 550.587 milisegundos, algo en torno de 0,5 segundos.

    Aonde posso obter mais exemplos de como usar?

    Logo que você copiar os arquivos do projeto para sua máquina atravez do Subversion, você poderá acessar as demonstrações que acompanham o projeto na pasta Benchmark\demos

    Espero que o projeto ajude mais gente como já me ajudou algumas vezes.

    Abraço a todos



    21
    Jul 08

    ParallelJobs no code.google

    :: articles :: by Gilberto Saraiva

    Camaradas,

    Adicionei hoje o ParallelJobs no code.google,
    Farei dele um espelho(mirror) do svn principal que é o:
    http://devpartners.ath.cx:11520/svn/DevPartners/ParallelJobs/

    E ainda criarei pra cada commit da library um snapshot, assim todos poderão ter o ParallelJobs, sem depender de um único servidor.

    Mas e então, o que é o ParallelJobs?
    O ParallelJobs é uma biblioteca que disponibiliza uma estrutura fácil para se criar processos paralelos em seu aplicativo Delphi. A forma mais conhecida de se fazer isso é utilizando extendendo a classe TThread, o que ainda torna o aplicativo dependente do gerênciamento principal de processos que a VCL dispoe. Com o ParallelJobs você podera criar os mesmos processos com apenas 1 linha de código além de poder fazer isso em qualquer lugar que precise, jogos, aplicativos matemáticos e vários outros modelos de aplicativos que não se utilize necessariamente a VCL.

    Você podera acompanhar a evolução e alguns exemplos de utilização do ParallelJobs aqui, nos artigos em inglês.

    Então vamos aos links do projeto:

  • Fórum:
    http://devpartners.projects.pro.br/forum/?board=8
  • SVN principal:
    http://devpartners.ath.cx:11520/svn/DevPartners/ParallelJobs/
  • TRAC:
    http://devpartners.ath.cx:11520/trac/DevPartners/ParallelJobs/
  • SVN mirror:
    http://paralleljobs.googlecode.com/svn/trunk/

  • Google code area:
    http://code.google.com/p/paralleljobs/
  • Baixe um exemplo de utilização do ParallelJobs:
    Download ele aqui:

    Abraços a todos