tvplanit: Extended resource file (vpbasepng.res) intended for three sizes of the internally used images. Update TaskListPainter to use the icon according to the best screen resolution.

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

components/tvplanit/examples/fulldemo/demo.lpi

@@ -7,7 +7,6 @@
       <SessionStorage Value="InProjectDir"/>
       <MainUnit Value="0"/>
       <Title Value="demo"/>
-      <Scaled Value="True"/>
       <ResourceType Value="res"/>
       <UseXPManifest Value="True"/>
       <XPManifest>

components/tvplanit/examples/fulldemo/demo.lpr

@@ -13,7 +13,6 @@ uses
 {$R *.res}
 
 begin
-  Application.Scaled := True;
   RequireDerivedFormResource := True;
   Application.Initialize;
   Application.CreateForm(TDemoDM, DemoDM);

components/tvplanit/examples/fulldemo/demomain.lfm

@@ -9,7 +9,7 @@ object MainForm: TMainForm
   Menu = MainMenu1
   OnCloseQuery = FormCloseQuery
   OnCreate = FormCreate
-  LCLVersion = '1.9.0.0'
+  LCLVersion = '1.6.4.0'
   object Panel1: TPanel
     Left = 125
     Height = 576
@@ -400,7 +400,7 @@ object MainForm: TMainForm
           MaxVisibleTasks = 250
           TaskHeadAttributes.Color = clSilver
           TaskHeadAttributes.Font.Style = [fsItalic]
-          DrawingStyle = ds3d
+          DrawingStyle = dsFlat
           ShowResourceName = True
         end
       end

components/tvplanit/examples/fulldemo/demomain.pas

@@ -766,6 +766,7 @@ var
   lang: String;
   L,T, W,H: Integer;
   R: TRect;
+  n: Integer;
 begin
   ini := TMemIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
   try
@@ -822,8 +823,9 @@ begin
       CbAddressBuilder.ItemIndex := 0 else
       CbAddressBuilder.ItemIndex := CbAddressBuilder.Items.Indexof(VpControlLink1.CityStateZipFormat);
 
-    CbDrawingStyle.ItemIndex := ini.ReadInteger('Settings', 'DrawingStyle',
-      ord(dsFlat));
+    n := ini.ReadInteger('Settings', 'DrawingStyle', ord(dsFlat));
+    if (n <= 0) or (n >= ord(High(TVpDrawingStyle))) then n := 0;
+    CbDrawingStyle.ItemIndex := n;
     CbDrawingStyleChange(nil);
 
     CbAllowInplaceEditing.Checked := ini.ReadBool('Settings', 'AllowInplaceEditing',

components/tvplanit/languages/demo.de.po

@@ -251,6 +251,16 @@ msgstr "Datei"
 msgid "Help"
 msgstr "Hilfe"
 
+#: tmainform.menuitem3.caption
+msgctxt "tmainform.menuitem3.caption"
+msgid "-"
+msgstr ""
+
+#: tmainform.menuitem4.caption
+msgctxt "tmainform.menuitem4.caption"
+msgid "-"
+msgstr ""
+
 #: tmainform.mnuabout.caption
 msgid "About Visual PlanIt"
 msgstr "Über Visual PlanIt"

components/tvplanit/languages/demo.fi.po

@@ -240,6 +240,16 @@ msgstr "Tiedosto"
 msgid "Help"
 msgstr "Ohje"
 
+#: tmainform.menuitem3.caption
+msgctxt "tmainform.menuitem3.caption"
+msgid "-"
+msgstr ""
+
+#: tmainform.menuitem4.caption
+msgctxt "tmainform.menuitem4.caption"
+msgid "-"
+msgstr ""
+
 #: tmainform.mnuabout.caption
 msgid "About Visual PlanIt"
 msgstr "Tietoja Visual PlanIt:stä"

components/tvplanit/languages/demo.nl.po

@@ -245,6 +245,16 @@ msgstr "Bestand"
 msgid "Help"
 msgstr "Help"
 
+#: tmainform.menuitem3.caption
+msgctxt "tmainform.menuitem3.caption"
+msgid "-"
+msgstr ""
+
+#: tmainform.menuitem4.caption
+msgctxt "tmainform.menuitem4.caption"
+msgid "-"
+msgstr ""
+
 #: tmainform.mnuabout.caption
 msgid "About Visual PlanIt"
 msgstr "Over Visual PlanIt"

components/tvplanit/languages/demo.po

@@ -240,6 +240,16 @@ msgstr ""
 msgid "Help"
 msgstr ""
 
+#: tmainform.menuitem3.caption
+msgctxt "TMAINFORM.MENUITEM3.CAPTION"
+msgid "-"
+msgstr ""
+
+#: tmainform.menuitem4.caption
+msgctxt "tmainform.menuitem4.caption"
+msgid "-"
+msgstr ""
+
 #: tmainform.mnuabout.caption
 msgid "About Visual PlanIt"
 msgstr ""

components/tvplanit/languages/demo.ru.po

@@ -254,6 +254,16 @@ msgstr "Файл"
 msgid "Help"
 msgstr "Справка"
 
+#: tmainform.menuitem3.caption
+msgctxt "tmainform.menuitem3.caption"
+msgid "-"
+msgstr ""
+
+#: tmainform.menuitem4.caption
+msgctxt "tmainform.menuitem4.caption"
+msgid "-"
+msgstr ""
+
 #: tmainform.mnuabout.caption
 msgid "About Visual PlanIt"
 msgstr "О Visual PlanIt"

components/tvplanit/readme.txt

@@ -132,7 +132,7 @@ steps:
   
   
 4.4 Current development version (1.07)
-  - ...
+  - Improved integration of the LCL scaling of Lazarus 1.8
   
   
 ==============================================

components/tvplanit/source/vpbase.pas

@@ -371,6 +371,7 @@ type
 implementation
 
 {$R vpbase.res}
+{$R vpbasepng.res}
 
 uses
 {$IFNDEF LCL}

components/tvplanit/source/vpmisc.pas

@@ -161,8 +161,6 @@ function GranularityToStr(Gran: TVpGranularity): string;
 
 function TaskPriorityToStr(APriority: TVpTaskPriority): String;
 
-//function AutoHeight(ARadioGroup: TRadioGroup): Integer;
-//function GetButtonWidth(AButton: TButton): Integer;
 function GetLabelWidth(ALabel: TLabel): Integer;
 function GetRealFontHeight(AFont: TFont): Integer;
 
@@ -174,6 +172,9 @@ procedure AddResourceGroupMenu(AMenu: TMenuItem; AResource: TVpResource;
   AEventHandler: TNotifyEvent);
 function OverlayPatternToBrushStyle(APattern: TVpOverlayPattern): TBrushStyle;
 
+function CreatePngFromResourceName(AResName: String): TPortableNetworkGraphic;
+  { Load a png picture from a resource (Note: OS resource, not vp resource! }
+
 procedure Unused(const A1); overload;
 procedure Unused(const A1, A2); overload;
 procedure Unused(const A1, A2, A3); overload;
@@ -793,19 +794,6 @@ begin
   end;
 end;
 
-(*
-function AutoHeight(ARadioGroup: TRadioGroup): Integer;
-var
-  w: Integer;
-begin
-  w := ARadioGroup.Width;
-  ARadioGroup.AutoSize := true;
-  Result := ARadioGroup.Height;
-  ARadioGroup.AutoSize := false;
-  ARadioGroup.Width := w;
-end;
-*)
-
 function GetLabelWidth(ALabel: TLabel): Integer;
 var
   canvas: TControlCanvas;
@@ -817,20 +805,6 @@ begin
   canvas.Free;
 end;
 
-(*
-function GetButtonWidth(AButton: TButton): Integer;
-const
-  MARGIN = 24;
-var
-  canvas: TControlCanvas;
-begin
-  canvas := TControlCanvas.Create;
-  canvas.Control := AButton;
-  canvas.Font.Assign(AButton.Font);
-  Result := canvas.TextWidth(AButton.Caption) + MARGIN * Screen.PixelsPerInch div DesignTimeDPI;
-  canvas.Free;
-end;
-  *)
 function GetRealFontHeight(AFont: TFont): Integer;
 begin
   if AFont.Size = 0 then
@@ -943,6 +917,23 @@ begin
   Result := TBrushStyle(APattern);
 end;
 
+function CreatePngFromResourceName(AResName: String): TPortableNetworkGraphic;
+var
+  stream: TResourceStream;
+begin
+  Result := TPortableNetworkGraphic.Create;
+  try
+    stream := TResourceStream.Create(HINSTANCE, AResName, RT_RCDATA);
+    try
+      Result.LoadFromStream(stream);
+    finally
+      stream.Free;
+    end;
+  except
+    FreeAndNil(Result);
+  end;
+end;
+
 {$PUSH}{$HINTS OFF}
 procedure Unused(const A1);
 begin

components/tvplanit/source/vptasklistpainter.pas

@@ -5,7 +5,7 @@ unit VpTasklistPainter;
 interface
 
 uses
-  SysUtils, LCLType, LCLIntf, LCLVersion,
+  SysUtils, LCLType, LCLIntf,
   Classes, Graphics, Types,
   VpConst, VpBase, VpTaskList, VpBasePainter;
 
@@ -16,7 +16,6 @@ type
 
     // local parameters of the old TVpTaskList method
     HeadRect: TRect;
-    Bmp: Graphics.TBitmap;
     RowHeight: Integer;
     RealColor: TColor;
     BackgroundSelHighlight: TColor;
@@ -55,6 +54,7 @@ type
 implementation
 
 uses
+  Forms,
   VpData, VpMisc, VpCanvasUtils, VpSR;
 
 type
@@ -90,16 +90,23 @@ var
   dx, dy: Integer;
   tm: Integer;   // Scaled text margin;
   d2: Integer;   // 2*Scale
+  d1px, d2px, d3px: Integer;
 begin
-  tm := Round(Textmargin * Scale);
+  if Scale > 1 then
+    tm := Round(TextMargin * Scale) else
+    tm := ScaleY(Textmargin, DesigntimeDPI);
+  d1px := ScaleY(1, DesigntimeDPI);
+  d2px := ScaleY(2, DesigntimeDPI);
+  d3px := ScaleY(3, DesigntimeDPI);
 
   X := Rec.Left + tm;
   Y := Rec.Top + tm;
-  W := RowHeight - tm * 2;    // correct: The checkbox is square, its width is determined by the row height
+  W := RowHeight - tm * 2;
+    // correct: The checkbox is square, its width is determined by the row height
 
   { draw check box }
   case FTaskList.DrawingStyle of
-    dsFlat:
+    dsFlat, dsNoBorder:
       begin
         RenderCanvas.Brush.Color := RealCheckBgColor;
         RenderCanvas.Pen.Color := RealCheckBoxColor;
@@ -136,11 +143,11 @@ begin
   end;
 
   { build check rect }
+  if Scale > 1 then begin
     d2 := Round(2*Scale);
-  if Scale > 1 then
     CR := Rect(X + d2, Y + d2, X + W - d2, Y + W - d2)
-  else
-    CR := Rect(X + 3, Y + 3, X + W - 3, Y + W - 3);
+  end else
+    CR := Rect(X + d3px, Y + d3px, X + W - d3px, Y + W - d3px);
   if Checked then begin
     RenderCanvas.Pen.Color := RealCheckColor;
     // Instead of using Pen.Width = 3 we paint 3x - looks better
@@ -178,6 +185,16 @@ begin
             TPSMoveTo(RenderCanvas, Angle, RenderIn, CR.Left, CR.Bottom-dy+1);
             TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Left+dx, CR.Bottom+1);
             TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Right, CR.Top);
+
+            if Screen.PixelsPerInch > 120 then begin
+              TPSMoveTo(RenderCanvas, Angle, RenderIn, CR.Left+2,  CR.Bottom-dy);
+              TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Left+dx, CR.Bottom-2);
+              TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Right-2, CR.Top-1);
+
+              TPSMoveTo(RenderCanvas, Angle, RenderIn, CR.Left, CR.Bottom-dy+2);
+              TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Left+dx, CR.Bottom+2);
+              TPSLineTo(RenderCanvas, Angle, RenderIn, CR.Right, CR.Top);
+            end;
           end;
         end;
     end;
@@ -213,7 +230,9 @@ var
   GlyphRect: TRect;
   HeadStr: string;
   delta: Integer;
-  w, h: Integer;
+  w, h, h0: Integer;
+  bmp: TBitmap;
+  png: TPortableNetworkGraphic;
 begin
   RenderCanvas.Brush.Color := TaskHeadAttrColor;
   RenderCanvas.Font.Assign(FTaskList.TaskHeadAttributes.Font);
@@ -246,16 +265,30 @@ begin
       end;
   end;
 
-  if FTaskList.ShowIcon then begin
   { Draw the glyph }
-    Bmp := Graphics.TBitmap.Create;
+  if FTaskList.ShowIcon then begin
+    h0 := HeightOf(HeadRect) - 2;
+    if h0 >= 32 then
+      png := CreatePngFromResourceName('VPCHECKPAD32')
+    else if h0 >= 24 then
+      png := CreatePngFromResourceName('VPCHECKPAD24')
+    else
+      png := CreatePngFromResourceName('VPCHECKPAD16');
     try
-      Bmp.LoadFromResourceName(HINSTANCE, 'VPCHECKPAD'); //soner changed: Bmp.Handle := LoadBaseBitmap('VPCHECKPAD');
-      if Bmp.Height > 0 then begin
-        w := Round(Bmp.Width * Scale);
-        h := Round(Bmp.Height * Scale);
+      if png.Height > 0 then begin
+        bmp := TBitmap.Create;
+        try
+          bmp.PixelFormat := pf32Bit;
+          bmp.Width := png.Width;
+          bmp.Height := png.Height;
+          bmp.Canvas.Brush.color := clWhite;
+          bmp.Canvas.FillRect(Rect(0, 0, bmp.Width, bmp.Height));
+          bmp.Canvas.Draw(0, 0, png);
 
-        GlyphRect.TopLeft := Point(HeadRect.Left + TextMargin, HeadRect.Top + TextMargin);
+          w := Round(bmp.Width * Scale);
+          h := Round(bmp.Height * Scale);
+
+          GlyphRect.TopLeft := Point(HeadRect.Left + TextMargin, (Headrect.Top + HeadRect.Bottom - h) div 2);
           GlyphRect.BottomRight := Point(GlyphRect.Left + w, GlyphRect.Top + h);
 
           {$IFDEF FPC}
@@ -263,22 +296,14 @@ begin
           {$ENDIF}
 
           TPSStretchDraw(RenderCanvas, Angle, RenderIn, GlyphRect, Bmp);
-        {
-        RenderCanvas.BrushCopy(
-          TPSRotateRectangle(Angle, RenderIn, GlyphRect),
-          Bmp,
-          Rect(0, 0, Bmp.Width, Bmp.Height),
-          Bmp.Canvas.Pixels[0, Bmp.Height-1]
-        );
-         }
-//TODO:          RenderCanvas.BrushCopy (TPSRotateRectangle (Angle, RenderIn, GlyphRect),
-//                                  Bmp, Rect(0, 0, Bmp.Width, Bmp.Height),
-//            Bmp.Canvas.Pixels[0, Bmp.Height - 1]);
-       // RenderCanvas.Draw(GlyphRect.TopLeft.x, GlyphRect.TopLeft.y, Bmp); //soner added
+
           HeadRect.Left := HeadRect.Left + w + TextMargin;
+        finally
+          bmp.Free;
+        end;
       end;
     finally
-      Bmp.Free;
+      png.Free;
     end;
   end;