11
Aug 09
::
news :: by Gilberto Saraiva
Nothing to say, only to 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
news — No comments
08
Jul 09
::
articles :: by Gilberto Saraiva
Folks,
For everybody thats need to limit the instance number of your application:
| 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:
| 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.
articles — No comments
19
Jun 09
::
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
| 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
articles — No comments
19
Jun 09
::
articles :: by Gilberto Saraiva
Folks,
For everybody thats use a lot Chained lists on your projects:
| 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!
articles — No comments
01
Sep 08
::
articles :: by Gilberto Saraiva
Folks,
For everybody that needs the ToolButton position:
| 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!
articles — No comments
01
Sep 08
::
articles :: by Gilberto Saraiva
Folks,
For everybody that needs the Speedbutton position:
| 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!
articles — No comments
01
Sep 08
::
articles :: by Gilberto Saraiva
Folks,
For everybody that need to show something only on the useful area of the desktop I wrote this function:
| 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!
articles — No comments
28
Jul 08
::
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.
| 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!
articles — No comments
26
Jul 08
::
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:
| 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:
| 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
articles — No comments
21
Jul 08
::
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
articles — 1 comment