■一个控件包含有一个按钮控件，请问如何响应这个按钮的单击事件■

Question

RT

Answer 1

procedure TForm1.Button1Click(Sender: TObject);
begin
showmessage('aa');
end;procedure TForm1.Button2Click(Sender: TObject);
begin
Button1.Click;
end;///是这样吗....

Answer 2

类似~~
TCloseEvent = procedure(Sender: TObject; var Action: TCloseAction) of object;
...
 property OnClose: TCloseEvent read FOnClose write FOnClose

Answer 3

发消息LRESULT SendMessage(    HWND hWnd, // handle of destination window
    UINT Msg, // message to send
    WPARAM wParam, // first message parameter
    LPARAM lParam  // second message parameter
   );

Answer 4

根据VCL设计思想，单击事件会先到控件，然后再由控件分配给按钮

Answer 5

源代码如下
unit SelectDa;{$S-,W-,R-}
{$C PRELOAD}interfaceuses Messages, Windows, SysUtils, Classes, Controls, Forms, Menus, Graphics,StrUtils,Math,ADODB,
  StdCtrls,TFlatButtonUnit;type
  TEditDataType = (SdString, SdInteger,SdFloat);
  TSelectDa = class(TCustomControl)
  private
    {label 6}
    FPen: TPen;
    FBrush:TBrush;
    FFont:TFont;
    FCaption:string;
    FBmText:string;
    FZjText:string;
    {edit 4}
    FEdit:TEdit;
    FMcText:string;
    FDataType: TEditDataType;
    FPrecision: Integer;
    {button 8}
    FButton:TFlatButton;
    FCn:TADOConnection;
    FTitleName:string;
    FTableName:string;
    FDataStyle:Integer;
    FBmField:string;
    FZjField:string;
    FMcField:string;
    {event 3}
    FOnClick: TNotifyEvent;
    FOnExit: TNotifyEvent;
    FOnKeyPress: TKeyPressEvent;
    {label 6}
    procedure SetPen(Value:TPen);
    procedure SetBrush(Value:TBrush);
    procedure SetFont(Value:TFont);
    procedure SetCaption(Value:string);
    procedure SetBmText(Value:string);
    procedure SetZjText(Value:string);
    {edit 9}
    procedure SetMcText(Value:string);
    procedure SetPrecision(const Value: Integer);
    procedure SetDataType(const Value: TEditDataType);
    function  GetAsFloat: double;
    function  GetAsInteger: Integer;
    function  GetAsText: string;
    procedure SetAsFloat(const Value: double);
    procedure SetAsInteger(const Value: Integer);
    procedure SetAsText(const Value: string);
    {other 1}
    procedure StyleChanged(Sender: TObject);
    {event 3}
    procedure SdOnClick(Sender: TObject);
    procedure SdOnExit(Sender: TObject);
    procedure SdOnKeyPress(Sender: TObject; var Key: Char);
  protected
    {vcl 7}
    procedure Paint; override;
    procedure Click; dynamic;
    procedure CMExit(var Message: TCMExit); message CM_EXIT;
    procedure DoExit; dynamic;
    procedure WMChar(var Message: TWMChar); message WM_CHAR;
    function  DoKeyPress(var Message: TWMKey): Boolean;
    procedure KeyPress(var Key: Char); dynamic;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
  published
    {label 6}
    property Pen: TPen read FPen write SetPen;
    property Brush: TBrush read FBrush write SetBrush;
    property Font: TFont read FFont write SetFont;
    property Caption:string read FCaption write SetCaption;
    property Bm:string read FBmText write SetBmText;
    property Zjf:string read FZjText write SetZjText;
    {edit 9}
    property Text:string read FMcText write SetMcText;
    property DataType: TEditDataType read FDataType write SetDataType default SdString;
    property Precision: Integer read Fprecision write SetPrecision;
    property AsFloat:Double read GetAsFloat write SetAsFloat;
    property AsInt: Integer read GetAsInteger write SetAsInteger;
    property AsStr: string read GetAsText write SetAsText;
    {button 0}
    property AdoCn:TAdoConnection read FCn write FCn;
    property TitleName:string read FTitleName write FTitleName;
    property TableName:string read FTableName write FTableName ;
    property DataStyle:Integer read FDataStyle write FDataStyle ;
    property BmField:string read FBmField write FBmField ;
    property ZjField:string read FZjField write FZjField ;
    property McField:string read FMcField write FMcField ;
    {other}
    property OnClick: TNotifyEvent read FOnClick write FOnClick;
    property OnKeyPress: TKeyPressEvent read FOnKeyPress write FOnKeyPress;
    property OnExit: TNotifyEvent read FOnExit write FOnExit;
  end;procedure Register;implementationuses Consts, PubSelect, PubUnitModule;{label 6}procedure TSelectDa.SetPen(Value: TPen);
begin
    FPen.Assign(Value);
    Invalidate;
end;procedure TSelectDa.SetBrush(Value:TBrush);
begin
    FBrush.Assign(Value);
    Invalidate;
end;procedure TSelectDa.SetFont(Value:TFont);
begin
    FFont.Assign(Value);
    Invalidate;
end;procedure TSelectDa.SetCaption(Value:string);
begin
    if FCaption <> Value then
    begin
        FCaption:=Value;
        Invalidate;
    end;
end;procedure TSelectDa.SetBmText(Value:string);
begin
    if FBmText <> Value then
    begin
        FBmText:=Value;
        Invalidate;
    end;
end;procedure TSelectDa.SetZjText(Value:string);
begin
    if FZjText <> Value then
    begin
        FZjText:=Value;
    end;
end;{edit 9}procedure TSelectDa.SetMcText(Value:string);
begin
    if FMcText <> Value then
    begin
        FMcText:=Value;
        Invalidate;
    end;
end;procedure TSelectDa.SetPrecision(const Value: Integer);
begin
    if Fprecision<>Value then
    begin
        case Value of
        1..6:FPrecision:=Value;
        else FPrecision:=2;
        end;
    end;
end;procedure TSelectDa.SetDataType(const Value: TEditDataType);
begin
    if FDataType <> Value then
    begin
        FDataType:=Value;
    end;
end;function  TSelectDa.GetAsFloat: Double;
    function StrToDouble(S:string):Double;
    begin
        if not trystrToFloat(s,Result) then Result:=0;
    end;
var
    f:string;
begin
    case FPrecision of
    1..6:  f:=FormatFloat('###0.'+DupeString('0',FPrecision),StrToDouble(FMcText));
    else  f:=FormatFloat('###0.00',StrToDouble(FMcText));
    end;
    Result:=StrToFloat(f);
end;function  TSelectDa.GetAsInteger: Integer;
    Function StrToInteger(S:string):integer;
    begin
        if not trystrToInt(s,Result) then Result:=0;
    end;
begin
    Result:=StrToInteger(FMcText);
end;

Answer 6

function  TSelectDa.GetAsText: string;
begin
    Result:=FMcText;
end;procedure TSelectDa.SetAsFloat(const Value: double);
var
    f:Double;
begin
    case FPrecision of
    1..6:  f:=RoundTo(Value,-FPrecision);
    else  f:=RoundTo(Value,-2);
    end;
    SetMcText(FloatToStr(f));
end;procedure TSelectDa.SetAsInteger(const Value: Integer);
begin
    SetMcText(IntToStr(Value));
end;procedure TSelectDa.SetAsText(const Value: string);
begin
    SetMcText(Value);
end;{other 1}procedure TSelectDa.StyleChanged(Sender: TObject);
begin
    Invalidate;
end;{event 3}procedure TSelectDa.SdOnKeyPress(Sender: TObject; var Key: Char);
begin
    case FDataType of
        SdInteger:
        begin
            if not (Key in ['0'..'9',      '-', #8, #13, #35,           #39]) then Key := #0;
            if (Key = '-') and ((Pos('-', FEdit.Text) > 0) or (FEdit.SelStart <> 0)) then Key := #0;
        end;
        SdFloat:
        begin
            if not (Key in ['0'..'9', '.', '-', #8, #13, #35, #36, #37, #39]) then Key := #0;
            if (Key = '.') and (Pos('.', FEdit.Text) > 0) then Key := #0;
            if (Key = '-') and ((Pos('-', FEdit.Text) > 0) or (FEdit.SelStart <> 0)) then Key := #0;
        end
    end;
end;procedure TSelectDa.SdOnExit(Sender: TObject);
begin
    if (FBmField<>'') and (FBmText<>'') then
        FEdit.Text:=GetDaBmToMc(FCn,FTableName,FBmField,FBmText,FMcField);
    FMcText:=FEdit.Text;
end;procedure TSelectDa.SdOnClick(Sender: TObject);
var
    PubSelect:TFrmPubSelect;
begin
    PubSelect:=TFrmPubSelect.Create(Self);
    try
        PubSelect.AdoCn:=FCn;
        PubSelect.TitleName:=FTitleName;
        PubSelect.TableName:=FTableName;
        PubSelect.DataStyle:=FDataStyle;
        PubSelect.BmField:=FBmField;
        PubSelect.ZjField:=FZjField;
        PubSelect.McField:=FMcField;
        if PubSelect.ReturnState=1 then
        begin
            FBmtext:=PubSelect.ReturnBm;
            FZjText:=PubSelect.ReturnZj;
            FMcText:=PubSelect.ReturnMc;
            FEdit.Text:=FMcText;
            Invalidate;
        end;
    finally
        PubSelect.Free;
    end;
end;{vcl 7}procedure TSelectDa.Click;
begin
  if not Assigned(FOnClick) then FOnClick:=SdOnClick;
  {if Assigned(FOnClick) then }FOnClick(Self);
  {Derive class:please don't inherited Click;}
end;procedure TSelectDa.CMExit(var Message: TCMExit);
begin
  DoExit;
end;procedure TSelectDa.DoExit;
begin
  if not Assigned(FOnExit) then FOnExit:=SdOnExit;
  {if Assigned(FOnExit) then }FOnExit(Self);
  {Derive class:please don't inherited DoExit;}
end;procedure TSelectDa.WMChar(var Message: TWMChar);
begin
  if not DoKeyPress(Message) then inherited;
end;function TSelectDa.DoKeyPress(var Message: TWMKey): Boolean;
var
  {Form: TCustomForm;}
  Ch: Char;
begin
  Result := True;
  {
  Form := GetParentForm(Self);
  if (Form <> nil) and (Form <> Self) and Form.KeyPreview and
    TWinControl(Form).DoKeyPress(Message) then Exit;
  }
  if not (csNoStdEvents in ControlStyle) then
    with Message do
    begin
      Ch := Char(CharCode);
      KeyPress(Ch);
      CharCode := Word(Ch);
      if Char(CharCode) = #0 then Exit;
    end;
  Result := False;
end;procedure TSelectDa.KeyPress(var Key: Char);
begin
  if not Assigned(FOnKeyPress) then FOnKeyPress:=SdOnKeyPress;
  {if Assigned(FOnKeyPress) then }FOnKeyPress(Self, Key);
  {Derive class:please don't inherited KeyPress(Key);}
end;procedure TSelectDa.Paint;
var
  aText:Pchar;
  aRect:TRect;
begin
  with Canvas do
  begin
    Font:=FFont;
    Pen:=FPen;
    Brush:=FBrush;
    FillRect(ClientRect);
    {caption}
    if FBmText<>'' then aText:=Pchar(FCaption+'['+FBmText+']') else aText:=Pchar(FCaption);
    aRect:=Rect(ClientRect.Left+FPen.Width, ClientRect.Top+FPen.Width, ClientRect.Right-FPen.Width, ClientRect.Bottom-FPen.Width);
    DrawText(Handle, aText, StrLen(aText), aRect, (DT_SINGLELINE or DT_VCENTER) or DT_LEFT);
    {line}
    Inc(aRect.Left,TextWidth(aText));
    MoveTo(aRect.Left,aRect.Bottom);
    LineTo(aRect.Right,aRect.Bottom);
  end;
  {edit}
  FEdit.Left:=aRect.Left;
  FEdit.Top:=aRect.Top;
  FEdit.Width:=aRect.Right-aRect.Left;
  FEdit.Height:=aRect.Bottom-aRect.Top-2*Pen.Width;
  {button}
  FButton.Left:=aRect.Right-FButton.Width;
  FButton.Top:=aRect.Top+2*Pen.Width;
  FButton.Height:=aRect.Bottom-aRect.Top-2*Pen.Width;
  if FBmField<>'' then FButton.Visible:=True;
end;{create and Destroy 2}constructor TSelectDa.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csReplicatable,csClickEvents];
  FPen := TPen.Create;
  FPen.OnChange:=StyleChanged;
  FBrush := TBrush.Create;
  FBrush.OnChange:=StyleChanged;
  FFont := TFont.Create;
  FFont.OnChange:=StyleChanged;
  FFont.Charset:=GB2312_CHARSET;
  FFont.Name:='宋体';
  FFont.Size:=9;
  FEdit:=TEdit.Create(AOwner);
  FEdit.Parent:=Self;
  FEdit.OnKeyPress:=FOnKeyPress;
  FEdit.BorderStyle:=bsNone;
  FEdit.Height:=23;
  FEdit.Width:=168;
  FEdit.Text:='';
  FEdit.Enabled:=True;
  FEdit.Visible:=True;
  FButton:=TFlatButton.Create(AOwner);
  FButton.Parent:=Self;
  FButton.OnClick:=FOnClick;
  FButton.ColorBorder:=clWhite;
  FButton.Height:=18;
  FButton.Width:=20;
  FButton.Caption:='…';
  FButton.Enabled:=True;
  FButton.Visible:=False;
  Width:=188;
  Height:=25;
  FCaption:='';
  FBmText:='';
  FZjText:='';
  FMcText:='';
  FDataType:=SdString;
  FPrecision:=0;
  FCn:=nil;
  FTitleName:='';
  FTableName:='';
  FDataStyle:=0;
  FBmField:='';
  FZjField:='';
  FMcField:='';
end;destructor TSelectDa.Destroy;
begin
  FPen.Free;
  FBrush.Free;
  FFont.Free;
  if Assigned(FEdit) then FreeAndNil(FEdit);
  if Assigned(FButton) then FreeAndNil(FButton);
  inherited Destroy;
end;///////////////////////////////////////////////////////////procedure Register;
begin
  RegisterComponents('swlmsoft', [TSelectDa]);
end;end.
 
问题:
1 在使用这个控件中提示错误：TEdit这个类找不到!请问如何解决?
2 帮忙把代码优化一下，是不是有很多冗余的代码谢谢

Answer 7

你已經使用了uses StdCtrls, 應該不會找不到: TEdit这个类找不到!请问如何解决?>>■一个控件包含有一个按钮控件，请问如何响应这个按钮的单击事件■ private
procedure Button1Click(Sender: TObject);
  FOnClick: TNotifyEvent;
published
  property OnClick: TNotifyEvent read FOnClick write FOnClick;constructor TSelectDa.Create(AOwner: TComponent);
begin
  ...
  FButton.OnClick := Button1Click;
end;procedure TSelectDa.Button1Click(Sender: TObject);
begin
if Assigned(FOnClick) then FOnClick(Self);
end;

Answer 8

代码好像全部是对的，
现在的问题是这样的，我用代码动态创建
SelectDa1：=TSelectDa.create(self);
SelectDa1.parent:=self;
程序运行没有问题，可是我在IDE开发界面用拖拉形式往Form1里面放TSelectDa控件，运行时就出现找不到TEdit 类的提示，这是怎么会是?

Answer 9

构造时改为以为语句，就可以了
  FEdit:=TEdit.Create(Self);
  FButton:=TFlatButton.Create(Self);

Answer 10

还是有问题
control '' has no parent window怎么处理？

Answer 11

自己搞定了
unit USWLMSelectDa;{$S-,W-,R-}                                             
{$C PRELOAD}interfaceuses
  Windows,Messages,SysUtils, Types, Classes, Graphics, Controls,StdCtrls,Forms,
  StrUtils,Math,ADODB,TFlatButtonUnit,USWLMStyleEdit;type
  TEditDataType = (SdString, SdInteger,SdFloat,SdMoney);
  TVAlignment = (tvaTopJustify, tvaCenter, tvaBottomJustify);
type
  TSelectDa = class(TCustomControl)
  private
    FPen: TPen;
    FBrush:TBrush;
    FFont:TFont;
    FCaption:string;
    FBmText:string;
    FZjText:string;
    FMcText:string;
    FDataType: TEditDataType;
    FPrecision: Integer;
    FReadOnly:Boolean;
    FEditFont:TFont;
    FHAlignment : TAlignment;
    FVAlignment : TVAlignment;
    FEdit:TStyleEdit;
    FButton:TFlatButton;
    FCn:TADOConnection;
    FTitleName:string;
    FTableName:string;
    FDataStyle:Integer;
    FBmField:string;
    FZjField:string;
    FMcField:string;
    FOnClick: TNotifyEvent;
    FOnEnter: TNotifyEvent;
    FOnExit: TNotifyEvent;
    FOnKeyPress: TKeyPressEvent;
    procedure SetPen(const Value:TPen);
    procedure SetBrush(const Value:TBrush);
    procedure SetFont(const Value:TFont);
    procedure SetCaption(const Value:string);
    procedure SetBmText(const Value:string);
    procedure SetZjText(const Value:string);
    procedure SetMcText(const Value:string);
    procedure SetDataType(const Value: TEditDataType);
    procedure SetPrecision(const Value: Integer);
    procedure SetReadOnly(const Value:Boolean);
    procedure SetEditFont(const Value:TFont);
    procedure SetHAlignment(const Value:TAlignment);
    procedure SetVAlignment(const Value:TVAlignment);
    procedure SetCn(const Value:TADOConnection);
    procedure SetTitleName(const Value:string);
    procedure SetTableName(const Value:string);
    procedure SetDataStyle(const Value:Integer);
    procedure SetBmField(const Value:string);
    procedure SetZjField(const Value:string);
    procedure SetMcField(const Value:string);
    function  GetAsFloat(): string;
    function  GetAsMoney(): string;
    function  GetAsInteger(): string;
    function  GetAsText(): string;
    procedure SetAsFloat(const Value: string);
    procedure SetAsMoney(const Value: string);
    procedure SetAsInteger(const Value: string);
    procedure SetAsText(const Value: string);
    procedure StyleChanged(Sender: TObject);
  protected
    procedure Paint; override;
    procedure Click; override;
    procedure DoEnter; override;
    procedure DoExit; override;
    procedure KeyPress(var Key: Char); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
  published
    property Pen: TPen read FPen write SetPen;
    property Brush: TBrush read FBrush write SetBrush;
    property Font: TFont read FFont write SetFont;
    property Caption:string read FCaption write SetCaption;
    property Bm:string read FBmText write SetBmText ;
    property Zjf:string read FZjText write SetZjText ;
    property Mc:string read FMcText write SetMcText ;
    property Text:string read FMcText write SetMcText;
    property DataType: TEditDataType read FDataType write SetDataType default SdString;
    property Precision: Integer read Fprecision write SetPrecision default 2;
    property ReadOnly: Boolean read FReadOnly write SetReadOnly default False;
    property EditFont: TFont read FEditFont write SetEditFont;
    property HAlignment:TAlignment read FHAlignment write SetHAlignment default taLeftJustify;
    property VAlignment:TVAlignment read FVAlignment write SetVAlignment default tvaBottomJustify;
    property AsFloat:string read GetAsFloat {write SetAsFloat};
    property AsMoney:string read GetAsMoney {write SetAsMoney};
    property AsInt: string read GetAsInteger {write SetAsInteger};
    property AsStr: string read GetAsText write SetAsText;
    property AdoCn:TAdoConnection read FCn write SetCn;
    property TitleName:string read FTitleName write SetTitleName ;
    property TableName:string read FTableName write SetTableName ;
    property DataStyle:Integer read FDataStyle write SetDataStyle default 0;
    property BmField:string read FBmField write SetBmField ;
    property ZjField:string read FZjField write SetZjField ;
    property McField:string read FMcField write SetMcField ;
    property OnClick: TNotifyEvent read FOnClick write FOnClick;
    property OnKeyPress: TKeyPressEvent read FOnKeyPress write FOnKeyPress;
    property OnEnter: TNotifyEvent read FOnEnter write FOnEnter;
    property OnExit: TNotifyEvent read FOnExit write FOnExit;
  end;procedure Register;implementationuses Consts;procedure TSelectDa.SetPen(const Value: TPen);
begin
  FPen.Assign(Value);
  Invalidate;
end;procedure TSelectDa.SetBrush(const Value:TBrush);
begin
  FBrush.Assign(Value);
  Invalidate;
end;procedure TSelectDa.SetFont(const Value:TFont);
begin
  FFont.Assign(Value);
  Invalidate;
end;procedure TSelectDa.SetCaption(const Value:string);
begin
  if FCaption <> Value then
  begin
    FCaption:=Value;
    Invalidate;
  end;
end;procedure TSelectDa.SetBmText(const Value:string);
begin
  if FBmText <> Value then
  begin
    FBmText:=Value;
    Invalidate;
  end;
end;procedure TSelectDa.SetZjText(const Value:string);
begin
  if FZjText <> Value then
  begin
    FZjText:=Value;
  end;
end;procedure TSelectDa.SetMcText(const Value:string);
begin
  if FMcText <> Value then
  begin
    FMcText:=Value;
    Invalidate;
  end;
end;procedure TSelectDa.SetReadOnly(const Value:Boolean);
begin
  if FReadOnly<>Value then
  begin
    FReadOnly:=Value;
    Invalidate;
  end;
end;procedure TSelectDa.SetEditFont(const Value:TFont);
begin
  FEditFont.Assign(Value);
  Invalidate;
end;procedure TSelectDa.SetPrecision(const Value: Integer);
begin
  if Fprecision<>Value then
  begin
    case Value of
    1..6:FPrecision:=Value;
    else FPrecision:=2;
    end;
    Invalidate;
  end;
end;procedure TSelectDa.SetDataType(const Value: TEditDataType);
begin
  if FDataType <> Value then
  begin
    FDataType:=Value;
    case FDataType of
      SdString:FEdit.InputStyle:=IsString;
      SdInteger:FEdit.InputStyle:=IsInteger;
      SdFloat:FEdit.InputStyle:=IsFloat;
      SdMoney:FEdit.InputStyle:=IsMoney;
      else FEdit.InputStyle:=IsString;
    end;
    Invalidate;
  end;
end;procedure TSelectDa.SetHAlignment(const Value:TAlignment);
begin
  if FHAlignment <> Value then
  begin
      FHAlignment:=Value;
      Invalidate;
  end;
end;procedure TSelectDa.SetVAlignment(const Value:TVAlignment);
begin
  if FVAlignment <> Value then
  begin
      FVAlignment:=Value;
      Invalidate;
  end;
end;procedure TSelectDa.SetCn(const Value:TADOConnection);
begin
  FCn:=Value;
end;procedure TSelectDa.SetTitleName(const Value:string);
begin
  if FTitleName<>Value then FTitleName:=Value;
end;procedure TSelectDa.SetTableName(const Value:string);
begin
  if FTableName<>Value then
  begin
      FTableName:=Value;
      Invalidate;
  end;
end;procedure TSelectDa.SetDataStyle(const Value:Integer);
begin
  if FDataStyle<>Value then FDataStyle:=Value;
end;

Answer 12

procedure TSelectDa.SetBmField(const Value:string);
begin
  if FBmField<>Value then
  begin
      FBmField:=Value;
      Invalidate;
  end;
end;procedure TSelectDa.SetZjField(const Value:string);
begin
  if FZjField<>Value then  FZjField:=Value;
end;procedure TSelectDa.SetMcField(const Value:string);
begin
  if FMcField<>Value then
  begin
      FMcField:=Value;
      Invalidate;
  end;
end;function  TSelectDa.GetAsFloat: string;
  function StrToDouble(S:string):Double;
  begin
      if not trystrToFloat(s,Result) then Result:=0;
  end;
begin
  case FPrecision of
  1..6:  Result:=FormatFloat('###0.'+DupeString('0',FPrecision),StrToDouble(FMcText));
  else  Result:=FormatFloat('###0.00',StrToDouble(FMcText));
  end;
end;function  TSelectDa.GetAsMoney: string;
  function StrToDouble(S:string):Double;
  begin
      if not trystrToFloat(s,Result) then Result:=0;
  end;
begin
  Result:=FormatFloat('###0.00',StrToDouble(FMcText));
end;function  TSelectDa.GetAsInteger: string;
  Function StrToInteger(S:string):integer;
  begin
      if not trystrToInt(s,Result) then Result:=0;
  end;
begin
  Result:=IntToStr(StrToInteger(FMcText));
end;function  TSelectDa.GetAsText: string;
begin
  Result:=FMcText;
end;procedure TSelectDa.SetAsFloat(const Value: string);
  function StrToDouble(S:string):Double;
  begin
      if not trystrToFloat(s,Result) then Result:=0;
  end;
var
  f:Double;
begin
  f:=StrToDouble(Value);
  case FPrecision of
  1..6:
  begin
      f:=RoundTo(f,-FPrecision);
      SetMcText(FormatFloat('###0.'+DupeString('0',FPrecision),f));
  end
  else
  begin
      f:=RoundTo(f,-2);
      SetMcText(FormatFloat('###0.00',f));
  end;
  end;
end;procedure TSelectDa.SetAsMoney(const Value: string);
  function StrToDouble(S:string):Double;
  begin
      if not trystrToFloat(s,Result) then Result:=0;
  end;
var
  f:Double;
begin
  f:=StrToDouble(Value);
  f:=RoundTo(f,-2);
  SetMcText(FormatFloat('###0.00',f));
end;procedure TSelectDa.SetAsInteger(const Value: string);
  Function StrToInteger(S:string):integer;
  begin
      if not trystrToInt(s,Result) then Result:=0;
  end;
var
  i:Integer;
begin
  i:=StrToInteger(Value);
  SetMcText(IntToStr(i));
end;procedure TSelectDa.SetAsText(const Value: string);
begin
  SetMcText(Value);
end;procedure TSelectDa.StyleChanged(Sender: TObject);
begin
  Invalidate;
end;procedure TSelectDa.Click;
begin
  if Assigned(FOnClick) then FOnClick(Self);
end;procedure TSelectDa.DoExit;
begin
  if Assigned(FOnExit) then FOnExit(Self);
end;procedure TSelectDa.KeyPress(var Key: Char);
begin
  if Assigned(FOnKeyPress) then FOnKeyPress(Self, Key);
end;procedure TSelectDa.DoEnter;
begin
  if Assigned(FOnEnter) then FOnEnter(Self);
end;constructor TSelectDa.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width:=188;
  Height:=25;
  FCaption:='未命名';
  FBmText:='';
  FZjText:='';
  FMcText:='';
  FReadOnly:=False;
  FHAlignment:=taLeftJustify;
  FVAlignment:=tvaBottomJustify;
  FDataType:=SdString;
  FPrecision:=2;
  FCn:=nil;
  FTitleName:='';
  FTableName:='';
  FDataStyle:=0;
  FBmField:='';
  FZjField:='';
  FMcField:='';
  FPen := TPen.Create;
  FPen.OnChange:=StyleChanged;
  FBrush := TBrush.Create;
  FBrush.OnChange:=StyleChanged;
  FFont := TFont.Create;
  FFont.OnChange:=StyleChanged;
  FFont.Charset:=GB2312_CHARSET;
  FFont.Name:='宋体';
  FFont.Size:=9;
  FEditFont := TFont.Create;
  FEditFont.OnChange:=StyleChanged;
  FEditFont.Charset:=GB2312_CHARSET;
  FEditFont.Name:='宋体';
  FEditFont.Size:=9;
  FEdit:=TStyleEdit.Create(Self);
  FEdit.Parent:=Self;
  FEdit.OnKeyPress:=FOnKeyPress;
  FEdit.OnEnter:=FOnEnter;
  FEdit.OnExit:=FOnExit;
  FEdit.Height:=23;
  FEdit.Width:=168;
  FEdit.BorderStyle:=bsNone;
  FEdit.Alignment:=FHAlignment;
  FEdit.Font:=FEditFont;
  FEdit.Text:=FMcText;
  FButton:=TFlatButton.Create(Self);
  FButton.Parent:=Self;
  FButton.Font:=FFont;
  FButton.OnClick:=FOnClick;
  FButton.ColorBorder:=FBrush.Color;
  FButton.Color:=FBrush.Color;
  FButton.ColorDown:=FBrush.Color;
  FButton.ColorShadow:=FBrush.Color;
  FButton.ColorFocused:=FBrush.Color;
  FButton.Height:=23;
  FButton.Width:=20;
  FButton.Caption:='…';
end;procedure TSelectDa.Paint;
var
  aText:Pchar;
  aRect:TRect;
  Flag:DWORD;
begin
  with Canvas do
  begin
    Font:=FFont;
    Pen:=FPen;
    Brush:=FBrush;
    FillRect(ClientRect);
    if FBmText<>'' then aText:=Pchar(FCaption+'['+FBmText+']') else aText:=Pchar(FCaption);
    aRect:=Rect(ClientRect.Left+FPen.Width, ClientRect.Top+FPen.Width, ClientRect.Right-FPen.Width, ClientRect.Bottom-FPen.Width);
    DrawText(Handle, aText, StrLen(aText), aRect, (DT_SINGLELINE or DT_VCENTER) or DT_LEFT);
    Inc(aRect.Left,TextWidth(aText));
    Dec(aRect.Right,FButton.Width);
    MoveTo(aRect.Left,aRect.Bottom);
    LineTo(aRect.Right,aRect.Bottom);
    Inc(aRect.Left,FPen.Width);
    if FReadOnly then
    begin
      FEdit.Visible:=False;
      Flag:=DT_SINGLELINE;
      case FHAlignment of
        taLeftJustify:Flag:=Flag or DT_LEFT;
        taRightJustify:Flag:=Flag or DT_RIGHT;
        taCenter:Flag:=Flag or DT_CENTER;
        else Flag:=Flag or DT_LEFT;
      end;
      case FVAlignment of
        tvaTopJustify:Flag:=Flag or DT_TOP;
        tvaCenter:Flag:=Flag or DT_VCENTER;
        tvaBottomJustify:Flag:=Flag or DT_BOTTOM;
        else Flag:=Flag or DT_BOTTOM;
      end;
      Font:=FEditFont;
      case FDataType of
        SdString:DrawText(Handle, PChar(AsStr),  StrLen(PChar(AsStr)), aRect, Flag);
        SdInteger:DrawText(Handle, PChar(AsInt), StrLen(PChar(AsInt)), aRect, Flag);
        SdFloat:DrawText(Handle, PChar(AsFloat), StrLen(PChar(AsFloat)), aRect, Flag);
        SdMoney:DrawText(Handle, PChar(AsMoney), StrLen(PChar(AsMoney)), aRect, Flag);
      end;
    end
    else
    begin
      FEdit.Alignment:=FHAlignment;
      FEdit.Font:=FEditFont;
      FEdit.Width:=aRect.Right-aRect.Left;
      FEdit.Height:=Min(Max(TextHeight(FMcText),TextHeight(FCaption)),aRect.Bottom-aRect.Top);
      FEdit.Left:=aRect.Left;
      case FVAlignment of
        tvaTopJustify:FEdit.Top:=aRect.Top;
        tvaCenter:FEdit.Top:=aRect.Top+(aRect.Bottom-aRect.Top-FEdit.Height)div 2;
        tvaBottomJustify:FEdit.Top:=aRect.Top+(aRect.Bottom-aRect.Top-FEdit.Height);
        else FEdit.Top:=aRect.Top;
      end;
      FButton.Left:=aRect.Right;
      FButton.Top:=aRect.Top;
      FButton.Height:=aRect.Bottom-aRect.Top;
      if (FDataType=SdString) and (FBmField<>'') and (FMcField<>'') and (FTableName<>'') then FButton.Visible:=True
      else FButton.Visible:=False;
    end;
  end;
end;destructor TSelectDa.Destroy;
begin
  FPen.Free;
  FBrush.Free;
  FFont.Free;
  FEditFont.Free;
  if Assigned(FEdit) then FreeAndNil(FEdit);
  if Assigned(FButton) then FreeAndNil(FButton);
  inherited Destroy;
end;procedure Register;
begin
  RegisterComponents('swlmsoft', [TSelectDa]);
end;end.