Mega Code Archive
Dbmemo içerisinde metin aranması
<![CDATA[
kaynak:www.programlama-tr.com
DBMemo içerisinde bir metnin aranmasi
procedure Tform1.FindDialog1Find(Sender: TObject);
var Buff, P, FT : PChar;
BuffLen : Word;
begin
With Sender as TFindDialog do
begin
GetMem(FT, Length(FindText) + 1);
StrPCopy(FT, FindText);
BuffLen:= DBMemo1.GetTextLen + 1;
GetMem(Buff,BuffLen);
DBMemo1.GetTextBuf(Buff,BuffLen);
P:= Buff + DBMemo1.SelStart + DBMemo1.SelLength;
P:= StrPos(P, FT);
if P = NIL then MessageBeep(0)
else
begin
DBMemo1.SelStart:= P - Buff;
DBMemo1.SelLength:= Length(FindText);
end;
FreeMem(FT, Length(FindText) + 1);
FreeMem(Buff,BuffLen);
DBMemo1.SetFocus;
end;
end;
Sekil 1 : Form1
kod örnegi 1 : form1.dfm
object Form1: TForm1
Left = 200
Top = 108
Width = 696
Height = 445
Caption = 'Form1'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
PixelsPerInch = 96
TextHeight = 13
object DBMemo1: TDBMemo
Left = 16
Top = 152
Width = 657
Height = 193
DataField = 'Notes'
DataSource = DataSource1
TabOrder = 0
OnDblClick = DBMemo1DblClick
end
object DBGrid1: TDBGrid
Left = 16
Top = 16
Width = 657
Height = 120
DataSource = DataSource1
TabOrder = 1
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'MS Sans Serif'
TitleFont.Style = []
end
object DBNavigator1: TDBNavigator
Left = 432
Top = 352
Width = 240
Height = 25
TabOrder = 2
end
object DataSource1: TDataSource
DataSet = Table1
Left = 138
Top = 364
end
object Table1: TTable
Active = True
DatabaseName = 'dbdemos'
TableName = 'BIOLIFE.DB'
Left = 220
Top = 366
end
object FindDialog1: TFindDialog
OnFind = FindDialog1Find
Left = 40
Top = 360
end
end
kod örnegi 2 : unit1.pas
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,StdCtrls, Grids, DBGrids, Db, DBTables, DBCtrls, ExtCtrls;
type
TForm1 = class(TForm)
DBMemo1: TDBMemo;
DataSource1: TDataSource;
Table1: TTable;
DBGrid1: TDBGrid;
FindDialog1: TFindDialog;
DBNavigator1: TDBNavigator;
procedure FindDialog1Find(Sender: TObject);
procedure DBMemo1DblClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure Tform1.FindDialog1Find(Sender: TObject);
var Buff, P, FT : PChar;
BuffLen : Word;
begin
With Sender as TFindDialog do
begin
GetMem(FT, Length(FindText) + 1);
StrPCopy(FT, FindText);
BuffLen:= DBMemo1.GetTextLen + 1;
GetMem(Buff,BuffLen);
DBMemo1.GetTextBuf(Buff,BuffLen);
P:= Buff + DBMemo1.SelStart + DBMemo1.SelLength;
P:= StrPos(P, FT);
if P = NIL then MessageBeep(0)
else
begin
DBMemo1.SelStart:= P - Buff;
DBMemo1.SelLength:= Length(FindText);
end;
FreeMem(FT, Length(FindText) + 1);
FreeMem(Buff,BuffLen);
DBMemo1.SetFocus;
end;
end;
procedure TForm1.DBMemo1DblClick(Sender: TObject);
begin
finddialog1.execute;
end;
end.
]]>