started double buffering for gtk intf

git-svn-id: trunk@5045 -
This commit is contained in:
mattias 2004-01-10 22:34:20 +00:00
parent e00eb8fd1a
commit 1766d6ed74
11 changed files with 446 additions and 197 deletions

View File

@ -56,6 +56,10 @@ unit SynEdit;
{$I synedit.inc}
{$IFDEF UseGTKDoubleBuf}
{$DEFINE DisableDoubleBuf}
{$ENDIF}
interface
{ $DEFINE VerboseKeys}
@ -554,8 +558,8 @@ type
fInternalImage: TSynInternalImage;
{$IFNDEF DisableDoubleBuf}
BufferBitmap: TBitmap; // the double buffer
SavedCanvas: TCanvas; // the normal TCustomControl canvas during paint
{$ENDIF}
SavedCanvas: TCanvas; // the normal TCustomControl canvas during paint
procedure DoOnClearBookmark(var Mark: TSynEditMark); virtual; // djlp - 2000-08-29
procedure DoOnCommandProcessed(Command: TSynEditorCommand; AChar: char;
Data: pointer); virtual;
@ -2329,12 +2333,12 @@ begin
// the gutter separator if visible
if AClip.Right >= fGutterWidth - 2 then
with Canvas do begin
Pen.Color := clBtnHighlight;
Pen.Color := {$IFDEF SYN_LAZARUS}clWhite{$ELSE}clBtnHighlight{$ENDIF};
Pen.Width := 1;
with AClip do begin
MoveTo(fGutterWidth - 2, Top);
LineTo(fGutterWidth - 2, Bottom);
Pen.Color := clBtnShadow;
Pen.Color := {$IFDEF SYN_LAZARUS}clDkGray{$ELSE}clBtnShadow{$ENDIF};
MoveTo(fGutterWidth - 1, Top);
LineTo(fGutterWidth - 1, Bottom);
end;

View File

@ -768,7 +768,7 @@ type
property Caption;
property ClientHeight;
property ClientWidth;
property Color default clBackground;
property Color;
property DragMode;
property Enabled;
property Font;
@ -836,6 +836,9 @@ end.
{
$Log$
Revision 1.89 2004/01/10 22:34:20 mattias
started double buffering for gtk intf
Revision 1.88 2004/01/10 18:00:42 mattias
fixed GetWindowOrgEx, added GetDCOriginRelativeToWindow

View File

@ -31,6 +31,10 @@ begin
FCanvas := TControlCanvas.Create;
TControlCanvas(FCanvas).Control := Self;
// custom controls are painted by the LCL, not the interface, so enable
// double buffering. It's up to the interface to do the actual
// doublebuffering.
DoubleBuffered:=true;
end;
{------------------------------------------------------------------------------
@ -92,7 +96,7 @@ procedure TCustomControl.PaintWindow(DC: HDC);
var
DCChanged: boolean;
begin
DCChanged:=(FCanvas.Handle<>DC);
DCChanged:=(not FCanvas.HandleAllocated) or (FCanvas.Handle<>DC);
if DCChanged then
FCanvas.Handle := DC;
try
@ -107,6 +111,9 @@ end;
{ =============================================================================
$Log$
Revision 1.9 2004/01/10 22:34:20 mattias
started double buffering for gtk intf
Revision 1.8 2004/01/03 23:14:59 mattias
default font can now change height and fixed gtk crash

View File

@ -58,7 +58,7 @@ begin
Result := True;
end;
function TInterfaceBase.BeginPaint(Handle: hWnd; Var PS : TPaintStruct) : hdc;
function TInterfaceBase.BeginPaint(Handle: hWnd; Var PS: TPaintStruct): hdc;
begin
Result:=GetDC(Handle);
end;
@ -1397,6 +1397,9 @@ end;
{ =============================================================================
$Log$
Revision 1.4 2004/01/10 22:34:20 mattias
started double buffering for gtk intf
Revision 1.3 2003/12/29 14:22:22 micha
fix a lot of range check errors win32

View File

@ -211,9 +211,10 @@ type
WndProc: Integer; // window data
Style: Integer;
ExStyle: Integer;
UserData: Integer;
EventMask: TGdkEventMask;
DoubleBuffer: PGdkPixmap;
Flags: TWinWidgetInfoFlags;
UserData: Integer;
end;
// clipboard
@ -545,6 +546,9 @@ end.
{ =============================================================================
$Log$
Revision 1.51 2004/01/10 22:34:20 mattias
started double buffering for gtk intf
Revision 1.50 2003/10/17 03:21:21 ajgenius
fix GTK2 compiling for new Keyboard changes

View File

@ -163,6 +163,7 @@ type
procedure DisposeDC(aDC: TDeviceContext);virtual;
function CreateDCForWidget(TheWidget: PGtkWidget; TheWindow: PGdkWindow;
WithChildWindows: boolean): HDC;
function GetDoubleBufferedDC(Handle: HWND): HDC;
// GDIObjects
function IsValidGDIObject(const GDIObject: HGDIOBJ): Boolean;virtual;
@ -417,6 +418,9 @@ end.
{ =============================================================================
$Log$
Revision 1.166 2004/01/10 22:34:20 mattias
started double buffering for gtk intf
Revision 1.165 2004/01/09 20:03:13 mattias
implemented new statusbar methods in gtk intf

View File

@ -7903,6 +7903,87 @@ begin
Assert(False, Format('trace:< [TgtkObject.GetDC] Got 0x%x', [Result]));
end;
{------------------------------------------------------------------------------
function TgtkObject.GetDoubleBufferedDC(Handle: HWND): HDC;
------------------------------------------------------------------------------}
function TgtkObject.GetDoubleBufferedDC(Handle: HWND): HDC;
var
Widget: PGtkWidget;
WidgetInfo: PWinWidgetInfo;
AWindow: PGdkWindow;
Width, Height: integer;
BufferWidth, BufferHeight: integer;
DoubleBuffer: PGdkPixmap;
BufferCreated: Boolean;
DevContext: TDeviceContext;
CaretWasVisible: Boolean;
MainWidget: PGtkWidget;
begin
Result:=0;
Widget:=PGtkWidget(Handle);
{$IFDEF VerboseDoubleBuffer}
writeln('TgtkObject.GetDoubleBufferedDC ',GetWidgetClassName(Widget));
{$ENDIF}
WidgetInfo:=GetWidgetInfo(Widget,true);
AWindow:=Widget^.Window;
gdk_window_get_size(AWindow,@Width,@Height);
// create or resize DoubleBuffer
DoubleBuffer:=WidgetInfo^.DoubleBuffer;
if DoubleBuffer<>nil then begin
gdk_window_get_size(DoubleBuffer,@BufferWidth,@BufferHeight);
{$IFDEF VerboseDoubleBuffer}
writeln('TgtkObject.GetDoubleBufferedDC Checking ',
' Width=',Width,' Height=',Height,
' BufferWidth=',BufferWidth,' BufferHeight=',BufferHeight
);
{$ENDIF}
// make sure buffer is not too small and not too big
if (BufferWidth<Width) or (BufferHeight<Height)
or (BufferWidth>(Width*2+20)) or (BufferHeight>(Height*2+20))
then begin
{$IFDEF VerboseDoubleBuffer}
writeln('TgtkObject.GetDoubleBufferedDC Destroying old double buffer ');
{$ENDIF}
gdk_pixmap_unref(DoubleBuffer);
DoubleBuffer:=nil;
WidgetInfo^.DoubleBuffer:=nil;
end;
end;
BufferCreated:=false;
if DoubleBuffer=nil then begin
// create DoubleBuffer
{$IFDEF VerboseDoubleBuffer}
writeln('TgtkObject.GetDoubleBufferedDC Creating double buffer ',
' Width=',Width,' Height=',Height);
{$ENDIF}
DoubleBuffer:=gdk_pixmap_new(AWindow,Width,Height,-1);
WidgetInfo^.DoubleBuffer:=DoubleBuffer;
BufferCreated:=true;
end;
// create DC for double buffer
Result:=CreateDCForWidget(Widget,PGDKWindow(DoubleBuffer),false);
if BufferCreated then begin
// copy old context to buffer
DevContext:=TDeviceContext(Result);
gdk_gc_set_clip_region(DevContext.GC, nil);
gdk_gc_set_clip_rectangle(DevContext.GC, nil);
// hide caret
HideCaretOfWidgetGroup(Widget,MainWidget,CaretWasVisible);
// copy
gdk_window_copy_area(DoubleBuffer, DevContext.GC,0,0, Widget^.Window,
0, 0, Width, Height);
// restore caret
if CaretWasVisible then
GTKAPIWidget_ShowCaret(PGTKAPIWidget(MainWidget));
end;
{$IFDEF VerboseDoubleBuffer}
writeln('TgtkObject.GetDoubleBufferedDC DC=',HexStr(Cardinal(Result),8));
{$ENDIF}
end;
{------------------------------------------------------------------------------
Function: NewGDIObject
Params: none
@ -8597,6 +8678,9 @@ end;
{ =============================================================================
$Log$
Revision 1.449 2004/01/10 22:34:20 mattias
started double buffering for gtk intf
Revision 1.448 2004/01/10 00:46:46 mattias
fixed DestroyComponent

View File

@ -626,6 +626,28 @@ begin
end;
end;
{------------------------------------------------------------------------------
procedure HideCaretOfWidgetGroup(ChildWidget: PGtkWidget;
var MainWidget: PGtkWidget; var CaretWasVisible: boolean);
Find main widget and if it is a API widget, hide caret.
------------------------------------------------------------------------------}
procedure HideCaretOfWidgetGroup(ChildWidget: PGtkWidget;
var MainWidget: PGtkWidget; var CaretWasVisible: boolean);
var
LCLObject: TObject;
IsAPIWidget: Boolean;
begin
MainWidget:=ChildWidget;
LCLObject:=GetParentLCLObject(ChildWidget);
if (LCLObject is TWinControl) then
MainWidget:=PGtkWidget(TWinControl(LCLObject).Handle);
IsAPIWidget:=GtkWidgetIsA(MainWidget,GTKAPIWidget_GetType);
CaretWasVisible:=false;
if IsAPIWidget then
GTKAPIWidget_HideCaret(PGTKAPIWidget(MainWidget),CaretWasVisible);
end;
{------------------------------------------------------------------------------
procedure SetComboBoxText(ComboWidget: PGtkCombo; const NewText: string);
@ -2507,6 +2529,8 @@ begin
if Widget=nil then exit;
WinWidgetInfo := gtk_object_get_data(Widget, 'widgetinfo');
if WinWidgetInfo<>nil then begin
if WinWidgetInfo^.DoubleBuffer<>nil then
gdk_pixmap_unref(WinWidgetInfo^.DoubleBuffer);
Dispose(WinWidgetInfo);
gtk_object_set_data(Widget,'widgetinfo',nil);
end;
@ -5704,6 +5728,9 @@ end;
{ =============================================================================
$Log$
Revision 1.241 2004/01/10 22:34:20 mattias
started double buffering for gtk intf
Revision 1.240 2004/01/09 13:49:43 mattias
improved gtk intf key fetching and OI keyboard navigation

View File

@ -284,6 +284,9 @@ function GetParentFixedWidget(Child: PGtkWidget): PGtkWidget;
function FindFixedChild(ParentFixed: PGtkFixed; Child: PGtkWidget): PGList;
procedure MoveGListLinkBehind(First, Item, After: PGList);
procedure HideCaretOfWidgetGroup(ChildWidget: PGtkWidget;
var MainWidget: PGtkWidget; var CaretWasVisible: boolean);
procedure SetComboBoxText(ComboWidget: PGtkCombo; NewText: PChar);
function GetComboBoxItemIndex(ComboBox: TComboBox): integer;
procedure SetComboBoxItemIndex(ComboBox: TComboBox; Index: integer);

View File

@ -122,8 +122,28 @@ end;
------------------------------------------------------------------------------}
function TgtkObject.BeginPaint(Handle: hWnd; Var PS : TPaintStruct) : hdc;
{$IFDEF Gtk1}
var
Widget: PGtkWidget;
TargetObject: TObject;
IsDoubleBuffered: Boolean;
{$ENDIF}
begin
PS.hDC:=GetDC(Handle);
{$IFDEF Gtk1}
Widget:=PGtkWidget(Handle);
TargetObject:=GetParentLCLObject(Widget);
IsDoubleBuffered:=(TargetObject is TWinControl)
and TWinControl(TargetObject).DoubleBuffered;
{$IFNDEF UseGTKDoubleBuf}
IsDoubleBuffered:=false;
{$ENDIF}
{$ELSE}
IsDoubleBuffered:=false;
{$ENDIF}
if IsDoubleBuffered then
PS.hDC:=GetDoubleBufferedDC(Handle)
else
PS.hDC:=GetDC(Handle);
Result := PS.hDC;
end;
@ -772,13 +792,13 @@ begin
GdiObject^.GDIBitmapType := gbBitmap;
GdiObject^.GDIBitmapObject :=
gdk_pixmap_new(DefGdkWindow, Width, Height, BitCount);
GdiObject^.Visual := gdk_window_get_visual(GdiObject^.GDIPixmapObject);
GdiObject^.Visual := gdk_window_get_visual(GdiObject^.GDIBitmapObject);
end
else begin
GdiObject^.GDIBitmapType := gbPixmap;
GdiObject^.GDIPixmapObject :=
gdk_pixmap_new(DefGdkWindow, Width, Height, BitCount);
GdiObject^.Visual := gdk_window_get_visual(GdiObject^.GDIBitmapObject);
GdiObject^.Visual := gdk_window_get_visual(GdiObject^.GDIPixmapObject);
end;
If GdiObject^.Visual <> nil then
@ -2212,7 +2232,8 @@ var
else begin
If State = GTK_STATE_SELECTED then
State := GTK_STATE_ACTIVE;
aStyle := gtk_style_attach(gtk_style_ref(aStyle),aDC.Drawable);
// MG: You can't assign a style to any window. Why it is needed anyway?
//aStyle := gtk_style_attach(gtk_style_ref(aStyle),aDC.Drawable);
end;
if aStyle<>nil then begin
@ -2782,11 +2803,49 @@ end;
Returns:
------------------------------------------------------------------------------}
function TgtkObject.EndPaint(Handle : hwnd; var PS : TPaintStruct): Integer;
function TgtkObject.EndPaint(Handle: hwnd; var PS: TPaintStruct): Integer;
{$IFDEF Gtk1}
var
Widget: PGtkWidget;
WidgetInfo: PWinWidgetInfo;
IsDoubleBuffer: Boolean;
DCDrawable: PGdkDrawable;
Width, Height: integer;
DevContext: TDeviceContext;
CaretWasVisible: Boolean;
MainWidget: PGtkWidget;
{$ENDIF}
begin
Result:=1;
if PS.HDC <> 0 then
if PS.HDC <> 0 then begin
{$IFDEF Gtk1}
Widget:=PGtkWidget(Handle);
WidgetInfo:=GetWidgetInfo(Widget,false);
DevContext:=TDeviceContext(PS.HDC);
DCDrawable:=DevContext.Drawable;
IsDoubleBuffer:=(WidgetInfo<>nil) and (WidgetInfo^.DoubleBuffer<>nil)
and (WidgetInfo^.DoubleBuffer=DCDrawable);
if IsDoubleBuffer then begin
// copy
gdk_window_get_size(DCDrawable,@Width,@Height);
{$IFDEF VerboseDoubleBuffer}
writeln('TgtkObject.EndPaint Copying from buffer to window: ',Width,' ',Height);
{$ENDIF}
gdk_gc_set_clip_region(DevContext.GC, nil);
gdk_gc_set_clip_rectangle(DevContext.GC, nil);
// hide caret
HideCaretOfWidgetGroup(Widget,MainWidget,CaretWasVisible);
// draw
gdk_window_copy_area(Widget^.Window, DevContext.GC,0,0, DCDrawable,
0, 0, Width, Height);
// restore caret
if CaretWasVisible then
GTKAPIWidget_ShowCaret(PGTKAPIWidget(MainWidget));
end;
{$ENDIF}
ReleaseDC(Handle, PS.HDC);
end;
end;
{------------------------------------------------------------------------------
@ -3296,7 +3355,6 @@ var
Widget, ClientWidget: PGtkWidget;
i : integer;
DCOrigin: TPoint;
AWindow: PGdkWindow;
TheStyle: PGtkStyle;
Area: TGdkRectangle;
ShadowType: Integer;
@ -3317,10 +3375,6 @@ begin
ClientWidget:=GetFixedWidget(Widget);
if ClientWidget=nil then
ClientWidget:=Widget;
AWindow:=GetControlWindow(ClientWidget);
if AWindow=nil then begin
exit;
end;
DCOrigin:=GetDCOffset(TDeviceContext(DC));
Area.X:=ARect.Left+DCOrigin.X;
Area.Y:=ARect.Top+DCOrigin.Y;
@ -3368,7 +3422,7 @@ begin
ARect.Left+DCOrigin.X, ARect.Bottom+DCOrigin.Y,
ARect.Right+DCOrigin.X, ARect.Bottom+DCOrigin.Y);}
gtk_paint_shadow(TheStyle,
AWindow, GTK_STATE_NORMAL,
Drawable, GTK_STATE_NORMAL,
ShadowType,
@Area,
ClientWidget,
@ -5679,6 +5733,7 @@ end;
function TgtkObject.HideCaret(hWnd: HWND): Boolean;
var
GTKObject: PGTKObject;
WasVisible: boolean;
begin
//writeln('[TgtkObject.HideCaret] A');
Assert(False, Format('Trace: [TgtkObject.HideCaret] HWND: 0x%x', [hWnd]));
@ -5691,7 +5746,7 @@ begin
then begin
if gtk_type_is_a(gtk_object_type(GTKObject), GTKAPIWidget_GetType)
then begin
GTKAPIWidget_HideCaret(PGTKAPIWidget(GTKObject));
GTKAPIWidget_HideCaret(PGTKAPIWidget(GTKObject),WasVisible);
end
// else if // TODO: other widgettypes
else begin
@ -7277,15 +7332,106 @@ end;
------------------------------------------------------------------------------}
function TGTKObject.SendMessage(HandleWnd: HWND; Msg: Cardinal; wParam: WParam;
lParam: LParam): LResult;
var
OldMsg: Cardinal;
procedure PreparePaintMessage(TargetObject: TObject; var AMessage: TLMessage);
var
PaintDC: HDC;
GtkPaintData: TLMGtkPaintData;
DCOrigin: TPoint;
begin
(* MG: old trick. Not used anymore, but it might be, that someday there
will be component, that works better with this, so it is kept.
{ The LCL repaints controls in a top-down hierachy. But the gtk sends
gtkdraw events bottom-up. So, controls at the bottom are repainted
many times. To avoid this the queue is checked for LM_PAINT messages
for the parent control. If there is a parent LM_PAINT, this message
is ignored.}
if (Target is TControl) then begin
ParentControl:=TControl(Target).Parent;
while ParentControl<>nil do begin
ParentHandle:=TWinControl(ParentControl).Handle;
if FindPaintMessage(ParentHandle)<>nil then begin
{$IFDEF VerboseDsgnPaintMsg}
if (csDesigning in TComponent(Target).ComponentState) then begin
writeln('TGTKObject.SendMessage A ',
TComponent(Target).Name,':',Target.ClassName,
' Parent Message found: ',ParentControl.Name,':',ParentControl.ClassName
);
end;
{$ENDIF}
if Msg=LM_PAINT then
ReleaseDC(0,AMessage.WParam);
//exit;
end;
ParentControl:=ParentControl.Parent;
end;
end; *)
{$IFDEF VerboseDsgnPaintMsg}
if (csDesigning in TComponent(Target).ComponentState) then begin
write('TGTKObject.SendMessage B ',
TComponent(Target).Name,':',Target.ClassName,
' GtkPaint=',AMessage.Msg=LM_GtkPAINT);
if AMessage.Msg=LM_GtkPAINT then begin
if AMessage.wParam<>0 then begin
with TLMGtkPaintData(AMessage.wParam) do begin
write(' GtkPaintData(',
' Widget=',HexStr(Cardinal(Widget),8),
' State=',State,
' Rect=',Rect.Left,',',Rect.Top,',',Rect.Right,',',Rect.Bottom,
' RepaintAll=',RepaintAll,
')');
end;
end else begin
write(' GtkPaintData=nil');
end;
end;
writeln('');
end;
{$ENDIF}
if AMessage.Msg=LM_GtkPAINT then begin
GtkPaintData:=TLMGtkPaintData(AMessage.wParam);
// convert LM_GtkPAINT to LM_PAINT
AMessage := TLMessage(GtkPaintMessageToPaintMessage(
TLMGtkPaint(AMessage), True));
{$IfNDef GTK2}
if (GtkPaintData<>nil) and (not GtkPaintData.RepaintAll) then begin
PaintDC:=TLMPaint(AMessage).DC;
DCOrigin:=GetDCOffset(TDeviceContext(PaintDC));
with GtkPaintData.Rect do
IntersectClipRect(PaintDC,Left-DCOrigin.X,Top-DCOrigin.Y,
Right-DCOrigin.X,Bottom-DCOrigin.Y);
end;
{$EndIf}
end;
end;
procedure DisposePaintMessage(TargetObject: TObject; var AMessage: TLMessage);
begin
if OldMsg=LM_GtkPAINT then begin
FinalizePaintMessage(@AMessage);
if (csDesigning in TComponent(TargetObject).ComponentState)
and (TargetObject is TWinControl) then
SendPaintMessagesForInternalWidgets(TWinControl(TargetObject));
end else
if (AMessage.Msg=LM_PAINT) and (AMessage.WParam<>0) then begin
// free DC
ReleaseDC(0,AMessage.WParam);
AMessage.WParam:=0;
if (csDesigning in TComponent(TargetObject).ComponentState)
and (TargetObject is TWinControl) then
SendPaintMessagesForInternalWidgets(TWinControl(TargetObject));
end;
end;
var
AMessage: TLMessage;
Target: TObject;
PaintDC: HDC;
GtkPaintData: TLMGtkPaintData;
DCOrigin: TPoint;
//ParentControl: TWinControl;
//ParentHandle: HWnd;
begin
OldMsg:=Msg;
AMessage.Msg := Msg;
AMessage.WParam := WParam;
AMessage.LParam := LParam;
@ -7295,90 +7441,14 @@ begin
if Target<>nil then begin
if (Msg=LM_PAINT) or (Msg=LM_GtkPaint) then begin
(* MG: old trick. Not used anymore, but it might be, that someday there
will be component, that works better with this, so it is kept.
{ The LCL repaints controls in a top-down hierachy. But the gtk sends
gtkdraw events bottom-up. So, controls at the bottom are repainted
many times. To avoid this the queue is checked for LM_PAINT messages
for the parent control. If there is a parent LM_PAINT, this message
is ignored.}
if (Target is TControl) then begin
ParentControl:=TControl(Target).Parent;
while ParentControl<>nil do begin
ParentHandle:=TWinControl(ParentControl).Handle;
if FindPaintMessage(ParentHandle)<>nil then begin
{$IFDEF VerboseDsgnPaintMsg}
if (csDesigning in TComponent(Target).ComponentState) then begin
writeln('TGTKObject.SendMessage A ',
TComponent(Target).Name,':',Target.ClassName,
' Parent Message found: ',ParentControl.Name,':',ParentControl.ClassName
);
end;
{$ENDIF}
if Msg=LM_PAINT then
ReleaseDC(0,AMessage.WParam);
//exit;
end;
ParentControl:=ParentControl.Parent;
end;
end; *)
{$IFDEF VerboseDsgnPaintMsg}
if (csDesigning in TComponent(Target).ComponentState) then begin
write('TGTKObject.SendMessage B ',
TComponent(Target).Name,':',Target.ClassName,
' GtkPaint=',Msg=LM_GtkPAINT);
if Msg=LM_GtkPAINT then begin
if AMessage.wParam<>0 then begin
with TLMGtkPaintData(AMessage.wParam) do begin
write(' GtkPaintData(',
' Widget=',HexStr(Cardinal(Widget),8),
' State=',State,
' Rect=',Rect.Left,',',Rect.Top,',',Rect.Right,',',Rect.Bottom,
' RepaintAll=',RepaintAll,
')');
end;
end else begin
write(' GtkPaintData=nil');
end;
end;
writeln('');
end;
{$ENDIF}
if Msg=LM_GtkPAINT then begin
GtkPaintData:=TLMGtkPaintData(AMessage.wParam);
// convert LM_GtkPAINT to LM_PAINT
AMessage := TLMessage(GtkPaintMessageToPaintMessage(
TLMGtkPaint(AMessage), True));
{$IfNDef GTK2}
if (GtkPaintData<>nil) and (not GtkPaintData.RepaintAll) then begin
PaintDC:=TLMPaint(AMessage).DC;
DCOrigin:=GetDCOffset(TDeviceContext(PaintDC));
with GtkPaintData.Rect do
IntersectClipRect(PaintDC,Left-DCOrigin.X,Top-DCOrigin.Y,
Right-DCOrigin.X,Bottom-DCOrigin.Y);
end;
{$EndIf}
end;
PreparePaintMessage(Target,AMessage);
end;
// deliver it
Result := DeliverMessage(Target, AMessage);
if Msg=LM_GtkPAINT then begin
FinalizePaintMessage(@AMessage);
if (csDesigning in TComponent(Target).ComponentState)
and (TObject(Target) is TWinControl) then
SendPaintMessagesForInternalWidgets(TWinControl(Target));
end else
if (AMessage.Msg=LM_PAINT) and (AMessage.WParam<>0) then begin
// free DC
ReleaseDC(0,AMessage.WParam);
AMessage.WParam:=0;
if (csDesigning in TComponent(Target).ComponentState)
and (TObject(Target) is TWinControl) then
SendPaintMessagesForInternalWidgets(TWinControl(Target));
if (Msg=LM_PAINT) or (Msg=LM_GtkPaint) then begin
DisposePaintMessage(Target,AMessage);
end;
end;
end;
@ -9121,6 +9191,9 @@ end;
{ =============================================================================
$Log$
Revision 1.314 2004/01/10 22:34:20 mattias
started double buffering for gtk intf
Revision 1.313 2004/01/10 18:00:42 mattias
fixed GetWindowOrgEx, added GetDCOriginRelativeToWindow

View File

@ -40,7 +40,7 @@ uses
{$ELSE}
glib, gdk, gtk, {$Ifndef NoGdkPixbufLib}gdkpixbuf,{$EndIf}
{$ENDIF}
SysUtils;
SysUtils, LCLProc;
{ $Define VerboseCaret}
@ -62,7 +62,7 @@ function GTKAPIWidget_New: PGTKWidget;
procedure GTKAPIWidget_CreateCaret(APIWidget: PGTKAPIWidget;
AWidth, AHeight: Integer; ABitmap: PGDKPixmap);
procedure GTKAPIWidget_DestroyCaret(APIWidget: PGTKAPIWidget);
procedure GTKAPIWidget_HideCaret(APIWidget: PGTKAPIWidget);
procedure GTKAPIWidget_HideCaret(APIWidget: PGTKAPIWidget; var OldVisible: boolean);
procedure GTKAPIWidget_ShowCaret(APIWidget: PGTKAPIWidget);
procedure GTKAPIWidget_SetCaretPos(APIWidget: PGTKAPIWidget; X, Y: Integer);
procedure GTKAPIWidget_GetCaretPos(APIWidget: PGTKAPIWidget; var X, Y: Integer);
@ -150,8 +150,9 @@ procedure GTKAPIWidgetClient_Init(Client, theClass: Pointer); cdecl; forward;
function GTKAPIWidgetClient_GetType: Guint; forward;
function GTKAPIWidgetClient_New: PGTKWidget; forward;
procedure GTKAPIWidgetClient_HideCaret(Client: PGTKAPIWidgetClient); forward;
procedure GTKAPIWidgetClient_DrawCaret(Client: PGTKAPIWidgetClient); forward;
procedure GTKAPIWidgetClient_HideCaret(Client: PGTKAPIWidgetClient;
var OldVisible: boolean); forward;
procedure GTKAPIWidgetClient_DrawCaret(Client: PGTKAPIWidgetClient; CalledByTimer: boolean); forward;
procedure GTKAPIWidgetClient_ShowCaret(Client: PGTKAPIWidgetClient); forward;
procedure GTKAPIWidgetClient_CreateCaret(Client: PGTKAPIWidgetClient;
AWidth, AHeight: Integer; ABitmap: PGDKPixmap); forward;
@ -177,7 +178,7 @@ begin
Result := gtk_False;
exit;
end;
GTKAPIWidgetClient_DrawCaret(Client);
GTKAPIWidgetClient_DrawCaret(Client,true);
if PGTKAPIWidgetClient(Client)^.Caret.Timer<>0 then
Result := gtk_True
else
@ -283,7 +284,7 @@ begin
{$ENDIF}
if Event=nil then ;
gtk_widget_set_flags(Widget, GTK_HAS_FOCUS);
GTKAPIWidgetClient_DrawCaret(PGTKAPIWidgetClient(Widget));
GTKAPIWidgetClient_DrawCaret(PGTKAPIWidgetClient(Widget),false);
Result := gtk_False;
end;
@ -295,7 +296,7 @@ begin
{$ENDIF}
if Event=nil then ;
gtk_widget_unset_flags(Widget, GTK_HAS_FOCUS);
GTKAPIWidgetClient_DrawCaret(PGTKAPIWidgetClient(Widget));
GTKAPIWidgetClient_DrawCaret(PGTKAPIWidgetClient(Widget),false);
Result := gtk_False;
end;
@ -430,7 +431,8 @@ begin
Result := PGTKWidget(gtk_type_new(GTKAPIWidgetClient_GetType()));
end;
procedure GTKAPIWidgetClient_HideCaret(Client: PGTKAPIWidgetClient);
procedure GTKAPIWidgetClient_HideCaret(Client: PGTKAPIWidgetClient;
var OldVisible: boolean);
begin
//writeln('[GTKAPIWidgetClient_HideCaret] A Client=',HexStr(Cardinal(Client),8));
if Client = nil
@ -441,11 +443,23 @@ begin
{$IFDEF VerboseCaret}
writeln('GTKAPIWidgetClient_HideCaret ',HexStr(Cardinal(Client),8),' ShowHideOnFocus=',Client^.Caret.ShowHideOnFocus);
{$ENDIF}
OldVisible:=Client^.Caret.Visible;
Client^.Caret.Visible := False;
GTKAPIWidgetClient_DrawCaret(Client);
GTKAPIWidgetClient_DrawCaret(Client,false);
if (Client^.Caret.IsDrawn) then begin
with Client^.Caret do begin
writeln('GTKAPIWidgetClient_ShowCaret IsDrawn=',IsDrawn,' Visible=',Visible,
' Blinking=',Blinking,' HasFocus=',gtk_widget_has_focus(PGtkWidget(Client)),
' ShowHideOnFocus=',ShowHideOnFocus,
' Window=',PGtkWidget(Client)^.Window<>nil,
' Style=',PGTKStyle(PGtkWidget(Client)^.theStyle)<>nil);
end;
end;
end;
procedure GTKAPIWidgetClient_DrawCaret(Client: PGTKAPIWidgetClient);
procedure GTKAPIWidgetClient_DrawCaret(Client: PGTKAPIWidgetClient;
CalledByTimer: boolean);
const
GC_STATE: array[Boolean] of TGtkStateType =
(GTK_STATE_INSENSITIVE, GTK_STATE_NORMAL);
@ -454,8 +468,6 @@ var
WidgetStyle: PGTKStyle;
HasFocus: boolean;
ForeGroundGC: PGdkGC;
//OldGdkFunction: TGdkFunction;
//ForeGroundGCValues: TGdkGCValues;
begin
if Client = nil then begin
WriteLn('WARNING: [GTKAPIWidgetClient_DrawCaret] Got nil client');
@ -479,101 +491,100 @@ begin
gtk_timeout_remove(Timer);
Timer := 0;
end;
if IsDrawn and ((not Visible) or Blinking)
if IsDrawn and ((not Visible) or (Blinking and CalledByTimer))
then begin
{$IFDEF VerboseCaret}
writeln('GTKAPIWidgetClient_DrawCaret ',HexStr(Cardinal(Client),8),
' Hiding Caret IsDrawn=',IsDrawn,' Visible=',Visible,' Blinking=',Blinking);
{$ENDIF}
// hide caret
if (BackPixmap <> nil)
and (Widget<>nil)
if (BackPixmap <> nil)
and (Widget<>nil)
and (WidgetStyle<>nil)
then gdk_draw_pixmap(
Widget^.Window,
WidgetStyle^.bg_gc[GTK_STATE_NORMAL],
Widget^.Window,
WidgetStyle^.bg_gc[GTK_STATE_NORMAL],
BackPixmap, 0, 0,
X, Y-1, // Y-1 for Delphi compatibility
Width, Height
);
IsDrawn := False;
end
else begin
if Visible
and (gtk_widget_has_focus(Widget) or not ShowHideOnFocus)
and (not IsDrawn)
else
if Visible
and (HasFocus or (not ShowHideOnFocus))
and (not IsDrawn)
and (Widget^.Window<>nil)
and (WidgetStyle<>nil)
then begin
if Pixmap <> nil then
Assert(False, 'Trace:TODO: [GTKAPIWidgetClient_DrawCaret] Implement bitmap');
//Create backbitmap if needed
if (BackPixmap = nil)
and (Widget^.Window<>nil)
and (Width>0)
and (Height>0)
then
BackPixmap := gdk_pixmap_new(Widget^.Window, Width, Height, -1);
// undraw old caret
if (BackPixmap <> nil)
and (Widget<>nil)
and (WidgetStyle<>nil)
and (Width>0) and (Height>0)
then gdk_draw_pixmap(
BackPixmap,
WidgetStyle^.bg_gc[GTK_STATE_NORMAL],
Widget^.Window,
X, Y-1, // Y-1 for Delphi compatibility
0, 0,
Width, Height
);
// draw caret
{$IFDEF VerboseCaret}
writeln('GTKAPIWidgetClient_DrawCaret B Client=',HexStr(Cardinal(Client),8)
,' ',cardinal(WidgetStyle)
,' ',cardinal(Widget^.Window)
,' ',Width
,' ',Height
);
{$ENDIF}
if (WidgetStyle<>nil)
and (Widget^.Window<>nil)
and (Width>0)
and (Height>0)
then begin
if Pixmap <> nil then
Assert(False, 'Trace:TODO: [GTKAPIWidgetClient_DrawCaret] Implement bitmap');
//Create backbitmap if needed
if (BackPixmap = nil)
and (Widget^.Window<>nil)
and (Width>0)
and (Height>0)
then
BackPixmap := gdk_pixmap_new(Widget^.Window, Width, Height, -1);
// undraw old caret
if (BackPixmap <> nil)
and (Widget<>nil)
and (WidgetStyle<>nil)
and (Width>0) and (Height>0)
then gdk_draw_pixmap(
BackPixmap,
WidgetStyle^.bg_gc[GTK_STATE_NORMAL],
Widget^.Window,
X, Y-1, // Y-1 for Delphi compatibility
0, 0,
Width, Height
);
// draw caret
// set draw function to xor
ForeGroundGC:=WidgetStyle^.fg_gc[GC_STATE[Integer(Pixmap) <> 1]];
//gdk_gc_get_values(ForeGroundGC,@ForeGroundGCValues);
//OldGdkFunction:=ForeGroundGCValues.thefunction;
{$IFDEF VerboseCaret}
writeln('GTKAPIWidgetClient_DrawCaret B Client=',HexStr(Cardinal(Client),8)
,' ',cardinal(WidgetStyle)
,' ',cardinal(Widget^.Window)
,' ',Width
,' ',Height
);
writeln('GTKAPIWidgetClient_DrawCaret ',HexStr(Cardinal(Client),8),' Real Drawing Caret ');
{$ENDIF}
if (WidgetStyle<>nil)
and (Widget^.Window<>nil)
and (Width>0)
and (Height>0)
then begin
// set draw function to xor
ForeGroundGC:=WidgetStyle^.fg_gc[GC_STATE[Integer(Pixmap) <> 1]];
//gdk_gc_get_values(ForeGroundGC,@ForeGroundGCValues);
//OldGdkFunction:=ForeGroundGCValues.thefunction;
{$IFDEF VerboseCaret}
writeln('GTKAPIWidgetClient_DrawCaret ',HexStr(Cardinal(Client),8),' Real Drawing Caret ');
{$ENDIF}
gdk_gc_set_function(ForeGroundGC,GDK_invert);
try
// draw the caret
//writeln('DRAWING');
gdk_draw_rectangle(
Widget^.Window,
ForeGroundGC,
1,
X, Y-1, // Y-1 for Delphi compatibility
Width, Height
);
finally
// restore draw function
gdk_gc_set_function(ForeGroundGC,GDK_COPY);
end;
end else
writeln('***: Draw Caret failed: Client=',HexStr(Cardinal(Client),8),' X=',X,' Y=',Y,' W=',Width,' H=',Height,' ',Pixmap<>nil,',',Widget^.Window<>nil,',',WidgetStyle<>nil);
IsDrawn := True;
end;
gdk_gc_set_function(ForeGroundGC,GDK_invert);
try
// draw the caret
//writeln('DRAWING');
gdk_draw_rectangle(
Widget^.Window,
ForeGroundGC,
1,
X, Y-1, // Y-1 for Delphi compatibility
Width, Height
);
finally
// restore draw function
gdk_gc_set_function(ForeGroundGC,GDK_COPY);
end;
end else
writeln('***: Draw Caret failed: Client=',HexStr(Cardinal(Client),8),' X=',X,' Y=',Y,' W=',Width,' H=',Height,' ',Pixmap<>nil,',',Widget^.Window<>nil,',',WidgetStyle<>nil);
IsDrawn := True;
end;
//writeln('GTKAPIWidgetClient_DrawCaret A Client=',HexStr(Cardinal(Client),8),' Timer=',Timer,' Blink=',Blinking,' Visible=',Visible,' ShowHideOnFocus=',ShowHideOnFocus,' Focus=',gtk_widget_has_focus(Widget),' IsDrawn=',IsDrawn,' W=',Width,' H=',Height);
if Visible and Blinking and (Timer = 0)
and (not ShowHideOnFocus or HasFocus)
and ((not ShowHideOnFocus) or HasFocus)
then Timer := gtk_timeout_add(500, @GTKAPIWidgetClient_Timer, Client);
end;
end;
@ -590,14 +601,34 @@ begin
{$IFDEF VerboseCaret}
writeln('GTKAPIWidgetClient_ShowCaret ',HexStr(Cardinal(Client),8));
{$ENDIF}
// force restarting time
with Client^.Caret do
if Timer<>0 then begin
gtk_timeout_remove(Timer);
Timer := 0;
end;
Client^.Caret.Visible := True;
GTKAPIWidgetClient_DrawCaret(Client);
GTKAPIWidgetClient_DrawCaret(Client,false);
if (not Client^.Caret.IsDrawn)
and (gtk_widget_has_focus(PGtkWidget(Client))) then begin
with Client^.Caret do begin
writeln('GTKAPIWidgetClient_ShowCaret IsDrawn=',IsDrawn,' Visible=',Visible,
' Blinking=',Blinking,' HasFocus=',gtk_widget_has_focus(PGtkWidget(Client)),
' ShowHideOnFocus=',ShowHideOnFocus,
' Window=',PGtkWidget(Client)^.Window<>nil,
' Style=',PGTKStyle(PGtkWidget(Client)^.theStyle)<>nil);
end;
end;
end;
procedure GTKAPIWidgetClient_CreateCaret(Client: PGTKAPIWidgetClient;
AWidth, AHeight: Integer; ABitmap: PGDKPixmap);
var
IsVisible: Boolean;
WasVisible: boolean;
begin
{$IFDEF VerboseCaret}
writeln('********** [GTKAPIWidgetClient_CreateCaret] A Client=',HexStr(Cardinal(Client),8),' Width=',AWidth,' Height=',AHeight,' Bitmap=',ABitmap<>nil);
@ -611,7 +642,7 @@ begin
with Client^.Caret do
begin
IsVisible := Visible;
if IsVisible then GTKAPIWidgetClient_HideCaret(Client);
if IsVisible then GTKAPIWidgetClient_HideCaret(Client,WasVisible);
if (Width <> AWidth) or (Height <> AHeight)
then begin
@ -628,6 +659,8 @@ begin
end;
procedure GTKAPIWidgetClient_DestroyCaret(Client: PGTKAPIWidgetClient);
var
WasVisible: boolean;
begin
{$IFDEF VerboseCaret}
writeln('********** [GTKAPIWidgetClient_DestroyCaret] A Client=',HexStr(Cardinal(Client),8));
@ -639,7 +672,7 @@ begin
end;
with Client^.Caret do begin
if Visible then GTKAPIWidgetClient_HideCaret(Client);
if Visible then GTKAPIWidgetClient_HideCaret(Client,WasVisible);
if BackPixmap <> nil then begin
gdk_pixmap_unref(BackPixmap);
@ -655,7 +688,7 @@ end;
procedure GTKAPIWidgetClient_SetCaretPos(Client: PGTKAPIWidgetClient;
AX, AY: Integer);
var
IsVisible: Boolean;
IsVisible, WasVisible: Boolean;
begin
{$IFDEF VerboseCaret}
Writeln('[GTKAPIWIDGETCLIENT] SetCaretPos '+inttostr(ax)+','+Inttostr(ay));
@ -670,7 +703,7 @@ begin
with Client^.Caret do
begin
IsVisible := Visible;
if IsVisible then GTKAPIWidgetClient_HideCaret(Client);
if IsVisible then GTKAPIWidgetClient_HideCaret(Client,WasVisible);
X := AX;
Y := AY;
if IsVisible then GTKAPIWidgetClient_ShowCaret(Client);
@ -855,7 +888,8 @@ begin
GTKAPIWidgetClient_DestroyCaret(PGTKAPIWidgetClient(APIWidget^.Client));
end;
procedure GTKAPIWidget_HideCaret(APIWidget: PGTKAPIWidget);
procedure GTKAPIWidget_HideCaret(APIWidget: PGTKAPIWidget;
var OldVisible: boolean);
begin
{$IFDEF VerboseCaret}
writeln('[GTKAPIWidget_HideCaret] A');
@ -865,7 +899,7 @@ begin
WriteLn('WARNING: [GTKAPIWidget_HideCaret] Got nil client');
Exit;
end;
GTKAPIWidgetClient_HideCaret(PGTKAPIWidgetClient(APIWidget^.Client));
GTKAPIWidgetClient_HideCaret(PGTKAPIWidgetClient(APIWidget^.Client),OldVisible);
end;
procedure GTKAPIWidget_ShowCaret(APIWidget: PGTKAPIWidget);
@ -937,6 +971,9 @@ end.
{ =============================================================================
$Log$
Revision 1.51 2004/01/10 22:34:20 mattias
started double buffering for gtk intf
Revision 1.50 2003/11/03 16:57:47 peter
* change $ifdef ver1_1 to $ifndef ver1_0 so it works also with
fpc 1.9.x