From c3e096135d80396dc8dee242061a2126d39c9cbc Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Sun, 17 Jul 2016 10:17:24 +0000 Subject: [PATCH] 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 --- .../tvplanit/examples/fulldemo/demomain.lfm | 2 +- .../tvplanit/examples/fulldemo/demomain.pas | 18 +- .../tvplanit/source/laz_visualplanit.lpk | 6 +- components/tvplanit/source/vpevnteditdlg.pas | 62 ++++--- components/tvplanit/source/vpnavbar.pas | 155 +++++++----------- components/tvplanit/source/vpxparsr.pas | 29 ++-- 6 files changed, 138 insertions(+), 134 deletions(-) diff --git a/components/tvplanit/examples/fulldemo/demomain.lfm b/components/tvplanit/examples/fulldemo/demomain.lfm index 7dd0f3d16..b431ecaaa 100644 --- a/components/tvplanit/examples/fulldemo/demomain.lfm +++ b/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 diff --git a/components/tvplanit/examples/fulldemo/demomain.pas b/components/tvplanit/examples/fulldemo/demomain.pas index ada70e5da..b4a6fbe4a 100644 --- a/components/tvplanit/examples/fulldemo/demomain.pas +++ b/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)); diff --git a/components/tvplanit/source/laz_visualplanit.lpk b/components/tvplanit/source/laz_visualplanit.lpk index 19e1ea2be..6d0c441c2 100644 --- a/components/tvplanit/source/laz_visualplanit.lpk +++ b/components/tvplanit/source/laz_visualplanit.lpk @@ -30,7 +30,7 @@ Portions created by TurboPower Software Inc. are Copyright (C) 2002 TurboPower S Contributor(s): "/> - + @@ -328,6 +328,10 @@ Contributor(s): "/> + + + + diff --git a/components/tvplanit/source/vpevnteditdlg.pas b/components/tvplanit/source/vpevnteditdlg.pas index 677a306e0..2cc95125a 100644 --- a/components/tvplanit/source/vpevnteditdlg.pas +++ b/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} - {$IFDEF DELPHI} - StartTime: TComboBox; - EndTime: TComboBox; + {$ELSE} + StartTime: 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} - StartTime.Text := FormatDateTime('hh:nn',Event.StartTime); - EndTime.Text := FormatDateTime('hh:nn',Event.EndTime); - {$ENDIF} + {$ELSE} + StartTime.Text := FormatDateTime('hh:nn', Event.StartTime); + EndTime.Text := FormatDateTime('hh:nn', Event.EndTime); + {$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 diff --git a/components/tvplanit/source/vpnavbar.pas b/components/tvplanit/source/vpnavbar.pas index 2d3cb61a1..a49e68e6c 100644 --- a/components/tvplanit/source/vpnavbar.pas +++ b/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 LabelRect: TRect read FLabelRect; + property DisplayName: String read liDisplayName write liDisplayName; // wp: needed by painter + 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 - {Regular Old Buttons} -//TODO: TR := DrawButtonFace(DrawBmp.Canvas, MyRect, 1, bsNew, False, + dsDefButton : + begin + {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); diff --git a/components/tvplanit/source/vpxparsr.pas b/components/tvplanit/source/vpxparsr.pas index fdabed6fa..8a20680b1 100644 --- a/components/tvplanit/source/vpxparsr.pas +++ b/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, - FFilter.LinePos, - sInvalidCommentText); + raise EVpParserError.CreateError(FFilter.Line, 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, - FFilter.LinePos, - sDataAfterValDoc); + raise EVpParserError.CreateError(FFilter.Line, 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;