Programlama yapalım ve Öğrenelim.

StatusBar (Gauge Renkli 2 versiyon) Component

{******************************************************************

* Kritik Sevi Eklendi SarıRenk oluyor. * *

* Değer Eklendi integer olarak verilen değere göre Kritik Seviye *

* Altında Kırmızı Üzerinde Yeşil oluyor. *

*******************************************************************}

unit Status;

interface

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,

Forms, Dialogs, ExtCtrls, Menus, Gauges;

type

TStatus = class(TCustomPanel)

private

FDate : Boolean;

FKeys : Boolean;

FTime : Boolean;

FResources : Boolean;

DateTimePanel : TPanel;

ResPanel : TPanel;

ResGauge : TGauge;

CapPanel : TPanel;

NumPanel : TPanel;

InsPanel : TPanel;

HelpPanel : TPanel;

UpdateWidth : Boolean;

FTimer : TTimer;

FCurValue : Longint;

FMinValue : Longint;

FMaxValue : Longint;

FKritikValue : Longint;

procedure SetMinValue(Value: Longint);

procedure SetMaxValue(Value: Longint);

procedure SetProgress(Value: Longint);

procedure SetKritik(Value: Longint);

function GetPercentDone: Longint;

procedure SetDate(A: Boolean);

procedure SetKeys(A: Boolean);

procedure SetTime(A: Boolean);

procedure SetResources(A: Boolean);

procedure SetCaption(A: String);

Function GetCaption: String;

procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;

public

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

procedure SetupPanelFields(ThePanel: TPanel);

procedure SetupPanel(ThePanel: TPanel; WidthMask: String);

procedure UpdateStatusBar(Sender: TObject);

property PercentDone: Longint read GetPercentDone;

procedure AddProgress(Value: Longint);

procedure AddKritik(Value: Longint);

published

property ShowDate: Boolean read FDate write SetDate default True;

property ShowKeys: Boolean read FKeys write SetKeys default True;

property ShowTime: Boolean read FTime write SetTime default True;

property ShowResources: Boolean read FResources write SetResources default True;

property Progress: Longint read FCurValue write SetProgress;

property Kritik : Longint read FKritikValue write SetKritik default 0;

property MinValue: Longint read FMinValue write SetMinValue default 0;

property MaxValue: Longint read FMaxValue write SetMaxValue default 100;

property BevelInner;

property BevelOuter;

property BevelWidth;

property BorderStyle;

property BorderWidth;

property Caption: string read GetCaption write SetCaption;

property Color;

property Ctl3D;

property DragCursor;

property DragMode;

property Enabled;

property Font;

property ParentColor;

property ParentCtl3d;

property ParentFont;

property ParentShowHint;

property PopUpMenu;

property ShowHint;

property Visible;

end;

procedure Register;

implementation

uses Windows;

procedure Register;

begin

RegisterComponents('Additional', [TStatus]);

end;

procedure TStatus.SetupPanelFields(ThePanel: TPanel);

begin

with ThePanel do

begin

Alignment := taCenter;

Caption := '';

BevelInner := bvLowered;

BevelOuter := bvNone;

{Set all these true so they reflect the settings of the TStatus}

ParentColor := True;

ParentFont := True;

ParentCtl3D := True;

end;

procedure TStatus.SetupPanel(ThePanel: TPanel; WidthMask: String);

begin

SetupPanelFields(ThePanel);

with ThePanel do

begin

Width := Canvas.TextWidth(WidthMask);

Align := alRight;

end;

constructor TStatus.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

Parent := TWinControl(AOwner);

FTime := True;

FDate := True;

FKeys := True;

FResources := True;

FMinValue := 0;

FMaxValue := 100;

FCurValue := 0;

FKritikValue:=0;

{Force the status bar to be aligned bottom}

Align := alBottom;

Height := 30;

BevelInner := bvNone;

BevelOuter := bvRaised;

{When UpdateWidth is set TRUE, status bar will recalculate panel widths once}

UpdateWidth := True;

Locked := True;

TabOrder := 0;;

TabStop := False;

Font.Name := 'Arial';

Font.Size := 8;

{Create the panel that will hold the date & time}

DateTimePanel := TPanel.Create(Self);

DateTimePanel.Parent := Self;

SetupPanel(DateTimePanel,' 00/00/00 00:00:00 am ');

{Create the panel that will hold the resources graph}

ResPanel := TPanel.Create(Self);

ResPanel.Parent := Self;

SetupPanel(ResPanel,' ');

{Create the 2 Gauges that will reside within the Resource Panel}

ResGauge := TGauge.Create(Self);

ResGauge.Parent := ResPanel;

ResGauge.Align := alClient;

ResGauge.ParentFont := True;

ResGauge.BackColor := Color;

ResGauge.ForeColor := clLime;

ResGauge.BorderStyle := bsNone;

{Create the panel that will hold the CapsLock state}

CapPanel := TPanel.Create(Self);

CapPanel.Parent := Self;

SetupPanel(CapPanel,' Cap ');

{Create the panel that will hold the NumLock state}

NumPanel := TPanel.Create(Self);

NumPanel.Parent := Self;

SetupPanel(NumPanel,' Num ');

{Create the panel that will hold the Insert/Overwrite state}

InsPanel := TPanel.Create(Self);

InsPanel.Parent := Self;

SetupPanel(InsPanel,' Ins ');

{Create the panel that will hold the status text}

HelpPanel := TPanel.Create(Self);

HelpPanel.Parent := Self;

SetupPanelFields(HelpPanel);

{Have the help panel consume all remaining space}

HelpPanel.Align := alClient;

HelpPanel.Alignment := taLeftJustify;

{This is the timer that will update the status bar at regular intervals}

FTimer := TTimer.Create(Self);

If FTimer <> Nil then

begin

FTimer.OnTimer := UpdateStatusBar;

{Updates will occur twice a second}

FTimer.Interval := 500;

FTimer.Enabled := True;

end;

destructor TStatus.Destroy;

begin

FTimer.Free;

HelpPanel.Free;

InsPanel.Free;

NumPanel.Free;

CapPanel.Free;

ResGauge.Free;

ResPanel.Free;

DateTimePanel.Free;

inherited Destroy;

end;

procedure TStatus.SetDate(A: Boolean);

begin

FDate := A;

UpdateWidth := True;

end;

procedure TStatus.SetKeys(A: Boolean);

begin

FKeys := A;

UpdateWidth := True;

end;

procedure TStatus.SetTime(A: Boolean);

begin

FTime := A;

UpdateWidth := True;

end;

procedure TStatus.SetResources(A: Boolean);

begin

FResources := A;

UpdateWidth := True;

end;

{When we set or get the TStatus caption, it is affecting the HelpPanel

caption instead}

procedure TStatus.SetCaption(A: String);

begin

HelpPanel.Caption := ' '+A;

end;

function TStatus.GetCaption: String;

begin

GetCaption := HelpPanel.Caption;

end;

{This procedure sets the captions appropriately}

procedure TStatus.UpdateStatusBar(Sender: TObject);

begin

if ShowDate and ShowTime then

DateTimePanel.Caption := DateTimeToStr(Now)

else

if ShowDate and not ShowTime then

DateTimePanel.Caption := DateToStr(Date)

else

if not ShowDate and ShowTime then

DateTimePanel.Caption := TimeToStr(Time)

else

DateTimePanel.Caption := '';

if UpdateWidth then with DateTimePanel do

if ShowDate or ShowTime then

Width := Canvas.TextWidth(' '+Caption+' ')

else

Width := 0;

if ShowResources then

begin

// Yeni Düzenleme

// ResGauge.Progress := GetFreeSystemResources(GFSR_SYSTEMRESOURCES);

ResGauge.Progress := FCurValue;

if ResGauge.Progress < FKritikValue then //kritik seviyekırmızı

ResGauge.ForeColor := clRed

else

if ResGauge.Progress = FKritikValue then //kritik seviyekırmızı

ResGauge.ForeColor := clYellow

else

ResGauge.ForeColor := clLime;

end;

if UpdateWidth then

if ShowResources then

ResPanel.Width := Canvas.TextWidth(' ')

else

ResPanel.Width := 0;

if ShowKeys then

begin

if (GetKeyState(vk_NumLock) and $01) <> 0 then

NumPanel.Caption := ' Num ' else NumPanel.Caption := '';

if (GetKeyState(vk_Capital) and $01) <> 0 then

CapPanel.Caption := ' Cap ' else CapPanel.Caption := '';

if (GetKeyState(vk_Insert) and $01) <> 0 then

InsPanel.Caption := ' Ins ' else InsPanel.Caption := '';

end;

if UpdateWidth then

if ShowKeys then

begin

NumPanel.Width := Canvas.TextWidth(' Num ');

InsPanel.Width := Canvas.TextWidth(' Ins ');

CapPanel.Width := Canvas.TextWidth(' Cap ');

end

else

begin

NumPanel.Width := 0;

InsPanel.Width := 0;

CapPanel.Width := 0;

end;

UpdateWidth := False;

end;

{This allows font changes to be detected so the panels will be adjusted}

procedure TStatus.CMFontChanged(var Message: TMessage);

begin

inherited;

UpdateWidth := True;

end;

procedure TStatus.SetProgress(Value: Longint);

var

TempPercent: Longint;

begin

TempPercent := GetPercentDone; { remember where we were }

if Value < FMinValue then

Value := FMinValue

else if Value > FMaxValue then

Value := FMaxValue;

if FCurValue <> Value then

begin

FCurValue := Value;

if TempPercent <> GetPercentDone then { only refresh if percentage changed }

Refresh;

end;

procedure TStatus.SetKritik(Value: Longint);

var

TempPercent: Longint;

begin

TempPercent := GetPercentDone; { remember where we were }

if Value < FMinValue then

Value := FMinValue

else if Value > FMaxValue then

Value := FMaxValue;

if FKritikValue <> Value then

begin

FKritikValue := Value;

if TempPercent <> GetPercentDone then { only refresh if percentage changed }

Refresh;

end;

procedure TStatus.AddProgress(Value: Longint);

begin

Progress := FCurValue + Value;

Refresh;

end;

procedure TStatus.AddKritik(Value: Longint);

begin

Kritik := FKritikValue + Value;

Refresh;

end;

function SolveForY(X, Z: Longint): Longint;

begin

if Z = 0 then Result := 0

else Result := Longint(Trunc( (X * 100.0) / Z ));

end;

function TStatus.GetPercentDone: Longint;

begin

Result := SolveForY(FCurValue - FMinValue, FMaxValue - FMinValue);

end;

procedure TStatus.SetMinValue(Value: Longint);

begin

if Value <> FMinValue then

begin

if Value > FMaxValue then

if not (csLoading in ComponentState) then

// raise EInvalidOperation.CreateFmt(SOutOfRange, [-MaxInt, FMaxValue - 1]);

FMinValue := Value;

if FCurValue < Value then FCurValue := Value;

Refresh;

end;

procedure TStatus.SetMaxValue(Value: Longint);

begin

if Value <> FMaxValue then

begin

if Value < FMinValue then

if not (csLoading in ComponentState) then

// raise EInvalidOperation.CreateFmt(SOutOfRange, [FMinValue + 1, MaxInt]);

FMaxValue := Value;

if FCurValue > Value then FCurValue := Value;

Refresh;

end;

end.

Delphi - .....................................

delphi ile php upload

soru?

You can do this using Indy that comes with Delphi.

It involves two things. TIdHTTP and TIdMultipartFormDataStream.

Add IdMultipartFormData to your uses clause.

Drop TIdHTTP (which is in Indy Clients tab of Component Palette )

on to your form. Set whatever properties of TIdHTTP you want.

Now if you were wanting the file to be uploaded after a button has

been clicked then put this in the event handler you assigned

for the buttons OnClick event.

procedure TFormClassNameHere.EventHandlerNameHere( Sender : TObject )

var

Stream : TIdMultipartFormDataStream;

begin

Stream := TIdMultipartFormDataStream.Create;

try

Stream.AddFile( 'form_field_name_here', 'filename_here', 'content-type_here' );

IdHTTP1.Post( 'url_here', Stream );

finally

Stream.Free;

end;

Delphi - .....................................

mssql table yedek

SELECT * INTO Categories_Yedek

FROM Categories

WHERE CategoryId > 3

Yukarıdaki komut ilk olarak Categories tablosu ile aynı yapıda Categories_Yedek

isimli bir tablo oluşturacaktır. Daha sonra Categories tablosundaki tüm kayıtları

Categories_Yedek tablosuna aktaracaktır. Burada şunu bilmekte fayda var;

SELECT INTO komutu index, trigger gibi nesneleri yeni oluşturulan tabloya aktarmaz.

Delphi - .....................................

Ping Atma

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, IdBaseComponent, IdComponent, IdRawBase, IdRawClient,

IdIcmpClient, StdCtrls, ExtCtrls;

type

TForm1 = class(TForm)

IdIcmpClient1: TIdIcmpClient;

host: TEdit;

Button1: TButton;

Label1: TLabel;

ekran: TListBox;

Timer1: TTimer;

ysure: TEdit;

zasim: TEdit;

Label5: TLabel;

CheckBox1: TCheckBox;

procedure FormCreate(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure IdIcmpClient1Reply(ASender: TComponent; const AReplyStatus: TReplyStatus);

procedure Timer1Timer(Sender: TObject);

procedure CheckBox1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

begin

host.Text:='172.17.24.172';

IdIcmpClient1.TTL:=9;

ysure.Text:='3000';

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

ekran.Clear;

IdIcmpClient1.Host:=HOST.Text;

IdIcmpClient1.ReceiveTimeout:=strtoint(zasim.text);

IdIcmpClient1.Ping();

end;

procedure TForm1.IdIcmpClient1Reply(ASender: TComponent; const AReplyStatus: TReplyStatus);

var

veri,ipadres,ttlsi,sure:string;

begin

case areplystatus.ReplyStatusType of

rsecho:

begin

veri:=inttostr(areplystatus.BytesReceived);

ipadres:=areplystatus.FromIpAddress;

ttlsi:=inttostr(areplystatus.TimeToLive);

sure:=inttostr(areplystatus.MsRoundTripTime);

ekran.Items.Add(ipadres+' Cevabı: Byte='+veri+' Süre='+sure+' TTL='+ttlsi);

end;

rstimeout: ekran.Items.Add('İstek zaman aşımına uğradı');

else ekran.Items.Add('Hedef Ağa Ulaşılamadı..');

end;

procedure TForm1.Timer1Timer(Sender: TObject);

begin

if length(host.Text)<1 then IdIcmpClient1.Host:=host.Text;

IdIcmpClient1.Ping();

end;

procedure TForm1.CheckBox1Click(Sender: TObject);

begin

if CheckBox1.Checked then begin

ysure.Enabled:=false;

Timer1.Interval:=strtoint(ysure.Text);

Timer1.Enabled:=true;

end else begin

ysure.Enabled:=true;

Timer1.Enabled:=false;

end;

end.

Delphi - .....................................

AvrilPanel

unit AvrilPanel;

interface

uses

Windows, Messages,IniFiles, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

ExtCtrls;

type

TAvrilPanel = class(TPanel)

private

FColor: TColorDialog; // Renk Dialog Kutusu

FFont : TFontDialog;

Section: String; // İni Dosyasından Okunacak Alan

IniFile : TIniFile;

{ Form : TCustomForm; -> Bu kısmı Kullanmaya gerek Yokmuş }

Form_Name : String; // Formun adının tutulduğu değişken

Exe_Name: String; // Exe'nin adının tutulduğu Değişken

SColor: String; // Okunan ya da Yazılan Renk'in geçici olarak tutulduğu Değer

{ Private declarations }

protected

procedure MouseDown (Button : TMouseButton; Shift : TShiftState;

X, Y : Integer); override;

procedure Loaded; override;

{ Protected declarations }

public

constructor Create(AOwner: TComponent); override;

{ Public declarations }

published

{ Published declarations }

end;

procedure Register;

implementation

procedure Register;

begin

RegisterComponents('MyComponents', [TAvrilPanel]);

end;

{ TAvrilPanel }

constructor TAvrilPanel.Create(AOwner: TComponent);

begin

inherited;

FColor:=TColorDialog.Create(Self);

FFont :=TFontDialog.Create(Self);

IniFile := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));

{Ini dosyası Exenin ismi ile oluşturulur. Eğer Aynı dosyadan varsa herhangi bir

işlem yapılmaz}

end;

procedure TAvrilPanel.Loaded;

begin

inherited;

Form_Name:=(GetParentForm(Self).Name); // Formun Adı

Exe_Name :=ChangeFileExt(Application.ExeName,'.ini'); //Exe'nin Adı

SColor:= inifile.ReadString('BACK_COLOR',Form_Name + '_'+Name,'clWhite');

Color:=StringToColor(SColor);

SColor:=inifile.ReadString('FONT_COLOR',Form_Name + '_'+Name,'clblack');

Font.Color:=StringToColor(SColor);

Font.Name := IniFile.ReadString('Font', Form_Name+'_'+ Name+'_Name', 'Courier New');

Font.Size := IniFile.ReadInteger('Font', Form_Name+'_'+ Name+'_Size', 9);

if IniFile.ReadBool('Font', Form_Name+'_'+ Name+'_Bold', false) then

Font.Style := Font.Style + [fsBold];

if IniFile.ReadBool('Font', Form_Name+'_'+ Name+'_Italic', false) then

Font.Style := Font.Style + [fsItalic];

if IniFile. ReadBool('Font',Form_Name+'_'+ Name+'_Underline', false) then

Font.Style := Font.Style + [fsUnderline];

if IniFile.ReadBool('Font', Form_Name+'_'+ Name+'_StrikeOut', false) then

Font.Style := Font.Style + [fsStrikeOut];

end;

procedure TAvrilPanel.MouseDown(Button: TMouseButton; Shift: TShiftState;

X, Y: Integer);

begin

inherited;

Form_name:=(GetParentForm(Self).Name);

if (SSShift in Shift) and (SSCtrl in Shift) Then

begin

FFont.Execute;

if FFont.Font.Color = Color Then

if Application.MessageBox('-UYARI'+Chr(13)+Chr(13)+

'- Yazı Rengi ile Arka Plan rengi Aynı, Bu Yazıların Görünmemesine yol açacaktır.'+chr(13)+Chr(13)+

'Devam Edilsinmi?','Uyarı',MB_YESNO) = idyes then begin

Font.Color:=ffont.Font.Color;

iniFile.WriteString('FONT_COLOR',Form_Name+'_'+ Name, ColorToString(FFont.Font.Color));

End;

If FFont.Font.color<>Color Then

begin

Font.Color:=ffont.Font.Color;

iniFile.WriteString('FONT_COLOR',Form_Name+'_'+ Name, ColorToString(FFont.Font.Color));

end;

font.name:=ffont.Font.Name;

font.size:=ffont.Font.Size;

Font.Style := FFont.Font.Style;

iniFile.WriteString('Font',Form_Name+'_'+ Name+'_Name', FFont.Font.Name);

iniFile.WriteInteger('Font',Form_Name+'_'+ Name+'_Size',FFont.Font.Size);

IniFile.WriteBool('Font', Form_Name+'_'+ Name+'_Bold', (fsBold in Font.Style));

IniFile.WriteBool('Font', Form_Name+'_'+ Name+'_Italic', (fsItalic in Font.Style));

Inifile.WriteBool('Font', Form_Name+'_'+ Name+'_Underline', (fsUnderline in Font.Style));

inifile.WriteBool('Font', Form_Name+'_'+ Name+'_StrikeOut', (fsStrikeOut in Font.Style));

Exit;

end;

if (SSCtrl in Shift) Or (SSShift in Shift) Then

begin

SColor := ColorToString(FColor.Color);

FColor.Execute; //renk dialog kutusunu çalıştır

If FColor.Color = StringToColor(SColor) Then Exit;

if (SSShift in Shift) and (FColor.Color = Color) Then

if Application.MessageBox('-UYARI'+Chr(13)+Chr(13)+

'- Yazı Rengi ile Arka Plan rengi Aynı, Bu Yazıların Görünmemesine yol açacaktır.'+chr(13)+Chr(13)+

'Devam Edilsinmi?','Uyarı',MB_YESNO) = idno then Exit;

if (SSCtrl in Shift) and (FColor.Color = Font.Color) Then

if Application.MessageBox('-UYARI'+Chr(13)+Chr(13)+

'- Yazı Rengi ile Arka Plan rengi Aynı, Bu Yazıların Görünmemesine yol açacaktır.'+chr(13)+Chr(13)+

'Devam Edilsinmi?','Uyarı',MB_YESNO) = idno then Exit;

SColor:=ColorToString(FColor.Color); //Seçilen Rengi Al

if SSCtrl in Shift Then Begin Color := FColor.Color; Section:='BACK_COLOR'; End; // Rengi Uygula ve alanı al

if SSShift in Shift Then Begin Font.Color := FColor.Color; Section:='FONT_COLOR'; End; // Rengi Uygula ve alanı al

iniFile.WriteString(section,Form_Name+'_'+ Name, SColor); // İni dosyasına yaz

End;

end;

end.

______________________________________________________________________

panel componenti componentin yaptığı işlem şu:

eğer kullanıcı Ctrl+Click yaparsa colordialog açılıp arkal plan rengi seçilir ve panelin rengi değişir.

shift + click yaparsa panelin yazı rengini değiştirir.

ctrl + shift + click yaparsa font dialog açılır ve yazı tipi + boyutu, rengi vs. ayarlayabilir.

ayrıca bunu setup.ini isimli ini dosyasına kaydediyor ve program tekrar açıldığında eski bilgiler geri geliyor. üstelik bu sadece tek bir panel için değil ayrı ayrı bağımsız tüm paneller için geçerli, Kodlar aşağıda(bu arada Delphi 5'te yaptım);

bu arada componenti yaparken panelin ismini avrilpanel yapınız.

Delphi - .....................................

for yada while döngülerinde donmayı engellemek ve döngüyü hızlandırmak

//-----------DECLARED-----------

//------------MoRFiN------------

//---declared@celikforum.info---

for döngülerinde yada while döngülerinde işlemi hızladırmak ve programın donmasını engellemek için

kodlarımızın arasına application.processmessages; koyuyoruz.(Harf hatam olabilir. Kusura bakma kod paletinde yazıyor ne de olsa)

örnek:

for i:= 0 to 1000 do

begin

application.processmessages;

//islem kodlarınız

end;

yada: //misal veritabanında veri taraması yapıyoruz.

query1.First;

while not Query1.Eof do

begin

application.processmessages;

query1.next;

//islem kodlarınız

end;

//Saygılarımla

Delphi - .....................................

re: Yardım istiyorum!..

lan hödük foruma yazsana ağzımı bozdurmayın konuşursam kötü olur.

Delphi - .....................................

Yüklü olan SQL Server'ların isimleri (instancename leri)

//uses Registry

function GetInstanceNames(const Liste:TStrings;Reg:TRegistry=nil):Boolean;

const RegValueName='InstalledInstances';

var

Info: TRegDataInfo;

Bilgi:PByteArray;

S:PChar;

RegAssigned:Boolean;

begin

Result:=False; Bilgi:=nil;

RegAssigned:=Assigned(Reg);

if not RegAssigned then Reg:=TRegistry.Create;

with Reg do try

RootKey:=HKEY_LOCAL_MACHINE;

OpenKey('SOFTWAREMicrosoftMicrosoft SQL Server',False);

if GetDataInfo(RegValueName, Info) then try

Bilgi:=AllocMem(Info.DataSize);

ReadBinaryData(RegValueName,Bilgi^,Info.DataSize);

Liste.Clear;

S:=@(Bilgi^);

repeat

Liste.Add(S);

S:=Pointer(Integer(S)+Length(S)+1)

until (S='') or (S[1]=#0);

Result:=True;

finally

if Assigned(Bilgi) then FreeMem(Bilgi);

end;

finally

if not RegAssigned then Free;

end;

//Örnek: GetInstanceNames(ListBox1.Items)

{Not:ilk sırada gelen MSSQLSERVER değerinin instancename olarak değeri boştur ('')

ancak diğerlerinin isimleri normaldir ('SQLEXPRESS' gibi)}

Delphi - .....................................

Tablodaki kullanılmayan en küçük değer

//Bir tablodaki bir alanı kullanarak o tablo içinde kullanılmamış en küçük değeri bulur

function SiradakiNo(const NoAlani:TField;const Minimum:Integer=0):Integer;

//Minimum olarak belirtilen değerden büyük bir sayı üretilir (eşit üretmez, eğer kayıt yoksa 0 minimum değeri için 1 üretir)

var

i,n:Integer;

Dizi:array of Integer;

DataSet:TDataSet;

KayitYeri:String;

Buldu:Boolean;

begin

Result:=-MaxInt;

if Assigned(NoAlani) and Assigned(NoAlani.DataSet) and NoAlani.DataSet.Active then try

DataSet:=NoAlani.DataSet;

SetLength(Dizi,DataSet.RecordCount);

KayitYeri:=DataSet.Bookmark;

DataSet.DisableControls;

DataSet.First;i:=0; n:=-1;

while not DataSet.Eof do begin

if Minimum<NoAlani.AsInteger then begin //hafızaya alınan sayıların gereksiz olanları ayıklanır

Dizi[i]:=NoAlani.AsInteger;

Inc(i);//<--i:=i+1;

Inc(n);//<--n:=n+1;

end;

DataSet.Next;

end;

Result:=Minimum;

repeat

Buldu:=False;Inc(Result);

for i:=0 to n do begin //sayılar taranıyor

Buldu:=(Dizi[i]=Result);

if Buldu then Break;

end;

until not Buldu;

finally

SetLength(Dizi,0);

Dizi:=nil;

DataSet.Bookmark:=KayitYeri;

DataSet.EnableControls;

end;

//Örn: i:=SiradakiNo(Table1Sirano);

Delphi - .....................................

herhangi bir dizinin varlığını sorgulama

procedure TForm1.Button1Click(Sender: TObject);

begin

if not DirectoryExists('c:windows') then

ShowMessage('Dizin bulunamadı')

else

ShowMessage('Dizin bulundu');

end;

Delphi - .....................................

Global Olarak uygulamadaki hataları yakalamak

procedure TForm1.GlobalhataDeposu(Sender: TObject; E: Exception);

begin

RichEdit1.Lines.Add(E.ClassName+' : '+E.Message);

Application.ShowException(E);

// Application.Terminate;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

Application.OnException:=Globalhatadeposu;

end;

Delphi - .....................................

Runtime'da Yeni form oluşturmak

1-Remove Form2 from the auto-create list.

2-Remove the line ($R *.dfm) from the Form2.PAS file.

3-In Form1.PAS, in the event where you show Form2, use the following code:

At runtime, the form will now be loaded from disk and displayed.

The two key functions here are the CreateNew() method, and the

ReadComponentResFile() procedure. CreateNew() will create a dummy TForm

instance, but (and this is the crucial difference) does *not* require a

form file. The ReadComponentResFile() procedure actually loads the .DFM

file from disk & streams it into your newly created TForm instance.

There is a corresponding WriteComponentResFile() procedure as well, should you d it.}

procedure TForm1.ButtonClick( Sender: TObject );

begin

Form2 := TForm2.CreateNew(Application);

ReadComponentResFile( 'Form2.dfm** Form2 );

{$IFDEF Delphi4}

Form2.AfterConstruction;

{$ELSE}

if @Form2.OnCreate <> nil then Form2.OnCreate(Form2);

{$ENDIF}

Form2.Show;

end;

Delphi - .....................................

Zorla hint göstermek/silmek

function RevealHint (Control: TControl): THintWindow;

{----------------------------------------------------------------}

{ Pops up Hint window for the specified Control, and returns a }

{ reference to the hint object so it may subsequently be removed }

{ with RemoveHint (see below). }

{----------------------------------------------------------------}

var

ShortHint: string;

AShortHint: array[0..255] of Char;

HintPos: TPoint;

HintBox: TRect;

begin

{ Create the window: }

Result := THintWindow.Create(Control);

{ Get first half of hint up to '|': }

ShortHint := GetShortHint(Control.Hint);

{ Calculate Hint Window position & size: }

HintPos := Control.ClientOrigin;

Inc(HintPos.Y, Control.Height + 6); <<<< See note below

HintBox := Bounds(0, 0, Screen.Width, 0);

DrawText(Result.Canvas.Handle,

StrPCopy(AShortHint, ShortHint), -1, HintBox,

DT_CALCRECT or DT_LEFT or DT_WORDBREAK or DT_NOPREFIX);

OffsetRect(HintBox, HintPos.X, HintPos.Y);

Inc(HintBox.Right, 6);

Inc(HintBox.Bottom, 2);

{ Now show the window: }

Result.ActivateHint(HintBox, ShortHint);

end; {RevealHint}

procedure RemoveHint (var Hint: THintWindow);

{----------------------------------------------------------------}

{ Releases the window handle of a Hint previously popped up with }

{ RevealHint. }

{----------------------------------------------------------------}

begin

Hint.ReleaseHandle;

Hint.Free;

Hint := nil;

end; {RemoveHint}

//The line marked <<<< above is the one that positions the hint window below the control.

Delphi - .....................................

StringGrid 'e Autosize özelliği

//veri yüklenme olayı

i,j,temp,max: integer;

for i := 0 to grid.colcount-1 do begin

max := 0;

for j := 0 to grid.rowcount-1 do begin

temp := grid.canvas.textWidth (grid.cells[i,j]);

if temp > max then max := temp;

end;

grid.colWidths[i] := max + grid.gridLineWidth +1;

end;

Delphi - .....................................

sağa dayalı özelliği verme

TEdit1 = class(TEdit)

public

procedure CreateParams(var Params: TCreateParams); Override;

end;

procedure TEdit1.CreateParams(var Params: TCreateParams);

begin

inherited CreateParams(Params);

Params.Style := Params.Style or ES_MULTILINE or ES_RIGHT;

end;

Delphi - .....................................

DBGrid'e OnClick olayı eklemek

{That's all! The OnClick is already declared in TControl as a

protected property. All you have to do is publish it, register the

derived component}

TGroothuisGrid = class(TDBGrid) {!}

published

property OnClick;

end;

Delphi - .....................................

ListBox'da her font için eşit aralıklı metin girişi

var

J, TempInt, LongPrefixLen, CurrPrefixLen: Integer;

begin

{Calculate the TextWidth of the widest pre-keyword string}

{Set CurrPrefixLen to the TextWidth of the pre-keyword of the

Indexth string}

LongPrefixLen := 0;

for J := 0 to ListBox1.Items.Count-1 do

with ListBox1.Canvas do

begin

TempInt:= TextWidth(Copy(Items[J],1,Pos(KeyString,Items[J]-1)));

if LongPrefixLen < TempInt then

LongPrefixLen:= TempInt;

if J = Index then

CurrPrefixLen:= TempInt;

end;

{PrevTextLeft - TextLeft = Where we want to write new item}

TextOut(LongPrefixLen-CurrPrefi xLen,Y,Items[i]);

end;

Delphi - .....................................