本来运行都挺正常的,但模块越加越多,就老出现一些希奇古怪的问题,头都大了,现在看的心烦气燥,请大家帮我分析分析,谢谢。unit HotelIcon;interfaceuses
Windows, Messages, SysUtils, Classes, Controls, Graphics,Dialogs;type
TColorType = (clEmpty,clSelled,clReserve,clClean,clDoup,clClose);
THotelIcon = class(TGraphicControl)
private
FClean:Boolean;
FColorValue:TColorType;
FPen: TPen;
FCol: Integer;
FRow: Integer;
FGuestName: String;
FHouseName: String;
FHouseType: String;
FBrush: TBrush;
FShowTips:Boolean;
FTipsColor:TColor;
procedure SetColorValue(Value:TColorType);
procedure SetShowTips(Value:Boolean);
procedure SetTipsColor(Value:TColor);
procedure SetClean(Value:Boolean);
procedure CMMouseEnter (var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave (var Message: TMessage); message CM_MOUSELEAVE;
procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN; protected
procedure Paint; override; public constructor Create(AOwner: TComponent); override;
destructor Destroy; override; published
procedure StyleChanged(Sender: TObject);
property Clean:Boolean Read Fclean Write SetClean default true; //虽然这里定义了默认值是TRUE,但在设计的时候新控件默认值却是FALSE,但运行的时候却始终是TRUE,在设计阶段修改成任何值运行的时候都是TRUE。
property Col:Integer Read FCol Write FCol Default 0;
property BoxColor:TColorType Read FColorValue Write SetColorValue Default clEmpty;
property Enabled;
property GuestName:String Read FGuestName Write FGuestName;
property HouseName:String Read FHouseName Write FHouseName;
property HouseType:String Read FHouseType Write FHouseType;
property ParentShowHint;
property Row:Integer Read FRow Write FRow Default 0;
property ShowHint;
property ShowTips:Boolean Read FShowTips Write SetShowTips Default False;
property TipsColor:TColor Read FTipsColor Write SetTipsColor Default clGreen; //虽然定义了默认值是clGreen,但设计时的默认值总是clBlack
property Visible;
property OnContextPopup;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
property OnClick;
property OnDblClick; end;procedure Register;implementationprocedure Register;
begin
RegisterComponents('Hotel', [THotelIcon]);
end;constructor THotelIcon.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Width := 45;
Height := 70;
FPen := TPen.Create;
FPen.Style := psClear;
FPen.OnChange := StyleChanged;
FBrush := TBrush.Create;
FBrush.Color := clWhite;
FBrush.OnChange := StyleChanged;end;destructor THotelIcon.Destroy;
begin
FPen.Free;
FBrush.Free;
inherited Destroy;
end;procedure THotelIcon.Paint;
var
mCol1,mCol2,mCol3,mRow:Integer;
begin mCol1 := Trunc((width-Length(FHouseName)*6)/2);
mCol2 := Trunc((width-Length(FHouseType)*6)/2);
mCol3 := Trunc((width-Length(FGuestName)*6)/2);
mRow := height-28; Canvas.Pen := FPen; Case FColorValue of
clEmpty:
Canvas.Brush.Color := clWhite;
clSelled:
Canvas.Brush.Color := clNavy;
clReserve:
Canvas.Brush.Color := clSkyBlue;
clClean:
Canvas.Brush.Color := clLime;
clDoup:
Canvas.Brush.Color := clRed;
clClose:
Canvas.Brush.Color := clBlack;
end; Canvas.Rectangle(0, 0, width, height); If not FClean Then
begin
Canvas.Pen.Style := psClear;
Canvas.Brush.Color := clBlack;
Canvas.Rectangle(0,0,width,Trunc(height/5));
end; If FShowTips Then //在没有添加这个功能前都是正常的,但现在去掉这部分问题却依然存在,另外在这里画出的文字在设计阶段没有底色,但运行的时候会出现黑色的底色,真奇怪。在canvas中怎么定义透明?
begin
Canvas.Font.Name:='宋体';
Canvas.Font.Size:=9;
Canvas.Font.Color:= FTipsColor;
canvas.TextOut(mCol1,mRow,FHouseName);
If FGuestName='' Then
canvas.TextOut(mCol2,mRow+12,FHouseType)
Else
canvas.TextOut(mCol3,mRow+12,FGuestName);
end;end;procedure THotelIcon.CMMouseEnter(var Message: TMessage);begin
inherited;
FPen.Style := psDot;
end;procedure THotelIcon.CMMouseLeave(var Message:TMessage);begin
inherited;
FPen.Style := psClear;
end;procedure THotelIcon.WMLButtonDown(var Message: TWMLButtonDown);begin
inherited;
FPen.Style := psSolid;
end;procedure THotelIcon.SetColorValue(Value:TColorType);
begin
if FColorValue <> Value then
begin
FColorValue := Value;
Invalidate;
end;
end;procedure THotelIcon.SetShowTips(Value:Boolean);
begin
if FShowTips <> Value then
begin
FShowTips := Value;
Invalidate;
end;
end;procedure THotelIcon.SetTipsColor(Value:TColor);
begin
if FTipsColor <> Value then
begin
FTipsColor := Value;
Invalidate;
end;
end;procedure THotelIcon.SetClean(Value:Boolean);
begin
If FClean <> Value Then
begin
FClean := Value;
Invalidate;
end;
end;procedure THotelIcon.StyleChanged(Sender: TObject);
begin
Invalidate;
end;end.
不知道是程序的问题还是我的系统有问题了,请大家帮忙试一下,谢谢!
解决方案 »
- 输出M个数中取N个数的组合到memo中的问题
- DELPHI2010安装控件问题
- 一个关于qrdbtext的问题?望各位帮帮忙啊?
- 高分求救!!!!关于QuickReport的问题????、
- 想问下点对点文件传输实现的原理
- 我用ReportBuild做报表时,加子报表SubReport1时,怎么子报表中ppHeaderBand1栏中的标签怎么不见呢?
- 关于控制数字格式的问题
- 两个不同结构的表,一个是VFP的“.dbf”,一个是SQL Server表
- 请问怎么弄到HyperSnap-DX开发包谢谢
- 不使用TTABLE,采用什么方式关闭表
- delphi前台流水号如何实现,贴出源代码?
- MSComm+多线程,想实现用多线程监的串口有无收到数据,但cpu居然达到100%,请问是哪里有错?
搞得你自己都晕了。在一个地方设置默认值就可以了啊既然运行的时候老是true,那肯定有代码让它是true了,你仔细检查一下吧
不过也不知道有什么作用
在Create里面加一句:FClean:=true就行了