(****************************************************************************** TGTKObject ******************************************************************************) 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; FCaptureHandle := 0; FKeyStateList := TList.Create; FDeviceContexts := TList.Create; FGDIObjects := TList.Create; FMessageQueue := TList.Create; FAccelGroup := gtk_accel_group_new(); end; {------------------------------------------------------------------------------ Method: Tgtkobject.Destroy Params: None Returns: Nothing Destructor for the class. ------------------------------------------------------------------------------} destructor TgtkObject.Destroy; var n: Integer; p: PMsg; begin if (FDeviceContexts.Count > 0) or (FGDIObjects.Count > 0) then begin WriteLN(Format('[TgtkObject.Destroy] WARNING: There are %d unreleased DCs and %d unreleased GDIObjects' ,[FDeviceContexts.Count, FGDIObjects.Count])); 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])); for n := 0 to FMessageQueue.Count - 1 do begin p := PMsg(FMessageQueue.Items[n]); Dispose(P); end; end; FMessageQueue.Free; FDeviceContexts.Free; FGDIObjects.Free; FKeyStateList.Free; gtk_accel_group_unref(FAccelGroup); inherited Destroy; end; {------------------------------------------------------------------------------ Method: TGtkObject,HandleEvents Params: None Returns: Nothing *Note: Passes execution control to the GTK engine ------------------------------------------------------------------------------} procedure TgtkObject.HandleEvents; var Msg: TMsg; begin //gtk_main; gtk_main_iteration_do(True); //Should we handle this ??? with FMessageQueue do while Count > 0 do begin Msg := PMsg(Items[0])^; Delete(0); with Msg do SendMessage(hWND, Message, WParam, LParam); end; 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); gtk_object_unref(PGTKObject(FGTKToolTips)); FGTKToolTips := nil; gtk_main_quit; end; {------------------------------------------------------------------------------ Method: TGtkObject.Init Params: None Returns: Nothing *Note: Initialite GTK engine ------------------------------------------------------------------------------} procedure TGtkObject.Init; begin { initialize app level gtk engine } gtk_set_locale (); { call init and pass no 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); gtk_key_snooper_install(@GTKKeySnooper, @FKeyStateList); // Init tooltips FGTKToolTips := gtk_tooltips_new; gtk_object_ref(PGTKObject(FGTKToolTips)); gtk_toolTips_Enable(FGTKToolTips); 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 pStr : PChar; pStr2 : PChar; TempStr : string; GList : pGList; Widget : PGtkWidget; SelectionMode : TGtkSelectionMode; AOwner : TControl; AParent: TWinControl; Pixmap : pgdkPixMap; PenColor : TColor; TheStyle : pgtkStyle; fWindow :pGdkWindow; gc : pgdkGC; p: Pointer; Num : Integer; ListItem : PGtkListItem; box1 : pgtkWidget; pixmapwid : pGtkWidget; mask : pGDKBitmap; style : pgtkStyle; pLabel : PgtkWidget; begin result := 0; //default value just in case nothing sets it Assert(False, 'Trace:Message recieved'); 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)])); case LM_Message of LM_Create : begin Assert(False, 'Trace:Callling CreateComponent'); CreateComponent(Sender); Assert(False, 'Trace:Called CreateComponent'); end; 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; Assert(False, Format('Trace:[TgtkObject.IntSendMessage3] %s --> Calling Add Child: %s', [AParent.ClassName, Sender.ClassNAme])); AddChild(Pgtkwidget(AParent.Handle), PgtkWidget((Sender as TWinControl).Handle), AParent.Left, AParent.Top); end; end; LM_BRINGTOFRONT: begin Assert(False, 'Trace:TODO:bringtofront'); end; LM_BTNDEFAULT_CHANGED : Begin if (TButton(Sender).Default) and (GTK_WIDGET_CAN_DEFAULT(pgtkwidget(TButton(Sender).handle))) then gtk_widget_grab_default(pgtkwidget(TButton(Sender).handle)) else gtk_widget_Draw_Default(pgtkwidget(TButton(Sender).Handle)); //this isn't right but I'm not sure what to call end; LM_DESTROY : begin if (Sender is TTimer) then begin Assert(False, 'Trace:removing timer!!!'); gtk_timeout_remove((Sender as TTimer).TimerID); end else begin if Sender is TWinControl then gtk_widget_destroy( PGtkWidget(TWinControl(Sender).Handle)) else begin if (Sender is TCustomDialog) then gtk_widget_destroy( PGtkWidget(TCustomDialog(Sender).Handle)); end; end; 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:********************'); Widget := PgtkWidget(TBitBtn(Sender).Handle); Assert(False, 'Trace:1'); box1 := gtk_object_get_data(pgtkObject(widget),'HBox'); if box1 <> nil then begin Assert(False, 'Trace:REMOVING THE HBOX'); gtk_container_remove(PgtkContainer(box1),gtk_object_get_data(pgtkObject(widget),'Label')); gtk_container_remove(PgtkContainer(box1),gtk_object_get_data(pgtkObject(widget),'Pixmap')); gtk_container_remove(PgtkContainer(widget),box1); 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 pixmapwid := gtk_pixmap_new(pixmap,PgdiObject(TBitBtn(Sender).Glyph.handle)^.GDIBitmapMAskObject) else pixmapwid := gtk_pixmap_new(pixmap,nil); Assert(False, 'Trace:4'); TempStr := TBitBtn(Sender).Caption; pStr := StrAlloc(length(TempStr) + 1); StrPCopy(pStr, TempStr); 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(widget),'Label',pLabel); gtk_object_set_data(pgtkObject(widget),'HBox',Box1); gtk_object_set_data(pgtkObject(widget),'Pixmap',pixmapwid); Assert(False, 'Trace:7'); gtk_widget_show(pixmapwid); gtk_widget_show(pLabel); gtk_container_add(PgtkContainer(widget),box1); gtk_widget_show(box1); Assert(False, 'Trace:********************'); end; 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_TB_BUTTONCOUNT: begin if (Sender is TToolbar) then Result := pgtkToolbar(TToolbar(Sender).handle)^.num_Children else Result := -1; end; LM_SETENABLED: begin if (sender is TWincontrol) then gtk_widget_set_sensitive(pgtkwidget(TWinControl(sender).handle),TControl(sender).Enabled) else if (sender is TMenuItem) then gtk_widget_set_sensitive(pgtkwidget(TMenuItem(sender).handle),TMenuItem(sender).Enabled) else Assert(False, 'Trace:***************NOT SUPPORTED*******************'); end; LM_SETFILTER : begin pStr := StrAlloc(length(TFileDialog(Sender).Filter) + 1); StrPCopy(pStr, TFileDialog(Sender).Filter); gtk_file_selection_complete(PGtkFileSelection((Sender as TCustomDialog).Handle), pstr); StrDispose(pStr); end; LM_SETFILENAME : begin pStr := StrAlloc(length(TFileDialog(Sender).Filename) + 1); StrPCopy(pStr, TFileDialog(Sender).Filename); gtk_file_selection_set_filename( PGtkFileSelection((Sender as TCustomDialog).Handle), pStr); StrDispose(pStr); end; LM_SETFOCUS:gtk_widget_grab_focus(PgtkWidget(TWinControl(sender).handle)); LM_SetSize : begin Assert(False, Format('Trace:[TgtkObject.IntSendMessage3] %s --> LM_SetSize(%d, %d, %d, %d)', [Sender.ClassNAme, pTRect(Data)^.Left,pTRect(Data)^.Top,pTRect(Data)^.Right,pTRect(Data)^.Bottom])); ResizeChild(Sender,pTRect(Data)^.Left,pTRect(Data)^.Top,pTRect(Data)^.Right,pTRect(Data)^.Bottom); end; LM_SetText : begin SetText(PgtkWidget((Sender as TWinControl).Handle), Data); end; 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_ShowModal : begin if Sender is TCustomForm then begin Widget:= PgtkWidget(TCustomForm(Sender).Handle); end else begin Widget:= PgtkWidget(TCustomDialog(Sender).Handle); pStr:= StrAlloc(Length(TCustomDialog(Sender).Title) + 1); try StrPCopy(pStr, TCustomDialog(Sender).Title); gtk_window_set_title(PGtkWindow(Widget), pStr); finally StrDispose(pStr); end; end; gtk_window_set_position(PGtkWindow(Widget), GTK_WIN_POS_CENTER); gtk_widget_show(Widget); gtk_window_set_modal(PGtkWindow(Widget), true); { Don't grab anything - this is done by gtk_window_set_modal } //gtk_grab_add(PgtkWidget(TWinControl(Sender).Handle)); end; LM_SetCursor : SetCursor(Sender); LM_SetLabel : begin SetLabel(Sender,Data); end; 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 ReDraw(PgtkWidget((Sender as TWinControl).Handle)) else (Sender as TSpeedButton).perform(LM_PAINT,0,0); end; LM_AddPage : 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; LM_RemovePage : begin RemoveNBPage(TControl(Sender), TLMNotebookEvent(Data^).Page); end; LM_ShowTabs : begin gtk_notebook_set_show_tabs(PGtkNotebook(TWinControl(Sender).Handle), Boolean(Integer(TLMNotebookEvent(Data^).ShowTabs))); end; LM_SetTabPosition : begin case TTabPosition(TLMNotebookEvent(Data^).TabPosition^) of tpTop : gtk_notebook_set_tab_pos(PGtkNotebook(TWinControl(Sender).Handle), GTK_POS_TOP); tpBottom: gtk_notebook_set_tab_pos(PGtkNotebook(TWinControl(Sender).Handle), GTK_POS_BOTTOM); tpLeft : gtk_notebook_set_tab_pos(PGtkNotebook(TWinControl(Sender).Handle), GTK_POS_LEFT); tpRight : gtk_notebook_set_tab_pos(PGtkNotebook(TWinControl(Sender).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); StrPCopy(pStr,ttoolbutton(SENDER).Caption); pStr2 := StrAlloc(Length(tcontrol(Sender).Hint)+1); StrPCopy(pStr2,tcontrol(Sender).Hint); 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 TWinControl(Sender).handle = 0 then IntSendMessage3(LM_CREATE,Sender,nil); gtk_toolbar_insert_widget(pGTKToolbar(TWinControl(sender).parent.Handle), pgtkwidget(tWinControl(Sender).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); // 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((Sender as TWinControl).Handle)^.Window; Event.Send_Event := 0; Event.X := 0; Event.Y := 0; Event.Width := PgtkWidget((Sender as TWinControl).Handle)^.Allocation.Width; Event.Height := PgtkWidget((Sender as TWinControl).Handle)^.Allocation.Height; gtk_Signal_Emit_By_Name(PgtkObject((Sender as TWinControl).Handle),'expose_event',[(Sender as TWinControl).Handle,Sender,@Event]); Assert(False, 'Trace:Signal Emitted - invalidate window'); } gtk_widget_queue_draw(PGtkWidget((Sender as TWinControl).Handle)); end; LM_InvalidateRect : begin //Erase and then write over that section in the rect PixMap := gtk_object_get_data(PgtkObject((Sender as TWinControl).Handle),'Pixmap'); if Assigned(PixMap) then begin PenColor := TCustomForm(Sender).Color; gdk_draw_rectangle(pixmap,GetPen(pixmap,TColortoTgdkColor(PenColor)),1,TREct(data^).Left,TRect(data^).Top,TRect(Data^).Right-TRect(Data^).Left,TRect(Data^).Bottom-TRect(Data^).Top); gtk_widget_queue_draw(PGtkWidget((Sender as TWinControl).Handle)); //The following should eventually be implemented. It's supposed // to allow the component to ONLY draw the invalidated rectangle, not the entire widget. { widget := gtk_Object_get_data(pgtkobject((Sender as TWinControl).Handle),'Fixed'); fWindow := pGtkWidget(widget)^.window; gc := gdk_gc_new(PgdkWindow(fWindow)); TheStyle := widget^.TheStyle; gdk_draw_pixmap(fwindow,TheStyle^.fg_gc[GTK_WIDGET_STATE (widget)], pixmap, TRect(data^).Left,TRect(data^).Top, TRect(data^).Left,TRect(data^).Top, TRect(data^).Right -TRect(data^).Left,TRect(data^).Bottom - TRect(data^).Top); } end; end; LM_SCREENINIT : begin { Initialize gdk } //??? shouldn't this go to init ???? gdk_init(@argc, @argv); //???--???? { 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((Sender as TWinControl).Handle)); Data := TGtkCListStringList.Create(PGtkCList(Widget)); Result := integer(Data); end else begin case (Sender as TControl).fCompStyle of csComboBox : Widget:= PGtkCombo((Sender as TWinControl).Handle)^.list; csListBox : Widget:= GetCoreChildWidget(PGtkWidget((Sender as TWinControl).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 TListBox(Sender).MultiSelect then Widget:= PGtkList(GetCoreChildWidget(PGtkWidget(TWinControl(Sender).Handle)))^.last_focus_child else begin GList:= PGtkList(GetCoreChildWidget(PGtkWidget(TWinControl(Sender).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(TWinControl(Sender).Handle))), Widget); end; csCListBox: begin GList:= PGtkCList(GetCoreChildWidget(PGtkWidget(TWinControl(Sender).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(TWinControl(Sender).Handle)); end; end; end; LM_SETITEMINDEX : begin case (Sender as TControl).fCompStyle of csComboBox: gtk_list_select_item(PGTKLIST(PGTKCOMBO(TWinControl(Sender).Handle)^.list), Integer(Data)); csListBox: gtk_list_select_item(PGtkList(GetCoreChildWidget(PGtkWidget(TWinControl(Sender).Handle))), Integer(Data)); csCListBox: gtk_clist_select_row( PGtkCList(GetCoreChildWidget(PGtkWidget(TWinControl(Sender).Handle))), Integer(Data), 1); // column csNotebook: begin Assert(False, 'Trace:Setting Page to ' + IntToStr(TLMNotebookEvent(Data^).Page)); gtk_notebook_set_page(PGtkNotebook(TWinControl(Sender).Handle), TLMNotebookEvent(Data^).Page); end; end; end; LM_GETSELSTART : begin if (Sender as TControl).fCompStyle = csComboBox then begin Result:= gtk_editable_get_position(PGtkEditable(PGtkCombo((Sender as TWinControl).Handle)^.entry)); end; end; LM_GETSELLEN : begin if (Sender as TControl).fCompStyle = csComboBox then begin Result:= PGtkEditable(PGtkCombo((Sender as TWinControl).Handle)^.entry)^.selection_end_pos - PGtkEditable(PGtkCombo((Sender as TWinControl).Handle)^.entry)^.selection_start_pos; end; end; LM_GETLIMITTEXT : begin if (Sender as TControl).fCompStyle = csComboBox then begin Result:= PGtkEntry(PGtkCombo((Sender as TWinControl).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(TWinControl(Sender).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(TWinControl(Sender).Handle)^.entry), gtk_editable_get_position(PGtkEditable(PGtkCombo(TWinControl(Sender).Handle)^.entry)), gtk_editable_get_position(PGtkEditable(PGtkCombo(TWinControl(Sender).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((Sender as TWinControl).Handle)))^.selection); csCListBox: Result:= g_list_length(PGtkCList(GetCoreChildWidget(PGtkWidget((Sender as TWinControl).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(TWinControl(Sender).Handle)))^.children, Integer(Data^)); Result:= g_list_index(PGtkList(GetCoreChildWidget(PGtkWidget(TWinControl(Sender).Handle)))^.selection, ListItem); end else if (Sender as TControl).fCompStyle = csCListBox then begin { Get the selections } GList:= PGtkCList(GetCoreChildWidget(PGtkWidget( (Sender as TWinControl).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(TWinControl(Sender).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(TWinControl(Sender).Handle))), TLMSetSel(Data^).Index) else gtk_list_unselect_item(PGtkList(GetCoreChildWidget(PGtkWidget(TWinControl(Sender).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(TWinControl(Sender).Handle))),TLMSetSel(Data^).Index,0) else gtk_clist_unselect_row(PGtkCList(GetCoreChildWidget(PGtkWidget(TWinControl(Sender).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 (Sender as TControl).fCompStyle of csListBox : gtk_list_set_selection_mode(PGtkList(GetCoreChildWidget(PGtkWidget(TWinControl(Sender).Handle))), SelectionMode); csCListBox : gtk_clist_set_selection_mode(PGtkCList(GetCoreChildWidget(PGtkWidget(TWinControl(Sender).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) and (TControl(Sender).fCompStyle = csListBox) then begin { In TempWidget, a viewport is stored } Widget:= PGtkWidget(PGtkBin(TWinControl(Sender).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; if (Sender as TControl).fCompStyle = csCListBox then begin if TListBox(Sender).BorderStyle = TBorderStyle(bsSingle) then gtk_clist_set_shadow_type( PGtkCList(GetCoreChildWidget(PGtkWidget(TWinControl(Sender).Handle))), GTK_SHADOW_IN) else gtk_clist_set_shadow_type( PGtkCList(GetCoreChildWidget(PGtkWidget(TWinControl(Sender).Handle))), GTK_SHADOW_NONE); end; end; LM_GETVALUE: Result := GetValue (Sender, data); LM_SETVALUE: Result := SetValue (Sender, data); LM_SETPROPERTIES: Result := SetProperties(Sender); LM_ATTACHMENU: AttachMenu(Sender); else Assert(True, Format ('WARNING: Unhandled message %d in IntSendMessage3 send by %s --> message:Redraw', [LM_Message, Sender.ClassName])); // unhandled message end; 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; begin Assert(false, (Format('trace:[TgtkObject.ResizeChild] %s --> Resize', [Sender.ClassNAme]))); Parent := TControl(Sender).Parent; if not (Sender is TSpeedButton) then begin pWidget := pgtkWidget(TWinControl(Sender).Handle); gtk_widget_set_usize(pWidget, Width, Height); if not ((Parent = nil) or (Sender is TCustomForm)) then begin pFixed := GetFixedWidget(PGtkWidget(Parent.Handle)); if pFixed <> nil then gtk_fixed_move(pFixed, pWidget, Left, Top) else Assert(False, 'Trace:ERROR!!!! - no Fixed Widget found to use when resizing....'); end else begin gtk_widget_set_uposition(pWidget, Left, Top); end; end 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 pStr: PChar; begin case pMsg(Data)^.fCompStyle of csStatusBar : gtk_statusbar_push(PGTKStatusBar(Child),pMsg(Data)^.Panel,pMsg(Data)^.Userdata); else writeln ('STOPPOK: [TGtkObject.SetText] Possible superfluous use of SetText, use SetLabel instead!'); end; {STOPPOK: Code seems superfluous, see SetLabel instead // Stoppok: Hmm, this cast looks quite dangerous if the code above is also valid case TLMNotebookEvent(Data^).fCompStyle of csNotebook : begin writeln ('STOPPOK: [TGtkObject.SetText] Notebook: Why the hell are we getting here?'); pStr := StrAlloc(Length(TLMNotebookEvent(Data^).Str) + 1); StrPCopy(pStr, TLMNotebookEvent(Data^).Str); gtk_notebook_set_tab_label_text(PGtkNotebook(TWinControl(TLMNotebookEvent(Data^).Parent).handle), PGtkWidget(TWinControl(TLMNotebookEvent(Data^).Child).handle), pStr); end; end; } 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); // crDefault : CursorType := GDK_Arrow; 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 Assert(False, Format('Trace:WARNING: [TgtkObject.SetLabel] %s --> No Decendant of TWinControl', [Sender.ClassName])); 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: ObjectToGTKObject Params: AObject: A LCL Object Returns: The GTKObject of the given object Returns the GTKObject of the given object, nil if no object available ------------------------------------------------------------------------------} function ObjectToGTKObject(const AObject: TObject): gtk_object; begin if AObject is TWinControl then Result := gtk_Object(TWinControl(AObject).Handle) else if AObject is TControlCanvas then Result := gtk_Object(TControlCanvas(AObject).Handle) else if AObject is TMenuItem then Result := gtk_Object(TMenuItem(AObject).Handle) else Result := nil; 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 ConnectSignal(gObject, 'activate', @gtkactivateCB); end; LM_ACTIVATEITEM : begin ConnectSignal(gObject, 'activate-item', @gtkactivateCB); end; LM_CHANGED : if sender is TTrackBar then ConnectSignal(gtk_Object(gtk_range_get_adjustment(GTK_RANGE(gObject))) , 'value_changed', @gtkvaluechanged) 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', @gtkchangedCB); LM_CLICKED : begin Assert(False, 'Trace:OBSOLETE: [TGTKObject.SetCallback] LM_CLICKED'); ConnectSignal(gObject, 'clicked', @gtkclickedCB); end; LM_CONFIGUREEVENT : begin ConnectSignal(gObject, 'configure-event', @gtkconfigureevent); end; LM_PAINT : begin // ConnectSignal(gFixed, 'show', @GTKDrawDefault); 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); ConnectSignal(gObject, 'focus-in-event', @gtkFocusCB); ConnectSignal(gObject, 'focus-out-event', @gtkKillFocusCB); end; LM_KEYDOWN, LM_CHAR, LM_KEYUP, LM_SYSKEYDOWN, LM_SYSCHAR, LM_SYSKEYUP: begin ConnectSignal(gFixed, 'key-press-event', @GTKKeyUpDown, GDK_KEY_PRESS_MASK); ConnectSignal(gFixed, 'key-release-event', @GTKKeyUpDown, GDK_KEY_RELEASE_MASK); end; LM_MOUSEMOVE: begin 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 ConnectSignal(gFixed, 'button-press-event', @gtkmousebtnpress, GDK_BUTTON_PRESS_MASK); end; LM_LBUTTONUP, LM_RBUTTONUP, LM_MBUTTONUP: begin 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_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 ro remove callbacks Returns: nothing Removes Call Back Signals from the sender ------------------------------------------------------------------------------} procedure TGTKObject.RemoveCallbacks(Sender : TObject); var gObject : gtk_Object; begin gObject := ObjectToGTKObject(Sender); if gObject = nil then Exit; 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); FormBorderWidth : array[TFormBorderStyle] of gint = (0, 1, 2, 1, 1, 2); type Tpixdata = Array[1..20] of String; var caption : string; StrTemp : PChar; TempWidget : PGTKWidget; p : pointer; CompStyle, TempInt : Integer; Adjustment: PGTKAdjustment; //for csBitBtn box1 : pgtkWidget; pixmap : pGdkPixMap; pixmapwid : pGtkWidget; mask : pGDKBitmap; style : pgtkStyle; label1 : pgtkwidget; TempStr : String; pStr : PChar; Pixdata : TPixData; tmp_key : Integer; menu_accel : pointer; begin Assert(False, 'Trace:In CreateComponet'); p := nil; if (Sender is TControl) then caption := TControl(Sender).caption else if (Sender is TMenuItem) then caption := TMenuItem(Sender).caption else caption := 'Unknown'; // the following is for debug only if caption = '' then caption := Sender.ClassName; Assert(False, 'Trace:----------------------Creating component in TgtkObject- STR = '+caption+'-'); // until here remove when debug not needed if caption = '' then caption := 'Blank'; strTemp := StrAlloc(length(caption) + 1); StrPCopy(strTemp, caption); Assert(False, 'Trace:1'); if (Sender is TControl) then CompStyle := TControl(Sender).FCompStyle else if (Sender is TTimer) then CompStyle := csTimer else if (Sender is TMenu) then CompStyle := TMenu(Sender).FCompStyle else if (Sender is TMenuItem) then CompStyle := TMenuItem(Sender).FCompStyle else if (Sender is TCustomDialog) then CompStyle := TCustomDialog(Sender).FCompStyle else Compstyle := csNone; case CompStyle of csAlignment : begin p := gtk_alignment_new(0.5,0.5,0,0); gtk_widget_show(p); end; csBitBtn : begin Assert(False, 'Trace:CSBITBTN CREATE*************************'); p := gtk_button_new; box1 := gtk_hbox_new(False,0); gtk_container_set_border_width(PgtkContainer(box1),2); style := gtk_widget_get_style(pGTKWidget(p)); 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); label1 := gtk_label_new(StrTemp); gtk_box_pack_start(pGTkBox(Box1),pixmapwid,False,False,3); gtk_box_pack_start(pGTkBox(box1), label1, FALSE, FALSE, 3); gtk_widget_show(pixmapwid); gtk_widget_show(label1); gtk_Container_add(PgtkContainer(p),box1); gtk_widget_show(box1); gtk_object_set_data(pgtkObject(p),'HBox',box1); 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; 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); SetCoreChildWidget(p, 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); SetCoreChildWidget(p, TempWidget); SetMainWidget(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); 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 p := GTKAPIWidget_New; 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]); 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_title(pGtkWindow(p), strTemp); TempWidget := gtk_fixed_new(); gtk_container_add(GTK_CONTAINER(p), TempWidget); 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; csLabel : begin P := gtk_label_new(StrTemp); gtk_misc_set_alignment(PGTKMISC(P), 0.0 , 1.0); end; csMemo : begin // 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); SetCoreChildWidget(p, TempWidget); SetMainWidget(p, TempWidget); case (Sender as TCustomMemo).Scrollbars of ssVertical, ssBoth: 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; end; 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_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; csScrolledWindow : begin P := gtk_scrolled_window_new(nil,nil); end; csSpeedButton: Begin {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; csTimer: begin Assert(False, 'Trace:Creating a timer in CreateComponent'); with (Sender as TTimer) do TimerID := gtk_timeout_add (Interval, @gtkTimerCB, Sender); end; csPage: // TPage - Notebook page begin 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; 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; 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 TCustomDialog) then TCustomDialog(Sender).Handle:= THandle(p); //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); end; {------------------------------------------------------------------------------} { TGtkObject GetLabel } { *Note: Returns a widgets lable value } {------------------------------------------------------------------------------} function TgtkObject.GetLabel(CompStyle: Integer; P : Pointer) : String; var pLabel: Pointer; begin Result := 'Label'; case CompStyle of csLabel: gtk_label_get(PGTKLabel(p),@Result); csForm : Result := String(PgtkWindow(p)^.Title); csPage : begin pLabel := gtk_notebook_get_tab_label(PGTKNoteBook(TWinControl(P).Parent.Handle), PGTKWidget(TWinControl(P).Handle)); if pLabel <> nil then gtk_label_get(pLabel, @Result); 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); begin if TControl(Sender).Visible then gtk_widget_show(PgtkWidget(TWinControl(Sender).Handle)) else gtk_widget_hide(PgtkWidget(TWinControl(Sender).Handle)); end; {------------------------------------------------------------------------------} { TGtkObject AddNBPage } { *Note: Add Notebook Page } {------------------------------------------------------------------------------} procedure TgtkObject.AddNBPage(Parent, Child: TObject; Index: Integer); var Msg: TLMNotebookEvent; 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), 'Owner', 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; {------------------------------------------------------------------------------} { TGtkObject FontSetName } { *Note: } {------------------------------------------------------------------------------} procedure TgtkObject.FontSetName(Sender : TObject); {var StrTemp : PChar; Name : String; Msg : Integer; NewHandle: THandle;} begin Assert(False, 'Trace:OBSOLETE: [TgtkObject.FontSetName]'); (* Assert(False, 'Trace:1'); Name := TFont(Sender).Name; Assert(False, 'Trace:2'); strTemp := StrAlloc(length(Name) + 1); Assert(False, 'Trace:3'); StrPCopy(strTemp, Name); Assert(False, 'Trace:4'); NewHandle := THandle(gdk_font_load(strTemp)); if NewHandle = 0 then //Load a DEFAULT font begin Assert(False, 'Trace:[TgtkObject.FontSetName] WARNING: Loading Default Font'); StrDispose(StrTemp); strTemp := StrAlloc(Length('-*-courier-bold-r-normal--*-120-*-*-*-*-iso8859-1') + 1); StrPCopy(strTemp, '-*-courier-bold-r-normal--*-120-*-*-*-*-iso8859-1'); NewHandle := THandle(gdk_font_load(strTemp)); end; if NewHandle <> 0 then begin if TFont(sender).Handle <> 0 then gdk_font_unref(pgdkFont(TFont(Sender).Handle)); Assert(False, 'Trace:5'); TFont(Sender).Handle := NewHandle; Assert(False, 'Trace:6'); Msg := LM_Changed; TObject(sender).Dispatch(Msg); end else Assert(False, Format('Trace:[TgtkObject.FontSetName] WARNING: Could not load font: %s', [strTemp]));; Assert(False, 'Trace:7'); StrDispose(StrTemp); Assert(False, 'Trace:8'); *) end; {------------------------------------------------------------------------------} { TGtkObject GetFontInfo } { *Note: } {------------------------------------------------------------------------------} procedure TgtkObject.GetFontInfo(Sender : TObject; Data : Pointer); var Font :pGdkfont; lBearing,rBearing,w,ascent,descent : LongInt; Str : String; FontName : String; I : Integer; begin Assert(False, 'Trace:OBSOLETE: [TgtkObject.GetFontInfo]'); { Assert(False, 'Trace:FONT GetInfo'); Font := PgdkFont(TFont(Sender).Handle); gdk_String_extents(Font,Data,@lbearing,@rBearing,@w,@ascent,@descent); Assert(False, 'Trace:' + Inttostr(lbearing)+','+Inttostr(rBearing)+','+Inttostr(w)+','+Inttostr(Ascent)+','+Inttostr(descent)); // Only for Extra properties // TODO: implement them though GetTextMetrics, not here (* Str := String(Data^); // use the name to see if the AVERAGE WIDTH is stored there, otherwise use w FontName := TFont(Sender).Name; for I := 1 to 11 do delete(FontName,pos('-',FontName),1); delete(FontName,1,pos('-',FontName)); //FontName should now start with the average SIZE or a dash if (FontName[1] <> '-') and (FontName[1] <> '*') then begin Delete(FontName,pos('-',FontName),length(FontName)); W := StrtoInt(FontName); end else w := gdk_Text_width(Font,Data,Length(Str)); if w <= 0 then begin gdk_String_extents(Font,Data,@lbearing,@rBearing,@w,@ascent,@descent); W := lBEaring + rBearing; end; *) // Extra properties // TODO: implement them though GetTextMetrix, not here //TFont(Sender).XBias := lbearing;; //TFOnt(Sender).YBias := ascent - descent; //TFont(Sender).Width := w; //----------------- TFont(Sender).height := Ascent+Descent; } end; {------------------------------------------------------------------------------ Method: TGtkObject.SetPixel Params: Sender : the lcl object which called this func via SenMessage 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 fWindow : pGdkWindow; gc : pgdkGC; Image : pGDKImage; widget : PgtkWidget; begin Widget := PgtkWidget(TCanvas(sender).Handle); Image := gtk_Object_get_data(pgtkobject(widget),'Image'); if Image = nil then Image := gdk_image_get(pgtkWidget(widget)^.window,0,0,widget^.allocation.width,widget^.allocation.height); gdk_image_put_pixel(Image,TLMSetGetPixel(data^).X,TLMSetGetPixel(data^).Y,TLMSetGetPixel(data^).PixColor); gtk_Object_set_data(pgtkobject(Widget),'Image',Image); widget := GetFixedWidget(Widget); fWindow := pGtkWidget(widget)^.window; gc := gdk_gc_new(PgdkWindow(fWindow)); 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 Image : pGDKImage; widget : PgtkWidget; WasNil : Boolean; begin Widget := PgtkWidget(TCanvas(sender).Handle); Image := gtk_Object_get_data(pgtkobject(widget),'Image'); if Image = nil then begin WasNil := True; Image := gdk_image_get(pgtkWidget(widget)^.window,0,0,widget^.allocation.width,widget^.allocation.height); end; TLMSetGetPixel(data^).PixColor := gdk_image_get_pixel(Image,TLMSetGetPixel(data^).X,TLMSetGetPixel(data^).Y); If WasNil then gtk_Object_set_data(pgtkobject(Widget),'Image',Image); 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; 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 : integer (data^) := round (gtk_range_get_adjustment (GTK_RANGE (handle))^.value); csRadiobutton, csCheckbox : if gtk_toggle_button_get_active (PGtkToggleButton (handle)) then TCheckBoxState (data^) := cbChecked else TCheckBoxState (data^) := cbUnChecked; 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; 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 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); 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; var Handle : Pointer; Widget : PGtkWidget; xAlign : gfloat; yAlign : gfloat; 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 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; 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; 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 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.IndexOf(Pointer(DC)) <> -1; 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 := FGDIObjects.IndexOf(Pointer(GDIObject)) <> -1; // 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; var n: Integer; 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; n := FDeviceContexts.Add(Result); Assert(False, Format('Trace:<== [TgtkObject.NewDC] FDeviceContexts[%d] --> 0x%p', [n, Result])); end; {------------------------------------------------------------------------------ Function: NewGDIObject Params: none Returns: a gtkwinapi DeviceContext Creates an initial DC ------------------------------------------------------------------------------} function TgtkObject.NewGDIObject(const GDIType: TGDIType): PGdiObject; var n: Integer; begin Assert(False, Format('Trace:==> [TgtkObject.NewGDIObject]', [])); New(Result); FillChar(Result^, SizeOf(TGDIObject), 0); Result^.GDIType := GDIType; n := FGDIObjects.Add(Result); Assert(False, Format('Trace:<== [TgtkObject.NewGDIObject] FGDIObjects[%d] --> 0x%p', [n, Result])); end; {------------------------------------------------------------------------------ Function: CreateDefaultBrush Params: none Returns: a Brush GDIObject Creates an default brush, used for initial values ------------------------------------------------------------------------------} function TgtkObject.CreateDefaultBrush: PGdiObject; begin 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); Result^.GDIFontObject := gdk_font_load('-*-helvetica-bold-r-normal--*-120-*-*-*-*-iso8859-1'); end; {------------------------------------------------------------------------------ Function: CreateDefaultPen Params: none Returns: a Pen GDIObject Creates an default pen, used for initial values ------------------------------------------------------------------------------} function TgtkObject.CreateDefaultPen: PGdiObject; begin Result := NewGDIObject(gdiPen); Result^.GDIPenStyle := PS_SOLID; gdk_color_black(gdk_colormap_get_system, @Result^.GDIPenColor); end; { ============================================================================= $Log$ Revision 1.1 2000/07/13 10:28:29 michael + Initial import Revision 1.28 2000/07/12 20:57:08 lazarus - some minor cleanups - cleanups in Set/Get Pixel - fixed to minor bugs related to Trackbar stoppok Revision 1.27 2000/07/09 20:46:38 lazarus - lots of new comments for methods - SetText: Code for Notebook removed (surrounded with comments)! - SetLabel: Code for NoteBook changed from ....get_label to ....set_label - some new asserts - many changes to beautify code stoppok Revision 1.26 2000/07/09 20:18:56 lazarus MWE: + added new controlselection + some fixes ~ some cleanup Revision 1.25 2000/07/02 05:51:41 lazarus Started code-review, beautified some oarts, nearly no code changes by now, stoppok Revision 1.24 2000/06/29 21:09:14 lazarus some minor cleanups, stoppok Revision 1.23 2000/06/29 18:08:56 lazarus Shane Looking for the editor problem I made a few changes. I changed everything back to the original though. Revision 1.22 2000/06/28 13:11:38 lazarus Fixed TNotebook so it gets page change events. Shane Revision 1.21 2000/06/24 21:26:19 lazarus *** empty log message *** Revision 1.20 2000/06/19 18:21:22 lazarus Spinedit was never getting created Shane Revision 1.19 2000/06/14 21:51:27 lazarus MWE: + Added menu accelerators. Not finished Revision 1.18 2000/06/13 21:51:19 lazarus MWE: + Started adding menu accels Revision 1.17 2000/06/13 20:50:42 lazarus MWE: - Started to remove obsolete/dead code/messages HJO: * Fixed messages in showmodal of 2nd form * Fixed modal result for button Revision 1.16 2000/06/09 11:35:22 lazarus More shortcut work. Shane Revision 1.15 2000/06/08 17:32:53 lazarus trying to add accel to menus. Shane Revision 1.14 2000/05/30 22:28:41 lazarus MWE: Applied patches from Vincent Snijders: + Added GetWindowRect * Fixed horz label alignment + Added vert label alignment Revision 1.13 2000/05/27 22:33:01 lazarus MWE: + Forgot to add Ref/UnRef to Tooltips Revision 1.12 2000/05/27 22:20:56 lazarus MWE & VRS: + Added new hint code Revision 1.11 2000/05/27 19:15:50 lazarus MWE: - Removed Linux dependencies. Functions are supported in wingtk Revision 1.10 2000/05/25 19:34:31 lazarus MWE: * Fixed messagequeue.count bug in GTKObject.Destroy (thanks to Vincent Snijders) Revision 1.9 2000/05/11 22:04:15 lazarus MWE: + Added messagequeue * Recoded SendMessage and Peekmessage + Added postmessage + added DeliverPostMessage Revision 1.8 2000/05/10 22:52:58 lazarus MWE: = Moved some global api stuf to gtkobject Revision 1.7 2000/05/09 02:05:08 lazarus Replaced writelns with Asserts. CAW Revision 1.6 2000/05/08 15:56:59 lazarus MWE: + Added support for mwedit92 in Makefiles * Fixed bug # and #5 (Fillrect) * Fixed labelsize in ApiWizz + Added a call to the resize event in WMWindowPosChanged Revision 1.5 2000/05/08 12:54:20 lazarus Removed some writeln's Added alignment for the TLabel. Isn't working quite right. Added the shell code for WindowFromPoint and GetParent. Added FindLCLWindow Shane Revision 1.4 2000/05/03 17:19:29 lazarus Added the TScreem forms code by hongli@telekabel.nl Shane Revision 1.3 2000/04/17 19:50:06 lazarus Added some compiler stuff built into Lazarus. This depends on the path to your compiler being correct in the compileroptions dialog. Shane Revision 1.2 2000/04/13 21:25:16 lazarus MWE: ~ Added some docu and did some cleanup. Hans-Joachim Ott : * TMemo.Lines works now. + TMemo has now a property Scrollbar. = TControl.GetTextBuf revised :-) + Implementation for CListBox columns added * Bug in TGtkCListStringList.Assign corrected. Revision 1.1 2000/03/30 22:51:42 lazarus MWE: Moved from ../../lcl Revision 1.143 2000/03/30 21:57:44 lazarus MWE: + Added some general functions to Get/Set the Main/Fixed/CoreChild widget + Started with graphic scalig/depth stuff. This is way from finished Hans-Joachim Ott : + Added some improvements for TMEMO Revision 1.142 2000/03/30 18:07:53 lazarus Added some drag and drop code Added code to change the unit name when it's saved as a different name. Not perfect yet because if you are in a comment it fails. Shane Revision 1.141 2000/03/24 14:40:41 lazarus A little polishing and bug fixing. Revision 1.140 2000/03/23 22:48:56 lazarus MWE & Hans-Joachim Ott : + added replacement for LM_GetText Revision 1.139 2000/03/23 20:40:03 lazarus Added some drag code Shane Revision 1.138 2000/03/22 17:09:29 lazarus *** empty log message *** Revision 1.137 2000/03/21 18:53:28 lazarus Added code for TBitBtn. Not finished but looks like mostly working. Shane Revision 1.136 2000/03/20 20:08:33 lazarus Added a generic MOUSE class. Shane Revision 1.135 2000/03/19 23:01:42 lazarus MWE: = Changed splashscreen loading/colordepth = Chenged Save/RestoreDC to platform dependent, since they are relative to a DC Revision 1.134 2000/03/17 19:19:58 lazarus Added Hans Ott's code for TMemo Shane Revision 1.133 2000/03/15 20:15:31 lazarus MOdified TBitmap but couldn't get it to work Shane Revision 1.132 2000/03/15 01:09:58 lazarus MWE: + Removed comment on LM_IMAGECHANGED in TgtkObject.IntSendMessage3 it does compile (compiler hickup ?) Revision 1.131 2000/03/15 00:51:57 lazarus MWE: + Added LM_Paint on expose + Added forced creation of gdkwindow if needed ~ Modified DrawFrameControl + Added BF_ADJUST support on DrawEdge - Commented out LM_IMAGECHANGED in TgtkObject.IntSendMessage3 (It did not compile) Revision 1.130 2000/03/14 19:49:04 lazarus Modified the painting process for TWincontrol. Now it runs throug it's FCONTROLS list and paints all them Shane Revision 1.129 2000/03/13 23:17:34 lazarus MWE: + finished hide caret + added blinking caret Revision 1.128 2000/03/10 18:31:09 lazarus Added TSpeedbutton code Shane Revision 1.127 2000/03/09 23:47:53 lazarus MWE: * Fixed colorcache * Fixed black window in new editor ~ Did some cosmetic stuff From Peter Dyson : + Added Rect api support functions + Added the start of ScrollWindowEx Revision 1.126 2000/03/04 00:05:21 lazarus MWE: added changes from Hans (HJO) Revision 1.125 2000/03/03 22:58:26 lazarus MWE: Fixed focussing problem. LM-FOCUS was bound to the wrong signal Added GetKeyState api func. Now LCL knows if shift/trl/alt is pressed (might be handy for keyboard selections ;-) Revision 1.124 2000/03/03 20:22:03 lazarus Trying to add TBitBtn Shane Revision 1.123 2000/03/01 00:41:03 lazarus MWE: Fixed updateshowing problem Added some debug code to display the name of messages Did a bit of cleanup in main.pp to get the code a bit more readable (my editor does funny things with tabs if the indent differs) Revision 1.122 2000/02/26 23:48:36 lazarus MWE: FIxed notebook, forgot getlabel code Revision 1.121 2000/02/26 23:31:50 lazarus MWE: Fixed notebook crash on insert Fixed loadfont problem for win32 (tleast now a fontname is required) Revision 1.120 2000/02/25 19:28:34 lazarus Played with TNotebook to see why it crashes when I add a tab and the tnotebook is showing. Havn't figured it out Shane Revision 1.119 2000/02/24 21:15:30 lazarus Added TCustomForm.GetClientRect and RequestAlign to try and get the controls to align correctly when a MENU is present. Not Complete yet. Fixed the bug in TEdit that caused it not to update it's text property. I will have to look at TMemo to see if anything there was affected. Added SetRect to WinAPI calls Added AdjustWindowRectEx to WINAPI calls. Shane Revision 1.118 2000/02/24 09:10:12 lazarus TListBox.Selected bug fixed. Revision 1.117 2000/02/23 22:08:38 lazarus MInor changes for listboxCVS: Committing in . Revision 1.116 2000/02/22 22:19:49 lazarus TCustomDialog is a descendant of TComponent. Initial cuts a form's proper Close behaviour. Revision 1.115 2000/02/22 21:29:42 lazarus Added a few more options in the editor like closeing a unit. Also am keeping track of what page , if any, they are currently on. Shane Revision 1.114 2000/02/22 17:32:49 lazarus Modified the ShowModal call. For TCustomForm is simply sets the visible to true now and adds fsModal to FFormState. In gtkObject.inc FFormState is checked. If it contains fsModal then either gtk_grab_add or gtk_grab_remove is called depending on the value of VISIBLE. The same goes for TCustomDialog (open, save, font, color). I moved the Execute out of the individual dialogs and moved it into TCustomDialog and made it virtual because FONT needs to set some stuff before calling the inherited execute. Shane Revision 1.113 2000/02/20 20:13:47 lazarus On my way to make alignments and stuff work :-) Revision 1.112 2000/02/19 18:11:59 lazarus More work on moving, resizing, forms' border style etc. Revision 1.111 2000/02/18 19:38:52 lazarus Implemented TCustomForm.Position Better implemented border styles. Still needs some tweaks. Changed TComboBox and TListBox to work again, at least partially. Minor cleanups. Revision 1.110 2000/01/25 22:04:27 lazarus MWE: The first primitive Caret functions are getting visible Revision 1.109 2000/01/22 20:07:46 lazarus Some cleanups. It needs much more cleanup than this. Worked around a compiler bug (?) in mwCustomEdit. Reverted some changes to font generation and increased font size. Revision 1.108 2000/01/18 22:18:34 lazarus Moved bitmap creation into appropriate place. Cleaned up a bit. Finished DeleteObject procedure. Revision 1.107 2000/01/17 23:33:06 lazarus MWE: fixed: nil pointer reference in DeleteObject fixed: some trace info didn't start with 'trace:' Revision 1.106 2000/01/17 20:36:25 lazarus Fixed Makefile again. Made implementation of TScreen and screen info saner. Began to implemented DeleteObject in GTKWinAPI. Fixed a bug in GDI allocation which in turn fixed A LOT of other bugs :-) Revision 1.105 2000/01/16 23:23:04 lazarus MWE: Added/completed scrollbar API funcs Revision 1.104 2000/01/16 20:24:42 lazarus Did some introductory work on TScreen. Only the PixelsPerInch property is implemented at the moment. Revision 1.103 2000/01/14 15:01:15 lazarus Changed SETCURSOR so the cursor's were created in the gtkObject.Init and destroyed in GTkObject.AppTerminate Shane Revision 1.102 2000/01/14 00:33:31 lazarus MWE: Added Scrollbar messages Revision 1.101 2000/01/13 22:44:05 lazarus MWE: Created/updated net gtkwidget for TWinControl decendants also improved foccusing on such a control Revision 1.100 2000/01/11 20:51:39 lazarus *** empty log message *** Revision 1.98 2000/01/10 00:07:12 lazarus MWE: Added more scrollbar support for TWinControl Most signals for TWinContorl are jet connected to the wrong widget (now scrolling window, should be fixed) Added some cvs entries Revision 1.97 2000/01/07 21:14:13 lazarus Added code for getwindowlong and setwindowlong. Shane Revision 1.96 2000/01/05 23:13:13 lazarus MWE: Made some changes to the ideeditor to track notebook problems Revision 1.95 2000/01/04 19:16:09 lazarus Stoppok: - new messages LM_GETVALUE, LM_SETVALUE, LM_SETPROPERTIES - changed trackbar, progressbar, checkbox to use above messages - some more published properties for above components (all properties derived from TWinControl) - new functions SetValue, GetValue, SetProperties in gtk-interface Revision 1.94 2000/01/03 00:19:21 lazarus MWE: Added keyup and buttonup events Added LM_MOUSEMOVE callback Started with scrollbars in editor Revision 1.93 2000/01/02 00:28:00 lazarus Stoppok: - changes for creation of radiobuttons Revision 1.92 1999/12/31 14:58:01 lazarus MWE: Set unkown VK_ codesto 0 Added pfDevice support for bitmaps Revision 1.91 1999/12/30 19:49:07 lazarus *** empty log message *** Revision 1.90 1999/12/30 19:04:13 lazarus - Made TRadiobutton work again - Some more cleanups to checkbox code stoppok Revision 1.89 1999/12/30 18:54:35 lazarus Fixed the problem that occured when more than one button was added to the toolbar. Also, I set it up so practically any widget (component) can be added to the toolbar now. In main.pp I have a TCOMBOBOX control being added. I will create a example program and place it into the examples directory. Shane Revision 1.88 1999/12/30 10:38:59 lazarus Some changes to Checkbox code. stoppok Revision 1.87 1999/12/29 20:38:23 lazarus Modified the toolbar so it now displays itself. However, I can only add one button at this point. I will fix that soon.... Shane Revision 1.86 1999/12/29 09:35:43 lazarus MWE: Reapplied lost changes Revision 1.85 1999/12/29 00:39:35 lazarus Changes to make trackbar/progressbar working again. stopppok Revision 1.84 1999/12/29 00:04:47 lazarus MWE: Refined key events. TODO get vk keycodes for non alpha keys Revision 1.83 1999/12/28 01:10:53 lazarus MWE: Added most common virtual keycodes Revision 1.82 1999/12/27 22:32:15 lazarus MWE: Fixed triple chars in editor. Events where fired more than once. Now it is checked if there already exists a callback. Revision 1.81 1999/12/23 21:48:13 lazarus *** empty log message *** Revision 1.78 1999/12/22 01:16:03 lazarus MWE: Changed/recoded keyevent callbacks We Can Edit! Commented out toolbar stuff Revision 1.77 1999/12/21 21:35:52 lazarus committed the latest toolbar code. Currently it doesn't appear anywhere and I have to get it to add buttons correctly through (I think) setstyle. I think I'll implement the LM_TOOLBARINSERTBUTTON call there. Shane Revision 1.76 1999/12/20 21:01:13 lazarus Added a few things for compatability with Delphi and TToolbar Shane Revision 1.75 1999/12/18 18:27:31 lazarus MWE: Rearranged some events to get a LM_SIZE, LM_MOVE and LM_WINDOWPOSCHANGED Initialized the TextMetricstruct to zeros to clear unset values Get mwEdit to show more than one line Fixed some errors in earlier commits Revision 1.74 1999/12/14 22:21:11 lazarus *** empty log message *** Revision 1.73 1999/12/10 00:47:01 lazarus MWE: Fixed some samples Fixed Dialog parent is no longer needed Fixed (Win)Control Destruction Fixed MenuClick Revision 1.72 1999/12/08 00:56:07 lazarus MWE: Fixed menus. Events aren't enabled yet (dumps --> invalid typecast ??) Revision 1.71 1999/12/07 01:19:25 lazarus MWE: Removed some double events Changed location of SetCallBack Added call to remove signals Restructured somethings Started to add default handlers in TWinControl Made some parts of TControl and TWinControl more delphi compatible ... and lots more ... Revision 1.70 1999/12/03 00:26:47 lazarus MWE: fixed control location added gdiobject reference counter Revision 1.69 1999/11/26 00:10:57 lazarus MWE: removed test unit commented some obsolete parts Revision 1.68 1999/11/25 23:45:08 lazarus MWE: Added font as GDIobject Added some API testcode to testform Commented out some more IFDEFs in mwCustomEdit Revision 1.67 1999/11/19 14:44:37 lazarus Changed the FONTSETNAME to try and load a default font if the first one doesn't work. This is being done for testing and probably will be removed later. Shane Revision 1.66 1999/11/19 01:09:43 lazarus MWE: implemented TCanvas.CopyRect Added StretchBlt Enabled creation of TCustomControl.Canvas Added a temp hack in TWinControl.Repaint to get a LM_PAINT Revision 1.65 1999/11/18 00:13:08 lazarus MWE: Partly Implemented SelectObject Added ExTextOut Added GetTextExtentPoint Added TCanvas.TextExtent/TextWidth/TextHeight Added TSize and HPEN Revision 1.64 1999/11/17 01:16:39 lazarus MWE: Added some more API stuff Added an initial TBitmapCanvas Added some DC stuff Changed and commented out, original gtk linedraw/rectangle code. This is now called through the winapi wrapper. Revision 1.63 1999/11/16 01:32:22 lazarus MWE: Added some more DC functionality Revision 1.62 1999/11/15 00:40:22 lazarus MWE: Added GetDC, ReleaseDC, Rectangle functions Revision 1.61 1999/11/13 13:03:34 lazarus MWE: Started to implement some platform dependent WINAPI stuff Added a baseclass for InterfaceObject Started messing around with canvasses Revision 1.60 1999/11/05 00:34:10 lazarus MWE: Menu structure updated, events and visible code not added yet Revision 1.59 1999/11/01 01:28:29 lazarus MWE: Implemented HandleNeeded/CreateHandle/CreateWND Now controls are created on demand. A call to CreateComponent shouldn't be needed. It is now part of CreateWnd Revision 1.58 1999/10/28 17:17:42 lazarus Removed references to FCOmponent. Shane Revision 1.57 1999/10/05 02:17:04 lazarus Cleaned up the code to make it more readable. CAW Revision 1.56 1999/09/30 21:59:01 lazarus MWE: Fixed TNoteBook problems Modifications: A few - Removed some debug messages + Added some others * changed fixed widged of TPage. Code is still broken. + TWinControls are also added to the Controls collection + Added TControl.Controls[] property Revision 1.55 1999/09/26 13:30:15 lazarus Implemented OnEnter & OnExit events for TTrackbar. These properties and handler functions have been added to TWincontrol, two new callbacks have been added to gtkcallback. stoppok Revision 1.54 1999/09/25 17:10:21 lazarus Modified TEDIT to give the correct text when you use Edit1.Text Thanks to Ned Boddie for noticing the error and sending the fix. Revision 1.53 1999/09/23 20:33:30 lazarus reintroduced changes to TTrackbar from v1.46 which where lost in 1.48. Some addtional changes to TTrackbar also applied. stoppok Revision 1.52 1999/09/22 20:29:53 lazarus *** empty log message *** Revision 1.49 1999/09/21 23:46:54 lazarus *** empty log message *** Revision 1.48 1999/09/17 23:18:45 lazarus Commented out a line in gtkobject that contaied the variable SCALEDIGITS that was not defined. Line 664 Editor has some additons as well. Revision 1.46 1999/09/17 20:49:03 lazarus Some changes to trackbar component (added lineSize/PageSize properties, removed scaledigits property) stoppok Revision 1.45 1999/09/17 04:33:56 lazarus Got the GETPIXEL and SETPIXEL to work (I think) Shane Revision 1.44 1999/09/15 03:45:23 lazarus Modified Editor. It displays files now. Revision 1.43 1999/09/15 03:17:31 lazarus Changes to Editor.pp If the text was actually displayed, then it would work better. :-) Revision 1.42 1999/09/13 03:22:12 lazarus Moved Notebook code to utilize IntSendMessage3 function. caw Revision 1.41 1999/09/11 12:16:16 lazarus Fixed a bug in key press evaluation. Initial cut at Invalidate problem. Revision 1.40 1999/09/03 22:01:02 lazarus Added TTrackBar stoppok Revision 1.39 1999/08/25 18:53:05 lazarus Added Canvas.pixel property which allows the user to get/set the pixel color. This will be used in the editor to create the illusion of the cursor by XORing the pixel with black. Shane Revision 1.38 1999/08/24 20:18:01 lazarus *** empty log message *** Revision 1.37 1999/08/21 13:57:38 lazarus Implemented TListBox.BorderStyle. The listbox is scrollable now. Revision 1.36 1999/08/20 18:34:16 lazarus *** empty log message *** Revision 1.35 1999/08/19 18:40:53 lazarus Added stuff for TProgressBar stoppok Aug. 19 1999 Revision 1.34 1999/08/17 16:46:26 lazarus Slight modification to Editor.pp Shane Revision 1.32 1999/08/16 22:32:45 peter * commented move_resize which doesn't exists under gtk 1.2.3 Revision 1.31 1999/08/16 20:48:05 lazarus Added a changed event for TFOnt and code to get the average size of the font. Doesn't seem to work very well yet. The "average size" code is found in gtkobject.inc. Revision 1.30 1999/08/16 18:45:42 lazarus Added a TFont Dialog plus minor additions. Shane Aug 16th 1999 14:07 CST Revision 1.29 1999/08/15 16:17:57 lazarus Win32 fix CEB Revision 1.28 1999/08/14 10:05:54 lazarus Added TListBox ItemIndex property. Made ItemIndex public for TComboBox and TListBox. Revision 1.27 1999/08/07 17:59:21 lazarus buttons.pp the DoLeave and DoEnter were connected to the wrong event. The rest were modified to use the new SendMessage function. MAH Revision 1.26 1999/08/07 00:11:51 lazarus Added the gtklistlh.inc and gtklistsi.inc files Revision 1.25 1999/08/06 23:55:29 lazarus Patched some files with a patch from Michal Bukovjan for TComboBox and TListBox. Revision 1.24 1999/08/04 19:52:47 lazarus Fixed the cursor display problem on Linux. KeyPRess still crashes. Have to figure out how to calc where the cursor should be going yet. Revision 1.23 1999/08/03 06:31:58 lazarus Moved all TNotebook GTK code to gtkint units Revision 1.22 1999/08/03 02:52:22 lazarus Added changes for CustomComboBox Revision 1.21 1999/08/01 21:46:28 lazarus Modified the GETWIDTH and GETHEIGHT of TFOnt so you can use it to calculate the length in Pixels of a string. This is now used in the editor. Shane Revision 1.20 1999/08/01 00:07:44 lazarus Alignment Changes CEB Revision 1.19 1999/07/31 06:39:29 lazarus Modified the IntSendMessage3 to include a data variable. It isn't used yet but will help in merging the Message2 and Message3 features. Adjusted TColor routines to match Delphi color format Added a TGdkColorToTColor routine in gtkproc.inc Finished the TColorDialog added to comDialog example. MAH }