#1
|
|||
|
|||
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(I nteger)); 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', 'http://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); haktann |