diff --git a/examples/memotest.pp b/examples/memotest.pp index 6bc059c996..f981a748f2 100644 --- a/examples/memotest.pp +++ b/examples/memotest.pp @@ -1,4 +1,4 @@ -program listboxtest; +program memotest; {$mode objfpc} @@ -8,14 +8,17 @@ uses type TMemoTestForm = class(TForm) public - Button1, Button2, Button3, Button4: TButton; + Button1, Button2, Button3, Button4, Button5, Button6: TButton; Memo1, Memo2: TMemo; MyLabel: TLabel; + Edit1: TEdit; constructor Create(AOwner: TComponent); override; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure Button4Click(Sender: TObject); + procedure Button5Click(Sender: TObject); + procedure Button6Click(Sender: TObject); end; var @@ -27,17 +30,37 @@ var constructor TMemoTestForm.Create(AOwner: TComponent); begin inherited Create(AOwner); - Width := 300; - Height := 200; + Width := 350; + Height := 245; Left := 200; Top := 200; // create childs + Button5 := TButton.Create(Self); + Button5.OnClick := @button5click; + Button5.Parent := Self; + Button5.left := 10; + Button5.top := 210; + Button5.width := 50; + Button5.height := 25; + Button5.caption := 'Add'; + Button5.Show; + + Button3 := TButton.Create(Self); + Button3.OnClick := @Button3Click; + Button3.Parent := Self; + Button3.left := 65; + Button3.top := 210; + Button3.width := 50; + Button3.height := 25; + Button3.caption := 'Clear 1'; + Button3.Show; + Button1 := TButton.Create(Self); Button1.OnClick := @Button1Click; Button1.Parent := Self; - Button1.left := 40; - Button1.top := 170; + Button1.left := 120; + Button1.top := 210; Button1.width := 50; Button1.height := 25; Button1.caption := '->'; @@ -46,32 +69,40 @@ begin Button2 := TButton.Create(Self); Button2.OnClick := @Button2Click; Button2.Parent := Self; - Button2.left := 95; - Button2.top := 170; + Button2.left := 175; + Button2.top := 210; Button2.width := 50; Button2.height := 25; Button2.caption := '<-'; Button2.Show; - Button3 := TButton.Create(Self); - Button3.OnClick := @Button3Click; - Button3.Parent := Self; - Button3.left := 150; - Button3.top := 170; - Button3.width := 50; - Button3.height := 25; - Button3.caption := 'Clear 1'; - Button3.Show; - Button4 := TButton.Create(Self); Button4.OnClick := @button4click; Button4.Parent := Self; - Button4.left := 205; - Button4.top := 170; + Button4.left := 230; + Button4.top := 210; Button4.width := 50; Button4.height := 25; Button4.caption := 'Clear 2'; Button4.Show; + + Button6 := TButton.Create(Self); + Button6.OnClick := @button6click; + Button6.Parent := Self; + Button6.left := 285; + Button6.top := 210; + Button6.width := 50; + Button6.height := 25; + Button6.caption := 'Add'; + Button6.Show; + + Edit1 := TEdit.Create(Self); + Edit1.Parent := Self; + Edit1.Top := 180; + Edit1.Height := 25; + Edit1.Left := 10; + Edit1.Width := 325; + Edit1.Visible := True; MyLabel := TLabel.Create(Self); with MyLabel @@ -88,23 +119,26 @@ begin Memo1 := TMemo.Create(Self); with Memo1 do begin + WordWrap := True; Parent := Self; Left := 10; Top := 20; - Width := 135; + Width := 160; Height := 155; + Scrollbars := ssVertical; Show; end; Memo2 := TMemo.Create(Self); with Memo2 do begin + WordWrap := False; Parent := Self; - WordWrap := false; - Left := 145; + Left := 175; Top := 20; - Width := 135; + Width := 160; Height := 155; + Scrollbars := ssBoth; Show; end; end; @@ -129,6 +163,16 @@ begin Memo2.Text := ''; end; +procedure TMemoTestForm.Button5Click(Sender: TObject); +begin + Memo1.Lines.Add(Edit1.Text); +end; + +procedure TMemoTestForm.Button6Click(Sender: TObject); +begin + Memo2.Lines.Add(Edit1.Text); +end; + begin Application.Initialize; Application.CreateForm(TMemoTestForm, MemoTestForm); diff --git a/lcl/controls.pp b/lcl/controls.pp index 907c9f8ee3..aa9a92ee1b 100644 --- a/lcl/controls.pp +++ b/lcl/controls.pp @@ -21,6 +21,7 @@ unit controls; {$mode objfpc} +{$LONGSTRINGS ON} interface @@ -1130,6 +1131,11 @@ end. { ============================================================================= $Log$ + Revision 1.18 2001/03/27 21:12:53 lazarus + MWE: + + Turned on longstrings + + modified memotest to add lines + Revision 1.17 2001/03/26 14:58:31 lazarus MG: setwindowpos + bugfixes diff --git a/lcl/include/control.inc b/lcl/include/control.inc index c28f3a10cc..3649881ad4 100644 --- a/lcl/include/control.inc +++ b/lcl/include/control.inc @@ -1174,22 +1174,28 @@ procedure TControl.SetText(const Value: TCaption); var pStr : PChar; begin - if GetText <> value - then begin -// added on 3/21/2000. Need to set FCaption otherwise those components that simply -// check FCaption will always be wrong. + if GetText <> value + then begin + // added on 3/21/2000. Need to set FCaption otherwise those components that simply + // check FCaption will always be wrong. FCaption := Value; - //We shouldn't NEED to create our own PCHAR. We should be able - //to typecast VALUE as a PCHAR but it doesn't work. - pStr := StrAlloc(length(Value) + 1); - try - StrPCopy(pStr, value); - SetTextBuf(pStr); - finally - strDispose(pStr); - end; - end; + {$IFOPT H+} + SetTextBuf(PChar(FCaption)); + {$ELSE} + //We shouldn't NEED to create our own PCHAR. We should be able + //to typecast VALUE as a PCHAR but it doesn't work. + // + // MWE: that's because strings were short strings + pStr := StrAlloc(length(Value) + 1); + try + StrPCopy(pStr, value); + SetTextBuf(pStr); + finally + strDispose(pStr); + end; + {$ENDIF} + end; end; {------------------------------------------------------------------------------ @@ -1302,6 +1308,11 @@ end; { ============================================================================= $Log$ + Revision 1.18 2001/03/27 21:12:53 lazarus + MWE: + + Turned on longstrings + + modified memotest to add lines + Revision 1.17 2001/03/21 23:48:29 lazarus MG: fixed window positions diff --git a/lcl/interfacebase.pp b/lcl/interfacebase.pp index f01a947507..4e8bce5978 100644 --- a/lcl/interfacebase.pp +++ b/lcl/interfacebase.pp @@ -28,7 +28,7 @@ Detailed description of the Unit. unit InterfaceBase; {$mode objfpc} - +{$LONGSTRINGS ON} interface {$ifdef Trace} @@ -81,6 +81,11 @@ end. { $Log$ + Revision 1.3 2001/03/27 21:12:53 lazarus + MWE: + + Turned on longstrings + + modified memotest to add lines + Revision 1.2 2001/02/01 19:34:50 lazarus TScrollbar created and a lot of code added. diff --git a/lcl/interfaces/gtk/gtkdef.pp b/lcl/interfaces/gtk/gtkdef.pp index 1aeba24321..89cac114fb 100644 --- a/lcl/interfaces/gtk/gtkdef.pp +++ b/lcl/interfaces/gtk/gtkdef.pp @@ -23,6 +23,8 @@ unit gtkdef; {$mode objfpc} +{$LONGSTRINGS ON} + interface @@ -111,6 +113,11 @@ end. { ============================================================================= $Log$ + Revision 1.3 2001/03/27 21:12:54 lazarus + MWE: + + Turned on longstrings + + modified memotest to add lines + Revision 1.2 2001/01/25 21:38:57 lazarus MWE: * fixed lil bug I commetted yesterday (listbox crash) diff --git a/lcl/interfaces/gtk/gtkint.pp b/lcl/interfaces/gtk/gtkint.pp index c7e4be2b0e..afdc50fa20 100644 --- a/lcl/interfaces/gtk/gtkint.pp +++ b/lcl/interfaces/gtk/gtkint.pp @@ -21,6 +21,7 @@ unit gtkint; {$mode objfpc} +{$LONGSTRINGS ON} interface @@ -248,6 +249,11 @@ end. { ============================================================================= $Log$ + Revision 1.12 2001/03/27 21:12:54 lazarus + MWE: + + Turned on longstrings + + modified memotest to add lines + Revision 1.11 2001/03/19 18:51:57 lazarus MG: added dynhasharray and renamed tsynautocompletion diff --git a/lcl/interfaces/gtk/gtkobject.inc b/lcl/interfaces/gtk/gtkobject.inc index 1e48e4b481..c500dcd90a 100644 --- a/lcl/interfaces/gtk/gtkobject.inc +++ b/lcl/interfaces/gtk/gtkobject.inc @@ -59,37 +59,50 @@ begin dec(n); end; - if (FDeviceContexts.Count > 0) or (FGDIObjects.Count > 0) + if (FDeviceContexts.Count > 0) then begin - WriteLN(Format('[TgtkObject.Destroy] WARNING: There are %d unreleased DCs and %d unreleased GDIObjects' ,[FDeviceContexts.Count, FGDIObjects.Count])); + WriteLN(Format('[TgtkObject.Destroy] WARNING: There are %d unreleased DCs, a detailed dump follows:' ,[FDeviceContexts.Count])); + n:=0; - write('DCs: '); + write('[TgtkObject.Destroy] DCs: '); HashItem:=FDeviceContexts.FirstHashItem; - while (n<7) and (HashItem<>nil) do begin + while (n<7) and (HashItem<>nil) do + begin write(' ',HexStr(Cardinal(HashItem^.Item),8)); HashItem:=HashItem^.Next; inc(n); end; writeln(); - n:=0; - write('GDIOs:'); - HashItem:=FGDIObjects.FirstHashItem; - for GDIType := Low(GDIType) to High(GDIType) do - GDITypeCount[GDIType] := 0; - while (HashItem<>nil) do begin - if n<7 then write(' ',HexStr(Cardinal(HashItem^.Item),8)); - Inc(GDITypeCount[PGdiObject(HashItem^.Item)^.GDIType]); - HashItem:=HashItem^.Next; - inc(n); - end; - writeln(); + end; + + if (FGDIObjects.Count > 0) + then begin + WriteLN(Format('[TgtkObject.Destroy] WARNING: There are %d unreleased GDIObjects, a detailed dump follows:' ,[FGDIObjects.Count])); for GDIType := Low(GDIType) to High(GDIType) do begin - if GDITypeCount[GDIType] > 0 - then WriteLN(Format('[TgtkObject.Destroy] %s: %d', - [GDITYPENAME[GDIType], GDITypeCount[GDIType]])); - end + for GDIType := Low(GDIType) to High(GDIType) do + GDITypeCount[GDIType] := 0; + + n:=0; + write('[TgtkObject.Destroy] GDIOs:'); + HashItem := FGDIObjects.FirstHashItem; + while (HashItem <> nil) do + begin + if n < 7 + then write(' ',HexStr(Cardinal(HashItem^.Item),8)); + + Inc(GDITypeCount[PGdiObject(HashItem^.Item)^.GDIType]); + HashItem := HashItem^.Next; + Inc(n); + end; + Writeln(); + + for GDIType := Low(GDIType) to High(GDIType) do + if GDITypeCount[GDIType] > 0 + then WriteLN(Format('[TgtkObject.Destroy] %s: %d', [GDITYPENAME[GDIType], GDITypeCount[GDIType]])); + end; end; + if FMessageQueue.Count > 0 then begin WriteLN(Format('[TgtkObject.Destroy] WARNING: There are %d messages left in the queue! I''ll free them' ,[FMessageQueue.Count])); @@ -1858,7 +1871,28 @@ begin csMemo : begin - // Assert(False, 'Trace:Creating a MEMO...'); + P := gtk_scrolled_window_new(nil, nil); + TempWidget := gtk_text_new(nil, nil); + gtk_text_set_editable (PGtkText(TempWidget), not (Sender as TMemo).ReadOnly); + gtk_text_set_word_wrap(PGtkText(TempWidget), Integer((Sender as TCustomMemo).WordWrap)); + gtk_widget_show(TempWidget); + + gtk_container_add(p, TempWidget); + case (Sender as TCustomMemo).Scrollbars of + ssHorizontal: gtk_scrolled_window_set_policy(p, GTK_POLICY_ALWAYS, GTK_POLICY_NEVER); + ssVertical: gtk_scrolled_window_set_policy(p, GTK_POLICY_NEVER, GTK_POLICY_ALWAYS); + ssBoth: gtk_scrolled_window_set_policy(p, GTK_POLICY_ALWAYS, GTK_POLICY_ALWAYS); + else + gtk_scrolled_window_set_policy(p, GTK_POLICY_NEVER, GTK_POLICY_NEVER); + end; + + //-------------------------- + // MWE: will be obsoleted + SetCoreChildWidget(p, TempWidget); + //-------------------------- + GetWidgetInfo(p, True)^.ImplementationWidget := TempWidget; + +(* // Assert(False, 'Trace:Creating a MEMO...'); P := gtk_hbox_new(false, 0); TempWidget := gtk_text_new(nil,nil); gtk_text_set_editable (PGtkText(TempWidget), not (Sender as TMemo).ReadOnly); @@ -1873,15 +1907,23 @@ begin GetWidgetInfo(p, True)^.ImplementationWidget := 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; + if (Sender as TCustomMemo).Scrollbars in [ssVertical, ssBoth] + then begin + TempWidget := gtk_vscrollbar_new(PGtkText(TempWidget)^.vadj); + gtk_box_pack_start(PGtkBox(P), TempWidget, false, false, 0); + gtk_widget_show(TempWidget); + SetMainWidget(p, TempWidget); end; +{ + if (Sender as TCustomMemo).Scrollbars in [ssHorizontal, ssBoth] + then begin + TempWidget := gtk_hscrollbar_new(PGtkText(TempWidget)^.hadj); + gtk_box_pack_start(PGtkBox(P), TempWidget, false, false, 0); + gtk_widget_show(TempWidget); + SetMainWidget(p, TempWidget); + end; +} +*) gtk_widget_show(P); end; @@ -2775,6 +2817,11 @@ end; { ============================================================================= $Log$ + Revision 1.42 2001/03/27 21:12:54 lazarus + MWE: + + Turned on longstrings + + modified memotest to add lines + Revision 1.41 2001/03/27 14:27:43 lazarus Changes from Nagy Zsolt Shane diff --git a/lcl/stdctrls.pp b/lcl/stdctrls.pp index 02622be99f..00336361bf 100644 --- a/lcl/stdctrls.pp +++ b/lcl/stdctrls.pp @@ -28,7 +28,7 @@ Detailed description of the Unit. unit stdctrls; {$mode objfpc} -{$H+} +{$LONGSTRINGS ON} interface uses vclglobals, classes, sysutils, Graphics, LMessages, Controls, forms; @@ -570,6 +570,11 @@ end. { ============================================================================= $Log$ + Revision 1.14 2001/03/27 21:12:53 lazarus + MWE: + + Turned on longstrings + + modified memotest to add lines + Revision 1.13 2001/02/02 14:23:38 lazarus Start of code completion code. Shane