网络编程 | 站长之家 | 网页制作 | 图形图象 | 操作系统 | 冲浪宝典 | 软件教学 | 网络办公 | 邮件系统 | 网络安全 | 认证考试 | 系统进程
Firefox | IE | Maxthon | 迅雷 | 电驴 | BitComet | FlashGet | QQ | QQ空间 | Vista | 输入法 | Ghost | Word | Excel | wps | Powerpoint
asp | .net | php | jsp | Sql | c# | Ajax | xml | Dreamweaver | FrontPages | Javascript | css | photoshop | fireworks | Flash | Cad | Discuz!
当前位置 > 网站建设学院 > 网络编程 > Delphi
Tag:注入,存储过程,分页,安全,优化,xmlhttp,fso,jmail,application,session,防盗链,stream,无组件,组件,md5,乱码,缓存,加密,验证码,算法,cookies,ubb,正则表达式,水印,索引,日志,压缩,base64,url重写,上传,控件,Web.config,JDBC,函数,内存,PDF,迁移,结构,破解,编译,配置,进程,分词,IIS,Apache,Tomcat,phpmyadmin,Gzip,触发器,socket
网络编程:ASP教程,ASP.NET教程,PHP教程,JSP教程,C#教程,数据库,XML教程,Ajax,Java,Perl,Shell,VB教程,Delphi,C/C++教程,软件工程,J2EE/J2ME,移动开发
本月文章推荐
.关于在Delphi中应用IinternetPro.
.获取其他进程中ListBox和ComboBo.
.DELPHI中的消息处理机制.
.移动没有CAPTION的窗体.
.TComboBox下拉取值.
.讲述如何开发一个控件,很有价值(.
.Delphi中的DLL封装和调用对象编写.
.GetPartFilter+SumStocklist.
.用Delphi在工业控制和自动化实现.
.感知鼠标移入移出组件.
.WinAPI编程关闭QQ登录窗体.
.創建一個簡單的"專家".
.Delphi开发经验四则.
.在Delphi中动态生成QuickReport报.
.利用钩子捕捉鼠标信息的一个问题.
.DELPHI的奇异菜单的编写.
.Delphi,编译文件(第12页).
.利用热键控制鼠标移动的一个程序.
.BORLAND第三方组件安装方法.
.动态创建ClientDataSet的表定义.

可以左右居中对齐并可设置DisplayFormat的Edit控件

发表日期:2006-2-4


欢迎测试!

liang_z@163.net

unit OWEdit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TInputDataType = (tFloat,tInteger,tAll);

type
  TOWEdit = class(TEdit)
  private
    { Private declarations }
    FCanvas : TCanvas;
    FDataType: TInputDataType;
    FAlignment : TAlignment;
    FDisplayFormat : String;
    FDeciNum : Word;
    FDisplayText : String;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  protected
    { Protected declarations }
    procedure SetDataType(Value:TInputDataType);
    procedure SetAlignment(Value:TAlignment);
    procedure SetDisplayFormat(Value:String);
    procedure ClipPaste(var M:TMessage); Message WM_PASTE;
    procedure PaintWindow(DC: HDC); override;
    procedure Paint; virtual;
    procedure WMExit(var Message:TWMKillFocus);Message WM_KILLFOCUS;
    procedure GetDisplayText;
    procedure ShowDisplayText;
    function  GetDeciLast:integer;
  public
    { Public declarations }
    OldText : String;
    property Text;
    property Canvas: TCanvas read FCanvas;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy(); override;
    procedure KeyPress(var Key: Char); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  published
    { Published declarations }
    property DataType: TInputDataType read fDataType write SetDataType default tFloat;
    property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
    property DisplayFormat: string read FDisplayFormat write SetDisplayFormat;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Ourway', [TOWEdit]);
end;

constructor TOWEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Text := '0';
  FCanvas := TControlCanvas.Create;
  TControlCanvas(FCanvas).Control := Self;
  FDeciNum := 9999;
end;

destructor TOWEdit.Destroy();
begin
  FCanvas.Free;
  inherited Destroy();
end;

procedure TOWEdit.SetDataType(Value:TInputDataType);
begin
  If Value<>fDataType Then
  begin
    fDataType := Value;
    Case Value of
      tAll: Text := ';
      tFloat: Text:='0.0';
      tInteger: Text:='0';
    end;
    ShowDisplayText;
    Invalidate;
  end;
end;

procedure TOWEdit.SetAlignment(Value:TAlignment);
begin
  If Value<>FAlignment Then
  begin
    FAlignment := Value;
    Invalidate;
  end;
end;

procedure TOWEdit.SetDisplayFormat(Value: string);
begin
  If Value<>FDisplayFormat Then
  begin
    FDisplayFormat := Value;
    if Trim(Value)<>' then
      FDeciNum := Length(Value)-Pos('.',Value)+1
    else
      FDeciNum := 9999;
    ShowDisplayText;
    Invalidate;
  end;
end;

procedure TOWEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if Key = VK_DELETE then
    if Self.SelStart=pos('.',Self.Text)-1 then
      Key := 0;
  inherited KeyDown(Key,Shift);
end;
procedure TOWEdit.KeyPress(var Key: Char);
var
  kv: Integer;
begin
  kv := Ord(Key);
  case fDataType of
    tInteger:
      if (((kv>58) or (kv<48)) and (kv<>3) and (kv<>22) and (kv<>8) and (kv<>13)) then
         Key := chr(0);
    tFloat:
      begin
        if (((kv>58) or (kv<48)) and (kv<>3) and (kv<>22) and (kv<>46) and (kv<>8) and (kv<>13)) then
           Key := chr(0)
        else
        begin
          if (kv=46) and (Pos('.',self.Text)>0) then//已有小数点
            Key := chr(0)
          else
            if MaxLength<1 then//小数点前面位数不定
            begin
              if ((GetDeciLast>=FDeciNum) and (kv<>8)) then //退格键
                if ((self.SelLength=0)and(pos('.',copy(Self.Text,1,self.SelStart))>0))then
                  Key := chr(0);
            end
            else//输入总长度已定
            begin
              if pos('.',copy(self.Text,1,self.selStart))<1 then
              begin//光标在小数点之前
                if ((self.SelStart>=MaxLength-FDeciNum)and(kv<>8)and(kv<>46)) then
                    Key := chr(0);
              end
              else
              begin//光标在小数点之后
                if ((GetDeciLast>=FDeciNum) and (kv<>8) and (self.SelLength=0)and(pos('.',copy(Self.Text,1,self.SelStart))>0)) then
                    Key := chr(0);
              end;
            end;
        end;
      end;
    else
  end;
  if (kv=8)and(Self.SelStart>0)and(Self.Text[self.SelStart]='.')and(GetDeciLast>1) then
    Key := chr(0);
  //还有一个Delete键没有截获!如果用此键删除小数点,还是有可能出错的。
  //搞定!用KeyDown override
  inherited KeyPress(Key);
end;

procedure TOWEdit.ClipPaste(var M:TMessage);
begin
  if fDataType=tAll then
    inherited;
end;

procedure TOWEdit.WMPaint(var Message: TWMPaint);
begin
  inherited;
  PaintWindow(Message.DC);
end;

procedure TOWEdit.PaintWindow(DC: HDC);
begin
  FCanvas.Lock;
  try
    FCanvas.Handle := DC;
    try
      TControlCanvas(FCanvas).UpdateTextFlags;
      Paint;
    finally
      FCanvas.Handle := 0;
    end;
  finally
    FCanvas.Unlock;
  end;
end;

procedure TOWEdit.Paint;
begin
  if not Focused then
  begin
    ShowDisplayText;
  end
  else
    inherited;
end;

procedure TOWEdit.WMExit(var Message:TWMKillFocus);
begin
  inherited;
  ShowDisplayText;
end;

procedure TOWEdit.GetDisplayText;
var
  ShowText : String;
begin
  ShowText := Text;
  if FDataType<>tAll then
  begin
    if Trim(ShowText)=' then
      ShowText := '0';
    if FDatatype=tFloat then
      ShowText := FormatFloat(FDisplayFormat,StrToFloat(ShowText))
    else
      ShowText := FormatFloat(FDisplayFormat,StrToInt(ShowText));
  end;
  FDisplayText := ShowText;
end;

procedure TOWEdit.ShowDisplayText;
var
  Rect : TRect;
  x,y : Integer;
begin
  GetDisplayText;
  Canvas.Lock;
  try
    Rect.Left := 1;
    Rect.Top := 1;
    Rect.Right := Width-1;
    Rect.Bottom:= Height-1;
    Canvas.Font := Font;
    if not Enabled then
      Canvas.Font.Color := clGrayText;
    Canvas.Brush.Color:=Self.Color;
    Canvas.FillRect(Rect);
    y := 2; x := 2;
    Case FAlignment of
      taLeftJustify:;
      taRightJustify:
        x := Width-Canvas.TextWidth(FDisplayText)-5;
    else
      x := (Width-Canvas.TextWidth(FDisplayText)-5)div 2;
    end;
    Canvas.TextOut(x,y,FDisplayText);
  finally
    Canvas.Unlock;
  end;
end;

function TOWEdit.GetDeciLast:integer;
var
  i : Integer;
begin
  Result := 0;
  if Pos('.',Text)>0 then
  begin
    for i:=1 to Length(Text) do
      if Text[i]='.' then
      begin
        Result := Length(Text)-i+1;//Length(Copy(Text,i,Length(Text)-i));
        Exit;
      end;
  end;
end;

end.

上一篇:如何访问一个进程的内存空间 人气:4766
下一篇:Delphi语言优化 人气:4637
浏览全部Delphi的内容 Dreamweaver插件下载 网页广告代码 祝你圣诞节快乐 2009年新年快乐