Duyuruyu Kapat
Facebook Gözat
Twitter Gözat

Kod Bankası

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

  1. cemaliozan

    cemaliozan Daimi Üye

    Kayıt:
    17 Mayıs 2005
    Mesajlar:
    1,849
    Beğenilen Mesajlar:
    1
    Meslek:
    Boşta gezenlerin yewmiye defterini tutarım...
    Şehir:
    » Burası «
    # Hepimizin elinde yeri geldiğinde çok işe yarayan ve baştan yazılması uzun süren yüzlerce binlerce kodcuk var. Elimizdeki KODCUK'ları bu başlık altından paylaşalım. Paylaşırken aşağıdaki örnek formata dikkat etmeye çalışalım.

    ###################################################
    1. Kodun tam olarak ne işe yaradığına dair kısa ve açıklayıcı bir başlık
    Ör. :MS-Access veri tabanının sıkıştırılması ve onarılması

    2. Hangi versiyonlarda sorunsuz çalışıyor
    Ör. : D6-D7-BDS2006-CG2007

    3. Kaynak Kodcuk :
    Ör : Kodun kendisi

    4. Açıklama ve ek bilgiler.
    Ör.: Biz Delphi6 BDS2006 ve CG (Codegear 2007) üzerinde test ettik mükemmel çalışıyor.

    ####################################################
     
    Son düzenleme yönetici tarafından yapıldı: 23 Mayıs 2008
  2. cemaliozan

    cemaliozan Daimi Üye

    Kayıt:
    17 Mayıs 2005
    Mesajlar:
    1,849
    Beğenilen Mesajlar:
    1
    Meslek:
    Boşta gezenlerin yewmiye defterini tutarım...
    Şehir:
    » Burası «
    MS-Access Veri Tabanının Sıkıştırılması - Onarılması

    # MS-Access veri tabanını uygulama içinde sıkıştırmaya ve onarmaya yarıyor.

    # D6-BDS2006-CG2007

    PHP:
    CompactAndRepair(sOldMDB StringsNewMDB String) : Boolean;
    const
    sProvider 'Provider=Microsoft.Jet.OLEDB.4.0;';
    var
    oJetEng JetEngine;
    begin
    sOldMDB 
    := sProvider 'Data Source=' sOldMDB;
    sNewMDB := sProvider 'Data Source=' sNewMDB;

    try
    oJetEng := CoJetEngine.Create;
    oJetEng.CompactDatabase(sOldMDBsNewMDB);
    oJetEng := Nil;
    Result := True;
    except
    oJetEng 
    := Nil;
    Result := False;
    end;
    end;

    if 
    CompactAndRepair('e:\Old.mdb''e:\New.mdb'then
    ShowMessage
    ('İşlem Başarılı.')
    else
    ShowMessage('İşlemde Hata Oluştu.');

    # Önemli Not:
    1- JRO_TLB unit ini uses bölümüne ekleyin.
    2- Database sıkıştırılırken kimse database i açıp kullanmamalıdır.
    3- Eðer JRO_TLB unit i ile ilgili Delphi hata verirse aşağıdakileri yapın
    a) Delphi menüsünde Project - Import Type Library i seçin
    b) "Microsoft Jet and Replication Objects 2.1 Library" i bulun.
    c) Install butonunu tıklayın.
    d) Programınızı tekrar derleyin
     
  3. cemaliozan

    cemaliozan Daimi Üye

    Kayıt:
    17 Mayıs 2005
    Mesajlar:
    1,849
    Beğenilen Mesajlar:
    1
    Meslek:
    Boşta gezenlerin yewmiye defterini tutarım...
    Şehir:
    » Burası «
    Code Gear 2007 For ASP.NET Web.Config

    # Bazı ASP.NET sunucularının güvenlik ayarları nedeniyle Code Gear yerleşik sınıf ve yöntemlerinin bazıları çalışmaz. Bunu düzeltmek için ilgili asp.net projesinin web.config dosyasının system.web anahtarı altına aşağıdaki satırları ekleyin...

    #CG-2007 For ASP.Net

    PHP:
    <system.web>
       <
    trust level="Full" originUrl="" />
    ......
    ......
    ......
    # Not : Kessinlikle <system.web> takısı arasına eklenmeli. Bu çözümü @burhanmt bulmuş ve test etmiştir.
     
  4. cemaliozan

    cemaliozan Daimi Üye

    Kayıt:
    17 Mayıs 2005
    Mesajlar:
    1,849
    Beğenilen Mesajlar:
    1
    Meslek:
    Boşta gezenlerin yewmiye defterini tutarım...
    Şehir:
    » Burası «
    Delphi Püfleri - 001

    # Delphi ile ilgili bir çok püf noktasının toplandığı dökuman...Ek dosyada aşağıdaki başlıklara ait örnekler bulunmaktadır...

    • VERİ TABANI/BDE
    • AĞ IŞLEMLERI
    • SES VE GRAFİK İŞLEMLERİ
    • FORM VE PENCERE IŞLEMLERI
    • DİSK VE DOSYA İŞLEMLERİ
    • GENEL

    # Gerekli düzenlemeler ile tüm versiyonlarda çalışırlar

    # Not : İçeriğin tamamı internet ortamından karşılıksız paylaşılmış kodlardan oluşmaktadır...
     
    apachi2006 bunu beğendi.
  5. cemaliozan

    cemaliozan Daimi Üye

    Kayıt:
    17 Mayıs 2005
    Mesajlar:
    1,849
    Beğenilen Mesajlar:
    1
    Meslek:
    Boşta gezenlerin yewmiye defterini tutarım...
    Şehir:
    » Burası «
    Delphi Püfleri - 002

    # Delphi ile ilgili çok sık sorulan soruların ve cevaplarının toplandığı dökumanlar...Ek dosyalarda internet ortamında sorulmuş ve cevaplanmış HTML formatında 1990 soru ve çözümü bulunmaktadır.

    # Soru ve Cevaplar ingilizcedir.
     
  6. cemaliozan

    cemaliozan Daimi Üye

    Kayıt:
    17 Mayıs 2005
    Mesajlar:
    1,849
    Beğenilen Mesajlar:
    1
    Meslek:
    Boşta gezenlerin yewmiye defterini tutarım...
    Şehir:
    » Burası «
    Delphi Püfleri - 003

    # BDS 2006 ve Codegear 2007 ile ASP.NET tabanlı site tasarlarken tasarımın farklı tarayıcılarda düzgün görüntülenmesini sağlar. Aşağıdaki satırları asp.net uygulamanızın web.config dosyasında <system.web> </system.web> anahtarları arasına ekleyiniz...

    # Delphi 2006 (BDS 2006) - CodeGear 2007

    PHP:
        <!-- // Eklenecek Bölüm Başlangıcı //-->
            
    <browserCaps>
            <!-- 
            
    Name:        BrowserCaps update for modern browsershttp://slingfive.com/pages/code/browserCaps/
            
    Author:    Rob Eberhardthttp://slingfive.com/
            
    History:
                
    2004-11-19    improved detection of SafariKonqueror &ampMozilla variantsadded Opera detection
                2003
    -12-21    updated TagWriter info
                2003
    -12-03    first published
            
    -->

                <!-- 
    GECKO Based Browsers (Netscape 6+, Mozilla/Firefox, ...) //-->
                
    <case match="^Mozilla/5\.0 \([^)]*\) (Gecko/[-\d]+)(?'VendorProductToken' (?'type'[^/\d]*)([\d]*)/(?'version'(?'major'\d+)(?'minor'\.\d+)(?'letters'\w*)))?">
                    
    browser=Gecko
                    
    <filter>
                        <case 
    match="(Gecko/[-\d]+)(?'VendorProductToken' (?'type'[^/\d]*)([\d]*)/(?'version'(?'major'\d+)(?'minor'\.\d+)(?'letters'\w*)))">
                            
    type=${type}
                        </case>
                        <case> <!-- 
    plain Mozilla if no VendorProductToken found -->
                            
    type=Mozilla
                        
    </case>
                    </
    filter>
                    
    frames=true
                    tables
    =true
                    cookies
    =true
                    javascript
    =true
                    javaapplets
    =true
                    ecmascriptversion
    =1.5
                    w3cdomversion
    =1.0
                    css1
    =true
                    css2
    =true
                    xml
    =true
                    tagwriter
    =System.Web.UI.HtmlTextWriter
                    
    <case match="rv:(?'version'(?'major'\d+)(?'minor'\.\d+)(?'letters'\w*))">
                        
    version=${version}
                        
    majorversion=0${major}
                        
    minorversion=0${minor}
                        <case 
    match="^b" with="${letters}">
                            
    beta=true
                        
    </case>
                    </case>
                </case>

                <!-- 
    AppleWebKit Based Browsers (Safari...) //-->
                
    <case match="AppleWebKit/(?'version'(?'major'\d?)(?'minor'\d{2})(?'letters'\w*)?)">
                    
    browser=AppleWebKit
                    version
    =${version}
                    
    majorversion=0${major}
                    
    minorversion=0.${minor}
                    
    frames=true
                    tables
    =true
                    cookies
    =true
                    javascript
    =true
                    javaapplets
    =true
                    ecmascriptversion
    =1.5
                    w3cdomversion
    =1.0
                    css1
    =true
                    css2
    =true
                    xml
    =true
                    tagwriter
    =System.Web.UI.HtmlTextWriter
                    
    <case match="AppleWebKit/(?'version'(?'major'\d)(?'minor'\d+)(?'letters'\w*))(.* )?(?'type'[^/\d]*)/.*( |$)">
                        
    type=${type}
                    </case>
                </case>

                <!-- 
    Konqueror //-->
                
    <case match=".+[K|k]onqueror/(?'version'(?'major'\d+)(?'minor'(\.[\d])*)(?'letters'[^;]*));\s+(?'platform'[^;\)]*)(;|\))">
                    
    browser=Konqueror
                    version
    =${version}
                    
    majorversion=0${major}
                    
    minorversion=0${minor}
                    
    platform=${platform}
                    
    type=Konqueror
                    frames
    =true
                    tables
    =true
                    cookies
    =true
                    javascript
    =true
                    javaapplets
    =true
                    ecmascriptversion
    =1.5
                    w3cdomversion
    =1.0
                    css1
    =true
                    css2
    =true
                    xml
    =true
                    tagwriter
    =System.Web.UI.HtmlTextWriter
                
    </case>

                <!-- 
    Opera //-->
                
    <case match="Opera[ /](?'version'(?'major'\d+)(?'minor'\.(?'minorint'\d+))(?'letters'\w*))">
                    <
    filter match="[7-9]" with="${major}">
                        
    tagwriter=System.Web.UI.HtmlTextWriter
                    
    </filter>
                    <
    filter>
                        <case 
    match="7" with="${major}">
                            <
    filter>
                                <case 
    match="[5-9]" with="${minorint}">
                                    
    ecmascriptversion=1.5
                                
    </case>
                                <case>
                                    
    ecmascriptversion=1.4
                                
    </case>
                            </
    filter>
                        </case>
                        <case 
    match="[8-9]" with="${major}">
                            
    ecmascriptversion=1.5
                        
    </case>
                    </
    filter>
                </case>
        </
    browserCaps>
      <!-- 
    // Eklenecek Bölüm Sonu //-->
     
  7. cemaliozan

    cemaliozan Daimi Üye

    Kayıt:
    17 Mayıs 2005
    Mesajlar:
    1,849
    Beğenilen Mesajlar:
    1
    Meslek:
    Boşta gezenlerin yewmiye defterini tutarım...
    Şehir:
    » Burası «
    Delphi ASP.NET ile Resim İşlemleri

    # Delphi ile geliştirilen ASP.NET web projelerinde kullanılmak üzere lokal sunucu üzerinden resim yüklenmesi, resmin yeniden oluşturulması ve uygun bir isim ve klasör altına kaydedilmesi.

    # BDS-2006 - CG-2007

    Resimlerin yüklendiği ASPX ana sayfasının kodu

    PHP:
    <%@ Page language="c#" Debug="true" Codebehind="m_resimekle.pas" AutoEventWireup="false" Inherits="m_uyeresimekle.TWebFormm_Resim_Ekle" %>
    <!
    DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
    <
    html>
     <
    head>
    <
    title>Yeni Resim Ekleyin</title>
    <
    meta http-equiv="Content-Language" content="tr">
      <
    meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
    <
    link rel="stylesheet" type="text/css" href="./css/ana.css" />
       <
    link rel="stylesheet" type="text/css" href="./css/profil_tabview.css" />
    <
    style type="text/css">.gonderbutton {
    BORDER-RIGHTmedium nonePADDING-RIGHT2pxBORDER-TOPmedium nonePADDING-LEFT2pxBACKGROUND-IMAGEurl(img/nr_bck.gif); PADDING-BOTTOM2pxFONTbold 9pt tahoma,arial,verdanaOVERFLOWvisibleBORDER-LEFTmedium noneWIDTH70pxCURSORhandCOLOR#000054; PADDING-TOP: 2px; BORDER-BOTTOM: medium none; HEIGHT: 25px
    }
    </
    style>
    <
    link rel="stylesheet" type="text/css" href="./css/profil.css" />
    <
    SCRIPT LANGUAGE="JavaScript">
    <!-- 
    Gizle
    function textCounter(fieldcountfieldmaxlimit)
    {
     if (
    field.value.length maxlimit)
     
    field.value field.value.substring(0maxlimit);
     else
    countfield.value maxlimit field.value.length;
    }
    // End -->
    </SCRIPT>
     
    <script type="text/javascript">
    <!--
    function resim_goster(islem, ry, resim) {
    rdiv = document.getElementById(ry);
    if (islem == 0)
    rdiv.style.display = 'none';
    else {
    rdiv.innerHTML = '<img src="' + resim + '" width="300" height="225">';
    rdiv.style.display = '';
    rdiv.style.background = '';
    tb = document.getElementById("TextBox_resim_adi");
    tb.value = "Resim";//resim;
       }
    }
    //-->
    </script>
    </head>
    <body style="BACKGROUND-IMAGE: url(img/gradinent/dino.gif)" onunload="JavaScript:opener.ListeyiYenile();">
        <form enctype="multipart/form-data" runat="server">
    <table style="WIDTH: 100%">
    <tr>
    <td class="etiket9pt" style="WIDTH: 69px">Resim Seçin</td>
    <td class="etiket9pt">
    <input id="dosya" type="file" name="dosya" viewstate="true" runat="server" class="editbox" onchange="resim_goster(1,'resimdiv',this.value);" title="Eklenecek Resmi Seçin"></td>
    <td class="etiket9pt">
    &nbsp;</td>
    </tr>
    <tr>
    <td colspan="3">
    <table style="WIDTH: 100%">
    <tr>
    <td class="etiket9pt" style="WIDTH: 79px">Albüm Adı</td>
    <td>
     
                         <ASP:DropDownList id="DropDownList_Album" runat="server" cssclass="editbox"></ASP:DropDownList></td>
    <td class="etiket9pt">
    &nbsp;</td>
    </tr>
    <tr>
    <td class="etiket9pt" style="WIDTH: 79px">Resim Adı</td>
    <td>
                         <ASP:TextBox id="TextBox_resim_adi" runat="server" CssClass="editbox"></ASP:TextBox></td>
    <td class="etiket9pt">
    <ASP:CheckBox id="CheckBox_Ozel" runat="server" text="Yalnızca arkadaşlarım görebilir" enableviewstate="False"></ASP:CheckBox>
    </td>
    </tr>
    <tr>
    <td class="etiket9pt" style="WIDTH: 79px">kategori</td>
    <td>
                         <ASP:TextBox id="TextBox_Kategori" runat="server" CssClass="editbox" enableviewstate="False"></ASP:TextBox></td>
    <td class="etiket9pt">
    </td>
    </tr>
    <tr>
    <td colspan="3" class="etiket9pt">Resim Açıklaması 
    <input size="5" name="thisSayac" id="thisSayac" value="1000" class="readonlyeditbox" readonly="true">&nbsp;Karakter kaldı...</td>
    </tr>
    <tr>
    <td colspan="3" class="etiket9pt">
    <asp:TextBox runat="server" id="TextBox_resim_aciklama" TextMode="MultiLine" Rows="4" Width="99%" CssClass="editbox"></asp:TextBox>
    </td>
    </tr>
    <tr>
    <td colspan="3" align="center" class="etiket8pt">
    <ASP:Label
                            id="Label_Msg" runat="server" enableviewstate="False">Yükleyeceğiniz resimlerin formatı jpg veya gif ve dosya büyüklüğü max. 512 KB olmalıdır.</ASP:Label></td>
    </tr>
    <tr>
    <td colspan="3" align="center">
                         <ASP:Button id="Button_Kapat" runat="server" text="  Kapat  " enableviewstate="False" cssclass="gonderbutton" CausesValidation="False"></ASP:Button>
    <asp:Button runat="server" Text="   Ekle   " id="Button_Ekle" cssclass="gonderbutton" /></td>
    </tr>
      </table>
    </td>
    </tr>
    <tr>
      <td colspan="3" class="etiket11pt" style="FONT-WEIGHT: 900; FONT-SIZE: 16pt; BACKGROUND-IMAGE: url(img/gradinent/marigold.gif); COLOR: #cc3300; FONT-FAMILY: tahoma, Helvetica, Verdana, Arial" align="center" valign="middle">
                 <ASP:Label id="Label_Eklenen" runat="server">0 Resim Eklendi</ASP:Label></td>
    </tr>
    <tr>
      <td colspan="3" style="BORDER-RIGHT: #fdefc6 2px dotted; BORDER-TOP: #fdefc6 2px dotted; BORDER-LEFT: #fdefc6 2px dotted; BORDER-BOTTOM: #fdefc6 2px dotted" align="center" valign="middle">
      <div id="resimdiv" style="BACKGROUND-POSITION: center center; BACKGROUND-IMAGE: url(img/resimgoster.jpeg); WIDTH: 100%; BACKGROUND-REPEAT: no-repeat; HEIGHT: 225px; TEXT-ALIGN: center">
    <ASP:Label id="Label_Resim" runat="server" enableviewstate="False">***</ASP:Label>
      </div>
      </td>
    </tr>
    <tr>
    <td class="etiket8pt" colspan="3" align="center" valign="middle"><ASP:Label id="Label_KullanimDurumu" runat="server">Size ayrılan 1024 KB. Alanın 512 KB. Bölümünü Kullanıyorsunuz. Toplam 4096 Kb. Kullanılabilir Alanınız Mevcut...</ASP:Label></td>
    </tr>
     
    </table>
    </form>
     </body>
    </html>
    # Resimleri sayfaya basan bir yordam...

    PHP:
    procedure TWebUserControl_pg_resimpaylasyorumekle.ResimleriBas(Const UID,AID,ResimID:String);
    Var
      
    Baglantim         MySqlConnection;
      
    Komutcu           MySqlCommand;
      
    Okuyucu           MySqlDataReader;
      
    TamEkran          String;
    begin
     
    try
       
    TamEkran            := '';
       
    Baglantim           := MySqlConnection.Create(GetBaglantiText);
       
    Komutcu             := MySqlCommand.Create('select * from tbl_resimler where id="'+ResimID+'"',Baglantim);
       
    Baglantim.Open;
     
       
    Okuyucu             := Komutcu.ExecuteReader;
       if 
    Okuyucu.Read then
       begin
         TamEkran  
    := '<a href="http://'+GetSiteAdresi+UyelerResimKlasoru+AID+'/orj/'+Okuyucu.Item['bresim_dosyasi'].ToString+'" Title="'+Okuyucu.Item['resim_adi'].ToString+' İsimli resmi orjinal boyutlarında göster" target="_blank">';
         
    Label_Resim_Adi.Text       := StrToHTml(Okuyucu.Item['resim_adi'].ToString);
         
    Label_KResim_Dosyasi.Text  := TamEkran+ResimGoster(AIDPage.Server.MapPath(Sabitler.UyelerResimKlasoru+AID+'/'+Okuyucu.Item['bresim_dosyasi'].ToString),Okuyucu.Item['bresim_dosyasi'].ToString)+'</a>';
         
    Label_Resim_Aciklama.Text  := StrToHtml(Okuyucu.Item['resim_aciklama'].ToString);
       
    end;
     finally
       
    Komutcu.Free;
       
    Baglantim.Close;
       
    Baglantim.Free;
     
    end;
    end;

    procedure TWebForm_Profilim_Uye_Resim_Ekle.YuklenebilecekResimBoyutu(Const UID:String;Out Ayrilan,KullanilanYer,BosYer Double);
    Var
    Baglantim MySqlConnection;
    Komutcu MySqlCommand;
    Okuyucu  MySqlDataReader;
    Begin
    Try
         
    Ayrilan         := 0;
         
    KullanilanYer   := 0;
         
    BosYer          := 0;
    Baglantim       := MySqlConnection.Create(GetBaglantiText);
    Komutcu      := MySqlCommand.Create('Select resim_size From uyeler Where id="'+UID+'"',Baglantim);
    Baglantim.Open;
    Okuyucu      := Komutcu.ExecuteReader;
    if 
    Okuyucu.Read then
         begin
           Ayrilan      
    := Okuyucu.GetDouble(0);
           
    Okuyucu.Close;
         
    end;
     
     
    Komutcu := MySqlCommand.Create('Select sum(bresim_size) as kullanilan From tbl_resimler Where uye_id="'+UID+'"',Baglantim);
         
    Okuyucu   := Komutcu.ExecuteReader;
         if 
    Okuyucu.Read then
         begin
           KullanilanYer 
    := Okuyucu.GetDouble(0);
           
    Okuyucu.Close;
         
    end;
     
     
    Komutcu := MySqlCommand.Create('Select count(id) as toplam From tbl_resimler Where uye_id="'+UID+'"',Baglantim);
         
    Okuyucu   := Komutcu.ExecuteReader;
         if 
    Okuyucu.Read then
         begin
           Label_Eklenen
    .Text := 'Klasörünüzde '+Okuyucu.Item['toplam'].ToString+' Resim Var...';
           
    Okuyucu.Close;
         
    end else
           
    Label_Eklenen.Text := 'Kayıtlı Resim Yok';
         
    BosYer              := Ayrilan KullanilanYer;
    Finally
    Komutcu.Free;
    Baglantim.Close;
    Baglantim.Free;
    end;
    END;
     
    Function 
    TWebForm_Profilim_Uye_Resim_Ekle.tbl_resimler_Insert(UID,BResimDosyasi,KResimDosyasi,bEn,bBoy,bSize,kEn,kBoy,kSize,kategori:String):Int16;
    Var
    Baglantim   MySqlConnection;
    Komutcu    MySqlCommand;
    Okuyucu    MySqlDataReader;
    KayitSayisi Int16;
    Begin
    KayitSayisi 
    := 0;
    Try
    Baglantim:= MySqlConnection.Create(GetBaglantiText);
    Komutcu := MySqlCommand.Create('INSERT INTO tbl_resimler (uye_id,resim_adi,resim_aciklama,'+
                                          
    'resim_gonderme_tarihi,bresim_dosyasi,bresim_en,bresim_boy,bresim_size,kresim_dosyasi,kresim_en,kresim_boy,kresim_size,kategori,'+
                                          
    'album_id,album_adi,ozel) VALUES('+
                                          
    '"'+UID+'" ,'+
                                          
    '"'+IlkHarfBuyuk(Duzelt(TextBox_resim_adi.Text))+'" ,'+
                                          
    '"'+IlkHarfBuyuk(Duzelt(TextBox_resim_aciklama.Text))+'" ,'+
                                          
    '"'+Sabitler.GetBugun+'" ,'+
                                          
    '"'+bResimDosyasi+'" ,'+
                                          
    '"'+bEn+'" ,'+
                                          
    '"'+bBoy+'" ,'+
                                          
    '"'+bSize+'" ,'+
                                          
    '"'+kResimDosyasi+'" ,'+
                                          
    '"'+kEn+'" ,'+
                                          
    '"'+kBoy+'" ,'+
                                          
    '"'+kSize+'" ,'+
                                          
    '"'+IlkHarfBuyuk(Duzelt(kategori))+'" ,'+
                                          
    '"'+DropDownList_Album.SelectedValue+'" ,'+
                                          
    '"'+DropDownList_Album.SelectedItem.Text+'" ,'+
                                          
    '"'+CheckIsareti(CheckBox_ozel.Checked)+'")',Baglantim);
    Baglantim.Open;
    KayitSayisi := Komutcu.ExecuteNonQuery;
    Finally
    Komutcu.Free;
    Baglantim.Close;
    Baglantim.Free;
    Result := KayitSayisi;
    end;
    END;
     
    function 
    TWebForm_Profilim_Uye_Resim_Ekle.ResimEklenebilirmi:Boolean;
    Var
      
    String;
    begin
     Result 
    := False;
     
    S      := '';
     if 
    Dosya.PostedFile.FileName '' then
     begin
       S  
    := 'Yüklemek İçin Önce Bir Dosya Seçin...<br />';
     
    end;
     if (
    Dosya.PostedFile.ContentType <> 'image/pjpeg') and (Dosya.PostedFile.ContentType <> 'image/gif'then
     begin
       S 
    := 'JPEG veya Gif Formatlı Resim Yüklemelisiniz...<br />';
     
    end;
     if 
    Dosya.PostedFile.ContentLength Sabitler.UyeHerResimMaxKB then
     begin
       S 
    := 'Yüklenecek Resim Dosyası Max.'+Convert.ToString(Sabitler.UyeHerResimMaxKB)+' Kb. Olmalı';
     
    end;
     if 
    ViewState['bosyer'] <> Nil then
     begin
       
    if Convert.ToDouble(ViewState['bosyer'].ToString) <= (Dosya.PostedFile.ContentLengththen
       S 
    := 'Toplam '+SayiFormatla(Convert.ToDouble(ViewState['bosyer'].ToString),True,2)+' KB. Boş Yeriniz Var.'+
            
    'Yüklemek İstediğiniz Dosya '+SayiFormatla(Dosya.PostedFile.ContentLength,True,2)+' KB. Yeterli Yer Yok !';
     
    end;
     
     
    Label_Msg.Text  := S;
     
    Result := '';
    end;
    # Resim upload edip veri tabanına kaydetme yordamları

    PHP:
    function TWebForm_Profilim_Uye_Resim_Ekle.ResimYukle(Const ID Stringout ResimDosyasiAdi:String):Boolean;
    Var
       
    DosyaKlasoru      String;
       
    DosyaAdi          String;
       
    TamYol            String;
       
    OrjYol            String;
       
    DosyaKontrol      String;
       
    I                 Integer;
       
    KisaResimDosyaAdi String;
       
    AResim            System.Drawing.Image;
       
    AResimStream      Filestream;
       
    Oranti,x,y        Double;
       
    OrjinalX,OrjinalY Double;
       
    ResimFormat       ImageFormat;
       
    AFileInfo         FileInfo;
       
    OFileInfo         FileInfo// orjinaldosya bilgileri
       
    bEn,bBoy,bSize,
       
    kEn,kBoy,kSize    String;
    begin
      TamYol       
    := '';
      
    OrjYol       := ''// orjinal kopya için
      
    Result       := False;
      if 
    Dosya.PostedFile.ContentType 'image/pjpeg' then
        ResimFormat  
    := ImageFormat.Jpeg
      
    else
      if 
    Dosya.PostedFile.ContentType 'image/gif' then
        ResimFormat  
    := ImageFormat.Gif
      
    else
        
    ResimFormat  := ImageFormat.Jpeg;
     
      
    // Üyenin resimlerinin saklanacağı klasör  uyeler/resimler/1/ şeklinde 1= üye ID
      
    DosyaKlasoru := Server.MapPath(Sabitler.UyelerResimKlasoru+ID);
      
    // Thumb boyutlu resim için Klasör yoksa yarat
      
    if Not &Directory.Exists(DosyaKlasoruthen &Directory.CreateDirectory(DosyaKlasoru);
     
      
    // Orjinal boyutlu resim için Klasör yoksa yarat
      
    if Not &Directory.Exists(DosyaKlasoru+'\orj'then &Directory.CreateDirectory(DosyaKlasoru+'\orj');
     
      
    DosyaAdi          := Path.GetFileName(Dosya.PostedFile.FileName);
      
    //* Her Halükarda Bu ismi tabloya kaydediyoruz...*//
      
    KisaResimDosyaAdi := DosyaAdi;
      
    //sunucuya kayıt edilecek konum ve dosya
      
    TamYol       := Path.Combine(DosyaKlasoru,DosyaAdi);
      
    OrjYol       := Path.Combine(DosyaKlasoru+'\orj',DosyaAdi);
      
    //Sunucuda bu isimde bir dosya varsa yeni isim seç  - Dosya isimleri benzersiz olmalı
      //Burası benzer dosya adlarından dolayı sistemi yavaşlatabilir, tablonun bir alanı ile çalışmak gerek...
         
    := 0;
         While &
    File.Exists(TamYol) do
         
    begin
           DosyaKontrol      
    := 'ur_'+I.ToString+'_'+DosyaAdi;
           
    KisaResimDosyaAdi := DosyaKontrol;
           
    TamYol            := Path.Combine(DosyaKlasoru,DosyaKontrol);
           
    OrjYol            := Path.Combine(DosyaKlasoru+'\Orj',DosyaKontrol);
           
    Inc(I);
         
    end;
     
       if 
    TamYol <> '' then
       begin
         ResimDosyasiAdi 
    := '<img src="'+Sabitler.UyelerResimKlasoru+ID+'/'+KisaResimDosyaAdi+'" border="0" />'
       
    end else
         
    ResimDosyasiAdi := '';
     
       
    //Dosyayi yükle
       
    try
         
    // Geçici dosyayı yüklüyoruz... sondaki ~ bu dosya sileceğimizden koyduk...
         
    Dosya.PostedFile.SaveAs(TamYol+'~');
         
    // Yeniden boyutlandır *//
         
    AResimStream  := Filestream.Create(TamYol+'~',Filemode.Open);
         
    Aresim        := System.Drawing.Image.FromStream(AResimStream);
         
    X             := AResim.Width;
         
    Y             := AResim.Height;
     
         
    // orjinal kopya için //
         
    OrjinalX      := X;
         
    OrjinalY      := Y;
     
         
    // orjinal kopyayı kaydet
         
    AResim        := AResim.GetThumbnailImage(Convert.ToInt32(OrjinalX),Convert.ToInt32(OrjinalY),nil,nil);
         
    AResim.Save(OrjYol,ResimFormat);
         
    OFileInfo     := FileInfo.Create(OrjYol);
         
    bSize         := Convert.ToString(OFileInfo.Length);
         
    bEn           := Convert.ToString(AResim.Width);
         
    bBoy          := Convert.ToString(AResim.Height);
     
         
    //thumbal görüntü//
         
    Oranti        := 1;
         
    //aspect ratio algoritması //
         
    if Y then
           Oranti 
    := Sabitler.UyeKResimBoy
         
    else
           
    Oranti := Sabitler.UyeKResimBoy;
     
         
    X      := Oranti;
         
    Y      := Oranti;
     
         try
           
    AResim   := AResim.GetThumbnailImage(Convert.ToInt32(X),Convert.ToInt32(Y),nil,nil);
           
    AResim.Save(TamYol,ResimFormat);
           
    AFileInfo     := FileInfo.Create(TamYol);
           
    kSize         := Convert.ToString(AFileInfo.Length);
           
    kEn           := Convert.ToString(AResim.Width);
           
    kBoy          := Convert.ToString(AResim.Height);
     
           
    tbl_resimler_Insert(ID,KisaResimDosyaAdi,KisaResimDosyaAdi,bEn,bBoy,bSize,kEn,KBoy,KSize,IlkHarfBuyuk(Duzelt(TextBox_Kategori.Text)));
         finally
           
    AFileInfo.Free;
           
    AResimStream.Close;
           
    AResim.Dispose;
           if &
    File.Exists(TamYol+'~'then &File.Delete(TamYol+'~');
         
    end;
         
    Result := True;
     
       
    except on E:Exception do
         
    Result := False;
      
    end;
    end;
    # Açıklamalar : Resim işlemleri için System.IO uzay adının (Name Space - Eski Dilde Unit), Upload edilen resimleri yeniden oluşturabilmek için System.Drawing ve System.Drawing.Imaging uzay adının, veri tabanı bağlantısı içinde mysql için MySql.Data uzay adının USES bildirimine eklenmesi gerekir.
     
  8. cemaliozan

    cemaliozan Daimi Üye

    Kayıt:
    17 Mayıs 2005
    Mesajlar:
    1,849
    Beğenilen Mesajlar:
    1
    Meslek:
    Boşta gezenlerin yewmiye defterini tutarım...
    Şehir:
    » Burası «
    ASP.NET - Klasör isimlerinin DropDownList İle Gösterilmesi

    # ASP.NET - Klasör isimlerinin DropDownList İle Gösterilmesi

    # BDS2006 - CG-2007

    PHP:
    procedure TWebForm_GaleriDuzenle.Button_Galeri1_Click(senderSystem.ObjecteSystem.EventArgs);
    Var
     
    DirInfo  DirectoryInfo;
     
    DirList  : Array of DirectoryInfo ;
     
    i        Integer;
     
    Item     ListItem;
    begin
     
    try
       
    DirInfo   := DirectoryInfo.Create(Server.MapPath('../galeri/kucukboy'));
       
    DirList   := DirInfo.GetDirectories;
       
    DropDownList_DirList.Items.Clear;
       For 
    i:=Low(DirListto High(DirList) do
       
    begin
         Item  
    := ListItem.Create(DirList[i].get_Name.ToString,DirList[i].get_Name.ToString);
         
    DropDownList_DirList.Items.Add(Item);
       
    end;
     finally
       
    DirInfo.Free;
     
    end;
    end;
     
  9. cemaliozan

    cemaliozan Daimi Üye

    Kayıt:
    17 Mayıs 2005
    Mesajlar:
    1,849
    Beğenilen Mesajlar:
    1
    Meslek:
    Boşta gezenlerin yewmiye defterini tutarım...
    Şehir:
    » Burası «
    ASP.NET - Resimler & Thumb

    # Ön izleme için resimleri yeniden oluşturup ölçeklendirir

    # BDS-2006 - CG-2007

    PHP:
    uses System.IO,System.Drawing.Imaging;
     
    procedure TWebForm_GaleriDuzenle.ResimKucult(ResimKlasoru,ResimDosyasi String);
    Var
       
    BDosya             String;
       
    KDosya            String// küçük resim dosyası
       
    AResim            System.Drawing.Image;
       
    AResimStream      Filestream;
       
    Oranti,x,y        Double;
       
    ResimFormat       ImageFormat;
       
    AFileInfo         FileInfo;
       
    kEn,kBoy,kSize    String;
    begin
      BDosya       
    := Server.MapPath('galeri\buyukboy\'+ResimKlasoru+'\'+ResimDosyasi);
      KDosya       := Server.MapPath('
    galeri\kucukboy\'+ResimKlasoru+'\'+ResimDosyasi);
     
    try
      AResim       := System.Drawing.Image.FromFile(BDosya);
      X            := AResim.Width;
      Y            := AResim.Height;
      ResimFormat  := AResim.RawFormat;
     
      if X > Y then
         Oranti := X / 150
      else
         Oranti := Y / 150;
     
       X      := X / Oranti;
       Y      := Y / Oranti;
     
     AResim   := AResim.GetThumbnailImage(Convert.ToInt32(X),Convert.ToInt32(Y),nil,nil);
     AResim.Save(KDosya,ResimFormat);
    finally
      AResim.Dispose;
    end;
    end;
     
    procedure TWebForm_GaleriDuzenle.DosyalardanKucukKopyaCikart(Klasor: String;Mask:String='');
    Var
      DListesi : Array of String;
      Yol      : String;
        i      : Integer;
        S      : String;
    DosyaAdi   : String;
    begin
     Yol       := Server.MapPath('
    galeri\buyukboy\'+Klasor+'\');
     if Mask <> '' then
       DListesi  := &Directory.GetFiles(Yol,Mask)
     else
       DListesi  := &Directory.GetFiles(Yol);
     
     S         := '';
     For i:=0 to High(DListesi) do
     begin
       DListesi[i] := DListesi[i].Remove(0,Yol.Length);
       DosyaAdi    := Path.GetFileName(DListesi[i].ToString); 
       if Not &File.Exists(Server.MapPath('
    galeri\kucukboy\'+Klasor+'\'+DosyaAdi)) then
         ResimKucult(Klasor,DosyaAdi);
     end;
    end;
     
  10. cemaliozan

    cemaliozan Daimi Üye

    Kayıt:
    17 Mayıs 2005
    Mesajlar:
    1,849
    Beğenilen Mesajlar:
    1
    Meslek:
    Boşta gezenlerin yewmiye defterini tutarım...
    Şehir:
    » Burası «
    ASP.NET - E-Posta Göndermek

    # ASP.NET web uygulamarından e-posta göndermek

    # BDS-2006 - CG-2007

    PHP:
    // System.Web.Mail name space uses bölümüne ekleyin...

    var
      
    eMailMailMessage;
    begin
      eMail 
    := MailMessage.Create;
      
    eMail.BodyFormat := MailFormat.Text//Bunu MailFormat.Html de yapabilirsiniz
      
    eMail.From := 'bizden@bizden.com'//kimden
      //smtp sunucu adresi
      
    eMail.Fields['http://schemas.microsoft.com/cdo/configuration/smtsperver'] := 'mail.bizimsunucu.com';
      
    eMail.Fields['http://schemas.microsoft.com/cdo/configuration/smtpserverport'] := Convert.ToString(25);
      
    eMail.Fields['http://schemas.microsoft.com/cdo/configuration/sendusing'] := Convert.ToString(2);
      
    eMail.Fields['http://schemas.microsoft.com/cdo/configuration/smtpauthenticate'] := Convert.ToString(1);
     
    //doğrulanacak mail adresi
      
    eMail.Fields['http://schemas.microsoft.com/cdo/configuration/sendusername'] := 'bizimmailadresi@bizimsunucu.com';
     
    //doğrulanacak mail adresinin şifresi
      
    eMail.Fields['http://schemas.microsoft.com/cdo/configuration/sendpassword'] := 'şifremiz';
      
    eMail.&to := 'size@hotmail.com'//kime
      
    eMail.Subject := 'Kodbank Konusu'//konu
      
    eMail.Body := 'ASP.NET ile smtp/pop3 mail göndermek'//mesaj
      //smtp sunucu adresi
      
    SmtpMail.SmtpServer := 'mail.bizimsunucu.com';
      
    //gönder
      
    SmtpMail.Send(eMail);
    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
    Bir Tablodaki Veriyi Diğer Bir Tabloya Aynen Aktarma

    Bir Tablodaki Veriyi Diğer Bir Tabloya Aynen Aktarma

    Benim için çok yararlı bir bilgiyi sizinle paylamak istedim. Elbette burada Eski TAblo ve yeni tablo yapıları aynı olmalıdır.





    Kod:
     
              Kaydet.Close;
              Kaydet.SQL.Clear;
              Kaydet.SQL.Add('INSERT INTO _YENITABLO select * From ESKITABLO where DosyaNo=''' + Label113.Caption + '''    ');
              Kaydet.ExecSQL;
    


    Umarım Yararlı Olur
     
  12. cemaliozan

    cemaliozan Daimi Üye

    Kayıt:
    17 Mayıs 2005
    Mesajlar:
    1,849
    Beğenilen Mesajlar:
    1
    Meslek:
    Boşta gezenlerin yewmiye defterini tutarım...
    Şehir:
    » Burası «
    Pointer ın üzerinde bulunduğu kaydın Kopyasını Çıkartmak

    # Pointer ın üzerinde bulunduğu kaydın (Record) kopyasını çıkartır ve Post için bekler...

    # Tüm Sürümler

    PHP:
    procedure TForm1.KayitCogalt(DataSeti TDataSet);
    var
      
    StrBufferTStringList;
      
    FieldStreamTMemoryStream;
      
    Iinteger;
    begin
      StrBuffer 
    := TStringList.Create;
      try
        
    with DataSeti do begin
          
    for := 0 to FieldCount do
            
    with Fields[I] do
              if 
    DataType in [ftString..ftDateTimethen
                StrBuffer
    .Add(AsString)
              else if 
    DataType in [ftBytes..ftGraphicthen begin
                FieldStream 
    := TMemoryStream.Create;
                if (
    Fields[Iis TMemoFieldthen
                  TMemoField
    (Fields[I]).SaveToStream(FieldStream)
                else if (
    Fields[Iis TGraphicFieldthen
                  TGraphicField
    (Fields[I]).SaveToStream(FieldStream)
                else if (
    Fields[Iis TBlobFieldthen
                  TBlobField
    (Fields[I]).SaveToStream(FieldStream)
                else if (
    Fields[Iis TBytesFieldthen begin
                  FieldStream
    .SetSize(Fields[I].DataSize);
                  
    TBytesField(Fields[I]).GetData(FieldStream.Memory);
                
    end
                
    else if (Fields[Iis TVarBytesFieldthen begin
                  FieldStream
    .SetSize(Fields[I].DataSize);
                  
    TVarBytesField(Fields[I]).GetData(FieldStream.Memory);
                
    end;
                
    StrBuffer.AddObject(IntToStr(FieldStream.Size), FieldStream);
              
    end;
          
    Append;
          for 
    := 0 to FieldCount do
            if 
    Fields[I].DataType in [ftString..ftDateTimethen
              Fields
    [I].AsString := StrBuffer.Strings[I]
            else if 
    Fields[I].DataType in [ftBytes..ftGraphicthen begin
                FieldStream 
    := TMemoryStream(StrBuffer.Objects[I]);
                
    FieldStream.Seek(0,0);
                if (
    Fields[Iis TMemoFieldthen
                  TMemoField
    (Fields[I]).LoadFromStream(FieldStream)
                else if (
    Fields[Iis TGraphicFieldthen
                  TGraphicField
    (Fields[I]).LoadFromStream(FieldStream)
                else if (
    Fields[Iis TBlobFieldthen
                  TBlobField
    (Fields[I]).LoadFromStream(FieldStream)
                else if (
    Fields[Iis TBytesFieldthen begin
                  TBytesField
    (Fields[I]).SetData(FieldStream.Memory);
                
    end
                
    else if (Fields[Iis TVarBytesFieldthen
                  TVarBytesField
    (Fields[I]).SetData(FieldStream.Memory);
                
    StrBuffer.Objects[I] := nil;
                
    FieldStream.Free;
              
    end;
        
    end;
      finally
        if 
    StrBuffer <> nil then
          
    for := 0 to StrBuffer.Count do
            if 
    StrBuffer.Objects[I] <> nil then begin
              FieldStream 
    := TMemoryStream(StrBuffer.Objects[I]);
              
    FieldStream.Free;
              
    StrBuffer.Objects[I] := nil;
            
    end;
        
    StrBuffer.Free;
      
    end;
    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
    Query İle Bİr Kaydın Yapılıp Yapılmadıgını Öğrenme

    Query İle Bİr Kaydın Yapılıp Yapılmadıgını Öğrenme




    Kod:
                
     if ((Adoquery3.fieldbyname('FormNo').asstring)=Edit18.Text) then
     begin
     showmessage('Bu Form Numarası Kaydedilmiş..!. Tekrar Girilemez');
     Edit18.SetFocus;
     end;
     
  14. cemaliozan

    cemaliozan Daimi Üye

    Kayıt:
    17 Mayıs 2005
    Mesajlar:
    1,849
    Beğenilen Mesajlar:
    1
    Meslek:
    Boşta gezenlerin yewmiye defterini tutarım...
    Şehir:
    » Burası «
    ASP.NET - WYSIWYGEditor Örneği

    # Web ugulamalarınıza zengin metin editörü ve html etiketlerini, flash, video, mp3 ekleyebilen bir editörün asp.net ile nasıl kullanılacağını anlatır. Tasarladığım tüm sitelerin yönetim panellerinde sorunsuz kullandım...

    # ASP.NET için ilgili editörü http://www.innovastudio.com/ adresinden indirebilirsiniz.

    # BDS-2006 - CG-2007

    1. WYSIWYGEditor.dll dosyasını bin klasörüne yerleştirip projeye add references seçeneği ile dahil edin...
    2. ASPX dosyasına :

    <%@ Register TagPrefix="editor" Assembly="WYSIWYGEditor" namespace="InnovaStudio" %>

    satırını ekleyin...

    3. Aspx sayfasında editörü konumlandıracağınız yerde

    <EDITOR:WYSIWYGEDITOR Runat="server" scriptPath="./scripts/" ID="oEdit1" EditMode="HTMLBody" UseDIV="false" />

    deklarasyonu yapın...

    4. code-behind içinde
    Uses InnovaStudio ile editör tanımı ekleyin...
    strict protected
    oEdit1: InnovaStudio.WYSIWYGEditor;

    ile editörü deklare edin....

    5. Editör için assetmanager kullanımı ve image/media ekleme işlemlerinin ayarlanması

    a. Editöre Assetmanager boyut tanımları yapılır...(Yükseklik, genişlik)
    b. Editöre assetmanager klasörünün ve assetmanager.asp dosyasının yeri gösterilir.
    Yer gösterme işleminde adres göreceli path / işaretiyle başlar
    * EditorAssetManagerKlasoru = '/teksevgi/assetmanager/assetmanager.asp';
    c. Assertmanager klasöründe settings.asp dosyasında aşağıdaki satır düzenlenir
    arrBaseFolder(0)="/teksevgi/yaziimg/"'Use "Relative to Root" Path
    arrBaseName(0)="Resimler"
    d. resim ve medya klasörüne iis_xxx kullanıcıları için yazma izni verilir

    6. İkide bir boyut ve ayarlarla uğraşmamak için :

    PHP:
    procedure TWebForm_YaziDuzenle.SetEditorOzellikleri;
    begin
     With oEdit1 
    do
     
    begin
      EditorWidth        
    := '100%';
        
    EditorHeight       := '650';
    btnPrint           := true;
    btnPasteText       := true;
    btnFlash           := true;
    btnMedia           := true;
    btnLTR             := true;
    btnRTL             := true;
    btnSpellCheck      := true;
    btnStrikethrough   := true;
    btnSuperscript     := true;
    btnSubscript       := true;
    btnClearAll        := true;
    btnStyles          := true//'Show "Styles/Style Selection" button
     
    AssetManagerWidth  := '640';
    AssetManagerHeight := '475';
    AssetManager       := Sabitler.GetAssertScriptYeri;
     
    end;
    end;
    7. Kodda editör nesnesinin content özelliği ile işlem yapılır. OEdit1.Content := '<h3>İçerik</H3>'

    8. Ek'teki Örneği inceleyiniz...
     
  15. cemaliozan

    cemaliozan Daimi Üye

    Kayıt:
    17 Mayıs 2005
    Mesajlar:
    1,849
    Beğenilen Mesajlar:
    1
    Meslek:
    Boşta gezenlerin yewmiye defterini tutarım...
    Şehir:
    » Burası «
    Binary Veriyi Windows Kayıt Defteri (Registery) İçinde Kaydetmek

    # Binary verinin Windows kayıt defterine (registry) kaydedilmesi.
    # Tüm Delphi Sürümleri

    PHP:
    procedure BinaryOkuYaz;
    type
        TSite 
    record
          AlanAdi
    string;
          
    UrlID  Integer;
    end;
      var 
    RegTRegistry;
       
    VeriOkuTSite;
    begin
      Reg 
    := TRegistry.Create;
      
      
    with Veri do
      
    begin
           AlanAdi  
    := 'www.ceviz.net';
           
    UrlID    := 1;
      
    end;
       
      
    with Reg do
       try
         if 
    OpenKey('sitelerim'Truethen
         begin
            WriteBinaryData
    ('Veri'VeriSizeof(Veri));
            
    ReadBinaryData('Veri'OkuSizeof(Veri));
            
    ShowMessage(Oku.AlanAdi);
         
    end;
      finally
        
    Free;
       
    end;
    end;
    # Uses deklarasyonuna Registry unit eklemelisiniz...
     
  16. cemaliozan

    cemaliozan Daimi Üye

    Kayıt:
    17 Mayıs 2005
    Mesajlar:
    1,849
    Beğenilen Mesajlar:
    1
    Meslek:
    Boşta gezenlerin yewmiye defterini tutarım...
    Şehir:
    » Burası «
    Bağımsız Excel Dosyaları Oluşturmak - Excel Sınıfı

    # Kodlar değerli üstat Tuğrul HELVACI'ya ait. Ortamdan bağımsız (Ole ve MS-Excel) Excel dosyaları oluşturmak için kullanılır.
    # Delphi.NET


    PHP:
      TExcelFile = class
      
    strict private
        
    fStream TStream;

        
    iRow,
        
    iCol    Integer;

        
    constructor Createoverload;
        
    procedure SetValue(aRowaCol Word; const Value TObject);

        
    procedure WriteNumber(Value Double);
        
    procedure WriteString(Value String);
        
    procedure WriteBegin;
        
    procedure WriteEnd;
        function 
    GetByteArray(const aArray TWordArray) : TByteArray;

        
    property Stream TStream read fStream;
      public
        
    constructor Create(const FileName String); overload;
        
    destructor Destroyoverride;

        
    property Cells[RowCol Word] : TObject write SetValue;
      
    end;


    constructor TExcelFile.Create;
    begin
      inherited
    ;
    end;

    constructor TExcelFile.Create(const FileNameString);
    begin
      inherited Create
    ;

      
    fStream := TFileStream.Create(FileNamefmCreate);
      
    WriteBegin;
    end;

    destructor TExcelFile.Destroy;
    begin
      WriteEnd
    ;
      if 
    Assigned(fStreamthen FreeAndNil(fStream);

      
    inherited;
    end;


    function 
    TExcelFile.GetByteArray(const aArrayTWordArray): TByteArray;
    var
      
    wWord    Word;
      
    iCounter Integer;
    begin
      iCounter 
    := 0;
      
    SetLength(Result, (High(aArray)+1) * 2);

      for 
    wWord in aArray do
      
    begin
        Result
    [iCounter]   := Lo(wWord);
        
    Result[iCounter+1] := Hi(wWord);
        
    Inc(iCounter2);
      
    end;
    end;

    procedure TExcelFile.SetValue(aRowaCol Word; const Value TObject);
    var
      
    typ System.&Type;
    begin
      iRow 
    := aRow;
      
    iCol := aCol;

      
    typ := Value.GetType;

      case 
    System.&Type.GetTypeCode(typof
        TypeCode
    .SByte,
        
    TypeCode.Byte,
        
    TypeCode.Int16,
        
    TypeCode.UInt16,
        
    TypeCode.Int32,
        
    TypeCode.UInt32,
        
    TypeCode.Int64,
        
    TypeCode.UInt64,
        
    TypeCode.Single,
        
    TypeCode.Double,
        
    TypeCode.Decimal  WriteNumber(Convert.ToDouble(Value));

        
    TypeCode.Object,
        
    TypeCode.Char,
        
    TypeCode.DateTime,
        
    TypeCode.String   WriteString(Value.ToString) ;

        
    TypeCode.Empty,
        
    TypeCode.DBNull,
        
    TypeCode.Boolean  WriteString('BOS');
        else 
    raise Exception.Create('Tanımsız veri tipi..!!');
      
    end;
    end;

    procedure TExcelFile.WriteBegin;
    var
      
    aArray : array[0..5of Word;
    begin
      aArray
    [0] := $809;
      
    aArray[1] := 8;
      
    aArray[2] := 00;
      
    aArray[3] := $10;
      
    aArray[4] := 0;//BuildNumber
      
    aArray[5] := 0;

      
    Stream.WriteBuffer(GetByteArray(aArray), 12);
    end;

    procedure TExcelFile.WriteEnd;
    var
      
    aArray : array[0..1of Word;
    begin
      aArray
    [0] := $0A;
      
    aArray[1] := 00;

      
    Stream.WriteBuffer(GetByteArray(aArray), 4);
    end;

    procedure TExcelFile.WriteNumber(ValueDouble);
    var
      
    aArray : array[0..4of Word;

    begin
      aArray
    [0] := $203;
      
    aArray[1] := 14;
      
    aArray[2] := iRow;
      
    aArray[3] := iCol;
      
    aArray[4] := 0;

      
    Stream.WriteBuffer(GetByteArray(aArray), 10);
      
    Stream.WriteBuffer(Value8);
    end;

    procedure TExcelFile.WriteString(ValueString);
    var
      
    iLen Word;
      
    aArray : array[0..5of Word;
    begin
      iLen 
    := Length(Value);
      
    aArray[0] := $204;
      
    aArray[1] := iLen;
      
    aArray[2] := iRow;
      
    aArray[3] := iCol;
      
    aArray[4] := 0;
      
    aArray[5] := iLen;

      
    Stream.WriteBuffer(GetByteArray(aArray), 12);
      
    Stream.WriteBuffer(System.Text.ASCIIEncoding.Default.GetBytes(Value), iLen);
    end;
     
  17. cemaliozan

    cemaliozan Daimi Üye

    Kayıt:
    17 Mayıs 2005
    Mesajlar:
    1,849
    Beğenilen Mesajlar:
    1
    Meslek:
    Boşta gezenlerin yewmiye defterini tutarım...
    Şehir:
    » Burası «
    ASP.NET 1.1 - E-Posta Göndermek

    # eposta gönderme örneği
    # BDS-2006 - CG-2007
     
  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
    DBGRID Hakkında Birkaç Özellik

    GRID'ler Hakkında Birkaç Özellik

    Projemdeki Yararlı Bazı Grid Özelliklerini Sizlerle Paylaşayım. Kodları zamanında çeşitli sitelerden ve kaynaklardan toplamıştım.

    Umarım yararlı olur.


    KAYDIRMA ÇUBUKLARINI AYARLAMA

    //-------------------------------------------------------------------
    Kod:
     TStringGrid( DBGrid1 ).ScrollBars := ssBoth;  // yatay göster , dikey gizle
    TStringGrid( DBGrid1 ).ScrollBars := ssNone;  // yatay gizle , dikey göster
    TStringGrid( DBGrid1 ).ScrollBars := ssHorizontal;  // her 2sinide göster
    
    //-------------------------------------------------------------------
    GRİDE SHİT + DELETE TUŞU İLE BASARAK SİLMEYİ ÖNLEME
    ÇUBUKLARINI AYARLAMA
    Kod:
     
        if (ssctrl in shift) and ( Key=VK_delete) then
        begin
        Key:=0;
        ShowMessage('Bu şekilde Kayıt Silinemez');
        end;
    
    //-------------------------------------------------------------------

    Gridin Belli Bir Sütununu Toplayıp Labellere Yazdırma

    Kod:
     
     Alacak:=0.0;                //  toplam:curreny; olrak tanımlayınız
      Borc:=0.0;
          ADOQuery1.first;
          while not ADOQuery1.eof do
          begin
          alacak:=alacak+dbgrid1.columns.grid.fields[11].AsCurrency;
          Borc:=Borc+dbgrid1.columns.grid.fields[10].AsCurrency;
          //devir burda son satırı verir //    Lbl4.Caption:=    floattostr  ((adoquery1.fieldbyname('Borc').asfloat) - (adoquery1.fieldbyname('Alacak').asfloat));
          ADOQuery1.next;
          end;
              Label2.Caption:=currtostr(alacak);
              Label2.Caption:=FormatFloat('##,###0.00',strtofloat(Label2.Caption)); // Alacak
              Label3.Caption:=currtostr(Borc);
              Label3.Caption:=FormatFloat('##,###0.00',strtofloat(Label3.Caption)); // Borç
              Bakiye:=Borc-Alacak;
              Label4.Caption:=currtostr(Bakiye);
              Label4.Caption:=FormatFloat('##,###0.00',strtofloat(Label4.Caption)); // Bakiye
              Lbl2.Caption:=(Currtostr(DBGrid1.DataSource.DataSet.RecordCount)); // Kayıtsayısı
    

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

    SATIR SATIR RENKLENDİRME VE GRİDİN BAŞINA İCON KOYMA

    Kod:
     
     
    procedure TForm18.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
    var Icon: TBitmap;
    begin
        If (gdSelected in state) then // eğer seçili ise
        begin
        DBGrid1.Canvas.Brush.Color := $00FD959C; // zemin rengi
        DbGrid1.Canvas.Font.Color := clYellow; // font rengi
            Label1.Caption:=dbgrid1.Fields[9].Text; // Tel 1
            Label2.Caption:=dbgrid1.Fields[10].Text; // Tel 2
            Label3.Caption:=dbgrid1.Fields[11].Text; // FAx
            Label4.Caption:=dbgrid1.Fields[12].Text; // Cep
            Label11.Caption:=dbgrid1.Fields[4].Text + dbgrid1.Fields[5].Text;      // Adresi
            Label13.Caption:=dbgrid1.Fields[2].Text // Ünvanı
        end
            else if DBGrid1.Fields[37].asstring <>'0' 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.datasource.dataset.recno mod 2) =0
            then DBGrid1.Canvas.Brush.Color := $00C8FBFD
            else DBGrid1.Canvas.Brush.Color := $00BFD7B5;
            DBGrid1.DefaultDrawColumnCell(Rect, DataCol, Column, State);
    //        if  (Column.index=0 ) then begin  // DbGridin 1. Sütunu
    //        with  DBGrid1.Canvas do begin
    //          MainForm.ImageList2.GetBitmap(13,Icon); // imagelistten 13.inci resim alınıyor...
    //          TextRect(Rect,Rect.Left+25,Rect.Top,Column.Field.AsString);     // Alan yazılıyor.. buradaki "rect.left+25" değeri ise 16x16 pix. resimden sonra 5 pixdaha sağa kayması için.
    //          Draw(rect.Left+1,Rect.Top,Icon); // Resim Konuyor..buradaki rect.Left+1 değeri resmin grid duvarına yapışmaması için 2 px sağa kay.
    //       end;
    //      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);
    end;
    



    //-------------------------------------------------------------------
    Satır Sil
    Kod:
      if DbGrid4.RowExist(DbGrid4.SelectedRow) then
        DbGrid4.DeleteRow(DbGrid4.SelectedRow);timepicker7.date;
    //-------------------------------------------------------------------
    SATIR EKLE
    Kod:
      DbGrid4.AddRow;
      DbGrid4.SelectLastRow;
    YADA

    Kod:
      DbGrid4.AddRow();
      DbGrid4.Cell[2, DbGrid4.LastAddedRow].AsString := 'Top Level';
      DbGrid4.Cell[3, DbGrid4.LastAddedRow].AsInteger := Random(100);
      DbGrid4.SelectLastRow;
    //-------------------------------------------------------------------
    SONRAKİ SATIR
    Kod:
    var
      Pos: Integer;
    begin
      Pos := DbGrid4.GetNextSibling(DbGrid4.SelectedRow);
      if DbGrid4.RowExist(Pos) then DbGrid4.SelectedRow := Pos;
    //-------------------------------------------------------------------
    ÖNCEKİ SATIR
    Kod:
    var
      Pos: Integer;
    begin
      Pos := DbGrid4.GetPrevSibling(DbGrid4.SelectedRow);
      if DbGrid4.RowExist(Pos) then DbGrid4.SelectedRow := Pos;
    //-------------------------------------------------------------------
    SALT OKUNUR
    Kod:
    procedure TForm1.DbGrid4BeforeEdit(Sender: TObject; ACol, ARow: Integer;
      var Accept: Boolean);
    begin
     if ((ACol = 2) and (ARow = 2)) or ((ACol = 1) and (ARow = 3)) then
      begin
        ShowMessage('OnBeforeEditEvent: Editing this cell is disabled.');
        Accept := False;
      end;
    end;
    //-------------------------------------------------------------------
    TAMAMLANDI İSE ÜSTÜ ÇİZGİLİ YAZ
    Kod:
    procedure TForm1.Button1Click(Sender: TObject);
    begin
      if DbGrid4.RowCount = 0 then Exit;
      DbGrid4.CellByName['ProgressColumn1', 'Selected'].AsInteger := 100;
      DbGrid4.RefreshRow(DbGrid4.SelectedRow);
    end;
    Kod:
     
     
    procedure TForm1.DbGrid4CellFormating(Sender: TObject; ACol,
      ARow: Integer; var TextColor: TColor; var FontStyle: TFontStyles;
      CellState: TCellState);
    begin
      if DbGrid4.CellByName['ProgressColumn1', ARow].AsInteger = 100 then begin
        TextColor := clGrayText;
        FontStyle := FontStyle + [fsStrikeOut];
      end;
    end;
    
    //-------------------------------------------------------------------
    YENİ SATIRA İSTENİLENLERİ EKLE
    Kod:
    procedure TForm1.Button2Click(Sender: TObject);
    begin
      with DbGrid4 do
      begin
        AddRow;
        Cell[0, RowCount - 1].AsInteger := 0;
        Cell[1, RowCount - 1].AsString := 'Low';
        Cell[2, RowCount - 1].AsString := 'This is sample task';
      end;
    end;
    
    //-------------------------------------------------------------------
    SEÇİLİ SÜTÜNU SAĞA SOLA DAYA
    Kod:
     
      DbGrid4.Columns[DbGrid4.SelectedColumn].Alignment := taLeftJustify;
    SÜTUNU CELLDE DÜŞEY KONUMLA
      DbGrid4.Columns[DbGrid4.SelectedColumn].VerticalAlignment := taAlignTop;
    
    //-------------------------------------------------------------------
    SATIRI KOMPLE AŞAĞI YADA YUKARI TAŞI
    Kod:
      DbGrid4.MoveRow(DbGrid4.SelectedRow, DbGrid4.SelectedRow - 1);
      DbGrid4.SelectedRow := DbGrid4.SelectedRow - 1;
    //-------------------------------------------------------------------
    SÜTUNU BİR ÖNCEKİ SÜTUNA TAŞI
    Kod:
     
     
    procedure TForm1.ToolButton18Click(Sender: TObject);
    var
      o, n: Integer;
    begin
      o := DbGrid4.Columns[DbGrid4.SelectedColumn].Position;
      if o = 0 then Exit;
      n := o - 1;
      DbGrid4.Columns.ChangePosition(o, n);
    end;
    
    //-------------------------------------------------------------------
    SEÇİLİ CELLİ KALIN YAZ
    Kod:
     
    procedure TForm1.btnBoldClick(Sender: TObject);
    begin
      with DbGrid4 do
        if CellBounds(SelectedColumn, SelectedRow) then
          if TToolButton(Sender).Down
            then Cell[SelectedColumn, SelectedRow].FontStyle := Cell[SelectedColumn, SelectedRow].FontStyle + [fsBold]
            else Cell[SelectedColumn, SelectedRow].FontStyle := Cell[SelectedColumn, SelectedRow].FontStyle - [fsBold];
    end;
    
    //-------------------------------------------------------------------
    SEÇİLİ CELLİ İSTENİLEN RENGE BOYA ( ColorPickerEditor1.SelectedColor ONCHANGE'ine YAZILACAK )
    Kod:
     
      with DbGrid4 do
        if CellBounds(SelectedColumn, SelectedRow) then
        begin
          if ColorPickerEditor1.SelectedColor = clNone
            then Cell[SelectedColumn, SelectedRow].Color := Color
            else Cell[SelectedColumn, SelectedRow].Color := ColorPickerEditor1.SelectedColor;
        end;
    
    //-------------------------------------------------------------------
    TÜM SATIRI SEÇ YADA SEÇME
    Kod:
      if TMenuItem(Sender).Checked
        then DbGrid4.Options := DbGrid4.Options + [goSelectFullRow]
          else DbGrid4.Options := DbGrid4.Options - [goSelectFullRow];
    //-------------------------------------------------------------------
    GRİD ÇİZGİLERİNİ GÖSTER YADA GİZLE
    Kod:
      if TMenuItem(Sender).Checked
        then DbGrid4.Options := DbGrid4.Options + [goGrid]
          else DbGrid4.Options := DbGrid4.Options - [goGrid];
    //-------------------------------------------------------------------
    İNDİGATOR GÖSTER YADA GÖSTERME
    Kod:
     
      if TMenuItem(Sender).Checked
        then DbGrid4.Options := DbGrid4.Options + [goIndicator]
          else DbGrid4.Options := DbGrid4.Options - [goIndicator];
    //-------------------------------------------------------------------
    
    CELL FORMAT'a Yazılacak
    Kod:
      if (ACol = 5) then
      begin
        if (DbGrid4.Cell[5, ARow].AsInteger < 200) then TextColor := clRed;
        if (DbGrid4.Cell[5, ARow].AsInteger > 1800) then TextColor := clBlue;
      end;
    //-------------------------------------------------------------------
    SATIR SİLME ONCELL CLICK' E YAZILACAK
    Kod:
    procedure TForm1.DbGrid4CellClick(Sender: TObject; ACol, ARow: Integer);
    begin
      if ACol = 9 then
      begin
        if DbGrid4.Cells[9, ARow] = '0' then DbGrid4.DeleteRow(ARow);
      end;
    end;
    
    //-------------------------------------------------------------------
    ON EDİT ACCEPT E YAZILACAK
    Kod:
      if Value = '-1' then
      begin
        Accept := False;
        ShowMessage('Geçersiz Değer');
      end;
    //-------------------------------------------------------------------
    Kod:
    procedure TForm1.DbGrid4SelectCell(Sender: TObject; ACol, ARow: Integer);
    begin
      if DbGrid4.Columns[DbGrid4.SelectedColumn].Alignment = taLeftJustify then btnLeftAlignment.Down := True;
      if DbGrid4.Columns[DbGrid4.SelectedColumn].Alignment = taCenter then btnCenterAlignment.Down := True;
      if DbGrid4.Columns[DbGrid4.SelectedColumn].Alignment = taRightJustify then btnRightAlignment.Down := True;
      btnBold.Down := fsBold in DbGrid4.Cell[ACol, ARow].FontStyle;
      btnItalic.Down := fsItalic in DbGrid4.Cell[ACol, ARow].FontStyle;
      btnUnderline.Down := fsUnderline in DbGrid4.Cell[ACol, ARow].FontStyle;
      ColorPickerEditor1.SelectedColor := DbGrid4.Cell[ACol, ARow].Color;
    end;
    
    //-------------------------------------------------------------------
    Kod:
    procedure TForm1.DbGrid4BeforeEdit(Sender: TObject; ACol, ARow: Integer;
      var Accept: Boolean);
    begin
     if ((ACol = 2) and (ARow = 2)) or ((ACol = 1) and (ARow = 3)) then
      begin
        ShowMessage('OnBeforeEditEvent: Değiştirme İzni Yok');
        Accept := False;
      end;
    end;
    //-------------------------------------------------------------------
     
  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
    DbGride Checkbox ve Combobox Eklemek ( Kodlu )

    DbGride Checkbox ve Combobox Eklemek ( Kodlu )

    Dosyayı Ekten indirebilirsiniz




    .
     
  20. hmustak

    hmustak PersianBulls

    Kayıt:
    29 Mayıs 2002
    Mesajlar:
    4,607
    Beğenilen Mesajlar:
    0
    Meslek:
    BT/QA
    Şehir:
    Persian
    memo için undo

    procedure TForm1.Button1Click(Sender:TObject);
    begin
    memo1.perform(em_undo, 0, 0);
    end;