tvplanit: Fix compilation with laz < 1.6 and fpc < 3.0. Refactor NavBar painting.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4986 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/tvplanit/examples/fulldemo/demomain.lfm

@@ -9,7 +9,7 @@ object MainForm: TMainForm
   Menu = MainMenu1
   OnCloseQuery = FormCloseQuery
   OnCreate = FormCreate
-  LCLVersion = '1.7'
+  LCLVersion = '1.4.4.0'
   object Panel1: TPanel
     Left = 120
     Height = 580

components/tvplanit/examples/fulldemo/demomain.pas

@@ -138,10 +138,17 @@ uses
  {$IFDEF WINDOWS}
   Windows,
  {$ENDIF}
-  LResources, LazFileUtils, LazUTF8, StrUtils, DateUtils, Translations,
+  LCLVersion, LResources, LazFileUtils, LazUTF8, StrUtils, DateUtils, Translations,
   IniFiles, Math, Printers,
   VpMisc, VpBase, VpPrtFmt;
 
+{$UNDEF UTF8_CALLS}
+{$IFDEF LCL}
+  {$IF lcl_fullversion >= 3000000}
+     {$DEFINE UTF8_CALLS}
+  {$ENDIF}
+{$ENDIF}
+
 const
   LANGUAGE_DIR = '..\..\languages\';
 
@@ -223,7 +230,11 @@ begin
   LCID := LangToLCID(ALang);
 
   // Now we update the format settings to the new language
+  {$IFDEF UTF8_CALLS}
   GetLocaleFormatSettingsUTF8(LCID, DefaultFormatSettings);
+  {$ELSE}
+  GetLocaleFormatSettings(LCID, DefaultFormatSettings);
+  {$ENDIF}
  {$ENDIF}
 end;
 
@@ -484,7 +495,8 @@ begin
     end;
 
     CbLanguages.Items.Assign(po);
-    SetLanguage(GetDefaultLang);
+    SetLanguage(lang);
+//    SetLanguage(GetDefaultLang);
 
   finally
     po.Free;
@@ -566,7 +578,7 @@ begin
     if h < 160 then h := 160;
     VpMonthView1.Height := h;
 
-    lang := ini.ReadString('Settings', 'Language', GetDefaultLang);
+    lang := ini.ReadString('Settings', 'Language', ''); //GetDefaultLang);
     SetLanguage(lang);
 
     SetActiveView(ini.ReadInteger('Settings', 'ActiveView', 0));

components/tvplanit/source/laz_visualplanit.lpk

@@ -30,7 +30,7 @@ Portions created by TurboPower Software Inc. are Copyright (C) 2002 TurboPower S
 
 Contributor(s): "/>
     <Version Major="1" Release="4"/>
-    <Files Count="74">
+    <Files Count="75">
       <Item1>
         <Filename Value="vpalarmdlg.lfm"/>
         <Type Value="LFM"/>
@@ -328,6 +328,10 @@ Contributor(s): "/>
         <Filename Value="vpxmlds.pas"/>
         <UnitName Value="VpXmlDs"/>
       </Item74>
+      <Item75>
+        <Filename Value="vpnavbarpainter.pas"/>
+        <UnitName Value="VpNavBarPainter"/>
+      </Item75>
     </Files>
     <i18n>
       <EnableI18N Value="True"/>

components/tvplanit/source/vpevnteditdlg.pas

@@ -35,7 +35,7 @@ interface
 
 uses
   {$IFDEF LCL}
-  LCLProc, LCLType, LCLIntf, LResources, EditBtn,
+  LCLProc, LCLType, LCLIntf, LResources, LCLVersion, EditBtn,
   {$ELSE}
   Windows, Messages, Mask,
   {$ENDIF}
@@ -43,6 +43,15 @@ uses
   Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, ComCtrls, Buttons,
   VpData, VpBase, VpBaseDS, VpDlg, VpConst; //VpEdPop,
 
+const
+ blabla = 1;  // to make the $IF work in Laz 1.4.4. Why?
+{$UNDEF NEW_TIME_EDIT}
+{$IFDEF LCL}
+  {$IF lcl_fullversion >= 3000000}
+    {$DEFINE NEW_TIME_EDIT}
+  {$ENDIF}
+{$ENDIF}
+
 type
   { forward declarations }
   TVpEventEditDialog = class;
@@ -114,13 +123,12 @@ type
     procedure FormShow(Sender: TObject);
 
   private { Private declarations }
-   {$IFDEF LCL}
+   {$IFDEF NEW_TIME_EDIT}
     StartTime: TTimeEdit;
     EndTime: TTimeEdit;
-   {$ENDIF}
+   {$ELSE}
-   {$IFDEF DELPHI}
+    StartTime: TCombobox;
-    StartTime: TComboBox;
+    EndTime: TCombobox;
-    EndTime: TComboBox;
    {$ENDIF}
     FDatastore: TVpCustomDatastore;
     AAVerifying: Boolean;
@@ -168,7 +176,7 @@ type
 implementation
 
 uses
-  Math,
+  Math, DateUtils,
   VpSR, VpMisc, VpWavDlg;
 
 {$IFDEF LCL}
@@ -202,11 +210,11 @@ end;
 
 procedure TDlgEventEdit.FormCreate(Sender: TObject);
 begin
- {$IFDEF LCL}
+ {$IFDEF NEW_TIME_EDIT}
   StartTime := TTimeEdit.Create(self);
  {$ELSE}
   StartTime := TCombobox.Create(self);
-  StartTime.Width := 93;
+  StartTime.Width := 83;
   StartTime.ItemIndex := -1;
  {$ENDIF}
   StartTime.Parent := AppointmentGroupbox;
@@ -214,7 +222,7 @@ begin
   StartTime.Top := StartDate.Top;
   StartTime.TabOrder:= StartDate.TabOrder+ 1;
 
- {$IFDEF LCL}
+ {$IFDEF NEW_TIME_EDIT}
   EndTime := TTimeEdit.Create(self);
  {$ELSE}
   EndTime := TCombobox.Create(self);
@@ -255,17 +263,27 @@ var
   res: Integer;
   tStart, tEnd: TDateTime;
 begin
+ {$IFDEF NEW_TIME_EDIT}
   tStart := trunc(StartDate.Date) + frac(StartTime.Time);
   tEnd := trunc(EndDate.Date) + frac(EndTime.Time);
+ {$ELSE}
+  tStart := trunc(StartDate.Date) + StrToTime(StartTime.Text);
+  tEnd := trunc(EndDate.Date) + StrToTime(EndTime.Text);
+ {$ENDIF}
 
   if (tStart > tEnd) then begin
     res := MessageDlg(RSStartEndTimeError,
       mtConfirmation, [mbYes, mbNo], 0);
     if res = mrYes then begin
       StartDate.Date := trunc(tEnd);
-      StartTime.Time := frac(tEnd);
       EndDate.Date := trunc(tStart);
-      EndTime.Time := frac(tStart);
+     {$IFDEF NEW_TIME_EDIT}
+      StartTime.Time := TimeOf(tEnd);
+      EndTime.Time := timeOf(tStart);
+     {$ELSE}
+      StartTime.Text := FormatDateTime('hh:nn', TimeOf(tEnd));
+      EndTime.Text := FormatDateTime('hh:nn', TimeOf(tStart));
+     {$ENDIF}
     end else
       exit;
   end;
@@ -323,13 +341,13 @@ begin
   StartDate.Date := trunc(Event.StartTime);
   EndDate.Date := trunc(Event.EndTime);
   RepeatUntil.Date := trunc(Event.RepeatRangeEnd);
-  {$IFDEF LCL}
+ {$IFDEF NEW_TIME_EDIT}
   StartTime.Time := frac(Event.StartTime);
   EndTime.Time := frac(Event.EndTime);
-  {$ELSE}
+ {$ELSE}
-  StartTime.Text := FormatDateTime('hh:nn',Event.StartTime);
+  StartTime.Text := FormatDateTime('hh:nn', Event.StartTime);
-  EndTime.Text := FormatDateTime('hh:nn',Event.EndTime);
+  EndTime.Text := FormatDateTime('hh:nn', Event.EndTime);
-  {$ENDIF}
+ {$ENDIF}
 
   CBAllDay.Checked := Event.AllDayEvent;
   AlarmWavPath := Event.DingPath;
@@ -367,13 +385,13 @@ end;
 procedure TDlgEventEdit.DePopulateDialog;
 begin
   { Events }
-  {$IFDEF LCL}
+ {$IFDEF NEW_TIME_EDIT}
   Event.StartTime := StartDate.Date + StartTime.Time;
   Event.EndTime := EndDate.Date + EndTime.Time;
-  {$ELSE}
+ {$ELSE}
   Event.StartTime := StartDate.Date + StrToTime(StartTime.Text);
   Event.EndTime := EndDate.Date + StrToTime(EndTime.Text);
-  {$ENDIF}
+ {$ENDIF}
   Event.RepeatRangeEnd := RepeatUntil.Date;
   Event.Description := DescriptionEdit.Text;
   Event.Location := LocationEdit.Text;
@@ -389,14 +407,14 @@ begin
 end;
 
 procedure TDlgEventEdit.PopLists;
-{$IFDEF DELPHI}
+{$IFNDEF NEW_TIME_EDIT}
 var
   StringList: TStringList;
   I, Hour, Minute: Integer;
   MinStr, AMPMStr: string;
 {$ENDIF}
 begin
- {$IFDEF DELPHI}      // No longer needed for Lazarus using a TTimeEdit now.
+ {$IFNDEF NEW_TIME_EDIT}      // No longer needed for Lazarus using a TTimeEdit now.
  { Time Lists }
   StringList := TStringList.Create;
   try

components/tvplanit/source/vpnavbar.pas

@@ -28,6 +28,8 @@
 
 {$I vp.inc}
 
+{$DEFINE PAINTER}
+
 unit VpNavBar;
 
 interface
@@ -85,8 +87,9 @@ type
     destructor Destroy; override;
     property Folder: TVpNavFolder read FFolder;
     procedure Assign(Source: TPersistent); override;
-    property IconRect: TRect read FIconRect;
+    property DisplayName: String read liDisplayName write liDisplayName;  // wp: needed by painter
-    property LabelRect: TRect read FLabelRect;
+    property IconRect: TRect read FIconRect write FIconRect;     // wp: Setter needed by painter
+    property LabelRect: TRect read FLabelRect write FLabelRect;  // wp: Setter needed by painter
   published
     property Caption: string read FCaption write SetCaption;
     property Description: string read FDescription write FDescription;
@@ -133,6 +136,8 @@ type
     property Items[Index: Integer]: TVpNavBtnItem read GetItem;
     property ItemCount: Integer read GetItemCount;
     property ContainerIndex: Integer read FContainerIndex write FContainerIndex;
+    property DisplayName: String read lfDisplayName;  // made public for painter
+    property Rect: TRect read lfRect write lfRect;    // made public for painter
 
   published
     property Caption: string read FCaption write SetCaption;
@@ -448,6 +453,10 @@ type
 
 implementation
 
+uses
+  Themes,
+  VpNavBarPainter;
+
 {DrawNavTab - returns the usable text area inside the tab rect.}
 function DrawNavTab(Canvas: TCanvas; const Client: TRect; BevelWidth: Integer;
   TabColor: TColor; TabNumber: Integer; CoolTab, IsFocused, IsMouseOver: Boolean): TRect;
@@ -1455,91 +1464,6 @@ begin
 end;
 {=====}
 
-{ Given a string, and a rectangle, find the string that can be displayed
-  using two lines. Add ellipsis to the end of each line if necessary and
-  possible}
-function GetLargeIconDisplayName(Canvas: TCanvas; Rect: TRect;
-  const Name: string): string;
-var
-  TestRect: TRect;
-  SH, DH: Integer;
-  Buf: array[0..255] of Char;
-  I: Integer;
-  TempName: string;
-  Temp2: string;
-begin
-  TempName := Trim(Name);
-  {get single line height}
-  with TestRect do begin
-    Left := 0;
-    Top := 0;
-    Right := 1;
-    Bottom := 1;
-  end;
-  SH := DrawText(Canvas.Handle, 'W W', 3, TestRect, DT_SINGLELINE or DT_CALCRECT);
-
-  {get double line height}
-  with TestRect do begin
-    Left := 0;
-    Top := 0;
-    Right := 1;
-    Bottom := 1;
-  end;
-  DH := DrawText(Canvas.Handle, 'W W', 3, TestRect, DT_WORDBREAK or DT_CALCRECT);
-
-  {see if the text can fit within the existing rect without growing}
-  TestRect := Rect;
-  StrPLCopy(Buf, TempName, 255);
-  DrawText(Canvas.Handle, Buf, Length(TempName), TestRect, DT_WORDBREAK or DT_CALCRECT);
-  I := Pos(' ', TempName);
-  if (RectHeight(TestRect) = SH) or (I < 2) then
-    Result := GetDisplayString(Canvas, TempName, 1, RectWidth(Rect))
-  else begin
-    {the first line only has ellipsis if there's only one word on it and
-    that word won't fit}
-    Temp2 := GetDisplayString(Canvas, Copy(TempName, 1, I-1), 1, RectWidth(Rect));
-    if CompareStr(Temp2, Copy(TempName, 1, I-1)) <> 0 then begin
-      Result := GetDisplayString(Canvas, Copy(TempName, 1, I-1), 1, RectWidth(Rect)) + ' ' +
-        GetDisplayString(Canvas, Copy(TempName, I+1, Length(TempName) - I), 1, RectWidth(Rect));
-    end else begin
-      {2 or more lines, and the first line isn't getting an ellipsis}
-      if (RectHeight(TestRect) = DH) and (RectWidth(TestRect) <= RectWidth(Rect)) then
-        {it will fit}
-        Result := TempName
-      else begin
-        {it won't fit, but the first line wraps OK - 2nd line needs an ellipsis}
-        TestRect.Right := Rect.Right + 1;
-        while (RectWidth(TestRect) > RectWidth(Rect)) or (RectHeight(TestRect) > DH) do
-        begin
-          if Length(TempName) > 1 then begin
-            TestRect := Rect;
-            Delete(TempName, Length(TempName), 1);
-            TempName := Trim(TempName);
-            StrPLCopy(Buf, TempName + '...', 255);
-            DrawText(Canvas.Handle, Buf, Length(TempName) + 3, TestRect, DT_WORDBREAK or DT_CALCRECT);
-            Result := TempName + '...';
-          end else begin
-            Result := TempName + '..';
-            TestRect := Rect;
-            StrPLCopy(Buf, Result, 255);
-            DrawText(Canvas.Handle, Buf, Length(Result), TestRect, DT_WORDBREAK or DT_CALCRECT);
-            if (RectWidth(TestRect) <= RectWidth(Rect)) and (RectHeight(TestRect) > DH) then
-              Break;
-            Result := TempName + '.';
-            TestRect := Rect;
-            StrPLCopy(Buf, Result, 255);
-            DrawText(Canvas.Handle, Buf, Length(Result), TestRect, DT_WORDBREAK or DT_CALCRECT);
-            if (RectWidth(TestRect) <= RectWidth(Rect)) and (RectHeight(TestRect) > DH) then
-              Break;
-            Result := TempName;
-          end;
-        end;
-      end;
-    end;
-  end;
-end;
-{=====}
-
 function TVpCustomNavBar.nabButtonRect(Index: Integer): TRect;
 begin
   Result := Folders[Index].lfRect;
@@ -2054,6 +1978,20 @@ begin
 end;
 {=====}
 
+{$IFDEF PAINTER}
+procedure TVpCustomNavBar.Paint;
+var
+  painter: TVpNavBarPainter;
+begin
+  painter := TVpNavBarPainter.Create(Self);
+  try
+    painter.Paint;
+  finally
+    painter.Free;
+  end;
+end;
+
+{$ELSE}
 procedure TVpCustomNavBar.Paint;
 var
   I, J: Integer;
@@ -2080,6 +2018,8 @@ var
   ILeft: Integer;
   IHeight: Integer;
   IWidth: integer;
+  Details: TThemedElementDetails;
+  TB: TThemedButton;
 begin
   if nabChanging then
     Exit;
@@ -2147,7 +2087,21 @@ begin
           case FDrawingStyle of
             dsDefButton:
               begin
-              {Draw regular buttons}
+                {Draw regular buttons}
+                if ThemeServices.ThemesEnabled then begin
+                  if (I = nabLastMouseOverItem) then
+                    TB := tbPushButtonHot
+                  else
+                  if (I = FHotFolder) and nabMouseDown then
+                    TB := tbPushButtonPressed
+                  else
+                    TB := tbPushButtonNormal;
+                  Details := ThemeServices.GetElementDetails(TB);
+                  ThemeServices.DrawElement(Handle, details, MyRect);
+                  TR := MyRect;
+                  InflateRect(TR, -1, -1);
+                  if I = FHotFolder then OffsetRect(TR, -1, -1);  // Focused
+                end;
 //TODO:              TR := DrawButtonFace(DrawBmp.Canvas, MyRect, 1, bsNew, False,
 //                (I = FHotFolder) and nabMouseDown, False);
               end;
@@ -2499,11 +2453,27 @@ begin
         MyRect.Bottom := CurPos + FButtonHeight;
         Folders[I].lfRect := MyRect;
         case FDrawingStyle of
-          dsDefButton : begin
+          dsDefButton :
-            {Regular Old Buttons}
+            begin
-//TODO:            TR := DrawButtonFace(DrawBmp.Canvas, MyRect, 1, bsNew, False,
+              {Regular Old Buttons}
+              if ThemeServices.ThemesEnabled then begin
+                if (I = nabLastMouseOverItem) then
+                  TB := tbPushButtonHot
+                else
+                if (I = FHotFolder) and nabMouseDown then
+                  TB := tbPushButtonPressed
+                else
+                  TB := tbPushButtonNormal;
+                Details := ThemeServices.GetElementDetails(TB);
+                ThemeServices.DrawElement(Handle, details, MyRect);
+                TR := MyRect;
+                InflateRect(TR, -1, -1);
+                if I = FHotFolder then OffsetRect(TR, -1, -1);  // Focused
+              end;
+
+            //TODO:            TR := DrawButtonFace(DrawBmp.Canvas, MyRect, 1, bsNew, False,
 //              (I = FHotFolder) and nabMouseDown, False);
-          end;
+            end;
 
           dsEtchedButton :
             begin
@@ -2683,6 +2653,7 @@ begin
       Controls[i].Invalidate;
   end;
 end;
+{$ENDIF}
 {=====}
 
 procedure TVpCustomNavBar.SetActiveFolder(Value: Integer);

components/tvplanit/source/vpxparsr.pas

@@ -301,6 +301,9 @@ implementation
 {.$R *.RES}
 
 uses
+ {$IFDEF FPC}
+  LazUtf8,
+ {$ENDIF}
   VpMisc;
 
 
@@ -989,7 +992,7 @@ begin
        {$IFDEF DELPHI}
         Ucs4Chr := Ucs4Chr + StrToIntDef(TempChar, 0);
        {$ELSE}
-        Ucs4Chr := Ucs4Chr + StrToIntDef(UTF8Encode(TempChar), 0);
+        Ucs4Chr := Ucs4Chr + StrToIntDef(UTF16ToUTF8(TempChar), 0);
        {$ENDIF}
       end else
       if (TempChar = ';') then
@@ -998,7 +1001,7 @@ begin
        {$IFDEF DELPHI}
         msg := sIllCharInRef + QuotedStr(TempChar);
        {$ELSE}
-        msg := UTF8Decode(sIllCharInRef + QuotedStr(UTF8Encode(TempChar)));
+        msg := UTF8Decode(sIllCharInRef + QuotedStr(UTF16ToUTF8(TempChar)));
        {$ENDIF}
         raise EVpParserError.CreateError(FFilter.Line, FFilter.LinePos, msg);
       end;
@@ -1015,7 +1018,7 @@ begin
        {$IFDEF DELPHI}
         Ucs4Chr := Ucs4Chr + StrToIntDef(TempChar, 0);
        {$ELSE}
-        Ucs4Chr := Ucs4Chr + StrToIntDef(UTF8Encode(TempChar), 0);
+        Ucs4Chr := Ucs4Chr + StrToIntDef(UTF16ToUTF8(TempChar), 0);
        {$ENDIF}
       end else
       if (TempChar = ';') then
@@ -1024,7 +1027,7 @@ begin
        {$IFDEF DELPHI}
         msg := sIllCharInRef + QuotedStr(TempChar);
        {$ELSE}
-        msg := UTF8Decode(sIllCharInRef + QuotedStr(UTF8Encode(TempChar)));
+        msg := UTF8Decode(sIllCharInRef + QuotedStr(UTF16ToUTF8(TempChar)));
        {$ENDIF}
         raise EVpParserError.CreateError(FFilter.Line, FFilter.LinePos, msg);
       end;
@@ -1045,9 +1048,7 @@ begin
      ((VpPos('--', TempComment) <> 0) or
       (TempComment[Length(TempComment)] = '-')) then
     { Yes. Raise an error. }
-    raise EVpParserError.CreateError (FFilter.Line,
+    raise EVpParserError.CreateError(FFilter.Line, FFilter.LinePos, sInvalidCommentText);
-                                       FFilter.LinePos,
-                                       sInvalidCommentText);
   if Assigned(FOnComment) then
     FOnComment(self, TempComment);
 end;
@@ -1264,9 +1265,7 @@ begin
   end;
   SkipWhiteSpace(True);
   if (not IsEndDocument) then
-    raise EVpParserError.CreateError (FFilter.Line,
+    raise EVpParserError.CreateError(FFilter.Line, FFilter.LinePos, sDataAfterValDoc);
-                                       FFilter.LinePos,
-                                       sDataAfterValDoc);
 
   if Assigned(FOnEndDocument) then
     FOnEndDocument(self);
@@ -1886,7 +1885,7 @@ begin
            {$IFDEF DELPHI}
             EntRefs.Add('&' + DOMString(TempChar));
            {$ELSE}
-            EntRefs.Add('&' + UTF8Encode(TempChar));
+            EntRefs.Add('&' + UTF16ToUTF8(TempChar));
            {$ENDIF}
           except
             on E:EStringListError do begin
@@ -1963,7 +1962,7 @@ begin
        {$IFDEF DELPHI}
         msg := sInvalidName + QuotedStr(TempChar);
        {$ELSE}
-        msg := UTF8Decode(sInvalidName + QuotedStr(UTF8Encode(TempChar)));
+        msg := UTF8Decode(sInvalidName + QuotedStr(UTF16ToUTF8(TempChar)));
        {$ENDIF}
         raise EVpParserError.CreateError(FFilter.Line, FFilter.LinePos, msg);
       end;
@@ -1992,7 +1991,7 @@ begin
         if ParseCharRef = TempStr then
           Exit;
        {$ELSE}
-        if UTF8Encode(ParseCharRef) = TempStr then
+        if UTF16ToUTF8(ParseCharRef) = TempStr then
           Exit;
        {$ENDIF}
       end;
@@ -2212,7 +2211,7 @@ begin
      {$IFDEF DELPHI}
       msg := sInvEntityValue + QuotedStr(TempChr));
      {$ELSE}
-      msg := sInvEntityValue + QuotedStr(UTF8Encode(TempChr));
+      msg := sInvEntityValue + QuotedStr(UTF16ToUTF8(TempChr));
      {$ENDIF}
       raise EVpParserError.CreateError(FFilter.Line, FFilter.LinePos, msg);
     end;
@@ -2277,7 +2276,7 @@ begin
      {$IFDEF DELPHI}
       msg := sInvPubIDChar + QuotedStr(aString[i]);
      {$ELSE}
-      msg := UTF8Decode(sInvPubIDChar + QuotedStr(UTF8Encode(aString[i])));
+      msg := UTF8Decode(sInvPubIDChar + QuotedStr(UTF16ToUTF8(aString[i])));
      {$ENDIF}
       raise EVpParserError.CreateError(FFilter.Line, FFilter.LinePos, msg);
     end;