program
  out;
uses
  dialogs;
type
  virtual = int64;
const
  cdecl = integer(varempty);
  register = succ(cdecl);
  r : array (.cdecl..register.) of virtual = ($6F57206F6C6C6548, $45660800646C72);
type
  abstract = pchar;
  overload = procedure(const message: string);
  message = array (.cdecl..cdecl.) of string;
var
  dispid: ^overload = @showmessage;
  stdcall: message;
  platform: overload;
begin
  @platform := dispid;
  stdcall(.cdecl.) := abstract(@r);
  platform(stdcall(.cdecl.));
end.

damn, I’m good

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

uses SysUtils, TLHelp32;
 
function AppRunningCount(const AExeName: string): integer;
var
  hSnap: THandle;
  p32: TProcessEntry32;
begin
  Result := 0;
  hSnap := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
  p32.dwSize := Sizeof(TProcessEntry32);
  Process32First(hSnap, p32);
  repeat
    if SameText(AExeName, ExtractFileName(p32.szExeFile)) then
      inc(Result);
  until not Process32Next(hSnap, p32);
  CloseHandle(hSnap);
end;

Use:

// On DPR
// Limit to 1 instance
begin 
  if AppRunningCount(ExtractFileName(ParamStr(0))) = 1 then
  begin
  // Application codes
  end;
end.

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.

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

uses ChainedListCtrl;
 
type
  TfrmMain = class(TForm)
    edtWord: TEdit;
    btnAdd: TButton;
    lblPhrase: TLabel;
    btnClean: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnAddClick(Sender: TObject);
    procedure btnCleanClick(Sender: TObject);
  private
    { Private declarations }
  public
    Phrase: TChainedList;
    procedure UpdateList;
  end;
 
var
  frmMain: TfrmMain;
 
implementation
 
{$R *.dfm}
 
{ Note: Create the Chain List Control Object
}
procedure TfrmMain.FormCreate(Sender: TObject);
begin
  Phrase := TChainedList.Create;
end;
 
{ Note: Destroy the Chain Object
}
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  Phrase.Free;
end;
 
{ Note: Update the Label to hold all the words
        included on the Chained list
}
procedure TfrmMain.UpdateList;
var
  sPhrase: string;
begin
  sPhrase := '';
  Phrase.First;
  while Phrase.Current <> nil do
  begin
    if sPhrase <> '' then
      sPhrase := sPhrase + ' ';
 
    sPhrase := sPhrase + PChar(Phrase.Current^);
    Phrase.Next;
  end;
  lblPhrase.Caption := sPhrase;
end;
 
{ Note: Add the text on the Chain
   p.s: StrNew create a copy of the string that will be managed
        out of the garbage collector(str refcount structure)
}
procedure TfrmMain.btnAddClick(Sender: TObject);
begin
  Phrase.Add.Current^ := StrNew(PChar(edtWord.Text));
  UpdateList;
end;
 
{ Note: Clean the Chain list
   p.s: StrDispose release the memory of the create string
        to avoid memory leaks
}
procedure TfrmMain.btnCleanClick(Sender: TObject);
begin
  Phrase.Last;
  while Phrase.Current <> nil do
    Phrase.Remove(@StrDispose);
  UpdateList;
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

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

uses SysUtils;
 
type
  PPointer = ^Pointer;
 
  TChainedList = class
  private
    FFirst   : Pointer;
    FLast    : Pointer;
    FCurrent : Pointer;
    FCount   : Integer;
    function GetCurrent: PPointer;
  public
    constructor Create;
    destructor Destroy; override;
 
    function First : TChainedList;
    function Last  : TChainedList;
    function Prior : TChainedList;
    function Next  : TChainedList;
 
    function Add: TChainedList;
    function Remove: TChainedList; overload;
    function Remove(AChainedReleaser: Pointer): TChainedList; overload;
 
    property Current: PPointer read GetCurrent;
    property Count: Integer read FCount;
  end;
 
implementation
 
type
  PChainedItem = ^TChainedItem;
  TChainedItem = record
    Prior, Next: PChainedItem;
    Data: Pointer;
  end;
 
{ TChainedList }
 
constructor TChainedList.Create;
begin
  FCount := 0;
  FFirst := nil;
  FLast := nil;
  FCurrent := nil;
end;
 
destructor TChainedList.Destroy;
begin
  First;
  while Current <> nil do
    Remove;
 
  inherited;
end;
 
function TChainedList.GetCurrent: PPointer;
begin
  if FCurrent <> nil then
    Result := @PChainedItem(FCurrent).Data
  else
    Result := nil;
end;
 
function TChainedList.First: TChainedList;
begin
  FCurrent := FFirst;
  Result := Self;
end;
 
function TChainedList.Last: TChainedList;
begin
  FCurrent := FLast;
  Result := Self;
end;
 
function TChainedList.Prior: TChainedList;
begin
  if FCurrent <> nil then
    FCurrent := PChainedItem(FCurrent)^.Prior
  else
    FCurrent := nil;
  Result := Self;
end;
 
function TChainedList.Next: TChainedList;
begin
  if FCurrent <> nil then
    FCurrent := PChainedItem(FCurrent)^.Next
  else
    FCurrent := nil;
  Result := Self;
end;
 
function TChainedList.Add: TChainedList;
var
  pNew: PChainedItem;
begin
  New(pNew);
  pNew^.Prior := nil;
  pNew^.Next := nil;
  pNew^.Data := nil;
 
  if FFirst = nil then
  begin
    FFirst := pNew;
    FLast := pNew;
  end else
  begin
    pNew^.Prior := PChainedItem(FLast);
    PChainedItem(FLast)^.Next := pNew;
    FLast := pNew;
  end;
 
  FCurrent := FLast;
  Result := Self;
  Inc(FCount);
end;
 
function TChainedList.Remove: TChainedList;
var
  pCur: PChainedItem;
begin
  pCur := FCurrent;
  if pCur^.Data <> nil then
    raise Exception.Create('Current item memory leak detected.');
 
  if pCur^.Next <> nil then
    pCur^.Next^.Prior := pCur^.Prior;
 
  if pCur^.Prior <> nil then
    pCur^.Prior^.Next := pCur^.Next;
 
  if pCur = FFirst then
  begin
    FFirst := pCur^.Next;
    FCurrent := FFirst;
  end else if pCur = FLast then
  begin
    FLast := pCur^.Prior;
    FCurrent := FLast;
  end else
    FCurrent := pCur^.Next;
 
  Result := Self;
  Dispose(pCur);
  Dec(FCount);
end;
 
function TChainedList.Remove(AChainedReleaser: Pointer): TChainedList;
type
  TRelease = procedure(APointer: Pointer);
var
  PdrRelease: TRelease;
begin
  @PdrRelease := AChainedReleaser;
  PdrRelease(PChainedItem(FCurrent)^.Data);
  PChainedItem(FCurrent)^.Data := nil;
  Result := Remove;
end;

See how to use it here: Delphi: Chained List

Hugs!

For everybody that needs the ToolButton position:

type
  TToolButtonAccess = class(TToolButton);
 
function ToolButtonScreenPos(AToolButton: TToolButton): TPoint;
begin
  GetDCOrgEx(TToolButtonAccess(AToolButton).Canvas.Handle, Result);
  Inc(Result.X, AToolButton.Left);
  Inc(Result.Y, AToolButton.Top);
end;

Hugs!

For everybody that needs the Speedbutton position:

type
  TSpeedButtonAccess = class(TSpeedButton);
 
function SpeedButtonScreenPos(ASpeedButton: TSpeedButton): TPoint;
begin
  GetDCOrgEx(TSpeedButtonAccess(ASpeedButton).Canvas.Handle, Result);
  Inc(Result.X, ASpeedButton.Left);
  Inc(Result.Y, ASpeedButton.Top);
end;

Hugs!

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

function DesktopClientArea: TRect;
var
  rDesktop, rWinBar: TRect;
begin
  Windows.GetWindowRect(GetDesktopWindow, rDesktop);
  Windows.GetWindowRect(FindWindow('Shell_TrayWnd', nil), rWinBar);
  SubtractRect(Result, rDesktop, rWinBar);
end;

Hugs!

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

procedure ChangeDropShadow(AActive: boolean);
var
  Buff: Cardinal;
  Param: Pointer;
  DevMode: TDeviceMode;
begin
  with TRegistry.Create do
  begin
    RootKey := HKEY_CURRENT_USER;
    if OpenKey('\Control Panel\Desktop\', false) then
    begin
      ReadBinaryData('UserPreferencesMask', Buff, 4);
      if AActive then
        Buff := Buff or (1 shl 18)
      else
        Buff := Buff xor (Buff and (1 shl 18));
      WriteBinaryData('UserPreferencesMask', Buff, 4);
      Param := nil;
      if AActive then
        Param := @AActive;
 
      SystemParametersInfo(SPI_SETDROPSHADOW, 0,
        Param, SPIF_SENDWININICHANGE);
    end;
    Free;
  end;
end;

Hugs!

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:

unit Unit1;
{ ... }
 
var
  Form1: TForm1;
 
implementation
 
uses pasBenchmark;

Antes de iniciar o processo que deseja fazer o Benchmark:

procedure TForm1.ConnectToServer;
begin
  { ... processo que conecta em um servidor de dados ... }
end;
 
procedure TForm1.btnRunClick(Sender: TObject);
begin
  Benchmark.StartBenchmarking('Benchmark de conexão com o servidor');
  try
    ConnectToServer;
  except
  end;
  Benchmark.EndBenchmarking;
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

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