دخول

Delphi4Us

توقفت عن استخدام الكود لمعالجة المشكلة وسوف استخدم طريقة اخرى و ستكون ناجحة
ولمعرفة حجم المشكلة وتعقيدها يمكن معاينة وتجربة هذا الكود
فقط استبدل الكود للوحدة Tedit واعد ترجمة المشروع

كود :
unit NewEdit;

interface

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

// type
// TVerticalAlignment = (taAlignTop, taAlignBottom, taVerticalCenter);

type
  TNewEdit = class(TEdit)
 private
    FCanvas: TCanvas;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  protected
    procedure WndProc(var Message: TMessage); override;
    procedure Paint; virtual;
    procedure PaintWindow(DC: HDC); override;
    property Canvas: TCanvas read FCanvas;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TNewEdit]);
end;

{ TNewEdit }

constructor TNewEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCanvas := TControlCanvas.Create;
  TControlCanvas(FCanvas).Control := Self;
end;

destructor TNewEdit.Destroy;
begin
  FCanvas.Free;
  inherited Destroy;
end;

procedure TNewEdit.Paint;
var
  R: TRect;
  I: Integer;
  S: String;
  TextBounds: TRect;
begin
  R := ClientRect;
  Inc(R.Left, 1);
  Inc(R.Top, 1);
  Canvas.Brush.Assign(Self.Brush);
  Canvas.Font.Assign(Self.Font);

  TextBounds := Rect(0, 0, ClientWidth, Font.Height);
  R.Top := (R.Height div 2 - TextBounds.Height) div 2;


  DrawText(Canvas.Handle, PChar(Text), -1, R, DT_LEFT or DT_VCENTER or ES_MULTILINE or
      DT_WORDBREAK or DrawTextBiDiModeFlagsReadingOnly);
 Inc(R.Left,Canvas.TextWidth(Text));


end;

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

procedure TNewEdit.WMPaint(var Message: TWMPaint);
begin
   ControlState := ControlState+[csCustomPaint];
  inherited;
  ControlState := ControlState-[csCustomPaint];
end;

procedure TNewEdit.WndProc(var Message: TMessage);
begin
  inherited WndProc(Message);
  with Message do
    case Msg of
      CM_MOUSEENTER, CM_MOUSELEAVE, WM_LBUTTONUP, WM_LBUTTONDOWN,
      WM_KEYDOWN, WM_KEYUP,
      WM_SETFOCUS, WM_KILLFOCUS,
      CM_FONTCHANGED, CM_TEXTCHANGED:
      begin
        Invalidate;
      end;
   end;

end;

end.

دخول
اسم المستخدم/البريد الالكتروني :
كلمة المرور :	فقدت كلمة المرور ؟
	تذكرني بالمرة القادمة