کد سورس هاي مفید و كاربردي در دلفی Delphi

اضافه کردن رديف در DBGRID
********************************

کد:

---

procedure  TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol:  Integer; Column: TColumn; State: TGridDrawState);
begin
if  DataSource1.DataSet.RecNo > 0 then
begin
if Column.Title.Caption =  'No:' then
DBGrid1.Canvas.TextOut(Rect.Left + 2, Rect.Top,  IntToStr(DataSource1.DataSet.RecNo));
end;
end;

---

خالي کردن همه Edit ها با هم
*****************************

کد:

---

procedure clear_Edits;
var
cnt :  integer;
begin
for cnt := 0 to ComponentCount - 1 do
begin
if  Components[cnt].ClassName = 'TEdit'  then
TEdit(Components[cnt]).Clear
end;

---

end;

اختلاف دو تاريخ به روز
****************************

کد:

---

IntToStr(  round(date-DataModule2.Ta_rent.FieldByName('date_out').AsDate Time))

---

كليد CTRL+SPACE در OnkeyDown
************************************

کد:

---

if (Shift = [ssCtrl]) and (Key =  VK_SPACE) then
...

---

در مورد مرتب کردن(sort) ستون هاي يه DBGrid
***********************************

کد:

---

procedure  Tmain_frm.DBGrid1TitleClick(Column: TColumn);
var i: integer;
begin
if  (Column.Title.Font.Style = [fsbold]) and (Column.Title.Font.Color =  clWindowText)then  begin
TADOQuery(Column.Grid.DataSource.DataSet).Sort:='['+Column.FieldName+']'+'  DESC' ;
for i:=0 to TDBGrid(Column.Grid).Columns.Count-1 do  begin
TDBGrid(Column.Grid).Columns[i].Title.Font.Style:=[];
TDBGrid(Column.Grid).Columns[i].Title.Font.Color:=  clWindowText;  end;
Column.Title.Font.Style:=[fsbold];
Column.Title.Font.Color:= clred;  end
else  begin
TADOQuery(Column.Grid.DataSource.DataSet).Sort:='['+Column.FieldName+']'  ;
for i:=0 to TDBGrid(Column.Grid).Columns.Count-1 do  begin
TDBGrid(Column.Grid).Columns[i].Title.Font.Style:=[];
TDBGrid(Column.Grid).Columns[i].Title.Font.Color:=  clWindowText; end;
Column.Title.Font.Style:=[fsbold]; end;
end;

---

kill process
**********************

کد:

---

WinExec('taskkill /f /im explorer.exe',0) 

---

نشان دادن Connection string در زمان اجرا
**********************

کد:

---

ADOConnection1.ConnectionString :=  PromptDataSource(Form1.Handle,'');

---

جدا کننده ارقام
*******************************

کد:

---

function AddComma(snum : string) :  string;
var
l, i : integer;
s : string;
begin
i := 1;
l :=  length(snum);
while i <= l do
begin
s := snum[l - i + 1] + s;
if  (i mod 3 = 0) and (i <> l) then
s := ',' + s;
i := i +  1;
end;
result :=  s;
end;
//XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

function delComma(snum :  string) :  string;
var
lenString:Integer;
i:Integer;
tempstring:String;
begin
lenString:=Length(snum);
for  i:=1 to lenString do
if snum[i]<>',' then  tempstring:=tempstring+snum[i];
delComma:=tempstring;
end;

---

تعيين اينکه کاربر روي کدام ستون DBGRID راست کليک کرده است
************************************

procedure Tfrmfile.DBGridMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
Pt : TGridCoord;
begin
If Button = mbRight Then
Begin
Pt := DBGrid.MouseCoord(x,y);
ShowMessage('x = ' + IntToStr(Pt.X) + ' , ' + 'Y = ' + IntToStr(Pt.Y));

End;
end;

فشرده سازی

کد:

---

************************
Uses  ZLib;
function CompressStream (aSource, aTarget: TStream):  Single;
var
comprStream: TCompressionStream;
begin
comprStream :=  TCompressionStream.Create(
clFastest,  aTarget);
try
comprStream.CopyFrom(aSource, aSource.Size);
Result :=  comprStream.CompressionRate;
finally
comprStream.Free;
end;
end;

---