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

MG: implemented DestroyCaret

Browse Source 
git-svn-id: trunk@511 -
This commit is contained in:
lazarus 2001-12-12 14:23:19 +00:00
parent 6566f466f4
commit 6db5507f43
7 changed files with 116 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
components/synedit/synedit.pp
View File

@ -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}

5
lcl/include/interfacebase.inc
View File

@ -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

7
lcl/include/winapi.inc
View File

@ -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

5
lcl/include/winapih.inc
View File

@ -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

29
lcl/interfaces/gtk/gtkwinapi.inc
View File

@ -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

5
lcl/interfaces/gtk/gtkwinapih.inc
View File

@ -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

88
lcl/interfaces/gtk/gtkwinapiwindow.pp
View File

@ -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