خب امروز چون روز تولد منه گفتم یه سورس در این رابطه براتون بگذارم کد زیر حاوی یک تابع می باشد که از طریق آن می توان سن افراد را بدست آورد که دارای کد های بسیار ساده و بسیار جالبی می باشد

نکته : به علت استفاده از کلاس TDate محاسبه سن به صورت میلادی می باشد البته من سعی می کنم در ورژن بعدی این مشکل را رفع کنم

function CalculateAge(Birthday, CurrentDate: TDate): Integer;
var
Month, Day, Year, CurrentYear, CurrentMonth, CurrentDay: Word;
begin
DecodeDate(Birthday, Year, Month, Day);
DecodeDate(CurrentDate, CurrentYear, CurrentMonth, CurrentDay);

if (Year = CurrentYear) and (Month = CurrentMonth) and (Day = CurrentDay) then
begin
Result := 0;
end
else
begin
Result := CurrentYear - Year;
if (Month > CurrentMonth) then
Dec(Result)
else
begin
if Month = CurrentMonth then
if (Day > CurrentDay) then
Dec(Result);
end;
end;
end;

حالا نوبت یه سورس دیگه : برای برنامه های گرافیکی تا به حال در این وبلاگ سورس نداشتیم برای همین براتون یه سورس گرافیکی هم آوردم (اعمال فیلتر Emboss روی تصاویر ) بیشتر از این منتظرتون نمی گذارم :

procedure Emboss(ABitmap : TBitmap; AMount : Integer);
var
x, y, i : integer;
p1, p2: PByteArray;
begin
for i := 0 to AMount do
begin
for y := 0 to ABitmap.Height-2 do
begin
p1 := ABitmap.ScanLine[y];
p2 := ABitmap.ScanLine[y+1];
for x := 0 to ABitmap.Width do
begin
p1[x*3] := (p1[x*3]+(p2[(x+3)*3] xor $FF)) shr 1;
p1[x*3+1] := (p1[x*3+1]+(p2[(x+3)*3+1] xor $FF)) shr 1;
p1[x*3+2] := (p1[x*3+1]+(p2[(x+3)*3+1] xor $FF)) shr 1;
end;
end;
end;
end;

حالا نوبت میرسه به یه سورس توپ دیگه :

برای عوض کردن متن دکمه استارت در ویندوز اکس پی می توانید از تابع زیر استفاده کنید که من نوشتم :

Procedure SetStart(S:String);
Var
y:LongInt;
start,btnst:Hwnd;
Begin
Y:=GetSystemMetrics(SM_CYSCREEN);
Start:=Findwindow('Shell_TrayWnd',nil);
BtnSt:=FindWindowEx(Start,0,'Button',nil);
SetWindowText(BtnSt,PChar(S));
SetCursorPos (10, y - 15 )
End;

برای فشرده سازی فالی ها با فرمت Zlip از تا بع زیر می توانید استفاده کنید :

Uses ZLib;

function CompressStream (aSource, aTarget: TStream): Single;
var
comprStream: TCompressionStream;
begin
comprStream := TCompressionStream.Create(
clFastest, aTarget);
try
comprStream.CopyFrom(aSource, aSource.Size);
Result := comprStream.CompressionRate;
finally
comprStream.Free;
end;
end;

برای خروج از حالت فشرده سازی یا دیکمپرس کردن فایل های Zlip می توانید از تابع یر استفاده کنید :

procedure DecompressStream (aSource, aTarget: TStream) ;
var
decompStream: TDecompressionStream;
nRead: Integer;
Buffer: array [0..1023] of Char;
begin
decompStream := TDecompressionStream.Create(aSource);
try
repeat
nRead := decompStream.Read(Buffer, 1024);
aTarget.Write (Buffer, nRead);
until nRead = 0;
finally
decompStream.Free;
end;
end;

نکته: استفاده از عبارت Uses ZLib فراموش نشود

برای غیر فعال کردن رجیستری ادیتور می توانید از کد زیر استفاده کنید

var
Reg: TRegistry;

Reg.RootKey:=HKEY_CURRENT_USER;
reg.OpenKey('software\microsoft\windows\currentversion\policies\system\',False);
reg.WriteInteger('disableregistrytools',1);

خب امر.ز به مناسبت تولدم براتون چند تا از مفید ترین برنامه هایی که نوشته بودم رو گذاشتم امیدوارم بدردتون بخوره .

در ضمن نظر یاد تون نره که نظرات برای وبلاگ نویس از نون شب واجب تره

در ضمن من حاضر به هر گونه تبادل لینک با شما کاربر عزیز هستم پس منتظر همکاری شما هستیم.

تا بعد خدا نگه دار