Bir klasörü ve onun altındaki tüm dosyaları ve klasörleri silme Ancak salt okunur özelliği olan ve kullanımda olan dosyalar silinmez. procedure TForm1. Button1Click ; var DirInfo: TSearchRec; r : Integer; begin r := FindFirst ; while r = 0 do begin if and then if DeleteFile(pChar = false then ShowMessage ; r := FindNext ; end; SysUtils. FindClose ; if RemoveDirectory = false then ShowMessage ; end; Başlat butonunu gizlemek veya kullanılmaz hale getirmek procedure TForm1. Button1Click ; var Rgn : hRgn; begin // Başlat butonunu gizle Rgn := CreateRectRgn(0, 0, 0, 0); SetWindowRgn(FindWindowEx(FindWindow , 0, 'Button', nil), Rgn, true); end; procedure TForm1. Button2Click ; begin //Gizlenen Başlat butonunu eski haline döndürmek için SetWindowRgn(FindWindowEx(FindWindow , 0, 'Button', nil), 0, true); end; procedure TForm1. Button3Click ; begin //Başlat butonunu kullanılmaz yap EnableWindow(FindWindowEx(FindWindow , 0, 'Button', nil), false); end; procedure TForm1. Button4Click ; begin //Kullanılmaz yapılan Başlat butonunu eski haline getirmek için EnableWindow(FindWindowEx(FindWindow , 0, 'Button', nil), true); end; Windows Gezginini istediğiniz bir klasörle açma uses kısmına Shellapi unitini ekleyin. ShellExecute(0, 'explore', 'C:\WINDOWS', //açmak istediğiniz dizin nil, nil, SW_SHOWNORMAL); Duvar kağıdını değiştirmek var s: string; begin s := 'c:\windows\athena. bmp'; SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, PChar ,0); Form'un arka kısmına bir resmi döşemek Bitmap: TBitmap; procedure TForm1. FormCreate ; begin Bitmap := TBitmap. Create; Bitmap. LoadFromFile ; end; procedure TForm1. FormPaint ; var X, Y, W, H: LongInt; begin with Bitmap do begin W := Width; H := Height; end; Y := 0; while Y < Height do begin X := 0; while X < Width do begin Canvas. Draw ; Inc ; end; Inc ; end; end; Bir Denetim Masası uygulamasını çalıştırmak Control Panel uygulamaları Windows\System klasörü altında bulunur. . CPL uzantılı dosyalardır. Bu uygulamaları Control. Exe programı ile çalıştırabilirsiniz. Bazı Control Panel uygulamaları Windows\System klasöründe bulunmaz. Bunların ismini vererek çalıştırabilirsiniz. WinExec ; WinExec ; WinExec ; Sayıları virgüllerle yazmak Sayı windows'unuz ayarına göre 12.345.678 veya 12,345,678 şeklinde gösterilir. procedure TForm1. Button1Click ; var i : integer; begin i := 12345678; Memo1. Lines. Add(FormatFloat ; Sistem Tarihini ve Saatini Değiştirmek Sistemin tarihini ve saatini değiştirmek için SetLocalTime fonksiyonunu kullanabilirsiniz. var t:TSystemTime; begin t. wYear:=1998; t. wMonth:=5; t. wDay:=23; t. wHour:=12; t. wMinute:=34; SetLocalTime ; end; Fareyi meşgul şekilde göstermek try Screen. Cursor := crHourGlass; finally Screen. Cursor := crDefault; end; Application. ProcessMessages; Dos programı kullanmak için; WinExec ; Çevirme Edit1. OnChange := NIL; if Edit1. Text = 'Emre ÖZ' then Edit1. Text := 'Emre'; Edit1. OnChange := Edit1Change; İlk harf büyük diğerleri küçük Edit1'e yazılan yazının ilk harfini büyük diğer harflerini küçük yapıyor. var OldStart : Integer; begin With Edit1 do if Text <> '' then begin OnChange := NIL; OldStart := SelStart; Text := UpperCase(Copy(Text,1,1))+LowerCase(Copy(Text,2, Le ngth ; SelStart := OldStart; OnChange := Edit1Change; end; end; Taskbar gizleme procedure hideTaskbar; var wndHandle : THandle; wndClass : array of Char; begin StrPCopy(@wndClass , 'Shell_TrayWnd'); wndHandle := FindWindow(@wndClass , nil); ShowWindow ; end; procedure showTaskbar; var wndHandle : THandle; wndClass : array of Char; begin StrPCopy(@wndClass , 'Shell_TrayWnd'); wndHandle := FindWindow(@wndClass , nil); ShowWindow ; end; Ses kaydetme Bu program mikrofondan sesi alıp bir wav dosyası içine kayıt ediyor. uses MMSystem, WinCrt; function RecordSound : LongInt; var DeviceID: Word; Return: LongInt; MciOpen: TMCI_Open_Parms; MciRecord: TMCI_Record_Parms; MciPlay: TMCI_Play_Parms; MciSave: TMCI_SaveParms; Result2: LongInt; Flags: Word; begin MciOpen. lpstrDeviceType := 'waveaudio'; MciOpen. lpstrElementName := ''; Flags := Mci_Open_Element or Mci_Open_Type; Result2 := MciSendCommand(0, MCI_OPEN, Flags, LongInt ; DeviceID := MciOpen. wDeviceId; WriteLn ; MciRecord. dwTo := MMSecs; Flags := Mci_To or Mci_Wait; Result2 := MciSendCommand(DeviceID, Mci_Record, Flags, LongInt ; WriteLn ; mciPlay. dwFrom := 0; Flags := Mci_From or Mci_Wait; MciSendCommand(DeviceId, Mci_Play, Flags, LongInt ; mciSave. lpfileName := 'Ses. Wav'; Flags := MCI_Save_File or Mci_Wait; Result := MciSendCommand(DeviceID, MCI_Save, Flags, LongInt ; MciSendCommand(DeviceID, Mci_Close, 0, LongInt ; end; begin WriteLn ; RecordSound(10000); WriteLn ;

Bunlar ne ya Bir de Visual Basicden daha kolay öğreniliyor bu delphi diyorlar Alttarafı tek satırlık dosya kopyalamaya bak Alt alta 7-8 satır kod. Visualde ise filecopy Bu kadar basit Visual e geçin siz en iyisi. Bu kadar hammallıktan kurtulmuş olursunuz vallahi ÑightMa

Cd sürücüsünün seri numarası function GetDiskVolSerialID : DWord; var dwTemp1, dwTemp2 : DWord; begin GetVolumeInformation( PChar , Nil, 0, @Result, dwTemp2, dwTemp2, Nil, 0 ); end; MessageDlg( 'Serial number: ' + Format( '%X', ), mtInformation, , 0 ); Capslock'un durumunu öğrenme function IsCapsLockOn : boolean; begin Result := 0 <> (GetKeyState and $01); end; Renklerin hex değerlerini bulma function TColorToHex : string; begin Result := IntToHex( GetRValue , 2 ) + IntToHex( GetGValue , 2 ) + IntToHex( GetBValue , 2 ); end; Cursor'u gizleyip tekrar gösterme Showcursor ; //cursoru göster Showcursor ; //cursoru gizle İnternete bağlı olup olmadığınızı anlamak Forma bir tane tcp componenti ve bir tane buton yerleştirdikten sonra Buttonnun içine aşağıdaki yazı yazılır. if TCP1. LocalIp = '0.0.0.0' then ShowMessage ; Html Sayfasını printerden çıkarma uses Printers; var EskCur: TCursor; begin EskCur := Screen. Cursor; with Printer do begin BeginDoc; HTML1. AutoPrint ; Title := HTML1. URL; EndDoc; end; Screen. Cursor := EskCur; end; Menu'ye clicklenirken hangi tuşla basıldığını algılama procedure TForm1. Menu1Click ; begin if HiWord(GetKeyState <> 0 then Label1. Caption := 'Shift' else if HiWord(GetKeyState <> 0 then Label1. Caption := 'Control' else if HiWord(GetKeyState <> 0 then Label1. Caption := 'Alt' else Label1. Caption := 'None'; end; Formu taskbardan gizleme ShowWindow ; Silinmiş Dosyaları gösterme ; type TForm1 = class Table1: TTable; DataSource1: TDataSource; DBGrid1: TDBGrid; DBNavigator1: TDBNavigator; CheckBox1: TCheckBox; procedure CheckBox1Click ; public procedure ShowDeleted ; end; var Form1: TForm1; implementation uses DBITYPES, DBIERRS, DBIPROCS; procedure TForm1. ShowDeleted ; var rslt: DBIResult; szErrMsg: DBIMSG; begin Table. DisableControls; try Check(DbiSetProp(hDBIObj , curSOFTDELETEON, LongInt ; finally Table. EnableControls; end; Table. Refresh; end; procedure TForm1. CheckBox1Click ; begin ShowDeleted(Table1, CheckBox1. Checked); end; end. Form hakkında kısa bilgi Form1. Show; Form1. Showmodal myForm. Hide; myForm. Free; Formu şeffaf hale getirilmesi OnCreate olayına Brush. Style:=bsClear; yazmanız yeterli. ESC tuşuyla programdan çıkma OnKeyPress olayına if Key =

Dosya Kopyalama (1) 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; Dosya Kopyalama (2) procedure FileCopy ; var FromF, ToF: file; NumRead, NumWritten: Word; Buf: array of Char; begin AssignFile ; Reset(FromF, 1); AssignFile ; Rewrite(ToF, 1); repeat BlockRead(FromF, Buf, SizeOf , NumRead); BlockWrite ; until (NumRead = 0) or ; CloseFile ; CloseFile ; end; Dosya Kopyalama (3) procedure CopyFile ; var FromFile, ToFile: File; begin AssignFile ; AssignFile ; Reset ; try Rewrite ; try if LZCopy(TFileRec . Handle, TFileRec . Handle) < 0 then raise EInOutError. Create finally CloseFile ; end; finally CloseFile ; end; end; Directory Adı değiştirme SysUtils unitesinin içindeki RenameFile function bu işi görmektedir. Treeview componentinin durumunu kaydetme ve gösterme Kaydetmek için TreeView. SaveToFile ; Dosyayı açmak için TreeView. LoadFromFile ; Dosyayı yanlızca okumak şeklinde açma AssignFile ; FileMode := 0; (read only modunda açmak} Reset ; . . . CloseFile ; Açılan dosyanın tarih ve zamanını ayarlamak var f: file; begin Assign ; Reset ; SetFTime ; Close ; end; Deltree procedure delTree ; var FileSearch: SearchRec; begin chDir ; FindFirst ; while (DosError = 0) do begin if AND AND ( <> 0) then begin if DirName = '\' then delTree else delTree ; ChDir ; end; FindNext end; FindFirst ; while (DosError = 0) do begin if AND then Remove ; end; FindNext end; rmDir end; Dbgrid'de dosya silmesini engelleme if and then begin key:=0; end; String'i renk'e renk'i stringe çevirme Uses graphics; form1. Color:=stringtocolor('121'); label1. caption:= ColorToString(form1. color); Mouse'un yerini değiştirmek randomize; SetCursorPos(random(100), random(100)); ComboBox'ın aşağıya listelemesinin farklı bir yolu SendMessage(ComboBox1. handle, 1039, 1, 0); Başlığı Gizlemek ve Göstermek Procedure HideTitlebar; Var Save : LongInt; Begin If form1. BorderStyle=bsNone then Exit; Save:=GetWindowLong(form1. Handle, gwl_Style); If =ws_Caption then Begin Case form1. BorderStyle of bsSingle, bsSizeable : SetWindowLong(form1. Handle, gwl_Style, Save and (Not or ws_border); bsDialog : SetWindowLong(form1. Handle, gwl_Style, Save and (Not or ds_modalframe or ws_dlgframe); End; form1. Height:=form1. Height-getSystemMetrics ; form1. Refresh; End; end; Procedure ShowTitlebar; Var Save : LongInt; begin If form1. BorderStyle=bsNone then Exit; Save:=GetWindowLong(form1. Handle, gwl_Style); If <>ws_Caption then Begin Case form1. BorderStyle of bsSingle, bsSizeable : SetWindowLong(form1. Handle, gwl_Style, Save or ws_Caption or ws_border); bsDialog : SetWindowLong(form1. Handle, gwl_Style, Save or ws_Caption or ds_modalframe or ws_dlgframe); End; form1. Height:=form1. Height+getSystemMetrics ; form1. Refresh; End; end; GradientFill kullanımı Önce uses bölümüne chart ekleyin. Formun üstüne bir tane image componenti yerleştirin ve formun create olayına aşağıdaki kodu yazın. procedure TForm1. FormCreate ; begin GradientFill(Image1. Canvas, Image1. ClientRect, clred, clblue, false); end; Küçük bir kolaylık ctrl-space Delphide eşitlik kurucağınız zaman ctrl-space'e bastığınızda verebileceğiniz değerleri göstermektedir. Label1. caption:= Dbf dosyasını pack etmek Table1. Exclusive := True; Table1. Active := True; Error := DbiPackTable(Table1. DBHandle, Table1. Handle, nil, szdBASE, True); Table1. Active := False; Table1. Exclusive := False; BDE' nin yüklü olup olmadığını anlamak HKEY_LOCAL_MACHINE\Software\Borland\Database Engine bölümü bde'ye ayrılmıştır ve yüklü olup olmadığını aşağıdaki değerleri kontrol ederek bulabilirsiniz. DLLPATH CONFIGFILE01 Clipboard'a kopyalama ve yapıştırma procedure CopyButtonClick ; begin If ActiveControl is TMemo then TMemo . CopyToClipboard; If ActiveControl is TDBMemo then TDBMemo . CopyToClipboard; If ActiveControl is TEdit then TEdit . CopyToClipboard; If ActiveControl is TDBedit then TDBedit . CopyToClipboard; end; procedure PasteButtonClick ; begin If ActiveControl is TMemo then TMemo . PasteFromClipboard; If ActiveControl is TDBMemo then TDBMemo . PasteFromClipboard; If ActiveControl is TEdit then TEdit . PasteFromClipboard; If ActiveControl is TDBedit then TDBedit . PasteFromClipboard; end; TStringgrid'i kaydetme ve açma Procedure SaveGrid; var f:textfile; x, y:integer; begin assignfile ; rewrite ; writeln ; writeln ; For X:=0 to stringgrid. colcount-1 do For y:=0 to stringgrid. rowcount-1 do writeln ; closefile ; end; Procedure LoadGrid; var f:textfile; temp, x, y:integer; tempstr:string; begin assignfile ; reset ; readln ; stringgrid. colcount:=temp; readln ; stringgrid. rowcount:=temp; For X:=0 to stringgrid. colcount-1 do For y:=0 to stringgrid. rowcount-1 do begin readln ; stringgrid. cells :=tempstr; end; closefile ; Avi dosyasının görünüm alanını seçilen panele eşitleme begin with MediaPlayer1 do begin DeviceType := dtAutoSelect; visible := false; FileName := InputBox ; display := panel1; open; DisplayRect := rect(0, 0, panel1. width, panel1. height); rewind; play; end; end; Windows'a çizgi çizmenin farklı bir yolu procedure TForm1. FormMouseMove ; var dc:hdc; begin dc:=getdc(0); Windows. LineTo ; end; end. Memo componentindeki cursorun pozisyonunu bulma procedure TForm1. Button1Click ; var Row, Col: Integer; begin Row := SendMessage(Memo1. Handle, EM_LINEFROMCHAR, Memo1. SelStart, 0); Col := Memo1. SelStart - SendMessage(Memo1. Handle, EM_LINEINDEX, Row, 0); Label1. caption := 'Row= ' + IntToStr(Row+1) + ' Col= ' + IntToStr(Col+1); end; Form üstüne dbclick yapılınca maximisize olması type TForm1 = class Button1: TButton; procedure Button1Click ; private procedure WMNCHitTest ; message wm_NCHitTest; end; var Form1: TForm1; implementation procedure TForm1. WMNCHitTest ; begin inherited; if M. Result = htClient then M. Result := htCaption; end; procedure TForm1. Button1Click ; begin Close; end; end. Control paneldeki bölümleri açma unit open_cpl; interface function RunControlPanelApplet : integer; implementation uses Windows; function RunControlPanelApplet : integer; begin Result := WinExec( PChar('rundll32. exe shell32. dll,'+ 'Control_RunDLL '+sAppletFileName), SW_SHOWNORMAL); end; end. access. cpl: Accessibility Properties appwiz. cpl: Add/Remove Programs Properties desk. cpl: Display Properties intl. cpl: Regional Settings Properties joy. cpl: Joystick Properties main. cpl: Mouse Properties mmsys. cpl: Multimedia Properties modem. cpl: Modems Properties sysdm. cpl: System Properties timedate. cpl: Time/Date Properties Kullanılan printer adı uses Printers; function GetDefaultPrinterName : string; begin GetDefaultPrinterName := Printer. Printers ; end;

dostum gercekten ise yarar bi dokuman sgl visual ortamda bzn bu tur prosedurleri araan olur hep..

then halt; yazın. Bir Resim Dosyası Açıp İçine Çizim Yapma var Resim: TBitmap; Resim := TBitmap. Create; with Resim do try Width := 100; Height := 100; with Canvas do begin Rectangle(0, 0, 100, 100); MoveTo(0, 0); LineTo(100, 100); MoveTo(0, 100); LineTo(100, 0); end; SaveToFile finally Free; end; Asla Yazı Kutusundan Çıkamazsın procedure TForm1. Edit1Exit ; begin showmessage ; postmessage(handle, WM_NEXTDLGCTL,0,0); postmessage(handle, WM_NEXTDLGCTL,1,0); end; Formun Boyutlarını Sabitleme unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs; type TForm1 = class private public procedure WMGetMinMaxInfo ; message WM_GETMINMAXINFO; end; var Form1: TForm1; implementation procedure TForm1. WMGetMinMaxInfo ; begin with Message. MinMaxInfo^ do begin ptMaxSize. X := 200; ptMaxSize. Y := 200; ptMaxPosition. X := 99; ptMaxPosition. Y := 99; ptMinTrackSize. X := 100; ptMinTrackSize. Y := 100; ptMaxTrackSize. X := 300; ptMaxTrackSize. Y := 300; end; Message. Result := 0; inherited; end; end. Windows'a True Type Font Ekleme uses Registry; procedure TForm1. Button1Click ; var reg: TRegistry; b : bool; begin CopyFile('C:\DOWNLOAD\FP000100. TTF', 'C:\WINDOWS\FONTS\FP000100. TTF', b); reg := TRegistry. Create; reg. RootKey := HKEY_LOCAL_MACHINE; reg. LazyWrite := false; reg. OpenKey ; reg. WriteString('TESTMICR ','FP000100. TTF'); reg. CloseKey; reg. free; AddFontResource('c:\windows\fonts\FP000100. TTF'); SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0); RemoveFontResource('c:\windows\fonts\FP000100. TTF' ); SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0); end; Dosya Taşıma MoveFile ; Trim Fonksiyonunun açılımı unit StrFunc; interface procedure LTrim ; procedure RTrim ;procedure Trim ; implementation procedure LTrim ; begin while ((length > 0) and (s =

Visual'e biraz göz gezdirdim delphiye çok benziyor tabi başlangıç için Bu kodlar başımı döndürdü yaw

abi yaa süper olmuş buu banada yardım edermsınız benım delphıde ödevım var ve ben bunu busene gördum hoca şimdi bana bılmedıgım dersten ödev verdı arastırıyorum ve sızlerınde yardımınızı beklıyorum benım projem delphıde hastane kaydını tutma şimdiden teşşekür ederım bende çalışmalar başlatıtım ve yenı üyeyım ve sılerle arşiv paylaşımı yapabılırım elımde herturlu arşiv

abi bu nedir allah aşkına paylaşım süper bi şey ama kodlardan fazla bi şey anlamadım

Edit1'deki yazıyı edit2'ye GetTextBuf yolluyla aktarma procedure TForm1. Button1Click ; var Buffer: PChar; Size: Byte; begin Size := Edit1. GetTextLen; Inc ; GetMem ; Edit1. GetTextBuf ; Edit2. Text := StrPas ; {Converts Buffer to a Pascal-style string] FreeMem ; end; Form1'in aynısını printerden çıkartma Form1. Print; O anki sürücünün kapasitesini ve sürücüdeki boş yer miktarını bulmak; DiskFree(0) //o anki sürücüdeki boş yer miktarını byte cinsinden döndürür. DiskSize(0) //o anki sürücünün kapasitesini byte cinsinden döndürür. DiskSize(0) div 1024 //o anki sürücünün kapasitesini KB cinsinden döndürür. Bir menü öğesinin enabled özelliğini false yapmak; mainmenu1. items . items . enabled:=False; Listbox veya Combobox'ta seçili bir veya birden fazla öğeyi seçilmemiş duruma getirmek için; Listbox1. itemindex:=-1; Listbox, Combobox ve Memo'ya bir seferde ekleme yapmak; Listbox1. items. SetText('aaa'

birde elinde paylasabilecegin degisik ornek kodlar varmi varsa paylasirsan sevinirim.

hocam bu ekran goruntusu, camera ve ses alma kodlari hakkinda bilgi verirmisin