程式碼測試

發文回覆瀏覽次數：994

推到 Plurk!

推到 Facebook!

maomfh
初階會員

發表：3
回覆：10
積分：27
註冊：2008-01-05

發送簡訊給我

#1 引用回覆回覆

發表時間：2008-08-11 11:50:26

IP:218.163.xxx.xxx 訂閱

[code delphi]
unit MyEdit;
interface
uses
SysUtils, Classes, Messages, Controls, StdCtrls, Graphics;
type
TMyEdit = class(TEdit)
private
FDisTextColor : TColor;
FDisTextBGColor : TColor;
procedure SetDisTextBGColor(const Value: TColor);
procedure SetDisTextColor(const Value: TColor);
{ Private declarations }
protected
{ Protected declarations }
FCanvas : TCanvas;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
public
{ Public declarations }
constructor Create(AOwner : TComponent); override;
published
{ Published declarations }
property DisTextColor : TColor read FDisTextColor write SetDisTextColor default clGrayText;
property DisTextBGColor : TColor read FDisTextBGColor write SetDisTextBGColor default clWhite;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TMyEdit]);
end;
{ TCustomEdit1 }
constructor TMyEdit.Create(AOwner: TComponent);
begin
inherited;
FDisTextColor := clGrayText;
FDisTextBGColor := clWhite;
FCanvas := TControlCanvas.Create;
TControlCanvas(FCanvas).Control := Self;
end;
procedure TMyEdit.SetDisTextBGColor(const Value: TColor);
begin
FDisTextBGColor := Value;
FCanvas.Brush.Color := Value;
end;
procedure TMyEdit.SetDisTextColor(const Value: TColor);
begin
FDisTextColor := Value;
FCanvas.Font.Color := Value;
end;
procedure TMyEdit.WMPaint(var Message: TWMPaint);
begin
inherited;
if not Enabled then
begin
FCanvas.Font := Font;
FCanvas.Font.Color := FDisTextColor;
FCanvas.Brush.Color := FDisTextBGColor;
FCanvas.FillRect(ClientRect);
FCanvas.TextOut(1, 1, Text);
end;
end;
end.
[/code]

------
Maomfh

系統時間：2024-04-24 10:13:30

聯絡我們 | Delphi K.Top討論版

本站聲明

1. 本論壇為無營利行為之開放平台，所有文章都是由網友自行張貼，如牽涉到法律糾紛一切與本站無關。
2. 假如網友發表之內容涉及侵權，而損及您的利益，請立即通知版主刪除。
3. 請勿批評中華民國元首及政府或批評各政黨，是藍是綠本站無權干涉，但這裡不是政治性論壇！

程式碼 測試

程式碼測試