From d8de02b1dc4ea481ea1d3365f7a3144247705227 Mon Sep 17 00:00:00 2001 From: lazarus Date: Mon, 19 Mar 2001 14:00:52 +0000 Subject: [PATCH] MG: fixed many unreleased DC and GDIObj bugs git-svn-id: trunk@228 - --- components/synedit/allunits.pp | 8 +- components/synedit/synedit.pp | 8 +- components/synedit/syneditkeycmds.pp | 12 +- components/synedit/syntextdrawer.pp | 35 ++- designer/abstractformeditor.pp | 8 +- designer/controlselection.pp | 267 +++++++++++++------ designer/designer.pp | 372 +++++++++++++++------------ designer/jitforms.pp | 13 +- ide/customformeditor.pp | 94 +++---- ide/lazarus.pp | 7 +- ide/main.pp | 187 ++++++++++---- ide/project.pp | 15 +- ide/splash.pp | 18 +- ide/uniteditor.pp | 71 ++--- lcl/controls.pp | 4 +- lcl/graphics.pp | 5 +- lcl/include/bitbtn.inc | 4 +- lcl/include/bitmap.inc | 11 +- lcl/include/bitmapcanvas.inc | 17 +- lcl/include/buttonglyph.inc | 17 +- lcl/include/canvas.inc | 26 +- lcl/include/control.inc | 15 +- lcl/include/controlcanvas.inc | 5 +- lcl/include/customform.inc | 34 +-- lcl/include/font.inc | 6 +- lcl/include/imglist.inc | 7 +- lcl/include/menuitem.inc | 18 +- lcl/include/pixmap.inc | 31 ++- lcl/include/speedbutton.inc | 8 +- lcl/include/statusbar.inc | 42 +-- lcl/include/wincontrol.inc | 29 ++- lcl/interfaces/gtk/gtkcallback.inc | 6 +- lcl/interfaces/gtk/gtkint.pp | 4 +- lcl/interfaces/gtk/gtkobject.inc | 66 +++-- lcl/interfaces/gtk/gtkproc.inc | 5 +- lcl/interfaces/gtk/gtkwinapi.inc | 145 +++++------ 36 files changed, 990 insertions(+), 630 deletions(-) diff --git a/components/synedit/allunits.pp b/components/synedit/allunits.pp index 48444a47d1..b7dc63581b 100644 --- a/components/synedit/allunits.pp +++ b/components/synedit/allunits.pp @@ -15,8 +15,8 @@ interface uses syntextdrawer, syneditkeycmds, synedittypes, syneditstrconst, - syneditmiscclasses, syneditmiscprocs, syneditsearch, synedittextbuffer, - synedit, synhighlighterpas, {synedithighlighter,} syncompletion, + syneditsearch, syneditmiscprocs, syneditmiscclasses, synedittextbuffer, + synedit, synhighlighterpas, syncompletion, syneditautocomplete, synhighlighterhtml, synhighlightercpp; implementation @@ -26,8 +26,8 @@ end. { ============================================================================= $Log$ - Revision 1.5 2001/03/12 23:42:40 lazarus - MG: added synhighlighter for cpp and html + Revision 1.6 2001/03/19 14:00:48 lazarus + MG: fixed many unreleased DC and GDIObj bugs Revision 1.4 2001/02/21 22:55:25 lazarus small bugfixes + added TOIOptions diff --git a/components/synedit/synedit.pp b/components/synedit/synedit.pp index 8ab3c8eaba..02ca4354c7 100644 --- a/components/synedit/synedit.pp +++ b/components/synedit/synedit.pp @@ -74,8 +74,8 @@ uses {$IFDEF SYN_MBCSSUPPORT} Imm, {$ENDIF} - SynEditTypes, SynEditMiscProcs, SynEditMiscClasses, SynEditTextBuffer, - SynEditKeyCmds, SynEditSearch, SynEditHighlighter, SynTextDrawer; + SynEditTypes, SynEditSearch, SynEditKeyCmds, SynEditMiscProcs, + SynEditMiscClasses, SynEditTextBuffer, SynEditHighlighter, SynTextDrawer; const DIGIT = ['0'..'9']; @@ -1097,7 +1097,7 @@ destructor TCustomSynEdit.Destroy; var i: integer; begin -writeln('[TCustomSynEdit.Destroy]'); +//writeln('[TCustomSynEdit.Destroy]'); Highlighter := nil; // free listeners while other fields are still valid if Assigned(fHookedCommandHandlers) then begin @@ -1110,7 +1110,7 @@ writeln('[TCustomSynEdit.Destroy]'); TSynEditPlugin(fPlugins[i]).Free; fPlugins.Free; end; - fScrollTimer.Free; + fScrollTimer.Free; fTSearch.Free; fMarkList.Free; fBookMarkOpt.Free; diff --git a/components/synedit/syneditkeycmds.pp b/components/synedit/syneditkeycmds.pp index 241ce42efe..745b42ce1b 100644 --- a/components/synedit/syneditkeycmds.pp +++ b/components/synedit/syneditkeycmds.pp @@ -37,13 +37,16 @@ Known Issues: unit SynEditKeyCmds; -{$mode objfpc} - {$I synedit.inc} interface uses + {$IFDEF SYN_LAZARUS} + LCLLinux, + {$ELSE} + Windows, + {$ENDIF} Classes, Menus, SysUtils; const @@ -263,11 +266,6 @@ implementation // FOR LAZARUS uses - {$IFDEF SYN_LAZARUS} - LCLLinux, - {$ELSE} - Windows, - {$ENDIF} SynEditStrConst; //============================================================================= diff --git a/components/synedit/syntextdrawer.pp b/components/synedit/syntextdrawer.pp index 27534cdcdb..a48368ef9c 100644 --- a/components/synedit/syntextdrawer.pp +++ b/components/synedit/syntextdrawer.pp @@ -63,7 +63,7 @@ unit SynTextDrawer; {$IFDEF FPC} - {$mode objfpc} + {$mode objfpc}{$H+} {$DEFINE SYN_LAZARUS} {$ENDIF} @@ -188,6 +188,9 @@ type private FDC: HDC; FSaveDC: Integer; + {$IFDEF SYN_LAZARUS} + FSavedFont: HFont; + {$ENDIF} // Font information FFontStock: TheFontStock; @@ -306,6 +309,10 @@ const var gFontsInfoManager: TheFontsInfoManager; +{$IFDEF SYN_LAZARUS} + SynTextDrawerFinalization: boolean; +{$ENDIF} + {$IFNDEF HE_LEADBYTES} LeadBytes: TheLeadByteChars; {$ENDIF} @@ -314,7 +321,11 @@ var function GetFontsInfoManager: TheFontsInfoManager; begin - if not Assigned(gFontsInfoManager) then + if (not Assigned(gFontsInfoManager)) + {$IFDEF SYN_LAZARUS} + and (not SynTextDrawerFinalization) + {$ENDIF} + then gFontsInfoManager := TheFontsInfoManager.Create; Result := gFontsInfoManager; end; @@ -380,8 +391,7 @@ end; constructor TheFontsInfoManager.Create; begin - inherited; - + inherited Create; FFontsInfo := TList.Create; end; @@ -866,11 +876,12 @@ begin ASSERT((FDC = 0) and (DC <> 0) and (FDrawingCount = 0)); FDC := DC; FSaveDC := SaveDC(DC); - SelectObject(DC, FCrntFont); {$IFNDEF SYN_LAZARUS} + SelectObject(DC, FCrntFont); Windows.SetTextColor(DC, ColorToRGB(FColor)); Windows.SetBkColor(DC, ColorToRGB(FBkColor)); {$ELSE} + FSavedFont := SelectObject(DC, FCrntFont); LCLLinux.SetTextColor(DC, ColorToRGB(FColor)); LCLLinux.SetBkColor(DC, ColorToRGB(FBkColor)); {$ENDIF} @@ -885,8 +896,13 @@ begin Dec(FDrawingCount); if FDrawingCount <= 0 then begin - if FDC <> 0 then + if FDC <> 0 then begin + {$IFDEF SYN_LAZARUS} + if FSavedFont <> 0 then + SelectObject(FDC,FSavedFont); + {$ENDIF} RestoreDC(FDC, FSaveDC); + end; FSaveDC := 0; FDC := 0; FDrawingCount := 0; @@ -1258,13 +1274,20 @@ end; initialization +{$IFDEF SYN_LAZARUS} + SynTextDrawerFinalization:=false; +{$ENDIF} {$IFNDEF HE_LEADBYTES} InitializeLeadBytes; {$ENDIF} finalization +{$IFDEF SYN_LAZARUS} + SynTextDrawerFinalization:=true; +{$ENDIF} gFontsInfoManager.Free; + gFontsInfoManager:=nil; end. diff --git a/designer/abstractformeditor.pp b/designer/abstractformeditor.pp index 34f0a95599..1748c563a3 100644 --- a/designer/abstractformeditor.pp +++ b/designer/abstractformeditor.pp @@ -87,14 +87,13 @@ or use TPropertyType Created by Shane Miller This unit defines the layout for the forms editor. The forms editor is responsible for creating a form, holding a list of selected controls, determining if the form was - modified, holding the filename for the form, and working wit the object inspector. + modified and working wit the object inspector. } TAbstractFormEditor = class public - Function Filename : AnsiString; virtual; abstract; Function FormModified : Boolean; virtual; abstract; - Function FindComponentByName(const Name : String) : TIComponentInterface; virtual; abstract; + Function FindComponentByName(const Name : ShortString) : TIComponentInterface; virtual; abstract; Function FindComponent(AComponent: TComponent): TIComponentInterface; virtual; abstract; Function GetFormComponent: TIComponentInterface; virtual; abstract; @@ -103,9 +102,10 @@ or use TPropertyType Function GetSelCount : Integer; virtual; abstract; Function GetSelComponent(Index : Integer) : TIComponentInterface; virtual; abstract; -// Function CreateComponent(CI : TIComponentInterface; TypeName : String; +// Function CreateComponent(CI : TIComponentInterface; TypeName : ShortString; Function CreateComponent(CI : TIComponentInterface; TypeClass : TComponentClass; X,Y,W,H : Integer): TIComponentInterface; virtual; abstract; + Function CreateFormFromStream(BinStream: TStream): TIComponentInterface; virtual; abstract; end; diff --git a/designer/controlselection.pp b/designer/controlselection.pp index 1bb48dc721..7421873341 100644 --- a/designer/controlselection.pp +++ b/designer/controlselection.pp @@ -48,6 +48,8 @@ type FOldTop: integer; FOldWidth: integer; FOldHeight: integer; + FGrabIndex: TGrabIndex; + FCursor: TCursor; public property Positions: TGrabPositions read FPositions write FPositions; property Left:integer read FLeft write FLeft; @@ -58,6 +60,8 @@ type property OldTop:integer read FOldTop write FOldTop; property OldWidth:integer read FOldWidth write FOldWidth; property OldHeight:integer read FOldHeight write FOldHeight; + property GrabIndex: TGrabIndex read FGrabIndex write FGrabIndex; + property Cursor: TCursor read FCursor write FCursor; procedure SaveBounds; end; @@ -99,10 +103,16 @@ type FCustomForm: TCustomForm; FGrabbers: array[TGrabIndex] of TGrabber; FGrabberSize: integer; + FGrabberColor: TColor; FMarkerSize: integer; + FMarkerColor: integer; FActiveGrabber:TGrabber; FRubberBandBounds:TRect; + FRubberbandActive: boolean; FVisible:boolean; + FUpdateLock: integer; + FChangedDuringLock: boolean; + FIsResizing: boolean; FOnChange: TNotifyEvent; @@ -110,7 +120,6 @@ type function GetGrabbers(AGrabIndex:TGrabIndex): TGrabber; procedure SetGrabbers(AGrabIndex:TGrabIndex; const AGrabber: TGrabber); procedure SetGrabberSize(const NewSize: integer); - procedure AdjustSize; procedure AdjustGrabber; procedure DoChange; procedure SetVisible(const Value: Boolean); @@ -120,25 +129,32 @@ type procedure SetRubberBandBounds(ARect:TRect); protected public + constructor Create; + destructor Destroy; override; property Items[Index:integer]:TSelectedControl read GetItems write SetItems; default; function Count:integer; + procedure BeginUpDate; + procedure EndUpdate; function IndexOf(AControl:TControl):integer; function Add(AControl: TControl):integer; procedure Remove(AControl: TControl); procedure Delete(Index:integer); procedure Clear; procedure Assign(AControlSelection:TControlSelection); + procedure AdjustSize; function IsSelected(AControl: TControl): Boolean; procedure SaveBounds; procedure MoveSelection(dx, dy: integer); procedure SizeSelection(dx, dy: integer); // size all controls depending on ActiveGrabber. - // if ActiveGrabber=nil then Left,Top + // if ActiveGrabber=nil then Right,Bottom property GrabberSize:integer read FGrabberSize write SetGrabberSize; + property GrabberColor: TColor read FGrabberColor write FGrabberColor; procedure DrawGrabbers(DC: HDC); function GrabberAtPos(X,Y:integer):TGrabber; property Grabbers[AGrabIndex:TGrabIndex]:TGrabber read GetGrabbers write SetGrabbers; property MarkerSize:integer read FMarkerSize write FMarkerSize; + property MarkerColor: TColor read FMarkerColor write FMarkerColor; property OnChange: TNotifyEvent read FOnChange write FOnChange; procedure DrawMarker(AControl:TControl; DC:HDC); property ActiveGrabber:TGrabber read FActiveGrabber write SetActiveGrabber; @@ -147,14 +163,17 @@ type property Width:integer read FWidth; property Height:integer read FHeight; property RubberbandBounds:TRect read FRubberbandBounds write SetRubberbandBounds; - procedure DrawRubberband(DeleteOld:boolean; ARect:TRect); - procedure SelectWithRubberBand(ACustomForm:TCustomForm); + property RubberbandActive: boolean read FRubberbandActive write FRubberbandActive; + procedure DrawRubberband(DC: HDC); + procedure SelectWithRubberBand(ACustomForm:TCustomForm; ExclusiveOr: boolean); property Visible:boolean read FVisible write SetVisible; - constructor Create; - destructor Destroy; override; end; +var TheControlSelection: TControlSelection; + +function GetFormRelativeControlTopLeft(Control: TControl): TPoint; + implementation @@ -175,6 +194,20 @@ const ); +function GetFormRelativeControlTopLeft(Control: TControl): TPoint; +var FormOrigin: TPoint; +begin + if Control.Parent=nil then begin + Result:=Point(0,0); + end else begin + Result:=Control.Parent.ClientOrigin; + FormOrigin:=GetParentForm(Control).ClientOrigin; + Result.X:=Result.X-FormOrigin.X+Control.Left; + Result.Y:=Result.Y-FormOrigin.Y+Control.Top; + end; +end; + + { TGrabber } procedure TGrabber.SaveBounds; @@ -201,6 +234,8 @@ end; procedure TSelectedControl.SaveBounds; begin +writeln('[TSelectedControl.SaveBounds] ',Control.Name,':',Control.ClassName + ,' ',Control.Left,',',Control.Top); FOldLeft:=Control.Left; FOldTop:=Control.Top; FOldWidth:=Control.Width; @@ -215,13 +250,21 @@ begin inherited; FControls:=TList.Create; FGrabberSize:=6; + FGrabberColor:=clBlack; FMarkerSize:=5; + FMarkerColor:=clDkGray; for g:=Low(TGrabIndex) to High(TGrabIndex) do begin FGrabbers[g]:=TGrabber.Create; FGrabbers[g].Positions:=GRAB_POSITIONS[g]; + FGrabbers[g].GrabIndex:=g; + FGrabbers[g].Cursor:=GRAB_CURSOR[g]; end; FCustomForm:=nil; FActiveGrabber:=nil; + FUpdateLock:=0; + FChangedDuringLock:=false; + FRubberbandActive:=false; + FIsResizing:=false; end; destructor TControlSelection.Destroy; @@ -233,6 +276,20 @@ begin inherited Destroy; end; +procedure TControlSelection.BeginUpDate; +begin + inc(FUpdateLock); +end; + +procedure TControlSelection.EndUpdate; +begin + if FUpdateLock<=0 then exit; + dec(FUpdateLock); + if FUpdateLock=0 then begin + if FChangedDuringLock then DoChange; + end; +end; + procedure TControlSelection.SetCustomForm; var NewCustomForm:TCustomForm; begin @@ -263,60 +320,50 @@ begin end; procedure TControlSelection.AdjustSize; -var i,ALeft,ATop:integer; - FormOrigin:TPoint; - - procedure AbsoluteLeftTop(AControl:TControl; var ALeft, ATop:integer); - var ControlOrigin:TPoint; - begin - ControlOrigin:=AControl.ClientOrigin; - ALeft:=ControlOrigin.X-FormOrigin.X; - ATop:=ControlOrigin.Y-FormOrigin.Y; -writeln('[AbsoluteLeftTop] ',ControlOrigin.X,',',ControlOrigin.Y - ,' ',FormOrigin.X,',',FormOrigin.Y); - end; - +var i:integer; + LeftTop:TPoint; begin + if FIsResizing then exit; if FControls.Count>=1 then begin - FormOrigin:=FCustomForm.ClientOrigin; - AbsoluteLeftTop(Items[0].Control,ALeft,ATop); -writeln('[TControlSelection.AdjustSize] ',ALeft,',',ATop,' ',Items[0].Control.Name); - FLeft:=ALeft; - FTop:=ATop; + LeftTop:=GetFormRelativeControlTopLeft(Items[0].Control); + FLeft:=LeftTop.X; + FTop:=LeftTop.Y; FHeight:=Items[0].Control.Height; FWidth:=Items[0].Control.Width; for i:=1 to FControls.Count-1 do begin - AbsoluteLeftTop(Items[i].Control,ALeft,ATop); - if FLeft>ALeft then begin - inc(FWidth,FLeft-ALeft); - FLeft:=ALeft; + LeftTop:=GetFormRelativeControlTopLeft(Items[i].Control); + if FLeft>LeftTop.X then begin + inc(FWidth,FLeft-LeftTop.X); + FLeft:=LeftTop.X; end; - if FTop>ATop then begin - inc(FHeight,FTop-ATop); - FTop:=ATop; + if FTop>LeftTop.Y then begin + inc(FHeight,FTop-LeftTop.Y); + FTop:=LeftTop.Y; end; - FWidth:=Max(FLeft+FWidth,ALeft+Items[i].Control.Width)-FLeft; - FHeight:=Max(FTop+FHeight,ATop+Items[i].Control.Height)-FTop; + FWidth:=Max(FLeft+FWidth,LeftTop.X+Items[i].Control.Width)-FLeft; + FHeight:=Max(FTop+FHeight,LeftTop.Y+Items[i].Control.Height)-FTop; end; AdjustGrabber; -writeln('[TControlSelection.AdjustSize] ',FLeft,',',FTop); end; end; procedure TControlSelection.AdjustGrabber; var g:TGrabIndex; + OutPix, InPix: integer; begin + OutPix:=GrabberSize div 2; + InPix:=GrabberSize-OutPix; for g:=Low(TGrabIndex) to High(TGrabIndex) do begin if gpLeft in FGrabbers[g].Positions then - FGrabbers[g].Left:=FLeft-GrabberSize + FGrabbers[g].Left:=FLeft-OutPix else if gpRight in FGrabbers[g].Positions then - FGrabbers[g].Left:=FLeft+FWidth + FGrabbers[g].Left:=FLeft+FWidth-InPix else FGrabbers[g].Left:=FLeft+((FWidth-GrabberSize) div 2); if gpTop in FGrabbers[g].Positions then - FGrabbers[g].Top:=FTop-GrabberSize + FGrabbers[g].Top:=FTop-OutPix else if gpBottom in FGrabbers[g].Positions then - FGrabbers[g].Top:=FTop+FHeight + FGrabbers[g].Top:=FTop+FHeight-InPix else FGrabbers[g].Top:=FTop+((FHeight-GrabberSize) div 2); FGrabbers[g].Width:=GrabberSize; @@ -326,14 +373,18 @@ end; procedure TControlSelection.DoChange; begin - if Assigned(FOnChange) then FOnChange(Self); + if (FUpdateLock>0) then + FChangedDuringLock:=true + else begin + if Assigned(FOnChange) then FOnChange(Self); + FChangedDuringLock:=false; + end; end; procedure TControlSelection.SetVisible(const Value: Boolean); begin if FVisible=Value then exit; FVisible:=Value; - DoChange; end; function TControlSelection.GetItems(Index:integer):TSelectedControl; @@ -351,6 +402,7 @@ procedure TControlSelection.SaveBounds; var i:integer; g:TGrabIndex; begin +writeln('TControlSelection.SaveBounds'); for i:=0 to FControls.Count-1 do Items[i].SaveBounds; for g:=Low(TGrabIndex) to High(TGrabIndex) do FGrabbers[g].SaveBounds; FOldLeft:=FLeft; @@ -436,14 +488,21 @@ var i:integer; g:TGrabIndex; begin if (dx=0) and (dy=0) then exit; - for i:=0 to FControls.Count-1 do - with Items[i] do - Control.SetBounds(OldLeft+dx,OldTop+dy - ,Control.Width,Control.Height); + BeginUpdate; + FIsResizing:=true; + for i:=0 to FControls.Count-1 do begin + with Items[i] do begin +writeln('TControlSelection.MoveSelection ',i,' ',OldLeft,',',OldTop,' d=',dx,',',dy); + Control.SetBounds(OldLeft+dx,OldTop+dy,Control.Width,Control.Height); + end; + end; for g:=Low(TGrabIndex) to High(TGrabIndex) do begin FGrabbers[g].Left:=FGrabbers[g].OldLeft+dx; FGrabbers[g].Top:=FGrabbers[g].OldTop+dy; end; + FIsResizing:=false; + SaveBounds; + EndUpdate; end; procedure TControlSelection.SizeSelection(dx, dy: integer); @@ -453,10 +512,12 @@ var i:integer; GrabberPos:TGrabPositions; begin if Count=0 then exit; + BeginUpdate; + FIsResizing:=true; if FActiveGrabber<>nil then GrabberPos:=FActiveGrabber.Positions else - GrabberPos:=[gpLeft,gpTop]; + GrabberPos:=[gpRight,gpBottom]; if [gpTop,gpBottom] * GrabberPos = [] then dy:=0; if [gpLeft,gpRight] * GrabberPos = [] then dx:=0; if (dx=0) and (dy=0) then exit; @@ -491,7 +552,9 @@ begin end; end; end; - DoChange; + SaveBounds; + EndUpdate; + FIsResizing:=false; end; function TControlSelection.GrabberAtPos(X,Y:integer):TGrabber; @@ -513,6 +576,7 @@ procedure TControlSelection.DrawGrabbers(DC: HDC); var OldBrushColor:TColor; g:TGrabIndex; FormOrigin, DCOrigin, Diff: TPoint; + OldFormHandle: HDC; begin if (Count=0) or (FCustomForm=nil) or (Items[0].Control is TCustomForm) then exit; @@ -526,10 +590,11 @@ writeln('[DrawGrabbers] Form=',FormOrigin.X,',',FormOrigin.Y ,' Grabber1=',FGrabbers[0].Left,',',FGrabbers[0].Top ,' Selection=',FLeft,',',FTop); } + OldFormHandle:=FCustomForm.Canvas.Handle; FCustomForm.Canvas.Handle:=DC; with FCustomForm.Canvas do begin OldBrushColor:=Brush.Color; - Brush.Color:=clBlack; + Brush.Color:=FGrabberColor; for g:=Low(TGrabIndex) to High(TGrabIndex) do FillRect(Rect( Diff.X+FGrabbers[g].Left @@ -539,6 +604,7 @@ writeln('[DrawGrabbers] Form=',FormOrigin.X,',',FormOrigin.Y )); Brush.Color:=OldbrushColor; end; + FCustomForm.Canvas.Handle:=OldFormHandle; end; procedure TControlSelection.DrawMarker(AControl:TControl; DC:HDC); @@ -546,16 +612,20 @@ var OldBrushColor:TColor; ALeft,ATop:integer; AControlOrigin,DCOrigin:TPoint; SaveIndex:HDC; + OldFormHandle:HDC; begin - if (Count<1) or (FCustomForm=nil) or (AControl is TCustomForm) + if (Count<2) or (FCustomForm=nil) or (AControl is TCustomForm) or (not IsSelected(AControl)) then exit; - AControlOrigin:=AControl.ClientOrigin; + AControlOrigin:=AControl.Parent.ClientOrigin; + Inc(AControlOrigin.X,AControl.Left); + Inc(AControlOrigin.Y,AControl.Top); GetWindowOrgEx(DC, DCOrigin); // MoveWindowOrg is currently not functioning in the gtk // this is a workaround - ALeft:=AControlOrigin.X-DCOrigin.X; //AControlOrigin.X-FormOrigin.X; - ATop:=AControlOrigin.Y-DCOrigin.Y; //AControlOrigin.Y-FormOrigin.Y; + ALeft:=AControlOrigin.X-DCOrigin.X; + ATop:=AControlOrigin.Y-DCOrigin.Y; SaveIndex := SaveDC(DC); + OldFormHandle:=FCustomForm.Canvas.Handle; FCustomForm.Canvas.Handle:=DC; { writeln('DrawMarker A ',FCustomForm.Name @@ -566,7 +636,7 @@ writeln('DrawMarker A ',FCustomForm.Name } with FCustomForm.Canvas do begin OldBrushColor:=Brush.Color; - Brush.Color:=clDKGray; + Brush.Color:=FMarkerColor; FillRect(Rect(ALeft,ATop,ALeft+MarkerSize,ATop+MarkerSize)); FillRect(Rect(ALeft,ATop+AControl.Height-MarkerSize ,ALeft+MarkerSize,ATop+AControl.Height)); @@ -577,60 +647,76 @@ writeln('DrawMarker A ',FCustomForm.Name ,ALeft+AControl.Width,ATop+AControl.Height)); Brush.Color:=OldbrushColor; end; - FCustomForm.Canvas.Handle:=0; + FCustomForm.Canvas.Handle:=OldFormHandle; RestoreDC(DC, SaveIndex); end; -procedure TControlSelection.DrawRubberband(DeleteOld:boolean; ARect:TRect); +procedure TControlSelection.DrawRubberband(DC: HDC); +var OldFormHandle: HDC; + FormOrigin, DCOrigin, Diff: TPoint; procedure DrawInvertFrameRect(x1,y1,x2,y2:integer); var i:integer; + procedure InvertPixel(x,y:integer); - var c:TColor; + //var c:TColor; begin - c:=FCustomForm.Canvas.Pixels[x,y]; - c:=c xor $ffffff; - FCustomForm.Canvas.Pixels[x,y]:=c; + //c:=FCustomForm.Canvas.Pixels[x,y]; + //c:=c xor $ffffff; + //FCustomForm.Canvas.Pixels[x,y]:=c; + FCustomForm.Canvas.MoveTo(Diff.X+x,Diff.Y+y); + FCustomForm.Canvas.LineTo(Diff.X+x+1,Diff.Y+y); end; + + var OldPenColor: TColor; begin if FCustomForm=nil then exit; if x1>x2 then begin i:=x1; x1:=x2; x2:=i; end; if y1>y2 then begin i:=y1; y1:=y2; y2:=i; end; - i:=x1+1; - while i=0 then begin + if ExclusiveOr then + Remove(ACustomForm.Controls[i]); + end else begin + Add(ACustomForm.Controls[i]); + end; + end; end; procedure TControlSelection.SetRubberBandBounds(ARect:TRect); +var i :integer; begin FRubberBandBounds:=ARect; + with FRubberBandBounds do begin + if Rightnil) or (getParentForm(Sender)=nil) then exit; MouseDownControl:=Sender; - FormOrigin:=GetParentForm(Sender).ClientOrigin; - SenderOrigin:=Sender.ClientOrigin; - MouseX:=Message.Pos.X+SenderOrigin.X-FormOrigin.X; - MouseY:=Message.Pos.Y+SenderOrigin.Y-FormOrigin.Y; + SenderOrigin:=GetFormRelativeControlTopLeft(Sender); + MouseX:=Message.Pos.X+SenderOrigin.X; + MouseY:=Message.Pos.Y+SenderOrigin.Y; MouseDownPos := Point(MouseX,MouseY); LastMouseMovePos:=MouseDownPos; writeln('************************************************************'); write('MouseDownOnControl'); - write(' ',Sender.Name,':',Sender.ClassName,' Sender=',SenderOrigin.X,',',SenderOrigin.Y); + write(' ',Sender.Name,':',Sender.ClassName,' Origin=',SenderOrigin.X,',',SenderOrigin.Y); write(' Msg=',Message.Pos.X,',',Message.Pos.Y); write(' Mouse=',MouseX,',',MouseY); writeln(''); - ControlSelection.ActiveGrabber:= - ControlSelection.GrabberAtPos(MouseDownPos.X,MouseDownPos.Y); - if (Message.Keys and MK_Shift) = MK_Shift then Write(' Shift down') else @@ -228,54 +239,63 @@ Begin else Writeln(', No CTRL down'); + if (Message.Keys and MK_LButton) > 0 then + ControlSelection.ActiveGrabber:= + ControlSelection.GrabberAtPos(MouseDownPos.X,MouseDownPos.Y); + if Assigned(FOnGetSelectedComponentClass) then FOnGetSelectedComponentClass(Self,SelectedCompClass) else SelectedCompClass:=nil; - if SelectedCompClass = nil then begin - // selection mode - if ControlSelection.ActiveGrabber=nil then begin - CompIndex:=ControlSelection.IndexOf(Sender); - if (Message.Keys and MK_SHIFT)>0 then begin - // shift key - if CompIndex<0 then begin - // not selected - // add component to selection - if (ControlSelection.Count=0) - or (not (Sender is TCustomForm)) then begin - ControlSelection.Add(Sender); + if (Message.Keys and MK_LButton) > 0 then begin + if SelectedCompClass = nil then begin + // selection mode + if ControlSelection.ActiveGrabber=nil then begin + CompIndex:=ControlSelection.IndexOf(Sender); + if (Message.Keys and MK_SHIFT)>0 then begin + // shift key (multiselection) + if CompIndex<0 then begin + // not selected + // add component to selection + if (ControlSelection.Count=0) + or (not (Sender is TCustomForm)) then begin + ControlSelection.Add(Sender); + Sender.Invalidate; + if Sender.Parent<>nil then + Sender.Parent.Invalidate; + end; + end else begin + // remove from multiselection + ControlSelection.Delete(CompIndex); Sender.Invalidate; if Sender.Parent<>nil then Sender.Parent.Invalidate; end; end else begin - // remove from multiselection - ControlSelection.Delete(CompIndex); - Sender.Invalidate; - if Sender.Parent<>nil then - Sender.Parent.Invalidate; - end; - end else begin - if (CompIndex<0) then begin - // select only this component - AControlSelection:=TControlSelection.Create; - AControlSelection.Assign(ControlSelection); - ControlSelection.Clear; - for i:=0 to AControlSelection.Count-1 do - AControlSelection[i].Control.Invalidate; - ControlSelection.Add(Sender); - Sender.Invalidate; - if Sender.Parent<>nil then - Sender.Parent.Invalidate; - AControlSelection.Free; + // no shift key (single selection) + if (CompIndex<0) then begin + // select only this component + AControlSelection:=TControlSelection.Create; + AControlSelection.Assign(ControlSelection); + ControlSelection.BeginUpdate; + ControlSelection.Clear; + for i:=0 to AControlSelection.Count-1 do + AControlSelection[i].Control.Invalidate; + ControlSelection.Add(Sender); + ControlSelection.EndUpdate; + Sender.Invalidate; + if Sender.Parent<>nil then + Sender.Parent.Invalidate; + AControlSelection.Free; + end; end; end; + end else begin + // add component mode -> handled in mousemove and mouseup end; - ControlSelection.SaveBounds; - end else begin - // add component mode -> handled in mousemove and mouseup end; + ControlSelection.SaveBounds; writeln('[TDesigner.MouseDownOnControl] END'); End; @@ -284,23 +304,18 @@ procedure TDesigner.MouseUpOnControl(Sender : TControl; Message:TLMMouse); var ParentCI, NewCI : TComponentInterface; NewLeft, NewTop, NewWidth, NewHeight, - MouseX, MouseY, I : Integer; + MouseX, MouseY : Integer; Shift : TShiftState; SenderParentForm:TCustomForm; RubberBandWasActive:boolean; - FormOrigin,SenderOrigin:TPoint; + SenderOrigin:TPoint; SelectedCompClass: TRegisteredComponent; - AControlSelection: TControlSelection; Begin SenderParentForm:=GetParentForm(Sender); if (MouseDownControl=nil) or (SenderParentForm=nil) then exit; ControlSelection.ActiveGrabber:=nil; - RubberBandWasActive:=FActiveRubberBand; - if FActiveRubberband then begin - FActiveRubberband:=false; - ControlSelection.DrawRubberBand(false,ControlSelection.RubberBandBounds); - end; + RubberBandWasActive:=ControlSelection.RubberBandActive; Shift := []; if (TLMMouse(Message).keys and MK_Shift) = MK_Shift then @@ -309,77 +324,90 @@ Begin Shift := Shift +[ssCTRL]; - FormOrigin:=SenderParentForm.ClientOrigin; - SenderOrigin:=Sender.ClientOrigin; - MouseX:=Message.Pos.X+SenderOrigin.X-FormOrigin.X; - MouseY:=Message.Pos.Y+SenderOrigin.Y-FormOrigin.Y; + SenderOrigin:=GetFormRelativeControlTopLeft(Sender); + MouseX:=Message.Pos.X+SenderOrigin.X; + MouseY:=Message.Pos.Y+SenderOrigin.Y; MouseUpPos := Point(MouseX,MouseY); dec(MouseX,MouseDownPos.X); dec(MouseY,MouseDownPos.Y); + writeln('************************************************************'); + write('MouseUpOnControl'); + write(' ',Sender.Name,':',Sender.ClassName,' Origin=',SenderOrigin.X,',',SenderOrigin.Y); + write(' Msg=',Message.Pos.X,',',Message.Pos.Y); + write(' Mouse=',MouseX,',',MouseY); + writeln(''); + if Assigned(FOnGetSelectedComponentClass) then FOnGetSelectedComponentClass(Self,SelectedCompClass) else SelectedCompClass:=nil; - if SelectedCompClass = nil then begin - // selection mode - if (ControlSelection.Count=1) - and (ControlSelection[0].Control is TCustomForm) then begin - // rubberband selection - if RubberBandWasActive then begin - AControlSelection:=TControlSelection.Create; - AControlSelection.Assign(ControlSelection); - ControlSelection.Clear; - for i:=0 to AControlSelection.Count-1 do - AControlSelection[i].Control.Invalidate; - AControlSelection.Free; - ControlSelection.SelectWithRubberBand(SenderParentForm); - for i:=0 to ControlSelection.Count-1 do - ControlSelection[i].Control.Invalidate; + if (Message.Keys and MK_LButton) > 0 then begin + // left mouse button + if SelectedCompClass = nil then begin + // selection mode + if not FHasSized then begin + ControlSelection.BeginUpdate; + if not (ssShift in Shift) then + ControlSelection.Clear; + if RubberBandWasActive then begin + ControlSelection.SelectWithRubberBand(SenderParentForm,ssShift in Shift); + if ControlSelection.Count=0 then + ControlSelection.Add(SenderParentForm); + ControlSelection.RubberbandActive:=false; + end else begin + ControlSelection.Add(Sender); + end; + ControlSelection.EndUpdate; + SenderParentForm.Invalidate; end; - end; - end else begin - // add a new control - if Assigned(FOnSetDesigning) then FOnSetDesigning(Self,FCustomForm,False); - ParentCI:=TComponentInterface(FFormEditor.FindComponent(Sender)); - if (Sender is TWinControl) - and (not (csAcceptsControls in TWinControl(Sender).ControlStyle)) then begin - ParentCI:=TComponentInterface( - FFormEditor.FindComponent(TWinControl(Sender).Parent)); - end; - if Assigned(ParentCI) then begin - NewLeft:=Min(MouseDownPos.X,MouseUpPos.X)-(SenderOrigin.X-FormOrigin.X); - NewWidth:=Abs(MouseUpPos.X-MouseDownPos.X)-(SenderOrigin.Y-FormOrigin.Y); - NewTop:=Min(MouseDownPos.Y,MouseUpPos.Y); - NewHeight:=Abs(MouseUpPos.Y-MouseDownPos.Y); - if Abs(NewWidth+NewHeight)<7 then begin - // this very small component is probably only a wag, take default size - NewWidth:=0; - NewHeight:=0; + end else begin + // add a new control + ControlSelection.RubberbandActive:=false; + if Assigned(FOnSetDesigning) then FOnSetDesigning(Self,FCustomForm,False); + ParentCI:=TComponentInterface(FFormEditor.FindComponent(Sender)); + if (Sender is TWinControl) + and (not (csAcceptsControls in TWinControl(Sender).ControlStyle)) then begin + ParentCI:=TComponentInterface( + FFormEditor.FindComponent(TWinControl(Sender).Parent)); end; - NewCI := TComponentInterface(FFormEditor.CreateComponent( - ParentCI,SelectedCompClass.ComponentClass - ,NewLeft,NewTop,NewWidth,NewHeight)); - NewCI.SetPropByName('Visible',True); - NewCI.SetPropByName('Designing',True); - if Assigned(FOnSetDesigning) then - FOnSetDesigning(Self,NewCI.Control,True); - if Assigned(FOnComponentListChanged) then - FOnComponentListChanged(Self); - if Assigned(FOnAddComponent) then - FOnAddComponent(Self,NewCI.Control,SelectedCompClass); + if Assigned(ParentCI) then begin + NewLeft:=Min(MouseDownPos.X,MouseUpPos.X)-SenderOrigin.X; + NewWidth:=Abs(MouseUpPos.X-MouseDownPos.X)-SenderOrigin.Y; + NewTop:=Min(MouseDownPos.Y,MouseUpPos.Y); + NewHeight:=Abs(MouseUpPos.Y-MouseDownPos.Y); + if Abs(NewWidth+NewHeight)<7 then begin + // this very small component is probably only a wag, take default size + NewWidth:=0; + NewHeight:=0; + end; + NewCI := TComponentInterface(FFormEditor.CreateComponent( + ParentCI,SelectedCompClass.ComponentClass + ,NewLeft,NewTop,NewWidth,NewHeight)); + NewCI.SetPropByName('Visible',True); + NewCI.SetPropByName('Designing',True); + if Assigned(FOnSetDesigning) then + FOnSetDesigning(Self,NewCI.Control,True); + if Assigned(FOnComponentListChanged) then + FOnComponentListChanged(Self); + if Assigned(FOnAddComponent) then + FOnAddComponent(Self,NewCI.Control,SelectedCompClass); - SelectOnlyThisComponent(TComponent(NewCI.Control)); - Writeln('Calling ControlClick with nil from MouseUpOnControl'); - if not (ssCtrl in Shift) then - if Assigned(FOnUnselectComponentClass) then - // this resets it to the mouse. (= selection tool) - FOnUnselectComponentClass(Self); - if Assigned(FOnSetDesigning) then FOnSetDesigning(Self,FCustomForm,True); - Form.Invalidate; + SelectOnlyThisComponent(TComponent(NewCI.Control)); + Writeln('Calling ControlClick with nil from MouseUpOnControl'); + if not (ssCtrl in Shift) then + if Assigned(FOnUnselectComponentClass) then + // this resets it to the mouse. (= selection tool) + FOnUnselectComponentClass(Self); + if Assigned(FOnSetDesigning) then FOnSetDesigning(Self,FCustomForm,True); + Form.Invalidate; + end; end; end; + ControlSelection.SaveBounds; + LastMouseMovePos.X:=-1; + FHasSized:=false; MouseDownControl:=nil; writeln('[TDesigner.MouseUpOnControl] END'); @@ -394,24 +422,36 @@ const mk_mbutton = $10; var Shift : TShiftState; - FormOrigin, SenderOrigin:TPoint; + SenderOrigin:TPoint; SenderParentForm:TCustomForm; MouseX, MouseY :integer; + AGrabber: TGrabber; Begin - if MouseDownControl=nil then exit; - SenderParentForm:=GetParentForm(Sender); if SenderParentForm=nil then exit; - FormOrigin:=SenderParentForm.ClientOrigin; - SenderOrigin:=Sender.ClientOrigin; - MouseX:=Message.Pos.X+SenderOrigin.X-FormOrigin.X; - MouseY:=Message.Pos.Y+SenderOrigin.Y-FormOrigin.Y; - + SenderOrigin:=GetFormRelativeControlTopLeft(Sender); if (Message.keys and MK_LButton) = MK_LButton then begin - Write('TDesigner.MouseMoveOnControl'); - Write(' Cur=',MouseX,',',MouseY); + MouseX:=Message.Pos.X; + MouseY:=Message.Pos.Y; + end else begin + MouseX:=Message.Pos.X+SenderOrigin.X; + MouseY:=Message.Pos.Y+SenderOrigin.Y; + end; + + AGrabber:=ControlSelection.GrabberAtPos(MouseX,MouseY); + if AGrabber=nil then begin + + end else begin + + end; + + if MouseDownControl=nil then exit; + + if true then begin + Write('MouseMoveOnControl'); + Write(' ',Sender.Name,':',Sender.ClassName,' Origin=',SenderOrigin.X,',',SenderOrigin.Y); Write(' Msg=',Message.Pos.x,',',Message.Pos.Y); - Write(' ',Sender.Name,':',Sender.ClassName,'=',Sender.Left,',',Sender.Top); + Write(' Mouse=',MouseX,',',MouseY); writeln(); end; @@ -423,19 +463,26 @@ Begin if ControlSelection.ActiveGrabber<>nil then begin if (Message.keys and MK_LButton) = MK_LButton then begin + FHasSized:=true; ControlSelection.SizeSelection(MouseX-MouseDownPos.X, MouseY-LastMouseMovePos.Y); if Assigned(FOnPropertiesChanged) then FOnPropertiesChanged(Self); end; end else begin if (Message.keys and MK_LButton) = MK_LButton then begin - if (ControlSelection.Count>=1) + if (not (MouseDownControl is TCustomForm)) and (ControlSelection.Count>=1) and not (ControlSelection[0].Control is TCustomForm) then begin // move selection + FHasSized:=true; ControlSelection.MoveSelection( - MouseX-MouseDownPos.X, MouseY-MouseDownPos.Y); + MouseX-LastMouseMovePos.X, MouseY-LastMouseMovePos.Y); if Assigned(FOnPropertiesChanged) then FOnPropertiesChanged(Self); + end else begin + // rubberband selection/creation + ControlSelection.RubberBandBounds:=Rect(MouseDownPos.X,MouseDownPos.Y,MouseX,MouseY); + ControlSelection.RubberBandActive:=true; + SenderParentForm.Invalidate; end; end; end; @@ -443,11 +490,11 @@ Begin end; { ------------------------------K E Y D O W N ------------------- +-----------------------------K E Y D O W N ------------------------------- } { - Handles the keydown messages. DEL deletes the selected controls, CTRL-UPARROR/DOWNARROW - moves the selection up one, etc. + Handles the keydown messages. DEL deletes the selected controls, CTRL-ARROR + moves the selection up one, SHIFT-ARROW resizes, etc. } Procedure TDesigner.KeyDown(Sender : TControl; Message:TLMKEY); var @@ -466,11 +513,13 @@ Writeln('KEYDOWN'); if Message.CharCode = 46 then //DEL KEY begin + ControlSelection.BeginUpdate; for I := ControlSelection.Count-1 downto 0 do Begin Writeln('I = '+inttostr(i)); RemoveControl(ControlSelection.Items[I].Control); End; SelectOnlythisComponent(FCustomForm); + ControlSelection.EndUpdate; end else if Message.CharCode = 38 then //UP ARROW @@ -530,21 +579,18 @@ Begin Result:=true; case Message.MSG of - LM_PAINT: Result:=Paint(Sender,TLMPAINT(Message)); + LM_PAINT: Result:=PaintControl(Sender,TLMPaint(Message)); LM_KEYDOWN: KeyDown(Sender,TLMKey(Message)); LM_KEYUP: KeyUP(Sender,TLMKey(Message)); - LM_LBUTTONDOWN: MouseDownOnControl(sender,TLMMouse(Message)); - LM_LBUTTONUP: MouseUpOnControl(sender,TLMMouse(Message)); + LM_LBUTTONDOWN,LM_RBUTTONDOWN: MouseDownOnControl(sender,TLMMouse(Message)); + LM_LBUTTONUP,LM_RBUTTONUP: MouseUpOnControl(sender,TLMMouse(Message)); LM_MOUSEMOVE: MouseMoveOnControl(Sender, TLMMouse(Message)); + LM_SIZE: Result:=SizeControl(Sender,TLMSize(Message)); + LM_MOVE: Result:=MoveControl(Sender,TLMMove(Message)); end; end; end; -procedure TDesigner.LoadFile(FileName: string); -begin - -end; - procedure TDesigner.Modified; Begin @@ -552,14 +598,14 @@ end; procedure TDesigner.Notification(AComponent: TComponent; Operation: TOperation); Begin - if Operation = opInsert then - begin - end + if Operation = opInsert then + begin + end else if Operation = opRemove then begin - writeln('[TDesigner.Notification] opRemove '+ - ''''+AComponent.ClassName+'.'+AComponent.Name+''''); + writeln('[TDesigner.Notification] opRemove '+ + ''''+AComponent.ClassName+'.'+AComponent.Name+''''); if (AComponent is TControl) then if ControlSelection.IsSelected(TControl(AComponent)) then ControlSelection.Remove(TControl(AComponent)); diff --git a/designer/jitforms.pp b/designer/jitforms.pp index c6d02e12de..37e943bdb4 100644 --- a/designer/jitforms.pp +++ b/designer/jitforms.pp @@ -18,11 +18,11 @@ unit jitforms; in designing state } -{$mode objfpc} +{$mode objfpc}{$H+} interface -uses Classes, SysUtils, CompReg, Forms, Controls; +uses Classes, SysUtils, CompReg, Forms, Controls, LCLLinux; type //---------------------------------------------------------------------------- @@ -204,7 +204,7 @@ writeln('[TJITForms.DoCreateJITForm] Creating an instance of JIT class '''+NewCl writeln('[TJITForms.DoCreateJITForm] Initializing new instance ...'); TComponent(FCurReadForm):=Instance; try - Instance.Create(Application); + Instance.Create(nil); Writeln('----------------------------------'); Writeln('New form name is '+NewFormName); Writeln('----------------------------------'); @@ -261,15 +261,19 @@ begin Result:=0; NewClassName:=GetClassNameFromStream(BinStream); if NewClassName='' then begin + Application.MessageBox('No classname in form stream found.','',mb_OK); Result:=-1; exit; end; +writeln('[TJITForms.AddJITFormFromStream] 1'); try Result:=DoCreateJITForm('',NewClassName); +writeln('[TJITForms.AddJITFormFromStream] 2'); Reader:=TReader.Create(BinStream,4096); MyFindGlobalComponentProc:=@OnFindGlobalComponent; FindGlobalComponent:=@MyFindGlobalComponent; +writeln('[TJITForms.AddJITFormFromStream] 3'); try // connect TReader events Reader.OnError:=@ReaderError; @@ -280,8 +284,10 @@ begin Reader.OnCreateComponent:=@ReaderCreateComponent; Reader.OnFindComponentClass:=@ReaderFindComponentClass; +writeln('[TJITForms.AddJITFormFromStream] 4'); Reader.ReadRootComponent(FCurReadForm); +writeln('[TJITForms.AddJITFormFromStream] 5'); // MG: workaround til visible=true is default for a:=0 to FCurReadForm.ComponentCount-1 do begin if FCurReadForm.Components[a] is TControl then @@ -289,6 +295,7 @@ begin end; // MG: end of workaround +writeln('[TJITForms.AddJITFormFromStream] 6'); FCurReadForm.Show; finally FindGlobalComponent:=nil; diff --git a/ide/customformeditor.pp b/ide/customformeditor.pp index e9a5881c47..a4a1436c00 100644 --- a/ide/customformeditor.pp +++ b/ide/customformeditor.pp @@ -86,23 +86,23 @@ TCustomFormEditor } - TControlClass = class of TControl; + TControlClass = class of TControl; - TCustomFormEditor = class(TAbstractFormEditor) + TCustomFormEditor = class(TAbstractFormEditor) private - FModified : Boolean; - FComponentInterfaceList : TList; //used to track and find controls - FSelectedComponents : TComponentSelectionList; - FObj_Inspector : TObjectInspector; + FModified : Boolean; + FComponentInterfaceList : TList; //used to track and find controls + FSelectedComponents : TComponentSelectionList; + FObj_Inspector : TObjectInspector; protected Procedure RemoveFromComponentInterfaceList(Value :TIComponentInterface); + procedure SetSelectedComponents(TheSelectedComponents : TComponentSelectionList); public constructor Create; destructor Destroy; override; Function AddSelected(Value : TComponent) : Integer; Procedure DeleteControl(Value : TComponent); - Function Filename : String; override; Function FormModified : Boolean; override; Function FindComponentByName(const Name : ShortString) : TIComponentInterface; override; Function FindComponent(AComponent: TComponent): TIComponentInterface; override; @@ -112,22 +112,21 @@ TCustomFormEditor Function CreateComponent(ParentCI : TIComponentInterface; TypeClass : TComponentClass; X,Y,W,H : Integer): TIComponentInterface; override; - Function NewFormFromLFM(_Filename : String): TCustomform; + Function CreateFormFromStream(BinStream: TStream): TIComponentInterface; override; Procedure ClearSelected; property SelectedComponents : TComponentSelectionList - read FSelectedComponents write FSelectedComponents; + read FSelectedComponents write SetSelectedComponents; property Obj_Inspector : TObjectInspector read FObj_Inspector write FObj_Inspector; - end; implementation uses - SysUtils,jitforms; + SysUtils, JITForms; var -JITFormList : TJITForms; + JITFormList : TJITForms; {TComponentInterface} @@ -516,12 +515,18 @@ begin inherited; end; +procedure TCustomFormEditor.SetSelectedComponents( + TheSelectedComponents : TComponentSelectionList); +begin + FSelectedComponents.Free; + FSelectedComponents:=TheSelectedComponents; + Obj_Inspector.Selections := FSelectedComponents; +end; + Function TCustomFormEditor.AddSelected(Value : TComponent) : Integer; Begin FSelectedComponents.Add(Value); Result := FSelectedComponents.Count; - // call the OI to update it's selected. - writeln('[TCustomFormEditor.AddSelected] '+Value.Name); Obj_Inspector.Selections := FSelectedComponents; end; @@ -547,11 +552,6 @@ Begin end; -Function TCustomFormEditor.Filename : String; -begin - Result := 'testing.pp'; -end; - Function TCustomFormEditor.FormModified : Boolean; Begin Result := FModified; @@ -612,7 +612,11 @@ Begin //this should be a form NewFormIndex := JITFormList.AddNewJITForm; if NewFormIndex >= 0 then - Temp.FControl := JITFormList[NewFormIndex]; + Temp.FControl := JITFormList[NewFormIndex] + else begin + Temp:=nil; + exit; + end; end; if Assigned(ParentCI) then @@ -678,6 +682,24 @@ Begin Result := Temp; end; +Function TCustomFormEditor.CreateFormFromStream( + BinStream: TStream): TIComponentInterface; +var NewFormIndex: integer; + Temp : TComponentInterface; +begin + Temp := TComponentInterface.Create; + NewFormIndex := JITFormList.AddJITFormFromStream(BinStream); + if NewFormIndex >= 0 then + Temp.FControl := JITFormList[NewFormIndex] + else begin + Temp:=nil; + exit; + end; + FComponentInterfaceList.Add(Temp); + + Result := Temp; +end; + Procedure TCustomFormEditor.RemoveFromComponentInterfaceList(Value :TIComponentInterface); Begin if (FComponentInterfaceList.IndexOf(Value) <> -1) then @@ -697,38 +719,6 @@ Begin FSelectedComponents.Clear; end; -Function TCustomFormEditor.NewFormFromLFM(_Filename : String): TCustomForm; -var - BinStream: TMemoryStream; - TxtStream : TFileStream; - Index : Integer; -Begin - Writeln('[NewFormFromLFM]'); - result := nil; - try - BinStream := TMemoryStream.Create; - try - TxtStream:= TFileStream.Create(_Filename,fmOpenRead); - try - ObjectTexttoBinary(TxtStream,BinStream); - finally - TxtStream.Free; - end; - BinStream.Position := 0; - Writeln('[NewFormFromLFM] calling AddJITFORMFromStream'); - Index := JITFormList.AddJITFormFromStream(binStream); - Writeln('[NewFormFromLFM] index='+inttostr(index)); - Result := JITFormList[Index]; - finally - BinStream.Free; - end; - except - //some error raised - end; - - -end; - Function TCustomFormEditor.CreateControlComponentInterface(Control: TComponent) :TIComponentInterface; var Temp : TComponentInterface; diff --git a/ide/lazarus.pp b/ide/lazarus.pp index 29e4c78eae..ed834c7f90 100644 --- a/ide/lazarus.pp +++ b/ide/lazarus.pp @@ -51,16 +51,21 @@ begin Application.CreateForm(TLazFindReplaceDialog, FindReplaceDlg); SplashForm.StartTimer; Application.Run; + SplashForm.Free; -writeln('LAZARUS END'); +writeln('LAZARUS close application...'); // workaround till lcl closes clean Application.Free; Application:=nil; +writeln('LAZARUS END'); end. { $Log$ + Revision 1.18 2001/03/19 14:00:46 lazarus + MG: fixed many unreleased DC and GDIObj bugs + Revision 1.17 2001/03/12 09:34:52 lazarus MG: added transfermacros, renamed dlgmessage.pp to msgview.pp diff --git a/ide/main.pp b/ide/main.pp index 9961b11a91..967c468af3 100644 --- a/ide/main.pp +++ b/ide/main.pp @@ -56,7 +56,6 @@ type Toolbutton3 : TToolButton; Toolbutton4 : TToolButton; GlobalMouseSpeedButton : TSpeedButton; - Bitmap1 : TBitmap; ComboBox1 : TComboBox; Edit1: TEdit; @@ -250,6 +249,7 @@ type procedure OnDesignerPropertiesChanged(Sender: TObject); procedure OnDesignerAddComponent(Sender: TObject; Component: TComponent; ComponentClass: TRegisteredComponent); + procedure OnControlSelectionChanged(Sender: TObject); procedure SaveDesktopSettings(TheEnvironmentOptions: TEnvironmentOptions); procedure LoadDesktopSettings(TheEnvironmentOptions: TEnvironmentOptions); @@ -277,7 +277,7 @@ var implementation uses - ViewUnit_dlg,ViewForm_dlg, Math,LResources, Designer; + ViewUnit_dlg, ViewForm_dlg, Math,LResources, Designer; { TMainIDE } @@ -352,8 +352,6 @@ begin LoadMainMenu; - Bitmap1 := TBitmap.Create; - Bitmap1.Handle := CreatePixmapIndirect(@IMGOK_Check, ColorToRGB(clBtnFace)); ComponentNotebook := TNotebook.Create(Self); with ComponentNotebook do begin @@ -366,7 +364,6 @@ begin Height := 100; //Self.ClientHeight - ComponentNotebook.Top; end; - SelectionPointerPixmap:=LoadSpeedBtnPixMap('tmouse'); PageCount := 0; for I := 0 to RegCompList.PageCount-1 do begin @@ -377,6 +374,7 @@ begin ComponentNotebook.Pages.Strings[pagecount] := RegCompPage.Name else ComponentNotebook.Pages.Add(RegCompPage.Name); GlobalMouseSpeedButton := TSpeedButton.Create(Self); + SelectionPointerPixmap:=LoadSpeedBtnPixMap('tmouse'); with GlobalMouseSpeedButton do Begin Parent := ComponentNotebook.Page[PageCount]; @@ -396,7 +394,6 @@ begin RegComp := RegCompPage.Items[x]; IDEComponent := TIDEComponent.Create; IdeComponent.RegisteredComponent := RegComp; - Writeln('Name is '+RegComp.ComponentClass.ClassName); IDEComponent._SpeedButton(Self,ComponentNotebook.Page[PageCount]); IDEComponent.SpeedButton.OnClick := @ControlClick; IDEComponent.SpeedButton.Hint := RegComp.ComponentClass.ClassName; @@ -621,6 +618,9 @@ begin MacroList.Add(TTransferMacro.Create('Params','',nil)); MacroList.Add(TTransferMacro.Create('TargetFile','',nil)); + TheControlSelection:=TControlSelection.Create; + TheControlSelection.OnChange:=@OnControlSelectionChanged; + // load last project or create a new project if (not FileExists(EnvironmentOptions.LastSavedProjectFile)) or (DoOpenProjectFile(EnvironmentOptions.LastSavedProjectFile)<>mrOk) then @@ -633,6 +633,7 @@ begin Project.Free; Project:=nil; end; + TheControlSelection.Free; MacroList.Free; EnvironmentOptions.Free; EnvironmentOptions:=nil; @@ -1053,12 +1054,12 @@ var begin if Sender is TSpeedButton then Begin - Writeln('sender is a speedbutton'); - Writeln('The name is '+TSpeedbutton(sender).name); +// Writeln('sender is a speedbutton'); +// Writeln('The name is '+TSpeedbutton(sender).name); SpeedButton := TSpeedButton(Sender); - Writeln('Speedbutton s Name is '+SpeedButton.name); +// Writeln('Speedbutton s Name is '+SpeedButton.name); //find the IDECOmponent that has this speedbutton - IDEComp := IDECompList.FindCompbySpeedButton(SpeedButton); + IDEComp := IDECompList.FindCompBySpeedButton(SpeedButton); if SelectedComponent <> nil then TIDeComponent( IdeCompList.FindCompByRegComponent(SelectedComponent)).SpeedButton.Down @@ -1077,9 +1078,11 @@ begin end; if temp <> nil then TSpeedButton(Temp).down := False - else - Writeln('*****************ERROR - Control ', + else begin + Writeln('[TMainIDE.ControlClick] ERROR - Control ', 'GlobalMouseSpeedButton',inttostr(ComponentNotebook.Pageindex),' not found'); + Halt; + end; end; if IDECOmp <> nil then Begin //draw this button down @@ -1100,14 +1103,16 @@ begin end; if temp <> nil then TSpeedButton(Temp).down := True - else - Writeln('*****************ERROR - Control ' + else begin + Writeln('[TMainIDE.ControlClick] ERROR - Control ' +'GlobalMouseSpeedButton'+inttostr(ComponentNotebook.Pageindex)+' not found'); + Halt; + end; end; end else Begin - Writeln('must be nil'); +// Writeln('must be nil'); //draw old speedbutton up if SelectedComponent <> nil then TIDeComponent( @@ -1127,11 +1132,13 @@ begin end; if temp <> nil then TSpeedButton(Temp).down := True - else - Writeln('*****************ERROR - Control ' + else begin + Writeln('[TMainIDE.ControlClick] ERROR - Control ' +'GlobalMouseSpeedButton'+inttostr(ComponentNotebook.Pageindex)+' not found'); + Halt; + end; end; - Writeln('Exiting ControlClick'); +// Writeln('Exiting ControlClick'); end; @@ -1305,7 +1312,9 @@ end; Procedure TMainIDE.SetDefaultsforForm(aForm : TCustomForm); Begin - aForm.Designer := TDesigner.Create(aForm); +writeln('[TMainIDE.SetDefaultsforForm] 1'); + aForm.Designer := TDesigner.Create(aForm, TheControlSelection); +writeln('[TMainIDE.SetDefaultsforForm] 2'); with TDesigner(aForm.Designer) do begin FormEditor := FormEditor1; OnGetSelectedComponentClass:=@OnDesignerGetSelectedComponentClass; @@ -1314,6 +1323,7 @@ Begin OnComponentListChanged:=@OnDesignerComponentListChanged; OnPropertiesChanged:=@OnDesignerPropertiesChanged; OnAddComponent:=@OnDesignerAddComponent; +writeln('[TMainIDE.SetDefaultsforForm] 3'); end; end; @@ -1323,7 +1333,11 @@ end; procedure TMainIDE.mnuQuitClicked(Sender : TObject); begin if SomethingOfProjectIsModified then begin - if DoSaveProject(false)=mrAbort then exit; + if Application.MessageBox('Save changes to project?','Project changed', + MB_OKCANCEL)=mrOk then begin + if DoSaveProject(false)=mrAbort then exit; + if DoCloseProject=mrAbort then exit; + end; end; Project.Free; Project:=nil; @@ -1582,7 +1596,7 @@ writeln('TMainIDE.DoNewEditorUnit 6'); // select the new form (object inspector, formeditor, control selection) PropertyEditorHook1.LookupRoot := TForm(CInterface.Control); - FormEditor1.AddSelected(TComponent(CInterface.Control)); + TDesigner(TempForm.Designer).SelectOnlyThisComponent(TempForm); end; UpdateMainUnitSrcEdit; @@ -1831,6 +1845,7 @@ var ActiveSrcEdit: TSourceEditor; ActiveUnitInfo: TUnitInfo; ACaption,AText:string; i:integer; + OldDesigner: TDesigner; begin writeln('TMainIDE.DoCloseEditorUnit 1'); Result:=mrCancel; @@ -1860,7 +1875,9 @@ writeln('TMainIDE.DoCloseEditorUnit 1'); writeln('TMainIDE.DoCloseEditorUnit 2'); // close form if ActiveUnitInfo.Form<>nil then begin + OldDesigner:=TDesigner(TCustomForm(ActiveUnitInfo.Form).Designer); FormEditor1.DeleteControl(ActiveUnitInfo.Form); + OldDesigner.Free; ActiveUnitInfo.Form:=nil; end; writeln('TMainIDE.DoCloseEditorUnit 3'); @@ -1888,6 +1905,8 @@ var Ext,ACaption,AText:string; NewPageName, NewLFMFilename: string; NewSrcEdit: TSourceEditor; TxtLFMStream,BinLFMStream:TMemoryStream; + CInterface: TComponentInterface; + TempForm: TCustomForm; begin writeln('TMainIDE.DoOpenEditorFile'); Result:=mrCancel; @@ -1955,24 +1974,68 @@ writeln('TMainIDE.DoOpenEditorFile'); // convert text to binary format try ObjectTextToBinary(TxtLFMStream,BinLFMStream); + BinLFMStream.Position:=0; Result:=mrOk; except - ACaption:='Format error'; - AText:='Unable to convert text form data of file "' - +NewLFMFilename+'" into binary stream.'; - Result:=Application.MessageBox(PChar(AText),PChar(ACaption) - ,MB_OKCANCEL); - if Result=mrCancel then begin - Result:=mrAbort; - exit; + on E: Exception do begin + ACaption:='Format error'; + AText:='Unable to convert text form data of file "' + +NewLFMFilename+'" into binary stream. ('+E.Message+')'; + Result:=Application.MessageBox(PChar(AText),PChar(ACaption) + ,MB_OKCANCEL); + if Result=mrCancel then begin + Result:=mrAbort; + exit; + end; end; end; finally TxtLFMStream.Free; end; - // ToDo: write a function TCustomFormEditor.CreateFormFromStream - // set NewUnitInfo.Formname and NewUnitInfo.Form +writeln('TMainIDE.DoOpenEditorFile LFM 1'); + if not Assigned(FormEditor1) then + FormEditor1 := TFormEditor.Create; + if not ProjectLoading then FormEditor1.ClearSelected; +writeln('TMainIDE.DoOpenEditorFile LFM 2'); + // create jitform + CInterface := TComponentInterface( + FormEditor1.CreateFormFromStream(BinLFMStream)); + if CInterface=nil then begin + ACaption:='Form load error'; + AText:='Unable to build form from file "' + +NewLFMFilename+'".'; + Result:=Application.MessageBox(PChar(AText),PChar(ACaption) + ,MB_OKCANCEL); + if Result=mrCancel then begin + Result:=mrAbort; + exit; + end; + end; +writeln('TMainIDE.DoOpenEditorFile LFM 3 '); + TempForm:=TForm(CInterface.Control); + NewUnitInfo.Form:=TempForm; +writeln('TMainIDE.DoOpenEditorFile LFM 3.1'); + SetDefaultsForForm(TempForm); +writeln('TMainIDE.DoOpenEditorFile LFM 3.2'); + NewUnitInfo.FormName:=TempForm.Name; + // show form + TDesigner(TempForm.Designer).SourceEditor := SourceNoteBook.GetActiveSE; + + if not ProjectLoading then begin +writeln('TMainIDE.DoOpenEditorFile LFM 4'); + TempForm.Show; + FCodeLastActivated:=false; + end; + SetDesigning(TempForm,True); + +writeln('TMainIDE.DoOpenEditorFile LFM 5'); + // select the new form (object inspector, formeditor, control selection) + if not ProjectLoading then begin + PropertyEditorHook1.LookupRoot := TForm(CInterface.Control); + TDesigner(TempForm.Designer).SelectOnlyThisComponent(TempForm); + end; +writeln('TMainIDE.DoOpenEditorFile LFM end'); finally BinLFMStream.Free; end; @@ -2101,11 +2164,14 @@ writeln('TMainIDE.DoNewProject 1'); Result:=mrCancel; If Project<>nil then begin - //save and close the project - - if DoSaveProject(false)=mrAbort then begin - Result:=mrAbort; - exit; + if SomethingOfProjectIsModified then begin + if Application.MessageBox('Save changes to project?','Project changed' + ,MB_OKCANCEL)=mrOK then begin + if DoSaveProject(false)=mrAbort then begin + Result:=mrAbort; + exit; + end; + end; end; writeln('TMainIDE.DoNewProject 2'); if DoCloseProject=mrAbort then begin @@ -2135,12 +2201,12 @@ writeln('TMainIDE.DoNewProject 4'); end; // set all modified to false - Project.Modified:=false; for i:=0 to Project.UnitCount-1 do begin Project.Units[i].Modified:=false; end; + Project.Modified:=false; -writeln('TMainIDE.DoNewProject end'); +writeln('TMainIDE.DoNewProject end '); UpdateCaption; Result:=mrOk; end; @@ -2330,6 +2396,15 @@ writeln('TMainIDE.DoOpenProjectFile 1'); end; until Result<>mrRetry; // close the old project + if SomethingOfProjectIsModified then begin + if Application.MessageBox('Save changes to project?','Project changed' + ,MB_OKCANCEL)=mrOK then begin + if DoSaveProject(false)=mrAbort then begin + Result:=mrAbort; + exit; + end; + end; + end; Result:=DoCloseProject; if Result=mrAbort then exit; writeln('TMainIDE.DoOpenProjectFile 2'); @@ -2370,7 +2445,15 @@ writeln('TMainIDE.DoOpenProjectFile 5'); if (SourceNoteBook.NoteBook<>nil) and (Project.ActiveEditorIndexAtStart>=0) and (Project.ActiveEditorIndexAtStartnil) + and (Project.SomethingModified or SourceNotebook.SomethingModified); end; function TMainIDE.DoSaveAll: TModalResult; @@ -2499,6 +2576,7 @@ begin FileStream:=TFileStream.Create(AFilename,fmOpenRead); try MemStream.CopyFrom(FileStream,FileStream.Size); + MemStream.Position:=0; finally FileStream.Free; end; @@ -2787,6 +2865,18 @@ begin end; end; +procedure TMainIDE.OnControlSelectionChanged(Sender: TObject); +var NewSelectedComponents : TComponentSelectionList; + i: integer; +begin +writeln('[TMainIDE.OnControlSelectionChanged]'); + NewSelectedComponents:=TComponentSelectionList.Create; + for i:=0 to TheControlSelection.Count-1 do begin + NewSelectedComponents.Add(TheControlSelection[i].Control); + end; + FormEditor1.SelectedComponents:=NewSelectedComponents; +end; + initialization {$I images/laz_images.lrs} @@ -2799,6 +2889,9 @@ end. { ============================================================================= $Log$ + Revision 1.75 2001/03/19 14:00:46 lazarus + MG: fixed many unreleased DC and GDIObj bugs + Revision 1.74 2001/03/12 18:57:31 lazarus MG: new designer and controlselection code diff --git a/ide/project.pp b/ide/project.pp index ca3d98ffb2..96f657b57d 100644 --- a/ide/project.pp +++ b/ide/project.pp @@ -234,6 +234,7 @@ type procedure CloseEditorIndex(EditorIndex:integer); procedure InsertEditorIndex(EditorIndex:integer); procedure Clear; + function SomethingModified: boolean; function AddCreateFormToProjectFile(AClassName,AName:string):boolean; function RemoveCreateFormFromProjectFile(AClassName,AName:string):boolean; function FormIsCreatedInProjectFile(AClassname,AName:string):boolean; @@ -806,8 +807,8 @@ begin case fProjectType of ptApplication: begin - Add(' Application.Initialize;'); - Add(' Application.Run;'); + Add(' Application.Initialize;'); + Add(' Application.Run;'); end; end; Add('end.'); @@ -1392,6 +1393,12 @@ begin end; end; +function TProject.SomethingModified: boolean; +var i: integer; +begin + Result:=Modified; + for i:=0 to UnitCount-1 do Result:=Result or Units[i].Modified; +end; end. @@ -1399,7 +1406,11 @@ end. { $Log$ + Revision 1.16 2001/03/19 14:00:47 lazarus + MG: fixed many unreleased DC and GDIObj bugs + Revision 1.15 2001/03/09 17:54:45 lazarus + Fixed error in Windows section of OnLoadSaveFilename - missing ')' Revision 1.14 2001/03/09 11:38:20 lazarus diff --git a/ide/splash.pp b/ide/splash.pp index 27ed653ab1..251a181575 100644 --- a/ide/splash.pp +++ b/ide/splash.pp @@ -18,21 +18,18 @@ * * ***************************************************************************/ } -{$H+} unit Splash; -{$mode objfpc} -//{$mode delphi} +{$mode objfpc}{$H+} interface uses - classes, Controls, forms,buttons,sysutils, stdctrls, extctrls, - LCLLinux{must be defined before graphics}, Graphics; + Classes, Controls, Forms, Buttons, SysUtils, StdCtrls, ExtCtrls, + LCLLinux{must be defined before graphics}, Graphics; type - - TSplashForm = class(TFORM) + TSplashForm = class(TForm) private FBitmap : TBitmap; FTimer : TTimer; @@ -307,6 +304,7 @@ const 's!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccvccccvcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccvcccccccccccc', 'evcvvcvcvcvcvcvcvcvcvcvcvcvcvcvcvcvcvcvcvcvcvcvcvcvcvcvcvcvcvcvcvcvcvcvcvcvcvcvcvcvcvcvcvcvcvcvcvcvcvcvcvcvccvccccccccccccccccccccccccccvccccccccccccccccccccccccccccccccccvccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccvccccccc' ); + constructor TSplashForm.Create(AOwner: TComponent); begin inherited Create(AOwner); @@ -326,7 +324,6 @@ begin OnTimer := @HideFormTimer; Enabled := False; end; - end; destructor TSplashForm.Destroy; @@ -342,7 +339,9 @@ begin FTimer.Enabled := False; //Release resources FTimer.Free; + FTimer:=nil; FBitmap.Free; + FBitmap:=nil; end; procedure TSplashForm.HideFormTimer(Sender : TObject); @@ -367,6 +366,9 @@ end. { ============================================================================= $Log$ + Revision 1.3 2001/03/19 14:00:47 lazarus + MG: fixed many unreleased DC and GDIObj bugs + Revision 1.2 2000/09/10 23:08:30 lazarus MWE: + Added CreateCompatibeleBitamp function diff --git a/ide/uniteditor.pp b/ide/uniteditor.pp index f9219b4cdc..4d3fc5c50c 100644 --- a/ide/uniteditor.pp +++ b/ide/uniteditor.pp @@ -273,6 +273,7 @@ type Function GetSourceForUnit(UnitName : String) : TStrings; Function SetSourceForUnit(UnitName : String; NewSource : TStrings) : Boolean; Function FindUniquePageName(FileName:string; IgnorePageIndex:integer):string; + function SomethingModified: boolean; Procedure DisplayFormforActivePage; Procedure DisplayCodeforControl(Control : TObject); @@ -1098,9 +1099,7 @@ writeln('TSourceEditor.CreateEditor freeing old FEditor'); aCompletion.AddEditor(FEditor); FEditor.Lines.Assign(OldSource); OldSource.Free; -writeln('TSourceEditor.CreateEditor focusing'); FEditor.SetFocus; -writeln('TSourceEditor.CreateEditor end'); end; Procedure TSourceEditor.AddControlCode(_Control : TComponent); @@ -1524,6 +1523,7 @@ begin FOpenDialog := TOpenDialog.Create(Self); BuildPopupMenu; + MarksImgList := TImageList.Create(AOwner); //load 10 bookmark images @@ -1600,7 +1600,7 @@ begin CodeCompletionTimer.Interval := 500; - Writeln('TSOurceNotebook create exiting'); + Writeln('TSourceNotebook create exiting'); end; destructor TSourceNotebook.Destroy; @@ -2230,6 +2230,13 @@ Begin Result := (not assigned(Notebook)) or (Notebook.Pages.Count = 0); end; +function TSourceNotebook.SomethingModified: boolean; +var i: integer; +begin + Result:=false; + for i:=0 to EditorCount-1 do Result:=Result or Editors[i].Modified; +end; + Procedure TSourceNotebook.NextEditor; Begin if Notebook.PageIndex < Notebook.Pages.Count-1 then @@ -2681,53 +2688,57 @@ end; Constructor TfrmGoto.Create(AOWner : TComponent); begin - inherited; - position := poScreenCenter; - Width := 250; - Height := 100; - Caption := 'Goto'; + inherited Create(AOwner); - Label1 := TLabel.Create(self); - with Label1 do + if LazarusResources.Find(ClassName)=nil then begin + position := poScreenCenter; + Width := 250; + Height := 100; + Caption := 'Goto'; + + Label1 := TLabel.Create(self); + with Label1 do Begin - Parent := self; - Top := 10; - Left := 5; - Caption := 'Goto line :'; - Visible := True; + Parent := self; + Top := 10; + Left := 5; + Caption := 'Goto line :'; + Visible := True; end; - Edit1 := TEdit.Create(self); - with Edit1 do - Begin + Edit1 := TEdit.Create(self); + with Edit1 do + Begin Parent := self; Top := 30; Width := self.width-40; Left := 5; Visible := True; Caption := ''; - end; + end; - btnOK := TBitbtn.Create(self); - with btnOK do - Begin + btnOK := TBitbtn.Create(self); + with btnOK do + Begin Parent := self; Top := 70; Left := 40; + kind := bkOK; Visible := True; - kind := bkOK - end; + end; - btnCancel := TBitbtn.Create(self); - with btnCancel do - Begin + btnCancel := TBitbtn.Create(self); + with btnCancel do + Begin Parent := self; Top := 70; Left := 120; + kind := bkCancel; Visible := True; - kind := bkCancel - end; - OnActivate := @GotoDialogActivate; + end; + + OnActivate := @GotoDialogActivate; + end; end; Procedure TfrmGoto.GotoDialogActivate(sender : TObject); diff --git a/lcl/controls.pp b/lcl/controls.pp index 0f4a34ba94..8b7682f575 100644 --- a/lcl/controls.pp +++ b/lcl/controls.pp @@ -1129,8 +1129,8 @@ end. { ============================================================================= $Log$ - Revision 1.15 2001/03/13 15:02:12 lazarus - MG: activated GetWindowOrgEx + Revision 1.16 2001/03/19 14:00:50 lazarus + MG: fixed many unreleased DC and GDIObj bugs Revision 1.14 2001/03/12 12:17:01 lazarus MG: fixed random function results diff --git a/lcl/graphics.pp b/lcl/graphics.pp index e95cae854a..ee1516217d 100644 --- a/lcl/graphics.pp +++ b/lcl/graphics.pp @@ -608,7 +608,7 @@ type procedure CreateHandle; override; public constructor Create(ABitMap : TBitmap); - destructor Destroy; //overriding causes a crash with flat speedbuttons + destructor Destroy; override; // overriding causes a crash with flat speedbuttons // TODO: replace this by property BitmapHandle; // MWE: Not needed //property Bitmap: TBitmap read FBitmap; @@ -645,6 +645,9 @@ end. { ============================================================================= $Log$ + Revision 1.7 2001/03/19 14:00:50 lazarus + MG: fixed many unreleased DC and GDIObj bugs + Revision 1.6 2001/03/05 14:20:04 lazarus added streaming to tgraphic, added tpicture diff --git a/lcl/include/bitbtn.inc b/lcl/include/bitbtn.inc index 0bde529cea..9ffe27824a 100644 --- a/lcl/include/bitbtn.inc +++ b/lcl/include/bitbtn.inc @@ -3,7 +3,6 @@ {------------------------------------------------------------------------------} constructor TBitBtn.Create(AOwner: TComponent); begin - Inherited Create(AOwner); FCompStyle := csBitBtn; FGlyph := TButtonGlyph.Create; @@ -21,7 +20,8 @@ end; {------------------------------------------------------------------------------} destructor TBitbtn.Destroy; Begin -inherited Destroy; + FGlyph.Free; + inherited Destroy; end; diff --git a/lcl/include/bitmap.inc b/lcl/include/bitmap.inc index 6e035a36bf..595c43dc35 100644 --- a/lcl/include/bitmap.inc +++ b/lcl/include/bitmap.inc @@ -244,7 +244,13 @@ end; procedure TBitmap.SetHandle(Value: HBITMAP); begin // TODO: the properties from new bitmap - FImage.FHandle := Value; + with FImage do + if FHandle <> Value then + begin + FreeContext; + FHandle:=Value; + Changed(Self); + end; end; procedure TBitmap.SetMaskHandle(Value: HBITMAP); @@ -311,6 +317,9 @@ end; { ============================================================================= $Log$ + Revision 1.5 2001/03/19 14:00:50 lazarus + MG: fixed many unreleased DC and GDIObj bugs + Revision 1.4 2001/03/12 09:40:44 lazarus MG: bugfix for readstream diff --git a/lcl/include/bitmapcanvas.inc b/lcl/include/bitmapcanvas.inc index 6a5c11936b..79778d8276 100644 --- a/lcl/include/bitmapcanvas.inc +++ b/lcl/include/bitmapcanvas.inc @@ -23,29 +23,29 @@ end; ------------------------------------------------------------------------------} procedure TBitMapCanvas.CreateHandle; var - hDC: HDC; + DC: HDC; begin if FBitmap <> nil then begin FBitmap.HandleNeeded; FreeDC; FBitmap.PaletteNeeded; - hDC := CreateCompatibleDC(0); + DC := CreateCompatibleDC(0); Assert(False, Format('trace:[TBitmapCanvas.CreateHandle] Got Handle 0x%x', [FBitmap.Handle])); if FBitmap.Handle = 0 then FOldBitmap := 0 - else FOldBitmap := SelectObject(hDC, FBitmap.Handle); + else FOldBitmap := SelectObject(DC, FBitmap.Handle); if FBitmap.FPalette = 0 then FOldPalette := 0 else begin - FOldPalette := SelectPalette(hDC, FBitmap.FPalette, True); - RealizePalette(hDC); + FOldPalette := SelectPalette(DC, FBitmap.FPalette, True); + RealizePalette(DC); end; - Handle := hDC; + Handle := DC; end; end; @@ -64,7 +64,7 @@ end; {------------------------------------------------------------------------------ - Method: TControlCanvas.FreeContext + Method: TControlCanvas.FreeDC Params: None Returns: Nothing @@ -87,6 +87,9 @@ end; { ============================================================================= $Log$ + Revision 1.3 2001/03/19 14:00:50 lazarus + MG: fixed many unreleased DC and GDIObj bugs + Revision 1.2 2000/09/10 23:08:30 lazarus MWE: + Added CreateCompatibeleBitamp function diff --git a/lcl/include/buttonglyph.inc b/lcl/include/buttonglyph.inc index 9cb68ee568..8b64dd5f18 100644 --- a/lcl/include/buttonglyph.inc +++ b/lcl/include/buttonglyph.inc @@ -3,7 +3,6 @@ {------------------------------------------------------------------------------} constructor TButtonGlyph.Create; begin - // Inherited Create; FOriginal := TBitmap.Create; end; @@ -13,10 +12,8 @@ end; {------------------------------------------------------------------------------} destructor TButtonGlyph.Destroy; Begin -FOriginal.Free; - -inherited Destroy; - + FOriginal.Free; + inherited Destroy; end; {------------------------------------------------------------------------------} @@ -24,10 +21,11 @@ end; {------------------------------------------------------------------------------} Procedure TButtonGlyph.SetGlyph(Value : TBitmap); Begin -if FOriginal = Value then exit; -//Invalidate; -FOriginal := Value; -//FOriginal.Assign(Value); + if FOriginal = Value then exit; + //Invalidate; + FOriginal.Free; + FOriginal := Value; + //FOriginal.Assign(Value); end; {------------------------------------------------------------------------------} @@ -76,3 +74,4 @@ Begin end; end; + diff --git a/lcl/include/canvas.inc b/lcl/include/canvas.inc index 3d8dc8fbf2..740aadb47d 100644 --- a/lcl/include/canvas.inc +++ b/lcl/include/canvas.inc @@ -8,7 +8,8 @@ const {-----------------------------------------------} {-- TCanvas.BrushCopy --} {-----------------------------------------------} -Procedure TCanvas.BrushCopy(Dest : TRect; InternalImages: TBitmap; Src : TRect; TransparentColor :TColor); +Procedure TCanvas.BrushCopy(Dest : TRect; InternalImages: TBitmap; Src : TRect; + TransparentColor :TColor); Begin //TODO:TCANVAS.BRUSHCOPY end; @@ -42,9 +43,7 @@ var SH, SW, DH, DW: Integer; Begin //this SHOULD stretch the image to the new canvas, but it doesn't yet..... - Assert(False, Format('Trace:==> [TCanvas.CopyRect] ', [])); - if Canvas <> nil then begin Canvas.RequiredState([csHandleValid, csBrushValid]); @@ -98,8 +97,10 @@ end; ------------------------------------------------------------------------------} procedure TCanvas.CreateBrush; +var OldHandle: HBRUSH; begin - SelectObject(FHandle, Brush.Handle); + OldHandle:=SelectObject(FHandle, Brush.Handle); + if OldHandle<>Brush.Handle then LCLLinux.DeleteObject(OldHandle); // SetBkColor(FHandle, not ColorToRGB(Brush.Color)); // SetBkMode(FHandle, TRANSPARENT); end; @@ -111,8 +112,10 @@ end; ------------------------------------------------------------------------------} procedure TCanvas.CreatePen; +var OldHandle: HPEN; begin - SelectObject(FHandle, Pen.Handle); + OldHandle:=SelectObject(FHandle, Pen.Handle); + if OldHandle<>Pen.Handle then LCLLinux.DeleteObject(OldHandle); // SetROP2(FHandle, PenModes[Pen.Mode]); end; @@ -123,8 +126,10 @@ end; ------------------------------------------------------------------------------} procedure TCanvas.CreateFont; +var OldHandle: HPEN; begin - SelectObject(FHandle, Font.Handle); + OldHandle:=SelectObject(FHandle, Font.Handle); + if OldHandle<>Font.Handle then LCLLinux.DeleteObject(OldHandle); SetTextColor(FHandle, ColorToRGB(Font.Color)); end; @@ -148,9 +153,9 @@ end; ------------------------------------------------------------------------------} procedure TCanvas.SetAutoReDraw(Value : Boolean); begin - FAutoRedraw := Value; - If FAutoReDraw then - CNSendMessage(LM_REDraw, Self, nil); + FAutoRedraw := Value; + If FAutoReDraw then + CNSendMessage(LM_ReDraw, Self, nil); end; {------------------------------------------------------------------------------ @@ -521,6 +526,9 @@ end; { ============================================================================= $Log$ + Revision 1.4 2001/03/19 14:00:50 lazarus + MG: fixed many unreleased DC and GDIObj bugs + Revision 1.3 2001/02/04 18:24:41 lazarus Code cleanup Shane diff --git a/lcl/include/control.inc b/lcl/include/control.inc index 1dab84feaa..fa77e7dd63 100644 --- a/lcl/include/control.inc +++ b/lcl/include/control.inc @@ -758,10 +758,9 @@ end; {------------------------------------------------------------------------------} procedure TControl.Notification( AComponent : TComponent; Operation : TOperation); begin - inherited Notification(AComponent, Operation); - if Operation = opRemove then - if AComponent = PopupMenu then PopupMenu := nil; - + inherited Notification(AComponent, Operation); + if Operation = opRemove then + if AComponent = PopupMenu then PopupMenu := nil; end; @@ -808,7 +807,7 @@ procedure TControl.InvalidateControl(IsVisible, IsOpaque : Boolean); var Rect : TRect; begin -Writeln('[INAVLIDATECONTROL]'); +//Writeln('[INVALIDATECONTROL]'); if (IsVisible or (csDesigning in ComponentState) and not (csNoDesignVisible in ControlStyle)) and (Parent <> nil) and (Parent.HandleAllocated) then Begin @@ -816,8 +815,7 @@ Writeln('[INAVLIDATECONTROL]'); // Rect := BoundsRect; // InvalidateRect(parent.handle,@Rect, True); end; -Writeln('[INAVLIDATECONTROL] Done'); - +//Writeln('[INVALIDATECONTROL] Done'); end; {------------------------------------------------------------------------------} @@ -1298,6 +1296,9 @@ end; { ============================================================================= $Log$ + Revision 1.16 2001/03/19 14:00:50 lazarus + MG: fixed many unreleased DC and GDIObj bugs + Revision 1.15 2001/02/20 16:53:27 lazarus Changes for wordcompletion and many other things from Mattias. Shane diff --git a/lcl/include/controlcanvas.inc b/lcl/include/controlcanvas.inc index 56e91de05c..bf38732367 100644 --- a/lcl/include/controlcanvas.inc +++ b/lcl/include/controlcanvas.inc @@ -55,7 +55,6 @@ end; ------------------------------------------------------------------------------} procedure TControlCanvas.CreateHandle; begin - if FControl = nil then inherited CreateHandle else begin @@ -67,7 +66,6 @@ begin end; Handle := FDeviceContext; end; - end; {------------------------------------------------------------------------------ @@ -90,6 +88,9 @@ end; { ============================================================================= $Log$ + Revision 1.2 2001/03/19 14:00:50 lazarus + MG: fixed many unreleased DC and GDIObj bugs + Revision 1.1 2000/07/13 10:28:25 michael + Initial import diff --git a/lcl/include/customform.inc b/lcl/include/customform.inc index 62ea2f9b75..236012d8e0 100644 --- a/lcl/include/customform.inc +++ b/lcl/include/customform.inc @@ -91,11 +91,10 @@ end; ------------------------------------------------------------------------------} Procedure TCustomForm.FocusControl(Control : TWinControl); Begin - Writeln('[FOCUSCONTROL]'); +// Writeln('[FOCUSCONTROL]'); FActiveControl := Control; LCLLinux.SetFocus(Control.Handle); - Writeln('[FOCUSCONTROL] DONE'); - +// Writeln('[FOCUSCONTROL] DONE'); End; @@ -104,9 +103,8 @@ End; ------------------------------------------------------------------------------} Procedure TCustomForm.Notification(AComponent : TComponent; Operation : TOperation); Begin -inherited Notification(AComponent,Operation); - -if FDesigner <> nil then FDesigner.Notification(AComponent,Operation); + inherited Notification(AComponent,Operation); + if FDesigner <> nil then FDesigner.Notification(AComponent,Operation); End; @@ -170,9 +168,9 @@ end; ------------------------------------------------------------------------------} Procedure TCustomForm.WMActivate(var Message : TLMActivate); Begin - Writeln('[TCUSTOMFORM.WMACtivate]'); -if Assigned(FOnActivate) then FOnActivate(Self); - Writeln('[TCUSTOMFORM.WMACtivate] Done'); +// Writeln('[TCUSTOMFORM.WMACtivate]'); + if Assigned(FOnActivate) then FOnActivate(Self); +// Writeln('[TCUSTOMFORM.WMACtivate] Done'); end; {------------------------------------------------------------------------------ @@ -205,17 +203,16 @@ end; ------------------------------------------------------------------------------} procedure TCustomForm.WMSize(var Message: TLMSize); Begin -Writeln('[TCUSTOMFORM].WMSIZE'); -Writeln(Format('Size is width=%d height= %d',[Message.Width,MEssage.height])); -Assert(False, 'Trace:WMSIZE in TCustomForm'); -if not (csDesigning in ComponentState) then +//Writeln('[TCUSTOMFORM].WMSIZE'); +//Writeln(Format('Size is width=%d height= %d',[Message.Width,MEssage.height])); + Assert(False, 'Trace:WMSIZE in TCustomForm'); + if not (csDesigning in ComponentState) then Case Message.SizeType of SIZENORMAL : FWindowState := wsNormal; SIZEICONIC : FWIndowState := wsMinimized; SIZEFULLSCREEN : FWindowstate := wsMaximized; end; -RequestAlign; - + RequestAlign; End; {------------------------------------------------------------------------------ @@ -353,7 +350,7 @@ end; {------------------------------------------------------------------------------} Procedure TCustomForm.SetDesigner(Value : TIDesigner); Begin -FDesigner := Value; + FDesigner := Value; end; {------------------------------------------------------------------------------} @@ -440,6 +437,7 @@ begin TOwnerDrawState(LongRec(itemState).Lo)); finally Handle := 0; +riteln('[TCustomForm.WndPRoc] 1'); RestoreDC(hDC, SaveIndex) end; finally @@ -472,6 +470,7 @@ begin Integer(itemWidth), Integer(itemHeight)); finally Handle := 0; +writeln('[TCustomForm.WndPRoc] 2'); RestoreDC(DC, SaveIndex); end; finally @@ -855,6 +854,9 @@ end; { ============================================================================= $Log$ + Revision 1.14 2001/03/19 14:00:50 lazarus + MG: fixed many unreleased DC and GDIObj bugs + Revision 1.13 2001/02/28 13:17:33 lazarus Added some debug code for the top,left reporting problem. Shane diff --git a/lcl/include/font.inc b/lcl/include/font.inc index e066a2d08d..c182e5a5d2 100644 --- a/lcl/include/font.inc +++ b/lcl/include/font.inc @@ -242,12 +242,11 @@ begin else lfPitchAndFamily := DEFAULT_PITCH; end; - + FFontData.Handle := CreateFontIndirect(LogFont); end; Result := FFontData.Handle; - end; {------------------------------------------------------------------------------ @@ -271,6 +270,9 @@ end; { ============================================================================= $Log$ + Revision 1.2 2001/03/19 14:00:50 lazarus + MG: fixed many unreleased DC and GDIObj bugs + Revision 1.1 2000/07/13 10:28:25 michael + Initial import diff --git a/lcl/include/imglist.inc b/lcl/include/imglist.inc index f0da7e0b77..bf50051e72 100644 --- a/lcl/include/imglist.inc +++ b/lcl/include/imglist.inc @@ -243,11 +243,13 @@ end; Destructor for the class. ------------------------------------------------------------------------------} destructor TCustomImageList.Destroy; +var i: integer; begin FBitmap.Free; FMaskBitmap.Free; FChangeLinkList.Free; - FImageList.Destroy; //shane + for i:=0 to FImageList.Count-1 do TObject(FImageList[i]).Free; + FImageList.Free; //shane inherited Destroy; end; @@ -808,6 +810,9 @@ end; { $Log$ + Revision 1.4 2001/03/19 14:00:50 lazarus + MG: fixed many unreleased DC and GDIObj bugs + Revision 1.3 2001/02/06 13:55:23 lazarus Changed the files from mode delphi to mode objfpc Shane diff --git a/lcl/include/menuitem.inc b/lcl/include/menuitem.inc index 2bbfb9a14b..67697071de 100644 --- a/lcl/include/menuitem.inc +++ b/lcl/include/menuitem.inc @@ -114,15 +114,17 @@ destructor TMenuItem.Destroy; var i : integer; begin - i := 0; if assigned (FItems) then begin - while i < FItems.Count do - begin - TMenuItem(FItems [i]).Free; - inc (i); + i := FItems.Count-1; + while i>=0 do begin + TMenuItem(FItems[i]).Free; + dec(i); end; end; FItems.Free; + FItems:=nil; + if FParent<>nil then + FParent.FItems.Remove(Self); inherited Destroy; end; @@ -405,6 +407,9 @@ end; { ============================================================================= $Log$ + Revision 1.7 2001/03/19 14:00:50 lazarus + MG: fixed many unreleased DC and GDIObj bugs + Revision 1.6 2001/02/21 22:55:26 lazarus small bugfixes + added TOIOptions @@ -452,6 +457,9 @@ end; $Log$ + Revision 1.7 2001/03/19 14:00:50 lazarus + MG: fixed many unreleased DC and GDIObj bugs + Revision 1.6 2001/02/21 22:55:26 lazarus small bugfixes + added TOIOptions diff --git a/lcl/include/pixmap.inc b/lcl/include/pixmap.inc index 293614a70a..17696c44fc 100644 --- a/lcl/include/pixmap.inc +++ b/lcl/include/pixmap.inc @@ -49,22 +49,22 @@ begin then Handle := CreatePixmapIndirect(Buf, -1) else Handle := CreatePixmapIndirect(Buf, ColorToRGB(FTransparentColor)); - //set width and height + //set width and height - try - t := S.Strings[2]; //this line contains the width and height - //remove the initial quote - delete(t,1,1); - Delete(t,pos(' ',t),length(t)); - Width := strtoint(t); + try + t := S.Strings[2]; //this line contains the width and height + //remove the initial quote + delete(t,1,1); + Delete(t,pos(' ',t),length(t)); + Width := strtoint(t); - t := S.Strings[2]; //this line contains the width and height - delete(t,1,1); - Delete(t,1,pos(' ',t)); - Delete(t,pos(' ',t),length(t)); - Height := strtoint(t); - except - end; + t := S.Strings[2]; //this line contains the width and height + delete(t,1,1); + Delete(t,1,pos(' ',t)); + Delete(t,pos(' ',t),length(t)); + Height := strtoint(t); + except + end; finally FreeMem(Buf); @@ -77,6 +77,9 @@ end; { ============================================================================= $Log$ + Revision 1.7 2001/03/19 14:00:51 lazarus + MG: fixed many unreleased DC and GDIObj bugs + Revision 1.6 2001/02/04 18:24:41 lazarus Code cleanup Shane diff --git a/lcl/include/speedbutton.inc b/lcl/include/speedbutton.inc index 4c3f602cb8..1b44e9ffc5 100644 --- a/lcl/include/speedbutton.inc +++ b/lcl/include/speedbutton.inc @@ -17,7 +17,6 @@ ------------------------------------------------------------------------------} constructor TSpeedbutton.Create(AOwner: TComponent); begin - Inherited Create(AOwner); FCompStyle := csSpeedButton; @@ -27,7 +26,6 @@ begin SetBounds(0, 0, 23, 22); ControlStyle := [csCaptureMouse, csDoubleClicks]; - {set default alignment} Align := alNone; FMouseInControl := False; @@ -275,7 +273,7 @@ begin end; InflateRect(PaintRect, -1, -1); end; - + if FState in [bsDown, bsExclusive] then begin if (FState = bsExclusive) @@ -298,7 +296,6 @@ begin Assert(False,'Trace:TODO: DRAWTEXTBIDIMODEFLAGS'); TButtonGlyph(FGlyph).Draw(Canvas, PaintRect, Offset, Caption, FLayout, FMargin, FSpacing, FState, Transparent, (0)); - end; {------------------------------------------------------------------------------ @@ -526,6 +523,9 @@ end; { ============================================================================= $Log$ + Revision 1.6 2001/03/19 14:00:51 lazarus + MG: fixed many unreleased DC and GDIObj bugs + Revision 1.5 2001/02/06 14:52:47 lazarus Changed TSpeedbutton in gtkobject so it erases itself when it's set to visible=false; Shane diff --git a/lcl/include/statusbar.inc b/lcl/include/statusbar.inc index 5803e41e25..ee107a941c 100644 --- a/lcl/include/statusbar.inc +++ b/lcl/include/statusbar.inc @@ -51,28 +51,31 @@ end; {------------------------------------------------------------------------------} destructor TStatusBar.Destroy; begin - FPanels.free; - inherited Destroy; + FPanels.Free; + FCanvas.Free; + inherited Destroy; end; Procedure TStatusBar.DrawBevel(xLeft, PanelNum : Integer ); Begin - Canvas.Brush.Color := color; - Canvas.FillRect(Rect(XLeft,Top,XLeft +Panels[PanelNum].Width,Top+Height)); +//writeln('[TStatusBar.DrawBevel] ',Canvas.Classname); + Canvas.Brush.Color := color; + Canvas.FillRect(Rect(XLeft,Top,XLeft +Panels[PanelNum].Width,Top+Height)); - if Panels[PanelNum].Bevel = pbRaised then - Begin - Canvas.Pen.Color := clWhite; - Canvas.Line(XLeft,Top,XLeft+Panels[PanelNum].Width-1,Top); - Canvas.Line(XLeft,Top,XLeft,Top+Height-1); - Canvas.Line(XLeft,Top+1,XLeft+Panels[PanelNum].Width-1,Top+1); - Canvas.Line(XLeft+1,Top,XLeft+1,Top+Height-1); - Canvas.Pen.Color := clBlack; - Canvas.Line(XLeft,Top+Height-5,XLeft+Panels[PanelNum].Width-1,Top+Height-5); - Canvas.Line(XLeft+Panels[PanelNum].Width-2,Top,XLeft+Panels[PanelNum].Width-2,Top+Height-1); - Canvas.Line(XLeft,Top+Height-6,XLeft+Panels[PanelNum].Width-1,Top+Height-6); - Canvas.Line(XLeft+Panels[PanelNum].Width-3,Top,XLeft+Panels[PanelNum].Width-3,Top+Height-2); - end + if (Panels[PanelNum].Bevel = pbRaised) then + with Canvas do begin + Pen.Width:=1; + Pen.Color := clWhite; + Line(XLeft,Top,XLeft+Panels[PanelNum].Width-1,Top); + Line(XLeft,Top,XLeft,Top+Height-1); + Line(XLeft,Top+1,XLeft+Panels[PanelNum].Width-1,Top+1); + Line(XLeft+1,Top,XLeft+1,Top+Height-1); + Pen.Color := clBlack; + Line(XLeft,Top+Height-5,XLeft+Panels[PanelNum].Width-1,Top+Height-5); + Line(XLeft+Panels[PanelNum].Width-2,Top,XLeft+Panels[PanelNum].Width-2,Top+Height-1); + Line(XLeft,Top+Height-6,XLeft+Panels[PanelNum].Width-1,Top+Height-6); + Line(XLeft+Panels[PanelNum].Width-3,Top,XLeft+Panels[PanelNum].Width-3,Top+Height-2); + end else if Panels[PanelNum].Bevel = pbLowered then Begin @@ -94,8 +97,8 @@ Begin Canvas.Line(XLeft,Top,XLeft+Panels[PanelNum].Width-1,Top); Canvas.Line(XLeft,Top,XLeft,Top+Height-1); Canvas.Line(XLeft,Top+Height-1,XLeft+Panels[PanelNum].Width-1,Top+Height-1); - Canvas.Line(XLeft+Panels[PanelNum].Width-1,Top,XLeft+Panels[PanelNum].Width-1,Top+Height-1);} - + Canvas.Line(XLeft+Panels[PanelNum].Width-1,Top,XLeft+Panels[PanelNum].Width-1,Top+Height-1); +} end @@ -144,5 +147,4 @@ Begin Begin Canvas.TextOut(Left+2,Top+2,SimpleText); end; - End; diff --git a/lcl/include/wincontrol.inc b/lcl/include/wincontrol.inc index 0bd589d698..bcfb4b3c0f 100644 --- a/lcl/include/wincontrol.inc +++ b/lcl/include/wincontrol.inc @@ -343,11 +343,10 @@ end; Procedure TWinControl.ReCreateWnd; Begin //send a message to inform the interface that we need to destroy and recreate this control -Writeln(Format('[TWinControl.RecreateWnd] %s ', [Classname])); -if FHandle <> 0 then + if FHandle <> 0 then Begin - CNSendMessage(LM_RECREATEWND,Self,Nil); - AttachSignals; + CNSendMessage(LM_RECREATEWND,Self,Nil); + AttachSignals; end; end; @@ -522,7 +521,7 @@ procedure TWinControl.PaintControls(DC: HDC; First: TControl); var I, Count, SaveIndex: Integer; FrameBrush: HBRUSH; - TempCOntrol : TCOntrol; + TempControl : TCOntrol; begin if FControls <> nil then begin @@ -535,7 +534,7 @@ begin Count := FControls.Count; while I < Count do begin - TempCOntrol := TControl(FControls.Items[I]); + TempControl := TControl(FControls.Items[I]); with (TempControl) do if (Visible or (csDesigning in ComponentState) and not (csNoDesignVisible in ControlStyle)) and @@ -727,7 +726,7 @@ procedure TWinControl.SetFocus; var Form : TCustomForm; begin - Writeln('[TWINCONTROL.SETFOCUS] ',Name,':',ClassName); +// Writeln('[TWINCONTROL.SETFOCUS] ',Name,':',ClassName); Form := GetParentForm(self); if Assigned(form) then Writeln('Form is assigned') else Writeln('Form is NOT assigned'); @@ -736,7 +735,7 @@ begin else if Visible and HandleAllocated then LCLLinux.SetFocus(Handle); - Writeln('[TWINCONTROL.SETFOCUS] done'); +// Writeln('[TWINCONTROL.SETFOCUS] done'); { if Visible and HandleAllocated then @@ -1241,7 +1240,7 @@ var n: Integer; Control: TControl; begin -writeln('[TWinControl.Destroy] ',Name,':',ClassName); +//writeln('[TWinControl.Destroy] 1 ',Name,':',ClassName); DestroyHandle; n := ControlCount; @@ -1259,6 +1258,7 @@ writeln('[TWinControl.Destroy] ',Name,':',ClassName); FBrush.Free; inherited Destroy; +//writeln('[TWinControl.Destroy] END ',Name,':',ClassName); end; {------------------------------------------------------------------------------ @@ -1329,7 +1329,7 @@ var PS : TPaintStruct; I : Integer; begin -//writeln('[TWinControl.WMPaint] ',Name,':',ClassName); +//writeln('[TWinControl.WMPaint] ',Name,':',ClassName,' ',HexStr(Msg.DC,8)); Assert(False, Format('Trace:> [TWinControl.WMPaint] %s Msg.DC: 0x%x', [ClassName, Msg.DC])); if (Msg.DC <> 0) then begin @@ -1363,6 +1363,7 @@ begin end; end; Assert(False, Format('Trace:< [TWinControl.WMPaint] %s', [ClassName])); +//writeln('[TWinControl.WMPaint] END ',Name,':',ClassName); end; {------------------------------------------------------------------------------ @@ -1407,8 +1408,8 @@ end; procedure TWinControl.WMMove(var Message: TLMMove); begin { Just sync the coordinates } -Writeln('[TWINCONTROL].WMMOVE'); -Writeln(Format('MOVE is LEft=%d Top= %d',[Message.XPos,MEssage.YPos])); +//Writeln('[TWINCONTROL].WMMOVE'); +//Writeln(Format('MOVE is LEft=%d Top= %d',[Message.XPos,MEssage.YPos])); FLeft := Message.XPos; FTop := Message.YPos; @@ -1936,8 +1937,8 @@ end; { ============================================================================= $Log$ - Revision 1.22 2001/03/13 15:02:13 lazarus - MG: activated GetWindowOrgEx + Revision 1.23 2001/03/19 14:00:51 lazarus + MG: fixed many unreleased DC and GDIObj bugs Revision 1.21 2001/03/12 12:17:02 lazarus MG: fixed random function results diff --git a/lcl/interfaces/gtk/gtkcallback.inc b/lcl/interfaces/gtk/gtkcallback.inc index b49f808da6..235a053495 100644 --- a/lcl/interfaces/gtk/gtkcallback.inc +++ b/lcl/interfaces/gtk/gtkcallback.inc @@ -348,7 +348,7 @@ begin end; Result := DeliverPostMessage(Data, Msg); - if ssLeft in ShiftState then WriteLN(Format('[GTKMotionNotify] widget: 0x%p', [widget])); + //if ssLeft in ShiftState then WriteLN(Format('[GTKMotionNotify] widget: 0x%p', [widget])); if (Pointer(MCaptureHandle) <> widget) and (MCaptureHandle <> 0) @@ -1091,8 +1091,8 @@ end; { ============================================================================= $Log$ - Revision 1.24 2001/03/13 15:02:13 lazarus - MG: activated GetWindowOrgEx + Revision 1.25 2001/03/19 14:00:51 lazarus + MG: fixed many unreleased DC and GDIObj bugs Revision 1.23 2001/02/28 13:17:34 lazarus Added some debug code for the top,left reporting problem. diff --git a/lcl/interfaces/gtk/gtkint.pp b/lcl/interfaces/gtk/gtkint.pp index 0c7444d1b2..6fcf4c1ec8 100644 --- a/lcl/interfaces/gtk/gtkint.pp +++ b/lcl/interfaces/gtk/gtkint.pp @@ -247,8 +247,8 @@ end. { ============================================================================= $Log$ - Revision 1.8 2001/03/15 14:40:09 lazarus - MG: added some mouse cursors + Revision 1.9 2001/03/19 14:00:51 lazarus + MG: fixed many unreleased DC and GDIObj bugs Revision 1.7 2001/02/20 16:53:27 lazarus Changes for wordcompletion and many other things from Mattias. diff --git a/lcl/interfaces/gtk/gtkobject.inc b/lcl/interfaces/gtk/gtkobject.inc index b36da1c8ef..70e818d62b 100644 --- a/lcl/interfaces/gtk/gtkobject.inc +++ b/lcl/interfaces/gtk/gtkobject.inc @@ -37,21 +37,43 @@ end; ------------------------------------------------------------------------------} destructor TgtkObject.Destroy; const - GDITYPENAME: array[TGDIType] of String = ('gdiBitmap', 'gdiBrush', 'gdiFont', 'gdiPen', 'gdiRegion'); + GDITYPENAME: array[TGDIType] of String = ('gdiBitmap', 'gdiBrush' + ,'gdiFont', 'gdiPen', 'gdiRegion'); var n: Integer; p: PMsg; GDITypeCount: array[TGDIType] of Integer; GDIType: TGDIType; begin - if (FDeviceContexts.Count > 0) - then begin - WriteLN(Format('[TgtkObject.Destroy] WARNING: There are %d unreleased DCs' ,[FDeviceContexts.Count])); + // tidy up the messages + n:=FMessageQueue.Count-1; + while (n>=0) do begin + p := PMsg(FMessageQueue.Items[n]); + if p^.Message=LM_PAINT then begin + //writeln('[TgtkObject.Destroy] freeing unused paint message ',HexStr(p^.WParam,8)); + ReleaseDC(0,P^.WParam); + FMessageQueue.Delete(n); + end; + dec(n); end; - if (FGDIObjects.Count > 0) - then begin - WriteLN(Format('[TgtkObject.Destroy] WARNING: There are %d unreleased GDIObjects, a detailed dump follows:' ,[FGDIObjects.Count])); + if (FDeviceContexts.Count > 0) or (FGDIObjects.Count > 0) + then begin + WriteLN(Format('[TgtkObject.Destroy] WARNING: There are %d unreleased DCs and %d unreleased GDIObjects' ,[FDeviceContexts.Count, FGDIObjects.Count])); + n:=0; + write('DCs: '); + while (n<7) and (n 0 - then WriteLN(Format('[TgtkObject.Destroy] %s: %d', [GDITYPENAME[GDIType], GDITypeCount[GDIType]])); + then WriteLN(Format('[TgtkObject.Destroy] %s: %d', + [GDITYPENAME[GDIType], GDITypeCount[GDIType]])); end end; if FMessageQueue.Count > 0 @@ -103,6 +126,10 @@ begin Delete(0); with Msg do SendMessage(hWND, Message, WParam, LParam); + case Msg.Message of + LM_PAINT: + ReleaseDC(0,Msg.WParam); + end; end; end; @@ -2592,8 +2619,6 @@ end; Creates an initial DC ------------------------------------------------------------------------------} function TgtkObject.NewDC: PDeviceContext; -var - n: Integer; begin Assert(False, Format('Trace:> [TgtkObject.NewDC]', [])); New(Result); @@ -2612,8 +2637,9 @@ begin gdk_color_black(gdk_colormap_get_system, @CurrentTextColor); gdk_color_white(gdk_colormap_get_system, @CurrentBackColor); end; - n := FDeviceContexts.Add(Result); - Assert(False, Format('Trace:< [TgtkObject.NewDC] FDeviceContexts[%d] --> 0x%p', [n, Result])); + FDeviceContexts.Add(Result); +//writeln('[TgtkObject.NewDC] ',HexStr(Cardinal(Result),8),' ',FDeviceContexts.Count); +// Assert(False, Format('Trace:< [TgtkObject.NewDC] FDeviceContexts[%d] --> 0x%p', [n, Result])); end; (* {------------------------------------------------------------------------------ @@ -2622,16 +2648,21 @@ end; Returns: nothing Frees an initial DC + It does not free the GDI objects. See ReleaseDC for a smarter function. ------------------------------------------------------------------------------} function TgtkObject.FreeDC(ADC: PDeviceContext); var n: Integer; begin +//writeln('[TgtkObject.FreeDC] ',HexStr(Cardinal(ADC),8)); Assert(False, Format('Trace:> [TgtkObject.FreeDC] DC:0x%p', [ADC])); if ADC <> nil then begin if ADC^.SavedContext <> nil - then FreeDC(ADC^.SavedContext); + then begin +writeln('[TgtkObject.FreeDC] WARNING: there is an unused saved context left!'); + FreeDC(ADC^.SavedContext); + end; Assert(ADC^.CurrentBitmap = nil, 'trace: [TgtkObject.FreeDC] CurrentBitmap <> nil'); Assert(ADC^.CurrentFont = nil, 'trace: [TgtkObject.FreeDC] CurrentFont <> nil'); @@ -2663,6 +2694,7 @@ begin FillChar(Result^, SizeOf(TGDIObject), 0); Result^.GDIType := GDIType; n := FGDIObjects.Add(Result); +//writeln('[TgtkObject.NewGDIObject] ',HexStr(Cardinal(Result),8),' ',FGDIObjects.Count); Assert(False, Format('Trace:< [TgtkObject.NewGDIObject] FGDIObjects[%d] --> 0x%p', [n, Result])); end; @@ -2716,12 +2748,8 @@ end; { ============================================================================= $Log$ - Revision 1.33 2001/03/17 17:30:02 lazarus - MWE: - + Added some detailed info on unreleased GDIObjects - - Revision 1.32 2001/03/15 14:40:09 lazarus - MG: added some mouse cursors + Revision 1.34 2001/03/19 14:00:51 lazarus + MG: fixed many unreleased DC and GDIObj bugs Revision 1.31 2001/03/12 12:17:02 lazarus MG: fixed random function results diff --git a/lcl/interfaces/gtk/gtkproc.inc b/lcl/interfaces/gtk/gtkproc.inc index 887783e029..9c44dbd80e 100644 --- a/lcl/interfaces/gtk/gtkproc.inc +++ b/lcl/interfaces/gtk/gtkproc.inc @@ -85,7 +85,7 @@ begin CurrentBrush := SourceDC^.CurrentBrush; CurrentTextColor := SourceDC^.CurrentTextColor; CurrentBackColor := SourceDC^.CurrentBackColor; - SavedContext := SourceDC^.SavedContext; + SavedContext := nil; end; end; Assert(False, Format('Trace:< [CopyDCData] DestDC:0x%x, SourceDC:0x%x --> %d', [Integer(DestinationDC), Integer(SourceDC), Integer(Result)])); @@ -723,6 +723,9 @@ end; { ============================================================================= $Log$ + Revision 1.11 2001/03/19 14:00:51 lazarus + MG: fixed many unreleased DC and GDIObj bugs + Revision 1.10 2001/01/25 21:38:57 lazarus MWE: * fixed lil bug I commetted yesterday (listbox crash) diff --git a/lcl/interfaces/gtk/gtkwinapi.inc b/lcl/interfaces/gtk/gtkwinapi.inc index aedb98597b..c0d543086f 100644 --- a/lcl/interfaces/gtk/gtkwinapi.inc +++ b/lcl/interfaces/gtk/gtkwinapi.inc @@ -474,20 +474,19 @@ begin // dont copy // In a compatible DC you have to select a bitmap into it (* - if IsValidDC(DC) - then with PDeviceContext(DC)^ do - begin - pNewDC^.hWnd := hWnd; - pNewDC^.Drawable := Drawable; - pNewDC^.GC := gdk_gc_new(Drawable); - end + if IsValidDC(DC) then + with PDeviceContext(DC)^ do + begin + pNewDC^.hWnd := hWnd; + pNewDC^.Drawable := Drawable; + pNewDC^.GC := gdk_gc_new(Drawable); + end else begin // We can't do anything yet // Wait till a bitmap get selected end; *) - // Maybe copy these ?? pNewDC^.CurrentFont := CreateDefaultFont; pNewDC^.CurrentBrush := CreateDefaultBrush; pNewDC^.CurrentPen := CreateDefaultPen; @@ -524,7 +523,6 @@ var CharSetRegistry, CharSetCoding ]); - GDIObject := NewGDIObject(gdiFont); pStr := StrAlloc(Length(S) + 1); try StrPCopy(pStr, S); @@ -627,6 +625,7 @@ begin CharSetCoding := '*'; end; + GDIObject := NewGDIObject(gdiFont); LoadFont; if GdiObject^.GDIFontObject = nil then begin @@ -676,6 +675,8 @@ begin if GdiObject^.GDIFontObject = nil then begin +writeln('[TgtkObject.CreateFontIndirect] ',HexStr(Cardinal(GdiObject),8) +,' ',FGDIObjects.Count); FGDIObjects.Remove(GdiObject); Dispose(GdiObject); Result := 0; @@ -829,6 +830,7 @@ begin { Dispose of the GDI object } if PGDIObject(GDIObject) <> nil then begin +//writeln('[TgtkObject.DeleteObject] ',HexStr(GDIObject,8),' ',FGDIObjects.Count); FGDIObjects.Remove(PGDIObject(GDIObject)); Dispose(PGDIObject(GDIObject)); end; @@ -1364,8 +1366,7 @@ begin then begin if Values.Font <> nil then begin - New(GdiObject); - GdiObject^.GDIType := gdiFont; + GdiObject:=NewGDIObject(gdiFont); GdiObject^.GDIFontObject := Values.Font; gdk_font_ref(Values.Font); end @@ -2495,20 +2496,35 @@ end; ------------------------------------------------------------------------------} -function TgtkObject.ReleaseDC(hWnd: HWND; hDC: HDC): Integer; +function TgtkObject.ReleaseDC(hWnd: HWND; DC: HDC): Integer; var nIndex: Integer; - pDC: PDeviceContext; + pDC, pSavedDC: PDeviceContext; begin - Assert(False, Format('trace:> [TgtkObject.ReleaseDC] DC:0x%x', [hDC])); +//writeln('[TgtkObject.ReleaseDC] ',HexStr(DC,8),' ',FDeviceContexts.Count); + Assert(False, Format('trace:> [TgtkObject.ReleaseDC] DC:0x%x', [DC])); Result := 0; - if {(hWnd <> 0) and} (hDC <> 0) + if {(hWnd <> 0) and} (DC <> 0) then begin - nIndex := FDeviceContexts.IndexOf(Pointer(hDC)); + nIndex := FDeviceContexts.IndexOf(Pointer(DC)); if nIndex <> -1 then begin - pDC := PDeviceContext(hDC); + pDC := PDeviceContext(DC); + { Release all saved device contexts } + pSavedDC:=pDC^.SavedContext; + if pSavedDC<>nil then begin + if pSavedDC^.CurrentBitmap = pDC^.CurrentBitmap + then pDC^.CurrentBitmap := nil; + if pSavedDC^.CurrentFont = pDC^.CurrentFont + then pDC^.CurrentFont := nil; + if pSavedDC^.CurrentPen = pDC^.CurrentPen + then pDC^.CurrentPen := nil; + if pSavedDC^.CurrentBrush = pDC^.CurrentBrush + then pDC^.CurrentBrush := nil; + ReleaseDC(0,HDC(pSavedDC)); + pDC^.SavedContext:=nil; + end; { Release all graphic objects } DeleteObject(HGDIObj(pDC^.CurrentBrush)); DeleteObject(HGDIObj(pDC^.CurrentPen)); @@ -2516,7 +2532,8 @@ begin DeleteObject(HGDIObj(pDC^.CurrentBitmap)); try { On root window, we don't allocate a graphics context } - if pDC^.GC <> nil then gdk_gc_unref(pDC^.GC); + if pDC^.GC <> nil then + gdk_gc_unref(pDC^.GC); except on Exception do; //Nothing, just try to unref it //(it segfaults if the window doesnt exist anymore :-) @@ -2526,7 +2543,7 @@ begin Result := 1; end; end; - Assert(False, Format('trace:< [TgtkObject.ReleaseDC] FDeviceContexts[%d] DC:0x%x', [nIndex, hDC])); + Assert(False, Format('trace:< [TgtkObject.ReleaseDC] FDeviceContexts[%d] DC:0x%x', [nIndex, DC])); end; {------------------------------------------------------------------------------ @@ -2537,63 +2554,40 @@ end; -------------------------------------------------------------------------------} function TgtkObject.RestoreDC(DC: HDC; SavedDC: Integer): Boolean; - function CountSaved(pDC: PDeviceContext): Integer; - begin - Result := 0; - while pDC^.SavedContext <> nil do - begin - Inc(Result); - pDC := pDC^.SavedContext; - end; - end; - var - pDC, pSaved: PDeviceContext; - count: Integer; + pDC, pSavedDC: PDeviceContext; + Count: Integer; begin Assert(False, Format('Trace:> [TgtkObject.RestoreDC] DC:0x%x, SavedDC: %d', [DC, SavedDC])); Result := IsValidDC(DC) and (SavedDC <> 0); if Result then begin - pDC := PDeviceContext(DC); - Count := CountSaved(pDC); - Result := (Abs(SavedDC) <= Count); - - if SavedDC > 0 then Dec(SavedDc, Count + 1); // make relative - - while (SavedDC < 0) and (pDC <> nil) and Result do - begin - Assert(False, Format('Trace:< [TgtkObject.RestoreDC] Unwinding#: %d', [SavedDC])); - pSaved := pDC^.SavedContext; - Inc(SavedDC); - // TODO copy bitmap allso - - pDC^.SavedContext := pSaved^.SavedContext; - pSaved^.SavedContext := nil; - - Result := CopyDCData(pDC, pSaved); - - //prevent deleting of copied objects; - if pSaved^.CurrentBitmap = pDC^.CurrentBitmap - then pSaved^.CurrentBitmap := nil; - if pSaved^.CurrentFont = pDC^.CurrentFont - then pSaved^.CurrentFont := nil; - if pSaved^.CurrentPen = pDC^.CurrentPen - then pSaved^.CurrentPen := nil; - if pSaved^.CurrentBrush = pDC^.CurrentBrush - then pSaved^.CurrentBrush := nil; - - - DeleteDC(HGDIOBJ(pSaved)); - // fornow unref GC -(* - if OldDC^.GC <> nil - then begin - gdk_gc_unref(OldDC^.GC); - OldDC^.GC := nil; - end; -*) + pSavedDC := PDeviceContext(DC); + Count:=Abs(SavedDC); + while (Count>0) and (pSavedDC<>nil) do begin + pDC:=pSavedDC; + pSavedDC:=pDC^.SavedContext; + dec(Count); end; + + // TODO copy bitmap also + + pDC^.SavedContext := pSavedDC^.SavedContext; + pSavedDC^.SavedContext := nil; + + Result := CopyDCData(pSavedDC, pDC); + + //prevent deleting of copied objects; + if pSavedDC^.CurrentBitmap = pDC^.CurrentBitmap + then pSavedDC^.CurrentBitmap := nil; + if pSavedDC^.CurrentFont = pDC^.CurrentFont + then pSavedDC^.CurrentFont := nil; + if pSavedDC^.CurrentPen = pDC^.CurrentPen + then pSavedDC^.CurrentPen := nil; + if pSavedDC^.CurrentBrush = pDC^.CurrentBrush + then pSavedDC^.CurrentBrush := nil; + + DeleteDC(HGDIOBJ(pSavedDC)); end; Assert(False, Format('Trace:< [TgtkObject.RestoreDC] DC:0x%x, Saved: %d --> %s', [Integer(DC), SavedDC, BOOL_TEXT[Result]])); end; @@ -2620,12 +2614,9 @@ begin pDC := PDeviceContext(DC); pSavedDC := NewDC; CopyDCData(pSavedDC, pDC); + pSavedDC^.SavedContext:=pDC^.SavedContext; pDC^.SavedContext:= pSavedDC; - // count saved DCs - repeat - Inc(Result); - pDC := pDC^.SavedContext; - until pDC^.SavedContext = nil; + Result:=1; end; Assert(False, Format('Trace:< [TgtkObject.SaveDC] 0x%x --> %d', [Integer(DC), Result])); @@ -2766,6 +2757,8 @@ begin end; end; end; +//writeln('[TgtkObject.SelectObject] GDI=',HexStr(Cardinal(GDIObj),8) +// ,' Old=',Hexstr(Cardinal(Result),8)); Assert(False, Format('trace:< [TgtkObject.SelectObject] DC: 0x%x --> 0x%x', [DC, Result])); end; @@ -3396,8 +3389,8 @@ end; { ============================================================================= $Log$ - Revision 1.23 2001/03/13 15:02:13 lazarus - MG: activated GetWindowOrgEx + Revision 1.24 2001/03/19 14:00:52 lazarus + MG: fixed many unreleased DC and GDIObj bugs Revision 1.22 2001/03/12 12:17:02 lazarus MG: fixed random function results