mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2026-01-03 12:35:35 +01:00
started double buffering for gtk intf
git-svn-id: trunk@5045 -
This commit is contained in:
parent
e00eb8fd1a
commit
1766d6ed74
@ -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;
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user