paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-02 19:43:15 +01:00
Code Issues Packages Projects Releases Wiki Activity

* fixes to get it working without crashes

Browse Source
This commit is contained in:
peter 1999-11-14 21:32:55 +00:00
parent 9a1b20ea20
commit f6939b9307
2 changed files with 46 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
fcl/shedit/doc_text.pp
View File

@ -110,6 +110,8 @@ uses Strings;
constructor TTextDoc.Create;
begin
FModified := false;
FLines := nil;
FLineCount := 0;
FViewInfos := TCollection.Create(TViewInfo);
end;
@ -125,7 +127,8 @@ var
begin
for i := 0 to FLineCount - 1 do
StrDispose(FLines^[i].s);
FreeMem(FLines);
if assigned(FLines) then
FreeMem(FLines);
for i := 0 to FViewInfos.Count - 1 do
if Assigned(TViewInfo(FViewInfos.Items[i]).OnLineRemove) then
@ -135,16 +138,11 @@ end;
procedure TTextDoc.InsertLine(BeforeLine: Integer; const s: String);
var
l: PLine;
NewLines: PLineArray;
i: Integer;
begin
if BeforeLine > FLineCount then exit; // *** throw an intelligent exception
GetMem(NewLines, (FLineCount + 1) * SizeOf(TLine));
Move(FLines^, NewLines^, BeforeLine * SizeOf(TLine));
Move(FLines^[BeforeLine], NewLines^[BeforeLine + 1],
(FLineCount - BeforeLine) * SizeOf(TLine));
FreeMem(FLines);
FLines := NewLines;
ReAllocMem(FLines, (FLineCount + 1) * SizeOf(TLine));
Move(FLines^[BeforeLine], FLines^[BeforeLine + 1],(FLineCount - BeforeLine) * SizeOf(TLine));
l := @(FLines^[BeforeLine]);
FillChar(l^, SizeOf(TLine), 0);
l^.len := Length(s);
@ -163,17 +161,12 @@ end;
procedure TTextDoc.RemoveLine(LineNumber: Integer);
var
NewLines: PLineArray;
i: Integer;
begin
StrDispose(FLines^[LineNumber].s);
GetMem(NewLines, (FLineCount - 1) * SizeOf(TLine));
Move(FLines^, NewLines^, LineNumber * SizeOf(TLine));
ReAllocMem(FLines, (FLineCount - 1) * SizeOf(TLine));
if LineNumber < FLineCount - 1 then
Move(FLines^[LineNumber + 1], NewLines^[LineNumber],
(FLineCount - LineNumber - 1) * SizeOf(TLine));
FreeMem(FLines);
FLines := NewLines;
Move(FLines^[LineNumber + 1], FLines^[LineNumber],(FLineCount - LineNumber - 1) * SizeOf(TLine));
Dec(FLineCount);
for i := 0 to FViewInfos.Count - 1 do
@ -263,7 +256,10 @@ end.
{
$Log$
Revision 1.1 1999-10-29 15:59:03 peter
Revision 1.2 1999-11-14 21:32:55 peter
* fixes to get it working without crashes
Revision 1.1 1999/10/29 15:59:03 peter
* inserted in fcl
}

45
fcl/shedit/gtkdemo.pp
View File

@ -1,3 +1,24 @@
{
$Id$
GTK (demo) implementation for shedit
Copyright (C) 1999 Sebastian Guenther (sguenther@gmx.de)
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
}
{$MODE objfpc}
{$H+}
@ -177,15 +198,9 @@ begin
Edit.shSelected := AddSHStyle('Selected', colWhite, colBlack, fsNormal);
end;
function TGtkSHEdit.AddSHStyle(AName: String; AColor, ABackground: LongWord;
AStyle: TSHFontStyle): Integer;
var
NewStyles: PSHStyleArray;
function TGtkSHEdit.AddSHStyle(AName: String; AColor, ABackground: LongWord; AStyle: TSHFontStyle): Integer;
begin
GetMem(NewStyles, SizeOf(TSHStyle) * (SHStyleCount + 1));
Move(SHStyles^, NewStyles^, SizeOf(TSHStyle) * SHStyleCount);
FreeMem(SHStyles);
SHStyles := NewStyles;
ReAllocMem(SHStyles, SizeOf(TSHStyle) * (SHStyleCount + 1));
Inc(SHStyleCount);
SHStyles^[SHStyleCount].Name := AName;
SHStyles^[SHStyleCount].Color := AColor;
@ -282,7 +297,7 @@ begin
SetGCColor(SHStyles^[Ord(RequestedColor)].Color);
gdk_draw_text(PGdkDrawable(GdkWnd),
Font[SHStyles^[Ord(RequestedColor)].FontStyle], GC,
px * CharW + LeftIndent, (y + 1) * CharH - 3, s, 1);
px * CharW + LeftIndent, (y + 1) * CharH - 3, s, 1);
end;
Inc(s);
Inc(i);
@ -368,8 +383,10 @@ begin
gtk_signal_connect(PGtkObject(MainWindow), 'destroy', GTK_SIGNAL_FUNC(@OnMainWindowDestroyed), nil);
// Set up documents
PasDoc := TTextDoc.Create; PasDoc.LoadFromFile('gtkdemo.pp');
XMLDoc := TTextDoc.Create; XMLDoc.LoadFromFile('gtkdemo.pp');
PasDoc := TTextDoc.Create;
PasDoc.LoadFromFile('gtkdemo.pp');
XMLDoc := TTextDoc.Create;
XMLDoc.LoadFromFile('gtkdemo.pp');
// Create notebook pages (editor widgets)
Pages[0] := TGtkSHPasEdit.Create(PasDoc);
@ -386,3 +403,9 @@ begin
gtk_widget_show(MainWindow);
gtk_main;
end.
{
$Log$
Revision 1.3 1999-11-14 21:32:55 peter
* fixes to get it working without crashes
}