= Renamed gtkobject includes to gtkwidgetset (that's the name of the class anyway)

+ added gtk1widgetset to make it possible to move ifdefed implementations

git-svn-id: trunk@12885 -
This commit is contained in:
marc 2007-11-15 23:15:11 +00:00
parent bba6436cd7
commit 13910703cb
8 changed files with 192 additions and 42 deletions

6
.gitattributes vendored
View File

@ -2871,10 +2871,11 @@ lcl/interfaces/fpgui/interfaces.pp svneol=native#text/pascal
lcl/interfaces/gtk/dragicons.inc svneol=native#text/pascal
lcl/interfaces/gtk/gtk1extra.inc svneol=native#text/pascal
lcl/interfaces/gtk/gtk1extrah.inc svneol=native#text/pascal
lcl/interfaces/gtk/gtk1int.pp svneol=native#text/pascal
lcl/interfaces/gtk/gtk1memostrings.inc svneol=native#text/pascal
lcl/interfaces/gtk/gtk1memostringsh.inc svneol=native#text/pascal
lcl/interfaces/gtk/gtk1object.inc svneol=native#text/pascal
lcl/interfaces/gtk/gtk1trayicon.inc -text
lcl/interfaces/gtk/gtk1widgetset.inc svneol=native#text/pascal
lcl/interfaces/gtk/gtk1wsprivate.pp svneol=native#text/pascal
lcl/interfaces/gtk/gtkcallback.inc svneol=native#text/pascal
lcl/interfaces/gtk/gtkcomboboxcallback.inc svneol=native#text/pascal
@ -2900,6 +2901,7 @@ lcl/interfaces/gtk/gtkprivatewidget.inc svneol=native#text/plain
lcl/interfaces/gtk/gtkproc.inc svneol=native#text/pascal
lcl/interfaces/gtk/gtkproc.pp svneol=native#text/pascal
lcl/interfaces/gtk/gtkthemes.pas svneol=native#text/pascal
lcl/interfaces/gtk/gtkwidgetset.inc svneol=native#text/pascal
lcl/interfaces/gtk/gtkwinapi.inc svneol=native#text/pascal
lcl/interfaces/gtk/gtkwinapih.inc svneol=native#text/pascal
lcl/interfaces/gtk/gtkwinapiwindow.pp svneol=native#text/pascal
@ -2949,10 +2951,10 @@ lcl/interfaces/gtk2/gtk2interface.pas svneol=native#text/pascal
lcl/interfaces/gtk2/gtk2lclintf.inc svneol=native#text/pascal
lcl/interfaces/gtk2/gtk2lclintfh.inc svneol=native#text/pascal
lcl/interfaces/gtk2/gtk2memostrings.inc svneol=native#text/pascal
lcl/interfaces/gtk2/gtk2object.inc svneol=native#text/pascal
lcl/interfaces/gtk2/gtk2privatewidget.inc svneol=native#text/plain
lcl/interfaces/gtk2/gtk2themes.pas svneol=native#text/pascal
lcl/interfaces/gtk2/gtk2trayicon.inc -text
lcl/interfaces/gtk2/gtk2widgetset.inc svneol=native#text/pascal
lcl/interfaces/gtk2/gtk2winapi.inc svneol=native#text/pascal
lcl/interfaces/gtk2/gtk2winapih.inc svneol=native#text/pascal
lcl/interfaces/gtk2/gtk2windows.pas svneol=native#text/pascal

View File

@ -0,0 +1,121 @@
{
/***************************************************************************
GTK1INT.pp - GTKInterface Object
-------------------
Initial Revision : Thu November 15th CST 2007
***************************************************************************/
*****************************************************************************
* *
* This file is part of the Lazarus Component Library (LCL) *
* *
* See the file COPYING.modifiedLGPL, included in this distribution, *
* for details about the copyright. *
* *
* This program is distributed in the hope that it will be useful, *
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
* *
*****************************************************************************
}
unit Gtk1Int;
{$mode objfpc}{$H+}
interface
{$ifdef Trace}
{$ASSERTIONS ON}
{$endif}
{$I gtkdefines.inc}
uses
{$IFDEF UNIX}
// use unix units first,
// if not, TSize is taken from the unix unit instead of types.
ctypes, baseunix, unix,
{$ENDIF}
{$IFDEF TraceGdiCalls}
LineInfo,
{$ENDIF}
// rtl+fcl
Types, Classes, SysUtils, FPCAdds,
// interfacebase
InterfaceBase,
// gtk
glib, gdk, gtk, gdkpixbuf,
// Target OS specific
{$ifdef HasX}
x, xlib,
{$endif}
Math, // after gtk to get the correct Float type
// LCL
Translations, ExtDlgs, Dialogs, Controls, Forms, LCLStrConsts, LMessages,
LCLProc, LCLIntf, LCLType, DynHashArray, GraphType, GraphMath,
Graphics, Menus, Maps, Themes,
// widgetset
GtkInt,
GtkDebug,
GtkFontCache, gtkDef, GtkProc, gtkMsgQueue, GtkExtra, gtkWSPrivate, WSLCLClasses;
type
{ TGTKWidgetSet }
TGTK1WidgetSet = class(TGTKWidgetSet)
protected
public
procedure SetWidgetFont(const AWidget: PGtkWidget; const AFont: TFont); override;
end;
var
GTK1WidgetSet: TGTK1WidgetSet absolute GtkWidgetSet;
implementation
uses
////////////////////////////////////////////////////
// I M P O R T A N T
////////////////////////////////////////////////////
// To get as little as possible circles,
// uncomment only those units with implementation
////////////////////////////////////////////////////
// Gtk1WSActnList,
// Gtk1WSArrow,
// Gtk1WSButtons,
// Gtk1WSCalendar,
// Gtk1WSCheckLst,
// Gtk1WSCListBox,
// Gtk1WSComCtrls,
// Gtk1WSControls,
// Gtk1WSDbCtrls,
// Gtk1WSDBGrids,
// Gtk1WSDialogs,
// Gtk1WSDirSel,
// Gtk1WSEditBtn,
// Gtk1WSExtCtrls,
// Gtk1WSExtDlgs,
// Gtk1WSFileCtrl,
// Gtk1WSForms,
// Gtk1WSGrids,
// Gtk1WSImgList,
// Gtk1WSMaskEdit,
// Gtk1WSMenus,
// Gtk1WSPairSplitter,
// Gtk1WSSpin,
// Gtk1WSStdCtrls,
// Gtk1WSToolwin,
// Gtk1Themes,
////////////////////////////////////////////////////
GTKWinApiWindow;
{$include gtk1widgetset.inc}
end.

View File

@ -0,0 +1,54 @@
{%MainUnit gtk1int.pp}
{******************************************************************************
TGtkWidgetSet
******************************************************************************
*****************************************************************************
* *
* This file is part of the Lazarus Component Library (LCL) *
* *
* See the file COPYING.modifiedLGPL, included in this distribution, *
* for details about the copyright. *
* *
* This program is distributed in the hope that it will be useful, *
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
* *
*****************************************************************************
}
{$IFOPT C-}
// Uncomment for local trace
// {$C+}
// {$DEFINE ASSERT_IS_ON}
{$ENDIF}
{------------------------------------------------------------------------------
procedure SetWidgetFont
AWidget : PGtkWidget; const AFont: TFont
------------------------------------------------------------------------------}
procedure TGtk1WidgetSet.SetWidgetFont(const AWidget: PGtkWidget; const AFont: TFont);
var
WindowStyle: PGtkStyle;
FontGdiObject: PGdiObject;
begin
if GtkWidgetIsA(AWidget,GTKAPIWidget_GetType) then begin
// the GTKAPIWidget is self drawn, so no use to change the widget style.
exit;
end;
if (GTK_WIDGET_REALIZED(AWidget)) then begin
WindowStyle := gtk_style_copy(gtk_widget_get_style (AWidget));
end else begin
WindowStyle := gtk_style_copy(gtk_rc_get_style (AWidget));
end;
if (Windowstyle = nil) then begin
Windowstyle := gtk_style_new ;
end;
FontGdiObject:=PGdiObject(AFont.Handle);
windowstyle^.font:=pointer(FontGdiObject^.GdiFontObject);
gtk_widget_set_style(aWidget,windowStyle);
end;

View File

@ -235,7 +235,7 @@ type
SelWidget: PGtkWidget); virtual;
// misc
Function GetCaption(Sender : TObject) : String; virtual;
function GetCaption(Sender : TObject) : String; virtual;
procedure WordWrap(DC: HDC; AText: PChar; MaxWidthInPixel: integer;
var Lines: PPChar; var LineCount: integer);
@ -253,7 +253,7 @@ type
procedure SetWidgetColor(const AWidget : PGtkWidget;
const FGColor,BGColor : TColor;
const Mask : tGtkStateEnum);
procedure SetWidgetFont(const AWidget : PGtkWidget;const AFONT : tFont); virtual;
procedure SetWidgetFont(const AWidget : PGtkWidget;const AFONT : tFont); virtual; abstract;
procedure SetCallbackEx(const AMsg: LongInt; const AGTKObject: PGTKObject;
const ALCLObject: TObject; Direct: boolean); virtual;
procedure SetCallbackDirect(const AMsg: LongInt; const AGTKObject: PGTKObject;
@ -367,7 +367,7 @@ uses
{$I gtklistsl.inc}
{$I gtkfiledialogutils.inc}
{$I gtk1object.inc}
{$I gtkwidgetset.inc}
{$I gtkwinapi.inc}
{$I gtklclintf.inc}

View File

@ -170,6 +170,9 @@ end;
------------------------------------------------------------------------------}
constructor TGtkWidgetSet.Create;
begin
if ClassType = TGtkWidgetSet
then raise EInvalidOperation.Create('Cannot create the base gtkwidgetset, use gtk1 or gtk2 instead');
inherited Create;
// DCs, GDIObjects
@ -1093,37 +1096,6 @@ begin
{$ENDIF}
end;
procedure TGtkWidgetSet.SetWidgetFont(const AWidget : PGtkWidget;
const AFont: TFont);
{$IFDEF GTK1}
var
WindowStyle: PGtkStyle;
FontGdiObject: PGdiObject;
begin
if GtkWidgetIsA(AWidget,GTKAPIWidget_GetType) then begin
// the GTKAPIWidget is self drawn, so no use to change the widget style.
exit;
end;
if (GTK_WIDGET_REALIZED(AWidget)) then begin
WindowStyle := gtk_style_copy(gtk_widget_get_style (AWidget));
end else begin
WindowStyle := gtk_style_copy(gtk_rc_get_style (AWidget));
end;
if (Windowstyle = nil) then begin
Windowstyle := gtk_style_new ;
end;
FontGdiObject:=PGdiObject(AFont.Handle);
windowstyle^.font:=pointer(FontGdiObject^.GdiFontObject);
gtk_widget_set_style(aWidget,windowStyle);
{$ELSE}
begin
{$ENDIF}
end;
{------------------------------------------------------------------------------
procedure TGtkWidgetSet.SendPaintMessagesForInternalWidgets(
AWinControl: TWinControl);

View File

@ -37,12 +37,12 @@ uses
implementation
uses
GTKInt, Forms;
GTK1Int, Forms;
initialization
WidgetSet:= TGTKWidgetSet.Create;
WidgetSet := TGTK1WidgetSet.Create;
finalization
FreeWidgetSet;
end.
end.

View File

@ -64,7 +64,6 @@ type
procedure SetCallbackEx(const AMsg: LongInt; const AGTKObject: PGTKObject; const ALCLObject: TObject; Direct: boolean);override;
procedure SetSelectionMode(Sender: TObject; Widget: PGtkWidget;
MultiSelect, ExtendedSelect: boolean); override;
procedure SetWidgetFont(const AWidget : PGtkWidget;const AFONT : tFont); override;
procedure InitializeFileDialog(FileDialog: TFileDialog;
var SelWidget: PGtkWidget; Title: PChar); override;
@ -79,8 +78,10 @@ type
public
constructor Create;
destructor Destroy; override;
function LCLPlatform: TLCLPlatform; override;
procedure SetWidgetFont(const AWidget: PGtkWidget; const AFont: TFont); override;
function AppHandle: Thandle; override;
{$I gtk2winapih.inc}
@ -178,7 +179,7 @@ uses
////////////////////////////////////////////////////
gtkProc;
{$include gtk2object.inc}
{$include gtk2widgetset.inc}
{$include gtk2winapi.inc}
{$include gtk2lclintf.inc}