Mega Code Archive
Code snippet - 1
<![CDATA[
//delphi FAQ.chm'den derledim
--1------------------------------------------------------------
{Eğer Open dediğinizde, Delphi'nin varsayılan klasörü çıkmasına,
sinir oluyorsanız şunu deneyin:
Delphi Kısayolunun "Başlama Yeri"/"Start in" yerine "C:\belgelerim\" deyin..
}
--2------------------------------------------------------------
{Menu elemanını gri yapmadan Aktifliğini kapatmak:
var
Menu: TMenu;
begin
Menu := Application.MainForm.Menu;
// The first Menu item will be disabled, but not greyed out.
EnableMenuItem(Menu.Handle, Menu.Items[0].Command, MF_DISABLED);
}
--3------------------------------------------------------------
{TWebBrowser nesnesinde sağ tuşu engellemek için:
Bu nesnenizi Panel içine atıp, Panel'in Enabled:False edin.
}
--4------------------------------------------------------------
{Bir dosyanın tarihini almak:
Label1.Caption := DateToStr(FileDateToDateTime(FileAge(OpenDialog1.FileName)));
}
--5------------------------------------------------------------
{Uygulamanız Masaüstünü kaplasın:
var
DeskTopForm: TRect;
begin
(* You'll find more options in the Win32.hlp file under SystemParametersInfo *)
SystemParametersInfo(SPI_GETWORKAREA, 0, Pointer(@DeskTopForm), 0);
Top := DeskTopForm.Top;
Left := DeskTopForm.Left;
Height := DeskTopForm.Bottom - DeskTopForm.Top + 1;
Width := DeskTopForm.Right - DeskTopForm.Left + 1;
}
--6------------------------------------------------------------
{TDateTimePicker içini boş isterseniz:
uses CommCtrl;
DateTime_SetFormat(DateTimePicker1.Handle, 'gg');
}
--7------------------------------------------------------------
{Ayın son gününü bulmak:
function LastDayCurrMon: TDate;
var
y, m, d: word;
begin
decodedate(now, y, m, d);
m := m + 1;
if m > 12 then
begin
y := y + 1;
m := 1;
end;
result := encodedate(y, m, 1) - 1;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(DateToStr(LastDayCurrMon));
end;
}
--8------------------------------------------------------------
{Roma Rakamına Çevrim:
function DecToRom(Dec: LongInt): String;
const
Nums : Array[1..13] of Integer =
(1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900, 1000);
RomanNums: Array[1..13] of string =
('I', 'IV', 'V', 'IX', 'X', 'XL', 'L', 'XC', 'C', 'CD', 'D', 'CM', 'M');
var
i: Integer;
begin
Result := '';
for i := 13 downto 1 do
while (Dec >= Nums[i]) do
begin
Dec := Dec - Nums[i];
Result := Result + RomanNums[i];
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Label1.Caption := DecToRom(StrToInt(Edit1.Text));
end;
}
--9------------------------------------------------------------
{Liste Kutusunda renkli satırlar:
Style:lbOwnerDrawFixed olmalıdır
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
myColor: TColor;
myBrush: TBrush;
begin
myBrush := TBrush.Create;
with (Control as TListBox).Canvas do // draw on control canvas, not on the form
begin
if not Odd(Index) then
myColor := clSilver
else
myColor := clYellow;
myBrush.Style := bsSolid;
myBrush.Color := myColor;
Windows.FillRect(handle, Rect, myBrush.Handle);
Brush.Style := bsClear;
// display the text
TextOut(Rect.Left, Rect.Top, (Control as TListBox).Items[Index]);
MyBrush.Free;
end;
end;
}
--10------------------------------------------------------------
{Windows Kısayolu Oluştur Sihirbazını açmak:
uses ShellApi,Registry;
function InvokeShortCutDialog(Directory : string) : boolean;
var
Reg : TRegistry;
CmdLine : string;
begin
Result := false;
Reg := TRegistry.Create;
try
Reg.Rootkey := HKEY_CLASSES_ROOT;
if Reg.OpenKeyReadOnly('.LNKShellNew') then
begin
CmdLine := Reg.ReadString('Command');
CmdLine := StringReplace(CmdLine, '%1', Directory, []);
Result := True;
WinExec(PChar(CmdLine), SW_SHOWNORMAL );
end
finally
Reg.free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
InvokeShortCutDialog('c:Temp');
end;
}
--11------------------------------------------------------------
{Fare İmlecinin resmini almak:
procedure TForm1.Button1Click(Sender: TObject);
var
HCursor : THandle;
begin
HCursor:= Screen.Cursors[Ord(Screen.Cursor)];//Gets the cursor handle.
// X Y Size
DrawIconEx(Form1.Canvas.Handle, 150, 150, HCursor, 32, 32,
0, 0, DI_NORMAL);//Draws to canvas
end;
}
--12------------------------------------------------------------
{Çokİşlemcili sistemde programımız Tek işlemcide çalışsın:(çüş yani)
procedure TForm1.Button1Click(Sender: TObject);
var
vHandle : Cardinal;
vMaskProcess, vMaskSystem : cardinal;
begin
vHandle := Form1.Handle;
SetProcessAffinityMask(vHandle, 0); // or 1
GetProcessAffinityMask(vHandle, vMaskProcess, vMaskSystem);
showmessage(inttostr(vMaskProcess));
showmessage(inttostr(vMaskSystem));
end;
}
--13------------------------------------------------------------
{Bazı hafif, tekrarlanan işlerinizi TTimer nesnesi yerine uygulamanız
boşta iken yapabilirsiniz:
Form Create olayına:
Application.OnIdle:= ApplicationEventsIdle;
İşlemleri de:
procedure TForm1.ApplicationEventsIdle(Sender: TObject;
var Done: Boolean);
begin
//
end;
}
--14------------------------------------------------------------
{Canlı Query'ler:
Eğer Sorgularınıza Tablo gibi veri girmek isterseniz RequestLive:True edin
}
]]>