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.
Программное открытие ComboBox II
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, если вы хотите спрятать список.
Проблемы с ComboBox
Delphi 1
…попробуйте сохранять в переменной в методе формы OnEnter или OnCreate значение Index. Затем, чтобы отменить выбор пользователя, сделайте:
ComboBox1.ItemIndex := var1;
DBEdit
Исправление DBEdit MaxLength
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
Поиск и управление TEdit/TField
Я хотел бы менять цвет компонентов 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 в список используемых модулей }
