Çeşitli kaynak kodlar(lib tarzında) (form ara, decode , encode, günbul ,türkçe büyük küçük harf, ad

Çeşitli kaynak kodlar(lib tarzında) (form ara, decode , encode, günbul ,türkçe büyük küçük harf, ad

Bu kodlar programcı arkadaşların işine yarar.

{**************************************}

{                                                                   }

{       ismail_cil lib document                            }

{                                                                   }

{                                                                   }

{       Copyright (c) 1994-2005                         }

{       a_cil@hotmail.com                                  }

{                                                                   }

{**************************************}

unit Lib;

 

interface

 

Uses Windows, Forms, Graphics, Db;

Type

  DurumType=(Sil,Duzelt,Ekle);

  PPalEntriesArray = ^TPalEntriesArray; {for palette re-construction}

  TPalEntriesArray = array[0..0] of TPaletteEntry;

 

Const

  AyAdlari: Array[1..12] Of String[15] = ('OCAK','ŞUBAT','MART','NİSAN','MAYIS','HAZİRAN','TEMMUZ','AĞUSTOS','EYLÜL','EKİM','KASIM','ARALIK');

  Gunler: Array[1..12] Of Byte = (31,29,31,30,31,30,31,31,30,31,30,31);

  GunAdlari: Array[1..7] Of String[15] = ('PAZAR','PAZARTESİ','SALI','ÇARŞAMBA','PERŞEMBE','CUMA','CUMARTESİ');

 

  Function Encode(S: String): String;

  Function Decode(S: String): String;

  Procedure GunBul(Tarih: TDateTime; Var Gun, Ay, Yil: Integer);

  Procedure GunBul2(Tarih1,Tarih2: TDateTime; Var Gun, Ay, Yil: Integer);

  Function  Harf(Rakam: LongInt; Ch: Char; n: Byte): String;

  Function  TurkUpCase(Txt: String): String;

  Function  TurkLowCase(Txt: String): String;

  Function  EngUpCase(Txt: String): String;

  Function  EngLowCase(Txt: String): String;

  Function  TurkUpCaseChar(Ch: Char): Char;

  Function  TurkLowCaseChar(Ch: Char): Char;

  Function  BuyukKucukHarf(Txt: String): String;

  Function  AdSoyad(Txt: String): String;

  Procedure AdiSoyadiBol(AdiSoyadi:String;Var Adi,Soyadi: String);

  Function  BuGun:Integer;

  Function  BuAy:Integer;

  Function  BuYil:Integer;

  Function  BuGunStr:String;

  Function  BuAyStr:String;

  Function  KacGun(Tarih: TDateTime): Byte;

  Function  GunAl(Tarih: TDateTime): Byte;

  Function  AyAl(Tarih: TDateTime): Byte;

  Function  YilAl(Tarih: TDateTime): Integer;

  Function  Space(n: Integer): String;

  Function  Bosluk(s:String;n:Integer): String;

  Function  RakamOku(Sayi: Currency): String;

  Function  Yuzde(Sayi: Currency; Yuzdesi: Byte): Currency;

  Function  Yuzdesiz(Sayi: Currency; Yuzdesi: Byte): Currency;

  Function  FormAra(ClassName: TFormClass; Tag: Integer): Boolean;

  Function  Bosalt(Ch: Char; str: String) :String;

  Function  HarfCikar(Txt: String): String;

  Function  SifirAt(Txt: String): String;

  Function  Ek1(S: String): String;

  Procedure DataUpCase(DataSet: TDataSet);

 

implementation

 

Uses SysUtils;

 

Function Encode(S: String): String;

Var

  i: Byte;

  S2: String;

Begin

  {S2:=";

  For i:=1 To Length(S) Do S2:=S2+Chr(Ord(S[i])+128);

  Result:=S2;}

  Result:=S;

End;

 

Function Decode(S: String): String;

Var

  i: Byte;

  S2: String;

Begin

  {S2:=";

  For i:=1 To Length(S) Do S2:=S2+Chr(Ord(S[i])-128);

  Result:=S2;}

  Result:=S;

End;

 

Procedure GunBul(Tarih: TDateTime; Var Gun, Ay, Yil: Integer);

Var

  TStr1,TStr2: String;

  gg,aa,yy,ggg,aaa,yyy: Integer;

  i,j,k: Integer;

Const

  Gunler: Array[1..12] Of Byte = (31,28,31,30,31,30,31,31,30,31,30,31);

Begin

  TStr1:=DateToStr(Tarih);

  gg:=StrToInt(Copy(TStr1,1,2));

  aa:=StrToInt(Copy(TStr1,4,2));

  yy:=StrToInt(Copy(TStr1,7,4));

  TStr2:=DateToStr(Date);

  ggg:=StrToInt(Copy(TStr2,1,2));

  aaa:=StrToInt(Copy(TStr2,4,2));

  yyy:=StrToInt(Copy(TStr2,7,4));

  Gun:=0;

  Ay:=0;

  Yil:=0;

  If StrToDate(TStr1)>StrToDate(TStr2) Then Exit;

  i:=yy;

  j:=aa;

  k:=gg;

  If Not ((i=yyy) And (j=aaa) And (k=ggg)) Then

  Repeat

    If j>12 Then

    Begin

      Inc(i);

      Inc(Yil);

      j:=1;

    End;

    If k>Gunler[j]+Byte((j=2) And (i Mod 4=0)) Then

    Begin

      Inc(j);

      Inc(Ay);

      k:=1;

    End;

    If (i=yyy) And (j=aaa) And (k=ggg) Then Break;

    Inc(k);

    Inc(Gun);

  Until False;

  Yil:=Gun Div 365;

End;

 

Procedure GunBul2(Tarih1,Tarih2: TDateTime; Var Gun, Ay, Yil: Integer);

Var

  FazlaGun1: Byte;

  aa,yy,

  gg1,aa1,yy1,

  gg2,aa2,yy2: Integer;

Begin

  FazlaGun1:=0;

  aa:=0;

  yy:=0;

  gg1:=GunAl(Tarih1);

  gg2:=GunAl(Tarih2);

  aa1:=AyAl(Tarih1);

  aa2:=AyAl(Tarih2);

  yy1:=YilAl(Tarih1);

  yy2:=YilAl(Tarih2);

  If Tarih1<Tarih2 Then

  If (yy1=yy2) And (gg1=gg2) And (aa1<aa2) Then

  Begin

    FazlaGun1:=0;

    aa:=aa2-aa1;

  End Else

  If (yy1<>yy2) And (gg1>gg2) And (aa1=aa2) Then

  Begin

    FazlaGun1:=(Gunler[aa1]+Byte((aa1=2) And (yy1 Mod 4=0)))-(gg1-gg2);

    aa:=11;

    yy:=yy2-yy1-1;

  End Else

  If (yy1<>yy2) And (gg1<=gg2) And (aa1=aa2) Then

  Begin

    FazlaGun1:=gg2-gg1;

    yy:=yy2-yy1;

  End Else

  If (aa1=aa2) And (yy1=yy2) Then FazlaGun1:=gg2-gg1 Else

  If (aa1<>aa2) Or (gg1<>gg2) Or (yy1<>yy2) Then

  Begin

    If gg1<=gg2 Then

    Begin

      FazlaGun1:=gg2-gg1;

      If aa1<aa2 Then

      Begin

        aa:=aa2-aa1;

        yy:=yy2-yy1;

      End Else

      Begin

        aa:=12-(aa1-aa2);

        yy:=yy2-yy1-1;

      End;

    End Else

    Begin

      FazlaGun1:=(Gunler[aa1]+Byte((aa1=2) And (yy1 Mod 4=0))-gg1)+gg2;

      If aa1<aa2 Then

      Begin

        aa:=aa2-aa1;

        yy:=yy2-yy1;

      End Else

      Begin

        aa:=12-(aa1-aa2);

        yy:=yy2-yy1-1;

      End;

      Dec(aa);

      If aa<0 Then

      Begin

        aa:=11;

        Dec(yy);

      End;

    End;

  End;

  Gun:=FazlaGun1;

  Ay:=aa;

  Yil:=yy;

  If (Gun=0) And (Ay=12) Then

  Begin

    Gun:=FazlaGun1;

    Ay:=0;

    Inc(Yil);

  End;

End;

 

Function Harf(Rakam: LongInt; Ch: Char; n: Byte): String;

Var

  ss: String;

Begin

  ss:=IntToStr(Rakam);

  While Length(ss)<n Do ss:=Ch+ss;

  Result:=ss;

End;

 

Function TurkUpCase(Txt: String): String;

Const

  BHarfler: String[33] = 'ABCÇDEFGĞHIİJKLMNOÖPQRSŞTUÜVWXYZ';

  KHarfler: String[33] = 'abcçdefgğhıijklmnoöpqrsştuüvwxyz';

Var

  i: Byte;

Begin

  For i:=1 To Length(Txt) Do

  If Pos(Txt[i],KHarfler)>0 Then Txt[i]:=BHarfler[Pos(Txt[i],KHarfler)];

  Result:=Txt;

End;

 

Function TurkLowCase(Txt: String): String;

Const

  BHarfler: String[33] = 'ABCÇDEFGĞHIİJKLMNOÖPQRSŞTUÜVWXYZ';

  KHarfler: String[33] = 'abcçdefgğhıijklmnoöpqrsştuüvwxyz';

Var

  i: Byte;

Begin

  For i:=1 To Length(Txt) Do

  If Pos(Txt[i],BHarfler)>0 Then Txt[i]:=KHarfler[Pos(Txt[i],BHarfler)];

  Result:=Txt;

End;

 

Function EngUpCase(Txt: String): String;

Const

  BHarfler: String[39] = 'ABCCDEFGGHIIJKLMNOOPQRSSTUUVWXYZGUSIOC';

  KHarfler: String[39] = 'abcçdefgğhıijklmnoöpqrsştuüvwxyzĞÜŞİÖÇ';

Var

  i: Byte;

Begin

  For i:=1 To Length(Txt) Do

  If Pos(Txt[i],KHarfler)>0 Then Txt[i]:=BHarfler[Pos(Txt[i],KHarfler)];

  Result:=Txt;

End;

 

Function EngLowCase(Txt: String): String;

Const

  BHarfler: String[39] = 'ABCÇDEFGĞHIİJKLMNOÖPQRSŞTUÜVWXYZğüşıöç';

  KHarfler: String[39] = 'abccdefgghiijklmnoopqrsstuuvwxyzgusioc';

Var

  i: Byte;

Begin

  For i:=1 To Length(Txt) Do

  If Pos(Txt[i],BHarfler)>0 Then Txt[i]:=KHarfler[Pos(Txt[i],BHarfler)];

  Result:=Txt;

End;

 

Function TurkUpCaseChar(Ch: Char): Char;

Const

  BHarfler: String[33] = 'ABCÇDEFGĞHIİJKLMNOÖPQRSŞTUÜVWXYZ';

  KHarfler: String[33] = 'abcçdefgğhıijklmnoöpqrsştuüvwxyz';

Begin

  If Pos(Ch,KHarfler)>0 Then Ch:=BHarfler[Pos(Ch,KHarfler)];

  Result:=Ch;

End;

 

Function TurkLowCaseChar(Ch: Char): Char;

Const

  BHarfler: String[33] = 'ABCÇDEFGĞHIİJKLMNOÖPQRSŞTUÜVWXYZ';

  KHarfler: String[33] = 'abcçdefgğhıijklmnoöpqrsştuüvwxyz';

Begin

  If Pos(Ch,BHarfler)>0 Then Ch:=KHarfler[Pos(Ch,BHarfler)];

  Result:=Ch;

End;

 

Function BuyukKucukHarf(Txt: String): String;

Var

  i: Integer;

begin

  Txt:=TurkLowCase(Txt);

  For i:=0 To Length(Txt)-1 Do

  If (i=0) Or (Txt[i] In [' ',',','.','-','/',#10,#13,'=',

                          '(',')','[',']','{','}',';',':',

                          '!','#','$','%','_','"',#39,'&',

                          '@','*','?','+','','^','~','>',

                          '<','|',#9,'`','0','1','2','3',

                          '4','5','6','7','8','9']) Then Txt[i+1]:=TurkUpCaseChar(Txt[i+1]);

  Result:=Txt;

end;

 

Function AdSoyad(Txt: String): String;

Var

  i: Byte;

  S: String;

begin

  S:=BuyukKucukHarf(TrimRight(Txt));

  For i:=Length(S) DownTo 1 Do

  Begin

    If (S[i]=' ') Then Break;

    S[i]:=TurkUpCaseChar(S[i]);

  End;

  Result:=S;

End;

 

Procedure AdiSoyadiBol(AdiSoyadi:String;Var Adi,Soyadi: String);

Var

  i: Byte;

  a1,a2: String[30];

begin

  Adi:=";

  Soyadi:=";

  If AdiSoyadi=" Then Exit;

  a1:=AdiSoyadi;

  a2:=";

  For i:=Length(AdiSoyadi) DownTo 1 Do

  If AdiSoyadi[i]=' ' Then

  Begin

    a1:=Copy(AdiSoyadi,1,i-1);

    a2:=Copy(AdiSoyadi,i+1,255);

    Break;

  End;

  Adi:=a1;

  Soyadi:=a2;

End;

 

Function BuGun:Integer;

Var

  Gun,Ay,Yil: Word;

Begin

  DecodeDate(Date,Yil,Ay,Gun);

  Result:=Gun;

End;

 

Function BuAy:Integer;

Var

  Gun,Ay,Yil: Word;

Begin

  DecodeDate(Date,Yil,Ay,Gun);

  Result:=Ay;

End;

 

Function BuYil:Integer;

Var

  Gun,Ay,Yil: Word;

Begin

  DecodeDate(Date,Yil,Ay,Gun);

  Result:=Yil;

End;

 

Function BuGunStr:String;

Begin

  Result:=GunAdlari[DayOfWeek(Date)];

End;

 

Function BuAyStr:String;

Begin

  Result:=AyAdlari[BuAy];

End;

 

Function KacGun(Tarih: TDateTime): Byte;

Var

  Gun,Ay,Yil: Word;

Begin

  DecodeDate(Tarih,Yil,Ay,Gun);

  Result:=Gunler[Ay]+Byte((Ay=2) And (Yil Mod 4=0));

End;

 

Function GunAl(Tarih: TDateTime): Byte;

Var

  Gun,Ay,Yil: Word;

Begin

  DecodeDate(Tarih,Yil,Ay,Gun);

  Result:=Gun;

End;

 

Function AyAl(Tarih: TDateTime): Byte;

Var

  Gun,Ay,Yil: Word;

Begin

  DecodeDate(Tarih,Yil,Ay,Gun);

  Result:=Ay;

End;

 

Function YilAl(Tarih: TDateTime): Integer;

Var

  Gun,Ay,Yil: Word;

Begin

  DecodeDate(Tarih,Yil,Ay,Gun);

  Result:=Yil;

End;

 

Function  Space(n: Integer): String;

Var

  i: Integer;

  s: String;

Begin

  s:=";

  For i:=1 To n Do s:=s+' ';

  Result:=s;

End;

 

Function  Bosluk(s:String;n:Integer): String;

Var

  i: Integer;

  ss: String;

Begin

  ss:=s;

  If Length(s)<n Then

  For i:=1 To n-Length(s) Do ss:=ss+' ';

  Result:=ss;

End;

 

Function Yuzde(Sayi: Currency; Yuzdesi: Byte): Currency;

Begin

  If (Sayi>0) Then

  If Yuzdesi In [1..99] Then Result:=(Sayi*Yuzdesi)/100

                        Else Result:=Sayi

              Else Result:=0;

End;

 

Function  Yuzdesiz(Sayi: Currency; Yuzdesi: Byte): Currency;

Begin

  If (Sayi>0) Then

  If Yuzdesi In [1..99] Then Result:=Sayi/((Yuzdesi+100)/100)

                        Else Result:=Sayi

              Else Result:=0;

End;

 

Function FormAra(ClassName: TFormClass; Tag: Integer): Boolean;

Var

  I: Integer;

Begin

  Result:=False;

  for I := 0 to Screen.FormCount - 1 do

  begin

    if Screen.Forms[I] is ClassName then

    if (Screen.Forms[I].Tag=Tag) and (Screen.Forms[I].Showing) then

    begin

      Result:=True;

      Break;

    end;

  end;

End;

 

Function Bosalt(Ch: Char; str: String) :String;

Var

  i: Integer;

  str2: String;

Begin

  str2:=";

  If str<>" Then

  For i:=1 To Length(str) Do

  If str[i]<>Ch Then str2:=str2+str[i];

  Result:=str2;

End;

 

Function  RakamOku(Sayi: Currency): String;

 

Const

  b: Array[0..9] Of String[6]=(",'Bir','Iki','Üç','Dört','Beş','Altı','Yedi','Sekiz','Dokuz');

  y: Array[0..9] Of String[6]=(",'On','Yirmi','Otuz','Kırk','Elli','Altmış','Yetmiş','Seksen','Doksan');

  m: Array[0..4] Of String[7]=('Trilyon','Milyar','Milyon','Bin',");

Var

  v: Array[0..15] Of Byte;

  c: Array[0..3] Of Byte;

 

Function Str1(u: Byte; c: Char): String;

Var

  i: Integer;

  s: String;

Begin

  s:=";

  For i:=1 To u Do s:=s+c;

  Str1:=s;

End;

 

Var

  a,s,e: String;

  Pozitif: 0..1;

  x: Byte;

  Kod: Integer;

 

Begin

  Str(Sayi:0:0,a);

  If a[1]='-' Then Pozitif:=0 Else Pozitif:=1;

  If Sayi<0 Then Delete(a,1,1);

  For x:=1 To Length(a) Do

  If (Ord(a[x])>Ord('9')) Or (Ord(a[x])<Ord('0')) Then

  Begin

    RakamOku:='Hata';

    Exit;

  End;

  If Length(a)>15 Then

  Begin

    RakamOku:='Hata';

    Exit;

  End;

  a:=Str1(15-Length(a),'0')+a;

  For x:=1 To 15 Do Val(a[x],v[x],Kod);

  s:=";

  For x:=0 To 4 Do

  Begin

    c[1]:=v[(x*3)+1];

    c[2]:=v[(x*3)+2];

    c[3]:=v[(x*3)+3];

    If c[1]=0 Then e:="

    Else If c[1]=1 Then e:='Yüz'

    Else e:=b[c[1]]+'Yüz';

    e:=e+y[c[2]]+b[c[3]];

    If e<>" Then e:=e+m[x];

    If (x=3) And (e='BirBin') Then e:='Bin';

    s:=s+e;

  End;

  If s=" Then s:='Sıfır';

  If Pozitif=0 Then s:='Eksi '+s;

  RakamOku:=s;

End;

 

Function HarfCikar(Txt: String): String;

Var

  i: Byte;

  txt2: String;

Begin

  Txt2:=";

  For i:=1 To Length(Txt) Do

  If Txt[i] In ['A'..'Z','a'..'z','0'..'9','_'] Then

  Txt2:=Txt2+Txt[i];

  Result:=Txt2;

End;

 

Function  SifirAt(Txt: String): String;

Var

  i: Integer;

  Txt2: String;

Begin

  Txt2:=Txt;

  If Pos('.',Txt)>0 Then

  For i:=Length(Txt) DownTo Pos('.',Txt) Do

  If Txt[i]='0' Then Delete(Txt2,Length(Txt2),1) Else

  If Txt[i]='.' Then Delete(Txt2,Length(Txt2),1) Else Break;

  Result:=Txt2;

End;

 

Function  Ek1(S: String): String;

Var

  u: Integer;

Begin

  u:=Length(S);

  If Pos(S[u],'ıIaA')>0 Then S:=S+"'nın' Else

  If Pos(S[u],'iİeE')>0 Then S:=S+"'nin' Else

  If Pos(S[u],'oOuU')>0 Then S:=S+"'nun' Else

  If Pos(S[u],'öÖüÜ')>0 Then S:=S+"'nün' Else

  If Pos(S[u],'ıIaAiİeEoOuUöÖüÜ')<0 Then

  Begin

    If Pos(S[u-1],'ıIaA')>0 Then S:=S+"'ın' Else

    If Pos(S[u-1],'iİeE')>0 Then S:=S+"'in' Else

    If Pos(S[u-1],'oOuU')>0 Then S:=S+"'un' Else

    If Pos(S[u-1],'öÖüÜ')>0 Then S:=S+"'ün';

  End;

  Result:=S;

End;

 

Procedure DataUpCase;

Var

  i: Integer;

begin

  For i:=0 To DataSet.Fields.Count-1 Do

  If DataSet.Fields.FieldByNumber(i).DataType=ftString Then

  DataSet.Fields.FieldByNumber(i).AsString:=TurkUpCase(DataSet.Fields.FieldByNumber(i).AsString);

End;

 

end.

 

Delphi - .....................................

 

Bilgisayarı konuşturun

bilgisayarı konuşturun

bu kodlarla bilgisayarı konuşturun...türkçe destekli değil ama yine

de güzel okuyor microsoft sam amca...xp de sorunsuz çalışır ama 98

de kullanmak için speech özelliği yüklenmeli...microsoft.com da var.

text to speech diye aratırsanız google da bulabilirsiniz.ama xp de

 gerek yok zaten yüklü...kolay gelsin...

kenanozyurt_turk@hotmail.com

unit Unit1;

 

interface

 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, ComObj , StdCtrls;     //uses kısmına “comobj” eklenecek…

 

type

  TForm1 = class(TForm)

    Button1: TButton;

    Edit1: TEdit;

    procedure Button1Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

 

var

  Form1: TForm1;

 

implementation

 

{$R *.dfm}

 

procedure TForm1.Button1Click(Sender: TObject);

var

  oleVoice: OLEVariant;

begin

  oleVoice := CreateOLEObject('SAPI.SpVoice');

  oleVoice.Speak(edit1.Text, 0);

 

end;

 

end.

 

Bu kodlarla ne yazarsanız yazın Microsoft sam amca’dan her şeyi dinleyebilirsiniz

 

Delphi - .....................................

 

Ekran klavyesi

pas dosyası

 

unit Unit1;

 

interface

 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, Grids;

 

type

  TForm1 = class(TForm)

    DrawGrid1: TDrawGrid;

    procedure DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;

      Rect: TRect; State: TGridDrawState);

    procedure DrawGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;

      var CanSelect: Boolean);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

 

var

  Form1: TForm1;

 

implementation

 

{$R *.dfm}

 

procedure TForm1.DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;

  Rect: TRect; State: TGridDrawState);

var

a:Integer;

begin

    DrawGrid1.Font.Color:=clRed;

    DrawGrid1.Font.Size:=15;

    DrawGrid1.Font.Style:=[fsbold];

  if (ACol=0) and (ARow=1) then

  begin

    Rect:=DrawGrid1.CellRect(ACol,ARow);

    DrawGrid1.Canvas.TextRect(rect,75,2,'B');

  end;

  if (ACol=0) and (ARow=0) then

  begin

    Rect:=DrawGrid1.CellRect(ACol,ARow);

    DrawGrid1.Canvas.TextRect(Rect,25,2,'A');

  end;

 

end;

 

procedure TForm1.DrawGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;

  var CanSelect: Boolean);

begin

if ACol=0 then ShowMessage('a');

end;

 

end.

 

 

dfm dosyası

 

object Form1: TForm1

  Left = 192

  Top = 107

  Width = 870

  Height = 640

  Caption = 'Form1'

  Color = clBtnFace

  Font.Charset = DEFAULT_CHARSET

  Font.Color = clWindowText

  Font.Height = -11

  Font.Name = 'MS Sans Serif'

  Font.Style = []

  OldCreateOrder = False

  PixelsPerInch = 96

  TextHeight = 13

  object DrawGrid1: TDrawGrid

    Left = 120

    Top = 96

    Width = 409

    Height = 353

    FixedCols = 0

    FixedRows = 0

    TabOrder = 0

    OnDrawCell = DrawGrid1DrawCell

    OnSelectCell = DrawGrid1SelectCell

  end

end

 

Delphi - .....................................

 

Kullanıcının Sadece Sizin Programınızı Kullanmasını İsterseniz

Kullanıcının Sadece Sizin Programınızı Kullanmasını İsterseniz

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

Bazen kullanıcının sadece sizin yazdığınız programı kullanmasını isteyebilirsiniz.

O zaman aşağıdaki prosedürler ihtiyaçlarınızı karşılayacaktır.

 

 

procedure TForm1.Formcreate(Sender: TObject);

var B: LongInt;

begin

&nbsp;&nbsp; SystemParametersInfo(97,word(True),@B,0);

&nbsp;&nbsp; {yukarıdaki satır ctrl-alt-del ve alt-tab tuslarını kapatır}

&nbsp;&nbsp; gizle;

end;

 

procedure TForm1.FormClose(Sender: TObject);

var B: LongInt;

begin

&nbsp;&nbsp; SystemParametersInfo(97,word(False),@B,0);

&nbsp;&nbsp; goster;

end;

 

procedure gizle;

var wndHandle: Thandle;

&nbsp;&nbsp;&nbsp;&nbsp;wndClass: array[0..50] of Char;

begin

&nbsp;&nbsp; StrPCopy(@wndclass[0],'Shell_TrayWnd');

&nbsp;&nbsp; wndHandle:= FindWindow(@wndclass[0],nil);

&nbsp;&nbsp; ShowWindow(wndHandle,SW_HIDE);

end;

 

procedure gizle;

var wndHandle: Thandle;

&nbsp;&nbsp;&nbsp;&nbsp;wndClass: array[0..50] of Char;

begin

&nbsp;&nbsp; StrPCopy(@wndclass[0],'Shell_TrayWnd');

&nbsp;&nbsp; wndHandle:= FindWindow(@wndclass[0],nil);

&nbsp;&nbsp; ShowWindow(wndHandle,SW_RESTORE);

end;

 

Delphi - .....................................

 

Cümlelerimizi formatlayalım

Cümlelerimizi formatlayalım (Türkçe Karakterler Dahil) ve bunu bir dll içine gömüp dilediğimiz zaman çağıralım

Bazan verileri raporlama islemleri yaparken  kullanicini girdigi cümlelerin düzgün bir şekilde gözükmesini isteriz.

Örneğin kullanıcı

  text := 'akŞama YEMEĞE geleceĞİM';

gibi bir yazı girdiğini varsayarsak biz bunu

  text := 'Aşama Yemeğe Geleceğim';

gibi formatlı bir hale çevirelim

 

Öncelikle dll dosyamızı yazalım.

Yeni bir delphi açalım,

File/CloseAll dedikten sonra,

File/New/Other/Dll Wizard sekmelerini sırası ile tıklayalım.

 

ve içerisine şunları yazalım

 

library Tools;

uses

  SysUtils,

  Classes;

 

  Function ucWords(duzelt:String):PChar; StdCall;

    var

     bosluk_ayir : TstringList;

     x : Integer;

     ilk_karakter : String;

     sonHal : String;

     son_karakterler : String;

     z : Integer;

     trLoverCase : array[0..6] of String;

     trUpperCase : array[0..6] of String;

     i : Integer;

     begin

        z:=0;

        i:=0;

        trLoverCase[0] := 'ç';

        trLoverCase[1] := 'ğ';

        trLoverCase[2] := 'ı';

        trLoverCase[3] := 'i';

        trLoverCase[4] := 'ö';

        trLoverCase[5] := 'ş';

        trLoverCase[6] := 'ü';

 

        trUpperCase[0] := 'Ç';

        trUpperCase[1] := 'Ğ';

        trUpperCase[2] := 'I';

        trUpperCase[3] := 'İ';

        trUpperCase[4] := 'Ö';

        trUpperCase[5] := 'Ş';

        trUpperCase[6] := 'Ü';

 

        bosluk_ayir := TStringList.Create;

        bosluk_ayir.Text := StringReplace(duzelt, ' ', #13#10, [rfReplaceAll]);

 

 

         //kaç kelime varsa o kadar donguye gir

         for x:=0 to bosluk_ayir.Count-1 do

             begin

 

                //Kelimenin ilk karakterini kopyala

                ilk_karakter := Copy(bosluk_ayir[z], 0, 1);

 

                    //kelinenin ilk karakterinde ç,ğ,ı,i,ö,ş,ü varsa

                    if (ilk_karakter = 'ç') or (ilk_karakter = 'ğ') or (ilk_karakter = 'ı') or (ilk_karakter = 'i') or (ilk_karakter = 'ö') or (ilk_karakter = 'ş') or (ilk_karakter = 'ü') then

                        begin

                             for i:=0 to 6 do

                                 begin

                                   ilk_karakter := StringReplace(ilk_karakter, trLoverCase[i], trUpperCase[i], [rfReplaceAll]);

                                end; //for end

                        end

                        //değilse

                        else

                           begin

                              ilk_karakter := AnsiUpperCase(ilk_karakter);

                           end;

 

 

                //Kelimenin ilk karakterini sil

                son_karakterler := bosluk_ayir[z];

                Delete(son_karakterler, 1, 1);

                   for i:=0 to 6 do

                       begin

                         son_karakterler := StringReplace(son_karakterler, trUpperCase[i], trLoverCase[i], [rfReplaceAll]);

                       end;

                son_karakterler := AnsiLowerCase(son_karakterler);

 

    SonHal := SonHal + ilk_karakter + son_karakterler + ' ';

    z:=z+1;

    end; //for end;

    Result := PChar(SonHal);

    bosluk_ayir.Free;

  end; //function ucWords end;

  Exports ucWords;

 

  {$R *.res}

begin

end.

 

//--------------dll Sonu-----------------------------

 

Şimdi sıra geldi bunu formumuzda çağırıp kullanmaya

 

unit Unit1;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls;

type

  TForm1 = class(TForm)

    Button1: TButton;

    Edit1: TEdit;

    procedure Button1Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

  Function ucWords(duzelt:String): PChar; StdCall; External 'Tools.dll';

var

  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button3Click(Sender: TObject);

begin

  Edit1.Text := ucWords(Edit1.Text);

end;

end.

 

Delphi - .....................................

 

TRichEdit Cursor Nerede?

var

     CursorX,CursorY : Integer

 

 

procedure UpdateCursorPos(BenimRich:TRichEdit);

var

  CharPos: TPoint;

begin

  CharPos.Y := SendMessage(BenimRich.Handle, EM_EXLINEFROMCHAR, 0,

    BenimRich.SelStart);

  CharPos.X := (BenimRich.SelStart -

    SendMessage(BenimRich.Handle, EM_LINEINDEX, CharPos.Y, 0));

  CursorX:=CharPos.X;

  CursorY:=CharPos.Y;

end;

 

 

Bu prosedür her tetiklendirğinde public olarak tanımlanmış CursorX ve CursorY değişkenlerine prosedüre atanan RichEdit deki cursorun konumunu atar.

 

Delphi - .....................................

 

Paradox veritabanı kullanan ve Install sorunu için

Özellikle Paradox veritabanı kullanan ve Install ederken programın path istediği ve çalışmadığı gibi bazı sorular olduğunu gördüm.Bu yüzden bu kodu yazdım bir deneyin....

Formun OnCreate olayına yazılacak

 

sizintable.Databasename:=ExtractFilePath(Application.EXEName);

 

Bu komut satırı ile InstallShields,InnoSetup vb programlar ile hazırlanacak olan Install programı sonrasında kullanıcının programı herhangi bir dizine kurması sağlanmaktadır.Çünkü programın çalışabilmesi için exe'si ile veritabanı dosyası aynı dizin içerisinde olmalıdır.

 

Umarım işinize yarar.

 

Delphi - .....................................

 

Güvenlik kiliti

güvenlik kiliti

yazılımın güvenliği ile ilgili örnek

procedure TForm1.FormCreate(Sender: TObject);

begin

edit1.Text:=";

hata:=0;

assignfile(dsy,'c:basri.dat');

{$i-}reset(dsy);{$i+}

if ioresult<>0 then rewrite(dsy);

for i:=0 to filesize(dsy)-1 do begin

seek(dsy,i);read(dsy,a);

if a.kilit='*'then begin

showmessage('kilitli');

halt;

end;

end;

end;

 

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);

begin

if ord(key)=13 then begin

sifre:='basri';

if edit1.Text<>sifre then begin

hata:=hata+1;

edit1.Text:=";

end

else if edit1.Text=sifre then begin

form2.Show;

end;

if hata>=3 then begin

a.kilit:='*';

seek(dsy,filesize(dsy));write(dsy,a);

halt;

end;

end;

end;

 

Delphi - .....................................

 

TMultiLineListBox

TListBox kullanırken satırlarınızın görüntüleme alanının dışına taşmasından

 bıktıysanız işte size güzel bir çözüm.

 

(*

*

* MULTILINELISTBOX

* ================

*

* Fikir ve Programlama: H. Emre KARTAL

* hekartal2000@operamail.com

*

* 25/07/2000

*

*)

 

unit MutliLineListBox;

 

interface

 

uses Windows, Graphics, Messages, SysUtils, Classes, Controls, StdCtrls;

 

type

  TMutliLineListBox = class(TListBox)

  private

    { Private declarations }

    FMultiLine: Boolean;

    procedure SetMultiLine(const Value: Boolean);

  protected

    { Protected declarations }

    procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;

    procedure MeasureItem(Index: Integer; var Height: Integer); override;

  public

    { Public declarations }

  published

    { Published declarations }

    property MultiLine: Boolean read FMultiLine write SetMultiLine;

  end;

 

procedure Register;

 

implementation

 

procedure Register;

begin

  RegisterComponents('Standard', [TMutliLineListBox]);

end;

 

{ TMutliLineListBox }

 

procedure TMutliLineListBox.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);

var

  s: string;

begin

  if (FMultiLine) then

    begin

      Canvas.Font := Font;

      if (odSelected in State) then Canvas.Font.Color := clHighlightText;

      Canvas.FillRect(Rect);

      s := Items[ Index ];

      DrawText(Canvas.Handle, PChar(s), Length(s), Rect, DT_WORDBREAK);

    end

  else

    inherited;

end;

 

procedure TMutliLineListBox.MeasureItem(Index: Integer; var Height: Integer);

var

  s: string;

  h: Integer;

  r: TRect;

begin

  if (FMultiLine) then

    begin

      h := Height;

      Canvas.Font := Font;

      s := Items[ Index ];

      r := ItemRect(Index);

      DrawText(Canvas.Handle, PChar(s), Length(s), r, DT_CALCRECT or DT_WORDBREAK);

      Height := (r.Bottom - r.Top);

      if (Height < h) then Height := h;

    end

  else

    inherited;

end;

 

procedure TMutliLineListBox.SetMultiLine(const Value: Boolean);

begin

  if (FMultiLine <> Value) then

  begin

    FMultiLine := Value;

 

    if (FMultiLine) then

      Style := lbOwnerDrawVariable

    else

      Style := lbStandard;

  end;

end;

 

end.

 

Delphi - .....................................

 

Metin icerisinden bir karakter silme

Metin icerisinden bir karakter silme

 

Function DeleteCharacterInString(InputCharacter,InputString: String): String;

Var

  CharPos : Integer;

Begin

  Result := InputString;

  While True Do

  Begin

    CharPos := Pos(InputCharacter,InputString);

    If Not (CharPos = 0) Then

    Begin

      Delete(InputString,CharPos,1);

    End

    Else

    Begin

      Break;

    End;

  End;

  Result := InputString;

End;

 

Delphi - .....................................

 

Birden Fazla Nesneyi Kontrol Etmek

Birden Fazla Nesneyi Kontrol Etmek

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

Birden fazla nesneyi kontrol etmek için her nesne için ayrı ayrı kod yazmak yerine bir kaç satır kodla işleminizi kolayca halledebilirsiniz.

Birden Fazla Nesneyi Kontrol Etmek

 

Formunuzda birden fazla SpeedButton olduğunu varsayalım.Bu nesnelerin özelliklerine göre bir işlem yaptırmak veya bu nesnelerin hepsine aynı anda müdahele etmek için nesnenin bağlı olduğu sınıf kullanılır.

 

 

Örnek1

 

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

 

 

     Speedbutton ların hepsini visible yapmak için

 

     For i:=0 to componentcount- 1 do

     Begin

        If components[i] is Tspeedbutton then

            Tspeedbutton(components[i]).visible:=false;

     End;

 

 

Form üzerindeki eleman sayısı (ComponentCount)  alınarak for döngüsü içerisinde bütün elemanların Speedbutton olup olmadığı kontrolü yapılır.Bu koşulu sağlayan elemanların yani SpeedButton ların visible özelliği false yapılır.,

 

 

Örnek2

 

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

 

 

     Form üzerinde 29 Speedbutton var ve hepsinin caption değişkenlerine sırasıyla alfabenin harfleri atanmış olsun.Form üzerinde bulunan Label1 in caption değişkenine Speedbutton ların caption değişkeni atanacak(OnClick).

 

Bütün Speedbutton ların teker teker Onclick olayını yazmaktansa sadece bir tanesinin(mesela SpeedButton1) Onclick olayına aşağıdaki kod yazılıp geri kalan bütün speedbutton ların OnClick olayı SpeedButton1 in Onclick olayına bağlanırsa yapılmak istenen işlem tek satır ile halledilmiş olur.

 

 

 

Procedure TspeedButton1.OnClick(Sender: Tobject);

Begin

   Label1.caption:=TspeedButton(Sender).caption;

End;

 

 

 

Bu kod ile TspeedButton sınıfına ait üzerinde işlem yapılan(Sender) nesnenin caption değişkeni Label1 in caption değişkenine atanır.

 

Not: Bu kodları diğer elemanlar içinde rahatlıkla kullanabilirsiniz.

 

Delphi - .....................................

 

Herşeyi Şekillendirelim

Form üzerine koyduğunuz bütün bileşenlerin geometrik şekiller alabileceğini görelim

Aşağıdaki Edit1 yazan yerlere Combobox1,ListBox1 yada abartın from1 falan yazın formuz şekillensin :)

 

SetWindowRgn( Edit1.handle,

                      CreateRoundRectRgn(2, 2, Edit1.Width-2, Edit1.Height-2, 15, 15),

                      True);

 

Delphi - .....................................

 

Saat ve tahih gösterimi editte

rocedure TForm1.Button1Click(Sender: TObject);

begin

 

   edit1.text:=datetostr(date);

   edit2.text:=timetostr(time);

end;

 

 

end.

 

Delphi - .....................................

 

HE-CE-LE-RE A-YI-RAN P-ROG-RAM

TURKCE TEXTLERI HECELERE AYIRIR.(CILGIN ALGORITMA)

unit Unit1;

 

 

{

iki edit bir buton yerlestirin ve uygulayin. turkce he-ce-le-re a-yi-ran p-rog-ram

}

 

interface

 

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

  StdCtrls;

 

type

  TForm1 = class(TForm)

    Edit1: TEdit;

    Button1: TButton;

    Edit2: TEdit;

    procedure Button1Click(Sender: TObject);

  private

    { Private declarations }

    function sesli(harf:string):boolean;

  public

    { Public declarations }

  end;

 

var

  Form1: TForm1;

 

implementation

 

{$R *.DFM}

function tform1.sesli(harf:string):boolean;

begin

 

result:=false;

 

if harf='i'then  result:=true;

if harf='e'then  result:=true;

if harf='a'then  result:=true;

if harf='u'then  result:=true;

if harf='o'then  result:=true;

 

if harf='I'then  result:=true;

if harf='E'then  result:=true;

if harf='A'then  result:=true;

if harf='U'then  result:=true;

if harf='O'then  result:=true;

 

end;//func

//---------------------------

procedure TForm1.Button1Click(Sender: TObject);

var

i:integer;

begin

Edit2.text:=EmptyStr;

for i:=1  to length(edit1.text) do

begin

  if

      not     sesli(copy(edit1.text,i,1))

      and     sesli(copy(edit1.text,i+1,1))

      and not (copy(edit1.text,i,1)=' ')

      and not (copy(edit1.text,i-1,1)=' ')

      and not (copy(edit1.text,i+1,1)=' ')

  then

    begin

     Edit2.text:=edit2.text+'-';

    end;//if

Edit2.text:=edit2.text+copy(edit1.text,i,1);

end;//for

 

if copy(edit2.text,1,1)='-' then

begin

//showmessage(");

edit2.text:=copy(edit2.text,2,length(edit2.text));

end;

 

end;//proc

 

end.

 

Delphi - .....................................

 

Sürüklenen bir dosyanın mediaplayer ile çalınması

Sürükleyip bırakın,şarkınız çalsın

Bu kodla bilgisayarınızdan bir mp3 dosyasını yapacağınız mediaplayer veya mp3player'a sürükleyip çalabilirsiniz.Ayrıca başka amaçlar için de kullanılabilir.Mesela Formunuza sürüklenen bir resim dosyasını formda göstermek gibi

Gelelim koda

Bu kodun çalışması için ShellApi'yi kullanmamız gerekir

Onun için Uses satırına ShellApi'yi eklemeliyiz

Şimdi basit bir program yapalım.

Formumuza bir label bir tane de mediaplayer komponenti ekleyelim ve sürüklediğimiz dosyayı çalalım.

 

unit Unit1;

 

interface

 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs,ShellApi, MPlayer, StdCtrls;

type

  TForm1 = class(TForm)

    MediaPlayer1: TMediaPlayer;

    Label1: TLabel;

    procedure FormCreate(Sender: TObject);

//Dosya sürükleyecek prosedürün tanımı

   procedure WMDROPFILES(var TheMessage: TWMDROPFILES);

message WM_DROPFILES;

  private

    { Private declarations }

  public

    { Public declarations }

  end;

 

var

  Form1: TForm1;

 

implementation

 

{$R *.dfm}

procedure TForm1.WMDROPFILES(var TheMessage: TWMDROPFILES);

var

  FileName : array[0..MAX_PATH] of char;

begin

// Sürüklenen Dosyanın ismini,yolunu al

DragQueryFile(TheMessage.Drop, 0, FileName, 300);

mediaplayer1.FileName:=filename;

mediaplayer1.Open;

mediaplayer1.Play;

label1.Caption:=filename;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

//Sürüklemeye izin ver

DragAcceptFiles(Handle, true)

end;

end.

 

 

     

 

 

 

Delphi Bölümü

Kullanıcı Hakkında Adres Defterinize Ekleyin Kullanıcıya Mesaj Yollayın!    sinan yüksel (2005-04-13)      Yazıcı Dostu Değerlendir Yorum Ekle

Sürüklenen bir dosyanın mediaplayer ile çalınması

Sürükleyip bırakın,şarkınız çalsın

Bu kodla bilgisayarınızdan bir mp3 dosyasını yapacağınız mediaplayer veya mp3player'a sürükleyip çalabilirsiniz.Ayrıca başka amaçlar için de kullanılabilir.Mesela Formunuza sürüklenen bir resim dosyasını formda göstermek gibi

Gelelim koda

Bu kodun çalışması için ShellApi'yi kullanmamız gerekir

Onun için Uses satırına ShellApi'yi eklemeliyiz

Şimdi basit bir program yapalım.

Formumuza bir label bir tane de mediaplayer komponenti ekleyelim ve sürüklediğimiz dosyayı çalalım.

 

unit Unit1;

 

interface

 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs,ShellApi, MPlayer, StdCtrls;

type

  TForm1 = class(TForm)

    MediaPlayer1: TMediaPlayer;

    Label1: TLabel;

    procedure FormCreate(Sender: TObject);

//Dosya sürükleyecek prosedürün tanımı

   procedure WMDROPFILES(var TheMessage: TWMDROPFILES);

message WM_DROPFILES;

  private

    { Private declarations }

  public

    { Public declarations }

  end;

 

var

  Form1: TForm1;

 

implementation

 

{$R *.dfm}

procedure TForm1.WMDROPFILES(var TheMessage: TWMDROPFILES);

var

  FileName : array[0..MAX_PATH] of char;

begin

// Sürüklenen Dosyanın ismini,yolunu al

DragQueryFile(TheMessage.Drop, 0, FileName, 300);

mediaplayer1.FileName:=filename;

mediaplayer1.Open;

mediaplayer1.Play;

label1.Caption:=filename;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

//Sürüklemeye izin ver

DragAcceptFiles(Handle, true)

end;

end.

 

Bu koda çeşitli eklemeler,kontroller koyarak güzel şeyler yapabilirsiniz.

Kolay gelsin

 

Delphi - .....................................