Changeset 37


Ignore:
Timestamp:
May 9, 2018, 1:22:44 PM (7 years ago)
Author:
chronos
Message:
  • Added: Multi-lingual support.
Location:
trunk
Files:
28 added
10 edited

Legend:

Unmodified
Added
Removed

  • trunk

    • Property svn:ignore

      •  

        old new  
        33lib
        44backup
         5LibrePaint.exe
         6*.lrj

  • trunk/Forms

    • Property svn:ignore set to
      *.lrj

  • trunk/Forms/UFormMain.lfm

    r36 r37  
    5252    Top = 0
    5353    Width = 920
    54     Caption = 'ToolBar1'
    5554    TabOrder = 1
    5655    object ToolButton1: TToolButton
    … …  
    6059    end
    6160    object ColorButton1: TColorButton
    62       Left = 24
    63       Height = 22
     61      Left = 30
     62      Height = 28
    6463      Top = 2
    6564      Width = 43
    … …  
    6968    end
    7069    object ToolButton2: TToolButton
    71       Left = 67
     70      Left = 73
    7271      Top = 2
    7372      Action = Core.AToolMove
    7473    end
    7574    object ToolButton3: TToolButton
    76       Left = 90
     75      Left = 102
    7776      Top = 2
    7877      Action = Core.AToolPen
    79     end
    80     object ToolButton4: TToolButton
    81       Left = 113
    82       Top = 2
    83       Caption = 'ToolButton4'
    84       OnClick = ToolButton4Click
    8578    end
    8679  end
    … …  
    161154      end
    162155    end
     156    object MenuItem24: TMenuItem
     157      Caption = 'General'
     158      object MenuItem25: TMenuItem
     159        Action = Core.ASettings
     160      end
     161    end
    163162  end
    164163  object Timer1: TTimer
    … …  
    172171    MaxCount = 10
    173172    OnChange = LastOpenedList1Change
    174     left = 292
     173    left = 304
    175174    top = 112
    176175  end

  • trunk/Forms/UFormMain.pas

    r36 r37  
    3232    MenuItem22: TMenuItem;
    3333    MenuItem23: TMenuItem;
     34    MenuItem24: TMenuItem;
     35    MenuItem25: TMenuItem;
    3436    MenuItemRecentFiles: TMenuItem;
    3537    MenuItem15: TMenuItem;
    … …  
    5052    ToolButton2: TToolButton;
    5153    ToolButton3: TToolButton;
    52     ToolButton4: TToolButton;
    5354    procedure FormActivate(Sender: TObject);
    5455    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);

  • trunk/Forms/UFormNew.lfm

    r33 r37  
    77  ClientHeight = 300
    88  ClientWidth = 497
     9  DesignTimePPI = 120
    910  OnClose = FormClose
    1011  OnCreate = FormCreate
    1112  OnShow = FormShow
    12   LCLVersion = '1.6.0.4'
     13  LCLVersion = '1.8.2.0'
    1314  object SpinEditWidth: TSpinEdit
    1415    Left = 168
    15     Height = 34
     16    Height = 28
    1617    Top = 24
    1718    Width = 122
    … …  
    2223  object Label1: TLabel
    2324    Left = 15
    24     Height = 24
     25    Height = 20
    2526    Top = 26
    26     Width = 56
     27    Width = 43
    2728    Caption = 'Width:'
    2829    ParentColor = False
    … …  
    3031  object Label2: TLabel
    3132    Left = 15
    32     Height = 24
     33    Height = 20
    3334    Top = 64
    34     Width = 62
     35    Width = 48
    3536    Caption = 'Height:'
    3637    ParentColor = False
    … …  
    3839  object SpinEditHeight: TSpinEdit
    3940    Left = 168
    40     Height = 34
     41    Height = 28
    4142    Top = 64
    4243    Width = 122
    … …  
    4748  object Label3: TLabel
    4849    Left = 15
    49     Height = 24
     50    Height = 20
    5051    Top = 104
    51     Width = 96
     52    Width = 73
    5253    Caption = 'Resolution:'
    5354    ParentColor = False
    … …  
    5556  object SpinEditDPI: TSpinEdit
    5657    Left = 168
    57     Height = 34
     58    Height = 28
    5859    Top = 104
    5960    Width = 122
    … …  
    6465  object Label4: TLabel
    6566    Left = 15
    66     Height = 24
     67    Height = 20
    6768    Top = 167
    68     Width = 105
     69    Width = 82
    6970    Caption = 'Color depth:'
    7071    ParentColor = False
    … …  
    7273  object ComboBoxColorFormat: TComboBox
    7374    Left = 167
    74     Height = 38
     75    Height = 28
    7576    Top = 157
    7677    Width = 209
    77     ItemHeight = 0
     78    ItemHeight = 20
    7879    OnChange = SpinEditWidthChange
    7980    Style = csDropDownList
    … …  
    9192  end
    9293  object Button2: TButton
    93     Left = 224
     94    Left = 232
    9495    Height = 25
    9596    Top = 256
    … …  
    101102  object Label5: TLabel
    102103    Left = 16
    103     Height = 24
     104    Height = 20
    104105    Top = 224
    105     Width = 152
     106    Width = 118
    106107    Caption = 'Memory required:'
    107108    ParentColor = False
    … …  
    109110  object LabelMemRequire: TLabel
    110111    Left = 192
    111     Height = 24
     112    Height = 20
    112113    Top = 224
    113     Width = 15
     114    Width = 12
    114115    Caption = '   '
    115116    ParentColor = False

  • trunk/LibrePaint.lpi

    r35 r37  
    1212    </General>
    1313    <i18n>
    14       <EnableI18N LFM="False"/>
     14      <EnableI18N Value="True"/>
     15      <OutDir Value="Languages"/>
    1516    </i18n>
    1617    <BuildModes Count="2">
    … …  
    2021          <Version Value="11"/>
    2122          <Target>
    22             <Filename Value="lib/$(TargetCPU)-$(TargetOS)/LibrePaint"/>
     23            <Filename Value="LibrePaint"/>
    2324          </Target>
    2425          <SearchPaths>
    2526            <IncludeFiles Value="$(ProjOutDir)"/>
    2627            <OtherUnitFiles Value="Forms"/>
    27             <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
     28            <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)-$(BuildMode)"/>
    2829          </SearchPaths>
    2930          <Parsing>
    … …  
    6364      </local>
    6465    </RunParams>
    65     <RequiredPackages Count="4">
     66    <RequiredPackages Count="5">
    6667      <Item1>
     68        <PackageName Value="CoolTranslator"/>
     69        <DefaultFilename Value="Packages/CoolTranslator/CoolTranslator.lpk" Prefer="True"/>
     70      </Item1>
     71      <Item2>
    6772        <PackageName Value="Common"/>
    6873        <DefaultFilename Value="Packages/Common/Common.lpk" Prefer="True"/>
    69       </Item1>
    70       <Item2>
     74      </Item2>
     75      <Item3>
    7176        <PackageName Value="TemplateGenerics"/>
    7277        <DefaultFilename Value="Packages/TemplateGenerics/TemplateGenerics.lpk" Prefer="True"/>
    73       </Item2>
    74       <Item3>
     78      </Item3>
     79      <Item4>
    7580        <PackageName Value="FastGraphics"/>
    7681        <DefaultFilename Value="Packages/FastGraphics/FastGraphics.lpk" Prefer="True"/>
    77       </Item3>
    78       <Item4>
     82      </Item4>
     83      <Item5>
    7984        <PackageName Value="LCL"/>
    80       </Item4>
     85      </Item5>
    8186    </RequiredPackages>
    82     <Units Count="5">
     87    <Units Count="6">
    8388      <Unit0>
    8489        <Filename Value="LibrePaint.lpr"/>
    … …  
    110115        <ResourceBaseClass Value="Form"/>
    111116      </Unit4>
     117      <Unit5>
     118        <Filename Value="Forms/UFormSettings.pas"/>
     119        <IsPartOfProject Value="True"/>
     120        <ComponentName Value="FormSettings"/>
     121        <ResourceBaseClass Value="Form"/>
     122      </Unit5>
    112123    </Units>
    113124  </ProjectOptions>
    … …  
    115126    <Version Value="11"/>
    116127    <Target>
    117       <Filename Value="lib/$(TargetCPU)-$(TargetOS)/LibrePaint"/>
     128      <Filename Value="LibrePaint"/>
    118129    </Target>
    119130    <SearchPaths>
    120131      <IncludeFiles Value="$(ProjOutDir)"/>
    121132      <OtherUnitFiles Value="Forms"/>
    122       <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
     133      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)-$(BuildMode)"/>
    123134    </SearchPaths>
    124135    <Parsing>

  • trunk/LibrePaint.lpr

    r30 r37  
    88  {$ENDIF}{$ENDIF}
    99  Interfaces, // this includes the LCL widgetset
    10   SysUtils, Forms, UCore, UProject, TemplateGenerics, Common, UFormNew,
    11   UFormMain;
     10  SysUtils, Forms, UCore, UProject, CoolTranslator, TemplateGenerics, Common,
     11  UFormNew, UFormMain, UFormSettings;
    1212
    1313{$R *.res}

  • trunk/Packages/Common/UMemory.pas

    r28 r37  
    1010type
    1111
    12   { TMemory }
    13 
    14   TMemory = class
     12  { TBlock }
     13
     14  TBlock = class
    1515  private
    1616    FData: PByte;
    1717    FSize: Integer;
    18     function GetItem(Index: Integer): Byte;
    19     procedure SetItem(Index: Integer; AValue: Byte);
    20     procedure SetSize(AValue: Integer); virtual;
    21   public
    22     procedure Clear(Value: Byte = 0);
    23     procedure Assign(Source: TMemory);
     18    function GetItem(Index: Integer): Byte; virtual; abstract;
     19    procedure SetItem(Index: Integer; AValue: Byte); virtual; abstract;
     20    procedure SetSize(AValue: Integer); virtual; abstract;
     21  public
     22    procedure ReadBlock(Block: TBlock; Position: Integer); virtual;
     23    procedure WriteBlock(Block: TBlock; Position: Integer); virtual;
     24    procedure Clear(Value: Byte = 0); virtual;
     25    procedure Assign(Source: TBlock); virtual;
     26    property Size: Integer read FSize write SetSize;
     27    property Items[Index: Integer]: Byte read GetItem write SetItem; default;
     28  end;
     29
     30  { TMemory }
     31
     32  TMemory = class(TBlock)
     33  private
     34    FData: PByte;
     35    FSize: Integer;
     36    function GetItem(Index: Integer): Byte; override;
     37    procedure SetItem(Index: Integer; AValue: Byte); override;
     38    procedure SetSize(AValue: Integer); override;
     39  public
     40    procedure Clear(Value: Byte = 0); override;
     41    procedure Assign(Source: TBlock); override;
    2442    constructor Create;
    2543    destructor Destroy; override;
    2644    property Data: PByte read FData;
    27     property Size: Integer read FSize write SetSize;
    28     property Items[Index: Integer]: Byte read GetItem write SetItem; default;
    2945  end;
    3046
    … …  
    4258  end;
    4359
     60  { TBitBlock }
     61
     62  TBitBlock = class
     63  private
     64    function GetItem(Index: Integer): Byte; virtual;
     65    function GetSize: Integer; virtual;
     66    procedure SetItem(Index: Integer; AValue: Byte); virtual;
     67    procedure SetSize(AValue: Integer); virtual;
     68  public
     69    procedure Invert; virtual;
     70    function GetInteger: Integer; virtual;
     71    procedure SetInteger(Value: Integer); virtual;
     72    procedure ReadBlock(Block: TBitBlock; Position: Integer); virtual;
     73    procedure WriteBlock(Block: TBitBlock; Position: Integer); virtual;
     74    procedure Clear(Value: Byte = 0); virtual;
     75    procedure Assign(Source: TBlock); virtual;
     76    property Size: Integer read GetSize write SetSize;
     77    property Items[Index: Integer]: Byte read GetItem write SetItem; default;
     78  end;
     79
     80  { TBitMemory }
     81
     82  TBitMemory = class(TBitBlock)
     83  private
     84    FData: PByte;
     85    FSize: Integer;
     86    function GetSize: Integer; override;
     87    procedure SetSize(AValue: Integer); override;
     88    function GetItem(Index: Integer): Byte; override;
     89    procedure SetItem(Index: Integer; AValue: Byte); override;
     90  public
     91    constructor Create;
     92    destructor Destroy; override;
     93    function GetInteger: Integer; override;
     94    procedure SetInteger(Value: Integer); override;
     95    procedure Clear(Value: Byte = 0); override;
     96    procedure ReadBlock(Block: TBitBlock; Position: Integer); override;
     97    procedure WriteBlock(Block: TBitBlock; Position: Integer); override;
     98    property Data: PByte read FData;
     99    procedure Invert; override;
     100  end;
     101
     102
    44103implementation
     104
     105{ TBitMemory }
     106
     107procedure TBitMemory.Clear(Value: Byte);
     108begin
     109  if (Size and 7) = 0 then begin
     110    if Value = 0 then FillChar(FData^, Size shr 3, 0)
     111      else FillChar(FData^, Size shr 3, $ff);
     112  end else inherited;
     113end;
     114
     115procedure TBitMemory.ReadBlock(Block: TBitBlock; Position: Integer);
     116begin
     117  if Block is TBitMemory then begin
     118    if (Position and 7) = 0 then begin
     119      if (Block.Size and 7) = 0 then
     120        Move(PByte(FData + Position shr 3)^, TBitMemory(Block).Data^, Block.Size shr 3)
     121        else inherited;
     122    end else inherited;
     123  end else inherited;
     124end;
     125
     126procedure TBitMemory.WriteBlock(Block: TBitBlock; Position: Integer);
     127begin
     128  if Block is TBitMemory then begin
     129    if (Position and 7) = 0 then begin
     130      if (Block.Size and 7) = 0 then
     131        Move(TBitMemory(Block).Data^, PByte(FData + Position shr 3)^, Block.Size shr 3)
     132        else inherited;
     133    end else inherited;
     134  end else inherited;
     135end;
     136
     137procedure TBitMemory.Invert;
     138var
     139  I: Integer;
     140begin
     141  if (Size and 7) = 0 then begin
     142    for I := 0 to (Size shr 3) - 1 do
     143      PByte(FData + I)^ := PByte(FData + I)^ xor $ff;
     144  end
     145  else inherited;
     146
     147end;
     148
     149function TBitMemory.GetInteger: Integer;
     150var
     151  I: Integer;
     152  V: Integer;
     153begin
     154  Result := 0;
     155  I := 0;
     156  while (I < 32) and (I < Size) do begin
     157    V := FData[I shr 3];
     158    V := V shl I;
     159    Result := Result or V;
     160//    Result := Result or (FData[I shr 3] shl I);
     161    Inc(I, 8);
     162  end;
     163  if Size < 32 then
     164    Result := Result and ((1 shl Size) - 1);
     165end;
     166
     167procedure TBitMemory.SetInteger(Value: Integer);
     168var
     169  I: Integer;
     170begin
     171  I := 0;
     172  while (I < 32) and (I < Size) do begin
     173    FData[I shr 3] := (Value shr I) and $ff;
     174    Inc(I, 8);
     175  end;
     176end;
     177
     178function TBitMemory.GetSize: Integer;
     179begin
     180  Result := FSize;
     181end;
     182
     183procedure TBitMemory.SetSize(AValue: Integer);
     184var
     185  ByteSize: Integer;
     186begin
     187  if AValue = FSize then Exit;
     188  FSize := AValue;
     189  ByteSize := FSize shr 3;
     190  if (FSize and 7) > 0 then Inc(ByteSize);
     191  FData := ReAllocMem(FData, ByteSize);
     192end;
     193
     194function TBitMemory.GetItem(Index: Integer): Byte;
     195begin
     196  if Index >= Size then raise Exception.Create('Out of range');
     197  Result := (PByte(FData + (Index shr 3))^ shr (Index and 7)) and 1;
     198end;
     199
     200procedure TBitMemory.SetItem(Index: Integer; AValue: Byte);
     201begin
     202  if Index >= Size then raise Exception.Create('Out of range, Size:' + IntToStr(Size) + ', Index:' + IntToStr(Index));
     203  PByte(FData + (Index shr 3))^ := PByte(FData + (Index shr 3))^ and not (1 shl (Index and 7))
     204    or ((AValue and 1) shl (Index and 7));
     205end;
     206
     207constructor TBitMemory.Create;
     208begin
     209  FData := nil;
     210end;
     211
     212destructor TBitMemory.Destroy;
     213begin
     214  FreeMem(FData);
     215  inherited Destroy;
     216end;
     217
     218{ TBitBlock }
     219
     220function TBitBlock.GetItem(Index: Integer): Byte;
     221begin
     222  Result := 0;
     223end;
     224
     225function TBitBlock.GetSize: Integer;
     226begin
     227  Result := 0;
     228end;
     229
     230procedure TBitBlock.SetItem(Index: Integer; AValue: Byte);
     231begin
     232
     233end;
     234
     235procedure TBitBlock.SetSize(AValue: Integer);
     236begin
     237end;
     238
     239procedure TBitBlock.Invert;
     240var
     241  I: Integer;
     242begin
     243  for I := 0 to Size - 1 do
     244    Items[I] := not Items[I];
     245end;
     246
     247function TBitBlock.GetInteger: Integer;
     248begin
     249  Result := 0;
     250end;
     251
     252procedure TBitBlock.SetInteger(Value: Integer);
     253begin
     254
     255end;
     256
     257procedure TBitBlock.ReadBlock(Block: TBitBlock; Position: Integer);
     258var
     259  I: Integer;
     260begin
     261  for I := 0 to Block.Size - 1 do
     262    Block.Items[I] := Items[Position + I];
     263end;
     264
     265procedure TBitBlock.WriteBlock(Block: TBitBlock; Position: Integer);
     266var
     267  I: Integer;
     268begin
     269  for I := 0 to Block.Size - 1 do
     270    Items[Position + I] := Block.Items[I];
     271end;
     272
     273procedure TBitBlock.Clear(Value: Byte);
     274var
     275  I: Integer;
     276begin
     277  for I := 0 to Size - 1 do
     278    Items[I] := Value;
     279end;
     280
     281procedure TBitBlock.Assign(Source: TBlock);
     282var
     283  I: Integer;
     284begin
     285  Size := Source.Size;
     286  for I := 0 to Size - 1 do
     287    Items[I] := Source.Items[I];
     288end;
     289
     290{ TBlock }
     291
     292procedure TBlock.ReadBlock(Block: TBlock; Position: Integer);
     293var
     294  I: Integer;
     295begin
     296  if Position + Block.Size > Size then raise Exception.Create('');
     297  for I := 0 to Block.Size - 1 do
     298    Items[I] := Items[Position + I];
     299end;
     300
     301procedure TBlock.WriteBlock(Block: TBlock; Position: Integer);
     302var
     303  I: Integer;
     304begin
     305  if Position + Block.Size > Size then raise Exception.Create('');
     306  for I := 0 to Block.Size - 1 do
     307    Items[Position + I] := Items[I];
     308end;
     309
     310procedure TBlock.Clear(Value: Byte);
     311var
     312  I: Integer;
     313begin
     314  for I := 0 to Size - 1 do
     315    Items[I] := Value;
     316end;
     317
     318procedure TBlock.Assign(Source: TBlock);
     319var
     320  I: Integer;
     321begin
     322  Size := Source.Size;
     323  for I := 0 to Size - 1 do
     324    Items[I] := Source.Items[I];
     325end;
    45326
    46327{ TPositionMemory }
    … …  
    90371end;
    91372
    92 procedure TMemory.Assign(Source: TMemory);
    93 begin
    94   Size := Source.Size;
    95   Move(Source.Data^, FData^, Size);
     373procedure TMemory.Assign(Source: TBlock);
     374begin
     375  if Source is TMemory then begin
     376    Size := Source.Size;
     377    Move(TMemory(Source).Data^, FData^, Size);
     378  end else inherited;
    96379end;
    97380

  • trunk/UCore.lfm

    r36 r37  
    106106      OnExecute = AToolMoveExecute
    107107    end
     108    object ASettings: TAction
     109      Caption = 'Settings'
     110      OnExecute = ASettingsExecute
     111    end
    108112  end
    109113  object ImageList1: TImageList
    … …  
    143147    top = 166
    144148  end
     149  object CoolTranslator1: TCoolTranslator
     150    POFilesFolder = 'Languages'
     151    left = 250
     152    top = 72
     153  end
    145154end

  • trunk/UCore.pas

    r36 r37  
    66
    77uses
    8   Classes, SysUtils, FileUtil, ActnList, UProject, UFGraphics, UPersistentForm,
    9   Controls, Graphics, ExtDlgs, ExtCtrls, URegistry, UApplicationInfo, Registry;
     8  Classes, SysUtils, FileUtil, ActnList, UProject, UCoolTranslator, UFGraphics,
     9  UPersistentForm, Controls, Graphics, ExtDlgs, ExtCtrls, URegistry,
     10  UApplicationInfo, Registry;
    1011
    1112const
    … …  
    1617
    1718  TCore = class(TDataModule)
     19    ASettings: TAction;
    1820    AToolMove: TAction;
    1921    AToolPen: TAction;
    … …  
    3638    AFileNew: TAction;
    3739    ActionList1: TActionList;
     40    CoolTranslator1: TCoolTranslator;
    3841    ImageList1: TImageList;
    3942    OpenPictureDialog1: TOpenPictureDialog;
    … …  
    5255    procedure AImageNegativeExecute(Sender: TObject);
    5356    procedure AImageRandomExecute(Sender: TObject);
     57    procedure ASettingsExecute(Sender: TObject);
    5458    procedure AToolMoveExecute(Sender: TObject);
    5559    procedure AToolPenExecute(Sender: TObject);
    … …  
    8286uses
    8387  UFormNew, UFormMain, Forms, UColorRGBA8, UColorGray8, UColorGray1, UColorGray4,
    84   UColorRGB565;
     88  UColorRGB565, UFormSettings;
    8589
    8690{ TCore }
    … …  
    151155    LastImageSize.X := ReadIntegerWithDefault('LastImageSizeX', 600);
    152156    LastImageSize.Y := ReadIntegerWithDefault('LastImageSizeY', 400);
     157    if ValueExists('LanguageCode') then
     158      CoolTranslator1.Language := CoolTranslator1.Languages.SearchByCode(ReadStringWithDefault('LanguageCode', ''))
     159      else CoolTranslator1.Language := CoolTranslator1.Languages.SearchByCode('');
    153160  finally
    154161    Free;
    … …  
    166173    WriteInteger('LastImageSizeX', LastImageSize.X);
    167174    WriteInteger('LastImageSizeY', LastImageSize.Y);
     175    if Assigned(CoolTranslator1.Language) and (CoolTranslator1.Language.Code <> '') then
     176      WriteString('LanguageCode', CoolTranslator1.Language.Code)
     177      else DeleteValue('LanguageCode');
    168178  finally
    169179    Free;
    … …  
    300310end;
    301311
     312procedure TCore.ASettingsExecute(Sender: TObject);
     313begin
     314  FormSettings := TFormSettings.Create(nil);
     315  try
     316    FormSettings.Load;
     317    if FormSettings.ShowModal = mrOk then begin
     318      FormSettings.Save;
     319    end;
     320  finally
     321    FormSettings.Free;
     322  end;
     323end;
     324
    302325procedure TCore.AToolMoveExecute(Sender: TObject);
    303326begin
Note: See TracChangeset for help on using the changeset viewer.