paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-06 16:58:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

added virtual TCanvas.FreeHandle and extended TControlCanvas to work without control from Darek

Browse Source 
git-svn-id: trunk@9428 -
This commit is contained in:
mattias 2006-06-12 19:41:12 +00:00
parent 324c1fdb88
commit ab619c7b0a
7 changed files with 18 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
components/popupnotifier/demo/unit1.lrs
View File

@ -1,5 +1,3 @@
{ This is an automatically generated lazarus resource file }
LazarusResources.Add('TForm1','FORMDATA',[ LazarusResources.Add('TForm1','FORMDATA',[
'TPF0'#6'TForm1'#5'Form1'#13'ActiveControl'#7#7'Button1'#7'Caption'#6#5'Form1' 'TPF0'#6'TForm1'#5'Form1'#13'ActiveControl'#7#7'Button1'#7'Caption'#6#5'Form1'
+#12'ClientHeight'#3#214#0#11'ClientWidth'#3#214#0#13'PixelsPerInch'#2'V'#18 +#12'ClientHeight'#3#214#0#11'ClientWidth'#3#214#0#13'PixelsPerInch'#2'V'#18

2
lcl/controls.pp
View File

@ -246,7 +246,7 @@ type
public public
constructor Create; constructor Create;
destructor Destroy; override; destructor Destroy; override;
procedure FreeHandle; procedure FreeHandle;override;
property Control: TControl read FControl write SetControl; property Control: TControl read FControl write SetControl;
end; end;

1
lcl/graphics.pp
View File

@ -923,6 +923,7 @@ type
procedure SetHandle(NewHandle: HDC); virtual; procedure SetHandle(NewHandle: HDC); virtual;
procedure SetInternalPenPos(const Value: TPoint); virtual; procedure SetInternalPenPos(const Value: TPoint); virtual;
Procedure SetPixel(X,Y: Integer; Value: TColor); virtual; Procedure SetPixel(X,Y: Integer; Value: TColor); virtual;
procedure FreeHandle;virtual;
public public
constructor Create; constructor Create;
destructor Destroy; override; destructor Destroy; override;

9
lcl/include/canvas.inc
View File

@ -1367,7 +1367,7 @@ end;
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
procedure TCanvas.DeselectHandles; procedure TCanvas.DeselectHandles;
begin begin
//debugln('TCanvas.DeselectHandles ',ClassName,' Self=',DbgS(Self),' Handle=',DbgS(FHandle),8),' FSavedBrushHandle=',DbgS(Cardinal(FSavedBrushHandle)); //debugln('TCanvas.DeselectHandles ',ClassName,' Self=',DbgS(Self),' Handle=',DbgS(FHandle),' FSavedBrushHandle=',DbgS(Cardinal(FSavedBrushHandle)));
if (FHandle<>0) then begin if (FHandle<>0) then begin
// select default sub handles in the device context without deleting owns // select default sub handles in the device context without deleting owns
if FSavedBrushHandle<>0 then begin if FSavedBrushHandle<>0 then begin
@ -1395,7 +1395,12 @@ end;
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
procedure TCanvas.CreateHandle; procedure TCanvas.CreateHandle;
begin begin
// Plain canvas does nothing // Plain canvas does nothing
end;
procedure TCanvas.FreeHandle;
begin
Handle:=0;
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------

8
lcl/include/controlcanvas.inc
View File

@ -79,9 +79,9 @@ end;
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
procedure TControlCanvas.CreateHandle; procedure TControlCanvas.CreateHandle;
begin begin
//DebugLn('[TControlCanvas.CreateHandle] ',FControl<>nil,' DC=',DbgS(FDeviceContext,8),' WinHandle=',DbgS(FWindowHandle,8)); //DebugLn('[TControlCanvas.CreateHandle] ',FControl<>nil,' DC=',DbgS(FDeviceContext,8),' WinHandle=',DbgS(FWindowHandle,8));
if FControl = nil if FControl = nil then
then inherited CreateHandle inherited CreateHandle
else begin else begin
if FDeviceContext = 0 then if FDeviceContext = 0 then
begin begin
@ -102,9 +102,9 @@ end;
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
procedure TControlCanvas.FreeHandle; procedure TControlCanvas.FreeHandle;
begin begin
inherited;
if FDeviceContext <> 0 then if FDeviceContext <> 0 then
begin begin
Handle := 0;
ReleaseDC(FWindowHandle, FDeviceContext); ReleaseDC(FWindowHandle, FDeviceContext);
FDeviceContext := 0; FDeviceContext := 0;
end; end;

2
lcl/include/scrollingwincontrol.inc
View File

@ -124,7 +124,7 @@ procedure TScrollingWinControl.DestroyWnd;
begin begin
inherited DestroyWnd; inherited DestroyWnd;
if Canvas<>nil then if Canvas<>nil then
Canvas.Handle:=0; Canvas.FreeHandle;
end; end;
Function TScrollingWinControl.StoreScrollBars : Boolean; Function TScrollingWinControl.StoreScrollBars : Boolean;

7
lcl/interfaces/gtk/gtkproc.inc
View File

@ -3908,13 +3908,10 @@ function GetWidgetInfo(const AWidget: Pointer;
var var
MainWidget: PGtkObject; MainWidget: PGtkObject;
begin begin
if AWidget <> nil if AWidget <> nil then begin
then begin
MainWidget := GetMainWidget(AWidget); MainWidget := GetMainWidget(AWidget);
if MainWidget = nil then MainWidget := AWidget;
Result := gtk_object_get_data(MainWidget, 'widgetinfo'); Result := gtk_object_get_data(MainWidget, 'widgetinfo');
if (Result = nil) and ACreate if (Result = nil) and ACreate then begin
then begin
Result := CreateWidgetInfo(MainWidget); Result := CreateWidgetInfo(MainWidget);
// use the main widget as default // use the main widget as default
Result^.CoreWidget := PGtkWidget(MainWidget); Result^.CoreWidget := PGtkWidget(MainWidget);