Üye Girişi

Kullanıcı Adı:  Parola:   Kayıp Parola

Başlığı Görüntüle

 Başlığı Yazdır
Delphi -- Shareware İpuçları
MuhBim
#1 Mesajı Yazdır
Mesaj Tarihi 31-03-2010 18:39
Süper Yönetici

Mesaj Sayısı: 41
Katılım Tarihi: 19.04.07

1 . Programınız her windows açılışında sadece bir kere çalışsın...
procedure TForm1.FormShow(Sender : TObject);
var atom : integer;
CRLF : string;
begin
if
GlobalFindAtom('THIS_IS_SOME_OBSCUREE_TEXT'Wink = 0 then
atom := GlobalAddAtom('THIS_IS_SOME_OBSCUREE_TEXT'Wink
else
begin
CRLF := #10 + #13;
ShowMessage('Bu versiyon her Windows oturumunda yanlızca bir kere çalışır.' + CRLF +
'Programı tekrar çalıştırmak için Windows'u restart edin. ' + CRLF +
'REGISTER !!'Wink;
Close;
end;
end;

Delphi -- WinAPI İpuçları
1.Windows'un dial-up bağlantısının çağrılması
//modem yüklü olmalı
winexec(PChar('rundll32.exe rnaui.dll,RnaDial '+Edit1.Text),sw_show);

2.Programına Animasyonlu Cursor Ekle
const
cnCursorID1 = 1;
begin
Screen.Cursors[ cnCursorID1 ] :=
LoadCursorFromFile(
'c:\winnt\cursors\piano.ani' );
Cursor := cnCursorID1;
end;

3.Programa E-mail linki eklemek
procedure email;
var
x: string;
begin
x:='****:'+FE****+'?Subject='+FEmailSubject+'&cc='+FEmailCC;
ShellExecute(0, nil, PChar(x), nil, nil, SW_SHOWDEFAULT);
end;

4.Registry'den Bilgi okumak
var
RegIni : TRegIniFile;
begin
RegIni := TRegIniFile.Create("Wink;
with RegIni do
begin
RootKey := HKEY_LOCAL_MACHINE;
LazyWrite := True;
OpenKey('\Software\Microsoft\Windows\',False);
ShowMessage(ReadString('CurrentVersion', 'RegisteredOrganization', 'not assigned'Wink);
Free;
end;
end;

5.Açık bütün pencereleri listeleme
function EnumWindowsProc(Wnd : HWnd;Form : TForm1) : Boolean; Export; {$ifdef Win32} StdCall; {$endif}
var
Buffer : Array[0..99] of char;
begin
GetWindowText(Wnd,Buffer,100);
if StrLen(Buffer) <> 0 then
Form.ListBox1.Items.Add(StrPas(Buffer));
Result := True;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
EnumWindows(@EnumWindowsProc,LongInt(Self));
end;

Delphi -- File Yönetimi İpuçları

1. Delphi 'de dosya nasıl Kopyalanır ?
Bunun için bir kaç yöntem var...
Procedure FileCopy( Const sourcefilename, targetfilename: String );
Var
S, T: TFileStream;
Begin
S := TFileStream.Create( sourcefilename, fmOpenRead );
try
T := TFileStream.Create( targetfilename,
fmOpenWrite or fmCreate );
try
T.CopyFrom(S, S.Size ) ;
finally
T.Free;
end;
finally
S.Free;
end;
End;

procedure FileCopy(const FromFile, ToFile: string);
var
FromF, ToF: file;
NumRead, NumWritten: Word;
Buf: array[1..2048] of Char;
begin
AssignFile(FromF, FromFile);
Reset(FromF, 1);
AssignFile(ToF, ToFile);
Rewrite(ToF, 1);
repeat
BlockRead(FromF, Buf, SizeOf(Buf), NumRead);
BlockWrite(ToF, Buf, NumRead, NumWritten);
until (NumRead = 0) or (NumWritten <> NumRead);
CloseFile(FromF);
CloseFile(ToF);
end;
{ USES LZExpand.}
procedure CopyFile(FromFileName, ToFileName: string);
var
FromFile, ToFile: File;
begin
AssignFile(FromFile, FromFileName);
AssignFile(ToFile, ToFileName);
Reset(FromFile);
try
Rewrite(ToFile);
try
if LZCopy(TFileRec(FromFile).Handle, TFileRec(ToFile).Handle) < 0 then
raise EInOutError.Create
finally
CloseFile(ToFile);
end;
finally
CloseFile(FromFile);
end;
end;

2. Dosyanın değiştirilme tarih ve saatinin öğrenilmesi
function GetModifiedDate(FileName: string): TDateTime;
var
SearchRec: TSearchRec;
ModifiedTime: TFileTime;
SystemTime: TSystemTime;
begin
Result := 0;
If FindFirst(FileName, faAnyFile, SearchRec) = 0 then
begin
ModifiedTime := SearchRec.FindData.ftLastWriteTime;
FileTimeToLocalFileTime(ModifiedTime, ModifiedTime);
FileTimeToSystemTime(ModifiedTime, SystemTime);
Result := SystemTimeToDateTime(SystemTime);
end;
FindClose(SearchRec);
end;

3. Dosyanın varlığının kontrol edilmesi
Function GetShortFileName(Const FileName : String) : String;
var
aTmp: array[0..255] of char;
begin
if GetShortPathName(PChar(FileName),aTmp,Sizeof(aTmp)-1)=0 then
Result:= FileName+ ' <--Bulunamadı'
else
Result:=FileName+' <--Bulundu';
end;

4. Verilen bir dizinin içini silme
procedure DelTree(StartDir: string);
var
Search : TSearchRec;
begin
if Startdir[Length(Startdir)] <> '\' then
startdir := startdir + '\';
if FindFirst(startdir + '*.*', faAnyFile, Search) = 0 then
repeat
if (Search.Name[1] <> '.' ) then
if ((Search.Attr and faDirectory) > 0) then
begin
RmDir(StartDir + Search.Name);
ChangeFAttrib(StartDir + Search.Name);
end else
begin
DeleteFile(StartDir + Search.Name);
Application.ProcessMessages;
end;
until FindNext(Search) <> 0;
FindClose(Search);
end

Delphi -- Hardware İpuçları

1. CD-ROM Drive'ı kontrol etmek...
function IsCDROM(DriveNum: Integer): Boolean; assembler;
asm
MOV AX,1500h { MSCDEX 'e bakıyor}
XOR BX,BX
INT 2fh
OR BX,BX
JZ @Finish
MOV AX,150Bh { CD driver ın kullanılırlığına bakıyor}
MOV CX,DriveNum
INT 2fh
OR AX,AX
@Finish:
end;
// Win32 kontrolörlü
A:
Function IsCdRom(DriveNum : Word) : Boolean;
Var
F : WordBool;
Begin
asm
mov ax, 1500h
xor bx, bx
int 2fh
mov ax, bx
or ax, ax
jz @no_mscdex
mov ax, 150bh
mov cx, DriveNum
int 2fh
@no_mscdex:
mov f,ax
end;
Result := F;
End;

2. Disk veya Disket yerinde mi ?
function DiskInDrive(Drive: Char): Boolean;
var
ErrorMode: word;
begin
if Drive in ['a'..'z'] then Dec(Drive, $20);
if not (Drive in ['A'..'Z']) then
raise EConvertError.Create('Not a valid drive ID'Wink;
ErrorMode := SetErrorMode(SEM_FailCriticalErrors);
try
{ sürücü 1 = a, 2 = b, 3 = c, etc. }
if DiskSize(Ord(Drive) - $40) = -1 then
Result := False
else
Result := True;
finally
{ error moduna geri dön }
SetErrorMode(ErrorMode);
end;
end;

3. Sistem Tarih ve Saatini değiştirme...
procedure SetDate(Year, Month, Day: Word); assembler;
asm
MOV CX,Year
MOV DH,BYTE PTR Month
MOV DL,BYTE PTR Day
MOV AH,2BH
INT 21H
end;
procedure SetTime(Hour, Minute, Second, Sec100: Word); assembler;
asm
MOV CH,BYTE PTR Hour
MOV CL,BYTE PTR Minute
MOV DH,BYTE PTR Second
MOV DL,BYTE PTR Sec100
MOV AH,2DH
INT 21H
end;
function SetSystemDateTime(Year, Month, Day, Hour, Minute, Second: word): integer;export;
begin
SetDate(Year, Month, Day);
SetTime(Hour, Minute + 1, Second, 0);
result := 1;
end

Delphi -- String İpuçları

1. Editten sadece sayımı girilsin...
procedure CheckText(Sender:TEdit; var Key:Char);
begin
If not (Key in ['0'..'9','.',#8, #13]) then
Key := #0;
If Key = '.' then
begin
If Pos('.', Sender.Text) > 0 then
Key := #0;
end;
end;

2. Editin içini belli bir formatta yazdırmak...
Procedure Format(MyEdit1,MyEdit2:TEdit);
Var
I : Integer;
S : String;
begin
I := StrToInt(MyEdit1.Text);
FmtStr(S, '%.3d', );
MyEdit2.Text := S;
// I.E. If Edit1.Text := '1' den Edit2.Text := '001'; döndürür
end;

3. String içinde belli iki karakter arasını almak...
Function GetParsedItem(TheItemStr, ParseStr : String; ItemNum : Integer): String;
Var
I4 : Integer;
S4 : String;
Begin
TheItemStr := TheItemStr + ParseStr;
S4 := ";
I4 := 0;
While I4 <= ItemNum Do
Begin
S4 := Copy(TheItemStr, 1, Pos(ParseStr, TheItemStr) - 1);
Delete(TheItemStr, 1, Pos(ParseStr, TheItemStr));
Inc(I4);
End;
Result := S4;
End;
{TheItemStr de Parsestr ye bakiyor ve ItemNum inci parsestrden sonra tekrar bulana dek olan str yi veriyor.}

4.String şifreleme...
function EnDeCode(const Value : String) : String;
var
CharIndex : Integer;
ReturnValue : String;
begin
ReturnValue := ";
for CharIndex := 1 to Length(Value) do
begin
ReturnValue := ReturnValue + chr(NOT(ord(Value[CharIndex])));
end;
Result := ReturnValue;
end;
 
http://www.programyukle.org
Atlanilacak Forum:

En Çok İndirilenlerYeni Eklenenler

image Outlook Express 6.0 [14961]  
image SPSS 15.0 [13132]  
image Msn Dondurucu ( Msn F... [12859]  
image GTA Mod Installer v2.2... [9643]  
image Cep Okey [9599]  
image Eşli Batak 2.0.0.8 [8543]  
image Cepte Televizyon v1.5 [7143]  
image Nokia N70 İçin Full Pr... [6204]  
image Championship Manager 0... [4347]  
image Ders dağıtım programı ... [4241]  
image CurrPortS 2.12 [18.12.2014]
image PHTML Encoder 6.4 [18.12.2014]
image DzSoft PHP Editor 4.2.7.7 [18.12.2014]
image KoolMoves 9.2.1 [18.12.2014]
image Chicken Invaders 2 2.0 [18.12.2014]
image Natalie Brooks: Kayıp Krallığın ... [18.12.2014]
image Zuma Deluxe 1.0 [18.12.2014]
image Bus Driver 1.5 [18.12.2014]
image Mario Forever 5.8 [18.12.2014]
image Icy Tower 1.5.1 [18.12.2014]
site statistics

Edit by MuhBim
Copyright © 2007 Programyukle.Org
Powered by PHP-Fusion copyright © 2002 - 2018 by Nick Jones.
Released as free software without warranties under GNU Affero GPL v3.
Sayfa oluşturulma süresi: 0.09 saniye | 48,997,389 Tekil Ziyaretçi | jQ Blog