delphi – AHMET AYDINLIK

Delphi, Vcl
delphi, döviz, günlük kur

17Eyl

Delphi İle TCMB den Döviz Kurlarını Çekme

Aşağıdaki procedure de USD ve EURO kuru çekilmiştir

Kurlar diye bir adet memory table oluşturulmuştur

Kurlar Memory Table Field Yapısı
object Kurlar: TJvMemoryData

FieldName = ‘DOVTUR’
DataType = ftString
Size = 100

FieldName = ‘KUR’
DataType = ftFloat

	Procedure DovizKurlari;
	var
		XMLNode: IXMLNode;
		I: Integer;
		XMLDocumentKur: TXMLDocument;
	Begin
		XMLDocumentKur := TXMLDocument.Create(Application);
		try
			try
				XMLDocumentKur.Active := false;
				XMLDocumentKur.FileName := 'https://www.tcmb.gov.tr/kurlar/today.xml';
				XMLDocumentKur.Active := true;
			Except  on E: Exception do
			Begin
				Msg_HataMesaji('İnternet bağlantınızı kontrol edin. TCMB günlük kur bilgisine ulaşılamadı!');
			end;
		end;

		Kurlar.Open;
		Kurlar.EmptyTable;
	
		if XMLDocumentKur.Active then
		Begin
			XMLNode := XMLDocumentKur.DocumentElement.ChildNodes.FindNode('Currency');
			repeat
				if XMLNode.HasAttribute('CurrencyCode') then
				begin
					if (XMLNode.Attributes['CurrencyCode'] = 'USD') then
					begin
						Kurlar.Append;
							KurlarDOVTUR.AsString := 'USD';
							KurlarKUR.AsFloat := StrToFloatDef(StringReplace(XMLNode.ChildNodes.Nodes['ForexSelling'].Text, '.', ',', [rfReplaceAll]), 0);
							DolarKuru := StrToFloatDef(StringReplace(XMLNode.ChildNodes.Nodes['ForexSelling'].Text, '.', ',', [rfReplaceAll]), 0);
						Kurlar.Post;
					end
					else if (XMLNode.Attributes['CurrencyCode'] = 'EUR') then
					begin
						Kurlar.Append;
							KurlarDOVTUR.AsString := 'EURO';
							KurlarKUR.AsFloat := StrToFloatDef(StringReplace(XMLNode.ChildNodes.Nodes['ForexSelling'].Text, '.', ',', [rfReplaceAll]), 0);
							EuroKuru := StrToFloatDef(StringReplace(XMLNode.ChildNodes.Nodes['ForexSelling'].Text, '.', ',', [rfReplaceAll]), 0);
						Kurlar.Post;
					end;
				end;
				XMLNode := XMLNode.NextSibling;
			until XMLNode = nil;
			End
			Else
			Begin
				if Msg_Soru('USD ve EURO Kurunu Elle Tanımlamak İster misiniz ? ') then
				Begin
					Kurlar.Append;
						KurlarDOVTUR.AsString := 'USD';
						KurlarKUR.AsFloat     := StrToFloatDef(InputBox('','USD Kurunu Giriniz','1'),1);
						DolarKuru             :=  KurlarKUR.AsFloat;
					Kurlar.Post;

					Kurlar.Append;
						KurlarDOVTUR.AsString := 'EURO';
						KurlarKUR.AsFloat     := StrToFloatDef(InputBox('','EURO Kurunu Giriniz','1'),1);
						EuroKuru              := KurlarKUR.AsFloat ;
					Kurlar.Post;
				End
				Else
				Begin
					Kurlar.Append;
						KurlarDOVTUR.AsString := 'USD';
						KurlarKUR.AsFloat     := 1;
						DolarKuru             := 1;
					Kurlar.Post;

					Kurlar.Append;
						KurlarDOVTUR.AsString := 'EURO';
						KurlarKUR.AsFloat     := 1;
						EuroKuru              := 1;
					Kurlar.Post;
				End;
		    End;
		finally
			XMLDocumentKur.Free;
		end;
	End;

Delphi, Vcl
delphi, delphi json, delphi json okuma, JSON

11Eyl

Delphi Json veri Alma

Qr-code lar da oluşan verileri okumak için aşağıdaki kodlar yardımcı olacaktır

aşağıdaki örnek bir e-irsaliye de bulunan qr-code verisinin içindeki almak için örneklendirilmiştir

uses System.JSON;

procedure TForm3.Button1Click(Sender: TObject);
var
  jsonData: TJSONObject;
begin
  // JSON veriyi bir TJSONObject nesnesine çözümle
  jsonData := TJSONObject.ParseJSONValue(Memo1.Lines.Text) as TJSONObject;

  if Assigned(jsonData) then
  begin
    try
      // ettn değerini al
      edit1.Text := jsonData.GetValue('ettn').Value;
      edit2.Text := jsonData.GetValue('vkntckn').Value;
      edit3.Text := jsonData.GetValue('avkntckn').Value;
      edit4.Text := jsonData.GetValue('senaryo').Value;
      edit5.Text := jsonData.GetValue('tip').Value;
      edit6.Text := jsonData.GetValue('tarih').Value;
      edit7.Text := jsonData.GetValue('no').Value;
      edit8.Text := jsonData.GetValue('sevktarihi').Value;
      edit9.Text := jsonData.GetValue('sevkzamani').Value;
      edit10.Text := jsonData.GetValue('tasiyicivkn').Value;
      edit11.Text := jsonData.GetValue('plaka').Value;


    finally
      jsonData.Free;
    end;
  end
  else
  begin
    ShowMessage('JSON Verisi Çözümlenemedi.');
  end;
end;

Örnek Programı İndirmek için aşağıdaki bağlantıyı kullanınız

Kaynak Kodları İndir

Delphi, Vcl
delphi, print, tarayici, webbrowser, yazdirma

2Tem

Delphi Web Browser Yazdırma İşlemleri

procedure TForm1.Button1Click(Sender: TObject);
begin
WebBrowser1.Navigate(‘https://ahmetaydinlik.com/‘);
end;

// Yazdır Dialog Penceresi Açmadan Yazdırma

procedure TForm1.Button2Click(Sender: TObject);
var
vaIn, vaOut: OleVariant;
begin
WebBrowser1.ControlInterface.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER,
vaIn, vaOut);
end;

// Yazdırma Dialog Penceres Açarak Yazdırma

procedure TForm1.Button3Click(Sender: TObject);
var
vaIn, vaOut: OleVariant;
begin
WebBrowser1.ControlInterface.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_PROMPTUSER,
vaIn, vaOut);
end;

// Önizleme

procedure TForm1.Button4Click(Sender: TObject);
var
vaIn, vaOut: OleVariant;
begin
WebBrowser1.ControlInterface.ExecWB(OLECMDID_PRINTPREVIEW,
OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut);
end;

// Sayfa ayarları dialogu açarak

procedure TForm1.Button5Click(Sender: TObject);
var
vaIn, vaOut: OleVariant;
begin
WebBrowser1.ControlInterface.ExecWB(OLECMDID_PAGESETUP, OLECMDEXECOPT_PROMPTUSER,
vaIn, vaOut);
end;

Delphi, Vcl
delphi, font style, string to style, style to string

14Şub

Font Style Stringe Çevirme ve String i Font Style Çevirme

function FontStyletoStr(St: TFontStyles): string;
var
  S: string;
begin
  S := '';
  if St = [fsbold] then S := 'Kalın'
  else if St = [fsItalic] then S := 'İtalik'
  else if St = [fsStrikeOut] then S := 'Üstu Çizgili'
  else if St = [fsUnderline] then S := 'Altı Çizgili'

  else if St = [fsbold, fsItalic] then S := 'Kalın İtalik'
  else if St = [fsBold, fsStrikeOut] then S := 'Kalın, Üstü Çizgili'
  else if St = [fsBold, fsUnderline] then S := 'Kalın, Altı Çizlili'
  else if St = [fsbold,fsItalic, fsStrikeOut] then S := 'Kalın İtalic Üstü Çizgili'
  else if St = [fsBold, fsUnderline,fsStrikeOut] then S := 'Kalın Altı Çizgili Üstü Çizgili'
  else if St = [fsbold,fsItalic, fsUnderline] then S := 'Kalın İtalic Altı Çizgili'
  else if St = [fsItalic, fsStrikeOut] then S := 'İtalik Üstü Çizgili'
  else if St = [fsItalic,fsUnderline] then S := 'İtalik Altı Çizgili'
  else if St = [fsUnderLine,fsStrikeOut] then S := 'Altı Üstü Çizgili'
  else if St = [fsItalic,fsStrikeOut] then S := 'İtalik Altı Çizgili';
  Result := S;
end;

function Pnn_StrtoFontStyle(St: string): TFontStyles;
var
  S: TfontStyles;
begin
  S  := [];

  if St = 'Kalın' then S :=[fsbold]
  else if St = 'İtalik'  then S :=[fsItalic]
  else if St = 'Üstu Çizgili' then S :=[fsStrikeOut]
  else if St = 'Altı Çizgili' then S := [fsUnderline]

  else if St = 'Kalın İtalik' then S :=[fsbold,fsItalic]
  else if St = 'Kalın, Üstü Çizgili' then S :=[fsBold, fsStrikeOut]
  else if St = 'Kalın, Altı Çizlili' then S :=[fsBold, fsUnderline]
  else if St = 'Kalın İtalic Üstü Çizgili' then S :=[fsbold,fsItalic, fsStrikeOut]
  else if St = 'Kalın İtalic Altı Çizgili' then S := [fsbold,fsItalic, fsUnderline]
  else if St = 'Kalın Altı Çizgili Üstü Çizgili' then S :=[fsBold, fsUnderline,fsStrikeOut]

  else if St = 'İtalik Üstü Çizgili' then S :=[fsItalic, fsStrikeOut]
  else if St = 'İtalik Altı Çizgili'  then S :=[fsItalic,fsUnderline]
  else if St = 'Altı Üstü Çizgili' then S := [fsUnderLine,fsStrikeOut]
  else if St = 'İtalik Altı Çizgili' then S := [fsItalic,fsStrikeOut];
  Result := S;
end;

Kullanımı

Font Dialogtaki Seçilen Style ı string e çeviriyoruz
edit1.text :=  FontStyletoStr(FontDialog1.Font.Style);

Edit teki Style ımızı Edit1 in fontuna atıyoruz
Edit1.Font.Style := StrtoFontStyle(Edit1.Text);

20Eki

Delphi Tutarı Yazıya Çevirme Function

function YaziyaCevir(Rakam:real ):string;
  const
    b1:ARRAY [1..9] of string =
      ('BİR','İKİ','ÜÇ','DÖRT','BEŞ','ALTI','YEDİ','SEKİZ','DOKUZ');
    b2:ARRAY [1..9] of string =
      ('ON','YİRMİ','OTUZ','KIRK','ELLİ','ALTMIŞ','YETMİŞ','SEKSEN','DOKSAN');
    b3:ARRAY [1..6] of string =
      ('KATRİLYON','TRİLYON','MİLYAR','MİLYON','BİN','');
  var
    gr:ARRAY [1..6] of string[3];
    sn:ARRAY [1..6] of string;
    bs:ARRAY [1..3] of integer;
    tutars, tutart, tutark , sonuct, sonuck: string;
    tur,i,l: integer;


  begin
     tutars:=floattostr(Rakam);
     if pos(',',tutars)=0 then tutars:=tutars+',00';
     tutart:=copy(tutars,1,(pos(',',tutars)-1));
     tutark:=copy(tutars,(pos(',',tutars)+1),2);
     tutart:=stringofchar('0',(18-(length(trim(tutart))))) + tutart;
     tutark:=tutark + stringofchar('0',( 2-(length(trim(tutark)))));
     for i:=1 to 6 do gr[i]:=copy(tutart,1+(3*(i-1)),3);

     for l:=1 to 6 do
      begin
        bs[1]:=strtoint(copy(gr[l],1,1));
        if bs[1]<>0 then
          (
            if bs[1]<>1 then
              sn[l]:=sn[l]+b1[bs[1]]+'YÜZ'
            else
              sn[l]:=sn[l]+'YÜZ'
          );
        bs[2]:=strtoint(copy(gr[l],2,1));
        if bs[2]<>0 then sn[l]:=sn[l]+b2[bs[2]];
        bs[3]:=strtoint(copy(gr[l],3,1));
        if bs[3]<>0 then sn[l]:=sn[l]+b1[bs[3]];
        if length(trim(sn[l]))<>0 then sn[l]:=sn[l]+b3[l];
      end;

     if sn[5]='BİRBİN' then sn[5]:='BİN';
     for i:=1 to 6 do sonuct:=sonuct+sn[i];
     if strtoint(copy(tutark,1,1))<> 0 then sonuck:=sonuck + b2[strtoint(copy(tutark,1,1))];
     if strtoint(copy(tutark,2,1))<> 0 then sonuck:=sonuck + b1[strtoint(copy(tutark,2,1))];
     if tur=0 then result:=sonuct + '.TL / ' + sonuck + '.KR ';
     if tur=1 then result:=sonuct + '.TL ';
     if tur=2 then result:=sonuck + '.KR ';
  end;

Delphi, Vcl
base64, base64topdf, decode, delphi, encode, pdftobase64

4Eki

Delphi Dosya base64 Decode ve Encode

Projemize alttaki kütüphaneleri ekliyoruz

daha sonra formumuza 2 adet buton bir tane filenameedit yada opendialog da olabilir 1 tane de memo ekliyoruz

     
    uses Soap.EncdDecd,System.NetEncoding;

Dosyamızı base64 formatına çevirmek için aşağıdaki kodu kullanıyoruz


procedure TForm3.Button1Click(Sender: TObject);
var
   stream: TMemoryStream;
begin
    stream := TMemoryStream.Create;
     try
           stream.LoadFromFile(JvFilenameEdit1.Text);
           Memo1.Text := EncodeBase64(stream.Memory, stream.Size);
     finally
          stream.Free;
  end;
end;

Base64 olan bir string i dosyaya çevirmek için benim çevirdiğim dosya pdf olduğundan pdf olarak ekledim


procedure TForm3.Button2Click(Sender: TObject);
var
   stream : TmemoryStream;
begin
stream := TmemoryStream.Create;
   stream.write(TNetEncoding.Base64.DecodeStringToBytes(Memo1.Text),
   length(TNetEncoding.Base64.DecodeStringToBytes(Memo1.Text)));
    stream.Position := 0;
   stream.SaveToFile('d:\test2.pdf');
end;

Delphi, Vcl
10.3, 10.4, ArrayFree, delphi, Dizi Silme, FreeAndNil

31Ağu

Delphi 10.4 FreeAndNil Hatası Çözümü

Delphi 10.3 olan freeandnil komutunda 10.4 versiyonunda değişikliğe gidilmesinden dolayı sadece Tobject leri gönderebiliyoruz array ları freeandnil olarak kullanamıyoruz

Delphi 10.3 deki FreeAndNil Procedure 
procedure FreeAndNil(var Obj);
{$IF not Defined(AUTOREFCOUNT)}
var
  Temp: TObject;
begin
  Temp := TObject(Obj);
  Pointer(Obj) := nil;
  Temp.Free;
end;
{$ELSE}
begin
  TObject(Obj) := nil;
end;
{$ENDIF}
Delphi 10.4 deki FreeAndNil Procedure 

procedure FreeAndNil(const [ref] Obj: TObject);
{$IF not Defined(AUTOREFCOUNT)}
var
  Temp: TObject;
begin
  Temp := Obj;
  TObject(Pointer(@Obj)^) := nil;
  Temp.Free;
end;
{$ELSE}
begin
  Obj := nil;
end;
{$ENDIF}

çözüm için şöyle bir yol buldum 

procedure AHMET_FreeAndNil(var Obj);
{$IF not Defined(AUTOREFCOUNT)}
var
  Temp: TObject;
begin
  Temp := TObject(Obj);
  Pointer(Obj) := nil;
  Temp.Free;
end;
{$ELSE}
begin
  TObject(Obj) := nil;
end;
{$ENDIF}

10.4 versiyonunda procedure nin ismini değiştirip projeye dahil ettiğimizde AHMET_FreeAndNil(array1); olarak kullanıp arrayları free edebiliyoruz

Delphi, FireMonkey
delphi, fmx, mobil

19Ağu

Delphi Fmx Mobil Modal Dialog

Delphi Android ile Modal İnputbox İşlemi

FMX.Dialogs.InputBox(
						'Miktar Giriniz ','','0',
						procedure(const AResult: TModalResult; const AValue: string)   
						begin
							case AResult of
								mrOk:
									begin
										ShowMessage('Veri Girildi');
									End;
								end;
							end;
						end
					);

Delphi, FireMonkey
delphi, fmx

19Ağu

Delphi FMX Mobil de Enter Tuşu İle İlermek

Mobil uygulama klavyedeki Enter tuşuna basınca sonraki işleme yapmak için kullandığım kod

procedure TForm.SifreKeyUp(Sender: TObject; var Key: Word; var KeyChar: Char;
  Shift: TShiftState);
begin
  if sender is TEdit then
    if Key in [vkReturn] then
      case TEdit(sender).ReturnKeyType   of
        TReturnKeyType.Send : Button1Click(Self);
      end;
end;

Delphi, FireMonkey
delphi, firemonkey, fmx, stringgrid

19Ağu

Delphi FMX Grid Renklendirme

Delphi Firemonkey string grid renklendirme kodu

procedure TForm.StringGrid1DrawColumnCell(Sender: TObject;
const Canvas: TCanvas; const Column: TColumn; const Bounds: TRectF;
const Row: Integer; const Value: TValue; const State: TGridDrawStates);
 
begin
 aRowColor := TBrush.Create(TBrushKind.Solid, TAlphaColors.Alpha);
 
if Sartim > 0 then
  aRowColor.Color := TAlphaColorRec.Aqua
else
if Sartim  = 0 Then
  ARowColor.Color := TAlphaColorRec.Lime
else
if Sartim  <  0 then
  aRowColor.Color := TAlphaColorRec.Aliceblue;
 
aNewRectF := Bounds;
aNewRectF.Inflate(3, 3);
Canvas.FillRect(aNewRectF, 0, 0, [], 1, aRowColor);
Column.DefaultDrawCell(Canvas, Bounds, Row, Value, State);
 
aRowColor.free;
 
 
 
end;

AHMET AYDINLIK

Etiket arşivi: delphi