mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-28 18:40:52 +02:00
= 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:
parent
bba6436cd7
commit
13910703cb
6
.gitattributes
vendored
6
.gitattributes
vendored
@ -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
|
||||
|
121
lcl/interfaces/gtk/gtk1int.pp
Normal file
121
lcl/interfaces/gtk/gtk1int.pp
Normal 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.
|
||||
|
54
lcl/interfaces/gtk/gtk1widgetset.inc
Normal file
54
lcl/interfaces/gtk/gtk1widgetset.inc
Normal 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;
|
@ -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}
|
||||
|
||||
|
@ -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);
|
@ -37,12 +37,12 @@ uses
|
||||
implementation
|
||||
|
||||
uses
|
||||
GTKInt, Forms;
|
||||
GTK1Int, Forms;
|
||||
|
||||
initialization
|
||||
WidgetSet:= TGTKWidgetSet.Create;
|
||||
WidgetSet := TGTK1WidgetSet.Create;
|
||||
|
||||
finalization
|
||||
FreeWidgetSet;
|
||||
|
||||
end.
|
||||
end.
|
||||
|
@ -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}
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user