Problem mit von CustomEdit abgeleiteten Eingabefeld

[LH_Freak]

Könnte ich probieren. Hast du irgendein Codebeispiel?

Das hab ich bis jetzt:

Delphi-Quellcode:

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.