Changeset 59 for trunk


Ignore:
Timestamp:
Dec 3, 2014, 9:09:42 PM (9 years ago)
Author:
chronos
Message:
  • Added: Support for high DPI screens. If not detected automatically correctly then user can specify desired values.
  • Updated: Common package to newer version.
Location:
trunk
Files:
6 added
28 edited

Legend:

Unmodified
Added
Removed

  • trunk/Forms/UFormCPU.lfm

    r39 r59  
    77  ClientHeight = 287
    88  ClientWidth = 414
    9   LCLVersion = '0.9.31'
     9  LCLVersion = '1.3'
    1010  object Label4: TLabel
    1111    Left = 8
    12     Height = 18
    13     Top = 42
    14     Width = 87
     12    Height = 25
     13    Top = 48
     14    Width = 124
    1515    Caption = 'Step counter:'
    1616    ParentColor = False
    … …  
    1818  object Label7: TLabel
    1919    Left = 8
    20     Height = 18
    21     Top = 62
    22     Width = 45
     20    Height = 25
     21    Top = 72
     22    Width = 63
    2323    Caption = 'Speed:'
    2424    ParentColor = False
    2525  end
    2626  object LabelStepSpeed: TLabel
    27     Left = 119
    28     Height = 18
    29     Top = 62
    30     Width = 13
     27    Left = 192
     28    Height = 25
     29    Top = 72
     30    Width = 15
    3131    Caption = '   '
    3232    ParentColor = False
    3333  end
    3434  object LabelStepCounter: TLabel
    35     Left = 119
    36     Height = 18
    37     Top = 42
    38     Width = 13
     35    Left = 192
     36    Height = 25
     37    Top = 48
     38    Width = 15
    3939    Caption = '   '
    4040    ParentColor = False
    4141  end
    4242  object LabelMemoryPointer: TLabel
    43     Left = 119
    44     Height = 18
     43    Left = 192
     44    Height = 25
    4545    Top = 24
    46     Width = 13
     46    Width = 15
    4747    Caption = '   '
    4848    ParentColor = False
    4949  end
    5050  object LabelProgramPointer: TLabel
    51     Left = 119
    52     Height = 18
    53     Top = 8
    54     Width = 13
     51    Left = 192
     52    Height = 25
     53    Top = 0
     54    Width = 15
    5555    Caption = '   '
    5656    ParentColor = False
    … …  
    5858  object Label3: TLabel
    5959    Left = 8
    60     Height = 18
    61     Top = 8
    62     Width = 110
     60    Height = 25
     61    Top = 0
     62    Width = 159
    6363    Caption = 'Program pointer:'
    6464    ParentColor = False
    … …  
    6666  object Label5: TLabel
    6767    Left = 8
    68     Height = 18
     68    Height = 25
    6969    Top = 24
    70     Width = 108
     70    Width = 156
    7171    Caption = 'Memory pointer:'
    7272    ParentColor = False

  • trunk/Forms/UFormInput.lfm

    r39 r59  
    77  ClientHeight = 240
    88  ClientWidth = 320
    9   LCLVersion = '0.9.31'
     9  LCLVersion = '1.3'
    1010  object MemoInput: TMemo
    11     Left = 8
    12     Height = 210
    13     Top = 22
    14     Width = 309
    15     Anchors = [akTop, akLeft, akRight, akBottom]
     11    Left = 4
     12    Height = 203
     13    Top = 33
     14    Width = 312
     15    Align = alClient
     16    BorderSpacing.Around = 4
    1617    Font.Height = -12
    1718    Font.Name = 'Courier New'
    … …  
    2223  end
    2324  object Label1: TLabel
    24     Left = 8
    25     Height = 18
    26     Top = 8
    27     Width = 38
     25    Left = 4
     26    Height = 25
     27    Top = 4
     28    Width = 312
     29    Align = alTop
     30    BorderSpacing.Around = 4
    2831    Caption = 'Input:'
    2932    ParentColor = False

  • trunk/Forms/UFormMain.lfm

    r52 r59  
    11object MainForm: TMainForm
    2   Left = 223
    3   Height = 430
    4   Top = 176
    5   Width = 670
     2  Left = 408
     3  Height = 586
     4  Top = 311
     5  Width = 860
    66  Caption = 'LazFuck'
    7   ClientHeight = 411
    8   ClientWidth = 670
     7  ClientHeight = 557
     8  ClientWidth = 860
    99  Menu = MainMenu1
    1010  OnCloseQuery = FormCloseQuery
    … …  
    1212  OnDestroy = FormDestroy
    1313  OnShow = FormShow
    14   LCLVersion = '1.1'
     14  LCLVersion = '1.3'
    1515  WindowState = wsMaximized
    1616  object StatusBarMain: TStatusBar
    1717    Left = 0
    18     Height = 20
    19     Top = 391
    20     Width = 670
     18    Height = 29
     19    Top = 528
     20    Width = 860
    2121    Panels = <   
    2222      item
    … …  
    3535    Height = 26
    3636    Top = 0
    37     Width = 670
     37    Width = 860
    3838    Images = ImageListMain
    3939    ParentShowHint = False
    … …  
    128128  end
    129129  object PageControlRight: TPageControl
    130     Left = 277
    131     Height = 365
     130    Left = 467
     131    Height = 502
    132132    Top = 26
    133133    Width = 393
    … …  
    139139    object TabSheetDebug: TTabSheet
    140140      Caption = 'Debug'
    141       ClientHeight = 357
    142       ClientWidth = 365
     141      ClientHeight = 496
     142      ClientWidth = 315
    143143      object PanelInput: TPanel
    144144        Left = 0
    145145        Height = 64
    146146        Top = 0
    147         Width = 365
     147        Width = 315
    148148        Align = alTop
    149149        BevelOuter = bvNone
    … …  
    155155        Height = 5
    156156        Top = 64
    157         Width = 365
     157        Width = 315
    158158        Align = alTop
    159159        ResizeAnchor = akTop
    … …  
    163163        Height = 259
    164164        Top = 69
    165         Width = 365
     165        Width = 315
    166166        Align = alTop
    167167        BevelOuter = bvNone
    … …  
    173173        Height = 5
    174174        Top = 328
    175         Width = 365
     175        Width = 315
    176176        Align = alTop
    177177        ResizeAnchor = akTop
    … …  
    181181        Height = 86
    182182        Top = 333
    183         Width = 365
     183        Width = 315
    184184        Align = alTop
    185185        BevelOuter = bvNone
    … …  
    190190        Left = 0
    191191        Height = 5
    192         Top = 357
    193         Width = 365
     192        Top = 419
     193        Width = 315
    194194        Align = alTop
    195195        ResizeAnchor = akTop
    … …  
    197197      object PanelMemory: TPanel
    198198        Left = 0
    199         Height = 0
    200         Top = 357
    201         Width = 365
     199        Height = 72
     200        Top = 424
     201        Width = 315
    202202        Align = alClient
    203203        BevelOuter = bvNone
    … …  
    207207  end
    208208  object Splitter1: TSplitter
    209     Left = 272
    210     Height = 365
     209    Left = 462
     210    Height = 502
    211211    Top = 26
    212212    Width = 5
    … …  
    216216  object PanelLeft: TPanel
    217217    Left = 0
    218     Height = 365
     218    Height = 502
    219219    Top = 26
    220     Width = 272
     220    Width = 462
    221221    Align = alClient
    222222    BevelOuter = bvNone
    223     ClientHeight = 365
    224     ClientWidth = 272
     223    ClientHeight = 502
     224    ClientWidth = 462
    225225    TabOrder = 4
    226226    object PageControlMain: TPageControl
    227227      Left = 0
    228       Height = 242
     228      Height = 379
    229229      Top = 0
    230       Width = 272
     230      Width = 462
    231231      ActivePage = TabSheetSource
    232232      Align = alClient
    … …  
    244244      Left = 0
    245245      Height = 118
    246       Top = 247
    247       Width = 272
     246      Top = 384
     247      Width = 462
    248248      ActivePage = TabSheetMessages
    249249      Align = alBottom
    … …  
    259259      Left = 0
    260260      Height = 5
    261       Top = 242
    262       Width = 272
     261      Top = 379
     262      Width = 462
    263263      Align = alBottom
    264264      ResizeAnchor = akBottom

  • trunk/Forms/UFormMain.pas

    r57 r59  
    197197procedure TMainForm.FormShow(Sender: TObject);
    198198begin
     199  with Core.ScaleDPI do begin
     200    ApplyToAll(DesignDPI);
     201    ScaleImageList(ImageListMain, DesignDPI);
     202  end;
    199203  Core.CoolTranslator1.Translate;
    200204  LoadFromRegistry(HKEY(Core.ApplicationInfo.RegistryRoot), Core.ApplicationInfo.RegistryKey);
    … …  
    446450procedure TMainForm.AOptionsExecute(Sender: TObject);
    447451begin
     452  OptionsForm.Load;
    448453  //OptionsForm.LoadFromInterpretter(CurrentTarget);
    449454  if OptionsForm.ShowModal = mrOK then begin
    450455    //OptionsForm.SaveToInterpretter(CurrentTarget);
     456    OptionsForm.Save;
    451457  end;
    452458end;

  • trunk/Forms/UFormMemory.lfm

    r39 r59  
    77  ClientHeight = 259
    88  ClientWidth = 391
    9   LCLVersion = '0.9.31'
     9  LCLVersion = '1.3'
    1010  object Label6: TLabel
    11     Left = 8
    12     Height = 18
    13     Top = 8
    14     Width = 57
     11    Left = 4
     12    Height = 25
     13    Top = 4
     14    Width = 383
     15    Align = alTop
     16    BorderSpacing.Around = 4
    1517    Caption = 'Memory:'
    1618    ParentColor = False
    1719  end
    1820  object ListViewMemory: TListView
    19     Left = 8
    20     Height = 231
    21     Top = 24
    22     Width = 374
    23     Anchors = [akTop, akLeft, akRight, akBottom]
     21    Left = 4
     22    Height = 222
     23    Top = 33
     24    Width = 383
     25    Align = alClient
     26    BorderSpacing.Around = 4
    2427    Columns = <   
    2528      item

  • trunk/Forms/UFormOptions.lfm

    r37 r59  
    88  ClientWidth = 468
    99  OnShow = FormShow
    10   LCLVersion = '0.9.31'
     10  LCLVersion = '1.3'
    1111  object ButtonOk: TButton
    1212    Left = 389
    … …  
    3131  end
    3232  object SpinEditCellSize: TSpinEdit
    33     Left = 136
    34     Height = 21
     33    Left = 165
     34    Height = 35
    3535    Top = 40
    3636    Width = 130
    … …  
    3939  end
    4040  object SpinEditMemorySize: TSpinEdit
    41     Left = 136
    42     Height = 21
     41    Left = 165
     42    Height = 35
    4343    Top = 6
    4444    Width = 130
    … …  
    4848  object Label1: TLabel
    4949    Left = 8
    50     Height = 14
     50    Height = 25
    5151    Top = 8
    52     Width = 64
     52    Width = 123
    5353    Caption = 'Memory size:'
    5454    ParentColor = False
    … …  
    5656  object Label2: TLabel
    5757    Left = 8
    58     Height = 14
     58    Height = 25
    5959    Top = 40
    60     Width = 43
     60    Width = 79
    6161    Caption = 'Cell size:'
    6262    ParentColor = False
    … …  
    6464  object Label3: TLabel
    6565    Left = 8
    66     Height = 14
     66    Height = 25
    6767    Top = 95
    68     Width = 97
     68    Width = 179
    6969    Caption = 'Interface language:'
    7070    ParentColor = False
    … …  
    7272  object CheckBox1: TCheckBox
    7373    Left = 8
    74     Height = 17
    75     Top = 120
    76     Width = 159
     74    Height = 27
     75    Top = 128
     76    Width = 456
     77    Anchors = [akTop, akLeft, akRight]
     78    AutoSize = False
    7779    Caption = 'Reopend last opened project'
    7880    TabOrder = 4
    7981  end
    8082  object ComboBoxLanguage: TComboBox
    81     Left = 162
    82     Height = 21
    83     Top = 86
     83    Left = 248
     84    Height = 37
     85    Top = 83
    8486    Width = 188
    85     ItemHeight = 13
     87    ItemHeight = 0
    8688    Style = csDropDownList
    8789    TabOrder = 5
    8890  end
     91  object SpinEditDPIX: TSpinEdit
     92    Left = 104
     93    Height = 35
     94    Top = 193
     95    Width = 80
     96    MaxValue = 1000
     97    MinValue = 1
     98    TabOrder = 6
     99    Value = 1
     100  end
     101  object LabelDPI: TLabel
     102    Left = 24
     103    Height = 25
     104    Top = 201
     105    Width = 39
     106    Caption = 'DPI:'
     107    ParentColor = False
     108  end
     109  object SpinEditDPIY: TSpinEdit
     110    Left = 208
     111    Height = 35
     112    Top = 193
     113    Width = 80
     114    MaxValue = 1000
     115    MinValue = 1
     116    TabOrder = 7
     117    Value = 1
     118  end
     119  object LabelX: TLabel
     120    Left = 192
     121    Height = 25
     122    Top = 201
     123    Width = 10
     124    Caption = 'x'
     125    ParentColor = False
     126  end
     127  object CheckBoxDPIAuto: TCheckBox
     128    Left = 8
     129    Height = 27
     130    Top = 168
     131    Width = 448
     132    Anchors = [akTop, akLeft, akRight]
     133    AutoSize = False
     134    Caption = 'Automatic DPI'
     135    OnChange = CheckBoxDPIAutoChange
     136    TabOrder = 8
     137  end
    89138end

  • trunk/Forms/UFormOptions.pas

    r51 r59  
    11unit UFormOptions;
    22
    3 {$mode objfpc}{$H+}
     3{$mode delphi}{$H+}
    44
    55interface
    … …  
    77uses
    88  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
    9   Spin, ComCtrls, UTargetInterpretter;
     9  Spin, UTargetInterpretter;
    1010
    1111type
    … …  
    1717    ButtonCancel: TButton;
    1818    CheckBox1: TCheckBox;
     19    CheckBoxDPIAuto: TCheckBox;
    1920    ComboBoxLanguage: TComboBox;
    2021    Label1: TLabel;
    2122    Label2: TLabel;
    2223    Label3: TLabel;
     24    LabelDPI: TLabel;
     25    LabelX: TLabel;
     26    SpinEditDPIX: TSpinEdit;
     27    SpinEditDPIY: TSpinEdit;
    2328    SpinEditCellSize: TSpinEdit;
    2429    SpinEditMemorySize: TSpinEdit;
    2530    procedure ButtonOkClick(Sender: TObject);
     31    procedure CheckBoxDPIAutoChange(Sender: TObject);
    2632    procedure FormShow(Sender: TObject);
    2733  private
    2834    { private declarations }
    2935  public
     36    procedure UpdateInterface;
     37    procedure Load;
     38    procedure Save;
    3039    procedure LoadFromInterpretter(Interpretter: TTargetInterpretter);
    3140    procedure SaveToInterpretter(Interpretter: TTargetInterpretter);
    … …  
    5261end;
    5362
     63procedure TOptionsForm.UpdateInterface;
     64begin
     65  SpinEditDPIX.Enabled := not CheckBoxDPIAuto.Checked;
     66  SpinEditDPIY.Enabled := not CheckBoxDPIAuto.Checked;
     67  LabelDPI.Enabled := not CheckBoxDPIAuto.Checked;
     68  LabelX.Enabled := not CheckBoxDPIAuto.Checked;
     69  if CheckBoxDPIAuto.Checked then begin
     70    SpinEditDPIX.Value := ScreenInfo.PixelsPerInchX;
     71    SpinEditDPIY.Value := ScreenInfo.PixelsPerInchY;
     72  end;
     73end;
     74
     75procedure TOptionsForm.Load;
     76begin
     77  SpinEditDPIX.Value := Core.ScaleDPI.DPI.X;
     78  SpinEditDPIY.Value := Core.ScaleDPI.DPI.Y;
     79  CheckBoxDPIAuto.Checked := Core.ScaleDPI.AutoDetect;
     80  UpdateInterface;
     81end;
     82
     83procedure TOptionsForm.Save;
     84begin
     85  Core.ScaleDPI.DPI.X := SpinEditDPIX.Value;
     86  Core.ScaleDPI.DPI.Y := SpinEditDPIY.Value;
     87  Core.ScaleDPI.AutoDetect := CheckBoxDPIAuto.Checked;
     88end;
     89
    5490procedure TOptionsForm.ButtonOkClick(Sender: TObject);
    5591begin
    … …  
    5793    Core.CoolTranslator1.Language := TLanguage(ComboBoxLanguage.Items.Objects[ComboBoxLanguage.ItemIndex]);
    5894  Core.OpenProjectOnStart := CheckBox1.Checked;
     95end;
     96
     97procedure TOptionsForm.CheckBoxDPIAutoChange(Sender: TObject);
     98begin
     99  UpdateInterface;
    59100end;
    60101

  • trunk/Forms/UFormOutput.lfm

    r39 r59  
    11object FormOutput: TFormOutput
    22  Left = 256
    3   Height = 240
     3  Height = 440
    44  Top = 32
    55  Width = 320
    66  Caption = 'Output'
    7   ClientHeight = 240
     7  ClientHeight = 440
    88  ClientWidth = 320
    9   LCLVersion = '0.9.31'
     9  LCLVersion = '1.3'
    1010  object Label2: TLabel
    11     Left = 8
    12     Height = 18
    13     Top = 6
    14     Width = 49
     11    Left = 4
     12    Height = 25
     13    Top = 4
     14    Width = 312
     15    Align = alTop
     16    BorderSpacing.Around = 4
    1517    Caption = 'Output:'
    1618    ParentColor = False
    1719  end
    1820  object MemoOutput: TMemo
    19     Left = 8
    20     Height = 211
    21     Top = 22
    22     Width = 309
    23     Anchors = [akTop, akLeft, akRight, akBottom]
     21    Left = 4
     22    Height = 403
     23    Top = 33
     24    Width = 312
     25    Align = alClient
     26    BorderSpacing.Around = 4
    2427    Font.Height = -12
    2528    Font.Name = 'Courier New'

  • trunk/Languages/LazFuckIDE.cs.po

    r58 r59  
    521521msgstr "Otevřít naposledy otevřenÃœ projekt"
    522522
     523#: toptionsform.checkboxdpiauto.caption
     524msgid "Automatic DPI"
     525msgstr "Automatické DPI"
     526
    523527#: toptionsform.label1.caption
    524528msgid "Memory size:"
    … …  
    532536msgid "Interface language:"
    533537msgstr "Jazyk rozhraní:"
     538
     539#: toptionsform.labeldpi.caption
     540msgctxt "toptionsform.labeldpi.caption"
     541msgid "DPI:"
     542msgstr "DPI:"
     543
     544#: toptionsform.labelx.caption
     545msgctxt "toptionsform.labelx.caption"
     546msgid "x"
     547msgstr "x"
    534548
    535549#: ubrainfuck.sjumptablecolision

  • trunk/Languages/LazFuckIDE.po

    r52 r59  
    508508msgstr ""
    509509
     510#: toptionsform.checkboxdpiauto.caption
     511msgid "Automatic DPI"
     512msgstr ""
     513
    510514#: toptionsform.label1.caption
    511515msgid "Memory size:"
    … …  
    518522#: toptionsform.label3.caption
    519523msgid "Interface language:"
     524msgstr ""
     525
     526#: toptionsform.labeldpi.caption
     527msgctxt "TOPTIONSFORM.LABELDPI.CAPTION"
     528msgid "DPI:"
     529msgstr ""
     530
     531#: toptionsform.labelx.caption
     532msgctxt "TOPTIONSFORM.LABELX.CAPTION"
     533msgid "x"
    520534msgstr ""
    521535

  • trunk/LazFuckIDE.lpi

    r55 r59  
    1 <?xml version="1.0"?>
     1<?xml version="1.0" encoding="UTF-8"?>
    22<CONFIG>
    33  <ProjectOptions>
    … …  
    1010      <ResourceType Value="res"/>
    1111      <UseXPManifest Value="True"/>
     12      <XPManifest>
     13        <DpiAware Value="True"/>
     14      </XPManifest>
    1215      <Icon Value="0"/>
    1316    </General>
    … …  
    1922      <StringTable ProductVersion=""/>
    2023    </VersionInfo>
     24    <MacroValues Count="1"/>
    2125    <BuildModes Count="2">
    2226      <Item1 Name="Debug" Default="True"/>
    … …  
    5357            </Options>
    5458          </Linking>
    55           <Other>
    56             <CompilerMessages>
    57               <MsgFileName Value=""/>
    58             </CompilerMessages>
    59             <CompilerPath Value="$(CompPath)"/>
    60           </Other>
    6159        </CompilerOptions>
    6260      </Item2>
     61      <SharedMatrixOptions Count="1">
     62        <Item1 ID="509373414797" Modes="Debug" Type="IDEMacro"/>
     63      </SharedMatrixOptions>
    6364    </BuildModes>
    6465    <PublishOptions>
    … …  
    7071      <local>
    7172        <FormatVersion Value="1"/>
    72         <LaunchingApplication PathPlusParams="\usr\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
    7373      </local>
    7474    </RunParams>
    75     <RequiredPackages Count="5">
     75    <RequiredPackages Count="6">
    7676      <Item1>
     77        <PackageName Value="FCL"/>
     78      </Item1>
     79      <Item2>
    7780        <PackageName Value="CoolTranslator"/>
    7881        <DefaultFilename Value="Packages\CoolTranslator\CoolTranslator.lpk" Prefer="True"/>
    79       </Item1>
    80       <Item2>
     82      </Item2>
     83      <Item3>
    8184        <PackageName Value="TemplateGenerics"/>
    8285        <DefaultFilename Value="Packages\TemplateGenerics\TemplateGenerics.lpk" Prefer="True"/>
    83       </Item2>
    84       <Item3>
     86      </Item3>
     87      <Item4>
    8588        <PackageName Value="Common"/>
    8689        <DefaultFilename Value="Packages\Common\Common.lpk" Prefer="True"/>
    87       </Item3>
    88       <Item4>
    89         <PackageName Value="SynEdit"/>
    9090      </Item4>
    9191      <Item5>
     92        <PackageName Value="SynEdit"/>
     93      </Item5>
     94      <Item6>
    9295        <PackageName Value="LCL"/>
    93       </Item5>
     96      </Item6>
    9497    </RequiredPackages>
    9598    <Units Count="19">
    … …  
    97100        <Filename Value="LazFuckIDE.lpr"/>
    98101        <IsPartOfProject Value="True"/>
    99         <UnitName Value="LazFuckIDE"/>
    100102      </Unit0>
    101103      <Unit1>
    … …  
    129131        <HasResources Value="True"/>
    130132        <ResourceBaseClass Value="Form"/>
    131         <UnitName Value="UFormTargets"/>
    132133      </Unit4>
    133134      <Unit5>
    … …  
    176177        <IsPartOfProject Value="True"/>
    177178        <ComponentName Value="FormMemory"/>
     179        <HasResources Value="True"/>
    178180        <ResourceBaseClass Value="Form"/>
    179181        <UnitName Value="UFormMemory"/>
    … …  
    197199        <HasResources Value="True"/>
    198200        <ResourceBaseClass Value="Form"/>
    199         <UnitName Value="UFormSourceCode"/>
    200201      </Unit15>
    201202      <Unit16>
    … …  
    205206        <HasResources Value="True"/>
    206207        <ResourceBaseClass Value="Form"/>
    207         <UnitName Value="UFormTargetCode"/>
    208208      </Unit16>
    209209      <Unit17>
    … …  
    239239      <SyntaxOptions>
    240240        <SyntaxMode Value="Delphi"/>
     241        <CStyleOperator Value="False"/>
     242        <AllowLabel Value="False"/>
     243        <CPPInline Value="False"/>
    241244      </SyntaxOptions>
    242245    </Parsing>
    243     <CodeGeneration>
    244       <Checks>
    245         <IOChecks Value="True"/>
    246         <RangeChecks Value="True"/>
    247         <OverflowChecks Value="True"/>
    248         <StackChecks Value="True"/>
    249       </Checks>
    250     </CodeGeneration>
    251246    <Linking>
    252247      <Options>
    … …  
    256251      </Options>
    257252    </Linking>
    258     <Other>
    259       <CompilerMessages>
    260         <MsgFileName Value=""/>
    261       </CompilerMessages>
    262       <CompilerPath Value="$(CompPath)"/>
    263     </Other>
    264253  </CompilerOptions>
    265254  <Debugging>

  • trunk/Packages/Common/Common.lpk

    r54 r59  
    1 <?xml version="1.0"?>
     1<?xml version="1.0" encoding="UTF-8"?>
    22<CONFIG>
    33  <Package Version="4">
    … …  
    1212        <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
    1313      </SearchPaths>
    14       <Other>
    15         <CompilerMessages>
    16           <UseMsgFile Value="True"/>
    17         </CompilerMessages>
    18         <CompilerPath Value="$(CompPath)"/>
    19       </Other>
    2014    </CompilerOptions>
    2115    <Description Value="Various libraries"/>
    2216    <License Value="GNU/GPL"/>
    2317    <Version Minor="7"/>
    24     <Files Count="15">
     18    <Files Count="20">
    2519      <Item1>
    2620        <Filename Value="StopWatch.pas"/>
    … …  
    8781        <UnitName Value="UApplicationInfo"/>
    8882      </Item15>
     83      <Item16>
     84        <Filename Value="USyncCounter.pas"/>
     85        <UnitName Value="USyncCounter"/>
     86      </Item16>
     87      <Item17>
     88        <Filename Value="UListViewSort.pas"/>
     89        <HasRegisterProc Value="True"/>
     90        <UnitName Value="UListViewSort"/>
     91      </Item17>
     92      <Item18>
     93        <Filename Value="UPersistentForm.pas"/>
     94        <HasRegisterProc Value="True"/>
     95        <UnitName Value="UPersistentForm"/>
     96      </Item18>
     97      <Item19>
     98        <Filename Value="UFindFile.pas"/>
     99        <HasRegisterProc Value="True"/>
     100        <UnitName Value="UFindFile"/>
     101      </Item19>
     102      <Item20>
     103        <Filename Value="UScaleDPI.pas"/>
     104        <UnitName Value="UScaleDPI"/>
     105      </Item20>
    89106    </Files>
    90107    <i18n>

  • trunk/Packages/Common/Common.pas

    r54 r59  
    1010  StopWatch, UCommon, UDebugLog, UDelay, UPrefixMultiplier, UURI, UThreading,
    1111  UMemory, UResetableThread, UPool, ULastOpenedList, URegistry,
    12   UJobProgressView, UXMLUtils, UApplicationInfo, LazarusPackageIntf;
     12  UJobProgressView, UXMLUtils, UApplicationInfo, USyncCounter, UListViewSort,
     13  UPersistentForm, UFindFile, UScaleDPI, LazarusPackageIntf;
    1314
    1415implementation
    … …  
    2021  RegisterUnit('UJobProgressView', @UJobProgressView.Register);
    2122  RegisterUnit('UApplicationInfo', @UApplicationInfo.Register);
     23  RegisterUnit('UListViewSort', @UListViewSort.Register);
     24  RegisterUnit('UPersistentForm', @UPersistentForm.Register);
     25  RegisterUnit('UFindFile', @UFindFile.Register);
    2226end;
    2327

  • trunk/Packages/Common/UApplicationInfo.pas

    r54 r59  
    5555procedure Register;
    5656begin
    57   RegisterComponents('Samples', [TApplicationInfo]);
     57  RegisterComponents('Common', [TApplicationInfo]);
    5858end;
    5959

  • trunk/Packages/Common/UCommon.pas

    r55 r59  
    4848function LoggedOnUserNameEx(Format: TUserNameFormat): string;
    4949function SplitString(var Text: string; Count: Word): string;
     50function GetBitCount(Variable: QWord; MaxIndex: Integer): Integer;
    5051function GetBit(Variable: QWord; Index: Byte): Boolean;
     52procedure SetBit(var Variable: Int64; Index: Byte; State: Boolean); overload;
    5153procedure SetBit(var Variable: QWord; Index: Byte; State: Boolean); overload;
    5254procedure SetBit(var Variable: Cardinal; Index: Byte; State: Boolean); overload;
    … …  
    336338end;
    337339
     340function GetBitCount(Variable: QWord; MaxIndex: Integer): Integer;
     341var
     342  I: Integer;
     343begin
     344  Result := 0;
     345  for I := 0 to MaxIndex - 1 do
     346    if ((Variable shr I) and 1) = 1 then Inc(Result);
     347end;
     348
    338349function GetBit(Variable:QWord;Index:Byte):Boolean;
    339350begin
    … …  
    341352end;
    342353
     354procedure SetBit(var Variable: Int64; Index: Byte; State: Boolean);
     355begin
     356  Variable := (Variable and ((1 shl Index) xor High(QWord))) or (Int64(State) shl Index);
     357end;
     358
    343359procedure SetBit(var Variable:QWord;Index:Byte;State:Boolean); overload;
    344360begin
    345   Variable := (Variable and ((1 shl Index) xor QWord($ffffffffffffffff))) or (QWord(State) shl Index);
     361  Variable := (Variable and ((1 shl Index) xor High(QWord))) or (QWord(State) shl Index);
    346362end;
    347363
    348364procedure SetBit(var Variable:Cardinal;Index:Byte;State:Boolean); overload;
    349365begin
    350   Variable := (Variable and ((1 shl Index) xor Cardinal($ffffffff))) or (Cardinal(State) shl Index);
     366  Variable := (Variable and ((1 shl Index) xor High(Cardinal))) or (Cardinal(State) shl Index);
    351367end;
    352368
    353369procedure SetBit(var Variable:Word;Index:Byte;State:Boolean); overload;
    354370begin
    355   Variable := (Variable and ((1 shl Index) xor Word($ffff))) or (Word(State) shl Index);
     371  Variable := (Variable and ((1 shl Index) xor High(Word))) or (Word(State) shl Index);
    356372end;
    357373

  • trunk/Packages/Common/UDebugLog.pas

    r54 r59  
    3131    Items: TListObject;
    3232    Lock: TCriticalSection;
    33     procedure Add(Group: string; Text: string);
     33    procedure Add(Text: string; Group: string = '');
    3434    procedure WriteToFile(Text: string);
    3535    constructor Create(AOwner: TComponent); override;
    … …  
    5252procedure Register;
    5353begin
    54   RegisterComponents('Samples', [TDebugLog]);
     54  RegisterComponents('Common', [TDebugLog]);
    5555end;
    5656
    … …  
    6969end;
    7070
    71 procedure TDebugLog.Add(Group: string; Text: string);
     71procedure TDebugLog.Add(Text: string; Group: string = '');
    7272var
    7373  NewItem: TDebugLogItem;

  • trunk/Packages/Common/UFindFile.pas

    r54 r59  
    6464procedure Register;
    6565begin
    66   RegisterComponents('Samples', [TFindFile]);
     66  RegisterComponents('Common', [TFindFile]);
    6767end;
    6868

  • trunk/Packages/Common/UJobProgressView.lfm

    r54 r59  
    2828    object LabelOperation: TLabel
    2929      Left = 8
    30       Height = 14
     30      Height = 13
    3131      Top = 8
    32       Width = 67
     32      Width = 66
    3333      Caption = 'Operations:'
    3434      Font.Height = -11
    … …  
    8080    object LabelEstimatedTimePart: TLabel
    8181      Left = 8
    82       Height = 14
     82      Height = 13
    8383      Top = -2
    84       Width = 72
     84      Width = 71
    8585      Caption = 'Estimated time:'
    8686      ParentColor = False
    … …  
    132132    object LabelEstimatedTimeTotal: TLabel
    133133      Left = 8
    134       Height = 14
     134      Height = 13
    135135      Top = 0
    136       Width = 98
     136      Width = 97
    137137      Caption = 'Total estimated time:'
    138138      ParentColor = False

  • trunk/Packages/Common/UJobProgressView.pas

    r54 r59  
    111111    Finished: Boolean;
    112112    FOnJobFinish: TJobProgressViewMethod;
     113    FOnOwnerDraw: TNotifyEvent;
     114    FOwnerDraw: Boolean;
    113115    FShowDelay: Integer;
    114116    FTerminate: Boolean;
    … …  
    116118    TotalStartTime: TDateTime;
    117119    Log: TStringList;
    118     Form: TFormJobProgressView;
    119120    procedure SetTerminate(const AValue: Boolean);
    120121    procedure UpdateProgress;
    … …  
    122123    procedure StartJobs;
    123124    procedure UpdateHeight;
     125    procedure JobProgressChange(Sender: TObject);
    124126  public
     127    Form: TFormJobProgressView;
    125128    Jobs: TObjectList; // TListObject<TJob>
    126129    CurrentJob: TJob;
    … …  
    136139    property Terminate: Boolean read FTerminate write SetTerminate;
    137140  published
     141    property OwnerDraw: Boolean read FOwnerDraw write FOwnerDraw;
    138142    property ShowDelay: Integer read FShowDelay write FShowDelay;
    139143    property AutoClose: Boolean read FAutoClose write FAutoClose;
    140144    property OnJobFinish: TJobProgressViewMethod read FOnJobFinish
    141145      write FOnJobFinish;
     146    property OnOwnerDraw: TNotifyEvent read FOnOwnerDraw
     147      write FOnOwnerDraw;
    142148  end;
    143149
    … …  
    163169procedure Register;
    164170begin
    165   RegisterComponents('Samples', [TJobProgressView]);
     171  RegisterComponents('Common', [TJobProgressView]);
    166172end;
    167173
    … …  
    196202  NewJob.Progress.Max := 100;
    197203  NewJob.Progress.Reset;
     204  NewJob.Progress.OnChange := JobProgressChange;
    198205  Jobs.Add(NewJob);
    199206  //ReloadJobList;
    … …  
    212219  Terminate := False;
    213220
    214   Form.BringToFront;
     221  if not OwnerDraw then Form.BringToFront;
    215222
    216223  Finished := False;
    … …  
    244251      CurrentJobIndex := I;
    245252      CurrentJob := TJob(Jobs[I]);
     253      JobProgressChange(Self);
    246254      StartTime := Now;
    247255      Form.LabelEstimatedTimePart.Caption := Format(SEstimatedTime, ['']);
    … …  
    339347end;
    340348
     349procedure TJobProgressView.JobProgressChange(Sender: TObject);
     350begin
     351  if Assigned(FOnOwnerDraw) then
     352    FOnOwnerDraw(Self);
     353end;
     354
    341355procedure TFormJobProgressView.TimerUpdateTimer(Sender: TObject);
    342356var
    … …  
    357371  if not Visible then begin
    358372    TimerUpdate.Interval := UpdateInterval;
    359     Show;
     373    if not JobProgressView.OwnerDraw then Show;
    360374  end;
    361375end;
    … …  
    509523destructor TJobProgressView.Destroy;
    510524begin
    511   Log.Free;
    512   Jobs.Free;
    513   inherited Destroy;
     525  FreeAndNil(Log);
     526  FreeAndNil(Jobs);
     527  inherited;
    514528end;
    515529
    … …  
    519533    FLock.Acquire;
    520534    FMax := AValue;
     535    if FMax < 1 then FMax := 1;
    521536    if FValue >= FMax then FValue := FMax;
    522537  finally
    … …  
    610625begin
    611626  Progress.Free;
    612   inherited Destroy;
     627  inherited;
    613628end;
    614629

  • trunk/Packages/Common/ULastOpenedList.pas

    r55 r59  
    66
    77uses
    8   Classes, SysUtils, Registry, URegistry, Menus;
     8  Classes, SysUtils, Registry, URegistry, Menus, XMLConf;
    99
    1010type
    … …  
    1818    procedure SetMaxCount(AValue: Integer);
    1919    procedure LimitMaxCount;
     20    procedure ItemsChange(Sender: TObject);
     21    procedure DoChange;
    2022  public
    2123    Items: TStringList;
    … …  
    2527    procedure LoadFromRegistry(Context: TRegistryContext);
    2628    procedure SaveToRegistry(Context: TRegistryContext);
     29    procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; Path: string);
     30    procedure SaveToXMLConfig(XMLConfig: TXMLConfig; Path: string);
    2731    procedure AddItem(FileName: string);
    2832  published
    … …  
    3842procedure Register;
    3943begin
    40   RegisterComponents('Samples', [TLastOpenedList]);
     44  RegisterComponents('Common', [TLastOpenedList]);
    4145end;
    4246
    … …  
    5862end;
    5963
     64procedure TLastOpenedList.ItemsChange(Sender: TObject);
     65begin
     66  DoChange;
     67end;
     68
     69procedure TLastOpenedList.DoChange;
     70begin
     71  if Assigned(FOnChange) then
     72    FOnChange(Self);
     73end;
     74
    6075constructor TLastOpenedList.Create(AOwner: TComponent);
    6176begin
    6277  inherited;
    6378  Items := TStringList.Create;
     79  Items.OnChange := ItemsChange;
    6480  MaxCount := 10;
    6581end;
    … …  
    129145end;
    130146
     147procedure TLastOpenedList.LoadFromXMLConfig(XMLConfig: TXMLConfig; Path: string
     148  );
     149var
     150  I: Integer;
     151  Value: string;
     152  Count: Integer;
     153begin
     154  with XMLConfig do begin
     155    Count := GetValue(Path + '/Count', 0);
     156    if Count > MaxCount then Count := MaxCount;
     157    Items.Clear;
     158    for I := 0 to Count - 1 do begin
     159      Value := GetValue(Path + '/File' + IntToStr(I), '');
     160      if Trim(Value) <> '' then Items.Add(Value);
     161    end;
     162    if Assigned(FOnChange) then
     163      FOnChange(Self);
     164  end;
     165end;
     166
     167procedure TLastOpenedList.SaveToXMLConfig(XMLConfig: TXMLConfig; Path: string);
     168var
     169  I: Integer;
     170begin
     171  with XMLConfig do begin
     172    SetValue(Path + '/Count', Items.Count);
     173    for I := 0 to Items.Count - 1 do
     174      SetValue(Path + '/File' + IntToStr(I), Items[I]);
     175    Flush;
     176  end;
     177end;
     178
    131179procedure TLastOpenedList.AddItem(FileName:string);
    132180begin
    … …  
    134182  Items.Insert(0, FileName);
    135183  LimitMaxCount;
    136   if Assigned(FOnChange) then
    137     FOnChange(Self);
     184  DoChange;
    138185end;
    139186

  • trunk/Packages/Common/UMemory.pas

    r55 r59  
    2424    constructor Create;
    2525    destructor Destroy; override;
    26     procedure WriteMemory(Position: Integer; Memory: TMemory);
    27     procedure ReadMemory(Position: Integer; Memory: TMemory);
    2826    property Data: PByte read FData;
    2927    property Size: Integer read FSize write SetSize;
    … …  
    110108end;
    111109
    112 procedure TMemory.WriteMemory(Position: Integer; Memory: TMemory);
    113 begin
    114   Move(Memory.FData, PByte(@FData + Position)^, Memory.Size);
    115 end;
    116 
    117 procedure TMemory.ReadMemory(Position: Integer; Memory: TMemory);
    118 begin
    119   Move(PByte(@FData + Position)^, Memory.FData, Memory.Size);
    120 end;
    121 
    122110end.
    123111

  • trunk/Packages/Common/URegistry.pas

    r55 r59  
    1717    rrKeyDynData = HKEY($80000006));
    1818
     19  { TRegistryContext }
     20
    1921  TRegistryContext = record
    2022    RootKey: HKEY;
    2123    Key: string;
     24    class operator Equal(A, B: TRegistryContext): Boolean;
    2225  end;
    2326
    … …  
    2629  TRegistryEx = class(TRegistry)
    2730  private
     31    function GetCurrentContext: TRegistryContext;
     32    procedure SetCurrentContext(AValue: TRegistryContext);
    2833  public
    2934    function ReadBoolWithDefault(const Name: string;
    … …  
    3540    function DeleteKeyRecursive(const Key: string): Boolean;
    3641    function OpenKey(const Key: string; CanCreate: Boolean): Boolean;
     42    property CurrentContext: TRegistryContext read GetCurrentContext write SetCurrentContext;
    3743  end;
    3844
    … …  
    4652  Result.RootKey := RootKey;
    4753  Result.Key := Key;
     54end;
     55
     56{ TRegistryContext }
     57
     58class operator TRegistryContext.Equal(A, B: TRegistryContext): Boolean;
     59begin
     60  Result := (A.Key = B.Key) and (A.RootKey = B.RootKey);
    4861end;
    4962
    … …  
    106119end;
    107120
     121function TRegistryEx.GetCurrentContext: TRegistryContext;
     122begin
     123  Result.Key := CurrentPath;
     124  Result.RootKey := RootKey;
     125end;
     126
     127procedure TRegistryEx.SetCurrentContext(AValue: TRegistryContext);
     128begin
     129  RootKey := AValue.RootKey;
     130  OpenKey(AValue.Key, True);
     131end;
     132
    108133function TRegistryEx.ReadBoolWithDefault(const Name: string;
    109134  DefaultValue: Boolean): Boolean;

  • trunk/Packages/Common/UResetableThread.pas

    r54 r59  
    104104
    105105procedure TResetableThread.WaitForStart;
    106 var
    107   WaitResult: TWaitResult;
     106//var
     107//  WaitResult: TWaitResult;
    108108begin
    109109  //try
    … …  
    127127
    128128procedure TResetableThread.WaitForStop;
    129 var
    130   WaitState: TWaitResult;
     129//var
     130//  WaitState: TWaitResult;
    131131begin
    132132  try

  • trunk/Packages/Common/UURI.pas

    r54 r59  
    326326    Drive := Drive + DriveSeparator;
    327327  end else Drive := '';
    328   Directory.AsString := AValue;
     328  if (Drive <> '') and (AValue = '') then
     329    Directory.AsString := Directory.DirSeparator
     330    else Directory.AsString := AValue;
    329331end;
    330332

  • trunk/Target/UTargetPHP.pas

    r52 r59  
    9191    Inc(FProgramIndex);
    9292  end;
    93   AddLine('');
    94   AddLine('?>');
    9593
    9694  CompileToFile;

  • trunk/UCore.lfm

    r51 r59  
    44  OldCreateOrder = False
    55  Height = 289
    6   HorizontalOffset = 421
    7   VerticalOffset = 187
     6  HorizontalOffset = 529
     7  VerticalOffset = 296
    88  Width = 339
    99  object ApplicationInfo: TApplicationInfo
    … …  
    2222    RegistryKey = '\Software\Chronosoft\LazFuck'
    2323    RegistryRoot = rrKeyCurrentUser
    24     left = 56
     24    left = 72
    2525    top = 16
    2626  end
    2727  object CoolTranslator1: TCoolTranslator
    2828    POFilesFolder = 'Languages'
    29     left = 48
     29    left = 72
    3030    top = 72
    3131  end
    3232  object LastOpenedList: TLastOpenedList
    3333    MaxCount = 10
    34     left = 48
     34    left = 72
    3535    top = 128
    3636  end

  • trunk/UCore.pas

    r55 r59  
    77uses
    88  Classes, SysUtils, FileUtil, UApplicationInfo, ULastOpenedList,
    9   UCoolTranslator, UTarget, URegistry, Registry;
     9  UCoolTranslator, UTarget, URegistry, Registry, XMLConf, Graphics, UScaleDPI;
    1010
    1111type
    … …  
    2121  private
    2222  public
     23    ScaleDPI: TScaleDPI;
    2324    Modified: Boolean;
    2425    ProjectFileName: string;
    … …  
    3132var
    3233  Core: TCore;
     34
    3335
    3436implementation
    … …  
    4446procedure TCore.DataModuleCreate(Sender: TObject);
    4547begin
     48  ScaleDPI := TScaleDPI.Create;
    4649  Targets := TTargetList.Create;
    4750  Targets.Add(TTargetInterpretter.Create);
    … …  
    5760  SaveToRegistry(HKEY(ApplicationInfo.RegistryRoot), ApplicationInfo.RegistryKey);
    5861  Targets.Free;
     62  ScaleDPI.Free;
    5963end;
    6064
    … …  
    7175      CoolTranslator1.Language := CoolTranslator1.Languages.SearchByCode(ReadStringWithDefault('LanguageCode', ''))
    7276      else CoolTranslator1.Language := CoolTranslator1.Languages.SearchByCode('');
     77    ScaleDPI.DPI := Point(ReadIntegerWithDefault('DPIX', 96),
     78      ReadIntegerWithDefault('DPIY', 96));
     79    ScaleDPI.AutoDetect := ReadBoolWithDefault('DPIAuto', True);
    7380  finally
    7481    Free;
    … …  
    8794    OpenKey(Key, True);
    8895    WriteBool('OpenProjectOnStart', OpenProjectOnStart);
     96    WriteBool('DPIAuto', ScaleDPI.AutoDetect);
     97    WriteInteger('DPIX', ScaleDPI.DPI.X);
     98    WriteInteger('DPIY', ScaleDPI.DPI.Y);
    8999    if Assigned(CoolTranslator1.Language) and (CoolTranslator1.Language.Code <> '') then
    90100      WriteString('LanguageCode', CoolTranslator1.Language.Code)
Note: See TracChangeset for help on using the changeset viewer.