BorlandTalk.com

Daniel Ferreira · Guest

Hi, i just started components writing yesterday, so any help would be welcome.

TDBComboBox does not goes like i expect so i have decided to create a component from that.. i need the onSELECT event from TComboBox, i have looked on the manual and found only simple events like onCLICK. A help on how creating or on getting this event from TComboBox, would be welcome

THX once again
Daniel Ferreira

Daniel Ferreira · Guest

Thanks for your response.
It makes sense but.. i really cant find the file that as the code for the DBComboBox, can you tell how should a look for it

thx again

Daniel Ferreira

"Emmanuel" <emmanuel (AT) erphk (DOT) com> wrote:

Emmanuel · Guest

my suggest is to rewrite the DBComboBox

you can copy the DBComboBox source code in the CBuilder6Source*.pas

rewrite it
class TNewDBComboBox:public TComboBox
{protected:
TFieldDataLink*FFieldDataLink;
TNotifyEvent FOnSelect;
.....
__published :
TNotifyEvent OnSelect={read=FOnSelet,write=FOnSelect};
}
__fastcall TNewDBComboBox::TNewDBComboBox(.....)....
{........
FFieldDataLink=new TFieldDataLink
FieldDataLink->OnEditingChange= FSelectEvent;
.......
}

void __fastcall TNewDBComboBox::FSelectEvent(System::TObjectTObject* Sender)
{....
if(FSelect!=NULL)
{FSelect(Sender);
}
.....

}

Emmanuel · Guest

C:Program FilesBorlandCBuilder6Sourcevcldbctrls.pas(350): {
TDBComboBox }

{ TDBComboBox }

TDBComboBox = class(TCustomComboBox)
private
FDataLink: TFieldDataLink;
FPaintControl: TPaintControl;
procedure DataChange(Sender: TObject);
procedure EditingChange(Sender: TObject);
function GetComboText: string;
function GetDataField: string;
function GetDataSource: TDataSource;
function GetField: TField;
function GetReadOnly: Boolean;
procedure SetComboText(const Value: string);
procedure SetDataField(const Value: string);
procedure SetDataSource(Value: TDataSource);
procedure SetEditReadOnly;
procedure SetReadOnly(Value: Boolean);
procedure UpdateData(Sender: TObject);
procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
procedure CMExit(var Message: TCMExit); message CM_EXIT;
procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
protected
procedure Change; override;
procedure Click; override;
procedure ComboWndProc(var Message: TMessage; ComboWnd: HWnd;
ComboProc: Pointer); override;
procedure CreateWnd; override;
procedure DropDown; override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override;
procedure Loaded; override;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure SetItems(const Value: TStrings); override;
procedure SetStyle(Value: TComboboxStyle); override;
procedure WndProc(var Message: TMessage); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function ExecuteAction(Action: TBasicAction): Boolean; override;
function UpdateAction(Action: TBasicAction): Boolean; override;
function UseRightToLeftAlignment: Boolean; override;
property Field: TField read GetField;
property Text;
published
property Style; {Must be published before Items}
property Anchors;
property AutoComplete;
property AutoDropDown;
property BevelEdges;
property BevelInner;
property BevelOuter;
property BevelKind;
property BevelWidth;
property BiDiMode;
property CharCase;
property Color;
property Constraints;
property Ctl3D;
property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;
property DragCursor;
property DragKind;
property DragMode;
property DropDownCount;
property Enabled;
property Font;
property ImeMode;
property ImeName;
property ItemHeight;
property Items write SetItems;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default
False;
property ShowHint;
property Sorted;
property TabOrder;
property TabStop;
property Visible;
property OnChange;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnDrawItem;
property OnDropDown;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMeasureItem;
property OnStartDock;
property OnStartDrag;
end;

{ TDBComboBox }

constructor TDBComboBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csReplicatable];
FDataLink := TFieldDataLink.Create;
FDataLink.Control := Self;
FDataLink.OnDataChange := DataChange;
FDataLink.OnUpdateData := UpdateData;
FDataLink.OnEditingChange := EditingChange;
FPaintControl := TPaintControl.Create(Self, 'COMBOBOX');
end;

destructor TDBComboBox.Destroy;
begin
FPaintControl.Free;
FDataLink.Free;
FDataLink := nil;
inherited Destroy;
end;

procedure TDBComboBox.Loaded;
begin
inherited Loaded;
if (csDesigning in ComponentState) then DataChange(Self);
end;

procedure TDBComboBox.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (FDataLink <> nil) and
(AComponent = DataSource) then DataSource := nil;
end;

procedure TDBComboBox.CreateWnd;
begin
inherited CreateWnd;
SetEditReadOnly;
end;

procedure TDBComboBox.DataChange(Sender: TObject);
begin
if not (Style = csSimple) and DroppedDown then Exit;
if FDataLink.Field <> nil then
SetComboText(FDataLink.Field.Text)
else
if csDesigning in ComponentState then
SetComboText(Name)
else
SetComboText('');
end;

procedure TDBComboBox.UpdateData(Sender: TObject);
begin
FDataLink.Field.Text := GetComboText;
end;

procedure TDBComboBox.SetComboText(const Value: string);
var
I: Integer;
Redraw: Boolean;
begin
if Value <> GetComboText then
begin
if Style <> csDropDown then
begin
Redraw := (Style <> csSimple) and HandleAllocated;
if Redraw then SendMessage(Handle, WM_SETREDRAW, 0, 0);
try
if Value = '' then I := -1 else I := Items.IndexOf(Value);
ItemIndex := I;
finally
if Redraw then
begin
SendMessage(Handle, WM_SETREDRAW, 1, 0);
Invalidate;
end;
end;
if I >= 0 then Exit;
end;
if Style in [csDropDown, csSimple] then Text := Value;
end;
end;

function TDBComboBox.GetComboText: string;
var
I: Integer;
begin
if Style in [csDropDown, csSimple] then Result := Text else
begin
I := ItemIndex;
if I < 0 then Result := '' else Result := Items[I];
end;
end;

procedure TDBComboBox.Change;
begin
FDataLink.Edit;
inherited Change;
FDataLink.Modified;
end;

procedure TDBComboBox.Click;
begin
FDataLink.Edit;
inherited Click;
FDataLink.Modified;
end;

procedure TDBComboBox.DropDown;
begin
inherited DropDown;
end;

function TDBComboBox.GetDataSource: TDataSource;
begin
Result := FDataLink.DataSource;
end;

procedure TDBComboBox.SetDataSource(Value: TDataSource);
begin
if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
FDataLink.DataSource := Value;
if Value <> nil then Value.FreeNotification(Self);
end;

function TDBComboBox.GetDataField: string;
begin
Result := FDataLink.FieldName;
end;

procedure TDBComboBox.SetDataField(const Value: string);
begin
FDataLink.FieldName := Value;
end;

function TDBComboBox.GetReadOnly: Boolean;
begin
Result := FDataLink.ReadOnly;
end;

procedure TDBComboBox.SetReadOnly(Value: Boolean);
begin
FDataLink.ReadOnly := Value;
end;

function TDBComboBox.GetField: TField;
begin
Result := FDataLink.Field;
end;

procedure TDBComboBox.KeyDown(var Key: Word; Shift: TShiftState);
begin
inherited KeyDown(Key, Shift);
if Key in [VK_BACK, VK_DELETE, VK_UP, VK_DOWN, 32..255] then
begin
if not FDataLink.Edit and (Key in [VK_UP, VK_DOWN]) then
Key := 0;
end;
end;

procedure TDBComboBox.KeyPress(var Key: Char);
begin
inherited KeyPress(Key);
if (Key in [#32..#255]) and (FDataLink.Field <> nil) and
not FDataLink.Field.IsValidChar(Key) then
begin
MessageBeep(0);
Key := #0;
end;
case Key of
^H, ^V, ^X, #32..#255:
FDataLink.Edit;
#27:
begin
FDataLink.Reset;
SelectAll;
end;
end;
end;

procedure TDBComboBox.EditingChange(Sender: TObject);
begin
SetEditReadOnly;
end;

procedure TDBComboBox.SetEditReadOnly;
begin
if (Style in [csDropDown, csSimple]) and HandleAllocated then
SendMessage(EditHandle, EM_SETREADONLY, Ord(not FDataLink.Editing), 0);
end;

procedure TDBComboBox.WndProc(var Message: TMessage);
begin
if not (csDesigning in ComponentState) then
case Message.Msg of
WM_COMMAND:
if TWMCommand(Message).NotifyCode = CBN_SELCHANGE then
if not FDataLink.Edit then
begin
if Style <> csSimple then
PostMessage(Handle, CB_SHOWDROPDOWN, 0, 0);
Exit;
end;
CB_SHOWDROPDOWN:
if Message.WParam <> 0 then FDataLink.Edit else
if not FDataLink.Editing then DataChange(Self); {Restore text}
WM_CREATE,
WM_WINDOWPOSCHANGED,
CM_FONTCHANGED:
FPaintControl.DestroyHandle;
end;
inherited WndProc(Message);
end;

procedure TDBComboBox.ComboWndProc(var Message: TMessage; ComboWnd: HWnd;
ComboProc: Pointer);
begin
if not (csDesigning in ComponentState) then
case Message.Msg of
WM_LBUTTONDOWN:
if (Style = csSimple) and (ComboWnd <> EditHandle) then
if not FDataLink.Edit then Exit;
end;
inherited ComboWndProc(Message, ComboWnd, ComboProc);
end;

procedure TDBComboBox.CMEnter(var Message: TCMEnter);
begin
inherited;
if SysLocale.FarEast and FDataLink.CanModify then
SendMessage(EditHandle, EM_SETREADONLY, Ord(False), 0);
end;

procedure TDBComboBox.CMExit(var Message: TCMExit);
begin
try
FDataLink.UpdateRecord;
except
SelectAll;
SetFocus;
raise;
end;
inherited;
end;

procedure TDBComboBox.WMPaint(var Message: TWMPaint);
var
S: string;
R: TRect;
P: TPoint;
Child: HWND;
begin
if csPaintCopy in ControlState then
begin
if FDataLink.Field <> nil then S := FDataLink.Field.Text else S := '';
if Style = csDropDown then
begin
SendMessage(FPaintControl.Handle, WM_SETTEXT, 0, Longint(PChar(S)));
SendMessage(FPaintControl.Handle, WM_PAINT, Message.DC, 0);
Child := GetWindow(FPaintControl.Handle, GW_CHILD);
if Child <> 0 then
begin
Windows.GetClientRect(Child, R);
Windows.MapWindowPoints(Child, FPaintControl.Handle, R.TopLeft, 2);
GetWindowOrgEx(Message.DC, P);
SetWindowOrgEx(Message.DC, P.X - R.Left, P.Y - R.Top, nil);
IntersectClipRect(Message.DC, 0, 0, R.Right - R.Left, R.Bottom -
R.Top);
SendMessage(Child, WM_PAINT, Message.DC, 0);
end;
end else
begin
SendMessage(FPaintControl.Handle, CB_RESETCONTENT, 0, 0);
if Items.IndexOf(S) <> -1 then
begin
SendMessage(FPaintControl.Handle, CB_ADDSTRING, 0,
Longint(PChar(S)));
SendMessage(FPaintControl.Handle, CB_SETCURSEL, 0, 0);
end;
SendMessage(FPaintControl.Handle, WM_PAINT, Message.DC, 0);
end;
end else
inherited;
end;

procedure TDBComboBox.SetItems(const Value: TStrings);
begin
inherited SetItems(Value);
DataChange(Self);
end;

procedure TDBCombobox.SetStyle(Value: TComboboxStyle);
begin
if (Value = csSimple) and Assigned(FDatalink) and
FDatalink.DatasourceFixed then
DatabaseError(SNotReplicatable);
inherited SetStyle(Value);
end;

function TDBComboBox.UseRightToLeftAlignment: Boolean;
begin
Result := DBUseRightToLeftAlignment(Self, Field);
end;

procedure TDBCombobox.CMGetDatalink(var Message: TMessage);
begin
Message.Result := Integer(FDataLink);
end;

function TDBComboBox.ExecuteAction(Action: TBasicAction): Boolean;
begin
Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
FDataLink.ExecuteAction(Action);
end;

function TDBComboBox.UpdateAction(Action: TBasicAction): Boolean;
begin
Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
FDataLink.UpdateAction(Action);
end;

Daniel Ferreira · Guest

Thank you very much for your time Emmanuel.

"Emmanuel" <emmanuel (AT) erphk (DOT) com> wrote: