Вставка одних компонентов в другие

Code:

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, Grids, ComCtrls;

type

TForm1 = class(TForm)

   StringGrid1: TStringGrid;

   DateTimePicker1: TDateTimePicker;

   procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;

     var CanSelect: Boolean);

   procedure FormCreate(Sender: TObject);

   procedure StringGrid1Exit(Sender: TObject);

   procedure DateTimePicker1Exit(Sender: TObject);

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,

ARow: Integer; var CanSelect: Boolean);

var

D: TDateTime;

begin

DateTimePicker1.Visible := True;

DateTimePicker1.BoundsRect := StringGrid1.CellRect(ACol, ARow);

D := DateTimePicker1.DateTime;

TryStrToDateTime(StringGrid1.Cells[ACol, ARow], D);

DateTimePicker1.DateTime := D;

DateTimePicker1.SetFocus;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

DateTimePicker1.Parent := StringGrid1;

DateTimePicker1.Visible := False;

DateTimePicker1.OnExit := DateTimePicker1Exit;

StringGrid1.OnSelectCell := StringGrid1SelectCell;

end;

procedure TForm1.StringGrid1Exit(Sender: TObject);

begin

DateTimePicker1.Visible := False;

end;

procedure TForm1.DateTimePicker1Exit(Sender: TObject);

begin

with StringGrid1 do

   Cells[Col, Row] := DateTimeToStr(DateTimePicker1.DateTime);

end;

end.

Code:

unit CBoxInMemo;

interface

uses

Windows, Classes, Controls, Graphics, Forms, StdCtrls;

type

TFrmCboxInMemo = class(TForm)

   Button1: TButton;

   Memo1: TMemo;

   Label1: TLabel;

   ComboBox1: TComboBox;

   procedure Button1Click(Sender: TObject);

   procedure ComboBox1Exit(Sender: TObject);

   procedure ComboBox1Click(Sender: TObject);

private

   { Private declarations }

public

   { Public declarations }

end;

var

FrmCboxInMemo: TFrmCboxInMemo;

implementation

{$R *.DFM}

procedure TFrmCboxInMemo.Button1Click(Sender: TObject);

var

clientPos: TPoint;

lineHeight: Integer;

tmpFont: TFont;

begin

GetCaretPos(clientPos);

{Use the following calculation of line height only if you want your combobox

to appear below the char position you are referencing.}

tmpFont := Canvas.Font;

Canvas.Font := Memo1.Font;

lineHeight := Canvas.TextHeight('Xy');

Canvas.Font := tmpFont;

with ComboBox1 do

begin

   {Adjustment of Top by lineHeight only necessary if combobox is to appear below line.}

   Top := clientPos.Y + Memo1.Top + lineHeight;

   Left := clientPos.X + Memo1.Left;

   Visible := true;

   SetFocus;

end;

end;

procedure TFrmCboxInMemo.ComboBox1Exit(Sender: TObject);

begin

ComboBox1.Visible := false;

end;

procedure TFrmCboxInMemo.ComboBox1Click(Sender: TObject);

begin

ComboBox1.Visible := false;

end;

end.

Code:

procedure TForm1.CheckBox1Click(Sender: TObject);

begin

ShowMessage('There it is!!');

end;

// Заполняем заголовок StringGrid

procedure TForm1.FormCreate(Sender: TObject);

begin

StringGrid1.Cells[0,0] := 'A Simple';

StringGrid1.Cells[1,0] := 'Way';

StringGrid1.Cells[2,0] := 'To';

StringGrid1.Cells[3,0] := 'Do It';

StringGrid1.Cells[4,0] := 'Check !!';

AddCheckBoxes; // добавляем чекбоксы...

end;

procedure TForm1.AddCheckBoxes;

var i: Integer;

    NewCheckBox: TCheckBox;

begin

clean_previus_buffer; // очищаем неиспользуемые чекбоксы...

for i := 1 to 4 do

begin

   StringGrid1.Cells[0,i] := 'a';

   StringGrid1.Cells[1,i] := 'b';

   StringGrid1.Cells[2,i] := 'c';

   StringGrid1.Cells[3,i] := 'd';

   NewCheckBox := TCheckBox.Create(Application);

   NewCheckBox.Width := 0;

   NewCheckBox.Visible := false;

   NewCheckBox.Caption := 'OK';

   NewCheckBox.Color := clWindow;

   NewCheckBox.Tag := i;

   NewCheckBox.OnClick := CheckBox1.OnClick; //Связываем предыдущее событие OnClick

                                             // с существующим TCheckBox

   NewCheckBox.Parent := Panel1;

   StringGrid1.Objects[4,i] := NewCheckBox;

   StringGrid1.RowCount := i;

end;

set_checkbox_alignment; // расположение чекбоксов в ячейках таблицы...

end;

Procedure TForm1.clean_previus_buffer;

var NewCheckBox: TCheckBox;

     i: Integer;

begin

for i := 1 to StringGrid1.RowCount do

   begin

   NewCheckBox := (StringGrid1.Objects[4,i] as TCheckBox);

   if NewCheckBox <> nil then

     begin

       NewCheckBox.Visible := false;

       StringGrid1.Objects[4,i] := nil;

     end;

   end;

end;

Procedure TForm1.set_checkbox_alignment;

var NewCheckBox: TCheckBox;

     Rect: TRect;

     i: Integer;

begin

for i := 1 to StringGrid1.RowCount do

   begin

     NewCheckBox := (StringGrid1.Objects[4,i] as TCheckBox);

     if NewCheckBox <> nil then

       begin

         Rect := StringGrid1.CellRect(4,i); // получаем размер ячейки для чекбокса

         NewCheckBox.Left := StringGrid1.Left + Rect.Left+2;

         NewCheckBox.Top := StringGrid1.Top + Rect.Top+2;

         NewCheckBox.Width := Rect.Right - Rect.Left;

         NewCheckBox.Height := Rect.Bottom - Rect.Top;

         NewCheckBox.Visible := True;

       end;

   end;

end;

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;

Rect: TRect; State: TGridDrawState);

begin

if not (gdFixed in State) then set_checkbox_alignment;

end;

Code:

{

A common problem when working with DBGrid is, that this component can't display TMemo fields,

multiline columns, Graphics...

There are a few good freeware components around to solve this problem.

The best one is definitly "DBGRIDPLUS", which comes with full sources.

However, this component does not allow to edit the text in memo fields.

The delphi fans out there who bought a delphi version that comes with the VCL sources can

fix this problem:

Open dbgrids.pas and make the following changes:

(To have memo editing in your app you must just add the modifyed version of dbgrids.pas to your uses clause)

}

function TCustomDBGrid.GetEditLimit: Integer;

begin

Result := 0;

if Assigned(SelectedField) and (SelectedField.DataType in [ftString, ftWideString, ftMemo]) then <-- Add

   Result := SelectedField.Size;

end;

function TCustomDBGrid.GetEditText(ACol, ARow: Longint): string;

begin

Result := '';

if FDatalink.Active then

with Columns[RawToDataColumn(ACol)] do

   if Assigned(Field) then

     Result := Field.AsString; <-- Change this.

FEditText := Result;

end;

{

Just compare theese edited functions with the original ones, and you will know what to change.

To get multiline cell support (not in memo fields!) for DBGridPlus, send me an email and i can send you the changed DBGridPlus.pas file.

}

Code:

procedure TForm1.FormCreate(Sender: TObject);

begin

{Высоту у combobox не получится установить, поэтому мы будем}

{подгонять размер у грида под размер combobox!}

StringGrid1.DefaultRowHeight := ComboBox1.Height;

{Скрываем combobox}

ComboBox1.Visible := False;

end;

procedure TForm1.ComboBox1Change(Sender: TObject);

begin

{Получаем выбранный элемент из ComboBox и помещаем его в грид}

StringGrid1.Cells[StringGrid1.Col,

                   StringGrid1.Row] :=

   ComboBox1.Items[ComboBox1.ItemIndex];

ComboBox1.Visible := False;

StringGrid1.SetFocus;

end;

procedure TForm1.ComboBox1Exit(Sender: TObject);

begin

{Получаем выбранный элемент из ComboBox и помещаем его в грид}

StringGrid1.Cells[StringGrid1.Col,

                   StringGrid1.Row] :=

   ComboBox1.Items[ComboBox1.ItemIndex];

ComboBox1.Visible := False;

StringGrid1.SetFocus;

end;

procedure TForm1.StringGrid1SelectCell(Sender: TObject; Col,

Row: Integer;  var CanSelect: Boolean);

var

R: TRect;

begin

if ((Col = 3) AND

     (Row <> 0)) then begin

  {Размер и расположение combobox подгоняем под ячейку}

   R := StringGrid1.CellRect(Col, Row);

   R.Left := R.Left + StringGrid1.Left;

   R.Right := R.Right + StringGrid1.Left;

   R.Top := R.Top + StringGrid1.Top;

   R.Bottom := R.Bottom + StringGrid1.Top;

   ComboBox1.Left := R.Left + 1;

   ComboBox1.Top := R.Top + 1;

   ComboBox1.Width := (R.Right + 1) - R.Left;

   ComboBox1.Height := (R.Bottom + 1) - R.Top;

  {Показываем combobox}

   ComboBox1.Visible := True;

   ComboBox1.SetFocus;

end;

CanSelect := True;

end;

Code:

Function CreateProgressBar(StatusBar:TStatusBar; index:integer):TProgressBar;

var findleft:integer;

     i:integer;

{©Drkb v.3(2007): www.drkb.ru,

®Vit (Vitaly Nevzorov) - Этот адрес электронной почты защищён от спам-ботов. У вас должен быть включен JavaScript для просмотра.}

begin

result:=TProgressBar.create(Statusbar);

result.parent:=Statusbar;

result.visible:=true;

result.top:=2;

findleft:=0;

for i:=0 to index-1 do findleft:=findleft+Statusbar.Panels[i].width+1;

result.left:=findleft;

result.width:=Statusbar.Panels[index].width-4;

result.height:=Statusbar.height-2;

end;

Code:

procedure TForm1.FormCreate(Sender: TObject);

{©Drkb v.3(2007): www.drkb.ru}

var

Acb: TCheckBox;

begin

RichEdit1.Left := 20;

Acb := TCheckBox.Create(RichEdit1);

Acb.Left := 30;

Acb.Top := 30;

Acb.Caption := 'my checkbox';

Acb.Parent := RichEdit1;

end;