paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-21 09:59:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

made gtklayout using window theme at start

Browse Source 
git-svn-id: trunk@4861 -
This commit is contained in:
mattias 2003-11-29 13:17:39 +00:00
parent 1900366602
commit 00d97112a7
6 changed files with 111 additions and 63 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -7578,10 +7578,10 @@ procedure TGTKObject.SelectGDKPenProps(DC: HDC);
procedure SetDashes(const Dashes: array of gint8);
begin
BeginGDKErrorTrap;
{$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
laz_gdk_gc_set_dashes(TDeviceContext(DC).GC,0,Pgint8(@Dashes[Low(Dashes)]),
High(Dashes)-Low(Dashes)+1);
EndGDKErrorTrap;
{$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
end;
begin
@ -7601,12 +7601,12 @@ begin
IsNullPen := GDIPenStyle = PS_NULL;
if (GDIPenStyle = PS_SOLID) or (GDIPenStyle = PS_INSIDEFRAME)
then begin
BeginGDKErrorTrap;
{$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
gdk_gc_set_line_attributes(GC, GDIPenWidth, GDK_LINE_SOLID, GDK_CAP_NOT_LAST, GDK_JOIN_MITER);
EndGDKErrorTrap;
{$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
end
else begin
BeginGDKErrorTrap;
{$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
gdk_gc_set_line_attributes(GC,GDIPenWidth,GDK_LINE_ON_OFF_DASH,GDK_CAP_NOT_LAST,GDK_JOIN_MITER);
case GDIPenStyle of
{$IfDef GTK2}
@ -7623,7 +7623,7 @@ begin
//This is DEADLY!!!
//PS_NULL: gdk_gc_set_dashes(GC, 0, [0,4], 2);
end;
EndGDKErrorTrap;
{$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
end;
end;
Include(TDeviceContext(DC).DCFlags,dcfPenSelected);
@ -8465,6 +8465,9 @@ end;
{ =============================================================================
$Log$
Revision 1.439 2003/11/29 13:17:38 mattias
made gtklayout using window theme at start
Revision 1.438 2003/11/28 11:25:49 mattias
added BitOrder for RawImages

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

@ -4470,8 +4470,8 @@ end;
Function CreateFormContents(AForm: TCustomForm;
var FormWidget: Pointer): Pointer;
var
ScrolledWidget,
ClientAreaWidget: Pointer;
ScrolledWidget, ClientAreaWidget: PGtkWidget;
WindowStyle: PGtkStyle;
begin
// Create the VBox. We need that to place controls outside
// the client area (like menu)
@ -4479,21 +4479,16 @@ begin
If FormWidget = nil then
FormWidget := Result;
// Create the form client area
if {$IFDEF PolymorphClientArea}(AForm=nil) or AForm.HasVisibleScrollbars
{$ELSE}true{$ENDIF}
then begin
ScrolledWidget := gtk_scrolled_window_new(nil,nil);
gtk_box_pack_end(Result, ScrolledWidget, True, True, 0);
gtk_widget_show(ScrolledWidget);
ClientAreaWidget := gtk_layout_new(nil, nil);
gtk_container_add(ScrolledWidget, ClientAreaWidget);
end else begin
ScrolledWidget:=nil;
ClientAreaWidget := gtk_fixed_new;
gtk_box_pack_end(Result, ClientAreaWidget, True, True, 0);
end;
// Create the form client area (a scrolled window with a gtklayout
// with the style of a window)
ScrolledWidget := gtk_scrolled_window_new(nil,nil);
gtk_box_pack_end(Result, ScrolledWidget, True, True, 0);
gtk_widget_show(ScrolledWidget);
ClientAreaWidget := gtk_layout_new(nil, nil);
WindowStyle:=GetStyle('window');
gtk_widget_set_style(ClientAreaWidget,WindowStyle);
gtk_container_add(PGtkContainer(ScrolledWidget), ClientAreaWidget);
gtk_object_set_data(FormWidget,odnScrollArea,ScrolledWidget);
gtk_widget_show(ClientAreaWidget);
@ -4621,7 +4616,7 @@ begin
NoName:=nil;
StyleObject^.Widget :=
// GTK2 does not allow to instantiate the abstract base Widget
// so we use the "invisible" widget, which should never be defined
// so we use the "invisible" widget, which should never be defined
// by the theme
GTK_WIDGET_NEW(
{$IFDEF Gtk2}GTK_TYPE_INVISIBLE{$ELSE}GTK_WIDGET_TYPE{$ENDIF},
@ -4671,6 +4666,14 @@ begin
If (StyleObject^.Widget <> nil) then begin
gtk_widget_ensure_style(StyleObject^.Widget);
StyleObject^.Style:=GTK_RC_GET_STYLE(StyleObject^.Widget);
// ToDo: find out, why sometimes the style is not initialized.
// for example: why the following occurs:
If AnsiCompareText(WName,'button')=0 then begin
if StyleObject^.Style^.light_gc[GTK_STATE_NORMAL]=nil then begin
//if not GtkWidgetIsA(StyleObject^.Widget,GTK_WINDOW_TYPE) then begin
//end;
end;
end;
end;
If StyleObject^.Style <> nil then
If AnsiCompareText(WName,'gtk_default')<>0 then
@ -4679,7 +4682,8 @@ begin
if StyleObject^.Style <> nil then begin
Styles.AddObject(WName, TObject(StyleObject));
Result:=StyleObject^.Style;
If StyleObject^.Widget <> nil then
If (StyleObject^.Widget <> nil)
and (AnsiCompareText(WName,'window')=0) then
UpdateSysColorMap(StyleObject^.Widget);
end
else begin
@ -4769,6 +4773,26 @@ begin
end;
{$EndIf}
procedure RealizeGDKColor(ColorMap: PGdkColormap; Color: PGDKColor);
var
AllocResult: gboolean;
begin
if ColorMap=nil then ColorMap:=gdk_colormap_get_system;
if (Color^.pixel = 0)
and ((Color^.red<>0) or (Color^.blue<>0) or (Color^.green<>0)) then
gdk_colormap_alloc_colors(ColorMap, Color, 1, false, true, @AllocResult)
else
gdk_colormap_query_color(ColorMap,Color^.pixel, Color);
end;
procedure RealizeGtkStyleColor(Style: PGTKStyle; Color: PGDKColor);
begin
if (Style<>nil) then
RealizeGDKColor(Style^.ColorMap,Color)
else
RealizeGDKColor(nil,Color);
end;
Function GetSysGCValues(Color: TColorRef;
ThemeWidget: PGtkWidget): TGDKGCValues;
// ThemeWidget can be nil
@ -4793,7 +4817,6 @@ var
SysColor: TColorRef;
BaseColor: TColorRef;
Red, Green, Blue: byte;
success: Boolean;
begin
BaseColor := Color and $FF;
@ -5042,23 +5065,8 @@ begin
end;
?????????????????}
end;
if (result.foreground.pixel = 0) and ((result.foreground.red <> 0) or
(result.foreground.blue <> 0) or (result.foreground.green <> 0)) then
begin
if (style <> nil) and (style^.colormap <> nil) then
gdk_colormap_alloc_colors(style^.colormap, @result.foreground, 1,
false, true, nil)
else
gdk_colormap_alloc_colors(gdk_colormap_get_system(),
@result.foreground, 1, false, true, @success);
end else
if (style <> nil) and (style^.colormap <> nil) then
gdk_colormap_query_color(style^.colormap,result.foreground.pixel,
@result.foreground)
else
gdk_colormap_query_color(gdk_colormap_get_system(),
result.foreground.pixel, @result.foreground);
RealizeGtkStyleColor(Style,@Result.foreground);
end;
Function StyleForegroundColor(Color: TColorRef;
@ -5139,10 +5147,7 @@ begin
Result := DefaultColor;
if (Result <> nil) and (Result <> DefaultColor) then
if (style^.colormap <> nil) then
gdk_colormap_query_color(style^.colormap,result^.pixel, result)
else
gdk_colormap_query_color(gdk_colormap_get_system(),result^.pixel, result)
RealizeGtkStyleColor(Style,Result);
end;
Procedure StyleFillRectangle(drawable : PGDKDrawable; GC : PGDKGC; Color : TColorRef; x, y, width, height : gint);
@ -5615,6 +5620,9 @@ end;
{ =============================================================================
$Log$
Revision 1.231 2003/11/29 13:17:38 mattias
made gtklayout using window theme at start
Revision 1.230 2003/11/26 21:30:19 mattias
reduced unit circles, fixed fpImage streaming

6
lcl/interfaces/gtk/gtkproc.pp
View File

@ -515,7 +515,9 @@ function LoadDefaultFontDesc: PPangoFontDescription;
function LoadDefaultFont: PGDKFont;
{$EndIf}
Function GetSysGCValues(Color: TColorRef; ThemeWidget: PGtkWidget) : TGDKGCValues;
procedure RealizeGDKColor(ColorMap: PGdkColormap; Color: PGDKColor);
procedure RealizeGtkStyleColor(Style: PGTKStyle; Color: PGDKColor);
Function GetSysGCValues(Color: TColorRef; ThemeWidget: PGtkWidget): TGDKGCValues;
{$Ifdef GTK1}
function FontIsDoubleByteCharsFont(TheFont: PGdkFont): boolean;
@ -532,7 +534,7 @@ Procedure FillScreenFonts(ScreenFonts : TStrings);
function GetGDKMouseCursor(Cursor: TCursor): PGdkCursor;
Procedure FreeGDKCursors;
// functions for easier GTK2<->GTK1 Compatibility/Consistancy ---->
// functions for easier GTK2<->GTK1 Compatibility/Consistency ---->
function gtk_widget_get_xthickness(Style : PGTKStyle) : gint; overload;
function gtk_widget_get_ythickness(Style : PGTKStyle) : gint; overload;

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

@ -5758,10 +5758,10 @@ begin
if (CurrentPen^.IsNullPen) then exit;
DCOrigin:=GetDCOffset(TDeviceContext(DC));
BeginGDKErrorTrap;
{$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
gdk_draw_line(Drawable, GC, PenPos.X+DCOrigin.X, PenPos.Y+DCOrigin.Y,
X+DCOrigin.X, Y+DCOrigin.Y);
EndGDKErrorTrap;
{$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
PenPos:= Point(X, Y);
end else
Result := False;
@ -9032,6 +9032,9 @@ end;
{ =============================================================================
$Log$
Revision 1.303 2003/11/29 13:17:38 mattias
made gtklayout using window theme at start
Revision 1.302 2003/11/24 11:03:07 marc
* Splitted winapi*.inc into a winapi and a lcl interface communication part

25
packager/packagesystem.pas
View File

@ -132,7 +132,8 @@ type
function FindAutoInstallDependencyPath(ChildPackage: TLazPackage): TList;
function FindAmbigiousUnits(APackage: TLazPackage;
FirstDependency: TPkgDependency;
var File1, File2: TPkgFile): boolean;
var File1, File2: TPkgFile;
var ConflictPkg: TLazPackage): boolean;
function FindFileInAllPackages(const TheFilename: string;
ResolveLinks, IgnoreDeleted: boolean): TPkgFile;
function FindLowestPkgNodeByName(const PkgName: string): TAVLTreeNode;
@ -1333,11 +1334,14 @@ begin
end;
function TLazPackageGraph.FindAmbigiousUnits(APackage: TLazPackage;
FirstDependency: TPkgDependency; var File1, File2: TPkgFile): boolean;
FirstDependency: TPkgDependency; var File1, File2: TPkgFile;
var ConflictPkg: TLazPackage): boolean;
// check if two connected packages have units with the same name
// Connected means here: a Package1 is directly required by a Package2
// or: a Package1 and a Package2 are directly required by a Package3
// returns true, if ambigious units found
// There can either be a conflict between two files (File1,File2)
// or between a file and a package (File1,ConflictPkg)
var
PackageTreeOfUnitTrees: TAVLTree; // tree of TPkgUnitsTree
@ -1377,10 +1381,19 @@ var
if Pkg1=Pkg2 then exit;
if (Pkg1.FileCount=0) or (Pkg2.FileCount=0) then exit;
UnitsTreeOfPkg2:=GetUnitsTreeOfPackage(Pkg2);
// check if a unit of Pkg2 has the same name as Pkg1
PkgFile2:=UnitsTreeOfPkg2.FindPkgFileWithUnitName(Pkg1.Name);
if PkgFile2<>nil then begin
File1:=PkgFile2;
ConflictPkg:=Pkg1;
Result:=true;
exit;
end;
for i:=0 to Pkg1.FileCount-1 do begin
PkgFile1:=Pkg1.Files[i];
if (PkgFile1.FileType in PkgFileUnitTypes)
and (PkgFile1.UnitName<>'') then begin
// check if a unit of Pkg1 exists in Pkg2
PkgFile2:=UnitsTreeOfPkg2.FindPkgFileWithUnitName(PkgFile1.UnitName);
if PkgFile2<>nil then begin
File1:=PkgFile1;
@ -1388,6 +1401,13 @@ var
Result:=true;
exit;
end;
// check if a unit of Pkg1 has the same name as Pkg2
if AnsiCompareText(PkgFile1.UnitName,Pkg2.Name)=0 then begin
File1:=PkgFile1;
ConflictPkg:=Pkg2;
Result:=true;
exit;
end;
end;
end;
end;
@ -1404,6 +1424,7 @@ begin
end;
File1:=nil;
File2:=nil;
ConflictPkg:=nil;
ConnectionsTree:=nil;
PkgList:=nil;
PackageTreeOfUnitTrees:=nil;

31
packager/pkgmanager.pas
View File

@ -741,6 +741,8 @@ var
PathList: TList;
Dependency: TPkgDependency;
PkgFile1,PkgFile2: TPkgFile;
ConflictPkg: TLazPackage;
s: String;
begin
{$IFDEF VerbosePkgCompile}
writeln('TPkgManager.CheckPackageGraphForCompilation A');
@ -792,17 +794,26 @@ begin
end;
// check for ambigious units
if PackageGraph.FindAmbigiousUnits(APackage,FirstDependency,PkgFile1,PkgFile2)
if PackageGraph.FindAmbigiousUnits(APackage,FirstDependency,
PkgFile1,PkgFile2,ConflictPkg)
then begin
Result:=MessageDlg('Ambigious units found',
'There are two units with the same name:'#13
+#13
+'1. "'+PkgFile1.Filename+'" from '+PkgFile1.LazPackage.IDAsString+#13
+'2. "'+PkgFile2.Filename+'" from '+PkgFile2.LazPackage.IDAsString+#13
+#13
+'Both packages are connected. This means, either one package uses '
+'the other, or they are both used by a third package.',
mtError,[mbCancel,mbAbort],0);
if PkgFile2<>nil then begin
s:='There are two units with the same name:'#13
+#13
+'1. "'+PkgFile1.Filename+'" from '+PkgFile1.LazPackage.IDAsString+#13
+'2. "'+PkgFile2.Filename+'" from '+PkgFile2.LazPackage.IDAsString+#13
+#13;
end else begin
s:='There is a unit with the same name as a package:'#13
+#13
+'1. "'+PkgFile1.Filename+'" from '+PkgFile1.LazPackage.IDAsString+#13
+'2. "'+ConflictPkg.IDAsString+#13
+#13;
end;
Result:=MessageDlg('Ambigious units found',s
+'Both packages are connected. This means, either one package uses '
+'the other, or they are both used by a third package.',
mtError,[mbCancel,mbAbort],0);
exit;
end;