عید بر عاشقان مبارک

عید بر عاشقان مبارک باد

لطفا برای حمایت روی تبلیغات پایین صفحه کلیک کنید
متشکذم

تعیین مقدار بار cpu

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

Get CPU usage

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, Buttons;

type

TForm1 = class(TForm)

Label1: TLabel;

procedure Label1Click(Sender: TObject);

procedure Label1DblClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

stop : boolean;

implementation

{$R *.DFM}

function GetCPUSpeed: Double;

const

DelayTime = 500; // measure time in ms

var

TimerHi, TimerLo: DWORD;

PriorityClass, Priority: Integer;

begin

PriorityClass := GetPriorityClass(GetCurrentProcess);

Priority := GetThreadPriority(GetCurrentThread);

SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);

SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);

Sleep(10);

asm

dw 310Fh // rdtsc

mov TimerLo, eax

mov TimerHi, edx

end;

Sleep(DelayTime);

asm

dw 310Fh // rdtsc

sub eax, TimerLo

sbb edx, TimerHi

mov TimerLo, eax

mov TimerHi, edx

end;

SetThreadPriority(GetCurrentThread, Priority);

SetPriorityClass(GetCurrentProcess, PriorityClass);

Result := TimerLo / (1000.0 * DelayTime);

end;

procedure TForm1.Label1Click(Sender: TObject);

begin

Stop := False;

while not Stop do

begin

label1.Caption := Format('CPU speed: %f MHz', [GetCPUSpeed]);

Application.ProcessMessages;

end;

end;

procedure TForm1.Label1DblClick(Sender: TObject);

begin

Stop := True;

end;

end.

تبدیل قالب رنگ در دلفی

تبدیل قالب استاندارد رنگ دلفی به hex

مانند استاندارد اینترنت

{

Return TColor value in XXXXXX format

(X being a hex digit)

}

function

TColorToHex( Color : TColor )

: string;

begin

Result :=

{ red value }

IntToHex( GetRValue( Color ), 2 ) +

{ green value }

IntToHex( GetGValue( Color ), 2 ) +

{ blue value }

IntToHex( GetBValue( Color ), 2 );

end;

Need to convert a hex color string to a TColor variable? Try this:

{

sColor should be in XXXXXX format

(X being a hex digit)

}

function

HexToTColor( sColor : string )

: TColor;

begin

Result :=

RGB(

{ get red value }

StrToInt( '$'+Copy( sColor, 1, 2 ) ),

{ get green value }

StrToInt( '$'+Copy( sColor, 3, 2 ) ),

{ get blue value }

StrToInt( '$'+Copy( sColor, 5, 2 ) )

);

end;

مژده-مژده

با سلام
بزودی قراره در آموزش کامپیوتر و دلفی پیشرفته بزارم پس با ما همراه باشید
انجام پروژه های دانشجویی به صورت رایگان انجام می گیرد.
اگه موافقید یه نظر کوچولو هم می تونید بدید