تشخیص اندازه فونت سیستم

uses Registry;
...
procedure TForm1.Button1Click(Sender: TObject);
begin
  with TRegistry.Create do
  begin
    RootKey:=HKEY_LOCAL_MACHINE;
    if OpenKey('Config001DisplaySettings', False) then
    try
      if ReadString('fonts.fon')='vgasys.fon' then
        Label1.Caption:='Small font'
      else
        Label1.Caption:='Large font'
    except
      MessageDlg('Can not go to handle', mtError, [mbOk], 0);
    end
    else
      MessageDlg('Registry reading error', mtError, [mbOk], 0);
    CloseKey;
  end;
end;

چک کردن اینکه time عوض شده یا نه

type
TForm1 = class(TForm)
Label1: TLabel;
private
procedure MyMessage(var Msg: TWMTimeChange); message WM_TIMECHANGE;
{ Private declarations }
public
{ Public declarations }
end;

...

procedure TForm1.MyMessage(var Msg: TWMTimeChange);
begin
if Msg.Result=0 then
Form1.Label1.Caption:='OK';
end;

تعیین مقدار بار 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;