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

MG: reduced paint messages and DC getting/releasing

Browse Source 
git-svn-id: trunk@1968 -
This commit is contained in:
lazarus 2002-08-17 23:40:26 +00:00
parent e376417311
commit fb47c94ac2
6 changed files with 467 additions and 80 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -97,6 +97,7 @@ designer/componenteditors.pas svneol=native#text/pascal
designer/controlselection.pp svneol=native#text/pascal
designer/customeditor.pp svneol=native#text/pascal
designer/designer.pp svneol=native#text/pascal
designer/designerprocs.pas svneol=native#text/pascal
designer/designerstr.pas svneol=native#text/pascal
designer/filesystem.pp svneol=native#text/pascal
designer/jitforms.pp svneol=native#text/pascal

46
designer/designer.pp
View File

@ -37,7 +37,8 @@ interface
uses
Classes, LCLType, LCLLinux, Forms, Controls, LMessages, GraphType, Graphics,
ControlSelection, CustomFormEditor, FormEditor, UnitEditor, CompReg, Menus,
AlignCompsDlg, SizeCompsDlg, ScaleCompsDlg, ExtCtrls, EnvironmentOpts;
AlignCompsDlg, SizeCompsDlg, ScaleCompsDlg, ExtCtrls, EnvironmentOpts,
DesignerProcs;
type
TDesigner = class;
@ -134,6 +135,8 @@ type
Procedure OnFormActivated;
public
ControlSelection : TControlSelection;
DC: TDesignerDeviceContext;
constructor Create(Customform : TCustomform;
AControlSelection: TControlSelection);
destructor Destroy; override;
@ -149,7 +152,7 @@ type
Procedure SelectOnlyThisComponent(AComponent:TComponent);
function NonVisualComponentLeftTop(AComponent: TComponent): TPoint;
function NonVisualComponentAtPos(x,y: integer): TComponent;
procedure DrawNonVisualComponents(DC: HDC);
procedure DrawNonVisualComponents(DDC: TDesignerDeviceContext);
function GetDesignedComponent(AComponent: TComponent): TComponent;
property ShowGrid: boolean read GetShowGrid write SetShowGrid;
@ -220,6 +223,8 @@ begin
FHintWindow.Caption := 'This is a hint window'#13#10'Neat huh?';
FHintWindow.HideInterval := 4000;
FHintWindow.AutoHide := True;
DC:=TDesignerDeviceContext.Create;
end;
destructor TDesigner.Destroy;
@ -229,6 +234,7 @@ Begin
FHintWIndow.Free;
FHintTimer.Free;
DC.Free;
Inherited Destroy;
end;
@ -322,25 +328,34 @@ function TDesigner.PaintControl(Sender: TControl; TheMessage: TLMPaint):boolean;
var OldDuringPaintControl: boolean;
begin
Result:=true;
//writeln('TDesigner.PaintControl A ',Sender.Name);
//writeln('*** LM_PAINT A ',Sender.Name,':',Sender.ClassName,' DC=',HexStr(Message.DC,8));
// Set flag
OldDuringPaintControl:=FDuringPaintControl;
FDuringPaintControl:=true;
// send the Paint message to the control, so that it paints itself
//writeln('TDesigner.PaintControl B ',Sender.Name);
Sender.Dispatch(TheMessage);
//writeln('TDesigner.PaintControl C ',Sender.Name);
{$IFDEF VerboseDesignerDraw}
writeln('TDesigner.PaintControl C ',Sender.Name,' DC=',HexStr(Cardinal(TheMessage.DC),8));
{$ENDIF}
// paint the Designer stuff
if TheMessage.DC<>0 then begin
DC.SetDC(Form,TheMessage.DC);
//writeln('*** LM_PAINT B ',Sender.Name,':',Sender.ClassName,' DC=',HexStr(Message.DC,8));
if (ControlSelection.IsSelected(Sender)) then begin
// writeln('*** LM_PAINT ',Sender.Name,':',Sender.ClassName,' DC=',HexStr(Message.DC,8));
ControlSelection.DrawMarker(Sender,TheMessage.DC);
ControlSelection.DrawMarker(Sender,DC);
end;
DrawNonVisualComponents(TheMessage.DC);
ControlSelection.DrawGrabbers(TheMessage.DC);
ControlSelection.DrawGuideLines(TheMessage.DC);
DrawNonVisualComponents(DC);
ControlSelection.DrawGrabbers(DC);
ControlSelection.DrawGuideLines(DC);
if ControlSelection.RubberBandActive then
ControlSelection.DrawRubberBand(TheMessage.DC);
ControlSelection.DrawRubberBand(DC);
DC.Clear;
end;
//writeln('TDesigner.PaintControl D ',Sender.Name);
@ -924,21 +939,17 @@ Begin
end;
procedure TDesigner.DrawNonVisualComponents(DC: HDC);
procedure TDesigner.DrawNonVisualComponents(DDC: TDesignerDeviceContext);
var
i, j, ItemLeft, ItemTop, ItemRight, ItemBottom,
IconWidth, IconHeight: integer;
FormOrigin, DCOrigin, Diff, ItemLeftTop: TPoint;
SaveIndex: HDC;
Diff, ItemLeftTop: TPoint;
IconRect: TRect;
IconCanvas: TCanvas;
begin
GetWindowOrgEx(DC, DCOrigin);
FormOrigin:=FCustomForm.ClientOrigin;
Diff.X:=FormOrigin.X-DCOrigin.X;
Diff.Y:=FormOrigin.Y-DCOrigin.Y;
SaveIndex:=SaveDC(DC);
FCustomForm.Canvas.Handle:=DC;
Diff:=DC.FormOrigin;
DDC.Save;
FCustomForm.Canvas.Handle:=DDC.DC;
for i:=0 to FCustomForm.ComponentCount-1 do begin
if not (FCustomForm.Components[i] is TControl) then begin
// non-visual component
@ -985,7 +996,6 @@ begin
end;
end;
FCustomForm.Canvas.Handle:=0;
RestoreDC(DC,SaveIndex);
end;
function TDesigner.GetDesignedComponent(AComponent: TComponent): TComponent;

297
designer/designerprocs.pas Normal file
View File

@ -0,0 +1,297 @@
{/***************************************************************************
DesignerProcs.pas
-----------------
***************************************************************************/
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
* *
***************************************************************************
Author: Mattias Gaertner
}
unit DesignerProcs;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LCLLinux, Forms, Controls, LCLType;
type
TDesignerDCFlag = (ddcDCOriginValid, ddcFormOriginValid,
ddcFormClientOriginValid);
TDesignerDCFlags = set of TDesignerDCFlag;
TDesignerDeviceContext = class
private
FDC: HDC;
FDCOrigin: TPoint; // DC origin on desktop
FFlags: TDesignerDCFlags;
FFormClientOrigin: TPoint; // Form client origin on desktop
FFormOrigin: TPoint; // DC origin relative to designer Form
FSavedDC: HDC;
FForm: TCustomForm;
function GetDCOrigin: TPoint;
function GetFormClientOrigin: TPoint;
function GetFormOrigin: TPoint;
public
procedure SetDC(AForm: TCustomForm; aDC: HDC);
procedure Clear;
procedure Save;
procedure Restore;
property DC: HDC read FDC;
property FormOrigin: TPoint read GetFormOrigin;// DC origin relative to designer Form
property DCOrigin: TPoint read GetDCOrigin;
property FormClientOrigin: TPoint read GetFormClientOrigin;
end;
const
NonVisualCompIconWidth = 23;
NonVisualCompBorder = 2;
NonVisualCompWidth = NonVisualCompIconWidth+2*NonVisualCompBorder;
function GetParentFormRelativeTopLeft(Component: TComponent): TPoint;
function GetParentFormRelativeBounds(Component: TComponent): TRect;
function GetParentFormRelativeClientOrigin(Component: TComponent): TPoint;
function GetParentFormRelativeParentClientOrigin(Component: TComponent): TPoint;
function GetFormRelativeMousePosition(Form: TCustomForm): TPoint;
function ComponentIsTopLvl(AComponent: TComponent): boolean;
procedure GetComponentBounds(AComponent: TComponent;
var Left, Top, Width, Height: integer);
function GetComponentLeft(AComponent: TComponent): integer;
function GetComponentTop(AComponent: TComponent): integer;
function GetComponentWidth(AComponent: TComponent): integer;
function GetComponentHeight(AComponent: TComponent): integer;
implementation
function GetParentFormRelativeTopLeft(Component: TComponent): TPoint;
var
FormOrigin: TPoint;
ParentForm: TCustomForm;
Parent: TWinControl;
begin
if Component is TControl then begin
ParentForm:=GetParentForm(TControl(Component));
Parent:=TControl(Component).Parent;
if (Parent=nil) or (ParentForm=nil) then begin
Result:=Point(0,0);
end else begin
Result:=Parent.ClientOrigin;
FormOrigin:=ParentForm.ClientOrigin;
Result.X:=Result.X-FormOrigin.X+TControl(Component).Left;
Result.Y:=Result.Y-FormOrigin.Y+TControl(Component).Top;
end;
end else begin
Result.X:=LongRec(Component.DesignInfo).Lo;
Result.Y:=LongRec(Component.DesignInfo).Hi;
end;
end;
function GetParentFormRelativeBounds(Component: TComponent): TRect;
var CTopLeft: TPoint;
begin
CTopLeft:=GetParentFormRelativeTopLeft(Component);
Result.Left:=CTopLeft.X;
Result.Top:=CTopLeft.Y;
Result.Right:=Result.Left+GetComponentWidth(Component);
Result.Bottom:=Result.Top+GetComponentHeight(Component);
end;
function GetParentFormRelativeClientOrigin(Component: TComponent): TPoint;
var
FormOrigin: TPoint;
ParentForm: TCustomForm;
begin
if Component is TControl then begin
ParentForm:=GetParentForm(TControl(Component));
if ParentForm=nil then begin
Result:=Point(0,0);
end else begin
Result:=TControl(Component).ClientOrigin;
FormOrigin:=ParentForm.ClientOrigin;
Result.X:=Result.X-FormOrigin.X;
Result.Y:=Result.Y-FormOrigin.Y;
end;
end else begin
Result.X:=LongRec(Component.DesignInfo).Lo;
Result.Y:=LongRec(Component.DesignInfo).Hi;
end;
end;
function GetParentFormRelativeParentClientOrigin(Component: TComponent): TPoint;
var
FormOrigin, ParentOrigin: TPoint;
ParentForm: TCustomForm;
Parent: TWinControl;
begin
if Component is TControl then begin
ParentForm:=GetParentForm(TControl(Component));
Parent:=TControl(Component).Parent;
if (Parent=nil) or (ParentForm=nil) then begin
Result:=Point(0,0);
end else begin
ParentOrigin:=Parent.ClientOrigin;
FormOrigin:=ParentForm.ClientOrigin;
Result.X:=ParentOrigin.X-FormOrigin.X;
Result.Y:=ParentOrigin.Y-FormOrigin.Y;
end;
end else begin
Result:=Point(0,0);
end;
end;
function GetFormRelativeMousePosition(Form: TCustomForm): TPoint;
var
FormClientOrigin: TPoint;
begin
Result.X:=0;
Result.Y:=0;
GetCaretPos(Result);
FormClientOrigin:=Form.ClientOrigin;
dec(Result.X,FormClientOrigin.X);
dec(Result.Y,FormClientOrigin.Y);
end;
function ComponentIsTopLvl(AComponent: TComponent): boolean;
begin
Result:=(AComponent<>nil) and (AComponent is TControl)
and (TControl(AComponent).Parent=nil);
end;
procedure GetComponentBounds(AComponent: TComponent;
var Left, Top, Width, Height: integer);
begin
if AComponent is TControl then begin
Left:=TControl(AComponent).Left;
Top:=TControl(AComponent).Top;
Width:=TControl(AComponent).Width;
Height:=TControl(AComponent).Height;
end else begin
Left:=LongRec(AComponent.DesignInfo).Lo;
Top:=LongRec(AComponent.DesignInfo).Hi;
Width:=NonVisualCompWidth;
Height:=Width;
end;
end;
function GetComponentLeft(AComponent: TComponent): integer;
begin
if AComponent is TControl then begin
Result:=TControl(AComponent).Left;
end else begin
Result:=LongRec(AComponent.DesignInfo).Lo;
end;
end;
function GetComponentTop(AComponent: TComponent): integer;
begin
if AComponent is TControl then begin
Result:=TControl(AComponent).Top;
end else begin
Result:=LongRec(AComponent.DesignInfo).Hi;
end;
end;
function GetComponentWidth(AComponent: TComponent): integer;
begin
if AComponent is TControl then begin
Result:=TControl(AComponent).Width;
end else begin
Result:=NonVisualCompWidth;
end;
end;
function GetComponentHeight(AComponent: TComponent): integer;
begin
if AComponent is TControl then begin
Result:=TControl(AComponent).Height;
end else begin
Result:=NonVisualCompWidth;
end;
end;
{ TDesignerDeviceContext }
function TDesignerDeviceContext.GetDCOrigin: TPoint;
begin
if not (ddcDCOriginValid in FFlags) then begin
GetWindowOrgEx(FDC,FDCOrigin);
Include(FFlags,ddcDCOriginValid);
end;
Result:=FDCOrigin;
end;
function TDesignerDeviceContext.GetFormClientOrigin: TPoint;
begin
if not (ddcFormClientOriginValid in FFlags) then begin
FFormClientOrigin:=FForm.ClientOrigin;
Include(FFlags,ddcFormClientOriginValid);
end;
Result:=FFormClientOrigin;
end;
function TDesignerDeviceContext.GetFormOrigin: TPoint;
var
FormClientOrig, DCOrig: TPoint;
begin
if not (ddcFormOriginValid in FFlags) then begin
FormClientOrig:=FormClientOrigin;
DCOrig:=DCOrigin;
FFormOrigin.X:=DCOrig.X-FormClientOrig.X;
FFormOrigin.Y:=DCOrig.Y-FormClientOrig.Y;
Include(FFlags,ddcFormOriginValid);
end;
Result:=FFormOrigin;
end;
procedure TDesignerDeviceContext.SetDC(AForm: TCustomForm; aDC: HDC);
begin
Clear;
FDC:=aDC;
FForm:=AForm;
end;
procedure TDesignerDeviceContext.Clear;
begin
Restore;
FDC:=0;
FFlags:=FFlags-[ddcFormOriginValid,ddcFormClientOriginValid,ddcDCOriginValid];
end;
procedure TDesignerDeviceContext.Save;
begin
if FSavedDC=0 then
FSavedDC:=SaveDC(DC);
end;
procedure TDesignerDeviceContext.Restore;
begin
if FSavedDC<>0 then begin
RestoreDC(DC,FSavedDC);
FSavedDC:=0;
end;
end;
end.

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

@ -43,6 +43,8 @@ var
function DeliverPostMessage(const Target: Pointer; var TheMessage): GBoolean;
var
PaintMsg: TLMPaint;
begin
if TObject(Target) is TWinControl then
begin
@ -51,15 +53,22 @@ begin
end
else
begin
Result := DeliverMessage(Target, TheMessage) = 0;
if TLMessage(TheMessage).Msg<>LM_GtkPAINT then
Result := DeliverMessage(Target, TheMessage) = 0
else begin
PaintMsg:= GtkPaintMessageToPaintMessage(TLMGtkPaint(TheMessage));
Result := DeliverMessage(Target,PaintMsg) = 0;
end;
end;
end;
procedure EventTrace(Themessage : string; data : pointer);
procedure EventTrace(const TheMessage : string; data : pointer);
begin
if Data = nil
then Assert(False, Format('Trace:Event [%s] fired',[Themessage]))
else Assert(False, Format('Trace:Event [%s] fired for %s',[Themessage, TObject(data).Classname]));
if Data = nil then
Assert(False, Format('Trace:Event [%s] fired',[Themessage]))
else
Assert(False, Format('Trace:Event [%s] fired for %s',
[TheMessage, TObject(data).Classname]));
end;
{*************************************************************}
@ -92,7 +101,7 @@ end;
but before the widget itself got the realize signal.
That means that the gdk window on the xserver has been created.
-------------------------------------------------------------------------------}
function GTKRealizeCB(Widget: PGtkWidget; Data: Pointer): GBoolean; cdecl;
function gtkRealizeCB(Widget: PGtkWidget; Data: Pointer): GBoolean; cdecl;
begin
EventTrace('realize', nil);
@ -119,7 +128,7 @@ end;
has initialized the gdkwindow. This function is used for the second part of
the initialization of a widget.
-------------------------------------------------------------------------------}
function GTKRealizeAfterCB(Widget: PGtkWidget; Data: Pointer): GBoolean; cdecl;
function gtkRealizeAfterCB(Widget: PGtkWidget; Data: Pointer): GBoolean; cdecl;
var
WinWidgetInfo: PWinWidgetInfo;
HiddenLCLObject, LCLObject: TObject;
@ -267,21 +276,79 @@ begin
// Result := DeliverMessage(Data, MSG) = 0;
end;
function gtkdraw(Widget: PGtkWidget; area: PGDKRectangle;
function gtkDraw(Widget: PGtkWidget; area: PGDKRectangle;
data: gPointer) : GBoolean; cdecl;
var
MSG: TLMPaint;
MSG: TLMGtkPaint;
begin
Result := True;
EventTrace('draw', data);
MSG.Msg := LM_PAINT;
MSG.DC := GetDC(THandle(Widget));
MSG.Unused := 0;
MSG.Msg := LM_GtkPAINT;
MSG.Widget := Widget;
MSG.Unused1 := 0;
MSG.Unused2 := 0;
Result := DeliverPostMessage(Data, MSG);
// Result := DeliverMessage(Data, MSG) = 0;
end;
function gtkDrawAfter(Widget: PGtkWidget; area: PGDKRectangle;
data: gPointer) : GBoolean; cdecl;
var
MSG: TLMGtkPaint;
DesignOnlySignal: boolean;
begin
Result := True;
EventTrace('DrawAfter', data);
if not (csDesigning in TComponent(Data).ComponentState) then begin
DesignOnlySignal:=GetDesignOnlySignalFlag(Widget,dstDrawAfter);
if DesignOnlySignal then exit;
end else begin
{$IFDEF VerboseDesignerDraw}
writeln('gtkDrawAfter',
' Widget=',HexStr(Cardinal(Widget),8),
' ',TComponent(Data).Name);
{$ENDIF}
end;
MSG.Msg := LM_GtkPAINT;
MSG.Widget := Widget;
MSG.Unused1 := 0;
MSG.Unused2 := 0;
Result := DeliverPostMessage(Data, MSG);
end;
function gtkExposeEventAfter(Widget: PGtkWidget; Event : PGDKEventExpose;
Data: gPointer): GBoolean; cdecl;
var
MSG: TLMGtkPaint;
DesignOnlySignal: boolean;
begin
Result := True;
EventTrace('expose-event', data);
if (Event^.Count > 0) then exit;
if not (csDesigning in TComponent(Data).ComponentState) then begin
DesignOnlySignal:=GetDesignOnlySignalFlag(Widget,dstExposeAfter);
if DesignOnlySignal then exit;
end else begin
{$IFDEF VerboseDesignerDraw}
writeln('gtkExposeAfter',
' Widget=',HexStr(Cardinal(Widget),8),
' ',TComponent(Data).Name);
{$ENDIF}
end;
MSG.Msg := LM_GtkPAINT;
MSG.Widget := Widget;
MSG.Unused1 := 0;
MSG.Unused2 := 0;
Result := DeliverPostMessage(Data, MSG);
end;
function gtkfrmactivate( widget: PGtkWidget; Event : TgdkEventFocus;
data: gPointer) : GBoolean; cdecl;
@ -309,27 +376,6 @@ begin
EventTrace('map', data);
end;
function GTKExposeEvent(Widget: PGtkWidget; Event : PGDKEventExpose;
Data: gPointer): GBoolean; cdecl;
var
// Mess : TLMessage;
// fWindow : pgdkWindow;
// widget2: pgtkWidget;
// PixMap : pgdkPixMap;
msg: TLMPaint;
begin
Result := True;
EventTrace('expose-event', data);
if (Event^.Count > 0) then exit;
msg.msg := LM_PAINT;
MSG.DC := GetDC(THandle(Widget));
msg.Unused := 0;
Result := DeliverPostMessage(Data, MSG);
end;
function GTKKeyUpDown(Widget: PGtkWidget; Event : pgdkeventkey;
Data: gPointer) : GBoolean; cdecl;
var
@ -519,7 +565,7 @@ end;
If the mouse is on the top-left pixel of the container widget then the
coordinates can be negative, if there is frame around the client area.
-------------------------------------------------------------------------------}
function GTKMotionNotify(Widget:PGTKWidget; Event: PGDKEventMotion;
function gtkMotionNotify(Widget:PGTKWidget; Event: PGDKEventMotion;
Data: gPointer): GBoolean; cdecl;
var
Msg: TLMMouseMove;
@ -541,12 +587,12 @@ begin
CheckMouseCaptureHandle(Widget);
if csDesigning in TControl(Data).ComponentState then begin
// stop the signal, so that the widget does not auto react
gtk_signal_emit_stop_by_name(PGTKObject(Widget),'motion-notify-event');
end else begin
if not (csDesigning in TComponent(Data).ComponentState) then begin
DesignOnlySignal:=GetDesignOnlySignalFlag(Widget,dstMouseMotion);
if DesignOnlySignal then exit;
end else begin
// stop the signal, so that the widget does not auto react
gtk_signal_emit_stop_by_name(PGTKObject(Widget),'motion-notify-event');
end;
MappedXY:=TranslateGdkPointToClientArea(Event^.Window,
@ -709,7 +755,7 @@ begin
writeln('');
DesignOnlySignal:=GetDesignOnlySignalFlag(Widget,dstMousePress);
writeln('[gtkMouseBtnPress] ',
TControl(Data).Name,':',TObject(Data).ClassName,
TComponent(Data).Name,':',TObject(Data).ClassName,
' Widget=',HexStr(Cardinal(Widget),8),
' ControlWidget=',HexStr(Cardinal(TWinControl(Data).Handle),8),
' DSO=',DesignOnlySignal,
@ -730,13 +776,13 @@ begin
CheckMouseCaptureHandle(Widget);
if csDesigning in TControl(Data).ComponentState then begin
if not (csDesigning in TComponent(Data).ComponentState) then begin
DesignOnlySignal:=GetDesignOnlySignalFlag(Widget,dstMousePress);
if DesignOnlySignal then exit;
end else begin
// stop the signal, so that the widget does not auto react
if TControl(Data).FCompStyle<>csNotebook then
gtk_signal_emit_stop_by_name(PGTKObject(Widget),'button-press-event');
end else begin
DesignOnlySignal:=GetDesignOnlySignalFlag(Widget,dstMousePress);
if DesignOnlySignal then exit;
end;
EventXY:=Point(trunc(Event^.X),trunc(Event^.Y));
@ -863,7 +909,7 @@ begin
{$IFDEF VerboseMouseBugfix}
DesignOnlySignal:=GetDesignOnlySignalFlag(Widget,dstMouseRelease);
writeln('[gtkMouseBtnRelease] A ',
TControl(Data).Name,':',TObject(Data).ClassName,' ',
TComponent(Data).Name,':',TObject(Data).ClassName,' ',
' Widget=',HexStr(Cardinal(Widget),8),
' DSO=',DesignOnlySignal,
' ',Trunc(Event^.X),',',Trunc(Event^.Y),' Btn=',event^.Button);
@ -875,13 +921,13 @@ begin
CheckMouseCaptureHandle(Widget);
if csDesigning in TControl(Data).ComponentState then begin
if not (csDesigning in TComponent(Data).ComponentState) then begin
DesignOnlySignal:=GetDesignOnlySignalFlag(Widget,dstMouseRelease);
if DesignOnlySignal then exit;
end else begin
// stop the signal, so that the widget does not auto react
if TControl(Data).FCompStyle<>csNotebook then
gtk_signal_emit_stop_by_name(PGTKObject(Widget),'button-release-event');
end else begin
DesignOnlySignal:=GetDesignOnlySignalFlag(Widget,dstMouseRelease);
if DesignOnlySignal then exit;
end;
EventTrace('Mouse button release', data);
@ -2206,6 +2252,9 @@ end;
{ =============================================================================
$Log$
Revision 1.114 2002/08/28 09:40:49 lazarus
MG: reduced paint messages and DC getting/releasing
Revision 1.113 2002/08/27 18:45:13 lazarus
MG: propedits text improvements from Andrew, uncapturing, improved comobobox

48
lcl/lazqueue.pp
View File

@ -45,6 +45,8 @@ type
FCount: integer;
function GetNewItem: PLazQueueItem;
procedure DisposeItem(AnItem: PLazQueueItem);
procedure Unbind(AnItem: PLazQueueItem);
procedure AddAsLast(AnItem: PLazQueueItem);
public
property First: PLazQueueItem read FFirst;
property Last: PLazQueueItem read FLast;
@ -53,6 +55,7 @@ type
property Count: integer read FCount;
procedure AddLast(Data: Pointer);
procedure Delete(AnItem: PLazQueueItem);
procedure MoveToLast(AnItem: PLazQueueItem);
function Find(Data: Pointer): PLazQueueItem;
procedure Clear;
function ConsistencyCheck: integer;
@ -104,24 +107,21 @@ var NewItem: PLazQueueItem;
begin
NewItem:=GetNewItem;
NewItem^.Data:=Data;
NewItem^.Prior:=FLast;
NewItem^.Next:=nil;
FLast:=NewItem;
if NewItem^.Prior<>nil then
NewItem^.Prior^.Next:=NewItem;
if FFirst=nil then FFirst:=NewItem;
inc(FCount);
AddAsLast(NewItem);
end;
procedure TLazQueue.Delete(AnItem: PLazQueueItem);
begin
if AnItem=nil then exit;
if FFirst=AnItem then FFirst:=FFirst^.Next;
if FLast=AnItem then FLast:=FLast^.Prior;
if AnItem^.Prior<>nil then AnItem^.Prior^.Next:=AnItem^.Next;
if AnItem^.Next<>nil then AnItem^.Next^.Prior:=AnItem^.Prior;
Unbind(AnItem);
DisposeItem(AnItem);
dec(FCount);
end;
procedure TLazQueue.MoveToLast(AnItem: PLazQueueItem);
begin
if AnItem=nil then exit;
Unbind(AnItem);
AddAsLast(AnItem);
end;
procedure TLazQueue.Clear;
@ -172,6 +172,30 @@ begin
end;
end;
procedure TLazQueue.Unbind(AnItem: PLazQueueItem);
begin
if AnItem=nil then exit;
if FFirst=AnItem then FFirst:=FFirst^.Next;
if FLast=AnItem then FLast:=FLast^.Prior;
if AnItem^.Prior<>nil then AnItem^.Prior^.Next:=AnItem^.Next;
if AnItem^.Next<>nil then AnItem^.Next^.Prior:=AnItem^.Prior;
AnItem^.Prior:=nil;
AnItem^.Next:=nil;
dec(FCount);
end;
procedure TLazQueue.AddAsLast(AnItem: PLazQueueItem);
begin
AnItem^.Prior:=FLast;
AnItem^.Next:=nil;
FLast:=AnItem;
if AnItem^.Prior<>nil then
AnItem^.Prior^.Next:=AnItem
else
FFirst:=AnItem;
inc(FCount);
end;
function TLazQueue.Find(Data: Pointer): PLazQueueItem;
begin
Result:=FFirst;

8
lcl/lmessages.pp
View File

@ -331,7 +331,10 @@ const
LM_RBUTTONTRIPLECLK = LM_USER+72;
LM_RBUTTONQUADCLK = LM_USER+73;
LM_UNKNOWN = LM_User+99;
LM_INTERFACEFIRST = LM_User+99;
LM_INTERFACELAST = LM_User+199;
LM_UNKNOWN = LM_INTERFACELAST+1;
type
@ -840,6 +843,9 @@ end.
{
$Log$
Revision 1.28 2002/08/28 09:40:48 lazarus
MG: reduced paint messages and DC getting/releasing
Revision 1.27 2002/08/06 09:32:48 lazarus
MG: moved TColor definition to graphtype.pp and registered TColor names