請問有辦法判斷兩個Canvas內容異同嗎? |
尚未結案
|
jenpeter
一般會員 發表:39 回覆:37 積分:15 註冊:2002-08-14 發送簡訊給我 |
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這函式嗎?
|
taishyang
站務副站長 發表:377 回覆:5490 積分:4563 註冊:2002-10-08 發送簡訊給我 |
|
jest0024
高階會員 發表:11 回覆:310 積分:224 註冊:2002-11-24 發送簡訊給我 |
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |