mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-09-25 16:09:17 +02:00
MG: fixed bugs and cleaned up messages
git-svn-id: trunk@280 -
This commit is contained in:
lazarus
parent
2703d29631
commit
36975e1117
@ -927,12 +927,10 @@ var
|
||||
NewUnitInfo: TUnitInfo;
|
||||
NewUnitCount,i: integer;
|
||||
begin
|
||||
writeln('TProject.ReadProject 1');
|
||||
Result := mrCancel;
|
||||
Clear;
|
||||
|
||||
ProjectInfoFile:=LPIFilename;
|
||||
writeln('TProject.ReadProject 2 ',LPIFilename);
|
||||
try
|
||||
xmlcfg := TXMLConfig.Create(ProjectInfoFile);
|
||||
except
|
||||
@ -964,7 +962,6 @@ writeln('TProject.ReadProject 2 ',LPIFilename);
|
||||
AddUnit(NewUnitInfo,false);
|
||||
NewUnitInfo.LoadFromXMLConfig(
|
||||
xmlcfg,'ProjectOptions/Units/Unit'+IntToStr(i)+'/');
|
||||
//writeln('NewUnitInfo: ',NewUnitInfo.Filename,', ',NewUnitInfo.EditorIndex);
|
||||
end;
|
||||
|
||||
// Load the compiler options
|
||||
@ -978,7 +975,6 @@ writeln('TProject.ReadProject 2 ',LPIFilename);
|
||||
end;
|
||||
|
||||
Result := mrOk;
|
||||
writeln('TProject.ReadProject end');
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -1402,6 +1398,9 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.24 2001/06/04 09:32:17 lazarus
|
||||
MG: fixed bugs and cleaned up messages
|
||||
|
||||
Revision 1.23 2001/05/27 11:52:00 lazarus
|
||||
MG: added --primary-config-path=<filename> cmd line option
|
||||
|
||||
|
||||
@ -2123,7 +2123,6 @@ Var
|
||||
TempEditor : TSourceEditor;
|
||||
Begin
|
||||
//create a new page
|
||||
writeln('[TSourceNotebook.NewFile] 1');
|
||||
TempEditor := NewSE(-1);
|
||||
TempEditor.Unitname := Unitname;
|
||||
TempEditor.Source := Source;
|
||||
|
||||
@ -642,14 +642,15 @@ end;
|
||||
{$I canvas.inc}
|
||||
{$I pixmap.inc}
|
||||
|
||||
initialization
|
||||
CNSendMessage(LM_SCREENINIT, nil, @ScreenInfo);
|
||||
|
||||
end.
|
||||
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.10 2001/06/04 09:32:17 lazarus
|
||||
MG: fixed bugs and cleaned up messages
|
||||
|
||||
Revision 1.9 2001/03/21 00:20:29 lazarus
|
||||
MG: fixed memory leaks
|
||||
|
||||
|
||||
@ -97,7 +97,7 @@ end;
|
||||
{------------------------------------------------------------------------------}
|
||||
{ TApplication HintMouseMEssage }
|
||||
{------------------------------------------------------------------------------}
|
||||
procedure TApplication.HintMOuseMEssage(Control : TControl; var Message : TLMessage);
|
||||
procedure TApplication.HintMouseMessage(Control : TControl; var Message : TLMessage);
|
||||
begin
|
||||
//TODO: Needs to be finished
|
||||
end;
|
||||
@ -110,7 +110,8 @@ end;
|
||||
{------------------------------------------------------------------------------}
|
||||
procedure TApplication.Initialize;
|
||||
begin
|
||||
InterfaceObject.Init;
|
||||
InterfaceObject.Init;
|
||||
CNSendMessage(LM_SCREENINIT, nil, @ScreenInfo);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -240,6 +241,9 @@ end;
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.4 2001/06/04 09:32:17 lazarus
|
||||
MG: fixed bugs and cleaned up messages
|
||||
|
||||
Revision 1.3 2001/01/24 23:26:40 lazarus
|
||||
MWE:
|
||||
= moved some types to gtkdef
|
||||
|
||||
@ -70,6 +70,8 @@ begin
|
||||
pf32bit : n:= 32;
|
||||
else raise EInvalidOperation.Create('Unsupported bitmap format.');
|
||||
end;
|
||||
if Width<1 then Width:=1;
|
||||
if Height<1 then Height:=1;
|
||||
FImage.FHandle:= CreateBitmap(Width, Height, 1, n, nil);
|
||||
end;
|
||||
end;
|
||||
@ -316,6 +318,9 @@ end;
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.7 2001/06/04 09:32:17 lazarus
|
||||
MG: fixed bugs and cleaned up messages
|
||||
|
||||
Revision 1.6 2001/03/21 00:20:29 lazarus
|
||||
MG: fixed memory leaks
|
||||
|
||||
|
||||
@ -52,11 +52,9 @@ end;
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TCustomComboBox.AttachSignals;
|
||||
begin
|
||||
Writeln('[TCustomComboBox] AttachSignals');
|
||||
inherited AttachSignals;
|
||||
Assert(False, Format('Trace:[TCustomComboBox.AttachSignals] %s', [ClassName]));
|
||||
SetCallback (LM_CHANGED);
|
||||
Writeln('[TCustomComboBox] Exiting AttachSignals');
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -134,7 +132,6 @@ end;
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TCustomComboBox.DoChange(var Msg);
|
||||
begin
|
||||
Writeln('[TCustomComboBox] DoChange');
|
||||
if Assigned(FOnChange) then FOnChange(Self);
|
||||
end;
|
||||
|
||||
@ -162,7 +159,8 @@ procedure TCustomComboBox.SetSelText(Val : string);
|
||||
begin
|
||||
if FStyle <> csDropDownList then begin
|
||||
{ First delete the actual selection }
|
||||
Text:= Concat(Copy(Text, 1, SelStart), Val, Copy(Text, SelStart + SelLength + 1, Length(Text)));
|
||||
Text:= Concat(Copy(Text, 1, SelStart), Val,
|
||||
Copy(Text, SelStart + SelLength + 1, Length(Text)));
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -311,7 +309,8 @@ end;
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TCustomComboBox.SetItemIndex(Val : integer);
|
||||
begin
|
||||
if (Val < 0) or (Val > FItems.Count) then raise Exception.Create('Out of bounds in TCustomComboBox.SetItemIndex');
|
||||
if (Val < 0) or (Val > FItems.Count) then
|
||||
raise Exception.Create('Out of bounds in TCustomComboBox.SetItemIndex');
|
||||
HandleNeeded;
|
||||
CNSendMessage(LM_SETITEMINDEX, Self, Pointer(Val));
|
||||
end;
|
||||
@ -324,6 +323,9 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.5 2001/06/04 09:32:17 lazarus
|
||||
MG: fixed bugs and cleaned up messages
|
||||
|
||||
Revision 1.4 2001/01/28 03:51:42 lazarus
|
||||
Fixed the problem with Changed for ComboBoxs
|
||||
Shane
|
||||
|
||||
@ -86,32 +86,27 @@ Procedure TCustomEdit.CMTextChanged(var Message : TLMessage);
|
||||
var
|
||||
Temp : String;
|
||||
Begin
|
||||
|
||||
//check to see if the charcase should effect the text.
|
||||
if FCharCase = ecUppercase then
|
||||
Begin
|
||||
//check to see if the charcase should effect the text.
|
||||
if FCharCase = ecUppercase then
|
||||
Begin
|
||||
Temp := Uppercase(text);
|
||||
if Temp <> Text then Text := Temp;
|
||||
end
|
||||
else
|
||||
if FCharCase = ecLowercase then
|
||||
Begin
|
||||
end
|
||||
else
|
||||
if FCharCase = ecLowercase then
|
||||
Begin
|
||||
Temp := Lowercase(text);
|
||||
if Temp <> Text then Text := Temp;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
Writeln('CMTEXTCHANGED');
|
||||
Modified := True;
|
||||
if HandleAllocated then Change;
|
||||
Modified := True;
|
||||
if HandleAllocated then Change;
|
||||
End;
|
||||
|
||||
Procedure TCustomEdit.Change;
|
||||
Begin
|
||||
//inherited Change;
|
||||
Writeln('CHANGED');
|
||||
if Assigned(FOnChange) then FOnChange(Self);
|
||||
//inherited Change;
|
||||
if Assigned(FOnChange) then FOnChange(Self);
|
||||
end;
|
||||
|
||||
|
||||
@ -136,6 +131,9 @@ end;
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.4 2001/06/04 09:32:17 lazarus
|
||||
MG: fixed bugs and cleaned up messages
|
||||
|
||||
Revision 1.3 2001/01/04 15:09:05 lazarus
|
||||
Tested TCustomEdit.Readonly, MaxLength and CharCase.
|
||||
Shane
|
||||
|
||||
@ -41,20 +41,18 @@ end;
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TNBPages.Put(Index: Integer; const S: String);
|
||||
var
|
||||
//Msg: TLMTabSetText;
|
||||
Msg: TLMNotebookEvent;
|
||||
begin
|
||||
TPage(fPageList[Index]).Caption := S;
|
||||
TPage(fPageList[Index]).Name := S;
|
||||
|
||||
|
||||
if FNoteBook.HandleAllocated
|
||||
then begin
|
||||
Msg.Parent := fNotebook;
|
||||
Msg.Child := TPage(fPageList[Index]);
|
||||
Msg.fCompStyle := fNotebook.fCompStyle;
|
||||
Msg.Str := S;
|
||||
CNSendMessage(LM_SETTEXT, fNotebook, @Msg);
|
||||
//CNSendMessage(LM_SETTEXT, fNotebook, @Msg);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -66,10 +64,7 @@ var
|
||||
i: Integer;
|
||||
begin
|
||||
for i := 0 to fPageList.Count - 1 do
|
||||
begin
|
||||
TPage(fPageList[I]).Free;
|
||||
end;
|
||||
|
||||
fPageList.Clear;
|
||||
end;
|
||||
|
||||
@ -81,15 +76,17 @@ var
|
||||
Msg: TLMNotebookEvent;
|
||||
begin
|
||||
{ Make sure Index is in the range of valid pages to delete }
|
||||
if (Index > -1) and
|
||||
if (Index >= 0) and
|
||||
(Index < fPageList.Count) then
|
||||
begin
|
||||
{ Make sure there are pages to delete }
|
||||
if (fPageList.Count > 0) then
|
||||
{ If that page is showing, then show the previous page before deleting it }
|
||||
if (Index = fNoteBook.PageIndex) then
|
||||
fNoteBook.PageIndex := fNoteBook.PageIndex - 1;
|
||||
|
||||
{ If that page is showing, then show the previous page before deleting it }
|
||||
if (fPageList.Count > 0) and (Index = fNoteBook.PageIndex) then begin
|
||||
if fNoteBook.PageIndex>0 then
|
||||
fNoteBook.PageIndex := fNoteBook.PageIndex - 1
|
||||
else
|
||||
fNoteBook.PageIndex := 1;
|
||||
end;
|
||||
|
||||
if FNoteBook.HandleAllocated
|
||||
then begin
|
||||
@ -100,7 +97,6 @@ begin
|
||||
end;
|
||||
TPage(fPageList[Index]).Free;
|
||||
fPageList.Delete(Index);
|
||||
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -151,10 +147,11 @@ end;
|
||||
TNBPages Move
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TNBPages.Move(CurIndex, NewIndex: Integer);
|
||||
// ToDo
|
||||
//var
|
||||
// theObject: TObject;
|
||||
begin
|
||||
fPageList.Move(CurIndex, NewIndex);
|
||||
//fPageList.Move(CurIndex, NewIndex);
|
||||
//theObject := fPageList[CurIndex];
|
||||
//fPageList[CurIndex] := fPageList[NewIndex];
|
||||
//fPageList[NewIndex] := theObject;
|
||||
@ -220,7 +217,6 @@ begin
|
||||
SetPageIndex(FPageIndex);
|
||||
|
||||
SetCallback(LM_CHANGED);
|
||||
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -375,9 +371,7 @@ var
|
||||
i: LongInt;
|
||||
begin
|
||||
for i := 0 to fPageList.Count - 1 do
|
||||
begin
|
||||
Proc(TControl(fPageList[i]));
|
||||
end;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -400,10 +394,8 @@ begin
|
||||
{ Find a child control that matches the one passed in and display
|
||||
the page that contains that control. This method is necessary
|
||||
for compatibility with Delphi }
|
||||
for i := 0 to fPageList.Count - 1 do
|
||||
begin
|
||||
if TControl(fPageList[i]) = AControl then
|
||||
begin
|
||||
for i := 0 to fPageList.Count - 1 do begin
|
||||
if TControl(fPageList[i]) = AControl then begin
|
||||
PageIndex := i;
|
||||
Exit;
|
||||
end;
|
||||
@ -415,30 +407,34 @@ end;
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TCustomNotebook.Change;
|
||||
Begin
|
||||
if Assigned(fOnPageChanged) then fOnPageChanged(self);
|
||||
if Assigned(fOnPageChanged) then fOnPageChanged(self);
|
||||
end;
|
||||
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
TCustomNotebook CNNotify
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TCustomNotebook.CNNotify(var Message : TLMNotify);
|
||||
Begin
|
||||
with Message do
|
||||
with Message do
|
||||
Case NMHdr^.code of
|
||||
TCN_SELCHANGE: Begin
|
||||
//set the page from the NMHDR^.idfrom
|
||||
FPageIndex := NMHDR^.idfrom;
|
||||
change;
|
||||
end;
|
||||
end;
|
||||
|
||||
TCN_SELCHANGE:
|
||||
Begin
|
||||
//set the page from the NMHDR^.idfrom
|
||||
FPageIndex := NMHDR^.idfrom;
|
||||
Change;
|
||||
end;
|
||||
else
|
||||
writeln('[TCustomNotebook.CNNotify]');
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.5 2001/06/04 09:32:17 lazarus
|
||||
MG: fixed bugs and cleaned up messages
|
||||
|
||||
Revision 1.4 2001/03/21 00:20:29 lazarus
|
||||
MG: fixed memory leaks
|
||||
|
||||
|
||||
@ -273,10 +273,9 @@ begin
|
||||
FStockDkGrayBrush := CreateBrushIndirect(LogBrush);
|
||||
LogBrush.lbColor := $FFFFFF;
|
||||
FStockWhiteBrush := CreateBrushIndirect(LogBrush);
|
||||
|
||||
end;
|
||||
|
||||
function TgtkObject.RecreateWnd(Sender: TObject): Integer;
|
||||
function TgtkObject.RecreateWnd(Sender: TObject): Integer;
|
||||
var
|
||||
aParent : TWinControl;
|
||||
Begin
|
||||
@ -311,7 +310,8 @@ End;
|
||||
WARNING: the result of this function sometimes is not always really an
|
||||
integer!!!!!
|
||||
------------------------------------------------------------------------------}
|
||||
function TgtkObject.IntSendMessage3(LM_Message : Integer; Sender : TObject; data : pointer) : integer;
|
||||
function TgtkObject.IntSendMessage3(LM_Message : Integer; Sender : TObject;
|
||||
data : pointer) : integer;
|
||||
var
|
||||
handle : hwnd; // handle of sender
|
||||
pStr : PChar; // temporary string pointer, must be allocated/disposed when used!
|
||||
@ -471,34 +471,43 @@ begin
|
||||
//TBitBtn
|
||||
LM_IMAGECHANGED, LM_LAYOUTCHANGED :
|
||||
Begin
|
||||
Assert(False, 'Trace:********************');
|
||||
Assert(False, 'Trace:********************');
|
||||
Assert(False, 'Trace:1');
|
||||
box1 := gtk_object_get_data(pgtkObject(handle),'HBox');
|
||||
if box1 <> nil then
|
||||
begin
|
||||
Assert(False, 'Trace:REMOVING THE HBOX');
|
||||
gtk_container_remove(PgtkContainer(box1),gtk_object_get_data(pgtkObject(handle),'Label'));
|
||||
gtk_container_remove(PgtkContainer(box1),gtk_object_get_data(pgtkObject(handle),'Pixmap'));
|
||||
PixMapWid:=gtk_object_get_data(pgtkObject(handle),'Pixmap');
|
||||
if PixMapWid<>nil then
|
||||
gtk_container_remove(PgtkContainer(box1),PixMapWid);
|
||||
gtk_container_remove(PgtkContainer(handle),box1);
|
||||
gtk_widget_destroy(box1);
|
||||
// gtk_container_remove automatically destroys box1 if ref count=0
|
||||
// so we dont need gtk_widget_destroy(box1);
|
||||
end;
|
||||
|
||||
if (TBitBtn(Sender).Layout = blGlyphLeft) or (TBitBtn(Sender).Layout = blGlyphRight) then
|
||||
if (TBitBtn(Sender).Layout = blGlyphLeft)
|
||||
or (TBitBtn(Sender).Layout = blGlyphRight) then
|
||||
Begin
|
||||
Assert(False, 'Trace:GLYPHLEFT or GLYPHRIGHT');
|
||||
box1 := gtk_hbox_new(False,0);
|
||||
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);
|
||||
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);
|
||||
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);
|
||||
then begin
|
||||
PixMapWid := gtk_pixmap_new(pixmap,
|
||||
PgdiObject(TBitBtn(Sender).Glyph.handle)^.GDIBitmapMaskObject)
|
||||
end else begin
|
||||
PixMapWid := gtk_pixmap_new(pixmap,nil);
|
||||
end;
|
||||
|
||||
Assert(False, 'Trace:4');
|
||||
pStr := StrAlloc(length(TBitBtn(Sender).Caption) + 1);
|
||||
@ -506,21 +515,26 @@ begin
|
||||
pLabel := gtk_label_new(pstr);
|
||||
StrDispose(pStr);
|
||||
Assert(False, 'Trace:5');
|
||||
if (TBitBtn(Sender).Layout = blGlyphLeft) or (TBitBtn(Sender).Layout = blGlyphTop) then
|
||||
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);
|
||||
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);
|
||||
gtk_box_pack_start(pGTKBox(Box1),pLabel,False,False,
|
||||
TBitBtn(Sender).Spacing);
|
||||
gtk_box_pack_start(pGTKBox(Box1),PixMapWid,False,False,
|
||||
TBitBtn(Sender).Spacing);
|
||||
end;
|
||||
Assert(False, 'Trace:6');
|
||||
gtk_object_set_data(pgtkObject(handle),'Label',pLabel);
|
||||
gtk_object_set_data(pgtkObject(handle),'HBox',Box1);
|
||||
gtk_object_set_data(pgtkObject(handle),'Pixmap',pixmapwid);
|
||||
gtk_object_set_data(pgtkObject(handle),'Label',pLabel);
|
||||
gtk_object_set_data(pgtkObject(handle),'Pixmap',PixMapWid);
|
||||
Assert(False, 'Trace:7');
|
||||
gtk_widget_show(pixmapwid);
|
||||
gtk_widget_show(pLabel);
|
||||
@ -535,11 +549,14 @@ 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));
|
||||
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);
|
||||
PdeviceContext(TBitmap(sender).handle)^.CurrentBitmap :=
|
||||
pgdiObject(pixmap);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -553,9 +570,11 @@ begin
|
||||
nil,
|
||||
0,
|
||||
0);
|
||||
{Displays a menu and makes it available for selection. Applications can use this function to display context-sensitive menus,
|
||||
and will typically supply NULL for the parent_menu_shell, parent_menu_item, func and data parameters.
|
||||
The default menu positioning function will position the menu at the current pointer position.
|
||||
{Displays a menu and makes it available for selection. Applications can use this
|
||||
function to display context-sensitive menus, and will typically supply NULL for
|
||||
the parent_menu_shell, parent_menu_item, func and data parameters.
|
||||
The default menu positioning function will position the menu at the current
|
||||
pointer position.
|
||||
menu : a GtkMenu.
|
||||
parent_menu_shell : the menu shell containing the triggering menu item.
|
||||
parent_menu_item : the menu item whose activation triggered the popup.
|
||||
@ -633,13 +652,13 @@ activate_time : the time at which the activation event occurred.
|
||||
ReDraw(PgtkWidget(Handle))
|
||||
else
|
||||
if (sender is TSpeedButton) then
|
||||
If TSpeedbutton(sender).Visible then (Sender as TSpeedButton).perform(LM_PAINT,0,0)
|
||||
else
|
||||
Begin
|
||||
If TSpeedbutton(sender).Visible then
|
||||
(Sender as TSpeedButton).perform(LM_PAINT,0,0)
|
||||
else
|
||||
Begin
|
||||
Rect := TSpeedButton(sender).BoundsRect;
|
||||
InvalidateRect(TSpeedButton(sender).Parent.Handle,@Rect,True);
|
||||
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
LM_AddPage :
|
||||
@ -676,10 +695,10 @@ activate_time : the time at which the activation event occurred.
|
||||
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);
|
||||
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');
|
||||
@ -731,13 +750,6 @@ activate_time : the time at which the activation event occurred.
|
||||
|
||||
LM_SCREENINIT :
|
||||
begin
|
||||
WriteLN('LM_SCREENINIT called --> should go to GTKObject.Init');
|
||||
WriteLN('TODO: check this');
|
||||
{ Initialize gdk }
|
||||
//??? shouldn't this go to init ????
|
||||
// MWE: Move this 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));
|
||||
@ -1103,7 +1115,6 @@ begin
|
||||
writeln ('STOPPOK: [TGtkObject.SetText] Possible superfluous use of SetText, use SetLabel instead!');
|
||||
end;
|
||||
{STOPPOK: Code seems superfluous, see SetLabel instead}
|
||||
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -1163,9 +1174,9 @@ begin
|
||||
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);
|
||||
csBitBtn : IntSendMessage3(LM_IMAGECHANGED,Sender,nil);
|
||||
|
||||
csButton,
|
||||
csToolButton : with PgtkButton(P)^ do
|
||||
@ -1623,7 +1634,7 @@ const
|
||||
//unused: Tpixdata = Array[1..20] of String;
|
||||
|
||||
var
|
||||
caption : string; // the caption of "Sender"
|
||||
caption : ansistring; // the caption of "Sender"
|
||||
StrTemp : PChar; // same as "caption" but as PChar
|
||||
TempWidget : PGTKWidget; // pointer to gtk-widget (local use when neccessary)
|
||||
p : pointer; // ptr to the newly created GtkWidget
|
||||
@ -1685,37 +1696,46 @@ begin
|
||||
|
||||
csBitBtn :
|
||||
begin
|
||||
Assert(False, 'Trace:CSBITBTN CREATE*************************');
|
||||
p := gtk_button_new;
|
||||
Box := gtk_hbox_new(False,0);
|
||||
gtk_container_set_border_width(PgtkContainer(Box),2);
|
||||
style := gtk_widget_get_style(pGTKWidget(p));
|
||||
|
||||
Assert(False, 'Trace:CSBITBTN CREATE*************************');
|
||||
p := gtk_button_new;
|
||||
if (TBitBtn(Sender).Layout = blGlyphLeft)
|
||||
or (TBitBtn(Sender).Layout = blGlyphRight) then begin
|
||||
Assert(False, 'Trace:GLYPHLEFT or GLYPHRIGHT');
|
||||
Box := gtk_hbox_new(False,0);
|
||||
end
|
||||
else Begin
|
||||
Assert(False, 'Trace:GLYPHTOP or GLYPHBOTTOM');
|
||||
Box := gtk_vbox_new(False,0);
|
||||
end;
|
||||
gtk_container_set_border_width(PgtkContainer(Box),2);
|
||||
style := gtk_widget_get_style(pGTKWidget(p));
|
||||
{
|
||||
// is this neccessary?
|
||||
// MWE: nope, if needeid, it should be done static
|
||||
// MWE: nope, if needed, it should be done static
|
||||
TempStr := './images/menu.xpm';
|
||||
pStr := StrAlloc(length(TempStr) + 1);
|
||||
StrPCopy(pStr, TempStr);
|
||||
pixmap := gdk_pixmap_create_from_xpm(pgtkWidget(p)^.window, @Mask,
|
||||
@style^.bg[GTK_STATE_NORMAL],pStr);
|
||||
StrDispose(pStr);
|
||||
|
||||
pixmapwid := gtk_pixmap_new(pixmap,mask);
|
||||
label1 := gtk_label_new(StrTemp);
|
||||
}
|
||||
|
||||
//pixmapwid := gtk_pixmap_new(pixmap,mask);
|
||||
PixMapWid := nil;
|
||||
Label1 := gtk_label_new(StrTemp);
|
||||
|
||||
gtk_box_pack_start(pGTkBox(Box),pixmapwid,False,False,3);
|
||||
gtk_box_pack_start(pGTkBox(Box), label1, FALSE, FALSE, 3);
|
||||
gtk_widget_show(pixmapwid);
|
||||
gtk_widget_show(label1);
|
||||
gtk_Container_add(PgtkContainer(p),Box);
|
||||
gtk_widget_show(Box);
|
||||
//gtk_box_pack_start(pGTkBox(Box),pixmapwid,False,False,3);
|
||||
gtk_box_pack_start(pGTkBox(Box), Label1, FALSE, FALSE, 3);
|
||||
//gtk_widget_show(pixmapwid);
|
||||
gtk_widget_show(Label1);
|
||||
gtk_Container_add(PgtkContainer(p),Box);
|
||||
gtk_widget_show(Box);
|
||||
|
||||
gtk_object_set_data(pgtkObject(p),'HBox',Box);
|
||||
gtk_object_set_data(pgtkObject(p),'Pixmap',PixMapwid);
|
||||
gtk_object_set_data(pgtkObject(p),'Label',Label1);
|
||||
|
||||
Assert(False, 'Trace:CSBITBTN CREATE EXITING*************************');
|
||||
gtk_object_set_data(pgtkObject(p),'HBox',Box);
|
||||
gtk_object_set_data(pgtkObject(p),'Pixmap',PixMapwid);
|
||||
gtk_object_set_data(pgtkObject(p),'Label',Label1);
|
||||
|
||||
Assert(False, 'Trace:CSBITBTN CREATE EXITING*************************');
|
||||
end;
|
||||
|
||||
csButton :
|
||||
@ -1832,7 +1852,9 @@ begin
|
||||
|
||||
csFixed: //used for TWinControl, maybe change this to csWinControl
|
||||
begin
|
||||
writeln('[TgtkObject.CreateComponent] csFixed A');
|
||||
p := GTKAPIWidget_New;
|
||||
writeln('[TgtkObject.CreateComponent] csFixed B');
|
||||
gtk_scrolled_window_set_policy(PGTKScrolledWindow(p), GTK_POLICY_NEVER, GTK_POLICY_NEVER);
|
||||
|
||||
Adjustment := gtk_scrolled_window_get_vadjustment(PGTKScrolledWindow(p));
|
||||
@ -2846,6 +2868,9 @@ end;
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.46 2001/06/04 09:32:17 lazarus
|
||||
MG: fixed bugs and cleaned up messages
|
||||
|
||||
Revision 1.45 2001/05/13 22:07:09 lazarus
|
||||
Implemented BringToFront / SendToBack.
|
||||
|
||||
|
||||
@ -149,7 +149,6 @@ begin
|
||||
gtk_style_set_background (Widget^.theStyle, Widget^.Window, GTK_STATE_NORMAL);
|
||||
// gdk_window_set_background(Widget^.Window, @PGTKStyle(Widget^.theStyle)^.Base[gtk_widget_state(Widget)]);
|
||||
// gdk_window_set_background (Client^.OtherWindow, @PGTKStyle(Widget^.theStyle)^.Base[gtk_widget_state(Widget)]);
|
||||
|
||||
end;
|
||||
|
||||
procedure GTKAPIWidgetClient_UnRealize(Widget: PGTKWidget); cdecl;
|
||||
@ -239,7 +238,6 @@ begin
|
||||
BackPixmap := nil;
|
||||
Timer := 0;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
function GTKAPIWidgetClient_GetType: Guint;
|
||||
@ -282,7 +280,6 @@ const
|
||||
var
|
||||
Widget: PGTKWidget;
|
||||
begin
|
||||
|
||||
Widget := PGTKWidget(Client);
|
||||
|
||||
with Client^.Caret do
|
||||
@ -396,7 +393,7 @@ begin
|
||||
X := AX;
|
||||
Y := AY;
|
||||
if IsVisible then GTKAPIWidgetClient_ShowCaret(Client);
|
||||
end
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure GTKAPIWidgetClient_GetCaretPos(Client: PGTKAPIWidgetClient; var X, Y: Integer);
|
||||
@ -437,19 +434,20 @@ end;
|
||||
|
||||
procedure GTKAPIWidget_ClassInit(wawClass: PGTKAPIWidgetClass); cdecl;
|
||||
var
|
||||
ObjectClass: PGTKObjectClass;
|
||||
// ObjectClass: PGTKObjectClass;
|
||||
WidgetClass: PGTKWidgetClass;
|
||||
begin
|
||||
ObjectClass := PGTKObjectClass(wawClass);
|
||||
// ObjectClass := PGTKObjectClass(wawClass);
|
||||
WidgetClass := PGTKWidgetClass(wawClass);
|
||||
|
||||
WidgetClass^.focus_in_event := @GTKAPIWidget_FocusIn;
|
||||
WidgetClass^.focus_out_event := @GTKAPIWidget_FocusOut;
|
||||
end;
|
||||
|
||||
procedure GTKAPIWidget_Init(waw: PGTKAPIWidget; theClass: PGTKAPIWidgetClass); cdecl;
|
||||
procedure GTKAPIWidget_Init(waw: PGTKAPIWidget;
|
||||
theClass: PGTKAPIWidgetClass); cdecl;
|
||||
var
|
||||
Widget: PGTKWidget;
|
||||
Widget: PGTKWidget;
|
||||
begin
|
||||
Widget := PGTKWidget(waw);
|
||||
|
||||
@ -460,7 +458,12 @@ begin
|
||||
gtk_object_set_data(PGTKObject(waw^.Client), 'Main', Widget);
|
||||
gtk_widget_show(waw^.Client);
|
||||
|
||||
writeln('(gtkwinapiwindow.pp) GTKAPIWidget_Init B check this:');
|
||||
// MG: range check GTK-Critical warnings results possibly from
|
||||
// function GTKAPIwidget_new.
|
||||
// ToDo: check nil parameters
|
||||
gtk_container_add(PGTKContainer(Widget), waw^.Client);
|
||||
writeln('GTKAPIWidget_Init END');
|
||||
end;
|
||||
|
||||
function GTKAPIWidget_GetType: Guint;
|
||||
@ -476,29 +479,32 @@ const
|
||||
begin
|
||||
if (wawType = 0)
|
||||
then wawType := gtk_type_unique(gtk_scrolled_window_get_type, @wawInfo);
|
||||
|
||||
Result := wawType;
|
||||
end;
|
||||
|
||||
function GTKAPIWidget_new: PGTKWidget;
|
||||
begin
|
||||
writeln('(gtkwinapiwindow.pp) GTKAPIWidget_new, ToDo: check parameters, gtk-Critical');
|
||||
// ToDo: check these nil parameters
|
||||
Result := gtk_widget_new(
|
||||
GTKAPIWidget_GetType,
|
||||
'hadjustment', [nil,
|
||||
'hadjustment', [nil, // what are these nils?
|
||||
'vadjustment', nil,
|
||||
nil]
|
||||
);
|
||||
|
||||
writeln('GTKAPIWidget_new END');
|
||||
end;
|
||||
|
||||
procedure GTKAPIWidget_CreateCaret(APIWidget: PGTKAPIWidget; AWidth, AHeight: Integer; ABitmap: PGDKPixmap);
|
||||
procedure GTKAPIWidget_CreateCaret(APIWidget: PGTKAPIWidget;
|
||||
AWidth, AHeight: Integer; ABitmap: PGDKPixmap);
|
||||
begin
|
||||
if APIWidget = nil
|
||||
then begin
|
||||
WriteLn('WARNING: [GTKAPIWidget_CreateCaret] Got nil client');
|
||||
Exit;
|
||||
end;
|
||||
GTKAPIWidgetClient_CreateCaret(PGTKAPIWidgetClient(APIWidget^.Client), AWidth, AHeight, ABitmap);
|
||||
GTKAPIWidgetClient_CreateCaret(PGTKAPIWidgetClient(APIWidget^.Client),
|
||||
AWidth, AHeight, ABitmap);
|
||||
end;
|
||||
|
||||
procedure GTKAPIWidget_HideCaret(APIWidget: PGTKAPIWidget);
|
||||
@ -546,6 +552,9 @@ end.
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.7 2001/06/04 09:32:17 lazarus
|
||||
MG: fixed bugs and cleaned up messages
|
||||
|
||||
Revision 1.6 2001/03/27 11:11:13 lazarus
|
||||
MG: fixed mouse msg, added filedialog initialdir
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user