paylaşım için teşekkürler iş görücek kodlar var You must log in or register to reply here. Forum Programlama Delphi Bize Ulaşın Forum Kuralları Gizlilik Sözleşmesi Yardım Ana Sayfa RSS bafra oto ekspertiz, Tiktokbegeni.com, erkek cüzdan, eskişehir haber, çelik ranza, hasta yatağı kiralama, bonus veren siteler, ankara oto ekspertiz, istanbul oto ekspertiz, eskişehir oto ekspertiz, çorum oto ekspertiz, geobonus. org, deneme bonusu, bonusportali.com, vbet giriş, Pokerklas, Caddebet, megapari giriş, meritking giriş, meritking, kingroyal giriş, bahis siteleri, betwinner, rokubet giriş, deneme bonusu veren siteler, takipçi satın al, deneme bonusu veren siteler, betnano giriş, elektronik sigara, deneme bonusu veren siteler, replika saat, melbet giriş, smok, deneme bonusu, bahis forum, melbet, izmit oto ekspertiz, poppers turkiye, eskişehir oto ekspertiz, dalyan otel, hack forum, melbet, sohbet numaraları Wardom. Org Bilginin Adresi. 1998'den beri Wardom yayında! Wardom Türkiye'nin en eski forum sitelerinden biri olarak günümüz web sitelerine sponsor linkler yayınlanmaktadır. ataşehir escort maltepe escort pendik escort gaziantep rus escort xxx videos erotik film izle istanbul escort ankara escort istanbul escort gaziantep escort gaziantep escort Paylaşım sitemizde 5651/8 ve 125. madellere göre, tüm üyeler ve ziyaretçiler sitenin kullanımı ve yapılan paylaşımlarından kendileri sorumludur. Şikayetleriniz için bize ulaşabilirsiniz. Tüm hakları saklıdır 2015 Wardom. Org bilginin adresi. Forum ve bilgisayar güvenliği sitesi. var sc_project=2030864;var sc_invisible=1;var sc_security="c6df530c"; Üst <div class="tooltip-content-inner"> <div class="reactTooltip"> <a href="#" class="reaction reaction--1" data-reaction-id="1"><i aria-hidden="true"></i><img src="data:image/gif;base64, R0lGODlhAQABAIAAAAAAAP///yH5BAEAAAAALAAAAAABAAEAAAIBRAA7" class="reaction-sprite js-reaction" alt="Like" title="Like" data-xf-init="tooltip" data-extra-class="tooltip--basic tooltip--noninteractive" /></a> <a href="#" class="reaction reaction--2" data-reaction-id="2"><i aria-hidden="true"></i><img src="data:image/gif;base64, R0lGODlhAQABAIAAAAAAAP///yH5BAEAAAAALAAAAAABAAEAAAIBRAA7" class="reaction-sprite js-reaction" alt="Love" title="Love" data-xf-init="tooltip" data-extra-class="tooltip--basic tooltip--noninteractive" /></a> <a href="#" class="reaction reaction--3" data-reaction-id="3"><i aria-hidden="true"></i><img src="data:image/gif;base64, R0lGODlhAQABAIAAAAAAAP///yH5BAEAAAAALAAAAAABAAEAAAIBRAA7" class="reaction-sprite js-reaction" alt="Haha" title="Haha" data-xf-init="tooltip" data-extra-class="tooltip--basic tooltip--noninteractive" /></a> <a href="#" class="reaction reaction--4" data-reaction-id="4"><i aria-hidden="true"></i><img src="data:image/gif;base64, R0lGODlhAQABAIAAAAAAAP///yH5BAEAAAAALAAAAAABAAEAAAIBRAA7" class="reaction-sprite js-reaction" alt="Wow" title="Wow" data-xf-init="tooltip" data-extra-class="tooltip--basic tooltip--noninteractive" /></a> <a href="#" class="reaction reaction--5" data-reaction-id="5"><i aria-hidden="true"></i><img src="data:image/gif;base64, R0lGODlhAQABAIAAAAAAAP///yH5BAEAAAAALAAAAAABAAEAAAIBRAA7" class="reaction-sprite js-reaction" alt="Sad" title="Sad" data-xf-init="tooltip" data-extra-class="tooltip--basic tooltip--noninteractive" /></a> <a href="#" class="reaction reaction--6" data-reaction-id="6"><i aria-hidden="true"></i><img src="data:image/gif;base64, R0lGODlhAQABAIAAAAAAAP///yH5BAEAAAAALAAAAAABAAEAAAIBRAA7" class="reaction-sprite js-reaction" alt="Angry" title="Angry" data-xf-init="tooltip" data-extra-class="tooltip--basic tooltip--noninteractive" /></a> </div> </div> { "@context": "https://schema.org", "@type": "DiscussionForumPosting", "@id": "https:\/\/www.wardom.org\/threads\/cok-ise-yariyan-kodlar.110723\/", "headline": "Çok İşe Yarıyan Kodlar", "articleBody": "Programdan windows wallpaper'i degistirme islemi\r\n\r\nprocedure TForm1. ChangeWallPaper ;\r\nbegin\r\n SystemParametersInfoA(SPI_SETDESKWALLPAPER, 0, \r\n PChar , SPIF_UPDATEINIFILE);\r\nend;\r\n\r\n\r\n \r\nEliptik form olusturulmasi\r\n\r\nprocedure TForm1. FormCreate ;\r\nvar\r\nregion: HRgn;\r\nbegin\r\n \r\n region:=CreateRoundRectRgn(1, 1, 484, 312, 25, 25);\r\n SetWindowRgn ;\r\nend;\r\n\r\n\r\n \r\nProgramdan bir internet adresini yeni ve istenilen ozelliklerde bir pencerede acmak\r\n\r\nuses \r\ncomobj;\r\nprocedure TFmMain. GotoUrl ;\r\nconst\r\n csOLEObjName = 'InternetExplorer. Application';\r\nvar\r\n IE : Variant;\r\n WinHanlde : HWnd;\r\nbegin\r\n if( VarIsEmpty )then\r\n begin\r\n IE := CreateOleObject ;\r\n IE. Visible := true;\r\n IE. Toolbar := Toolbar;\r\n if Width > 0 then IE. Width := Width;\r\n if Height > 0 then IE. Height := Height;\r\n IE. Navigate ;\r\n end else\r\n begin\r\n WinHanlde := FindWIndow ;\r\n if( 0 <> WinHanlde )then\r\n begin\r\n IE. Navigate ;\r\n SetForegroundWindow ;\r\n end else\r\n begin\r\n ShowMessage ;\r\n end;\r\n end;\r\nend;\r\n\r\n\/\/ kullanimi:\r\n\r\n \r\nGotoUrl('http:\/\/www.delphiturk.com', 0, 0, True);\r\n \r\nGotoUrl('http:\/\/www.delphiturk.com', 400, 400, False);\r\n\r\n\r\n \r\nProgramdan dosya kopyalama islemi \r\n\r\n\r\nprocedure FileCopy ;\r\nvar\r\n S, T: TFileStream;\r\nbegin\r\n S := TFileStream. Create ;\r\n try\r\n T := TFileStream. Create ;\r\n try\r\n T. CopyFrom ;\r\n finally\r\n T. Free;\r\n end;\r\n finally\r\n S. Free;\r\n end;\r\nend; \r\n\r\n\r\n \r\nHerhangi bir Wincontrol' veya tüm ekran nasil bitmap olarak alinir? \r\n\r\n\r\nfunction GetDcAsBitmap : Boolean;\r\nvar\r\n hdcCompatible: HDC;\r\n hbmScreen: HBitmap;\r\nbegin\r\n Result := False;\r\n if DC = 0 then Exit;\r\n hdcCompatible := CreateCompatibleDC ;\r\n hbmScreen := CreateCompatibleBitmap ;\r\n if (hbmScreen = 0) then Exit;\r\n if (SelectObject =0) then Exit;\r\n if not(BitBlt(hdcCompatible, 0,0, W, H, DC, 0,0, SRCCOPY)) then \r\n Exit;\r\n Bitmap. Handle := HbmScreen;\r\n Bitmap. Dormant;\r\n Result := True;\r\nend;\r\n\r\nfunction GetScreenAsBitmap : Boolean;\r\nvar ScreenDC: HDC;\r\nbegin\r\n ScreenDC := CreateDC ;\r\n Result := GetDCAsBitmap(ScreenDC, Bitmap,\r\n GetDeviceCaps ,\r\n GetDeviceCaps \r\n );\r\nend;\r\n\r\nfunction GetWindowAsBitmap : Boolean;\r\nvar Wnd: HWnd;\r\n Rect: TRect;\r\nbegin\r\n Wnd := FindWindow(nil, PChar ;\r\n GetWindowRect ;\r\n Result := GetDCAsBitmap(GetWindowDC , Bitmap, \r\n Rect. Right - Rect. Left, Rect. Bottom - Rect. Top);\r\nend;\r\n\r\nfunction GetWindowAsBitmap : Boolean;\r\nvar\r\n Rect: TRect;\r\nbegin\r\n GetWindowRect ;\r\n Result := GetDCAsBitmap(GetWindowDC , Bitmap, \r\n Rect. Right - Rect. Left, Rect. Bottom - Rect. Top);\r\nend;\r\n\r\n\/\/ Kullanimi:\r\n \r\nGetWindowAsBitmap(Button1. Handle, Image1. Picture. Bitmap);\r\n \r\nGetScreenAsBitmap(Image1. Picture. Bitmap); \r\n\r\n \r\nForm baslik yerine tüm yüzeyden nasil sürüklenir? \r\n\r\n\r\n \r\n\r\nprocedure TForm1. FormMouseDown ;\r\nbegin\r\nReleaseCapture;\r\nForm1. perform(WM_SYSCOMMAND, $F012, 0);\r\nend;\r\n\r\n\r\n\r\n \r\nKlasör ve alt klasörlerde dosya aramak ve bulunanlari bir listeye atmak \r\n\r\n \r\n\r\n\r\nprocedure TForm1. FindFiles ;\r\nvar\r\n SR: TSearchRec;\r\n DirList: TStringList;\r\n IsFound: Boolean;\r\n i: integer;\r\nbegin\r\n if StartDir <> '\\' then\r\n StartDir := StartDir + '\\';\r\n\r\n\r\n IsFound :=\r\n FindFirst = 0;\r\n while IsFound do begin\r\n Memo1. Lines. Add ;\r\n IsFound := FindNext = 0;\r\n end;\r\n FindClose ;\r\n\r\n DirList := TStringList. Create;\r\n IsFound := FindFirst = 0;\r\n while IsFound do begin\r\n if <> 0) and\r\n (SR. Name <> '.') then\r\n DirList. Add ;\r\n IsFound := FindNext = 0;\r\n end;\r\n FindClose ;\r\n\r\n for i := 0 to DirList. Count-1 do\r\n FindFiles ;\r\n DirList. Free;\r\nend;\r\n\r\n\/\/ Kullanimi:\r\nFindFiles ; \r\n\r\n \r\n\r\nBir klasörün toplam boyutu nasil alinir? \r\n\r\nfunction GetDirectorySize : Integer;\r\nvar\r\n Dir: TSearchRec;\r\n Ret: integer;\r\n Path: string;\r\nbegin\r\n Result := 0;\r\n Path := ExtractFilePath ;\r\n Ret := Sysutils. FindFirst ;\r\n\r\n if Ret <> NO_ERROR then\r\n exit;\r\n\r\n try\r\n while ret=NO_ERROR do\r\n begin\r\n inc ;\r\n if and (Dir. Name <> '.') then\r\n Inc(Result, GetDirectorySize ;\r\n Ret := Sysutils. FindNext ;\r\n end;\r\n finally\r\n Sysutils. FindClose ;\r\n end;\r\nend;\r\n\r\n\/\/Kullanimi:\r\nprocedure TForm1. Button1Click ;\r\nbegin\r\n label1. caption := Format('Boyut: %d bytes', );\r\nend;\r\n\r\n\r\n \r\nVerilen bir kredi karti numarasi'nin gecerli olup olmadiginin kontrolü\r\n\r\n \r\n\r\nfunction Vc : integer; \r\nvar \r\n card: string ; \r\n Vcard: array of byte absolute card; \r\n Xcard: integer; \r\n Cstr: string ; \r\n y, x: integer; \r\nbegin \r\n Cstr := \"; \r\n fillchar(Vcard, 22,

Excel dosyasindaki bir hucreye ulasmak // uses kismina ComObj ekle procedure TForm1. Button1Click ; var Book : Variant; FileName : string; Excel, Sheet : Variant; begin Excel := CreateOleObject ; repeat FileName := Excel. GetOpenFileName; until FileName <> '0'; Book := Excel. WorkBooks. Open ; Excel. Visible := False; Sheet := Book. Worksheets ; Showmessage(Sheet. Cells ); end; Buton üzerine birden çok satır yazmak? procedure TForm1. Button1Click ; var i : integer; begin i:=GetWindowLong(Button1. Handle, GWL_STYLE ); SetWindowLong (Button1. Handle, GWL_STYLE, i or BS_MULTILINE); Button1. Caption := 'satır1'

Programdan windows wallpaper'i degistirme islemi procedure TForm1. ChangeWallPaper ; begin SystemParametersInfoA(SPI_SETDESKWALLPAPER, 0, PChar , SPIF_UPDATEINIFILE); end; Eliptik form olusturulmasi procedure TForm1. FormCreate ; var region: HRgn; begin region:=CreateRoundRectRgn(1, 1, 484, 312, 25, 25); SetWindowRgn ; end; Programdan bir internet adresini yeni ve istenilen ozelliklerde bir pencerede acmak uses comobj; procedure TFmMain. GotoUrl ; const csOLEObjName = 'InternetExplorer. Application'; var IE : Variant; WinHanlde : HWnd; begin if( VarIsEmpty )then begin IE := CreateOleObject ; IE. Visible := true; IE. Toolbar := Toolbar; if Width > 0 then IE. Width := Width; if Height > 0 then IE. Height := Height; IE. Navigate ; end else begin WinHanlde := FindWIndow ; if( 0 <> WinHanlde )then begin IE. Navigate ; SetForegroundWindow ; end else begin ShowMessage ; end; end; end; // kullanimi: GotoUrl('http://www.delphiturk.com', 0, 0, True); GotoUrl('http://www.delphiturk.com', 400, 400, False); Programdan dosya kopyalama islemi procedure FileCopy ; var S, T: TFileStream; begin S := TFileStream. Create ; try T := TFileStream. Create ; try T. CopyFrom ; finally T. Free; end; finally S. Free; end; end; Herhangi bir Wincontrol' veya tüm ekran nasil bitmap olarak alinir? function GetDcAsBitmap : Boolean; var hdcCompatible: HDC; hbmScreen: HBitmap; begin Result := False; if DC = 0 then Exit; hdcCompatible := CreateCompatibleDC ; hbmScreen := CreateCompatibleBitmap ; if (hbmScreen = 0) then Exit; if (SelectObject =0) then Exit; if not(BitBlt(hdcCompatible, 0,0, W, H, DC, 0,0, SRCCOPY)) then Exit; Bitmap. Handle := HbmScreen; Bitmap. Dormant; Result := True; end; function GetScreenAsBitmap : Boolean; var ScreenDC: HDC; begin ScreenDC := CreateDC ; Result := GetDCAsBitmap(ScreenDC, Bitmap, GetDeviceCaps , GetDeviceCaps ); end; function GetWindowAsBitmap : Boolean; var Wnd: HWnd; Rect: TRect; begin Wnd := FindWindow(nil, PChar ; GetWindowRect ; Result := GetDCAsBitmap(GetWindowDC , Bitmap, Rect. Right - Rect. Left, Rect. Bottom - Rect. Top); end; function GetWindowAsBitmap : Boolean; var Rect: TRect; begin GetWindowRect ; Result := GetDCAsBitmap(GetWindowDC , Bitmap, Rect. Right - Rect. Left, Rect. Bottom - Rect. Top); end; // Kullanimi: GetWindowAsBitmap(Button1. Handle, Image1. Picture. Bitmap); GetScreenAsBitmap(Image1. Picture. Bitmap); Form baslik yerine tüm yüzeyden nasil sürüklenir? procedure TForm1. FormMouseDown ; begin ReleaseCapture; Form1. perform(WM_SYSCOMMAND, $F012, 0); end; Klasör ve alt klasörlerde dosya aramak ve bulunanlari bir listeye atmak procedure TForm1. FindFiles ; var SR: TSearchRec; DirList: TStringList; IsFound: Boolean; i: integer; begin if StartDir <> '\' then StartDir := StartDir + '\'; IsFound := FindFirst = 0; while IsFound do begin Memo1. Lines. Add ; IsFound := FindNext = 0; end; FindClose ; DirList := TStringList. Create; IsFound := FindFirst = 0; while IsFound do begin if <> 0) and (SR. Name <> '.') then DirList. Add ; IsFound := FindNext = 0; end; FindClose ; for i := 0 to DirList. Count-1 do FindFiles ; DirList. Free; end; // Kullanimi: FindFiles ; Bir klasörün toplam boyutu nasil alinir? function GetDirectorySize : Integer; var Dir: TSearchRec; Ret: integer; Path: string; begin Result := 0; Path := ExtractFilePath ; Ret := Sysutils. FindFirst ; if Ret <> NO_ERROR then exit; try while ret=NO_ERROR do begin inc ; if and (Dir. Name <> '.') then Inc(Result, GetDirectorySize ; Ret := Sysutils. FindNext ; end; finally Sysutils. FindClose ; end; end; //Kullanimi: procedure TForm1. Button1Click ; begin label1. caption := Format('Boyut: %d bytes', ); end; Verilen bir kredi karti numarasi'nin gecerli olup olmadiginin kontrolü function Vc : integer; var card: string ; Vcard: array of byte absolute card; Xcard: integer; Cstr: string ; y, x: integer; begin Cstr := "; fillchar(Vcard, 22,

Sayiyi Turkce olarak yazan kod (159 = Yuzellidokuz vb.) Katirilyona kadar olan sayilari destekler. } const BIRLER: array of string= ; ONLAR : array of string= ; DIGER : array of string= ; function SmallNum : string; var S: string ; begin Result := "; S := IntToStr ; if (Length =1) then S := '00' + S else if (Length =2) then S := '0' + S; if S <>'0' then if S <>'1' then Result := BIRLER[StrToInt(S )] + 'Yüz' else Result := 'Yüz'; Result := Result + ONLAR[StrToInt(S )]; Result := Result + BIRLER[StrToInt(S )]; end; function NumStr : string; var i, j, n, Nm: Integer; S, Sn: string; begin S := FormatFloat('0', Num); Sn := "; if Num = 0 then Sn := 'Sifir' else if Length < 4 then Sn := SmallNum(Round else begin I := 1; J := Length mod 3; if J=0 then begin J := 3; N := Length div 3 - 1; end else N := Length div 3; while i<Length do begin Nm := StrToInt(Copy ; if (Nm=1) and (N=1) then begin Nm := 0; Sn := Sn + SmallNum + Diger ; end; if Nm<>0 then Sn := Sn + SmallNum + Diger ; I := I + J; J := 3; N := N - 1; end; end; Result := Sn; end; // Kullanimi: procedure TForm1. Button1Click ; begin Label1. Caption := NumStr(StrToCurr(Edit1. Text)); end; Bir StringGrid colonu icine dgerin saga kaydirilarak yazilmasi function sagaDaya : string; var bosluk: string; en: integer; begin bosluk := ' '; en := StringGrid1. ColWidths - StringGrid1. Canvas. TextWidth ; while (en - 5) > SG1. Canvas. TextWidth do bosluk := bosluk + ' '; sagaDaya := bosluk + s; end; DBGrid verilerini Excel sayfasina aktarma procedure TForm1. Button1Click ; var v, sayfa:variant; say, i:integer; begin query1. open; say:=query1. recordcount;//query kayit sayisi v:=createoleobject ;//exceli yarat v. workbooks. add;//yeni calisma kitabini ekle sayfa:=v. workbooks . worksheets ; query1. first; for i:=1 to say do begin sayfa. cells :=query1ad. text; sayfa. cells :=query1soyad. text; query1. next; end; v. visible:=true;//Exceli acip verileri goster end; Bilinmeyen bir sql ile ne zaman Query1. Open, ne zaman Query1. ExecSql? procedure TForm1. Button1Click ; begin Query1. Close; Query1. Sql. Text :=Memo1. Lines. Text; try Query1. Open; except on E: Exception do if not then // eger bunun disinda hata varsa raise; end; end; FORMLAR ICIN HOS BIR CAPTION EFEKTI FORMUNUZA BIR TIMER NESNESI EKLEYIN. TIMER'IN INTERVAL DEGERINI 100 YA DA DAHA ASAGI BIR DEGER YAPIP ONTIMER OLAYINI ASAGIDAKI GIBI DUZENLEYIN! EGER BASLIGINIZA BOSLUK KARAKTERLERINI EKLERSENIZ DAHA HOS OLUR : 'BASLIK ' GIBI} procedure TForm1. Timer1Timer ; begin CAPTION:=COPY(CAPTION,2, LENGTH -1)+CAPTION ; end; Databes'den StringGrid'e Aktarma procedure TForm1. BitBtn1Click ; var i, row:integer; begin Table1. OPEN; Table1. First; row := 0; StringGrid1. RowCount:=Table1. RecordCount; while not Table1. EOF do begin for i := 0 to Table1. FieldCount-1 do StringGrid1. Cells := Table1. Fields. AsString; Inc ; Table1. Next; end; end; Yuvarlak Form Olusturma procedure TForm1. FormCreate ; var region: HRgn; begin region:=CreateEllipticRgn(1,1,200,200); SetWindowRgn ; end; Key Kodlari VK_LBUTTON = 1; VK_RBUTTON = 2; VK_CANCEL = 3; VK_MBUTTON = 4; VK_BACK = 8; VK_TAB = 9; VK_CLEAR = 12; VK_RETURN = 13; VK_SHIFT = $10; VK_CONTROL = 17; VK_MENU = 18; VK_PAUSE = 19; VK_CAPITAL = 20; VK_KANA = 21; VK_HANGUL = 21; VK_JUNJA = 23; VK_FINAL = 24; VK_HANJA = 25; VK_KANJI = 25; VK_CONVERT = 28; VK_NONCONVERT = 29; VK_ACCEPT = 30; VK_MODECHANGE = 31; VK_ESCAPE = 27; VK_SPACE = $20; VK_PRIOR = 33; VK_NEXT = 34; VK_END = 35; VK_HOME = 36; VK_LEFT = 37; VK_UP = 38; VK_RIGHT = 39; VK_DOWN = 40; VK_SELECT = 41; VK_PRINT = 42; VK_EXECUTE = 43; VK_SNAPSHOT = 44; VK_INSERT = 45; VK_DELETE = 46; VK_HELP = 47; VK_LWIN = 91; VK_RWIN = 92; VK_APPS = 93; VK_NUMPAD0 = 96; VK_NUMPAD1 = 97; VK_NUMPAD2 = 98; VK_NUMPAD3 = 99; VK_NUMPAD4 = 100; VK_NUMPAD5 = 101; VK_NUMPAD6 = 102; VK_NUMPAD7 = 103; VK_NUMPAD8 = 104; VK_NUMPAD9 = 105; VK_MULTIPLY = 106; VK_ADD = 107; VK_SEPARATOR = 108; VK_SUBTRACT = 109; VK_DECIMAL = 110; VK_DIVIDE = 111; VK_F1 = 112; VK_F2 = 113; VK_F3 = 114; VK_F4 = 115; VK_F5 = 116; VK_F6 = 117; VK_F7 = 118; VK_F8 = 119; VK_F9 = 120; VK_F10 = 121; VK_F11 = 122; VK_F12 = 123; VK_F13 = 124; VK_F14 = 125; VK_F15 = 126; VK_F16 = 127; VK_F17 = 128; VK_F18 = 129; VK_F19 = 130; VK_F20 = 131; VK_F21 = 132; VK_F22 = 133; VK_F23 = 134; VK_F24 = 135; VK_NUMLOCK = 144; VK_SCROLL = 145; VK_LSHIFT = 160; VK_RSHIFT = 161; VK_LCONTROL = 162; VK_RCONTROL = 163; VK_LMENU = 164; VK_RMENU = 165; VK_PROCESSKEY = 229; VK_ATTN = 246; VK_CRSEL = 247; VK_EXSEL = 248; VK_EREOF = 249; VK_PLAY = 250; VK_ZOOM = 251; VK_NONAME = 252; VK_PA1 = 253; VK_OEM_CLEAR = 254; form üzerinde herhangi bir nesneyi tasimak procedure TForm1. Button1MouseDown ; const sc_DragMove=$F012; begin ReleaseCapture; Button1. Perform(WM_SYSCOMMAND, sc_DragMove, 0); end; Verilen web sitesini Internet Explorer'da acmak procedure TForm1. Button1Click ; begin winexec ; end; VeriTabanindan Excele Aktarim. procedure TForm1. Button1Click ; var IRange : Excel97. Range; i, Row : integer; begin if not ExcelApplication1. Visible then //excel acikmi begin excelApplication1. Visible := True; //acik degilse ac excelApplication1. Workbooks. Add(NULL,0); //yeni calisma kitabi olustur end else //excel aciksa yeni calisma sayfasi ekle excelApplication1. Sheets. Add(Null, null, null, null,1); // Alan Basliklarini aktar IRange := excelApplication1. ActiveCell; for i := 0 to Table1. Fields. count-1 do begin IRange. Value := Table1. Fields. DisplayLabel; IRange := IRange. Next; end; // Kayitlari Aktar Table1. DisableControls; try Table1. First; Row :=2; while not Table1. Eof do begin IRange := ExcelApplication1. Range ; for i := 0 to Table1. Fields. Count-1 do begin IRange. Value := Table1. Fields. Value; IRange := IRange. Next; end; Table1. Next; Inc ; end; finally Table1. EnableControls; end; // Auto format IRange:= ExcelApplication1. Range ; IRange. AutoFormat(6, Null, Null, Null, Null, Null, Null); end;