Pir Zöhre Ana Forum - Delphi

CÃÂ´ng ty XÃÂ°ÃÂ¡ng Minh tri ÃÂ¢n khÃÂ¡ch hÃ*ng

Thu, 31 Jan 2013 04:49:40 +0200

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

[size=3]CÃÂ´ng ty TNHH TM XÃÂ°ÃÂ¡ng Minh[/size]
ÃÂÃ¡Â»Âa chÃ¡Â»Â: phÃÂ²ng 301- tÃÂ²a nhÃ* HÃ¡Â»Ân hÃ¡Â»Â£p 5 tÃ¡ÂºÂ§ng - Ã’ÃÂ°Ã¡Â»Âng Kim ÃÂÃ¡Â»’ng - PhÃÂ°Ã¡Â»Âng HoÃ*ng VÃÂn ThÃ¡Â»Â¥ -QuÃ¡Âº*n HoÃ*ng Mai - HÃ* NÃ¡Â»Âi
Tel: (04) 39877407 ~ 09 Fax: (04) 39877410 Hotline: 0913.201.426
Email: daothanhbinh66@gmail.com
Website 1: http://motorteco.vn Website 2: http://thapgiainhiettashin.vn

Varsayılan Delphi component, bileşen ve kod paylaşımlar

Fri, 02 Apr 2010 21:16:05 +0300

....:::: İlk Paylaşım Delphi Tmsn Poupup Menu 5.0 ::::....

Bu kod parçacığı ile aynı msn benzeri poupup menu tarzı kullanıcıya ister uyarı istersenizde bilgi amaçlı form göstermenize yarıyor...

...::: Download Link :::...

...::: Ekran Görüntüsü :::...

Control Panel Ayarları

Thu, 19 Feb 2009 15:41:58 +0200

Control Panel üzerindeki herhangi bir ayar diyalog penceresine ulaşmak için en temel api'lerden birini kullanabileceğinizi biliyormusunuz? Yapmanız gereken şey çok basit Önce unit'e uses ShellApi; satırını ekleyin.

[COLOR=#c5003f]ShellExecute() fonksiyonu ShellApi unit'i içinde tanımlıdır. Bu api fonksiyonunu programınızda kullanabilmek için yukardaki satırın programınızda bulunması gerekir.

daha sonra programınızda Control Panelden herhangi bir ayar özelliğini açmak istediğiniz event'in içine şu kodu ekleyin. Biz örneğimizde Form1 adlı bir formun üzerinde yer alan Button1 adlı bir butona basıldığında bu işlemin yapılmasını istedik.

procedure TForm1.Button1Click(Sender: TObject);
begin
ShellExecute(Handle, 'open', 'control', 'keyboard', nil, SW_SHOW);
end;

[COLOR=#c5003f]Burada 'control' Control Panel'in açılacağını 'date/time' ise Date/Time Properties diyalog penceresinin açılacağını belirtiyor.

[COLOR=#c5003f]Diğer özelliklere ulaşmak için 'date/time' yerine aşağıdaki parametreleri kullanabilirsiniz:

'display' Ekran ve masaüstü ayarları penceresini getirir.
'international' Bölgesel ayarlar penceresini getirir.
'mouse' Mouse ayarları penceresini getirir.
'keyboard' Keyboard ayarları penceresini getirir.

Murat Zaralı

Bilgisayarınıza Bağlı Yazıcıları Bulun

Thu, 19 Feb 2009 15:40:49 +0200

Printers unit'i yazıcılarla ilgili isteyebileceğiniz kontrollerin neredeyse hepsini içerir.
İşe uses satırına Printers'ı ekleyerek başlayalım. Aşağıdaki kod varsayılan yazıcıyının ismini bulmanızı sağlar.

function Varsayilan : string;
begin
if (Printer.PrinterIndex > 0) then
Varsayilan := Printer.Printers[Printer.PrinterIndex]
else
Varsayilan := ";
end;

Eğer bilgisayarınıza bağlı olan yazıcıların listesini almak isterseniz önce formunuza bir combobox ekleyin daha sonra aşağıdaki kodu istediğiniz bir event'e bağlayabilirsiniz.

ComboBox1.items := Printer.Printers;

Dosya Sıkıstırma Ve Acma

Thu, 19 Feb 2009 15:39:08 +0200

uses
ZLib;

{ Compress a stream }

procedure CompressStream(inpStream, outStream: TStream);
var
InpBuf, OutBuf: Pointer;
InpBytes, OutBytes: Integer;
begin
InpBuf := nil;
OutBuf := nil;
try
GetMem(InpBuf, inpStream.Size);
inpStream.Position := 0;
InpBytes := inpStream.Read(InpBuf^, inpStream.Size);
CompressBuf(InpBuf, InpBytes, OutBuf, OutBytes);
outStream.Write(OutBuf^, OutBytes);
finally
if InpBuf <> nil then FreeMem(InpBuf);
if OutBuf <> nil then FreeMem(OutBuf);
end;
end;

{ Decompress a stream }
procedure DecompressStream(inpStream, outStream: TStream);
var
InpBuf, OutBuf: Pointer;
OutBytes, sz: Integer;
begin
InpBuf := nil;
OutBuf := nil;
sz := inpStream.Size - inpStream.Position;
if sz > 0 then
try
GetMem(InpBuf, sz);
inpStream.Read(InpBuf^, sz);
DecompressBuf(InpBuf, sz, 0, OutBuf, OutBytes);
outStream.Write(OutBuf^, OutBytes);
finally
if InpBuf <> nil then FreeMem(InpBuf);
if OutBuf <> nil then FreeMem(OutBuf);
end;
outStream.Position := 0;
end;

{
Example:
Compress the *******s of RichEdit1 and
calculate the compression rate.
Then save the stream to a file (ms2.dat)

Beispiel:
Komprimiert den Inhalt von RichEdit1 und
berechnet die Kompressionsrate.
Dann wird der Stream in eine Datei (ms2.dat) gespeichert.
}

procedure TForm1.Button1Click(Sender: TObject);
var
ms1, ms2: TMemoryStream;
begin
ms1 := TMemoryStream.Create;
try
ms2 := TMemoryStream.Create;
try
RichEdit1.Lines.SaveToStream(ms1);
CompressStream(ms1, ms2);
ShowMessage(Format('Stream Compression Rate: %d %%',
[round(100 / ms1.Size * ms2.Size)]));
ms2.SaveToFile('C:\ms2.dat');
finally
ms1.Free;
end;
finally
ms2.Free;
end;
end;

{
Loads the stream from a file (ms2.dat)
and decompresses it.
Then loads the Stream to RichEdit1.

LÃ¤dt den komprimierten Stream von einer Datei (ms2.dat)
und dekomprimiert ihn.
Dann wird der Stream wieder in RichEdit1 geladen.
}

procedure TForm1.Button2Click(Sender: TObject);
var
ms1, ms2: TMemoryStream;
begin
ms1 := TMemoryStream.Create;
try
ms2 := TMemoryStream.Create;
try
ms1.LoadFromFile('C:\ms2.dat');
DecompressStream(ms1, ms2);
RichEdit1.Lines.LoadFromStream(ms2);
finally
ms1.Free;
end;
finally
ms2.Free;
end;
end;

alıntıdır

Girilen Tc Kimlik No Doğru Mu?

Fri, 05 Dec 2008 14:15:13 +0200

Tc Kimlik Numarasının doğru olup olmadığını kontrol ediyor. function KimlikDogrumu(kimlikno:String):Boolean ;
var
d:array[1..9] of integer;
a,tmp:double;
cift_sum,tek_sum,total,chkdigit1,chkdigit2,tmp1,n:integer;
begin
if TryStrToFloat(kimlikno,a)=false and (length(kimlikno) <> 11) then
result:=False
else
begin
tmp := Floor(strtofloat(kimlikno)/100);
tmp1 := Floor(strtofloat(kimlikno)/100);
for n:= 1 to 9 do
begin
d[n]:=tmp1 mod 10 ;
tmp1:=floor(tmp1/10);
end;
tek_sum:=d[9]+d[7]+d[5]+d[3]+d[1];
cift_sum:=d[8]+d[6]+d[4]+d[2];
total:=(tek_sum * 3 )+ cift_sum;
chkdigit1:= (10 - (total mod 10)) mod 10;
tek_sum:=chkdigit1+d[8]+d[6]+d[4]+d[2];
cift_sum:=d[9]+d[7]+d[5]+d[3]+d[1];
total:=(tek_sum*3) + cift_sum;
chkdigit2:=(10-(total mod 10 )) mod 10;
tmp:=(tmp*100) + (chkdigit1*10) + chkdigit2;
if not( tmp=StrToFloat(kimlikno)) then
result:=False
else
result:=true;
end;
end;

Delphi İle Outlook Üzerinden Mail Gönderme

Fri, 05 Dec 2008 14:14:22 +0200

Bu örnek kod. Outlook (varsayılan outlook posta yöneticisi) üzerinden mail gönderir. Outlook açık değilken gönderilen mailleri outbox'a atıyor ve outlook açılınca gönderiyor.

Kolay Gelsin.. Unit Send_Mail;

Interface

Uses Mapi;

Procedure SendMail(Subject,Mailtext,
FromName,FromAdress,
ToName,ToAdress tring;
AttachedFileName:TStringList;
DisplayFileNametring;
ShowDialog:boolean);
var
Form1: TForm1;

implementation

// Uses 'a Mapi eklenecek **********************

Procedure TForm1.SendMail(Subject,Mailtext,
FromName,FromAdress,
ToName,ToAdress tring;
AttachedFileName:TStringList;
DisplayFileNametring;
ShowDialog:boolean);
var
MapiMessage : TMapiMessage;
MError : Cardinal;
AlicilarT : Array[0..255] of TMapiRecipDesc;
GondericilerT : TMapiRecipDesc;
EklerT : Array[0..255] of TMapiFileDesc;
I:Integer;
begin

with MapiMessage do begin
ulReserved := 0;

lpszSubject := PChar(Subject);

lpszNoteText := PChar(Mailtext);

lpszMessageType := nil;
lpszDateReceived := nil;
lpszConversationID := nil;
flFlags := 0;

GondericilerT.ulReserved:=0;
GondericilerT.ulRecipClass:=MAPI_ORIG;
GondericilerT.lpszName:= PChar(FromName);
GondericilerT.lpszAddress:= PChar(FromAdress);
GondericilerT.ulEIDSize:=0;
GondericilerT.lpEntryID:=nil;
lpOriginator := @GondericilerT;

nRecipCount := 1;

AlicilarT[0].ulReserved:=0;
AlicilarT[0].ulRecipClass:=MAPI_TO;
AlicilarT[0].lpszName:= PChar(ToName);
AlicilarT[0].lpszAddress:= PChar(ToAdress);
AlicilarT[0].ulEIDSize:=0;
AlicilarT[0].lpEntryID:=nil;
lpRecips := @AlicilarT;

nFileCount :=AttachedFileName.Count;

For I:=0 To AttachedFileName.Count-1 Do
Begin
EklerT.lpszPathName:= PChar(AttachedFilename.Strings);

EklerT.lpszFileName:= PChar(AttachedFileName.Strings);
EklerT.ulReserved:=I;
EklerT.flFlags:=I;
EklerT.nPosition:=Cardinal(-1);
EklerT.lpFileType:=nil;
lpFiles := @EklerT;
End;

end;

Try
if ShowDialog then
MError := MapiSendMail(0, Application.Handle,
MapiMessage, MAPI_DIALOG or MAPI_LOGON_UI, 0)
else
MError := MapiSendMail(0, Application.Handle, MapiMessage, 0,);
Except
Case MError of
MAPI_E_AMBIGUOUS_RECIPIENT:
MessageDlg('XXXX',mterror,[mbok],0);

MAPI_E_ATTACHMENT_NOT_FOUND:
MessageDlg('XX',mterror,[mbok],0);

MAPI_E_ATTACHMENT_OPEN_FAILURE:
MessageDlg('XXX',mterror,[mbok],0);

MAPI_E_BAD_RECIPTYPE:
MessageDlg('XXXX',mterror,[mbok],0);

MAPI_E_FAILURE:
MessageDlg('XXX',mterror,[mbok],0);

MAPI_E_INSUFFICIENT_MEMORY:
MessageDlg('XXX',mterror,[mbok],0);

MAPI_E_LOGIN_FAILURE:
MessageDlg('XXX',mterror,[mbok],0);

MAPI_E_TEXT_TOO_LARGE:
MessageDlg('XXX',mterror,[mbok],0);

MAPI_E_TOO_MANY_FILES:
MessageDlg('XXX',mterror,[mbok],0);

MAPI_E_TOO_MANY_RECIPIENTS:
MessageDlg('XXXX',mterror,[mbok],0);

MAPI_E_UNKNOWN_RECIPIENT:
MessageDlg('XXXX',mterror,[mbok],0);

MAPI_E_USER_ABORT:
MessageDlg('XXXXX',mterror,[mbok],0);

SUCCESS_SUCCESS:
MessageDlg('Mail Gonderildi',mtinformation,[mbok],0);
End;
End;
end;

//***************** Örnek Yordam ***************

procedure TForm1.BitBtn1Click(Sender: TObject);

var
X:String;
FilesX:TStringList;

begin
FilesX:=TStringList.Create;
FilesX.Clear;
FilesX.Add('C:\cheaters.log');
FilesX.Add('C:\Autoexec.bak');

// (Subject, Mailtext, FromName, FromAdress, ToName ,ToAdress, AttachedFileName, DisplayFileName, ShowDialog;

SendMail('Mail Deneme', 'Bu mail, Delphi içinden gönderildi.','Programcı ',
'Programci@oldeye.com','Alıcı Adı','AliciAdresi@xxxxxx.com',Filesx ,
' ',False);
end;