Iran Developers Network » کدها و ترفندهای زبان دلفی

رنگی کردن ردیفهای متفاوت زوج و فرد در DBGRID

admin — Wed, 28 Oct 2009 10:54:13 +0000

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject;
const Rect: TRect; DataCol: Integer; Column: TColumn;
State: TGridDrawState);
var
test1: Real;
RowNo: Integer;
begin
with (Sender as TDBGrid) do
begin
if (gdSelected in State) then
begin
// Farbe für die Zelle mit dem Focus
// color of the focused row
Canvas.Brush.Color := clblue;
end
else
begin
// Zeile erfahren
// get the actual row number
rowno := Query1.RecNo;
// gerade und ungerade Zeilen ermitteln
// odd or even ?
test1 := (RowNo / ۲) - trunc(RowNo / ۲);
// Zeile gerade…
// If it’s an even one…
if test1 = ۰ then
begin
farbe := clWhite
end
// …Zeile ungerade
// …else it’s an odd one
else
begin
farbe := clYellow;
end;
Canvas.Brush.Color := farbe;
// Font-Farbe immer schwarz
// font color always black
Canvas.Font.Color := clBlack;
end;
Canvas.FillRect(Rect);
// Denn Text in der Zelle ausgeben
// manualy output the text
Canvas.TextOut(Rect.Left + ۲, Rect.Top + ۱, Column.Field.AsString);
end
end;

ساخت یک بانک اکسس در دلفی

admin — Wed, 28 Oct 2009 10:51:10 +0000

uses
ComObj;

procedure TForm1.Button1Click(Sender: TObject);
var
AccessApp: Variant;
begin
AccessApp := CreateOleObject(‘Access.Application’);
AccessApp.NewCurrentDatabase(‘c:\111.mdb’);
AccessApp := Unassigned;
end;

ساخت یک جدول در SQL Server با یک فیلد با شمارشگر خودکار

admin — Wed, 28 Oct 2009 10:49:43 +0000

uses AdoDB;

var
q: TAdoQuery;
db: TAdoConnection;
begin

// Initialize db here

q := TADOQuery.Create(nil);
q.Connection := db;
q.Close;
q.SQL.Clear;
q.SQL.Add(‘Create Table MYTABLENAME (ID COUNTER PRIMARY KEY, MYTEXT1 String, MYTEXT2 String);’);
q.Prepared := True;
try
q.ExecSQL;
except
end;
q.Free;

end;

رنگی کردن برخی از سلولهای Dbgrid بر اساس شرط خاص

admin — Wed, 28 Oct 2009 10:45:29 +0000

procedure TFRM_Main.DBG_MainGetCellParams(Sender: TObject; Field: TField;
AFont: TFont; var Background: TColor; Highlight: Boolean);
begin

if (Field.AsString = ’0′) and (Field.FullName = ‘LoadingAttn’) then
begin
Background := $00E69B00;
AFont.Color := clBlack;
AFont.Style := AFont.Style + [fsBold];
end
else
begin
if (Field.AsString = ’0′) and (Field.FullName = ‘DeliveryAttn’) then
begin
Background := $0082FFFF;
AFont.Color := clBlack;
AFont.Style := AFont.Style + [fsBold];
end
else
begin
if (Field.AsString = ‘H’) and (Field.FullName = ‘EctaCode1′) then
begin
Background := $008080FF;
AFont.Color := clBlack;
AFont.Style := AFont.Style + [fsBold];
end
else
begin
AFont.Color := clBlack;
AFont.Style := AFont.Style – [fsBold];
Background := clWhite;
end;
end;
end;

end;