50分,帮我修改控件,主要是重绘时闪烁的问题(0分)

  • 主题发起人 主题发起人 smilboy
  • 开始时间 开始时间
S

smilboy

Unregistered / Unconfirmed
GUEST, unregistred user!
unit Monitor;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;

type
TMonitor = class(TPanel)
private
FComputerName: string;
FComputerIP: string;
FOnLineTime: TDateTime;

//****My Procedure*************************
procedure SetComputerName(value: string);
procedure SetComputerIP(value: string);
procedure SetOnlineTime(value: TdateTime);
//****My Procedure*************************

protected
{ Protected declarations }
public

//****My Procedure*************************
constructor Create(AOwner: TComponent); override;
procedure Update2(picture: TBitmap);
//****My Procedure*************************
published

property ComputerName: string read FComputerName write SetComputerName;
property ComputerIP: string read FComputerIP write SetComputerIP;
property OnlineTime: TDateTime read FOnlineTime write SetOnlineTime;

end;
procedure Register;

implementation
constructor TMonitor.Create(AOwner: TComponent); //设置缺省值
begin
inherited Create(AOwner);
{ default values }
inherited;
ControlStyle := ControlStyle + [csOpaque];
FComputerIP := '0.0.0.0';
FComputerName := 'Comuter';
FOnlineTime := now;
Width := 200;
Height := 100;
end;

procedure TMonitor.SetComputerName(value: string);
begin
if value <> '' then FComputerName := value;
end;

procedure TMonitor.SetComputerIP(value: string);
begin
if value <> '' then FComputerIP := value;
end;

procedure TMonitor.SetOnlineTime(value: TdateTime);
begin
FOnlineTime := value;
end;

procedure TMonitor.Update2(picture: TBitmap);
begin
self.Repaint;
self.Canvas.StretchDraw(self.ClientRect, picture);
self.Canvas.FillRect(self.ClientRect);
self.Canvas.Brush.Style := bsclear;
self.Canvas.Font.Name := '宋体';
self.Canvas.Font.Size := 9;
self.Canvas.TextOut(18, 18, self.ComputerName);
self.Canvas.TextOut(18, 31, self.ComputerIP);
self.Canvas.TextOut(18, 44, Timetostr(self.OnlineTime));
end;

procedure Register;
begin
RegisterComponents('smilboy', [TMonitor]);
end;

end.

 
procedure TMonitor.Update2(picture: TBitmap);
begin
self.Repaint;
self.Canvas.StretchDraw(self.ClientRect, picture);
self.Canvas.FillRect(self.ClientRect);
self.Canvas.Brush.Style := bsclear;
self.Canvas.Font.Name := '宋体';
self.Canvas.Font.Size := 9;
self.Canvas.TextOut(18, 18, self.ComputerName);
self.Canvas.TextOut(18, 31, self.ComputerIP);
self.Canvas.TextOut(18, 44, Timetostr(self.OnlineTime));
end;

先建一个Tcanvas,设置好属性后再给self.canvas
是不是能好一点?
 

你试试设置一下TWinControl的
DoubleBuffered:=true
 
在Update2第一条语句前加入Inherit;
 
是不是tdatatime的问题。因为他( FOnlineTime := value);在不停的重化。把时间改一改
 
方法一:
重载一个Panel的paint过程,然后把要做的东东写进去。如下:
...
pretected
procedure Paint; override;
...
implementation

procedure TMonitor.Paint;
begin
self.Canvas.TextOut(18, 18, self.ComputerName);
self.Canvas.TextOut(18, 31, self.ComputerIP);
self.Canvas.TextOut(18, 44, Timetostr(self.OnlineTime));

inherited Paint;
end;

end.
Canvas的设置如下:(在控件创建时设置)
self.Canvas.Font.Name := '宋体';
self.Canvas.Font.Size := 9;

方法二:
其实,关键在于这几句:
self.Canvas.StretchDraw(self.ClientRect, picture);
self.Canvas.FillRect(self.ClientRect);
self.Canvas.Brush.Style := bsclear;
CANVAS重画(REPAINT)时,会擦除画布上的所有东东,不用你过多的考虑。

方法三:
在Update2过程中加两句:
repaint;
self.canvas.lock;
...
self.canvas.unlock;
end;
 
在Update2过程中repaint改为invalidate试试。
 
方法一:
重载一个Panel的paint过程,然后把要做的东东写进去。如下:
...
pretected
procedure Paint; override;
...
implementation

procedure TMonitor.Paint;
begin
self.Canvas.TextOut(18, 18, self.ComputerName);
self.Canvas.TextOut(18, 31, self.ComputerIP);
self.Canvas.TextOut(18, 44, Timetostr(self.OnlineTime));

inherited Paint;
end;

end.
Canvas的设置如下:(在控件创建时设置)
self.Canvas.Font.Name := '宋体';
self.Canvas.Font.Size := 9;

方法二:
其实,关键在于这几句:
self.Canvas.StretchDraw(self.ClientRect, picture);
self.Canvas.FillRect(self.ClientRect);
self.Canvas.Brush.Style := bsclear;
CANVAS重画(REPAINT)时,会擦除画布上的所有东东,不用你过多的考虑。

方法三:
在Update2过程中加两句:
repaint;
self.canvas.lock;
...
self.canvas.unlock;
end;
方法一:
重载一个Panel的paint过程,然后把要做的东东写进去。如下:
...
pretected
procedure Paint; override;
...
implementation

procedure TMonitor.Paint;
begin
self.Canvas.TextOut(18, 18, self.ComputerName);
self.Canvas.TextOut(18, 31, self.ComputerIP);
self.Canvas.TextOut(18, 44, Timetostr(self.OnlineTime));

inherited Paint;
end;

end.
Canvas的设置如下:(在控件创建时设置)
self.Canvas.Font.Name := '宋体';
self.Canvas.Font.Size := 9;

方法二:
其实,关键在于这几句:
self.Canvas.StretchDraw(self.ClientRect, picture);
self.Canvas.FillRect(self.ClientRect);
self.Canvas.Brush.Style := bsclear;
CANVAS重画(REPAINT)时,会擦除画布上的所有东东,不用你过多的考虑。

方法三:
在Update2过程中加两句:
repaint;
self.canvas.lock;
...
self.canvas.unlock;
end;
 
unit Monitor;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;

type
TMonitor = class(TPanel)
private
FComputerName: string;
FComputerIP: string;
FOnLineTime: TDateTime;

//****My Procedure*************************
procedure SetComputerName(value: string);
procedure SetComputerIP(value: string);
procedure SetOnlineTime(value: TdateTime);
//****My Procedure*************************

protected
{ Protected declarations }
public

//****My Procedure*************************
constructor Create(AOwner: TComponent); override;
procedure Update2(picture: TBitmap);
//****My Procedure*************************
published

property ComputerName: string read FComputerName write SetComputerName;
property ComputerIP: string read FComputerIP write SetComputerIP;
property OnlineTime: TDateTime read FOnlineTime write SetOnlineTime;

end;
procedure Register;

implementation
constructor TMonitor.Create(AOwner: TComponent); //设置缺省值
begin
inherited Create(AOwner);
{ default values }
inherited;
ControlStyle := ControlStyle + [csOpaque];
FComputerIP := '0.0.0.0';
FComputerName := 'Comuter';
FOnlineTime := now;
Width := 200;
Height := 100;
end;

procedure TMonitor.SetComputerName(value: string);
begin
if value <> '' then FComputerName := value;
Update2();
end;

procedure TMonitor.SetComputerIP(value: string);
begin
if value <> '' then FComputerIP := value;
Update2();
end;

procedure TMonitor.SetOnlineTime(value: TdateTime);
begin
FOnlineTime := value;
Update2();
end;

procedure TMonitor.Update2();
var picture: TBitmap
begin
picture := TBitmap.Create;
with picture.Canvas do
begin
Brush.Style := bsclear;
Font.Name := '宋体';
TextOut(18, 18, self.ComputerName);
TextOut(18, 31, self.ComputerIP);
TextOut(18, 44, Timetostr(self.OnlineTime));
end;
Canvas.Draw(0,0,picture);
picture.Free;
end;

procedure Register;
begin
RegisterComponents('smilboy', [TMonitor]);
end;

end.
 
接受答案了.
 

Similar threads

后退
顶部