neoturk: ...Get different background color of dbgrid for odd and even rows [1] ?...
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 / 2) - trunc(RowNo / 2);
// Zeile gerade...
// If it's an even one...
if test1 = 0 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 + 2, Rect.Top + 1, Column.Field.AsString);
end
end;
Delphi - .....................................
neoturk: ...Get different background color of dbgrid for odd and even rows [1] ?...
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 / 2) - trunc(RowNo / 2);
// Zeile gerade...
// If it's an even one...
if test1 = 0 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 + 2, Rect.Top + 1, Column.Field.AsString);
end
end;
Delphi - .....................................
neoturk: ...Create an access database ?...
// 1: Using ADOX:
uses
ComObj;
// You can with ADOX (Microsoft ADO Extensions for DDL and Security),
function CreateAccessDatabase(FileName: string): string;
var
cat: OLEVariant;
begin
Result := '';
try
cat := CreateOleObject('ADOX.Catalog');
cat.Create('Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' + FileName + ';');
cat := NULL;
except
on e: Exception do Result := e.message;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
CreateAccessDatabase('c:Testdb.mdb');
end;
// 2: Using ODBC:
const
ODBC_ADD_DSN = 1; // Add data source
ODBC_CONFIG_DSN = 2; // Configure (edit) data source
ODBC_REMOVE_DSN = 3; // Remove data source
ODBC_ADD_SYS_DSN = 4; // add a system DSN
ODBC_CONFIG_SYS_DSN = 5; // Configure a system DSN
ODBC_REMOVE_SYS_DSN = 6; // remove a system DSN
ODBC_REMOVE_DEFAULT_DSN = 7; // remove the default DSN
function SQLConfigDataSource(hwndParent: HWND;
fRequest: Word;
lpszDriver: LPCSTR;
lpszAttributes: LPCSTR): BOOL; stdcall; external 'ODBCCP32.DLL';
function CreateDB(const Database: string): Boolean;
begin
Result := SQLConfigDataSource(0, ODBC_ADD_DSN,
'Microsoft Access Driver (*.mdb)', PChar('CREATE_DB=' + Database + ' General'#0));
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
CreateAccessDatabase('c:Testdb.mdb');
end;
----
uses
ComObj;
procedure TForm1.Button1Click(Sender: TObject);
var
AccessApp: Variant;
begin
AccessApp := CreateOleObject('Access.Application');
AccessApp.NewCurrentDatabase('c:111.mdb');
AccessApp := Unassigned;
end;
Delphi - .....................................
neoturk: ...Create an access database ?...
// 1: Using ADOX:
uses
ComObj;
// You can with ADOX (Microsoft ADO Extensions for DDL and Security),
function CreateAccessDatabase(FileName: string): string;
var
cat: OLEVariant;
begin
Result := '';
try
cat := CreateOleObject('ADOX.Catalog');
cat.Create('Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' + FileName + ';');
cat := NULL;
except
on e: Exception do Result := e.message;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
CreateAccessDatabase('c:Testdb.mdb');
end;
// 2: Using ODBC:
const
ODBC_ADD_DSN = 1; // Add data source
ODBC_CONFIG_DSN = 2; // Configure (edit) data source
ODBC_REMOVE_DSN = 3; // Remove data source
ODBC_ADD_SYS_DSN = 4; // add a system DSN
ODBC_CONFIG_SYS_DSN = 5; // Configure a system DSN
ODBC_REMOVE_SYS_DSN = 6; // remove a system DSN
ODBC_REMOVE_DEFAULT_DSN = 7; // remove the default DSN
function SQLConfigDataSource(hwndParent: HWND;
fRequest: Word;
lpszDriver: LPCSTR;
lpszAttributes: LPCSTR): BOOL; stdcall; external 'ODBCCP32.DLL';
function CreateDB(const Database: string): Boolean;
begin
Result := SQLConfigDataSource(0, ODBC_ADD_DSN,
'Microsoft Access Driver (*.mdb)', PChar('CREATE_DB=' + Database + ' General'#0));
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
CreateAccessDatabase('c:Testdb.mdb');
end;
----
uses
ComObj;
procedure TForm1.Button1Click(Sender: TObject);
var
AccessApp: Variant;
begin
AccessApp := CreateOleObject('Access.Application');
AccessApp.NewCurrentDatabase('c:111.mdb');
AccessApp := Unassigned;
end;
Delphi - .....................................
neoturk: SON SÖZÜM
son sözüm,
burası,
- gereksiz sorularla dolduğunda,
- seviye düşürülüp manasız başlıklar yazıldığında,
- gereksiz polemiklere girildiğinde,
- verilen bilginin yarım bırakılması halinde,
- doyurucu ve açıklayıcı bilginin olmaması durumunda,
- saygının ve sevginin kalmaması durumunda,
örnek kodlar göndermeyeceğim.
isterim ki,
- elimde var olan tüm örnek kodların ( alıntı kodlar )
- kendi örnek kodlarım ( %100 bana ait )
- önemli makaleler ve bilgilendirici açıklamalar
- teknik kriterler ve konu irdelemeleri
konularını sizlerle paylaşayım,
siz de benimle paylaşın, herkes okusun, öğrensin.
Türk Programcılığını Geliştirelim.
Ruslar nasıl kodlamada ve crack konusunda uzmanlaşmış iseler,
biz de kendimizi geliştirelim...
Birbirimizi taşlamanın ne bana, ne size, ne diğer değerli
arkadaşlarıma faydası olmaz.....
Kalite olarak gördüğünüz kodları buraya yayınlayın lütfen.
Burası "ACEMİ EĞİTİM MERKEZİ" olmamalı.
Acemi arkadaşlarımız elbette vardır, ama, sorularınızı lütfen,
ısrar ediyorum, lütfen, FORUM sayfasına sorun.
"Gereksiz" ve "kısa başlıklı", "manasız" "şeyler" yazmayalım.
Bu kurallara uyulduğu takdirde,
ben de elimde var olan 10.000'den fazla örnek delphi kaynak
kod ve makale bilgilerini sizlerle paylaşırım.
son sözüm budur. lütfen geriye dönmeyelim.
saygılarımla_
neoturk [ xxnt03@lycos.co.uk ]
Delphi - .....................................
neoturk: SON SÖZÜM
son sözüm,
burası,
- gereksiz sorularla dolduğunda,
- seviye düşürülüp manasız başlıklar yazıldığında,
- gereksiz polemiklere girildiğinde,
- verilen bilginin yarım bırakılması halinde,
- doyurucu ve açıklayıcı bilginin olmaması durumunda,
- saygının ve sevginin kalmaması durumunda,
örnek kodlar göndermeyeceğim.
isterim ki,
- elimde var olan tüm örnek kodların ( alıntı kodlar )
- kendi örnek kodlarım ( %100 bana ait )
- önemli makaleler ve bilgilendirici açıklamalar
- teknik kriterler ve konu irdelemeleri
konularını sizlerle paylaşayım,
siz de benimle paylaşın, herkes okusun, öğrensin.
Türk Programcılığını Geliştirelim.
Ruslar nasıl kodlamada ve crack konusunda uzmanlaşmış iseler,
biz de kendimizi geliştirelim...
Birbirimizi taşlamanın ne bana, ne size, ne diğer değerli
arkadaşlarıma faydası olmaz.....
Kalite olarak gördüğünüz kodları buraya yayınlayın lütfen.
Burası "ACEMİ EĞİTİM MERKEZİ" olmamalı.
Acemi arkadaşlarımız elbette vardır, ama, sorularınızı lütfen,
ısrar ediyorum, lütfen, FORUM sayfasına sorun.
"Gereksiz" ve "kısa başlıklı", "manasız" "şeyler" yazmayalım.
Bu kurallara uyulduğu takdirde,
ben de elimde var olan 10.000'den fazla örnek delphi kaynak
kod ve makale bilgilerini sizlerle paylaşırım.
son sözüm budur. lütfen geriye dönmeyelim.
saygılarımla_
neoturk [ xxnt03@lycos.co.uk ]
Delphi - .....................................
neoturk: ...File manager drag-drop ?...
To use File Manager Drag & Drop, add a method to your form that
handles the WM_DROPFILES message. For example, the following
would be placed in the TForm1 declaration in the protected
section:
...
procedure WMDropFiles(var msg : TMessage); message WM_DROPFILES;
...
You would typically activate file drag & drop by calling
DragAcceptFiles() in the OnCreate event, and turn it off
with a subsequent call to DragAcceptFiles() in the OnClose
or OnDestroy events. The code follows:
procedure TForm1.WMDropFiles(var msg : TMessage);
var
i, n : word;
size : word;
fname : string;
hdrop : word;
begin
{1. Get the drop handle.}
hdrop := msg.WParam;
{2. Find out how many files were dropped by passing $ffff in arg #2.}
n := DragQueryFile(hdrop, $ffff, nil, 0);
{3. Loop through, reading in the filenames (w/full paths).}
for i := 0 to (n - 1) do begin
{4. Get the size of the filename string by passing 0 in arg #4.}
size := DragQueryFile(hdrop, i, nil, 0);
{5. Make sure it won't overflow our string (255 char. limit)}
if size < 255 then begin
fname[0] := Chr(size);
{6. Get the dropped filename.}
DragQueryFile(hdrop, i, @fname[1], size + 1);
{-- Do whatever you want to do with fname. --}
end;
end;
{7. Return zero.}
msg.Result := 0;
{8. Let the inherited message handler (if there is one) go at it.}
inherited;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
DragAcceptFiles(Handle, true);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
DragAcceptFiles(Handle, false);
end;
Keep in mind that you don't have to put all of this stuff
on a form. Any windowed control that has an HWnd handle
(descendants of TWinControl) should be able to accept
dropped files.
Delphi - .....................................
neoturk: ...File manager drag-drop ?...
To use File Manager Drag & Drop, add a method to your form that
handles the WM_DROPFILES message. For example, the following
would be placed in the TForm1 declaration in the protected
section:
...
procedure WMDropFiles(var msg : TMessage); message WM_DROPFILES;
...
You would typically activate file drag & drop by calling
DragAcceptFiles() in the OnCreate event, and turn it off
with a subsequent call to DragAcceptFiles() in the OnClose
or OnDestroy events. The code follows:
procedure TForm1.WMDropFiles(var msg : TMessage);
var
i, n : word;
size : word;
fname : string;
hdrop : word;
begin
{1. Get the drop handle.}
hdrop := msg.WParam;
{2. Find out how many files were dropped by passing $ffff in arg #2.}
n := DragQueryFile(hdrop, $ffff, nil, 0);
{3. Loop through, reading in the filenames (w/full paths).}
for i := 0 to (n - 1) do begin
{4. Get the size of the filename string by passing 0 in arg #4.}
size := DragQueryFile(hdrop, i, nil, 0);
{5. Make sure it won't overflow our string (255 char. limit)}
if size < 255 then begin
fname[0] := Chr(size);
{6. Get the dropped filename.}
DragQueryFile(hdrop, i, @fname[1], size + 1);
{-- Do whatever you want to do with fname. --}
end;
end;
{7. Return zero.}
msg.Result := 0;
{8. Let the inherited message handler (if there is one) go at it.}
inherited;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
DragAcceptFiles(Handle, true);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
DragAcceptFiles(Handle, false);
end;
Keep in mind that you don't have to put all of this stuff
on a form. Any windowed control that has an HWnd handle
(descendants of TWinControl) should be able to accept
dropped files.
Delphi - .....................................
neoturk: ...Getting the line number in a memo field ?...
How do you figure out what line number you are currently
on with a TMemo control?
The trick is to use the em_LineFromChar message. Try this:
procedure TMyForm.BitBtn1Click(Sender: TObject);
var
iLine : Integer ;
begin
iLine := Memo1.Perform(em_LineFromChar, $FFFF, 0);
{ Note: First line is zero }
messageDlg('Line Number: ' + IntToStr(iLine), mtInformation,
[mbOK], 0 ) ;
end;
Delphi - .....................................
neoturk: ...Getting the line number in a memo field ?...
How do you figure out what line number you are currently
on with a TMemo control?
The trick is to use the em_LineFromChar message. Try this:
procedure TMyForm.BitBtn1Click(Sender: TObject);
var
iLine : Integer ;
begin
iLine := Memo1.Perform(em_LineFromChar, $FFFF, 0);
{ Note: First line is zero }
messageDlg('Line Number: ' + IntToStr(iLine), mtInformation,
[mbOK], 0 ) ;
end;
Delphi - .....................................
neoturk: ...Graphics in your listboxes ?...
The ability to place graphics inside ListBoxes and ComboBoxes
can improve the look of your application and set your user
interface apart from the others.
Q: How do I stick graphics in a Listbox or ComboBox???
Here is an step-by-step example.....
1. Create a form.
2. Place a ComboBox and Listbox component on your form.
3. Change the Style property of the ComboBox component to
csOwnerDrawVariable and the Style property of the ListBox to
lbOwnerDrawVariable.
An Owner-Draw TListBox or TComboBox allows you to display
both objects (ex. graphics) and strings as the items. For
this example, we are adding both a graphic object and a
string.
4. Create 5 variables of type TBitmap in the Form's VAR
section.
5. Create a Procedure for the Form's OnCreate event.
6. Create a Procedure for the ComboBox's OnDraw Event.
7. Create a Procedure for the ComboBox's OnMeasureItem.
8. Free the resources in the Form's OnClose Event.
{START OWNERDRW.PAS}
unit Ownerdrw;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls;
type
TForm1 = class(TForm)
ComboBox1: TComboBox;
ListBox1: TListBox;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ComboBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
procedure ComboBox1MeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer);
procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
procedure ListBox1MeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
TheBitmap1, TheBitmap2, TheBitmap3, TheBitmap4,
TheBitmap5 : TBitmap;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
TheBitmap1 := TBitmap.Create;
TheBitmap1.LoadFromFile('C:delphiimagesbuttonsglobe.bmp');
TheBitmap2 := TBitmap.Create;
TheBitmap2.LoadFromFile('C:delphiimagesbuttonsvideo.bmp');
TheBitmap3 := TBitmap.Create;
TheBitmap3.LoadFromFile('C:delphiimagesbuttonsgears.bmp');
TheBitmap4 := TBitmap.Create;
TheBitmap4.LoadFromFile('C:delphiimagesbuttonskey.bmp');
TheBitmap5 := TBitmap.Create;
TheBitmap5.LoadFromFile('C:delphiimagesbuttonstools.bmp');
ComboBox1.Items.AddObject('Bitmap1: Globe', TheBitmap1);
ComboBox1.Items.AddObject('Bitmap2: Video', TheBitmap2);
ComboBox1.Items.AddObject('Bitmap3: Gears', TheBitmap3);
ComboBox1.Items.AddObject('Bitmap4: Key', TheBitmap4);
ComboBox1.Items.AddObject('Bitmap5: Tools', TheBitmap5);
ListBox1.Items.AddObject('Bitmap1: Globe', TheBitmap1);
ListBox1.Items.AddObject('Bitmap2: Video', TheBitmap2);
ListBox1.Items.AddObject('Bitmap3: Gears', TheBitmap3);
ListBox1.Items.AddObject('Bitmap4: Key', TheBitmap4);
ListBox1.Items.AddObject('Bitmap5: Tools', TheBitmap5);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
TheBitmap1.Free;
TheBitmap2.Free;
TheBitmap3.Free;
TheBitmap4.Free;
TheBitmap5.Free;
end;
procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
Bitmap: TBitmap;
Offset: Integer;
begin
with (Control as TComboBox).Canvas do
begin
FillRect(Rect);
Bitmap := TBitmap(ComboBox1.Items.Objects[Index]);
if Bitmap <> nil then
begin
BrushCopy(Bounds(Rect.Left + 2, Rect.Top + 2, Bitmap.Width,
Bitmap.Height), Bitmap, Bounds(0, 0, Bitmap.Width,
Bitmap.Height), clRed);
Offset := Bitmap.width + 8;
end;
{ display the text }
TextOut(Rect.Left + Offset, Rect.Top, Combobox1.Items[Index])
end;
end;
procedure TForm1.ComboBox1MeasureItem(Control: TWinControl; Index:
Integer; var Height: Integer);
begin
height:= 20;
end;
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
Bitmap: TBitmap;
Offset: Integer;
begin
with (Control as TListBox).Canvas do
begin
FillRect(Rect);
Bitmap := TBitmap(ListBox1.Items.Objects[Index]);
if Bitmap <> nil then
begin
BrushCopy(Bounds(Rect.Left + 2, Rect.Top + 2, Bitmap.Width,
Bitmap.Height), Bitmap, Bounds(0, 0, Bitmap.Width,
Bitmap.Height), clRed);
Offset := Bitmap.width + 8;
end;
{ display the text }
TextOut(Rect.Left + Offset, Rect.Top, Listbox1.Items[Index])
end;
end;
procedure TForm1.ListBox1MeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer);
begin
height:= 20;
end;
end.
{END OWNERDRW.PAS}
{START OWNERDRW.DFM}
object Form1: TForm1
Left = 211
Top = 155
Width = 435
Height = 300
Caption = 'Form1'
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'System'
Font.Style = []
PixelsPerInch = 96
OnClose = FormClose
OnCreate = FormCreate
TextHeight = 16
object ComboBox1: TComboBox
Left = 26
Top = 30
Width = 165
Height = 22
Style = csOwnerDrawVariable
ItemHeight = 16
TabOrder = 0
OnDrawItem = ComboBox1DrawItem
OnMeasureItem = ComboBox1MeasureItem
end
object ListBox1: TListBox
Left = 216
Top = 28
Width = 151
Height = 167
ItemHeight = 16
Style = lbOwnerDrawVariable
TabOrder = 1
OnDrawItem = ListBox1DrawItem
OnMeasureItem = ListBox1MeasureItem
end
end
{END OWNERDRW.DFM}
