paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-29 14:25:12 +02:00
Code Issues Packages Projects Releases Wiki Activity
8b07b4a5da
lazarus/lcl/interfaces/gtk/gtkobject.inc
lazarus 8b07b4a5da MWE: 
* More delphi compatibility added/updated to TListView
  * Introduced TDebugger.locals
  * Moved breakpoints dialog to debugger dir
  * Changed breakpoints dialog to read from resource

git-svn-id: trunk@685 -
2002-02-09 01:45:12 +00:00

4148 lines
150 KiB
PHP
Raw Blame History

(******************************************************************************
TGTKObject
******************************************************************************)
{$IFOPT C-}
// Uncomment for local trace
// {$C+}
// {$DEFINE ASSERT_IS_ON}
{$ENDIF}
const
BOOL_RESULT: array[Boolean] of String = ('False', 'True');
{------------------------------------------------------------------------------
Method: TGtkObject.Create
Params: None
Returns: Nothing
Contructor for the class.
------------------------------------------------------------------------------}
constructor TGtkObject.Create;
begin
inherited Create;
FKeyStateList := TList.Create;
FDeviceContexts := TDynHashArray.Create(-1);
FGDIObjects := TDynHashArray.Create(-1);
FMessageQueue := TLazQueue.Create;
FPaintMessages := TDynHashArray.Create(-1);
FPaintMessages.OwnerHashFunction := @HashPaintMessage;
FAccelGroup := gtk_accel_group_new();
FTimerData := TList.Create;
FDefaultFont:= nil;
end;
{------------------------------------------------------------------------------
Method: Tgtkobject.Destroy
Params: None
Returns: Nothing
Destructor for the class.
------------------------------------------------------------------------------}
destructor TgtkObject.Destroy;
const
GDITYPENAME: array[TGDIType] of String = ('gdiBitmap', 'gdiBrush'
,'gdiFont', 'gdiPen', 'gdiRegion');
var
n: Integer;
p: PMsg;
pTimerInfo : PGtkITimerinfo;
GDITypeCount: array[TGDIType] of Integer;
GDIType: TGDIType;
HashItem: PDynHashArrayItem;
QueueItem, OldQueueItem: PLazQueueItem;
begin
// tidy up the messages
QueueItem:=FMessageQueue.First;
while (QueueItem<>nil) do begin
p := PMsg(QueueItem^.Data);
if p^.Message=LM_PAINT then begin
//writeln('[TgtkObject.Destroy] freeing unused paint message ',HexStr(p^.WParam,8));
FPaintMessages.Remove(QueueItem);
ReleaseDC(0,P^.WParam);
Dispose(P);
OldQueueItem:=QueueItem;
QueueItem:=QueueItem^.Next;
FMessageQueue.Delete(OldQueueItem);
end else
QueueItem:=QueueItem^.Next;
end;
if FPaintMessages.Count>0 then begin
WriteLn('[TgtkObject.Destroy] WARNING: There are ',FPaintMessages.Count
,' unremoved LM_PAINT message links left.');
end;
if (FDeviceContexts.Count > 0)
then begin
WriteLN(Format('[TgtkObject.Destroy] WARNING: There are %d unreleased DCs, a detailed dump follows:' ,[FDeviceContexts.Count]));
n:=0;
write('[TgtkObject.Destroy] DCs: ');
HashItem:=FDeviceContexts.FirstHashItem;
while (n<7) and (HashItem<>nil) do
begin
write(' ',HexStr(Cardinal(HashItem^.Item),8));
HashItem:=HashItem^.Next;
inc(n);
end;
writeln();
end;
if (FGDIObjects.Count > 0)
then begin
WriteLN(Format('[TgtkObject.Destroy] WARNING: There are %d unreleased GDIObjects, a detailed dump follows:' ,[FGDIObjects.Count]));
for GDIType := Low(GDIType) to High(GDIType) do
begin
for GDIType := Low(GDIType) to High(GDIType) do
GDITypeCount[GDIType] := 0;
n:=0;
write('[TgtkObject.Destroy] GDIOs:');
HashItem := FGDIObjects.FirstHashItem;
while (HashItem <> nil) do
begin
if n < 7
then write(' ',HexStr(Cardinal(HashItem^.Item),8));
Inc(GDITypeCount[PGdiObject(HashItem^.Item)^.GDIType]);
HashItem := HashItem^.Next;
Inc(n);
end;
Writeln();
for GDIType := Low(GDIType) to High(GDIType) do
if GDITypeCount[GDIType] > 0
then WriteLN(Format('[TgtkObject.Destroy] %s: %d', [GDITYPENAME[GDIType], GDITypeCount[GDIType]]));
end;
end;
if FMessageQueue.Count > 0
then begin
WriteLN(Format('[TgtkObject.Destroy] WARNING: There are %d messages left in the queue! I''ll free them' ,[FMessageQueue.Count]));
while FMessageQueue.First<>nil do begin
p := PMsg(FMessageQueue.First^.Data);
Dispose(P);
FMessageQueue.Delete(FMessageQueue.First);
end;
end;
n := FTimerData.Count;
if (n > 0) then
begin
WriteLN(Format('[TgtkObject.Destroy] WARNING: There are %d TimerInfo structures left, I''ll free them' ,[n]));
while (n > 0) do
begin
dec (n);
pTimerInfo := PGtkITimerinfo (FTimerData.Items[n]);
Dispose (pTimerInfo);
FTimerData.Delete (n);
end;
end;
FMessageQueue.Free;
FPaintMessages.Free;
FDeviceContexts.Free;
FGDIObjects.Free;
FKeyStateList.Free;
FTimerData.Free;
gtk_accel_group_unref(FAccelGroup);
inherited Destroy;
end;
{------------------------------------------------------------------------------
Method: TGtkObject.HandleEvents
Params: None
Returns: Nothing
*Note: Handle all pending messages of the GTK engine
------------------------------------------------------------------------------}
procedure TgtkObject.HandleEvents;
var
Msg: TMsg;
p: pMsg;
begin
//gtk_main;
// first let gtk handle all its messages
while gtk_events_pending<>0 do
gtk_main_iteration_do(False);
// then handle our own messages
with FMessageQueue do
while First<>nil do
begin
p := PMsg(First^.Data);
Msg := p^;
if Msg.Message=LM_PAINT then
FPaintMessages.Remove(First);
Delete(First);
with Msg do
SendMessage(hWND, Message, WParam, LParam);
case Msg.Message of
LM_PAINT:
ReleaseDC(0,Msg.WParam);
end;
Dispose(p);
end;
end;
{------------------------------------------------------------------------------
Method: TGtkObject.WaitMessage
Params: None
Returns: Nothing
*Note: Passes execution control to the GTK engine
------------------------------------------------------------------------------}
procedure TgtkObject.WaitMessage;
begin
gtk_main_iteration_do(True);
end;
{------------------------------------------------------------------------------
Method: TGtkObject.DoEvents
Params: None
Returns: Nothing
*Note: Tells GTK Engine to process pending events
------------------------------------------------------------------------------}
procedure TgtkObject.DoEvents;
begin
// dont block waiting for an event
//gtk_main_iteration_do(False);
gtk_main_iteration;
end;
{------------------------------------------------------------------------------
Method: TGtkObject.AppTerminate
Params: None
Returns: Nothing
*Note: Tells GTK Engine to halt and destroy
------------------------------------------------------------------------------}
procedure TGtkObject.AppTerminate;
begin
gdk_Cursor_Destroy(Cursor_Watch);
gdk_Cursor_Destroy(Cursor_Arrow);
gdk_Cursor_Destroy(Cursor_Cross);
gdk_Cursor_Destroy(Cursor_Hand1);
gdk_Cursor_Destroy(Cursor_XTerm);
gdk_Cursor_Destroy(Cursor_StdArrow);
gdk_Cursor_Destroy(Cursor_HSplit);
gdk_Cursor_Destroy(Cursor_VSplit);
gdk_Cursor_Destroy(Cursor_SizeNWSE);
gdk_Cursor_Destroy(Cursor_SizeNS);
gdk_Cursor_Destroy(Cursor_SizeNESW);
gdk_Cursor_Destroy(Cursor_SizeWE);
gtk_object_unref(PGTKObject(FGTKToolTips));
FGTKToolTips := nil;
DeleteObject(FStockNullBrush);
DeleteObject(FStockBlackBrush);
DeleteObject(FStockLtGrayBrush);
DeleteObject(FStockGrayBrush);
DeleteObject(FStockDkGrayBrush);
DeleteObject(FStockWhiteBrush);
// MG: using gtk_main_quit is not a clean way to close
//gtk_main_quit;
end;
{------------------------------------------------------------------------------
Method: TGtkObject.Init
Params: None
Returns: Nothing
*Note: Initialite GTK engine
------------------------------------------------------------------------------}
procedure TGtkObject.Init;
var
LogBrush: TLogBrush;
//Attributes: TGdkWindowAttr;
//AttributesMask: gint;
FG,BG : TgdkColor; //foreground and background
begin
// initialize app level gtk engine
gtk_set_locale ();
// call init and pass cmd line args
gtk_init (@argc, @argv);
// Create default cursor types
Cursor_Watch := gdk_Cursor_New(gdk_Watch);
Cursor_Arrow := gdk_Cursor_New(gdk_Arrow);
Cursor_Cross := gdk_Cursor_New(gdk_Cross);
Cursor_Hand1 := gdk_Cursor_New(gdk_Hand1);
Cursor_XTerm := gdk_Cursor_New(gdk_XTerm);
Cursor_StdArrow := gdk_Cursor_New(GDK_LEft_Ptr);
Cursor_HSplit := gdk_Cursor_New(GDK_SB_H_DOUBLE_ARROW);
Cursor_VSplit := gdk_Cursor_New(GDK_SB_V_DOUBLE_ARROW);
Cursor_SizeNWSE := gdk_Cursor_New(GDK_TOP_LEFT_CORNER);
Cursor_SizeNS := gdk_Cursor_New(GDK_SB_V_DOUBLE_ARROW);
Cursor_SizeNESW := gdk_Cursor_New(GDK_BOTTOM_LEFT_CORNER);
Cursor_SizeWE := gdk_Cursor_New(GDK_SB_H_DOUBLE_ARROW);
gtk_key_snooper_install(@GTKKeySnooper, @FKeyStateList);
// Init tooltips
FGTKToolTips := gtk_tooltips_new;
gtk_object_ref(PGTKObject(FGTKToolTips));
gtk_toolTips_Enable(FGTKToolTips);
FG.red := $FFFF;
FG.Green := $FFFF;
fg.blue := $FFFF;
BG.REd := $4444;
bg.Green := $ffff;
bg.Blue := $1111;
gtk_toolTips_set_colors(FGTKToolTips,@FG,@BG);
// Init stock objects;
LogBrush.lbStyle := BS_NULL;
FStockNullBrush := CreateBrushIndirect(LogBrush);
LogBrush.lbStyle := BS_SOLID;
LogBrush.lbColor := $000000;
FStockBlackBrush := CreateBrushIndirect(LogBrush);
LogBrush.lbColor := $C0C0C0;
FStockLtGrayBrush := CreateBrushIndirect(LogBrush);
LogBrush.lbColor := $808080;
FStockGrayBrush := CreateBrushIndirect(LogBrush);
LogBrush.lbColor := $404040;
FStockDkGrayBrush := CreateBrushIndirect(LogBrush);
LogBrush.lbColor := $FFFFFF;
FStockWhiteBrush := CreateBrushIndirect(LogBrush);
// clipboard
ClipboardTypeAtoms[ctPrimarySelection]:=GDK_SELECTION_PRIMARY;
ClipboardTypeAtoms[ctSecondarySelection]:=GDK_SELECTION_SECONDARY;
ClipboardTypeAtoms[ctClipboard]:=gdk_atom_intern('CLIPBOARD',0);
end;
function TgtkObject.RecreateWnd(Sender: TObject): Integer;
var
aParent : TWinControl;
Begin
//could we just call IntSendMessage??
//destroy old widget
if TWinControl(Sender).HandleAllocated then begin
if MCaptureHandle=TWinControl(Sender).Handle then
MCaptureHandle:=0;
gtk_widget_destroy(PgtkWidget(TWinControl(Sender).Handle));
end;
aParent := TWinControl(Sender).Parent;
aParent.RemoveControl(TControl(Sender));
TWincontrol(Sender).Parent := nil;
TWincontrol(Sender).Parent := aParent;
//writeln('[TgtkObject.RecreateWnd] ',Sender.ClassName);
ResizeChild(Sender,TWinControl(Sender).Left,TWinControl(Sender).Top,
TWinControl(Sender).Width,TWinControl(Sender).Height);
ShowHide(Sender);
Result:=0;
End;
{------------------------------------------------------------------------------
Method: TGtkObject.IntSendMessage3
Params: LM_Message - message to be processed by GTK
Sender - sending control
data - pointer to (optional)
Returns: depends on the message and the sender
Processes messages from different components.
WARNING: the result of this function sometimes is not always really an
integer!!!!!
------------------------------------------------------------------------------}
function TgtkObject.IntSendMessage3(LM_Message : Integer; Sender : TObject;
data : pointer) : integer;
var
handle : hwnd; // handle of sender
pStr : PChar; // temporary string pointer, must be allocated/disposed when used!
Widget : PGtkWidget; // pointer to gtk-widget (local use when neccessary)
AParent : TWinControl; // only used twice, replace with typecasts!
Pixmap : pgdkPixMap;
box1 : pgtkWidget; // currently only used for TBitBtn
pixmapwid : pGtkWidget; // currently only used for TBitBtn, possibly replace with pixmap!!!!
pLabel : PgtkWidget; // currently only used as extra label-widget for TBitBtn
Num : Integer; // currently only used for LM_INSERTTOOLBUTTON and LM_ADDITEM
pStr2 : PChar; // currently only used for LM_INSERTTOOLBUTTON
GList : pGList; // Only used for listboxes, replace with widget!!!!!
SelectionMode : TGtkSelectionMode; // currently only used for listboxes
ListItem : PGtkListItem; // currently only used for listboxes
AddItemListItem : TListItem;
Rect : TRect;
FormIconGdiObject: PGdiObject; // currently only used by LM_SETFORMICON
QueueItem, OldQueueItem: PLazQueueItem; // currently only used by LM_DESTROY
MsgPtr : PMsg; // currently only used by LM_DESTROY
Count : Integer; //Used in TListView LM_LV_CHANGEITEM
Titles : Array [0..255] of PChar;
BitImage : TBitmap;
begin
Result := 0; //default value just in case nothing sets it
Assert(False, 'Trace:Message received');
if Sender <> nil then
Assert(False, Format('Trace: [TgtkObject.IntSendMessage3] %s --> Sent LM_Message: $%x (%s); Data: %d', [Sender.ClassName, LM_Message, GetMessageName(LM_Message), Integer(data)]));
// The following case is now split into 2 separate parts:
// 1st part should contain all messages which don't need the "handle" variable
// 2nd part has to contain all parts which need the handle
// Reason for this split are performance issues since we need RTTI to
// retrieve the handle
case LM_Message of
LM_Create : CreateComponent(Sender);
LM_SETCOLOR : SetColor(Sender);
LM_SETPixel : SetPixel(Sender,Data);
LM_GETPixel : GetPixel(Sender,Data);
LM_ShowHide :
begin
Assert(False, Format('Trace: [TgtkObject.IntSendMessage3] %s --> Show/Hide', [Sender.ClassNAme]));
ShowHide(Sender);
end;
LM_SetCursor : SetCursor(Sender);
LM_SetLabel : SetLabel(Sender,Data);
LM_GETVALUE : Result := GetValue (Sender, data);
LM_SETVALUE : Result := SetValue (Sender, data);
LM_SETPROPERTIES: Result := SetProperties(Sender);
{
LM_SETDESIGNING
Used in Main.pp. Used to set anything specifically needed when setting controls to Designing.
}
LM_SETDESIGNING : Begin //Result := SetDesigning(sender);
//trying to prevent some key actions....
//this didn't work....
//if not (csAcceptsControls in TControl(Sender).ControlStyle) then gtk_widget_set_sensitive(PgtkWidget(TWinControl(sender).Handle),False);
if (Sender is TCustomComboBox) then
begin
gtk_combo_disable_activate(PGTKCombo(TWinControl(sender).handle));
end;
end;
LM_RECREATEWND : Result := RecreateWnd(sender);
LM_ATTACHMENU: AttachMenu(Sender);
else begin
handle := hwnd(ObjectToGtkObject(Sender));
//??? if handle = nil then assert (false, Format ('Trace: [TgtkObject.IntSendMessage3] %s --> got handle=nil',[Sender.ClassName]));
Case LM_Message of
LM_SetText : SetText(PgtkWidget(Handle), Data);
LM_AddChild :
begin
Assert(False, 'Trace:Adding a child to Parent');
If (TWinControl(Sender).Parent is TToolbar) then
Begin
// Assert(False, Format('Trace: [TgtkObject.IntSendMessage3] %s --> %s ---calling INSERTBUTTON from Add Child', [AParent.ClassName, Sender.ClassNAme]));
exit;
end
else Begin
AParent := (Sender as TWinControl).Parent;
if Not Assigned(AParent) then
Begin
Assert(true, Format('Trace: [TgtkObject.IntSendMessage3] %s --> Parent is not assigned', [Sender.ClassName]));
end
else
Begin
Assert(False, Format('Trace: [TgtkObject.IntSendMessage3] %s --> Calling Add Child: %s', [AParent.ClassName, Sender.ClassNAme]));
AddChild(Pgtkwidget(AParent.Handle), PgtkWidget(Handle), AParent.Left, AParent.Top);
end;
end;
end;
{Used by:
TListView
}
LM_LV_DELETEITEM :
begin
if (Sender is TListView) then
begin
Num := Integer(data^);
Widget := PgtkWidget(Handle);//GetWidgetInfo(Pointer(Handle), True)^.ImplementationWidget;
gtk_clist_remove(PgtkCList(Widget),Num);
end;
end;
LM_LV_CHANGEITEM :
begin
if (Sender is TListView) then
begin
Widget := PgtkWidget(Handle);//GetWidgetInfo(Pointer(Handle), True)^.ImplementationWidget;
Num := Integer(data^);
AddItemListItem := TListview(sender).Items[Num];
pStr := StrAlloc(length(AddItemListItem.Caption) + 1);
StrPCopy(pStr, AddItemListItem.Caption);
gtk_clist_set_text(PgtkCList(Widget),num,0,pStr);
if (TListview(sender).SmallImages <> nil) and (TListItem(TListview(sender).Items[Num]).ImageIndex > -1)
then begin
if (TListItem(TListview(sender).Items[Num]).ImageIndex < TListview(sender).SmallImages.Count)
then begin
//draw image
BitImage := TBitmap.Create;
TListview(sender).SmallImages.GetBitmap(TListItem(TListview(sender).Items[Num]).ImageIndex,BitImage);
gtk_clist_set_pixtext(Pgtkclist(Widget),Num,0,pStr,3,pgdkPixmap(PgdiObject(BitImage.handle)^.GDIBitmapObject),nil);
end;
end;
StrDispose(pStr);
for count := 0 to AddItemListItem.SubItems.Count-1 do
begin
pStr := StrAlloc(length(AddItemListItem.SubItems.Strings[Count]) + 1);
StrPCopy(pStr, AddItemListItem.SubItems.Strings[Count]);
gtk_clist_set_text(PgtkCList(Widget),num,count+1,pStr);
StrDispose(pStr);
end;
end;
end;
LM_LV_ADDITEM :
begin
if (Sender is TListView) then
begin
Widget := PgtkWidget(Handle);//GetWidgetInfo(Pointer(Handle), True)^.ImplementationWidget;
//get last item and add it..
pStr := StrAlloc(length('Test') + 1);
StrPCopy(pStr, 'Test');
Titles[0] := pStr;
for Count := 1 to 255 do
Titles[Count] := nil;
Num := gtk_clist_append(PgtkCList(Widget),@Titles);
StrDispose(pStr);
AddItemListItem := TListView(sender).Items[TListView(sender).Items.Count-1];
if AddItemListItem <> nil then
Begin
gtk_clist_set_text(PgtkCList(Widget),num,0,@AddItemListItem.Caption);
end;
end;
end;
LM_BRINGTOFRONT:
begin
{ Assert(False, 'Trace:TODO:bringtofront');
//For now just hide and show again.
if (Sender is TControl) then begin
TControl(Sender).Parent.RemoveControl(TControl(Sender));
writeln('Removed control ', TControl(Sender).Name);
TControl(Sender).Parent.InsertControl(TControl(Sender));
writeln('Inserted control ', TControl(Sender).Name);
end;
}
if (Sender is TCustomForm) then
Begin
Widget := PgtkWidget(TCustomForm(Sender).Handle);
gdk_window_raise(Widget^.Window);
end;
end;
LM_BTNDEFAULT_CHANGED :
Begin
if (TButton(Sender).Default) and (GTK_WIDGET_CAN_DEFAULT(pgtkwidget(handle)))
then gtk_widget_grab_default(pgtkwidget(handle))
else gtk_widget_Draw_Default(pgtkwidget(Handle)); //this isn't right but I'm not sure what to call
end;
LM_DESTROY :
begin
if (Sender is TWinControl) or (Sender is TCommonDialog) then begin
//writeln('>>> LM_DESTROY ',Sender.Classname,' Sender=',HexStr(Cardinal(Sender),8),' Handle=',HexStr(Cardinal(Handle),8));
if Handle<>0 then begin
if MCaptureHandle=Handle then MCaptureHandle:=0;
if ClipboardWidget=PGtkWidget(Handle) then begin
// clipboard widget destroyed
if (Application<>nil)
and (Application.MainForm<>nil)
and (Application.MainForm.HandleAllocated)
and (Application.MainForm.Handle<>Handle) then
// there is still the main form left -> use it for clipboard
SetClipboardWidget(PGtkWidget(Application.MainForm.Handle))
else
// program closed -> close clipboard
SetClipboardWidget(nil);
end;
//writeln('>>> LM_DESTROY A ',Sender.Classname,' Sender=',HexStr(Cardinal(Sender),8),' Handle=',HexStr(Cardinal(Handle),8));
{
MG: Important:
If Sender is TForm and one of its components was focused by SetFocus then
the next line will produce a gtk warning. The PGtkWidget(Handle) is also
a dirty cast. If Sender is TForm, Handle is a PGtkWindow !
}
if gtk_type_is_a(gtk_object_type(PGtkObject(Handle)),
GTKAPIWidget_GetType)
then
DestroyCaret(Handle);
gtk_widget_destroy(PGtkWidget(Handle));
//writeln('>>> LM_DESTROY END ',Sender.Classname,' Sender=',HexStr(Cardinal(Sender),8),' Handle=',HexStr(Cardinal(Handle),8));
end;
// remove all remaining messages to this component
QueueItem:=FMessageQueue.First;
while (QueueItem<>nil) do begin
MsgPtr := PMsg(QueueItem^.Data);
if MsgPtr^.HWnd=Handle then begin
// remove message
if MsgPtr^.Message=LM_PAINT then begin
FPaintMessages.Remove(QueueItem);
ReleaseDC(0,MsgPtr^.WParam);
end;
Dispose(MsgPtr);
OldQueueItem:=QueueItem;
QueueItem:=QueueItem^.Next;
FMessageQueue.Delete(OldQueueItem);
end else
QueueItem:=QueueItem^.Next;
end;
end
else
Assert (False, Format ('Trace:Dont know how to destroy component %s', [sender.classname]));
end;
LM_DRAGINFOCHANGED :
Begin
(*
if ((Sender is TEdit) and((Sender as TEdit).DragMode = dmAutoMatic)) then
Begin
//drag and drop
gtk_drag_dest_set (p,
GTK_DEST_DEFAULT_ALL,
target_table, TargetEntrys - 1,
GDK_ACTION_COPY or GDK_ACTION_MOVE);
gtk_signal_connect( PgtkObject(p), 'drag_data_received',
TGTKSignalFunc( @edit_drag_data_received), Sender);
gtk_drag_source_set (p, GDK_BUTTON1_MASK,
target_table, TargetEntrys,
GDK_ACTION_COPY or GDK_ACTION_MOVE);
gtk_drag_source_set_icon (p,
gtk_widget_get_colormap (pgtkwidget(p)),
drag_icon, drag_mask);
gtk_signal_connect (GTK_OBJECT (p), 'drag_data_get',
GTK_SIGNAL_FUNC (@Edit_source_drag_data_get), Sender);
gtk_signal_connect (GTK_OBJECT (p), 'drag_data_delete',
GTK_SIGNAL_FUNC (@Edit_source_drag_data_delete), Sender);
end
else
Begin
//drag and drop
gtk_drag_dest_set (p,
GTK_DEST_DEFAULT_ALL,
target_table, TargetEntrys - 1,
GDK_ACTION_COPY or GDK_ACTION_MOVE);
gtk_signal_connect( PgtkObject(p), 'drag_data_received',
TGTKSignalFunc( @edit_drag_data_received), Sender);
gtk_drag_source_set (p, GDK_BUTTON1_MASK,
target_table, TargetEntrys,
GDK_ACTION_COPY or GDK_ACTION_MOVE);
gtk_drag_source_set_icon (p,
gtk_widget_get_colormap (pgtkwidget(p)),
drag_icon, drag_mask);
gtk_signal_connect (GTK_OBJECT (p), 'drag_data_get',
GTK_SIGNAL_FUNC (@Edit_source_drag_data_get), Sender);
gtk_signal_connect (GTK_OBJECT (p), 'drag_data_delete',
GTK_SIGNAL_FUNC (@Edit_source_drag_data_delete), Sender);
end;
*)
end;
//TBitBtn
LM_IMAGECHANGED, LM_LAYOUTCHANGED :
Begin
Assert(False, 'Trace:********************');
Assert(False, 'Trace:1');
box1 := gtk_object_get_data(pgtkObject(handle),'HBox');
if box1 <> nil then
begin
Assert(False, 'Trace:REMOVING THE HBOX');
gtk_container_remove(PgtkContainer(box1),gtk_object_get_data(pgtkObject(handle),'Label'));
PixMapWid:=gtk_object_get_data(pgtkObject(handle),'Pixmap');
if PixMapWid<>nil then
gtk_container_remove(PgtkContainer(box1),PixMapWid);
gtk_container_remove(PgtkContainer(handle),box1);
// gtk_container_remove automatically destroys box1 if ref count=0
// so we dont need gtk_widget_destroy(box1);
end;
if (TBitBtn(Sender).Layout = blGlyphLeft)
or (TBitBtn(Sender).Layout = blGlyphRight) then
Begin
Assert(False, 'Trace:GLYPHLEFT or GLYPHRIGHT');
box1 := gtk_hbox_new(False,0);
end
else Begin
Assert(False, 'Trace:GLYPHTOP or GLYPHBOTTOM');
box1 := gtk_vbox_new(False,0);
end;
Assert(False, 'Trace:2');
pixmap := pgdkPixmap(
PgdiObject(TBitBtn(Sender).Glyph.handle)^.GDIBitmapObject);
Assert(False, 'Trace:3');
if PgdiObject(TBitBtn(Sender).Glyph.handle)^.GDIBitmapMaskObject <> nil
then begin
PixMapWid := gtk_pixmap_new(pixmap,
PgdiObject(TBitBtn(Sender).Glyph.handle)^.GDIBitmapMaskObject)
end else begin
PixMapWid := gtk_pixmap_new(pixmap,nil);
end;
Assert(False, 'Trace:4');
pStr := StrAlloc(length(TBitBtn(Sender).Caption) + 1);
StrPCopy(pStr, TBitBtn(Sender).Caption);
pLabel := gtk_label_new(pstr);
StrDispose(pStr);
Assert(False, 'Trace:5');
if (TBitBtn(Sender).Layout = blGlyphLeft)
or (TBitBtn(Sender).Layout = blGlyphTop) then
begin
Assert(False, 'Trace:GLYPHLEFT or GLYPHTOP');
gtk_box_pack_start(pGTKBox(Box1),PixMapWid,False,False,
TBitBtn(Sender).Spacing);
gtk_box_pack_start(pGTKBox(Box1),pLabel,False,False,
TBitBtn(Sender).Spacing);
end
else begin
Assert(False, 'Trace:GLYPHRIGHT or GLYPHBOTTOM');
gtk_box_pack_start(pGTKBox(Box1),pLabel,False,False,
TBitBtn(Sender).Spacing);
gtk_box_pack_start(pGTKBox(Box1),PixMapWid,False,False,
TBitBtn(Sender).Spacing);
end;
Assert(False, 'Trace:6');
gtk_object_set_data(pgtkObject(handle),'HBox',Box1);
gtk_object_set_data(pgtkObject(handle),'Label',pLabel);
gtk_object_set_data(pgtkObject(handle),'Pixmap',PixMapWid);
Assert(False, 'Trace:7');
gtk_widget_show(pixmapwid);
gtk_widget_show(pLabel);
gtk_container_add(PgtkContainer(handle),box1);
gtk_widget_show(box1);
Assert(False, 'Trace:********************');
end;
//SH: think of TBitmap.handle!!!!
LM_LOADXPM:
Begin
if (sender is TBitmap) then
Begin
Assert(False, 'Trace:pixmap name '+strpas(data));
pixmap := gdk_pixmap_create_from_xpm(
PdeviceContext(TBitmap(sender).handle)^.drawable,
nil,nil,pchar(data));
Assert(False, 'Trace:1');
if Pixmap = nil
then Assert(False, 'Trace:PIXMAP NOT LOADED!');
PdeviceContext(TBitmap(sender).handle)^.CurrentBitmap :=
pgdiObject(pixmap);
end;
end;
LM_POPUPSHOW :
Begin
gtk_menu_popup (PgtkMenu(TPopupMenu(Sender).Handle),
nil,
nil,
nil,
nil,
0,
0);
{Displays a menu and makes it available for selection. Applications can use this
function to display context-sensitive menus, and will typically supply NULL for
the parent_menu_shell, parent_menu_item, func and data parameters.
The default menu positioning function will position the menu at the current
pointer position.
menu : a GtkMenu.
parent_menu_shell : the menu shell containing the triggering menu item.
parent_menu_item : the menu item whose activation triggered the popup.
func : a user supplied function used to position the menu.
data : user supplied data to be passed to func.
button : the button which was pressed to initiate the event.
activate_time : the time at which the activation event occurred.
}
end;
LM_SETFILTER :
begin
if Sender is TFileDialog then begin
pStr := StrAlloc(length(TFileDialog(Sender).Filter) + 1);
try
StrPCopy(pStr, TFileDialog(Sender).Filter);
gtk_file_selection_complete(PGtkFileSelection(Handle), pstr);
finally
StrDispose(pStr);
end;
end;
end;
LM_SETFILENAME :
begin
if Sender is TFileDialog then begin
pStr := StrAlloc(length(TFileDialog(Sender).Filename) + 1);
try
StrPCopy(pStr, TFileDialog(Sender).Filename);
gtk_file_selection_set_filename( PGtkFileSelection(Handle), pStr);
finally
StrDispose(pStr);
end;
end;
end;
LM_SETFOCUS:
begin
writeln('[TgtkObject.IntSendMessage3] LM_SETFOCUS ',TObject(Sender).ClassName);
if GTK_WIDGET_CAN_FOCUS(PgtkWidget(Handle)) then
gtk_widget_grab_focus(PgtkWidget(handle))
else
Writeln('The control '+TControl(Sender).name+' can not get focus');
end;
LM_SetSize :
begin
Assert(False, Format('Trace: [TgtkObject.IntSendMessage3] %s --> LM_SetSize(%d, %d, %d, %d)', [Sender.ClassNAme, PRect(Data)^.Left,PRect(Data)^.Top,PRect(Data)^.Right,PRect(Data)^.Bottom]));
//writeln('[IntSendMessage3.lm_setsize] Left=',PRect(Data)^.Left,' Top=',PRect(Data)^.Top,
// ' Right=',PRect(Data)^.Right,' Bottom=',PRect(Data)^.Bottom);
//writeln('[LM_SetSize] A ',Sender.ClassName,' ',PgtkWidget(Handle)^.window<>nil);
ResizeChild(Sender,PRect(Data)^.Left,PRect(Data)^.Top,
PRect(Data)^.Right,PRect(Data)^.Bottom);
//writeln('[LM_SetSize] B ',Sender.ClassName,' ',PgtkWidget(Handle)^.window<>nil);
end;
LM_ShowModal :
begin
if Sender is TCommonDialog then
begin
// Should be done elsewhere (eg via SetLabel) not here!
pStr:= StrAlloc(Length(TCommonDialog(Sender).Title) + 1);
try
StrPCopy(pStr, TCommonDialog(Sender).Title);
gtk_window_set_title(PGtkWindow(handle), pStr);
finally
StrDispose(pStr);
end;
end;
gtk_window_set_position(PGtkWindow(handle), GTK_WIN_POS_CENTER);
if Sender is TColorDialog then
SetColorDialogColor(Pointer(Handle),TColorDialog(Sender).Color);
gtk_widget_show(PGtkWidget(handle));
gtk_window_set_modal(PGtkWindow(handle), true);
end;
LM_TB_BUTTONCOUNT:
begin
if (Sender is TToolbar)
then Result := pgtkToolbar(handle)^.num_Children
else Result := -1;
end;
//SH: think of TCanvas.handle!!!!
LM_ReDraw :
begin
Assert(False, Format('Trace: [TgtkObject.IntSendMessage3] %s --> Redraw', [Sender.ClassName]));
if (Sender is TCanvas) then
ReDraw(PgtkWidget((Sender as TCanvas).Handle))
else
if not (sender is TSpeedbutton) then begin
if Sender is TControl then
ReDraw(PgtkWidget(Handle))
end else
If TSpeedbutton(sender).Visible then
(Sender as TSpeedButton).Perform(LM_PAINT,0,0)
else
Begin
Rect := TSpeedButton(sender).BoundsRect;
InvalidateRect(TSpeedButton(sender).Parent.Handle,@Rect,True);
end;
end;
LM_AddPage :
begin
if Sender is TControl then begin
Assert(False, Format('Trace: [TgtkObject.IntSendMessage3] %s --> Add NB page: %s', [Sender.ClassName, TLMNotebookEvent(Data^).Child.ClassName]));
AddNBPage(TControl(Sender), TLMNotebookEvent(Data^).Child,
TLMNotebookEvent(Data^).Page);
end;
end;
LM_RemovePage :
begin
if Sender is TControl then
RemoveNBPage(TControl(Sender), TLMNotebookEvent(Data^).Page);
end;
LM_ShowTabs :
begin
gtk_notebook_set_show_tabs(PGtkNotebook(Handle),
Boolean(Integer(TLMNotebookEvent(Data^).ShowTabs)));
end;
LM_SetTabPosition :
begin
case TTabPosition(TLMNotebookEvent(Data^).TabPosition^) of
tpTop : gtk_notebook_set_tab_pos(PGtkNotebook(Handle), GTK_POS_TOP);
tpBottom: gtk_notebook_set_tab_pos(PGtkNotebook(Handle), GTK_POS_BOTTOM);
tpLeft : gtk_notebook_set_tab_pos(PGtkNotebook(Handle), GTK_POS_LEFT);
tpRight : gtk_notebook_set_tab_pos(PGtkNotebook(Handle), GTK_POS_RIGHT);
end;
end;
LM_INSERTTOOLBUTTON:
begin
Assert(False, 'Trace:!!!!!!!!!!!!!!!!!!!!!!!!!');
Assert(False, 'Trace:Toolbutton being inserted');
Assert(False, 'Trace:!!!!!!!!!!!!!!!!!!!!!!!!!');
If (SENDER is TWINCONTROL) Then
Begin
pStr := StrAlloc(Length(TToolbutton(SENDER).Caption)+1);
try
StrPCopy(pStr,TToolbutton(SENDER).Caption);
pStr2 := StrAlloc(Length(TControl(Sender).Hint)+1);
finally
StrPCopy(pStr2,TControl(Sender).Hint);
end;
end
else Begin
raise Exception.Create('Can not assign this control to the toolbar');
exit;
end;
num := TToolbar(TWinControl(Sender).parent).Buttonlist.IndexOf(TControl(Sender));
if num < 0 then Num := TToolbar(TWinControl(Sender).parent).Buttonlist.Count+1;
Assert(False, Format('Trace:NUM = %d in INSERTBUTTON',[num]));
{Make sure it's created!!}
if handle = 0
then IntSendMessage3(LM_CREATE,Sender,nil);
gtk_toolbar_insert_widget(pGTKToolbar(TWinControl(sender).parent.Handle),
pgtkwidget(handle),pstr,pStr2,Num);
StrDispose(pStr);
StrDispose(pStr2);
Assert(False, 'Trace:!!!!!!!!!!!!!!!!!!!!!!!!!');
end;
LM_DELETETOOLBUTTON:
Begin
with pgtkToolbar(TToolbar(TWinControl(Sender).parent).handle)^ do
children := g_list_remove(pgList(children), sender);
// Next 3 lines: should be same as above, remove when above lines are proofed
// pgtkToolbar(TToolbar(TWinControl(Sender).parent).handle)^.children :=
// g_list_remove(pgList(pgtkToolbar(TToolbar(TWinControl(Sender).parent).handle)^.children),
// sender);
end;
LM_Invalidate :
begin
Assert(False, 'Trace:Trying to invalidate window... !!!');
//THIS DOESN'T WORK YET....
{
Event.thetype := GDK_EXPOSE;
Event.window := PgtkWidget(Handle)^.Window;
Event.Send_Event := 0;
Event.X := 0;
Event.Y := 0;
Event.Width := PgtkWidget((Handle)^.Allocation.Width;
Event.Height := PgtkWidget(Handle)^.Allocation.Height;
gtk_Signal_Emit_By_Name(PgtkObject(Handle),'expose_event',[(Sender as TWinControl).Handle,Sender,@Event]);
Assert(False, 'Trace:Signal Emitted - invalidate window');
}
gtk_widget_queue_draw(PGtkWidget(Handle));
end;
LM_SETFORMICON :
begin
if Sender is TCustomForm then begin
if (Handle<>0) and (Data<>nil) then begin
FormIconGdiObject:=Data;
//writeln('LM_SETFORMICON ',FormIconGdiObject<>nil,' ',pgtkWidget(Handle)^.Window<>nil);
if (FormIconGdiObject<>nil) and (pgtkWidget(Handle)^.Window<>nil)
then begin
gdk_window_set_icon(pgtkWidget(Handle)^.Window, nil,
FormIconGdiObject^.GDIBitmapObject,
FormIconGdiObject^.GDIBitmapMaskObject);
end;
end;
end;
end;
LM_SCREENINIT :
begin
{ Compute pixels per inch variable }
PLMScreenInit(Data)^.PixelsPerInchX:=
Round(gdk_screen_width / (gdk_screen_width_mm / 25.4));
PLMScreenInit(Data)^.PixelsPerInchY:=
Round(gdk_screen_height / (gdk_screen_height_mm / 25.4));
PLMScreenInit(Data)^.ColorDepth:= gdk_visual_get_system^.depth;
end;
LM_GETITEMS :
begin
if (Sender as TControl).fCompStyle = csCListBox
then begin
Widget:= GetCoreChildWidget(PGtkWidget(Handle));
Data := TGtkCListStringList.Create(PGtkCList(Widget));
Result := integer(Data);
end
else begin
case (Sender as TControl).fCompStyle of
csComboBox : Widget:= PGtkCombo(Handle)^.list;
csListBox : Widget:= GetCoreChildWidget(PGtkWidget(Handle));
else
raise Exception.Create('Message LM_GETITEMS - Not implemented');
end;
Data:= TGtkListStringList.Create(PGtkList(Widget));
Result:= Integer(Data);
end;
end;
LM_GETTEXT :
begin
Assert (true, 'WARNING:[TgtkObject.IntSendMessage3] usage of LM_GETTEXT superfluous, use interface-function GetText instead');
Result := integer (nil);
end;
LM_GETITEMINDEX :
begin
case (Sender as TControl).fCompStyle of
csListBox:
begin
if Handle<>0 then begin
if TListBox(Sender).MultiSelect then
Widget:= PGtkList(
GetCoreChildWidget(PGtkWidget(Handle)))^.last_focus_child
else begin
GList:= PGtkList(
GetCoreChildWidget(PGtkWidget(Handle)))^.selection;
if GList = nil
then Widget:= nil
else Widget:= PGtkWidget(GList^.data);
end;
if Widget = nil
then Result:= -1
else Result:= gtk_list_child_position(
PGtkList(GetCoreChildWidget(PGtkWidget(Handle))), Widget);
end else
Result:=-1;
end;
csCListBox:
begin
GList:=
PGtkCList(GetCoreChildWidget(PGtkWidget(Handle)))^.selection;
if GList = nil
then Result := -1
else Result := integer(GList^.Data);
end;
csNotebook:
begin
TLMNotebookEvent(Data^).Page :=
gtk_notebook_get_current_page(PGtkNotebook(Handle));
end;
end;
end;
LM_SETITEMINDEX :
begin
case (Sender as TControl).fCompStyle of
csComboBox: gtk_list_select_item(PGTKLIST(PGTKCOMBO(Handle)^.list), Integer(Data));
csListBox : gtk_list_select_item(PGtkList(GetCoreChildWidget(PGtkWidget(Handle))), Integer(Data));
csCListBox: gtk_clist_select_row(PGtkCList(GetCoreChildWidget(PGtkWidget(Handle))), Integer(Data), 1); // column
csNotebook:
begin
Assert(False, 'Trace:Setting Page to ' + IntToStr(TLMNotebookEvent(Data^).Page));
//writeln('LM_SETITEMINDEX A ',HexStr(Cardinal(Handle),8),', ',TLMNotebookEvent(Data^).Page);
gtk_notebook_set_page(PGtkNotebook(Handle), TLMNotebookEvent(Data^).Page);
//writeln('LM_SETITEMINDEX B ',TLMNotebookEvent(Data^).Page);
end;
end;
end;
LM_GETSELSTART :
begin
if (Sender as TControl).fCompStyle = csComboBox then
begin
Result:= gtk_editable_get_position(PGtkEditable(PGtkCombo(Handle)^.entry));
end;
end;
LM_GETSELLEN :
begin
if (Sender as TControl).fCompStyle = csComboBox then
begin
Result:= PGtkEditable(PGtkCombo(Handle)^.entry)^.selection_end_pos -
PGtkEditable(PGtkCombo(Handle)^.entry)^.selection_start_pos;
end;
end;
LM_GETLIMITTEXT :
begin
if (Sender as TControl).fCompStyle = csComboBox then
begin
Result:= PGtkEntry(PGtkCombo(Handle)^.entry)^.text_max_length;
end;
end;
LM_SETSELSTART :
begin
if (Sender is TControl) and (TControl(Sender).fCompStyle = csComboBox) then
begin
gtk_editable_set_position(PGtkEditable(PGtkCombo(Handle)^.entry), Integer(Data));
end;
end;
LM_SETSELLEN :
begin
if (Sender is TControl) and (TControl(Sender).fCompStyle = csComboBox) then
begin
gtk_editable_select_region(PGtkEditable(PGtkCombo(Handle)^.entry),
gtk_editable_get_position(PGtkEditable(PGtkCombo(Handle)^.entry)),
gtk_editable_get_position(PGtkEditable(PGtkCombo(Handle)^.entry)) + Integer(Data));
end;
end;
LM_GetLineCount :
begin
end;
LM_GETSELCOUNT :
begin
case (Sender as TControl).fCompStyle of
csListBox : Result:= g_list_length(PGtkList(GetCoreChildWidget(PGtkWidget(Handle)))^.selection);
csCListBox: Result:= g_list_length(PGtkCList(GetCoreChildWidget(PGtkWidget(Handle)))^.selection);
end;
end;
LM_GETSEL :
begin
if (Sender as TWinControl).fCompStyle = csListBox then
begin
{ Get the child in question of that index }
ListItem:= g_list_nth_data(PGtkList(GetCoreChildWidget(PGtkWidget(Handle)))^.children, Integer(Data^));
Result:= g_list_index(PGtkList(GetCoreChildWidget(PGtkWidget(Handle)))^.selection, ListItem);
end
else if (Sender as TControl).fCompStyle = csCListBox then
begin
{ Get the selections }
GList:= PGtkCList(GetCoreChildWidget(PGtkWidget(Handle)))^.selection;
Result := -1; { assume: nothing found }
while Assigned(GList) and (result = -1) do
begin
if integer(GList^.data) = integer(Data^)
then Result := 0
else GList := GList^.Next;
end;
end;
end;
LM_SETLIMITTEXT :
begin
if (Sender is TControl) and (TControl(Sender).fCompStyle = csComboBox)
then gtk_entry_set_max_length(PGtkEntry(PGtkCombo(Handle)^.entry), Integer(Data^));
end;
LM_SORT :
begin
if (Sender is TControl) and assigned (data) then
begin
case TControl(Sender).fCompStyle of
csComboBox,
csListBox : TGtkListStringList(TLMSort(Data^).List).Sorted:= TLMSort(Data^).IsSorted;
csCListBox : TGtkCListStringList(TLMSort(Data^).List).Sorted := TLMSort(Data^).IsSorted;
end
end
end;
LM_SETSEL :
begin
if (Sender is TControl) and
(TControl(Sender).fCompStyle in [csListBox, csCListBox]) and
assigned (data) then
begin
if (TControl(Sender).fCompStyle = csListBox) then
begin
if TLMSetSel(Data^).Selected
then gtk_list_select_item(PGtkList(GetCoreChildWidget(PGtkWidget(Handle))), TLMSetSel(Data^).Index)
else gtk_list_unselect_item(PGtkList(GetCoreChildWidget(PGtkWidget(Handle))), TLMSetSel(Data^).Index);
end
else if (TControl(Sender).fCompStyle = csCListBox) then
begin
if TLMSetSel(Data^).Selected
then gtk_clist_select_row(PGtkCList(GetCoreChildWidget(PGtkWidget(Handle))),TLMSetSel(Data^).Index,0)
else gtk_clist_unselect_row(PGtkCList(GetCoreChildWidget(PGtkWidget(Handle))),TLMSetSel(Data^).Index,0);
end;
end;
end;
LM_SETSELMODE :
begin
if (Sender is TControl) and
(TControl(Sender).fCompStyle in [csListBox, csCListBox]) and
assigned (data) then
begin
if TLMSetSelMode(Data^).MultiSelect then
begin
if TLMSetSelMode(Data^).ExtendedSelect
then SelectionMode:= GTK_SELECTION_EXTENDED
else SelectionMode:= GTK_SELECTION_MULTIPLE;
end
else
SelectionMode:= GTK_SELECTION_BROWSE;
case TControl(Sender).fCompStyle of
csListBox : gtk_list_set_selection_mode(PGtkList(GetCoreChildWidget(PGtkWidget(Handle))), SelectionMode);
csCListBox : gtk_clist_set_selection_mode(PGtkCList(GetCoreChildWidget(PGtkWidget(Handle))),SelectionMode);
else
Assert (true, 'WARNING:[TgtkObject.IntSendMessage3] usage of LM_SETSELMODE unimplemented for actual component');
end;
end;
end;
LM_SETBORDER :
begin
if (Sender is TControl) then
begin
if (TControl(Sender).fCompStyle = csListBox) then
begin
{ In TempWidget, a viewport is stored }
Widget:= PGtkWidget(PGtkBin(Handle)^.child);
if TListBox(Sender).BorderStyle = TBorderStyle(bsSingle)
then gtk_viewport_set_shadow_type(PGtkViewPort(Widget), GTK_SHADOW_IN)
else gtk_viewport_set_shadow_type(PGtkViewPort(Widget), GTK_SHADOW_NONE);
end
else if TControl(Sender).fCompStyle = csCListBox then
begin
if TListBox(Sender).BorderStyle = TBorderStyle(bsSingle)
then gtk_clist_set_shadow_type(
PGtkCList(GetCoreChildWidget(PGtkWidget(Handle))),
GTK_SHADOW_IN)
else gtk_clist_set_shadow_type(
PGtkCList(GetCoreChildWidget(PGtkWidget(Handle))),
GTK_SHADOW_NONE);
end;
end;
end;
LM_SETSHORTCUT :
begin
with TLMShortcut(data^) do begin
Widget:= PGtkWidget(Handle);
end;
Accelerate(Widget, TLMShortcut(data^));
end;
else
if Sender<>nil then
Assert(True, Format('WARNING: Unhandled message %d in IntSendMessage3'
+'send by %s --> message:Redraw', [LM_Message, Sender.ClassName]));
// unhandled message
end; // end of 2nd case
end; // end of else-part of 1st case
end; // end of 1st case
end;
{------------------------------------------------------------------------------
Function: TGtkObject.GetText
Params: Sender: The control to retrieve the text from
Returns: the requested text
Retrieves the text from a gtk control. this is a replacement for
the LM_GetText message.
------------------------------------------------------------------------------}
function TGtkObject.GetText(Sender: TControl; var Text: String): Boolean;
var
CS: PChar;
begin
Result := True;
case Sender.fCompStyle of
csComboBox: Text := StrPas(gtk_entry_get_text(PGtkEntry(PGtkCombo((Sender as TWinControl).Handle)^.entry)));
csEdit : Text := StrPas(gtk_entry_get_text(PgtkEntry((Sender as TWinControl).Handle)));
csMemo : begin
CS := gtk_editable_get_chars(PGtkEditable(GetCoreChildWidget(PGtkWidget((Sender as TWinControl).Handle))), 0, -1);
Text := StrPas(CS);
g_free(CS);
end;
else
Result := False;
end;
end;
{------------------------------------------------------------------------------
Method: TGtkObject.ResizeChild
Params: sender - the object which invoked this function
Left,Top,Width,Height - new dimensions for the control
Returns: Nothing
*Note: Resize a child widget on the parents fixed widget
------------------------------------------------------------------------------}
procedure TgtkObject.ResizeChild(Sender : TObject;Left,Top,Width,Height : Integer);
var
pFixed: PGTKFixed;
pWidget: PGTKWidget;
Parent: TWinControl;
IsTopLevelWidget: boolean;
begin
//writeln('[TgtkObject.ResizeChild] START ',TControl(Sender).Name,':',Sender.Classname,' Left=',Left,' Top=',Top,' Width=',Width,' Height=',Height);
Assert(false, (Format('trace: [TgtkObject.ResizeChild] %s --> Resize', [Sender.ClassNAme])));
Parent := TControl(Sender).Parent;
if Sender is TWinControl then begin
if TWinControl(Sender).HandleAllocated then begin
if not (Sender is TSpeedButton) then begin
pWidget := pgtkWidget(TWinControl(Sender).Handle);
IsTopLevelWidget:=(Sender is TCustomForm) and (Parent=nil);
if IsTopLevelWidget then
gtk_window_set_default_size(PgtkWindow(pWidget),Width,Height);
if IsTopLevelWidget then
gtk_widget_set_usize(pWidget, -1, -1);
gtk_widget_set_usize(pWidget, Width, Height);
//writeln('[TgtkObject.ResizeChild] D IsTopLevelWidget=',IsTopLevelWidget);
if not IsTopLevelWidget then begin
if Parent<>nil then begin
pFixed := GetFixedWidget(PGtkWidget(Parent.Handle));
if pFixed <> nil then begin
gtk_fixed_move(pFixed, pWidget, Left, Top);
end
else begin
Assert(False, 'Trace:ERROR!!!! - no Fixed Widget found to use when resizing....');
end;
end
else begin
Assert(False, 'Trace:ERROR !!! - no Fixed Widget found to use when resizing....');
raise Exception('ARG2');
end;
end
else begin
gtk_widget_set_uposition(pWidget, Left, Top);
end;
end;
end;
end;
//writeln('[TgtkObject.ResizeChild] END ',Sender.Classname,' Left=',Left,' Top=',Top,' Width=',Width,' Height=',Height);
end;
{------------------------------------------------------------------------------
Method: TGtkObject.AddChild
Params: parent -
child -
left, top -
Returns: Nothing
*Note: Adds A Child to a Parent Widget
------------------------------------------------------------------------------}
procedure TgtkObject.AddChild(Parent,Child : Pointer; Left,Top: Integer);
var
pFixed: PGTKFixed;
begin
Assert(False, 'Trace:ADDCHILD');
pFixed := GetFixedWidget(PGtkWidget(Parent));
if pFixed <> nil
then gtk_fixed_put(pFixed, Child, Left, Top);
// gtk_object_set_data(PgtkObject(Child),'Owner',Parent);
end;
{------------------------------------------------------------------------------
Method: TGtkObject.SetText
Params: Child -
data -
Returns: Nothing
Sets the text of a control.
WARNING: This should possibly be merged with the SetLabel method!
It's only left in here for TStatusBar right now cause it
may be nice to use it with different panels.
------------------------------------------------------------------------------}
procedure TgtkObject.SetText(Child, Data: Pointer);
type
pMsg = ^TLMSetControlText;
var
num : Integer;
begin
case pMsg(Data)^.fCompStyle of
csStatusBar : begin
num := gtk_statusbar_get_context_id(PGTKStatusBar(Child),PChar(inttostr(pMsg(Data)^.panel)));
gtk_statusbar_push(PGTKStatusBar(Child),num,pMsg(Data)^.Userdata);
end
else
writeln ('STOPPOK: [TGtkObject.SetText] Possible superfluous use of SetText, use SetLabel instead!');
end;
{STOPPOK: Code seems superfluous, see SetLabel instead}
end;
{------------------------------------------------------------------------------
Method: TGtkObject.SetCursor
Params: Sender - the control which invoked this method
Returns: Nothing
Sets the cursor for a widget
WARNING: Sender will be casted to TControl, CLEANUP!
------------------------------------------------------------------------------}
procedure TgtkObject.SetCursor(Sender : TObject);
//var CursorType : Integer;
begin
Assert(False, 'Trace:IN SETCURSOR');
If not(Sender is TWinControl) or(TWinControl(Sender).Handle = 0) then EXIT;
Assert(False, 'Trace:IN SETCURSOR CASE STATEMENT');
case TControl(Sender).Cursor of
crAppStart : gdk_window_set_cursor (pgtkWidget(TWinControl(Sender).Handle)^.window, Cursor_Watch);
crArrow : gdk_window_set_cursor (pgtkWidget(TWinControl(Sender).Handle)^.window, Cursor_Arrow);
crCross : gdk_window_set_cursor (pgtkWidget(TWinControl(Sender).Handle)^.window, Cursor_Cross);
crHandPoint: gdk_window_set_cursor (pgtkWidget(TWinControl(Sender).Handle)^.window, Cursor_hand1);
crIBeam : gdk_window_set_cursor (pgtkWidget(TWinControl(Sender).Handle)^.window, Cursor_XTerm);
crHourGlass: gdk_window_set_cursor (pgtkWidget(TWinControl(Sender).Handle)^.window, Cursor_Watch);
crDefault : gdk_window_set_cursor (pgtkWidget(TWinControl(Sender).Handle)^.window, Cursor_StdArrow);
crHSplit : gdk_window_set_cursor (pgtkWidget(TWinControl(Sender).Handle)^.window, Cursor_HSplit);
crVSplit : gdk_window_set_cursor (pgtkWidget(TWinControl(Sender).Handle)^.window, Cursor_VSplit);
crSizeNWSE : gdk_window_set_cursor (pgtkWidget(TWinControl(Sender).Handle)^.window, Cursor_SizeNWSE);
crSizeNS : gdk_window_set_cursor (pgtkWidget(TWinControl(Sender).Handle)^.window, Cursor_SizeNS);
crSizeNESW : gdk_window_set_cursor (pgtkWidget(TWinControl(Sender).Handle)^.window, Cursor_SizeNESW);
crSizeWE : gdk_window_set_cursor (pgtkWidget(TWinControl(Sender).Handle)^.window, Cursor_SizeWE);
else
Exit;
end;
end;
{------------------------------------------------------------------------------
Method: TGtkObject.SetLabel
Params: sender - the calling object
data - String (PChar) to be set as label for a control
Returns: Nothing
Sets the label text on a widget
------------------------------------------------------------------------------}
procedure TgtkObject.SetLabel(Sender : TObject; Data : Pointer);
var
P : Pointer;
pLabel: pchar;
begin
if Sender is TWinControl
then Assert(False, Format('Trace: [TgtkObject.SetLabel] %s --> label %s', [Sender.ClassName, TControl(Sender).Caption]))
else begin
Assert(False, Format('Trace:WARNING: [TgtkObject.SetLabel] %s --> No Decendant of TWinControl', [Sender.ClassName]));
writeln('[TgtkObject.SetLabel] ERROR: Sender (',Sender.Classname,')'
,'is not TWinControl ');
Halt;
end;
P := Pointer(TWinControl(Sender).Handle);
Assert(p = nil, 'Trace:WARNING: [TgtkObject.SetLabel] --> got nil pointer');
Assert(False, 'Trace:Setting Str1 in SetLabel');
pLabel := pchar(Data);
case TControl(Sender).fCompStyle of
csBitBtn : IntSendMessage3(LM_IMAGECHANGED,Sender,nil);
csButton,
csToolButton : with PgtkButton(P)^ do
begin
if Child = nil then
begin
Assert(False, Format('trace: [TgtkObject.SetLabel] %s has no child label', [Sender.ClassName]));
child := gtk_label_new(pLabel)
end
else begin
Assert(False, Format('trace: [TgtkObject.SetLabel] %s has child label', [Sender.ClassName]));
gtk_label_set_text(pgtkLabel(Child), PLabel);
end;
end;
csForm,
csFileDialog,
csColorDialog,
csFontDialog : gtk_window_set_title(pGtkWindow(p),PLabel);
csLabel : gtk_label_set_text(pGtkLabel(p), pLabel);
csCheckBox : gtk_label_set_text(pGtkLabel( pgtkCheckButton(p)^.Toggle_Button.Button.Child),pLabel);
csGroupBox : gtk_frame_set_label(pgtkFrame(P),pLabel);
csEdit : gtk_entry_set_text(pGtkEntry(P),pLabel);
csMemo : begin
P := GetCoreChildWidget(P);
gtk_text_freeze(PGtkText(P));
gtk_text_set_point(PGtkText(P), 0);
gtk_text_forward_delete(
PGtkText(P),
gtk_text_get_length(PGtkText(P)));
gtk_text_insert(PGtkText(P), nil, nil, nil, pLabel, -1);
gtk_text_thaw(PGtkText(P));
end;
csPage : gtk_notebook_set_tab_label_text(PGtkNotebook((TWinControl(Sender).Parent).handle),
PGtkWidget(P),
PGChar(data));
//GET? WHY should this be right? p := gtk_notebook_get_tab_label(PGTKNoteBook(TWinControl(Sender).Parent.Handle), P);
csComboBox : gtk_entry_set_text(PGtkEntry(PGtkCombo(P)^.entry), PLabel);
else
Assert(True, Format ('WARNING: [TgtkObject.SetLabel] --> not handled for class %s ', [Sender.ClassName]));
end;
Assert(False, Format('trace: [TgtkObject.SetLabel] %s --> END', [Sender.ClassName]));
end;
{------------------------------------------------------------------------------}
{ TGtkObject SetColor }
{ *Note: Changes the form's default background color }
{------------------------------------------------------------------------------}
procedure TgtkObject.SetColor(Sender : TObject);
{var
TheStyle : pGtkStyle;
widget : pgtkWidget;
NewColor : TgdkColor;}
begin
if Sender is TWincontrol
then with TWincontrol(Sender) do
begin
// Temphack to set backcolor, till better solution
if HandleAllocated then SetBKColor(Handle, ColorToRGB(Color));
end;
// OBSOLETE
//NOT USED RIGHT NOW..........CAUSES ALL FORMS TO USE THESE COLORS!!!!!!
{
widget := TCustomForm(Sender).handle;
TheStyle := pgtkWidget(widget)^.thestyle;
NewColor := ConvertTogdk(TCustomForm(Sender).Color);
gdk_color_alloc (gdk_colormap_get_system (), @NewColor);
gdk_gc_set_foreground (TheStyle^.fg_gc[GTK_STATE_NORMAL], @NewColor);
gdk_gc_set_background (TheStyle^.fg_gc[GTK_STATE_NORMAL], @NewColor);
}
end;
{------------------------------------------------------------------------------
Function: TGTKObject.SetCallback
Params: Msg - message for which to set a callback
sender - object to which callback will be send
Returns: nothing
Applies a Message to the sender
------------------------------------------------------------------------------}
procedure TGTKObject.SetCallback(Msg : LongInt; Sender : TObject);
procedure ConnectSignal(const AObject:gtk_Object; const ASignal: PChar;
const ACallBackProc: Pointer; const ReqSignalMask: TGdkEventMask);
var
RealizeHandler, Handler: PGTKHandler;
RealizeID, SignalID: guint;
begin
if ACallBackProc <> nil then
begin
// first loop though the handlers to:
// - check if a handler already exists
// - Find the realize handler to change data
Handler := gtk_object_get_data_by_id (AObject, gtk_handler_quark);
SignalID := gtk_signal_lookup(ASignal, GTK_OBJECT_TYPE(AObject));
RealizeID := gtk_signal_lookup('realize', GTK_OBJECT_TYPE(AObject));
RealizeHandler := nil;
while (Handler <> nil) do
with Handler^ do
begin
//look for realize handler
if (Id > 0) and
(Signal_ID = RealizeID) and
(Func = TGTKSignalFunc(@GTKRealizeCB))
then RealizeHandler := Handler;
if (Id > 0) and
(Signal_ID = SignalID) and
(Func = TGTKSignalFunc(ACallBackProc)) and
(func_data = Pointer(Sender))
then begin
Assert(False, Format('Trace:WARNING: [TGTKObject.SetCallback] %s signal <%s> set twice', [Sender.ClassName, ASignal]));
Exit;
end;
Handler := Next;
end;
// if we are here no handler was defined yet
Assert(False, Format('trace: [TGTKObject.SetCallback] %s signal <%s>', [Sender.ClassName, ASignal]));
gtk_signal_connect(AObject, ASignal, TGTKSignalFunc(ACallBackProc), Sender);
if ReqSignalMask <> 0 then
begin
if RealizeHandler = nil
then
gtk_signal_connect(AObject, 'realize',
TGTKSignalFunc(@GTKRealizeCB), Pointer(ReqSignalMask))
else
TGdkEventMask(RealizeHandler^.func_data) :=
TGdkEventMask(RealizeHandler^.func_data) or ReqSignalMask;
end;
end;
end;
procedure ConnectSignal(const AObject:gtk_Object; const ASignal: PChar;
const ACallBackProc: Pointer);
begin
ConnectSignal(AObject, ASignal, ACallBackProc, 0);
end;
var
gObject, gFixed: PGTKObject;
begin
gObject := ObjectToGTKObject(Sender);
if gObject = nil then Exit;
gFixed := PGTKObject(GetFixedWidget(gObject));
if gFixed = nil then gFixed := gObject;
case Msg of
LM_SHOWWINDOW :
begin
ConnectSignal(gObject, 'show', @gtkshowCB);
ConnectSignal(gObject, 'hide', @gtkhideCB);
end;
LM_DESTROY :
begin
ConnectSignal(gObject, 'destroy', @gtkdestroyCB);
end;
LM_CLOSEQUERY :
begin
ConnectSignal(gObject, 'delete-event', @gtkdeleteCB);
end;
LM_ACTIVATE :
begin
if (Sender is TCustomForm) then
Begin
ConnectSignal(gObject, 'focus-in-event', @gtkfrmactivate);
ConnectSignal(gObject, 'focus-out-event', @gtkfrmdeactivate);
end
else
ConnectSignal(gObject, 'activate', @gtkactivateCB);
end;
LM_ACTIVATEITEM :
begin
ConnectSignal(gObject, 'activate-item', @gtkactivateCB);
end;
LM_CHANGED :
if sender is TTrackBar then begin
ConnectSignal(gtk_Object(gtk_range_get_adjustment(
GTK_RANGE(gObject))) , 'value_changed', @gtkvaluechanged);
end
else if sender is TNotebook
then ConnectSignal(gObject, 'switch-page', @gtkswitchpage)
else if sender is TCustomCombobox
then ConnectSignal (PGtkObject(PGtkCombo(gobject)^.entry), 'changed', @gtkchangedCB)
else
ConnectSignal(gObject, 'changed', @gtkchanged_editbox);
LM_CLICKED :
begin
ConnectSignal(gObject, 'clicked', @gtkclickedCB);
end;
LM_CONFIGUREEVENT :
begin
ConnectSignal(gObject, 'configure-event', @gtkconfigureevent);
end;
LM_DAYCHANGED : //calendar
Begin
ConnectSignal(gObject, 'day-selected', @gtkdaychanged);
ConnectSignal(gObject, 'day-selected-double-click', @gtkdaychanged);
end;
LM_PAINT :
begin
ConnectSignal(gFixed, 'expose-event', @GTKExposeEvent);
ConnectSignal(gFixed, 'draw', @GTKDraw);
end;
LM_EXPOSEEVENT :
begin
// ConnectSignal(gFixed, 'expose-event', @gtkexposeevent)
end;
LM_FOCUS :
begin
//ConnectSignal(gObject, 'focus', @gtkfocusCB);
if (sender is TCustomComboBox) then
Begin
ConnectSignal(PgtkObject(PgtkCombo(TCustomComboBox(sender).handle)^.entry), 'focus-in-event', @gtkFocusCB);
ConnectSignal(PgtkObject(PgtkCombo(TCustomComboBox(sender).handle)^.entry), 'focus-out-event', @gtkKillFocusCB);
ConnectSignal(PgtkObject(PgtkCombo(TCustomComboBox(sender).handle)^.list), 'focus-in-event', @gtkFocusCB);
ConnectSignal(PgtkObject(PgtkCombo(TCustomComboBox(sender).handle)^.list), 'focus-out-event', @gtkKillFocusCB);
end
else
Begin
ConnectSignal(gObject, 'focus-in-event', @gtkFocusCB);
ConnectSignal(gObject, 'focus-out-event', @gtkKillFocusCB);
end;
end;
LM_KEYDOWN,
LM_CHAR,
LM_KEYUP,
LM_SYSKEYDOWN,
LM_SYSCHAR,
LM_SYSKEYUP:
begin
if (sender is TComboBox) then Begin
ConnectSignal(PgtkObject(PgtkCombo(TComboBox(sender).handle)^.entry), 'key-press-event', @GTKKeyUpDown, GDK_KEY_PRESS_MASK);
ConnectSignal(PgtkObject(PgtkCombo(TComboBox(sender).handle)^.entry), 'key-release-event', @GTKKeyUpDown, GDK_KEY_RELEASE_MASK);
end
else
if (sender is TCustomForm) then Begin
ConnectSignal(PgtkObject(TCustomForm(sender).handle), 'key-press-event', @GTKKeyUpDown, GDK_KEY_PRESS_MASK);
ConnectSignal(PgtkObject(TCustomForm(sender).handle), 'key-release-event', @GTKKeyUpDown, GDK_KEY_RELEASE_MASK);
end
else
if (sender is TCustomListBox) then
Begin
//TODO:listbox is STILL not sendig keypress events even wtih these lines.
ConnectSignal(PgtkObject(GetCoreChildWidget(PgtkWidget(TCustomListBox(sender).handle))), 'key-press-event', @GTKKeyUpDown, GDK_KEY_PRESS_MASK);
ConnectSignal(PgtkObject(GetCoreChildWidget(PgtkWidget(TCustomListBox(sender).handle))), 'key-release-event', @GTKKeyUpDown, GDK_KEY_RELEASE_MASK);
end;
ConnectSignal(gFixed, 'key-press-event', @GTKKeyUpDown, GDK_KEY_PRESS_MASK);
ConnectSignal(gFixed, 'key-release-event', @GTKKeyUpDown, GDK_KEY_RELEASE_MASK);
end;
LM_MONTHCHANGED : //calendar
Begin
ConnectSignal(gObject, 'month-changed', @gtkmonthchanged);
ConnectSignal(gObject, 'prev-month', @gtkmonthchanged);
ConnectSignal(gObject, 'next-month', @gtkmonthchanged);
end;
LM_MOUSEMOVE:
begin
if (sender is TComboBox) then Begin
ConnectSignal(PgtkObject(PgtkCombo(TComboBox(sender).handle)^.entry), 'motion-notify-event', @GTKMotionNotify, GDK_POINTER_MOTION_MASK);
ConnectSignal(PgtkObject(PgtkCombo(TComboBox(sender).handle)^.button), 'motion-notify-event', @GTKMotionNotify, GDK_POINTER_MOTION_MASK);
end
else
ConnectSignal(gFixed, 'motion-notify-event', @GTKMotionNotify, GDK_POINTER_MOTION_MASK)
end;
LM_PRESSED :
begin
Assert(False, 'Trace:OBSOLETE: [TGTKObject.SetCallback] LM_PRESSED');
ConnectSignal(gObject, 'pressed', @gtkpressedCB);
end;
LM_RELEASED :
begin
Assert(False, 'Trace:OBSOLETE: [TGTKObject.SetCallback] LM_RELEASED');
ConnectSignal(gObject, 'released', @gtkreleasedCB);
end;
LM_MOVECURSOR :
begin
ConnectSignal(gObject, 'move-cursor', @gtkmovecursorCB);
end;
LM_LBUTTONDOWN,
LM_RBUTTONDOWN,
LM_MBUTTONDOWN,
LM_MOUSEWHEEL :
begin
if (sender is TCustomComboBox) then
Begin
ConnectSignal(PgtkObject(PgtkCOmbo(gObject)^.entry), 'button-press-event', @gtkmousebtnpress, GDK_BUTTON_PRESS_MASK);
ConnectSignal(PgtkObject(PgtkCOmbo(gObject)^.button) , 'button-press-event', @gtkmousebtnpress, GDK_BUTTON_PRESS_MASK);
// Connecting the list seems to cause errors. Maybe we are returning the wrong boolean in the callback func
// ConnectSignal(PgtkObject(PgtkCOmbo(gObject)^.list), 'button-press-event', @gtkmousebtnpress, GDK_BUTTON_PRESS_MASK);
end
else
ConnectSignal(gFixed, 'button-press-event', @gtkmousebtnpress, GDK_BUTTON_PRESS_MASK);
end;
LM_LBUTTONUP,
LM_RBUTTONUP,
LM_MBUTTONUP:
begin
if (sender is TCustomComboBox) then
Begin
ConnectSignal(PgtkObject(PgtkCOmbo(gObject)^.entry), 'button-release-event', @gtkmousebtnrelease, GDK_BUTTON_RELEASE_MASK);
ConnectSignal(PgtkObject(PgtkCOmbo(gObject)^.button) , 'button-release-event', @gtkmousebtnrelease, GDK_BUTTON_RELEASE_MASK);
// Connecting the list seems to cause errors. Maybe we are returning the wrong boolean in the callback func
// ConnectSignal(PgtkObject(PgtkCOmbo(gObject)^.list), 'button-release-event', @gtkmousebtnrelease, GDK_BUTTON_RELEASE_MASK);
end
else
ConnectSignal(gFixed, 'button-release-event', @gtkmousebtnrelease, GDK_BUTTON_RELEASE_MASK);
end;
LM_ENTER :
begin
if sender is TButton
then ConnectSignal(gObject, 'enter', @gtkenterCB)
else ConnectSignal(gObject, 'focus-in-event', @gtkFocusInNotifyCB); //TODO: check this focus in is mapped to focus
end;
LM_EXIT :
begin
if sender is TButton
then ConnectSignal(gObject, 'leave', @gtkleaveCB)
else ConnectSignal(gObject, 'focus-out-event', @gtkFocusOutNotifyCB);
end;
LM_LEAVE :
begin
ConnectSignal(gObject, 'leave', @gtkleaveCB);
end;
LM_WINDOWPOSCHANGED: //LM_SIZEALLOCATE, LM_RESIZE :
begin
ConnectSignal(gObject, 'size-allocate', @gtksize_allocateCB);
end;
LM_CHECKRESIZE :
begin
ConnectSignal(gObject, 'check-resize', @gtkresizeCB);
end;
LM_INSERTTEXT :
begin
ConnectSignal(gObject, 'insert-text', @gtkinserttext);
end;
LM_DELETETEXT :
begin
ConnectSignal(gObject, 'delete-text', @gtkdeletetext);
end;
LM_SETEDITABLE :
begin
ConnectSignal(gObject, 'set-editable', @gtkseteditable);
end;
LM_MOVEWORD :
begin
ConnectSignal(gObject, 'move-word', @gtkmoveword);
end;
LM_MOVEPAGE :
begin
ConnectSignal(gObject, 'move-page', @gtkmovepage);
end;
LM_MOVETOROW :
begin
ConnectSignal(gObject, 'move-to-row', @gtkmovetorow);
end;
LM_MOVETOCOLUMN :
begin
ConnectSignal(gObject, 'move-to-column', @gtkmovetocolumn);
end;
LM_KILLCHAR :
begin
ConnectSignal(gObject, 'kill-char', @gtkkillchar);
end;
LM_KILLWORD :
begin
ConnectSignal(gObject, 'kill-word', @gtkkillword);
end;
LM_KILLLINE :
begin
ConnectSignal(gObject, 'kill-line', @gtkkillline);
end;
LM_CUTTOCLIP :
begin
ConnectSignal(gObject, 'cut-clipboard', @gtkcuttoclip);
end;
LM_COPYTOCLIP :
begin
ConnectSignal(gObject, 'copy-clipboard', @gtkcopytoclip);
end;
LM_PASTEFROMCLIP :
begin
ConnectSignal(gObject, 'paste-clipboard', @gtkpastefromclip);
end;
LM_HSCROLL:
begin
ConnectSignal(PGTKObject(gtk_scrolled_window_get_hadjustment(PGTKScrolledWindow(gObject))), 'value-changed', @GTKHScrollCB);
end;
LM_VSCROLL:
begin
ConnectSignal(PGTKObject(gtk_scrolled_window_get_vadjustment(PGTKScrolledWindow(gObject))), 'value-changed', @GTKVScrollCB);
end;
LM_YEARCHANGED : //calendar
Begin
ConnectSignal(gObject, 'prev-year', @gtkyearchanged);
ConnectSignal(gObject, 'next-year', @gtkyearchanged);
end;
(*
LM_WINDOWPOSCHANGED:
begin
ConnectSignal(gObject, 'size-allocate', @gtkSizeAllocateCB);
// ConnectSignal(gObject, 'move_resize', @gtkmoveresize);
end;
*)
else
Assert(False, Format('Trace:ERROR: Signal %d not found!', [Msg]));
end;
end;
{------------------------------------------------------------------------------
Function: TGTKObject.RemoveCallBacks
Params: sender - object for which to remove callbacks
Returns: nothing
Removes Call Back Signals from the sender
------------------------------------------------------------------------------}
procedure TGTKObject.RemoveCallbacks(Sender : TObject);
var
gObject : gtk_Object;
Info: PWinWidgetInfo;
Widget: pointer;
begin
gObject := ObjectToGTKObject(Sender);
if gObject = nil then Exit;
if (Sender is TWinControl) and (TWinControl(Sender).HandleAllocated) then
begin
Widget:=Pointer(TWinControl(Sender).Handle);
Info := GetWidgetInfo(Widget, False);
if Info <> nil then Dispose(Info);
gtk_object_set_data(Widget, 'widgetinfo', nil);
end;
gtk_signal_handlers_destroy(gObject);
end;
{------------------------------------------------------------------------------
Function: TGTKObject.CreateComponent
Params: sender - object for which to create visual representation
Returns: nothing
Tells GTK Engine to create a widget
------------------------------------------------------------------------------}
procedure TgtkObject.CreateComponent(Sender : TObject);
const
FormStyleMap : array[TFormBorderStyle] of integer = (
GTK_WINDOW_DIALOG, GTK_WINDOW_TOPLEVEL, GTK_WINDOW_TOPLEVEL,
GTK_WINDOW_TOPLEVEL, GTK_WINDOW_POPUP, GTK_WINDOW_POPUP
);
FormSizeableMap : array[TFormBorderStyle] of gint = (0, 0, 1, 0, 0, 1);
//unused: FormBorderWidth : array[TFormBorderStyle] of gint = (0, 1, 2, 1, 1, 2);
//unused:type
//unused: Tpixdata = Array[1..20] of String;
var
caption : ansistring; // the caption of "Sender"
StrTemp : PChar; // same as "caption" but as PChar
TempWidget : PGTKWidget; // pointer to gtk-widget (local use when neccessary)
TempWidget2: PgtkWidget; //used by TListView
p : pointer; // ptr to the newly created GtkWidget
CompStyle, // componentstyle (type) of GtkWidget which will be created
TempInt : Integer; // local use when neccessary
Adjustment: PGTKAdjustment; // currently only used for csFixed
// - for csBitBtn
Box : Pointer; // currently only used for TBitBtn and TForm and TListView
//pixmap : pGdkPixMap; // TBitBtn - the default pixmap
pixmapwid : pGtkWidget; // currently only used for TBitBtn
//mask : pGDKBitmap; // currently only used for TBitBtn
//style : pgtkStyle; // currently only used for TBitBtn
label1 : pgtkwidget; // currently only used for TBitBtn
//TempStr : String; // currently only used for TBitBtn to load default pixmap
//pStr : PChar; // currently only used for TBitBtn to load default pixmap
begin
Assert(False, 'Trace:In CreateComponet');
p := nil;
CompStyle := csNone;
Caption := Sender.ClassName;
if (Sender is TControl) then
begin
caption := TControl(Sender).caption;
CompStyle := TControl(Sender).FCompStyle
end
else if (Sender is TMenuItem) then
begin
caption := TMenuItem(Sender).caption;
CompStyle := TMenuItem(Sender).FCompStyle;
end
else if (Sender is TMenu) or (Sender is TPopupMenu)
then CompStyle := TMenu(Sender).FCompStyle
else if (Sender is TCommonDialog)
then CompStyle := TCommonDialog(Sender).FCompStyle
else
;
// ToDo: the following is for debug only
if caption = '' then caption := Sender.ClassName;
Assert(False, 'Trace:----------------------Creating component in TgtkObject- STR = '+caption+'-');
// ToDo: until here remove when debug not needed
if caption = '' then caption := 'Blank';
strTemp := StrAlloc(length(caption) + 1);
StrPCopy(strTemp, caption);
Assert(False, 'Trace:1');
case CompStyle of
csAlignment :
begin
p := gtk_alignment_new(0.5,0.5,0,0);
gtk_widget_show(p);
end;
csArrow :
begin
p := gtk_arrow_new(gtk_arrow_left,gtk_shadow_etched_in);
end;
csBitBtn :
begin
Assert(False, 'Trace:CSBITBTN CREATE*************************');
writeln('Creating a new bit button');
p := gtk_button_new;
if ((Sender as TBitBtn).Layout in [blGlyphLeft, blGlyphRight]) then begin
Assert(False, 'Trace:GLYPHLEFT or GLYPHRIGHT');
Box := gtk_hbox_new(False,0);
end
else Begin
Assert(False, 'Trace:GLYPHTOP or GLYPHBOTTOM');
Box := gtk_vbox_new(False,0);
end;
gtk_container_set_border_width(PgtkContainer(Box),2);
//style := gtk_widget_get_style(pGTKWidget(p));
{
// is this neccessary?
// MWE: nope, if needed, it should be done static
TempStr := './images/menu.xpm';
pStr := StrAlloc(length(TempStr) + 1);
StrPCopy(pStr, TempStr);
pixmap := gdk_pixmap_create_from_xpm(pgtkWidget(p)^.window, @Mask,
@style^.bg[GTK_STATE_NORMAL],pStr);
StrDispose(pStr);
}
//pixmapwid := gtk_pixmap_new(pixmap,mask);
PixMapWid := nil;
Label1 := gtk_label_new(StrTemp);
//gtk_box_pack_start(pGTkBox(Box),pixmapwid,False,False,3);
gtk_box_pack_start(pGTkBox(Box), Label1, FALSE, FALSE, 3);
//gtk_widget_show(pixmapwid);
gtk_widget_show(Label1);
gtk_Container_add(PgtkContainer(p),Box);
gtk_widget_show(Box);
gtk_object_set_data(pgtkObject(p),'HBox',Box);
gtk_object_set_data(pgtkObject(p),'Pixmap',PixMapwid);
gtk_object_set_data(pgtkObject(p),'Label',Label1);
Assert(False, 'Trace:CSBITBTN CREATE EXITING*************************');
end;
csButton :
begin
p := gtk_button_new_with_label(StrTemp);
end;
csCalendar :
begin
p := gtk_calendar_new();
end;
csCheckbox :
begin
p := gtk_check_button_new_with_label(strTemp);
end;
csComboBox :
begin
p := gtk_combo_new();
gtk_entry_set_text(PGtkEntry(PGtkCombo(p)^.entry), StrTemp);
end;
csListBox :
begin
p:= gtk_scrolled_window_new(nil, nil);
GTK_WIDGET_UNSET_FLAGS(PGtkScrolledWindow(p)^.hscrollbar, GTK_CAN_FOCUS);
GTK_WIDGET_UNSET_FLAGS(PGtkScrolledWindow(p)^.vscrollbar, GTK_CAN_FOCUS);
gtk_scrolled_window_set_policy(PGtkScrolledWindow(p), GTK_POLICY_AUTOMATIC, GTK_POLICY_AUTOMATIC);
gtk_widget_show(p);
TempWidget:= gtk_list_new;
gtk_scrolled_window_add_with_viewport(PGtkScrolledWindow(p), TempWidget);
gtk_container_set_focus_vadjustment(PGtkContainer(TempWidget),
gtk_scrolled_window_get_vadjustment(PGtkScrolledWindow(p)));
gtk_container_set_focus_hadjustment(PGtkContainer(TempWidget),
gtk_scrolled_window_get_hadjustment(PGtkScrolledWindow(p)));
gtk_widget_show(TempWidget);
//--------------------------
// MWE: will be obsoleted
SetCoreChildWidget(p, TempWidget);
//--------------------------
GetWidgetInfo(p, True)^.ImplementationWidget := TempWidget;
SetMainWidget(p, TempWidget);
end;
csCListBox :
begin
Assert(False, 'Trace:!!!!!!!!!!!!!!!! Creating Clist box !!!!!!!!!!!!!!');
p:= gtk_scrolled_window_new(nil, nil);
GTK_WIDGET_UNSET_FLAGS(PGtkScrolledWindow(p)^.hscrollbar,
GTK_CAN_FOCUS);
GTK_WIDGET_UNSET_FLAGS(PGtkScrolledWindow(p)^.vscrollbar,
GTK_CAN_FOCUS);
gtk_scrolled_window_set_policy(PGtkScrolledWindow(p),
GTK_POLICY_AUTOMATIC,
GTK_POLICY_AUTOMATIC);
gtk_widget_show(p);
with Sender as TCListBox
do begin
TempWidget:= gtk_clist_new(ListColumns);
gtk_container_add(PGtkContainer(p), TempWidget);
for TempInt := 0 to ListColumns - 1 do
gtk_clist_set_column_width(PGtkCList(TempWidget), TempInt, (Width-50) div ListColumns);
end;
gtk_widget_show(TempWidget);
//--------------------------
// MWE: will be obsoleted
SetCoreChildWidget(p, TempWidget);
//--------------------------
GetWidgetInfo(p, True)^.ImplementationWidget := TempWidget;
SetMainWidget(p, TempWidget);
end;
csListView :
Begin
// tempwidget := gtk_fixed_new;
// Box := gtk_hbox_new(False,0);
// gtk_widget_show(box);
if TListview(sender).Columns.Count > 0
then p := PgtkWidget(gtk_clist_new(TListview(sender).Columns.Count))
else p := PgtkWidget(gtk_clist_new(1));
// gtk_box_pack_start(Pgtkbox(box),p,True,False,0);
if TListview(sender).ScrollBars in [ssBoth, ssHorizontal]
then begin
// gtk_clist_set_hadjustment(PgtkCList(P),PgtkAdjustment(gtk_adjustment_new(1,1,100,1,10,10)));
tempWidget2 := gtk_hscrollbar_new(gtk_clist_get_hadjustment(PgtkCList(p)));
// gtk_box_pack_end(Pgtkbox(box),TempWidget2,False,False,0);
gtk_widget_show(tempwidget2);
end;
// Tempwidget2 := box;
// Box := gtk_vbox_new(False,0);
// gtk_widget_show(Box);
// gtk_fixed_put(Pgtkfixed(tempwidget),box,0,0);
// gtk_box_pack_start(Pgtkbox(box),Tempwidget2,True,False,0);
if TListview(sender).ScrollBars in [ssBoth, ssVertical]
then begin
gtk_clist_set_vadjustment(PgtkCList(P),PgtkAdjustment(gtk_adjustment_new(1,1,100,1,10,10)));
TempWidget2 := gtk_hscrollbar_new(gtk_clist_get_hadjustment(PgtkCList(p)));
gtk_widget_show(tempwidget2);
// gtk_box_pack_end(pgtkbox(box),TempWidget2,TRue,False,0);
end;
// GetWidgetInfo(tempWidget, True)^.ImplementationWidget := P;
// SetMainWidget(P,TempWidget);//p, TempWidget);
// gtk_fixed_put(PgtkFixed(TempWidget), P,0,0);
// GetWidgetInfo(tempWidget, True)^.ImplementationWidget := P;
// SetMainWidget(TempWidget,P);//p, TempWidget);
gtk_widget_show(P);
// gtk_widget_show(tempwidget);
// SetFixedWidget(P,TempWidget);
end;
csEdit :
begin
p := gtk_entry_new();
end;
csFileDialog :
begin
P := gtk_file_selection_new(StrTemp);
{****This is a major hack put by Cliff Baeseman to solve
a gtk win32 dll implementation problem where the headers implementation
does not match the linux version**** }
{$ifdef LINUX}
gtk_signal_connect( gtk_object((PGtkFileSelection(P))^.ok_button), 'clicked', gtk_signal_func(@gtkDialogOKclickedCB), Sender);
gtk_signal_connect( gtk_object((PGtkFileSelection(P))^.cancel_button), 'clicked', gtk_signal_func(@gtkDialogCancelclickedCB), Sender);
{$endif}
{$ifdef WIN32}
gtk_signal_connect( gtk_object((PGtkFileSelection(P))^.cancel_button), 'clicked', gtk_signal_func(@gtkDialogOKclickedCB), Sender);
gtk_signal_connect( gtk_object((PGtkFileSelection(P))^.help_button), 'clicked', gtk_signal_func(@gtkDialogCancelclickedCB), Sender);
{$endif}
gtk_signal_connect( gtk_object(P), 'destroy', gtk_Signal_Func(@gtkDialogDestroyCB), Sender);
if Sender is TOpenDialog then begin
// set extra options
if ofAllowMultiSelect in TOpenDialog(Sender).Options then
begin
LastFileSelectRow := -1;
gtk_signal_connect( gtk_object(PGtkCList(PGtkFileSelection(P)^.file_list)), 'select-row', gtk_signal_func(@gtkOpenDialogRowSelectCB), Sender);
gtk_clist_set_selection_mode(
PGtkCList(PGtkFileSelection(P)^.file_list),GTK_SELECTION_MULTIPLE);
end;
end;
end;
csColorDialog :
begin
P := gtk_color_selection_dialog_new(StrTemp);
// We will only add this line if we see problem in the future with the color dialog MAH 7-31-99
// gtk_color_selection_set_update_policy(GTK_COLOR_SELECTION((GTK_COLOR_SELECTION_DIALOG(P))^.colorsel), GTK_UPDATE_DISCONTINUOUS);
gtk_signal_connect( gtk_object((GTK_COLOR_SELECTION_DIALOG(P))^.ok_button), 'clicked', gtk_signal_func(@gtkDialogOKclickedCB), Sender);
gtk_signal_connect( gtk_object((GTK_COLOR_SELECTION_DIALOG(P))^.cancel_button), 'clicked', gtk_signal_func(@gtkDialogCancelclickedCB), Sender);
gtk_signal_connect( gtk_object(P), 'destroy', gtk_Signal_Func(@gtkDialogDestroyCB), Sender);
end;
csFontDialog :
begin
P := gtk_Font_selection_dialog_new(StrTemp);
gtk_signal_connect( gtk_object((GTK_FONT_SELECTION_DIALOG(P))^.ok_button), 'clicked', gtk_signal_func(@gtkDialogOKclickedCB), Sender);
gtk_signal_connect( gtk_object((GTK_FONT_SELECTION_DIALOG(P))^.cancel_button), 'clicked', gtk_signal_func(@gtkDialogCancelclickedCB), Sender);
gtk_signal_connect( gtk_object(P), 'destroy', gtk_Signal_Func(@gtkDialogDestroyCB), Sender);
end;
csFixed: //used for TWinControl, maybe change this to csWinControl
begin
writeln('[TgtkObject.CreateComponent] csFixed A ',Sender.Classname);
p := GTKAPIWidget_New;
writeln('[TgtkObject.CreateComponent] csFixed B');
gtk_scrolled_window_set_policy(PGTKScrolledWindow(p), GTK_POLICY_NEVER, GTK_POLICY_NEVER);
Adjustment := gtk_scrolled_window_get_vadjustment(PGTKScrolledWindow(p));
if Adjustment <> nil
then with Adjustment^ do
begin
gtk_object_set_data(PGTKObject(Adjustment), 'ScrollBar', PGTKScrolledWindow(p)^.VScrollBar);
Step_Increment := 1;
end;
Adjustment := gtk_scrolled_window_get_hadjustment(PGTKScrolledWindow(p));
if Adjustment <> nil
then with Adjustment^ do
begin
gtk_object_set_data(PGTKObject(Adjustment), 'ScrollBar', PGTKScrolledWindow(p)^.HScrollBar);
Step_Increment := 1;
end;
end;
csForm :
begin
Assert(Sender is TForm);
p := gtk_window_new(FormStyleMap[TForm(Sender).BorderStyle]);
// I comment the next line because this causes that when I align something
// it's right and bottom don't visible.
//Nagy Zsolt 2001/03/27
// gtk_container_set_border_width(GTK_CONTAINER(P), 2);
//TempInt:= FormSizeableMap[TForm(Sender).BorderStyle];
//gtk_window_set_policy (GTK_WINDOW (p), TempInt, TempInt, 0);
gtk_window_set_policy (GTK_WINDOW (p), 1, 1, 0);
gtk_window_set_title(pGtkWindow(p), strTemp);
// the clipboard needs a widget
if ClipboardWidget=nil then
SetClipboardWidget(p);
// Create the VBox, we need that to place controls outside
// the client area (like menu)
Box := gtk_vbox_new(False, 0);
gtk_container_add(p, Box);
gtk_widget_show(Box);
// Create the form client area
TempWidget := gtk_fixed_new();
gtk_box_pack_end(Box, TempWidget, True, True, 0);
gtk_widget_show(TempWidget);
SetFixedWidget(p, TempWidget);
SetMainWidget(p, TempWidget);
//drag icons
if Drag_Icon = nil then
Drag_Icon := gdk_pixmap_colormap_create_from_xpm_d (nil,
gtk_widget_get_colormap (p), @Drag_Mask,
nil, @IMGDrag_Icon);
end;
csFrame :
begin
P := gtk_frame_new(' ');
gtk_frame_set_shadow_type(pGtkFrame(P),GTK_SHADOW_NONE);
end;
csHintWindow :
Begin
p := gtk_window_new(FormStyleMap[bsToolWindow]{gtk_window_Popup});
gtk_window_set_policy (GTK_WINDOW (p), 0, 0, 0);
// Box := gtk_vbox_new(False, 0);
// gtk_container_add(p, Box);
// gtk_widget_show(Box);
// Create the form client area
TempWidget := gtk_fixed_new();
gtk_container_add(p, TempWidget);// gtk_box_pack_end(Box, TempWidget, True, True, 0);
gtk_widget_show(TempWidget);
SetFixedWidget(p, TempWidget);
SetMainWidget(p, TempWidget);
gtk_widget_show(p);
end;
csImage : Begin
p := gtk_image_new(nil,nil);
end;
csLabel :
begin
P := gtk_label_new(StrTemp);
gtk_misc_set_alignment(PGTKMISC(P), 0.0 , 1.0);
end;
csMemo :
begin
P := gtk_scrolled_window_new(nil, nil);
TempWidget := gtk_text_new(nil, nil);
gtk_text_set_editable (PGtkText(TempWidget), not (Sender as TMemo).ReadOnly);
gtk_text_set_word_wrap(PGtkText(TempWidget), Integer((Sender as TCustomMemo).WordWrap));
gtk_widget_show(TempWidget);
gtk_container_add(p, TempWidget);
case (Sender as TCustomMemo).Scrollbars of
ssHorizontal: gtk_scrolled_window_set_policy(p, GTK_POLICY_ALWAYS, GTK_POLICY_NEVER);
ssVertical: gtk_scrolled_window_set_policy(p, GTK_POLICY_NEVER, GTK_POLICY_ALWAYS);
ssBoth: gtk_scrolled_window_set_policy(p, GTK_POLICY_ALWAYS, GTK_POLICY_ALWAYS);
else
gtk_scrolled_window_set_policy(p, GTK_POLICY_NEVER, GTK_POLICY_NEVER);
end;
//--------------------------
// MWE: will be obsoleted
SetCoreChildWidget(p, TempWidget);
//--------------------------
GetWidgetInfo(p, True)^.ImplementationWidget := TempWidget;
(* // Assert(False, 'Trace:Creating a MEMO...');
P := gtk_hbox_new(false, 0);
TempWidget := gtk_text_new(nil,nil);
gtk_text_set_editable (PGtkText(TempWidget), not (Sender as TMemo).ReadOnly);
gtk_text_set_word_wrap(PGtkText(TempWidget), Integer((Sender as TCustomMemo).WordWrap));
gtk_box_pack_start(PGtkBox(P), TempWidget, true, true, 0);
gtk_widget_show(TempWidget);
//--------------------------
// MWE: will be obsoleted
SetCoreChildWidget(p, TempWidget);
//--------------------------
GetWidgetInfo(p, True)^.ImplementationWidget := TempWidget;
SetMainWidget(p, TempWidget);
if (Sender as TCustomMemo).Scrollbars in [ssVertical, ssBoth]
then begin
TempWidget := gtk_vscrollbar_new(PGtkText(TempWidget)^.vadj);
gtk_box_pack_start(PGtkBox(P), TempWidget, false, false, 0);
gtk_widget_show(TempWidget);
SetMainWidget(p, TempWidget);
end;
{
if (Sender as TCustomMemo).Scrollbars in [ssHorizontal, ssBoth]
then begin
TempWidget := gtk_hscrollbar_new(PGtkText(TempWidget)^.hadj);
gtk_box_pack_start(PGtkBox(P), TempWidget, false, false, 0);
gtk_widget_show(TempWidget);
SetMainWidget(p, TempWidget);
end;
}
*)
gtk_widget_show(P);
end;
csMainMenu:
begin
p := gtk_menu_bar_new();
// get the VBox, the form has one child, a VBox
Box := PGTKBin(TWinControl(TMenu(Sender).Owner).Handle)^.Child;
gtk_box_pack_start(Box, p, False, False, 0);
SetAccelGroup(p, gtk_accel_group_get_default);
gtk_widget_show(p);
end;
csMenuBar :
begin
P := gtk_menu_bar_new();
gtk_container_add(GTK_Container(GetFixedWidget(Pointer(TWinControl(TMenu(Sender).Owner).Handle))), P);
SetAccelGroup(p, gtk_accel_group_get_default);
gtk_widget_show(p);
end;
csMenuItem :
begin
if Caption <> '-'
then begin
//Check for an shortcut key
tempInt := pos('&', Caption);
if tempInt <> 0 then
begin
StrTemp[tempInt - 1] := '_';
P := gtk_menu_item_new_with_label('');
SetAccelKey(P, gtk_label_parse_uline(PGTKLabel(PGTKBin(p)^.Child), StrTemp));
end
else P := gtk_menu_item_new_with_label(Strtemp)
end
else P := gtk_menu_item_new;
gtk_widget_show (p);
end;
csNotebook :
begin
P := gtk_notebook_new();
gtk_notebook_set_scrollable(P, true);
gtk_notebook_popup_enable(P);
gtk_notebook_set_show_tabs(P, false); // Turn tabs off
{
MWE: The FixedWidged pops up as an Page
We don't want that. BTW Adding controls to the notebookcontrol ???
}
{ TempWidget := gtk_fixed_new();
gtk_container_add(GTK_CONTAINER(p), TempWidget);
gtk_widget_show(TempWidget);
gtk_Object_Set_Data(Pgtkobject(p),'Fixed',tempWidget);
gtk_object_set_data(PGTKObject(TempWidget), 'Main', p);
gtk_Object_Set_Data(Pgtkobject(tempwidget),'Owner',p);
??? Fixed object_data not only a container ???
Without, the notebook dumps
This should be fixed someday
}
// Assert(False, 'Trace:FIXME !!! [TgtkObject.CreateComponent] csNotebook --> gtk_Object_Set_Data');
// SetFixedWidget(p, p);
end;
csRadioButton :
with sender as TRadioButton do
begin
if group = 0 then
begin
P := gtk_radio_button_new_with_label(PGsList(group),StrTemp);
group := THandle (gtk_radio_button_group (GTk_Radio_Button(P)));
end
else begin
P := gtk_radio_button_new_with_label(gtk_radio_button_group (GTk_Radio_Button(group)),StrTemp);
end;
end;
csScrollBar :
begin
if (TScrollBar(sender).kind = sbHorizontal) then
begin
P := gtk_hscrollbar_new(PgtkAdjustment(gtk_adjustment_new(1,TScrollBar(sender).min, TScrollBar(sender).max,
TScrollBar(sender).SmallChange, TScrollBar(sender).LargeChange,
TScrollBar(sender).Pagesize)));
end
else
Begin
P := gtk_vscrollbar_new(PgtkAdjustment(gtk_adjustment_new(1,TScrollBar(sender).min, TScrollBar(sender).max,
TScrollBar(sender).SmallChange, TScrollBar(sender).LargeChange,
TScrollBar(sender).Pagesize)));
end;
end;
csScrolledWindow :
begin
P := gtk_scrolled_window_new(nil,nil);
end;
csSpeedButton:
Begin
p := gtk_button_new_with_label(StrTemp);
{p := gtk_drawing_area_new();
gtk_drawing_area_size(pGTKDrawingArea(p),22,22);}
//nothing done here. We are only worried about the canvas
end;
csSpinEdit :
begin
p := gtk_spin_button_new(PgtkAdjustment(gtk_adjustment_new(1,1,100,1,1,1)),1,0);
end;
csSTATUSBAR :
begin
P := gtk_statusbar_new();
Assert(False, 'Trace:In CreateComponent --StatusBar');
end;
csgtkTable :
begin
P := gtk_table_new(2,2,False);
end;
csToggleBox :
begin
P := gtk_toggle_button_new_with_label(StrTemp);
end;
csToolbar:
begin
p := gtk_toolbar_new(GTK_ORIENTATION_HORIZONTAL,GTK_TOOLBAR_BOTH);
gtk_widget_show (P);
end;
csToolButton:
begin
if TToolButton(Sender).Style = tbsButton then
Begin
p := gtk_button_new_with_label(StrTemp);
Assert(False, 'Trace:TTOOLBUTTON created as type TBSBUTTON');
end
else Begin
p := gtk_button_new_with_label(StrTemp);
Assert(False, 'Trace:TTOOLBUTTON created as type TBSBUTTON because type was unknown');
end;
gtk_widget_show (P);
{ p := gtk_toolbar_prepend_item(pGTKToolbar(TWinControl(TWincontrol(sender).Parent).Handle),
str,Str2,nil,nil,gtk_signal_func(@gtkclickedCB),Sender);
}
end;
csGroupBox:
begin
P := gtk_frame_new (StrTemp);
TempWidget := gtk_fixed_new();
gtk_container_add(GTK_CONTAINER(p), TempWidget);
gtk_widget_show(TempWidget);
SetFixedWidget(p, TempWidget);
SetMainWidget(p, TempWidget);
gtk_widget_show (P);
end;
csPage: // TPage - Notebook page
begin
// create a fixed widget in a horizontal box
P := gtk_hbox_new(false, 0);
TempWidget := gtk_fixed_new();
gtk_container_add(GTK_CONTAINER(P), TempWidget);
gtk_widget_show(TempWidget);
SetFixedWidget(p, TempWidget);
SetMainWidget(p, TempWidget);
gtk_widget_show(P);
end;
csPopupMenu :
with (TPopupMenu(Sender)) do
Begin
P := gtk_menu_new();
end;
csProgressBar:
with (TProgressBar (Sender)) do
begin
{ Create a GtkAdjusment object to hold the range of the progress bar }
TempWidget := PGtkWidget( gtk_adjustment_new (Position, Min, Max, 0, 0, 0));
{ Create the GtkProgressBar using the adjustment }
P := gtk_progress_bar_new_with_adjustment (PGtkAdjustment (TempWidget));
end;
csTrackBar:
with (TTrackBar (Sender)) do
begin
TempWidget := PGtkWidget( gtk_adjustment_new (Position, Min, Max, linesize, pagesize, 0));
if (Orientation = trHorizontal)
then P := gtk_hscale_new (PGTKADJUSTMENT (TempWidget))
else P := gtk_vscale_new (PGTKADJUSTMENT (TempWidget));
gtk_scale_set_digits (PGTKSCALE (P), 0);
end;
csPanel:
with (TPanel(Sender)) do begin
p := gtk_fixed_new();
gtk_widget_show (p);
SetFixedWidget(p, p);
SetMainWidget(p, p);
end;
end; //case
if (Sender is TWinControl) then
begin
TWinControl(Sender).Handle := THandle(p);
if p <> nil then
gtk_object_set_data(pgtkobject(p),'Sender',Sender);
end
else if (Sender is TMenuItem)
then TMenuItem(Sender).Handle := HMenu(p)
else if (Sender is TMenu)
then TMenu(Sender).Items.Handle := HMenu(p)
else if (Sender is TCommonDialog)
then TCommonDialog(Sender).Handle:= THandle(p);
// MWE: next will be obsoleted by WinWidgetInfo
//Set these for functions like GetWindowLong Added 01/07/2000
{}
SetLCLObject(p, Sender);
if p <> nil then
Begin
gtk_object_set_data(pgtkObject(p),'Style',0);
gtk_object_set_data(pgtkObject(p),'ExStyle',0);
end;
{}
//--------------------------
StrDispose(StrTemp);
Assert(False, 'Trace:Leaving CreateComponent');
end;
{------------------------------------------------------------------------------}
{ TGtkObject GetLabel }
{ *Note: Returns a widgets lable value }
{------------------------------------------------------------------------------}
function TgtkObject.GetLabel(CompStyle: Integer; P : Pointer) : String;
var
pLabel: Pointer;
aPChar: PChar;
begin
Result := 'Label';
case CompStyle of
csLabel: begin
gtk_label_get(PGTKLabel(p),@aPChar);
Result:=StrPas(aPChar);
end;
csForm : Result := StrPas(PgtkWindow(p)^.Title);
csPage : begin
pLabel := gtk_notebook_get_tab_label(
PGTKNoteBook(TWinControl(P).Parent.Handle),
PGTKWidget(TWinControl(P).Handle));
if pLabel <> nil then begin
gtk_label_get(pLabel, @aPChar);
Result:=StrPas(aPChar);
end;
end;
end;
end;
{------------------------------------------------------------------------------}
{ TGtkObject AssignSelf }
{ *Note: Assigns a pointer to self on a widget }
{------------------------------------------------------------------------------}
procedure TgtkObject.AssignSelf(Child,Data : Pointer);
begin
gtk_Object_Set_Data(Pgtkobject(Child),'Self',Data);
end;
{------------------------------------------------------------------------------}
{ TGtkObject ShowHide }
{ *Note: Show or hide a widget }
{------------------------------------------------------------------------------}
procedure TgtkObject.ShowHide(Sender : TObject);
var FormIconGdiObject: PGDIObject;
FormWidget: PGTKWidget;
begin
FormWidget:=PgtkWidget(TWinControl(Sender).Handle);
//if Sender is TForm then
//writeln('[TgtkObject.ShowHide] START ',Sender.ClassName,' Visible=',TControl(Sender).Visible,' Window=',FormWidget^.Window<>nil);
if TControl(Sender).Visible then begin
gtk_widget_show(FormWidget);
if (Sender is TCustomForm) and (FormWidget^.Window<>nil) then begin
FormIconGdiObject:=PGDIObject(TCustomForm(Sender).GetIconHandle);
if (FormIconGdiObject<>nil) then begin
gdk_window_set_icon(FormWidget^.Window, nil,
FormIconGdiObject^.GDIBitmapObject,
FormIconGdiObject^.GDIBitmapMaskObject);
end;
end;
end
else Begin
gtk_widget_hide(FormWidget);
end;
//if Sender is TForm then
//writeln('[TgtkObject.ShowHide] END ',Sender.ClassName,' Window=',FormWidget^.Window<>nil);
end;
{------------------------------------------------------------------------------}
{ TGtkObject AddNBPage }
{ *Note: Add Notebook Page }
{------------------------------------------------------------------------------}
procedure TgtkObject.AddNBPage(Parent, Child: TObject; Index: Integer);
var
pStr: PCHar;
begin
Assert(false, 'Trace:Adding a notebook page');
pStr := StrAlloc(Length(TWinControl(Child).Caption) + 1);
try
StrPCopy(pStr, TWinControl(Child).Caption);
gtk_notebook_insert_page(PGtkNotebook(TWinControl(Parent).Handle),
PGtkWidget(TWinControl(Child).Handle),
gtk_label_new(pStr),
Index);
finally
strDispose(pStr);
end;
// gtk_object_set_data(PGtkObject(TPage(Child).Handle), '1', pgtkwidget(TWinControl(Parent).handle));
end;
{------------------------------------------------------------------------------}
{ TGtkObject RemoveNBPage }
{ *Note: Remove Notebook Page }
{------------------------------------------------------------------------------}
procedure TgtkObject.RemoveNBPage(Parent: TObject; Index: Integer);
begin
Assert(false, 'Trace:Removing a notebook page');
gtk_notebook_remove_page(PGtkNotebook(TWinControl(Parent).Handle), Index);
end;
{------------------------------------------------------------------------------}
{ TGtkObject ReDraw }
{ *Note: }
{------------------------------------------------------------------------------}
procedure TgtkObject.ReDraw(Child : Pointer);
var
fWindow :pGdkWindow;
widget : PgtkWIdget;
PixMap : pgdkPixMap;
//gc : PGDKGc;
begin
Assert(False, 'Trace:In AutoRedraw in GTKObject');
Widget := GetFixedWidget(Child);
pixmap := gtk_Object_get_data(pgtkobject(Child),'Pixmap');
if PixMap = nil then Exit;
fWindow := pGtkWidget(widget)^.window;
//gc := gdk_gc_new(PgdkWindow(fWindow));
gdk_draw_pixmap(fwindow,PGtkStyle(widget^.TheStyle)^.fg_gc[GTK_WIDGET_STATE (widget)],
pixmap,
0,0,
0,0,
pgtkwidget(widget)^.allocation.width, pgtkwidget(widget)^.allocation.height);
end;
{------------------------------------------------------------------------------
Method: TGtkObject.SetPixel
Params: Sender : the lcl object which called this func via SendMessage
Data : pointer to a TLMSetGetPixel record
Returns: nothing
Set the color of the specified pixel on the window?screen?object?
------------------------------------------------------------------------------}
procedure TgtkObject.SetPixel(Sender : TObject; Data : Pointer);
var
PDC : PDeviceContext;
Image : pGDKImage;
Widget : PgtkWidget;
GDKColor: TGDKColor;
pFixed : PGTKFixed;
fWindow : pGdkWindow;
begin
PDC := PDeviceContext(TCanvas(Sender).Handle);
if PDC = nil then exit;
Widget := PgtkWidget(PDC^.HWnd);
Image := gtk_Object_get_data(pgtkobject(widget),'Image');
if Image = nil then begin
Image := gdk_image_get(pgtkWidget(widget)^.window,0,0,
widget^.allocation.width,widget^.allocation.height);
if Image = nil then exit;
gtk_Object_set_data(pgtkobject(Widget),'Image',Image);
end;
GDKColor:=AllocGDKColor(TLMSetGetPixel(data^).PixColor);
//writeln('SetPixel: Color=',HexStr(TLMSetGetPixel(data^).PixColor,8),' GDKColor=',HexStr(GDKColor.Pixel,8));
gdk_image_put_pixel(Image,TLMSetGetPixel(data^).X,TLMSetGetPixel(data^).Y,
GDKColor.Pixel);
pFixed := GetFixedWidget(Widget);
if pFixed <> nil then Widget:=PgtkWidget(pFixed);
fWindow := pGtkWidget(Widget)^.window;
gdk_draw_image(fwindow,
PGtkStyle(widget^.TheStyle)^.fg_gc[GTK_WIDGET_STATE (Widget)],
Image,
TLMSetGetPixel(Data^).X,TLMSetGetPixel(data^).Y,
TLMSetGetPixel(Data^).X,TLMSetGetPixel(data^).Y,
1,1);
end;
{------------------------------------------------------------------------------
Method: TGtkObject.GetPixel
Params: Sender : the lcl object which called this func via SenMessage
Data : pointer to a TLMSetGetPixel record
Returns: nothing
Get the color of the specified pixel on the window?screen?object?
------------------------------------------------------------------------------}
procedure TgtkObject.GetPixel(Sender : TObject; Data : Pointer);
var
PDC : PDeviceContext;
Image : pGDKImage;
Widget : PgtkWidget;
GDKColor: TGDKColor;
GdkColorContext: PGdkColorContext;
begin
PDC := PDeviceContext(TCanvas(Sender).Handle);
if PDC = nil then exit;
Widget := PgtkWidget(PDC^.HWnd);
Image := gtk_Object_get_data(pgtkobject(Widget),'Image');
if Image = nil then begin
Image := gdk_image_get(pgtkWidget(widget)^.window,0,0,
widget^.allocation.width,widget^.allocation.height);
if Image = nil then exit;
gtk_Object_set_data(pgtkobject(Widget),'Image',Image);
end;
GDKColor.Pixel := gdk_image_get_pixel(Image,
TLMSetGetPixel(data^).X,TLMSetGetPixel(data^).Y);
GdkColorContext:=
gdk_color_context_new(gdk_visual_get_system,gdk_colormap_get_system);
gdk_color_context_query_color(GdkColorContext,@GDKColor);
gdk_color_context_free(GdkColorContext);
TLMSetGetPixel(data^).PixColor := TGDKColorToTColor(GDKColor);
end;
{------------------------------------------------------------------------------
Method: TGtkObject.SetColorDialogColor
Params: ColorSelection : a gtk color selection dialog;
Color : the color to select
Returns: nothing
Set the color of the coor selection dialog
------------------------------------------------------------------------------}
procedure TgtkObject.SetColorDialogColor(ColorSelection: PGtkColorSelection;
Color: TColor);
var
SelectionColor: PGDouble; // currently only used by TColorDialog
colorSel : GTK_COLOR_SELECTION;
begin
GetMem(SelectionColor,4*SizeOf(GDouble));
try
Color:=ColorToRGB(Color);
SelectionColor[0]:=(Color and $ff)/255;
SelectionColor[1]:=((Color shr 8) and $ff)/255;
SelectionColor[2]:=((Color shr 16) and $ff)/255;
SelectionColor[3]:=0.0;
colorSel := GTK_COLOR_SELECTION(
(GTK_COLOR_SELECTION_DIALOG(ColorSelection))^.colorsel);
gtk_color_selection_set_color(colorSel,SelectionColor);
finally
FreeMem(SelectionColor);
end;
end;
{------------------------------------------------------------------------------
Method: TGtkObject.GetValue
Params: Sender : the lcl object which called this func via SenMessage
Data : pointer to component specific variable
Returns: currently always 0
Depending on the compStyle, this function will get the current value
of a GTK object and save it in the variable referenced by 'data'.
This function should be used to synchronize the state of an lcl-object
with the corresponding GTK-object.
------------------------------------------------------------------------------}
function TgtkObject.GetValue (Sender : TObject; data : pointer) : integer;
var
Handle : Pointer;
Year,Month,Day : Integer; //used for csCalendar
begin
result := 0; // default if nobody sets it
if Sender is TWinControl
then Assert(False, Format('Trace: [TgtkObject.GetValue] %s', [Sender.ClassName]))
else Assert(False, Format('Trace:WARNING: [TgtkObject.GetValue] %s --> No Decendant of TWinControl', [Sender.ClassName]));
Handle := Pointer(TWinControl(Sender).Handle);
Assert (Handle = nil, 'WARNING: [TgtkObject.GetValue] --> got nil pointer (no gtkobject)');
case TControl(Sender).fCompStyle of
csTrackbar :
if (handle <> nil) then begin
integer(data^) := round(gtk_range_get_adjustment(
GTK_RANGE (handle))^.value);
end else
integer(data^) := 0;
csRadiobutton,
csCheckbox : if gtk_toggle_button_get_active (PGtkToggleButton (handle))
then TCheckBoxState (data^) := cbChecked
else TCheckBoxState (data^) := cbUnChecked;
csCalendar :Begin
gtk_calendar_get_date(PgtkCalendar(handle),@Year, @Month, @Day);
//TODO: account for local settings like date format
//Form some reason, the month is zero based.
TLMCalendar(data^).Date := StrtoDate(Inttostr(Day)+'-'+Inttostr(Month+1)+'-'+Inttostr(Year));
end;
else
Assert (true, Format ('WARNING:[TgtkObject.GetValue] failed for %s', [Sender.ClassName]));
end;
end;
{------------------------------------------------------------------------------
Method: TGtkObject.SetValue
Params: Sender : the lcl object which called this func via SenMessage
Data : pointer to component specific variable
Returns: currently always 0
Depending on the compStyle, this function will apply the parameter 'data'
to the GTK object repesenting the lcl-object which called the function.
This function should for be used in cases where the most common property
of an object has changed (e.g. the position of a trackbar). If more than
one property changed use the SetProperties function instead;
------------------------------------------------------------------------------}
function TgtkObject.SetValue (Sender : TObject; data : pointer) : integer;
var
Handle : Pointer;
//used for csCalendar
Date : TDateTime;
Year,Month,Day : String;
gtkcalendardisplayoptions : TGtkCalendarDisplayOptions;
NUm : Integer;
ArrowType : TGTKArrowType;
ShadowType : TGTKShadowType;
begin
result := 0; // default if nobody sets it
if Sender is TWinControl
then Assert(False, Format('Trace: [TgtkObject.SetValue] %s', [Sender.ClassName]))
else Assert(False, Format('Trace:WARNING: [TgtkObject.SetValue] %s --> No Decendant of TWinControl', [Sender.ClassName]));
Handle := Pointer(TWinControl(Sender).Handle);
// Assert (Handle = nil, 'WARNING: [TgtkObject.SetValue] --> got nil pointer (no gtkobject)');
case TControl(Sender).fCompStyle of
csProgressBar: gtk_progress_set_value (GTK_PROGRESS (handle), integer (data^));
csTrackbar : begin
if Handle = nil then Exit;
gtk_range_get_adjustment (GTK_RANGE (handle))^.value := integer (data^);
gtk_signal_emit_by_name (PGtkObject
(gtk_range_get_adjustment (
GTK_RANGE (handle))), 'value_changed');
end;
csRadiobutton,
csCheckbox : if TCheckBoxState (data^) = cbChecked
then gtk_toggle_button_set_active( PGtkToggleButton (handle), TRUE)
else gtk_toggle_button_set_active( PGtkToggleButton (handle), FALSE);
csCalendar : Begin
Date := TLMCalendar(data^).Date;
Year := FormatDateTime('yyyy',Date);
Month := FormatDateTime('mm',Date);
Day := FormatDateTime('dd',Date);
gtk_calendar_select_month(PgtkCalendar(handle),StrtoInt(Month)-1,StrToInt(Year));
gtk_calendar_select_day(PgtkCalendar(handle),StrToInt(Day));
//set display options
Num := 0;
if (dsShowHeadings in TLMCalendar(data^).DisplaySettings) then
num := Num + (1 shl 0);
if (dsShowDayNames in TLMCalendar(data^).DisplaySettings) then
num := Num + (1 shl 1);
if (dsNoMonthChange in TLMCalendar(data^).DisplaySettings) then
num := Num + (1 shl 2);
if (dsShowWeekNumbers in TLMCalendar(data^).DisplaySettings) then
num := Num + (1 shl 3);
if (dsStartMonday in TLMCalendar(data^).DisplaySettings) then
num := Num + (1 shl 4);
gtkCalendarDisplayOptions := TgtkCalendarDisplayOPtions(num);
gtk_Calendar_Display_options(PgtkCalendar(handle),gtkCalendarDisplayOptions);
//readonly
if TLMCalendar(data^).ReadOnly then
gtk_calendar_freeze(PgtkCalendar(handle))
else
gtk_calendar_thaw(PgtkCalendar(handle));
end;
csArrow : Begin
if TLmArrow(data^).ArrowType = atUp then
ArrowType := GTK_ARROW_UP
else
if TLMArrow(data^).ArrowType = atLeft then
ArrowType := GTK_ARROW_LEFT
else
if TLMArrow(data^).ArrowType = atRight then
ArrowType := GTK_ARROW_RIGHT
else
ArrowType := GTK_ARROW_DOWN;
case TLMArrow(data^).ShadowType of
stNONE : ShadowType := GTK_SHADOW_NONE;
stIN : ShadowType := GTK_SHADOW_IN;
stOut : ShadowType := GTK_SHADOW_OUT;
stEtchedIn : ShadowType := GTK_SHADOW_ETCHED_IN;
stEtchedOut : ShadowType := GTK_SHADOW_ETCHED_OUT;
else
ShadowType := GTK_SHADOW_NONE;
end;
gtk_arrow_set(PgtkArrow(handle),ArrowType,ShadowType);
end
else
Assert (true, Format ('WARNING:[TgtkObject.SetValue] failed for %s', [Sender.ClassName]));
end;
end;
{------------------------------------------------------------------------------
Method: TGtkObject.SetProperties
Params: Sender : the lcl object which called this func via SenMessage
Returns: currently always 0
Depending on the compStyle, this function will apply all properties of
the calling object to the corresponding GTK object.
------------------------------------------------------------------------------}
function TgtkObject.SetProperties (Sender : TObject) : integer;
const
aGTKJustification: array[TAlignment] of TGTKJustification = (GTK_JUSTIFY_LEFT,GTK_JUSTIFY_RIGHT,GTK_JUSTIFY_CENTER);
aGTkSelectionMode: Array[Boolean] of TGtkSelectionMode = (GTK_SELECTION_SINGLE,GTk_SELECTION_EXTENDED);
var
Handle : Pointer;
Widget : PGtkWidget;
xAlign : gfloat;
yAlign : gfloat;
I,X : Integer;
ColName : String;
pColName : PChar;
pRowText : PChar;
Image : PgdkImage;
BitImage : TBitMap;
begin
result := 0; // default if nobody sets it
if Sender is TWinControl
then Assert(False, Format('Trace: [TgtkObject.SetProperties] %s', [Sender.ClassName]))
else Assert(False, Format('Trace:WARNING: [TgtkObject.SetProperties] %s --> No Decendant of TWinControl', [Sender.ClassName]));
Handle := Pointer(TWinControl(Sender).Handle);
Assert (Handle = nil, 'WARNING: [TgtkObject.SetProperties] --> got nil pointer');
case TControl(Sender).fCompStyle of
csEdit :
with (TCustomEdit(Sender)) do
Begin
gtk_entry_set_editable(PgtkEntry(handle),not(TCustomEdit(sender).ReadOnly));
gtk_entry_set_max_length(PgtkEntry(handle),TCustomEdit(sender).MaxLength);
end;
csProgressBar :
with (TProgressBar (Sender)) do
begin
Widget := PGtkWidget( gtk_adjustment_new (0, Min, Max, 0, 0, 0));
gtk_progress_set_adjustment (GTK_PROGRESS (handle), PGtkAdjustment (Widget));
gtk_progress_set_value (GTK_PROGRESS (handle), Position);
if Smooth
then gtk_progress_bar_set_bar_style (GTK_PROGRESS_BAR (handle), GTK_PROGRESS_CONTINUOUS)
else gtk_progress_bar_set_bar_style (GTK_PROGRESS_BAR (handle), GTK_PROGRESS_DISCRETE);
case Orientation of
pbVertical : gtk_progress_bar_set_orientation(GTK_PROGRESS_BAR (handle), GTK_PROGRESS_BOTTOM_TO_TOP);
pbRightToLeft : gtk_progress_bar_set_orientation(GTK_PROGRESS_BAR (handle), GTK_PROGRESS_RIGHT_TO_LEFT);
pbTopDown : gtk_progress_bar_set_orientation(GTK_PROGRESS_BAR (handle), GTK_PROGRESS_TOP_TO_BOTTOM);
else { pbHorizontal is default }
gtk_progress_bar_set_orientation(GTK_PROGRESS_BAR (handle), GTK_PROGRESS_LEFT_TO_RIGHT);
end;
if BarShowText then
begin
gtk_progress_set_format_string (GTK_PROGRESS (handle), '%v from [%l-%u] (=%p%%)');
gtk_progress_set_show_text (GTK_PROGRESS (handle), 1);
end
else
gtk_progress_set_show_text (GTK_PROGRESS (handle), 0);
end;
csScrollBar:
with (TScrollBar (Sender)) do
begin
//set properties for the range
Widget := PGtkWidget (gtk_range_get_adjustment (GTK_RANGE (handle)));
PGtkAdjustment(Widget)^.lower := Min;
PGtkAdjustment(Widget)^.Upper := Max;
PGtkAdjustment(Widget)^.Value := Position;
PGtkAdjustment(Widget)^.step_increment := SmallChange;
PGtkAdjustment(Widget)^.page_increment := LargeChange;
end;
csTrackbar :
with (TTrackBar (Sender)) do
begin
Widget := PGtkWidget (gtk_range_get_adjustment (GTK_RANGE (handle)));
PGtkAdjustment(Widget)^.lower := Min;
PGtkAdjustment(Widget)^.Upper := Max;
PGtkAdjustment(Widget)^.Value := Position;
PGtkAdjustment(Widget)^.step_increment := LineSize;
PGtkAdjustment(Widget)^.page_increment := PageSize;
{ now do some of the more sophisticated features }
{ Hint: For some unknown reason we have to disable the draw_value first,
otherwise it's set always to true }
gtk_scale_set_draw_value (PGTKSCALE (handle), false);
if ShowScale then
begin
gtk_scale_set_draw_value (PGTKSCALE (handle), ShowScale);
case ScalePos of
trLeft : gtk_scale_set_value_pos (PGTKSCALE (handle), GTK_POS_LEFT);
trRight : gtk_scale_set_value_pos (PGTKSCALE (handle), GTK_POS_RIGHT);
trTop : gtk_scale_set_value_pos (PGTKSCALE (handle), GTK_POS_TOP);
trBottom: gtk_scale_set_value_pos (PGTKSCALE (handle), GTK_POS_BOTTOM);
end;
end;
//Not here (Delphi compatibility): gtk_signal_emit_by_name (GTK_Object (Widget), 'value_changed');
end;
csLabel :
with TLabel(Sender) do
begin
case Alignment of
taLeftJustify : xAlign := 0.0;
taCenter : xAlign := 0.5;
taRightJustify : xAlign := 1.0;
else
xAlign := 0.0; // default, shouldn't happen
end;
case Layout of
tlTop : yAlign := 0.0;
tlCenter : yAlign := 0.5;
tlBottom : yAlign := 1.0;
else
yAlign := 1.0; //default, shouldn't happen
end;
gtk_misc_set_alignment(PGTKMISC(Handle), xAlign, yAlign);
gtk_label_set_line_wrap(PGTKLABEL(Handle),WordWrap);
end;
csListView :
begin
//set up columns..
//
Widget := PgtkWidget(Handle);//GetWidgetInfo(Pointer(Handle), True)^.ImplementationWidget;
gtk_clist_freeze(PgtkCList(Widget));
for I := 0 to TListview(sender).Columns.Count-1 do
begin
ColName := TListview(sender).Columns[i].Caption;
GetMem(pColName, Length(colname)+1);
StrPcopy(pColName, ColName);
gtk_clist_set_column_title(Pgtkclist(Widget),I,pColName);
Dispose(pColName);
//set column alignment
gtk_clist_set_column_justification(PgtkCList(Widget),I,aGTKJUSTIFICATION[TListview(sender).Columns[i].Alignment]);
//set width
gtk_clist_set_column_width(PgtkCList(Widget),I, TListview(sender).Columns[i].Width);
//set auto sizing
gtk_clist_set_column_auto_resize(PgtkCList(Widget),I, TListview(sender).Columns[i].AutoSize);
//set Visible
gtk_clist_set_column_visibility(PgtkCList(Widget),I, TListview(sender).Columns[i].Visible);
end;
//sorting
if (TListview(sender).ViewStyle = vsReport)
then gtk_clist_column_titles_show(PgtkCList(Widget))
else gtk_clist_column_titles_Hide(PgtkCList(Widget));
gtk_clist_set_sort_column(PgtkCList(Widget), TListview(sender).SortColumn);
//multiselect
gtk_clist_set_selection_mode(PgtkCList(Widget),aGTkSelectionMode[TListview(sender).MultiSelect]);
//TODO:This doesn't work right now
// gtk_clist_set_auto_sort(PgtkCList(handle),TListview(sender).Sorted);
//
//do items...
//
for I := 0 to TListview(sender).Items.Count-1 do
begin
GetMem(pRowText,Length(TListItem(TListview(sender).Items[i]).Caption)+1);
try
StrPcopy(pRowText,TListItem(TListview(sender).Items[i]).Caption);
gtk_clist_set_text(Pgtkclist(Widget),0,I+1,pRowText);
//do image if one is assigned....
// TODO: Largeimage support
Writeln('Starting image section');
if (TListview(sender).SmallImages <> nil)
and (TListItem(TListview(sender).Items[i]).ImageIndex > -1)
then begin
Writeln('Checking images');
if (TListItem(TListview(sender).Items[i]).ImageIndex < TListview(sender).SmallImages.Count)
then begin
//draw image
Writeln('drawing image');
Writeln('TListItem(TListview(sender).Items[i]).ImageIndex is ',TListItem(TListview(sender).Items[i]).ImageIndex);
BitImage := TBitmap.Create;
TListview(sender).SmallImages.GetBitmap(TListItem(TListview(sender).Items[i]).ImageIndex,BitImage);
gtk_clist_set_pixmap(Pgtkclist(Widget),I,0,pgdkPixmap(PgdiObject(BitImage.handle)^.GDIBitmapObject),nil);
gtk_clist_set_pixtext(Pgtkclist(Widget),I,0,pRowText,3,pgdkPixmap(PgdiObject(BitImage.handle)^.GDIBitmapObject),nil);
// bitimage.Free;
end;
end;
finally
freemem(pRowText);
end;
if (TListview(sender).ViewStyle = vsReport)
then begin //columns showing
for X := 1 to TListview(sender).Columns.Count-1 do
begin
if ( X <= TListItem(TListview(sender).Items[i]).SubItems.Count)
then begin
GetMem(pRowText,Length(TListItem(TListview(sender).Items[i]).SubItems.Strings[X-1])+1);
try
pRowText := StrPcopy(pRowText,TListItem(TListview(sender).Items[i]).SubItems.Strings[X-1]);
gtk_clist_set_text(Pgtkclist(Widget),X,I+1,pRowText);
finally
freemem(pRowText);
end;
end;
end; //for loop
end;
end;
gtk_clist_thaw(PgtkCList(Widget));
end;
csImage:
begin
//Image changed.
Widget := PgtkWidget(PdeviceContext(TBitmap(sender).handle));
Image := gdk_image_get(pgtkWidget(widget)^.window,0,0,widget^.allocation.width,widget^.allocation.height);
if Handle = nil
then TWinControl(sender).Handle := THandle(gtk_image_new(Image,nil))
else gtk_image_set(PgtkImage(handle),Image,nil);
end;
else
Assert (true, Format ('WARNING:[TgtkObject.SetProperties] failed for %s', [Sender.ClassName]));
end;
end;
{------------------------------------------------------------------------------
Method: TGtkObject.UpdateHint
Params: Sender : the lcl object which called this func
Returns: currently always 0
Sets the tooltip text of the sending control.
------------------------------------------------------------------------------}
function TGtkObject.UpdateHint(Sender: TObject) : integer;
var
StrTemp : PChar;
begin
Result := 0; // default if nobody sets it
if Sender is TWinControl then
with Sender as TWinControl do
begin
if (Length(Hint) > 0) and (ShowHint or (csDesigning in ComponentState))
then begin
strTemp := StrAlloc(Length(Hint) + 1);
try
StrPCopy(strTemp, Hint);
// ?? TODO something with short and long hints ??
gtk_ToolTips_Set_Tip(FGTKToolTips, PgtkWidget(Handle), StrTemp, StrTemp);
finally
StrDispose(strTemp);
end;
end
else gtk_ToolTips_Set_Tip(FGTKToolTips, PgtkWidget(Handle), nil, nil);
end;
end;
{------------------------------------------------------------------------------
Method: TGtkObject.AttachMenu
Params: Sender : the lcl object which called this func
Returns: nothing
Attaches the calling Menu to its Parent
------------------------------------------------------------------------------}
procedure TGtkObject.AttachMenu(Sender: TObject);
var
AccelKey: Integer;
AccelGroup: PGTKAccelGroup;
MenuParent, MenuItem: Pointer;
begin
with (Sender as TMenuItem) do
begin
MenuItem := Pointer(Handle);
if (Parent.GetParentMenu <> nil) and
(Parent.GetParentMenu.Items.IndexOf(TMenuItem(Sender)) <> -1) then //mainmenu
begin
MenuParent := Pointer(Parent.Handle);
gtk_menu_bar_append(MenuParent, MenuItem);
end
else begin
// find the menu container
MenuParent := gtk_object_get_data(PGtkObject(Parent.Handle), 'ContainerMenu');
if MenuParent = nil then
begin
MenuParent := gtk_menu_new;
gtk_object_set_data(PGtkObject(Parent.Handle), 'ContainerMenu', MenuParent);
gtk_menu_item_set_submenu(PGTKMenuItem(Parent.Handle), MenuParent);
AccelGroup := gtk_accel_group_new;
gtk_menu_set_accel_group(MenuParent, AccelGroup);
SetAccelGroup(MenuParent, AccelGroup);
end;
gtk_menu_append(MenuParent, MenuItem);
end;
// Add accelerators
AccelGroup := GetAccelGroup(MenuParent);
AccelKey := GetAccelKey(MenuItem);
if (AccelGroup <> nil) and (AccelKey <> 0)
then gtk_accel_group_add(AccelGroup, AccelKey, GDK_MOD1_MASK, GTK_ACCEL_LOCKED, MenuItem, 'activate_item');
end;
end;
{------------------------------------------------------------------------------
Function: IsValidDC
Params: DC: a (LCL) devicecontext
Returns: True if valid
Checks if the given DC is valid.
------------------------------------------------------------------------------}
function TgtkObject.IsValidDC(const DC: HDC): Boolean;
begin
Result := FDeviceContexts.Contains(Pointer(DC));
Assert(False, Format('Trace: [TgtkObject.IsValidDC] DC: 0x%x --> %s', [Integer(DC), BOOL_RESULT[Result]]));
end;
{------------------------------------------------------------------------------
Function: IsValidGDIObject
Params: GDIObject: a (LCL) gdiObject
Returns: True if valid
Checks if the given GDIObject is valid
------------------------------------------------------------------------------}
function TgtkObject.IsValidGDIObject(const GDIObject: HGDIOBJ): Boolean;
begin
Result := (GDIObject<>0) and (FGDIObjects.Contains(Pointer(GDIObject)));
// Result := (GDIObject <> 0);
if Result then
// try
with PGdiObject(GDIObject)^ do
case GDIType of
gdiBitmap : begin
case GDIBitmapType of
gbPixmap: Result := GDIPixmapObject <> nil;
gbBitmap: Result := GDIBitmapObject <> nil;
gbImage: Result := GDIRawImageObject <> nil;
else
Result := False;
end;
end;
gdiBrush : Result := True; //Result := GDIBrushPixmap <> nil; //GDIBrushPixmap may be nil
gdiFont : Result := GDIFontObject <> nil;
gdiPen : Result := True;
// gdiRegion :
else
Result := False;
end;
// except
// on Exception do Result := False;
// end;
Assert(False, Format('Trace: [TgtkObject.IsValidGDIObject] GDIObject: 0x%x --> %s', [Integer(GDIObject), BOOL_RESULT[Result]]));
end;
{------------------------------------------------------------------------------
Function: IsValidGDIObjectType
Params: GDIObject: a (LCL) gdiObject
GDIType: the requested type
Returns: True if valid
Checks if the given GDIObject is valid and the GDItype is the requested type
------------------------------------------------------------------------------}
function TgtkObject.IsValidGDIObjectType(const GDIObject: HGDIOBJ; const GDIType: TGDIType): Boolean;
begin
Result := IsValidGDIObject(GDIObject) and (PGdiObject(GDIObject)^.GDIType = GDIType);
end;
{------------------------------------------------------------------------------
Function: NewDC
Params: none
Returns: a gtkwinapi DeviceContext
Creates an initial DC
------------------------------------------------------------------------------}
function TgtkObject.NewDC: PDeviceContext;
begin
Assert(False, Format('Trace:> [TgtkObject.NewDC]', []));
New(Result);
with Result^ do
begin
hWnd := 0;
GC := nil;
Drawable := nil;
PenPos.X := 0;
PenPos.Y := 0;
CurrentBitmap := nil;
CurrentFont := nil;
CurrentPen := nil;
CurrentBrush := nil;
SavedContext := nil;
gdk_color_black(gdk_colormap_get_system, @CurrentTextColor);
gdk_color_white(gdk_colormap_get_system, @CurrentBackColor);
end;
FDeviceContexts.Add(Result);
//writeln('[TgtkObject.NewDC] ',HexStr(Cardinal(Result),8),' ',FDeviceContexts.Count);
// Assert(False, Format('Trace:< [TgtkObject.NewDC] FDeviceContexts[%d] --> 0x%p', [n, Result]));
end;
(*
{------------------------------------------------------------------------------
Function: FreeDC
Params: ADC: A DC to Free
Returns: nothing
Frees an initial DC
It does not free the GDI objects. See ReleaseDC for a smarter function.
------------------------------------------------------------------------------}
function TgtkObject.FreeDC(ADC: PDeviceContext);
var
n: Integer;
begin
//writeln('[TgtkObject.FreeDC] ',HexStr(Cardinal(ADC),8));
Assert(False, Format('Trace:> [TgtkObject.FreeDC] DC:0x%p', [ADC]));
if ADC <> nil
then begin
if ADC^.SavedContext <> nil
then begin
writeln('[TgtkObject.FreeDC] WARNING: there is an unused saved context left!');
FreeDC(ADC^.SavedContext);
end;
Assert(ADC^.CurrentBitmap = nil, 'trace: [TgtkObject.FreeDC] CurrentBitmap <> nil');
Assert(ADC^.CurrentFont = nil, 'trace: [TgtkObject.FreeDC] CurrentFont <> nil');
Assert(ADC^.CurrentPen = nil, 'trace: [TgtkObject.FreeDC] CurrentPen <> nil');
Assert(ADC^.CurrentBrush = nil, 'trace: [TgtkObject.FreeDC] CurrentBrush <> nil');
if ADC^.GC <> nil
then gdk_gc_unref(ADC^.GC);
n := FDeviceContexts.Remove(ADC);
Dispose(ADC);
end;
Assert(False, Format('Trace:< [TgtkObject.FreeDC] FDeviceContexts[%d]', [n]));
end;
*)
{------------------------------------------------------------------------------
Function: NewGDIObject
Params: none
Returns: a gtkwinapi DeviceContext
Creates an initial DC
------------------------------------------------------------------------------}
function TgtkObject.NewGDIObject(const GDIType: TGDIType): PGdiObject;
begin
Assert(False, Format('Trace:> [TgtkObject.NewGDIObject]', []));
New(Result);
FillChar(Result^, SizeOf(TGDIObject), 0);
Result^.GDIType := GDIType;
FGDIObjects.Add(Result);
//writeln('[TgtkObject.NewGDIObject] ',HexStr(Cardinal(Result),8),' ',FGDIObjects.Count);
Assert(False, Format('Trace:< [TgtkObject.NewGDIObject] FGDIObjects --> 0x%p', [Result]));
end;
{------------------------------------------------------------------------------
Function: CreateDefaultBrush
Params: none
Returns: a Brush GDIObject
Creates an default brush, used for initial values
------------------------------------------------------------------------------}
function TgtkObject.CreateDefaultBrush: PGdiObject;
begin
//write(' TgtkObject.CreateDefaultBrush ->');
Result := NewGDIObject(gdiBrush);
Result^.GDIBrushFill := GDK_SOLID;
gdk_color_white(gdk_colormap_get_system, @Result^.GDIBrushColor);
end;
{------------------------------------------------------------------------------
Function: CreateDefaultFont
Params: none
Returns: a Font GDIObject
Creates an default font, used for initial values
------------------------------------------------------------------------------}
function TgtkObject.CreateDefaultFont: PGdiObject;
begin
Result := NewGDIObject(gdiFont);
if FDefaultFont = nil then begin
FDefaultFont:= gdk_font_load('-adobe-helvetica-medium-r-normal--*-120-*-*-*-*-iso8859-1');
if FDefaultFont = nil then begin
FDefaultFont:= gdk_font_load ('fixed');
if FDefaultFont = nil then raise EOutOfResources.Create('Unable to load default font');
end;
end;
Result^.GDIFontObject:= FDefaultFont;
gdk_font_ref(Result^.GDIFontObject);
end;
{------------------------------------------------------------------------------
Function: CreateDefaultPen
Params: none
Returns: a Pen GDIObject
Creates an default pen, used for initial values
------------------------------------------------------------------------------}
function TgtkObject.CreateDefaultPen: PGdiObject;
begin
//write(' TgtkObject.CreateDefaultPen ->');
Result := NewGDIObject(gdiPen);
Result^.GDIPenStyle := PS_SOLID;
gdk_color_black(gdk_colormap_get_system, @Result^.GDIPenColor);
end;
{------------------------------------------------------------------------------
Function: HashPaintMessage
Params: a PaintMessage in the Message queue (= PLazQueueItem)
Returns: a hash index
Calculates a hash of the handle in the PaintMessage which is used by the
FPaintMessages (which is a TDynHashArray).
------------------------------------------------------------------------------}
function TgtkObject.HashPaintMessage(p: pointer): integer;
var h: integer;
begin
h:=PMsg(PLazQueueItem(p)^.Data)^.HWnd;
if h<0 then h:=-h;
Result:=((h mod 5364329)+(h mod 17)) mod FPaintMessages.Capacity;
end;
{------------------------------------------------------------------------------
Function: FindPaintMessage
Params: a window handle
Returns: nil or a Paint Message to the widget
Searches in FPaintMessages for a LM_PAINT message with HandleWnd.
------------------------------------------------------------------------------}
function TgtkObject.FindPaintMessage(HandleWnd: HWnd): PLazQueueItem;
var h: integer;
HashItem: PDynHashArrayItem;
begin
h:=HandleWnd;
if h<0 then h:=-h;
h:=((h mod 5364329)+(h mod 17)) mod FPaintMessages.Capacity;
HashItem:=FPaintMessages.GetHashItem(h);
if HashItem<>nil then begin
Result:=PLazQueueItem(HashItem^.Item);
if PMsg(Result^.Data)^.HWnd=HandleWnd then
exit;
HashItem:=HashItem^.Next;
while (HashItem<>nil) and (HashItem^.IsOverflow) do begin
Result:=PLazQueueItem(HashItem^.Item);
if PMsg(Result^.Data)^.HWnd=HandleWnd then
exit;
HashItem:=HashItem^.Next;
end;
end;
Result:=nil;
end;
{------------------------------------------------------------------------------
Function: SetClipboardWidget
Params: TargetWidget: PGtkWidget - This widget will be connected to all
clipboard signals which are all handled by the TGtkObject
itself.
Returns: none
All supported targets are added to the new widget. This way, no one,
especially not the lcl, will notice the change. ;)
------------------------------------------------------------------------------}
procedure TgtkObject.SetClipboardWidget(TargetWidget: PGtkWidget);
type
TGtkTargetSelectionList = record
Selection: Cardinal;
List: PGtkTargetList;
end;
PGtkTargetSelectionList = ^TGtkTargetSelectionList;
const
gtk_selection_handler_key: PChar = 'gtk-selection-handlers';
{$IFDEF DEBUG_CLIPBOARD}
function gtk_selection_target_list_get(Widget: PGtkWidget;
ClipboardType: TClipboardType): PGtkTargetList;
var
SelectionLists, CurSelList: PGList;
TargetSelList: PGtkTargetSelectionList;
begin
SelectionLists := gtk_object_get_data (PGtkObject(Widget),
gtk_selection_handler_key);
CurSelList := SelectionLists;
while (CurSelList<>nil) do begin
TargetSelList := CurSelList^.Data;
if (TargetSelList^.Selection = ClipboardTypeAtoms[ClipboardType]) then
begin
Result:=TargetSelList^.List;
exit;
end;
CurSelList := CurSelList^.Next;
end;
Result:=nil;
end;
procedure WriteTargetLists(Widget: PGtkWidget);
var c: TClipboardType;
TargetList: PGtkTargetList;
TmpList: PGList;
Pair: PGtkTargetPair;
begin
writeln(' WriteTargetLists WWW START');
for c:=Low(TClipboardType) to High(TClipboardType) do begin
TargetList:=gtk_selection_target_list_get(Widget,c);
writeln(' WriteTargetLists WWW ',ClipboardTypeName[c],' ',TargetList<>nil);
if TargetList<>nil then begin
TmpList:=TargetList^.List;
while TmpList<>nil do begin
Pair:=PGtkTargetPair(TmpList^.Data);
writeln(' WriteTargetLists BBB ',Pair^.Target);
TmpList:=TmpList^.Next;
end;
end;
end;
writeln(' WriteTargetLists WWW END');
end;
{$ENDIF}
{$IFNDEF WIN32}
procedure ClearTargetLists(Widget: PGtkWidget);
// MG: Reading in gtk internas is dirty, but there seems to be no other way
// to clear the old target lists
var
SelectionLists, CurSelList: PGList;
TargetSelList: PGtkTargetSelectionList;
begin
{$IFDEF DEBUG_CLIPBOARD}
writeln(' ClearTargetLists WWW START');
{$ENDIF}
SelectionLists := gtk_object_get_data (PGtkObject(Widget),
gtk_selection_handler_key);
CurSelList := SelectionLists;
while (CurSelList<>nil) do begin
TargetSelList := CurSelList^.Data;
gtk_target_list_unref(TargetSelList^.List);
g_free(TargetSelList);
CurSelList := CurSelList^.Next;
end;
g_list_free(SelectionLists);
gtk_object_set_data (PGtkObject(Widget),gtk_selection_handler_key,0);
{$IFDEF DEBUG_CLIPBOARD}
writeln(' ClearTargetLists WWW END');
{$ENDIF}
end;
{$ENDIF}
var c: TClipboardType;
begin
if ClipboardWidget=TargetWidget then exit;
{$IFDEF DEBUG_CLIPBOARD}
writeln('[TgtkObject.SetClipboardWidget] ',ClipboardWidget<>nil,' -> ',TargetWidget<>nil);
{$ENDIF}
if ClipboardWidget<>nil then begin
{$IFDEF DEBUG_CLIPBOARD}
WriteTargetLists(ClipboardWidget);
{$ENDIF}
{$IFNDEF WIN32}
ClearTargetLists(ClipboardWidget);
{$ENDIF}
{$IFDEF DEBUG_CLIPBOARD}
WriteTargetLists(ClipboardWidget);
{$ENDIF}
end;
ClipboardWidget:=TargetWidget;
if ClipboardWidget<>nil then begin
// connect widget to all clipboard signals
gtk_signal_connect(PGtkObject(ClipboardWidget),'selection_received',
TGTKSignalFunc(@ClipboardSelectionReceivedHandler),0);
gtk_signal_connect(PGtkObject(ClipboardWidget),'selection_get',
TGTKSignalFunc(@ClipboardSelectionRequestHandler),0);
gtk_signal_connect(PGtkObject(ClipboardWidget),'selection_clear_event',
TGTKSignalFunc(@ClipboardSelectionLostOwnershipHandler),0);
// add all supported targets for all clipboard types
for c:=Low(TClipboardType) to High(TClipboardType) do begin
if (ClipboardTargetEntries[c]<>nil) then begin
{$IFNDEF WIN32}
gtk_selection_add_targets(ClipboardWidget,ClipboardTypeAtoms[c],
ClipboardTargetEntries[c],ClipboardTargetEntryCnt[c]);
{$ENDIF}
end;
end;
end;
end;
{$IFDEF ASSERT_IS_ON}
{$UNDEF ASSERT_IS_ON}
{$C-}
{$ENDIF}
{ =============================================================================
$Log$
Revision 1.107 2002/03/12 23:55:37 lazarus
MWE:
* More delphi compatibility added/updated to TListView
* Introduced TDebugger.locals
* Moved breakpoints dialog to debugger dir
* Changed breakpoints dialog to read from resource
Revision 1.106 2002/03/11 23:07:23 lazarus
MWE:
* Made TListview more Delphi compatible
* Did some cleanup
Revision 1.105 2002/02/20 19:11:48 lazarus
Minor tweaks, default font caching.
Revision 1.104 2002/02/18 22:46:11 lazarus
Implented TMenuItem.ShortCut (not much tested).
Revision 1.103 2002/02/03 00:24:01 lazarus
TPanel implemented.
Basic graphic primitives split into GraphType package, so that we can
reference it from interface (GTK, Win32) units.
New Frame3d canvas method that uses native (themed) drawing (GTK only).
New overloaded Canvas.TextRect method.
LCLLinux and Graphics was split, so a bunch of files had to be modified.
Revision 1.102 2002/01/24 15:40:59 lazarus
MG: deactivated clipboard setting target list for win32
Revision 1.101 2002/01/08 16:02:45 lazarus
Minor changes to TListView.
Added TImageList to the IDE
Shane
Revision 1.100 2002/01/04 20:29:04 lazarus
Added images to TListView.
Shane
Revision 1.99 2002/01/03 21:17:08 lazarus
added column visible and autosize settings.
Shane
Revision 1.98 2002/01/03 15:31:27 lazarus
Added changes to propedit so the colum editor changes effect the TListView.
Shane
Revision 1.97 2002/01/01 15:50:16 lazarus
MG: fixed initial component aligning
Revision 1.96 2001/12/28 15:12:02 lazarus
MG: LM_SIZE and LM_MOVE messages are now send directly, not queued
Revision 1.95 2001/12/21 18:17:00 lazarus
Added TImage class
Shane
Revision 1.94 2001/12/20 19:11:23 lazarus
Changed the delay for the hints from 100 miliseconds to 500. I'm hoping this reduces the crashing for some people until I determine the problem.
Shane
Revision 1.93 2001/12/19 21:36:05 lazarus
Added MultiSelect to TListView
Shane
Revision 1.92 2001/12/19 20:28:51 lazarus
Enabled Alignment of columns in a TListView.
Shane
Revision 1.91 2001/12/18 21:10:01 lazarus
MOre additions for breakpoints dialog
Added a TSynEditPlugin in SourceEditor to get notified of lines inserted and deleted from the source.
Shane
Revision 1.90 2001/12/16 22:24:55 lazarus
MG: changes for new compiler 20011216
Revision 1.89 2001/12/14 19:51:48 lazarus
More changes to TListView
Shane
Revision 1.88 2001/12/14 18:38:56 lazarus
Changed code for TListView
Added a generic Breakpoints dialog
Shane
Revision 1.87 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.86 2001/12/12 14:39:25 lazarus
MG: carets will now be auto destroyed on widget destroy
Revision 1.85 2001/12/12 08:29:21 lazarus
Add code to allow TOpenDialog to do multiple line selects. MAH
Revision 1.84 2001/12/11 16:51:37 lazarus
Modified the Watches dialog
Shane
Revision 1.83 2001/12/11 14:36:41 lazarus
MG: started multiselection for TOpenDialog
Revision 1.82 2001/12/07 20:12:15 lazarus
Added a watch dialog.
Shane
Revision 1.81 2001/12/06 13:39:36 lazarus
Added TArrow component
Shane
Revision 1.80 2001/12/05 18:23:48 lazarus
Added events to Calendar
Shane
Revision 1.79 2001/12/05 17:40:00 lazarus
Added READONLY to Calendar.
Shane
Revision 1.77 2001/11/26 14:19:34 lazarus
Added some code to make the interbae components work better.
Shane
Revision 1.75 2001/11/21 14:55:33 lazarus
Changes for combobox to receive butondown and up events
DblClick events now working.
Shane
Revision 1.74 2001/11/20 18:30:32 lazarus
Pressing DEL when form is the only thing selected in designer no longer crashes Lazarus.
Shane
Revision 1.73 2001/11/17 09:42:26 lazarus
MG: fixed range check errors for FG,BG in Init
Revision 1.72 2001/11/16 20:08:39 lazarus
Object inspector has hints now.
Shane
Revision 1.71 2001/11/14 17:46:58 lazarus
Changes to make toggling between form and unit work.
Added BringWindowToTop
Shane
Revision 1.70 2001/11/12 16:56:08 lazarus
MG: CLIPBOARD
Revision 1.69 2001/11/10 10:48:02 lazarus
MG: fixed set formicon on invisible forms
Revision 1.68 2001/11/09 19:14:24 lazarus
HintWindow changes
Shane
Revision 1.67 2001/11/09 14:33:41 lazarus
MG: fixed GetItemIndex-Handle-NotAllocated-Crash bug
Revision 1.66 2001/11/05 18:18:19 lazarus
added popupmenu+arrows to notebooks, added target filename
Revision 1.65 2001/11/01 21:30:35 lazarus
Changes to Messagebox.
Added line to CodeTools to prevent duplicate USES entries.
Revision 1.64 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.63 2001/10/16 20:01:28 lazarus
MG: removed splashform fix, because of the unpredictable side effects
Revision 1.62 2001/10/16 10:51:10 lazarus
MG: added clicked event to TButton, MessageDialog reacts to return key
Revision 1.60 2001/10/09 09:46:59 lazarus
MG: added codetools, fixed synedit unindent, fixed MCatureHandle
Revision 1.59 2001/10/08 12:57:07 lazarus
MG: fixed GetPixel
Revision 1.58 2001/10/08 08:05:08 lazarus
MG: fixed TColorDialog set color
Revision 1.57 2001/10/07 07:28:34 lazarus
MG: fixed setpixel and TCustomForm.OnResize event
Revision 1.56 2001/09/30 08:34:52 lazarus
MG: fixed mem leaks and fixed range check errors
Revision 1.55 2001/08/07 11:05:51 lazarus
MG: small bugfixes
Revision 1.54 2001/07/01 23:33:13 lazarus
MG: added WaitMessage and HandleEvents is now non blocking
Revision 1.53 2001/06/28 18:15:04 lazarus
MG: bugfixes for destroying controls
Revision 1.52 2001/06/26 21:44:32 lazarus
MG: reduced paint messages
Revision 1.51 2001/06/26 00:08:36 lazarus
MG: added code for form icons from Rene E. Beszon
Revision 1.49 2001/06/14 14:57:59 lazarus
MG: small bugfixes and less notes
Revision 1.47 2001/06/05 10:32:05 lazarus
MG: small bugfixes for bitbtn, handles
Revision 1.45 2001/05/13 22:07:09 lazarus
Implemented BringToFront / SendToBack.
Revision 1.44 2001/04/13 17:56:17 lazarus
MWE:
* Moved menubar outside clientarea
* Played a bit with the IDE layout
* Moved the creation of the toolbarspeedbuttons to a separate function
Revision 1.43 2001/04/06 22:25:14 lazarus
* TTimer uses winapi-interface now instead of sendmessage-interface, stoppok
Revision 1.42 2001/03/27 21:12:54 lazarus
MWE:
+ Turned on longstrings
+ modified memotest to add lines
Revision 1.41 2001/03/27 14:27:43 lazarus
Changes from Nagy Zsolt
Shane
Revision 1.40 2001/03/26 14:58:31 lazarus
MG: setwindowpos + bugfixes
Revision 1.36 2001/03/19 18:51:57 lazarus
MG: added dynhasharray and renamed tsynautocompletion
Revision 1.35 2001/03/19 14:44:22 lazarus
MG: fixed many unreleased DC and GDIObj bugs
Revision 1.31 2001/03/12 12:17:02 lazarus
MG: fixed random function results
Revision 1.30 2001/02/20 16:53:27 lazarus
Changes for wordcompletion and many other things from Mattias.
Shane
Revision 1.29 2001/02/06 18:19:38 lazarus
Shane
Revision 1.28 2001/02/06 14:52:47 lazarus
Changed TSpeedbutton in gtkobject so it erases itself when it's set to visible=false;
Shane
Revision 1.27 2001/02/04 04:18:12 lazarus
Code cleanup and JITFOrms bug fix.
Shane
Revision 1.26 2001/02/02 20:13:39 lazarus
Codecompletion changes.
Added code to Uniteditor for code completion.
Also, added code to gtkobject.inc so forms now get keypress events.
Shane
Revision 1.25 2001/02/01 19:34:50 lazarus
TScrollbar created and a lot of code added.
It's cose to working.
Shane
Revision 1.24 2001/01/31 21:16:45 lazarus
Changed to TCOmboBox focusing.
Shane
Revision 1.23 2001/01/28 21:06:07 lazarus
Changes for TComboBox events KeyPress Focus.
Shane
Revision 1.22 2001/01/28 03:51:42 lazarus
Fixed the problem with Changed for ComboBoxs
Shane
Revision 1.21 2001/01/24 23:26:40 lazarus
MWE:
= moved some types to gtkdef
+ added WinWidgetInfo
+ added some initialization to Application.Create
Revision 1.20 2001/01/24 03:21:03 lazarus
Removed gtkDrawDefualt signal function from gtkcallback.inc
It was no longer used.
Shane
Revision 1.19 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.18 2001/01/13 03:09:37 lazarus
Minor changes
Shane
Revision 1.17 2001/01/10 20:12:29 lazarus
Added the Nudge feature to the IDE.
Shane
Revision 1.16 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.15 2001/01/04 15:09:05 lazarus
Tested TCustomEdit.Readonly, MaxLength and CharCase.
Shane
Revision 1.14 2001/01/04 13:52:00 lazarus
Minor changes to TEdit.
Not tested.
Shane
Revision 1.13 2000/12/29 19:20:27 lazarus
Shane
Revision 1.11 2000/12/22 19:55:38 lazarus
Added the Popupmenu code to the LCL.
Now you can right click on the editor and a PopupMenu appears.
Shane
Revision 1.10 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.9 2000/10/09 22:50:32 lazarus
MWE:
* fixed some selection code
+ Added selection sample
Revision 1.8 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.7 2000/08/10 10:55:45 lazarus
Changed TCustomDialog to TCommonDialog
Shane
Revision 1.6 2000/08/09 18:32:10 lazarus
Added more code for the find function.
Shane
Revision 1.5 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.4 2000/07/23 18:59:35 lazarus
more cleanups, stoppok
Revision 1.3 2000/07/23 10:51:53 lazarus
- cleanups in IntSendMessage3
- minor cleanups in other functions
stoppok
Revision 1.2 2000/07/16 20:59:03 lazarus
- some more cleanups (removal of unused variables), stoppok
Revision 1.1 2000/07/13 10:28:29 michael
+ Initial import
}
Reference in New Issue View Git Blame Copy Permalink