程序師世界是廣大編程愛好者互助、分享、學習的平台,程序師世界有你更精彩!
首頁
編程語言
C語言|JAVA編程
Python編程
網頁編程
ASP編程|PHP編程
JSP編程
數據庫知識
MYSQL數據庫|SqlServer數據庫
Oracle數據庫|DB2數據庫
 程式師世界 >> 編程語言 >> 更多編程語言 >> Delphi >> Delphi控件制作技巧[二]

Delphi控件制作技巧[二]

編輯:Delphi
 

  unit USWLMSelectDa;

  {$S-,W-,R-}                                            
  {$C PRELOAD}

  interface

  uses
    Windows,Messages,SysUtils, Types, Classes, Graphics, Controls,StdCtrls,Forms,
    StrUtils,Math,ADODB,TFlatButtonUnit,USWLMStyleEdit;

  type
    TEditDataType = (sdString, sdInteger,sdFloat,sdMoney,sdDate);
    TVAlignment = (tvaTopJustify, tvaCenter, tvaBottomJustify);
    TDataStyle = (dsBm, dsZj, dsMc);
  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;
      FTitleName:string;
      FTableName:string;
      FDataStyle:TDataStyle;
      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 SetTitleName(const Value:string);
      procedure SetTableName(const Value:string);
      procedure SetDataStyle(const Value:TDataStyle);
      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;
      function  GetAsDate(): 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);
      procedure SetBackColor(const Value : TColor);
      procedure SetColorOnEnter(const Value : TColor);
      {
      procedure DoClick(Sender: TObject);
      procedure DoEnter(Sender: TObject);
      procedure DoExit(Sender: TObject);
      procedure DoKeyPress(Sender: TObject; var Key: Char);
      }

      procedure SetOnClick(const Value:TNotifyEvent);
      procedure SetOnKeyPress(const Value:TKeyPressEvent);
      procedure SetOnEnter(const Value:TNotifyEvent);
      procedure SetOnExit(const Value:TNotifyEvent);

    protected
      procedure Paint; 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 TitleName:string read FTitleName write SetTitleName ;
      property TableName:string read FTableName write SetTableName ;
      property DataStyle:TDataStyle read FDataStyle write SetDataStyle default dsBm;
      property BmField:string read FBmField write SetBmField ;
      property ZjField:string read FZjField write SetZjField ;
      property McField:string read FMcField write SetMcField ;
      property AsFloat:string read GetAsFloat {write SetAsFloat};
      property AsMoney:string read GetAsMoney {write SetAsMoney};
      property AsInt: string read GetAsInteger {write SetAsInteger};
      property AsDate: string read GetAsDate ;
      property AsStr: string read GetAsText write SetAsText;
      property OnClick: TNotifyEvent read FOnClick write SetOnClick;
      property OnKeyPress: TKeyPressEvent read FOnKeyPress write SetOnKeyPress;
      property OnEnter: TNotifyEvent read FOnEnter write SetOnEnter;
      property OnExit: TNotifyEvent read FOnExit write SetOnExit;
      property BackColor : TColor write SetBackColor;
      property ColorOnEnter : TColor write SetColorOnEnter;
      property AlignDisabled;
      property VisibleDockClientCount;
      property ControlCount;
      property ParentWindow;
      property Showing;
      property TabOrder;
      property TabStop;
    end;

  procedure Register;

  implementation

  uses 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;
        SdDate:FEdit.InputStyle:=IsDate;
        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.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:TDataStyle);
  begin
    if FDataStyle<>Value then FDataStyle:=Value;
  end;

  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.GetAsDate(): string;
  var
    TempDate:TDateTime;
  begin
    if TryStrToDate(FMcText,TempDate) then Result:=FormatDateTime('YYYY-MM-DD',TempDate)
    else Result:='';
  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.SetBackColor(const Value : TColor);
  begin
    FEdit.BackColor:=Value;
  end;

  procedure TSelectDa.SetColorOnEnter(const Value : TColor);
  begin
    FEdit.ColorOnEnter:=Value;
  end;

  constructor TSelectDa.Create(AOwner: TComponent);
  begin
    inherited Create(AOwner);
    Width:=188;
    Height:=20;
    FCaption:='未命名';
    FBmText:='';
    FZjText:='';
    FMcText:='';
    FReadOnly:=False;
    FHAlignment:=taLeftJustify;
    FVAlignment:=tvaBottomJustify;
    FDataType:=SdString;
    FPrecision:=2;
    FTitleName:='';
    FTableName:='';
    FDataStyle:=dsBm;
    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.BorderStyle:=bsNone;
    FEdit.InputStyle:=isString;
    {
    FEdit.OnKeyPress:=DoKeyPress;
    FEdit.OnEnter:=DoEnter;
    FEdit.OnExit:=DoExit;
    }
    FButton:=TFlatButton.Create(Self);
    FButton.Parent:=Self;
    FButton.Font:=FFont;
    FButton.ColorBorder:=FBrush.Color;
    FButton.Color:=FBrush.Color;
    FButton.ColorDown:=FBrush.Color;
    FButton.ColorShadow:=FBrush.Color;
    FButton.ColorFocused:=FBrush.Color;
    FButton.Width:=19;
    FButton.Caption:='…';
    {
    FButton.OnClick:=DoClick;
    }
  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;
        FButton.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);
          SdDate:DrawText(Handle, PChar(AsDate), StrLen(PChar(AsDate)), aRect, Flag);
        end;
      end
      else
      begin
        FEdit.Alignment:=FHAlignment;
        FEdit.Font:=FEditFont;
        FEdit.Text:=FMcText;
        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<>''))
           or (FDataType=SdDate) 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 TSelectDa.DoClick(Sender: TObject);
  begin
    if Assigned(FOnClick) then FOnClick(Self);
  end;

  procedure TSelectDa.DoEnter(Sender: TObject);
  begin
    if Assigned(FOnEnter) then FOnEnter(Self);
  end;

  procedure TSelectDa.DoExit(Sender: TObject);
  begin
    if Assigned(FOnExit) then FOnExit(Self);
  end;

  procedure TSelectDa.DoKeyPress(Sender: TObject; var Key: Char);
  begin
    if Assigned(FOnKeyPress) then FOnKeyPress(Self,Key);
  end;
  }

  procedure TSelectDa.SetOnClick(const Value:TNotifyEvent);
  begin
    if @FOnClick<>@Value then
    begin
      FOnClick:=Value;
      FButton.OnClick:=FOnClick;
    end;
  end;

  procedure TSelectDa.SetOnKeyPress(const Value:TKeyPressEvent);
  begin
    if @FOnKeyPress<>@Value then
    begin
      FOnKeyPress:=Value;
      FEdit.OnKeyPress:=FOnKeyPress;
    end;
  end;

  procedure TSelectDa.SetOnEnter(const Value:TNotifyEvent);
  begin
    if @FOnEnter<>@Value then
    begin
      FOnEnter:=Value;
      FEdit.OnEnter:=FOnEnter;
    end;
  end;

  procedure TSelectDa.SetOnExit(const Value:TNotifyEvent);
  begin
    if @FOnExit<>@Value then
    begin
      FOnExit:=Value;
      FEdit.OnExit:=FOnExit;
    end;
  end;

  procedure Register;
  begin
    RegisterComponents('swlmsoft', [TSelectDa]);
  end;

  end.

  1. 上一頁:
  2. 下一頁:
Copyright © 程式師世界 All Rights Reserved