Отрисовка компонента

Имеется Компонент TDBLookupEdit=class(TCustomControl)
на на при создании он создаёт TEdit и TSpeedButton 2 штуки.

Проблема состоит вот в чём:
1. если компонент кинуть на форму всё отрисовуется правильно. сохранил проек, загрузил всё хорошо.
2. но вот если изменить, например, ширину контрола, сохранить и потом открыть то видим, что ширина контрола не изменилась, а Tedit и TspeedButton's отрисовуются уже какбы с той новой шириной...
3.

object Button1: TButton
    Left = 124
    Top = 49
    Width = 75
    Height = 25
    Caption = 'Button1'
    TabOrder = 0
  end
  object DBLookupEdit1: TDBLookupEdit
    Left = 132
    Top = 124
    Width = 200
    Height = 22
    TabOrder = 1
    ReadOnly = False
    LookUpOne = True
    ListEditRO = False
    EnabledColor = clWindow
    Buttons = [btClear, btBrowser]
    DesignSize = (
      200
      22)
  end
end

может кто знает что такое DesignSize и почему его нет например в TButton?

Сообщение отредактировано: subdigger - 28.12.05, 10:55

Цитата

Specifies the design size for the data module at design time.

Можно взглянуть на код компонента?

Цитата s-mike @ 30.12.05, 07:31

Цитата
Specifies the design size for the data module at design time.

однако в TButton такого нету....

unit DBLookupEdit;
 
interface
 
uses
  windows,SysUtils, Classes, Controls, DBCtrls, db, StdCtrls, Variants,Buttons, Graphics;
 
const
  but_width = 20;
 
  op_ok    = 0;
  op_stop  = 1;
  op_back  = 2;
 
type
  TDBLookupEdit = class;
 
  TDSLink = class(TDataLink)
  private
    FDBLookupControl: TDBLookupEdit;
  protected
    procedure FocusControl(Field: TFieldRef); override;
    procedure ActiveChanged; override;
    procedure LayoutChanged; override;
    procedure RecordChanged(Field: TField); override;
  public
    constructor Create;
  end;
 
  TLSLink = class(TDataLink)
  private
    FDBLookupControl: TDBLookupEdit;
  protected
    procedure ActiveChanged; override;
    procedure DataSetChanged; override;
    procedure LayoutChanged; override;
  public
    constructor Create;
  end;
 
  // TDBLookupEdit
  TDBLookupButton = (btClear, btBrowser);       //êíîïêè íà êîíòðîëå
  TDBLookupButtons = set of TDBLookupButton;
 
  TDBLookupEdit = class(TCustomControl)
  private
    FReadOnly: boolean;
    FDataLink: TDSLink;
    FListLink: TLSLink;
    FListEdit: TEdit;
    Fbut: TspeedButton;
    FClearbut: TSpeedButton;
    FLookUpOne: boolean;
    FListEditRO: boolean;
    FEnColor: TColor;
    FOnChange: TNotifyEvent;
    FDataFieldName: string;
    FKeyValue: Variant;
    FListFieldName: string;
    FKeyFieldName: string;
    FKeyOper: integer;
    FButtons: TDBLookupButtons;
    FDataField: TField;
    FFieldText: TField;
    procedure goClick(Sender:TObject);
    procedure ClearClick(Sender:TObject);
    function GetReadOnly: Boolean;
    procedure SetReadOnly(const Value: Boolean);
    procedure SetListEditRO(const Value: boolean);
    procedure SetDataFieldName(const Value: string);
    function GetDataSource: TDataSource;
    procedure SetDataSource(const Value: TDataSource);
    procedure SetKeyValue(const Value: Variant);
    procedure SetKeyFieldName(const Value: string);
    procedure SetListFieldName(const Value: string);
    function GetListSource: TDataSource;
    procedure SetListSource(const Value: TDataSource);
    procedure SetButtons(const Value: TDBLookupButtons);
    procedure EdtKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure EdtChange(Sender: TObject);
    function GetText: TCaption;
    procedure SetText(const Value: TCaption);
    procedure SetEnColor(const Value: TColor);
  protected
    procedure Resize; override;
    procedure Paint; override;
    procedure UpdateDataFields;
    procedure UpdateListFields;
    procedure KeyValueChanged;
    procedure RecordChanged(AField: TField);
    procedure SetButClear;
    procedure SetButBrowse;
//    property FieldText: TField read GetFieldText;
    property FieldText: TField read FFieldText;
    property DataLink: TDSLink read FDataLink;
    property ListLink: TLSLink read FListLink;
  public
    constructor Create(AOwner: TComponent); override;
    destructor destroy; override;
    property KeyValue: Variant read FKeyValue write SetKeyValue;
//    property Field: TField read GetDataField;
    property Field: TField read FDataField;
    procedure SetFocus; override;
    property Text: TCaption read GetText write SetText;
  published
    property DataField: string read FDataFieldName write SetDataFieldName;
    property TabOrder;
    property TabStop;
    property KeyField: string read FKeyFieldName write SetKeyFieldName;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property ListField: string read FListFieldName write SetListFieldName;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property ListSource: TDataSource read GetListSource write SetListSource;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly;
    property LookUpOne: boolean read FLookUpOne write FLookUpOne;
    property ListEditRO: boolean read FListEditRO write SetListEditRO;
    property EnabledColor: TColor read FEnColor write SetEnColor;
    property Buttons: TDBLookupButtons read FButtons write SetButtons;
 end;
 
procedure Register;
 
implementation
 
uses dialogs, dic, Types;
 
procedure Register;
begin
  RegisterComponents('Unitex Tools', [TDBLookupEdit]);
end;
{$R pic.res}
{ TDBLookupEdit }
 
procedure TDBLookupEdit.ClearClick(Sender: TObject);
begin
  KeyValue := NULL;
end;
 
constructor TDBLookupEdit.Create(AOwner: TComponent);
begin
  inherited create(AOwner);
  TabStop := True;
  FDataLink := TDSLink.Create;
  FDataLink.FDBLookupControl := Self;
  FListLink := TLSLink.Create;
  FListLink.FDBLookupControl := Self;
  FKeyValue := Null;
 
  width := 200;
  height := 22;
 
  FListEdit := TEdit.Create(self);
  FListEdit.Left := 0;
  FListEdit.Top := 0;
  FListEdit.Anchors := FListEdit.Anchors + [akRight];
  FListEdit.Parent := self;
  FListEdit.Anchors := [akRight,akLeft];
  FListEdit.OnKeyDown := EdtKeyDown;
  FListEdit.OnChange := EdtChange;
  FEnColor := clWindow;
  FLookUpOne := True;
  Buttons := [btBrowser, btClear];
end;
 
procedure TDBLookupEdit.EdtChange(Sender: TObject);
var
  po: integer;
begin
  if FKeyOper = op_stop then exit;
  if not (sender is TEdit) then exit;
  with sender as TEdit do begin
    if (Text = '') or not assigned(FieldText) then exit;
    if FieldText.DataSet.Locate(ListField, Text, [loPartialKey, loCaseInsensitive]) then begin
      po := SelStart;
      if (FKeyOper = op_back) then dec(po);
      FKeyOper := op_stop;
      TEdit(Sender).Text := FieldText.Value;
      SelStart := po;
      SelLength := length(Text) - po;
      FKeyOper := op_ok;
    end;
  end;
end;
 
procedure TDBLookupEdit.EdtKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  FKeyOper := op_ok;
  case Key of
    VK_BACK: begin
               if not (sender is TEdit) then exit;
               if TEdit(sender).SelStart < TEdit(sender).gettextlen then
                 FKeyOper := op_back;
             end;
    VK_DELETE: FKeyOper := op_stop;
  end;
end;
 
function TDBLookupEdit.GetText: TCaption;
begin
  Result := FListEdit.Text;
end;
 
function TDBLookupEdit.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;
 
function TDBLookupEdit.GetListSource: TDataSource;
begin
  Result := FListLink.DataSource;
end;
 
function TDBLookupEdit.GetReadOnly: Boolean;
begin
  Result := FReadOnly;
end;
 
procedure TDBLookupEdit.goClick(Sender: TObject);
var
  DicFrm      : TDic_Form;
  IT : TIniBrowser;
begin
  //âûçîâ áðîóçåðà
  if not assigned(ListSource) or not assigned(ListSource.DataSet) then exit;
  DicFrm := TDic_Form.create(self);
  IT.Query := ListSource.DataSet;
  IT.One := FLookUpOne;
  IT.Field := KeyField;
  IT.Criterion := KeyField;
  IT.FCaption := 'Âèá³ð çíà÷åííÿ';
  IT.ForWatch := ListField;
  IT.Bnds := nil;
  try
    DicFrm.InitBrower(it);
    if dicfrm.ShowModal = mrOK then
      if dicfrm.Result <> '' then
        KeyValue := dicfrm.Result;
  finally
    DicFrm.Free;
  end;  
end;
 
procedure TDBLookupEdit.KeyValueChanged;
begin
  inherited;
  if csDestroying in componentstate then exit;
  if not assigned(Field) or not assigned(FieldText) then begin
    FKeyOper := op_stop;
    FListEdit.Text := '';
    exit;
  end;
  if KeyValue = NULL then FListEdit.Text := '' //î÷èùàåì òåêñò òîëüêî åñëè â ðåæèìå ðåäàêòèðîâàíèÿ íåëüçÿ ïèñàòü ðóêàìè
  else begin
    FKeyOper := op_stop;
    if FieldText.DataSet.Locate(KeyField, KeyValue, []) then
      FListEdit.Text := FieldText.AsString
    else FListEdit.Text := '';
  end;
  if assigned(OnChange) and not (csLoading in componentstate)
      and not (csReading in componentstate) then
    OnChange(self);
end;
 
procedure TDBLookupEdit.Paint;
var
  rect: TRect;
begin
  inherited;
  Canvas.Brush.Color := clBtnFace;
  Rect := GetClientRect;
  Canvas.FillRect(Rect);
  if ReadOnly then begin
    Brush.Color := clBtnFace;
    FListEdit.Brush.Color := clBtnFace;
  end else begin
    Brush.Color := clBtnFace;
    FListEdit.Brush.Color := FEnColor;
  end;
end;
 
procedure TDBLookupEdit.Resize;
begin
  inherited;
//  FListEdit.Width := width - 46;
end;
 
procedure TDBLookupEdit.SetButBrowse;
begin
  Fbut := TSpeedButton.Create(self);
  Fbut.Glyph.Transparent := true;
  Fbut.Glyph.LoadFromResourceName(HInstance,'GO');
  Fbut.Flat := true;
  Fbut.name := 'go';
  Fbut.top := 1;
  Fbut.width := but_width;
  Fbut.height := but_width;
  Fbut.OnClick := goClick;
  Fbut.parent := self;
  Fbut.Anchors := [akTop,akRight];
end;
 
procedure TDBLookupEdit.SetButClear;
begin
  FClearbut := TSpeedButton.Create(self);
  FClearbut.Glyph.Transparent := true;
  FClearbut.Glyph.LoadFromResourceName(HInstance,'CLEAR');
  FClearbut.Flat := true;
  FClearbut.name := 'clear';
  FClearbut.top := 1;
  FClearbut.width := but_width;
  FClearbut.height := but_width;
  FClearbut.OnClick := ClearClick;
  FClearbut.parent := self;
  FClearbut.Anchors := [akTop,akRight];
end;
 
procedure TDBLookupEdit.SetButtons(const Value: TDBLookupButtons);
var
  x: integer;
begin
  FButtons := Value;
  x := width - 1;
  if btBrowser in FButtons then begin
    if not assigned(FBut) then SetButBrowse;
    FBut.Left := x - but_width;
    FBut.Visible := true;
    x := x - but_width - 1;
  end
  else if assigned(FBut) then begin
    FBut.Free;
    FBut := nil;
  end;
  if btClear in FButtons then begin
    if not assigned(FClearBut) then SetButClear;
    FClearBut.Left := x - but_width;
    FClearbut.Visible := true;
    x := x - but_width - 1;
  end
  else if Assigned(FClearBut) then begin
    FClearbut.free;
    FClearBut := nil;
  end;
  FListEdit.Width := x - FListEdit.Left;
  Invalidate;
end;
 
procedure TDBLookupEdit.SetDataFieldName(const Value: string);
begin
  if FDataFieldName <> Value then
  begin
    FDataFieldName := Value;
    UpdateListFields;
  end;
end;
 
procedure TDBLookupEdit.SetDataSource(const Value: TDataSource);
begin
  if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
    FDataLink.DataSource := Value;
  if Value <> nil then Value.FreeNotification(Self);
end;
 
procedure TDBLookupEdit.SetFocus;
begin
  inherited;
  FListEdit.SetFocus;
end;
 
procedure TDBLookupEdit.SetKeyFieldName(const Value: string);
begin
  if FKeyFieldName <> Value then
  begin
    FKeyFieldName := Value;
    UpdateListFields;
  end;
end;
 
function VarEquals(const V1, V2: Variant): Boolean;
begin
  Result := False;
  try
    Result := V1 = V2;
  except
  end;
end;
 
procedure TDBLookupEdit.SetKeyValue(const Value: Variant);
begin
  if not VarEquals(FKeyValue, Value) then begin
    FKeyValue := Value;
    KeyValueChanged;
  end;
end;
 
procedure TDBLookupEdit.SetListEditRO(const Value: boolean);
begin
  FListEditRO := value;
  FListEdit.ReadOnly := Value or ReadOnly;
end;
 
procedure TDBLookupEdit.SetListFieldName(const Value: string);
begin
  if FListFieldName <> Value then
  begin
    FListFieldName := Value;
    UpdateListFields;
  end;
end;
 
procedure TDBLookupEdit.SetListSource(const Value: TDataSource);
begin
  FListLink.DataSource := Value;
  if Value <> nil then Value.FreeNotification(Self);
end;
 
procedure TDBLookupEdit.SetReadOnly(const Value: Boolean);
begin
  FReadOnly := Value;
  If value then begin
    if assigned(FBut) then Fbut.Enabled :=  not Value;
    if assigned(FClearBut) then FClearbut.Enabled := not Value;
    FListEdit.ReadOnly := value;
  end else begin
    if assigned(FBut) then Fbut.Enabled :=  not Value;
    if assigned(FClearBut) then FClearbut.Enabled := not Value;
    FListEdit.ReadOnly := FListEditRO;
  end;
  invalidate;
end;
 
procedure TDBLookupEdit.SetText(const Value: TCaption);
begin
  FKeyOper := op_stop;
  FListEdit.Text := Value;
end;
 
procedure TDBLookupEdit.UpdateDataFields;
begin
  if assigned(DataLink) and assigned(DataLink.DataSet) and DataLink.DataSet.Active
    and (DataField <> '') then
      FDataField := DataLink.DataSet.FindField(DataField)
  else FDataField := nil;
  if assigned(FDataField) then FKeyValue := FDataField.Value;
  KeyValueChanged;
end;
 
procedure TDBLookupEdit.UpdateListFields;
begin
  if assigned(ListLink) and assigned(ListLink.DataSet) and ListLink.DataSet.Active
    and (ListField <> '') then
      FFieldText := ListLink.DataSet.FindField(ListField)
  else FFieldText := nil;    
  KeyValueChanged;
end;
 
procedure TDBLookupEdit.RecordChanged(AField: TField);
begin
  if assigned(FDataField) then
    KeyValue := FDataField.Value;
end;
 
destructor TDBLookupEdit.destroy;
begin
  inherited destroy;
  if FListLink <> nil then
    FListLink.FDBLookupControl := nil;
  FListLink.Free;
  FListLink := nil;
  if FDataLink <> nil then
    FDataLink.FDBLookupControl := nil;
  FDataLink.Free;
  FDataLink := nil;
end;
 
procedure TDBLookupEdit.SetEnColor(const Value: TColor);
begin
  FEnColor := Value;
  Invalidate;
//  paint;
end;
 
{ TDSLink }
 
procedure TDSLink.ActiveChanged;
begin
  if FDBLookupControl <> nil then FDBLookupControl.UpdateDataFields;
end;
 
constructor TDSLink.Create;
begin
  inherited Create;
  VisualControl := True;
end;
 
procedure TDSLink.FocusControl(Field: TFieldRef);
begin
  if (Field^ <> nil) and (Field^ = FDBLookupControl.Field) and
    (FDBLookupControl <> nil) and FDBLookupControl.CanFocus then
  begin
    Field^ := nil;
    FDBLookupControl.SetFocus;
  end;
end;
 
procedure TDSLink.LayoutChanged;
begin
  if FDBLookupControl <> nil then FDBLookupControl.UpdateDataFields;
end;
 
procedure TDSLink.RecordChanged(Field: TField);
begin
  if (FDBLookupControl <> nil) and ((Field = FDBLookupControl.Field)) {or
subdigger    (Field = nil)) }then FDBLookupControl.RecordChanged(Field);
end;
 
{ TListSourceLink }
 
procedure TLSLink.ActiveChanged;
begin
  if FDBLookupControl <> nil then FDBLookupControl.UpdateListFields;
end;
 
constructor TLSLink.Create;
begin
  inherited Create;
  VisualControl := True;
end;
 
procedure TLSLink.DataSetChanged;
begin
//  if FDBLookupControl <> nil then FDBLookupControl.UpdateListFields;
end;
 
procedure TLSLink.LayoutChanged;
begin
  if FDBLookupControl <> nil then FDBLookupControl.UpdateListFields;
end;
 
end.

Попробуй в конструкторе создавать кнопки FBut, FButclear вместо вызова процедуры SetButtons (Buttons := [btBrowser, btClear]

zubr так собственно говоря они и создадутся на Buttons := [btBrowser, btClear]. не вижу в этом смысла.

Цитата subdigger @ 10.01.06, 09:15

zubr так собственно говоря они и создадутся на Buttons := [btBrowser, btClear]. не вижу в этом смысла.

Я предполагаю, что у тебя процедура SetButtons в дизайнтайм вызывается раньше отрисовки контрола. Подробно еще не разбирался, сегодня вечером если будет время посмотрю подробнее.

Наконец появилось время. Все что тебе надо сделать:
1. В начало процедуры SetButtons вставить:

If FButtons=Value then
  exit;

2. В конструкторе вместо FListEdit.Anchors := [akRight,akLeft], сделать FListEdit.Anchors := [akRight,akLeft, akTop];

zubr

Цитата zubr @ 14.01.06, 14:29

1. В начало процедуры SetButtons вставить:
If FButtons=Value then
exit;

особого смысла нет просто не позволит сменить батоны. Кстати там раньше так и было написано и убрал я эту строку потому, что мне казалось это именно она мешает правильно рисоватся. =)

Цитата zubr @ 14.01.06, 14:29

2. В конструкторе вместо FListEdit.Anchors := [akRight,akLeft], сделать FListEdit.Anchors := [akRight,akLeft, akTop];

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

я очень тебе благодарен за внимание но это не помогло.
у меня вкралось подозрение, что это всё-таки из-за вот этого прикола

  object DBLookupEdit3: TDBLookupEdit
    Left = 64
    Top = 124
    Width = 179
    Height = 22
    TabOrder = 2
    TabStop = True
    ReadOnly = False
    LookUpOne = True
    ListEditRO = False
    EnabledColor = clWindow
    Buttons = [btClear]
    DesignSize = (
      179
      22)
  end
  object Button1: TButton
    Left = 73
    Top = 183
    Width = 70
    Height = 25
    Caption = 'Button1'
    TabOrder = 3
  end

в моём компоненте добавляется с трока DesignSize
а вот в батоне такой строки неееееет. почему?

Проблемы в свойстве Anchors, как для FListEdit так и для Buttons. Поработал с твоим компонентом, вот что я изменил:

constructor TDBLookupEdit.Create(AOwner: TComponent);
var
  x: integer;
begin
  inherited create(AOwner);
  TabStop := True;
  FDataLink := TDSLink.Create;
  FDataLink.FDBLookupControl := Self;
  FListLink := TLSLink.Create;
  FListLink.FDBLookupControl := Self;
  FKeyValue := Null;
  width := 200;
  height := 220;
  FListEdit := TEdit.Create(self);
  FListEdit.Left := 0;
  FListEdit.Top := 0;
  //FListEdit.Anchors := FListEdit.Anchors + [akRight];
  FListEdit.Parent := self;
  //FListEdit.Anchors := [akRight,akLeft, akTop];
  FListEdit.OnKeyDown := EdtKeyDown;
  FListEdit.OnChange := EdtChange;
  FEnColor := clWindow;
  FLookUpOne := True;
 
  Buttons := [btBrowser, btClear];
 
end;
 
procedure TDBLookupEdit.UpdateButtons;//Эту процедуру я добавил для отрисовки кнопок и эдита как приватный метод
var
  x: integer;
begin
 x := width - 1;
 if btBrowser in FButtons then
 begin
  FBut.Left := x - but_width;
  FBut.Visible := true;
  x := x - but_width - 1;
 end;
 if btClear in FButtons then
 begin
  FClearBut.Left := x - but_width;
  FClearbut.Visible := true;
  x := x - but_width - 1;
 end;
 FListEdit.Width := x - FListEdit.Left;
end;
 
procedure TDBLookupEdit.Paint;
var
  rect: TRect;
begin
  inherited;
  Canvas.Brush.Color := clBtnFace;
  Rect := GetClientRect;
  Canvas.FillRect(Rect);
  if ReadOnly then begin
    Brush.Color := clBtnFace;
    FListEdit.Brush.Color := clBtnFace;
  end else begin
    Brush.Color := clBtnFace;
    FListEdit.Brush.Color := FEnColor;
  end;
  UpdateButtons;//отрисовка
end;
 
procedure TDBLookupEdit.SetButtons(const Value: TDBLookupButtons);
begin
  FButtons := Value;
  if btBrowser in FButtons then begin
    if not assigned(FBut) then SetButBrowse;
    {FBut.Left := x - but_width;
    FBut.Visible := true;
    x := x - but_width - 1;}
  end
  else if assigned(FBut) then begin
    FBut.Free;
    FBut := nil;
  end;
  if btClear in FButtons then begin
    if not assigned(FClearBut) then SetButClear;
    {FClearBut.Left := x - but_width;
    FClearbut.Visible := true;
    x := x - but_width - 1;}
  end
  else if Assigned(FClearBut) then begin
    FClearbut.free;
    FClearBut := nil;
  end;
  //FListEdit.Width := x - FListEdit.Left;
  Invalidate;
end;

В процедурах SetButBrowse и SetButClear убрал FClearbut.Anchors := [akTop,akRight];
В результате все заработало.

zubr Спасибо. Вот тебе жирный плюс.