paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-14 09:19:22 +02:00
Code Issues Packages Projects Releases Wiki Activity

gtk: perform erasing background on non opaque controls

Browse Source 
git-svn-id: trunk@13842 -
This commit is contained in:
paul 2008-01-23 10:21:20 +00:00
parent c380a23969
commit e48133ad74
6 changed files with 146 additions and 114 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
lcl/interfaces/gtk/gtkcallback.inc
View File

@ -27,15 +27,29 @@
{$ENDIF} {$ENDIF}
function DoDeliverPaintMessage(const Target: TObject; var PaintMsg: TLMPaint): PtrInt;
begin
if (TObject(Target) is TCustomControl) and not (csOpaque in TWinControl(Target).ControlStyle) then
begin
Include(TWinControlAccess(Target).FWinControlFlags, wcfEraseBackground);
TWinControl(Target).Perform(LM_ERASEBKGND, PaintMsg.DC, 0);
Exclude(TWinControlAccess(Target).FWinControlFlags, wcfEraseBackground);
end;
Result := DeliverMessage(Target, PaintMsg);
end;
function DeliverPaintMessage(const Target: Pointer; var TheMessage): GBoolean; function DeliverPaintMessage(const Target: Pointer; var TheMessage): GBoolean;
var var
PaintMsg: TLMPaint; PaintMsg: TLMPaint;
begin begin
if TLMessage(TheMessage).Msg=LM_GtkPAINT then if TLMessage(TheMessage).Msg = LM_GTKPAINT then
PaintMsg:= GtkPaintMessageToPaintMessage(TLMGtkPaint(TheMessage),true) PaintMsg := GtkPaintMessageToPaintMessage(TLMGtkPaint(TheMessage), True)
else else
PaintMsg:=TLMPaint(TheMessage); PaintMsg := TLMPaint(TheMessage);
Result := DeliverMessage(Target,PaintMsg) = 0;
Result := DoDeliverPaintMessage(TObject(Target), PaintMsg) = 0;
FinalizePaintMessage(PLMessage(@PaintMsg)); FinalizePaintMessage(PLMessage(@PaintMsg));
end; end;
@ -57,11 +71,10 @@ begin
end end
else else
begin begin
if TLMessage(TheMessage).Msg<>LM_GtkPAINT then if TLMessage(TheMessage).Msg <> LM_GTKPAINT then
Result := DeliverMessage(Target, TheMessage) = 0 Result := DeliverMessage(Target, TheMessage) = 0
else begin else
Result := DeliverPaintMessage(Target,TheMessage); Result := DeliverPaintMessage(Target, TheMessage);
end;
end; end;
end; end;
@ -73,9 +86,6 @@ function DeliverGtkPaintMessage(Target: Pointer; Widget: PGtkWidget;
{$ENDIF} {$ENDIF}
var var
MSG: TLMGtkPaint; MSG: TLMGtkPaint;
{$IFDEF DirectPaintMsg}
PaintMsg: TLMPaint;
{$ENDIF}
begin begin
//DebugLn(['DeliverGtkPaintMessage ',DbgSName(TObject(Target)),' Widget=',GetWidgetDebugReport(Widget),' RepaintAll=',RepaintAll,' AfterGtk=',IsAfterGtk,' Area=',dbgs(Area)]); //DebugLn(['DeliverGtkPaintMessage ',DbgSName(TObject(Target)),' Widget=',GetWidgetDebugReport(Widget),' RepaintAll=',RepaintAll,' AfterGtk=',IsAfterGtk,' Area=',dbgs(Area)]);
{$IFDEF Gtk2} {$IFDEF Gtk2}
@ -83,16 +93,18 @@ begin
// In case of TCustomControl, there is no gtk painting only the // In case of TCustomControl, there is no gtk painting only the
// child paintings. Let the TCustomControl paint the background. // child paintings. Let the TCustomControl paint the background.
// ToDo: Eventually there must be a 'before paint message'. // ToDo: Eventually there must be a 'before paint message'.
if IsAfterGtk then begin if IsAfterGtk then
begin
if TObject(Target) is TCustomControl then exit; if TObject(Target) is TCustomControl then exit;
end else begin end else
begin
if not (TObject(Target) is TCustomControl) then exit; if not (TObject(Target) is TCustomControl) then exit;
end; end;
{$ENDIF} {$ENDIF}
if (not RepaintAll) and ((Area^.Width<1) or (Area^.Height<1)) then exit; if (not RepaintAll) and ((Area^.Width<1) or (Area^.Height<1)) then exit;
MSG.Msg := LM_GtkPAINT; MSG.Msg := LM_GTKPAINT;
MSG.Data := TLMGtkPaintData.Create; MSG.Data := TLMGtkPaintData.Create;
MSG.Data.Widget := Widget; MSG.Data.Widget := Widget;
MSG.Data.State := GtkPaint_LCLWidget; MSG.Data.State := GtkPaint_LCLWidget;
@ -100,11 +112,9 @@ begin
Msg.Data.RepaintAll := RepaintAll; Msg.Data.RepaintAll := RepaintAll;
{$IFDEF DirectPaintMsg} {$IFDEF DirectPaintMsg}
PaintMsg:= GtkPaintMessageToPaintMessage(Msg,true); Result := DeliverPaintMessage(Target, Msg);
Result := DeliverMessage(Target,PaintMsg) = 0;
FinalizePaintMessage(PLMessage(@PaintMsg));
{$ELSE} {$ELSE}
Result := DeliverPostMessage(Target,Msg); Result := DeliverPostMessage(Target, Msg);
{$ENDIF} {$ENDIF}
end; end;

2
lcl/interfaces/gtk/gtkglobals.pp
View File

@ -284,7 +284,7 @@ var
// Internal Paint message: // Internal Paint message:
const const
LM_GTKPaint = LM_INTERFACEFIRST + 0; LM_GTKPAINT = LM_INTERFACEFIRST + 0;
GtkPaint_LCLWidget = 1; GtkPaint_LCLWidget = 1;
GtkPaint_GtkWidget = 2; GtkPaint_GtkWidget = 2;

18
lcl/interfaces/gtk/gtkmsgqueue.pp
View File

@ -36,7 +36,7 @@ type
fMsg : PMsg; fMsg : PMsg;
public public
property Msg: PMsg read fMsg write fMsg; property Msg: PMsg read fMsg write fMsg;
function IsPaintMessage : boolean; function IsPaintMessage: Boolean;
procedure DestroyMessage(ParFinalInternalOnly: TFinalPaintMessageFlag; procedure DestroyMessage(ParFinalInternalOnly: TFinalPaintMessageFlag;
DisposeMessage: boolean); DisposeMessage: boolean);
constructor Create; constructor Create;
@ -72,12 +72,12 @@ implementation
{---(TGtkMessageQueueItem)----------------------} {---(TGtkMessageQueueItem)----------------------}
function TGtkMessageQueueItem.IsPaintMessage : boolean; function TGtkMessageQueueItem.IsPaintMessage: Boolean;
begin begin
Result := false; if fMsg <> nil then
if fMsg <> nil then begin Result := (Msg^.Message = LM_PAINT) or (Msg^.Message = LM_GTKPAINT)
Result := (Msg^.Message = LM_Paint) or (Msg^.Message = LM_GtkPaint); else
end; Result := False;
end; end;
constructor TGtkMessageQueueItem.Create; constructor TGtkMessageQueueItem.Create;
@ -89,8 +89,8 @@ end;
procedure TGtkMessageQueueItem.DestroyMessage( procedure TGtkMessageQueueItem.DestroyMessage(
ParFinalInternalOnly: TFinalPaintMessageFlag; DisposeMessage: boolean); ParFinalInternalOnly: TFinalPaintMessageFlag; DisposeMessage: boolean);
begin begin
if (ParFinalInternalOnly in [FPMF_All,FPMF_Internal]) if (ParFinalInternalOnly in [FPMF_All, FPMF_Internal])
and (fMsg^.message = LM_GtkPaint) and (fMsg^.message = LM_GTKPAINT)
then then
FinalizePaintTagMsg(fMsg); FinalizePaintTagMsg(fMsg);
if DisposeMessage then if DisposeMessage then
@ -204,7 +204,7 @@ procedure TGtkMessageQueue.RemoveMessage(ParItem: TGtkMessageQueueItem;
begin begin
if (ParItem.IsPaintMessage) then if (ParItem.IsPaintMessage) then
fPaintMessages.Remove(ParItem); fPaintMessages.Remove(ParItem);
ParItem.DestroyMessage(ParFinalOnlyInternal,DisposeMessage); ParItem.DestroyMessage(ParFinalOnlyInternal, DisposeMessage);
Delete(ParItem); Delete(ParItem);
end; end;

89
lcl/interfaces/gtk/gtkproc.inc
View File

@ -943,7 +943,7 @@ end;
function GtkPaintMessageToPaintMessage(var GtkPaintMsg: TLMGtkPaint; function GtkPaintMessageToPaintMessage(var GtkPaintMsg: TLMGtkPaint;
FreeGtkPaintMsg: boolean): TLMPaint; FreeGtkPaintMsg: boolean): TLMPaint;
Converts a LM_GtkPaint message to a LM_PAINT message Converts a LM_GTKPAINT message to a LM_PAINT message
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
function GtkPaintMessageToPaintMessage(var GtkPaintMsg: TLMGtkPaint; function GtkPaintMessageToPaintMessage(var GtkPaintMsg: TLMGtkPaint;
FreeGtkPaintMsg: boolean): TLMPaint; FreeGtkPaintMsg: boolean): TLMPaint;
@ -951,7 +951,7 @@ var
PS : PPaintStruct; PS : PPaintStruct;
Widget: PGtkWidget; Widget: PGtkWidget;
begin begin
Result.Msg:=LM_PAINT; Result.Msg := LM_PAINT;
New(PS); New(PS);
FillChar(PS^, SizeOf(TPaintStruct), 0); FillChar(PS^, SizeOf(TPaintStruct), 0);
Widget := GtkPaintMsg.Data.Widget; Widget := GtkPaintMsg.Data.Widget;
@ -969,56 +969,61 @@ end;
procedure FinalizePaintMessage(Msg: PLMessage); procedure FinalizePaintMessage(Msg: PLMessage);
var var
PS : PPaintStruct; PS: PPaintStruct;
DC : TGtkDeviceContext; DC: TGtkDeviceContext;
begin begin
if (Msg^.Msg=LM_PAINT) or (Msg^.Msg=LM_INTERNALPAINT) then begin if (Msg^.Msg = LM_PAINT) or (Msg^.Msg = LM_INTERNALPAINT) then
if Msg^.LParam <> 0 then begin begin
PS := PPaintStruct(Msg^.LParam); if Msg^.LParam <> 0 then
If Msg^.WParam<>0 then begin
DC := TGtkDeviceContext(Msg^.WParam) PS := PPaintStruct(Msg^.LParam);
else if Msg^.WParam <> 0 then
DC := TGtkDeviceContext(PS^.hdc); DC := TGtkDeviceContext(Msg^.WParam)
EndPaint(THandle(PtrUInt(DC.Widget)), PS^); else
Dispose(PS); DC := TGtkDeviceContext(PS^.hdc);
Msg^.LParam:=0; EndPaint(THandle(PtrUInt(DC.Widget)), PS^);
Msg^.WParam:=0; Dispose(PS);
end else Msg^.LParam:=0;
if Msg^.WParam<>0 then begin Msg^.WParam:=0;
ReleaseDC(0,Msg^.WParam); end
Msg^.WParam:=0; else
end; if Msg^.WParam<>0 then
begin
ReleaseDC(0, Msg^.WParam);
Msg^.WParam := 0;
end;
end else end else
if Msg^.Msg=LM_GtkPAINT then begin if Msg^.Msg = LM_GTKPAINT then
FreeThenNil(TLMGtkPaintData(Msg^.WParam)); FreeThenNil(TLMGtkPaintData(Msg^.WParam));
end;
end; end;
procedure FinalizePaintTagMsg(Msg: PMsg); procedure FinalizePaintTagMsg(Msg: PMsg);
var var
PS : PPaintStruct; PS: PPaintStruct;
DC : TGtkDeviceContext; DC: TGtkDeviceContext;
begin begin
if (Msg^.Message=LM_PAINT) or (Msg^.Message=LM_INTERNALPAINT) then begin if (Msg^.Message = LM_PAINT) or (Msg^.Message = LM_INTERNALPAINT) then
If Msg^.LParam <> 0 then begin begin
PS := PPaintStruct(Msg^.LParam); if Msg^.LParam <> 0 then
If Msg^.WParam<>0 then begin
DC := TGtkDeviceContext(Msg^.WParam) PS := PPaintStruct(Msg^.LParam);
else if Msg^.WParam<>0 then
DC := TGtkDeviceContext(PS^.hdc); DC := TGtkDeviceContext(Msg^.WParam)
EndPaint(THandle(PtrUInt(DC.Widget)), PS^); else
Dispose(PS); DC := TGtkDeviceContext(PS^.hdc);
Msg^.LParam:=0; EndPaint(THandle(PtrUInt(DC.Widget)), PS^);
Msg^.WParam:=0; Dispose(PS);
Msg^.LParam:=0;
Msg^.WParam:=0;
end else end else
if Msg^.WParam<>0 then begin if Msg^.WParam<>0 then
ReleaseDC(0,Msg^.WParam); begin
Msg^.WParam:=0; ReleaseDC(0, Msg^.WParam);
end; Msg^.WParam:=0;
end;
end else end else
if Msg^.Message=LM_GtkPAINT then begin if Msg^.Message = LM_GTKPAINT then
FreeThenNil(TObject(Msg^.WParam)); FreeThenNil(TObject(Msg^.WParam));
end;
end; end;
procedure SetGCRasterOperation(TheGC: PGDKGC; Rop: Cardinal); procedure SetGCRasterOperation(TheGC: PGDKGC; Rop: Cardinal);
@ -3591,7 +3596,7 @@ begin
{$ENDIF} {$ENDIF}
if (TLMessage(AMessage).Msg=LM_PAINT) if (TLMessage(AMessage).Msg=LM_PAINT)
or (TLMessage(AMessage).Msg=LM_INTERNALPAINT) or (TLMessage(AMessage).Msg=LM_INTERNALPAINT)
or (TLMessage(AMessage).Msg=LM_GtkPaint) then or (TLMessage(AMessage).Msg=LM_GTKPAINT) then
CurrentSentPaintMessageTarget:=TObject(Target); CurrentSentPaintMessageTarget:=TObject(Target);
try try
if TObject(Target) is TControl if TObject(Target) is TControl

4
lcl/interfaces/gtk/gtkproc.pp
View File

@ -377,6 +377,7 @@ procedure SetLabelAlignment(LabelWidget: PGtkLabel;
const NewAlignment: TAlignment); const NewAlignment: TAlignment);
// paint messages // paint messages
function DoDeliverPaintMessage(const Target: TObject; var PaintMsg: TLMPaint): PtrInt;
function GtkPaintMessageToPaintMessage(var GtkPaintMsg: TLMGtkPaint; function GtkPaintMessageToPaintMessage(var GtkPaintMsg: TLMGtkPaint;
FreeGtkPaintMsg: boolean): TLMPaint; FreeGtkPaintMsg: boolean): TLMPaint;
procedure FinalizePaintMessage(Msg: PLMessage); procedure FinalizePaintMessage(Msg: PLMessage);
@ -860,6 +861,9 @@ type
function IsEqual(Event: PGdkEventKey): boolean; function IsEqual(Event: PGdkEventKey): boolean;
end; end;
TWinControlAccess = class(TWinControl)
end;
{ TLCLHandledKeyEvent } { TLCLHandledKeyEvent }
constructor TLCLHandledKeyEvent.Create(Event: PGdkEventKey); constructor TLCLHandledKeyEvent.Create(Event: PGdkEventKey);

101
lcl/interfaces/gtk/gtkwinapi.inc
View File

@ -7172,31 +7172,38 @@ function TGtkWidgetSet.PostMessage(Handle: HWND; Msg: Cardinal; wParam: WParam;
vlItem := fMessageQueue.FindPaintMessage(NewMsg^.Hwnd); vlItem := fMessageQueue.FindPaintMessage(NewMsg^.Hwnd);
if vlItem = nil then exit; if vlItem = nil then exit;
OldMsg := vlItem.Msg; OldMsg := vlItem.Msg;
if OldMsg=nil then exit; if OldMsg = nil then exit;
if (NewMsg^.Message=LM_PAINT) or (OldMsg^.Message=LM_PAINT) then begin if (NewMsg^.Message = LM_PAINT) or (OldMsg^.Message = LM_PAINT) then
begin
// LM_PAINT means: repaint all // LM_PAINT means: repaint all
// convert NewMsg into a LM_PAINT if not already done // convert NewMsg into a LM_PAINT if not already done
if NewMsg^.Message<>LM_PAINT then begin if NewMsg^.Message <> LM_PAINT then
begin
FinalizePaintTagMsg(NewMsg); FinalizePaintTagMsg(NewMsg);
NewMsg^.Message:=LM_PAINT; NewMsg^.Message:=LM_PAINT;
end; end;
end else if (NewMsg^.Message<>LM_GtkPAINT) then begin end
RaiseGDBException('CombinePaintMessages A unknown paint message'); else
end else if (OldMsg^.Message<>LM_GtkPAINT) then begin if (NewMsg^.Message <> LM_GTKPAINT) then
RaiseGDBException('CombinePaintMessages B unknown paint message'); RaiseGDBException('CombinePaintMessages A unknown paint message')
end else begin else
if (OldMsg^.Message<>LM_GtkPAINT) then
RaiseGDBException('CombinePaintMessages B unknown paint message')
else
begin
// combine the two LM_GtkPAINT messages // combine the two LM_GtkPAINT messages
NewData:=TLMGtkPaintData(NewMsg^.WParam); NewData := TLMGtkPaintData(NewMsg^.WParam);
OldData:=TLMGtkPaintData(OldMsg^.WParam); OldData := TLMGtkPaintData(OldMsg^.WParam);
NewData.RepaintAll:=NewData.RepaintAll or OldData.RepaintAll; NewData.RepaintAll := NewData.RepaintAll or OldData.RepaintAll;
if not NewData.RepaintAll then begin if not NewData.RepaintAll then
NewData.Rect.Left:=Min(NewData.Rect.Left,OldData.Rect.Left); begin
NewData.Rect.Top:=Min(NewData.Rect.Top,OldData.Rect.Top); NewData.Rect.Left := Min(NewData.Rect.Left, OldData.Rect.Left);
NewData.Rect.Right:=Max(NewData.Rect.Right,OldData.Rect.Right); NewData.Rect.Top := Min(NewData.Rect.Top, OldData.Rect.Top);
NewData.Rect.Bottom:=Max(NewData.Rect.Bottom,OldData.Rect.Bottom); NewData.Rect.Right := Max(NewData.Rect.Right, OldData.Rect.Right);
NewData.Rect.Bottom := Max(NewData.Rect.Bottom, OldData.Rect.Bottom);
end; end;
end; end;
fMessageQueue.RemoveMessage(vlItem,FPMF_All,true); fMessageQueue.RemoveMessage(vlItem, FPMF_All, True);
end; end;
var var
@ -7211,7 +7218,8 @@ begin
AMessage^.LParam := LParam; AMessage^.LParam := LParam;
// Message^.Time := // Message^.Time :=
if (AMessage^.Message=LM_PAINT) or (AMessage^.Message=LM_GtkPAINT) then begin if (AMessage^.Message = LM_PAINT) or (AMessage^.Message = LM_GTKPAINT) then
begin
{ Obsolete, because InvalidateRectangle now works. { Obsolete, because InvalidateRectangle now works.
// paint messages are the most expensive messages in the LCL // paint messages are the most expensive messages in the LCL
@ -7227,7 +7235,7 @@ begin
// so that the widget repaints only once // so that the widget repaints only once
CombinePaintMessages(AMessage); CombinePaintMessages(AMessage);
end ; end;
FMessageQueue.AddMessage(AMessage); FMessageQueue.AddMessage(AMessage);
end; end;
@ -7992,21 +8000,22 @@ var
end; end;
{$ENDIF} {$ENDIF}
if AMessage.Msg=LM_GtkPAINT if AMessage.Msg = LM_GTKPAINT
then begin then begin
OldGtkPaintMsg:=TLMGtkPaint(AMessage); OldGtkPaintMsg := TLMGtkPaint(AMessage);
GtkPaintData:=OldGtkPaintMsg.Data; GtkPaintData := OldGtkPaintMsg.Data;
// convert LM_GtkPAINT to LM_PAINT // convert LM_GTKPAINT to LM_PAINT
AMessage := TLMessage(GtkPaintMessageToPaintMessage( AMessage := TLMessage(GtkPaintMessageToPaintMessage(
TLMGtkPaint(AMessage), False)); TLMGtkPaint(AMessage), False));
{$IfNDef GTK2} {$IfNDef GTK2}
if (GtkPaintData<>nil) and (not GtkPaintData.RepaintAll) if (GtkPaintData <> nil) and (not GtkPaintData.RepaintAll)
then begin then begin
PaintDC:=TLMPaint(AMessage).DC; PaintDC := TLMPaint(AMessage).DC;
DCOrigin:= TGtkDeviceContext(PaintDC).Offset; DCOrigin := TGtkDeviceContext(PaintDC).Offset;
with GtkPaintData.Rect do with GtkPaintData.Rect do
IntersectClipRect(PaintDC,Left-DCOrigin.X,Top-DCOrigin.Y, IntersectClipRect(PaintDC,
Right-DCOrigin.X,Bottom-DCOrigin.Y); Left - DCOrigin.X, Top - DCOrigin.Y,
Right - DCOrigin.X, Bottom - DCOrigin.Y);
end; end;
{$EndIf} {$EndIf}
GtkPaintData.Free; GtkPaintData.Free;
@ -8015,18 +8024,21 @@ var
procedure DisposePaintMessage(TargetObject: TObject; var AMessage: TLMessage); procedure DisposePaintMessage(TargetObject: TObject; var AMessage: TLMessage);
begin begin
if OldMsg=LM_GtkPAINT then begin if OldMsg = LM_GTKPAINT then
begin
FinalizePaintMessage(@AMessage); FinalizePaintMessage(@AMessage);
//if (csDesigning in TComponent(TargetObject).ComponentState) //if (csDesigning in TComponent(TargetObject).ComponentState)
//and (TargetObject is TWinControl) then //and (TargetObject is TWinControl) then
// SendPaintMessagesForInternalWidgets(TWinControl(TargetObject)); // SendPaintMessagesForInternalWidgets(TWinControl(TargetObject));
end else end
if ((AMessage.Msg=LM_PAINT) or (AMessage.Msg=LM_INTERNALPAINT)) else
and (AMessage.WParam<>0) then begin if ((AMessage.Msg = LM_PAINT) or (AMessage.Msg = LM_INTERNALPAINT))
and (AMessage.WParam <> 0) then
begin
// free DC // free DC
ReleaseDC(0,AMessage.WParam); ReleaseDC(0, AMessage.WParam);
AMessage.WParam:=0; AMessage.WParam := 0;
//if (csDesigning in TComponent(TargetObject).ComponentState) //if (csDesigning in TComponent(TargetObject).ComponentState)
//and (TargetObject is TWinControl) then //and (TargetObject is TWinControl) then
@ -8038,7 +8050,7 @@ var
AMessage: TLMessage; AMessage: TLMessage;
Target: TObject; Target: TObject;
begin begin
OldMsg:=Msg; OldMsg := Msg;
AMessage.Msg := Msg; AMessage.Msg := Msg;
AMessage.WParam := WParam; AMessage.WParam := WParam;
@ -8047,17 +8059,18 @@ begin
Target := GetLCLObject(Pointer(HandleWnd)); Target := GetLCLObject(Pointer(HandleWnd));
if Target<>nil then begin if Target <> nil then
if (Msg=LM_PAINT) or (Msg=LM_GtkPaint) then begin begin
if (Msg = LM_PAINT) or (Msg = LM_GTKPAINT) then
begin
PreparePaintMessage(Target,AMessage); PreparePaintMessage(Target,AMessage);
end; Result := DoDeliverPaintMessage(Target, TLMPaint(AMessage));
end
else
Result := DeliverMessage(Target, AMessage); // deliver it
// deliver it if (Msg = LM_PAINT) or (Msg = LM_INTERNALPAINT) or (Msg = LM_GTKPAINT) then
Result := DeliverMessage(Target, AMessage); DisposePaintMessage(Target, AMessage);
if (Msg=LM_PAINT) or (Msg=LM_INTERNALPAINT) or (Msg=LM_GtkPaint) then begin
DisposePaintMessage(Target,AMessage);
end;
end; end;
end; end;