paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-04 19:19:42 +01:00
Code Issues Packages Projects Releases Wiki Activity

MG: fixed many unreleased DC and GDIObj bugs

Browse Source 
git-svn-id: trunk@228 -
This commit is contained in:
lazarus 2001-03-19 14:00:52 +00:00
parent 33a7107d2e
commit d8de02b1dc
36 changed files with 990 additions and 630 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
components/synedit/allunits.pp
View File

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

8
components/synedit/synedit.pp
View File

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

12
components/synedit/syneditkeycmds.pp
View File

@ -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;
//=============================================================================

35
components/synedit/syntextdrawer.pp
View File

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

8
designer/abstractformeditor.pp
View File

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

267
designer/controlselection.pp
View File

@ -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<x2-1 do begin
InvertPixel(i,y1);
InvertPixel(i,y2);
inc(i,2);
end;
i:=y1;
while i<y2 do begin
InvertPixel(x1,i);
InvertPixel(x2,i);
inc(i,2);
with FCustomForm.Canvas do begin
OldPenColor:=Brush.Color;
Pen.Color:=clBlack;
i:=x1+1;
while i<x2-1 do begin
InvertPixel(i,y1);
InvertPixel(i,y2);
inc(i,2);
end;
i:=y1;
while i<y2 do begin
InvertPixel(x1,i);
InvertPixel(x2,i);
inc(i,2);
end;
Pen.Color:=OldPenColor;
end;
end;
// DrawRubberband
begin
if DeleteOld then
with FRubberBandBounds do
DrawInvertFrameRect(Left,Top,Right,Bottom);
FRubberBandBounds:=ARect;
if (FCustomForm=nil) then exit;
GetWindowOrgEx(DC, DCOrigin);
FormOrigin:=FCustomForm.ClientOrigin;
Diff.X:=FormOrigin.X-DCOrigin.X;
Diff.Y:=FormOrigin.Y-DCOrigin.Y;
OldFormHandle:=FCustomForm.Canvas.Handle;
FCustomForm.Canvas.Handle:=DC;
with FRubberBandBounds do
DrawInvertFrameRect(Left,Top,Right,Bottom);
FCustomForm.Canvas.Handle:=OldFormHandle;
end;
procedure TControlSelection.SelectWithRubberBand(ACustomForm:TCustomForm);
procedure TControlSelection.SelectWithRubberBand(ACustomForm:TCustomForm;
ExclusiveOr:boolean);
var i:integer;
FormOrigin:TPoint;
function ControlInRubberBand(AControl:TControl):boolean;
var ALeft,ATop,ARight,ABottom:integer;
Origin:TPoint;
begin
Origin:=AControl.ClientOrigin;
ALeft:=Origin.X-FormOrigin.X;
ATop:=Origin.Y-FormOrigin.Y;
Origin:=GetFormRelativeControlTopLeft(AControl);
ALeft:=Origin.X;
ATop:=Origin.Y;
ARight:=ALeft+AControl.Width;
ABottom:=ATop+AControl.Height;
Result:=(ALeft<FRubberBandBounds.Right)
@ -641,16 +727,33 @@ var i:integer;
// SelectWithRubberBand
begin
FormOrigin:=ACustomForm.ClientOrigin;
Clear;
for i:=0 to ACustomForm.ControlCount-1 do
if ControlInRubberBand(ACustomForm.Controls[i]) then
Add(ACustomForm.Controls[i]);
if ControlInRubberBand(ACustomForm.Controls[i]) then begin
if IndexOf(ACustomForm.Controls[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 Right<Left then begin
i:=Left;
Left:=Right;
Right:=i;
end;
if Bottom<Top then begin
i:=Top;
Top:=Bottom;
Bottom:=i;
end;
end;
end;
end.

372
designer/designer.pp
View File

@ -46,13 +46,13 @@ type
FCustomForm: TCustomForm;
FFormEditor : TFormEditor;
FSourceEditor : TSourceEditor;
FActiveRubberband:boolean;
FOnGetSelectedComponentClass: TOnGetSelectedComponentClass;
FOnUnselectComponentClass: TNotifyEvent;
FOnSetDesigning: TOnSetDesigning;
FOnComponentListChanged: TNotifyEvent;
FOnPropertiesChanged: TNotifyEvent;
FOnAddComponent: TOnAddComponent;
FHasSized: boolean;
function GetIsControl: Boolean;
procedure SetIsControl(Value: Boolean);
@ -60,12 +60,12 @@ type
MouseDownControl : TObject;
MouseDownPos, MouseUpPos, LastMouseMovePos : TPoint;
function Paint(Sender: TControl; Message: TLMPaint):boolean;
function PaintControl(Sender: TControl; Message: TLMPaint):boolean;
function SizeControl(Sender: TControl; Message: TLMSize):boolean;
function MoveControl(Sender: TControl; Message: TLMMove):boolean;
Procedure MouseDownOnControl(Sender : TControl; Message : TLMMouse);
Procedure MouseMoveOnControl(Sender : TControl; var Message : TLMMouse);
Procedure MouseUpOnControl(Sender : TControl; Message:TLMMouse);
Procedure KeyDown(Sender : TControl; Message:TLMKEY);
Procedure KeyUP(Sender : TControl; Message:TLMKEY);
@ -75,12 +75,9 @@ type
public
ControlSelection : TControlSelection;
constructor Create(Customform : TCustomform);
constructor Create(Customform : TCustomform; AControlSelection: TControlSelection);
destructor Destroy; override;
procedure CreateNew(FileName : string);
procedure LoadFile(FileName: string);
function IsDesignMsg(Sender: TControl; var Message: TLMessage): Boolean; override;
procedure Modified; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
@ -123,26 +120,20 @@ const
var
GridPoints : TGridPoint;
constructor TDesigner.Create(CustomForm : TCustomForm);
constructor TDesigner.Create(CustomForm : TCustomForm;
AControlSelection: TControlSelection);
begin
inherited Create;
FCustomForm := CustomForm;
ControlSelection := TControlSelection.Create;
FActiveRubberband:=false;
ControlSelection:=AControlSelection;
FHasSized:=false;
end;
destructor TDesigner.Destroy;
Begin
ControlSelection.free;
Inherited;
end;
procedure TDesigner.CreateNew(FileName : string);
begin
end;
Procedure TDesigner.RemoveControl(Control : TComponent);
Begin
Writeln('[TDesigner.RemoveControl] ',Control.Name,':',Control.ClassName);
@ -157,8 +148,8 @@ end;
Procedure TDesigner.NudgeControl(Value1,Value2 : Integer);
Begin
Writeln('[TDesigner.NudgeControl]');
ControlSelection.MoveSelection(Value1,Value2);
Writeln('[TDesigner.NudgeControl]');
ControlSelection.MoveSelection(Value1,Value2);
end;
Procedure TDesigner.NudgeSize(Value1,Value2 : Integer);
@ -169,16 +160,13 @@ end;
procedure TDesigner.SelectOnlyThisComponent(AComponent:TComponent);
begin
Writeln('Control Added ',TControl(aComponent).name);
ControlSelection.BeginUpdate;
ControlSelection.Clear;
ControlSelection.Add(TControl(AComponent));
FFormEditor.ClearSelected;
// this will automatically inform the object inspector
FFormEditor.AddSelected(AComponent);
ControlSelection.EndUpdate;
end;
function TDesigner.Paint(Sender: TControl; Message: TLMPaint):boolean;
function TDesigner.PaintControl(Sender: TControl; Message: TLMPaint):boolean;
begin
Result:=true;
Sender.Dispatch(Message);
@ -187,37 +175,60 @@ begin
ControlSelection.DrawMarker(Sender,Message.DC);
end;
ControlSelection.DrawGrabbers(Message.DC);
if ControlSelection.RubberBandActive then
ControlSelection.DrawRubberBand(Message.DC);
end;
function TDesigner.SizeControl(Sender: TControl; Message: TLMSize):boolean;
begin
Result:=true;
Sender.Dispatch(Message);
if (ControlSelection.IsSelected(Sender)) then begin
//writeln('*** LM_Size ',Sender.Name,':',Sender.ClassName);
ControlSelection.AdjustSize;
if Assigned(FOnPropertiesChanged) then
FOnPropertiesChanged(Self);
end;
end;
function TDesigner.MoveControl(Sender: TControl; Message: TLMMove):boolean;
begin
Result:=true;
Sender.Dispatch(Message);
if (ControlSelection.IsSelected(Sender)) then begin
//writeln('*** LM_Move ',Sender.Name,':',Sender.ClassName);
ControlSelection.AdjustSize;
if Assigned(FOnPropertiesChanged) then
FOnPropertiesChanged(Self);
end;
end;
procedure TDesigner.MouseDownOnControl(Sender : TControl; Message : TLMMouse);
var i,
MouseX,MouseY,
CompIndex:integer;
FormOrigin,SenderOrigin:TPoint;
SenderOrigin:TPoint;
AControlSelection:TControlSelection;
SelectedCompClass: TRegisteredComponent;
Begin
FHasSized:=false;
if (MouseDownControl<>nil) 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));

13
designer/jitforms.pp
View File

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

94
ide/customformeditor.pp
View File

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

7
ide/lazarus.pp
View File

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

187
ide/main.pp
View File

@ -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.ActiveEditorIndexAtStart<SourceNoteBook.NoteBook.Pages.Count) then
SourceNoteBook.Notebook.PageIndex:=Project.ActiveEditorIndexAtStart;
writeln('TMainIDE.DoOpenProjectFile end');
// set all modified to false
for i:=0 to Project.UnitCount-1 do begin
Project.Units[i].Modified:=false;
end;
Project.Modified:=false;
writeln('TMainIDE.DoOpenProjectFile end ');
end;
function TMainIDE.DoBuildProject: TModalResult;
@ -2404,15 +2487,9 @@ begin
end;
function TMainIDE.SomethingOfProjectIsModified: boolean;
var i:integer;
begin
Result:=Project.Modified;
for i:=0 to Project.UnitCount-1 do begin
Result:=Result or Project.Units[i].Modified;
if Project.Units[i].Loaded then
Result:=Result or SourceNoteBook.FindSourceEditorWithPageIndex(
Project.Units[i].EditorIndex).Modified;
end;
Result:=(Project<>nil)
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

15
ide/project.pp
View File

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

18
ide/splash.pp
View File

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

71
ide/uniteditor.pp
View File

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

4
lcl/controls.pp
View File

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

5
lcl/graphics.pp
View File

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

4
lcl/include/bitbtn.inc
View File

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

11
lcl/include/bitmap.inc
View File

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

17
lcl/include/bitmapcanvas.inc
View File

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

17
lcl/include/buttonglyph.inc
View File

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

26
lcl/include/canvas.inc
View File

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

15
lcl/include/control.inc
View File

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

5
lcl/include/controlcanvas.inc
View File

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

34
lcl/include/customform.inc
View File

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

6
lcl/include/font.inc
View File

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

7
lcl/include/imglist.inc
View File

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

18
lcl/include/menuitem.inc
View File

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

31
lcl/include/pixmap.inc
View File

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

8
lcl/include/speedbutton.inc
View File

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

42
lcl/include/statusbar.inc
View File

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

29
lcl/include/wincontrol.inc
View File

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

6
lcl/interfaces/gtk/gtkcallback.inc
View File

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

4
lcl/interfaces/gtk/gtkint.pp
View File

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

66
lcl/interfaces/gtk/gtkobject.inc
View File

@ -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<FDeviceContexts.Count) do begin
write(' ',HexStr(Cardinal(FDeviceContexts[n]),8));
inc(n);
end;
writeln();
n:=0;
write('GDIOs:');
while (n<7) and (n<FGDIObjects.Count) do begin
write(' ',HexStr(Cardinal(FGDIObjects[n]),8));
inc(n);
end;
writeln();
for GDIType := Low(GDIType) to High(GDIType) do
GDITypeCount[GDIType] := 0;
for n := 0 to FGDIObjects.Count - 1 do
@ -59,7 +81,8 @@ begin
for GDIType := Low(GDIType) to High(GDIType) do
begin
if GDITypeCount[GDIType] > 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

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

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

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

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