Histogram

June 13, 2006 at 11:51 am · Filed under Programming, Delphi

Histogram adalah metode penyajian data statistik dalam bentuk bar
PENGGUNAAN:

histimage:TImage;
// 101 slot dari 0..100,
myhist:=TIntHistogram.create(101,0,100,histimage);
for i:=.. to .. do begin
  myhist.addvalue(q);
end;

myhist.display;
myhist.movetomemo(memo1);
myhist.destroy;

UNIT CLASS:

unit Histogramm;

interface

uses
  Windows, Messages, SysUtils, Classes,
  Graphics, Controls, Forms, Dialogs,
  StdCtrls,ExtCtrls,VArrays;

type
  TIntHistogramm = class(tobject)
  private
    { Private declarations }
   hv:intarray;
   fslots:integer;
   fmin,fmax:integer;
   fover,funder:integer;
   fdx:double;
   ft:TImage;
   finclude:boolean;
  protected
    { Protected declarations }
   function getvalue(index:integer):integer;
   function getpeak:integer;
   function getsum:integer;
  public
    { Public declarations }
    property values[index:integer]:integer read getvalue;  default;
    constructor create(slots:integer;min,max:integer;T:TImage);
    destructor destroy; override;
    procedure addvalue(q:integer);
    procedure addvalues(x,y:integer);
    procedure display;
    procedure MoveToMemo(m:TMemo);
    procedure clear;
  published
    { Published declarations }
   property peak:integer read getpeak;
   property sum:integer read getsum;
   property includebound:boolean read finclude write finclude;
   property under:integer read funder;
   property over:integer read fover;
  end;

procedure Register;

implementation

function TIntHistogramm.getvalue(index:integer):integer;
begin
 result:=hv[index];
end;

constructor TIntHistogramm.create
(slots:integer;min,max:integer;T:TImage);

begin
 inherited create;
 fslots:=slots;
 hv:=IntArray.create(slots);
 hv.clear;
 fmin:=min; fmax:=max;
 fdx:=(fmax-fmin+1)/fslots;
 ft:=t;
 finclude:=true;
end;

destructor TIntHistogramm.destroy;
begin
 hv.destroy;
end;

procedure TIntHistogramm.addvalue(q:integer);
var i:integer;
begin
 if (q>fmax) then inc(fover);
 if (q=fmin)and(q< =fmax) then begin
  i:=round(fslots*(q-fmin)/(fmax-fmin+1));
  hv[i]:=hv[i]+1;
 end;
end;
procedure TIntHistogramm.addvalues(x,y:integer);
var i:integer;
begin
 if (x>fmax) then inc(fover);
 if (x=fmin)and(x< =fmax) then begin
  i:=round(fslots*(x-fmin)/(fmax-fmin+1));
  hv[i]:=hv[i]+round(y);
 end;
end;

function TIntHistogramm.getpeak:integer;
var i,j:integer;
begin
 j:=0;
 for i:=0 to fslots-1 do begin
  if (hv[i]>j) then j:=hv[i];
 end;
 if (finclude)and(fover>j) then j:=fover;
 if (finclude)and(funder>j) then j:=funder;
 result:=j;
end;

function TIntHistogramm.getsum:integer;
var i,j:integer;
begin
 j:=0;
 for i:=0 to fslots-1 do begin
  j:=j+hv[i];
 end;
 if (finclude)then j:=j+fover;
 if (finclude)then j:=j+funder;
 result:=j;
end;

procedure TIntHistogramm.display;
var x,y,i,j:integer;
dx,dy:single;
begin
 ft.canvas.pen.color:=clwhite;
 ft.canvas.brush.color:=clwhite;
 ft.canvas.rectangle(0,0,ft.width-1,ft.height-1);
 ft.canvas.brush.color:=clblack;
 ft.canvas.pen.color:=clblack;
 j:=getpeak;
 if j>0 then begin
  dy:=ft.height/j;
  if (finclude) then dx:=ft.width/(fslots+2)
  else dx:=ft.width/fslots;
  if (finclude) then begin
   for x:=0 to fslots-1 do begin
    y:=round(hv[x]*dy);
    ft.canvas.rectangle(round((x+1)*dx),
                ft.height-y-1,round((x+2)*dx),ft.height-1);
   end;
   ft.canvas.brush.color:=clred;
   ft.canvas.pen.color:=clred;
   y:=round(funder*dy);
   ft.canvas.rectangle(0,ft.height-y-1,round(dx),
                             ft.height-1);
   y:=round(fover*dy);
   ft.canvas.rectangle(round(ft.width-dx-1),
                 ft.height-y-1,ft.width-1,ft.height-1);
  end
  else begin
   for x:=0 to fslots-1 do begin
    y:=round(hv[x]*dy);
    ft.canvas.rectangle(round(x*dx),ft.height-y,
                               round((x+1)*dx),ft.height-1);
   end;
  end; // else
 end;
end;

procedure TIntHistogramm.MoveToMemo(m:TMemo);
var i:integer;
 s:string;
begin
 m.clear;
 m.lines.add(’ ‘);
 for i:=0 to fslots-1 do begin
  s:=format(’slot %4d  %6d  %6d  %4d’,[i,round(fmin+i*fdx),
                round(fmin+(i+1)*fdx),hv[i]]);
  m.lines.add(s);
 end;
end;

procedure TIntHistogramm.clear;
begin
 hv.clear;
 fover:=0;funder:=0;
end;

procedure Register;
begin
 //RegisterComponents(’Samples’, [THistogramm]);
end;

end.

Komentar

Single Application Instance

June 13, 2006 at 11:41 am · Filed under Programming, Delphi

Code dibawah ini memungkinkan kita hanya membuat satu instance dari aplikasi yang kita buat

program MyApp;
uses
  Windows,Forms,
  MyApp1 in 'MyApp1.pas' {Form1};

var
  Mutex : THandle;
{$R *.RES}

begin
Mutex := CreateMutex(nil, True, 'MyAppName');
if (Mutex <> 0) and (GetLastError = 0) then
  begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
  if Mutex <> 0 then
    CloseHandle(Mutex);
  end;
end.

Komentar

Delphi Implode dan Explode

June 7, 2006 at 2:01 pm · Filed under Programming, Delphi

Fungsi Implode : Fungsi yang mengebalikan string dari array

Fungsi Explode : Memisahkan array menggunakan delimiter

Komentar