Changeset 60 for trunk/Packages/Common

Timestamp:

Nov 25, 2020, 12:14:18 PM (4 years ago)

Author:

chronos

Message:

• Modified: Updated Common package.

Location:

trunk/Packages/Common

Files:

• Common.lpk (modified) (2 diffs)
• Common.pas (modified) (2 diffs)
• Languages/UFindFile.cs.mo (deleted)
• Languages/ULanguages.po (added)
• Languages/UScaleDPI.cs.mo (deleted)
• UApplicationInfo.pas (modified) (6 diffs)
• UFormAbout.lfm (added)
• UFormAbout.lrj (added)
• UFormAbout.pas (added)
• ULanguages.pas (added)
• UMetaCanvas.pas (modified) (8 diffs)
• UTranslator.pas (added)

trunk/Packages/Common/Common.lpk

@@ -40 +40 @@
     <License Value="GNU/GPL"/>
     <Version Minor="7"/>
-    <Files Count="24">
+    <Files Count="26">
       <Item1>
         <Filename Value="StopWatch.pas"/>
@@ -147 +147 @@
         <UnitName Value="UGeometric"/>
       </Item24>
+      <Item25>
+        <Filename Value="UTranslator.pas"/>
+        <HasRegisterProc Value="True"/>
+        <UnitName Value="UTranslator"/>
+      </Item25>
+      <Item26>
+        <Filename Value="ULanguages.pas"/>
+        <UnitName Value="ULanguages"/>
+      </Item26>
     </Files>
     <i18n>

trunk/Packages/Common/Common.pas

@@ -13 +13 @@
   UJobProgressView, UXMLUtils, UApplicationInfo, USyncCounter, UListViewSort, 
   UPersistentForm, UFindFile, UScaleDPI, UTheme, UStringTable, UMetaCanvas, 
-  UGeometric, LazarusPackageIntf;
+  UGeometric, UTranslator, ULanguages, LazarusPackageIntf;
 
 implementation
@@ -29 +29 @@
   RegisterUnit('UScaleDPI', @UScaleDPI.Register);
   RegisterUnit('UTheme', @UTheme.Register);
+  RegisterUnit('UTranslator', @UTranslator.Register);
 end;
 

trunk/Packages/Common/UApplicationInfo.pas

@@ -6 +6 @@
 
 uses
-  SysUtils, Classes, Forms, URegistry, Controls;
+  SysUtils, Classes, Forms, URegistry, Controls, Graphics;
 
 type
@@ -15 +15 @@
   private
     FDescription: TCaption;
+    FIcon: TBitmap;
     FIdentification: Byte;
     FLicense: string;
@@ -33 +34 @@
   public
     constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
     property Version: string read GetVersion;
     function GetRegistryContext: TRegistryContext;
@@ -52 +54 @@
     property RegistryRoot: TRegistryRoot read FRegistryRoot write FRegistryRoot;
     property License: string read FLicense write FLicense;
+    property Icon: TBitmap read FIcon write FIcon;
   end;
 
@@ -74 +77 @@
 constructor TApplicationInfo.Create(AOwner: TComponent);
 begin
-  inherited Create(AOwner);
+  inherited;
   FVersionMajor := 1;
   FIdentification := 1;
@@ -80 +83 @@
   FRegistryKey := '\Software\' + FAppName;
   FRegistryRoot := rrKeyCurrentUser;
+  FIcon := TBitmap.Create;
+end;
+
+destructor TApplicationInfo.Destroy;
+begin
+  FreeAndNil(FIcon);
+  inherited;
 end;
 

trunk/Packages/Common/UMetaCanvas.pas

@@ -39 +39 @@
     Brush: TBrush;
     BoundingRect: TRect;
+    Rounded: TPoint;
     procedure Paint(Canvas: TCanvas); override;
     procedure Zoom(Factor: Double); override;
@@ -133 +134 @@
   public
     Objects: TObjectList;
+    procedure FillRect(const ARect: TRect); overload; override;
+    procedure FillRect(X1,Y1,X2,Y2: Integer); overload;
+    procedure RoundRect(X1, Y1, X2, Y2: Integer; RX,RY: Integer); overload; override;
+    procedure RoundRect(const Rect: TRect; RX,RY: Integer); overload;
     procedure TextOut(X,Y: Integer; const Text: String); override;
     procedure Polygon(Points: PPoint; NumPts: Integer; Winding: boolean = False); override;
@@ -152 +157 @@
 
 uses
-  UGeometric;
+  UGeometric, LCLIntf;
 
 { TCanvasPie }
@@ -340 +345 @@
   Canvas.Pen.Assign(Pen);
   Canvas.Brush.Assign(Brush);
-  Canvas.Rectangle(BoundingRect);
+
+  if Rounded <> Point(0, 0) then Canvas.RoundRect(BoundingRect, Rounded.X, Rounded.Y)
+    else Canvas.Rectangle(BoundingRect);
 end;
 
@@ -354 +361 @@
 procedure TCanvasRectangle.Move(Delta: TPoint);
 begin
-  ShiftRect(BoundingRect, Delta);
+  BoundingRect := ShiftRect(BoundingRect, Delta);
 end;
 
@@ -361 +368 @@
   Pen := TPen.Create;
   Brush := TBrush.Create;
+  Rounded := Point(0, 0);
 end;
 
@@ -547 +555 @@
 
 function TMetaCanvas.TextExtent(const Text: string): TSize;
-begin
-  Result := Size(0, 0);
+var
+  Canvas: TCanvas;
+begin
+  Canvas := TCanvas.Create;
+  Canvas.Handle := CreateCompatibleDC(0);
+  Canvas.Font.Assign(Font);
+  Result := Canvas.TextExtent(Text);
+  DeleteDC(Canvas.Handle);
+  Canvas.Free;
 end;
 
@@ -560 +575 @@
   DoLine(FPenPos.X, FPenPos.Y, X, Y);
   DoMoveTo(X, Y);
+end;
+
+procedure TMetaCanvas.FillRect(const ARect: TRect);
+begin
+  DoRectangleFill(ARect);
+end;
+
+procedure TMetaCanvas.FillRect(X1, Y1, X2, Y2: Integer);
+begin
+  FillRect(Rect(X1, Y1, X2, Y2));
+end;
+
+procedure TMetaCanvas.RoundRect(X1, Y1, X2, Y2: Integer; RX, RY: Integer);
+begin
+  RoundRect(Rect(X1, Y1, X2, Y2), RX, RY);
+end;
+
+procedure TMetaCanvas.RoundRect(const Rect: TRect; RX, RY: Integer);
+var
+  NewObj: TCanvasRectangle;
+begin
+  NewObj := TCanvasRectangle.Create;
+  NewObj.Brush.Assign(Brush);
+  NewObj.Pen.Assign(Pen);
+  NewObj.BoundingRect := Rect;
+  NewObj.Rounded := Point(RX, RY);
+  Objects.Add(NewObj);
 end;