Bu unit program database dialog işleminde kullanılır.
Kod: Tümünü seç
unit ads_DlgDBLocate;
{Copyright(c)2000 Advanced Delphi Systems
Richard Maley
Advanced Delphi Systems
12613 Maidens Bower Drive
Potomac, MD 20854 USA
phone 301-840-1554
maley@advdelphisys.com
The code herein can be used or modified by anyone. Please retain references
to Richard Maley at Advanced Delphi Systems. If you make improvements to the
code please send your improvements to maley@advdelphisys.com so that the
entire Delphi community can benefit. All comments are welcome.
}
(*
Description: ads_DlgDBLocate.pas.pas
This unit contains
*)
interface
Uses DB;
{!~DlgDBLocate_ads
}
Function DlgDBLocate_ads(DataSource: TDataSource): Boolean;
Function FindRecordFirst_ads(
// DDataSource is the TDataSource to be searched.
DataSource : TDataSource;
// SearchValue is the item to be found
SearchValue : String;
// SearchField is the DataSet Field name.
SearchField : String;
// ApplyCase Options:
// True : Search is case sensitive
// False: Search is case insensitive
ApplyCase : Boolean;
// ShowMessages Options:
// True : Messages dialogs are displayed
// False: Messages dialogs are not displayed
ShowMessages : Boolean;
// MatchValue Options:
// 0: Match at Start
// 1: Match in Middle
// 2: Match at End
// 3: Match AnyWhere
// 4: Exact Match
MatchValue : Integer
): Boolean; //True if found, False otherwise.
Function FindRecordPrior_ads(
// DDataSource is the TDataSource to be searched.
DataSource : TDataSource;
// SearchValue is the item to be found
SearchValue : String;
// SearchField is the DataSet Field name.
SearchField : String;
// ApplyCase Options:
// True : Search is case sensitive
// False: Search is case insensitive
ApplyCase : Boolean;
// ShowMessages Options:
// True : Messages dialogs are displayed
// False: Messages dialogs are not displayed
ShowMessages : Boolean;
// MatchValue Options:
// 0: Match at Start
// 1: Match in Middle
// 2: Match at End
// 3: Match AnyWhere
// 4: Exact Match
MatchValue : Integer
): Boolean; //True if found, False otherwise.
Function FindRecordNext_ads(
// DDataSource is the TDataSource to be searched.
DataSource : TDataSource;
// SearchValue is the item to be found
SearchValue : String;
// SearchField is the DataSet Field name.
SearchField : String;
// ApplyCase Options:
// True : Search is case sensitive
// False: Search is case insensitive
ApplyCase : Boolean;
// ShowMessages Options:
// True : Messages dialogs are displayed
// False: Messages dialogs are not displayed
ShowMessages : Boolean;
// MatchValue Options:
// 0: Match at Start
// 1: Match in Middle
// 2: Match at End
// 3: Match AnyWhere
// 4: Exact Match
MatchValue : Integer
): Boolean; //True if found, False otherwise.
Function FindRecordLast_ads(
// DDataSource is the TDataSource to be searched.
DataSource : TDataSource;
// SearchValue is the item to be found
SearchValue : String;
// SearchField is the DataSet Field name.
SearchField : String;
// ApplyCase Options:
// True : Search is case sensitive
// False: Search is case insensitive
ApplyCase : Boolean;
// ShowMessages Options:
// True : Messages dialogs are displayed
// False: Messages dialogs are not displayed
ShowMessages : Boolean;
// MatchValue Options:
// 0: Match at Start
// 1: Match in Middle
// 2: Match at End
// 3: Match AnyWhere
// 4: Exact Match
MatchValue : Integer
): Boolean; //True if found, False otherwise.
Function FindRecord_ads(
// DDataSource is the TDataSource to be searched.
DataSource : TDataSource;
// SearchValue is the item to be found
SearchValue : String;
// SearchField is the DataSet Field name.
SearchField : String;
// FromCursor Options:
// True : Search from current record
// False: Search from table end based
// on SearchAhead value. If
// SearchAhead is True then
// Search is from First record
// forward, otherwise, it is
// from the last record toward
// the top.
FromCursor : Boolean;
// SearchAhead Options:
// True : Search toward table bottom
// False: Search toward table top
SearchAhead : Boolean;
// ApplyCase Options:
// True : Search is case sensitive
// False: Search is case insensitive
ApplyCase : Boolean;
// ShowMessages Options:
// True : Messages dialogs are displayed
// False: Messages dialogs are not displayed
ShowMessages : Boolean;
// MatchValue Options:
// 0: Match at Start
// 1: Match in Middle
// 2: Match at End
// 3: Match AnyWhere
// 4: Exact Match
MatchValue : Integer
): Boolean; //True if found, False otherwise.
implementation
Uses
ads_GraphicStrings,
ads_Exception,
SysUtils,
StdCtrls,
Buttons,
ExtCtrls,
Graphics,
Classes,
Controls,
Forms,
DBCtrls,
Dialogs
;
Var
UnitName : String;
ProcName : String;
type
TDBLocMatch_ads =
(Start_mt_ads,
Middle_mt_ads,
End_mt_ads,
AnyWhere_mt_ads,
Exact_mt_ads);
type
TDBLoc_ads = Class(TScrollingWinControl)
Public
Constructor Create(AOwner: TComponent); Override;
Destructor Destroy; Override;
Public
PanelLocateBase : TPanel;
GroupBoxSearchFor : TGroupBox;
EditSearchFor : TEdit;
GroupBoxSearchField : TGroupBox;
ComboBoxSearchField : TComboBox;
RadioGroupMatch : TRadioGroup;
RadioGroupCase : TRadioGroup;
Panelbuttons : TPanel;
PanelButtonSlider : TPanel;
ButtonFirst : TBitBtn;
ButtonPrior : TBitBtn;
ButtonNext : TBitBtn;
ButtonLast : TBitBtn;
ButtonCancel : TBitBtn;
procedure FormCreate(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure ButtonFirstClick(Sender: TObject);
procedure ButtonPriorClick(Sender: TObject);
procedure ButtonNextClick(Sender: TObject);
procedure ButtonLastClick(Sender: TObject);
procedure ButtonCancelClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure EditSearchForEnter(Sender: TObject);
private
{ Private declarations }
FDataLink : TFieldDataLink;
fDataSet : TDataSet;
fSearchFromCursor : Boolean;
fSearchForward : Boolean;
fMatchFound : Boolean;
fCaseSensitive : Boolean;
FShowMessages : Boolean;
fMatchType : TDBLocMatch_ads;
fSearchString : String;
FTitle : String; {stores the Dialog Title}
FBeveled : Boolean; {Selected panels have beveling if true}
FButtonsReSize : Boolean; {Buttons resize if true}
FButtonsAlignment : TAlignment; {taLeftJustify, taCenter, taRightJustify}
FButtonWidth : Integer; {Sets Button Widths}
FButtonSpacer : Integer; {Sets Button Spacer Width}
FApplyChanges : Boolean; {True if changes should be made. = mrOk}
FModal : Boolean; {True if Form is being shown modal}
FIsComponent : Boolean; {True if Form is part of a component,
False if Form is a standalone form,
Default is False}
FReSizeNow : Boolean; {Causes the form to resize when the
property is set}
FMinFormWidth : Integer; {Sets a Minimum FormWidth}
FMinFormHeight : Integer; {Sets a Minimum FormHeight}
FDialogComponentName : String;
procedure SetReSizeNow(Value : Boolean);
procedure SetMinFormWidth(Value : Integer);
procedure SetMinFormHeight(Value : Integer);
procedure SetBeveled(Value : Boolean);
function GetDataSet : TDataSet;
procedure SetDataSet(Value : TDataSet);
procedure SetMatchFound(Value : Boolean);
function GetDataSource: TDataSource;
procedure SetDataSource(Value: TDataSource);
function GetDataField: string;
procedure SetDataField(const Value: string);
Function GetCenterFormLeft(FormWidth : Integer): Integer;
Function GetCenterFormTop(FormHeight : Integer): Integer;
Procedure PanelBevel(Beveled : Boolean; Panel: TPanel);
procedure ButtonReSizer(
ButtonBase : TPanel;
ButtonSlider : TPanel;
ButtonWidth : Integer;
ButtonSpacer : Integer;
ButtonsReSize : Boolean;
ButtonsAlignment: TAlignment;
Beveled : Boolean);
public
{ Public declarations }
procedure ReSizeAll;
procedure SetBevel;
function FindRecord(
SearchValue,
SearchField: String;
FromCursor,
SearchAhead,
ApplyCase: Boolean;
MatchValue:TDBLocMatch_ads): Boolean; virtual;
property MatchFound : Boolean read fMatchFound write SetMatchFound;
property DataSet : TDataSet read GetDataSet write SetDataSet;
Function IsMatchFound: Boolean;
{Returns A SubString Of An Input String}
property Title : String {stores the Dialog Title}
read FTitle
write FTitle;
property Beveled : Boolean {Selected panels have beveling if true}
Read FBeveled
Write SetBeveled;
property ButtonsReSize : Boolean {Buttons resize if true}
Read FButtonsReSize
Write FButtonsReSize;
property ButtonsAlignment : TAlignment {taLeftJustify, taCenter, taRightJustify}
Read FButtonsAlignment
Write FButtonsAlignment;
property ButtonWidth : Integer {Sets Button Widths}
Read FButtonWidth
Write FButtonWidth;
property ButtonSpacer : Integer {Sets Button Spacer Width}
Read FButtonSpacer
Write FButtonSpacer;
property ApplyChanges: Boolean {True if changes should be made. = mrOk}
Read FApplyChanges
Write FApplyChanges;
property Modal : Boolean {True if Form is being shown modal}
Read FModal
Write FModal;
property IsComponent : Boolean
Read FIsComponent
Write FIsComponent;
property ReSizeNow : Boolean
Read FReSizeNow
Write SetReSizeNow;
published
{ Published declarations }
property ShowMessages : Boolean Read fShowMessages Write FShowMessages;
property CaseSensitive : Boolean Read fCaseSensitive Write FCaseSensitive;
property MatchType : TDBLocMatch_ads Read fMatchType Write fMatchType;
property DataSource : TDataSource read GetDataSource write SetDataSource;
property SearchString : String Read fSearchString Write fSearchString;
property DataField : string read GetDataField write SetDataField;
property SearchForward : Boolean read fSearchForward write fSearchForward;
property SearchFromCursor : Boolean read fSearchFromCursor write fSearchFromCursor;
property MinFormWidth : Integer {Sets the form's Minimum Width}
Read FMinFormWidth
Write SetMinFormWidth;
property MinFormHeight : Integer {Sets the form's Minimum Height}
Read FMinFormHeight
Write SetMinFormHeight;
property DialogComponentName : String {Used in messages to display the }
Read FDialogComponentName {dialog component name}
Write FDialogComponentName;
end;
procedure TDBLoc_ads.ReSizeAll;
Var
HeightEach : Integer;
begin
If Width < MinFormWidth Then Width := MinFormWidth;
If Height < MinFormHeight Then Height := MinFormHeight;
ButtonReSizer(
PanelButtons, {ButtonBase}
PanelButtonSlider, {ButtonSlider}
ButtonWidth, {ButtonWidth}
ButtonSpacer, {ButtonSpacer}
ButtonsReSize, {ButtonsReSize}
ButtonsAlignment, {ButtonsAlignment}
Beveled); {Beveled}
If Beveled Then
Begin
HeightEach :=
(PanelLocateBase.Height -
(2 * PanelLocateBase.BorderWidth) -
6) div 4;
End
else
Begin
HeightEach :=
(PanelLocateBase.Height -
(2 * PanelLocateBase.BorderWidth) -
0) div 4;
End;
GroupBoxSearchFor.Height := HeightEach-1;
GroupBoxSearchField.Height := HeightEach-1;
RadioGroupMatch.Height := HeightEach;
RadioGroupCase.Height := HeightEach;
end;
procedure TDBLoc_ads.FormResize(Sender: TObject);
begin
ReSizeAll;
end;
function TDBLoc_ads.GetDataSet : TDataSet;
begin
result := fDataSet;
end;
procedure TDBLoc_ads.SetDataSet(Value : TDataSet);
begin
fDataSet := Value;
end;
procedure TDBLoc_ads.SetMatchFound(Value : Boolean);
begin
fMatchFound := Value;
end;
function TDBLoc_ads.FindRecord(
SearchValue,
SearchField: String;
FromCursor,
SearchAhead,
ApplyCase: Boolean;
MatchValue:TDBLocMatch_ads): Boolean;
var
BookMark : TBookMark;
CursorWas : TCursor;
begin
CursorWas := Screen.Cursor;
MatchFound := False;
If
(
Assigned(fDataSet) and
fDataSet.Active
)
Then
Begin
SearchString := SearchValue;
DataField := SearchField;
MatchType := MatchValue;
CaseSensitive := ApplyCase;
BookMark := fDataSet.GetBookMark;
fDataSet.DisableControls;
If Not FromCursor Then
Begin
If SearchAhead Then
Begin
fDataSet.First;
While Not (fDataSet.EOF) Do
Begin
If IsMatchFound Then Break;
fDataSet.Next;
End;
End
Else
Begin
fDataSet.Last;
While Not (fDataSet.BOF) Do
Begin
If IsMatchFound Then Break;
fDataSet.Prior;
End;
End;
End
Else
Begin
If SearchAhead Then
Begin
fDataSet.Next;
While Not (fDataSet.EOF) Do
Begin
If IsMatchFound Then Break;
fDataSet.Next;
End;
End
Else
Begin
fDataSet.Prior;
While Not (fDataSet.BOF) Do
Begin
If IsMatchFound Then Break;
fDataSet.Prior;
End;
End;
End;
IF (NOT MatchFound) THEN
fDataSet.GotoBookMark(BookMark);
fDataSet.EnableControls;
fDataSet.FreeBookMark(BookMark);
end;
If (Not MatchFound) And ShowMessages Then
Begin
Try
CursorWas := Screen.Cursor;
Screen.Cursor := crArrow;
MessageDlg('No match was found.', mtInformation,[mbOK], 0);
Finally
Screen.Cursor := CursorWas;
End;
End;
Result := MatchFound;
end;
procedure TDBLoc_ads.ButtonFirstClick(Sender: TObject);
begin
SearchString := EditSearchFor.Text;
DataField := ComboBoxSearchField.Text;
SearchFromCursor := False;
SearchForward := True;
MatchType := TDBLocMatch_ads(RadioGroupMatch.ItemIndex);
If RadioGroupCase.ItemIndex = 0 Then
Begin
CaseSensitive := False;
End
Else
Begin
CaseSensitive := True;
End;
FindRecord(
SearchString,
DataField,
SearchFromCursor,
SearchForward,
CaseSensitive,
MatchType);
ApplyChanges := True;
end;
procedure TDBLoc_ads.ButtonPriorClick(Sender: TObject);
begin
SearchString := EditSearchFor.Text;
DataField := ComboBoxSearchField.Text;
SearchFromCursor := True;
SearchForward := False;
MatchType := TDBLocMatch_ads(RadioGroupMatch.ItemIndex);
If RadioGroupCase.ItemIndex = 0 Then
Begin
CaseSensitive := False;
End
Else
Begin
CaseSensitive := True;
End;
FindRecord(
SearchString,
DataField,
SearchFromCursor,
SearchForward,
CaseSensitive,
MatchType);
ApplyChanges := True;
end;
procedure TDBLoc_ads.ButtonNextClick(Sender: TObject);
begin
SearchString := EditSearchFor.Text;
DataField := ComboBoxSearchField.Text;
SearchFromCursor := True;
SearchForward := True;
MatchType := TDBLocMatch_ads(RadioGroupMatch.ItemIndex);
If RadioGroupCase.ItemIndex = 0 Then
Begin
CaseSensitive := False;
End
Else
Begin
CaseSensitive := True;
End;
FindRecord(
SearchString,
DataField,
SearchFromCursor,
SearchForward,
CaseSensitive,
MatchType);
ApplyChanges := True;
end;
procedure TDBLoc_ads.ButtonLastClick(Sender: TObject);
begin
SearchString := EditSearchFor.Text;
DataField := ComboBoxSearchField.Text;
SearchFromCursor := False;
SearchForward := False;
MatchType := TDBLocMatch_ads(RadioGroupMatch.ItemIndex);
If RadioGroupCase.ItemIndex = 0 Then
Begin
CaseSensitive := False;
End
Else
Begin
CaseSensitive := True;
End;
FindRecord(
SearchString,
DataField,
SearchFromCursor,
SearchForward,
CaseSensitive,
MatchType);
ApplyChanges := True;
end;
procedure TDBLoc_ads.ButtonCancelClick(Sender: TObject);
begin
ApplyChanges := False;
end;
function TDBLoc_ads.GetDataSource: TDataSource;
begin
Result := FDataLink.DataSource;
end;
procedure TDBLoc_ads.SetDataSource(Value: TDataSource);
begin
FDataLink.DataSource := Value;
If Value <> nil Then
DataSet := FDataLink.DataSource.DataSet;
end;
function TDBLoc_ads.GetDataField: string;
begin
Result := FDataLink.FieldName;
end;
procedure TDBLoc_ads.SetDataField(const Value: string);
begin
Try
If FDataLink.FieldName <> Value Then
FDataLink.FieldName := Value;
Except End;
end;
procedure TDBLoc_ads.FormDestroy(Sender: TObject);
begin
FDataLink.Free;
FDataLink := nil;
end;
procedure TDBLoc_ads.FormCreate(Sender: TObject);
begin
FDataLink := TFieldDataLink.Create;
FDataLink.Control := Self;
EditSearchFor.Align := alTop;
ComboBoxSearchField.Align := alClient;
ShowMessages := True;
CaseSensitive := False;
MatchType := Start_mt_ads;
DataSource := nil;
SearchString := '';
DataField := '';
SearchForward := True;
SearchFromCursor := False;
Title := 'Locate a Record';{stores the Dialog Title}
FBeveled := False; {Selected panels have beveling if true}
FButtonsReSize := False; {Buttons resize if true}
FButtonsAlignment := taCenter; {taLeftJustify, taCenter, taRightJustify}
FButtonWidth := 25; {Sets Button Widths}
FButtonSpacer := 5; {Sets Button Spacer Width}
FApplyChanges := False; {True if changes should be made. = mrOk}
FModal := True; {True if Form is being shown modal}
IsComponent := False; {True if Form is part of a component,
False if Form is a standalone form,
Default is False}
Height := 250;
Width := 300;
MinFormWidth := 300; {Sets a Minimum FormWidth}
MinFormHeight := 250; {Sets a Minimum FormHeight}
FDialogComponentName := 'TDBLocate_ads';
{Set bevel prior to resizing}
SetBevel;
{ReSize at the end of the create}
ReSizeAll;
end;
procedure TDBLoc_ads.FormActivate(Sender: TObject);
Var i : Integer;
begin
RadioGroupMatch.ItemIndex := Ord(MatchType);
EditSearchFor.Text := SearchString;
ComboBoxSearchField.Text := DataField;
If SearchFromCursor Then
Begin
If SearchForward Then
Begin
ButtonFirst.Default := False;
ButtonPrior.Default := False;
ButtonNext.Default := True;
ButtonLast.Default := False;
End
Else
Begin
ButtonFirst.Default := False;
ButtonPrior.Default := True;
ButtonNext.Default := False;
ButtonLast.Default := False;
End;
End
Else
Begin
If SearchForward Then
Begin
ButtonFirst.Default := True;
ButtonPrior.Default := False;
ButtonNext.Default := False;
ButtonLast.Default := False;
End
Else
Begin
ButtonFirst.Default := False;
ButtonPrior.Default := False;
ButtonNext.Default := False;
ButtonLast.Default := True;
End;
End;
If CaseSensitive Then
Begin
RadioGroupCase.ItemIndex := 1;
End
Else
Begin
RadioGroupCase.ItemIndex := 0;
End;
If DataSet <> nil Then
Begin
Try
ComboBoxSearchField.Items.Clear;
For i := 0 To DataSet.FieldCount -1 Do
Begin
ComboBoxSearchField.Items.Add(DataSet.Fields[i].FieldName);
End;
Except
raise Exception.
Create('An error occurred while populating the field list combobox');
End;
End;
If IsComponent Then
Begin
{}
End
Else
Begin
Caption := Title; {stores the Dialog Title}
SetBevel;
Left := GetCenterFormLeft(Width);
Top := GetCenterFormTop(Height);
End;
EditSearchFor.SelectAll;
end;
Function TDBLoc_ads.IsMatchFound: Boolean;
Var S,T : String;
begin
Result := False;
S := SearchString;
T := DataSet.FieldByName(DataField).AsString;
MatchFound := False;
If MatchType = Exact_mt_ads Then
Begin
If CaseSensitive Then
Begin
If S = T Then
Begin
Result := True;
End
Else
Begin
Result := False;
End;
End
Else
Begin
If UpperCase(S) = UpperCase(T) Then
Begin
Result := True;
End
Else
Begin
Result := False;
End;
End;
MatchFound := Result;
Exit;
End;
If MatchType = Start_mt_ads Then
Begin
If CaseSensitive Then
Begin
If S = Copy(T,1,Length(S)) Then
Begin
Result := True;
End
Else
Begin
Result := False;
End;
End
Else
Begin
If UpperCase(S) =
UpperCase(Copy(T,1,Length(S))) Then
Begin
Result := True;
End
Else
Begin
Result := False;
End;
End;
MatchFound := Result;
Exit;
End;
If MatchType = Middle_mt_ads Then
Begin
If CaseSensitive Then
Begin
If Pos(S,Copy(T,2,Length(T)-2)) <> 0 Then
Begin
Result := True;
End
Else
Begin
Result := False;
End;
End
Else
Begin
If Pos(UpperCase(S),UpperCase(Copy(T,2,Length(T)-2))) <> 0 Then
Begin
Result := True;
End
Else
Begin
Result := False;
End;
End;
MatchFound := Result;
Exit;
End;
If MatchType = End_mt_ads Then
Begin
If CaseSensitive Then
Begin
If S = Copy(T,Length(T)-Length(S)+1,Length(S)) Then
Begin
Result := True;
End
Else
Begin
Result := False;
End;
End
Else
Begin
If UpperCase(S) =
UpperCase(Copy(T,Length(T)-
Length(S)+1,Length(S))) Then
Begin
Result := True;
End
Else
Begin
Result := False;
End;
End;
MatchFound := Result;
Exit;
End;
If MatchType = AnyWhere_mt_ads Then
Begin
If CaseSensitive Then
Begin
If Pos(S,T) <> 0 Then
Begin
Result := True;
End
Else
Begin
Result := False;
End;
End
Else
Begin
If Pos(UpperCase(S),UpperCase(T)) <> 0 Then
Begin
Result := True;
End
Else
Begin
Result := False;
End;
End;
MatchFound := Result;
Exit;
End;
end;
procedure TDBLoc_ads.SetBeveled(Value : Boolean);
Begin
FBeveled := Value;
SetBevel;
End;
procedure TDBLoc_ads.SetReSizeNow(Value : Boolean);
Begin
ReSizeAll;
FReSizeNow := Value;
End;
procedure TDBLoc_ads.SetMinFormWidth(Value : Integer);
Begin
If FMinFormWidth <> Value Then FMinFormWidth := Value;
End;
procedure TDBLoc_ads.SetMinFormHeight(Value : Integer);
Begin
If FMinFormHeight <> Value Then FMinFormHeight := Value;
End;
procedure TDBLoc_ads.SetBevel;
Begin
PanelBevel(Beveled,PanelLocateBase);
PanelBevel(Beveled,PanelButtons);
End;
procedure TDBLoc_ads.EditSearchForEnter(Sender: TObject);
begin
EditSearchFor.SelectAll;
end;
procedure TDBLoc_ads.ButtonReSizer(
ButtonBase : TPanel;
ButtonSlider : TPanel;
ButtonWidth : Integer;
ButtonSpacer : Integer;
ButtonsReSize : Boolean;
ButtonsAlignment: TAlignment;
Beveled : Boolean);
Var
MinFormWidth : Integer;
NButtons : Integer;
i : Integer;
NSpacers : Integer;
SpacerWidth : Integer;
SpacersWidth : Integer;
W : Integer;
LeftPos : Integer;
Begin
NButtons := ButtonSlider.ControlCount;
If ButtonSpacer > 0 Then
Begin
SpacerWidth := ButtonSpacer;
NSpacers := NButtons +1;
SpacersWidth := ButtonSpacer * NSpacers;
End
Else
Begin
SpacerWidth := 0;
SpacersWidth:= 0;
End;
MinFormWidth :=
SpacersWidth +
(NButtons * ButtonWidth) +
(ButtonBase.BorderWidth * 2) +
(ButtonBase.BevelWidth * 4) +
25;
Try
If ButtonBase.Parent is TForm Then
Begin
If ButtonBase.Parent.Width < MinFormWidth Then
Begin
ButtonBase.Parent.Width := MinFormWidth;
End;
End
Else
Begin
Try
If ButtonBase.Parent.Parent is TForm Then
Begin
If ButtonBase.Parent.Parent.Width < MinFormWidth Then
Begin
ButtonBase.Parent.Parent.Width := MinFormWidth;
End;
End
Else
Begin
Try
If ButtonBase.Parent.Parent.Parent is TForm Then
Begin
If ButtonBase.Parent.Parent.Parent.Width < MinFormWidth Then
Begin
ButtonBase.Parent.Parent.Parent.Width := MinFormWidth;
End;
End
Else
Begin
Try
If ButtonBase.Parent.Parent.Parent.Parent is TForm Then
Begin
If ButtonBase.Parent.Parent.Parent.Parent.Width < MinFormWidth Then
Begin
ButtonBase.Parent.Parent.Parent.Parent.Width := MinFormWidth;
End;
End
Else
Begin
{Not going to set a minimum form width}
End;
Except
End;
End;
Except
End;
End;
Except
End;
End;
Except
End;
If Beveled Then
Begin
ButtonBase.Height :=
(ButtonBase.BorderWidth * 2) +
(ButtonBase.BevelWidth * 4) +
2 {for borderStyle} +
25 {for standard button height} +
3;
End
else
Begin
ButtonBase.Height :=
(ButtonBase.BorderWidth * 2) +
25 {for standard button height} +
4;
End;
If ButtonsReSize Then
Begin
Buttonslider.Align := alClient;
W := (Buttonslider.Width - SpacersWidth) div NButtons;
LeftPos := SpacerWidth;
For i := 0 To NButtons - 1 Do
Begin
ButtonSlider.Controls[i].Align := alNone;
ButtonSlider.Controls[i].Top := 0;
ButtonSlider.Controls[i].Height := 25;
ButtonSlider.Controls[i].Width := W;
ButtonSlider.Controls[i].Left := LeftPos;
LeftPos := LeftPos + W + SpacerWidth;
End;
End
Else
Begin
ButtonSlider.Align := alNone;
If Beveled Then
Begin
ButtonSlider.Top :=
ButtonBase.BorderWidth +
(ButtonBase.BevelWidth * 2)+
1 + {For BorderStyle}
0; {For Margin}
End
Else
Begin
ButtonSlider.Top :=
ButtonBase.BorderWidth +
1; {For Margin}
End;
ButtonSlider.Height := 25;
ButtonSlider.Width :=
SpacersWidth +
(NButtons * ButtonWidth);
If (Not Beveled) Then
Begin
{Align totally left with not leftmost spacer}
If ButtonsAlignment = taLeftJustify Then
Begin
LeftPos := 0;
End
Else
Begin
If ButtonsAlignment = taRightJustify Then
Begin
{Align totally Right with not rightmost spacer}
LeftPos := 2 * SpacerWidth;
End
Else
Begin
LeftPos := SpacerWidth;
End;
End;
End
Else
Begin
LeftPos := SpacerWidth;
End;
For i := 0 To NButtons - 1 Do
Begin
ButtonSlider.Controls[i].Align := alNone;
ButtonSlider.Controls[i].Top := 0;
ButtonSlider.Controls[i].Height := 25;
ButtonSlider.Controls[i].Width := ButtonWidth;
ButtonSlider.Controls[i].Left := LeftPos;
LeftPos := LeftPos + ButtonWidth+ SpacerWidth;
End;
If ButtonsAlignment = taLeftJustify Then ButtonSlider.Align := alLeft;
If ButtonsAlignment = taRightJustify Then ButtonSlider.Align := alRight;
If ButtonsAlignment = taCenter Then
Begin
ButtonSlider.Align := alNone;
ButtonSlider.Left :=
(ButtonBase.Width -
ButtonSlider.Width) div 2;
End;
End;
ButtonBase.Refresh;
End;
Function TDBLoc_ads.GetCenterFormLeft(FormWidth : Integer): Integer;
Begin
If Screen.Width < FormWidth Then
Begin
Result := Screen.Width-26;
End
Else
Begin
Result := (Screen.Width - FormWidth) div 2;
End;
End;
Function TDBLoc_ads.GetCenterFormTop(FormHeight : Integer): Integer;
Begin
If Screen.Height < FormHeight Then
Begin
Result := Screen.Height-26;
End
Else
Begin
Result := (Screen.Height - FormHeight) div 2;
End;
End;
Procedure TDBLoc_ads.PanelBevel(Beveled : Boolean; Panel: TPanel);
Begin
If Not Beveled Then
Begin
Panel.BevelOuter := bvNone;
Panel.BevelInner := bvNone;
Panel.BorderStyle:= bsNone;
End
Else
Begin
Panel.BevelOuter := bvRaised;
Panel.BevelInner := bvLowered;
Panel.BorderStyle:= bsSingle;
End;
End;
Constructor TDBLoc_ads.Create(AOwner: TComponent);
Begin
ProcName := 'TDBLoc_ads.Create'; Try
inherited;
Self.Parent := TWincontrol(AOwner);
PanelLocateBase := TPanel.Create(AOwner);
With PanelLocateBase Do
Begin
Parent := Self;
Left := 0;
Top := 0;
Width := 385;
Height := 200;
Align := alClient;
BevelOuter := bvNone;
BorderWidth := 10;
Caption := ' ';
ParentColor := True;
TabOrder := 0;
End;
GroupBoxSearchFor := TGroupBox.Create(AOwner);
With GroupBoxSearchFor Do
Begin
Parent := PanelLocateBase;
Left := 10;
Top := 10;
Width := 365;
Height := 50;
Align := alTop;
Caption := 'Search For';
TabOrder := 0;
End;
EditSearchFor := TEdit.Create(AOwner);
With EditSearchFor Do
Begin
Parent := GroupBoxSearchFor;
Left := 8;
Top := 16;
Width := 121;
Height := 25;
Hint := 'Enter what to search for.';
AutoSize := False;
ParentShowHint := False;
ShowHint := True;
TabOrder := 0;
OnEnter := EditSearchForEnter;
End;
GroupBoxSearchField := TGroupBox.Create(AOwner);
With GroupBoxSearchField Do
Begin
Parent := PanelLocateBase;
Left := 10;
Top := 60;
Width := 365;
Height := 50;
Align := alTop;
Caption := 'Search Field';
TabOrder := 1;
End;
ComboBoxSearchField := TComboBox.Create(AOwner);
With ComboBoxSearchField Do
Begin
Parent := GroupBoxSearchField;
Left := 8;
Top := 16;
Width := 145;
Height := 24;
Hint := 'Select the field to search on.';
ItemHeight := 16;
ParentShowHint := False;
ShowHint := True;
Sorted := True;
TabOrder := 0;
End;
RadioGroupMatch := TRadioGroup.Create(AOwner);
With RadioGroupMatch Do
Begin
Parent := PanelLocateBase;
Left := 10;
Top := 110;
Width := 365;
Height := 41;
Hint :=
'Select whether the search should match at the start, middle, end' +
', anywhere or exactly.';
Align := alClient;
Caption := 'Match';
Columns := 5;
ParentShowHint := False;
ShowHint := True;
TabOrder := 2;
Items.Clear;
With Items Do
Begin
Try Add('Start'); Except End;
Try Add('Middle'); Except End;
Try Add('End'); Except End;
Try Add('Any'); Except End;
Try Add('Exact'); Except End;
End;
ItemIndex := 0;
End;
RadioGroupCase := TRadioGroup.Create(AOwner);
With RadioGroupCase Do
Begin
Parent := PanelLocateBase;
Left := 10;
Top := 151;
Width := 365;
Height := 39;
Hint := 'Select whether this search should be case sensitive.';
Align := alBottom;
Caption := 'Case';
Columns := 2;
ParentShowHint := False;
ShowHint := True;
TabOrder := 3;
Items.Clear;
With Items Do
Begin
Try Add('Ignore Case'); Except End;
Try Add('Case Sensitive'); Except End;
End;
ItemIndex := 0;
End;
Panelbuttons := TPanel.Create(AOwner);
With Panelbuttons Do
Begin
Parent := Self;
Left := 0;
Top := 200;
Width := 385;
Height := 53;
Align := alBottom;
BevelOuter := bvNone;
BorderWidth := 10;
Caption := ' ';
ParentColor := True;
TabOrder := 1;
End;
PanelButtonSlider := TPanel.Create(AOwner);
With PanelButtonSlider Do
Begin
Parent := Panelbuttons;
Left := 10;
Top := 10;
Width := 346;
Height := 33;
Align := alLeft;
BevelOuter := bvNone;
Caption := ' ';
ParentColor := True;
TabOrder := 0;
End;
ButtonFirst := TBitBtn.Create(AOwner);
With ButtonFirst Do
Begin
Parent := PanelButtonSlider;
Left := 0;
Top := 0;
Width := 25;
Height := 25;
Hint := 'Find the first match in the table.';
Default := True;
ModalResult := 1;
ParentShowHint := False;
ShowHint := True;
TabOrder := 0;
OnClick := ButtonFirstClick;
StringToGlyph_ads(Glyph,'object TBitmap_ads Bitmap.Data = {'+
' 46010000424D460100000000000076000000280000001C0000000D0000000100'+
' 040000000000D000000000000000000000001000000010000000000000000000'+
' 8000008000000080800080000000800080008080000080808000C0C0C0000000'+
' FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333'+
' 3333333333333333020033333333333333333333333333337333333333333333'+
' 333FFF3FF73333331100330730773333333F333F33FF3333CECC330730007333'+
' 333F333F333337336222330730000077333F333F333333F32222330730000000'+
' 333F333F333333F30000330730000077333F333F3333FFF30000330730007733'+
' 333F333F337F33338888330730773333333F333F3F3333330000333333333333'+
' 3337773FF7333333000033333333333333333333333333330000333333333333'+
' 33333333333333330000}end');
NumGlyphs := 2;
End;
ButtonPrior := TBitBtn.Create(AOwner);
With ButtonPrior Do
Begin
Parent := PanelButtonSlider;
Left := 28;
Top := 0;
Width := 25;
Height := 25;
Hint :=
'Find the first match from the current cursor position toward the' +
' top of the table.';
ModalResult := 1;
ParentShowHint := False;
ShowHint := True;
TabOrder := 1;
OnClick := ButtonPriorClick;
StringToGlyph_ads(Glyph,'object TBitmap_ads Bitmap.Data = {'+
' 12010000424D12010000000000007600000028000000140000000D0000000100'+
' 0400000000009C00000000000000000000001000000010000000000000000000'+
' 8000008000000080800080000000800080008080000080808000C0C0C0000000'+
' FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333'+
' 333333335AAA33333333333333333333E11133333333333333333FFF5AAA3333'+
' 33370333333FF33FF0003333370003333FF3333FD22233370000033FF333333F'+
' F0003700000003733333333FD2223337000003377333333F3000333337000333'+
' 3773333FD2223333333703333337733FF00033333333333333333773D2223333'+
' 3333333333333333F00033333333333333333333D222}end');
NumGlyphs := 2;
End;
ButtonNext := TBitBtn.Create(AOwner);
With ButtonNext Do
Begin
Parent := PanelButtonSlider;
Left := 56;
Top := 0;
Width := 25;
Height := 25;
Hint :=
'Find the first match in the table from the current cursor positi' +
'on.';
ModalResult := 1;
ParentShowHint := False;
ShowHint := True;
TabOrder := 2;
OnClick := ButtonNextClick;
StringToGlyph_ads(Glyph,'object TBitmap_ads Bitmap.Data = {'+
' 12010000424D12010000000000007600000028000000140000000D0000000100'+
' 0400000000009C00000000000000000000001000000010000000000000000000'+
' 8000008000000080800080000000800080008080000080808000C0C0C0000000'+
' FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333'+
' 33333333FFFF33333333333333333333CEEC33333333333FF3333333CDFC3073'+
' 333333733FF33333CDFC300073333373333FF333CDFC30000073337333333FF3'+
' CCEC3000000073733333333FCFFD30000073337333333773EFFF300073333373'+
' 33377333EFFE30733333337337733333EEEE33333333337773333333FFFF3333'+
' 3333333333333333FFFF33333333333333333333FFFF}end');
NumGlyphs := 2;
End;
ButtonLast := TBitBtn.Create(AOwner);
With ButtonLast Do
Begin
Parent := PanelButtonSlider;
Left := 85;
Top := 0;
Width := 25;
Height := 25;
Hint := 'Find the first match searching from the bottom of the table.';
ModalResult := 1;
ParentShowHint := False;
ShowHint := True;
TabOrder := 3;
OnClick := ButtonLastClick;
StringToGlyph_ads(Glyph,'object TBitmap_ads Bitmap.Data = {'+
' 12010000424D12010000000000007600000028000000140000000D0000000100'+
' 0400000000009C00000000000000000000001000000010000000000000000000'+
' 8000008000000080800080000000800080008080000080808000C0C0C0000000'+
' FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333'+
' 3333333300663333333333333333333300DD33333333333333333FFF00BB3333'+
' 77037033333FF33F00663377000370333FF3333F00DD77000003703FF333333F'+
' 00BB0000000370733333333F00667700000370377333333F00DD337700037033'+
' 3773333F00BB3333770370333337733F00663333333333333333377300DD3333'+
' 33333333333333330088333333333333333333330066}end');
NumGlyphs := 2;
End;
ButtonCancel := TBitBtn.Create(AOwner);
With ButtonCancel Do
Begin
Parent := PanelButtonSlider;
Left := 114;
Top := 0;
Width := 25;
Height := 25;
Hint := 'Cancel the search.';
Cancel := True;
ModalResult := 2;
ParentShowHint := False;
ShowHint := True;
TabOrder := 4;
OnClick := ButtonCancelClick;
StringToGlyph_ads(Glyph,'object TBitmap_ads Bitmap.Data = {'+
' DE010000424DDE01000000000000760000002800000024000000120000000100'+
' 0400000000006801000000000000000000001000000000000000000000000000'+
' 80000080000000808000800000008000800080800000C0C0C000808080000000'+
' FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333'+
' 333333333333333333333333000033338833333333333333333F333333333333'+
' 0000333911833333983333333388F333333F3333000033391118333911833333'+
' 38F38F333F88F33300003339111183911118333338F338F3F8338F3300003333'+
' 911118111118333338F3338F833338F3000033333911111111833333338F3338'+
' 3333F8330000333333911111183333333338F333333F83330000333333311111'+
' 8333333333338F3333383333000033333339111183333333333338F333833333'+
' 00003333339111118333333333333833338F3333000033333911181118333333'+
' 33338333338F333300003333911183911183333333383338F338F33300003333'+
' 9118333911183333338F33838F338F33000033333913333391113333338FF833'+
' 38F338F300003333333333333919333333388333338FFF830000333333333333'+
' 3333333333333333333888330000333333333333333333333333333333333333'+
' 0000}end');
NumGlyphs := 2;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
Destructor TDBLoc_ads.Destroy;
Begin
ProcName := 'TDBLoc_ads.Destroy'; Try
ButtonCancel .Free;
ButtonLast .Free;
ButtonNext .Free;
ButtonPrior .Free;
ButtonFirst .Free;
PanelButtonSlider .Free;
Panelbuttons .Free;
RadioGroupCase .Free;
RadioGroupMatch .Free;
ComboBoxSearchField.Free;
GroupBoxSearchField.Free;
EditSearchFor .Free;
GroupBoxSearchFor .Free;
PanelLocateBase .Free;
inherited Destroy;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
{!~DlgDBLocate_ads
}
Function DlgDBLocate_ads(DataSource: TDataSource): Boolean;
Var
Dialog : TForm;
Form : TDBLoc_ads;
Begin
Result := False;
Dialog := nil;
ProcName := 'DlgDBLocate_ads'; Try
Try
Dialog := TForm.Create(nil);
Form := TDBLoc_ads.Create(Dialog);
Form.Parent:= Dialog;
Form.Align := alClient;
With Dialog Do
Begin
Left := 505;
Top := 120;
Width := 393;
Height := 280;
BorderIcons := [biSystemMenu];
Caption := 'Locate a Record ';
Color := clBtnFace;
Font.Color := clWindowText;
Font.Height := -13;
Font.Name := 'System';
Font.Style := [];
OldCreateOrder := True;
Position := poScreenCenter;
OnActivate := Form.FormActivate;
OnCreate := Form.FormCreate;
OnDestroy := Form.FormDestroy;
OnResize := Form.FormResize;
PixelsPerInch := 96;
End;
Form.FormCreate(Dialog);
Form.DataSource := DataSource;
Dialog.ShowModal;
If Dialog.ModalResult = mrOK Then
Begin
//Do Something here
Result := True;
End;
Finally
Dialog.Free;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
Function FindRecord_ads(
// DDataSource is the TDataSource to be searched.
DataSource : TDataSource;
// SearchValue is the item to be found
SearchValue : String;
// SearchField is the DataSet Field name.
SearchField : String;
// FromCursor Options:
// True : Search from current record
// False: Search from table end based
// on SearchAhead value. If
// SearchAhead is True then
// Search is from First record
// forward, otherwise, it is
// from the last record toward
// the top.
FromCursor : Boolean;
// SearchAhead Options:
// True : Search toward table bottom
// False: Search toward table top
SearchAhead : Boolean;
// ApplyCase Options:
// True : Search is case sensitive
// False: Search is case insensitive
ApplyCase : Boolean;
// ShowMessages Options:
// True : Messages dialogs are displayed
// False: Messages dialogs are not displayed
ShowMessages : Boolean;
// MatchValue Options:
// 0: Match at Start
// 1: Match in Middle
// 2: Match at End
// 3: Match AnyWhere
// 4: Exact Match
MatchValue : Integer
): Boolean; //True if found, False otherwise.
Var
Dialog : TForm;
Form : TDBLoc_ads;
Begin
Result := False;
Dialog := nil;
ProcName := 'DlgDBLocate_ads'; Try
Try
Dialog := TForm.Create(nil);
Form := TDBLoc_ads.Create(Dialog);
Form.Parent:= Dialog;
Form.Align := alClient;
With Dialog Do
Begin
Left := 505;
Top := 120;
Width := 393;
Height := 280;
BorderIcons := [biSystemMenu];
Caption := 'Locate a Record ';
Color := clBtnFace;
Font.Color := clWindowText;
Font.Height := -13;
Font.Name := 'System';
Font.Style := [];
OldCreateOrder := True;
Position := poScreenCenter;
OnActivate := Form.FormActivate;
OnCreate := Form.FormCreate;
OnDestroy := Form.FormDestroy;
OnResize := Form.FormResize;
PixelsPerInch := 96;
End;
Form.FormCreate(Dialog);
Form.DataSource := DataSource;
Form.ShowMessages := ShowMessages;
Result :=
Form.FindRecord(
SearchValue,
SearchField,
FromCursor,
SearchAhead,
ApplyCase,
TDBLocMatch_ads(MatchValue));
Finally
Dialog.Free;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
Function FindRecordFirst_ads(
// DDataSource is the TDataSource to be searched.
DataSource : TDataSource;
// SearchValue is the item to be found
SearchValue : String;
// SearchField is the DataSet Field name.
SearchField : String;
// ApplyCase Options:
// True : Search is case sensitive
// False: Search is case insensitive
ApplyCase : Boolean;
// ShowMessages Options:
// True : Messages dialogs are displayed
// False: Messages dialogs are not displayed
ShowMessages : Boolean;
// MatchValue Options:
// 0: Match at Start
// 1: Match in Middle
// 2: Match at End
// 3: Match AnyWhere
// 4: Exact Match
MatchValue : Integer
): Boolean; //True if found, False otherwise.
Var
FromCursor : Boolean;
SearchAhead : Boolean;
Begin
FromCursor := False;
SearchAhead := True;
Result :=
FindRecord_ads(
// DDataSource is the TDataSource to be searched.
DataSource, // DataSource : TDataSource;
// SearchValue is the item to be found
SearchValue, // SearchValue : String;
// SearchField is the DataSet Field name.
SearchField, // SearchField : String;
// FromCursor Options:
// True : Search from current record
// False: Search from table end based
// on SearchAhead value. If
// SearchAhead is True then
// Search is from First record
// forward, otherwise, it is
// from the last record toward
// the top.
FromCursor, // FromCursor : Boolean;
// SearchAhead Options:
// True : Search toward table bottom
// False: Search toward table top
SearchAhead, // SearchAhead : Boolean;
// ApplyCase Options:
// True : Search is case sensitive
// False: Search is case insensitive
ApplyCase, // Ap