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

• Название: Советы по Delphi. Версия 1.4.3 от 1.1.2001
• Автор: Валентин Озеров
• Жанр: Программирование

…начиная с 1001. Смотрите другие файлы…

---

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 в список используемых модулей }