Bu unit program database filtre dialog işleminde kullanılır.
Kod: Tümünü seç
unit ads_DlgDBFieldFilter;
{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_DlgDBFieldFilter.pas.pas
This unit contains
*)
interface
Uses DB;
{!~DlgDBFieldFilter_ads
}
Function DlgDBFieldFilter_ads(DataSource: TDataSource): Boolean;
implementation
Uses
ads_Exception,
SysUtils,
StdCtrls,
Buttons,
Classes,
Controls,
ExtCtrls,
Forms,
Graphics
;
Var
UnitName : String;
ProcName : String;
type
TDBFieldFilterDlg_ads = Class(TScrollingWinControl)
Public
Constructor Create(AOwner: TComponent); Override;
Destructor Destroy; Override;
Public
BaseList: TPanel;
PanelButtons: TPanel;
FieldNameList: TListBox;
MsgPanel: TPanel;
PanelButtonSlider: TPanel;
ButtonAll: TBitBtn;
ButtonNone: TBitBtn;
ButtonOK: TBitBtn;
ButtonCancel: TBitBtn;
ButtonDummyAll: TBitBtn;
ButtonDummyNone: TBitBtn;
procedure FormCreate(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure ButtonOKClick(Sender: TObject);
procedure ButtonCancelClick(Sender: TObject);
procedure ButtonAllClick(Sender: TObject);
procedure ButtonNoneClick(Sender: TObject);
private
{ Private declarations }
FDataSource : TDataSource;
FMsg : String; {stores the Dialog Message}
FColorOfFieldList : TColor;
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}
procedure SetReSizeNow(Value : Boolean);
procedure SetMinFormWidth(Value : Integer);
procedure SetMinFormHeight(Value : Integer);
function GetDataSource: TDataSource;
procedure SetDataSource(Value: TDataSource);
function GetMultiSelect: Boolean;
procedure SetMultiSelect(Value: Boolean);
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;
property IsComponent : Boolean
Read FIsComponent
Write FIsComponent;
property ReSizeNow : Boolean
Read FReSizeNow
Write SetReSizeNow;
Published
property MultiSelect: Boolean
read GetMultiSelect
write SetMultiSelect
default True;
property DataSource: TDataSource read GetDataSource write SetDataSource;
property Msg : String read FMsg write FMsg;
property ColorOfFieldList : TColor
Read FColorOfFieldList
Write FColorOfFieldList;
property Title : String {stores the Dialog Title}
read FTitle
write FTitle;
property Beveled : Boolean {Selected panels have beveling if true}
Read FBeveled
Write FBeveled;
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 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;
end;
procedure TDBFieldFilterDlg_ads.FormCreate(Sender: TObject);
Begin
FieldNameList.Items.Clear;
MultiSelect := True;
Msg := 'Select your fields'; {stores the Dialog Message}
ColorOfFieldList := clWindow;
Title := 'Field Selection Dialog';{stores the Dialog Title}
FBeveled := False; {Selected panels have beveling if true}
FButtonsReSize := False; {Buttons resize if true}
FButtonsAlignment := taCenter; {taLeftJustify, taCenter, taRightJustify}
FButtonWidth := 75; {Sets Button Widths}
FButtonSpacer := 10; {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}
FMinFormWidth := 300; {Sets a Minimum FormWidth}
FMinFormHeight := 300; {Sets a Minimum FormHeight}
{Set bevel prior to resizing}
SetBevel;
{ReSize at the end of the create}
ReSizeAll;
end;
procedure TDBFieldFilterDlg_ads.ReSizeAll;
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}
End;
procedure TDBFieldFilterDlg_ads.FormResize(Sender: TObject);
begin
ReSizeAll;
end;
procedure TDBFieldFilterDlg_ads.FormActivate(Sender: TObject);
var
I,J: Integer;
begin
Try
If DataSource = nil Then Exit;
If DataSource.DataSet = nil Then Exit;
For I := 0 to DataSource.DataSet.FieldCount - 1 Do
begin
FieldNameList.Items.Add (DataSource.DataSet.Fields[I].FieldName);
end;
FieldNameList.Sorted := True;
If MultiSelect Then
Begin
For I := 0 to DataSource.DataSet.FieldCount - 1 Do
Begin
If DataSource.DataSet.Fields[I].Visible then
Begin
For J := 0 to FieldNameList.Items.Count - 1 Do
Begin
If UpperCase(FieldNameList.Items[J]) =
UpperCase(DataSource.DataSet.Fields[I].FieldName)
Then
Begin
Try
FieldNameList.Selected [J] := True;
Except
Break;
End;
End;
End;
End;
End;
End;
Except
Raise Exception.Create('Unable to list the Tables Fields');
End;
If MultiSelect Then
Begin
ButtonAll.Enabled := True;
End
Else
Begin
ButtonAll.Enabled := False;
End;
If IsComponent Then
Begin
{}
End
Else
Begin
Caption := Title; {stores the Dialog Title}
MsgPanel.Caption := Msg; {stores the Dialog Message}
FieldNameList.Color:= ColorOfFieldList;
SetBevel;
Left := GetCenterFormLeft(Width);
Top := GetCenterFormTop(Height);
End;
end;
function TDBFieldFilterDlg_ads.GetDataSource: TDataSource;
begin
Result := FDataSource;
end;
procedure TDBFieldFilterDlg_ads.SetDataSource(Value : TDataSource);
begin
FDataSource := Value;
end;
function TDBFieldFilterDlg_ads.GetMultiSelect: Boolean;
begin
Result := FieldNameList.MultiSelect;
end;
procedure TDBFieldFilterDlg_ads.SetMultiSelect(Value : Boolean);
begin
FieldNameList.MultiSelect := Value;
end;
procedure TDBFieldFilterDlg_ads.ButtonCancelClick(Sender: TObject);
begin
ApplyChanges := False;
end;
procedure TDBFieldFilterDlg_ads.ButtonOKClick(Sender: TObject);
Var I: Integer;
begin
Try
Try
FieldNameList.Invalidate;
For I := 0 to DataSource.DataSet.FieldCount - 1 Do
If FieldNameList.Selected[I] Then
Begin
DataSource.DataSet.FieldByName(FieldNameList.Items[I]).Visible := True;
{MessageDlg(FieldNameList.Items[I]+'.Visible = True '+IntToStr(I),
mtInformation,[mbOK], 0);}
End
Else
Begin
DataSource.DataSet.FieldByName(FieldNameList.Items[I]).Visible := False;
{MessageDlg(FieldNameList.Items[I]+'.Visible = False '+IntToStr(I),
mtInformation,[mbOK], 0);}
End;
Except
Raise Exception.Create('Unable to select the Tables Fields');
End;
Finally
FieldNameList.Clear;
ApplyChanges := True;
End;
end;
procedure TDBFieldFilterDlg_ads.ButtonAllClick(Sender: TObject);
Var I: Integer;
begin
TBitBtn(Sender).ModalResult := mrNone;
Try
FieldNameList.Invalidate;
For I := 0 to FieldNameList.Items.Count - 1 Do
FieldNameList.Selected[I] := True;
Except
Raise Exception.Create('Unable to select All Fields');
End;
end;
procedure TDBFieldFilterDlg_ads.ButtonNoneClick(Sender: TObject);
Var I: Integer;
begin
TBitBtn(Sender).ModalResult := mrNone;
Try
FieldNameList.Invalidate;
For I := 0 to FieldNameList.Items.Count - 1 Do
FieldNameList.Selected[I] := False;
Except
Raise Exception.Create('Unable to select All Fields');
End;
end;
procedure TDBFieldFilterDlg_ads.SetBevel;
Begin
PanelBevel(Beveled,MsgPanel);
PanelBevel(Beveled,BaseList);
PanelBevel(Beveled,PanelButtons);
End;
procedure TDBFieldFilterDlg_ads.SetReSizeNow(Value : Boolean);
Begin
ReSizeAll;
FReSizeNow := Value;
End;
procedure TDBFieldFilterDlg_ads.SetMinFormWidth(Value : Integer);
Begin
If FMinFormWidth <> Value Then FMinFormWidth := Value;
End;
procedure TDBFieldFilterDlg_ads.SetMinFormHeight(Value : Integer);
Begin
If FMinFormHeight <> Value Then FMinFormHeight := Value;
End;
procedure TDBFieldFilterDlg_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 TDBFieldFilterDlg_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 TDBFieldFilterDlg_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 TDBFieldFilterDlg_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 TDBFieldFilterDlg_ads.Create(AOwner: TComponent);
Begin
ProcName := 'TDBFieldFilterDlg_ads.Create'; Try
inherited;
Self.Parent := TWincontrol(AOwner);
BaseList := TPanel.Create(AOwner);
With BaseList Do
Begin
Parent := Self;
Left := 0;
Top := 49;
Width := 337;
Height := 202;
Align := alClient;
BevelOuter := bvNone;
BorderWidth := 10;
Caption := ' ';
ParentColor := True;
TabOrder := 0;
End;
FieldNameList := TListBox.Create(AOwner);
With FieldNameList Do
Begin
Parent := BaseList;
Left := 10;
Top := 10;
Width := 317;
Height := 180;
Hint := 'Ctrl-LeftClick fields to be visible.';
Align := alClient;
IntegralHeight := True;
ItemHeight := 16;
MultiSelect := True;
TabOrder := 0;
End;
PanelButtons := TPanel.Create(AOwner);
With PanelButtons Do
Begin
Parent := Self;
Left := 0;
Top := 251;
Width := 337;
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 := 309;
Height := 33;
Align := alLeft;
BevelOuter := bvNone;
Caption := ' ';
ParentColor := True;
TabOrder := 0;
End;
ButtonAll := TBitBtn.Create(AOwner);
With ButtonAll Do
Begin
Parent := PanelButtonSlider;
Left := 6;
Top := 0;
Width := 75;
Height := 25;
Hint := 'Select all fields.';
Caption := '&All';
TabOrder := 0;
OnClick := ButtonAllClick;
NumGlyphs := 2;
End;
ButtonNone := TBitBtn.Create(AOwner);
With ButtonNone Do
Begin
Parent := PanelButtonSlider;
Left := 82;
Top := 0;
Width := 75;
Height := 25;
Hint := 'Have no fields selected.';
Cancel := True;
Caption := '&None';
TabOrder := 1;
OnClick := ButtonNoneClick;
NumGlyphs := 2;
End;
ButtonOK := TBitBtn.Create(AOwner);
With ButtonOK Do
Begin
Parent := PanelButtonSlider;
Left := 154;
Top := 0;
Width := 75;
Height := 25;
Hint := 'Activate field selection.';
Caption := '&OK';
TabOrder := 2;
OnClick := ButtonOKClick;
Kind := bkOK;
End;
ButtonCancel := TBitBtn.Create(AOwner);
With ButtonCancel Do
Begin
Parent := PanelButtonSlider;
Left := 234;
Top := 0;
Width := 75;
Height := 25;
Hint := 'Make no changes and close this dialog.';
Caption := '&Cancel';
TabOrder := 3;
OnClick := ButtonCancelClick;
Kind := bkCancel;
End;
MsgPanel := TPanel.Create(AOwner);
With MsgPanel Do
Begin
Parent := Self;
Left := 0;
Top := 0;
Width := 337;
Height := 49;
Align := alTop;
BevelOuter := bvNone;
BorderWidth := 10;
Caption := 'Select your fields';
ParentColor := True;
TabOrder := 2;
End;
ButtonDummyAll := TBitBtn.Create(AOwner);
With ButtonDummyAll Do
Begin
Parent := MsgPanel;
Left := 16;
Top := 8;
Width := 25;
Height := 25;
TabOrder := 0;
Visible := False;
Kind := bkAll;
End;
ButtonDummyNone := TBitBtn.Create(AOwner);
With ButtonDummyNone Do
Begin
Parent := MsgPanel;
Left := 304;
Top := 8;
Width := 27;
Height := 25;
TabOrder := 1;
Visible := False;
Kind := bkNo;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
Destructor TDBFieldFilterDlg_ads.Destroy;
Begin
ProcName := 'TDBFieldFilterDlg_ads.Destroy'; Try
ButtonDummyNone .Free;
ButtonDummyAll .Free;
MsgPanel .Free;
ButtonCancel .Free;
ButtonOK .Free;
ButtonNone .Free;
ButtonAll .Free;
PanelButtonSlider .Free;
PanelButtons .Free;
FieldNameList .Free;
BaseList .Free;
inherited Destroy;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
{!~DlgDBFieldFilter_ads
}
Function DlgDBFieldFilter_ads(DataSource: TDataSource): Boolean;
Var
Dialog : TForm;
Form : TDBFieldFilterDlg_ads;
Begin
Result := False;
Dialog := nil;
ProcName := 'DlgDBFieldFilter_ads'; Try
Try
Dialog := TForm.Create(nil);
Form := TDBFieldFilterDlg_ads.Create(Dialog);
Form.Parent:= Dialog;
Form.Align := alClient;
With Dialog Do
Begin
Left := 568;
Top := 252;
Width := 345;
Height := 331;
BorderIcons := [biSystemMenu, biMaximize];
Caption := 'Field Selection Dialog';
Color := clBtnFace;
Font.Color := clWindowText;
Font.Height := -14;
Font.Name := 'System';
Font.Style := [];
OldCreateOrder := True;
Position := poScreenCenter;
ShowHint := True;
OnActivate := Form.FormActivate;
OnCreate := Form.FormCreate;
OnResize := Form.FormResize;
PixelsPerInch := 96;
End;
Form.FormCreate(Dialog);
Form.DataSource := DataSource;
Form.ButtonAll.Glyph.Assign(Form.ButtonDummyAll.Glyph);
Form.ButtonNone.Glyph.Assign(Form.ButtonDummyNone.Glyph);
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;
Initialization
UnitName := 'ads_DlgDBFieldFilter';
ProcName := 'Unknown';
End.