unit PaintBoxout; interface uses Windows, Messages, SysUtils, Classes, Controls, ExtCtrls,Qpos,Graphics,Forms,dialogs; type Wee =(wsLeft,wsCenter,wsRight,wsNormal); Hee =(hsTop,hsCenter,hsBottom,hsNormal); TPaintBoxout = class(TControl) //TPanel TComponent TCustomControl TWinControl private xMove:Integer; fFontColor,fMaskColor,fitColor:TColor; fCaption,fFontName:WideString; fFontSize,fLeft,fTop,fPenWidth:Integer; fxCenter:Wee; fyCenter:Hee ; fAlignment:TAlignment; fBorderWidth:Integer; fSelect,fAutoSize:Boolean; fWordWidth:Integer; fBitmap,f1Bitmap:TBitmap; OverlayColor:TColor; fCanVas:TCanvas; fShowd:Boolean; Procedure MyRepaint(sender:TObject); Procedure SetXY; Procedure SetFontParameter; Procedure SetColor(tc:Boolean); protected Procedure Loaded;override; procedure CMColorChanged(var Message: TMessage); message CM_PARENTCOLORCHANGED; procedure WMPaint(var Message: TWMPaint); message WM_PAINT; procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND; public constructor Create(Aowner:TComponent);override; destructor Destroy;override; Procedure Show(xc:Boolean =False); Procedure LoadParameters(wParm:WideString); Procedure SetCaption(Cap:WideString); Procedure ClearShow; Function GetWordWidth:Integer; Function GetHeight:Integer; Function GetWidth:Integer; Property Caption:WideString Read fCaption write SetCaption; Property FontName:WideString Read fFontName write fFontName; Property FontColor:TColor Read fFontColor write fFontColor; Property ItemColor:TColor Read fitColor write fitColor; Property myLeft:Integer Read fLeft write fLeft; Property myTop:Integer Read fTop write fTop; Property FontSize:Integer Read fFontSize write fFontSize; Property PenWidth:Integer Read fPenWidth write fPenWidth; Property WordCenter:Wee Read fxCenter write fxCenter; Property HeightCenter:hee Read fyCenter write fyCenter; Property AutoSize:Boolean Read fAutoSize write fAutoSize; Property WordWidth:Integer Read GetWordWidth ; Property BorderWidth:Integer Read fBorderWidth write fBorderWidth; published { Published declarations } end; procedure Register; implementation constructor TPaintBoxout.Create(Aowner:TComponent); begin inherited Create(Aowner); fBitmap:=TBitmap.Create; f1Bitmap:=TBitmap.Create; fSelect:=False; fAutoSize:=True; fAlignment:=taCenter; fxCenter:=wsNormal; fyCenter:=hsNormal; fBitmap.OnChange:=MyRepaint; FCanvas := TControlCanvas.Create; TControlCanvas(FCanvas).Control := Self; fAlignment:= taLeftJustify; end; Procedure TPaintBoxout.Loaded; begin inherited; end; destructor TPaintBoxout.Destroy; begin fBitmap.Free; f1Bitmap.Free; fCanVas.Free; inherited Destroy; end; Procedure TPaintBoxout.Show(xc:Boolean =False); begin xMove:=0; SetFontParameter; ClearShow; with fBitmap do begin Canvas.Pen.Width:=fPenWidth; fSelect:=xc; if fAutoSize then self.Width:=Canvas.TextWidth(fCaption); GetHeight; SetXY; Left:=fLeft; Top:=fTop; Width:= self.Width; height:= self.height; if fAlignment=taCenter then xMove:=Trunc((self.Width-GetWidth)/2); SetColor(fSelect); ShowExText(Canvas,xMove,0,fCaption); beginpath( Canvas.handle); ShowExText( Canvas,xMove,0,fCaption); endpath( Canvas.handle); StrokePath( Canvas.handle); end; end; Function TPaintBoxout.GetHeight:Integer; begin SetFontParameter; self.Height:=fBitmap.Canvas.TextHeight(fCaption); Result:= self.Height end; Function TPaintBoxout.GetWidth:Integer; begin SetFontParameter; Result:= fBitmap.Canvas.TextWidth(Trim(fCaption)); end; Function TPaintBoxout.GetWordWidth:Integer; begin SetFontParameter; Result:= fBitmap.Canvas.TextWidth('我'); end; Procedure TPaintBoxout.SetXY; Begin Case fxCenter of wsLeft:fLeft:=0; wsCenter: fLeft:=Trunc((Parent.Width- self.Width)/2) ; wsRight: fLeft:=Parent.Width- self.Width-10; end; Case fyCenter of hsTop:fTop:=0; hsCenter:fTop:=Trunc((Parent.Height-self.Height)/2); hsBottom:fTop:=Parent.Height-self.Height-5; end; end; procedure TPaintBoxout.SetFontParameter; begin fBitmap.Canvas.Font.Size:=fFontSize; fBitmap.Canvas.Font.Color:=Self.Color; fBitmap.Canvas.Font.Name:=fFontName; fBitmap.Canvas.Font.Style:=[fsBold]; end; Procedure TPaintBoxout.SetColor(tc:Boolean); begin if tc then begin fBitmap.Canvas.Pen.Color := fitColor ; end else begin fBitmap.Canvas.Pen.Color := fFontColor; end; self.Font.Color:= fBitmap.Canvas.Pen.Color; end; Procedure TPaintBoxout.ClearShow; Var Rect:TRect; begin Rect:= self.ClientRect; fBitmap.Canvas.Brush.Color:=self.Color; fBitmap.Canvas.FillRect(Rect); end; Procedure TPaintBoxout.MyRepaint(sender:TObject); begin invalidate; end; procedure TPaintBoxout.CMColorChanged(var Message: TMessage); begin if Self.color<> TForm(Parent).Color then begin Self.color:=TForm(Parent).Color; if Self.Visible then begin Show(fselect); end; end; end; procedure TPaintBoxout.WMEraseBkgnd(var Message: TWmEraseBkgnd); begin Message.Result := 1; end; Procedure TPaintBoxout.SetCaption(Cap:WideString); begin inherited; if Cap<>fCaption then begin fCaption:=Cap; if Self.Visible then begin Show(fSelect) end; end; end; procedure TPaintBoxout.WMPaint(var Message: TWMPaint); Var mRect:Trect; begin inherited ; mRect:=self.ClientRect; fCanvas.CopyRect(mRect,fBitmap.Canvas,mRect); fShowd:=true; end; procedure Register; begin RegisterComponents('Samples', [TPaintBoxout]); end; end. //上面是我自己寫的顯示空心字元件,請問有辦法判斷fCanvas的內容fBitmap.canvas不相同時才去 執到show這函式嗎?

您好:    PO程式碼的方式請參考版規說明,煩請修改謝謝您的配合 >

判斷Canvas不同!?似乎要檢查每個點的不一樣，是不是會造成系統負擔?! 若是判斷Canvas是否使用，是不是比較簡單的多!?