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

MG: replaced logo, increased version to 0.8.3a and some clientrectbugfix

Browse Source 
git-svn-id: trunk@1658 -
This commit is contained in:
lazarus 2002-05-06 08:50:37 +00:00
parent cb4486355e
commit 043bf0082a
7 changed files with 179 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
ide/mainbar.pas
View File

@ -43,7 +43,7 @@ uses
TypInfo, IDEOptionDefs, CodeToolsDefines, LocalsDlg, DebuggerDlg;
const
Version_String = '0.8.2 alpha';
Version_String = '0.8.3 alpha';
type
{

31
ide/splash.pp
View File

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

8
images/README
View File

@ -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 <lazarusdir>/images/codetoolsdefines
../../tools/lazres ../../codetoolsdefines.lrs *.xpm
7. splash.lrs
cd <lazarusdir>/
./tools/lazres splash.lrs images/splash_logo.xpm

9
lcl/comctrls.pp
View File

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

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

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

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

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

21
lcl/lresources.pp
View File

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