MG: implemented DestroyCaret

git-svn-id: trunk@511 -

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}

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
 

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

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

lcl/interfaces/gtk/gtkwinapi.inc

@@ -895,8 +895,7 @@ begin
   GTKObject := PGTKObject(Handle);
   Result := GTKObject <> nil;
 
-  if Result
+  if Result then begin
-  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;
+function TgtkObject.DestroyCaret(Handle: HWND): Boolean;
-Begin
+var
-  Assert(False, 'Trace:TODO: [TgtkObject.DestroyCaret]');
+  GTKObject: PGTKObject;
-  //TODO: Implement this;
+begin
-  Result := False;
+  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

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

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)
+      if (BackPixmap = nil) and (Widget^.Window<>nil) and (Width>0)
-      then BackPixmap := gdk_pixmap_new(Widget^.Window, Width, Height, -1);
+      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