MWE:

+ Turned on longstrings
  + modified memotest to add lines

git-svn-id: trunk@244 -

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;
+  Width := 350;
-  Height := 200;
+  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.left := 120;
-  Button1.top :=  170;
+  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.left := 175;
-  Button2.top := 170;
+  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.left := 230;
-  Button4.top := 170;
+  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 := 175;
-    Left := 145;
     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);

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
 

lcl/include/control.inc

@@ -1174,22 +1174,28 @@ procedure TControl.SetText(const Value: TCaption);
 var
   pStr : PChar;
 begin
-   if GetText <> value
+  if GetText <> value
-   then begin
+  then begin
-//  added on 3/21/2000.  Need to set FCaption otherwise those components that simply
+    //  added on 3/21/2000.  Need to set FCaption otherwise those components that simply
-//  check FCaption will always be wrong.
+    //  check FCaption will always be wrong.
     FCaption := Value;
 
-     //We shouldn't NEED to create our own PCHAR.  We should be able
+  {$IFOPT H+}
-     //to typecast VALUE as a PCHAR but it doesn't work.
+    SetTextBuf(PChar(FCaption));
-     pStr := StrAlloc(length(Value) + 1);
+  {$ELSE}
-     try
+    //We shouldn't NEED to create our own PCHAR.  We should be able
-       StrPCopy(pStr, value);
+    //to typecast VALUE as a PCHAR but it doesn't work.
-       SetTextBuf(pStr);
+    //
-     finally
+    // MWE: that's because strings were short strings
-       strDispose(pStr);
+    pStr := StrAlloc(length(Value) + 1);
-     end;
+    try
-   end;
+      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
 

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.
 

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)

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
 

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;
+  end;
-    write('GDIOs:');
+
-    HashItem:=FGDIObjects.FirstHashItem;
+  if (FGDIObjects.Count > 0)  
-    for GDIType := Low(GDIType) to High(GDIType) do 
+  then begin  
-      GDITypeCount[GDIType] := 0;
+    WriteLN(Format('[TgtkObject.Destroy] WARNING: There are %d unreleased GDIObjects, a detailed dump follows:' ,[FGDIObjects.Count]));  
-    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 
     begin
-      if GDITypeCount[GDIType] > 0 
+      for GDIType := Low(GDIType) to High(GDIType) do 
-      then WriteLN(Format('[TgtkObject.Destroy]   %s: %d',
+        GDITypeCount[GDIType] := 0;
-        [GDITYPENAME[GDIType], GDITypeCount[GDIType]]));
+        
-    end
+      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
+         if (Sender as TCustomMemo).Scrollbars in [ssVertical, ssBoth]
-         ssVertical, ssBoth:
+         then begin
-           begin
+           TempWidget := gtk_vscrollbar_new(PGtkText(TempWidget)^.vadj);
-             TempWidget := gtk_vscrollbar_new(PGtkText(TempWidget)^.vadj);
+           gtk_box_pack_start(PGtkBox(P), TempWidget, false, false, 0);
-             gtk_box_pack_start(PGtkBox(P), TempWidget, false, false, 0);
+           gtk_widget_show(TempWidget);
-             gtk_widget_show(TempWidget);
+           SetMainWidget(p, TempWidget);
-             SetMainWidget(p, TempWidget);
-           end;
          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

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