unit MUH_Edit;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TMUH_Edit =
class(TCustomEdit)
private
BorderCol: TColor;
BorderCol2: TColor;
Bckrnd: TColor;
FCanvas: TCanvas;
MouseInControl: Boolean;
procedure NewAdjustHeight;
procedure CMFontChanged (
var Message: TMessage);
message CM_FONTCHANGED;
procedure CMMouseEnter (
var Message: TMessage);
message CM_MOUSEENTER;
procedure CMMouseLeave (
var Message: TMessage);
message CM_MOUSELEAVE;
procedure WMSetFocus (
var Message: TWMSetFocus);
message WM_SETFOCUS;
procedure WMKillFocus (
var Message: TWMKillFocus);
message WM_KILLFOCUS;
procedure WMNCCalcSize (
var Message: TWMNCCalcSize);
message WM_NCCALCSIZE;
procedure WMNCPaint (
var Message: TMessage);
message WM_NCPAINT;
procedure SetBorderCol(Value:TColor);
procedure SetBorderCol2(Value: TColor);
procedure SetBckrnd(Value: TColor);
procedure Paint(
const Clip: HRGN);
public
constructor Create (AOwner: TComponent);
override;
procedure Loaded;
override;
published
property BackgroundColor: TColor
read Bckrnd
write SetBckrnd;
property BorderColor: TColor
read BorderCOl
write SetBorderCol;
property BorderColor_hell: TColor
read BorderCol2
write SetBorderCol2;
property Align;
property AutoSize;
property BorderStyle;
property CharCase;
property DragCursor;
property DragMode;
property Enabled;
property Font;
property HideSelection;
property MaxLength;
property OEMConvert;
property ParentFont;
property ParentShowHint;
property PasswordChar;
property PopupMenu;
property ReadOnly;
property ShowHint;
property TabOrder;
property TabStop;
property Text;
property Visible;
property OnChange;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDrag;
{$IFDEF D4CB4}
property Anchors;
property BiDiMode;
property Constraints;
property DragKind;
property ParentBiDiMode;
property OnEndDock;
property OnStartDock;
{$ENDIF}
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('
MUH Messenger', [TMUH_EDIT]);
end;
constructor TMUH_Edit.Create (AOwner: TComponent);
begin
inherited;
ParentFont := True;
BorderCol := $00849295;
BorderCol2 := $00E7EBEF;
Bckrnd := clWhite;
FCanvas := TControlCanvas.Create;
TControlCanvas(FCanvas).Control := self;
AutoSize := False;
Ctl3D := False;
ControlStyle := ControlStyle - [csFramed];
SetBounds(0, 0, 121, 19);
end;
procedure TMUH_Edit.Paint(
const Clip: HRGN);
var
Points:
array [0..8]
of TPoint;
aRect: TRect;
R: TRect;
begin
GetWindowRect(
Handle, R);
InflateRect(R, 3, 3);
FCanvas.Brush.Color := Bckrnd;
FCanvas.Rectangle(Rect(1,1,Width,Height));
FCanvas.Brush.Color := BorderCol;
FCanvas.FrameRect(Rect(0,0,Width,Height));
FCanvas.Pen.Color := BorderCol2;
FCanvas.MoveTo(1,Height-2);
FCanvas.LineTo(1,1);
FCanvas.LineTo(Width-1,1);
FCanvas.Brush.Style := bsClear;
FCanvas.TextOut(0,0,Text);
end;
procedure TMUH_Edit.NewAdjustHeight;
var
DC: HDC;
SaveFont: HFONT;
Metrics: TTextMetric;
begin
DC := GetDC(0);
SaveFont := SelectObject(
DC, Font.Handle);
GetTextMetrics(
DC, Metrics);
SelectObject(
DC, SaveFont);
ReleaseDC(0,
DC);
Height := Metrics.tmHeight + 6;
end;
procedure TMUH_Edit.CMFontChanged(
var Message: TMessage);
begin
inherited;
if not((csDesigning
in ComponentState)
and (csLoading
in ComponentState))
then
NewAdjustHeight;
end;
procedure TMUH_Edit.CMMouseEnter(
var Message: TMessage);
begin
inherited;
if (GetActiveWindow <> 0)
then
begin
MouseInControl := True;
Paint(0);
end;
end;
procedure TMUH_edit.CMMouseLeave(
var Message: TMessage);
begin
inherited;
MouseInControl := False;
Paint(0);
end;
procedure TMUH_Edit.WMSetFocus (
var Message: TWMSetFocus);
begin
inherited;
if not(csDesigning
in ComponentState)
then
Paint(0);
end;
procedure TMUH_Edit.WMKillFocus (
var Message: TWMKillFocus);
begin
inherited;
if not(csDesigning
in ComponentState)
then
Paint(0);
end;
procedure TMUH_Edit.WMNCCalcSize (
var Message: TWMNCCalcSize);
begin
inherited;
InflateRect(
Message.CalcSize_Params^.rgrc[0],-3,-3);
end;
procedure TMUH_Edit.Loaded;
begin
inherited;
if not(csDesigning
in ComponentState)
then
NewAdjustHeight;
end;
procedure TMUH_Edit.WMNCPaint (
var Message: TMessage);
begin
inherited;
Paint(HRGN(
Message.WParam));
end;
procedure TMUH_Edit.SetBorderCol(Value: TCOlor);
begin
BorderCol := Value;
Paint(0);
end;
procedure TMUH_Edit.SetBorderCol2(Value: TCOlor);
begin
BorderCol2 := Value;
end;
procedure TMUH_Edit.SetBckrnd(Value: TCOlor);
begin
Bckrnd := Value;
end;
end.