Delphi 1 

… вы все делаете правильно. BatchMove не может пересобирать индексы. Тем не менее, следующая процедура все же поможет вам сделать это (создать индексы заново). Задайте ей необходимые параметры (.DBF. Name, исходная и целевая таблица, Source и Target) и попробуйте ее в деле!

procedure Form1.FormCreate(Sender: TObject);

var x: integer;

begin

 BatchMove1.Execute;

 Source.Open;

 Target.Exclusive := True;

 Target.Open;

 Source.IndexDefs.Update;

 for x := 0 to Source.IndexDefs.Count – 1 do

  Target.AddIndex(Source.IndexDefs[x].Name, Source.IndexDefs[x].Fields, Source.IndexDefs[x].Options);

 Source.Close;

 Target.Close;

end;

Nomadic отвечает:

Удобней всего, например, так —

with bmovMyBatchMove do begin

 Mode := bmCopy;

 RecordCount := 1;

 Execute;

 R Destination.Delete;

end;

Где bmovMyBatchMove – экземпляр класса TBatchMove из VCL.

Неправда Ваша! ;)

Этот загадочный BatchMove имеет одну очень неприятную особенность (по крайней мере при работе с DBF-таблицами и в Delphi 1.0x), как-то:

увеличивает в создаваемых таблицах в полях типа NUMBER количество значащих цифр после запятой (не помню – возможно, что и до), если там указаны небольшие (около 1-3 цифр) значения :(.

Я эту особенность побороть не сумел, а мириться с ней в условиях нашей конторы (когда приходится бороться за место под солнцем с программистами на Clipper и FoxPro совершенно неприемлемо.

Кроме того, в предложенном выше варианте еще и запись удалять приходится…:)

Решалась же эта проблема следующим способом:

procedure CopyStruct(SrcTable, DestTable: TTable; cpyFields: array of string);

var

 i: Integer;

 bActive: Boolean;

 SrcDatabase, DestDatabase: TDatabase;

 iSrcMemSize, iDestMemSize: Integer;

 pSrcFldDes: PFldDesc; CrtTableDesc: CRTblDesc;

 bNeedAllFields: Boolean;

begin

 SrcDatabase := Session.OpenDatabase(SrcTable.DatabaseName);

 try

  DestDatabase := Session.OpenDatabase(DestTable.DatabaseName);

  try

   bActive := SrcTable.Active;

   SrcTable.FieldDefs.Update;

   iSrcMemSize := SrcTable.FieldDefs.Count * SizeOf(FLDDesc);

   pSrcFldDes := AllocMem(iSrcMemSize);

   if pSrcFldDes = nil then begin

    raise EOutOfMemory.Create('Не хватает памяти!');

   end;

   try

    SrcTable.Open;

    Check(DbiGetFieldDescs(SrcTable.Handle, pSrcFldDes));

    SrcTable.Active := bActive;

    FillChar(CrtTableDesc, SizeOf(CrtTableDesc), 0);

    with CrtTableDesc do begin

     StrPcopy(szTblName, DestTable.TableName);

     StrPcopy(szTblType, 'DBASE');

     if (Length(cpyFields[0] ) = 0) or (cpyFields[0] = '*') then begin

      bNeedAllFields := True;

      SrcTable.FieldDefs.Update;

      iFldCount := SrcTable.FieldDefs.Count;

     end else begin

      bNeedAllFields := False;

      iFldCount := High(cpyFields) + 1;

     end;

     iDestMemSize := iFldCount * Sizeof(FLDDesc);

     CrtTableDesc.pFLDDesc := AllocMem(iDestMemSize);

     if CrtTableDesc.pFLDDesc = nil then begin

      raise EOutOfMemory.Create('Не хватает памяти!');

     end;

    end;

    try

     if bNeedAllFields then begin

      for i := 0 to CrtTableDesc.iFldCount - 1 do begin

       Move(PFieldDescList(pSrcFldDes)^[i], PFieldDescList(CrtTableDesc.pFLDDesc)^[i], SizeOf(FldDesc));

      end;

     end else begin

      for i:=0 to CrtTableDesc.iFldCount-1 do begin

       Move(PFieldDescList(pSrcFldDes)^[SrcTable.FieldDefs.Find(cpyFields[i]).FieldNo – 1], PFieldDescList(CrtTableDesc.pFLDDesc)^[i], SizeOf(FldDesc));

      end;

     end;

     Check(DbiCreateTable(DestDatabase.Handle, True, CrtTableDesc));

    finally

     FreeMem(CrtTableDesc.pFLDDesc, iDestMemSize);

    end;

   finally

    FreeMem(pSrcFldDes, iSrcMemSize);

   end;

  finally

   Session.CloseDatabase(DestDatabase);

  end;

 finally

  Session.CloseDatabase(SrcDatabase);

 end;

end;

VS пишет:

В книгах Калверта, Свана и других авторов можно найти похожий текст. Смысл текста — "Изменить цвет кнопок Button, BitBt нельзя, т.к. их рисует WINDOWS". Если нельзя, но ОЧЕНЬ НУЖНО, то можно.

Небольшой компонент ColorBtn, дает возможность использовать в кнопках цвет. Кроме того, представлено новое свойство — Frame3D, позволяющее получить более реалистичный вид нажатой кнопки. В отличие от API, при изменении значения свойства Frame3D, не требуется переоткрытие компонента.

unit ColorBtn;

interface

uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons;

type TColorBtn = class(TButton)

private

 { Private declarations }

 IsFocused: boolean;

 FCanvas: TCanvas;

 F3DFrame: boolean;

 FButtonColor: TColor;

 procedure Set3DFrame(Value: boolean);

 procedure SetButtonColor(Value: TColor);

 procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;

 procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;

 procedure DrawButtonText(const Caption: string; TRC: TRect; State: TButtonState; BiDiFlags: Longint);

 procedure CalcuateTextPosition(const Caption: string; var TRC: TRect; BiDiFlags: Longint);

protected

 { Protected declarations }

 procedure CreateParams(var Params: TCreateParams); override;

 procedure SetButtonStyle(ADefault: boolean); override;

public

 { Public declarations }

 constructor Create(AOwner: TComponent); override;

 destructor Destroy; override;

published

 { Published declarations }

 property ButtonColor: TColor read FButtonColor write SetButtonColor default clBtnFace;

 property Frame3D: boolean read F3DFrame write Set3DFrame default False;

end;

procedure Register;

implementation

{ TColorBtn }

constructor TColorBtn.Create(AOwner: TComponent);

begin

 Inherited Create(AOwner);

 FCanvas:= TCanvas.Create;

 FButtonColor:= clBtnFace;

 F3DFrame:= False;

end;

destructor TColorBtn.Destroy;

begin

 FCanvas.Free;

 Inherited Destroy;

end;

procedure TColorBtn.CreateParams(var Params: TCreateParams);

begin

 Inherited CreateParams(Params);

 with Params do Style:= Style or BS_OWNERDRAW;

end;

procedure TColorBtn.Set3DFrame(Value: boolean);

begin

 if F3DFrame <> Value then F3DFrame:= Value;

end;

procedure TColorBtn.SetButtonColor(Value: TColor);

begin

 if FButtonColor <> Value then begin

  FButtonColor:= Value;

  Invalidate;

 end;

end;

procedure TColorBtn.WMLButtonDblClk(var Message: TWMLButtonDblClk);

begin

 Perform(WM_LBUTTONDOWN, Message.Keys, Longint(Message.Pos));

end;

procedure TColorBtn.SetButtonStyle(ADefault: Boolean);

begin

 if IsFocused <> ADefault then IsFocused:= ADefault;

end;

procedure TColorBtn.CNDrawItem(var Message: TWMDrawItem);

var

 RC: TRect;Flags: Longint;

 State: TButtonState;

 IsDown, IsDefault: Boolean;

 DrawItemStruct: TDrawItemStruct;

begin

 DrawItemStruct:= Message.DrawItemStruct^;

 FCanvas.Handle:= DrawItemStruct.HDC;

 RC:= ClientRect;

 with DrawItemStruct do begin

  IsDown:= ItemState and ODS_SELECTED <> 0;

  IsDefault:= ItemState and ODS_FOCUS <> 0;

  if not Enabled then State:= bsDisabled

  else if IsDown then State:= bsDown

  else State:= bsUp;

 end;

 Flags:= DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;

 if IsDown then Flags:= Flags or DFCS_PUSHED;

 if DrawItemStruct.ItemState and ODS_DISABLED <> 0 then Flags:= Flags or DFCS_INACTIVE;

 if IsFocused or IsDefault then begin

  FCanvas.Pen.Color:= clWindowFrame;

  FCanvas.Pen.Width:= 1;

  FCanvas.Brush.Style:= bsClear;

  FCanvas.Rectangle(RC.Left, RC.Top, RC.Right, RC.Bottom);

  InflateRect(RC, -1, -1);

 end;

 if IsDown then begin

  FCanvas.Pen.Color:= clBtnShadow;

  FCanvas.Pen.Width:= 1;

  FCanvas.Rectangle(RC.Left, RC.Top, RC.Right, RC.Bottom);

  InflateRect(RC, -1, -1);

  if F3DFrame then begin

   FCanvas.Pen.Color:= FButtonColor;

   FCanvas.Pen.Width:= 1;

   DrawFrameControl(DrawItemStruct.HDC, RC, DFC_BUTTON, Flags);

  end;

 end else DrawFrameControl(DrawItemStruct.HDC, RC, DFC_BUTTON, Flags);

 FCanvas.Brush.Color:= FButtonColor;

 FCanvas.FillRect(RC);

 InflateRect(RC, 1, 1);

 if IsFocused then begin

  RC:= ClientRect;

  InflateRect(RC, -1, -1);

 end;

 if IsDown then OffsetRect(RC, 1, 1);

 FCanvas.Font:= Self.Font;

 DrawButtonText(Caption, RC, State, 0);

 if IsFocused and IsDefault then begin

  RC:= ClientRect;

  InflateRect(RC, -4, -4);

  FCanvas.Pen.Color:= clWindowFrame;

  Windows.DrawFocusRect(FCanvas.Handle, RC);

 end;

 FCanvas.Handle:= 0;

end;

procedure TColorBtn.CalcuateTextPosition(const Caption: string; var TRC: TRect; BiDiFlags: Integer);

var

 TB: TRect;

 TS, TP: TPoint;

begin

 with FCanvas do begin

  TB:= Rect(0, 0, TRC.Right + TRC.Left, TRC.Top + TRC.Bottom);

  DrawText(Handle, PChar(Caption), Length(Caption), TB, DT_CALCRECT or BiDiFlags);

  TS := Point(TB.Right - TB.Left, TB.Bottom - TB.Top);

  TP.X := ((TRC.Right - TRC.Left) - TS.X + 1) div 2;

  TP.Y := ((TRC.Bottom - TRC.Top) - TS.Y + 1) div 2;

  OffsetRect(TB, TP.X + TRC.Left, TP.Y + TRC.Top);

  TRC:= TB;

 end;

end;

procedure TColorBtn.DrawButtonText(const Caption: string; TRC: TRect; State: TButtonState; BiDiFlags: Integer);

begin

 with FCanvas do begin

  CalcuateTextPosition(Caption, TRC, BiDiFlags);

  Brush.Style:= bsClear;

  if State = bsDisabled then begin

   OffsetRect(TRC, 1, 1);

   Font.Color:= clBtnHighlight;

   DrawText(Handle, PChar(Caption), Length(Caption), TRC, DT_CENTER or DT_VCENTER or BiDiFlags);

   OffsetRect(TRC, -1, -1);

   Font.Color:= clBtnShadow;

   DrawText(Handle, PChar(Caption), Length(Caption), TRC, DT_CENTER or DT_VCENTER or BiDiFlags);

  end else DrawText(Handle, PChar(Caption), Length(Caption), TRC, DT_CENTER or DT_VCENTER or BiDiFlags);

 end;

end;

procedure Register;

begin

 RegisterComponents('Controls', [TColorBtn]);

end;

end.

Небольшое дополнение. Кнопку по прежнему рисует WINDOWS, а раскрашивает ее ColorBtn. Код компонента на 90% повторяет код BitBtn, ничего необычного здесь нет. Хочется повторить слова Калверта — «Пользуйтесь исходным кодом». Чаще заглядывайте в VCL – можно найти много интересного. 

Delphi 1 

…с ваших слов я понял, что вы все уже реализовали, но давайте все повторим: вы должны убедиться в том, что событие OnClick привязано к каждой кнопке калькулятора (числовые кнопки 0..9) и указывают на общий обработчик события.

В разделяемом обработчике события получите заголовок обрабатываемой кнопки следующим образом:

Edit1.Text := TButton(Sender).Caption;

…я думаю в этом случае самым разумным будет использование свойства Tag каждой кнопки:

1. назначьте уникальный Tag для каждой кнопки (например, эквивалент арабским цифрам)

2.

procedureTForm1.Button1Click(Sender: TObject);

begin

 if (Sender is TButton) then with (Sender as TButton) do

  {используем Tag}

end;

Если вам нужен только заголовок, то есть изящный способ получить к нему доступ. Подключите общий обработчик события для всех кнопок и используйте приведение типа как показано ниже:

procedure TForm1.Edit1Click(Sender: TObject);

begin

 edit1.text := (sender as TButton).caption;

end;

Приведенная ниже конструкция будет недостаточной:

sender.caption

поскольку компилятор не знает о том, имеет ли «sender» свойство caption, или нет. 

Delphi 1 

Поместите несколько Checkbox в компонент TGroupBox. Во время прогона (или проектирования) назначьте общий обработчик события Click для всех checkbox'в. Чтобы в цикле обойти все «дочерние» TCheckBox'ы, можно воспользоваться свойством-массивом Controls TGroupBox (и заодно привести их к типу TCheckBox). Приблизительно так:

for i := 0 to GroupBox1.ControlCount -1 do

 if  (GroupBox1.Controls[i] as TCheckBox).checked then

  {что-то там еще};

Вы можете получить имя sender следующим образом:

procedure TMain1.CheckBoxClick(Sender: TObject);

var whodidit: string[63];

begin

 whodidit := TComponent(sender).name;

end;

После приведения типа можно добраться и до других свойств. К примеру, очень полезным может оказаться свойство Tag. Во время создания, вы можете присвоить каждому checkbox.tag свой ID номер. А в обработчике события, читая ID, можно идентифицировать sender. 

Delphi 1

var

 CheckArray: array[1..x] of TCheckBox;

 i:integer;

begin

 for i:=1 to x do begin

  CheckArray[i]:=TCheckBox.Create(Form1);

  {Устанавливаем свойства}

  with CheckBox[i] do begin

   Left:=i*20;

   Width:=15;

   другое…

  end;

 end;

Очевидно, можно сказать:

Check[i].OnClick:=xyz.

Пока я и сам не знаю как поступить. Динамическое создание компонентов да, но обработчики событий?

Существует способ организации массива checkbox'ов с разделяемым обработчиком события. Расположите их на форме и дайте им «непрерывные» имена (Check1, Check2 и т.д.). Затем установите у них общий обработчик события. Обработчик события может выглядеть так:

procedure TForm.Check1Click(Sender : TObject);

var i : Integer;

begin

 for i := 1 to 10 { предположим, что мы имеем 10 checkbox'ов } do

  With TCheckBox(FindComponent('Check'+IntToStr(i))) do begin

  { другой какой-то код }

 end;

end;

Delphi 3

В режиме проектирования вы, как программист, без труда узнаете, сколько checkbox'ов содержит ваша форма. А вот когда приложение запущено… Используйте Delphi Run Time Type Information (RTTI). Для нашей испытуемой формы вы можете попробовать следующий код:

var i : Integer

begin

 for i := 0 to ComponentCount - 1 do

  if Components[i] is TCheckBox then

  (Components[i] as TCheckBox).Checked then begin

  ... сюда поместите ваш код ...

 end;

end;

Кроме того, следующий код Delphi абсолютно корректен:

if Components[i] = CheckBox5 then Чтотоделаем;

Также, каждый компонент в Delphi имеет опубликованное (Published) свойство с именем 'Tag', значение которого вы можете задавать во время создания компонента, и затем, во время выполнения приложения, обращаться к нему для получения доступа к компоненту:

var i : Integer

begin

 for i := 0 to ComponentCount - 1 do

  if Components[i] is TCheckBox then

  with (Components[i] as TCheckBox) do

  Case Tag of

  1 : if Checked then DoSomethingOnBox1;

  2 : if Checked then DoSomethingOnBox2;

  … другое …

 end;

end;

Для получения дополнительной информации, обратитесь к справке Delphi с ключевым словом «ComponentCount».

Вот полный код проекта, создающего на кнопке во время выполнения две строчки текста.

program TwolnBtn;

uses Forms,TwolnBtu in 'TWOLNBTU.PAS' {Form1};

{$R *.RES}

begin

 Application.CreateForm(TForm1, Form1);

 Application.Run;

end.

object Form1: TForm1

 Left = 202

 Top = 98

 Width = 320

 Height = 176

 Caption = 'Form1'

 Font.Color = clRed

 Font.Height = -12

 Font.Name = 'Arial'

 Font.Style = [fsBold]

 PixelsPerInch = 96

 OnActivate = ChgSpeedButton

 OnCreate = ChgBitBtn

 TextHeight = 15

 object SpeedButton1: TSpeedButton

  Left = 144

  Top = 24

  Width = 65

  Height = 45

  Caption = 'Это двустрочный заголовок'

  OnClick = ChgSpeedButton

 end

 object

 BitBtn1: TBitBtn

  Left = 32

  Top = 24

  Width = 69

  Height = 37

  Caption = 'Прерывание работы программы'

  TabOrder = 0

  OnClick = BitBtn1Click

 end

end

unit Twolnbtu;

interface

uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons;

type TForm1 = class(TForm)

 BitBtn1: TBitBtn;

 SpeedButton1: TSpeedButton;

 procedure ChgBitBtn(Sender: TObject);

 procedure ChgSpeedButton(Sender: TObject);

 procedure BitBtn1Click(Sender: TObject);

private

 { Private declarations }

public

 { Public declarations }

end;

var Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.ChgBitBtn(Sender: TObject);

VAR

R : TRect;

 N : Integer;

 Buff : ARRAY[0..255] OF Char;

BEGIN

 WITH BitBtn1 DO BEGIN

  Glyph.Canvas.Font := Self.Font;

  Glyph.Width  := Width-6;

  Glyph.Height := Height-6;

  R := Bounds(0,0,Glyph.Width,0);

  StrPCopy(Buff, Caption);

  Caption := '';

  DrawText(Glyph.Canvas.Handle, Buff, StrLen(Buff), R, DT_CENTER OR DT_WORDBREAK OR DT_CALCRECT);

  OffsetRect(R, (Glyph.Width-R.Right) DIV 2, (Glyph.Height - R.Bottom) DIV 2);

  DrawText(Glyph.Canvas.Handle, Buff, StrLen(Buff), R, DT_CENTER OR DT_WORDBREAK);

 END;

END;

procedure TForm1.ChgSpeedButton(Sender: TObject);

VAR

R : TRect;

 N : Integer;

 Buff : ARRAY[0..255] OF Char;

BEGIN

 WITH SpeedButton1 DO BEGIN

  Glyph.Canvas.Font := Self.Font;

  Glyph.Width  := Width-6;

  Glyph.Height := Height-6;

  R := Bounds(0,0,Glyph.Width,0);

  StrPCopy(Buff, Caption);

  Caption := '';

  DrawText(Glyph.Canvas.Handle, Buff, StrLen(Buff), R,DT_CENTER OR DT_WORDBREAK OR DT_CALCRECT);

  OffsetRect(R, (Glyph.Width-R.Right) DIV 2, (Glyph.Height - R.Bottom) DIV 2);

  DrawText(Glyph.Canvas.Handle, Buff, StrLen(Buff), R,DT_CENTER OR DT_WORDBREAK);

 END;

END;

procedure TForm1.BitBtn1Click(Sender: TObject);

begin

 Close;

end;

end.

-Dennis Passmore

Nomadic отвечает:

Когда-то потратил немало времени на разбор, как же все таки работают дропдаун-контролы. В итоге мной был написан маленький юнит, который я положил у себя в каталоге Demo для ознакомления интересующихся. Он маленький (его основная задача — показать принцип работы, а все остальное — как реализуешь), я думаю, что большинству он пригодиться, поэтому публикую здесь. Касательно твоего вопроса - реализуй вместо листбокса выпадающий контрол, который даст тебе функциональность дерева.

unit edit1;

interface

uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

type

 TPopupListbox = class(TCustomListbox)

 protected

  procedure CreateParams(var Params: TCreateParams); override;

  procedure CreateWnd; override;

  procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;

 end;

 TTestDropEdit = class(TEdit)

 private

  FPickList: TPopupListbox;

  procedure CMCancelMode(var Message: TCMCancelMode); message CM_CancelMode;

  procedure WMKillFocus(var Message: TMessage); message WM_KillFocus;

 protected

  procedure CloseUp(Accept: Boolean);

  procedure DropDown;

  procedure WndProc(var Message: TMessage); override;

 public

  constructor Create(Owner: TComponent); override;

  destructor Destroy; override;

 end;

implementation

{ TPopupListBox }

procedure TPopupListBox.CreateParams(var Params: TCreateParams);

begin

 inherited;

 with Params do begin

  Style := Style or WS_BORDER;

  ExStyle := WS_EX_TOOLWINDOW or WS_EX_TOPMOST;

  WindowClass.Style := CS_SAVEBITS;

 end;

end;

procedure TPopupListbox.CreateWnd;

begin

 inherited CreateWnd;

 Windows.SetParent(Handle, 0);

 CallWindowProc(DefWndProc, Handle, WM_SETFOCUS, 0, 0);

end;

procedure TPopupListbox.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

 inherited MouseUp(Button, Shift, X, Y);

 TTestDropEdit(Owner).CloseUp((X >= 0) and (Y >= 0) and (X < Width) and (Y < Height));

end;

{ TTestDropEdit }

constructor TTestDropEdit.Create(Owner: TComponent);

begin

 inherited Create(Owner);

 Parent := Owner as TWinControl;

 FPickList := TPopupListbox.Create(nil);

 FPickList.Visible := False;

 FPickList.Parent := Self;

 FPickList.IntegralHeight := True;

 FPickList.ItemHeight := 11;

 FPickList.Items.CommaText :='1,2,3,4,5,6,7,8,9,0';

end;

destructor TTestDropEdit.Destroy;

begin

 FPickList.Free;

 inherited;

end;

procedure TTestDropEdit.CloseUp(Accept: Boolean);

begin

 if FPickList.Visible then begin

  if GetCapture <> 0 then SendMessage(GetCapture, WM_CANCELMODE, 0, 0);

  SetWindowPos(FPickList.Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);

  if FPickList.ItemIndex <> -1 then Text := FPickList.Items.Strings[FPickList.ItemIndex];

  FPickList.Visible := False;

  Invalidate;

 end;

end;

procedure TTestDropEdit.DropDown;

var

 P: TPoint;

 I,J,Y: Integer;

begin

 if Assigned(FPickList) and (not FPickList.Visible) then begin

  FPickList.Width := Width;

  FPickList.Color := Color;

  FPickList.Font := Font;

  FPickList.Height := 6 * FPickList.ItemHeight + 4;

  FPickList.ItemIndex := FPickList.Items.IndexOf(Text);

  P := Parent.ClientToScreen(Point(Left, Top));

  Y := P.Y + Height;

  if Y + FPickList.Height > Screen.Height then Y := P.Y - FPickList.Height;

  SetWindowPos(FPickList.Handle, HWND_TOP, P.X, Y, 0, 0, SWP_NOSIZE or SWP_NOACTIVATE or SWP_SHOWWINDOW);

  FPickList.Visible := True;

  Invalidate;

  Windows.SetFocus(Handle);

 end;

end;

procedure TTestDropEdit.CMCancelMode(var Message: TCMCancelMode);

begin

 if (Message.Sender <> Self) and (Message.Sender <> FPickList) then CloseUp(False);

end;

procedure TTestDropEdit.WMKillFocus(var Message: TMessage);

begin

 inherited;

 CloseUp(False);

end;

procedure TTestDropEdit.WndProc(var Message: TMessage);

 procedure DoDropDownKeys(var Key: Word; Shift: TShiftState);

 begin

  case Key of

  VK_UP, VK_DOWN:

   if ssAlt in Shift then begin

    if FPickList.Visible  then CloseUp(True)

    else DropDown;

    Key := 0;

   end;

  VK_RETURN, VK_ESCAPE:

   if FPickList.Visible  and not (ssAlt in Shift) then begin

    CloseUp(Key = VK_RETURN);

    Key := 0;

   end;

  end;

 end;

begin

 case Message.Msg of

 WM_KeyDown, WM_SysKeyDown, WM_Char:

  with TWMKey(Message) do begin

   DoDropDownKeys(CharCode, KeyDataToShiftState(KeyData));

   if (CharCode <> 0) and FPickList.Visible then begin

    with TMessage(Message) do SendMessage(FPickList.Handle, Msg, WParam, LParam);

    Exit;

   end;

  end

 end;

 inherited;

end;

end.

Delphi 1

procedureTForm1.ComboBox1Enter(Sender:TObject);

begin

 SendMessage(ComboBox1.Handle, CB_SHOWDROPDOWN, Integer(True), 0);

end;

Поместите эту строку в обработчик события OnEnter ComboBox:

SendMessage(combobox1.Handle, CB_SHOWDROPDOWN, 1, 0);

Измените третий параметр (1) на 0, если вы хотите спрятать список. 

Delphi 1 

…попробуйте сохранять в переменной в методе формы OnEnter или OnCreate значение Index. Затем, чтобы отменить выбор пользователя, сделайте:

ComboBox1.ItemIndex := var1;

Delphi 1

Я, кажется, не могу получить свойство MaxLength, чтобы работать с компонентами TDBEdit. В TEdit это работает как положено, но при попытке задать максимальную длину текста в TDBEdit это не срабатывает, и я все еще могу набрать текст сверх установленного ограничения.

По-моему, это является следствием этого кода в TDBEdit.DataChange (DBCTRLS.PAS):

if FDataLink.Field <> nil then begin

 …

 if FDataLink.Field.DataType = ftString then MaxLength := FDataLink.Field.Size

 else MaxLength := 0;

 …

end else begin

 …

 MaxLength := 0;

 …

end;

т.к. иногда значение устанавливается на ноль…

Похоже все будет работать, если вы измените строку

MaxLength := 0;

на

MaxLength := inherited MaxLength;

Для того, чтобы изменения вступили в силу, вам необходимо перекомпилировать ваш complib с измененным DBCTRLS.PAS, находящимся в пути lib.

Если вы хотите использовать MaxLength с StringField, изменений необходимо сделать немного больше:

…

if (FDataLink.Field.DataType = ftString) and (inherited MaxLength = 0) then

  MaxLength := FDataLink.Field.Size

else MaxLength := inherited MaxLength;

…

Или использовать что-то типа EditMask…

– Reinhard Kalinke

Я хотел бы менять цвет компонентов TDBEdit и TEdit, расположенных на форме, на другой, "отчетливый" цвет, в том случае, если с помощью них требуется ввести какие-либо данные.

Как насчет этого? Представляю вашему вниманию два метода. Первый метод задает цвет каждому DBEdit, имеющему требуемое поле. Второй метод (более сложный) задает цвет каждому БД-компоненту, имеющему необходимое поле.

procedure TForm3.Button3Click(Sender: TObject);

Var Control : Integer;

begin

 For Control := 0 To ControlCount-1 Do

  If Controls[Control] Is TDBEdit Then

   With TDBEdit(Controls[Control]) Do

    If DataSource.DataSet.FieldByName(DataField).Required Then Color := clRed;

end;

{ Данный метод будет работать только в случае, если БД-компонент обладает тремя полями: DataSource, типа TDataSource, DataField, типа String, и Color, типа TColor (это не должно быть проблемой). Также вам необходимо включить TypInfo в список используемых модулей }

procedure TForm3.Button4Click(Sender: TObject);

Var

 Control : Integer;

 DataSource : TDataSource;

 DataField  : String;

 Function GetDataSource(Instance: TComponent) : Boolean;

 Var PropInfo: PPropInfo;

 Begin

  Result := False;

  PropInfo := TypInfo.GetPropInfo(Instance.ClassInfo, 'DataSource');

  If (PropInfo <> Nil) And (PropInfo^.PropType^.Kind = tkClass) Then Begin

   DataSource := TDataSource(TypInfo.GetOrdProp(Instance, PropInfo));

   Result := DataSource <> Nil;

  End;

  End;

 Function GetDataField(Instance: TComponent) : Boolean;

 Var PropInfo : PPropInfo;

 Begin

  Result := False;

  PropInfo := TypInfo.GetPropInfo(Instance.ClassInfo, 'DataField');

  If (PropInfo <> Nil) And (PropInfo^.PropType^.Kind = tkString) Then Begin

   DataField := TypInfo.GetStrProp(Instance, PropInfo);

   Result := True;

  End;

 End;

 Procedure SetColor(Instance: TComponent; Color: TColor);

 Var PropInfo : PPropInfo;

 Begin

  PropInfo := TypInfo.GetPropInfo(Instance.ClassInfo, 'Color');

  If (PropInfo <> Nil) And (PropInfo^.PropType^.Kind = tkInteger) Then TypInfo.SetOrdProp (Instance, PropInfo, Ord(Color));

 End;

begin

 For Control := 0 To ControlCount-1 Do

  If GetDataSource(Controls[Control]) And GetDataField(Controls[Control]) And

   (DataSource.DataSet <> Nil) And

   DataSource.DataSet.FieldByName(DataField).Required Then

   SetColor(Controls[Control], clRed);

end;

– Robert Wittig

Сама Windows не позволяет это сделать, но я нашел как это обойти с помощью одной хитрости, и, похоже, это классно работает (надеюсь вы получите даже больше, чем вы хотите :).

Сначала я добавляю к моей форме свойство (и соответствующие переменные и процедуры), наподобие этому:

private

 FinsertMode: boolean;

procedure SetInsertMode(value: boolean);

public

 property insertMode: boolean read FinsertMode write SetInsertMode;

В обработчике создания события формы я инициализирую его:

procedure TForm1.FormCreate(Sender: TObject);

begin

 {инициализация}

 insertMode := True;

end;

Также для этого свойства я создаю процедуру SetInsertMode, которая с помощью TPanel с именем Panel1 извещает пользователя о текущем режиме работы:

procedure TForm1.SetInsertMode(value: boolean);

begin

 FinsertMode := value;

 if FinsertMode then Panel1.Caption := 'ВСТАВКА'

 else Panel1.Caption := 'ПЕРЕЗАПИСЬ';

end;

Затем я добавляю три обработчика событий (OnKeyDown, OnKeyPress, OnEnter) для каждого моего DBEdit (можно при наличии нескольких компонентов создать один общий обработчик для всех):

procedure TForm1.DBEditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

begin

 if (Key = VK_INSERT) then insertMode := not insertMode;

end;

procedure TForm1.DBEditKeyPress(Sender: TObject; var Key: Char);

begin

 if (not insertMode) and (Sender is TDBEdit) then (Sender as TDBEdit).SelLength := 1

 else (Sender as TDBEdit).SelLength := 0;

end;

procedure TForm1.DBEditEnter(Sender: TObject);

begin

 insertMode := True;

end;

Банзай! Похоже это работает, хотя я и не имел достаточного времени протестировать это. Естественно, вы можете изменить это по просьбе вашего заказчика (например, я всегда сбрасывал режим во вставку при перемещении к другому компоненту DBEedit). Все вышесказанное должно также работать без проблем и с компонентами Edit.

– Denis Sarrazin 

Delphi 1 

Пробую так:

myDbEdit.Text := '';

или адрес TField, если вы хотите так:

TableNameMyField.Value := '';

Ответ:

Table1.Edit;

Table1.FieldByName(DBEdit1.FieldName).Clear;

Delphi 2 

Тема: TDBGrid и множественный выбор записей (Multi-Selecting Records)

При включении флажка [dgMultiSelect] в свойстве-наборе Options компонента DBGrid, вы добавляете к табличной сетке возможность множественного выбора записей.

Выбранные вами записи представлены в виде закладок и храняться в свойстве SelectedRows.

Свойство SelectedRows является объектом, имеющим тип TBookmarkList. Его свойства и методы описаны ниже.

// property SelectedRows: TBookmarkList read FBookmarks;

//   TBookmarkList = class

//   public

 {* Метод Clear освобождает все выбранные в DBGrid записи *}

 // procedure Clear;

 {* Метод Delete удаляет все выбранные строки из набора данных *}

 // procedure Delete;

 {* Метод Find определяет наличие закладки в выбранном списке. *}

 // function  Find(const Item: TBookmarkStr;

 //      var Index: Integer): Boolean;

 {* Метод IndexOf возвращает индекс закладки, расположенной в свойстве Items. *}

 // function IndexOf(const Item: TBookmarkStr): Integer;

 {* Метод Refresh возвращает логическую величину, уведомляющую о том, что в то время, пока в табличной сетке была выбрана запись, были добавлены (удалены) какие-то данные. Метод Refresh может быть использован для обновления списка выбранных записей для уменьшения возможности получения удаленной записи. *}

 // function Refresh: Boolean;  True = orphans found

 {* Свойство Count возвращает количество выбранных в настоящий момент элементов в DBGrid *}

 // property Count: Integer read GetCount;

 {* Свойство CurrentRowSelected содержит логическую величину, зависящую от того, выбрана текущая строка или нет. *}

 // property CurrentRowSelected: Boolean

 //      read GetCurrentRowSelected

 //      write SetCurrentRowSelected;

 {* Свойство Items – TStringList TBookmarkStr *}

 // property Items[Index: Integer]: TBookmarkStr

 //      read GetItem; default;

//  end;

unit Unit1;

interface

uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Grids, DBGrids, DB, DBTables;

type TForm1 = class(TForm)

 Table1: TTable;

 DBGrid1: TDBGrid;

 Count: TButton;

 Selected: TButton;

 Clear: TButton;

 Delete: TButton;

 Select: TButton;

 GetBookMark: TButton;

 Find: TButton;

 FreeBookmark: TButton;

 DataSource1: TDataSource;

 procedure CountClick(Sender: TObject);

 procedure SelectedClick(Sender: TObject);

 procedure ClearClick(Sender: TObject);

 procedure DeleteClick(Sender: TObject);

 procedure SelectClick(Sender: TObject);

 procedure GetBookMarkClick(Sender: TObject);

 procedure FindClick(Sender: TObject);

 procedure FreeBookmarkClick(Sender: TObject);

private

 { Private declarations }

public

 { Public declarations }

end;

var

 Form1: TForm1;

 Bookmark1: TBookmark;

 z: Integer;

implementation

{$R *.DFM}

//Пример использования свойства Count

procedure TForm1.CountClick(Sender: TObject);

begin

 if DBgrid1.SelectedRows.Count > 0 then begin

  showmessage(inttostr(DBgrid1.SelectedRows.Count));

 end;

end;

//Пример использования свойства CurrentRowSelected

procedure TForm1.SelectedClick(Sender: TObject);

begin

 if DBgrid1.SelectedRows.CurrentRowSelected then showmessage('Выбрана');

end;

//Пример использования метода Clear

procedure TForm1.ClearClick(Sender: TObject);

begin

 dbgrid1.SelectedRows.Clear;

end;

//Пример использования метода Delete

procedure TForm1.DeleteClick(Sender: TObject);

begin

 DBgrid1.SelectedRows.Delete;

end;

{*Данные пример проходит в цикле все выбранныезаписи табличной сетки и отображает второеполе набора данных.

Метод DisableControls используется в случае,когда необходимо запретить обновление DBGridпри изменении набора данных. Последняя позициянабора данных сохраняется как TBookmark.

Метод IndexOf вызывается при необходимостипроверить существование закладки.Решение использовать метод IndexOf, а неRefresh, должно приниматься исходя изспецифики приложения.*}

procedure TForm1.SelectClick(Sender: TObject);

var

 x: word;

 TempBookmark: TBookMark;

begin

 DBGrid1.Datasource.Dataset.DisableControls;

 with DBgrid1.SelectedRows do if Count > 0 then begin

  TempBookmark:= DBGrid1.Datasource.Dataset.GetBookmark;

  for x:= 0 to Count - 1 do begin

   if IndexOf(Items[x]) > -1 then begin

    DBGrid1.Datasource.Dataset.Bookmark:= Items[x];

    showmessage(DBGrid1.Datasource.Dataset.Fields[1].AsString);

   end;

  end;

 end;

 DBGrid1.Datasource.Dataset.GotoBookmark(TempBookmark);

 DBGrid1.Datasource.Dataset.FreeBookmark(TempBookmark);

 DBGrid1.Datasource.Dataset.EnableControls;

end;

{*Данный пример позволит вам установить закладку изатем найти ее в списке выбранных записей компонента DBGrid.*}

//Устанавливаем закдадку

procedure TForm1.GetBookMarkClick(Sender: TObject);

begin

 Bookmark1:= DBGrid1.Datasource.Dataset.GetBookmark;

end;

//Освобождаем закладку

procedure TForm1.FreeBookmarkClick(Sender: TObject);

begin

 if assigned(Bookmark1) then begin

  DBGrid1.Datasource.Dataset.FreeBookmark(Bookmark1);

  Bookmark1:= nil;

 end;

end;

//Испольуем метод Find для установления позиции

//записи-закладки в списке выбранных записей компонента DBGrid

procedure TForm1.FindClick(Sender: TObject);

begin

 if assigned(Bookmark1) then begin

  if DBGrid1.SelectedRows.Find(TBookMarkStr(Bookmark1),z) then showmessage(inttostr(z));

 end;

end;

end.

Delphi 1

Это небольшое исправление к исходному коду VCL, позволяющее поддерживать перемещение по таблице с помощью изменения позиции движка вертикальной полосы прокрутки.

(Примечание: это работает только с таблицами Paradox и BDE. Для использования этого кода с другими таблицами/движками вам необходимо заменить DBIGetSeqNo на функцию, надежно возвращающую текущую позицию записи вне зависимости от того, использует ли таблица индекс или нет.)

В DBGRID.PAS измените две следующих процедуры:

procedure TCustomDBGrid.UpdateScrollBar;

var

 Pos: Integer;

 mPos, mMax: longint;

begin

 if FDatalink.Active and HandleAllocated then

  with FDatalink.DataSet do begin

  UpdateCursorPos;

  if (DBIGetSeqNo(Handle,mPos) = DBIERR_NONE) then begin

  mMax := RecordCount;

   while mMax > 1000 do begin

    mMax := mMax div 10;

    mPos := mPos div 10;

   end;

   SetScrollRange(Self.Handle, SB_VERT, 1, mMax, False);

  end else begin

   if BOF then mPos := 0

   else if EOF then mPos := 4

   else mPos := 2;

   SetScrollRange(Self.Handle, SB_VERT, 0, 4, False);

  end; (**)

  if GetScrollPos(Self.Handle, SB_VERT) <> mPos then

   SetScrollPos(Self.Handle, SB_VERT, mPos, True);

 end;

end;

procedure TCustomDBGrid.WMVScroll(var Message: TWMVScroll);

var

 mMin, mMax: integer;

 RecCount, RecNo, NewRecNo: longint;

begin

 if not AcquireFocus then Exit;

 if FDatalink.Active then

  with Message, FDataLink.DataSet, FDatalink do

  case ScrollCode of

  SB_LINEUP: MoveBy(-ActiveRecord - 1);

  SB_LINEDOWN: MoveBy(RecordCount - ActiveRecord);

  SB_PAGEUP: MoveBy(-VisibleRowCount);

  SB_PAGEDOWN: MoveBy(VisibleRowCount);

  SB_THUMBPOSITION:

   if (DBIGetSeqNo(Handle,RecNo) = DBIERR_NONE) then begin

    GetScrollRange(self.Handle, SB_VERT, mMin, mMax);

    NewRecNo := Pos*(FDataLink.DataSet.RecordCount div mMax);

    MoveBy(NewRecNo-RecNo);

   end else case Pos of

   0: First;

   1: MoveBy(-VisibleRowCount);

   2: Exit;

   3: MoveBy(VisibleRowCount);

   4: Last;

   end;

  SB_BOTTOM: Last;

  SB_TOP: First;

 end;

end;

Имейте в виду, что из-за небольшой ошибки в VCL (MoveBy использует integer-параметр вместо longint), могут быть проблемы с большими таблицами (RecordCount>MaxInt). Объяснение этому факту я нашел в журнале Delphi Magazine. Для больших таблиц вы должны заменить вызовы MoveBy на DBISetToSeqNo или DBIGetRelativeRecord. Не забудьте после данного вызова вызвать Resnyc([]) или Refresh!

P.S. Пока вы ковыряетесь в DBGRIDS.PAS: найдите и замените TitleColor на FixedColor в TCustomDBGrid.Create и в TCustomDBGrid.DrawCell. Значение свойства FixedColor влияет на показ заголовков колонок, и они будут выводится как и ожидалось.

– Reinhard Kalinke 

Delphi 2 

1. Как создать lookup-поле в TDBGrid для Delphi 2.0

2. Разместите на форме 2 компонента TTable, 1 компонент TDataSource и 1 – TDBGrid.

 • Подключите Table1 – к DataSource1 – к DBGrid1

 • DataSource1.DataSet = Table1

 • DBGrid1.DataSource = DataSource1

3. Установка Table1

 • Table1.Database = DBDemos

 • Table1.TableName = Customer

 • Table1.Active = True

4. Установка Table2

 • Table2.Database = DBDemos

 • Table2.TableName = Orders

 • Table2.Active = True

5. Добавьте все поля для Table1, используя Fields Editor (редактор полей):

 • Дважды щелкните на Table1

 • Нажмите правую кнопку мыши в редакторе полей

 • Выберите пункт Add New Fields. Добавьте их все.

6. Добавьте новое поле для Table1.

 • Нажмите правую кнопку мыши в редакторе полей и выберите пункт «New Field».

7. Определите следующие параметры для вновь добавленного поля:

 • Name: Bob

 • Type: String

 • Size: 30

 • Select Lookup

 • Key Fields: CustNo    –  Поле в Table1 для хранения значения

 • DataSet: Table2       –  Здесь устанавливается табличный lookup

 • LookUpKeys: CustNo  –  Данный ключ копируется в KeyField

 • Result Field: OrderNo –  Значение для показа пользователю в выпадающем списке

8. Запустите приложение

Nomadic советует:

Это маленькая вставка в Ваш наследник от TCustomDBGrid, которая решает данную задачу.

// DBGRIDEX.PAS

// ----------------------------------------------------------------------------

destructor TDbGridEx.Destroy;

begin

 _HideColumnsValues.Free;_HideColumns.Free;

 inherited Destroy;

end;

// ----------------------------------------------------------------------------

constructor TDbGridEx.Create(Component : TComponent);

begin

 inherited Create(Component);

 FFreezeCols   := ?;

 _HideColumnsValues := TList.Create;

 _HideColumns       := TList.Create;

end;

// ----------------------------------------------------------------------------

procedure TDbGridEx.KeyDown(var Key: Word; Shift: TShiftState);

begin

 if (Key = VK_LEFT) then ColBeforeEnter(-1);

 if (Key = VK_RIGHT) then ColBeforeEnter(1);

 inherited;

end;

// ----------------------------------------------------------------------------

procedure TDbGridEx.SetFreezeColor(AColor : TColor);

begin

 InvalidateRow(0);

end;

// ----------------------------------------------------------------------------

procedure TDbGridEx.SetFreezeCols(AFreezeCols : Integer);

begin

 FFreezeCols := AFreezeCols;

 InvalidateRow(0);

end;

// ----------------------------------------------------------------------------

procedure TDbGridEx.ColEnter;

begin

 ColBeforeEnter(0);

 if Assigned(OnColEnter) then OnColEnter(Self);

end;

// ----------------------------------------------------------------------------

procedure TDbGridEx.ColBeforeEnter(ADelta : Integer);

var nIndex : Integer;

 function ReadWidth : Integer;

 var i : Integer;

 begin

  i := _HideColumns.IndexOf(Columns[nIndex]);

  if i = -1 then result := 120

  else result := Integer(_HideColumnsValues[i]);

 end;

 procedure SaveWidth;

 var i : Integer;

 begin

  i := _HideColumns.IndexOf(Columns[nIndex]);

  if i <> - 1 then begin

   _HideColumnsValues[i] := Pointer(Columns[nIndex].Width);

  end else begin

   _HideColumns.Add(Columns[nIndex]);

   _HideColumnsValues.Add(Pointer(Columns[nIndex].Width));

  end;

 end;

begin

 for nIndex := 0 to Columns.Count - 1 do begin

  if (Columns[nIndex].Width = 0)  then begin

   if (nIndex + 1 <= FreezeCols) or (nIndex >= SelectedIndex + ADelta) then

    Columns[nIndex].Width := ReadWidth;

  end else begin

   SaveWidth;

   if (nIndex + 1 > FreezeCols) and (nIndex < SelectedIndex + ADelta) and

    (nIndex + 1 < Columns.Count) and (FreezeCols > 0) then

    Columns[nIndex].Width := 0;

  end;

 end;

end;

Nomadic советует:

Hапример, так:

DefaultDrawing:=False;

….

procedure TfrmCard.GridDrawColumnCell(Sender: TObject; constRect: TRect; DataCol: Integer; Column: TColumn;State: TGridDrawState);

var

 Index : Integer;

 Marked, Selected: Boolean;

begin

 Marked := False;

 if (dgMultiSelect in Grid.Options) and THackDBGrid(Grid).Datalink.Active then

 Marked:=Grid.SelectedRows.Find(THackDBGrid(Grid).Datalink.Datasource.Dataset.Bookmark, Index);

 Selected := THackDBGrid(Grid).Datalink.Active and (Grid.Row-1 = THackDBGrid(Grid).Datalink.ActiveRecord);

 if Marked then begin

  Grid.Canvas.Brush.Color:=$DFEFDF;

  Grid.Canvas.Font.Color :=clBlack;

 end;

 if Selected then begin

  Grid.Canvas.Brush.Color:=$FFFBF0;

  Grid.Canvas.Font.Color :=clBlack;

  if Marked then Grid.Canvas.Brush.Color:=$EFE3DF; { $8F8A30 }

 end;

 Grid.DefaultDrawColumnCell(Rect, DataCol, Column, State);

end;

где

THackDBGrid = class(TDBGrid)

 property DataLink;

 property UpdateLock;

end;

Обратите внимание на обьявление класса THackDBGrid. Таким образом можно получить доступ к приватным полям, свойствам и методам класса, что, к сожалению, приходится делать, если авторы исходного класса оказались не предусмотрительны. 

Delphi 1 

Попробуйте следующий код в обработчике события TDBGrid OnDrawDataCell:

Procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect; Field: TField; State: TGridDrawState);

begin

 If gdFocused in State then with (Sender as TDBGrid).Canvas do begin

  Brush.Color := clRed;

  FillRect(Rect);

  TextOut(Rect.Left, Rect.Top, Field.AsString);

 end;

end;

Установите рисование по умолчинию (Default drawing) в True. Только после этого можно нарисовать выделенную ячейку. Если вы установили DefaultDrawing в False, вы должны сами рисовать все ячейки, используя свойство Canvas. 

Nomadic отвечает:

ConstraintBroker позволяет Вам включать проверки на ограничения в данные.

Это означает, что когда Вы запрашиваете данные, Вы получаете вместе с ними и правила, которым они дорлжны удовлетворять. Эти правила автоматически без дополнительного кода входят в силу.

Поскольку это происходит без единой строчки кода, то Вам не требуется переписывать или обновлять приложение каждый раз при изменении правил.

Фактически это простое решение задачи обновления клиентского приложения без выхода из него.

Каждое приложение, использующее ConstraintBroker, автоматически получает это качество…

Delphi 1

{

Код улучшенного TDBGrid, имеющего свойства Col, Row и Canvas и метод CellRect. Это чрезвычайно полезно в случае, если вы, к примеру, хотите получить выпадающий список на месте редактируемой пользователем ячейки.

}

unit VUBComps;

interface

uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,Forms, Dialogs, Grids, DBGrids, DB, Menus;

type TDBGridVUB = class(TDBGrid)

private

  { Private declarations }

protected

 { Protected declarations }

public

 property Canvas;

 function CellRect(ACol, ARow: Longint): TRect;

 property Col;

 property Row;

procedure Register;

implementation

procedure Register;

begin

 RegisterComponents('VUBudget', [TDBGridVUB]);

end;

function TDBGridVUB.CellRect(ACol, ARow: Longint): TRect;

begin

 Result := inherited CellRect(ACol, ARow);

end;

end.

Delphi 3

Данный пример компонента и демонстрационный проект показывают простой путь осуществления операции "drag and drop" (перетащи и брось) между двумя полями различных табличных сеток.

Запустите Delphi 3 (с незначительными изменениями данный код может работать и в Delphi 1-2).

Активизируйте File|New|Unit. Скопируйте приведенный ниже модуль MyDBGrid во вновь созданный модуль. Сделайте File|Save As. Сохраните модуль как MyDBGrid.pas.

Выберите пункт меню Component|Install Component. Переключитесь на страницу Info New Package. Поместите MyDBGrid.pas в поле редактирования "Unit file name" (имя файла модуля). Назовите модуль MyPackage.dpk. Ответьте Yes на вопрос Delphi 3 о необходимости сборки и установки пакета. Нажмите OK на сообщение Delphi 3 о необходимости включения VCL30.DPL. После этого пакет будет собран и установлен. Теперь компонент TMyDBGrid будет отображен в Палитре Компонентов в группе "Samples". Закройте редактор пакетов и сохраните пакет.

Выберите пункт меню File|New Application. Щелкните правой кнопкой мыши на форме (Form1) и выберите View As Text. Скопируйте приведенный ниже исходный код формы GridU1 в Form1. Щелкните правой кнопкой мыши на форме и выберите View As Form. Убедитесь в активности ваших таблиц. Скопируйте расположенный ниже модуль GridU1 в ваш модуль Unit1.

Выберите пункт меню File|Save Project As. Сохраните модуль как GridU1.pas. Сохраните проект как GridProj.dpr.

Теперь запустите проект и наслаждайтесь функцией Drag and Drop между двумя табличными сетками.

unit MyDBGrid;

interface

uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Grids, DBGrids;

type TMyDBGrid = class(TDBGrid)

private

 { Private declarations }

 FOnMouseDown: TMouseEvent;

protected

 { Protected declarations }

 procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;

published

 { Published declarations }

 property Row;

 property OnMouseDown read FOnMouseDown write FOnMouseDown;

end;

procedure Register;

implementation

procedure TMyDBGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

 if Assigned(FOnMouseDown) then FOnMouseDown(Self, Button, Shift, X, Y);

 inherited MouseDown(Button, Shift, X, Y);

end;

procedure Register;

begin

 RegisterComponents('Samples', [TMyDBGrid]);

end;

end.

unit GridU1;

interface

uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Db, DBTables, Grids, DBGrids, MyDBGrid, StdCtrls;

type TForm1 = class(TForm)

 MyDBGrid1: TMyDBGrid;

 Table1: TTable;

 DataSource1: TDataSource;

 Table2: TTable;

 DataSource2: TDataSource;

 MyDBGrid2: TMyDBGrid;

 procedure MyDBGrid1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

 procedure MyDBGrid1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);

 procedure MyDBGrid1DragDrop(Sender, Source: TObject; X, Y: Integer);

private

 { Private declarations }

public

 { Public declarations }

end;

var Form1: TForm1;

implementation

{$R *.DFM}

var SGC : TGridCoord;

procedure TForm1.MyDBGrid1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

var DG : TMyDBGrid;

begin

 DG := Sender as TMyDBGrid;

 SGC := DG.MouseCoord(X,Y);

 if (SGC.X > 0) and (SGC.Y > 0) then (Sender as TMyDBGrid).BeginDrag(False);

end;

procedure TForm1.MyDBGrid1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);

var GC : TGridCoord;

begin

 GC := (Sender as TMyDBGrid).MouseCoord(X,Y);

 Accept := Source is TMyDBGrid and (GC.X > 0) and (GC.Y > 0);

end;

procedure TForm1.MyDBGrid1DragDrop(Sender, Source: TObject; X, Y: Integer);

var

 DG     : TMyDBGrid;

 GC     : TGridCoord;

 CurRow : Integer;

begin

 DG := Sender as TMyDBGrid;

 GC := DG.MouseCoord(X,Y);

 with DG.DataSource.DataSet do begin

  with (Source as TMyDBGrid).DataSource.DataSet do

   Caption := 'Вы перетащили «'+Fields[SGC.X-1].AsString+'"';

  DisableControls;

  CurRow := DG.Row;

  MoveBy(GC.Y-CurRow);

  Caption := Caption+' в «'+Fields[GC.X-1].AsString+'"';

  MoveBy(CurRow-GC.Y);

  EnableControls;

 end;

end;

end.

object Form1: TForm1

 Left = 200

 Top = 108

 Width = 544

 Height = 437

 Caption = 'Form1'

 Font.Charset = DEFAULT_CHARSET

 Font.Color = clWindowText

 Font.Height = -11

 Font.Name = 'MS Sans Serif'

 Font.Style = []

 PixelsPerInch = 96

 TextHeight = 13

 object MyDBGrid1: TMyDBGrid

  Left = 8

  Top = 8

  Width = 521

  Height = 193

  DataSource = DataSource1

  Row = 1

  TabOrder = 0

  TitleFont.Charset = DEFAULT_CHARSET

  TitleFont.Color = clWindowTextTitle

  Font.Height = -11

  TitleFont.Name = 'MS Sans Serif'

  TitleFont.Style = []

  OnDragDrop = MyDBGrid1DragDrop

  OnDragOver = MyDBGrid1DragOver

  OnMouseDown = MyDBGrid1MouseDown

 end

 object MyDBGrid2: TMyDBGrid

  Left = 7

  Top = 208

  Width = 521

  Height = 193

  DataSource = DataSource2

  Row = 1

  TabOrder = 1

  TitleFont.Charset = DEFAULT_CHARSET

  TitleFont.Color = clWindowText

  TitleFont.Height = -11

  TitleFont.Name = 'MS Sans Serif'

  TitleFont.Style = []

  OnDragDrop = MyDBGrid1DragDrop

  OnDragOver = MyDBGrid1DragOver

  OnMouseDown = MyDBGrid1MouseDown

 end

 object Table1: TTableActive = True

  DatabaseName = 'DBDEMOS'

  TableName = 'ORDERS'

  Left = 104

  Top = 48

 end

 object DataSource1: TDataSource

  DataSet = Table1

  Left = 136

  Top = 48

 end

 object Table2: TTable

  Active = True

  DatabaseName = 'DBDEMOS'

  TableName = 'CUSTOMER'

  Left = 104

  Top = 240

 end

 object DataSource2: TDataSource

  DataSet = Table2

  Left = 136

  Top = 240

 end

end

Nomadic советует:

Кyсочек кода, чтобы повесить на clickable столбец RxGrid, показывающий RxQuery с определенным макросом %Order. Работать не бyдет (без модyлей), но в качестве идеи может быть полезен.

unit vgRXutil;

interface

uses SysUtils, Classes, DB, DBTables, rxLookup, RxQuery;

{ TrxDBLookup }

procedure RefreshRXLookup(Lookup: TrxLookupControl);

procedure RefreshRXLookupLookupSource(Lookup: TrxLookupControl);

function RxLookupValueInteger(Lookup: TrxLookupControl): Integer;

{ TRxQuery }

{ Applicatable to SQL's without SELECT * syntax }

{ Inserts FieldName into first position in '%Order' macro and refreshes query }

procedure HandleOrderMacro(Query: TRxQuery; Field: TField);

{ Sets '%Order' macro, if defined, and refreshes query }

procedure InsertOrderBy(Query: TRxQuery; NewOrder: String);

{ Converts list of order fields if defined and refreshes query }

procedure UpdateOrderFields(Query: TQuery; OrderFields: TStrings);

implementation

uses vgUtils, vgDBUtl, vgBDEUtl;

{ TrxDBLookup refresh }

type TRXLookupControlHack = class(TrxLookupControl)

 property DataSource;

 property LookupSource;

 property Value;

 property EmptyValue;

end;

procedure RefreshRXLookup(Lookup: TrxLookupControl);

var SaveField: String;

begin

 with TRXLookupControlHack(Lookup) do begin

  SaveField := DataField;

  DataField := '';

  DataField := SaveField;

 end;

end;

procedure RefreshRXLookupLookupSource(Lookup: TrxLookupControl);

var SaveField: String;

begin

 with TRXLookupControlHack(Lookup) do begin

  SaveField := LookupDisplay;

  LookupDisplay := '';

  LookupDisplay := SaveField;

 end;

end;

function RxLookupValueInteger(Lookup: TrxLookupControl): Integer;

begin

 with TRXLookupControlHack(Lookup) do try

  if Value <> EmptyValue then Result := StrToInt(Value)

  else Result := 0;

 except

  Result := 0;

 end;

end;

procedure InsertOrderBy(Query: TRxQuery; NewOrder: String);

var

 Param: TParam;

 OldActive: Boolean;

 OldOrder: String;

 Bmk: TPKBookMark;

begin

 Param := FindParam(Query.Macros, 'Order');

 if not Assigned(Param) then Exit;

 OldOrder := Param.AsString;

 if OldOrder <> NewOrder then begin

  OldActive := Query.Active;

  if OldActive then Bmk := GetPKBookmark(Query, '');

  try

   Query.Close;

   Param.AsString := NewOrder;

   try

    Query.Prepare;

   except

    Param.AsString := OldOrder;

   end;

   Query.Active := OldActive;

   if OldActive then SetToPKBookMark(Query, Bmk);

  finally

   if OldActive then FreePKBookmark(Bmk);

  end;

 end;

end;

procedure UpdateOrderFields(Query: TQuery; OrderFields: TStrings);

var NewOrderFields: TStrings;

 procedure AddOrderField(S: String);

 begin

  if NewOrderFields.IndexOf(S) < 0 then NewOrderFields.Add(S);

 end;

var

 I, J: Integer;

 Field: TField;

 FieldDef: TFieldDef;

 S: String;

begin

 NewOrderFields := TStringList.Create;

 with Query do try

  for I := 0 to OrderFields.Count - 1 do begin

   S := OrderFields[I];

   Field := FindField(S);

   if Assigned(Field) and (Field.FieldNo > 0) then AddOrderField(IntToStr(Field.FieldNo))

   else try

    J := StrToInt(S);

    if J < FieldDefs.Count then AddOrderField(IntToStr(J));

   except

   end;

  end;

  OrderFields.Assign(NewOrderFields);

 finally

  NewOrderFields.Free;

 end;

end;

procedure HandleOrderMacro(Query: TRxQuery; Field: TField);

var

 Param: TParam;

 Tmp, OldOrder, NewOrder: String;

 I: Integer;

 C: Char;

 TmpField: TField;

 OrderFields: TStrings;

begin

 Param := FindParam(Query.Macros, 'Order');

 if not Assigned(Param) or Field.Calculated or Field.Lookup then Exit;

 OldOrder := Param.AsString;

 I := 0;

 Tmp := '';

 OrderFields := TStringList.Create;

 try

  OrderFields.Ad(Field.FieldName);

  while I < Length(OldOrder) do begin

   Inc(I);

   C := OldOrder[I];

   if C in FieldNameChars then Tmp := Tmp + C;

   if (not (C in FieldNameChars) or (I = Length(OldOrder))) and (Tmp <> '') then begin

    TmpField := Field.DataSet.FindField(Tmp);

    if OrderFields.IndexOf(Tmp) < 0 then OrderFields.Add(Tmp);

    Tmp := '';

   end;

  end;

  UpdateOrderFields(Query, OrderFields);

  NewOrder := OrderFields[0];

  for I := 1 to OrderFields.Count – 1 do NewOrder := NewOrder + ', ' + OrderFields[1];

 finally

  OrderFields.Free;

 end;

 InsertOrderBy(Query, NewOrder);

end;

end.

Delphi 1 

1. Расположите на вашей форме 2 TQuerie с двумя соответствующими TDatasource (Query1 будет вашим Мастером, Query2 будет вашей Деталью)

2. Разместите 2 TDBGrid, связанных с Datasource'ами (вероятно, вы уже это сделали)

3. Используйте базу данных, поставляемую с Delphi:

Query1.SQL := 'Select * from customer'

Query2.SQL := 'Select * from Orders whereOrders."CustNo" = :CustNo'

(это можно сделать как во время выполнения приложения, так и во время его разработки)

4. В свойствах Query2 выберите свойство Params и напишите в строке 'CustNo'. 'CustNo' был определен как параметр, поскольку в SQL строке было использовано ':'.

5. ОЧЕНЬ ВАЖНО: установите Query2.Datasource в набор данных, связанный с Query1.

Каждый раз при изменении записи в наборе данных Query1, Query2 будет обновляться. Имя параметра 'CustNo' соответствует имени реального поля в таблице Customer.

P.S.: Для получения дополнительной информации обратитесь к разделу электронной справки 'dynamic SQL' 

Delphi 1 

1. Расположите компонент table на пустой форме и свяжите его с вашего таблицей Client.

2. Добавьте компонент Datasource и свяжите его с компонентом table, описанным выше.

3. Добавьте компонент grid и свяжите его с компонентом datasource, описанным выше.

4. Используя Редактор Полей (Fields Editor), создайте компоненты TField для всех полей таблицы client.

5. Установите свойство Visible всех компонентов TField, кроме Client Name (или другого поля, которое будет отображаться в DBGrid), в False. Grid теперь будет отображать только Client Name.

6. Для отображения полей таблицы Client (которые вы хотите показать, или которые вы хотите сделать доступными для редактирования пользователем), ниже табличной сетки расположите компоненты DBEdit. Они могут использовать тот же набор данных, что и DBGrid.

Теперь пользователь может воспользоваться DBGrid для навигации и ввода/редактирования данных посредством DBEdit'ов. 

Delphi 1 

В режиме разработки дважды щелкните на компоненте TQuery, и выберите все поля, которые вы хотите использовать в DBGrid. Затем в обработчике события DBGrid doubleclick смотрите значение DBGrid.SelectedIndex. Если оно  < 0, выбранных пунктов нет. Также, текущая запись TQuery будет указывать на ту же самую строку, которая выбранна в DBGrid. Таким образом, вы можете использовать что-то типа requiredvalue := Query1Field1.AsString; и т.д., естественно, компоненты TQuery и DBGrid должны быть подключены друг к другу. 

Delphi 1 

Для перехода к следующей записи:

MyDBGrid.SelectedIndex := MyDBGrid.SelectedIndex + 1;

Колонки DBGrid индексируются с 0, поэтому SelectedIndex := 0 даст вам первую колонку. Свойство FieldCount вернет вам количество колонок, так что вы без труда можете пробежаться по всей матрице данных.

Многие программисты хотели бы использовать OnClick у TDBGrid. Но TDBGrid не имеет такого события. В данном документе рассказывается о том, как обеспечить поддержку события OnClick для TDBGrid. Рассказанная здесь технология может пригодиться при добавлении других свойств к различным объектам. Если вы знаете, что сделать это мог предок, то можно заставить сделать это и наследника. Ключевым моментом здесь можно считать добавление csClickEvents к свойству-набору элемента управления ControlStyle. Это позволит элементу управления, приведенному к типу THack, получать и правильно обрабатывать системные сообщение о щелчке мышью. Назначение OnClick какого-либо элемента управления OnClick DBGrid1 позволяет воспользоваться событием OnClick для элемента управления, которое его не поддерживает.

Это "неофициальный" путь. Существует несколько причин того, почему dbgrid не поддерживает этого события. Используйте этот код на свой страх и риск.

unit Udbgclk;

interface

uses Windows, Messages, SysUtils, Classes, Graphics,Controls, Forms, Dialogs, StdCtrls, Grids, DBGrids, DBTables, DB;

type

 thack = class(tcontrol);

 TForm1 = class(TForm)

  DBGrid1: TDBGrid;

  Button1: TButton;

  DataSource1: TDataSource;

  Table1: TTable;

  procedure Button1Click(Sender: TObject);

  procedure FormClick(Sender: TObject);

 private

  { Private declarations }

 public

  { Public declarations }

 end;

var Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);

begin

 THack(dbgrid1).controlstyle :=THack(dbgrid1).controlstyle + [csClickEvents];

 THack(dbgrid1).OnClick := Form1.OnClick;

end;

procedure TForm1.FormClick(Sender: TObject);

begin

 messagebeep(0);

 application.processmessages;

end;

end.

Delphi 1 

Для показа в табличной сетке дробных чисел, выберите таблицу, с которой связана ваша сетка (через datasource, источник данных).

Активизируйте редактор полей (правой кнопкой мыши) и выберите поле, в котором вы хотите видеть дробное число.

Измените значение свойств 'DisplayFormat' и 'EditFormat', чтобы дробь имела формат такой, какой вы хотите (к примеру, шаблон '0.00', позволяющий сетке показывать поле с двумя цифрами после запятой).

Дважды щелкните на компоненте table, расположенном на форме. Нажмите на кнопку 'Add'. Будут показаны все поля вашей таблицы. Выберите их в списке «Available field» (доступные поля) и щелкните на кнопке OK. Теперь при щелчке на имени поля, в Инспекторе Объектов будут показаны все свойства, относящиеся к данному полю, здесь можно изменить текст заголовка, выводимый формат «DisplayFormat» (это как раз то, что вам нужно, измените его на ####0.0) и пр. 

Delphi 3 

Вы можете «видеть» что набирается в TDBGrid, «смотря» на контрол сетки TInPlaceEdit. Вы должны убедиться только в том, что к моменту использования TInPlaceEdit, контрол уже создан. Следующая функция покажет данные, редактируемые в колонках сетки:

procedure TForm1.DBGrid1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);

var B: byte;

begin

 for B := 0 to DBGrid1.ControlCount - 1 do

  if DBGrid1.Controls[B] is TInPlaceEdit then begin

   with DBGrid1.Controls[B] as TInPlaceEdit do begin

    Label1.Caption := 'Текст = ' + Text;

   end;

  end;

end;

Nomadic советует:

Уже реализовано в виде вот этого компонента — © Andre

unit bdbgrid;

interface

uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Grids, DBGrids, Math;

type

 TOnDrawTitleEvent = procedure(ACol : integer; ARect : TRect; var TitleText : string) of object;

 TBitDBGrid = class(TDBGrid)

 private

  FBitmapBrowse : TBitmap;

  FBitmapEdit : TBitmap;

  FBitmapInsert : TBitmap;

  FBitmapFill : TBitmap;

  FRealTitleFont : TFont;

  FOnDrawTitle : TOnDrawTitleEvent;

  FResizeFlag : boolean;

  { Private declarations }

  procedure SetRealTitleFont(Value : TFont);

  procedure UpdateTitlesHeight;

 protected

  procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;

  procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;

  procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;

  { Protected declarations }

 public

  constructor Create(AOwner : TComponent);override;

  destructor Destroy; override;

  { Public declarations }

 published

  property OnDrawTitle : TOnDrawTitleEvent read FOnDrawTitle write FOnDrawTitle;

  property RealTitleFont : TFont read FRealTitleFont write SetRealTitleFont;

  { Published declarations }

 end;

procedure Register;

implementation

var DrawBitmap : TBitmap;

function Max(X, Y: Integer): Integer;

begin

 Result := Y;

 if X > Y then Result := X;

end;

procedure WriteText(ACanvas: TCanvas; ARect: TRect; DX, DY: Integer; const Text: string; Alignment: TAlignment);

// © Borland function :)

const AlignFlags : array [TAlignment] of Integer =

 ( DT_LEFT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,

 DT_RIGHT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,

 DT_CENTER or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX );

var

 B, R: TRect;

 I, Left: Integer;

begin

 with DrawBitmap, ARect do { Use offscreen bitmap to eliminate flicker and }

 begin { brush origin tics in painting / scrolling. }

  Width := Max(Width, Right - Left);

  Height := Max(Height, Bottom - Top);

  R := Rect(DX, DY, Right - Left - 1, Bottom - Top - 1);

  B := Rect(0, 0, Right - Left, Bottom - Top);

 end;

 with DrawBitmap.Canvas do begin

  DrawBitmap.Canvas.CopyRect(B, ACanvas, ARect);

  Font := ACanvas.Font;

  Font.Color := ACanvas.Font.Color;

  Brush := ACanvas.Brush;

  SetBkMode(Handle, TRANSPARENT);

  DrawText(Handle, PChar(Text), Length(Text), R, AlignFlags[Alignment]);

 end;

 ACanvas.CopyRect(ARect, DrawBitmap.Canvas, B);

end;

constructor TBitDBGrid.Create(AOwner : TComponent);

begin

 inherited Create(Aowner);

 FRealTitleFont := TFont.Create;

 FResizeFlag := false;

end;

destructor TBitDBGrid.Destroy;

begin

 FRealTitleFont.Free;

 inherited Destroy;

end;

procedure TBitDBGrid.UpdateTitlesHeight;

var

 Loop : integer;

 MaxTextHeight : integer;

 RRect : TRect;

begin

 MaxTextHeight := 0;

 for loop := 0 to Columns.Count - 1 do begin

  RRect := CellRect(0, 0);

  RRect.Right := Columns[Loop].Width;

  RRect.Left := 0;

  Canvas.Font := RealTitleFont;

  MaxTextHeight := Max(MaxTextHeight, DrawText(Canvas.Handle, PChar(Columns[Loop].Title.Caption), Length(Columns[Loop].Title.Caption), RRect, DT_CALCRECT + DT_WORDBREAK));

 end;

 if TitleFont.Height <> - MaxTextHeight then TitleFont.Height := - MaxTextHeight;

end;

procedure TBitDBGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

 if MouseCoord(X, Y).Y = 0 then FResizeFlag := true;

 inherited MouseDown(Button, Shift, X, Y);

end;

procedure TBitDBGrid.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

 inherited MouseUp(Button, Shift, X, Y);

 if FResizeFlag then begin

  FResizeFlag := false;

  UpdateTitlesHeight;

 end;

end;

procedure TBitDBGrid.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);

var

 Indicator : TBitmap;

 TitleText : string;

 Al : TAlignment;

begin

 if not ((gdFixed in AState) and ((ARow = 0) and (dgTitles in Options) and (ACol <> 0))) then

  inherited DrawCell(ACol, ARow, ARect, AState)

 else begin

  if DefaultDrawing then begin

   DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_BOTTOMLEFT);

   DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_TOPRIGHT);

   InflateRect(ARect, -1, -1);

   Canvas.Brush.Color := FixedColor;

   Canvas.FillRect(ARect);

  end;

  TitleText := Columns[ACol - 1].Title.Caption;

  if Assigned(OnDrawTitle) then OnDrawTitle(ACol, ARect, TitleText);

  if DefaultDrawing and (TitleText <> '') then begin

   Canvas.Brush.Style := bsClear;

   Canvas.Font := RealTitleFont;

   if ACol > 0 then Al := Columns[ACol - 1].Title.Alignment

   else Al := Columns[0].Title.DefaultAlignment;

   WriteText(Canvas, ARect, 2, 2, TitleText, Al);

  end;

 end;

end;

procedure TBitDBGrid.SetRealTitleFont(Value : TFont);

begin

 FRealTitleFont.Assign(Value);

 Repaint;

end;

procedure Register;

begin

 RegisterComponents('Andre VCL', [TBitDBGrid]);

end;

initialization

 DrawBitmap := TBitmap.Create;

finalization

 DrawBitmap.Free;

end.

Delphi 1 

Насколько я знаю, единственное легкое решение заключается в использовании вычисляемых полей.

Для того, чтобы поместить данные из нескольких таблиц в один DBGrid, нужно воспользоваться объектом TQuery. На заметку: используйте TQuery в режиме только для чтения, если вы не можете обеспечить гарантию выполнения некоторых из его руководящих принципов, один из которых – данные могут быть получены только от одной таблицы.

Nomadic советует:

Ну примерно так (лишнее мало-мало порезал, больно много его, но идея видна :) на сервере — тaблицa Advertis.DB, первичный ключ ID — autoincrement. На локальном диске — тaблицa Founds.DB, с полем Advertis: integer, по которому есть индекс, и tblFounds.IndexFieldNames = 'Advertis'.

На гриде:

=== cut ===

procedure TMainForm.dbgWorkDblClick(Sender: TObject);

begin

 TriggerRowSelection;

end;

procedure TMainForm.TriggerRowSelection;

begin

 if dmFile.AdvertisCount <> 0 then begin

  with dmFile do if not tblFounds.FindKey([tblAdvertisID.Value]) then begin

   tblFounds.AppendRecord([tblAdvertisID.Value]);

  end else begin

   tblFounds.Delete;

  end;

  dbgWork.Refresh;

 end;

end;

procedure TMainForm.dbgWorkDrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);

begin

 if DataCol = 0 then with dmFile, dbgWork.Canvas do begin

  FillRect(Rect); {clear the cell}

  if tblFounds.FindKey([tblAdvertisID.Value]) then begin

   TextOut(Rect.Left, Rect.Top, '?');

  end else begin

   TextOut(Rect.Left, Rect.Top, 'o');

  end;

 end;

end;

=== cut ===

Оказывается, я переопределял рисование гридa, а не вычислял поле. Не помню точно, но кажется, чтобы не перечитывать таблицу на каждый даблклик, а только перерисовать грид.

А колонка для галки в гриде определялась так:

=== cut ===

with dmFile, dbgWork.Columns do begin

 BeginUpdate;

 Clear;

 {check mark}

 nc := Add;

 nc.Width := 14;

 nc.Font.Name := 'Wingdings';

 nc.Font.Size := 11;

 nc.Alignment := taRightJustify;

 nc.Title.Caption := 'y';

 nc.Title.Font.Name := 'Wingdings';

 nc.Title.Font.Size := 10;

 nc.Title.Alignment := taCenter;

 [skip определения остaльных колонок]

 EndUpdate;

end;

=== cut ===

Вроде всё.

Ну, как напечатать/обработать только помеченное, сам разберёшься. У меня там накручено чего-то с фильтрами, думаю, можно проще.

Что касается других способов – можно вместо временной тaблицы попользовать список, массив или in-memory table. 

Nomadic советует:

А я делаю так.

На DataSource, к которому прицеплен Grid, вешаю обработчик на событие OnStateChange.

Ниже текст типичного обработчика –

if DBGrid1.DataSource.DataSet.State in [dsEdit, dsInsert] then

DBGrid1.Options := DBGrid1.Options + goRowSelect

else DBGrid1.Options := DBGrid1.Options – goRowSelect;

Дело в том, что если у Grid'а стоит опция goRowSelect, то из Grid'а невозможно добавить запись. Ну а когда програмно вызываешь редактирование или вставку, то курсор принимает обычный вид и все Ok.

Лучше использовать конструкцию «State in dsEditModes». 

Delphi 1 

А вы постите запись, прежде чем закрыть форму? При закрытии, форма самостоятельно данных не постит. Вы должны постить изменения или с помощью компонента dbnavigator, или c помощью кода, который при закрытии формы постит данные в основную таблицу.

На странице 95 Database Application Developers Guide (руководство разработчиков приложений баз данных), поставляемое с Delphi, приведен демонстрационный проект с двумя формами, демонстрирующий хорошую технику при использовании ttable на мастер-форме в качестве набора данных для детали.

Одним из решений вашей проблемы может служить связывание компонента DataSource на Form2 с набором данных DataSet на Form1. Это может быть достигнуто путем добавления следующей строки в обработчик события OnActivate для Form2:

MyDataSource.DataSet := Form1.MyTable;

Данный метод имеет 3 преимущества:

1. сделанные вами изменения немедленно отображаются, поскольку вы используете одну и ту же логическую таблицу;

2. если вам нужно определить установки для ваших полей таблицы, например, DisplayFormat или EditMask, вам нужно сделать это только один раз в таблице на Form1, вам не нужно это делать на каждой форме, которая использует таблицу;

3. это сохраняет ресурсы и повышает производительность, поскольку ваше приложение при работе с таблицей использует только одну сессию. Тем не менее, в проектном времени вам нужно иметь TTable на вашей Form2 для того, чтобы вы могли выбрать поля для БД-контролов, после чего вы можете удалить TTable. 

Одной строкой 

используйте <имя поля>.index := <желаемый номер поля>

Nomadic отвечает:

Здесь отрывки из исходников VCL —

unit DBGrids;

procedure TCustomDBGrid.UpdateScrollBar;

var

 SIOld, SINew: TScrollInfo;

begin

 [skipped]

 if IsSequenced then begin

  SINew.nMin := 1;

  SINew.nPage := Self.VisibleRowCount;

  SINew.nMax := RecordCount + SINew.nPage -1;

  if State in [dsInactive, dsBrowse, dsEdit] then SINew.nPos := RecNo; // else keep old pos

 end else begin

  SINew.nMin := 0;

  SINew.nPage := 0;

  SINew.nMax := 4;

  if BOF then SINew.nPos := 0

  else if EOF then SINew.nPos := 4

  else SINew.nPos := 2;

 end;

 [skipped]

unit dbtables;

function TBDEDataSet.IsSequenced: Boolean;

begin

 Result := (FRecNoStatus = rnParadox) and (not Filtered);

end;

То есть, к примеру, все будет работать «красиво» на таблицах BDE, если они:

• таблицы Paradox;

• на них не установлен фильтр.

TClientDataSet в режиме single-tier (briefcase) также работает «красиво». 

Delphi 1

Var

 i: Integer;

 fName: string;

 …………

 { Определение изменения месторасположения колонок }

 …………

 with dbgrid1.datasource.dataset as ttable do

  for i := 0 to indexdefs.count – 1 do begin

  fName := DBGrid1.Fields[0].FieldName;

  if copy(indexdefs[i].fields, 1, length(fname)) = fname then IndexName := IndexDefs[i].Name

 end;

В данном документе содержится решение проблемы невозможности получения DBGrid-ом фокуса после щелчка на каком-либо элементе управления родительской формы, в то время, как DBGrid находится на ее дочерней MDI-форме.

Относится ко всем версиям Delphi.

Очевидно, DBGrid имеет некоторые проблемы с управлением фокусом, если он находится на дочерней MDI-форме. Эта проблема решена в приведенном ниже наследнике TDBGrid, в котором обрабатываются мышиные сообщения и выясняется когда фокус должен быть передан сетке. Наследник создан в виде компонента, который легко устанавливается в Палитру Компонентов. Примечание: код адаптирован для всех версий Delphi. Проблемы могут быть в Delphi 2 и 3, если вы забудете заменить устаревшие в этих версиях модули "winprocs" и "wintypes" на "windows."

unit FixedDBGrid;

interface

uses Winprocs,wintypes, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Grids, DBGrids;

type TFixedDBGrid = class(TDBGrid)

private

 { Private declarations }

protected

 { Protected declarations }

public

 { Public declarations }

 procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN;

 procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;

published

 { Published declarations }

end;

procedure Register;

implementation

procedure TFixedDBGrid.WMRButtonDown(var Message: TWMRButtonDown);

begin

 winprocs.SetFocus(handle); {помните, что winprocs относится только к Delphi 1!}

 inherited;

end;

procedure TFixedDBGrid.WMLButtonDown(var Message: TWMLButtonDown);

begin

 winprocs.SetFocus(handle); {помните, что winprocs относится только к Delphi 1!}

 inherited;

end;

procedure tfixeddbgrid.wmlbuttondown(var Message: twmlbuttondown);

begin

 winprocs.SetFocus(handle); {помните, что winprocs относится только к Delphi 1!}

 inherited;

end;

procedure Register;

begin

 RegisterComponents('Samples', [TFixedDBGrid]);

end;

end.

Добавьте в обработчик события вашего TTable «BeforeInsert» следующую строку:

procedure TForm1.Tbable1BeforeInsert(DataSet: TDataset);

begin

 Abort;  ←эту строчку

end;

Осуществляем перехват нажатия клавиши и проверку на конец файла (end-of-file):

procedure TForm8.DBGrid1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

begin

 if (Key = VK_DOWN) then begin

  TTable1.DisableControls;

  TTable1Next;

  if TTable1.EOF then Key := 0

  else TTable1.Prior;

  TTable1.EnableControls;

 end;

end;

Delphi 2 

Если у вас D2, вы можете воспользоваться свойством Lookup. Для этого выберите в контекстном меню объекта table редактор полей (fields editor). Затем для добавления нового поля нажмите <Ctrl>+N. Просто раскройте combobox и выберите lookup-поле. TDBGrid автоматически создаст выпадающий список, в котором пользователь сможет выбрать нужный элемент. 

Delphi 1

TGroothuisGrid = class() {!}

published

 property OnClick;

end;

Это все! OnClick уже объявлен в TControl как защищенное свойство. Все, что вы должны сделать, это опубликовать это свойство в компоненте-наследнике, зарегистрировать его (смотри гл. 8 Руководства по созданию компонентов, Component Writer's Guide) и использовать взамен TDBGrid.

Delphi 1

В TCustomGrid определен метод CellRect, который, к сожалению, защищен. Это означает, что даный метод доступен только для TCustomGrid и его наследников. Но все-таки существует немного мудреное решение вызова данного метода:

type TMyDBGrid = class(TDBGrid)

public

 function CellRect(ACol, ARow: Longint): TRect;

end;

function TMyDBGrid.CellRect(ACol, ARow: Longint): TRect;

begin

 Result := inherited CellRect(ACol, ARow);

end;

Вы можете сделать приведение типа вашего DBGrid к TMyDBGrid (это возможно, поскольку CellRect статический метод) и вызвать CellRect:

Rectangle := TMyDBGrid(SomeDBGrid).CellRect(SomeColumn, SomeRow);

procedure TfmLoadIn.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn;State: TGridDrawState);

const Disp = 2;        //Правильно выравниваем компонент

begin

 inherited;

 if (gdFocused in State) then begin

  if (Column.FieldName = 'TYPEDescription') then begin

   dlTYPEDescription.Left := Rect.Left + DBGrid1.Left + Disp;

   dlTYPEDescription.Top := Rect.Top + DBGrid1.top + Disp;

   dlTYPEDescription.Width := Rect.Right – Rect.Left;

   dlTYPEDescription.Height := Rect.Bottom – Rect.Top;

   dlTYPEDescription.Visible := True;

  end;

 end;

end;

Delphi 1

Установите defaultDrawing в false, и создайте собственный onDrawDataCell, в котором и задавайте нужный вам цвет ячеек. Примерно так:

procedure Tform1.DBgrid1DrawDataCell(Sender: TObject; const Rect: TRect; Field: TField; State: TGridDrawState);

begin

 { выберите цвет для текста (font.color) и фона (brush.color) }

 if (field = table1Status) then begin

  { белый на красном }

  DBgrid1.canvas.font.color := clWhite;

  DBgrid1.canvas.brush.color := clRed;

 end else begin

  { черное на белом }

  DBgrid1.canvas.brush.color := clWhite;

  DBgrid1.canvas.font.color := clBlack;

 end;

 { рисуем ячейку }

 DBgrid1.canvas.textrect(rect, rect.left+2, rect.top+2, field.asString);

end;

procedure TMainForm.CharGridDrawCell(Sender: TObject; Col, Row: Longint; Rect: TRect; State: TGridDrawState);

var TheText: string;

begin

 TheText := CharGrid.Cells[Col, Row];

 with CharGrid.Canvas do begin

  { Определяем цвет фона в зависимости от состояния ячейки: }

  if gdFocused in State then Brush.Color := clYellow {Цвет ячейки с фокусом}

  else if gdSelected in State then Brush.Color := clOlive {Цвет выбранной ячейки}

  else {ячейка не имеет фокуса и не выбрана}

   if IntFromStr(TheText) <> 0 then Brush.Color := clNavy {Цвет фона подсвеченной ячейки}

   else Brush.Color := clWhite; {Цвет фона нормальной ячейки}

  { Определяем цвет текста: }

  if IntFromStr(TheText) <> 0 then Font.Color := clRed {Цвет текста подсвеченной ячейки}

  else Font.Color := clNavy; {Цвет текста нормальной ячейки}

  TextRect(Rect, Rect.Left + 2, Rect.Top + 2, TheText);

 end; {with CharGrid.Canvas}

end;

Delphi 1 

…я все же лелею надежду, что когда-нибудь увижу TMemoField.DataSize, имеющим значение, отличное от нуля. Может быть значение DataSize является размером части Memo, которая сохранилась в .db-файле? Вместо этого я теперь пользуюсь объектом TBlobStream, который вполне хорошо справляется с этой работой. Все это у меня происходит примерно так:

Var

 pBuffer: PChar;

 Blob: TBlobStream;

begin

 {FDataField – это TMemoField}

 Blob := TBlobStream.Create(FDataField, bmRead);

 try

  if Blob.Size > 0 then try

   GetMem(pBuffer, Blob.Size);

   Blob.Read(pBuffer^, Blob.Size);

   { что-то тут делаем }

   FreeMem(pBuffer, Blob.Size);

  except

   ShowMessage('Нехватка памяти' );

  end;

 finally

  Blob.Free

 end;

Используйте событие OnDataChange объекта Datasource, соединенного с DBGrid. Если параметр State в обработчике событие равен dsBrowse, значит вы перешли в новую строку (или только что открыли таблицу).

Почему сетка не поддерживает такое событие? Поскольку сетка может быть не единственным элементом управления, оторбажающим данные из текущей строки и может быть не единственным элементом, позволяющим осуществлять перемещение от строки к строке. С помощью Datasource обработка события осуществляется централизованно.

Я не уверен в том, что проблему можно решить, обрабатывая событие одинарного щелчка, для отслеживания события изменения строк я рекомендую использовать событие TDatasource.OnDataChange, а для колонок — TDBGrid.OnColEnter/Exit.

Лично я пользуюсь следующей рабочей технологией:

1. Для того, чтобы обнаружить изменения текущей строки, воспользуйтесь событием TDataSource OnDataChange. OnDataChange возникает при прокрутке или щелчке на другой строке. Обработчик события может выглядеть приблизительно так:

procedure Form1.DSrc1DataChange(Sender: TObject; Field: TField);

где Field является колонкой, где произошло изменение.

Поля TTable могут использоваться для сравнения текущих выбранных строк полей (ключ) с вашими требованиями. С той же целью может быть использовано и свойство TDBGrid Fields. Для примера:

if tbl1.Fields[0].AsString = 'BlaBlaBla' then …

или

if dbGrid1.Fields[I].IsNull then …

2. Для отслеживания изменения колонки, используйте события TDBGrid OnColExit & OnColEnter. Для определения выбранной к настоящему времени колонки воспользуйтесь свойствами TDBGrid SelectedField и SelectedIndex.

Когда выбирается другая колонка другой строки, вы получаете события OnColExit, OnColEnter и OnDataChange.

3. Можно пойти и «кривым» путем, взявшись за обработку события TDBGrid OnDrawDataCell, которое возникает когда ячейка выбирается, или когда сетка скроллируется. Обработчик события может выглядеть примерно так:

procedure Form1.dbGrid1DrawDataCell(Sender: TObject; Rect: TRect; Field: TField; State: TGridDrawState);

При изменении ячейки вы получаете поток событий, поэтому вам нужно каким-то образом их фильтровать.

4. Если у вас нет проблем в создании «101 изменения» стандартных компонентов – что является проблемой для меня 8-), то попробуйте это. Это легко.

Чтобы иметь доступ к индексу строки или колонки выбранной ячейки, вы должны унаследовать ваш класс от TCustomGrid и опубликать свойства времени выполнения Row и Col (текущие строка и колонка сетки, не таблицы!!):

type TSampleDBGrid = class(TCustomGrid)

public

 property Col;

 property Row;

end;

в соответствующей процедуре или обработчике события осуществите приведение типа:

var G: TSampleDBGrid;

begin

 G := TSampleDBGrid(myDBGrid1);

 if G.Row = I then …

 if G.Col = J then …

Дело в том, что TDBGrid является потомком TCustomGrid, который имеет несколько свойств, содержащих координаты сетки, но это не опубликовано в TDBGrid.

…из чего я могу заключить, что вы должны это сделать программным путем. Подразумеваем, что сетка уже существует, и у вас есть доступ к основной таблице TTable:

grid.colcount := dbGrid.fieldcount;

table.first;

row := 0;

while not table.eof do begin

 grid.rowcount := row + 1;

 for i := 0 to grid.colcount-1 do

  grid.cells[i,row] := dbGrid.fields[i].asString;

 table.next;

 inc(row);

end;

Могут быть ошибки, но это должно помочь.

Посмотрите на следующий код, он может вам помочь. Он берет у элемента управления свойсто 'Name' и помещает его в свойство 'Caption' метки.

unit Unit1;

interface

uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

type TForm1 = class(TForm)

 Label1: TLabel;

 Edit1: TEdit;

 Edit2: TEdit;

 Button1: TButton;

 procedure Button1Click(Sender: TObject);

 procedure Edit1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

 procedure Edit2MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

private

 { Private declarations }

public

 { Public declarations }

end;

var Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);

begin

 close;

end;

procedure TForm1.Edit1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

 Label1.Caption := TEdit(Sender).Name;

end;

procedure TForm1.Edit2MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

 Label1.Caption := TEdit(Sender).Name;

end;

end.

Delphi 1 

Вот основные шаги чтобы сделать это:

1. Создавайте и рисуйте TComboBox (CB) при получении ввода ячейки необходимой колонки табличной сетки

2. Получайте текущее значение поля (если имеется) и помещайте его в CB

3. После всех манипуляций, поместите новое значение обратно в поле

4. Избавляемся от CB 

Delphi 1 

Вы можете редактировать ваш источник данных. Говорят, вы хотите сохранить ваши lookuping-данные из таблицы customer в таблицу sales – 'Cust No'? Вы можете просто проинициализировать поля (задать значение по умолчанию), редактируя таблицу sales «Cust No»

with tbSales do begin

 Edit;

 FieldByName('Cust No').AsInteger := 1;

 Post;

end;

Delphi 1 

Одним из способов вывести выши данные в другом порядке сортировки является использование TQuery и включение в SQL-запрос ключевого слова «order by». После чего вы можете установить этот запрос как DataSource в вашем DBLookupComboBox.

ПРИМЕР:

Если у вас имеется таблица Customer, содержащая «Customer_No» и «Customer_Name», и индексированная по Customer_No, то ваш запрос должен содержать в редакторе списка строк (свойство SQL) для вашего TQuery следующую строку:

select Customer_No, Customer_Name from Customer

 order by Customer_Name

Я думаю что у меня есть то, что вы хотите. Если вы обратитесь к свойству LookUpValue, то вы получите поле, которое .... ищете.

Я надеюсь что помог вам.

unit clookup;

interface

uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, DB, DBLookup;

type

 TDBJustLookupCombo = class(TDBLookupCombo)

 private

  { Private declarations }

 protected

  { Protected declarations }

  function GetLValue: TField;

 public

  { Public declarations }

  property LookUpValue: TField read GetLValue;

 published

  { Published declarations }

 end;

 TDBJustLookupList = class(TDBLookupList)

 private

  { Private declarations }

 protected

  { Protected declarations }

  function GetLValue: TField;

 public

  { Public declarations }

  property LookUpValue: TField read GetLValue;

 published

  { Published declarations }

 end;

procedure Register;

implementation

procedure Register;

begin

 RegisterComponents('Data Controls', [TDBJustLookupList, TDBJustLookupCombo]);

end;

function TDBJustLookupCombo.GetLValue: TField;

begin

 Result := LookupSource.DataSet.FieldByName(LookUpField);

end;

function TDBJustLookupList.GetLValue: TField;

begin

 Result := LookupSource.DataSet.FieldByName(LookUpField);

end;

end.

Delphi 1 

Попробуй:

DBMemo6.Lines:=DBMemo5.Lines.Assign;

Delphi 1

Попробуйте так:

"Подключите" следующую процедуру к событию OnFind для FindDialog. Единственная проблема заключается в том, что в DBMemo я не могу получить выделенный текст, тем не менее в стандартном Memo такой проблемы нет.

procedure TMainForm.FindDialog1Find(Sender: TObject);

var

 Buff, P, FT : PChar;

 BuffLen     : Word;

begin

 With Sender as TFindDialog do begin

  GetMem(FT, Length(FindText) + 1);

  StrPCopy(FT, FindText);

  BuffLen:= DBMemo1.GetTextLen + 1;

  GetMem(Buff,BuffLen);

  DBMemo1.GetTextBuf(Buff,BuffLen);

  P:= Buff + DBMemo1.SelStart + DBMemo1.SelLength;

  P:= StrPos(P, FT);

  if P = NIL then MessageBeep(0)

  else begin

   DBMemo1.SelStart:= P – Buff;

   DBMemo1.SelLength:= Length(FindText);

  end;

  FreeMem(FT, Length(FindText) + 1);

  FreeMem(Buff,BuffLen);

 end;

end;

Попробуйте так:

«Подключите» следующую процедуру к событию OnFind для FindDialog. Единственная проблема заключается в том, что в DBMemo я не могу получить выделенный текст, тем не менее в стандартном Memo такой проблемы нет.

 begin

  DBMemo1.SelStart:= P – Buff;

  DBMemo1.SelLength:= Length(FindText);

 end;

 FreeMem(FT, Length(FindText) + 1);

 FreeMem(Buff,BuffLen);

 DBMemo1.SetFocus;

end;

Возможно ли изменение свойства Hints компонента TDBNavigator во время выполнения программы?

Это должно работать:

procedure TForm1.Button1Click(Sender: TObject);

var ix : integer;

begin

 With DBNavigator1 do

  for ix := 0 to ControlCount - 1 do

   if Controls[ix] is TNavButton then

    with Controls[ix] as TNavButton do

     case index of

     nbFirst : Hint := 'Подсказка для кнопки First';

     nbPrior : Hint := 'Подсказка для кнопки Prior';

     nbNext : Hint := 'Подсказка для кнопки Next';

     nbLast : Hint := '';

     {……}

     end;

end;

– Freddy Hansson

Delphi 1

{ Расширение DBNavigator: позволяет разработчику включать и выключать

отдельные кнопки через методы EnableButton и DisableButton }

unit GNav;

interface

uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, DBCtrls;

type TMyNavigator = class(TDBNavigator)

public

 procedure EnableButton(Btn : TNavigateBtn);

 procedure DisableButton(Btn : TNavigateBtn);

end;

procedure Register;

implementation

procedure TMyNavigator.EnableButton(Btn : TNavigateBtn);

begin

 Buttons[Btn].Enabled := True;

end;

procedure TMyNavigator.DisableButton(Btn : TNavigateBtn);

begin

 Buttons[Btn].Enabled := False;

end;

procedure Register;