Sayıca fazla çoktan seçmeli alan (içerikleri çeşitli türleri farklı olabilir) olduğunu anlıyorum.
Yan yana bir sürü DBLookupComboBox kurmak bir yana sorgu durumuna göre farklı pencere tasarımları gerekeceğinden size hak veriyroum.
Alternatif olarak DBGrid üzerinden "PickList" ile ( cell/hücre bazında combobox diyebiliriz) yapılandırmak çözüm olabilir.
Bunun için bir örnek hazırladım incelemek isteyebilirsiniz.
Örnekte görmenizi istediğim konu; alan tipi ve alan ismini referans alarak seçenekleri bir kerede nasıl özelleştirebileceğiniz konusudur.
* MyGetText ve MySetText kısmında dönüşümü nasıl yaptığımızı kendi projenizde örneğe bakarak deneyebilirsiniz.
* Integer, Boolean veya String alan fark etmeksizin seçenek oluşturabilirsiniz.
MSSQL Server veritabanı ile örnekledim elimde kolayda bu vardı ama diğer tüm veritabanlarında aynen çalışır.
Proje dosyası bu mesaj ekindedir.
Kullanımı ve kaynak kodları indirmeden incelemek isteyenler için buraya paylaşıyorum.
Helper Class Unit
unit DBGridHelper;
interface
uses WinApi.Windows,
System.SysUtils, System.Classes, System.Types,
Vcl.DBGrids,
Data.DB;
Type
tDBGridHelper = class( TObject )
private
const
FEvetHayir : array[boolean] of string = ('Hayır','Evet');
FYesNo : array[boolean] of string = ('No','Yes');
FVarYok : array[0..1] of string = ('Yok','Var');
FAktifPasif : array[0..1] of string = ('Pasif', 'Aktif');
FYonler : array[0..4] of string = ('Yerinde', 'Yukarı', 'Aşağı', 'Sağa', 'Sola');
var
FDBGrid : TDBGrid;
FLog : TStrings;
procedure PreparePickList;
function ArrayIdx(const aText: string;
const aArray: array of string): integer;
function ListPick(const aArray: array of string): string;
function GetDBGrid: TDBGrid;
procedure SetDBGrid( value: TDBGrid );
procedure MyGetText(Sender: TField; var Text: String; DisplayText: Boolean);
procedure MySetText(Sender: TField; const Text: string);
procedure DBGrid_OnCellClick(Column: TColumn);
procedure LogLa( value: string );
public
constructor Create;
destructor Destroy; override;
property DBGrid : TDBGrid read GetDBGrid write SetDBGrid;
property Log : TStrings read FLog write FLog;
end;
implementation
{ tDBGridHelper }
constructor tDBGridHelper.Create;
begin
inherited;
end;
destructor tDBGridHelper.Destroy;
begin
inherited;
end;
function tDBGridHelper.ArrayIdx( const aText: string;
const aArray: array of string ): integer;
var
i : integer;
begin
result := -1;
i := Low(aArray);
while (i <= High(aArray)) and (result < 0) do
begin
if aText = aArray[i]
then result := i
else inc(i);
end;
end;
function tDBGridHelper.ListPick( const aArray: array of string ): string;
var
i : Integer;
begin
result := '';
for i := Low(aArray) to High(aArray)
do
result := result + aArray[i] + sLineBreak;
result := trim(result);
end;
procedure tDBGridHelper.PreparePickList;
var
i : Integer;
begin
if (FDBGrid.DataSource <> nil )
and (FDBGrid.DataSource.DataSet.Active)
then
begin
with FDBGrid.DataSource.DataSet do
begin
for i := 0 to FDBGrid.Columns.Count-1 do
begin
case FDBGrid.Columns[i].Field.DataType of
ftBoolean : // boolean
begin
if pos( 'EvetHayir', FDBGrid.Columns[i].Field.DisplayName ) > 0
then begin
FDBGrid.Columns[i].PickList.Text := ListPick( FEvetHayir );
FDBGrid.Columns[i].DropDownRows := Length(FEvetHayir);
end;
if pos( 'YesNo', FDBGrid.Columns[i].Field.DisplayName ) > 0
then begin
FDBGrid.Columns[i].PickList.Text := ListPick( FYesNo );
FDBGrid.Columns[i].DropDownRows := Length(FYesNo);
end;
end;
ftInteger : // integer
begin
if pos( 'VarYok', FDBGrid.Columns[i].Field.DisplayName ) > 0
then begin
FDBGrid.Columns[i].PickList.Text := ListPick( FVarYok );
FDBGrid.Columns[i].DropDownRows := Length(FVarYok);
end;
if pos( 'YukariAsagi', FDBGrid.Columns[i].Field.DisplayName ) > 0
then begin
FDBGrid.Columns[i].PickList.Text := ListPick( FYonler );
FDBGrid.Columns[i].DropDownRows := Length(FYonler);
end;
end;
ftString : // string
begin
if pos( 'AktifPasif', FDBGrid.Columns[i].Field.DisplayName ) > 0
then begin
FDBGrid.Columns[i].PickList.Text := ListPick( FAktifPasif );
FDBGrid.Columns[i].DropDownRows := Length(FAktifPasif);
end;
end;
end;
end;
end;
end;
end;
function tDBGridHelper.GetDBGrid: TDBGrid;
begin
result := FDBGrid;
end;
procedure tDBGridHelper.SetDBGrid(value: TDBGrid);
var
i : Integer;
begin
FDBGrid := value;
PreparePickList();
FDBGrid.OnCellClick := DBGrid_OnCellClick;
for i := 0 to FDBGrid.Datasource.DataSet.FieldCount-1
do begin
FDBGrid.Datasource.DataSet.Fields[i].OnGetText := MyGetText;
FDBGrid.Datasource.DataSet.Fields[i].OnSetText := MySetText;
end;
for i := 0 to FDBGrid.Columns.Count-1
do
if FDBGrid.Columns[i].Width > 100
then
FDBGrid.Columns[i].Width := 100;
end;
procedure tDBGridHelper.MyGetText(Sender: TField; var Text: String;
DisplayText: Boolean);
begin
case TField(sender).DataType of
ftBoolean : // boolean
begin
if pos( 'EvetHayir', TField(sender).DisplayName ) > 0
then
Text := FEvetHayir[TField(sender).AsBoolean];
if pos( 'YesNo', TField(sender).DisplayName ) > 0
then
Text := FYesNo[TField(sender).AsBoolean];
end;
ftInteger : // integer
begin
if pos( 'VarYok', TField(sender).DisplayName ) > 0
then begin
Text := FVarYok[TField(sender).AsInteger];
end;
if pos( 'YukariAsagi', TField(sender).DisplayName ) > 0
then begin
Text := FYonler[TField(sender).AsInteger];
end;
end;
else
begin
Text := TField(sender).AsString; // def
end;
end;
end;
procedure tDBGridHelper.MySetText(Sender: TField; const Text: string);
begin
case TField(sender).DataType of
ftBoolean : // boolean
begin
if pos( 'EvetHayir', TField(sender).DisplayName ) > 0
then begin
LogLa('GET: ' + TField(sender).DisplayName + ' = ' + Text + ' ( ' + IntToStr( ArrayIdx( Text, FEvetHayir ) ) + ' )');
TField(sender).AsBoolean := Boolean( ArrayIdx( Text, FEvetHayir ) );
end;
if pos( 'YesNo', TField(sender).DisplayName ) > 0
then begin
LogLa('GET: ' + TField(sender).DisplayName + ' = ' + Text + ' ( ' + IntToStr( ArrayIdx( Text, FYesNo ) ) + ' )');
TField(sender).AsBoolean := Boolean( ArrayIdx( Text, FYesNo ) );
end;
end;
ftInteger : // integer
begin
if pos( 'VarYok', TField(sender).DisplayName ) > 0
then begin
LogLa('GET: ' + TField(sender).DisplayName + ' = ' + Text + ' ( ' + IntToStr( ArrayIdx( Text, FVarYok ) ) + ' )');
TField(sender).AsInteger := ArrayIdx( Text, FVarYok );
end;
if pos( 'YukariAsagi', TField(sender).DisplayName ) > 0
then begin
LogLa('GET: ' + TField(sender).DisplayName + ' = ' + Text + ' ( ' + IntToStr( ArrayIdx( Text, FYonler ) ) + ' )');
TField(sender).AsInteger := ArrayIdx( Text, FYonler )
end;
end;
else
begin
LogLa('GET: ' + TField(sender).DisplayName + ' = ' + Text );
TField(Sender).AsString := Text; // def
end;
end;
end;
procedure tDBGridHelper.DBGrid_OnCellClick(Column: TColumn);
begin
if Column.PickList.Count > 0 then
begin
keybd_event(VK_F2, 0, 0,0);
keybd_event(VK_F2, 0, KEYEVENTF_KEYUP,0);
keybd_event(VK_MENU,0, 0,0);
keybd_event(VK_DOWN,0, 0,0);
keybd_event(VK_DOWN,0, KEYEVENTF_KEYUP,0);
keybd_event(VK_MENU,0, KEYEVENTF_KEYUP,0);
end;
end;
procedure tDBGridHelper.LogLa(value: string);
begin
if Assigned(FLog) then FLog.Add( value );
end;
end.
Kullanımı :
implementation
{$R *.dfm}
uses DBGridHelper;
const
FProvider = 'SQLOLEDB';
FServiceIp = '192.168.0.17';
FServicePort = '1433';
FDatabase = 'TestDatabase';
FTableName = 'TestTable';
FUserName = 'arman';
FPassword = 'mrm.arman';
FConnectionString_MSSQL =
'Provider=' + FProvider + ';'
+'Encrypt=Mandatory;'
+'Trusted Connection=false;'
+'Trust Server Certificate=True;'
+'Use Encryption for Data=False;'
+'Data Source=%s;'
+'Initial Catalog=%s;'
+'User ID=%s;'
+'Password=%s;'
;
Var
FDBGridHelper : tDBGridHelper;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
With FDConnection1.Params do
begin
Values['Server'] := FServiceIp + ',' + FServicePort;
Values['DriverID'] := 'MSSQL';
Values['DriverName'] := 'MSSQL';
Values['User_Name'] := FUserName;
Values['Password'] := FPassword;
Values['OSAuthent'] := 'no';
Values['Database'] := 'master';
Values['Mars'] := 'no';
Values['Pooled'] := 'no';
Values['CharacterSet'] := 'utf8';
Values['ServerCharSet'] := 'utf8';
Values['MetaDefSchema'] := 'dbo';
Values['MetaDefCatalog']:= 'master';
Values['MonitorBy'] := 'Remote';
end;
FDConnection1.LoginPrompt := false;
FDConnection1.Connected := true;
FDQuery1.Connection := FDConnection1;
With FDQuery1 do
begin
// Create Database if NOT Exists....
Connection.Params.Values['Database'] := 'master';
SQL.Text := ''
+ sLineBreak + 'IF NOT EXISTS ( SELECT 1 FROM sys.databases '
+ sLineBreak +' WHERE [name] = N'+ QuotedStr(FDatabase) +' )'
+ sLineBreak + 'CREATE DATABASE [' + FDatabase + ']'
+ sLineBreak + ' CONTAINMENT = NONE'
;
ExecSQL;
// Create Table if NOT Exists....
Connection.Params.Values['Database'] := FDatabase;
SQL.Text := 'IF NOT EXISTS '
+ sLineBreak + '( SELECT * FROM sysobjects '
+ sLineBreak + ' where 1=1 '
+ sLineBreak + ' and name= ' + QuotedStr(FTableName)
+ sLineBreak + ' and xtype=' + QuotedStr('U')
+ sLineBreak + ') '
+ sLineBreak + 'CREATE TABLE ['+FTableName+'] ('
+ sLineBreak + ' T_ID INT IDENTITY(1,1) CONSTRAINT PK_Users PRIMARY KEY NOT NULL '
+ sLineBreak + ', T_Data1 VARCHAR(38) '
+ sLineBreak + ', T_Data2 VARCHAR(38) '
+ sLineBreak + ', T_EvetHayir BIT DEFAULT 0'
+ sLineBreak + ', T_YesNo BIT DEFAULT 0'
+ sLineBreak + ', T_VarYok INTEGER DEFAULT 0'
+ sLineBreak + ', T_YukariAsagi INTEGER DEFAULT 0'
+ sLineBreak + ', T_AktifPasif VARCHAR(5) DEFAULT ''Pasif'''
+ sLineBreak + ', T_AutoDate DateTime DEFAULT CURRENT_TIMESTAMP '
+ sLineBreak + ', T_Update DATETIME '
+ sLineBreak + ', T_UpdateBy VARCHAR(38) '
+ sLineBreak + '); '
;
ExecSQL;
end;
// Open Table
FDQuery1.SQL.Text := 'SELECT * from ' + FTableName;
FDQuery1.Active := true;
DBGrid1.DataSource := DataSource1;
DBGrid1.DataSource.DataSet := FDQuery1;
// DBGrid Setup
if NOT Assigned(FDBGridHelper) then
begin
FDBGridHelper := tDBGridHelper.Create;
FDBGridHelper.DBGrid := DBGrid1;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
ReportMemoryLeaksOnShutdown := true;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Assigned( FDBGridHelper )
then
FreeAndNil( FDBGridHelper );
end;
ilave bir SQL değişikliğinde yapılması gereken yegane işlem DBGrid property'sini yeniden set etmek o kadar.
procedure TForm1.BitBtn2Click(Sender: TObject);
begin
// Open Table
FDQuery1.SQL.Text := Edit1.Text;
FDQuery1.Active := true;
FDBGridHelper.DBGrid := DBGrid1;
end;
