* colortxt added

fv/Makefile

@@ -179,12 +179,12 @@ else
 UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
 endif
 PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra)
-override PACKAGE_NAME=fvision
+override PACKAGE_NAME=fv
 override PACKAGE_VERSION=1.0.5
 override TARGET_UNITS+=buildfv
+override TARGET_IMPLICITUNITS+=app callspec colortxt dialogs drivers editors fileio fvcommon fvconsts gadgets histlist inplong memory menus msgbox resource statuses stddlg tabs time validate views gfvgraph
 override TARGET_EXAMPLEDIRS+=test
-override CLEAN_UNITS+=$(subst $(PPUEXT),,$(wildcard *$(PPUEXT)))
-override INSTALL_UNITS+=$(subst $(PPUEXT),,$(wildcard *$(PPUEXT)))
+override INSTALL_BUILDUNIT=buildfv
 override INSTALL_FPCPACKAGE=y
 override COMPILER_TARGETDIR+=.
 ifdef REQUIRE_UNITSDIR
@@ -925,7 +925,7 @@ ifdef INSTALL_UNITS
 override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS))
 endif
 ifdef INSTALL_BUILDUNIT
-override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT),$(INSTALLPPUFILES))
+override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES))
 endif
 ifdef INSTALLPPUFILES
 override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))

fv/Makefile.fpc

@@ -3,11 +3,15 @@
 #
 
 [package]
-name=fvision
+name=fv
 version=1.0.5
 
 [target]
 units=buildfv
+implicitunits=app callspec colortxt dialogs drivers editors fileio \
+              fvcommon fvconsts gadgets histlist inplong memory \
+              menus msgbox resource statuses stddlg tabs time validate \
+              views gfvgraph
 exampledirs=test
 
 [libs]
@@ -18,12 +22,9 @@ libversion=1.0
 targetdir=.
 
 [install]
-units=$(subst $(PPUEXT),,$(wildcard *$(PPUEXT)))
+buildunit=buildfv
 fpcpackage=y
 
-[clean]
-units=$(subst $(PPUEXT),,$(wildcard *$(PPUEXT)))
-
 [default]
 fpcdir=..
 

fv/buildfv.pas

@@ -25,6 +25,7 @@ uses
   stddlg,
 
   tabs,
+  colortxt,
   statuses,
   histlist,
   inplong,
@@ -37,7 +38,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.2  2001-08-05 02:03:13  peter
+  Revision 1.3  2002-01-29 22:00:33  peter
+    * colortxt added
+
+  Revision 1.2  2001/08/05 02:03:13  peter
     * view redrawing and small cursor updates
     * merged some more FV extensions
 

fv/colortxt.pas

@@ -0,0 +1,126 @@
+unit ColorTxt;
+
+{
+  TColoredText is a descendent of TStaticText designed to allow the writing
+  of colored text when color monitors are used.  With a monochrome or BW
+  monitor, TColoredText acts the same as TStaticText.
+
+  TColoredText is used in exactly the same way as TStaticText except that
+  the constructor has an extra Byte parameter specifying the attribute
+  desired.  (Do not use a 0 attribute, black on black).
+}
+
+{$i platform.inc}
+
+{$ifdef PPC_FPC}
+  {$H-}
+{$else}
+  {$F+,O+,E+,N+}
+{$endif}
+{$X+,R-,I-,Q-,V-}
+{$ifndef OS_LINUX}
+  {$S-}
+{$endif}
+
+interface
+
+uses
+  Objects, Drivers, Views, Dialogs, App;
+
+type
+  PColoredText = ^TColoredText;
+  TColoredText = object(TStaticText)
+    Attr : Byte;
+    constructor Init(var Bounds: TRect; const AText: String; Attribute : Byte);
+    constructor Load(var S: TStream);
+    function GetTheColor : byte; virtual;
+    procedure Draw; virtual;
+    procedure Store(var S: TStream);
+  end;
+
+const
+  RColoredText: TStreamRec = (
+     ObjType: 611;
+     VmtLink: Ofs(TypeOf(TColoredText)^);
+     Load:    @TColoredText.Load;
+     Store:   @TColoredText.Store
+  );
+
+implementation
+
+constructor TColoredText.Init(var Bounds: TRect; const AText: String;
+                                  Attribute : Byte);
+begin
+TStaticText.Init(Bounds, AText);
+Attr := Attribute;
+end;
+
+constructor TColoredText.Load(var S: TStream);
+begin
+TStaticText.Load(S);
+S.Read(Attr, Sizeof(Attr));
+end;
+
+procedure TColoredText.Store(var S: TStream);
+begin
+TStaticText.Store(S);
+S.Write(Attr, Sizeof(Attr));
+end;
+
+function TColoredText.GetTheColor : byte;
+begin
+if AppPalette = apColor then
+  GetTheColor := Attr
+else
+  GetTheColor := GetColor(1);
+end;
+
+procedure TColoredText.Draw;
+var
+  Color: Byte;
+  Center: Boolean;
+  I, J, L, P, Y: Sw_Integer;
+  B: TDrawBuffer;
+  S: String;
+begin
+  Color := GetTheColor;
+  GetText(S);
+  L := Length(S);
+  P := 1;
+  Y := 0;
+  Center := False;
+  while Y < Size.Y do
+  begin
+    MoveChar(B, ' ', Color, Size.X);
+    if P <= L then
+    begin
+      if S[P] = #3 then
+      begin
+        Center := True;
+        Inc(P);
+      end;
+      I := P;
+      repeat
+        J := P;
+        while (P <= L) and (S[P] = ' ') do Inc(P);
+        while (P <= L) and (S[P] <> ' ') and (S[P] <> #13) do Inc(P);
+      until (P > L) or (P >= I + Size.X) or (S[P] = #13);
+      if P > I + Size.X then
+        if J > I then P := J else P := I + Size.X;
+      if Center then J := (Size.X - P + I) div 2 else J := 0;
+      MoveBuf(B[J], S[I], Color, P - I);
+      while (P <= L) and (S[P] = ' ') do Inc(P);
+      if (P <= L) and (S[P] = #13) then
+      begin
+        Center := False;
+        Inc(P);
+        if (P <= L) and (S[P] = #10) then Inc(P);
+      end;
+    end;
+    WriteLine(0, Y, Size.X, 1, B);
+    Inc(Y);
+  end;
+end;
+
+
+end.

fvision/Makefile

@@ -179,12 +179,12 @@ else
 UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
 endif
 PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra)
-override PACKAGE_NAME=fvision
+override PACKAGE_NAME=fv
 override PACKAGE_VERSION=1.0.5
 override TARGET_UNITS+=buildfv
+override TARGET_IMPLICITUNITS+=app callspec colortxt dialogs drivers editors fileio fvcommon fvconsts gadgets histlist inplong memory menus msgbox resource statuses stddlg tabs time validate views gfvgraph
 override TARGET_EXAMPLEDIRS+=test
-override CLEAN_UNITS+=$(subst $(PPUEXT),,$(wildcard *$(PPUEXT)))
-override INSTALL_UNITS+=$(subst $(PPUEXT),,$(wildcard *$(PPUEXT)))
+override INSTALL_BUILDUNIT=buildfv
 override INSTALL_FPCPACKAGE=y
 override COMPILER_TARGETDIR+=.
 ifdef REQUIRE_UNITSDIR
@@ -925,7 +925,7 @@ ifdef INSTALL_UNITS
 override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS))
 endif
 ifdef INSTALL_BUILDUNIT
-override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT),$(INSTALLPPUFILES))
+override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES))
 endif
 ifdef INSTALLPPUFILES
 override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))

fvision/Makefile.fpc

@@ -3,11 +3,15 @@
 #
 
 [package]
-name=fvision
+name=fv
 version=1.0.5
 
 [target]
 units=buildfv
+implicitunits=app callspec colortxt dialogs drivers editors fileio \
+              fvcommon fvconsts gadgets histlist inplong memory \
+              menus msgbox resource statuses stddlg tabs time validate \
+              views gfvgraph
 exampledirs=test
 
 [libs]
@@ -18,12 +22,9 @@ libversion=1.0
 targetdir=.
 
 [install]
-units=$(subst $(PPUEXT),,$(wildcard *$(PPUEXT)))
+buildunit=buildfv
 fpcpackage=y
 
-[clean]
-units=$(subst $(PPUEXT),,$(wildcard *$(PPUEXT)))
-
 [default]
 fpcdir=..
 

fvision/buildfv.pas

@@ -25,6 +25,7 @@ uses
   stddlg,
 
   tabs,
+  colortxt,
   statuses,
   histlist,
   inplong,
@@ -37,7 +38,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.2  2001-08-05 02:03:13  peter
+  Revision 1.3  2002-01-29 22:00:33  peter
+    * colortxt added
+
+  Revision 1.2  2001/08/05 02:03:13  peter
     * view redrawing and small cursor updates
     * merged some more FV extensions
 

fvision/colortxt.pas

@@ -0,0 +1,126 @@
+unit ColorTxt;
+
+{
+  TColoredText is a descendent of TStaticText designed to allow the writing
+  of colored text when color monitors are used.  With a monochrome or BW
+  monitor, TColoredText acts the same as TStaticText.
+
+  TColoredText is used in exactly the same way as TStaticText except that
+  the constructor has an extra Byte parameter specifying the attribute
+  desired.  (Do not use a 0 attribute, black on black).
+}
+
+{$i platform.inc}
+
+{$ifdef PPC_FPC}
+  {$H-}
+{$else}
+  {$F+,O+,E+,N+}
+{$endif}
+{$X+,R-,I-,Q-,V-}
+{$ifndef OS_LINUX}
+  {$S-}
+{$endif}
+
+interface
+
+uses
+  Objects, Drivers, Views, Dialogs, App;
+
+type
+  PColoredText = ^TColoredText;
+  TColoredText = object(TStaticText)
+    Attr : Byte;
+    constructor Init(var Bounds: TRect; const AText: String; Attribute : Byte);
+    constructor Load(var S: TStream);
+    function GetTheColor : byte; virtual;
+    procedure Draw; virtual;
+    procedure Store(var S: TStream);
+  end;
+
+const
+  RColoredText: TStreamRec = (
+     ObjType: 611;
+     VmtLink: Ofs(TypeOf(TColoredText)^);
+     Load:    @TColoredText.Load;
+     Store:   @TColoredText.Store
+  );
+
+implementation
+
+constructor TColoredText.Init(var Bounds: TRect; const AText: String;
+                                  Attribute : Byte);
+begin
+TStaticText.Init(Bounds, AText);
+Attr := Attribute;
+end;
+
+constructor TColoredText.Load(var S: TStream);
+begin
+TStaticText.Load(S);
+S.Read(Attr, Sizeof(Attr));
+end;
+
+procedure TColoredText.Store(var S: TStream);
+begin
+TStaticText.Store(S);
+S.Write(Attr, Sizeof(Attr));
+end;
+
+function TColoredText.GetTheColor : byte;
+begin
+if AppPalette = apColor then
+  GetTheColor := Attr
+else
+  GetTheColor := GetColor(1);
+end;
+
+procedure TColoredText.Draw;
+var
+  Color: Byte;
+  Center: Boolean;
+  I, J, L, P, Y: Sw_Integer;
+  B: TDrawBuffer;
+  S: String;
+begin
+  Color := GetTheColor;
+  GetText(S);
+  L := Length(S);
+  P := 1;
+  Y := 0;
+  Center := False;
+  while Y < Size.Y do
+  begin
+    MoveChar(B, ' ', Color, Size.X);
+    if P <= L then
+    begin
+      if S[P] = #3 then
+      begin
+        Center := True;
+        Inc(P);
+      end;
+      I := P;
+      repeat
+        J := P;
+        while (P <= L) and (S[P] = ' ') do Inc(P);
+        while (P <= L) and (S[P] <> ' ') and (S[P] <> #13) do Inc(P);
+      until (P > L) or (P >= I + Size.X) or (S[P] = #13);
+      if P > I + Size.X then
+        if J > I then P := J else P := I + Size.X;
+      if Center then J := (Size.X - P + I) div 2 else J := 0;
+      MoveBuf(B[J], S[I], Color, P - I);
+      while (P <= L) and (S[P] = ' ') do Inc(P);
+      if (P <= L) and (S[P] = #13) then
+      begin
+        Center := False;
+        Inc(P);
+        if (P <= L) and (S[P] = #10) then Inc(P);
+      end;
+    end;
+    WriteLine(0, Y, Size.X, 1, B);
+    Inc(Y);
+  end;
+end;
+
+
+end.