Üye Girişi

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

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

 Başlığı Yazdır
Delphi DLL Uygulaması
MuhBim
#1 Mesajı Yazdır
Mesaj Tarihi 31-03-2010 18:42
Süper Yönetici

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

Delphi de nasıl DLL yapar ?
Delphi bir yazıyı derlemeden önce ilk satırı olan,
Program Project1;
Library Project1;
Unit Project1;
Gibi satırlara bakarak ona göre derleme yapar, zeki olanlar hemen anladılar tabii. Evet Bir DLL yapmak için
1-) Delphi’yi açalım, her zamanki gibi New Application diyelim bize Form ve Üzerinde Unit Unit1; yazılı kod penceremiz gelecektir. View ve Project Source dediğimizde bize Unit1 den başka ile düzey yazılarımızda da kullandığımz Proje kodları gelir. Burada
program Project1; ve diğer kodlaro göreceksiniz. program Project1; yazısının yerine Library Project1; yazarsanız ve Derlerseniz programınızın Exe değil DLL uzantısı ile derlendiğini göreceksiniz. İşte bir DLL yaptınız.
2-) Delphi’yi açalım sadece New diyelim, karşımıza Yeni oluşturabileceğimiz bir çok şey çıkacaktır biz şimdilik bunlardan DLL ile ilgilendiğimiz için DLL’i seçin (soldan 4.cü). Proje kod ekranı karşımıza çıkıyor save as deyip kaydedelim ve yine bir DLL oluşturdunuz.
Şimdi, oluşturduğumuz DLL ler hiçbir şey yapmıyor sadece oluşturmayı öğrendik. DLL’in içine ne yazarız ne yapabiliriz buna bakalım.
Baştan başlayalım, Delphi deyiz, New, ve oradan DLL yi seçelim. Kod pencersindeyiz.

library Project1;
uses
SysUtils,
Classes;
begin
end.
Yazıyor.
library Project1;
uses
SysUtils,
Classes;
function trscene:integer;export;
begin
result:=9;

KODLAR

Dosya Kopyalama (1)

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;

DOSYA KOPYALAMA 2

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); { Record size = 1 }
AssignFile(ToF, ToFile); { Open output file }
Rewrite(ToF, 1); { Record size = 1 }
repeat
BlockRead(FromF, Buf, SizeOf(Buf), NumRead);
BlockWrite(ToF, Buf, NumRead, NumWritten);
until (NumRead = 0) or (NumWritten <> NumRead);
CloseFile(FromF);
CloseFile(ToF);
end;

Dosya Kopyalama (3)

procedure CopyFile(FromFileName, ToFileName: string);
var
FromFile, ToFile: File;
begin
AssignFile(FromFile, FromFileName); { Assign FromFile to FromFileName }
AssignFile(ToFile, ToFileName); { Assign ToFile to ToFileName }
Reset(FromFile); { Open file for input }
try
Rewrite(ToFile); { Create file for output }
try
if LZCopy(TFileRec(FromFile).Handle, TFileRec(ToFile).Handle) < 0
then
raise EInOutError.Create('Error using LZCopy'Wink
finally
CloseFile(ToFile); { Close ToFile }
end;
finally
CloseFile(FromFile); { Close FromFile }
end;
end;

Directory Adı değiştirme

SysUtils unitesinin içindeki RenameFile function bu işi görmektedir.

Treeview componentinin durumunu kaydetme ve gösterme
Kaydetmek için

TreeView.SaveToFile('Dosya.adı'Wink;
Dosyayı açmak için
TreeView.LoadFromFile('Dosya.adı'Wink;
Dosyayı yanlızca okumak (read only) şeklinde açma
AssignFile(F, Dosya);
FileMode := 0; (read only modunda açmak}
Reset(F);
CloseFile(F);

Açılan dosyanın tarih ve zamanını ayarlamak

var
f: file;
begin
Assign(f, DirInfo.Name);
Reset(f);
SetFTime(f, Time);
Close(f);
end;
Deltree
{$I-} {$I+}
procedure delTree (DirName: string);
var
FileSearch: SearchRec;
begin
chDir (DirName);
FindFirst ('*.*', Directory, FileSearch);
while (DosError = 0) do begin
if (FileSearch.name <> '.'Wink AND (FileSearch.name <> '..'Wink AND
( (FileSearch.attr AND Directory) <> 0)
then begin
if DirName[length(DirName)] = '\' then
delTree (DirName+FileSearch.Name)
else
delTree (DirName+'\'+FileSearch.Name);
ChDir (DirName);
end;
FindNext (FileSearch)
end;

FindFirst ('*.*', AnyFile, FileSearch);
while (DosError = 0) do begin
if (FileSearch.name <> '.'Wink AND (FileSearch.name <> '..'Wink then
Remove (workdir);
end;
FindNext (FileSearch)
end;
rmDir (DirName)
end;

Dbgrid'de (Ctrl-Del diyince) dosya silmesini engelleme

if (ssctrl in shift) and (key=vk_delete) then
begin
key:=0;
end;

String'i renk'e renk'i stringe çevirme

Uses graphics;
form1.Color:=stringtocolor('121'Wink;
label1.caption:= ColorToString(form1.color);

Mouse'un yerini değiştirmek

randomize;
SetCursorPos(random(100),random(100));
ComboBox'ın aşağıya listelemesinin farklı bir yolu (DropComboBox)
SendMessage(ComboBox1.handle , 1039, 1, 0);

Başlığı Gizlemek ve Göstermek

Procedure HideTitlebar;
Var
Save : LongInt;
Begin
If form1.BorderStyle=bsNone then Exit;
Save:=GetWindowLong(form1.Handle,gwl_Style);
If (Save and ws_Caption)=ws_Caption then Begin
Case form1.BorderStyle of
bsSingle,
bsSizeable : SetWindowLong(form1.Handle,gwl_Style,Save and
(Not(ws_Caption)) or ws_border);
bsDialog : SetWindowLong(form1.Handle,gwl_Style,Save and
(Not(ws_Caption)) or ds_modalframe or ws_dlgframe);
End;
form1.Height:=form1.Height-getSystemMetrics(sm_cyCaption);
form1.Refresh;
End;
end;
Procedure ShowTitlebar;
Var
Save : LongInt;
begin
If form1.BorderStyle=bsNone then Exit;
Save:=GetWindowLong(form1.Handle,gwl_Style);
If (Save and ws_Caption)<>ws_Caption then Begin
Case form1.BorderStyle of
bsSingle,
cLabel1.Caption := 'Control'
else
if HiWord(GetKeyState(VK_MENU)) <> 0 then
Label1.Caption := 'Alt'
else
Label1.Caption := 'None';
end;

Formu taskbardan gizleme

ShowWindow(Application.Handle, SW_HIDE);

Silinmiş Dosyaları gösterme (DBF);

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.

Form hakkında kısa bilgi

Form1.Show; {Formu göster}
Form1.Showmodal { Formu showmodal olarak göster (Showmodal iken başka hiçbir forma ulaşılamaz) }
myForm.Hide; {Formu gizle }
myForm.Free; {Formu sil }

Formu şeffaf hale getirilmesi

OnCreate olayına Brush.Style:=bsClear; yazmanız yeterli.
ESC tuşuyla programdan çıkma
OnKeyPress olayına if Key = #27 then halt; yazın.

Bir Resim Dosyası Açıp İçine Çizim Yapma

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'Wink
finally
Free;
end;
Asla Yazı Kutusundan Çıkamazsın
procedure TForm1.Edit1Exit(Sender: TObject);
begin
showmessage('Asla yazı kutusundan çıkamassın'Wink;
postmessage(handle,WM_NEXTDLGCTL,0,0);
postmessage(handle,WM_NEXTDLGCTL,1,0);
end;

Formun Boyutlarını Sabitleme

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
TForm1 = class(TForm)
private
{ Private declarations }
public
procedure WMGetMinMaxInfo( var Message :TWMGetMinMaxInfo ); message WM_GETMINMAXINFO;
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.WMGetMinMaxInfo( var Message :TWMGetMinMaxInfo );
begin
with Message.MinMaxInfo^ do
begin
ptMaxSize.X := 200;
ptMaxSize.Y := 200;
ptMaxPosition.X := 99;
ptMaxPosition.Y := 99;
ptMinTrackSize.X := 100;
ptMinTrackSize.Y := 100;
ptMaxTrackSize.X := 300;
ptMaxTrackSize.Y := 300;
end;
Message.Result := 0;
inherited;
end;

end.

Windows'a True Type Font Ekleme

uses Registry;
procedure TForm1.Button1Click(Sender: TObject);
var
reg: TRegistry;
b : bool;
begin CopyFile('C:\DOWNLOAD\FP000100.TTF', 'C:\WINDOWS\FONTS\FP000100.TTF', Cool;
reg := TRegistry.Create; reg.RootKey := HKEY_LOCAL_MACHINE;
reg.LazyWrite := false; reg.OpenKey('Software\Microsoft\Windows\CurrentVer sion\Fonts', false); reg.WriteString('TESTMICR (TrueType)','FP000100.TTF'Wink;
reg.CloseKey; reg.free;
AddFontResource('c:\windows\fonts\FP000100.TTF'Wink; SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
RemoveFontResource('c:\windows\fonts\FP000100.TTF' ); SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
end;

Dosya Taşıma

MoveFile('C:\Source\sourcefile.txt', 'C:\Dest\destfile.txt'Wink;

Trim Fonksiyonunun açılımı

unit StrFunc;
interface
procedure LTrim(var s : string);
procedure RTrim(var s : string)
;procedure Trim(var s : string);
implementation
{$R *.DFM}
procedure LTrim(var s : string);
begin
while ((length(s) > 0) and (s[1] = #32)) do Delete(s, 1, 1);
end;
procedure RTrim(var s : string);
begin
while ((length(s) > 0) and (s[Length(s)] = #32)) do Delete(s, Length(s), 1);
end;
procedure Trim(var s : string);
begin
LTrim(s); RTrim(s);
end;

Screen Capture Programı (Ekran Çalma)
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;

Sağa yada Sola hizalama function'u

function hiza(sagsol,yer:string;sayi:integer):string;
var
i,bosluk,uzunluk:integer;
begin
trim(yer); //Boşlukları temizle
uzunluk:=length(yer); //Verilen stringin uzunluğunu öğren
bosluk:=sayi-uzunluk; //Verilen sayıdan uzunluğu çıkar
if sagsol='sag' then begin //Sağamı solamı yaslancağını öğren
for i:=1 to bosluk do begin //Fark kadar sağa boşluk ekle
yer:=' '+yer; //Boşluk 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;

Sayıyı virgüllü yazma functionu
Bunun için forma birtana label componenti yerleştirin ve visible özeliğini false yapın.

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 değerindeki bir sayıyı string yapma

function Comp2Str(N: Comp): String;
var
TS: String;
begin
Str(N:0:0, TS);Comp2Str := TS;
end;

Dosya açılış yolları

Windows programının açılışı
WinExec('C:\WINDOWS\NOTEPAD.EXE', SW_SHOWNORMAL);

Komut satırı 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 programının komutla açılışı
WinExec('COMMAND.COM /C DIR *.*', SW_SHOWNORMAL);

Dekstop'ı refresh etmek

procedure TForm1.Button1Click(Sender: TObject);
begin
SendMessage(FindWindow('Progman', 'Program Manager'Wink, WM_COMMAND,$A065, 0);
end;

Programın windows'la birlikte açılması

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 çubuğunu 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'ın handle sayısı
hTaskbar := FindWindow('Shell_TrayWnd', Nil );
 
http://www.programyukle.org
Atlanilacak Forum:

En Çok İndirilenlerYeni Eklenenler

image Outlook Express 6.0 [14847]  
image SPSS 15.0 [13018]  
image Msn Dondurucu ( Msn F... [12778]  
image GTA Mod Installer v2.2... [9520]  
image Cep Okey [9441]  
image Eşli Batak 2.0.0.8 [8455]  
image Cepte Televizyon v1.5 [7052]  
image Nokia N70 İçin Full Pr... [6137]  
image Championship Manager 0... [4233]  
image Ders dağıtım programı ... [3933]  
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 - 2017 by Nick Jones.
Released as free software without warranties under GNU Affero GPL v3.
Sayfa oluşturulma süresi: 0.10 saniye | 44,097,115 Tekil Ziyaretçi | jQ Blog