Корректнее было бы самому канву рисовать, но можно и просто вставить - держи функцию для этого - применять вместо стандартного метода Create.

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;

 

Взято с Vingrad.ru http://forum.vingrad.ru

 

Для использования следующего примера, необходимо создать новую форму, перетащить на неё TRichEdit (RichEdit1) и создать checkbox (acb) в событии FormCreate().

 

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;

 

  

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.

 

 

 

Автор: Joel E. Cant.

 

Пример демонстрирует добавление любого количества чекбоксов в StringGrid. В этом примере необходимо добавить TPanel, а в саму панель включить TstringGrid. Так же необходимо добавить невидимый TcheckBox на форму. Затем добавьте5 колонок и 4 строки в объект StringGrid.

 

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.

}

 

  

Следующий пример демонстрирует всплывающий ComboBox в качестве местного редактора для компонента TStringGrid:

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:

procedure DrawGridCheckBox(Canvas: TCanvas; Rect: TRect; Checked: boolean);

var

DrawFlags: Integer;

begin

Canvas.TextRect(Rect, Rect.Left + 1, Rect.Top + 1, ' ');

DrawFrameControl(Canvas.Handle, Rect, DFC_BUTTON, DFCS_BUTTONPUSH or DFCS_ADJUSTRECT);

DrawFlags := DFCS_BUTTONCHECK or DFCS_ADJUSTRECT;// DFCS_BUTTONCHECK

if Checked then

   DrawFlags := DrawFlags or DFCS_CHECKED;

DrawFrameControl(Canvas.Handle, Rect, DFC_BUTTON, DrawFlags);

end;

 

 

Автор: Neil Rubenking

 

Некоторое время тому назад такой вопрос уже ставился: возможно ли поместить элемент управления, например, CheckBox или ComboBox внутрь компонента ...Grid. Я сегодня помозговал и нашел неплохую, на мой взгляд, технологию. Это работает! Вот решение для тех, кто этим интересуется:

 

 

При создании компонента (в обработчике OnCreate), создайте его объекты Objects[C,R], например TCheckBox.Create(Self). Имейте в виду, что вы должны присвоить ячейкам Cells[C,R] какие-либо значения прежде, чем чем вы сможете иметь доступ к Objects[C,R]. Установите у вновь созданного компонента свойство Visible в FALSE, а свойство parent в SELF. Осуществите другую необходимую инициализацию. Имейте в виду, что вы должны внести необходимые модули в список uses, если создаете тип компонента, которого нигде кроме как на форме нет.

 

Создайте процедуру, берущую координаты колонки/строки и правильно позиционирующую соотвествующий объект в пределах прямоугольника ячейки, например:

 

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.

 

 

Данный совет и сопутствующий код показывает как просто поместить любой компонент в ячейку сетки данных. Компонент в данном контексте может означать любой видимый элемент управления - от простого combobox до сложного диалогового окна. Методы, описанные ниже, применимы практически к любому визуальному компоненту. Если Вы можете поместить его на форму, то, вероятно, сможете поместить и в ячейку DBGrid.