diff --git a/ide/mainbar.pas b/ide/mainbar.pas index 158be07ba6..e6d965917c 100644 --- a/ide/mainbar.pas +++ b/ide/mainbar.pas @@ -43,7 +43,7 @@ uses TypInfo, IDEOptionDefs, CodeToolsDefines, LocalsDlg, DebuggerDlg; const - Version_String = '0.8.2 alpha'; + Version_String = '0.8.3 alpha'; type { diff --git a/ide/splash.pp b/ide/splash.pp index 4431cad9eb..618c0ac01e 100644 --- a/ide/splash.pp +++ b/ide/splash.pp @@ -25,14 +25,14 @@ unit Splash; interface uses - Classes, Controls, Forms, Buttons, SysUtils, StdCtrls, ExtCtrls, + Classes, Controls, Forms, Buttons, SysUtils, StdCtrls, ExtCtrls, LResources, LCLLinux{must be used before graphics}, Graphics; type TSplashForm = class(TForm) procedure ApplicationOnIdle(Sender: TObject; var Done: Boolean); private - FBitmap : TBitmap; + FPixmap : TPixmap; FTimer : TTimer; procedure HideFormTimer(Sender : TObject); protected @@ -314,13 +314,14 @@ constructor TSplashForm.Create(AOwner: TComponent); begin inherited Create(AOwner); Caption := 'Lazarus'; + Width := 429; + Height := 341; Position:= poScreenCenter; - Width := 240; - Height := 180; BorderStyle := bsToolWindow; - FBitmap := TBitmap.Create; - FBitmap.Handle := CreatePixmapIndirect(@SPLASH_IMAGE, ColorToRGB(clBtnFace)); + FPixmap := TPixmap.Create; + FPixmap.LoadFromLazarusResource('splash_logo'); + //FBitmap.Handle := CreatePixmapIndirect(@SPLASH_IMAGE, ColorToRGB(clBtnFace)); FTimer := TTimer.Create(self); with FTimer do @@ -335,8 +336,8 @@ end; destructor TSplashForm.Destroy; begin - FBitmap.Free; - FBitmap:=nil; + FPixmap.Free; + FPixmap:=nil; FTimer.Free; FTimer:=nil; if Application.OnIdle=@ApplicationOnIdle then @@ -352,8 +353,8 @@ begin //Release resources FTimer.Free; FTimer:=nil; - FBitmap.Free; - FBitmap:=nil; + FPixmap.Free; + FPixmap:=nil; end; end; @@ -370,9 +371,9 @@ end; procedure TSplashForm.Paint; begin inherited Paint; - if FBitmap <>nil + if FPixmap <>nil then Canvas.Copyrect(Bounds(0, 0, Width, Height) - ,FBitmap.Canvas, Rect(0,0, Width, Height)); + ,FPixmap.Canvas, Rect(0,0, Width, Height)); end; procedure TSplashForm.StartTimer; @@ -381,11 +382,17 @@ begin FTimer.Enabled := True; end; +initialization + {$I splash.lrs} + end. { ============================================================================= $Log$ + Revision 1.11 2002/05/06 08:50:34 lazarus + MG: replaced logo, increased version to 0.8.3a and some clientrectbugfix + Revision 1.10 2002/03/30 21:09:07 lazarus MG: hide splash screen on message diff --git a/images/README b/images/README index c32b5065fd..bbeec1c338 100644 --- a/images/README +++ b/images/README @@ -5,8 +5,10 @@ in xpm format. mainicon.lrs - This is the IDE program icon. laz_images.lrs - The icons for the speedbuttons (Open, Save, Run,...) components_images.lrs - Icons and pics for lcl components +bookmark.lrs - Icons for bookmarks editoroptions.lrs - Icons for editor options codetoolsdefines.lrs - Icons for CodeTools Defines Editor +splash.lrs - the lazarus logo at IDE start How to update the image resources: @@ -54,3 +56,9 @@ cd /images/codetoolsdefines ../../tools/lazres ../../codetoolsdefines.lrs *.xpm +7. splash.lrs + +cd / +./tools/lazres splash.lrs images/splash_logo.xpm + + diff --git a/lcl/comctrls.pp b/lcl/comctrls.pp index be66f8e95c..e9a502c8ca 100644 --- a/lcl/comctrls.pp +++ b/lcl/comctrls.pp @@ -30,6 +30,8 @@ unit ComCtrls; {$mode objfpc} {$H+} +{ $DEFINE ClientRectBugFix} + interface uses @@ -1501,8 +1503,12 @@ const ButtonStyles: array[TToolButtonStyle] of Word = (TBSTYLE_BUTTON, TBSTYLE_CHECK, TBSTYLE_DROPDOWN, TBSTYLE_SEP, TBSTYLE_SEP); + {$IFDEF ClientRectBugFix} + ScrollBarWidth=0; + {$ELSE} // workaround till clientwidth/height is working correctly with scrollbars ScrollBarWidth=19; + {$ENDIF} { Toolbar menu support } @@ -1549,6 +1555,9 @@ end. { ============================================================================= $Log$ + Revision 1.33 2002/05/06 08:50:36 lazarus + MG: replaced logo, increased version to 0.8.3a and some clientrectbugfix + Revision 1.32 2002/04/17 09:15:51 lazarus MG: fixes, e.g. method jumping to changed overloaded methods diff --git a/lcl/interfaces/gtk/gtkcallback.inc b/lcl/interfaces/gtk/gtkcallback.inc index 3ce92f5684..c7639fcd69 100644 --- a/lcl/interfaces/gtk/gtkcallback.inc +++ b/lcl/interfaces/gtk/gtkcallback.inc @@ -815,9 +815,44 @@ begin Result := DeliverMessage(Data, Mess) = 0; end; -function gtksize_allocateCB( widget: PGtkWidget; size :pGtkAllocation; +function gtksize_allocateCB(widget: PGtkWidget; size :pGtkAllocation; data: gPointer) : GBoolean; cdecl; -{ $DEFINE VerboseSizeMsg} + + {$IFDEF ClientRectBugFix} + procedure UpdateParentSizes(AParent: TWinControl); + var + OldLeft, OldTop, OldWidth, OldHeight: integer; + NewLeft, NewTop, NewWidth, NewHeight: integer; + ParentWidget: PGtkWidget; + begin + if AParent=nil then exit; + UpdateParentSizes(AParent.Parent); + if (not AParent.HandleAllocated) then exit; + + // update size + OldLeft:=AParent.Left; + OldTop:=AParent.Top; + OldWidth:=AParent.Width; + OldHeight:=AParent.Height; + + ParentWidget:=PGtkWidget(AParent.Handle); + NewLeft:=ParentWidget^.Allocation.x; + NewTop:=ParentWidget^.Allocation.y; + NewWidth:=ParentWidget^.Allocation.Width; + NewHeight:=ParentWidget^.Allocation.Height; + {$IFDEF VerboseSizeMsg} + writeln(' UpdateParentSizes ',AParent.Name,':',AParent.ClassName, + ' LCL=',OldLeft,',',OldTop,',',OldWidth,',',OldHeight, + ' GTK=',NewLeft,',',NewTop,',',NewWidth,',',NewHeight + ); + {$ENDIF} + + // update client rectangle + if AParent is TWinControl then + TWinControl(AParent).DoAdjustClientRectChange; + end; + {$ENDIF} + var PosMsg : TLMWindowPosChanged; SizeMsg: TLMSize; @@ -830,32 +865,48 @@ var {$ENDIF} // DummyW, DummyH, DummyD: integer; begin + Result:=false; + EventTrace('size-allocate', data); + with Size^ do Assert(False, Format('Trace:[gtksize_allocateCB] %s --> X: %d, Y: %d, Width: %d, Height: %d', [TObject(data).ClassName, X, Y, Width, Height])); + + if not (TObject(Data) is TControl) then begin + // owner is not TControl -> ignore + writeln('WARNING: gtksize_allocateCB: Data is not TControl. Data=', + HexStr(Cardinal(Data),8)); + exit; + end; + + {$IFDEF ClientRectBugFix} + { The gtk sends the size messages after the resizing. Therefore the parent + widget is already resized, but the parent resize message will be emitted + after all its childs. So, the gtk resizes in top-bottom order, just like the + LCL. But it sends size messages in bottom-top order, which results in + many resizes in the LCL. + The next lines repairs this, by updating the parents first + } + UpdateParentSizes(TControl(Data).Parent); + {$ENDIF} + + OldLeft:=TControl(Data).Left; + OldTop:=TControl(Data).Top; + OldWidth:=TControl(Data).Width; + OldHeight:=TControl(Data).Height; + {$IFDEF VerboseSizeMsg} + writeln('gtksize_allocateCB: ', + TControl(Data).Name,':',TControl(Data).ClassName, + ' widget=',HexStr(Cardinal(Widget),8), + ' fixwidget=',HexStr(Cardinal(GetFixedWidget(Widget)),8), + ' OldPos=',OldLeft,',',OldTop,',',OldWidth,',',OldHeight); + {$ENDIF} + PosMsg.msg := LM_WINDOWPOSCHANGED; //LM_SIZEALLOCATE; PosMsg.Result := -1; SizeMsg.Result := -1; MoveMsg.Result := -1; - - with Size^ do Assert(False, Format('Trace:[gtksize_allocateCB] %s --> X: %d, Y: %d, Width: %d, Height: %d', [TObject(data).ClassName, X, Y, Width, Height])); - - if (TObject(Data) is TControl) then begin - OldLeft:=TControl(Data).Left; - OldTop:=TControl(Data).Top; - OldWidth:=TControl(Data).Width; - OldHeight:=TControl(Data).Height; - {$IFDEF VerboseSizeMsg} - writeln('gtksize_allocateCB: ',TControl(Data).Name,':',TControl(Data).ClassName, - ' OldPos=',OldLeft,',',OldTop,',',OldWidth,',',OldHeight); - {$ENDIF} - end else begin - OldLeft:=0; - OldTop:=0; - OldWidth:=0; - OldHeight:=0; - end; - + New(PosMsg.WindowPos); try with PosMsg.WindowPos^ do @@ -954,12 +1005,42 @@ end;} end; end; - if (TObject(Data) is TWinControl) - and (not WidthHeightChanged) and (not TopLeftChanged) then begin + {$IFDEF ClientRectBugFix} + {$ELSE} + if not (TopLeftChanged or WidthHeightChanged) + and (TObject(Data) is TWinControl) then TWinControl(Data).DoAdjustClientRectChange; - end; + {$ENDIF} + end; +{$IFDEF ClientRectBugFix} +function gtksize_allocate_client(widget: PGtkWidget; size :pGtkAllocation; + data: gPointer) : GBoolean; cdecl; +begin + if (TObject(Data) is TControl) then begin + {$IFDEF VerboseSizeMsg} + writeln('gtksize_allocate_client: ', + TControl(Data).Name,':',TControl(Data).ClassName, + ' widget=',HexStr(Cardinal(Widget),8), + ' NewSize=',Size^.Width,',',Size^.Height, + ' Allocation=',widget^.Allocation.Width,',',Widget^.Allocation.Height, + ' Requisiton=',widget^.Requisition.Width,',',Widget^.Requisition.Height + ); + {$ENDIF} + end else begin + // owner is not TControl -> ignore + writeln('WARNING: gtksize_allocate_client: Data is not TControl. Data=', + HexStr(Cardinal(Data),8)); + exit; + end; + + if (TObject(Data) is TWinControl) then + TWinControl(Data).DoAdjustClientRectChange; + Result:=true; +end; +{$ENDIF} + function gtkswitchpage(widget: PGtkWidget; page: Pgtkwidget; pagenum : integer; data: gPointer) : GBoolean; cdecl; var @@ -1635,6 +1716,9 @@ end; { ============================================================================= $Log$ + Revision 1.71 2002/05/06 08:50:36 lazarus + MG: replaced logo, increased version to 0.8.3a and some clientrectbugfix + Revision 1.70 2002/04/27 15:35:51 lazarus MG: fixed window shrinking diff --git a/lcl/interfaces/gtk/gtkwinapi.inc b/lcl/interfaces/gtk/gtkwinapi.inc index e7d8c67837..734ee26283 100644 --- a/lcl/interfaces/gtk/gtkwinapi.inc +++ b/lcl/interfaces/gtk/gtkwinapi.inc @@ -1922,7 +1922,7 @@ end; Function TGTKObject.GetClientRect(handle : HWND; var ARect : TRect) : Boolean; var // requisition : TgtkRequisition; - Widget: PGtkWidget; + Widget, ClientWidget: PGtkWidget; begin result := False; if Handle = 0 then Exit; @@ -1930,8 +1930,12 @@ begin Try ARect.Left := 0; ARect.Top := 0; - Widget := GetFixedWidget(pgtkwidget(Handle)); - if (Widget = nil) then Widget := pgtkwidget(Handle); + ClientWidget := GetFixedWidget(pgtkwidget(Handle)); + if (ClientWidget <> nil) then begin + Widget := ClientWidget; + end else begin + Widget := pgtkwidget(Handle); + end; if (Widget <> nil) and (Widget^.Window<>nil) then begin gdk_window_get_size(Widget^.Window, @ARect.Right, @ARect.Bottom); //gtk_Widget_size_request(PgtkWidget(handle),@requisition); @@ -1941,6 +1945,15 @@ begin ARect.Bottom:=0; ARect.Right:=0; end; + {$IFDEF VerboseGetClientRect} + if ClientWidget<>nil then begin + writeln('GetClientRect Widget=',HexStr(Cardinal(handle),8), + ' Client=',HexStr(Cardinal(ClientWidget),8), + ' WindowSize=',ARect.Right,',',ARect.Bottom, + ' Allocation=',ClientWidget^.Allocation.Width,',',ClientWidget^.Allocation.Height + ); + end; + {$ENDIF} // Writeln('Width / Height = '+Inttostr(REct.Right)+'/'+Inttostr(Rect.Bottom)); except on E: Exception do begin @@ -4403,6 +4416,9 @@ end; { ============================================================================= $Log$ + Revision 1.66 2002/05/06 08:50:37 lazarus + MG: replaced logo, increased version to 0.8.3a and some clientrectbugfix + Revision 1.65 2002/04/22 13:07:45 lazarus MG: fixed AdjustClientRect of TGroupBox diff --git a/lcl/lresources.pp b/lcl/lresources.pp index 73c53f11e2..be7b2260c0 100644 --- a/lcl/lresources.pp +++ b/lcl/lresources.pp @@ -70,13 +70,22 @@ procedure BinaryToLazarusResourceCode(BinStream,ResStream:TStream; +#83#187#6#78#83 ); } -const LineEnd:ShortString=#10; - RightMargin:integer=79; -var s,Indent:ShortString; - p,x:integer; - c,h:char; - RangeString,NewRangeString:boolean; +const LineEnd:ShortString={$IFDEF win32}#13{$ENDIF}#10; +var s, Indent: ShortString; + p, x: integer; + c, h: char; + RangeString, NewRangeString: boolean; + RightMargin: integer; begin + // normally a resource should be split into lines with the right margin at 80, + // so that it looks like nice source. + // But fpc is not optimized for building a constant string out of thousands of + // lines. It needs huge amounts of memory and becomes very slow. Therefore for + // big files the right margin is set to 256. + RightMargin:=80; + p:=BinStream.Size-BinStream.Position; + if p>5000 then RightMargin:=256; + Indent:=''; s:=Indent+'LazarusResources.Add('''+ResourceName+''','''+ResourceType+''',' +LineEnd;