Kısa delphi kodları

» TMemo için gerial işlemi
Memo1.Perform(EM_UNDO,0,0);
--------------------------------------------------------------------------------

» TMemo için yatay kaydırma çubuğu
Memo1.Perform(EM_LINESCROLL,10,50);
// This function scrolls memo to 50. line and 10 chars right
--------------------------------------------------------------------------------

» BDE de silinen kayıtları göstermek
procedure deletedrecords(Table: TTable; SioNo: Boolean);
begin
Table.DisableControls;
try
Check(DbiSetProp(hDBIObj(Table.Handle), curSOFTDELETEON, LongInt(SioNo)));
finally
Table.EnableControls;
end;
Table.Refresh;
end;
--------------------------------------------------------------------------------

» Windows kısayollarını iptal ve açma
1)Disable
var
Dummy: Integer;
begin
SystemParametersInfo( SPI_SETFASTTASKSWITCH, 1, @Dummy, 0);
SystemParametersInfo( SPI_SCREENSAVERRUNNING, 1, @Dummy, 0);
end;

2)Enable
var
Dummy: Integer;
begin
SystemParametersInfo( SPI_SETFASTTASKSWITCH, 0, @Dummy, 0);
SystemParametersInfo( SPI_SCREENSAVERRUNNING, 0, @Dummy, 0);
end;

--------------------------------------------------------------------------------

» İşlemci hızını bulmak
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
mov TimerLo, eax
mov TimerHi, edx
end;
Sleep(DelayTime);
asm
dw 310Fh
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;
//To use this function, write: Caption:=Format('%f MHz', [GetCPUSpeed]);

--------------------------------------------------------------------------------

» İşlemci kullanımını görmek
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls, CommCtrl, StdCtrls, Menus,WinSpool, ExtCtrls, Buttons, Registry;
type
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
Label2: TLabel;
Timer1: TTimer;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
started : boolean;
reg : TRegistry;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var
Dummy : array[0..1024] of byte;
begin
// Stats started by Button1 hit
Reg:=TRegistry.Create;
Reg.RootKey:=HKEY_DYN_DATA; // Statistic data is saved under this topic
{ Before starting retrieving statistic data you have to query the appropiate key under 'PerfStats\StartStat'. }
Reg.OpenKey
('PerfStats\StartStat',false); // Open this key first to start collecting performance data Reg.ReadBinaryData('KERNEL\CPUUsage',Dummy,Sizeof(Dummy));
Reg.CloseKey;
started:=true;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
CPUU : integer;
begin
{ After starting the collection of statistic data, you can retrieve the recent value under the 'PerfStats\StatData' key. This is done by a timer event in this example }
if started then
begin
Reg.OpenKey
('PerfStats\StatData',false); // Open extension kex for txt files Reg.ReadBinaryData('KERNEL\CPUUsage',CPUU,SizeOf(Integer));
Reg.CloseKey;
Label1.Caption:=IntToStr(CPUU)+'%';
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
Dummy : array[0..1024] of byte;
begin
// Button2 hit stops statistic collection { Collecting statistic data is stopped by a query under 'PerfStats/StopStat' }
Reg.OpenKey
('PerfStats\StopStat',false); // Open this key first to start collecting performance data
Reg.ReadBinaryData
('KERNEL\CPUUsage',Dummy,SizeOf(Dummy));
Reg.Free;
Started:=false;
end;
end.
--------------------------------------------------------------------------------

» Hareketli imleç(animated cursor)leri kullanma
procedure TForm1.Button1Click(Sender:TObject);
var
h : THandle;
begin
h := LoadImage(0, 'C:\TheWall\Magic.ani', IMAGE_CURSOR, 0, 0, LR_DEFAULTSIZE or LR_LOADFROMFILE);
if h = 0 then ShowMessage('Cursor not loaded') else begin
Screen.Cursors[1] := h;
Form1.Cursor := 1;
end;
end;
--------------------------------------------------------------------------------

» Bir klasörü ve onun altındaki tüm dosyalari ve klasörleri silmek
Ancak salt okunur (read only) özelligi olan ve kullanimda olan dosyalar silinmez.
procedure TForm1.Button1Click(Sender: TObject);
var
DirInfo: TSearchRec;
r : Integer;
begin
r := FindFirst('C:\Download\Test\*.*', FaAnyfile, DirInfo);
while r = 0 do begin
if ((DirInfo.Attr and FaDirectory <> FaDirectory) and (DirInfo.Attr and FaVolumeId <> FaVolumeID)) then
if DeleteFile(pChar('C:\Download\test\' + DirInfo.Name)) = false then
ShowMessage('C:\Download\test\'+DirInfo.Name+' silinemiyor!!!');
r := FindNext(DirInfo);
end;
SysUtils.FindClose(DirInfo);
if RemoveDirectory('C:\Download\Test') = false then
ShowMessage('C:\Download\test klasörü silinemiyor!!!');
end;


» Windowsa bir dosyanın açtırılması
Unit listesine "shellapi" unitini ekleyin.
shellexecute(0,'open', 'c:\autoexec.bat','','',SW_NORMAL);
--------------------------------------------------------------------------------

» Ekran çözünürlüğünü öğrenmek
ShowMessage('Çözünürlük: '+IntToStr( Screen.Width ) +' x '+ IntToStr( Screen.Height ));
--------------------------------------------------------------------------------

» Table nesnesinde Locate ile birden fazla alanda aratmak
with musteri do
Locate('isim;soyad;meslek', VarArrayOf(['Mete', 'YILMAZ', 'Programcı']), [loPartialKey]);
--------------------------------------------------------------------------------

» WEB sayfasının açılması işlemi
ShellExecute(Handle, 'open', 'https://www.programlarim.com', nil, nil, sw_ShowMaximized);
--------------------------------------------------------------------------------

» DOS programının çalıştırılması
WinExec('command.com /c programim.exe',sw_ShowNormal);
--------------------------------------------------------------------------------

» Programı bekletmek
(1000milisaniye = 1 saniye)
Sleep(10000);