Özel id oluşturma

[brs]

Selam; Çok, çok özel bir id oluşturmak istiyorum, fakat bir noktadan sonra takıldım.

Örnek: Ahmet bu akşam saat 19:00'da sinemaya gidecek "ABASSG" gibi nasıl yapabilirim?

Her kelimenin ilk harfi, küçük yazılmışsa büyük ve Türkçe karakter olmayacak, arada boşluk olmadan sayı veya özel karakter ekle eklenmeyecek. Mümkün mü acaba? Konu hakkında yol gösterirseniz sevinirim...

Kod: Tümünü seç

function OzelID(StrKarakter: String): String;
const
  Turk: String = 'ÇĞİÖŞÜabcçdefgğhiijklmnoöprsştuuüvyzqw';
  Cvr: String = 'CGIOSUABCCDEFGGHIIJKLMNOOPRSSTUUVYZQW';
var
  N: Integer;
begin
  begin
    for N := 1 to length(Turk) do
      while Pos(Turk[N], StrKarakter) > 0 do
        StrKarakter[Pos(Turk[N], StrKarakter)] := Cvr[N];
    Result := StrKarakter;
    SplitViewForm.Caption := StrKarakter;
  end;
end;

Kod: Tümünü seç

procedure TForm3.PLAdKeyPress(Sender: TObject; var Key: Char);
var
  DecimalSeparator: Char;
begin
  if Key in ['A' .. 'Z', 'a' .. 'z', DecimalSeparator] then
  begin
    Caption := OzelID(PLAd.Text);
  end;

[ertank]

Merhaba,

Aşağıdaki kodu deneyebilirsiniz.

Kod: Tümünü seç

function GetLatinLetters(const Value: string): string;
var
  i: Integer;
begin
  Result := Value;
  for I := 1 to Length(Result) do
  begin
    case Result[i] of
      'İ': Result[i] := 'I';
      'ı': Result[i] := 'i';
      'Ş': Result[i] := 'S';
      'ş': Result[i] := 's';
      'Ğ': Result[i] := 'G';
      'ğ': Result[i] := 'g';
      'Ç': Result[i] := 'C';
      'ç': Result[i] := 'ç';
      'Ü': Result[i] := 'Ü';
      'ü': Result[i] := 'ü';
      'Ö': Result[i] := 'O';
      'ö': Result[i] := 'o';
    end;
  end;
end;

function GetStringPartCount(const Value: string; const DelimChar: Char): Integer;
var
  List: TStringList;
begin
  Result := -1;
  List := TStringList.Create();
  try
    List.Delimiter     := DelimChar;
    List.DelimitedText := Value;
    Result := List.Count;
  finally
    List.Free();
  end;
end;

function GetStringPart(const Value: string; const DelimChar: Char; const Index: Integer): string;
var
  List: TStringList;
begin
  Result := EmptyStr;
  List := TStringList.Create();
  try
    List.Delimiter     := DelimChar;
    List.DelimitedText := Value;
    if (Index <= List.Count) and (Index >= 0) then
    begin
      Exit(List[Index]);
    end;
  finally
    List.Free();
  end;
end;

function GetOzelId(const Value: string): string;
const
  Numbers = ['0'..'9'];

var
  i, PartCount: Integer;
  TempString: string;
begin
  Result := EmptyStr;
  
  PartCount := GetStringPartCount(Value, ' ');
  if PartCount > 0 then
  begin
    for i := 0 to Pred(PartCount) do
    begin
      TempString := GetStringPart(Value, ' ', i);
      if TempString <> EmptyStr then
      begin
        if not CharInSet(TempString[1], Numbers) then
          Result := Result + UpperCase(GetLatinLetters(TempString[1]));
      end;
    end;
  end;
end;

Kullanımı şöyle olacaktır:

Kod: Tümünü seç

procedure TForm1.Button1Click(Sender: TObject);
begin
  Edit2.Text := GetOzelId(Edit1.Text);
end;

[adelphiforumz]

Selamlar
Sadece bir hatırlatma yapmak istedim.
Eğer ÖzelId Uniq olacaksa bu mantıkta sorun yaşarsın Ahmet yerine Ali gelirse sonuç yine aynı olur.

[freeman35]

Neden alfanumerik olmak zorunda ? TDateTime ı kullanabilirsin, salise bazında real sayıdır. illaki alfa numerik olsun diyorsan

Kod: Tümünü seç

var g: TGUID;
    S: string;
begin
  CreateGUID(g);
  S:= GUIDToString(g);

girilene göre bir şeyler üretilsin içinde, dosya doğruluk işlerindeki yanılmıyorsam MD5 mantığını kullanabilirsin, buna benzer örnekler mutlaka nette vardır. boşluk vs işleri içinde "Trim" kullan
Kolay gele

[brs]

On numara bir kod, tek sıkıntısı bir function altında toplayamadım...

Merhaba,

Aşağıdaki kodu deneyebilirsiniz.

Kod: Tümünü seç

function GetLatinLetters(const Value: string): string;
var
  i: Integer;
begin
  Result := Value;
  for I := 1 to Length(Result) do
  begin
    case Result[i] of
      'İ': Result[i] := 'I';
      'ı': Result[i] := 'i';
      'Ş': Result[i] := 'S';
      'ş': Result[i] := 's';
      'Ğ': Result[i] := 'G';
      'ğ': Result[i] := 'g';
      'Ç': Result[i] := 'C';
      'ç': Result[i] := 'ç';
      'Ü': Result[i] := 'Ü';
      'ü': Result[i] := 'ü';
      'Ö': Result[i] := 'O';
      'ö': Result[i] := 'o';
    end;
  end;
end;

function GetStringPartCount(const Value: string; const DelimChar: Char): Integer;
var
  List: TStringList;
begin
  Result := -1;
  List := TStringList.Create();
  try
    List.Delimiter     := DelimChar;
    List.DelimitedText := Value;
    Result := List.Count;
  finally
    List.Free();
  end;
end;

function GetStringPart(const Value: string; const DelimChar: Char; const Index: Integer): string;
var
  List: TStringList;
begin
  Result := EmptyStr;
  List := TStringList.Create();
  try
    List.Delimiter     := DelimChar;
    List.DelimitedText := Value;
    if (Index <= List.Count) and (Index >= 0) then
    begin
      Exit(List[Index]);
    end;
  finally
    List.Free();
  end;
end;

function GetOzelId(const Value: string): string;
const
  Numbers = ['0'..'9'];

var
  i, PartCount: Integer;
  TempString: string;
begin
  Result := EmptyStr;
  
  PartCount := GetStringPartCount(Value, ' ');
  if PartCount > 0 then
  begin
    for i := 0 to Pred(PartCount) do
    begin
      TempString := GetStringPart(Value, ' ', i);
      if TempString <> EmptyStr then
      begin
        if not CharInSet(TempString[1], Numbers) then
          Result := Result + UpperCase(GetLatinLetters(TempString[1]));
      end;
    end;
  end;
end;

Kullanımı şöyle olacaktır:

Kod: Tümünü seç

procedure TForm1.Button1Click(Sender: TObject);
begin
  Edit2.Text := GetOzelId(Edit1.Text);
end;

[ertank]

Neden tek bir fonksiyon içinde toplamak istiyorsunuz?

Ü, ü ve ç karakterinde GetLatinLetters() içinde hata var. Yine aynı Türkçe hallerini geri çeviriyor. Düzeltilmiş hali aşağıda.

Kod: Tümünü seç

function GetLatinLetters(const Value: string): string;
var
  i: Integer;
begin
  Result := Value;
  for I := 1 to Length(Result) do
  begin
    case Result[i] of
      'İ': Result[i] := 'I';
      'ı': Result[i] := 'i';
      'Ş': Result[i] := 'S';
      'ş': Result[i] := 's';
      'Ğ': Result[i] := 'G';
      'ğ': Result[i] := 'g';
      'Ç': Result[i] := 'C';
      'ç': Result[i] := 'c';
      'Ü': Result[i] := 'U';
      'ü': Result[i] := 'u';
      'Ö': Result[i] := 'O';
      'ö': Result[i] := 'o';
    end;
  end;
end;

[brs]

Neden tek bir fonksiyon içinde toplamak istiyorsunuz?

Ü, ü ve ç karakterinde GetLatinLetters() içinde hata var. Yine aynı Türkçe hallerini geri çeviriyor. Düzeltilmiş hali aşağıda.

Kod: Tümünü seç

function GetLatinLetters(const Value: string): string;
var
  i: Integer;
begin
  Result := Value;
  for I := 1 to Length(Result) do
  begin
    case Result[i] of
      'İ': Result[i] := 'I';
      'ı': Result[i] := 'i';
      'Ş': Result[i] := 'S';
      'ş': Result[i] := 's';
      'Ğ': Result[i] := 'G';
      'ğ': Result[i] := 'g';
      'Ç': Result[i] := 'C';
      'ç': Result[i] := 'c';
      'Ü': Result[i] := 'U';
      'ü': Result[i] := 'u';
      'Ö': Result[i] := 'O';
      'ö': Result[i] := 'o';
    end;
  end;
end;

Türkçe için aşağıdaki kodları entegre ettim

Kod: Tümünü seç

function Rakamlar(StrKarakter: String): String;
const
  Turk: String = 'ÇĞİÖŞÜabcçdefgğhiijklmnoöprsştuuüvyzqw';
  Cvr: String = 'CGIOSUABCCDEFGGHIIJKLMNOOPRSSTUUVYZQW';
var
  N: Integer;
begin
  begin
    for N := 1 to Length(Turk) do
      while Pos(Turk[N], StrKarakter) > 0 do
        StrKarakter[Pos(Turk[N], StrKarakter)] := Cvr[N];
    Result := StrKarakter;
  end;
end;

[brs]

İlk harften sonrasını silmeyi veya almamyı iptal edemedim kafam çok karıştı...

Kod: Tümünü seç

function TitleCase(const IlkHarf: String): String;
var
  I: Integer;
begin
  if Length(IlkHarf) > 3 then
  begin
    if (Pos(IlkHarf, '') > 0) then
    begin
      Result := '';
    end
    else
    begin
      Result := UpperCase(IlkHarf[1]);
      for I := 2 to Length(IlkHarf) do
        if Pos(IlkHarf[I - 1], ' ') > 0 then
        begin
          Result := Result + UpperCase(IlkHarf[I]);
        end
        else
        begin
          Result := Result + Lowercase(IlkHarf[I]);
         Form3.Caption := Result;
        end;
    end;
  end;
end;

[brs]

Kısmen çözdüm

Kod: Tümünü seç

function TitleCase(const IlkHarf: String): String;
var
  I, J: Integer;
begin
  if Length(IlkHarf) > 3 then
  begin
    if (Pos(IlkHarf, '') > 0) then
    begin
      Result := '0';
    end
    else
    begin
      Result := UpperCase(IlkHarf[1]);
      for I := 2 to Length(IlkHarf) do
        if Pos(IlkHarf[I - 1], ' ') > 0 then
        begin
          Result := Trim(Result + UpperCase(IlkHarf[I]));
        end;
      for J := 1 to Length(Result) do
      begin
        if Not(Result[J] in ['A' .. 'Z', '0' .. '9']) then
          Result := Trim(Result + Lowercase(IlkHarf[I]));
        SplitViewForm.Caption := Result;
      end;
    end;
  end;

[ertank]

Türkçe için ektegre ettiğiniz kod ile ilgili sorun var.

Kod: Tümünü seç

Siz bizim osmanlılaştıramadıklarımızdan mısınız? Yoksa Osmanlılaştıramadıklarımızdan mısınız?

değerini aşağıdaki gibi dönüştürüyor

Kod: Tümünü seç

SIQ BIQIM OSMANLıLASTıRAMADıKLARıMıQDAN MıSıNıQ? YOKSA OSMANLıLASTıRAMADıKLARıMıQDAN MıSıNıQ?

Diğer paylaştığınız kodların amacınn orjinal soru ile aynı olduğunu düşünüyorum. Buna istinaden aşağıdaki noktalarda mantık hatası olabilir diye uyarmak istedim:
(1):

Kod: Tümünü seç

if (Pos(IlkHarf, '') > 0) then

koşulu hiçbir zaman sağlanmaz. Çünkü bu noktada IlkHarf değişkeni içinde en az 4 karakter olduğunu biliyoruz.

(2):

Kod: Tümünü seç

     Result := UpperCase(IlkHarf[1]);
      for I := 2 to Length(IlkHarf) do
        if Pos(IlkHarf[I - 1], ' ') > 0 then

Yukarıda ilk karakter boşluk ise direk Result içine ekliyor. Ayrıca aynı karakteri tekrar for döngüsünde kontrol ediyor

(3):
Gelen IlkHarf değeri bir noktada iki veya daha fazla boşluk karakteri içeriyor ise aşağıdaki kod hatalı çalışacaktır

Kod: Tümünü seç

if Pos(IlkHarf[I - 1], ' ') > 0 then
        begin
          Result := Trim(Result + UpperCase(IlkHarf[I]));
        end;

Mutlaka tek fonksiyon içinde yapmak isiyorsanız aşağıdaki şekilde deneyebilirsiniz.

Kod: Tümünü seç

function GetOzelId2(const Value: string): string;

  function GetLatinLetters(const Value: string): string;
  var
    i: Integer;
  begin
    Result := Value;
    for I := 1 to Length(Result) do
    begin
      case Result[i] of
        'İ': Result[i] := 'I';
        'ı': Result[i] := 'i';
        'Ş': Result[i] := 'S';
        'ş': Result[i] := 's';
        'Ğ': Result[i] := 'G';
        'ğ': Result[i] := 'g';
        'Ç': Result[i] := 'C';
        'ç': Result[i] := 'c';
        'Ü': Result[i] := 'U';
        'ü': Result[i] := 'u';
        'Ö': Result[i] := 'O';
        'ö': Result[i] := 'o';
      end;
    end;
  end;

const
  Numbers = ['0'..'9'];
var
  List: TStringList;
  LocalValue: string;
  TempChar: Char;
  i: Integer;
begin
  LocalValue := Trim(Value);
  if LocalValue = EmptyStr then Exit(EmptyStr);

  List := TStringList.Create();
  try
    List.Delimiter := ' ';
    List.DelimitedText := LocalValue;

    Result := EmptyStr;
    for i := 0 to List.Count-1 do
    begin
      if List[i] <> EmptyStr then
      begin
        TempChar := List[i][1];
        TempChar := GetLatinLetters(TempChar)[1];
        TempChar := UpperCase(TempChar)[1];
        if (Ord(TempChar) >= 65) and (Ord(TempChar) <= 90) then
          Result := Result + TempChar;
      end;
    end;
  finally
    List.Free();
  end;
end;

[brs]

Uyarı ve bilgilendirme için teşekkür ederim...

[Lord_Ares]

Dostum belki faydası olur diye paylaşıyorum.

"Her kelimenin ilk harfi, küçük yazılmışsa büyük "

aşağıdaki fonksiyonu bu forumda bir arkadaşımız paylaşmış ve fonksiyona 3 değerini verirsen her kelimenin ilk harfi büyük oluyormuş.

Kod: Tümünü seç

Function Stringcevir(kelime: string; tip: integer): string;
var
  buyuk, kucuk: string;
  j, i: integer;
Begin
  {
  0 tümü küçük
  1 TÜMÜ BÜYÜK
  2 İlk harf büyük
  3 Her Kelimenin İlk Harfi Büyük
  }
  buyuk := 'ABCÇDEFGĞHIİJKLMNOÖPRSŞTUÜVYZQWX';
  kucuk := 'abcçdefgğhıijklmnoöprsştuüvyzqwx';
  for i := length(Kelime) downto 1 do
    for j := 29 downto 1 do
      if (kelime[i] = buyuk[j]) or (kelime[i] = kucuk[j]) then
        case tip of
          0: kelime[i] := kucuk[j];
          1: kelime[i] := buyuk[j];
          2: if i = 1 then
              kelime[i] := buyuk[j]
            else
              kelime[i] := kucuk[j];
          3: if i = 1 then
              kelime[i] := buyuk[j]
            else if (kelime[i - 1] = ' ') or (kelime[i - 1] = '.') then
              kelime[i] := buyuk[j]
            else
              kelime[i] := kucuk[j];
        end;
  Result :=kelime;
end;