Mega Code Archive
Ornek component yazilimi
<![CDATA[
{
Tkimlik ver 1.0
With this component you can do a human's First,last name, father and
Mather name, Birth Place, Birth date write and it calculate 11 digit
charecter a Person Number.
Maybe it calculate different person identity same number. Not Warranty.
Nihat yorganci nyorganci@hotmail.com
}
unit Kimlik;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
TKimlik = class(TComponent)
private
{ Private declarations }
FFirstName:string;
FLastName:string;
FFather:string;
FMather:string;
FBirthPlace:string;
FBirthDate:Tdate;
function Girmismi:Boolean;//verileri girmişmi.
function Hesap:int64;//sonucu hesapla.
protected
{ Protected declarations }
procedure loaded;override;//Tcomponentin metodu.Buradaki kod kendiliğinden çalışıyor.hep override olarak tanımla.
//Ulaşılamayan olayları başlatan prosedürleride buraya yaz.
Public
PersonNo:int64;
{ Public declarations }
constructor Create(AOwner: TComponent); override;
procedure Calculate;
published
{ Published declarations }
property FirstName : String Read FFirstName Write FFirstName;
property LastName : String Read FLastName Write FLastName;
property Father : String Read FFather Write FFather;
property Mather : String read FMather Write FMather;
property BirthPlace : String read FBirthPlace Write FBirthPlace;
property BirthDate: Tdate read FBirthDate Write FBirthDate;
end;
procedure Register;
implementation
constructor TKimlik.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
end;
procedure Tkimlik.Calculate;
begin
PersonNo:=Hesap;
end;
Function Tkimlik.hesap:int64;
var
size:int64;
str,codestr,sdate:string;
i,x,y,code:integer;
Num: Int64;
begin
if girmismi=false then begin
result:=0;
exit;
end else begin
str:=FFirstName+FLastName+FFather+FMather+FBirthPlace;
str:=Uppercase(str);//Upper Case.
i:=length(str);
size:=Trunc(FBirthDate);
while i>0 do begin
CodeStr := CodeStr + intToStr(size mod Ord(str[i]));
dec(i);
end;
if codestr[1]='0' then Codestr[1]:=codestr[length(codestr)];
sdate:=inttostr(size);//date to string
if length(sdate)>5 then begin
while length(sdate)>5 do begin
delete(sdate,1,1);
end;
end else
if length(sdate)<5 then begin
while length(sdate)<5 do begin
sdate:='0'+sdate;
end;
end;
end;
y:=0;
if length(codestr)>6 then begin
while length(codestr)>6 do begin
str:=copy(codestr,1,6);
delete(codestr,1,6);
x:=strtoint(str);
Y:=y+x;
end;
y:=Y+strtoint(codestr);//left number<6 also add.
end;
if y=0 then y:=strtoint(codestr);
str:=inttostr(y);
if length(str)>6 then
str:=copy(str,1,6);//cut first 6 character.
if length(str)<6 then begin
for x:=1 to 6-length(str)do begin
str:=inttostr(x)+str;
end;
end;
if str[1]='0' then
if str[length(str)]<>'0' then
str[1]:=str[length(str)]
else str[1]:='1';
codestr:=str+sdate;//total 11 character.
Val(CodeStr, Num, Code);//11' eşit olsada buraya geliyor.
result:=num;
end;//yanlış değerler girilmemiş.
function Tkimlik.Girmismi:Boolean;
begin
FFirstName:=trim(FirstName);
FLastName:=trim(FLastName);
FFather:=trim(FFather);
FMather:=trim(FMather);
FBirthPlace:=trim(FBirthPlace);
if (FFirstName='')or(FLastName='')or (FFather='') Or(FMather='')or (FBirthPlace='') then begin
showmessage('Adı,Soyadı,Anne,Baba Adı,Doğum Yeri Doldurulmalı.');
result:=false;
end else begin
if FBirthDate=null then result:=false
else
result:=True;
end;
end;
procedure Tkimlik.loaded;//kendiliğinden yükleniyor.
begin
inherited;
//buraya kodları yaz.Daha Vcl açılır açılmaz çalışıyor.
end;
procedure Register;
begin
RegisterComponents('Samples', [TKimlik]);
end;
end.
]]>