Duyuruyu Kapat
Facebook Gözat
Twitter Gözat

Kod Bankası

Konu, 'Pascal / Delphi / Delphi.NET' kısmında cemaliozan tarafından paylaşıldı.

  1. hmustak

    hmustak PersianBulls

    Kayıt:
    29 Mayıs 2002
    Mesajlar:
    4,607
    Beğenilen Mesajlar:
    0
    Meslek:
    BT/QA
    Şehir:
    Persian
    HTML koda erişim

    const
    HTMLID_FIND = 1;
    HTMLID_VIEWSOURCE = 2;
    HTMLID_OPTIONS = 3;

    ...

    procedure TForm1.FindIE;
    const
    CGID_WebBrowser: TGUID = '{ED016940-BD5B-11cf-BA4E-00C04FD70816}';
    var
    CmdTarget : IOleCommandTarget;
    vaIn, vaOut: OleVariant;
    PtrGUID: PGUID;
    begin
    New(PtrGUID);
    PtrGUID^ := CGID_WebBrowser;
    if WebBrowser1.Document <> nil then
    try
    WebBrowser1.Document.QueryInterface(IOleCommandTarget, CmdTarget);
    if CmdTarget <> nil then
    try
    CmdTarget.Exec( PtrGUID, HTMLID_FIND, 0, vaIn, vaOut);
    finally
    CmdTarget._Release;
    end;
    except
    // Nothing
    end;
    Dispose(PtrGUID);
    end;


    //bunlar kendi kodbankıma zamanında eklediğim sourcelar. (ben yazmadım). uzun zamandır aktif olarak delphi ile uğraşmıyorum, olası hatalardan sorumlu tutulamam :)
     
  2. hmustak

    hmustak PersianBulls

    Kayıt:
    29 Mayıs 2002
    Mesajlar:
    4,607
    Beğenilen Mesajlar:
    0
    Meslek:
    BT/QA
    Şehir:
    Persian
    aranan kısmın reklendirilmesi

    for I := 0 to RichEdit1.Lines.Count do
    begin
    PosReturn := Pos(Edit1.Text,RichEdit1.Lines);
    //if PosReturn > 0 then {found!}
    //begin
    SkipChars := 0;
    for J := 0 to I - 1 do
    SkipChars := SkipChars + Length(RichEdit1.Lines[J]);
    SkipChars := SkipChars + (I*2);
    SkipChars := SkipChars + PosReturn - 1;

    RichEdit1.SetFocus;
    RichEdit1.SelStart := SkipChars;
    RichEdit1.SelLength := Length(Edit1.Text);
    RichEdit1.SelAttributes.Style:=[fsBOLD];
    RichEdit1.SelAttributes.Color:=ClRed;
    RichEdit1.SelLength := 0;
    //end;
    end;
     
  3. hmustak

    hmustak PersianBulls

    Kayıt:
    29 Mayıs 2002
    Mesajlar:
    4,607
    Beğenilen Mesajlar:
    0
    Meslek:
    BT/QA
    Şehir:
    Persian
    uygulamanın çalıştığı dizini al

    function DizinAl(Klasor: Integer): string;
    var
    PIDL: PItemIDList;
    Yol: LPSTR;
    AMalloc: IMalloc;
    begin
    Yol := StrAlloc(MAX_PATH);
    SHGetSpecialFolderLocation(Application.Handle, Klasor, PIDL);
    if SHGetPathFromIDList(PIDL, Yol) then
    Result := Yol;
    SHGetMalloc(AMalloc);
    AMalloc.Free(PIDL);
    StrDispose(Yol);
    end;
     
  4. hmustak

    hmustak PersianBulls

    Kayıt:
    29 Mayıs 2002
    Mesajlar:
    4,607
    Beğenilen Mesajlar:
    0
    Meslek:
    BT/QA
    Şehir:
    Persian
    querytoexcel

    {Bu kod ornegi herhangi bir table'dan Ad ve Soyad verilerini ceken TQuery verilerini, Excelde yeni bir calisma sayfasi acip icine yazar.}


    {uses satirina comobj unitini ekleyin}

    procedure TForm1.Button1Click(Sender: TObject);
    var
    v,sayfa:variant;{v excel prg, sayfa calisma sayfasi}
    say,i:integer;
    begin
    query1.open;
    say:=query1.recordcount;//query kayit sayisi
    v:=createoleobject('excel.application');//exceli yarat
    v.workbooks.add;//yeni calisma kitabini ekle
    sayfa:=v.workbooks[1].worksheets[1];{Birinci calisma sayfasini sayfa degiskenine ata}
    query1.first;
    for i:=1 to say do
    begin
    sayfa.cells[i,1]:=query1ad.text;
    sayfa.cells[i,2]:=query1soyad.text;
    query1.next;
    end;
    v.visible:=true;//Exceli acip verileri goster
    end;
     
  5. Caylaq

    Caylaq Daimi Üye

    Kayıt:
    11 Aralık 2007
    Mesajlar:
    1,145
    Beğenilen Mesajlar:
    0
    Meslek:
    Product Development Specialist
    Şehir:
    DELPHI LAND
    //--------------------------------------------------------------
    gridden listboxa aktarma
    Kod:
     
    procedure TForm1.Button4Click(Sender: TObject);
    var
      i: Integer;
    begin
      ListBox1.Clear;
      for i := 0 to DBGrid1.RowCount - 1 do
      begin
        if DBGrid1.Selected[i] then
          ListBox1.Items.Add(DBGrid1.Cells[1, i] + ', ' + 
    DBGrid1.Cells[2, i]);
      end;
    end;
    
    //--------------------------------------------------------------
    seçili celli Bulma
    Kod:
     
      StatusBar1.Panels[1].Text := 'Current Cell: ' + IntToStr(ACol) 
    + ',' + IntToStr(ARow);
    
     
  6. Caylaq

    Caylaq Daimi Üye

    Kayıt:
    11 Aralık 2007
    Mesajlar:
    1,145
    Beğenilen Mesajlar:
    0
    Meslek:
    Product Development Specialist
    Şehir:
    DELPHI LAND
    DOSYA KOPYALAMA ( NetWork Üzerindede Sorunsuz Çalışıyor )

    DOSYA KOPYALAMA ( NetWork Üzerindede Sorunsuz Çalışıyor )


    İstenilen Klasöre İstenilen Dosyayı Network üzerinde veya Local Pcde Sorunsuzca Kopyalayabilirsiniz. Bizzat kullandığım kodlardır.

    Önemli Ek Bilgi : Network üzerinde kullanacaksanız İlgili Klasörü MAP etmelisiniz....!!

    Buton1 ile önce Dosyayı seçelim. Sonra ilgili editlere yazdıralım

    Kod:
     
    var
    Dosyauzantisi:AnsiString;
    DosyaAd:AnsiString;
    begin
      OpenDialog1.Title:='HASAR DOSYASINA BELGE EKLE ';
      OpenDialog1.FilterIndex:=1;
      OpenDialog1.InitialDir:='c:\';
        if OpenDialog1.Execute then
        Begin
        Dosyauzantisi:=ExtractFileExt(OpenDialog1.FileName);  // Dosya Uzantısı
        DosyaAd:=ExtractFileNAme(OpenDialog1.FileName);  // Dosya Adı. ( Uzantısıyla) 
        Edit1.Text:=GetCurrentDir + '\' + DosyaAd;
        Edit3.Text:=Dosyaad;
        Edit4.Text:=Dosyauzantisi;
        end;
    


    Sonra Klasör Kontrolü yapalım ve Dosyamızı Kopyalayalım


    Kod:
     
     
    Var
        Baglanti : String;
        Veritabani : String;
    KlasorAdi:String;
    KaydetmeYolu:AnsiString;
    begin
              KlasorAdi:=Label7.Caption; // Müşteri Kodu olarak Klasör Adı veriliyor
              KaydetmeYolu:=Edit2.Text;
     if Edit1.Text='' then
     begin
     ShowMessage('Lütfen Önce Dosya Seçiniz');
     end
     else
     begin
              if not DirectoryExists('w:\PoliceDosyalari\'+KlasorAdi) then   // Klasör Yoksa Oluşturp kopyala    // 3 üde oluyor
              begin
              createDir('w:\PoliceDosyalari\'+KlasorAdi);                    // MüşteriKodu
              createDir('w:\PoliceDosyalari\'+KlasorAdi+'\'+Label8.Caption); // MüşteriKodu\PoliçeNo
              CopyFile( PChar(Edit1.Text), PChar('W:\PoliceDosyalari\'+'\'+ KlasorAdi+'\'+Label8.Caption+'\'+Edit3.Text),True); // True ise üstüne yazmaz.
              ShowMessage('Klasör Yoktu, Oluşturulup , Dosya Eklenmiştir' + KlasorAdi);
              end
              else       // Klasör Varsa sadece kopyala
              begin
              createDir('w:\PoliceDosyalari\'+KlasorAdi+'\'+Label8.Caption); // MüşteriKodu\PoliçeNo
              CopyFile( PChar(Edit1.Text), PChar('W:\PoliceDosyalari\'+'\'+ KlasorAdi+'\'+Label8.Caption+'\'+Edit3.Text),True); // True ise üstüne yazmaz.
              ShowMessage('Klasör Vardı, Dosya Eklenmiştir');
              end;
       end;  
     
    



    Not: Kodlarda görülen editleri , butonları , dialogları eklemelisiniz.

    Eğer çalıştıramazsanız, Foruma sorabilirsiniz.










    DATABASE ALANINA DOSYA KAYDETME
    Alan tipini blob olarak ayarla. Dosyayı binary olarak oku ve kaydet..

    Aşağıdaki Kod Cemakli hocamın linkinden alınmıştır.
    http://forum.ceviz.net/mysql-de-resim-depolama-p403103.html#post403103




    Kod:
     
     
     
    [COLOR=#ff8000]/// kaydetmek için 
     
    [COLOR=#0000bb]procedure TForm1[COLOR=#007700].[COLOR=#0000bb]Button1Click[COLOR=#007700]([COLOR=#0000bb]Sender[COLOR=#007700]: [COLOR=#0000bb]TObject[COLOR=#007700]); 
    [COLOR=#0000bb]begin 
    [COLOR=#0000bb]openpicturedialog1[COLOR=#007700].[COLOR=#0000bb]filter[COLOR=#007700]:=[COLOR=#dd0000]'Resim Dosyaları *.bmp'[COLOR=#007700]; 
    [COLOR=#007700]if [COLOR=#0000bb]openpicturedialog1[COLOR=#007700].[COLOR=#0000bb]Execute then 
    [COLOR=#0000bb]begin 
    [COLOR=#0000bb]   table1[COLOR=#007700].[COLOR=#0000bb]edit[COLOR=#007700]; 
    [COLOR=#0000bb]dbimage1[COLOR=#007700].[COLOR=#0000bb]Picture[COLOR=#007700].[COLOR=#0000bb]loadfromfile[COLOR=#007700]([COLOR=#0000bb]openpicturedialog1[COLOR=#007700].[COLOR=#0000bb]filename[COLOR=#007700]); 
    [COLOR=#0000bb]table1[COLOR=#007700].[COLOR=#0000bb]post[COLOR=#007700]; 
    [COLOR=#0000bb]end[COLOR=#007700]; 
    [COLOR=#0000bb]end[COLOR=#007700]; 
     
    [COLOR=#ff8000]///Okumak için 
    [COLOR=#ff8000]//1. yol 
    [COLOR=#0000bb]procedure TForm1[COLOR=#007700].[COLOR=#0000bb]Button1Click[COLOR=#007700]([COLOR=#0000bb]Sender[COLOR=#007700]: [COLOR=#0000bb]TObject[COLOR=#007700]); 
    [COLOR=#0000bb]begin 
    [COLOR=#0000bb]  Image1[COLOR=#007700].[COLOR=#0000bb]Picture[COLOR=#007700].[COLOR=#0000bb]Bitmap[COLOR=#007700].[COLOR=#0000bb]Assign[COLOR=#007700]([COLOR=#0000bb]Table1Bitmap[COLOR=#007700]); 
    [COLOR=#0000bb]end[COLOR=#007700]; 
     
     
    [COLOR=#ff8000]//2. yol 
    [COLOR=#0000bb]procedure TForm1[COLOR=#007700].[COLOR=#0000bb]Button1Click[COLOR=#007700]([COLOR=#0000bb]Sender[COLOR=#007700]: [COLOR=#0000bb]TObject[COLOR=#007700]); 
    [COLOR=#0000bb]begin 
    [COLOR=#0000bb]  Image1[COLOR=#007700].[COLOR=#0000bb]Picture[COLOR=#007700].[COLOR=#0000bb]Bitmap[COLOR=#007700].[COLOR=#0000bb]Assign[COLOR=#007700]([COLOR=#0000bb]TBLOBField[COLOR=#007700]([COLOR=#0000bb]Table1[COLOR=#007700].[COLOR=#0000bb]Fields[COLOR=#007700][[COLOR=#0000bb]1[COLOR=#007700]])); 
    [COLOR=#0000bb]end[COLOR=#007700]; 
     
     
    [COLOR=#ff8000]//3. yol 
    [COLOR=#0000bb]procedure TForm1[COLOR=#007700].[COLOR=#0000bb]Button1Click[COLOR=#007700]([COLOR=#0000bb]Sender[COLOR=#007700]: [COLOR=#0000bb]TObject[COLOR=#007700]); 
    [COLOR=#007700]var 
    [COLOR=#0000bb]B[COLOR=#007700]: [COLOR=#0000bb]TBitmap[COLOR=#007700]; 
    [COLOR=#0000bb]begin 
    [COLOR=#0000bb]  B [COLOR=#007700]:= [COLOR=#0000bb]TBitmap[COLOR=#007700].[COLOR=#0000bb]Create[COLOR=#007700]; 
    [COLOR=#007700]  try 
    [COLOR=#0000bb]B[COLOR=#007700].[COLOR=#0000bb]Assign[COLOR=#007700]([COLOR=#0000bb]Table1Bitmap[COLOR=#007700]); 
    [COLOR=#0000bb]Image1[COLOR=#007700].[COLOR=#0000bb]Picture[COLOR=#007700].[COLOR=#0000bb]Bitmap[COLOR=#007700].[COLOR=#0000bb]Assign[COLOR=#007700]([COLOR=#0000bb]B[COLOR=#007700]); 
    [COLOR=#0000bb]finally 
    [COLOR=#0000bb]    B[COLOR=#007700].[COLOR=#0000bb]Free[COLOR=#007700]; 
    [COLOR=#0000bb]end[COLOR=#007700]; 
    [COLOR=#0000bb]end[COLOR=#007700];  
    














    .
     
    Son düzenleme yönetici tarafından yapıldı: 28 Ağustos 2008
  7. Caylaq

    Caylaq Daimi Üye

    Kayıt:
    11 Aralık 2007
    Mesajlar:
    1,145
    Beğenilen Mesajlar:
    0
    Meslek:
    Product Development Specialist
    Şehir:
    DELPHI LAND
    DateTimePicker ' daki Bilgiyi AY - YIL- GÜN olarak Ayırma

    DateTimePickerdeki Bilgiyi AY- YIL - GÜN olarak Ayırma


    Bu fonksiyonu projemde kullanmak zorunda kaldım,

    Kodu sizlerle paylaşıyorum ki hazırlarken kaydettiğim zamanı siz de kaydetmeyin

    Umarım yararlı olur




    Kod:
     
    var
      YeniTarihim : TDateTime;
      SadeceGun : string;
      SadeceAy : string;
      SadeceYIL : string;    
    begin
      YeniTarihim := SeciliTarih.Date;
      DateTimeToString(SadeceGun, 'dd', YeniTarihim);
      G.Text:=SadeceGun;
      DateTimeToString(SadeceAy, 'mm', YeniTarihim);
      A.Text:=SadeceAy;
      DateTimeToString(SadeceYIL, 'yyyy', YeniTarihim);
      Y.Text:=SadeceYIL;
    









    .
     
  8. Caylaq

    Caylaq Daimi Üye

    Kayıt:
    11 Aralık 2007
    Mesajlar:
    1,145
    Beğenilen Mesajlar:
    0
    Meslek:
    Product Development Specialist
    Şehir:
    DELPHI LAND
    MERKEZ BANKASI DÖVİZ KURLARI ALMA

    MERKEZ BANKASI DÖVİZ KURLARI ALMA

    Sadece Kopyalayıp , Yapıştırın

    Kolay gelsin...




    Malzemeler

    1 adet IdHTTP
    1 adet Memo
    1 adet Buton
    4 adet Edit



    YAPILIŞI

    Kod:
     
    var
    z,s,alis,satis,aranan:string;
    yer,i:Integer;
    begin
    Memo1.Clear;
    Edit1.Text:='';
    Edit2.Text:='';
    Edit3.Text:='';
    Edit4.Text:='';
    s:=IDHttp1.Get('http://www.tcmb.gov.tr/kurlar/today.html');
    z:=IDHttp1.Get('http://www.tcmb.gov.tr/kurlar/today.html');
    aranan:='1 ABD DOLARI';
    for i:=1 to 2 do
    begin
    yer:=pos(aranan,s);
    yer:=pos(aranan,z);
    if yer=0 then
    begin
    ShowMessage('Kur bilgisi yok');
    exit;
    end
    else
    begin
    yer:=yer+length(aranan);
    s:=copy(s,yer,length(s)-yer);
    z:=copy(z,yer,length(s)-yer);
    s:=trim(s);
    z:=trim(z);
    alis:=copy(s,1,9);
    satis:=copy(z,14,9);
    Memo1.Lines.Add(aranan +' Alış = ' + alis);
    Memo1.Lines.Add(aranan +' Satış = ' + satis);
    aranan:='1 EURO';
    Edit1.Text:=copy(Memo1.Lines.Text,23,8);
    Edit2.Text:=copy(Memo1.Lines.Text,55,8);
    Edit3.Text:=copy(Memo1.Lines.Text,82,8);
    Edit4.Text:=copy(Memo1.Lines.Text,108,8);
    end;
    end;
    
    
     
  9. Caylaq

    Caylaq Daimi Üye

    Kayıt:
    11 Aralık 2007
    Mesajlar:
    1,145
    Beğenilen Mesajlar:
    0
    Meslek:
    Product Development Specialist
    Şehir:
    DELPHI LAND
    Şifreli Access Dosyasına Kolayından Bağlantı Kurma

    Şifreli Access Dosyasına Kolayından Bağlantı Kurma



    Kod:
     
    procedure DataBaglantim;
    var
      veritabani : String;
    Begin
        veritabani := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=VT.mdb;Jet OLEDB:Database Password=123000;';
        qry1.ConnectionString := veritabani;
    end;
     
    





    .
     
  10. Caylaq

    Caylaq Daimi Üye

    Kayıt:
    11 Aralık 2007
    Mesajlar:
    1,145
    Beğenilen Mesajlar:
    0
    Meslek:
    Product Development Specialist
    Şehir:
    DELPHI LAND
    Grid Alt Toplam Almak

    Kod:
     
    procedure AltToplam;
    var
      i: Integer;
      FormulaResult: Double;
      procedure ColumnSum(Index: Integer; var Sum: Double);
      var
        i: Integer;
      begin
        for i := 1 to Pred(RowCount) do
          if not VisibleOnly or RowVisible[i] then Sum := Sum + Cell[Index, i].AsFloat;
      end;               
      function CalculateColumn(Index: Integer; FormulaKind: TFormulaKind): Double;
      var
        i: Integer;
        FormulaSum: Double;
        s: WideString;
        sl: TStringList;
      begin
        FormulaSum := 0;
        if (not VisibleOnly or RowVisible[0]) and (FormulaKind <> fkCount)
          then FormulaSum := Cell[Index, 0].AsFloat;
        case FormulaKind of
          fkAverage:  begin
                        ColumnSum(Index, FormulaSum);
                        FormulaSum := FormulaSum / RowCount;
                      end;
          fkCount:    FormulaSum := RowCount;
          fkCustom:   DoColumnFooterValue(Index, FormulaSum);
          fkDistinct: begin
                        sl := TStringList.Create;
                        for i := 0 to RowCount - 1 do
                          if not VisibleOnly or RowVisible[i] then { visible only }
                          begin
                            s := Cells[Index, i];
                            if sl.IndexOf(s)= - 1 then
                            sl.Add(s);
                          end;
                        FormulaSum := sl.Count;
                        FreeAndNil(sl);
                      end;
          fkMaximum:  for i := 1 to Pred(RowCount) do
                        if (not VisibleOnly or RowVisible[i])
                          and (Cell[Index, i].AsFloat > FormulaSum)
                            then FormulaSum := Cell[Index, i].AsFloat;
          fkMinimum:  for i := 1 to Pred(RowCount) do
                        if (not VisibleOnly or RowVisible[i])
                          and (Cell[Index, i].AsFloat < FormulaSum)
                            then FormulaSum := Cell[Index, i].AsFloat;
          fkSum:      ColumnSum(Index, FormulaSum);
        end;
        DoFooterCalculate(Index, FormulaSum); { event }
        Result := FormulaSum;
      end;
    begin
      for i := 0 to Pred(Columns.Count) do
      begin
        if Columns[i].Footer.FormulaKind <> fkNone then
          if RowCount = 0 then Columns[i].Footer.Caption := '0' else
        begin
          FormulaResult := CalculateColumn(i, Columns[i].Footer.FormulaKind);
          Columns[i].Footer.Caption := FloatToStr(FormulaResult);
          
        end;
      end;
    end;
    
     
  11. Caylaq

    Caylaq Daimi Üye

    Kayıt:
    11 Aralık 2007
    Mesajlar:
    1,145
    Beğenilen Mesajlar:
    0
    Meslek:
    Product Development Specialist
    Şehir:
    DELPHI LAND
    Dbgrid Satır Satır Renklendirme ve Cell Sonuna 3 nokta koyma ve İkon Ekleme vee :))

    Dbgrid Satır Satır Renklendirme , Cell Başına İkon ekleme ve Celle yazı sığmıyorsa cell sonuna 3 nokta koyma olayı. Ayrıca Seçili Satırı labele yazdırma


    Üzerinde çok çalışmıştım bunun , kanımca süper bir çalışma.
    Değerli projemden ceviz.net kullanıcılarına feda olsun


    DrawColumnCell bölümünde, fieldleri kendinize göre ayarlayın


    Kod:
     
        if DBGrid1.Fields[4].asstring <>'K' then
        begin
        DBGrid1.Canvas.Brush.Color := clRed;
        dbGrid1.Canvas.Font.Color:=clYellow; // Fontun rengini değiştirir..
        DBGrid1.DefaultDrawColumnCell(Rect,DataCol,Column,State);
        end
        else if DBGrid1.Fields[7].asstring ='0.00' then
        begin
        DBGrid1.Canvas.Brush.Color := clYellow;
        dbGrid1.Canvas.Font.Color:=ClBlack; // Fontun rengini değiştirir..
        DBGrid1.DefaultDrawColumnCell(Rect,DataCol,Column,State);
        end
           else If (gdSelected in state) then // eğer seçili ise
        begin
        DBGrid1.Canvas.Brush.Color := $00A00000;  // zemin rengi  Lacivert
        DbGrid1.Canvas.Font.Color := clYellow; // font rengi
        UstUnvani.Caption:=DBGrid1.Fields[15].asstring;
        UstMusteriKodu.Caption:=DBGrid1.Fields[16].asstring;
        gRUPkODU.Caption:=DBGrid1.Fields[18].asstring;
        DosyaEki.Caption:=DBGrid1.Fields[19].asstring;
        PolNo.Caption:=DBGrid1.Fields[2].asstring;
        end
        else if (dbgrid1.datasource.dataset.recno mod 2) =0       then
        DBGrid1.Canvas.Brush.Color := $00C8FBFD
        else
        DBGrid1.Canvas.Brush.Color := $00BFD7B5;
        DBGrid1.DefaultDrawColumnCell(Rect, DataCol, Column, State);
     
     
      // Burada özel boyama işlemleri bitmiştir. Artık kendi özelimize girebiliriz.
      if Column.Field.DataType = ftWideString then begin
        if TDBGrid(Sender).Canvas.TextWidth(Column.Field.asString) > (Rect.Right-Rect.Left) then
        begin // Canvas varsayılan font tipine göre, Filed içindeki text veri, eğer
              // DataCell yani hücrenin eninden büyükse. (demek ki devamında örtülü kısım var)
              // Bu durumda örtülü olmayan kısım olana kadar sondan ve fazladan 3 tane fazla kırpıp
              // bu sonradan kırpılan fazlalık kısım yerine ... koyucaz.. nasıl mı ?
          Veri := Column.Field.asString;
          while TDBGrid(Sender).Canvas.TextWidth(Veri) > (Rect.Right-Rect.Left)
            do Delete(Veri, Length(Veri), 1); // Sondan geri doğru kırpıyoruz..
          For i := 1 to 3 do Delete(Veri, Length(Veri), 1); // 3 tane fazla kırptık...
          Veri := Veri + ' ...';
          TDBGrid(Sender).Canvas.FillRect(Rect); // Önce renk doldur..
          TDBGrid(Sender).Canvas.TextOut( Rect.Left+1, Rect.Top+1, Veri );
    end;
    
     
    Son düzenleme yönetici tarafından yapıldı: 17 Mart 2009
  12. Caylaq

    Caylaq Daimi Üye

    Kayıt:
    11 Aralık 2007
    Mesajlar:
    1,145
    Beğenilen Mesajlar:
    0
    Meslek:
    Product Development Specialist
    Şehir:
    DELPHI LAND
    Tarih Parçalama

    Gün Ay Yıl olarak istnilen tarihi Parçalar. Daha kısa yolu olabilir.
    Benim çözümüm bu yönde oldu.


    Faydalı olması dileğiyle


    Kod:
     
    procedure TForm1.btn4Click(Sender: TObject);
    var
      YeniTarihim : TDateTime;
      SadeceGun : string;
      SadeceAy  :  string;
      SadeceYIL : string;
    begin
      YeniTarihim := Now;
      DateTimeToString(SadeceGun, 'dd', YeniTarihim);
      g.Caption:=SadeceGun;
      DateTimeToString(SadeceAy, 'mm', YeniTarihim);
      a.Caption:=SadeceAy;
      DateTimeToString(SadeceYIL, 'yyyy', YeniTarihim);
      y.Caption:=SadeceYIL;
    end;
    



    ..
     
  13. Caylaq

    Caylaq Daimi Üye

    Kayıt:
    11 Aralık 2007
    Mesajlar:
    1,145
    Beğenilen Mesajlar:
    0
    Meslek:
    Product Development Specialist
    Şehir:
    DELPHI LAND
    Formatlama Hakkında

    Formatlama Hakkında Güzel Bir Örnek

    delphibasics sitesinden alıntıdır.



    [FONT=Courier New][COLOR=#808080][COLOR=#008000][COLOR=#808080][FONT=Courier New][FONT=Courier New][FONT=Courier New][FONT=Courier New][FONT=Courier New][FONT=Courier New][FONT=Courier New][FONT=Courier New][FONT=Courier New][COLOR=#008800][FONT=Courier New][FONT=Courier New][FONT=Courier New][FONT=Courier New][FONT=Courier New][COLOR=#008000][FONT=Courier New][FONT=Courier New][COLOR=#008000][FONT=Courier New][COLOR=#008000][FONT=Courier New][COLOR=#c00000][FONT=Courier New][COLOR=#c00000][FONT=Courier New][COLOR=#c00000][FONT=Courier New][COLOR=#c00000][FONT=Courier New][COLOR=#c00000][FONT=Courier New][FONT=Courier New][COLOR=#008000][FONT=Courier New][COLOR=#c00000][FONT=Courier New][COLOR=#c00000][FONT=Courier New][FONT=Courier New][COLOR=#008000][FONT=Courier New][COLOR=#c00000][FONT=Courier New][COLOR=#c00000][FONT=Courier New][COLOR=#c00000][FONT=Courier New][FONT=Courier New][COLOR=#008000][FONT=Courier New][COLOR=#c00000][FONT=Courier New][FONT=Courier New][COLOR=#008000][FONT=Courier New][FONT=Courier New][COLOR=#c00000][FONT=Courier New][FONT=Courier New][COLOR=#c00000][FONT=Courier New][FONT=Courier New][COLOR=#c00000][FONT=Courier New][FONT=Courier New][COLOR=#008000][FONT=Courier New][FONT=Courier New][COLOR=#c00000][FONT=Courier New][FONT=Courier New][COLOR=#c00000][FONT=Courier New][FONT=Courier New][COLOR=#808080][/color][/font][/font][/color][/font][/font][/color][/font][/font][/color][/font][/font][/color][/font][/font][/color][/font][/font][/color][/font][/font][/color][/font][/font][/color][/font][/color][/font][/font][/color][/font][/color][/font][/color][/font][/color][/font][/font][/color][/font][/color][/font][/color][/font][/font][/color][/font][/color][/font][/color][/font][/color][/font][/color][/font][/color][/font][/color][/font][/font][/color][/font][/font][/font][/font][/font][/color][/font][/font][/font][/font][/font][/font][/font][/font][/font][/color][/color][/color][/font]
     
  14. Caylaq

    Caylaq Daimi Üye

    Kayıt:
    11 Aralık 2007
    Mesajlar:
    1,145
    Beğenilen Mesajlar:
    0
    Meslek:
    Product Development Specialist
    Şehir:
    DELPHI LAND
    Sayıyı Yazıya Çevirme





     
  15. Caylaq

    Caylaq Daimi Üye

    Kayıt:
    11 Aralık 2007
    Mesajlar:
    1,145
    Beğenilen Mesajlar:
    0
    Meslek:
    Product Development Specialist
    Şehir:
    DELPHI LAND
    Listbox - Tekrar Eden Kayıtları Teke İndir

    Listbox - Tekrar Eden Kayıtları Teke İndir




    Kod:
     
    procedure TForm1.Button1Click(Sender: TObject);
    var
            i, listIndex   : integer;
            str            : string;
    begin
            for  i:=ListBox1.Items.Count - 1  downto 0 do
            begin
                    str       := ListBox1.Items.Strings[i];
                    listIndex := ListBox1.Items.IndexOf(str);
                    if (listIndex <> -1) AND (listIndex <> i) then
                    begin
                            ListBox1.Items.Delete(listIndex);
                    end;
            end;
    end;
    
     
  16. Caylaq

    Caylaq Daimi Üye

    Kayıt:
    11 Aralık 2007
    Mesajlar:
    1,145
    Beğenilen Mesajlar:
    0
    Meslek:
    Product Development Specialist
    Şehir:
    DELPHI LAND
    DbGrid - Kolona Göre Sıralama

    Kod:
     
    procedure TForm71.DBGrid1TitleClick(Column: TColumn);
    begin
          adotable1.IndexFieldNames:=Column.FieldName;         // Kolona Göre Sıralama
    end;
     
    







    .
     
  17. Caylaq

    Caylaq Daimi Üye

    Kayıt:
    11 Aralık 2007
    Mesajlar:
    1,145
    Beğenilen Mesajlar:
    0
    Meslek:
    Product Development Specialist
    Şehir:
    DELPHI LAND
    IP adresinden bilgisayarın adının bulunması








    ...
     
  18. Caylaq

    Caylaq Daimi Üye

    Kayıt:
    11 Aralık 2007
    Mesajlar:
    1,145
    Beğenilen Mesajlar:
    0
    Meslek:
    Product Development Specialist
    Şehir:
    DELPHI LAND
    ip to domain çevirici






    ...
     
  19. Caylaq

    Caylaq Daimi Üye

    Kayıt:
    11 Aralık 2007
    Mesajlar:
    1,145
    Beğenilen Mesajlar:
    0
    Meslek:
    Product Development Specialist
    Şehir:
    DELPHI LAND
    ListBox - Sadece Seçilenler Üzerinde İşlenm Yapma

    Projemden Cevizcilere Basit ama çok kullanışlı bir kesit daha sunuyorum :D

    Faydalı olması dileğiyle



    Kod:
     
    var
      c:integer;
    begin
          for c:=0 to Jvlistbox1.count-1 do
          begin
              if (Jvlistbox1.Items.Strings[c] <> '') and (Jvlistbox1.Selected[c]) then
              begin
                   Showmessage(Jvlistbox1.Items.Strings[c] );
              end;
          end;
    
     
  20. Caylaq

    Caylaq Daimi Üye

    Kayıt:
    11 Aralık 2007
    Mesajlar:
    1,145
    Beğenilen Mesajlar:
    0
    Meslek:
    Product Development Specialist
    Şehir:
    DELPHI LAND
    Webden İçerik almanın Alternatif Yöntemleri

    Projemden bir kesit daha. Webdeki bilgiyi işleyip İstediğiniz methodla alma.

    Faydalı olması dileğiyle



    Kod:
     
     const
     SourceFile = 'http://www.tcmb.gov.tr/kurlar/toccday.html';
     DestFile = 'c:\Kurlar.xml';
    begin
        if DownloadFile(SourceFile, DestFile) then
        begin
          ShowMessage('İndirme işlemi başarılı !');
        end else begin
          ShowMessage('Hata : ' + SourceFile)
        end;
    


    Kod:
     
     
     
    procedure TForm113.Button3Click(Sender: TObject);
    var
    s: String;
    Yol:String;
    Tarih:String;
    begin            // Şirket Adı Gizlenmiştir
      Yol:='http://transfer.xxxxx.com/Post/FormAction.do?direction=PostListeleme&userName=abc&userPassword=password&tanzimTarihi=';
      Tarih:=(y.Text)+'-'+(a.Text)+'-'+(g.Text);   // 2008-09-28
       Edit1.text:=Yol+Tarih;
       WebBrowser1.Navigate(Edit1.text);
       s:=IdHTTP1.Get(Edit1.text);
       Memo1.Text:=s;
        Memo1.Lines.SaveToFile('W:\Xmller\'+datetostr(dtpSimdiki.date)+'.xml');
       // ShowMessage('Kayıt Yapılmıştır');
       JvHTButton1Click(Sender);
    end;