2 Ocak 2010 Cumartesi

Saga yada Sola hizalama function'u

function hiza(sagsol,yer:string;sayi:integer):string;
var
i,bosluk,uzunluk:integer;
begin
trim(yer); //Bosluklari temizle
uzunluk:=length(yer); //Verilen stringin uzunlugunu ögren
bosluk:=sayi-uzunluk; //Verilen sayidan uzunlugu çikar
if sagsol='sag' then begin //Sagami solami yaslancagini ögren
for i:=1 to bosluk do begin //Fark kadar saga bosluk ekle
yer:=' '+yer; //Bosluk ekle
end;
result:=yer; //Sonucu bildir
exit;
end;
if sagsol='sol' then
begin
trim(yer);
for i:=1 to bosluk do begin //Fark kadar sola ekle
yer:=yer+' ';
end;
result:=yer; //Sonucu bildir
exit;
end;
Sayiyi virgüllü yazma functionu

Bunun için forma birtana label componenti yerlestirin ve visible özeligini false yapin.

function frmt(yer:string):string;
var
s:string;
uzunluk:integer;
kalan,k,dgr:integer;
begin
s:='.';
uzunluk:=Length(yer);
dgr:=uzunluk div 3;
kalan:=uzunluk - (dgr*3);
label1.caption:=inttostr(kalan);
if yer='0' then
begin
yer:='0,';
result:=yer;
exit;
end;
if label1.caption<>'0' then
begin
insert(s,yer,kalan+1);
for k:=1 to dgr do begin
if k=dgr then begin
insert(',',yer,(kalan +(k*3)+k+1));
result:=yer;
exit;
end;
insert(s,yer,(kalan +(k*3)+k+1));
end;
end;
Comp degerindeki bir sayiyi string yapma

function Comp2Str(N: Comp): String;
var
TS: String;
begin
Str(N:0:0, TS);Comp2Str := TS;
end;
Dosya açilis yollari

Windows programinin açilisi
WinExec('C:\WINDOWS\NOTEPAD.EXE', SW_SHOWNORMAL);

Komut satiri ile birlikte :
WinExec('C:\WINDOWS\NOTEPAD.EXE C:\WINDOWS\WIN.INI', SW_SHOWNORMAL);

Pop Up dos kutusuyla :
WinExec('COMMAND.COM', SW_SHOWNORMAL);

Normal bir dos programinin komutla açilisi
WinExec('COMMAND.COM /C DIR *.*', SW_SHOWNORMAL);
Dekstop'i refresh etmek

procedure TForm1.Button1Click(Sender: TObject);
begin
SendMessage(FindWindow('Progman', 'Program Manager'), WM_COMMAND,$A065, 0);
end;
Programin windows'la birlikte açilmasi

uses Registry, {For Win32}
IniFiles; {For Win16}
{$IFNDEF WIN32}
const
MAX_PATH = 144;
{$ENDIF}
{For Win32}
procedure TForm1.Button1Click(Sender: TObject);
var
reg: TRegistry;
begin
reg := TRegistry.Create;
reg.RootKey := HKEY_LOCAL_MACHINE;
reg.LazyWrite := false; reg.OpenKey('Software\Microsoft\Windows\CurrentVer sion\Run', false); reg.WriteString('My App', Application.ExeName);
reg.CloseKey;
reg.free;
end;
Formun ara çubugunu gizleme

procedure TForm1.FormCreate(Sender: TObject);
begin
SetWindowLong(Form1.Handle,GWL_STYLE,GetWindowLong (Handle,GWL_STYLE) and not WS_CAPTION);
Height := ClientHeight;
end;
Flash icon

var Flash : bool;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
FlashWindow(Form1.Handle, Flash);
FlashWindow(Application.Handle, Flash); Flash := not Flash;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Flash := False;
end;
Taskbar'in handle sayisi

hTaskbar := FindWindow('Shell_TrayWnd', Nil );
Exe yada Dll'deki iconlarin alinmasi
Uses shellapi;
procedure TForm1.FormCreate(Sender: TObject);
var TheIcon: TIcon;
begin TheIcon := TIcon.Create;
TheIcon.Handle := ExtractIcon(hInstance,'C:\dosya\dosya.EXE',0);
image1.picture.Icon:=Theicon;
end;
Windows ekranina çizim yapma

procedure TForm1.Button1Click(Sender: TObject);
var dc : hdc;
begin dc := GetDc(0);
MoveToEx(Dc, 0, 0, nil);
LineTo(Dc, 300, 300);
ReleaseDc(0, Dc);
end;

Edit1'deki yaziyi edit2'ye GetTextBuf yolluyla aktarma

procedure TForm1.Button1Click(Sender: TObject);
var
Buffer: PChar;
Size: Byte;
begin
Size := Edit1.GetTextLen; {Get length of string in Edit1}
Inc(Size); {Add room for null character}
GetMem(Buffer, Size); {Creates Buffer dynamic variable}
Edit1.GetTextBuf(Buffer,Size); {Puts Edit1.Text into Buffer}
Edit2.Text := StrPas(Buffer); {Converts Buffer to a Pascal-style string]
FreeMem(Buffer, Size); {Frees memory allocated to Buffer}

end;
Form1'in aynisini printerden çikartma

Form1.Print;
O anki sürücünün kapasitesini ve sürücüdeki bos yer miktarini bulmak;
DiskFree(0) //o anki sürücüdeki bos yer miktarini byte cinsinden döndürür.
DiskSize(0) //o anki sürücünün kapasitesini byte cinsinden döndürür.
DiskSize(0) div 1024 //o anki sürücünün kapasitesini KB cinsinden döndürür.
Bir menü ögesinin enabled özelligini false yapmak;
mainmenu1.items[0].items[1].enabled:=False;
Listbox veya Combobox'ta seçili bir veya birden fazla ögeyi seçilmemis duruma getirmek için;
Listbox1.itemindex:=-1;
Listbox, Combobox ve Memo'ya bir seferde ekleme yapmak;
Listbox1.items.SetText('aaa'#13'bbb'#13'ccc');
Memo1.Lines.SetText('aaa'#13'bbb'#13'ccc');
Harddiskin seri numarasinin bulunmasi;
procedure TForm1.Button1Click(Sender: TObject);var VolumeSerialNumber : DWORD; MaximumComponentLength : DWORD; FileSystemFlags : DWORD; SerialNumber : string;begin GetVolumeInformation('C:\',nil,0,@VolumeSerialNumb er,MaximumComponentLength,FileSystemFlags,nil, 0); SerialNumber := IntToHex(HiWord(VolumeSerialNumber), 4) + '-' +IntToHex(LoWord(VolumeSerialNumber), 4); Memo1.Lines.Add(SerialNumber);end;Bir string'in basindaki ve sonundaki bosluklari atmak için;
Trim(string) TrimLeft (string) //stringin sadece basindaki bosluklari atmak içinTrimRight (string) //stringin sadece sonundaki bosluklari atmak içinsifreli bir table için programin sifre istememesi için;
Table'in Active özelligini False yapin ve Form'un OnCreate olayina asagidaki kodu ekleyin
Session.AddPassword('sifre');Table1.Active:=True;Pencereyi minimize etmek;
Application.Minimize; //taskbar'a minimize
CloseWindow(handle)
WindowState := wsMinimized;
Windows'u kapatmak veya yeniden baslatmak(reboot);
var i:dword;begin ExitWindowsEx(EWX_SHUTDOWN); //yeniden baslatmak için EWX_REBOOTend;Help menüsünden About kismina girin. Alt tusuna basili tutarak TEAM veya DEVELOPERS yazin. Delphi'yi gelistirenlerin isimlerini görebilirsiniz. Database Desktop'tada Help menüsünden About kismina girin ve delphi yazin.
ico'dan bmp'ye çevirme;
var Icon : TIcon; Bitmap : TBitmap;begin Icon := TIcon.Create; Bitmap := TBitmap.Create; Icon.LoadFromFile('c:\picture.ico'); Bitmap.Width := Icon.Width; Bitmap.Height := Icon.Height; Bitmap.Canvas.Draw(0, 0, Icon ); Bitmap.SaveToFile('c:\picture.bmp'); Icon.Free; Bitmap.Free;end;CD-Rom sürücüyü açmak ve kapamak;
uses kismina MMSystem unitini ekleyin.
mciSendString('Set cdaudio door open wait', nil, 0, handle); //açmciSendString('Set cdaudio door closed wait', nil, 0, handle); //kapaCapsLock ve Numlock tuslarini açip-kapama;
procedure TMyForm.Button1Click(Sender: TObject);Var KeyState : TKeyboardState;begin GetKeyboardState(KeyState); if (KeyState[VK_CAPITAL] = 0) then KeyState[VK_CAPITAL] := 1 else KeyState[VK_CAPITAL] := 0; SetKeyboardState(KeyState);end;Numlock tusu için VK_CAPITAL yerine VK_NUMLOCK yaziniz.

Hiç yorum yok:

Yorum Gönder