paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-11 10:35:58 +02:00
Code Issues Packages Projects Releases Wiki Activity

MWE:

Browse Source 
+ Turned on longstrings
  + modified memotest to add lines

git-svn-id: trunk@244 -
This commit is contained in:
lazarus 2001-03-27 21:12:54 +00:00
parent 652e4b7903
commit 5cc0992d9c
8 changed files with 200 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

92
examples/memotest.pp
View File

@ -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);

6
lcl/controls.pp
View File

@ -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

39
lcl/include/control.inc
View File

@ -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

7
lcl/interfacebase.pp
View File

@ -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.

7
lcl/interfaces/gtk/gtkdef.pp
View File

@ -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)

6
lcl/interfaces/gtk/gtkint.pp
View File

@ -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

105
lcl/interfaces/gtk/gtkobject.inc
View File

@ -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

7
lcl/stdctrls.pp
View File

@ -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