本来运行都挺正常的,但模块越加越多,就老出现一些希奇古怪的问题,头都大了,现在看的心烦气燥,请大家帮我分析分析,谢谢。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.
不知道是程序的问题还是我的系统有问题了,请大家帮忙试一下,谢谢!

解决方案 »

  1.   

    property Clean:Boolean Read Fclean Write SetClean default true;  //虽然这里定义了默认值是TRUE,但在设计的时候新控件默认值却是FALSE,但运行的时候却始终是TRUE,在设计阶段修改成任何值运行的时候都是TRUE。(这里定义了Clean的默认值是True,但我将该组件放到FORM上的时候该属性的值还是False,但如果运行程序,组件的值变成了True,而且设计阶段无论将组件设置为True还是False,运行的时候都会自动变为True。直观的说就是Clean为False的时候组件顶部会画一个黑色的长方形,如果为True就不画,但现在是设计阶段总是会画,但运行的时候就没有了。不知道这样讲能不能看明白?)
      

  2.   

    为什么要在两个地方定义默认值呢?一个在代码里,一个在设计时,有必要吗?
    搞得你自己都晕了。在一个地方设置默认值就可以了啊既然运行的时候老是true,那肯定有代码让它是true了,你仔细检查一下吧
      

  3.   

    安装了一下你的控件,没有任何的问题,也没有任何的bug
    不过也不知道有什么作用
      

  4.   

    设计时会直接去读取FClean,FClean没有初始化,自然是False.运行时default才会产生作用吧。
    在Create里面加一句:FClean:=true就行了
      

  5.   

    楼上正解,谢谢了。不过还有一个问题,那就是在canvas中怎么定义透明?让输出的文字没有底色??