Tüm Versiyonu Göster : Soru-Cevap köşesi
arkadaşlar bu bölümde soru cevap şeklinde verdiğim başlıklarla sizlere örnekler sunacağım
Modem ile bir telefon numarasını nasıl çeviririm?
Verilen iletişim port'unu kullanarak standart dosya açma yöntemi ile O porta bilgi göndermek.
Yani verilen telefon numarasını CreateFile() winapi'sini kullanarak çevirme.
Örnek:
var
hCommFile : THandle;
procedure TForm1.Button1Click(Sender: TObject);
var
PhoneNumber : string;
CommPort : string;
NumberWritten : LongInt;
begin
PhoneNumber := 'ATDT 0392 2277125' + #13 + #10;
CommPort := 'COM2';
{portu aç}
hCommFile := CreateFile(PChar(CommPort),
GENERIC_WRITE,
0,
nil,
OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL,
0);
if hCommFile=INVALID_HANDLE_VALUE then
begin
ShowMessage(CommPort + ' Açılamadı');
exit;
end;
{numarayı çevir}
NumberWritten:=0;
if WriteFile(hCommFile,
PChar(PhoneNumber)^,
Length(PhoneNumber),
NumberWritten,
nil) = false then begin
ShowMessage('Unable to write to ' + CommPort);
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
{portu kapat}
CloseHandle(hCommFile);
end;
Modem durumunu nasıl görüntülerim?
Win32 altında modemin durumunu anlamaya yarayan örnektir
Örnek:
procedure TForm1.Button1Click(Sender: TObject);
var
CommPort : string;
hCommFile : THandle;
ModemStat : DWord;
begin
CommPort := 'COM2';
{Comm Portu Aç}
hCommFile := CreateFile(PChar(CommPort),
GENERIC_READ,
0,
nil,
OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL,
0);
if hCommFile = INVALID_HANDLE_VALUE then
begin
ShowMessage(CommPort + ' Açılamadı');
exit;
end;
{Modem Durumunu al}
if GetCommModemStatus(hCommFile, ModemStat) <> false then begin
if ModemStat and MS_CTS_ON <> 0 then
ShowMessage('The CTS (clear-to-send) is on.');
if ModemStat and MS_DSR_ON <> 0 then
ShowMessage('The DSR (data-set-ready) is on.');
if ModemStat and MS_RING_ON <> 0then
ShowMessage('The ring indicator is on.');
if ModemStat and MS_RLSD_ON <> 0 then
ShowMessage('The RLSD (receive-line-signal-detect) is
on.');
end;
{comm port'u kapat}
CloseHandle(hCommFile);
end;
Difault windows klasörünü nasıl bulurum?
Default windows klasörünü bulmaya yarayan bir registry örneği
Örnek:
uses Registry;
procedure TForm1.Button1Click(Sender: TObject);
var
reg : TRegistry;
ts : TStrings;
i : integer;
begin
reg := TRegistry.Create;
reg.RootKey := HKEY_CURRENT_USER;
reg.LazyWrite := false;
reg.OpenKey(
'Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders',
false);
ts := TStringList.Create;
reg.GetValueNames(ts);
for i := 0 to ts.Count -1 do begin
Memo1.Lines.Add(ts.Strings[i] +
' = ' +
reg.ReadString(ts.Strings[i]));
end;
ts.Free;
reg.CloseKey;
reg.free;
end;
Sabit disk sürücüsünün seri numarasını nasıl alırım?
procedure TForm1.Button1Click(Sender: TObject);
var
VolumeName,
FileSystemName : array [0..MAX_PATH-1] of Char;
VolumeSerialNo : DWord;
MaxComponentLength,
FileSystemFlags : Integer;
begin
GetVolumeInformation('C:\',VolumeName,MAX_PATH,@VolumeSerialNo,
MaxComponentLength,FileSystemFlags,
FileSystemName,MAX_PATH);
Memo1.Lines.Add('Sürücü Adı = '+VolumeName);
Memo1.Lines.Add('Seri Nosu = $'+IntToHex(VolumeSerialNo,8));
Memo1.Lines.Add('Bileşen Uzunluğu = '+IntToStr(MaxComponentLength));
Memo1.Lines.Add('Bayrak = $'+IntToHex(FileSystemFlags,4));
Memo1.Lines.Add('Dosya sistemi = '+FileSystemName);
end;
Delphi veya C++ derleyicisinin çalışıp çalışmadığını nasıl anlarım?
TAppBuilder;
if FindWindow('TAppBuilder', Nil) <> 0 Then
ShowMessage('Delphi ve/veya C++ Derleyicisi çalışıyor.');
Dosya veya klasörleri nasıl taşırım?
Dosya veya klasörleri taşımak için API fonksiyonu olan MoveFile()'ı kullanabilirsiniz
Eğer dosya taşıyorsanız ve hedef klasör yok ise hedef klasör de oluşacaktır.
Eğer bir klasör taşıyorsanız, o klasör altındaki bütün dosya ve alt klasörler taşınacaktır
Örnek:
Dosya Taşıma:
MoveFile('C:\kaynak\kaynakdosya.txt',
'C:\hedef\hedefdosya.txt');
Klasör Taşıma:
MoveFile('C:\kaynak',
'C:\hedef');
Bilgisayarım'ın networke bağlı olup olmadığını nasıl anlarım?
GetSystemMetrics() Windows API fonksiyonunu çağırarak networkde olup olmadığını
anlayabilirsiniz.
Örnek:
procedure TForm1.Button1Click(Sender: TObject);
begin
if GetSystemMetrics(SM_NETWORK) AND $01 = $01 then
ShowMessage('Bilgisayar Networke Bağlıdır') else
ShowMessage('Bilgisayar Networkde değildir.');
end;
Internet Explorer'in her açılışında istediğim URL ye bağlanmasını nasıl sağlarım?
ShellAPI fonksiyonu olan ShellExecute komutu kullanılır.
Örnek:
uses ShellAPI;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShellExecute(Form1.Handle,
nil,
'Linki görüntüleyebilmek için <a href="%2$s"><strong>Üye</strong></a> olmanız gerekiyor.',
nil,
nil,
SW_SHOWNORMAL);
end;
Windows her açıldığında programımın çalışmasını nasıl sağlarım?
Programınızı windows'un açılışında çalıştırılmasını istiyorsanız aşağıdaki
win16 inifile ve win32 registry örneğini kullanabilirsiniz.
uses
Registry, {Win32}
IniFiles; {Win16}
{$IFNDEF WIN32}
const MAX_PATH = 144;
{$ENDIF}
{Win32 için}
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\CurrentVersion\Run',
false);
reg.WriteString('My App', Application.ExeName);
reg.CloseKey;
reg.free;
end;
{Win16 için}
procedure TForm1.Button2Click(Sender: TObject);
var
WinIni : TIniFile;
WinIniFileName : array[0..MAX_PATH] of char;
s : string;
begin
GetWindowsDirectory(WinIniFileName, sizeof(WinIniFileName));
StrCat(WinIniFileName, '\win.ini');
WinIni := TIniFile.Create(WinIniFileName);
s := WinIni.ReadString('windows',
'run',
'');
if s = '' then
s := Application.ExeName else
s := s + ';' + Application.ExeName;
WinIni.WriteString('windows',
'run',
s);
WinIni.Free;
end;
...Resource Dosyadan Bitmap Kullanılabilir mi? (*.res)
Projenizi oluşturduğunuz klasörde bir text dosya oluşturun ve newres.txt
ismi ile kaydedin. Dosyanın ilk satırına da aşağıdaki satırı ilave edin.
MY_BMP_RES BITMAP "bmpname.bmp"
Dos Komut satırından brcc32 newres.txt komutu ile dosyayı derleyin
Böylelikle newres.res isimli bitmap dosyanız oluşacaktır.
Bu dosyayı kullanmak için ise aşağıdaki kodu kullanabilirsiniz:
unit Unit1;
interface
...
var
MyBmp: TBitmap;
implementation
{$R *.DFM}
{$R newres.res} // Bu satır eklendi!
procedure TForm1.FormCreate(Sender: TObject);
begin
MyBmp := TBitmap.Create;
MyBmp.LoadFromResourceName(HInstance,'MY_BMP_RES');
end;
Registryden nasıl kayıt okuyabilirim?
Örnek 1:
procedure TForm1.FormCreate(Sender: TObject);
Var
Registry: TRegistry;
Listan:TStringList;
begin
Listan := TStringList.create;
Registry := TRegistry.Create;
try
Registry.RootKey := HKey_Classes_Root;
Registry.OpenKey('',False);
Registry.GetKeynames(Listan);
ComboBox1.Items := Listan;
finally
Registry.Free;
end;
end;
Örnek 2:
var
RegIni : TRegIniFile;
begin
RegIni := TRegIniFile.Create('');
with RegIni do
begin
RootKey := HKEY_LOCAL_MACHINE;
LazyWrite := True;
OpenKey('\Software\Microsoft\Windows\',False);
ShowMessage(ReadString('CurrentVersion', 'RegisteredOrganization', 'not assigned'));
Free;
end;
end;
Program 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') = 0 then
atom := GlobalAddAtom('THIS_IS_SOME_OBSCUREE_TEXT')
end
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 !!');
Close;
end;
Dosya Kopyalama Yöntemleri
Yöntem1:
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;
Yöntem2:
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;
Yöntem3:
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;
Diractory 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;
Porta bilgi gönderme ve Porttan bilgi okuma...
function ReadPortB( wPort : Word ) : Byte;
begin
asm
mov dx, wPort
in al, dx
mov result, al
end;
end;
procedure WritePortB( wPort : Word; bValue : Byte );
begin
asm
mov dx, wPort
mov al, bValue
out dx, al
end;
end.
B. Visual Component Library (VCL)
Çalışma esnasında mouse olaylarını nasıl kontrol edebilirim ?
Mouse tuşlarını OnMouseDown ve OnMouseUp olayı ile, mouse hareketlerini
ise OnMouseMove olayı ile kontrol edebilirsiniz.
Aşağıdaki örnekte form üzerine yerleştirilen bir button componenti
çevresinde mouse kullanımı örneği bulacaksınız. Kullanıcı, kontrol
tuşuna basılı tutarken mouse buttonu aktif hale geçecektir.
Örnek:
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Button1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Button1MouseUp(Sender: TObject; Button:
TMouseButton; Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
MouseDownSpot : TPoint;
Capturing : bool;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if ssCtrl in Shift then begin
SetCapture(Button1.Handle);
Capturing := true;
MouseDownSpot.X := x;
MouseDownSpot.Y := Y;
end;
end;
procedure TForm1.Button1MouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
if Capturing then begin
Button1.Left := Button1.Left - (MouseDownSpot.x - x);
Button1.Top := Button1.Top - (MouseDownSpot.y - y);
end;
end;
procedure TForm1.Button1MouseUp(Sender: TObject; Button:
TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Capturing then begin
ReleaseCapture;
Capturing := false;
Button1.Left := Button1.Left - (MouseDownSpot.x - x);
Button1.Top := Button1.Top - (MouseDownSpot.y - y);
end;
end;
Yazdığımız uygulamanın Windows NT altında çalışıp çalışmayacağını nasıl söyleyebiliriz ?
Aşağıdaki örnekte, uygulamanızın Windows NT altında mı çalıştığını
anlayabileceksizniz. Bu kodu 16 ve 32 bit ortamda derleyeceksiniz.
Örnek:
{$IFNDEF WIN32}
const WF_WINNT = $4000;
{$ENDIF}
function IsNT : bool;
{$IFDEF WIN32}
var
osv : TOSVERSIONINFO;
{$ENDIF}
begin
result := true;
{$IFDEF WIN32}
GetVersionEx(osv);
if osv.dwPlatformId = VER_PLATFORM_WIN32_NT then exit;
{$ELSE}
if ((GetWinFlags and WF_WINNT) = WF_WINNT ) then exit;
{$ENDIF}
result := false;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if IsNt then
ShowMessage('NT altında Çalışıyor')
else
ShowMessage('NT altında çalışmıyor');
end;
Grid üzerindeki her hücre için farklı hint'leri nasıl kullanabilirim ?
StringGrid componenti üzerinde mouse hareketleri ile ilgili bir
örnek bulacaksınız. Mouse grid üzerinde farklı hücreler üzerinde
hareket ederken, hint penceresinde hücrenin satır ve sütün numarası
görünecektir.
Örnek:
type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
procedure StringGrid1MouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
Col : integer;
Row : integer;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
StringGrid1.Hint := '0 0';
StringGrid1.ShowHint := True;
end;
procedure TForm1.StringGrid1MouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
var
r : integer;
c : integer;
begin
StringGrid1.MouseToCell(X, Y, C, R);
if ((Row <> r) or
(Col <> c)) then begin
Row := r;
Col := c;
Application.CancelHint;
StringGrid1.Hint := IntToStr(r) + #32 + IntToStr(c);
end;
end;
Uygulamam ile bir jpeg resim dosyasını res dosyadan nasıl bağlayabilirim?
Aşağıdaki Örnekte, JPEG image içeren bir resource dosyanın nasıl oluşturulduğunu
ve resource dosyadan JPEG dosyanın nasıl yüklendiğini göreceksiniz. Sonuç JPEG
resmi, bir image bileşeninde gösterilmektedir.
".rc" uzantılı bir text dosya oluşturun. Bu text dosya ismi, uygulama isminden ve
uygulamadaki herhangi bir unit isminden farklı olmalıdır.Bu text dosya aşağıdaki
satırları ihtiva etmelidir.
MYJPEG JPEG C:\Gigasoft\Image\MY.JPG
Where:
"MYJPEG" tercih ettiğiniz resource dosya ismidir.
"JPEG" kullanıcının tanımladığı resource tipidir.
"C:\Gigasoft\Image\MY.JPG" JPEG dosyanın bulunduğu dosya yoludur.
Örneğimiz için dosyamızın ismi "foo.rc" dir.
Şimdi BRCC32.exe (Borland Resource CommandLine Compiler) programını
çalıştırabiliriz. Bu programı Delphi/C++ derleyicilerinin bin directorisinde bulabilirsiniz.
Kullanımı:
C:\DelphiPath\BIN\BRCC32.EXE C:\ProjectPath\FOO.RC
Şimdi, derlediğiniz uzantısı ".res" olan dosyadan sonra ".rc" uzantılı bir dosyaya sahipsiniz
demektir.
Aşağıdaki örnek uygulamanıza bir jpeg dosyayı nasıl yerleştirebileceğinizi göstermektedir.
{Res Dosya Bağlantısı}
{$R FOO.RES}
uses Jpeg;
procedure LoadJPEGFromRes(TheJPEG : string;
ThePicture : TPicture);
var
ResHandle : THandle;
MemHandle : THandle;
MemStream : TMemoryStream;
ResPtr : PByte;
ResSize : Longint;
JPEGImage : TJPEGImage;
begin
ResHandle := FindResource(hInstance, PChar(TheJPEG), 'JPEG');
MemHandle := LoadResource(hInstance, ResHandle);
ResPtr := LockResource(MemHandle);
MemStream := TMemoryStream.Create;
JPEGImage := TJPEGImage.Create;
ResSize := SizeOfResource(hInstance, ResHandle);
MemStream.SetSize(ResSize);
MemStream.Write(ResPtr^, ResSize);
FreeResource(MemHandle);
MemStream.Seek(0, 0);
JPEGImage.LoadFromStream(MemStream);
ThePicture.Assign(JPEGImage);
JPEGImage.Free;
MemStream.Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
LoadJPEGFromRes('MYJPEG', Image1.Picture);
end;
Shift, Alt, veya Ctrl tuşlarına basılıp basılmadığını nasıl anlayabilirim ?
Aşağıdaki örnekte Alt, Ctrl, ve Shift tuşlarının durmlarının kontrolu
incelenmektedir.
Örnek:
function CtrlDown : Boolean;
var
State : TKeyboardState;
begin
GetKeyboardState(State);
Result := ((State[vk_Control] And 128) <> 0);
end;
function ShiftDown : Boolean;
var
State : TKeyboardState;
begin
GetKeyboardState(State);
Result := ((State[vk_Shift] and 128) <> 0);
end;
function AltDown : Boolean;
var
State : TKeyboardState;
begin
GetKeyboardState(State);
Result := ((State[vk_Menu] and 128) <> 0);
end;
procedure TForm1.MenuItem12Click(Sender: TObject);
begin
if ShiftDown then
Form1.Caption := 'Shift' else
Form1.Caption := '';
end;
Standart Uses Unitleri içermeyen Bir Delphi dll dosyası nasıl oluşturabilirim?
İçinde birkaç küçük fonksiyon olan bir dll dosyası oluşturmak isterim. Uses'daki unit seçeneklerini istemiyorum, ama uses'daki bu standart unit seçeneklerini sildiğim zaman Delphi hata vermeye devam ediyor. Eğer bu unitleri silersem çok küçük bir dll dosya oluşturmuş olacağım. Projemi yüklediğim zaman hatayı nasıl giderebilirim?
Cevap:
Bu hatayı elbette giderebilirsiniz. Sadece sizin fonksiyonlarınızdan
oluşan bir dll yaratabilirsiniz. Bunun yolu, ana proje dosyasında,
uses kısmında, kullanılacak unitin belirtilmesidir.
Örnek:
(* Main project file *)
library Project1;
uses
Unit1;
exports
AddLong index 1 name 'ADDLONG' resident;
begin
end.
(* unit1's code *)
unit Unit1;
interface
function AddLong(a : longint;
b : longint) : longint
{$IFDEF Win32} stdcall; {$ELSE} ; export; {$ENDIF}
implementation
function AddLong(a : longint;
b : longint) : longint;
begin
AddLong := a + b;
end;
end.
CD-ROM sürücümde müzik CD'si var mı?
Bunun için Windows API fonksiyou GetDriveType()'ı kullanabilirsiniz.
Ardından, yine Windows API fonksiyonu olan GetVolumeInformation()'ı da
'Audio CD' 'nin müzik cd si olup olmadığını anlamak için kullanabilirsiniz.
Örnek:
function IsAudioCD(Drive : char) : bool;
var
DrivePath : string;
MaximumComponentLength : DWORD;
FileSystemFlags : DWORD;
VolumeName : string;
begin
Result := false;
DrivePath := Drive + ':\';
if GetDriveType(PChar(DrivePath)) <> DRIVE_CDROM then exit;
SetLength(VolumeName, 64);
GetVolumeInformation(PChar(DrivePath),
PChar(VolumeName),
Length(VolumeName),
nil,
MaximumComponentLength,
FileSystemFlags,
nil,
0);
if lStrCmp(PChar(VolumeName),'Audio CD') = 0 then result := true;
end;
function PlayAudioCD(Drive : char) : bool;
var
mp : TMediaPlayer;
begin
result := false;
Application.ProcessMessages;
if not IsAudioCD(Drive) then exit;
mp := TMediaPlayer.Create(nil);
mp.Visible := false;
mp.Parent := Application.MainForm;
mp.Shareable := true;
mp.DeviceType := dtCDAudio;
mp.FileName := Drive + ':';
mp.Shareable := true;
mp.Open;
Application.ProcessMessages;
mp.Play;
Application.ProcessMessages;
mp.Close;
Application.ProcessMessages;
mp.free;
result := true;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if not PlayAudioCD('D') then
ShowMessage('Not an Audio CD');
end;
Uygulamada kullanacağım dosya tipini windows'a nasıl register ederim?
Bu, Dosya uzantılarının nasıl register edildiğini gösteren bir örnektir(.myext).
Bir örnek uygulama (MyApp.Exe), yukarıdaki uzantıyı kullanmaktadır.
Bunu windowsa kayıt edebilmenin yolu, bir kaç satır registry kou yazmaktan
geçmektedir. Aşağıda bununla ilgili bir örneği görmektesiniz.
uses
Registry;
procedure TForm1.Button1Click(Sender: TObject);
var
R : TRegIniFile;
begin
R := TRegIniFile.Create('');
with R do begin
RootKey := HKEY_CLASSES_ROOT;
WriteString('.myext','','MyExt');
WriteString('MyExt','','Some description of MyExt files');
WriteString('MyExt\DefaultIcon','','C:\MyApp.Exe,0');
WriteString('MyExt\Shell','','This_Is_Our_Default_Action');
WriteString('MyExt\Shell\First_Action','','This is our first action');
WriteString('MyExt\Shell\First_Action\command','',
'C:\MyApp.Exe /LotsOfParamaters %1');
WriteString('MyExt\Shell\This_Is_Our_Default_Action','',
'This is our default action');
WriteString('MyExt\Shell\This_Is_Our_Default_Action\command',
'','C:\MyApp.Exe %1');
WriteString('MyExt\Shell\Second_Action','','This is our second action');
WriteString('MyExt\Shell\Second_Action\command',
'','C:\MyApp.Exe /TonsOfParameters %1');
Free;
end;
end;
Oluşturma metodu ile ilgili seçenekli parametre içeren bir form oluşturmak mümkün müdür?
Bunun için, Seçenekli parametrenizi form class'ınızın Create Constructor'una
yerleştirmeniz yeterli olacaktır.
Örnek:
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs;
type
TForm2 = class(TForm)
private
{ Private declarations }
public
constructor CreateWithCaption(aOwner: TComponent;
aCaption: string);
{ Public declarations }
end;
var
Form2: TForm2;
implementation
{$R *.DFM}
constructor TForm2.CreateWithCaption(aOwner: TComponent;
aCaption: string);
begin
Create(aOwner);
Caption := aCaption;
end;
uses Unit2;
procedure TForm1.Button1Click(Sender: TObject);
begin
Unit2.Form2 :=
Unit2.TForm2.CreateWithCaption(Application, 'My Caption');
Unit2.Form2.Show;
end;
Çalışma Esanasında Program İçinden Bileşen Oluşturma...
var
Label1: TLabel ;
ComboBox1:TComboBox;
SpinEdit1:TSpinEdit;
DateTimePicker1:TDateTimePicker;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
Begin
//Label1 Bileşeni Oluşturuldu
Label1 := TLabel.Create(self) ;
With Label1 Do Begin
Parent:=Self;
Left := 5;
Top := 70;
Width := 70;
Height := 13;
Alignment := taRightJustify;
AutoSize := False;
Caption := 'Listeler:';
end;
//ComboBox1 Bileşeni Oluşturuldu
ComboBox1:=TComboBox.Create(self);
With ComboBox1 Do Begin
Parent:=Self;
Left := 85;
Top := 65;
Width := 145;
Height := 21;
ItemHeight := 13;
TabOrder := 3;
Text := 'Liste1';
Items.Clear;
Items.Add('Liste1');
Items.Add('Liste2');
Items.Add('Liste3');;
end;
//DateTimePicker1 Bileşeni Oluşturuldu
DateTimePicker1:=TDateTimePicker.Create(self);
With DateTimePicker1 Do Begin
Parent:=Self;
Left := 85;
Top := 90;
Width := 146;
Height := 21;
CalAlignment := dtaLeft;
Date := 36964.028340625;
Time := 36964.028340625;
DateFormat := dfShort;
DateMode := dmComboBox;
Kind := dtkDate;
ParseInput := False;
TabOrder := 4;
end;
end;
Form üzerindeki bileşenleri resolution oranında büyütme.
//Referans olarak 640*480 alinmıiştır.
procedure AdjustResolution(oForm:TForm);
var
iPercentage:integer;
begin
if Screen.Width > 640 then
begin
iPercentage:=Round(((Screen.Width-640)/640)*100)+100;
oForm.ScaleBy(iPercentage,100);
end;
end;
AdjustResolution(Self);
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;
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ü
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;
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');
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;
C. Print & Printer
Default printer tanımlanmamış bir bilgisayarda bir uygulama çalıştığında karşılaşılan hata kontrolu.
QuickReport, default olarak bir printerin instll edilmesine ihtiyç duyar.
Rapor printer driver bilgileri kullanılarak hazırlanır. Aşağıdaki kaynak kod
default printerin tanımlanıp tanımlanmadığını anlamya yarar.
procedure TForm1.Button1Click(Sender: TObject);
var
Device, Driver, Port : array [0..255] of Char;
Mode : Integer;
begin
Printer.GetPrinter(Device,Driver,Port,Mode);
if Device <> '' then
ShowMessage(Device)
else
ShowMessage('Default printer tanımlanmamış.');
end;
Hehangibir standart delphi kontrolünü print edebilir miyim ?
Hayır. Ancak, isterseniz, QuickReport üzerine bir TQRImage koyup
aşağıdaki kodu uyglayabilirsiniz:
procedure TForm1.Button1Click(Sender: TObject);
var
DC : HDC;
begin
DC := GetDC(Button1.Handle);
BitBlt(QuickReport2.QRImage1.Canvas.Handle,0,0,
Button1.Width,Button1.Height,DC,0,0,SrcCopy);
ReleaseDC(Button1.Handle,DC);
QuickReport2.Preview;
end;
Bir TStringGrid veya TDBGrid içeriğini nasıl yazdırabilirm?
StringGrid'in içeriğini, printers unitini kullanarak aşağıdaki gibi yazdırabilirsiniz.
uses Printers;
procedure PrintStringGrid(AGrid: TStringGrid);
var MaxSizes: array of Integer;
column, row, sx, sy, LeftSpace: Integer;
begin
SetLength(MaxSizes, AGrid.ColCount);
for column := 0 to AGrid.ColCount - 1 do
MaxSizes[column] := 0;
for row := 0 to AGrid.RowCount - 1 do
for column := 0 to AGrid.ColCount - 1 do
if Printer.Canvas.TextWidth(Agrid.Cells[column, row]) > MaxSizes[column] then
MaxSizes[column] := Printer.Canvas.TextWidth(Agrid.Cells[column, row]) + 10;
Printer.BeginDoc;
LeftSpace := 10; // sol bosluk
sx := LeftSpace;
sy := 0;
for row := 0 to AGrid.RowCount - 1 do
begin
for column := 0 to AGrid.ColCount - 1 do
begin
Printer.Canvas.TextOut(sx, sy, AGrid.Cells[column, row]);
sx := sx + MaxSizes[column];
end;
sx := LeftSpace;
sy := sy + Printer.Canvas.TextHeight('A') + 2;
end;
Printer.EndDoc;
end;
TPrinter unitini kullanmadan yazıcıdan nasıl çıktı alabilirim ?
Aşağıdki örnek bir windows API fonksiyonu olan PrintDlg() fonksiyonu ile
printer kullanıını örneklemektedir:
uses CommDlg;
{$IFNDEF WIN32}
const MAX_PATH = 144;
{$ENDIF}
procedure TForm1.Button1Click(Sender: TObject);
var
Pd : TPrintDlg;
DocInfo: TDocInfo;
begin
FillChar(Pd, sizeof(Pd), #0);
Pd.lStructSize := sizeof(Pd);
Pd.hWndOwner := Form1.Handle;
Pd.Flags := PD_RETURNDC;
if PrintDlg(pd) then begin
FillChar(DocInfo, sizeof(DocInfo), #0);
DocInfo.cbSize := SizeOf(DocInfo);
GetMem(DocInfo.lpszDocName, 32);
GetMem(DocInfo.lpszOutput, MAX_PATH);
lStrCpy(DocInfo.lpszDocName, 'My Document');
{Add this line to print to a file }
lStrCpy(DocInfo.lpszOutput, 'C:\Download\Test.doc');
StartDoc(Pd.hDc, DocInfo);
StartPage(Pd.hDc);
TextOut(Pd.hDc, 100, 100, 'Page 1', 6);
EndPage(Pd.hDc);
StartPage(Pd.hDc);
TextOut(Pd.hDc, 100, 100, 'Page 2', 6);
EndPage(Pd.hDc);
EndDoc(Pd.hDc);
FreeMem(DocInfo.lpszDocName, 32);
FreeMem(DocInfo.lpszOutput, MAX_PATH);
end;
end;
GetPrinter() metodu ile TPrinter unitinden printer driverini nasıl getirebilirim ?
Bazı durumlarda bu parametreler boş karakter döndürecektir. Windows.ini dosyasında
tanımlnmış driver ve portu, GetProfileString()Windows API fonksiyonunu ile
getirebilirsiniz.
Örnek:
uses Printers;
{$IFNDEF WIN32}
const MAX_PATH = 144;
{$ENDIF}
procedure TForm1.Button1Click(Sender: TObject);
var
pDevice : pChar;
pDriver : pChar;
pPort : pChar;
hDMode : THandle;
begin
if PrintDialog1.Execute then begin
GetMem(pDevice, cchDeviceName);
GetMem(pDriver, MAX_PATH);
GetMem(pPort, MAX_PATH);
Printer.GetPrinter(pDevice, pDriver, pPort, hDMode);
if lStrLen(pDriver) = 0 then begin
GetProfileString('Devices', pDevice, '', pDriver, MAX_PATH);
pDriver[pos(',', pDriver) - 1] := #0;
end;
if lStrLen(pPort) = 0 then begin
GetProfileString('Devices', pDevice, '', pPort, MAX_PATH);
lStrCpy(pPort, @pPort[lStrLen(pPort)+2]);
end;
Memo1.Lines.Add('Device := ' + StrPas(pDevice));
Memo1.Lines.Add('Driver := ' + StrPas(pDriver));
Memo1.Lines.Add('Port := ' + StrPas(pPort));
FreeMem(pDevice, cchDeviceName);
FreeMem(pDriver, MAX_PATH);
FreeMem(pPort, MAX_PATH);
end;
end;
D. Database
Çalışma esnasında bir lookup alanı nasıl oluşturulur ?
Çalışma anında Lookup alanı ouşturmak için bir kaç yol bulunmaktadır.
Bu alanın üç özelliği (LookUpDataset, LookUpKeyFields ve LookUpResultField)
bir lookup alanı gibi set edilmelidir. Aşağıdaki örnek kod çalışma anında
nasıl lookup alanı yaratıldığını örneklemektedir. Bunun için iki tane
DBDEMOS tablou 'customer.DB' ve 'orders.DB' kullaılmıştır.
Example:
uses
Forms, Classes, Controls, StdCtrls, Db, DBTables, DBCtrls;
type
TForm1 = class(TForm)
Table1: TTable; // DBDemos customer table
Table2: TTable; // DBDemos orders table
Button1: TButton;
DBLookupComboBox1: TDBLookupComboBox;
DataSource1: TDataSource;
Table2CustNo: TFloatField; // CustNo key field object used for Lookup
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
begin
with TStringField.Create(Table2) do begin
FieldName := 'MyLookup';
FieldKind:= fkLookup;
DataSet := Table2;
Name := Dataset.Name + FieldName;
KeyFields:= 'CustNo';
LookUpDataset:= Table1;
LookUpKeyFields:= 'CustNo';
LookUpResultField:= 'Company';
DbLookupCombobox1.DataField:= FieldName;
DataSource1.DataSet:= Dataset;
Table2.FieldDefs.Add(Name, ftString, 20, false);
end;
DbLookupCombobox1.DataSource:= Datasource1;
Table1.Active:= True;
Table2.Active:= True;
end;
end.
Birden fazla column için Lookup metodunu nasıl kullanabilirim ?
procedure TForm1.Button1Click(Sender: TObject);
var
MyResults: Variant;
MyKeyFields, MyKeyValues: String;
MySearchForValue: Integer;
begin
MyKeyFields := 'CustNo';
MySearchForValue := 1351;
MyReturnColumns := 'Company;Addr1';
MyResults := Table1.Lookup(MyKeyFields, MySearchForValue,
MyKeyValues);
if not VarIsNull(MyResults) then
ShowMessage('Company: ' + MyResults[0] + ' Address: ' +
MyResults[1]);
{ With DBDemos data this returns
"Company: Sight Diver Address: 1 Neptune Lane" }
end;
Çalışma esnasında bir DB Table nasıl oluşturulur ?
Bir TTable nesnesi çalışma esnasında oluşturlabilir ve silinebilir. Metod CreateTable metodudur. Aşağıdaki örnekte TDatabase/BDE Aliası kullanılmamıştır ancak arzu ederseniz alias a kulanabilisiniz. Sadece C:\temp. yerine kullanacağınız databae ismini girmelisiniz.
var
Tbl:TTable;
begin
Tbl:=TTable.Create(nil);
try
Tbl.DatabaseName:='C:\temp';
Tbl.TableName:='TEMP';
Tbl.TableType:=ttParadox;
with Tbl do
begin
FieldDefs.Add('id',ftInteger,0,False);
FieldDefs.Add('description',ftString,255,False);
{Primary key.}
IndexDefs.Add('','id',[ixPrimary]);
{Secondary key.}
IndexDefs.Add('sort1','description;id',[ixCaseInsensitive]);
end;
Tbl.CreateTable;
finally
Tbl.Free;
end;
Bir Access database'i nasıl sıkıştırılır?
Function Compactmdb(mdbFileName:String): Boolean;
var db : OLEVariant;
tempFile : String;
begin
result := true;
try
screen.cursor := crSQLWait ;
db := GetDAO_Object ;
result := false;
try
tempFile := ExtractFilePath (mdbFilename) + '\msaTemp.mdb';
db.CompactDataBase(mdbFIleName,tempFile);
DeleteFile(mdbFileName);
RenameFile (tempFile,mdbFileName);
Result := true;
Except on EOLEexception do
Result := false;
end
finally
db := Unassigned ;
screen.cursor := crDefault ;
end;
end;
Çalışma esnasında bir access table (mdb dosya) nasıl oluşturulur ?
Procedure tmsaUtility.CreateMDB(Const mdbFileName: String; mdblocale : String; mdbOptions :Integer);
var db, ws : OleVariant;
begin
try
db := GetDAO_Object ;
ws := db.WorkSpaces[0];
try
if mdbOptions >= 0 then
ws.CreateDataBase(mdbFilename,mdblocale,mdbOptions)
else
ws.CreateDataBase(mdbFilename,mdblocale);
except on EOLEexception do
end;
finally
db := unassigned;
ws := unassigned;
end;
end;
Çalışma esnasında bir access table (mdb dosya) nasıl oluşturulur ?
Procedure tmsaUtility.CreateMDB(Const mdbFileName: String; mdblocale : String; mdbOptions :Integer);
var db, ws : OleVariant;
begin
try
db := GetDAO_Object ;
ws := db.WorkSpaces[0];
try
if mdbOptions >= 0 then
ws.CreateDataBase(mdbFilename,mdblocale,mdbOptions)
else
ws.CreateDataBase(mdbFilename,mdblocale);
except on EOLEexception do
end;
finally
db := unassigned;
ws := unassigned;
end;
end;
Paradox Table da maintained ve case insensitive indexi nasıl oluşturabilirim ?
Paradoc Table da birininci ve ikince alanlara göre a maintained ve case insensitive index oluşturabilriz. İndex ilk alan küçükten büyüğe ikinci aln ise büyükten küçüğe sıralanmıştır.
Procedure fDbiAddIndex6(Tbl: TTable);
var
NewIndex: IDXDesc;
begin
FillChar(yeniIndex, SizeOf(yeniIndex), 0);
if Tbl.Exclusive = False then
raise EDatabaseError.Create
('TTable.Exclusive must be set to true in order to add an index to the table');
NewIndex.szName:= 'yeniIndex2';
NewIndex.iIndexId:= 0;
NewIndex.bPrimary:= FALSE;
NewIndex.bUnique:= FALSE;
NewIndex.bDescending:= TRUE;
NewIndex.bMaintained:= TRUE;
NewIndex.bSubset:= FALSE;
NewIndex.bExpIdx:= FALSE;
NewIndex.iFldsInKey:= 2;
NewIndex.aiKeyFld[0]:= 1;
NewIndex.aiKeyFld[1]:=2;
NewIndex.abDescending[0]:=TRUE;
NewIndex.abDescending[1]:=FALSE;
NewIndex.bCaseInsensitive:= TRUE;
Check(DbiAddIndex(Tbl.dbhandle, Tbl.handle, PChar(Tbl.TableName),
szPARADOX, yeniIndex, nil));
end;
Bir Table'ı tek alana göre sıralayabilir miyim ?
Seçenkler: Case Insensitive, Case Sensitive, Descending, ve Ascending.
Bu örnek kullandığı girdiler:
SortTable(Table1, Table1.FieldByName('SortField'), False, sortDESCEND, L);
procedure SortTable(Table: TTable; Field: TField; CaseInsensitive: boolean;
Order: SORTOrder; var SortNumber: longint);
var
Props: CURProps;
FieldNumber: word;
hDb: hDBIDb;
begin
if Table.Active = False then
raise EDatabaseError.Create('Table açık olmalıdır.');
Check(DbiGetCursorProps(Table.Handle, Props));
if Props.bIndexed = True then
raise EDatabaseError.Create('Table sıralanırken index aktif olamaz');
FieldNumber := Field.Index + 1;
Check(DbiGetObjFromObj(hDBIObj(Table.Handle), objDATABASE, hDBIObj(hDb)));
Table.Close;
try
Check(DbiSortTable(hDb, PChar(Table.TableName), Props.szTableType,
nil, nil, nil, nil, 1, @FieldNumber, @CaseInsensitive, @Order, nil,
False, nil, SortNumber));
finally
Table.Open;
end;
end;
TTable objesi nin Post işlmi esnasında hafızadaki bilgiyi diske yazması.
procedure TForm1.Table1AfterPost(DataSet: TDataSet);
begin
Check(DbiSaveChanges(Table1.Handle));
end;
Paradox veya dBase table ın sıkıştırılması.
Bu örnek Paradox vey dBase table ın sıkıştırılması işlemini örneklemektedir. Bu fonksiyon bütün zamanı eski kalmış indexlerin yeniden düzenlemesini de sağlamaktadır.
Paradox veya dBASE table(Table1)'ı sıkıştır.
Bu fonksiyon çağrılmadan önce table execlusivly olarak açılmış olmalıdır.
procedure PackTable(Table: TTable);
var
Props: CURProps;
hDb: hDBIDb;
TableDesc: CRTblDesc;
begin
if Table.Active = False then
raise EDatabaseError.Create('Sıkıştırmak için Table açılmış olmalıdır.');
if Table.Exclusive = False then
raise EDatabaseError.Create('Sıkıştırmak içn Table exclusively olarak açılmalıdır.');
Check(DbiGetCursorProps(Table.Handle, Props));
if Props.szTableType = szPARADOX then
begin
FillChar(TableDesc, sizeof(TableDesc), 0);
Check(DbiGetObjFromObj(hDBIObj(Table.Handle), objDATABASE, hDBIObj(hDb)));
StrPCopy(TableDesc.szTblName, Table.TableName);
StrPCopy(TableDesc.szTblType, Props.szTableType);
TableDesc.bPack := True;
Table.Close;
Check(DbiDoRestructure(hDb, 1, @TableDesc, nil, nil, nil, FALSE));
end
else
if Props.szTableType = szDBASE then
Check(DbiPackTable(Table.DBHandle, Table.Handle, nil, szDBASE, TRUE))
else
raise EDatabaseError.Create('Sıkıştırmak için Paradox veya dBASE table dan sadece biri olmalıdır.');
Table.Open;
end;
Database'de Arama Yöntemleri...
Query'de SQL kullanarak arama yapmak.
procedure TForm1.Button1Click(Sender: TObject);
begin
Query1.Close;
Query1.Sql.Clear;
Query1.Sql.Add('Select * From Database Where Adi like "'+Edit1.text+'%"');
Query1.Open;
End;
Table'da istenilen alana göre arama yapmak .
procedure TForm1.Button1Click(Sender: TObject);
begin
Table1.Locate('AlanAdi',Edit1.Text,[]);
end;
Table'da Aranan bilgiye en yakın kaydı bulma...
procedure TForm1.Edit1Change(Sender: TObject);
begin
Table1.FindNearst([Edit1.Text]);
end;
Table'da indexli alana göre arama yapmak...
procedure TForm1.Button1Click(Sender: TObject);
begin
Table1.FindKey([Edit1.text]);
end;
Network konfigürasyonunun uygun biçimde ayarlanması
Normalde paradox, dbase gibi veritabanları ilk geliştirildiklerinden itibaren network üzerinden çalışması için planlanmışlardır. Buna rağmen eğer burada anlatacaklarımız konusunda bilginiz yoksa, bu veritabanlarını Delphi ile kullandığınızda programlarınızın network üzerinden çalışmıyor olması hiç de şaşırtıcı olmaz. Bunun sebebi network üzerinden çalışırken, hangi kullanıcının o an ne yaptığı, hangi kayıdı değiştirmekte olduğu gibi konularda network üzerinden çalışan veritabanı uygulamaları arasında koordinasyonu sağlayan "netfile" dosyasının konfigürasyonunu yapmamış olmanızdandır.
Delphi veritabanı uygulamanızı çalıştırdığında bir tek veritabanınız olsa dahi default olarak bir TSession ve TDatabase nesnesi oluşturur. TSession, veritabanının o an kullandığı Database'lerin kontrolünden sorumludur. Bu database'ler bir BDE Alias'ı, hard diskinizde bir dizin olabilir. TDatabase nesnesi işte bu dizin ve aliasların kontrolünden sorumludur. Ama bizim burada kullanacağımız nesne TSession. Default olarak oluşturulan TSession nesnesinin adı Session dır.
Başlangıç olarak programınızı network üzerinde bir yere kurduğunuzu düşünelim. Bütün kullanıcılar herhangi bir makina üzerinden programın exe'si ni çalıştırabilirler. Fakat eğer siz aksini belirtmezseniz daha önce bahsettiğimiz network kontrol dosyası normalde C harddiskinin ana dizininde oluşturulur. Oysa ki network üzerinde veritabanınızı kullanan bütün programların aynı dosyayı kullanması gerekir. Bunun için programınızı kurduğunuz F:\PROGRAM dizini altında NETWORK adlı yeni bir dizin oluşturun ve programınızın ana formunun oncreate olayı içerisinde aşağıdaki gibi network kontrol dosyasının yerini belirtin. Diğer dizin ise kullanıcının harddiskinde geçici dosyalarını koymak için kullanacağı private directory'dir. Bunun kullanıcın kendi harddiski içinde olması hem performansı arttırır, hem de network üzerinde kullanıcılar arasında doğabilecek karışıklığı önler.
procedure TformMain.FormCreate(Sender: TObject);
var
Buf : array[0..256] of char; { windows dizinini almak için }
T : TSearchRec;
begin
Session.NetFileDir := ExtractFilePath(Application.ExeName) + 'network\';
GetTempPath(255, Buf); { windows'un template dizinini öğren }
Session.PrivateDir := Buf; { private dizin olarak onu belirle } Session.Open; { session'umuzu ve ayarlarımızı aktif hale getir }
end;
Eğer aynı makina üzerinde programınızın veya aynı veritabanını kullanan programların aynı anda sorunsuz açılabilmesini istiyorsanız private dizinini windows'un template dizini altında her program için ayrı ayrı oluşturacağınız ve program bitiminde sileceğiniz dizinler olarak belirtmeniz yararlı olabilir.
Bir dataset'in (table,query vb) kayıt numarası nasıl öğrenilir
Bir dataset'in şu anki kayıt numarasını öğrenmek için BDE komutlarını kullanabiliriz. Yalnız bu işlem en azından buradaki örneğimiz için sadece Paradox ve DBase table'ları için geçerli. Aşağıdaki fonksiyon DBase table'larında o anki fiziksel kayıt numarasını verirken, Paradox için Logical (Lojik) kayıt numarasını (yani o anki sıralama (seçili index) ve aralığa (range) göre olan) verir. Diğer veritabanı tipleri içinse 0 gönderir.
uses DbiProcs, DbiTypes, DBConsts;
...
...
function KayitNo(Dataset: TDataset): Longint;
var
CursorProps: CurProps;
RecordProps: RECProps;
begin
{ Eğer Paradox veya DBase değilse 0 döndür }
Result := 0;
with Dataset do
begin
{ Dataset aktif durumda mı? }
if State = dsInactive then DBError(SDataSetClosed);
{ Cursor'ün iSeqNums değişkenini almak için... }
Check(DbiGetCursorProps(Handle, CursorProps));
{ BDE ile Dataset'in Cursor'ünü senkronize et }
UpdateCursorPos;
{ RecordProps'u şu anki kayıt bilgileri ile doldur }
Check(DbiGetRecord(Handle, dbiNOLOCK, nil,
@RecordProps));
{ Şu an ne tip bir dataset üzerinde çalışıyoruz? }
case CursorProps.iSeqNums of
0: Result := RecordProps.iPhyRecNum; { dBASE }
1: Result := RecordProps.iSeqNum; { Paradox }
end;
end;
end.
Veri tabanından Excel 'e Aktarım
Bu işlemi aşağıdaki örnekte görüldüğü gibi Pascal'dan bildiğiniz komutlara benzer bir şekilde yapabilirsiniz.Form üzerine ole serverla bağlantı kurmak için "servers" bilesenlerinden "ExcelApplication" nesnesini eklemeniz gerekir
procedure TForm1.Button1Click(Sender: TObject);
var IRange : Excel97.Range;
i,Row : integer;
begin
if not ExcelApplication1.Visible[0] then //excel açıkmı
begin
excelApplication1.Visible[0]:= True;//açık değilse aç
excelApplication1.Workbooks.Add(NULL,0);//yeni çalışma litabı oluştur
end
else //excel açıksa yeni çalışma sayfası ekle
excelApplication1.Sheets.Add(Null,null,null,null,1);
// Alan Başlıkları
IRange := excelApplication1.ActiveCell;
for i := 0 to Table1.Fields.count-1 do
begin
IRange.Value := Table1.Fields[i].DisplayLabel;
IRange := IRange.Next;
end;
// Kayıt Alanları
Table1.DisableControls;
try
Table1.First;
Row :=2;
while Not Table1.Eof do
begin
IRange := ExcelApplication1.Range['A'+IntToStr(Row),'A'+IntToStr(Row)];
for i := 0 to Table1.Fields.Count-1 do
begin
IRange.Value := Table1.Fields[i].Value;
IRange := IRange.Next;
end;
Table1.Next;
Inc(Row);
end;
finally
Table1.EnableControls;
end;
// Auto format
IRange:= ExcelApplication1.Range['A1','D'+IntToStr(Row-1)];
IRange.AutoFormat(6,Null,Null,Null,Null,Null,Null);
end;
Şifreli bir table için programın şifre istememesi için ne yapmalıyım ?
Table'ın Active özelliğini False yapın ve Form'un OnCreate olayına aşağıdaki kodu ekleyin
Session.AddPassword('şifre');
Table1.Active:=True;
Bir DBGrid’de birden fazla seçtiğim kayıtlara nasıl erişirim?
Eğer grid’in MultiSelect özelliği True yapılmışsa ve grid’den rastgele iki veya daha fazla kayıt seçilmişse seçilen kayıtlara aşağıdaki koda benze bir kod yardımıyla ulaşabilirsiniz.
procedure TForm1.BitBtn1Click(Sender: TObject);
var
Liste: TBookMarkList;
i: integer;
Kayit: TBookMark;
begin
Liste:=DBGrid1.SelectedRows;
for i:=0 to Liste.Count-1 do begin
Kayit:=TBookMark(Liste.Items[i]);
Table1.GotoBookmark(Kayit);
end;
end;
Dbgrid'de (Ctrl-Del diyince) dosya silmesini engelleme
if (ssctrl in shift) and (key=vk_delete) then
begin
key:=0;
end;
DBF de sildiğim kayıtları tekrar nasıl gösterebilirim?
Bilindiği gibi DBF dosyalarda kayıt silme işlemi kaydı doğrudan diskten silmemektedir. Sadece silinmiş işareti konmaktadır. Eğer bunları tamamen silmek istersek dosyanın pack edilmesi gerekir. Bu işlemden önce silinen kayıtlar tekrar getirilebilir.
type
TForm1 = class(TForm)
Table1: TTable;
DataSource1: TDataSource;
DBGrid1: TDBGrid;
DBNavigator1: TDBNavigator;
CheckBox1: TCheckBox;
procedure CheckBox1Click(Sender: TObject);
public
procedure ShowDeleted(Table: TTable; ShowDeleted: Boolean);
end;
var
Form1: TForm1;
implementation
uses DBITYPES, DBIERRS, DBIPROCS;
{$R *.DFM}
procedure TForm1.ShowDeleted(Table: TTable; ShowDeleted: Boolean);
var
rslt: DBIResult;
szErrMsg: DBIMSG;
begin
Table.DisableControls;
try
Check(DbiSetProp(hDBIObj(Table.Handle), curSOFTDELETEON,
LongInt(ShowDeleted)));
finally
Table.EnableControls;
end;
Table.Refresh;
end;
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
ShowDeleted(Table1, CheckBox1.Checked);
end;
end.
TTABLE/TQUERY üzerinde arama teknikleri nelerdir?
TEdit kullanarak, TTable üzerinde arttırmalı arama yapmak için, Tedid bileşeninin OnChange olay yordamına, aşağıdaki kod yazılır.
procedure TForm1.Edit1Change(Sender: TObject);
begin
With Edit1 do
if Text <> '' then
Table1.FindNearest([Text]);
end;
Bu türlü bir arama Tquerry üzerinde yapılacaksa;
procedure TForm1.Edit1Change(Sender: TObject);
begin
With Edit1 do
if Text <> '' then begin
Query1.Filter := 'code = '''+Edit1.Text+'''';
Query1.FindFirst;
end;
end;
veya ,
procedure TForm1.Edit1Change(Sender: TObject);
begin
With Edit1 do
if Text <> '' then Query1.Locate('code',Edit1.Text,[loPartialKey]);
end;
DBMemo içeriğinin başka bir DBMemo bileşenine naıl aktarırım?
DBMemo2.Lines:=DBMemo1.Lines.Assign;
TDBNavigator bileşeni, kod içerisinden nasıl kontrol edilir?
procedure TForm1.DBNavigator1Click(Sender: TObject; Button:
TNavigateBtn);
var
BtnName: string;
begin
case Button of
nbFirst : BtnName := 'nbFirst';
nbPrior : BtnName := 'nbPrior';
nbNext : BtnName := 'nbNext';
nbLast : BtnName := 'nbLast';
nbInsert : BtnName := 'nbInsert';
nbDelete : BtnName := 'nbDelete';
nbEdit : BtnName := 'nbEdit';
nbPost : BtnName := 'nbPost';
nbCancel : BtnName := 'nbCancel';
nbRefresh: BtnName := 'nbRefresh';
end;
MessageDlg(BtnName + ' butonu clicklendi.', mtInformation, [mbOK], 0);
end;
Bir PARADOX Tabloya ikincil indexi Çalışma anında nasıl eklerim?
Table1.AddIndex('<indeks adı>', 'CustNo;CustName',
[ixDescending]);
DBGrid kolonları üzerinde dolaşma
dbgrid1.selectedindex:=dbgrid1.selectedindex+1;
dbgrid1.setfocus;
Master-Detail Bir Tablodan nasıl kayıt silebilirim?
Master-Detay ilişki içerisindeki tablolarda, detayı olan bir ana kayıt silindiğinde, detaylar ortada kalır. Ana kayıt olmadığına göre detaylara da ihtiyaç yoktur. Bu nedenle ana kayıt silinmeden önce detayları silmek gerekir. Table1 ana tabloya, Table2 de Detay tabloya bağlı kabul edilirse, Table1' den bir kayıt silinmek istendiğinde önce Table2' deki detaylar temizlenecektir aşağıdaki örnek bunu göstermektedir.
procedure TForm1.Table1BeforeDelete(DataSet: TDataset)
begin
with Table2 do begin
DisableControls;
First;
While not EOF do
Delete;
EnableControls;
end;
end;
E. Internet ve Multimedia
Avi dosyasının görünüm alanını seçilen panele eşitleme
Begin
with MediaPlayer1 do begin
DeviceType := dtAutoSelect;
visible := false;
FileName := InputBox('AVI', 'Enter AVI file name', 'c:\windows\borland.avi');
display := panel1;
open;
DisplayRect := rect(0, 0, panel1.width, panel1.height); {This is it!}
rewind;
play;
end;
end;
Cd sürücüsünün seri numarası
function GetDiskVolSerialID( cDriveName : char ) : DWord;
var dwTemp1, dwTemp2 : DWord;
begin
GetVolumeInformation( PChar( cDriveName + ':\' ), Nil, 0, @Result, dwTemp2, dwTemp2, Nil, 0 );
end;
MessageDlg( 'Serial number: ' + Format( '%X', [ GetDiskVolSerialID( 'E' ) ] ),
mtInformation, [mbOk], 0 );
İnternete bağlı olup olmadığınızı anlamak
Forma bir tane tcp componenti ve bir tane buton yerleştirdikten sonra buttonun onclick olayına aşağıdaki kod yazılır.
if TCP1.LocalIp = '0.0.0.0' then ShowMessage('Internete bağlı değilsiniz!')
else ShowMessage('Internete bağlısınız!');
Bir html sayfayı printerden çıkarmak için ne yapmalıyım?
uses Printers;
var
EskCur: TCursor;
Begin
EskCur := Screen.Cursor;
with Printer do begin
BeginDoc;
HTML1.AutoPrint(handle);
Title := HTML1.URL;
EndDoc;
end;
Screen.Cursor := EskCur;
end;
Bir resim dosyası açıp içine çizim yapmak?
var
Resim: TBitmap;
Resim := TBitmap.Create;
with Resim do
try
Width := 100;
Height := 100;
with Canvas do
begin
Rectangle(0, 0, 100, 100);
MoveTo(0, 0);
LineTo(100, 100);
MoveTo(0, 100);
LineTo(100, 0);
end;
SaveToFile('test.bmp')
finally
Free;
end;
Desktop ya da aktif formu nasıl capture yapabiliriz?
Bir tane image componenti eklemek zorundasınız.
procedure TForm1.FormCreate(Sender: TObject);
var
DCDesk: HDC;
Begin
DCDesk:=GetWindowDC(GetDesktopWindow);
BitBlt(Image1.Canvas.Handle, 0, 0, Screen.Width, Screen.Height,DCDesk, 0, 0,SRCCOPY);
ReleaseDC(GetDesktopWindow, DCDesk);
end;
Windows ekranına çizim yapmak mümkün müdür?
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;
Speakerdan Beep sesi çıkartmak
MessageBeep(word(-1));
Programımdan bir web sayfasını nasıl açabilirim?
uses kısmına Shellapi unitini eklemelisiniz.
ShellExecute(Handle,
'open',
'Linki görüntüleyebilmek için <a href="%2$s"><strong>Üye</strong></a> olmanız gerekiyor.',
nil,
nil,
sw_ShowMaximized);
Form'un arka kısmına bir resmi döşemek nasıl yapılır?
Bitmap: TBitmap;
procedure TForm1.FormCreate(Sender: TObject);
begin
Bitmap := TBitmap.Create;
Bitmap.LoadFromFile('C:\WINDOWS\cars.BMP');
end;
procedure TForm1.FormPaint(Sender: TObject);
var
X, Y, W, H: LongInt;
begin
with Bitmap do begin
W := Width;
H := Height;
end;
Y := 0;
while Y < Height do begin
X := 0;
while X < Width do begin
Canvas.Draw(X, Y, Bitmap);
Inc(X, W);
end;
Inc(Y, H);
end;
end;
Programa E-mail linki eklemek nasıl olabilir?
procedure email;
var
x: string;
Begin
x:='mailto:'+FEmailTo+'?Subject='+FEmailSubject+'&cc='+FEmailCC;
ShellExecute(0, nil, PChar(x), nil, nil, SW_SHOWDEFAULT);
end
Eline sağlık ..
Şu delphi yi hala öğrenemedim.. En güzel yanı .(nokta) koyunca herşeyin çıkması :D
Bu özelliği gerçekten harika ama insan bilmeyince pek bişey yapamıyor yinede deneme yanılma yöntemide bayağı uzun sürüyor .. :)
;) umarım bilgiler yardımcı olmuştur. gerekirse resimli anlatım da yapabilirim.
PcTeknikZone