***دانلود در ادامه مطالب***

دانلود جدیدترین نسخه ها و ابزارهای دلفی را از این پست دریافت نمایید(دانلود در ادامه مطالب)

کرک دلفی - فعالسازی دلفی - دلفی ایکس ای - دلفی ایکس ای 2 - دلفی ایکس ای 3 - دلفی ایکس ای 4 - دلفی پریسم - راد پی اچ پی - راد استدیو - Delphi - Delphi XE - Delphi XE2 - Crack For Delphi XE - Crack For Delphi XE2 Delphi Disteller Delphi XE3 - Delphi XE3 - Crack For Delphi X3- Delphi Keygen - Serial For Delphi

با استفاده از کدهای زیر می توانید اطلاعات دقیق و مفیدی در مورد پردازندۀ کامپیوترتان بدست آورید .

زیربرنامۀ

   procedure info(s1, s2: string);

را در Public  تعریف کنید ؛ متغیر های زیر را به صورت عمومی تعریف کنبد ؛

var

  frm_main: Tfrm_main;

  gn_speed_y: Integer;

  gn_text_y: Integer;

  const

  gn_speed_x: Integer = 8;

  gn_text_x: Integer = 15;

  gl_start: Boolean = True;

یک Image روی فرم قرار دهید و اسم اون رو img_info قرار بدید ؛

دربلاک برنامه هم دو زیربرنامه وجود دارد که اولی مربوط به OnShow فرم اصلی و دومی همان زیربرنامه ای است که در ابتدا تعریف کردیم :

procedure Tfrm_main.FormShow(Sender: TObject);

var

_eax, _ebx, _ecx, _edx: Longword;

i: Integer;

b: Byte;

b1: Word;

s, s1, s2, s3, s_all: string;

begin

  //Set the startup colour of the image

img_info.Canvas.Brush.Color := clblue;

img_info.Canvas.FillRect(rect(0, 0, img_info.Width, img_info.Height));

gn_text_y := 5; //position of the 1st text

asm //asm call to the CPUID inst.

mov eax,0 //sub. func call

db $0F,$A2 //db $0F,$A2 = CPUID instruction

mov _ebx,ebx

mov _ecx,ecx

mov _edx,edx

end;

for i := 0 to 3 do //extract vendor id

begin

b := lo(_ebx);

s := s + chr(b);

b := lo(_ecx);

s1:= s1 + chr(b);

b := lo(_edx);

s2:= s2 + chr(b);

_ebx := _ebx shr 8;

_ecx := _ecx shr 8;

_edx := _edx shr 8;

end;

info('CPU', '');

info(' - ' + 'Vendor ID: ', s + s2 + s1);

asm

mov eax,1

db $0F,$A2

mov _eax,eax

mov _ebx,ebx

mov _ecx,ecx

mov _edx,edx

end;

//06B1

//|0000| |0000 0000| |0000| |00| |00| |0110| |1011| |0001|

b := lo(_eax) and 15;

info(' - ' + 'Stepping ID: ', IntToStr(b));

b := lo(_eax) shr 4;

info(' - ' + 'Model Number: ', IntToHex(b, 1));

b := hi(_eax) and 15;

info(' - ' + 'Family Code: ', IntToStr(b));

b := hi(_eax) shr 4;

info(' - ' + 'Processor Type: ', IntToStr(b));

//31. 28. 27. 24. 23. 20. 19. 16.

// 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0

b := lo((_eax shr 16)) and 15;

info(' - ' + 'Extended Model: ', IntToStr(b));

b := lo((_eax shr 20));

info(' - ' + 'Extended Family: ', IntToStr(b));

b := lo(_ebx);

info(' - ' + 'Brand ID: ', IntToStr(b));

b := hi(_ebx);

info(' - ' + 'Chunks: ', IntToStr(b));

b := lo(_ebx shr 16);

info(' - ' + 'Count: ', IntToStr(b));

b := hi(_ebx shr 16);

info(' - ' + 'APIC ID: ', IntToStr(b));

//Bit 18 =? 1 //is serial number enabled?

if (_edx and $40000) = $40000 then

info(' - ' + 'Serial Number ', 'Enabled')

else

info(' - ' + 'Serial Number ', 'Disabled');

s := IntToHex(_eax, 8);

asm //determine the serial number

mov eax,3

db $0F,$A2

mov _ecx,ecx

mov _edx,edx

end;

s1 := IntToHex(_edx, 8);

s2 := IntToHex(_ecx, 8);

Insert('-', s, 5);

Insert('-', s1, 5);

Insert('-', s2, 5);

info(' - ' + 'Serial Number: ', s + '-' + s1 + '-' + s2);

asm

mov eax,1

db $0F,$A2

mov _edx,edx

end;

info('', '');

//Bit 23 =? 1

if (_edx and $800000) = $800000 then

info('MMX ', 'Supported')

else

info('MMX ', 'Not Supported');

//Bit 24 =? 1

if (_edx and $01000000) = $01000000 then

info('FXSAVE & FXRSTOR Instructions ', 'Supported')

else

info('FXSAVE & FXRSTOR Instructions Not ', 'Supported');

//Bit 25 =? 1

if (_edx and $02000000) = $02000000 then

info('SSE ', 'Supported')

else

info('SSE ', 'Not Supported');

//Bit 26 =? 1

if (_edx and $04000000) = $04000000 then

info('SSE2 ', 'Supported')

else

info('SSE2 ', 'Not Supported');

info('', '');

asm //execute the extended CPUID inst.

mov eax,$80000000 //sub. func call

db $0F,$A2

mov _eax,eax

end;

if _eax > $80000000 then //any other sub. funct avail. ?

begin

info('Extended CPUID: ', 'Supported');

info(' - Largest Function Supported: ', IntToStr(_eax - $80000000));

asm //get brand ID

mov eax,$80000002

db $0F

db $A2

mov _eax,eax

mov _ebx,ebx

mov _ecx,ecx

mov _edx,edx

end;

s := '';

s1 := '';

s2 := '';

s3 := '';

for i := 0 to 3 do

begin

b := lo(_eax);

s3:= s3 + chr(b);

b := lo(_ebx);

s := s + chr(b);

b := lo(_ecx);

s1 := s1 + chr(b);

b := lo(_edx);

s2 := s2 + chr(b);

_eax := _eax shr 8;

_ebx := _ebx shr 8;

_ecx := _ecx shr 8;

_edx := _edx shr 8;

end;

s_all := s3 + s + s1 + s2;

asm

mov eax,$80000003

db $0F

db $A2

mov _eax,eax

mov _ebx,ebx

mov _ecx,ecx

mov _edx,edx

end;

s := '';

s1 := '';

s2 := '';

s3 := '';

for i := 0 to 3 do

begin

b := lo(_eax);

s3 := s3 + chr(b);

b := lo(_ebx);

s := s + chr(b);

b := lo(_ecx);

s1 := s1 + chr(b);

b := lo(_edx);

s2 := s2 + chr(b);

_eax := _eax shr 8;

_ebx := _ebx shr 8;

_ecx := _ecx shr 8;

_edx := _edx shr 8;

end;

s_all := s_all + s3 + s + s1 + s2;

asm

mov eax,$80000004

db $0F

db $A2

mov _eax,eax

mov _ebx,ebx

mov _ecx,ecx

mov _edx,edx

end;

s := '';

s1 := '';

s2 := '';

s3 := '';

for i := 0 to 3 do

begin

b := lo(_eax);

s3 := s3 + chr(b);

b := lo(_ebx);

s := s + chr(b);

b := lo(_ecx);

s1 := s1 + chr(b);

b := lo(_edx);

s2 := s2 + chr(b);

_eax := _eax shr 8;

_ebx := _ebx shr 8;

_ecx := _ecx shr 8;

_edx := _edx shr 8;

end;

info('Brand String: ', '');

if s2[Length(s2)] = #0 then setlength(s2, Length(s2) - 1);

info('', ' - ' + s_all + s3 + s + s1 + s2);

end

else

info(' - Extended CPUID ', 'Not Supported.');

end;

procedure Tfrm_main.info(s1, s2: string);

begin

if s1 <> '' then

begin

img_info.Canvas.Brush.Color := clblue;

img_info.Canvas.Font.Color := clyellow;

img_info.Canvas.TextOut(gn_text_x, gn_text_y, s1);

end;

if s2 <> '' then

begin

img_info.Canvas.Brush.Color := clblue;

img_info.Canvas.Font.Color := clWhite;

img_info.Canvas.TextOut(gn_text_x + img_info.Canvas.TextWidth(s1), gn_text_y, s2);

end;

Inc(gn_text_y, 13);

end;

این قطعه برنامه کل فضا ، فضای استفاده شده و فضای خالی هاردتون رو هم بر حسب بایت ، به صورت نمودار درصدی نمایش می دهد.

روی فرمتون کامپوننت های زیر رو قرار بدید. Gauge از پالت Sample ، سه عدد Label ، یک Button

روی Button دابا کلیک کنید و مثل زیر کد رو داخل اون قرر بدید.

procedure TForm1.Button1Click(Sender: TObject);

var total,free,used:longint;

begin

 total:=DiskSize(disk) div 1024;

 free:=DiskFree(disk) div 1024;

 used:=total-free;

 Gauge1.MaxValue:=total;

 Gauge1.Progress:=used;

 Label1.Caption:='total size='+IntToStr(total)+' Byte';

 Label2.Caption:='free size='+IntToStr(free)+' Byte';

 Label3.Caption:='used size='+IntToStr(used)+' Byte';

end;

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

Function SHDate:String;

Const

 D : Array [0..11] of integer=(20, 19, 20, 20, 21, 21, 22, 22, 22, 22, 21, 21);

 P : Array [0..11] of integer=(11, 12, 10, 12, 11, 11, 10, 10, 10, 9, 10, 10);

 Mon: Array [0..11]of String=('01','02','03','04','05','06','07','08','09','10','11','12');

Var DateLocal:_SYSTEMTIME;

    Dm,Mm,Ym:Word;

    P1,D1,I,U,Rp,Ys,Ms,Ds,X:Integer;

    Sal,Mah,Roz:String;

begin

 GetLocalTime(DateLocal);

 Ym:=DateLocal.wYear;

 Mm:=DateLocal.wMonth;

 Dm:=DateLocal.wDay;

 Dm := Dm;

 U := 0;

 Rp:= 0;

 If (Ym Mod 4) = 0 Then U := 1;

 If ((Ym Mod 100 = 0) AND (Ym Mod 400 <> 0)) Then U := 0;

 Ys := Ym - 622;

 X := Ys - 22;

 X := X Mod 33;

 If ((X Mod 4 = 0) AND (X <> 32)) Then Rp := 1;

 I := Not(Rp-2) + NOT(U - 2) * 2;

 X := 0;

 If (I = 0) AND (Mm = 3) Then X := 1;

 If I = 0 Then I := 3;

 Ms := (9 + Mm) Mod 13;

 If Ms < 10 Then Ms := Ms + 1;

 D1 := D[Mm - 1];

 If (I = 1) AND (Mm > 2) Then D1 := D1 - 1;

 If (I = 2) AND (Mm < 3) then D1 := D1 - 1;

 P1 := P[Mm - 1];

 If (I = 1) AND (Mm > 2) Then P1 := P1 + 1;

 If (I = 2) AND (Mm < 4) Then P1 := P1 + 1;

 If (Dm > 0) AND (Dm <= D1) Then

   Begin

     Ds := P1 + Dm + X - 1;

     X := 1;

   End

 Else

   Begin

     Ds := Dm - D1;

     Ms := Ms + 1;

     If Ms = 13 Then Ms := 1;

     X := 2;

   End;

 If ((Mm = 3) AND (X = 2)) OR (Mm > 3) Then Ys := Ys + 1;

 Sal:=IntToStr(Ys);

 If Length(Sal)=1 then Insert('0',Sal,1);

 Mah:=Mon[Ms-1];

 Roz:=IntToStr(Ds);

 If Length(Roz)=1 then Insert('0',Roz,1);

 Result:=Sal+'/'+Mah+'/'+Roz;

 Delete(Result,1,2);

end;

قطعه برنامه ی زیر مثالی از حرکت دادن ماوس توسط برنامه نویسیه . روی فرمتون یه Timer بذارید و خاصیت Inteval  اونو برابر 10 قرار بدید ، روش دابل کلیک کنید و کدها  رو مثل زیر داخل اون بذارید.

procedure TForm1.Timer1Timer(Sender: TObject);

VAR p:Tpoint;

begin

 GetCursorPos(p);

 p.X:=p.X+1;

 p.y:=p.y+1;

 SetCursorPos(p.x,p.y);

 if p.x>=Screen.Width-1 then SetCursorPos(0,p.y);

 if p.y>=Screen.Height-1 then SetCursorPos(p.x,0);

end;

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

Function Speech(Text:String);

Var

  Voice: OLEVariant;

Begin

  Voice := CreateOLEObject('SAPI.SpVoice');

  if Not(Trim(Text)='') then

    Voice.Speak(trim(Text), 0);

End;

برای این کار یک  TrackBar روی فرم قرار بدید. مقدار Max اون رو برابر 65535   قرار بدید. و خطوط زیر رو در OnChange اون قرار بدید. لازم به ذکر است که باید از یونیت MMSystem استفاده کنید.

Procedure TForm1.TrackBar1Change(Sender: TObject);

Var

  MyWaveOutCaps: TWaveOutCaps;

  Volume: Integer;

Begin

  Volume:=TrackBar1.Position;

  If WaveOutGetDevCaps(WAVE_MAPPER, @MyWaveOutCaps,sizeof(MyWaveOutCaps)=MMSYSERR_NOERROR then

    WaveOutSetVolume(WAVE_MAPPER, MakeLong(Volume, Volume));

End;

سلام

امروز می خوام یکی دیگه از تخم مرغ های دلفی رو براتون معرفی کنم.

از منوی Help آیتم  About رو انتخاب کنید . وقتی پنجره About باز شد ، کلید  Alt رو پایین نگه داشته و کلمه ی Developers رو تایپ کنید ، به صداهایی که می یاد توجه نکنید . نتیجه کار رو براتون نمی گم تا خودتون انجامش بدین.

با تابع زیر می تونید زمان شروع به کار ویندوز رو به دست بیارید و در قالبی جالب ببینید که چند روز و چند ساعت و چند دقیقه و چند ثانیه از اون می گذره.

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

Procedure TForm1.Button1Click(Sender: TObject);

Var NDay:Double;

       Tick:Longint;

       BTime:TDateTime;

       S:String;

Begin

 Tick:=GetTickCount;

 NDay:=tick/86400000;

 BTime:=Now-NDay;

 S:='"Windows started on" dddd,mmmm d,yyyy,'+'"at" hh:nn:ss AM/PM';

 ShowMessage( FormatDateTime(S,BTime)+#10#13+

 'It been up for '+IntToStr(TRUNC(nday))+' Days,'+

 FormatDateTime(' h "Houre," n "minutes," s "seconds"',nday));

End;

• → صفحه بعد