Thema: Delphi TEdit mit Rahmen

Einzelnen Beitrag anzeigen

Benutzerbild von toms
toms
(CodeLib-Manager)

Registriert seit: 10. Jun 2002
4.648 Beiträge
 
Delphi XE Professional
 
#7

Re: TEdit mit Rahmen

  Alt 26. Mär 2008, 20:40
Hallo, hier mal eine kleine Weiterentwicklung.

PS: Ist nur mal ein Anfang und ist noch nicht perfekt!

Delphi-Quellcode:
unit SEdit;

interface

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

type
  TSEdit = class(TEdit)
  private
    Fh: TWMNCPAINT;
    Fdc: hDc;
    FPen: hPen;
    FOldPen: hPen;
    FOldBrush: hBrush;
    FSelected: boolean;
    procedure WMNCCalcSize(var Msg: TWMNCCALCSIZE); message WM_NCCALCSIZE;
    procedure WMNCPAINT(var Msg: TWMNCPaint); message WM_NCPAINT;
    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 RedrawBorder;
  protected
    { Protected-Deklarationen }
  public
    procedure RePaint; override;
    constructor Create(AOwner: TComponent); override;
  published
    { Published-Deklarationen }
  end;

procedure Register;


implementation

procedure Register;
begin
  RegisterComponents('Additional', [TSEdit]);
end;

constructor TSedit.Create(AOwner: TComponent);
begin
  inherited;
  ParentFont := True;
  FSelected := False;
end;

procedure TSEdit.RePaint;
begin
  WMNCPAINT(Fh);
end;

procedure TSedit.WMNCCalcSize(var Msg: TWMNCCalcSize);
begin
  inherited;
  InflateRect(Msg.CalcSize_Params^.rgrc[0], -1, -1);
end;

procedure TSEdit.WMNCPAINT(var Msg: TWMNCPAINT);
begin
  inherited;
  RedrawBorder;
end;


procedure TSedit.WMSetFocus(var Message: TWMSetFocus);
var
  Msg: TWMNCPAINT;
begin
  inherited;
  if not (csDesigning in ComponentState) then
  begin
    FSelected := True;
    RedrawBorder;
  end;
end;

procedure TSedit.WMKillFocus(var Message: TWMKillFocus);
begin
  inherited;
  if not (csDesigning in ComponentState) then
  begin
    FSelected := False;
    RedrawBorder;
  end;
end;

procedure TSedit.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  if (GetActiveWindow <> 0) then
  begin
    RedrawBorder();
  end;
end;

procedure TSedit.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  RedrawBorder();
end;

procedure TSEdit.RedrawBorder;
begin
  inherited;
  if FSelected then
  begin
    Fdc := GetWindowDC(Handle);
    //Change the RGB value to change the color
    FPen := CreatePen(PS_SOLID, 1, RGB(255, 0, 0));
    FOldPen := SelectObject(Fdc, FPen);
    FOldBrush := SelectObject(Fdc, GetStockObject(NULL_BRUSH));
    Rectangle(Fdc, 0, 0, Width, Height);
    SelectObject(Fdc, FOldBrush);
    SelectObject(Fdc, FOldPen);
    DeleteObject(FPen);
    ReleaseDC(Handle, Handle);
  end else
  begin
    Fdc := GetWindowDC(Handle);
  //Change the RGB value to change the color
    FPen := CreatePen(PS_SOLID, 1, color);
    FOldPen := SelectObject(Fdc, FPen);
    FOldBrush := SelectObject(Fdc, GetStockObject(NULL_BRUSH));
    Rectangle(Fdc, 0, 0, Width, Height);
    SelectObject(Fdc, FOldBrush);
    SelectObject(Fdc, FOldPen);
    DeleteObject(FPen);
    ReleaseDC(Handle, Handle);
  end;
end;


end.
Thomas
  Mit Zitat antworten Zitat