paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-23 16:24:01 +02:00
Code Issues Packages Projects Releases Wiki Activity
b9f3eb9c5a
lazarus/lcl/interfaces/gtk/gtkcallback.inc
lazarus b9f3eb9c5a MG: fixed AdjustClientRect of TGroupBox 
git-svn-id: trunk@1626 -
2002-04-22 13:07:46 +00:00

1886 lines
58 KiB
PHP
Raw Blame History

{$IFOPT C-}
// Uncomment for local trace
// {$C+}
// {$DEFINE ASSERT_IS_ON}
{$ENDIF}
const
DblClickTime = 250;//250 miliseconds or less between clicks is a double click
var
//testing
LMouseButtonDown,MMouseButtonDown,RMouseButtonDown : Boolean; //used to track the mouse buttons
LLastClick, RLastClick, MLastClick : TDateTime;
LastFileSelectRow : gint;
// temp solution to fill msgqueue
function DeliverPostMessage(const Target: Pointer; var Message): GBoolean;
begin
if TObject(Target) is TWinControl then
begin
Result := PostMessage(TWinControl(Target).Handle, TLMessage(Message).Msg,
TLMessage(Message).WParam, TLMessage(Message).LParam);
end
else
begin
Result := DeliverMessage(Target, Message) = 0;
end;
end;
procedure EventTrace(message : string; data : pointer);
begin
if Data = nil
then Assert(False, Format('Trace:Event [%s] fired',[message]))
else Assert(False, Format('Trace:Event [%s] fired for %s',[message, TObject(data).Classname]));
end;
{*************************************************************}
{ callback routines }
{*************************************************************}
// GTKRealizeCB is used to set extra signal masks after the widget window is created
// define extra events we're interrested in
function GTKRealizeCB(Widget: PGtkWidget; Data: Pointer): GBoolean; cdecl;
begin
EventTrace('realize', nil);
gdk_window_set_events(Widget^.Window, gdk_window_get_events(Widget^.Window) or TGdkEventMask(Data));
Result := True;
end;
function gtkshowCB( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
var
Mess : TLMShowWindow;
begin
Result := True;
EventTrace('show', data);
Mess.Msg := LM_SHOWWINDOW;
Mess.Show := True;
Result := DeliverMessage(Data, Mess) = 0;
end;
function gtkHideCB( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
var
Mess : TLMShowWindow;
begin
Result := True;
EventTrace('hide', data);
Mess.Msg := LM_SHOWWINDOW;
Mess.Show := False;
Result := DeliverMessage(Data, Mess) = 0;
end;
function gtkactivateCB( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
var
Mess : TLMessage;
begin
EventTrace('activate', data);
Mess.Msg := LM_ACTIVATE;
Result := DeliverMessage(Data, Mess) = 0;
end;
function gtkchangedCB( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
var
Mess : TLMessage;
begin
Result := True;
EventTrace('changed', data);
Mess.Msg := LM_CHANGED;
Result := DeliverMessage(Data, Mess) = 0;
end;
function gtkchanged_editbox( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
var
Mess : TLMessage;
begin
Result := True;
EventTrace('changed', data);
Mess.Msg := CM_TEXTCHANGED;
Result := DeliverMessage(Data, Mess) = 0;
end;
function gtkdaychanged(Widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
var
MSG: TLMessage;
begin
Result := True;
EventTrace('day changed', data);
MSG.Msg := LM_DAYCHANGED;
Result := DeliverPostMessage(Data, MSG);
// Result := DeliverMessage(Data, MSG) = 0;
end;
function gtkdraw(Widget: PGtkWidget; area: PGDKRectangle; data: gPointer) : GBoolean; cdecl;
var
MSG: TLMPaint;
begin
Result := True;
EventTrace('draw', data);
MSG.Msg := LM_PAINT;
MSG.DC := GetDC(THandle(Widget));
MSG.Unused := 0;
Result := DeliverPostMessage(Data, MSG);
// Result := DeliverMessage(Data, MSG) = 0;
end;
function gtkfrmactivate( widget: PGtkWidget; Event : TgdkEventFocus;
data: gPointer) : GBoolean; cdecl;
var
Mess : TLMActivate;
begin
EventTrace('activate', data);
Mess.Msg := LM_ACTIVATE;
Result := DeliverPostMessage(Data, Mess);
end;
function gtkfrmdeactivate( widget: PGtkWidget; Event : TgdkEventFocus;
data: gPointer) : GBoolean; cdecl;
var
Mess : TLMActivate;
begin
EventTrace('deactivate', data);
Mess.Msg := LM_DEACTIVATE;
Result := DeliverPostMessage(Data, Mess);
end;
function GTKMap(Widget: PGTKWidget; Data: gPointer): GBoolean; cdecl;
begin
Result := True;
EventTrace('map', data);
end;
function GTKExposeEvent(Widget: PGtkWidget; Event : PGDKEventExpose;
Data: gPointer): GBoolean; cdecl;
var
// Mess : TLMessage;
// fWindow : pgdkWindow;
// widget2: pgtkWidget;
// PixMap : pgdkPixMap;
msg: TLMPaint;
begin
Result := True;
EventTrace('expose-event', data);
if (Event^.Count > 0) then exit;
msg.msg := LM_PAINT;
MSG.DC := GetDC(THandle(Widget));
msg.Unused := 0;
Result := DeliverPostMessage(Data, MSG);
end;
function GTKKeyUpDown(Widget: PGtkWidget; Event : pgdkeventkey;
Data: gPointer) : GBoolean; cdecl;
var
Msg: TLMKey;
KeyCode: Word;
Flags: Integer;
Toggle, Extended, SysKey: Boolean;
begin
GetGTKKeyInfo(Event, KeyCode, Msg.CharCode, SysKey, Extended, Toggle);
// Assert(False, Format('Trace:[GTKKeyUpDown] Type: %3:d, GTK: 0x%0:x(%0:d) LCL: 0x%1:x(%1:d) VK: 0x%2:x(%2:d)', [Event^.keyval, KeyCode, Msg.CharCode, Event^.theType]));
Flags := 0;
if Extended then Flags := KF_EXTENDED;
if SysKey then Flags := Flags or KF_ALTDOWN;
Msg.KeyData := $00000000; //TODO: OEM char
case Event^.theType of
GDK_KEY_RELEASE:
begin
//writeln('GTKKeyUpDown-GDK_KEY_RELEASE Code=',KeyCode,' Char=',Msg.CharCode,' Sys=',SysKey,' Ext=',Extended,' Toggle=',Toggle);
EventTrace('key up', data);
if SysKey
then Msg.msg := LM_SYSKEYUP
else Msg.msg := LM_KEYUP;
Flags := Flags or KF_UP or KF_REPEAT;
Msg.KeyData := Msg.KeyData or (Flags shl 16) or $0001 {allways};
Result := DeliverPostMessage(data, msg);
end;
GDK_KEY_PRESS:
begin
{writeln('[GTKKeyUpDown] ',HexStr(Cardinal(Widget),8),' ',HexStr(Cardinal(Data),8));
writeln(' [GetGTKKeyInfo] Event^.KeyVal=',Event^.KeyVal,
' State=',HexStr(Cardinal(Event^.State),8),
' Ctrl=',ssCtrl in ShiftState,
' Shift=',ssShift in ShiftState,
' KeyCode=',KeyCode,
' VK=',Msg.CharCode
);
writeln(' ',
' SysKey=',SysKey,
' Extended=',Extended,
' Toggle=',Toggle
);}
EventTrace('key down', data);
if SysKey
then Msg.msg := LM_SYSKEYDOWN
else Msg.msg := LM_KEYDOWN;
// todo repeat
// Flags := Flags or KF_REPEAT;
Msg.KeyData := Msg.KeyData or (Flags shl 16) or $0001 {TODO: repeatcount};
Result := DeliverPostMessage(data, msg);
if KeyCode <> $FFFF
then begin
EventTrace('char', data);
if SysKey then Msg.msg := LM_SYSCHAR
else Msg.msg := LM_CHAR;
Msg.CharCode := KeyCode;
Result := DeliverPostMessage(data, msg);
end;
end;
end;
end;
function GTKFocusCB( widget: PGtkWidget; event:PGdkEventFocus; data: gPointer) : GBoolean; cdecl;
var
Mess : TLMessage;
begin
EventTrace('focus', data);
//Writeln('Getting Focus... ',TObject(Data).ClassName,' widget=',HexStr(Cardinal(widget),8));
//writeln(' Focus=',HexStr(Cardinal(GetFocus),8));
//TODO: fill in old focus
Mess.msg := LM_SETFOCUS;
Assert(False, Format('Trace:TODO: [gtkfocusCB] %s finish', [TObject(Data).ClassName]));
Result := DeliverMessage(Data, Mess) = 0;
//Writeln('Getting Focus... END ',TObject(Data).ClassName,' ',Result);
end;
function GTKKillFocusCB(widget: PGtkWidget; event:PGdkEventFocus; data: gPointer) : GBoolean; cdecl;
var
Mess : TLMessage;
begin
EventTrace('killfocus', data);
//Writeln('Killing Focus... ',TObject(Data).ClassName,' widget=',HexStr(Cardinal(widget),8));
//writeln(' Focus=',HexStr(Cardinal(GetFocus),8));
Mess.msg := LM_KILLFOCUS;
//TODO: fill in new focus
Assert(False, Format('Trace:TODO: [gtkkillfocusCB] %s finish', [TObject(Data).ClassName]));
if GetFocus<>0 then
Result := DeliverMessage(Data, Mess) = 0;
//Writeln('Killing Focus... END ',TObject(Data).ClassName,' ',Result);
end;
function gtkdestroyCB(widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
var
Mess: TLMessage;
Info: PWinWidgetInfo;
begin
Result := True;
EventTrace('destroy', data);
Mess.msg := LM_DESTROY;
Result := DeliverMessage(Data, Mess) = 0;
if longint(widget)=MCaptureHandle then MCaptureHandle:=0;
// NOTE: if the destroy message is posted
// we should post an info destroy message as well
Info := GetWidgetInfo(widget, False);
if Info <> nil then Dispose(Info);
end;
function gtkdeleteCB( widget : PGtkWidget; event : PGdkEvent; data : gPointer) : GBoolean; cdecl;
var Mess : TLMessage;
begin
Mess.Msg:= LM_CLOSEQUERY;
{ Message results : True - do nothing, False - destroy or hide window }
Result:= DeliverMessage(Data, Mess) = 0;
if longint(widget)=MCaptureHandle then MCaptureHandle:=0;
end;
function gtkresizeCB( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
//var
// Mess : TLMessage;
begin
Result := True;
EventTrace('resize', data);
// Mess.msg := LM_RESIZE;
// TControl(data).WindowProc(TLMessage(Mess));
Assert(False, 'Trace:TODO: [gtkresizeCB] fix (or remove) to new LM_SIZE');
//TObject(data).Dispatch(Mess);
end;
function gtkmonthchanged(Widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
var
MSG: TLMessage;
begin
Result := True;
EventTrace('month changed', data);
MSG.Msg := LM_MONTHCHANGED;
Result := DeliverPostMessage(Data, MSG);
// Result := DeliverMessage(Data, MSG) = 0;
end;
function GTKMotionNotify(widget:PGTKWidget; event: PGDKEventMotion; data: gPointer):GBoolean; cdecl;
var
Msg: TLMMouseMove;
ShiftState: TShiftState;
parWindow : PgdkWindow; //the Parent's GDKWindow
ShowDebugging : Boolean;
begin
ShowDebugging := False;
if ShowDebugging then
Begin
writeln('_______________');
Writeln('Motion Notify');
Writeln('Control = ',TControl(data).Name);
Writeln('Handle = ',Longint(TWinControl(data).Handle));
Writeln('Widget = ',LongInt(widget));
Writeln('Window = ',Longint(Event^.Window));
Writeln('Coords = ',trunc(Event^.x),',',trunc(Event^.Y));
Writeln('Send Event',Event^.send_Event);
Writeln('Event Type',Event^.thetype);
Writeln('Coords root = ',trunc(Event^.x_root),',',trunc(Event^.Y_root));
Writeln('State = ',event^.state);
Writeln('TGtkWidget^.Window is ',Longint(Widget^.Window));
parWindow := gtk_widget_get_parent_window(widget);
Writeln('Parwindow is ',LongInt(parwindow));
Writeln('_______________');
end;
//work around
//if the gdkwindow is the same as the parent's gdkwindow, then adjust the x,y relative to the cotnrol.
parWindow := gtk_widget_get_parent_window(widget);
if (ParWindow = Event^.Window) then
Begin
if ShowDebugging then
Begin
Writeln('***********************');
Writeln('Calculating new X and Y');
Writeln('TWincontrol(data).left and Top = ',TWinControl(data).Left,',',TWinControl(data).Top);
Writeln('Event^.X and Y = ',Event^.X,',',Event^.Y);
end;
Event^.X := Event^.X - TWinControl(data).left;
Event^.Y := Event^.Y - TWinControl(data).Top;
if ShowDebugging then
Begin
Writeln('CAlculated...');
Writeln('TWincontrol(data).left and Top = ',TWinControl(data).Left,',',TWinControl(data).Top);
Writeln('Event^.X and Y = ',Event^.X,',',Event^.Y);
Writeln('***********************');
end;
end;
ShiftState := GTKEventState2ShiftState(Event^.State);
with Msg do
begin
Msg := LM_MouseMove;
if ShowDebugging then
Begin
Writeln('re-calcing XPos and YPos');
Writeln('Event X and Y :',Event^.X,',',Event^.y);
end;
XPos := trunc(Event^.X);//Round(Event^.X);
YPos := trunc(Event^.Y); //Round(Event^.Y);
if ShowDebugging then
Begin
Writeln('Done...');
Writeln('XPos,mYPos :',XPos,',',YPos);
end;
Keys := 0;
if ssShift in ShiftState then Keys := Keys or MK_SHIFT;
if ssCtrl in ShiftState then Keys := Keys or MK_CONTROL;
if ssLeft in ShiftState then Keys := Keys or MK_LBUTTON;
if ssRight in ShiftState then Keys := Keys or MK_RBUTTON;
if ssMiddle in ShiftState then Keys := Keys or MK_MBUTTON;
end;
Result := DeliverPostMessage(Data, Msg);
//if ssLeft in ShiftState then WriteLN(Format('[GTKMotionNotify] widget: 0x%p', [widget]));
if (Pointer(MCaptureHandle) <> widget)
and (MCaptureHandle <> 0)
then WriteLN(Format('[GTKMotionNotify] Capture differs --> cap:0x%x gtk:0x%p', [MCaptureHandle, widget]));
end;
function gtkMouseBtnPress(widget: PGtkWidget; event : pgdkEventButton;
data: gPointer) : GBoolean; cdecl;
const
WHEEL_DELTA : array[Boolean] of Integer = (-1, 1);
var
MessI : TLMMouse;
MessE : TLMMouseEvent;
ShiftState: TShiftState;
ShowDebugging : Boolean;
parWindow : PgdkWindow; //the Parent's GDKWindow
begin
//writeln('[gtkMouseBtnPress] ',ToBject(Data).ClassName,' ',Trunc(Event^.X),',',Trunc(Event^.Y));
EventTrace('Mouse button Press', data);
Assert(False, Format('Trace:[gtkMouseBtnPress] ', []));
ShiftState := GTKEventState2ShiftState(Event^.State);
ShowDebugging := False;
if ShowDebugging then
Begin
writeln('_______________');
Writeln('Button Down');
Writeln('Control = ',TControl(data).Name);
Writeln('Handle = ',Longint(TWinControl(data).Handle));
Writeln('Widget = ',LongInt(widget));
Writeln('Window = ',Longint(Event^.Window));
Writeln('Coords = ',trunc(Event^.x),',',trunc(Event^.Y));
Writeln('Event Type',Event^.thetype);
Writeln('Coords root = ',trunc(Event^.x_root),',',trunc(Event^.Y_root));
Writeln('State = ',event^.state);
Writeln('TGtkWidget^.Window is ',Longint(Widget^.Window));
parWindow := gtk_widget_get_parent_window(widget);
Writeln('Parwindow is ',LongInt(parwindow));
Writeln('_______________');
end;
if event^.Button in [4,5]
then begin
MessE.Msg := LM_MOUSEWHEEL;
MessE.WheelDelta := WHEEL_DELTA[event^.Button = 4];
MessE.X := Trunc(Event^.X);
MessE.Y := trunc(Event^.Y);
MessE.State := ShiftState;
MessE.UserData := Data;
Result := DeliverPostMessage(Data, MessE);
end
else begin
MessI.Keys := 0;
case event^.Button of
1 : begin
if (LMouseButtonDown) and (not ((Event^.theType = gdk_2button_press) or (Event^.theType = gdk_3button_press))) then Exit;
MessI.Keys := MessI.Keys or MK_LBUTTON;
if ((now - LLastClick) <= ((1/86400)*(DblClickTime/1000))) and (not (Event^.theType = gdk_3button_press)) then
Event^.theType := gdk_2Button_press;
LLastClick := Now;
if event^.thetype = gdk_button_press then
MessI.Msg := LM_LBUTTONDOWN
else
if event^.thetype = gdk_2button_press then
begin
MessI.Msg := LM_LBUTTONDBLCLK;
LLastClick := -1;
end
else
if event^.thetype = gdk_3button_press then
begin
MessI.Msg := LM_LBUTTONTRIPLECLK;
LLastClick := -1;
end;
LMouseButtonDown := True;
end;
2 : begin
if (MMouseButtonDown) and (not ((Event^.theType = gdk_2button_press) or (Event^.theType = gdk_3button_press))) then Exit;
MessI.Keys := MessI.Keys or MK_MBUTTON;
if ((now - MLastClick) <= ((1/86400)*(DblClickTime/1000))) and (not (Event^.theType = gdk_3button_press)) then
Event^.theType := gdk_2Button_press;
MLastClick := Now;
if event^.thetype = gdk_button_press then
MessI.Msg := LM_MBUTTONDOWN
else
if event^.thetype = gdk_2button_press then
Begin
MessI.Msg := LM_MBUTTONDBLCLK;
MLastClick := -1;
end
else
if event^.thetype = gdk_3button_press then
begin
MessI.Msg := LM_MBUTTONTRIPLECLK;
LLastClick := -1;
end;
MMouseButtonDown := True;
end;
3 : begin
if (RMouseButtonDown) and (not ((Event^.theType = gdk_2button_press) or (Event^.theType = gdk_3button_press))) then Exit;
MessI.Keys := MessI.Keys or MK_RBUTTON;
if ((now - RLastClick) <= ((1/86400)*(DblClickTime/1000))) and (not (Event^.theType = gdk_3button_press)) then
Event^.theType := gdk_2Button_press;
RLastClick := Now;
if event^.thetype = gdk_button_press then
MessI.Msg := LM_RBUTTONDOWN
else
if event^.thetype = gdk_2button_press then
Begin
MessI.Msg := LM_RBUTTONDBLCLK;
RLastClick := -1;
end
else
if event^.thetype = gdk_3button_press then
begin
MessI.Msg := LM_RBUTTONTRIPLECLK;
LLastClick := -1;
end;
RMouseButtonDown := True;
end;
else MessI.Msg := LM_NULL;
end; //case
MessI.XPos := Trunc(Event^.X);
MessI.YPos := Trunc(Event^.Y);
if ssShift in ShiftState then MessI.Keys := MessI.Keys or MK_SHIFT;
if ssCtrl in ShiftState then MessI.Keys := MessI.Keys or MK_CONTROL;
if ssLeft in ShiftState then MessI.Keys := MessI.Keys or MK_LBUTTON;
if ssRight in ShiftState then MessI.Keys := MessI.Keys or MK_RBUTTON;
if ssMiddle in ShiftState then MessI.Keys := MessI.Keys or MK_MBUTTON;
if MessI.Msg <> LM_NULL then Result := DeliverPostMessage(Data, MessI)
else Result:= false;
end;
end;
function gtkMouseBtnRelease( widget: PGtkWidget; event : pgdkEventButton; data: gPointer) : GBoolean; cdecl;
var
MessI : TLMMouse;
ShiftState: TShiftState;
begin
EventTrace('Mouse button release', data);
Assert(False, Format('Trace:[gtkMouseBtnRelease] ', []));
ShiftState := gtkeventstate2shiftstate(Event^.State);
case event^.Button of
1 : if not(LMouseButtonDown) then
Exit
else
begin
MessI.Msg := LM_LBUTTONUP;
LMouseButtonDown := False;
end;
2 : if not(MMouseButtonDown) then
Exit
else
begin
MessI.Msg := LM_MBUTTONUP;
MMouseButtonDown := False;
end;
3 : if not(RMouseButtonDown) then
Exit
else
begin
MessI.Msg := LM_RBUTTONUP;
RMouseButtonDown := False;
end
else MessI.Msg := LM_NULL;
end;
MessI.XPos := Trunc(Event^.X);
MessI.YPos := Trunc(Event^.Y);
MessI.Keys := 0;
if ssShift in ShiftState then MessI.Keys := MessI.Keys or MK_SHIFT;
if ssCtrl in ShiftState then MessI.Keys := MessI.Keys or MK_CONTROL;
if ssLeft in ShiftState then MessI.Keys := MessI.Keys or MK_LBUTTON;
if ssRight in ShiftState then MessI.Keys := MessI.Keys or MK_RBUTTON;
if ssMiddle in ShiftState then MessI.Keys := MessI.Keys or MK_MBUTTON;
if MessI.Msg <> LM_NULL
then Result := DeliverPostMessage(Data, MessI)
else Result := false;
end;
function gtkclickedCB( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
var
Mess : TLMessage;
begin
//writeln('[gtkclickedCB] ',TObject(Data).ClassName);
EventTrace('clicked', data);
Assert(False, Format('Trace:OBSOLETE: [gtkclickedCB] ', []));
Mess.Msg := LM_CLICKED;
Result:= DeliverMessage(Data, Mess) = 0;
Result := True;
end;
function gtkOpenDialogRowSelectCB( widget : PGtkWidget; row : gint; column : gint; event : pgdkEventButton; data : gPointer ) : GBoolean; cdecl;
var
ShiftState: TShiftState;
loop : gint;
startRow : gint;
endRow : gint;
begin
// 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.
if event <> nil then
begin
ShiftState := GTKEventState2ShiftState(Event^.State);
if ssShift in ShiftState then
begin
if LastFileSelectRow <> -1 then
begin
startRow := LastFileSelectRow;
endRow := row;
if LastFileSelectRow > row then
begin
startRow := row;
endRow := LastFileSelectRow;
end;
for loop := startRow to endRow do
begin
gtk_clist_select_row(PGtkCList(widget), loop, column);
end;
end;
end
else if not (ssCtrl in ShiftState) then
begin
gtk_clist_unselect_all(PGtkCList(widget));
gtk_clist_select_row(PGtkCList(widget), row, column);
end;
LastFileSelectRow := row;
end;
Result := True;
end;
function gtkDialogOKclickedCB( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
var
theDialog : TCommonDialog;
Fpointer : Pointer;
colorArray : array[0..2] of double;
colorsel : GTK_COLOR_SELECTION;
newColor : TGdkColor;
FontName : String;
cListRow : PGList;
rowNum : gint;
fileInfo : PGChar;
fileList : PGTKCList;
DirName : string;
FileName : string;
Files: TStringList;
begin
Result := True;
theDialog := TCommonDialog(data);
FPointer := Pointer(theDialog.Handle);
// gtk_grab_remove(PgtkWidget(TCommonDialog(data).Handle));
if theDialog is TFileDialog then
begin
if theDialog is TOpenDialog then
begin
// check extra options
if ofAllowMultiSelect in TOpenDialog(theDialog).Options then
begin
FileName:=gtk_file_selection_get_filename(
PGtkFileSelection(FPointer));
DirName:=ExtractFilePath(FileName);
TFileDialog(data).FileName := '';
Files:=TStringList(TFileDialog(theDialog).Files);
Files.Clear;
if not FileExists(FileName) then
Files.Add(FileName);
fileList := PGtkCList(PGtkFileSelection(FPointer)^.file_list);
rowNum := 0;
cListRow := fileList^.row_list;
while cListRow <> nil do
begin
if PGtkCListRow(cListRow^.data)^.state = GTK_STATE_SELECTED then
begin
if gtk_clist_get_cell_type(fileList, rowNum, 0) = GTK_CELL_TEXT
then begin
gtk_clist_get_text(fileList, rowNum, 0, @fileInfo);
Files.Add(DirName+fileInfo);
end;
end;
// get next row from list
rowNum := rowNum + 1;
cListRow := g_list_next(cListRow);
end;
if (Filename<>'') and (Files.IndexOf(Filename)<0) then
Files.Add(Filename);
end
else
begin
TFileDialog(data).FileName :=
gtk_file_selection_get_filename(PGtkFileSelection(FPointer));
end;
end
else
begin
TFileDialog(data).FileName := gtk_file_selection_get_filename(PGtkFileSelection(FPointer));
end;
end
else if theDialog is TColorDialog then
begin
colorSel := GTK_COLOR_SELECTION((GTK_COLOR_SELECTION_DIALOG(FPointer))^.colorsel);
gtk_color_selection_get_color(colorsel, @colorArray[0]);
newColor.pixel := 0;
newColor.red := Trunc(colorArray[0] * $FFFF);
newColor.green := Trunc(colorArray[1] * $FFFF);
newColor.blue := Trunc(colorArray[2] * $FFFF);
TColorDialog(theDialog).Color := TGDKColorToTColor(newcolor);
end
else if theDialog is TFontDialog then
begin
Assert(False, 'Trace:Prssed OK in FontDialog');
FontName := gtk_font_selection_dialog_get_font_name(pgtkfontselectiondialog(FPointer));
TFontDialog(theDialog).FontName := FontName;
Assert(False, 'Trace:-----'+TFontDialog(theDialog).FontName+'----');
end;
theDialog.UserChoice := mrOK;
end;
function gtkDialogCancelclickedCB( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
var
theDialog : TCommonDialog;
begin
Result := True;
theDialog := TCommonDialog(data);
// gtk_grab_remove(PgtkWidget(TCommonDialog(data).Handle));
if theDialog is TFileDialog then
begin
TFileDialog(data).FileName := '';
end;
theDialog.UserChoice := mrCancel;
end;
function gtkDialogDestroyCB( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
var
theDialog : TCommonDialog;
begin
Result := True;
theDialog := TCommonDialog(data);
// gtk_grab_remove(PgtkWidget(TCommonDialog(data).Handle));
if theDialog is TFileDialog then
begin
// TFileDialog(data).FileName := '';
end;
theDialog.UserChoice := -1;
end;
function gtkpressedCB( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
var
Mess : TLMessage;
begin
Result := True;
EventTrace('pressed', data);
Mess.msg := LM_PRESSED;
Result := DeliverMessage(Data, Mess) = 0;
end;
function gtkenterCB( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
var
Mess : TLMessage;
begin
Result := True;
EventTrace('enter', data);
Mess.msg := LM_ENTER;
Result := DeliverMessage(Data, Mess) = 0;
end;
function gtkleaveCB( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
var
Mess : TLMessage;
begin
Result := True;
EventTrace('leave', data);
Mess.msg := LM_LEAVE;
Result := DeliverMessage(Data, Mess) = 0;
end;
function gtkmovecursorCB( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
var
Mess : TLMessage;
begin
Result := True;
EventTrace('move-cursor', data);
Mess.msg := LM_MOVECURSOR;
Result := DeliverMessage(Data, Mess) = 0;
end;
function gtksize_allocateCB( widget: PGtkWidget; size :pGtkAllocation;
data: gPointer) : GBoolean; cdecl;
var
PosMsg : TLMWindowPosChanged;
SizeMsg: TLMSize;
MoveMsg: TLMMove;
Dummy: TPoint;
OldLeft, OldTop, OldWidth, OldHeight: integer;
TopLeftChanged, WidthHeightChanged: boolean;
// DummyWidget: PGtkWidget;
// DummyW, DummyH, DummyD: integer;
begin
EventTrace('size-allocate', data);
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;
end else begin
OldLeft:=0;
OldTop:=0;
OldWidth:=0;
OldHeight:=0;
end;
New(PosMsg.WindowPos);
try
with PosMsg.WindowPos^ do
begin
if TObject(data) is TWinControl then begin
hWnd := TWinControl(data).Handle;
if TObject(data) is TCustomForm then begin
{ writeln('[gtksize_allocateCB] CUSTOMFORM AAA1 ************ ',
TCustomForm(Data).Name,' Widget=',HexStr(Cardinal(Widget),8),
' ',TControl(Data).Left,',',TControl(Data).Top,' ',Size^.X,',',Size^.Y);}
Dummy.X:=TControl(Data).Left;
Dummy.Y:=TControl(Data).Top;
if widget^.window<>nil then
try
gdk_window_get_root_origin(widget^.window, @Dummy.X, @Dummy.Y);
except
on E: Exception do writeln('This was gdk_window_get_root_origin: ',E.Message);
end;
Size^.X:=Dummy.X;
Size^.Y:=Dummy.Y;
{ writeln('[gtksize_allocateCB] CUSTOMFORM AAA2 ************ ',
TCustomForm(Data).Name,' Widget=',HexStr(Cardinal(Widget),8),
' ',TControl(Data).Left,',',TControl(Data).Top,' ',Size^.X,',',Size^.Y);}
{if widget^.window<>nil then begin
gdk_window_get_Position(widget^.window, @Dummy.X, @Dummy.Y);
writeln(' Position=',Dummy.X,',',Dummy.Y);
gdk_window_get_geometry(widget^.window, @Dummy.X, @Dummy.Y, @DummyW, @DummyH, @DummyD);
writeln(' Geometry=',Dummy.X,',',Dummy.Y,',',DummyW,',',DummyH,',',DummyD);
gdk_window_get_origin(widget^.window, @Dummy.X, @Dummy.Y);
writeln(' Origin=',Dummy.X,',',Dummy.Y);
gdk_window_get_deskrelative_origin(widget^.window, @Dummy.X, @Dummy.Y);
writeln(' deskrelative_Origin=',Dummy.X,',',Dummy.Y);
end;}
end;
end else
hWnd := 0;
hWndInsertAfter := 0;
x := Size^.X;
y := Size^.Y;
cx := Size^.Width;
cy := Size^.Height;
flags := 0;
end;
TopLeftChanged:=(OldLeft<>Size^.X) or (OldTop<>Size^.Y);
WidthHeightChanged:=(OldWidth<>Size^.Width) or (OldHeight<>Size^.Height);
{if PosMsg.WindowPos^.hWnd<>0 then begin
DummyWidget:=pgtkwidget(PosMsg.WindowPos^.hWnd);
DummyWidget := GetFixedWidget(DummyWidget);
if (DummyWidget = nil) then DummyWidget := pgtkwidget(PosMsg.WindowPos^.hWnd);
if (DummyWidget <> nil) and (DummyWidget^.Window<>nil) then begin
gdk_window_get_size(DummyWidget^.Window, @Dummy.X, @Dummy.Y);
writeln(' GGG1 ',TControl(Data).Name,':',TControl(Data).ClassName,' ',Size^.Width,' ',Size^.Height);
writeln(' GGG2 ',Dummy.X,',',Dummy.Y);
end;
end;}
if TopLeftChanged or WidthHeightChanged then begin
Assert(False, 'Trace:[gtksize_allocateCB] DeliverMessage LM_WINDOWPOSCHANGED');
//writeln('[gtksize_allocateCB] Sending LM_WINDOWPOSCHANGED message: Target=',TObject(Data).ClassName,' Left=',Size^.X,' Top=',Size^.Y,' Width=',Size^.Width,' Height=',Size^.Height);
Result := DeliverMessage(Data, PosMsg) = 0;
end;
finally
Dispose(PosMsg.WindowPos);
end;
{ If the message is not handled. A LM_SIZE and LM_MOVE should be sent
}
if (PosMsg.Result = 0) then
begin
if WidthHeightChanged then begin
with SizeMsg do
begin
Msg := LM_SIZE;
SizeType := Size_SourceIsInterface;
Width := Size^.Width;
Height := Size^.Height;
end;
Assert(False, 'Trace:[gtksize_allocateCB] DeliverMessage LM_SIZE');
Result := (DeliverMessage(Data, SizeMsg) = 0) or Result;
end;
if TopLeftChanged then begin
with MoveMsg do
begin
Msg := LM_MOVE;
MoveType := Move_SourceIsInterface;
XPos := Size^.X;
YPos := Size^.Y;
end;
Assert(False, 'Trace:[gtksize_allocateCB] DeliverMessage LM_MOVE');
Result := (DeliverMessage(Data, MoveMsg) = 0) or Result;
end;
end;
if (TObject(Data) is TWinControl)
and (not WidthHeightChanged) and (not TopLeftChanged) then begin
TWinControl(Data).DoAdjustClientRectChange;
end;
end;
function gtkswitchpage(widget: PGtkWidget; page: Pgtkwidget; pagenum : integer;
data: gPointer) : GBoolean; cdecl;
var
Mess : TLMNotify;
T : tagNMHDR;
begin
Result := True;
EventTrace('switch-page', data);
Mess.Msg := LM_NOTIFY;
//this is the
T.code := TCN_SELCHANGE;//(0-550)-1;
T.hwndfrom := longint(widget);
T.idfrom := pagenum; //use this to set pageindex to the correct page.
Mess.NMHdr := @T;
Result := DeliverMessage(Data, Mess) = 0;
end;
function gtkconfigureevent( widget: PGtkWidget; event : PgdkEventConfigure;
data: gPointer) : GBoolean; cdecl;
var
Allocation : PGtkAllocation;
begin
{ This signal is emitted for top level controls only, i.e. only controls
that are not children. Thus, we register this event only for forms.
This event is fired when the form is sized, moved or changes Z order.
TODO : We may yet have to figure a way how not to call the WindowPosChanged
twice in some cases. It may also be that this event is called whenever
one of the controls of the form gets resized !!! }
New(Allocation);
try
with Allocation^ do begin
X:= Event^.X;
Y:= Event^.Y;
Width:= Event^.Width;
Height:= Event^.Height;
end;
Result:= gtksize_allocateCB( Widget, Allocation, Data);
finally
Dispose(Allocation);
end;
end;
function gtkreleasedCB( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
var
Mess : TLMEssage;
begin
Result := True;
EventTrace('released', data);
Mess.msg := LM_RELEASED;
Result := DeliverMessage(Data, Mess) = 0;
end;
function gtkInsertText( widget: PGtkWidget; char : pChar; NewTextLength : Integer; Position : pgint; data: gPointer) : GBoolean; cdecl;
var
Msg : TLMInsertText;
I : Integer;
begin
Result := True;
EventTrace('Insert Text', data);
Msg.Msg := LM_INSERTTEXT;
Msg.NewText := '';
For I := 0 to NewTextLength - 1 do
Msg.NewText := Msg.Newtext+Char[i];
//Msg.NewText := String(Char);
Msg.Length := NewTextLength;
Msg.Position := Position^;
Msg.Userdata := data;
Result:= DeliverMessage(Data, Msg) = 0;
end;
function gtkDeleteText( widget: PGtkWidget; Startpos, EndPos : Integer; data: gPointer) : GBoolean; cdecl;
var
Mess : TLMessage;
begin
EventTrace('Delete Text', data);
Mess.msg := LM_DELETETEXT;
Result:= DeliverMessage(Data, Mess) = 0;
end;
function gtkSetEditable( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
var
Mess : TLMessage;
begin
EventTrace('Set Editable', data);
Mess.msg := LM_SETEDITABLE;
Result:= DeliverMessage(Data, Mess) = 0;
end;
function gtkMoveWord( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
var
Mess : TLMessage;
begin
EventTrace('Move Word', data);
Mess.msg := LM_MOVEWORD;
Result:= DeliverMessage(Data, Mess) = 0;
end;
function gtkMovePage( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
var
Mess : TLMessage;
begin
EventTrace('Move Page', data);
Mess.msg := LM_MOVEPAGE;
Result:= DeliverMessage(Data, Mess) = 0;
end;
function gtkMoveToRow( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
var
Mess : TLMessage;
begin
EventTrace('Move To Row!!', data);
Mess.msg := LM_MOVETOROW;
Result:= DeliverMessage(Data, Mess) = 0;
end;
function gtkMoveToColumn( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
var
Mess : TLMessage;
begin
EventTrace('MoveToColumn', data);
Mess.msg := LM_MOVETOCOLUMN;
Result:= DeliverMessage(Data, Mess) = 0;
end;
function gtkKillChar( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
var
Mess : TLMessage;
begin
EventTrace('Kill Char', data);
Mess.msg := LM_KILLCHAR;
Result:= DeliverMessage(Data, Mess) = 0;
end;
function gtkKillWord( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
var
Mess : TLMessage;
begin
EventTrace('Kill Word', data);
Mess.msg := LM_KILLWORD;
Result:= DeliverMessage(Data, Mess) = 0;
end;
function gtkKillLine( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
var
Mess : TLMessage;
begin
EventTrace('Kill Line', data);
Mess.msg := LM_KILLLINE;
Result:= DeliverMessage(Data, Mess) = 0;
end;
function gtkCutToClip( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
var
Mess : TLMessage;
begin
EventTrace('Cut to clip', data);
Mess.msg := LM_CUTTOCLIP;
Result:= DeliverMessage(Data, Mess) = 0;
end;
function gtkCopyToClip( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
var
Mess : TLMessage;
begin
EventTrace('Copy to Clip', data);
Mess.msg := LM_COPYTOCLIP;
Result:= DeliverMessage(Data, Mess) = 0;
end;
function gtkPasteFromClip( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
var
Mess : TLMessage;
begin
EventTrace('Paste from clip', data);
Mess.msg := LM_PASTEFROMCLIP;
Result:= DeliverMessage(Data, Mess) = 0;
end;
(*
function gtkMoveResize(widget: PGtkWidget; X,Y,Width,Height : pgInt; data: gPointer) : GBoolean; cdecl;
var
msg : TLMResize;
begin
Result := True;
EventTrace('move_resize', data);
msg.msg := LM_MOVERESIZE;
Msg.Left := X^;
Msg.Top := Y^;
Msg.Width := Width^;
Msg.Height := Height^;
Msg.Userdata := Data;
if TObject(data) is TControl
then TControl(data).WindowProc(TLMessage(msg))
else TObject(data).Dispatch(msg);
end;
*)
function gtkvaluechanged ( widget: PGtkWidget; data : gPointer) : GBoolean; cdecl;
var
Mess : TLMessage;
begin
EventTrace('Value changed', data);
Mess.msg := LM_CHANGED;
Result := DeliverMessage(Data, Mess) = 0;
end;
{------------------------------------------------------------------------------
Method: gtkTimerCB
Params: Data - pointer TGtkITimerInfo structure
Returns: 1 - 1 tells gtk to restart the timer
0 - 0 will stop the gtk timer
Callback for gtk timer. Depending on "data" either user-callback function
will be called or a timer message will be delivered.
WARNING: There seems to be a bug in gtk-1.2.x which breaks
gtk_timeout_remove so we have to dispose data here & return 0
(s.a. KillTimer).
------------------------------------------------------------------------------}
function gtkTimerCB(Data: gPointer): gint; cdecl;
var
Mess : TLMessage;
begin
EventTrace ('TimerCB', nil);
Result := 1; // assume: timer will continue
if PGtkITimerinfo(Data)^.TimerFunc <> nil
then begin // Call users timer function
PGtkITimerinfo(Data)^.TimerFunc(PGtkITimerinfo(Data)^.Handle,
LM_TIMER,
PGtkITimerinfo(Data)^.IDEvent,
0{WARN: should be: GetTickCount});
end
else if (pointer (PGtkITimerinfo(Data)^.Handle) <> nil)
then begin // Handle through default message handler
Mess.msg := LM_TIMER;
Mess.WParam := PGtkITimerinfo(Data)^.IDEvent;
Mess.LParam := LongInt (PGtkITimerinfo(Data)^.TimerFunc);
DeliverMessage (Pointer (PGtkITimerinfo(Data)^.Handle), Mess);
end
else begin
result := 0; // stop timer
FOldTimerData.Remove(Data);
dispose (PGtkITimerinfo(Data)); // free memory with timer data
end;
end;
function gtkFocusInNotifyCB (widget : PGtkWidget; event : PGdkEvent; data : gpointer) : GBoolean; cdecl;
var
MessI : TLMEnter;
begin
//writeln('[gtkFocusInNotifyCB] ',TObject(data).ClassName);
EventTrace ('FocusInNotify (alias Enter)', data);
MessI.msg := LM_Enter;
Result:= DeliverMessage(Data, MessI) = 0;
end;
function gtkFocusOutNotifyCB (widget : PGtkWidget; event : PGdkEvent; data : gpointer) : GBoolean; cdecl;
var
MessI : TLMExit;
begin
//writeln('[gtkFocusOutNotifyCB] ',TObject(data).ClassName);
EventTrace ('FocusOutNotify (alias Exit)', data);
MessI.msg := LM_Exit;
Result:= DeliverMessage(Data, MessI) = 0;
end;
{
Msg : Cardinal;
ScrollCode : SmallInt;
Pos : SmallInt;
ScrollBar : HWND;
Result : LongInt;
}
function GTKHScrollCB(Adjustment: PGTKAdjustment; data: GPointer): GBoolean; cdecl;
var
Msg: TLMHScroll;
OldValue,
V, U, {L,}
StepI, PageI{, Page}: Integer;
Scroll: PGTKHScrollBar;
X, Y: GInt;
Mask: TGdkModifierType;
begin
Assert(False, Format('Trace:[GTKHScrollCB] Value: %d', [Round(Adjustment^.Value)]));
OldValue := Integer(gtk_object_get_data(PGTKObject(Adjustment), 'OldValue'));
gtk_object_set_data(PGTKObject(Adjustment), 'OldValue', Pointer(Round(Adjustment^.Value)));
Scroll := gtk_object_get_data(PGTKObject(Adjustment), 'ScrollBar');
// Get rounded values
with Adjustment^ do
begin
V := Round(Value);
U := Round(Upper);
//L := Round(Lower);
StepI := Round(Step_Increment);
PageI := Round(Page_Increment);
//Page := Round(Page_Size);
end;
// get keystates
if Scroll <> nil
then gdk_window_get_pointer(PGTKWidget(Scroll)^.Window, @X, @Y, @Mask);
with Msg do
begin
msg := LM_HSCROLL;
// Get scrollcode
if ssLeft in GTKEventState2ShiftState(Mask)
then ScrollCode := SB_THUMBTRACK
else if V - OldValue = StepI
then ScrollCode := SB_LINERIGHT
else if OldValue - V = StepI
then ScrollCode := SB_LINELEFT
else if V - OldValue = PageI
then ScrollCode := SB_PAGERIGHT
else if OldValue - V = PageI
then ScrollCode := SB_PAGELEFT
else if V >= U
then ScrollCode := SB_ENDSCROLL
else ScrollCode := SB_THUMBPOSITION;
Pos := V;
ScrollBar := HWND(Scroll);
end;
Result := DeliverMessage(Data, Msg) = 0;
end;
function GTKVScrollCB(Adjustment: PGTKAdjustment; data: GPointer): GBoolean; cdecl;
var
Msg: TLMVScroll;
OldValue,
V, U, {L,}
StepI, PageI{, Page}: Integer;
Scroll: PGTKHScrollBar;
X, Y: GInt;
Mask: TGdkModifierType;
begin
Assert(False, Format('Trace:[GTKVScrollCB] Value: %d', [Round(Adjustment^.Value)]));
OldValue := Integer(gtk_object_get_data(PGTKObject(Adjustment), 'OldValue'));
gtk_object_set_data(PGTKObject(Adjustment), 'OldValue', Pointer(Round(Adjustment^.Value)));
Scroll := gtk_object_get_data(PGTKObject(Adjustment), 'ScrollBar');
// Get rounded values
with Adjustment^ do
begin
V := Round(Value);
U := Round(Upper);
//L := Round(Lower);
StepI := Round(Step_Increment);
PageI := Round(Page_Increment);
//Page := Round(Page_Size);
end;
// get keystates
if Scroll <> nil
then gdk_window_get_pointer(PGTKWidget(Scroll)^.Window, @X, @Y, @Mask);
with Msg do
begin
msg := LM_VSCROLL;
// Get scrollcode
if ssLeft in GTKEventState2ShiftState(Mask)
then ScrollCode := SB_THUMBTRACK
else if V - OldValue = StepI
then ScrollCode := SB_LINEDOWN
else if OldValue - V = StepI
then ScrollCode := SB_LINEUP
else if V - OldValue = PageI
then ScrollCode := SB_PAGEDOWN
else if OldValue - V = PageI
then ScrollCode := SB_PAGEUP
else if V >= U
then ScrollCode := SB_ENDSCROLL
else ScrollCode := SB_THUMBPOSITION;
Pos := V;
ScrollBar := HWND(Scroll);
end;
Result := DeliverMessage(Data, Msg) = 0;
end;
{------------------------------------------------------------------------------
Function: GTKKeySnooper
Params: Widget: The widget for which this event is fired
Event: The keyevent data
FuncData: the user parameter passed when the snooper was installed
Returns: True if other snoopers shouldn't handled
Keeps track of which keys are pressed. The keycode is casted to a pointer and
if it exists in the KeyStateList, it is pressed.
------------------------------------------------------------------------------}
function GTKKeySnooper(Widget: PGtkWidget; Event: PGdkEventKey; FuncData: gPointer): gInt; cdecl;
type
PList = ^TList;
var
//Msg: TLMKey;
KeyCode, VirtKeyCode: Word;
ListCode: Integer;
Toggle, Extended, SysKey: Boolean;
ShiftState: TShiftState;
KeyStateList: TList;
procedure UpdateExtraKeyState(ListCode: integer; Pressed: boolean);
begin
if Pressed then begin
if KeyStateList.IndexOf(Pointer(ListCode)) = -1 then begin
KeyStateList.Add(Pointer(ListCode));
end;
end else begin
KeyStateList.Remove(Pointer(ListCode));
// just remove the togglekey if present
KeyStateList.Remove(Pointer(ListCode or KEYMAP_TOGGLE));
// just remove the extendedkey if present
KeyStateList.Remove(Pointer(ListCode or KEYMAP_EXTENDED));
end;
end;
begin
GetGTKKeyInfo(Event, KeyCode, VirtKeyCode, SysKey, Extended, Toggle);
KeyStateList:=PList(FuncData)^;
// update extra keys like Ctrl, Shift, Alt
ShiftState := GTKEventState2ShiftState(Event^.State);
UpdateExtraKeyState(VK_CONTROL,ssCtrl in ShiftState);
UpdateExtraKeyState(VK_SHIFT,ssShift in ShiftState);
UpdateExtraKeyState(VK_MENU,ssAlt in ShiftState);
with Event^ do
begin
ListCode:=KeyToListCode(KeyCode, VirtKeyCode, Extended);
case theType of
GDK_KEY_PRESS:
begin
if KeyStateList.IndexOf(Pointer(ListCode)) = -1
then begin
KeyStateList.Add(Pointer(ListCode));
if Toggle then KeyStateList.Add(Pointer(ListCode or KEYMAP_TOGGLE));
end;
//else WriteLn(Format('WARNING: [GTKKeySnooper] Pressed key (0x%x) already pressed (LC=0x%x)', [KeyCode, ListCode]));
end;
GDK_KEY_RELEASE:
begin
{if KeyStateList.Remove(Pointer(ListCode)) = -1 then
WriteLn(Format('WARNING: [GTKKeySnooper] Released key (0x%x) not pressed (LC=0x%x)', [KeyCode, ListCode]));}
KeyStateList.Remove(Pointer(ListCode));
// just remove the togglekey if present
KeyStateList.Remove(Pointer(ListCode or KEYMAP_TOGGLE));
end;
else
WriteLn(Format('ERROR: [GTKKeySnooper] Got unknown event %d', [theType]));
end;
Assert(False, Format('trace:' +
// WriteLN(Format(
'[GTKKeySnooper] Type %d, window $%x, send_event %d, time %d, state %d, keyval %d, length %d, string %s',
[ thetype, Integer(window), send_event, time, state, keyval, length, thestring])
);
end;
Result := 0;
end;
function gtkyearchanged(Widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
var
MSG: TLMessage;
begin
Result := True;
EventTrace('year changed', data);
MSG.Msg := LM_YEARCHANGED;
Result := DeliverPostMessage(Data, MSG);
end;
{------------------------------------------------------------------------------
ClipboardSelectionReceivedHandler
copy the received selection data record and buffer to
internal record and buffer (ClipboardSelectionData)
------------------------------------------------------------------------------}
procedure ClipboardSelectionReceivedHandler(TargetWidget: PGtkWidget;
SelectionData: PGtkSelectionData; TimeID: cardinal; Data: Pointer); cdecl;
var TempBuf: Pointer;
c: PClipboardEventData;
i: integer;
begin
// at any time there can be several requests
// find the request with the correct TimID
i:=ClipboardSelectionData.Count-1;
while (i>=0) do begin
c:=PClipboardEventData(ClipboardSelectionData[i]);
if c^.TimeID=TimeID then break;
dec(i);
end;
{$IFDEF DEBUG_CLIPBOARD}
writeln('[ClipboardSelectionReceivedHandler] TimeID=',TimeID,' ',i>=0);
{$ENDIF}
if i<0 then exit;
// free old data
if (c^.Data.Data<>nil) then FreeMem(c^.Data.Data);
// copy the information
c^.Data:=SelectionData^;
// copy the raw data to an internal buffer (the gtk buffer will be destroyed
// right after this event)
if (c^.Data.Data<>nil)
and (c^.Data.Length>0) then begin
GetMem(TempBuf,c^.Data.Length);
Move(c^.Data.Data^,TempBuf^,c^.Data.Length);
c^.Data.Data:=TempBuf;
{$IFDEF DEBUG_CLIPBOARD}
writeln('[ClipboardSelectionReceivedHandler] ',ord(PChar(c^.Data.Data)[0]));
{$ENDIF}
end else
c^.Data.Data:=nil;
end;
{------------------------------------------------------------------------------
ClipboardSelectionRequestHandler
This signal is emitted if someone requests the clipboard data
Since the lcl clipboard caches all requests this will typically be another
application
------------------------------------------------------------------------------}
procedure ClipboardSelectionRequestHandler(TargetWidget: PGtkWidget;
SelectionData: PGtkSelectionData; Info: cardinal; TimeID: cardinal;
Data: Pointer); cdecl;
type
PGdkAtom = ^TGdkAtom;
var ClipboardType: TClipboardType;
MemStream: TMemoryStream;
FormatID: cardinal;
Buffer: Pointer;
BufLength: integer;
P: PChar;
BitCount: integer;
//s: string;
begin
{$IFDEF DEBUG_CLIPBOARD}
writeln('*** [ClipboardSelectionRequestHandler] START');
{$ENDIF}
if SelectionData^.Target=0 then exit;
for ClipboardType:=Low(TClipboardType) to High(TClipboardType) do
if SelectionData^.Selection=ClipboardTypeAtoms[ClipboardType] then begin
if Assigned(ClipboardHandler[ClipboardType]) then begin
// handler found for this of clipboard
// now create a stream and find a supported format
{$IFDEF DEBUG_CLIPBOARD}
p:=gdk_atom_name(SelectionData^.Target);
writeln('[ClipboardSelectionRequestHandler] ',ClipboardTypeName[ClipboardType],' Format=',p,' ID=',SelectionData^.Target);
g_free(p);
{$ENDIF}
MemStream:=TMemoryStream.Create;
try
// the gtk-interface provides autiomatically some formats, that the lcl
// does not know. Wrapping them to lcl formats ...
FormatID:=SelectionData^.Target;
if ((FormatID=gdk_atom_intern('COMPOUND_TEXT',1))
and (ClipboardExtraGtkFormats[ClipboardType][gfCOMPOUND_TEXT]))
or ((FormatID=gdk_atom_intern('STRING',1))
and (ClipboardExtraGtkFormats[ClipboardType][gfSTRING]))
or ((FormatID=gdk_atom_intern('TEXT',1))
and (ClipboardExtraGtkFormats[ClipboardType][gfTEXT]))
then
FormatID:=gdk_atom_intern('text/plain',0);
{$IFDEF DEBUG_CLIPBOARD}
writeln('[ClipboardSelectionRequestHandler] FormatID=',FormatID,' CompoundText=',gdk_atom_intern('COMPOUND_TEXT',1),' ',ClipboardExtraGtkFormats[ClipboardType][gfCOMPOUND_TEXT]);
{$ENDIF}
// get the requested data by calling the handler for this clipboard type
ClipboardHandler[ClipboardType](FormatID,MemStream);
MemStream.Position:=0;
// build clipboard data for gtk
Buffer:=nil;
BufLength:=0;
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
begin
// transform text/plain to COMPOUND_TEXT
P:=StrAlloc(MemStream.Size+1);
MemStream.Read(P^,MemStream.Size);
P[MemStream.Size]:=#0;
gdk_string_to_compound_text(P,@SelectionData^.theType,
@SelectionData^.Format,@Buffer,@BufLength);
StrDispose(P);
gtk_selection_data_set(SelectionData,SelectionData^.Target,
SelectionData^.Format,Buffer,BufLength);
gdk_free_compound_text(Buffer);
exit;
end;
end;
if Buffer=nil then begin
{$IFDEF DEBUG_CLIPBOARD}
writeln('[ClipboardSelectionRequestHandler] Default MemStream.Size=',MemStream.Size);
{$ENDIF}
BufLength:=MemStream.Size;
if MemStream.Size>0 then begin
GetMem(Buffer,MemStream.Size);
MemStream.Read(Buffer^,MemStream.Size);
{SetLength(s,MemStream.Size);
MemStream.Position:=0;
MemStream.Read(s[1],MemStream.Size);
writeln(' >>> "',s,'"');}
end;
end;
{$IFDEF DEBUG_CLIPBOARD}
writeln('[ClipboardSelectionRequestHandler] Len=',BufLength);
{$ENDIF}
gtk_selection_data_set(SelectionData,SelectionData^.Target,BitCount,
Buffer,BufLength);
if Buffer<>nil then
FreeMem(Buffer);
finally
MemStream.Free;
end;
end;
break;
end;
end;
{------------------------------------------------------------------------------
ClipboardSelectionLostOwnershipHandler
This signal is emitted if another application gets the clipboard ownership.
------------------------------------------------------------------------------}
function ClipboardSelectionLostOwnershipHandler(TargetWidget: PGtkWidget;
EventSelection: PGdkEventSelection; Data: Pointer): cardinal; cdecl;
var ClipboardType: TClipboardType;
begin
//writeln('*** [ClipboardSelectionLostOwnershipHandler] ',hexstr(cardinal(targetwidget),8));
for ClipboardType:=Low(TClipboardType) to High(TClipboardType) do
if EventSelection^.Selection=ClipboardTypeAtoms[ClipboardType] then begin
{$IFDEF DEBUG_CLIPBOARD}
writeln('*** [ClipboardSelectionLostOwnershipHandler] ',ClipboardTypeName[ClipboardType]);
{$ENDIF}
if (ClipboardWidget<>nil)
and (gdk_selection_owner_get(ClipboardTypeAtoms[ClipboardType])
<> ClipboardWidget^.window)
and Assigned(ClipboardHandler[ClipboardType]) then begin
// handler found for this type of clipboard
{$IFDEF DEBUG_CLIPBOARD}
writeln('[ClipboardSelectionLostOwnershipHandler] ',ClipboardTypeName[ClipboardType]);
{$ENDIF}
ClipboardHandler[ClipboardType](0,nil);
ClipboardHandler[ClipboardType]:=nil;
end;
break;
end;
Result:=1;
end;
{$I gtkDragCallback.inc}
{$I gtkListViewCallback.inc}
{$IFDEF ASSERT_IS_ON}
{$UNDEF ASSERT_IS_ON}
{$C-}
{$ENDIF}
{ =============================================================================
$Log$
Revision 1.69 2002/04/22 13:07:45 lazarus
MG: fixed AdjustClientRect of TGroupBox
Revision 1.68 2002/04/04 12:25:02 lazarus
MG: changed except statements to more verbosity
Revision 1.67 2002/03/31 22:01:37 lazarus
MG: fixed unreleased/unpressed Ctrl/Alt/Shift
Revision 1.66 2002/03/29 19:11:38 lazarus
Added Triple Click
Shane
Revision 1.65 2002/03/27 00:33:54 lazarus
MWE:
* Cleanup in lmessages
* Added Listview selection and notification events
+ introduced commctrl
Revision 1.64 2002/03/25 17:59:20 lazarus
GTK Cleanup
Shane
Revision 1.63 2002/03/23 19:05:52 lazarus
MG: pascal lowercase for open new unit
Revision 1.62 2002/03/16 21:40:55 lazarus
MG: reduced size+move messages between lcl and interface
Revision 1.61 2002/03/14 18:12:46 lazarus
Mouse events fixes.
Revision 1.60 2002/03/13 22:48:16 lazarus
Constraints implementation (first cut) and sizig - moving system rework to
better match Delphi/Kylix way of doing things (the existing implementation
worked by acident IMHO :-)
Revision 1.59 2002/01/01 18:38:36 lazarus
MG: more wmsize messages :(
Revision 1.58 2002/01/01 15:50:16 lazarus
MG: fixed initial component aligning
Revision 1.57 2001/12/28 15:12:02 lazarus
MG: LM_SIZE and LM_MOVE messages are now send directly, not queued
Revision 1.56 2001/12/17 11:09:48 lazarus
MG: fixed typed but not selected filename in TOpenDialog
Revision 1.55 2001/12/12 20:45:30 lazarus
MG: added non existing filename to multiselection in TOpenDialog
Revision 1.54 2001/12/12 20:19:19 lazarus
Modified the the GTKFileSelection so that it will handle and use
CTRL and SHIFT keys in a fashion similar to Windows.
Revision 1.53 2001/12/12 15:12:31 lazarus
MG: added file path to files in TOpenDialog
Revision 1.52 2001/12/12 08:29:21 lazarus
Add code to allow TOpenDialog to do multiple line selects. MAH
Revision 1.51 2001/12/07 20:12:15 lazarus
Added a watch dialog.
Shane
Revision 1.50 2001/12/05 18:23:47 lazarus
Added events to Calendar
Shane
Revision 1.49 2001/11/30 16:41:59 lazarus
Improved hints with overlapping windows.
Shane
Revision 1.48 2001/11/29 18:41:27 lazarus
Improved the double click.
Shane
Revision 1.47 2001/11/21 19:32:32 lazarus
TComboBox can now be moved in FormEditor
Shane
Revision 1.46 2001/11/21 14:55:31 lazarus
Changes for combobox to receive butondown and up events
DblClick events now working.
Shane
Revision 1.45 2001/11/20 17:20:45 lazarus
Fixed designer problem with moving controls.
Can no longer drag controls off the form.
Shane
Revision 1.44 2001/11/14 17:46:58 lazarus
Changes to make toggling between form and unit work.
Added BringWindowToTop
Shane
Revision 1.43 2001/11/12 19:32:23 lazarus
MG: fixed empty clipboard stream crashing bug
Revision 1.42 2001/11/12 16:56:08 lazarus
MG: CLIPBOARD
Revision 1.41 2001/11/09 19:14:24 lazarus
HintWindow changes
Shane
Revision 1.40 2001/11/01 21:30:35 lazarus
Changes to Messagebox.
Added line to CodeTools to prevent duplicate USES entries.
Revision 1.39 2001/10/31 16:29:22 lazarus
Fixed the gtk mousemove bug where the control gets the coord's based on it's parent instead of itself.
Shane
Revision 1.38 2001/10/16 14:19:13 lazarus
MG: added nvidia opengl support and a new opengl example from satan
Revision 1.35 2001/10/09 09:46:58 lazarus
MG: added codetools, fixed synedit unindent, fixed MCatureHandle
Revision 1.34 2001/10/03 21:03:02 lazarus
MG: reduced repaints
Revision 1.32 2001/06/16 09:14:38 lazarus
MG: added lazqueue and used it for the messagequeue
Revision 1.31 2001/06/14 14:57:59 lazarus
MG: small bugfixes and less notes
Revision 1.30 2001/04/06 22:25:14 lazarus
* TTimer uses winapi-interface now instead of sendmessage-interface, stoppok
Revision 1.29 2001/03/27 11:11:13 lazarus
MG: fixed mouse msg, added filedialog initialdir
Revision 1.28 2001/03/26 14:58:31 lazarus
MG: setwindowpos + bugfixes
Revision 1.26 2001/03/19 14:44:22 lazarus
MG: fixed many unreleased DC and GDIObj bugs
Revision 1.23 2001/02/28 13:17:34 lazarus
Added some debug code for the top,left reporting problem.
Shane
Revision 1.22 2001/02/20 16:53:27 lazarus
Changes for wordcompletion and many other things from Mattias.
Shane
Revision 1.21 2001/01/31 21:16:45 lazarus
Changed to TCOmboBox focusing.
Shane
Revision 1.20 2001/01/30 18:15:02 lazarus
Added code for TStatusBar
I'm now capturing WMPainT and doing the drawing myself.
Shane
Revision 1.19 2001/01/28 03:51:42 lazarus
Fixed the problem with Changed for ComboBoxs
Shane
Revision 1.18 2001/01/24 23:26:40 lazarus
MWE:
= moved some types to gtkdef
+ added WinWidgetInfo
+ added some initialization to Application.Create
Revision 1.17 2001/01/24 03:21:03 lazarus
Removed gtkDrawDefualt signal function from gtkcallback.inc
It was no longer used.
Shane
Revision 1.16 2001/01/23 23:33:55 lazarus
MWE:
- Removed old LM_InvalidateRect
- did some cleanup in old code
+ added some comments on gtkobject data (gtkproc)
Revision 1.15 2001/01/12 18:10:54 lazarus
Changes for keyevents in the editor.
Shane
Revision 1.14 2001/01/11 20:16:47 lazarus
Added some TImageList code.
Added a bookmark resource with 10 resource images.
Removed some of the IFDEF's in mwCustomEdit around the inherited code.
Shane
Revision 1.13 2001/01/10 23:53:30 lazarus
MWE:
~ minor change
Revision 1.12 2001/01/10 20:12:29 lazarus
Added the Nudge feature to the IDE.
Shane
Revision 1.11 2001/01/09 18:23:21 lazarus
Worked on moving controls. It's just not working with the X and Y coord's I'm getting.
Shane
Revision 1.10 2001/01/04 15:09:05 lazarus
Tested TCustomEdit.Readonly, MaxLength and CharCase.
Shane
Revision 1.9 2000/12/19 18:43:13 lazarus
Removed IDEEDITOR. This causes the PROJECT class to not function.
Saving projects no longer works.
I added TSourceNotebook and TSourceEditor. They do all the work for saving/closing/opening units. Somethings work but they are in early development.
Shane
Revision 1.8 2000/11/29 21:22:35 lazarus
New Object Inspector code
Shane
Revision 1.7 2000/10/09 22:50:32 lazarus
MWE:
* fixed some selection code
+ Added selection sample
Revision 1.6 2000/09/10 23:08:31 lazarus
MWE:
+ Added CreateCompatibeleBitamp function
+ Updated TWinControl.WMPaint
+ Added some checks to avoid gtk/gdk errors
- Removed no fixed warning from GetDC
- Removed some output
Revision 1.5 2000/08/28 14:23:49 lazarus
Added a few files for the start of creating classes for the editor. [SHANE]
Revision 1.4 2000/08/11 14:59:09 lazarus
Adding all the Synedit files.
Changed the GDK_KEY_PRESS and GDK_KEY_RELEASE stuff to fix the problem in the editor with the shift key being ignored.
Shane
Revision 1.3 2000/08/10 10:55:45 lazarus
Changed TCustomDialog to TCommonDialog
Shane
Revision 1.2 2000/07/30 21:48:33 lazarus
MWE:
= Moved ObjectToGTKObject to GTKProc unit
* Fixed array checking in LoadPixmap
= Moved LM_SETENABLED to API func EnableWindow and EnableMenuItem
~ Some cleanup
Revision 1.1 2000/07/13 10:28:29 michael
+ Initial import
}
Reference in New Issue View Git Blame Copy Permalink