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

fixes for gtk2

Browse Source 
git-svn-id: trunk@4547 -
This commit is contained in:
mattias 2003-08-29 21:21:07 +00:00
parent 3d2037b1ac
commit 4804ddc2f9
9 changed files with 354 additions and 153 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -109,6 +109,7 @@ function gtkNoteBookCloseBtnClicked(Widget: PGtkWidget;
var APage: TPage;
begin
Result:=true; // handled = true
if Widget=nil then ;
if ComponentIsDestroyingHandle(TWinControl(Data)) then exit;
APage:=TPage(Data);
TCustomNoteBook(APage.Parent).DoCloseTabClicked(APage);
@ -200,6 +201,7 @@ var
MainWidget: PGtkWidget;
begin
Result := True;
if Data=nil then ;
EventTrace('realizeafter', nil);
HiddenLCLObject:=GetHiddenLCLObject(Widget);
@ -258,6 +260,7 @@ var
begin
Result := True;
EventTrace('show', data);
if Widget=nil then ;
FillChar(Mess,SizeOf(Mess),0);
Mess.Msg := LM_SHOWWINDOW;
Mess.Show := True;
@ -271,6 +274,7 @@ var
begin
Result := True;
EventTrace('hide', data);
if Widget=nil then ;
FillChar(Mess,SizeOf(Mess),0);
Mess.Msg := LM_SHOWWINDOW;
Mess.Show := False;
@ -307,7 +311,7 @@ begin
// the gtk always toggles the check flag
// -> restore 'checked' flag if needed
if (AMenuItem^.flag0 and bm_checkmenuitem_active <> 0) = LCLMenuItem.Checked then Exit;
if MenuItemChecked(AMenuItem) = LCLMenuItem.Checked then Exit;
if LCLMenuItem.AutoCheck then Exit;
// restore it
@ -412,6 +416,7 @@ var
{$ENDIF}
begin
EventTrace('activate after', data);
if (Widget=nil) or (Event=nil) then ;
{$IFDEF VerboseFocus}
write('gtkfrmactivateAfter Widget=',HexStr(Cardinal(Widget),8),' Event^.theIn=',Event^.theIn);
LCLObject:=TObject(data);
@ -454,6 +459,7 @@ var
{$ENDIF}
begin
EventTrace('deactivate after', data);
if (Widget=nil) or (Event=nil) then ;
{$IFDEF VerboseFocus}
write('gtkfrmdeactivate Widget=',HexStr(Cardinal(Widget),8),' ',Event^.theIn,
' GetFocus=',HexStr(Cardinal(Widget),8));
@ -470,6 +476,7 @@ end;
function GTKMap(Widget: PGTKWidget; Data: gPointer): GBoolean; cdecl;
begin
Result := True;
if (Widget=nil) then ;
EventTrace('map', data);
end;
@ -652,6 +659,7 @@ var
{$ENDIF}
begin
EventTrace('focus', data);
if (Widget=nil) or (Event=nil) then ;
{$IFDEF VerboseFocus}
write('GTKFocusCB Widget=',HexStr(Cardinal(Widget),8),' Event^.theIn=',Event^.theIn);
LCLObject:=TObject(data);
@ -695,6 +703,7 @@ var
{$ENDIF}
begin
EventTrace('focus', data);
if (Widget=nil) or (Event=nil) then ;
{$IFDEF VerboseFocus}
write('GTKFocusCBAfter Widget=',HexStr(Cardinal(Widget),8),' Event^.theIn=',Event^.theIn);
LCLObject:=TObject(data);
@ -742,6 +751,7 @@ var
{$ENDIF}
begin
EventTrace('killfocus', data);
if (Widget=nil) or (Event=nil) then ;
{$IFDEF VerboseFocus}
write('GTKillFocusCB Widget=',HexStr(Cardinal(Widget),8),' Event^.theIn=',Event^.theIn);
LCLObject:=TObject(data);
@ -784,6 +794,7 @@ var
CurFocusWidget: PGtkWidget;
{$ENDIF}
begin
if (Widget=nil) or (Event=nil) then ;
EventTrace('killfocus', data);
{$IFDEF VerboseFocus}
write('GTKillFocusCBAfter Widget=',HexStr(Cardinal(Widget),8),' Event^.theIn=',Event^.theIn);
@ -840,10 +851,12 @@ begin
if Info <> nil then Dispose(Info);
end;
function gtkdeleteCB( widget : PGtkWidget; event : PGdkEvent; data : gPointer) : GBoolean; cdecl;
function gtkdeleteCB( widget : PGtkWidget; event : PGdkEvent;
data : gPointer) : GBoolean; cdecl;
var Mess : TLMessage;
begin
FillChar(Mess,SizeOf(Mess),0);
if (Widget=nil) or (Event=nil) then ;
Mess.Msg:= LM_CLOSEQUERY;
{ Message results : True - do nothing, False - destroy or hide window }
Result:= DeliverMessage(Data, Mess) = 0;
@ -854,6 +867,7 @@ function gtkresizeCB( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
// Mess : TLMessage;
begin
Result := True;
if (Widget=nil) then ;
EventTrace('resize', data);
// Mess.msg := LM_RESIZE;
// TControl(data).WindowProc(TLMessage(Mess));
@ -866,6 +880,7 @@ var
Mess: TLMessage;
begin
Result := True;
if (Widget=nil) then ;
EventTrace('month changed', data);
FillChar(Mess,SizeOf(Mess),0);
Mess.Msg := LM_MONTHCHANGED;
@ -902,6 +917,7 @@ var
ShiftState: TShiftState;
MappedXY: TPoint;
begin
if (Widget=nil) then ;
MappedXY:=TranslateGdkPointToClientArea(Event^.Window,
Point(trunc(Event^.X),trunc(Event^.Y)),
PGtkWidget(AWinControl.Handle));
@ -939,6 +955,7 @@ end;
-------------------------------------------------------------------------------}
function ControlGetsMouseMoveBefore(AControl: TControl): boolean;
begin
if (AControl=nil) then ;
// currently there are no controls, that need after events.
Result:=true;
end;
@ -1172,6 +1189,7 @@ var
end;
begin
if (Widget=nil) then ;
EventXY:=Point(trunc(Event^.X),trunc(Event^.Y));
ShiftState := GTKEventState2ShiftState(Event^.State);
MappedXY:=TranslateGdkPointToClientArea(Event^.Window,EventXY,
@ -1358,6 +1376,7 @@ var
end;
begin
if (Widget=nil) then ;
MappedXY:=TranslateGdkPointToClientArea(Event^.Window,
Point(trunc(Event^.X),trunc(Event^.Y)),
PGtkWidget(AWinControl.Handle));
@ -1496,6 +1515,7 @@ var
startRow : gint;
endRow : gint;
begin
if (Data=nil) then ;
// only process the callback if there is event data. If there isn't any
// event data that means it was called due to a direct function call of the
// widget and not an actual mouse click on the widget.
@ -1536,7 +1556,7 @@ var
Fpointer : Pointer;
// colordialog
colorArray : array[0..2] of double;
colorsel : GTK_COLOR_SELECTION;
colorsel : PGtkColorSelection;
newColor : TGdkColor;
// fontdialog
FontName : String;
@ -1551,6 +1571,7 @@ var
Files: TStringList;
begin
Result := True;
if (Widget=nil) then ;
theDialog := TCommonDialog(data);
FPointer := Pointer(theDialog.Handle);
@ -1601,7 +1622,7 @@ begin
end
else if theDialog is TColorDialog then
begin
colorSel := GTK_COLOR_SELECTION((GTK_COLOR_SELECTION_DIALOG(FPointer))^.colorsel);
colorSel := PGtkColorSelection(PGtkColorSelectionDialog(FPointer)^.colorsel);
gtk_color_selection_get_color(colorsel, @colorArray[0]);
newColor.pixel := 0;
newColor.red := Trunc(colorArray[0] * $FFFF);
@ -1643,6 +1664,7 @@ var
theDialog : TCommonDialog;
begin
Result := True;
if (Widget=nil) then ;
theDialog := TCommonDialog(data);
if theDialog is TFileDialog then
begin
@ -1666,6 +1688,7 @@ var
theDialog : TCommonDialog;
begin
Result := True;
if (Widget=nil) then ;
theDialog := TCommonDialog(data);
if theDialog is TOpenDialog then begin
if TOpenDialog(theDialog).OnHelpClicked<>nil then
@ -1689,6 +1712,7 @@ var
ALogFont: TLogFont;
begin
Result := True;
if (Widget=nil) then ;
theDialog := TCommonDialog(data);
if (theDialog is TFontDialog)
and (fdApplyButton in TFontDialog(theDialog).Options)
@ -1720,6 +1744,7 @@ var
CanClose: boolean;
begin
Result := False; // true = do nothing, false = destroy or hide window
if (Data=nil) then ;
// data is not the commondialog. Get it manually.
theDialog := TCommonDialog(GetLCLObject(Widget));
if theDialog=nil then exit;
@ -1782,6 +1807,7 @@ function GTKDialogKeyUpDownCB(Widget: PGtkWidget; Event : pgdkeventkey;
begin
Result:=false;
if (Widget=nil) then ;
{$ifdef GTK2}
case Event^._Type of
{$else}
@ -1790,7 +1816,8 @@ begin
GDK_KEY_RELEASE, GDK_KEY_PRESS:
begin
if Event^.KeyVal=GDK_Escape then begin
if Event^.KeyVal={$ifdef GTK2}GDK_KEY_Escape{$else}GDK_Escape{$EndIf}
then begin
StoreCommonDialogSetup(TCommonDialog(data));
TCommonDialog(data).UserChoice:=mrCancel;
end;
@ -1811,6 +1838,7 @@ end;
-------------------------------------------------------------------------------}
function GTKDialogRealizeCB(Widget: PGtkWidget; Data: Pointer): GBoolean; cdecl;
begin
if (Data=nil) then ;
gdk_window_set_events(GetControlWindow(Widget),
gdk_window_get_events(GetControlWindow(Widget))
or GDK_KEY_RELEASE_MASK or GDK_KEY_PRESS_MASK);
@ -1830,6 +1858,7 @@ var
theDialog: TCommonDialog;
begin
Result:=false;
if (Data=nil) then ;
theDialog:=TCommonDialog(GetLCLObject(Widget));
if (theDialog is TOpenDialog) then begin
UpdateDetailView(TOpenDialog(theDialog));
@ -1849,6 +1878,7 @@ var
theDialog: TCommonDialog;
begin
Result:=false;
if (Data=nil) or (BEvent=nil) or (Column=0) or (Row=0) then ;
theDialog:=TCommonDialog(GetLCLObject(Widget));
if (theDialog is TOpenDialog) then begin
UpdateDetailView(TOpenDialog(theDialog));
@ -1874,7 +1904,7 @@ var
AFilterEntry:=gtk_object_get_data(PGtkObject(FilterWidget),
'LCLIsFilterMenuItem');
if (AFilterEntry<>nil) and (AFilterEntry^.Mask<>nil) then begin
gtk_file_selection_complete(GTK_FILE_SELECTION(theDialog.Handle),
gtk_file_selection_complete(PGtkFileSelection(theDialog.Handle),
AFilterEntry^.Mask);
UpdateDetailView(TOpenDialog(theDialog));
end;
@ -1885,6 +1915,7 @@ var
FilterMenu, ActiveFilterMenuItem: PGtkWidget;
begin
Result:=false;
if (Data=nil) then ;
theDialog:=TCommonDialog(GetLCLObject(Widget));
if (theDialog is TOpenDialog) then begin
// check if history activated
@ -1893,7 +1924,7 @@ begin
if (AHistoryEntry<>nil) and (AHistoryEntry^.Filename<>nil) then begin
// use has choosen a history file
// -> select it in the filedialog
gtk_file_selection_complete(GTK_FILE_SELECTION(theDialog.Handle),
gtk_file_selection_complete(PGtkFileSelection(theDialog.Handle),
AHistoryEntry^.Filename);
// restore filter
if DirectoryExists(AHistoryEntry^.Filename) then begin
@ -1921,6 +1952,7 @@ end;
function gtkDialogDestroyCB(widget: PGtkWidget; data: gPointer): GBoolean; cdecl;
begin
Result := True;
if (Widget=nil) then ;
TCommonDialog(data).UserChoice := mrAbort;
TCommonDialog(data).Close;
end;
@ -1930,6 +1962,7 @@ var
Mess : TLMessage;
begin
Result := True;
if (Widget=nil) then ;
EventTrace('pressed', data);
Mess.msg := LM_PRESSED;
Result := DeliverMessage(Data, Mess) = 0;
@ -1974,6 +2007,7 @@ var
Mess : TLMessage;
begin
Result := True;
if (Widget=nil) then ;
EventTrace('move-cursor', data);
Mess.msg := LM_MOVECURSOR;
DeliverMessage(Data, Mess);
@ -2020,6 +2054,7 @@ end;
function gtksize_allocate_client(widget: PGtkWidget; size :pGtkAllocation;
data: gPointer) : GBoolean; cdecl;
begin
if (Widget=nil) or (Size=nil) then ;
if (TObject(Data) is TWinControl) then begin
{$IFDEF VerboseSizeMsg}
writeln('gtksize_allocate_client: ',
@ -2049,6 +2084,7 @@ var
T : tagNMHDR;
begin
Result := True;
if (Widget=nil) or (Page=nil) then ;
EventTrace('switch-page', data);
UpdateNoteBookClientWidget(TObject(Data));
Mess.Msg := LM_NOTIFY;
@ -2091,6 +2127,7 @@ var
Mess : TLMEssage;
begin
Result := True;
if (Widget=nil) then ;
EventTrace('released', data);
Mess.msg := LM_RELEASED;
Result := DeliverMessage(Data, Mess) = 0;
@ -2128,6 +2165,7 @@ var
Mess : TLMessage;
begin
EventTrace('Delete Text', data);
if (StartPos=0) or (EndPos=0) or (Widget=nil) then ;
Mess.msg := LM_DELETETEXT;
Result:= DeliverMessage(Data, Mess) = 0;
end;
@ -2137,6 +2175,7 @@ var
Mess : TLMessage;
begin
EventTrace('Set Editable', data);
if (Widget=nil) then ;
Mess.msg := LM_SETEDITABLE;
Result:= DeliverMessage(Data, Mess) = 0;
end;
@ -2146,6 +2185,7 @@ var
Mess : TLMessage;
begin
EventTrace('Move Word', data);
if (Widget=nil) then ;
Mess.msg := LM_MOVEWORD;
Result:= DeliverMessage(Data, Mess) = 0;
end;
@ -2155,6 +2195,7 @@ var
Mess : TLMessage;
begin
EventTrace('Move Page', data);
if (Widget=nil) then ;
Mess.msg := LM_MOVEPAGE;
Result:= DeliverMessage(Data, Mess) = 0;
end;
@ -2164,6 +2205,7 @@ var
Mess : TLMessage;
begin
EventTrace('Move To Row!!', data);
if (Widget=nil) then ;
Mess.msg := LM_MOVETOROW;
Result:= DeliverMessage(Data, Mess) = 0;
end;
@ -2173,6 +2215,7 @@ var
Mess : TLMessage;
begin
EventTrace('MoveToColumn', data);
if (Widget=nil) then ;
Mess.msg := LM_MOVETOCOLUMN;
Result:= DeliverMessage(Data, Mess) = 0;
end;
@ -2182,6 +2225,7 @@ var
Mess : TLMessage;
begin
EventTrace('Kill Char', data);
if (Widget=nil) then ;
Mess.msg := LM_KILLCHAR;
Result:= DeliverMessage(Data, Mess) = 0;
end;
@ -2191,6 +2235,7 @@ var
Mess : TLMessage;
begin
EventTrace('Kill Word', data);
if (Widget=nil) then ;
Mess.msg := LM_KILLWORD;
Result:= DeliverMessage(Data, Mess) = 0;
end;
@ -2200,6 +2245,7 @@ var
Mess : TLMessage;
begin
EventTrace('Kill Line', data);
if (Widget=nil) then ;
Mess.msg := LM_KILLLINE;
Result:= DeliverMessage(Data, Mess) = 0;
end;
@ -2209,6 +2255,7 @@ var
Mess : TLMessage;
begin
EventTrace('Cut to clip', data);
if (Widget=nil) then ;
Mess.msg := LM_CUTTOCLIP;
Result:= DeliverMessage(Data, Mess) = 0;
end;
@ -2218,6 +2265,7 @@ var
Mess : TLMessage;
begin
EventTrace('Copy to Clip', data);
if (Widget=nil) then ;
Mess.msg := LM_COPYTOCLIP;
Result:= DeliverMessage(Data, Mess) = 0;
end;
@ -2227,6 +2275,7 @@ var
Mess : TLMessage;
begin
EventTrace('Paste from clip', data);
if (Widget=nil) then ;
Mess.msg := LM_PASTEFROMCLIP;
Result:= DeliverMessage(Data, Mess) = 0;
end;
@ -2236,6 +2285,7 @@ var
Mess : TLMessage;
begin
EventTrace('Value changed', data);
if (Widget=nil) then ;
Mess.msg := LM_CHANGED;
Result := DeliverMessage(Data, Mess) = 0;
end;
@ -2252,12 +2302,12 @@ end;
gtk_timeout_remove so we have to dispose data here & return 0
(s.a. KillTimer).
------------------------------------------------------------------------------}
function gtkTimerCB(Data: gPointer): gint; cdecl;
function gtkTimerCB(Data: gPointer): {$IFDEF Gtk2}gBoolean{$ELSE}gint{$ENDIF}; cdecl;
var
TimerInfo: PGtkITimerinfo;
begin
EventTrace ('TimerCB', nil);
Result := 0; // assume: timer will stop
Result := GdkFalse; // assume: timer will stop
TimerInfo:=PGtkITimerinfo(Data);
@ -2266,7 +2316,7 @@ begin
writeln('gtkTimerCB Timer was killed: TimerInfo=',HexStr(Cardinal(TimerInfo),8));
{$ENDIF}
// timer was killed
Result:=0; // stop timer
Result:=GdkFalse; // stop timer
end else begin
{$IFDEF VerboseTimer}
writeln('gtkTimerCB Timer Event: TimerInfo=',HexStr(Cardinal(TimerInfo),8));
@ -2275,20 +2325,20 @@ begin
then begin
// Call users timer function
TimerInfo^.TimerFunc;
Result:=1; // timer will go on
Result:=GdkTrue; // timer will go on
end
else begin
Result := 0; // stop timer
Result := GdkFalse; // stop timer
end;
end;
if (Result<>0) and (FTimerData.IndexOf(Data)<0) then begin
if (Result<>GdkFalse) and (FTimerData.IndexOf(Data)<0) then begin
// timer was killed
// -> stop timer
Result:=0;
Result:=GdkFalse;
end;
if Result=0 then begin
if Result=GdkFalse then begin
{$IFDEF VerboseTimer}
writeln('gtkTimerCB Timer was STOPPED: TimerInfo=',HexStr(Cardinal(TimerInfo),8));
{$ENDIF}
@ -2309,6 +2359,7 @@ begin
//writeln('[gtkFocusInNotifyCB] ',TObject(data).ClassName);
EventTrace ('FocusInNotify (alias Enter)', data);
if (Event=nil) then ;
if csDesigning in TControl(Data).ComponentState then begin
// stop the signal, so that the widget does not auto react
gtk_signal_emit_stop_by_name(PGTKObject(Widget),'focus-in-event');
@ -2326,6 +2377,7 @@ begin
//writeln('[gtkFocusOutNotifyCB] ',TObject(data).ClassName);
EventTrace ('FocusOutNotify (alias Exit)', data);
if (Event=nil) then ;
if csDesigning in TControl(Data).ComponentState then begin
// stop the signal, so that the widget does not auto react
gtk_signal_emit_stop_by_name(PGTKObject(Widget),'focus-out-event');
@ -2510,6 +2562,7 @@ var
end;
begin
if (Widget=nil) then ;
GetGTKKeyInfo(Event,KeyCode,VirtKeyCode,SysKey,Extended,Toggle,ShiftState);
KeyStateList:=TList(FuncData);
ListCode:=KeyToListCode(KeyCode, VirtKeyCode, Extended);
@ -2556,6 +2609,7 @@ var
MSG: TLMessage;
begin
Result := True;
if (Widget=nil) then ;
EventTrace('year changed', data);
MSG.Msg := LM_YEARCHANGED;
Result := DeliverPostMessage(Data, MSG);
@ -2575,6 +2629,7 @@ var TempBuf: Pointer;
begin
// at any time there can be several requests
// find the request with the correct TimeID
if (Data=nil) or (TargetWidget=nil) then ;
i:=ClipboardSelectionData.Count-1;
while (i>=0) do begin
c:=PClipboardEventData(ClipboardSelectionData[i]);
@ -2622,8 +2677,6 @@ end;
procedure ClipboardSelectionRequestHandler(TargetWidget: PGtkWidget;
SelectionData: PGtkSelectionData; Info: cardinal; TimeID: cardinal;
Data: Pointer); cdecl;
type
PGdkAtom = ^TGdkAtom;
var ClipboardType: TClipboardType;
MemStream: TMemoryStream;
FormatID: cardinal;
@ -2635,6 +2688,7 @@ begin
{$IFDEF DEBUG_CLIPBOARD}
writeln('*** [ClipboardSelectionRequestHandler] START');
{$ENDIF}
if (Data=nil) or (TimeID=0) or (Info=0) or (TargetWidget=nil) then ;
if SelectionData^.Target=0 then exit;
for ClipboardType:=Low(TClipboardType) to High(TClipboardType) do
if SelectionData^.Selection=ClipboardTypeAtoms[ClipboardType] then begin
@ -2651,14 +2705,14 @@ begin
// the gtk-interface provides automatically some formats, that the lcl
// does not know. Wrapping them to lcl formats ...
FormatID:=SelectionData^.Target;
if ((FormatID=gdk_atom_intern('COMPOUND_TEXT',1))
if ((FormatID=gdk_atom_intern('COMPOUND_TEXT',GdkTrue))
and (ClipboardExtraGtkFormats[ClipboardType][gfCOMPOUND_TEXT]))
or ((FormatID=gdk_atom_intern('STRING',1))
or ((FormatID=gdk_atom_intern('STRING',GdkTrue))
and (ClipboardExtraGtkFormats[ClipboardType][gfSTRING]))
or ((FormatID=gdk_atom_intern('TEXT',1))
or ((FormatID=gdk_atom_intern('TEXT',GdkTrue))
and (ClipboardExtraGtkFormats[ClipboardType][gfTEXT]))
then
FormatID:=gdk_atom_intern('text/plain',0);
FormatID:=gdk_atom_intern('text/plain',GdkFalse);
{$IFDEF DEBUG_CLIPBOARD}
writeln('[ClipboardSelectionRequestHandler] FormatID=',FormatID,' CompoundText=',gdk_atom_intern('COMPOUND_TEXT',1),' ',ClipboardExtraGtkFormats[ClipboardType][gfCOMPOUND_TEXT]);
@ -2673,20 +2727,17 @@ begin
BitCount:=8;
// if the format was wrapped, transform it back
if (FormatID=gdk_atom_intern('text/plain',1)) then begin
if (SelectionData^.Target=gdk_atom_intern('COMPOUND_TEXT',1)) then
if (FormatID=gdk_atom_intern('text/plain',GdkTrue)) then begin
if (SelectionData^.Target=gdk_atom_intern('COMPOUND_TEXT',GdkTrue)) then
begin
// transform text/plain to COMPOUND_TEXT
P:=StrAlloc(MemStream.Size+1);
MemStream.Read(P^,MemStream.Size);
P[MemStream.Size]:=#0;
{$ifdef GTK2}
gdk_string_to_compound_text(P,@SelectionData^._Type,
gdk_string_to_compound_text(P,
@SelectionData^.{$ifdef GTK2}_Type{$ELSE}theType{$ENDIF},
@SelectionData^.Format,@Buffer,@BufLength);
{$else}
gdk_string_to_compound_text(P,@SelectionData^.theType,
@SelectionData^.Format,@Buffer,@BufLength);
{$endif}
StrDispose(P);
gtk_selection_data_set(SelectionData,SelectionData^.Target,
SelectionData^.Format,Buffer,BufLength);
@ -2732,6 +2783,7 @@ function ClipboardSelectionLostOwnershipHandler(TargetWidget: PGtkWidget;
EventSelection: PGdkEventSelection; Data: Pointer): cardinal; cdecl;
var ClipboardType: TClipboardType;
begin
if (Data=nil) or (TargetWidget=nil) then ;
//writeln('*** [ClipboardSelectionLostOwnershipHandler] ',hexstr(cardinal(targetwidget),8));
for ClipboardType:=Low(TClipboardType) to High(TClipboardType) do
if EventSelection^.Selection=ClipboardTypeAtoms[ClipboardType] then begin
@ -2760,8 +2812,10 @@ end;
Handler for style changes. For example the user changes the the theme.
-------------------------------------------------------------------------------}
Procedure GTKStyleChanged(Widget: PGtkWidget; previous_style : PGTKStyle; Data: Pointer); cdecl;
Procedure GTKStyleChanged(Widget: PGtkWidget; previous_style : PGTKStyle;
Data: Pointer); cdecl;
begin
if (Widget=nil) or (Data=nil) or (previous_style=nil) then ;
EventTrace('style-set', nil);
ReleaseStyle('button');
ReleaseStyle('radiobutton');
@ -2787,6 +2841,9 @@ end;
{ =============================================================================
$Log$
Revision 1.184 2003/08/29 21:21:07 mattias
fixes for gtk2
Revision 1.183 2003/07/21 23:43:32 marc
* Fixed radiogroup menuitems

2
lcl/interfaces/gtk/gtkcomboboxcallback.inc
View File

@ -22,6 +22,7 @@ begin
Result := True;
EventTrace('ComboBoxShow', data);
if (Widget=nil) then ;
FillChar(Mess,SizeOf(Mess),0);
Mess.Msg := CN_Command;
Mess.NotifyCode := CBN_DROPDOWN;
@ -34,6 +35,7 @@ var
Mess : TLMCommand;
begin
Result := True;
if (Widget=nil) then ;
EventTrace('ComboBoxHide', data);
FillChar(Mess,SizeOf(Mess),0);
Mess.Msg := CN_Command;

14
lcl/interfaces/gtk/gtkdef.pp
View File

@ -34,7 +34,7 @@ interface
uses
{$IFDEF gtk2}
glib2, gdk2pixbuf, gdk2, gtk2,
glib2, gdk2pixbuf, pango, gdk2, gtk2,
{$ELSE}
glib, gdk, gtk, {$Ifndef NoGdkPixbufLib}gdkpixbuf,{$EndIf}
{$ENDIF}
@ -44,7 +44,7 @@ uses
type
TGDIType = (gdiBitmap, gdiBrush, gdiFont, gdiPen, gdiRegion, gdiPalette);
TGDIBitmapType = (gbBitmap, gbPixmap, gbImage);
PGDIRGB = ^TGDIRGB;
TGDIRGB = record
Red,
@ -235,6 +235,13 @@ const
'TIMESTAMP', 'USER'
);
const
GdkTrue = {$IFDEF Gtk2}true{$ELSE}1{$ENDIF};
GdkFalse = {$IFDEF Gtk2}false{$ELSE}0{$ENDIF};
type
TGdkPixBufBuffer = {$IFDEF Gtk2}Pguchar{$ELSE}PChar{$ENDIF};
function NewPGDIObject: PGDIObject;
procedure DisposePGDIObject(GDIObject: PGdiObject);
@ -449,6 +456,9 @@ end.
{ =============================================================================
$Log$
Revision 1.42 2003/08/29 21:21:07 mattias
fixes for gtk2
Revision 1.41 2003/07/02 10:02:51 mattias
fixed TPaintStruct

35
lcl/interfaces/gtk/gtkdragcallback.inc
View File

@ -17,21 +17,21 @@
//DRAG CALLBACK FUNCTIONS
Function edit_drag_data_received(widget : pgtkWidget;
Context : pGdkDragContext;
X : Integer;
Y : Integer;
seldata : pGtkSelectionData;
info : Integer;
time : Integer;
data : pointer) : GBoolean; cdecl;
Context : pGdkDragContext;
X, Y : Integer;
SelData : pGtkSelectionData;
info : Integer;
time : Integer;
data : pointer) : GBoolean; cdecl;
Var
Texts : String;
Begin
Result:=false;
if (Widget=nil) or (X=0) or (Y=0) or (Info=0) then exit;
Assert(False, 'Trace:***********Drag Data Received*******************');
if Seldata^.Length > 0 then
Begin
Texts := strpas(Seldata^.data);
Texts := StrPas(PChar(SelData^.data));
Assert(False, 'Trace:' + Texts);
Assert(False, 'Trace:0');
TEdit(Data).Caption := Texts;
@ -41,16 +41,17 @@ Begin
end;
Function edit_source_drag_data_get(widget : pgtkWidget;
Context : pGdkDragContext;
Selection_data : pGtkSelectionData;
info : Integer;
time : Integer;
data : pointer) : GBoolean; cdecl;
Context : pGdkDragContext;
Selection_data : pGtkSelectionData;
info : Integer;
time : Integer;
data : pointer) : GBoolean; cdecl;
var
strTemp : PChar;
Texts : String;
Begin
Result:=false;
if (Time=0) or (Context=nil) or (Widget=nil) then ;
if (info = TARGET_ROOTWIN) then
Assert(False, 'Trace:I WAS DROPPED ON THE ROOTWIN')
else
@ -64,7 +65,7 @@ Begin
Assert(False, 'Trace:1');
gtk_selection_data_set(selection_data,selection_data^.target,
8,
strtemp,
{$IFDEF Gtk2}PGUChar(StrTemp){$ELSE}StrTemp{$ENDIF},
length(Texts)+1);
Assert(False, 'Trace:2');
finally
@ -75,10 +76,10 @@ Begin
end;
Function Edit_source_drag_data_delete (widget : pGtkWidget;
context : pGdkDragContext;
data : gpointer): gBoolean ; cdecl;
Function Edit_source_drag_data_delete (Widget: pGtkWidget;
Context: pGdkDragContext; Data: gpointer): gBoolean ; cdecl;
begin
if (Widget=nil) or (Context=nil) or (Data=nil) then ;
Assert(False, 'Trace:***************');
Assert(False, 'Trace:DELETE THE DATA');
Result:=false;

17
lcl/interfaces/gtk/gtklistviewcallback.inc
View File

@ -52,6 +52,7 @@ end;
function gtkLVAbortColumnResize(AList: PGTKCList; AData: gPointer): GBoolean; cdecl;
begin
//TODO: implement
if (AList=nil) or (AData=nil) then ;
Result := False;
end;
@ -60,9 +61,11 @@ end;
//HDN_TRACK
//HDN_ITEMCHANGED
//HDN_ITEMCHANGING
function gtkLVResizeColumn(AList: PGTKCList; AColumn, AWidth: Integer; AData: gPointer): GBoolean; cdecl;
function gtkLVResizeColumn(AList: PGTKCList; AColumn, AWidth: Integer;
AData: gPointer): GBoolean; cdecl;
begin
//TODO: implement
if (AList=nil) or (AData=nil) or (AColumn=0) or (AWidth=0) then ;
Result := False;
end;
@ -123,6 +126,7 @@ begin
EventTrace('select-row', Adata);
msg.Msg := CN_NOTIFY;
if (AEvent=nil) then ;
FillChar(NM, SizeOf(NM), 0);
NM.hdr.hwndfrom := longint(AList);
NM.hdr.code := LVN_ITEMCHANGED;
@ -134,7 +138,8 @@ begin
Result := DeliverMessage(AData, msg) = 0;
end;
function gtkLVUnSelectRow(AList: PGTKCList; ARow, AColumn: Integer; AEvent: PGDKEventButton; AData: gPointer): GBoolean; cdecl;
function gtkLVUnSelectRow(AList: PGTKCList; ARow, AColumn: Integer;
AEvent: PGDKEventButton; AData: gPointer): GBoolean; cdecl;
var
msg: TLMNotify;
NM: TNMListView;
@ -142,6 +147,7 @@ begin
EventTrace('unselect-row', Adata);
msg.Msg := CN_NOTIFY;
if (AEvent=nil) then ;
FillChar(NM, SizeOf(NM), 0);
NM.hdr.hwndfrom := longint(AList);
NM.hdr.code := LVN_ITEMCHANGED;
@ -159,11 +165,8 @@ function gtkLVToggleFocusRow(AList: PGTKCList; AData: gPointer): GBoolean; cdecl
//NM: TNMListView;
begin
EventTrace('toggle-focus-row', Adata);
if (AList=nil) or (AData=nil) then ;
//msg.Msg := CN_NOTIFY;
(*
TODO:
Do we need this?
*)
Result := False;
end;
@ -198,12 +201,14 @@ end;
function gtkLVUnSelectAll(AList: PGTKCList; AData: gPointer): GBoolean; cdecl;
begin
EventTrace('unselect-all', Adata);
if (AList=nil) or (AData=nil) then ;
Result:=true;
end;
function gtkLVEndSelection(AList: PGTKCList; AData: gPointer): GBoolean; cdecl;
begin
EventTrace('end-selection', Adata);
if (AList=nil) or (AData=nil) then ;
Result:=true;
end;

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

@ -30,7 +30,8 @@
Here are Fatals, Criticals and Errors translated to Exceptions
Comment Ex to skip exception, comment Level to skip logging
------------------------------------------------------------------------------}
procedure GLogFunc(ALogDomain: Pgchar; ALogLevel: TGLogLevelFlags; AMessage: Pgchar; AData: gpointer);cdecl;
procedure GLogFunc(ALogDomain: Pgchar; ALogLevel: TGLogLevelFlags;
AMessage: Pgchar; AData: gpointer);cdecl;
var
Flag, Level, Domain: String;
Ex: ExceptClass;
@ -46,6 +47,7 @@ begin
G_LOG_LEVEL_DEBUG = 1 shl 7;
G_LOG_LEVEL_MASK = (1 shl 8) - 2;
*)
if (AData=nil) then ;
Ex := nil;
Level := '';
@ -188,7 +190,7 @@ begin
// clipboard
ClipboardTypeAtoms[ctPrimarySelection]:=GDK_SELECTION_PRIMARY;
ClipboardTypeAtoms[ctSecondarySelection]:=GDK_SELECTION_SECONDARY;
ClipboardTypeAtoms[ctClipboard]:=gdk_atom_intern('CLIPBOARD',0);
ClipboardTypeAtoms[ctClipboard]:=gdk_atom_intern('CLIPBOARD',GdkFalse);
end;
{------------------------------------------------------------------------------
@ -505,7 +507,8 @@ begin
if (List^.Data <> nil)
then begin
gdk_window_get_user_data(PGDKWindow(List^.Data), @Window);
if GtkWidgetIsA(PGtkWidget(Window),GTK_WINDOW_TYPE)
if GtkWidgetIsA(PGtkWidget(Window),
{$IFDEF Gtk2}GTK_TYPE_WINDOW{$ELSE}GTK_WINDOW_TYPE{$ENDIF})
then begin
// visible window found -> add to list
New(ATransientWindow);
@ -1057,10 +1060,14 @@ begin
end;
{$ENDIF}
if GtkWidgetIsA(Widget,GTK_SCROLLBAR_TYPE) then begin
if GtkWidgetIsA(Widget,
{$IFDEF Gtk2}GTK_TYPE_SCROLLBAR{$ELSE}GTK_SCROLLBAR_TYPE{$ENDIF}) then
begin
// the width of a scrollbar is fixed and depends only on the theme
gtk_widget_size_request (widget, @Requisition);
if GtkWidgetIsA(Widget,GTK_HSCROLLBAR_TYPE) then begin
if GtkWidgetIsA(Widget,
{$IFDEF Gtk2}GTK_TYPE_HSCROLLBAR{$ELSE}GTK_HSCROLLBAR_TYPE{$ENDIF}) then
begin
NewHeight:=Requisition.height;
end else begin
NewWidth:=Requisition.width;
@ -1070,7 +1077,9 @@ begin
gtk_widget_set_usize(Widget, NewWidth, NewHeight);
if GtkWidgetIsA(Widget,GTK_COMBO_TYPE) then begin
if GtkWidgetIsA(Widget,
{$IFDEF Gtk2}GTK_TYPE_COMBO{$ELSE}GTK_COMBO_TYPE{$ENDIF}) then
begin
// the combobox has an entry, which height is not resized
// automatically. Do it manually.
gtk_widget_set_usize(PGtkCombo(Widget)^.entry,
@ -1127,7 +1136,9 @@ var
// check if window belongs to another LCL control
gdk_window_get_user_data(PaintWindow,@UserData);
if (UserData<>nil) and (GtkWidgetIsA(PGtkWidget(UserData),GTK_WIDGET_TYPE))
if (UserData<>nil)
and (GtkWidgetIsA(PGtkWidget(UserData),
{$IFDEF Gtk2}GTK_TYPE_WIDGET{$ELSE}GTK_WIDGET_TYPE{$ENDIF}))
then begin
LCLObject:=GetLCLObject(UserData);
if (LCLObject<>nil) and (LCLObject<>AWinControl) then exit;
@ -1168,7 +1179,11 @@ var
procedure ForAllChilds(PaintWidget: PgtkWidget);
var
LCLObject: TObject;
{$IFDEF Gtk2}
ChildEntry2: PGList;
{$ELSE}
ChildEntry: PGSList;
{$ENDIF}
begin
if PaintWidget=nil then exit;
LCLObject:=GetLCLObject(PaintWidget);
@ -1177,36 +1192,63 @@ var
SendPaintMessageForGDkWindow(GetControlWindow(PaintWidget));
// search all child widgets
if GtkWidgetIsA(PaintWidget,GTK_CONTAINER_TYPE) then begin
if GtkWidgetIsA(PaintWidget,
{$IFDEF Gtk2}GTK_TYPE_CONTAINER{$ELSE}GTK_CONTAINER_TYPE{$ENDIF}) then
begin
// this is a container widget -> go through all childs
{$IFDEF Gtk2}
ChildEntry2:=gtk_container_get_children(PGtkContainer(PaintWidget));
while ChildEntry2<>nil do begin
if PGtkWidget(ChildEntry2^.Data)<>PaintWidget then
ForAllChilds(PGtkWidget(ChildEntry2^.Data));
ChildEntry2:=ChildEntry2^.Next;
end;
{$ELSE}
ChildEntry:=PGtkContainer(PaintWidget)^.resize_widgets;
while ChildEntry<>nil do begin
if PGtkWidget(ChildEntry^.Data)<>PaintWidget then
ForAllChilds(PGtkWidget(ChildEntry^.Data));
ChildEntry:=ChildEntry^.Next;
end;
{$ENDIF}
end;
if GtkWidgetIsA(PaintWidget,GTK_SCROLLED_WINDOW_TYPE) then begin
if GtkWidgetIsA(PaintWidget,
{$IFDEF Gtk2}GTK_TYPE_SCROLLED_WINDOW{$ELSE}GTK_SCROLLED_WINDOW_TYPE{$ENDIF})
then begin
ForAllChilds(PGtkScrolledWindow(PaintWidget)^.hscrollbar);
ForAllChilds(PGtkScrolledWindow(PaintWidget)^.vscrollbar);
end;
if GtkWidgetIsA(PaintWidget,GTK_BIN_TYPE) then begin
if GtkWidgetIsA(PaintWidget,
{$IFDEF Gtk2}GTK_TYPE_BIN{$ELSE}GTK_BIN_TYPE{$ENDIF}) then
begin
ForAllChilds(PGtkBin(PaintWidget)^.child);
end;
if GtkWidgetIsA(PaintWidget,GTK_COMBO_TYPE) then begin
if GtkWidgetIsA(PaintWidget,
{$IFDEF Gtk2}GTK_TYPE_COMBO{$ELSE}GTK_COMBO_TYPE{$ENDIF}) then begin
ForAllChilds(PGtkCombo(PaintWidget)^.entry);
ForAllChilds(PGtkCombo(PaintWidget)^.button);
end;
if GtkWidgetIsA(PaintWidget,GTK_RANGE_TYPE) then begin
if GtkWidgetIsA(PaintWidget,
{$IFDEF Gtk2}GTK_TYPE_RANGE{$ELSE}GTK_RANGE_TYPE{$ENDIF})
then begin
{$IFDEF Gtk2}
// Gtk2ToDo
writeln('ToDo: SendPaintMessagesForInternalWidgets GTK_TYPE_RANGE');
{$ELSE}
SendPaintMessageForGDkWindow(PGtkRange(PaintWidget)^.slider);
SendPaintMessageForGDkWindow(PGtkRange(PaintWidget)^.trough);
SendPaintMessageForGDkWindow(PGtkRange(PaintWidget)^.step_forw);
SendPaintMessageForGDkWindow(PGtkRange(PaintWidget)^.step_back);
{$ENDIF}
end;
if GtkWidgetIsA(PaintWidget,GTK_TEXT_TYPE) then begin
if GtkWidgetIsA(PaintWidget,
{$IFDEF Gtk2}GTK_TYPE_TEXT{$ELSE}GTK_TEXT_TYPE{$ENDIF}) then
begin
SendPaintMessageForGDkWindow(PGtkText(PaintWidget)^.text_area);
end;
if GtkWidgetIsA(PaintWidget,GTK_ENTRY_TYPE) then begin
if GtkWidgetIsA(PaintWidget,
{$IFDEF Gtk2}GTK_TYPE_ENTRY{$ELSE}GTK_ENTRY_TYPE{$ENDIF}) then
begin
SendPaintMessageForGDkWindow(PGtkEntry(PaintWidget)^.text_area);
end;
end;
@ -1526,7 +1568,12 @@ begin
ColorMap:=gdk_colormap_get_system;
GdiObject^.GDIPixmapObject :=
gdk_pixmap_colormap_create_from_xpm(Window,Colormap,
@(GdiObject^.GDIBitmapMaskObject), p, Filename);
{$IFDEF Gtk2}
GdiObject^.GDIBitmapMaskObject,
{$ELSE}
@(GdiObject^.GDIBitmapMaskObject),
{$ENDIF}
p, Filename);
GdiObject^.GDIBitmapType:=gbPixmap;
gdk_window_get_geometry(GdiObject^.GDIPixmapObject,
nil, nil, @Width, @Height, @Depth);
@ -1543,7 +1590,7 @@ begin
else
gdk_visual_ref(GdiObject^.Visual);
GdiObject^.Colormap := gdk_colormap_new(GdiObject^.Visual, 1);
GdiObject^.Colormap := gdk_colormap_new(GdiObject^.Visual, GdkTrue);
TheBitmap.Handle := HBITMAP(GdiObject);
If GdiObject^.GDIBitmapMaskObject <> nil then
@ -1566,15 +1613,22 @@ var
begin
Result := False;
SRC := nil;
SRC := gdk_pixbuf_new_from_file(FileName);
SRC := gdk_pixbuf_new_from_file(FileName{$IFDEF Gtk2},nil{$ENDIF});
If SRC = nil then
exit;
Width := gdk_pixbuf_get_width(Src);
Height := gdk_pixbuf_get_height(Src);
TMP := CreateCompatibleBitmap(0, Width, Height);
gdk_pixbuf_render_pixmap_and_mask(Src,@PGDIObject(TMP)^.GDIPixmapObject,
PPGDKBitmap(@PGDIObject(TMP)^.GDIBitmapMaskObject), 0);
gdk_pixbuf_render_pixmap_and_mask(Src,
{$IFDEF Gtk2}
PGDIObject(TMP)^.GDIPixmapObject,
PGDIObject(TMP)^.GDIBitmapMaskObject,
{$ELSE}
@PGDIObject(TMP)^.GDIPixmapObject,
PPGDKBitmap(@PGDIObject(TMP)^.GDIBitmapMaskObject),
{$ENDIF}
0);
gdk_window_get_geometry(PGDIObject(TMP)^.GDIPixmapObject,
nil, nil, nil, nil, @Depth);
@ -1591,7 +1645,8 @@ var
If PGDIObject(TMP)^.Colormap <> nil then
GDK_Colormap_UnRef(PGDIObject(TMP)^.Colormap);
PGDIObject(TMP)^.Colormap := gdk_colormap_new(PGDIObject(TMP)^.Visual, 1);
PGDIObject(TMP)^.Colormap :=
gdk_colormap_new(PGDIObject(TMP)^.Visual, GdkTrue);
TheBitmap.Handle := TMP;
GDK_Pixbuf_Unref(Src);
@ -1654,11 +1709,11 @@ Type
SRC := nil;
If gdk_pixbuf_loader_write(Loader, PChar(@BMPInfo),
SizeOf(BMPInfo) div SizeOf(Char))
If gdk_pixbuf_loader_write(Loader, TGdkPixBufBuffer(@BMPInfo),
SizeOf(BMPInfo) div SizeOf(Char){$IFDEF Gtk2},nil{$ENDIF})
then begin
If gdk_pixbuf_loader_write(Loader, PChar(Data),
BMPInfo.InfoHeader.biSizeImage) then
If gdk_pixbuf_loader_write(Loader, TGdkPixBufBuffer(Data),
BMPInfo.InfoHeader.biSizeImage{$IFDEF Gtk2},nil{$ENDIF}) then
begin
SRC := gdk_pixbuf_loader_get_pixbuf(loader);
if Src=nil then
@ -1669,14 +1724,21 @@ Type
end
else
WriteLn('WARNING: [TgtkObject.LoadFromPixbufData] Error occured loading Bitmap Header!');
gdk_pixbuf_loader_close(Loader);
gdk_pixbuf_loader_close(Loader{$IFDEF Gtk2},nil{$ENDIF});
If SRC = nil then
exit;
With PGDIObject(Bitmap)^ do begin
gdk_pixbuf_render_pixmap_and_mask(Src,@GDIPixmapObject,
PPGDKBitmap(@GDIBitmapMaskObject), 0);
gdk_pixbuf_render_pixmap_and_mask(Src,
{$IFDEF Gtk2}
GDIPixmapObject,
GDIBitmapMaskObject,
{$ELSE}
@GDIPixmapObject,
PPGDKBitmap(@GDIBitmapMaskObject),
{$ENDIF}
0);
gdk_window_get_geometry(GDIPixmapObject,
nil, nil, nil, nil, @Depth);
@ -1693,7 +1755,7 @@ Type
If Colormap <> nil then
GDK_Colormap_UnRef(Colormap);
Colormap := gdk_colormap_new(Visual, 1);
Colormap := gdk_colormap_new(Visual, GdkTrue);
GDK_Pixbuf_Unref(Src);
end;
@ -1847,6 +1909,7 @@ var
begin
Assert(False, 'trace:[TgtkObject.InternalGetDIBits]');
Result := 0;
if (DC=0) or (Usage=0) then ;
TrapIsSet:=false;
if IsValidGDIObject(Bitmap)
then begin
@ -1970,7 +2033,8 @@ begin
GDK_VISUAL_TRUE_COLOR: Desc^.Format:=ricfRGBA;
GDK_VISUAL_DIRECT_COLOR: Desc^.Format:=ricfRGBA;
else
writeln('TgtkObject.GetDeviceRawImageDescription unknown Visual type ',Visual^.thetype);
writeln('TgtkObject.GetDeviceRawImageDescription unknown Visual type ',
integer(Visual^.thetype));
exit;
end;
@ -8000,6 +8064,9 @@ end;
{ =============================================================================
$Log$
Revision 1.401 2003/08/29 21:21:07 mattias
fixes for gtk2
Revision 1.400 2003/08/28 09:10:00 mattias
listbox and comboboxes now set sort and selection at handle creation

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

@ -512,7 +512,7 @@ begin
end;
Procedure EnsureGCColor(DC: hDC; ColorType: TDevContextsColorType;
IsSolidBrush: Boolean; AsBackground: Boolean);
IsSolidBrush, AsBackground: Boolean);
var
GC: PGDKGC;
GDIColor: PGDIColor;
@ -520,9 +520,11 @@ var
Procedure EnsureAsGCValues;
var
AllocFG : Boolean;
SyGCValues: TGdkGCValues;
begin
FreeGDIColor(GDIColor);
With GetSysGCValues(GDIColor^.ColorRef) do begin
SyGCValues:=GetSysGCValues(GDIColor^.ColorRef);
With SyGCValues do begin
gdk_gc_set_fill(GC, fill);
AllocFG := Foreground.Pixel = 0;
If AllocFG then
@ -558,9 +560,10 @@ var
gdk_gc_set_foreground(GC, @(GDIColor^.Color));
end;
end;
begin
GC:=TDeviceContext(DC).GC;
GDIColor:=nil;
with TDeviceContext(DC) do
begin
case ColorType of
@ -568,35 +571,51 @@ begin
dccCurrentTextColor: GDIColor:=@CurrentTextColor;
dccGDIBrushColor : GDIColor:=@(CurrentBrush^.GDIBrushColor);
dccGDIPenColor : GDIColor:=@(CurrentPen^.GDIPenColor);
else
exit;
end;
Case TColor(GDIColor^.ColorRef) of
clScrollbar,
clInfoBk,
clMenu,
clHighlight,
clHighlightText,
clBtnFace: //often have a BK Pixmap
If IsSolidBrush then
EnsureAsGCValues
else
EnsureAsColor;//GC's with Pixmaps can't work w/Hatch's (yet)
clBtnShadow,
clBtnHighlight,
clBtnText,
clInfoText,
clWindow,
clWindowText,
clMenuText,
clGrayText://should never have a BK Pixmap
EnsureAsGCValues;
else
EnsureAsColor;
end;
end;
if GDIColor=nil then exit;
// FPC bug workaround:
// clScrollbar = $80000000 can't be used in case statements
if TColor(GDIColor^.ColorRef)=clScrollbar then begin
//often have a BK Pixmap
If IsSolidBrush then
EnsureAsGCValues
else
EnsureAsColor;//GC's with Pixmaps can't work w/Hatch's (yet)
exit;
end;
Case TColor(GDIColor^.ColorRef) of
//clScrollbar,
clInfoBk,
clMenu,
clHighlight,
clHighlightText,
clBtnFace:
//often have a BK Pixmap
If IsSolidBrush then
EnsureAsGCValues
else
EnsureAsColor;//GC's with Pixmaps can't work w/Hatch's (yet)
clBtnShadow,
clBtnHighlight,
clBtnText,
clInfoText,
clWindow,
clWindowText,
clMenuText,
clGrayText:
//should never have a BK Pixmap
EnsureAsGCValues;
else
EnsureAsColor;
end;
{$DEFINE Bla1}
end;
{$DEFINE Bla2}
procedure CopyGDIColor(var SourceGDIColor, DestGDIColor: TGDIColor);
begin
SetGDIColorRef(DestGDIColor,SourceGDIColor.ColorRef);
@ -1038,7 +1057,7 @@ begin
VirtualKey := VK_SCROLL;
{$ifdef GTK2}GDK_KEY_Sys_Req{$else}GDK_Sys_Req{$EndIf}:
VirtualKey := VK_SNAPSHOT;
{$ifdef GTK2}GDK_KEY_Escape{$else}GDK_Escape{$EndIf}:
{$ifdef GTK2}GDK_KEY_Escape{$else}GDK_Escape{$EndIf}:
VirtualKey := VK_ESCAPE;
{$ifdef GTK2}GDK_KEY_Delete{$else}GDK_Delete_Key{$EndIf}:
VirtualKey := VK_DELETE;
@ -2044,7 +2063,6 @@ procedure ConnectInternalWidgetsSignals(AWidget: PGtkWidget;
procedure ConnectChilds(TheWidget: PGtkWidget);
var
ContainerWidget: PGtkContainer;
ScrolledWindow: PGtkScrolledWindow;
BinWidget: PGtkBin;
ChildEntry: PGSList;
@ -2054,11 +2072,10 @@ procedure ConnectInternalWidgetsSignals(AWidget: PGtkWidget;
if GtkWidgetIsA(TheWidget,GTK_TYPE_CONTAINER) then begin
//if AWinControl is TListView then writeln('ConnectChilds B ');
// this is a container widget -> connect all childs
ContainerWidget:=PGtkContainer(TheWidget);
{$IfDef GTK2}
ChildEntry:=nil;
{$else}
ChildEntry:=ContainerWidget^.resize_widgets;
ChildEntry:=PGtkContainer(TheWidget)^.resize_widgets;
{$endif}
while ChildEntry<>nil do begin
ChildWidget:=PGtkWidget(ChildEntry^.Data);
@ -2188,6 +2205,9 @@ procedure ShareWindowAccelGroups(AWindow: PGtkWidget);
procedure AttachUnique(TheWindow: PGtkWidget; TheAccelGroup: PGTKAccelGroup);
begin
{$IfDef GTK2}
// Gtk2ToDo
writeln('ToDo: gtkproc.inc AttachUnique');
if (TheWindow=nil) or (TheAccelGroup=nil) then exit;
{$else}
if (TheAccelGroup=nil)
or ((TheAccelGroup^.attach_objects<>nil)
@ -2251,6 +2271,9 @@ procedure UnshareWindowAccelGroups(AWindow: PGtkWidget);
procedure Detach(TheWindow: PGtkWidget; TheAccelGroup: PGTKAccelGroup);
begin
{$IfDef GTK2}
// Gtk2ToDo
writeln('ToDo: gtkproc.inc Detach');
if (TheWindow=nil) or (TheAccelGroup=nil) then exit;
{$else}
if (TheAccelGroup=nil)
or (TheAccelGroup^.attach_objects=nil)
@ -2564,6 +2587,15 @@ begin
{$endif}
end;
function MenuItemChecked(MenuWidget: PGtkCheckMenuItem): boolean;
begin
{$IFDEF Gtk2}
Result:=gtk_check_menu_item_get_active(MenuWidget);
{$ELSE}
Result:=(MenuWidget^.flag0 and bm_checkmenuitem_active <> 0)
{$ENDIF}
end;
{------------------------------------------------------------------------------
function GetRadioMenuItemGroup(LCLMenuItem: TMenuItem): PGSList;
@ -2627,16 +2659,6 @@ end;
Set 'checked' for all menuitems in the group
------------------------------------------------------------------------------}
procedure UpdateRadioGroupChecks(RadioGroup: PGSList);
function GtkMenuItemChecked(AnMenuItem: PGtkCheckMenuItem): boolean;
begin
{$IFDEF Gtk2}
Result;=gtk_check_menu_item_get_active(AnMenuItem);
{$ELSE}
Result:=((AnMenuItem^.flag0 and bm_checkmenuitem_active) = 0);
{$ENDIF}
end;
var
CurListItem: PGSList;
MenuItem: PGtkCheckMenuItem;
@ -2658,7 +2680,7 @@ begin
then begin
LCLMenuItem := TMenuItem(GetLCLObject(MenuItem));
if (LCLMenuItem <> nil)
and (GtkMenuItemChecked(MenuItem) = LCLMenuItem.Checked)
and (MenuItemChecked(MenuItem) <> LCLMenuItem.Checked)
then gtk_check_menu_item_set_active(MenuItem, LCLMenuItem.Checked);
end;
CurListItem := CurListItem^.Next;
@ -2727,7 +2749,8 @@ var
CurToggleSize, MaxToggleSize: integer;
MenuShell: PGtkMenuShell;
ListItem: PGList;
MenuItem, CheckMenuItem: PGtkMenuItem;
MenuItem: PGtkMenuItem;
CheckMenuItem: PGtkMenuItem;
LCLMenuItem: TMenuItem;
IconImg, IconMask: PGdkPixmap;
Width, Height: integer;
@ -2754,11 +2777,13 @@ begin
end;
ListItem:=ListItem^.Next;
end;
{$Ifdef GTK2}
{$else}
{$IFDEF Gtk2}
// Gtk2ToDo
writeln('ToDo: MenuSizeRequest ');
{$ELSE}
if CheckMenuItem<>nil then
MENU_ITEM_CLASS(PGtkWidget(CheckMenuItem))^.toggle_size:=MaxToggleSize;
{$EndIf}
{$ENDIF}
OldMenuSizeRequestProc(Widget,requisition);
end;
@ -3319,10 +3344,19 @@ end;
this is a helper function for WaitForClipboardAnswer
------------------------------------------------------------------------------}
{$IFDEF Gtk2}
function WaitForClipbrdAnswerDummyTimer(Client: Pointer): gboolean; cdecl;
begin
if CLient=nil then ;
Result:=true; // go on, make sure getting a message at least every second
end;
{$ELSE}
function WaitForClipbrdAnswerDummyTimer(Client: Pointer): gint; cdecl;
begin
if CLient=nil then ;
Result:=1; // go on, make sure getting a message at least every second
end;
{$ENDIF}
{------------------------------------------------------------------------------
Function: WaitForClipboardAnswer
@ -3339,11 +3373,7 @@ var
function ValidDateSelection : boolean;
begin
{$ifdef GTK2}
result := c^.Data.Selection<>NIL;
{$else}
result := c^.Data.Selection<>0;
{$endif}
end;
begin
@ -3444,7 +3474,7 @@ begin
writeln('[RequestSelectionData] TimeID=',TimeID);
{$ENDIF}
if gtk_selection_convert(ClipboardWidget, ClipboardTypeAtoms[ClipboardType],
FormatID, TimeID)<>0
FormatID, TimeID){$IFDEF Gtk2}=false{$ELSE}<>0{$ENDIF}
then
break;
ClipboardSelectionData.Remove(c);
@ -3552,7 +3582,8 @@ begin
If StyleObject^.Widget <> nil then
GTK_Widget_Destroy(StyleObject^.Widget);
If StyleObject^.Style <> nil then
If StyleObject^.Style^.Ref_Count > 0 then
If StyleObject^.Style^.{$IFDEF Gtk2}attach_count{$ELSE}Ref_Count{$ENDIF}>0
then
GTK_Style_Unref(StyleObject^.Style);
Dispose(StyleObject);
StyleObject := nil;
@ -3595,6 +3626,7 @@ var
Tp : Pointer;
l : Longint;
StyleObject : PStyleObject;
NoName: PGChar;
begin
Result := nil;
If Not Assigned(Styles) then
@ -3606,8 +3638,13 @@ begin
If AnsiCompareText(WName,'button')=0 then
StyleObject^.Widget := GTK_BUTTON_NEW
else
If AnsiCompareText(WName,'default')=0 then
StyleObject^.Widget := GTK_WIDGET_NEW(GTK_WIDGET_TYPE,nil,[])
If AnsiCompareText(WName,'default')=0 then begin
NoName:=nil;
StyleObject^.Widget :=
GTK_WIDGET_NEW(
{$IFDEF Gtk2}GTK_TYPE_WIDGET{$ELSE}GTK_WIDGET_TYPE{$ENDIF},
NoName,[]);
end
else
If AnsiCompareText(WName,'window')=0 then
StyleObject^.Widget := GTK_WINDOW_NEW(0)
@ -3702,12 +3739,18 @@ begin
Style := GetStyle('gtk_default');
If Style <> nil then begin
If Style^.Font <> nil then
Result := Style^.Font
else
If (Style^.RC_Style <> nil) and (Style^.RC_Style^.font_name <> nil)
then
Result := gdk_font_load(Style^.RC_Style^.font_name);
{$IFDEF Gtk2}
// Gtk2ToDo
if Style^.font_desc<>nil then
Result:=gdk_font_from_description(Style^.font_desc);
{$ELSE}
Result := Style^.Font;
If Result = nil then
If (Style^.RC_Style <> nil) then begin
if (Style^.RC_Style^.font_name <> nil) then
Result := gdk_font_load(Style^.RC_Style^.font_name);
end;
{$ENDIF}
end;
If Result = nil then
@ -4164,11 +4207,14 @@ end;
retrieved from gdk_image_get_pixel, and uses the passed Visual and Colormap
to try and look up actual RGB values.
------------------------------------------------------------------------------}
Function GDKPixel2GDIRGB(Pixel : Longint; Visual : PGDKVisual;
Colormap : PGDKColormap) : TGDIRGB;
Function GDKPixel2GDIRGB(Pixel: Longint; Visual: PGDKVisual;
Colormap: PGDKColormap) : TGDIRGB;
{$IFDEF Gtk2}
{$ELSE}
var
Color : TGDKColor;
GdkColorContext : PGdkColorContext;
Color: TGDKColor;
GdkColorContext: PGdkColorContext;
{$ENDIF}
begin
FillChar(Result, SizeOf(TGDIRGB),0);
@ -4176,7 +4222,13 @@ begin
Visual := GDK_Visual_Get_System;
Colormap := GDK_Colormap_Get_System;
end;
{$IFDEF Gtk2}
// Gtk2ToDo
writeln('ToDo: GDKPixel2GDIRGB');
if Pixel=0 then ;
FillChar(Result,SizeOf(Result),0);
{$ELSE}
gdk_error_trap_push;
Color.Pixel := Pixel;
@ -4189,6 +4241,7 @@ begin
Result.Blue := Color.Blue shr 8;
gdk_error_trap_pop;
{$ENDIF}
end;
{------------------------------------------------------------------------------
@ -4310,6 +4363,9 @@ end;
{ =============================================================================
$Log$
Revision 1.191 2003/08/29 21:21:07 mattias
fixes for gtk2
Revision 1.190 2003/08/28 09:10:00 mattias
listbox and comboboxes now set sort and selection at handle creation

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

@ -162,7 +162,7 @@ function gtkCutToClip( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
function gtkCopyToClip( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
function gtkPasteFromClip( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
function gtkValueChanged(widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
function gtkTimerCB(Data: gPointer): gint; cdecl;
function gtkTimerCB(Data: gPointer): {$IFDEF Gtk2}gBoolean{$ELSE}gint{$ENDIF}; cdecl;
function gtkFocusInNotifyCB (widget : PGtkWidget; event : PGdkEvent;
data : gpointer) : GBoolean; cdecl;
function gtkFocusOutNotifyCB (widget : PGtkWidget; event : PGdkEvent;
@ -286,7 +286,7 @@ Procedure AllocGDIColor(DC: hDC; GDIColor: PGDIColor);
procedure BuildColorRefFromGDKColor(var GDIColor : TGDIColor);
procedure SetGDIColorRef(var GDIColor : TGDIColor; NewColorRef: TColorRef);
Procedure EnsureGCColor(DC: hDC; ColorType: TDevContextsColorType;
IsSolidBrush: Boolean; AsBackground: Boolean);
IsSolidBrush, AsBackground: Boolean);
procedure CopyGDIColor(var SourceGDIColor, DestGDIColor: TGDIColor);
function AllocGDKColor(const AColor: LongInt): TGDKColor;
function TGDKColorToTColor(const value : TGDKColor) : TColor;
@ -428,6 +428,7 @@ procedure GetGdkPixmapFromGraphic(LCLGraphic: TGraphic;
// menus
function MENU_ITEM_CLASS(widget: PGtkWidget): PGtkMenuItemClass;
function CHECK_MENU_ITEM_CLASS(widget: PGtkWidget): PGtkCheckMenuItemClass;
function MenuItemChecked(MenuWidget: PGtkCheckMenuItem): boolean;
function GetRadioMenuItemGroup(LCLMenuItem: TMenuItem): PGSList;
function GetRadioMenuItemGroup(MenuItem: PGtkRadioMenuItem): PGSList;
procedure LockRadioGroupOnChange(RadioGroup: PGSList; const ADelta: Integer);
@ -445,7 +446,6 @@ procedure SaveSizeNotification(Widget: PGtkWidget);
procedure SaveClientSizeNotification(FixWidget: PGtkWidget);
function CreateTopologicalSortedWidgets(HashArray: TDynHashArray): TList;
Procedure ReportNotObsolete(const Texts : String);
function WaitForClipbrdAnswerDummyTimer(Client: Pointer): gint; cdecl;
function WaitForClipboardAnswer(c: PClipboardEventData): boolean;
function RequestSelectionData(ClipboardWidget: PGtkWidget;
ClipboardType: TClipboardType; FormatID: cardinal): TGtkSelectionData;

3
lcl/interfaces/gtk2/gtk2interface.lpk
View File

@ -109,6 +109,9 @@
<LCLWidgetType Value="gtk"/>
</SearchPaths>
<Other>
<Verbosity>
<ShoLineNum Value="True"/>
</Verbosity>
<CustomOptions Value="-dGTK2"/>
<CompilerPath Value="$(CompPath)"/>
</Other>