Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.
procedure TForm1.Button1Click(Sender: TObject);
var StrVal : String;
begin
StrVal := '';
Form2 := TForm2.Create(nil);
if Form2.ShowModal = mrOK then
StrVal := Form2.Edit1.Text;
FreeAndNil(Form2);
ShowMessage(StrVal);
end;
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DB, StdCtrls, Buttons, ExtCtrls, Grids, DBGrids, DBClient;
type
TfrmSelectEmails = class(TForm)
cds: TClientDataSet;
ds: TDataSource;
grid: TDBGrid;
pnl: TPanel;
btnCancel: TBitBtn;
btnSelectAll: TBitBtn;
btnOk: TBitBtn;
cdsName: TStringField;
cdsemail: TStringField;
procedure btnSelectAllClick(Sender: TObject);
private
function GetSelectedEmails: string;
procedure SelectAll;
procedure RandomData;
public
constructor Create(AOwner: TComponent); override;
property SelectedEmails: string read GetSelectedEmails;
end;
var
frmSelectEmails: TfrmSelectEmails;
function SelectEmails(AOwner: TComponent): string;
implementation
{$R *.dfm}
function SelectEmails(AOwner: TComponent): string;
begin
Result := '';
frmSelectEmails := TfrmSelectEmails.Create(AOwner);
try
if frmSelectEmails.ShowModal = mrOk then
Result := frmSelectEmails.SelectedEmails;
finally
FreeAndNil(frmSelectEmails);
end;
end;
{ TfrmSelectEmails }
procedure TfrmSelectEmails.btnSelectAllClick(Sender: TObject);
begin
SelectAll;
end;
constructor TfrmSelectEmails.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
cds.Active := True;
RandomData;
end;
function TfrmSelectEmails.GetSelectedEmails: string;
const Delimiter = ';';
var b: TBookmark;
begin
Result := '';
with grid.DataSource.DataSet do
begin
DisableControls;
try
b := GetBookmark;
try
First;
while not Eof do
begin
if grid.SelectedRows.CurrentRowSelected then
Result := Result + FieldByName('email').AsString + Delimiter;
Next;
end;
finally
GotoBookmark(b);
FreeBookmark(b);
end;
finally
EnableControls;
end;
end;
if Result <> '' then
Delete(Result, Length(Result) - Length(Delimiter) + 1, Length(Delimiter));
end;
procedure TfrmSelectEmails.RandomData;
const MaxRandom = 30;
var I: Integer;
begin
for I := 0 to Random(MaxRandom) do
cds.InsertRecord([Format('name ', [i]), Format('email%d@abc.com', [i])]);
end;
procedure TfrmSelectEmails.SelectAll;
var b: TBookmark;
begin
grid.SelectedRows.Clear;
with grid.DataSource.DataSet do
begin
DisableControls;
try
b := GetBookmark;
try
First;
while not Eof do
begin
grid.SelectedRows.CurrentRowSelected := True;
Next;
end;
finally
GotoBookmark(b);
FreeBookmark(b);
end;
finally
EnableControls;
end;
end;
end;
end.
--- dfm ---
object frmSelectEmails: TfrmSelectEmails
Left = 0
Top = 0
Caption = 'Select emails'
ClientHeight = 451
ClientWidth = 692
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object grid: TDBGrid
Left = 0
Top = 0
Width = 692
Height = 392
Align = alClient
DataSource = ds
Options = [dgEditing, dgTitles, dgIndicator, dgColumnResize, dgColLines, dgRowLines, dgTabs, dgConfirmDelete, dgCancelOnExit, dgMultiSelect]
TabOrder = 0
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'Tahoma'
TitleFont.Style = []
end
object pnl: TPanel
Left = 0
Top = 392
Width = 692
Height = 59
Align = alBottom
TabOrder = 1
object btnCancel: TBitBtn
Left = 568
Top = 16
Width = 105
Height = 25
DoubleBuffered = True
Kind = bkCancel
ParentDoubleBuffered = False
TabOrder = 0
end
object btnSelectAll: TBitBtn
Left = 16
Top = 16
Width = 105
Height = 25
Caption = 'Select All'
DoubleBuffered = True
Glyph.Data = {
F2010000424DF201000000000000760000002800000024000000130000000100
0400000000007C01000000000000000000001000000000000000000000000000
80000080000000808000800000008000800080800000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333334433333
3333333333388F3333333333000033334224333333333333338338F333333333
0000333422224333333333333833338F33333333000033422222243333333333
83333338F3333333000034222A22224333333338F33F33338F33333300003222
A2A2224333333338F383F3338F33333300003A2A222A222433333338F8333F33
38F33333000034A22222A22243333338833333F3338F333300004222A2222A22
2433338F338F333F3338F3330000222A3A2224A22243338F3838F338F3338F33
0000A2A333A2224A2224338F83338F338F3338F300003A33333A2224A2224338
333338F338F3338F000033333333A2224A2243333333338F338F338F00003333
33333A2224A2233333333338F338F83300003333333333A2224A333333333333
8F338F33000033333333333A222433333333333338F338F30000333333333333
A224333333333333338F38F300003333333333333A223333333333333338F8F3
000033333333333333A3333333333333333383330000}
NumGlyphs = 2
ParentDoubleBuffered = False
TabOrder = 1
OnClick = btnSelectAllClick
end
object btnOk: TBitBtn
Left = 440
Top = 16
Width = 105
Height = 25
DoubleBuffered = True
Kind = bkOK
ParentDoubleBuffered = False
TabOrder = 2
end
end
object cds: TClientDataSet
Active = True
Aggregates = <>
Params = <>
Left = 576
Top = 40
Data = {
4D0000009619E0BD0100000018000000020000000000030000004D00044E616D
65010049000000010005574944544802000200640005656D61696C0200490000
000100055749445448020002002C010000}
object cdsName: TStringField
FieldName = 'Name'
Size = 100
end
object cdsemail: TStringField
FieldName = 'email'
Size = 300
end
end
object ds: TDataSource
DataSet = cds
Left = 512
Top = 40
end
end
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DB, StdCtrls, Buttons, ExtCtrls, Grids, DBGrids, DBClient;
type
TfrmSelectEmails = class(TForm)
cds: TClientDataSet;
ds: TDataSource;
grid: TDBGrid;
pnl: TPanel;
btnCancel: TBitBtn;
btnSelectAll: TBitBtn;
btnOk: TBitBtn;
cdsName: TStringField;
cdsemail: TStringField;
procedure btnSelectAllClick(Sender: TObject);
private
function GetSelectedEmails: string;
procedure SelectAll;
procedure RandomData;
public
constructor Create(AOwner: TComponent); override;
property SelectedEmails: string read GetSelectedEmails;
end;
var
frmSelectEmails: TfrmSelectEmails;
function SelectEmails(AOwner: TComponent): string; overload;
procedure SelectEmails(AOwner: TComponent; var Emails: string); overload;
implementation
{$R *.dfm}
function SelectEmails(AOwner: TComponent): string;
begin
Result := '';
frmSelectEmails := TfrmSelectEmails.Create(AOwner);
try
if frmSelectEmails.ShowModal = mrOk then
Result := frmSelectEmails.SelectedEmails;
finally
FreeAndNil(frmSelectEmails);
end;
end;
procedure SelectEmails(AOwner: TComponent; var Emails: string);
begin
Emails := SelectEmails(AOwner);
end;
{ TfrmSelectEmails }
procedure TfrmSelectEmails.btnSelectAllClick(Sender: TObject);
begin
SelectAll;
end;
constructor TfrmSelectEmails.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
cds.Active := True;
RandomData;
end;
function TfrmSelectEmails.GetSelectedEmails: string;
const Delimiter = ';';
var b: TBookmark;
begin
Result := '';
with grid.DataSource.DataSet do
begin
DisableControls;
try
b := GetBookmark;
try
First;
while not Eof do
begin
if grid.SelectedRows.CurrentRowSelected then
Result := Result + FieldByName('email').AsString + Delimiter;
Next;
end;
finally
GotoBookmark(b);
FreeBookmark(b);
end;
finally
EnableControls;
end;
end;
if Result <> '' then
Delete(Result, Length(Result) - Length(Delimiter) + 1, Length(Delimiter));
end;
procedure TfrmSelectEmails.RandomData;
const MaxRandom = 30;
var I: Integer;
begin
for I := 0 to Random(MaxRandom) do
cds.InsertRecord([Format('name ', [i]), Format('email%d@abc.com', [i])]);
end;
procedure TfrmSelectEmails.SelectAll;
var b: TBookmark;
begin
grid.SelectedRows.Clear;
with grid.DataSource.DataSet do
begin
DisableControls;
try
b := GetBookmark;
try
First;
while not Eof do
begin
grid.SelectedRows.CurrentRowSelected := True;
Next;
end;
finally
GotoBookmark(b);
FreeBookmark(b);
end;
finally
EnableControls;
end;
end;
end;
end.
--- dfm ---
object frmSelectEmails: TfrmSelectEmails
Left = 0
Top = 0
Caption = 'Select emails'
ClientHeight = 451
ClientWidth = 692
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object grid: TDBGrid
Left = 0
Top = 0
Width = 692
Height = 392
Align = alClient
DataSource = ds
Options = [dgEditing, dgTitles, dgIndicator, dgColumnResize, dgColLines, dgRowLines, dgTabs, dgConfirmDelete, dgCancelOnExit, dgMultiSelect]
TabOrder = 0
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'Tahoma'
TitleFont.Style = []
end
object pnl: TPanel
Left = 0
Top = 392
Width = 692
Height = 59
Align = alBottom
TabOrder = 1
object btnCancel: TBitBtn
Left = 568
Top = 16
Width = 105
Height = 25
DoubleBuffered = True
Kind = bkCancel
ParentDoubleBuffered = False
TabOrder = 0
end
object btnSelectAll: TBitBtn
Left = 16
Top = 16
Width = 105
Height = 25
Caption = 'Select All'
DoubleBuffered = True
Glyph.Data = {
F2010000424DF201000000000000760000002800000024000000130000000100
0400000000007C01000000000000000000001000000000000000000000000000
80000080000000808000800000008000800080800000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333334433333
3333333333388F3333333333000033334224333333333333338338F333333333
0000333422224333333333333833338F33333333000033422222243333333333
83333338F3333333000034222A22224333333338F33F33338F33333300003222
A2A2224333333338F383F3338F33333300003A2A222A222433333338F8333F33
38F33333000034A22222A22243333338833333F3338F333300004222A2222A22
2433338F338F333F3338F3330000222A3A2224A22243338F3838F338F3338F33
0000A2A333A2224A2224338F83338F338F3338F300003A33333A2224A2224338
333338F338F3338F000033333333A2224A2243333333338F338F338F00003333
33333A2224A2233333333338F338F83300003333333333A2224A333333333333
8F338F33000033333333333A222433333333333338F338F30000333333333333
A224333333333333338F38F300003333333333333A223333333333333338F8F3
000033333333333333A3333333333333333383330000}
NumGlyphs = 2
ParentDoubleBuffered = False
TabOrder = 1
OnClick = btnSelectAllClick
end
object btnOk: TBitBtn
Left = 440
Top = 16
Width = 105
Height = 25
DoubleBuffered = True
Kind = bkOK
ParentDoubleBuffered = False
TabOrder = 2
end
end
object cds: TClientDataSet
Active = True
Aggregates = <>
Params = <>
Left = 576
Top = 40
Data = {
4D0000009619E0BD0100000018000000020000000000030000004D00044E616D
65010049000000010005574944544802000200640005656D61696C0200490000
000100055749445448020002002C010000}
object cdsName: TStringField
FieldName = 'Name'
Size = 100
end
object cdsemail: TStringField
FieldName = 'email'
Size = 300
end
end
object ds: TDataSource
DataSet = cds
Left = 512
Top = 40
end
end
unit uSelectDate;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls, Buttons, ExtCtrls;
type
TfrmDatePick = class(TForm)
pnlButtons: TPanel;
btnOk: TBitBtn;
btnCancel: TBitBtn;
mcPick: TMonthCalendar;
end;
var
frmDatePick: TfrmDatePick;
function SelectDate(AOwner: TComponent; var ADate: TDateTime): Boolean;
implementation
{$R *.dfm}
function SelectDate(AOwner: TComponent; var ADate: TDateTime): Boolean;
var frm: TfrmDatePick;
begin
Result := False;
frm := TfrmDatePick.Create(AOwner);
try
if frm.ShowModal = mrOk then
begin
Result := True;
ADate := frm.mcPick.Date;
end;
finally
FreeAndNil(frm);
end;
end;
end.
Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.
Have a better answer? Share it in a comment.
Join the community of 500,000 technology professionals and ask your questions.