Changeset 60 for trunk/Packages/Common


Ignore:
Timestamp:
Nov 25, 2020, 12:14:18 PM (4 years ago)
Author:
chronos
Message:
  • Modified: Updated Common package.
Location:
trunk/Packages/Common
Files:
6 added
2 deleted
4 edited

Legend:

Unmodified
Added
Removed
  • trunk/Packages/Common/Common.lpk

    r55 r60  
    4040    <License Value="GNU/GPL"/>
    4141    <Version Minor="7"/>
    42     <Files Count="24">
     42    <Files Count="26">
    4343      <Item1>
    4444        <Filename Value="StopWatch.pas"/>
     
    147147        <UnitName Value="UGeometric"/>
    148148      </Item24>
     149      <Item25>
     150        <Filename Value="UTranslator.pas"/>
     151        <HasRegisterProc Value="True"/>
     152        <UnitName Value="UTranslator"/>
     153      </Item25>
     154      <Item26>
     155        <Filename Value="ULanguages.pas"/>
     156        <UnitName Value="ULanguages"/>
     157      </Item26>
    149158    </Files>
    150159    <i18n>
  • trunk/Packages/Common/Common.pas

    r55 r60  
    1313  UJobProgressView, UXMLUtils, UApplicationInfo, USyncCounter, UListViewSort,
    1414  UPersistentForm, UFindFile, UScaleDPI, UTheme, UStringTable, UMetaCanvas,
    15   UGeometric, LazarusPackageIntf;
     15  UGeometric, UTranslator, ULanguages, LazarusPackageIntf;
    1616
    1717implementation
     
    2929  RegisterUnit('UScaleDPI', @UScaleDPI.Register);
    3030  RegisterUnit('UTheme', @UTheme.Register);
     31  RegisterUnit('UTranslator', @UTranslator.Register);
    3132end;
    3233
  • trunk/Packages/Common/UApplicationInfo.pas

    r55 r60  
    66
    77uses
    8   SysUtils, Classes, Forms, URegistry, Controls;
     8  SysUtils, Classes, Forms, URegistry, Controls, Graphics;
    99
    1010type
     
    1515  private
    1616    FDescription: TCaption;
     17    FIcon: TBitmap;
    1718    FIdentification: Byte;
    1819    FLicense: string;
     
    3334  public
    3435    constructor Create(AOwner: TComponent); override;
     36    destructor Destroy; override;
    3537    property Version: string read GetVersion;
    3638    function GetRegistryContext: TRegistryContext;
     
    5254    property RegistryRoot: TRegistryRoot read FRegistryRoot write FRegistryRoot;
    5355    property License: string read FLicense write FLicense;
     56    property Icon: TBitmap read FIcon write FIcon;
    5457  end;
    5558
     
    7477constructor TApplicationInfo.Create(AOwner: TComponent);
    7578begin
    76   inherited Create(AOwner);
     79  inherited;
    7780  FVersionMajor := 1;
    7881  FIdentification := 1;
     
    8083  FRegistryKey := '\Software\' + FAppName;
    8184  FRegistryRoot := rrKeyCurrentUser;
     85  FIcon := TBitmap.Create;
     86end;
     87
     88destructor TApplicationInfo.Destroy;
     89begin
     90  FreeAndNil(FIcon);
     91  inherited;
    8292end;
    8393
  • trunk/Packages/Common/UMetaCanvas.pas

    r55 r60  
    3939    Brush: TBrush;
    4040    BoundingRect: TRect;
     41    Rounded: TPoint;
    4142    procedure Paint(Canvas: TCanvas); override;
    4243    procedure Zoom(Factor: Double); override;
     
    133134  public
    134135    Objects: TObjectList;
     136    procedure FillRect(const ARect: TRect); overload; override;
     137    procedure FillRect(X1,Y1,X2,Y2: Integer); overload;
     138    procedure RoundRect(X1, Y1, X2, Y2: Integer; RX,RY: Integer); overload; override;
     139    procedure RoundRect(const Rect: TRect; RX,RY: Integer); overload;
    135140    procedure TextOut(X,Y: Integer; const Text: String); override;
    136141    procedure Polygon(Points: PPoint; NumPts: Integer; Winding: boolean = False); override;
     
    152157
    153158uses
    154   UGeometric;
     159  UGeometric, LCLIntf;
    155160
    156161{ TCanvasPie }
     
    340345  Canvas.Pen.Assign(Pen);
    341346  Canvas.Brush.Assign(Brush);
    342   Canvas.Rectangle(BoundingRect);
     347
     348  if Rounded <> Point(0, 0) then Canvas.RoundRect(BoundingRect, Rounded.X, Rounded.Y)
     349    else Canvas.Rectangle(BoundingRect);
    343350end;
    344351
     
    354361procedure TCanvasRectangle.Move(Delta: TPoint);
    355362begin
    356   ShiftRect(BoundingRect, Delta);
     363  BoundingRect := ShiftRect(BoundingRect, Delta);
    357364end;
    358365
     
    361368  Pen := TPen.Create;
    362369  Brush := TBrush.Create;
     370  Rounded := Point(0, 0);
    363371end;
    364372
     
    547555
    548556function TMetaCanvas.TextExtent(const Text: string): TSize;
    549 begin
    550   Result := Size(0, 0);
     557var
     558  Canvas: TCanvas;
     559begin
     560  Canvas := TCanvas.Create;
     561  Canvas.Handle := CreateCompatibleDC(0);
     562  Canvas.Font.Assign(Font);
     563  Result := Canvas.TextExtent(Text);
     564  DeleteDC(Canvas.Handle);
     565  Canvas.Free;
    551566end;
    552567
     
    560575  DoLine(FPenPos.X, FPenPos.Y, X, Y);
    561576  DoMoveTo(X, Y);
     577end;
     578
     579procedure TMetaCanvas.FillRect(const ARect: TRect);
     580begin
     581  DoRectangleFill(ARect);
     582end;
     583
     584procedure TMetaCanvas.FillRect(X1, Y1, X2, Y2: Integer);
     585begin
     586  FillRect(Rect(X1, Y1, X2, Y2));
     587end;
     588
     589procedure TMetaCanvas.RoundRect(X1, Y1, X2, Y2: Integer; RX, RY: Integer);
     590begin
     591  RoundRect(Rect(X1, Y1, X2, Y2), RX, RY);
     592end;
     593
     594procedure TMetaCanvas.RoundRect(const Rect: TRect; RX, RY: Integer);
     595var
     596  NewObj: TCanvasRectangle;
     597begin
     598  NewObj := TCanvasRectangle.Create;
     599  NewObj.Brush.Assign(Brush);
     600  NewObj.Pen.Assign(Pen);
     601  NewObj.BoundingRect := Rect;
     602  NewObj.Rounded := Point(RX, RY);
     603  Objects.Add(NewObj);
    562604end;
    563605
Note: See TracChangeset for help on using the changeset viewer.