diff --git a/components/synedit/synedit.pp b/components/synedit/synedit.pp index 14e936d261..6ebdd4794a 100644 --- a/components/synedit/synedit.pp +++ b/components/synedit/synedit.pp @@ -1172,6 +1172,9 @@ var i: integer; begin //writeln('[TCustomSynEdit.Destroy]'); + {$IFDEF SYN_LAZARUS} + if HandleAllocated then LCLLinux.DestroyCaret(Handle); + {$ENDIF} Highlighter := nil; // free listeners while other fields are still valid if Assigned(fHookedCommandHandlers) then begin @@ -3616,7 +3619,7 @@ begin //writeln('[TCustomSynEdit.WMKillFocus] A'); HideCaret; {$IFDEF SYN_LAZARUS} - LCLLinux.DestroyCaret; + LCLLinux.DestroyCaret(Handle); {$ELSE} Windows.DestroyCaret; {$ENDIF} diff --git a/lcl/include/interfacebase.inc b/lcl/include/interfacebase.inc index df01be7b1d..1bd0e74a52 100644 --- a/lcl/include/interfacebase.inc +++ b/lcl/include/interfacebase.inc @@ -129,7 +129,7 @@ begin Result := False; end; -function TInterfaceBase.DestroyCaret: Boolean; +function TInterfaceBase.DestroyCaret(Handle : HWND): Boolean; begin Result := False; end; @@ -498,6 +498,9 @@ end; { ============================================================================= $Log$ + Revision 1.21 2001/12/12 14:23:17 lazarus + MG: implemented DestroyCaret + Revision 1.20 2001/11/14 19:10:03 lazarus MG: fixes for parser and linkscanner and small cleanups diff --git a/lcl/include/winapi.inc b/lcl/include/winapi.inc index cd85284561..da110989ba 100644 --- a/lcl/include/winapi.inc +++ b/lcl/include/winapi.inc @@ -130,9 +130,9 @@ begin Result := InterfaceObject.DeleteObject(GDIObject); end; -function DestroyCaret: Boolean; +function DestroyCaret(Handle : HWND): Boolean; Begin - Result := InterfaceObject.DestroyCaret; + Result := InterfaceObject.DestroyCaret(Handle); end; Function DrawFrameControl(DC: HDC; var Rect : TRect; uType, uState : Cardinal) : Boolean; @@ -1027,6 +1027,9 @@ end; { ============================================================================= $Log$ + Revision 1.20 2001/12/12 14:23:18 lazarus + MG: implemented DestroyCaret + Revision 1.19 2001/11/14 17:46:58 lazarus Changes to make toggling between form and unit work. Added BringWindowToTop diff --git a/lcl/include/winapih.inc b/lcl/include/winapih.inc index a3c9fdbfce..12b84c5032 100644 --- a/lcl/include/winapih.inc +++ b/lcl/include/winapih.inc @@ -52,7 +52,7 @@ function CreateRectRgn(X1,Y1,X2,Y2 : Integer): HRGN; {$IFDEF IF_BASE_MEMBER}virt function DeleteDC(hDC: HDC): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} function DeleteObject(GDIObject: HGDIOBJ): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} -function DestroyCaret: Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} +function DestroyCaret(Handle : HWND): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} Function DrawFrameControl(DC: HDC; var Rect : TRect; uType, uState : Cardinal) : Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} function DrawEdge(DC: HDC; var Rect: TRect; edge: Cardinal; grfFlags: Cardinal): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} @@ -241,6 +241,9 @@ function UnionRect(var lprcDst: TRect; const lprcSrc1, lprcSrc2: TRect): Boolean { ============================================================================= $Log$ + Revision 1.16 2001/12/12 14:23:18 lazarus + MG: implemented DestroyCaret + Revision 1.15 2001/11/14 17:46:58 lazarus Changes to make toggling between form and unit work. Added BringWindowToTop diff --git a/lcl/interfaces/gtk/gtkwinapi.inc b/lcl/interfaces/gtk/gtkwinapi.inc index 464320f0a4..86a5fcb177 100644 --- a/lcl/interfaces/gtk/gtkwinapi.inc +++ b/lcl/interfaces/gtk/gtkwinapi.inc @@ -895,8 +895,7 @@ begin GTKObject := PGTKObject(Handle); Result := GTKObject <> nil; - if Result - then begin + if Result then begin if gtk_type_is_a(gtk_object_type(GTKObject), GTKAPIWidget_GetType) then begin if IsValidGDIObjectType(Bitmap, gdiBitmap) @@ -1328,11 +1327,24 @@ end; ------------------------------------------------------------------------------} -function TgtkObject.DestroyCaret: Boolean; -Begin - Assert(False, 'Trace:TODO: [TgtkObject.DestroyCaret]'); - //TODO: Implement this; - Result := False; +function TgtkObject.DestroyCaret(Handle: HWND): Boolean; +var + GTKObject: PGTKObject; +begin + GTKObject := PGTKObject(Handle); + Result := true; + + if GTKObject<>nil then begin + if gtk_type_is_a(gtk_object_type(GTKObject), GTKAPIWidget_GetType) + then begin + GTKAPIWidget_DestroyCaret(PGTKAPIWidget(GTKObject)); + end +// else if // TODO: other widgettypes + else begin + Result := False; + end; + end + else Assert(False, 'Trace:WARNING: [TgtkObject.DestroyCaret] Got null HWND'); end; {------------------------------------------------------------------------------ @@ -4072,6 +4084,9 @@ end; { ============================================================================= $Log$ + Revision 1.51 2001/12/12 14:23:18 lazarus + MG: implemented DestroyCaret + Revision 1.50 2001/12/11 16:51:37 lazarus Modified the Watches dialog Shane diff --git a/lcl/interfaces/gtk/gtkwinapih.inc b/lcl/interfaces/gtk/gtkwinapih.inc index f76a5d94f6..e15aac971e 100644 --- a/lcl/interfaces/gtk/gtkwinapih.inc +++ b/lcl/interfaces/gtk/gtkwinapih.inc @@ -36,7 +36,7 @@ function CreateRectRgn(X1,Y1,X2,Y2 : Integer): HRGN; function DeleteDC(hDC: HDC): Boolean; override; function DeleteObject(GDIObject: HGDIOBJ): Boolean; override; -function DestroyCaret: Boolean; override; +function DestroyCaret(Handle : HWND): Boolean; override; Function DrawFrameControl(DC: HDC; var Rect : TRect; uType, uState : Cardinal) : Boolean; override; function DrawEdge(DC: HDC; var Rect: TRect; edge: Cardinal; grfFlags: Cardinal): Boolean; override; @@ -126,6 +126,9 @@ Function WindowFromPoint(Point : TPoint) : HWND; override; { ============================================================================= $Log$ + Revision 1.20 2001/12/12 14:23:18 lazarus + MG: implemented DestroyCaret + Revision 1.19 2001/11/14 17:46:59 lazarus Changes to make toggling between form and unit work. Added BringWindowToTop diff --git a/lcl/interfaces/gtk/gtkwinapiwindow.pp b/lcl/interfaces/gtk/gtkwinapiwindow.pp index b2e4574723..b310e4ed38 100644 --- a/lcl/interfaces/gtk/gtkwinapiwindow.pp +++ b/lcl/interfaces/gtk/gtkwinapiwindow.pp @@ -49,6 +49,7 @@ function GTKAPIWidget_GetType : guint; 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_ShowCaret(APIWidget: PGTKAPIWidget); procedure GTKAPIWidget_SetCaretPos(APIWidget: PGTKAPIWidget; X, Y: Integer); @@ -104,13 +105,21 @@ try Result := 0; exit; end; +except + Writeln('------Exception 1 in GTKAPIWidgetClient_Timer------'); +end; +try GTKAPIWidgetClient_DrawCaret(Client); +except + Writeln('------Exception 2 in GTKAPIWidgetClient_Timer------'); +end; +try if PGTKAPIWidgetClient(Client)^.Caret.Timer<>0 then Result := 1 else Result := 0; except - Writeln('------Exception in GTKAPIWidgetClient_Timer------'); + Writeln('------Exception 3 in GTKAPIWidgetClient_Timer------'); writeln('Client = ',longint(Client)); if Assigned(Client) then begin @@ -317,7 +326,7 @@ end; procedure GTKAPIWidgetClient_HideCaret(Client: PGTKAPIWidgetClient); begin -//writeln('[GTKAPIWidgetClient_HideCaret] A'); +//writeln('[GTKAPIWidgetClient_HideCaret] A Client=',HexStr(Cardinal(Client),8)); if Client = nil then begin WriteLn('WARNING: [GTKAPIWidgetClient_HideCaret] Got nil client'); @@ -333,6 +342,7 @@ const (GTK_STATE_INSENSITIVE, GTK_STATE_NORMAL); var Widget: PGTKWidget; + HasFocus: boolean; begin if Client = nil then begin WriteLn('WARNING: [GTKAPIWidgetClient_DrawCaret] Got nil client'); @@ -341,11 +351,15 @@ begin Widget := PGTKWidget(Client); with Client^.Caret do begin - if (Timer <> 0) and ((not Blinking) or (not Visible)) then begin + HasFocus:=gtk_widget_has_focus(Widget); + + if (Timer <> 0) and + ((not Blinking) or (not Visible) + or (ShowHideOnFocus and (not HasFocus))) + then begin gtk_timeout_remove(Timer); Timer := 0; end; - if IsDrawn and ((not Visible) or Blinking) then begin // hide caret if (BackPixmap <> nil) and (Widget<>nil) and (Widget^.theStyle<>nil) @@ -362,31 +376,41 @@ begin and (not IsDrawn) then begin if Pixmap <> nil then - Assert(False, 'Trace:TODO: [GTKAPIWidgetClient_ShowCaret] Implement bitmap'); + Assert(False, 'Trace:TODO: [GTKAPIWidgetClient_DrawCaret] Implement bitmap'); //Create backbitmap if needed - if (BackPixmap = nil) and (Widget^.Window<>nil) - then BackPixmap := gdk_pixmap_new(Widget^.Window, Width, Height, -1); - + if (BackPixmap = nil) and (Widget^.Window<>nil) and (Width>0) + and (Height>0) + then + BackPixmap := gdk_pixmap_new(Widget^.Window, Width, Height, -1); + if (BackPixmap <> nil) and (Widget<>nil) and ((Widget^.theStyle)<>nil) + and (Width>0) and (Height>0) then gdk_draw_pixmap( BackPixmap, PGTKStyle(Widget^.theStyle)^.bg_gc[GTK_STATE_NORMAL], Widget^.Window, X, Y, 0, 0, Width, Height ); - + // draw caret - if PGTKStyle(PGTKWidget(Client)^.theStyle)<>nil then + if (PGTKStyle(PGTKWidget(Client)^.theStyle)<>nil) + and (PGTKWidget(Client)^.Window<>nil) + and (Width>0) and (Height>0) + and (PGTKWidget(Client)^.theStyle<>nil) then gdk_draw_rectangle( PGTKWidget(Client)^.Window, PGTKStyle(PGTKWidget(Client)^.theStyle)^.fg_gc[GC_STATE[Integer(Pixmap) <> 1]], 1, X, Y, Width, Height - ); + ) + else + writeln('Draw Caret failed: X=',X,',Y=',Y,',W=',Width,',H=',Height,',',Pixmap<>nil,',',PGTKWidget(Client)^.Window<>nil,',',PGTKWidget(Client)^.theStyle<>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)); if Visible and Blinking and (Timer = 0) - and (gtk_widget_has_focus(Widget) or not ShowHideOnFocus) + and (not ShowHideOnFocus or HasFocus) then Timer := gtk_timeout_add(500, @GTKAPIWidgetClient_Timer, Client); end; @@ -394,7 +418,7 @@ end; procedure GTKAPIWidgetClient_ShowCaret(Client: PGTKAPIWidgetClient); begin -//writeln('[GTKAPIWidgetClient_ShowCaret] A'); +//writeln('[GTKAPIWidgetClient_ShowCaret] A Client=',HexStr(Cardinal(Client),8)); if Client = nil then begin WriteLn('WARNING: [GTKAPIWidgetClient_ShowCaret] Got nil client'); @@ -410,10 +434,10 @@ procedure GTKAPIWidgetClient_CreateCaret(Client: PGTKAPIWidgetClient; var IsVisible: Boolean; begin -//writeln('[GTKAPIWidgetClient_CreateCaret] A'); +//writeln('********** [GTKAPIWidgetClient_CreateCaret] A Client=',HexStr(Cardinal(Client),8),' Width=',AWidth,' Height=',AHeight,' Bitmap=',ABitmap<>nil); if Client = nil then begin - WriteLn('WARNING: [GTKAPIWidgetClient_HideCaret] Got nil client'); + WriteLn('WARNING: [GTKAPIWidgetClient_CreateCaret] Got nil client'); Exit; end; @@ -436,6 +460,27 @@ begin end; end; +procedure GTKAPIWidgetClient_DestroyCaret(Client: PGTKAPIWidgetClient); +begin +writeln('********** [GTKAPIWidgetClient_DestroyCaret] A Client=',HexStr(Cardinal(Client),8)); + if Client = nil + then begin + WriteLn('WARNING: [GTKAPIWidgetClient_DestroyCaret] Got nil client'); + Exit; + end; + + with Client^.Caret do begin + if Visible then GTKAPIWidgetClient_HideCaret(Client); + + if BackPixmap <> nil then begin + gdk_pixmap_unref(BackPixmap); + BackPixmap := nil; + end; + Pixmap := nil; + end; +writeln('********** B[GTKAPIWidgetClient_DestroyCaret] A Client=',HexStr(Cardinal(Client),8)); +end; + procedure GTKAPIWidgetClient_SetCaretPos(Client: PGTKAPIWidgetClient; AX, AY: Integer); var @@ -586,6 +631,16 @@ begin AWidth, AHeight, ABitmap); end; +procedure GTKAPIWidget_DestroyCaret(APIWidget: PGTKAPIWidget); +begin + if APIWidget = nil + then begin + WriteLn('WARNING: [GTKAPIWidget_DestroyCaret] Got nil client'); + Exit; + end; + GTKAPIWidgetClient_DestroyCaret(PGTKAPIWidgetClient(APIWidget^.Client)); +end; + procedure GTKAPIWidget_HideCaret(APIWidget: PGTKAPIWidget); begin //writeln('[GTKAPIWidget_HideCaret] A'); @@ -644,6 +699,9 @@ end. { ============================================================================= $Log$ + Revision 1.17 2001/12/12 14:23:19 lazarus + MG: implemented DestroyCaret + Revision 1.16 2001/11/13 18:50:10 lazarus Changes to facilitate the toggle between form and unit Shane