Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001

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;

destructorTTestDropEdit.Destroy;

begin

FPickList.Free;

inherited;

end;

procedureTTestDropEdit.CloseUp(Accept: Boolean);

begin

ifFPickList.Visible then begin

ifGetCapture <> 0 thenSendMessage(GetCapture, WM_CANCELMODE, 0, 0);

SetWindowPos(FPickList.Handle, 0, 0, 0, 0, 0, SWP_NOZORDER orSWP_NOMOVE orSWP_NOSIZE orSWP_NOACTIVATE orSWP_HIDEWINDOW);

ifFPickList.ItemIndex <> -1 thenText := FPickList.Items.Strings[FPickList.ItemIndex];

FPickList.Visible := False;

Invalidate;

end;

end;

procedureTTestDropEdit.DropDown;

var

P: TPoint;

I,J,Y: Integer;

begin

ifAssigned(FPickList) and( notFPickList.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 orSWP_NOACTIVATE orSWP_SHOWWINDOW);

FPickList.Visible := True;

Invalidate;

Windows.SetFocus(Handle);

end;

end;

procedureTTestDropEdit.CMCancelMode( var Message: TCMCancelMode);

begin

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

end;

procedureTTestDropEdit.WMKillFocus( var Message: TMessage);

begin

inherited;

CloseUp(False);

end;

procedureTTestDropEdit.WndProc( var Message: TMessage);

procedureDoDropDownKeys( varKey: Word; Shift: TShiftState);

begin

caseKey of

VK_UP, VK_DOWN:

ifssAlt inShift then begin

ifFPickList.Visible thenCloseUp(True)

elseDropDown;

Key := 0;

end;

VK_RETURN, VK_ESCAPE:

ifFPickList.Visible and not(ssAlt inShift) then begin

CloseUp(Key = VK_RETURN);

Key := 0;

end;

end;

end;

begin

caseMessage.Msg of

WM_KeyDown, WM_SysKeyDown, WM_Char:

withTWMKey(Message) do begin

DoDropDownKeys(CharCode, KeyDataToShiftState(KeyData));

if(CharCode <> 0) andFPickList.Visible then begin

withTMessage(Message) doSendMessage(FPickList.Handle, Msg, WParam, LParam);

Exit;

end;

end

end;

inherited;

end;

end.

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, если вы хотите спрятать список.

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

ComboBox1.ItemIndex := var1;

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

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

ifFDataLink.Field <> nil then begin

…

ifFDataLink.Field.DataType = ftString thenMaxLength := FDataLink.Field.Size

elseMaxLength := 0;

…

end else begin

…

MaxLength := 0;

…

end;

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

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

MaxLength := 0;

на

MaxLength := inheritedMaxLength;

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

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

…

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

MaxLength := FDataLink.Field.Size

elseMaxLength := inheritedMaxLength;

…

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

– Reinhard Kalinke

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

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

procedureTForm3.Button3Click(Sender: TObject);

VarControl : Integer;

begin

ForControl := 0 ToControlCount-1 Do

IfControls[Control] IsTDBEdit Then

WithTDBEdit(Controls[Control]) Do

IfDataSource.DataSet.FieldByName(DataField).Required ThenColor := clRed;

end;

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

procedureTForm3.Button4Click(Sender: TObject);

Var

Control : Integer;

DataSource : TDataSource;

DataField : String;

FunctionGetDataSource(Instance: TComponent) : Boolean;

VarPropInfo: 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;

FunctionGetDataField(Instance: TComponent) : Boolean;

VarPropInfo : 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);