Bazı Çeviri Fonksiyonları Unit dosyası

Selamlar

İhtiyaç duyduğumda ufak tefek dönüştürme fonksiyonları yazmıştım.
Bunları bir araya getirdiğim Uniti paylaşayım dedim.
Bazı fonksiyonlar Delphi 3'den beri gelen fonksiyonlar olduğundan yeni versiyonlarda daha basit çözümleride olabilir
Eh artık bununda kusuruna bakmazsınız sanırım
Unit UnitDonusumler;

interface

uses
*Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
*StdCtrls, StrUtils, DateUtils, Jpeg, variants,
*IdHashMessageDigest, //Md5 Sifreleme için
*Math;

const
*Harfler_TXT : String = 'ıİüÜşŞöÖğÐçÇ';
*Harfler_CHR : array[1..12] of Integer = (253, 221, 252, 220, 254, 222, 246, 214, 240, 208, 231, 199);
*Harfler_ASC : array[1..12] of Integer = (141, 152, 129, 154, 159, 158, 148, 153, 167, 166, 135, 128);

*BinTable: array [0..15] of string =
* // 0 * * * 1 * * * 2 * * * 3 * * * 4 * * * 5 * * * 6 * * * 7 * * * 8 * * * 9 * * * A * * * B * * * C * * * D * * * E * * * F
* *('0000', '0001', '0010', '0011', '0100', '0101', '0110', '0111', '1000', '1001', '1010', '1011', '1100', '1101', '1110', '1111');

type
*TRGB=Record
* *R : Byte;
* *G : Byte;
* *B : Byte;
end;

type
*CeviriTipleri = (TypeCHR, TypeASC, TypePrinter);

* *function fn_HexDegerKontrol(pHexDeger:String):Boolean;

* *function fn_ChuckSumLRC(pStr : string) :byte;
* *function fn_HexToInt64(pHexDeger:String):Int64;
* *function fn_CharConvert(pCeviriTipi:CeviriTipleri; pDeger:String):String;
* *function fn_HexToBin(pHex: string): string;
* *function fn_KarakterSil(pStr, pSilinecekKarakter:String):String;
* *function fn_AscToHex(pStr, pBaglac:AnsiString):AnsiString;
* *function fn_HexToAsc(pStr:String):String;
* *function fn_TurkceleriDegistir(pStr:String):String;
* *function fn_TBytesToString(pBytes:TBytes): String;
* *function fn_BytesArrayToString(bytearray: array of byte; len : Integer ): String;
* *function fn_BarCodeEAN13_CheckDigit_Hesapla(FVeri: String):String;
* *function fn_StringParcala(pStr, pAyirac : String) : TStrings;
* *function fn_StringTersCevir(pStr: String) : String;
* *function fn_StrTamamla(pDolacakData:String; pDolduracakData:Char; pAdet:SmallInt):String;
* *function FarkZaman(BasZaman, BitZaman:TDateTime; var FSaat, FDakika, FTplDakika: Double):String;

* *function fn_StringToMemoryStream(pString: String): TMemoryStream;
* *function fn_MemoryStreamToString(pMemoryStream: TMemoryStream): String;
* *function fn_CepTelKotrol(_sCepTel : string) : string;

* *function fn_CheckLRC(const s: AnsiString): byte;
* *function fn_BCC_Bul(FVeri: String):String;
* *function fn_BCC_FarmaDRC_SerialNo(FVeri: String):String;
* *function fn_Fatek_LRC_Hesapla(pData:String):String;
* *function fn_Fatek_CRC16_ModeBus(pData:String):String;
* *function fn_CRC_ParaTanima(pData:String):String;
* *function fn_MD5_Olutur(pData:String):String;

* *function fn_StrToFloat(pStr, DecSeperator : String):String;
* *function fn_NumStringToBCD(const inStr: string): string;
* *function fn_BCDToNumString(const inStr: string): string;
* *procedure pr_StringToByteArray(const inStr: string; var InOutByte:Array of Byte);

* *function fn_ReSizeJpgToJpg(_Jpeg : TJpegImage; _iWidth, _iHeight:Integer):TJpegImage;

* *function fn_Renk_ColorToHex( Color : TColor ) : string;
* *function fn_Renk_HexToColor( sColor : string ) : TColor;
* *function fn_Renk_ColorToRGB( Color : TColor ) : TRGB;
* *function fn_Renk_RGBToColor(_RGB : TRGB ) : TColor;
* *function fn_Renk_IntToColor( iValue : Integer ) : TColor;
* *function fn_Renk_IntToHex( iValue : Integer ) : String;

* *function fn_VariantToString(_AVar: OleVariant): string;
* *function fn_StrToHex(sValue:WideString):WideString;

var
*ConvetTipi : CeviriTipleri;


implementation

function fn_MemoryStreamToString(pMemoryStream: TMemoryStream): String;
var
*xString : String;
begin
*xString := '';
*SetString(xString, PChar(pMemoryStream.Memory), pMemoryStream.Size div SizeOf(Char));
*Result := xString;
end;

function fn_StringToMemoryStream(pString: String): TMemoryStream;
var
*xMemoryStream: TMemoryStream;
begin
*xMemoryStream := TMemoryStream.Create;
*xMemoryStream.WriteBuffer(Pointer(pString)^, (Length(pString) * 2));
*xMemoryStream.Position := 0;
*Result := xMemoryStream;
end;


function fn_MD5_Olutur(pData:String):String;
var
*IdMD5: TIdHashMessageDigest5;
begin
* *try
* * * Result := '';
* * * IdMD5 := TIdHashMessageDigest5.Create;
* * * Result := IdMD5.HashStringAsHex(pData);
* *except
* *end;
* *IdMD5.Free;
end;

function fn_CRC_ParaTanima(pData:String):String;
var
*CRCToplam, TmpMod, I: Integer;
*TmpStr : String;
begin
*TmpStr := pData;

*CRCToplam := 0;
*for I := 1 to Length(TmpStr) do
* *CRCToplam := CRCToplam + Ord(TmpStr);

{
*if CRCToplam > 256 then
*begin
* *TmpMod := CRCToplam Mod 512;
* *if TmpMod = 0 then
* * *Result := '00'
* *else
* * *Result := IntToHex((512 - (CRCToplam Mod 512)), 2);
*end
*else
*begin
}
* *TmpMod := CRCToplam Mod 256;
* *if TmpMod = 0 then
* * *Result := '00'
* *else
* * *Result := IntToHex((256 - (CRCToplam Mod 256)), 2);
// *end;
end;

function FarkZaman(BasZaman, BitZaman:TDateTime; var FSaat, FDakika, FTplDakika: Double):String;
Var
*Fark: Double;
begin
*Result:='';
*if BasZaman > BitZaman Then
* *Result:='Hatalı Parametre.';
*Fark:=((BitZaman - BasZaman) * 24);
*FSaat:=Trunc(Fark);
*FDakika:=(Frac(Fark) * 60);
// *FDakika:=Round((Frac(Fark) * 60));
*if FDakika = 60 Then
*begin
* *FSaat:=FSaat + 1;
* *FDakika:=0;
*end;
* *FTplDakika :=Floor(((FSaat * 60) + FDakika))
end;

function fn_HexDegerKontrol(pHexDeger:String):Boolean;
var
*i : Smallint;
begin
*Result := True;
*for i := 1 to Length(pHexDeger) do
* *if Not(pHexDeger in ['0'..'9', 'A'..'F', 'a'..'f']) *then
* * *Result := False;
end;

function fn_Fatek_CRC16_ModeBus(pData:String):String;
var
*CRC: word;
*N, I: integer;
*B:byte;
begin
*CRC := $FFFF;
*for I := 1 to Length (pData) do
*begin
* *B := Ord(pData);
* *CRC := CRC xor B;
* *for N := 1 to 8 do
* *begin
* * *if (CRC and 1)0 then
* * * *CRC := (CRC shr 1) xor $A001
* * *else
* * * *CRC := CRC shr 1;
* *end;
*end;
Result := Chr(CRC and $ff) + Chr(CRC shr 8);
end;

function fn_Fatek_LRC_Hesapla(pData:String):String;
var
*T, I : Integer;
*H : String;
begin
*T := 0;
*for I := 1 to Length(pData) do
* *T := T + Ord(pData);
*H := IntToHex(T, 8);
*Result := H[7] + H[8];
end;

function fn_BCC_Bul(FVeri: String):String;
var i,x:Integer;
begin
*x:= ord(FVeri[1]) xor ord(FVeri[2]);
*for i := 3 to Length(FVeri) do
*begin
* *x:= x xor Ord(FVeri);
*end;
*Result := IntToHex(x, 2);
end;

function fn_BCC_FarmaDRC_SerialNo(FVeri: String):String;
var i,x:Integer;
begin
*x:= ord(FVeri[1]) xor 77;
*for i := 2 to Length(FVeri) do
*begin
* *x:= x xor Ord(FVeri);
*end;
*Result := IntToHex(x, 2);
end;

function fn_HexToBin(pHex: string): string;
var
*i: integer;
begin
*Result := '';
*for i := Length(pHex) downto 1 do
* *Result := BinTable[StrToInt('$' + pHex)] + Result;
end;

function fn_CheckLRC(const s: AnsiString): byte;
var i: integer;
begin
*result := 0;
*for i := 1 to length(s) do
* *inc(result,ord(s));
*result := (result xor $FF)+1; // or result := (not result)+1;
end;

function fn_ChuckSumLRC(pStr : string) :byte;
var i : Integer;
*Len : integer;
*lrc : byte;
begin
*Len := length(pStr);
*lrc := 0;
*if len > 0 then
*begin
* *lrc := ord(len);
* *for i := 2 to Len do
* * *lrc := lrc xor (Ord(pStr[i-1]));
* *end;
*Result := lrc;
end;

function fn_StrTamamla(pDolacakData:String; pDolduracakData:Char; pAdet:SmallInt):String;
begin
*while Length(pDolacakData) < pAdet do
* *pDolacakData := pDolacakData + pDolduracakData;

*Result := Copy(pDolacakData, 1, pAdet);
end;

function fn_StringTersCevir(pStr : String): String;
var
*i : Integer;
Begin
*Result := '';
*For i := Length(pStr) DownTo 1 Do
*Begin
* *Result := Result + Copy(pStr, i, 1) ;
*End;
end;

function fn_StringParcala(pStr, pAyirac : String) : TStrings;
var
*Sonuc : TStringList;
*I : integer;
*Parca : string;
begin
*Sonuc := TStringList.Create();
*Parca := '';

*for i := 1 to Length(pStr) do
*begin
* *if pStr pAyirac then
* * *Parca := Parca + pStr
* *else
* *begin
* * *Sonuc.Add(Parca);
* * *Parca := '';
* *end;
*end;

*if Length(pStr) > 0 then
* *if Sonuc.Count = 0 then
* * *parca := pStr;
*Sonuc.Add(Parca);
*Result := Sonuc;
end;

function fn_AscToHex(pStr, pBaglac:AnsiString):AnsiString;
var
* i:Integer;
* WStr:AnsiString;
begin
*WStr := '';
*for i := 1 to Length(pStr) do
* *WStr := WStr + pBaglac + IntTOHex(Ord(pStr),2);
*Result := WStr;
end;

function fn_HexToAsc(pStr:String):String;
var
* i: Integer;
* WStr, HexStr :String;
begin
*WStr := '';
*i := 1;
*while i < Length(pStr) do
*begin
* *if not(pStr in ['0'..'9', 'A'..'F']) then
* *begin
* * *Inc(i);
* * *Continue;
* *end;

* *if not(pStr[i+1] in ['0'..'9', 'A'..'F']) then
* *begin
* * *Inc(i);
* * *Continue;
* *end;

* *HexStr := pStr + pStr[i+1];
* *WStr := WStr + Chr(StrToInt64('$' + HexStr));
* *i:=i+2;
*end;
*Result := WStr;
end;

function fn_KarakterSil(pStr, pSilinecekKarakter:String):String;
var
* i:Integer;
* WStr:String;
begin
*for i := 1 to Length(pStr) do
*begin
* *if pStr = pSilinecekKarakter Then Continue;
* *WStr := WStr + pStr;
*end;
*Result := WStr;
end;

function fn_HexToInt64(pHexDeger:String):Int64;
var
*I:Integer;
*TempStr : String;
*wflag:Boolean;
begin
*try
* *wFlag := False;
* *for I := 1 to Length(pHexDeger) do
* *begin
* * *TempStr := pHexDeger;
* * *if TempStr IN ['0'..'9', 'A'..'F'] then Continue;
* * *wFlag := True;
* * *Break;
* *end;
* *if wFlag = False then
* * *Result := StrToInt64(('$' + pHexDeger))
* *else
* * *Result := 0;
*except
* *Result := 0;
*end;
end;

function fn_CharConvert(pCeviriTipi:CeviriTipleri; pDeger:String):String;
var
*I, P :Integer;
*TempStr:String;
begin
*TempStr := pDeger;
*if pCeviriTipi = TypePrinter then
*begin
* *TempStr := pDeger;
* *TempStr := AnsiReplaceStr(TempStr,'ı', CHR(141));
* *TempStr := AnsiReplaceStr(TempStr,'ç', CHR(135));
* *TempStr := AnsiReplaceStr(TempStr,'ğ', CHR(167));
* *TempStr := AnsiReplaceStr(TempStr,'ö', CHR(148));
* *TempStr := AnsiReplaceStr(TempStr,'ş', CHR(159));
* *TempStr := AnsiReplaceStr(TempStr,'ü', CHR(129));
* *TempStr := AnsiReplaceStr(TempStr,'İ', CHR(152));
* *TempStr := AnsiReplaceStr(TempStr,'Ç', CHR(128));
* *TempStr := AnsiReplaceStr(TempStr,'Ð', CHR(166));
* *TempStr := AnsiReplaceStr(TempStr,'Ö', CHR(153));
* *TempStr := AnsiReplaceStr(TempStr,'Ş', CHR(158));
* *TempStr := AnsiReplaceStr(TempStr,'Ü', CHR(154));
*end
*else
*begin
* *for I := 1 to Length(TempStr) do
* *begin
* * *P := Pos(TempStr, Harfler_TXT);
* * *if P 0 then
* * *begin
* * * *if pCeviriTipi = TypeCHR then TempStr := Chr(Harfler_CHR[P]);
* * * *if pCeviriTipi = TypeASC then TempStr := Chr(Harfler_ASC[P]);
* * *end;
* *end;
*end;
*Result := TempStr;
end;

function fn_TurkceleriDegistir(pStr:String):String;
var
*ws:String;
*i:integer;
begin
*ws:=pStr;
*for i := 1 to Length(ws) do
*begin
* *case ws of
* * *'Ð' : ws := 'G';
* * *'ğ' : ws := 'g';
* * *'Ü' : ws := 'U';
* * *'ü' : ws := 'u';
* * *'Ş' : ws := 'S';
* * *'ş' : ws := 's';
* * *'İ' : ws := 'I';
* * *'ı' : ws := 'i';
* * *'Ö' : ws := 'O';
* * *'ö' : ws := 'o';
* * *'Ç' : ws := 'C';
* * *'ç' : ws := 'c';
* * end;
*end;
*Result := ws;
end;

function fn_BytesArrayToString(bytearray: array of byte; len : Integer ): String;
var
*a: Integer;
begin
*result := '';
*for a := 0 to len-1 do begin
* *result := result + char( bytearray[a] );
*end;
end;

function fn_TBytesToString(pBytes:TBytes): String;
var
*I, xSize: Integer;
*xStr:String;
begin
*xStr := '';
*xSize := Length(pBytes);
*for I := 1 to xSize do begin
* *xStr := xStr + Char(pBytes);
*end;
*Result := xStr;
end;

function fn_BarCodeEAN13_CheckDigit_Hesapla(FVeri: String):String;
var i:Integer;
ModKalan, ToplamTek, ToplamCift:Integer;
begin
*ToplamTek *:= 0;
*ToplamCift := 0;
*for I := 1 to 12 do
*begin
* *case I of
* * 1,3,5,7,9,11 *: ToplamTek *:= ToplamTek *+ StrToInt(FVeri);
* * 2,4,6,8,10,12 : ToplamCift := ToplamCift + StrToInt(FVeri);
* *end;
*end;
*ModKalan := ((ToplamCift * 3) + ToplamTek) Mod 10;
*if ModKalan = 0 then
* *Result := IntToStr(ModKalan)
*else
* *Result := IntToStr(10 - ModKalan);
end;

function fn_CepTelKotrol(_sCepTel : string) : string;
var
*I : Integer;
*Sonuc, bKontrol : Boolean;
begin
* *if _sCepTel[1] = '0' then
* *begin
* * * Delete(_sCepTel,1,1);
* * * if (_sCepTel[1] = '5') and (Length(_sCepTel)=10) then
* * * * Sonuc := True
* * * else
* * * * Sonuc := False;
* *end else
* *begin
* * * if (_sCepTel[1] = '5') and (Length(_sCepTel)=10) then
* * * * Sonuc := True
* * * else
* * * * Sonuc := False;
* *end;

* *if Sonuc = True Then
* * *for I := 1 to Length(_sCepTel) do
* * * *if Not(_sCepTel in ['0'..'9']) then
* * * * *Sonuc := False;

* *if Sonuc = True Then
* *begin
* * * *bKontrol := True;
* * * *for I := 1 to Length(_sCepTel) do
* * * * * *if I < Length(_sCepTel) then
* * * * * * * *if _sCepTel _sCepTel[I+1] then
* * * * * * * * * *bKontrol := False;

* * * *if bKontrol = True then
* * * * * Sonuc := False;
* *end;

* *if Sonuc = True then
* * *Result := _sCeptel
* *else
* * *Result := '';
end;

function fn_NumStringToBCD(const inStr: string): string;
*function Pack(ch1, ch2: Char): Char;
*begin
* *Assert((ch1 >= '0') and (ch1 = '0') and (ch2 = '0') and (ch1 = '0') and (ch2 _Jpeg.Width then
* * * *scale := 100 / _Jpeg.Height
* * *else
* * * *scale := 100 / _Jpeg.Width;
* * *bmp := TBitmap.Create;
* * *try
* * * *{Create thumbnail bitmap, keep pictures aspect ratio}
* * * *bmp.Width := 100; //orj Round(jpg.Width * scale);
* * * *bmp.Height:= 100; //orj Round(jpg.Height * scale);
* * * *bmp.Canvas.StretchDraw(bmp.Canvas.Cliprect, _Jpeg);
* * *finally
* * * *_Jpeg.Assign(bmp);
* * * *bmp.free;
* * *end;
* *finally
* * * *Result := _Jpeg;
* *end;
end;

function fn_Renk_ColorToHex( Color : TColor ) : string;
begin
* *Result := IntToHex( GetRValue( Color ), 2 ) + *//Red
* * * * * * *IntToHex( GetGValue( Color ), 2 ) + *//Green
* * * * * * *IntToHex( GetBValue( Color ), 2 ); * //Blue
end;

function fn_Renk_HexToColor( sColor : string ) : TColor;
begin
* *Result := RGB(StrToInt( '$'+Copy( sColor, 1, 2 ) ), * //Red
* * * * * * * * *StrToInt( '$'+Copy( sColor, 3, 2 ) ), * //Green
* * * * * * * * *StrToInt( '$'+Copy( sColor, 5, 2 ) )); *//Blue
end;

function fn_Renk_IntToHex( iValue : Integer ) : String;
var
*sHex : String;
begin
* *sHex := IntToHex(iValue, 6);
* *sHex := Copy(sHex, 5, 2) + Copy(sHex, 3, 2) + Copy(sHex, 1, 2);
* *Result := sHex;
end;

function fn_Renk_IntToColor( iValue : Integer ) : TColor;
var
*sHex : String;
begin
* *sHex := IntToHex(iValue, 6);
* *Result := RGB(StrToInt( '$'+Copy( sHex, 5, 2 ) ), * //Red
* * * * * * * * *StrToInt( '$'+Copy( sHex, 3, 2 ) ), * //Green
* * * * * * * * *StrToInt( '$'+Copy( sHex, 1, 2 ) )); *//Blue
end;

function fn_Renk_ColorToRGB( Color : TColor ) : TRGB;
begin
* *Result.R := GetRValue( Color ); *//Red
* *Result.G := GetGValue( Color ); *//Green
* *Result.B := GetBValue( Color ); *//Blue
end;

function fn_Renk_RGBToColor(_RGB : TRGB ) : TColor;
begin
* *Result := RGB(_RGB.R, _RGB.G, _RGB.B); // Red, Green, Blue
end;

function fn_StrToHex(sValue:WideString):WideString;
var
*I : Integer;
*_ws : WideString;
begin
* *_ws := '0x';
* *for I := 1 to Length(sValue) do
* * * _ws := _ws + fn_AscToHex(sValue,'');
* *Result := _ws + IntToHex(10, 2) + IntToHex(13, 2);
end;

function fn_VariantToString(_AVar: OleVariant): string;
var
* i: integer;
* V: olevariant;
begin
* Result := '';
* if VarType(_AVar) = (varVariant or varByRef) then
* * *V := Variant(TVarData(_AVar).VPointer^)
* else V := _AVar;

* if VarType(V) = (varByte or varArray) then
* * * try
* * * * for i:=VarArrayLowBound(V,1) to VarArrayHighBound(V,1) do
* * * * * Result := Result + Chr(Byte(V));
* * * except;
* * * end
* * else Result := V;
end;

end.