Tüm Platformlar için Hızlı Uygulama Geliştirme Kitabı... Delphi
Ön Sipariş Talebinde Bulunan Üyelerimiz
Sipariş Talebinde Bulunan Üyelerimiz

Konuyu Paylaş : facebook gplus twitter

Konuyu Oyla:
  • Derecelendirme: 0/5 - 0 oy
  • 1
  • 2
  • 3
  • 4
  • 5
Lazarus Hazır Fonksiyonlar
#1
Merhaba
Lazarus İle İlgilenen arkadaşların işine yarıyacağına inanıyorum. 23 adet hazır Function and Procedure
unit AllLibrary;

{$mode objfpc}{$H+}

interface

uses
 Classes, SysUtils,StrUtils,Windows,CheckLst;

{$REGION 'METİNSEL İŞLEMLER'}
procedure Prg_Split(Delimiter: Char; Str: string; ListOfStrings: TStrings);
// Delimetere göre parçalar verilen liste döndürür
function  Fn_Replace(Metin, Eski, Yeni: string): string;
// Stringreplace yapar içindekilerin hepsini değiştirir.
function  Fn_TrKarakterVarMi(Metin: String): Boolean;
// Verilen metin içinde tr karakter varsa true döner
function  Fn_TrKarakterBoslukVarMi(Metin: String): Boolean;
// Verilen metin içinde tr karakter veya boşluk varsa true döner
function  Fn_StringBirlestir(Metin1, Metin2: String; Ayrac: String = ''): String;
// Verilen 2 stringi ayraca göre birleştirir döndürür
function  Fn_XeKADAR(Metin, Aranan: String): String;
// Verilen metinden aranana kadarını koparır
function  Fn_XdenSonra(Metin, Aranan: String): String;
// Verilen metinden aranandan sonrasını koparır
function  Fn_HepsiBuyuk(Metin: String): String;
// Metni Trye uygun büyük yapar
function  Fn_HepsiKucuk(Metin: String): String;
// Metni Trye uygun küçük yapar
function  Fn_NumericMi(Metin: String): Boolean;
// Metin içinde karakter 0..9 arasında ise true döner
function  Fn_BasamakAyir(Sayi: Integer): TStringList;
// Sayiyi Basamaklarına Ayırır
function  Fn_StrToChar(Metin: String): Char;
// Stringi Chara Çevirir
{$ENDREGION}
{$REGION 'SİSTEM'}
function Fn_DecimalSep: String;
// Sistem ondalık ayracını verir
function Fn_ThousandSep: String;
// Sistem binlik ayracını verir
function Fn_ComputerName: String;
// Bilgisayar adını verir
{$ENDREGION}
{$REGION 'DOSYA-KLASÖR'}
function  Fn_TumDosyaListele(KlasorAdi: String; const Liste: TStrings;const Kriter: String = '*.*'): Integer;
// Klasör altındaki klasörleride gezer tüm dosyaları listeler
function  Fn_DosyaListele(KlasorAdi: String; const Liste: TStrings;const Kriter: String = '*.*'): Integer;
// Klasör altındaki dosyaları listeler
procedure Prg_KlasorleriListele(LS: TStrings; StartDir: string);
// Verilen yoldaki tüm klasörleri listeler
{$ENDREGION}
{$REGION 'DİĞER'}
function  Fn_Sirala(List: TStrings; BaslangicIndex: Integer; BitisIndex: Integer):String;
// Listeyi sıralar geri gönderir algoritma,istenilen aralıkta sıralanabilir
procedure Prg_SiralaDizi(var A: array of Integer;BaslangicIndex, BitisIndex: Integer);
// Diziyi sıralar geri gönderir algoritma,istenilen aralıkta sıralanabilir
procedure CheckTumunuSec(Chk: TCheckListBox);
// CheckListBox Tümünü seçer
procedure CheckTemizle(Chk: TCheckListBox);
// CheckListBox Tümünü temizler
{$ENDREGION}

implementation

procedure Prg_Split(Delimiter: Char; Str: string; ListOfStrings: TStrings);
begin
 ListOfStrings.Clear;
 ListOfStrings.Delimiter       := Delimiter;
 ListOfStrings.StrictDelimiter := True;
 ListOfStrings.DelimitedText   := Str;
end;

function Fn_Replace(Metin, Eski, Yeni: string): string;
begin
 Result := AnsiReplaceStr(Trim(Metin), Eski, Yeni);
end;

function Fn_TrKarakterVarMi(Metin: String): Boolean;
const
 dizi: array [0 .. 11] of String = ('ç', 'Ç', 'ğ', 'Ğ', 'İ', 'ı', 'Ö', 'ö', 'Ş','ş', 'Ü', 'ü');
var
 i, sayac: integer;
begin
 sayac := 0;
 for i := Low(dizi) to High(dizi) do
 begin
   If AnsiPos(dizi[i], Metin) <> 0 then
      sayac := Succ(sayac);
 end;
 Result := sayac > 0;
end;

function Fn_TrKarakterBoslukVarMi(Metin: String): Boolean;
const
 dizi: array [0 .. 12] of String = ('ç', 'Ç', 'ğ', 'Ğ', 'İ', 'ı', 'Ö', 'ö', 'Ş','ş', 'Ü', 'ü', ' ');
var
 i, sayac: integer;
begin
 sayac := 0;
 for i := Low(dizi) to High(dizi) do
 begin
   If AnsiPos(dizi[i], Metin) <> 0 then
      sayac := Succ(sayac);
 end;
 Result := sayac > 0;
end;

function Fn_StringBirlestir(Metin1, Metin2: String; Ayrac: String): String;
begin
 Result := Metin1 + Ayrac + Metin2;
end;

function Fn_XeKADAR(Metin, Aranan: String): String;
begin
 if AnsiPos(Aranan, Metin) = 0 then
   Result := Metin
 else
   Result := LeftStr(Metin, AnsiPos(Aranan, Metin) - 1);
end;

function Fn_XdenSonra(Metin, Aranan: String): String;
begin
 if AnsiPos(Aranan, Metin) = 0 then
   Result := Metin
 else
   Result := MidStr(Metin, AnsiPos(Aranan, Metin) + 1, length(Metin));
end;

function Fn_HepsiBuyuk(Metin: String): String;
var
  i:integer;
const
  dizi :  array [0 .. 6] of String = ('ç','ğ','ı','ö','ş','ü','i');
  dizi2:  array [0 .. 6] of String = ('Ç','Ğ','I','Ö','Ş','Ü','İ');
begin
  for i := low(dizi) to high(dizi) do
  begin
    if AnsiPos(dizi[i],Metin)<>0 then
      Metin := Fn_Replace(Metin,dizi[i],dizi2[i]);
  end;
  Result := AnsiUpperCase(Metin);
end;

function Fn_HepsiKucuk(Metin: String): String;
var
  i:integer;
const
  dizi  :  array [0 .. 6] of String = ('Ç','Ğ','I','Ö','Ş','Ü','İ');
  dizi2 :  array [0 .. 6] of String = ('ç','ğ','ı','ö','ş','ü','i');
begin
  for i := low(dizi) to high(dizi) do
  begin
    if AnsiPos(dizi[i],Metin)<>0 then
      Metin := Fn_Replace(Metin,dizi[i],dizi2[i]);
  end;
  Result := AnsiLowerCase(Metin);
end;

function Fn_NumericMi(Metin: String): Boolean;
begin
 try
   StrToInt(Metin);
   Result := True;
 except
   Result := False;
 end;
end;

function Fn_BasamakAyir(Sayi: Integer): TStringList;
var
 List, List2: TStringList;
 xTemp, I: Integer;
begin
 List  := TStringList.Create;
 List2 := TStringList.Create;
 try
   xTemp := Sayi;
   while xTemp > 0 do
   begin
     List.Add(IntToStr(xTemp mod 10));
     xTemp := xTemp div 10;
   end;
   for I := List.Count - 1 downto 0 do
     List2.Add(List[I]);
 finally
   List.Free;
 end;
 Result := List2;
end;

function Fn_StrToChar(Metin: String): Char;
begin
 Result := Metin[Low(Metin)];
end;

function Fn_DecimalSep: String;
begin
 Result := FormatSettings.DecimalSeparator;
end;

function Fn_ThousandSep: String;
begin
 Result := FormatSettings.ThousandSeparator;
end;

function Fn_ComputerName: String;
var
 ComputerName: Array [0 .. 256] of Char;
 Size: DWORD;
begin
 Size := 256;
 GetComputerName(ComputerName, Size);
 Result := ComputerName;
end;

function Fn_Sirala(List: TStrings; BaslangicIndex: Integer; BitisIndex: Integer
 ): String;
var
 Lo, Hi, Pivot, T: Integer;
begin
 Result := '';
 Lo := BaslangicIndex;
 Hi := BitisIndex;
 Pivot := strtoint(List[(Lo + Hi) div 2]);
 repeat
   while strtoint(List[Lo]) < Pivot do
     Inc(Lo);
   while strtoint(List[Hi]) > Pivot do
     Dec(Hi);
   if Lo <= Hi then
   begin
     T := strtoint(List[Lo]);
     List[Lo] := List[Hi];
     List[Hi] := inttostr(T);
     Inc(Lo);
     Dec(Hi);
   end;
 until Lo > Hi;
 if Hi > BaslangicIndex then
   Fn_Sirala(List, BaslangicIndex, Hi);
 if Lo < BitisIndex then
   Fn_Sirala(List, Lo, BitisIndex);
end;

procedure Prg_SiralaDizi(var A: array of Integer; BaslangicIndex,
 BitisIndex: Integer);
var
 Lo, Hi, Pivot, T: Integer;
begin
 Lo := BaslangicIndex;
 Hi := BitisIndex;
 Pivot := A[(Lo + Hi) div 2];
 repeat
   while A[Lo] < Pivot do
     Inc(Lo);
   while A[Hi] > Pivot do
     Dec(Hi);
   if Lo <= Hi then
   begin
     T := A[Lo];
     A[Lo] := A[Hi];
     A[Hi] := T;
     Inc(Lo);
     Dec(Hi);
   end;
 until Lo > Hi;
 if Hi > BaslangicIndex then
   Prg_SiralaDizi(A, BaslangicIndex, Hi);
 if Lo < BitisIndex then
   Prg_SiralaDizi(A, Lo, BitisIndex);
end;

procedure CheckTumunuSec(Chk: TCheckListBox);
var
 i: Integer;
begin
 for i := 0 to Chk.Items.Count - 1 do
   Chk.Checked[i] := True;
end;

procedure CheckTemizle(Chk: TCheckListBox);
var
 i: Integer;
begin
 for i := 0 to Chk.Items.Count - 1 do
   Chk.Checked[i] := False;
end;

function Fn_TumDosyaListele(KlasorAdi: String; const Liste: TStrings;const Kriter: String): Integer;
 procedure DosyaTara(const Yol: String);
 var
   Ara: TSearchRec;
 begin
   if FindFirst(Yol + Kriter, faAnyFile, Ara) = 0 then
     repeat
       if Ara.Attr and faDirectory = 0 then
         Liste.Add(Yol + Ara.Name);
     until FindNext(Ara) <> 0;
   SysUtils.FindClose(Ara);
   if FindFirst(Yol + '*.*', faDirectory, Ara) = 0 then
     repeat // daha alt klasörleri tara
       if (Ara.Name <> '.') and (Ara.Name <> '..') and
         (Ara.Attr and faDirectory = faDirectory) then
         DosyaTara(Yol + Ara.Name + '\');
     until FindNext(Ara) <> 0;
   SysUtils.FindClose(Ara);
 end;
begin
Liste.Clear;
if (KlasorAdi <> '') and (KlasorAdi[length(KlasorAdi)] <> '\') then
 KlasorAdi := KlasorAdi + '\';
DosyaTara(KlasorAdi);
Result := Liste.Count;
end;

function Fn_DosyaListele(KlasorAdi: String; const Liste: TStrings;const Kriter: String): Integer;
 procedure DosyaTara(const Yol: String);
 var
   Ara: TSearchRec;
 begin
   if FindFirst(Yol + Kriter, faAnyFile, Ara) = 0 then
     repeat
       if Ara.Attr and faDirectory = 0 then
         Liste.Add(Yol + Ara.Name);
     until FindNext(Ara) <> 0;
   SysUtils.FindClose(Ara);
 end;
begin
 Liste.Clear;
 if (KlasorAdi <> '') and (KlasorAdi[length(KlasorAdi)] <> '\') then
   KlasorAdi := KlasorAdi + '\';
 DosyaTara(KlasorAdi);
 Result := Liste.Count;
end;

procedure Prg_KlasorleriListele(LS: TStrings; StartDir: string);
var
 SR: TSearchRec;
 IsFound: Boolean;
begin
 LS.Clear;
 if StartDir[length(StartDir)] <> '\' then
   StartDir := StartDir + '\';
 IsFound := FindFirst(StartDir + '*.*', faDirectory, SR) = 0;
 while IsFound do
 begin
   if ((SR.Attr and faDirectory) <> 0) and (SR.Name[1] <> '.') then
     LS.Add(SR.Name);
   IsFound := FindNext(SR) = 0;
 end;
 SysUtils.FindClose(SR);
end;

end.
Yalnızım ama bir kente yürüyen ordu gibiyim, edebiyattan kaçınmalıyım..
Cevapla
#2
Güzel bir kitaplık wline sağlık
Topluluk mopluluk yok :/
Cevapla
#3
Thumbs Up 
(11-03-2018, Saat: 15:28)boreas Adlı Kullanıcıdan Alıntı: Linkleri Görebilmeniz İçin Giriş yap veya Üye OlGüzel bir kitaplık wline sağlık

Smile
Yalnızım ama bir kente yürüyen ordu gibiyim, edebiyattan kaçınmalıyım..
Cevapla

Konuyu Paylaş : facebook gplus twitter



Konu ile Alakalı Benzer Konular
Konular Yazar Yorumlar Okunma Son Yorum
  Lazarus nedir? Fesih ARSLAN 7 2.808 23-10-2018, Saat: 16:33
Son Yorum: engerex
  Lazarus SIGSEGV hatası (Çözüldü / Dolaylı olarak) uparlayan 13 1.483 27-09-2017, Saat: 13:54
Son Yorum: Fesih ARSLAN
  Lazarus 1.6.4 cikti Ugur 0 770 19-03-2017, Saat: 13:27
Son Yorum: Ugur
  Lazarus ile basit bir el terminali sayım programı esistem 4 2.535 24-02-2017, Saat: 20:40
Son Yorum: gjamesbond
Information CodeTyphon - Lazarus - FreePascal engerex 6 2.719 17-01-2017, Saat: 14:17
Son Yorum: AliZairov



Konuyu Okuyanlar: 1 Ziyaretçi