flatajhedit.pas

FlatStyle 一组平面控件

unit FlatAJHEdit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, TFlatEditUnit,Buttons,MMsystem,Mask;
  {$R COMEDIT.res}
type
  TButtonGlyphKind = (gkSearch,gkSave,gkFile,gkAdd,gkRemove,gkHome,gkOpen,gkCheck,
   gkEllipsis,gkMail,gkTime,gkDate,gkCustom,gkHelp,gkSilly,gkCancel);
  TButtonLayout = (boGlyphLeft, boGlyphRight);
  TButtonCursor = (cuHandPoint,cuArrow);
  TNumGlyphs = 1..4;

  TFlatAJHEdit = class(TFlatEdit)
  private
    FButtonGlyphKind:TButtonGlyphKind;
    FButton:TSpeedButton;
    FButtonCursor: TButtonCursor;
    FButtonLayout:TButtonLayout;
    Fsirina:integer;
    FCop: string;
    FShowButton:boolean;
    function GetCop: string;
    procedure SetCop(const Value: string);
    procedure SetButtonGlyphKind(value:TButtonGlyphKind);
    procedure SetButtonLayout(value:TButtonLayout);
    procedure SetButtonCursor(value:TButtonCursor);
    procedure SetFlat(Value: boolean);
    function  GetFlat:boolean;
    procedure SetCaption(const Value: String);
    function  GetCaption:String;
    procedure SetButtonHint(const Value: String);
    function  GetButtonHint:String;
    procedure SetGlyph(const Value: TBitmap);
    function  GetGlyph:TBitmap;
    procedure SetSirina(ASirina:integer);
    function GetNumGlyphs: TNumGlyphs;
    procedure SetNumGlyphs(Value: TNumGlyphs);
    procedure CmEnabledChanged(var Message: TWmNoParams); message CM_ENABLEDCHANGED;
    procedure CmParentColorChanged(var Message: TWMNoParams); message CM_PARENTCOLORCHANGED;
    procedure CmVisibleChanged(var Message: TWmNoParams); message CM_VISIBLECHANGED;
    procedure CmParentFontChanged(var Message: TWMNoParams); message CM_FONTCHANGED;
    function GetOnButtonClick: TNotifyEvent;
    procedure SetOnButtonClick(Value: TNotifyEvent);
    procedure TextChanged(sender: TObject);
    procedure setbutton(const value:boolean);
  protected
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure CreateWnd;override;
  public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
  published
   property Copyright: string read GetCop write SetCop;
   property ButtonGlyphKind:TButtonGlyphKind read FButtonGlyphKind write SetButtonGlyphKind default gkCustom;
   property ButtonLayout:TButtonLayout read FButtonLayout write SetButtonLayout default boGlyphLeft;
   property ButtonFlat:boolean read GetFlat write SetFlat default False;
   property ShowButton:boolean read FShowButton write setbutton;
   property ButtonHint:String
   read GetButtonHint write SetButtonHint;
   property ButtonCursor:TButtonCursor
   read FButtonCursor write SetButtonCursor default cuHandPoint;
   property OnChange;
   property OnClick;
   property OnDblClick;
   property OnDragDrop;
   property OnDragOver;
   property OnEndDrag;
   property OnEnter;
   property OnExit;
   property OnKeyDown;
   property OnKeyPress;
   property OnMouseDown;
   property OnMouseMove;
   property OnMouseUp;
   property OnStartDrag;
   property OnClickButton: TNotifyEvent read GetOnButtonClick write SetOnButtonClick;
   property ButtonGlyph:TBitmap read GetGlyph write SetGlyph;
   property CharCase;
   property Text;
   property Font;
   property ButtonWidth:integer read FSirina write SetSirina default 20;
   property ButtonNumGlyphs: TNumGlyphs read GetNumGlyphs write SetNumGlyphs default 1;
   property Visible;
   property Enabled;
   property ParentColor;
   property ParentFont;
   property Color;
   property ButtonCaption:String read GetCaption write SetCaption;
   property Hint;
   property ShowHint;
   property Ctl3D;
   property DragCursor;
   property DragMode;
   property HelpContext;
   property HideSelection;
   property ImeMode;
   property ImeName;
   property MaxLength;
   property OEMConvert;
   property ParentCtl3D;
   property PasswordChar;
   property PopupMenu;
   property ReadOnly;
   property TabOrder;
   property TabStop;
   property BorderStyle;

  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('FlatStyle', [TFlatAJHEdit]);
end;

constructor TFlatAJHEdit.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 //ControlStyle:= ControlStyle + [csAcceptsControls];
  FSirina:=20;
  FCop:='Copyright 2003-2004 by [e-mail]';
  FButtonCursor:= cuArrow;
  FButton := TSpeedButton.Create(Self);
  FButton.Parent:=self;
  FButton.width:=FSirina;
  FButton.top:=top;
  Fbutton.Height :=Height-4;
  Fbutton.Left := Width-FButton.width-4;
  FButton.cursor:=crArrow;
  FButton.ShowHint:=true;
  FButton.Flat:=False;
  FButtonLayout:=boGlyphLeft;
  FButtonGlyphKind:=gkCustom;
  FShowbutton:=true;
  //FButton.Visible:=false;
end;

procedure  TFlatAJHEdit.setbutton(const value:boolean);
begin
  FShowbutton:=value;
  FButton.Visible:=value;
  if FButton.Visible=false then FButton.Width:=0 else FButton.width:=FSirina;
end;

destructor  TFlatAJHEdit.Destroy;
begin
  FButton.Free;
  inherited Destroy;
end;

function TFlatAJHEdit.GetCop: string;
begin
Result:=FCop;
end;


procedure TFlatAJHEdit.SetCop(const Value: string);
begin
FCop:=FCop;
end;

procedure TFlatAJHEdit.SetButtonGlyphKind(value:TButtonGlyphKind);
begin
  if value <> FButtonGlyphKind then
  begin
    FButtonGlyphKind := value;
    Fbutton.NumGlyphs:=1;

    case FButtonGlyphKind of
    gkSearch:
Fbutton.Glyph.Handle := LoadBitmap(hInstance, 'lupace');
    gkSave:
Fbutton.Glyph.Handle := LoadBitmap(hInstance, 'disketace');
    gkFile:
Fbutton.Glyph.Handle := LoadBitmap(hInstance, 'filece');
    gkAdd:
Fbutton.Glyph.Handle := LoadBitmap(hInstance, 'plusce');
    gkRemove:
Fbutton.Glyph.Handle := LoadBitmap(hInstance, 'minusce');
    gkHome:
Fbutton.Glyph.Handle := LoadBitmap(hInstance, 'homece');
    gkOpen:
Fbutton.Glyph.Handle := LoadBitmap(hInstance, 'opence');
    gkCheck:
Fbutton.Glyph.Handle := LoadBitmap(hInstance, 'checkce');
    gkEllipsis:
Fbutton.Glyph.Handle := LoadBitmap(hInstance, 'elace');
    gkMail:
Fbutton.Glyph.Handle := LoadBitmap(hInstance, 'mailce');
    gkTime:
Fbutton.Glyph.Handle := LoadBitmap(hInstance, 'satce');
    gkDate:
Fbutton.Glyph.Handle := LoadBitmap(hInstance, 'datece');
    gkHelp:
Fbutton.Glyph.Handle := LoadBitmap(hInstance, 'helpce');
    gkSilly:
Fbutton.Glyph.Handle := LoadBitmap(hInstance, 'glupce');
    gkCancel:
Fbutton.Glyph.Handle := LoadBitmap(hInstance, 'delce');
end;
end;
end;

procedure TFlatAJHEdit.SetButtonLayout(Value:TButtonLayout);
begin
  if value <> FButtonLayout then
  begin
    FButtonLayout := value;
    case FButtonLayout of
    boGlyphLeft:
    FButton.Layout:=blGlyphLeft;
    boGlyphRight:
    FButton.Layout:=blGlyphRight;
    end;
  end;
end;

procedure TFlatAJHEdit.SetButtonCursor(Value:TButtonCursor);
begin
  if value <> FButtonCursor then
  begin
    FButtonCursor := value;
    case FButtonCursor of
    cuHandPoint:
    FButton.cursor:=crHandPoint;
    cuArrow:
    FButton.cursor:=crArrow;
    end;
  end;
end;

function TFlatAJHEdit.GetOnButtonClick: TNotifyEvent;
begin
  Result := FButton.OnClick;
end;

procedure TFlatAJHEdit.SetOnButtonClick(Value: TNotifyEvent);
begin
  FButton.onClick := Value;
end;

procedure TFlatAJHEdit.CmParentFontChanged(var Message: TWMNoParams);
begin
  inherited;
  RecreateWnd;
end;

procedure TFlatAJHEdit.TextChanged(sender: TObject);
begin
  inherited;
 // SendMessage(Handle, EM_LIMITTEXT, MaxLength, 0);
  Perform(EM_SETMARGINS,EC_RIGHTMARGIN,(FButton.Width+4)*$10000);
end;

procedure TFlatAJHEdit.CmParentColorChanged(var Message: TWMNoParams);
begin
  inherited;
  RecreateWnd;
end;

procedure TFlatAJHEdit.CmVisibleChanged(var Message: TWmNoParams);
begin
  inherited;
end;


procedure TFlatAJHEdit.CmEnabledChanged(var Message: TWmNoParams);
begin
  inherited;
  FButton.enabled:=enabled;
end;

function TFlatAJHEdit.GetFlat: boolean;
begin
  Result := FButton.Flat;
end;

procedure TFlatAJHEdit.SetFlat(Value: boolean);
begin
  FButton.Flat := Value;
end;

function TFlatAJHEdit.GetNumGlyphs: TNumGlyphs;
begin
  Result := FButton.NumGlyphs;
end;

procedure TFlatAJHEdit.SetNumGlyphs(Value: TNumGlyphs);
begin
  if Value < 0 then Value := 1
  else if Value > 4 then Value := 4;
  if Value <> FButton.NumGlyphs then
  begin
    FButton.NumGlyphs := Value;
    Invalidate;
  end;
end;

procedure TFlatAJHEdit.SetGlyph(const Value: TBitmap);
begin

 FButton.Glyph.assign(Value);
 if not FButton.Glyph.Empty then
 begin
 //if  FButton.Glyph.Width = FButton.Glyph.Height then FButton.NumGlyphs :=1;
 if  FButton.Glyph.Width < FButton.Glyph.Height then FButton.NumGlyphs :=1;
  if FButton.Glyph.Width mod FButton.Glyph.Height = 0 then
      begin
        FButton.NumGlyphs := FButton.Glyph.Width div FButton.Glyph.Height;
end;
end;
 if FButton.Glyph.Empty then FButton.NumGlyphs :=1;
 FButtonGlyphKind:=gkCustom;
end;


function TFlatAJHEdit.GetGlyph: TBitmap;
begin
  result:=FButton.Glyph;
end;

procedure TFlatAJHEdit.SetButtonHint(const Value: String);
begin
FButton.Hint:=Value;
end;

function  TFlatAJHEdit.GetButtonHint:String;
begin
result:=Fbutton.Hint;
end;

procedure TFlatAJHEdit.SetCaption(const Value: String);
begin
FButton.caption:=Value;
end;

function  TFlatAJHEdit.GetCaption:String;
begin
result:=Fbutton.caption;
end;

procedure TFlatAJHEdit.SetSirina(ASirina:integer);
begin
FSirina:=ASirina;
FButton.Width:=Fsirina;
RecreateWnd;
end;


procedure TFlatAJHEdit.WMSize(var Message: TWMSize);
begin
  inherited;
  if Ctl3D then
  begin
  Fbutton.Height :=Height-4;
  Fbutton.Left := Width-FButton.width-4;
  Perform(EM_SETMARGINS,EC_RIGHTMARGIN,(FButton.Width+4)*$10000);
  end
  else
  begin
  Fbutton.Height :=Height;
  Fbutton.Left := Width-FButton.width;
  Perform(EM_SETMARGINS,EC_RIGHTMARGIN,(FButton.Width+4)*$10000);
  end;

end;

procedure TFlatAJHEdit.CreateWnd;
begin
  inherited;
 if Ctl3D then
  begin
  Fbutton.Height :=Height-4;
  Fbutton.Left := Width-FButton.width-4;
  Perform(EM_SETMARGINS,EC_RIGHTMARGIN,(FButton.Width+4)*$10000);
  end
  else
  begin
  Fbutton.Height :=Height;
  Fbutton.Left := Width-FButton.width;
  Perform(EM_SETMARGINS,EC_RIGHTMARGIN,(FButton.Width+4)*$10000);
  end;

end;

end.