Changeset 91


Ignore:
Timestamp:
Dec 4, 2014, 10:18:13 PM (10 years ago)
Author:
chronos
Message:
  • Added: Partial support for high DPI screens. Disabled.
Location:
trunk
Files:
11 added
14 edited

Legend:

Unmodified
Added
Removed

  • trunk/Forms/UFormMain.lfm

    r87 r91  
    55  Width = 775
    66  Caption = 'xTactics'
    7   ClientHeight = 595
     7  ClientHeight = 592
    88  ClientWidth = 775
    99  Menu = MainMenu1
    … …  
    1818  object StatusBar1: TStatusBar
    1919    Left = 0
    20     Height = 26
    21     Top = 569
     20    Height = 29
     21    Top = 563
    2222    Width = 775
    2323    Panels = <   
    … …  
    3535  object ToolBar1: TToolBar
    3636    Left = 0
    37     Height = 569
     37    Height = 563
    3838    Top = 0
    3939    Width = 40
    … …  
    116116  object PaintBox1: TPaintBox
    117117    Left = 40
    118     Height = 569
     118    Height = 563
    119119    Top = 0
    120120    Width = 735
    121121    Align = alClient
    122122    OnMouseDown = PaintBox1MouseDown
    123     OnMouseLeave = PaintBox1MouseLeave
    124123    OnMouseMove = PaintBox1MouseMove
    125124    OnMouseUp = PaintBox1MouseUp
     125    OnMouseLeave = PaintBox1MouseLeave
    126126    OnMouseWheelDown = PaintBox1MouseWheelDown
    127127    OnMouseWheelUp = PaintBox1MouseWheelUp

  • trunk/Forms/UFormMain.pas

    r90 r91  
    7373    procedure AZoomOutExecute(Sender: TObject);
    7474    procedure FormActivate(Sender: TObject);
     75    procedure FormShow(Sender: TObject);
    7576    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    7677    procedure FormCreate(Sender: TObject);
    7778    procedure FormDestroy(Sender: TObject);
    7879    procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    79     procedure FormShow(Sender: TObject);
    80     procedure MenuItem19Click(Sender: TObject);
    8180    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
    8281      Shift: TShiftState; X, Y: Integer);
    … …  
    244243  Factor: TFloatPoint;
    245244  MapRect: TRect;
     245  NewZoom: Single;
    246246begin
    247247  with Core, Game, Player, View do begin
    … …  
    249249    Factor := FloatPoint((DestRect.Right - DestRect.Left) / (MapRect.Right - MapRect.Left),
    250250      (DestRect.Bottom - DestRect.Top) / (MapRect.Bottom - MapRect.Top));
    251     if Factor.X < Factor.Y then Zoom := Factor.X
    252       else Zoom := Factor.Y;
     251    if Factor.X < Factor.Y then NewZoom := Factor.X
     252      else NewZoom := Factor.Y;
     253    //if NewZoom <> 0 then
     254    Zoom := NewZoom;
    253255    CenterMap;
    254256  end;
    … …  
    326328  ReloadView;
    327329  Redraw;
    328 end;
    329 
    330 procedure TFormMain.MenuItem19Click(Sender: TObject);
    331 begin
    332 
    333330end;
    334331

  • trunk/Forms/UFormNew.lfm

    r87 r91  
    11object FormNew: TFormNew
    22  Left = 624
    3   Height = 528
     3  Height = 519
    44  Top = 313
    5   Width = 745
     5  Width = 1229
    66  Caption = 'New game'
    7   ClientHeight = 528
    8   ClientWidth = 745
     7  ClientHeight = 519
     8  ClientWidth = 1229
    99  OnCreate = FormCreate
    1010  OnDestroy = FormDestroy
    1111  OnShow = FormShow
    1212  LCLVersion = '1.3'
    13   object Splitter1: TSplitter
    14     Cursor = crVSplit
    15     Left = 0
    16     Height = 5
    17     Top = 0
    18     Width = 745
    19     Align = alTop
    20     ResizeAnchor = akTop
    21   end
    2213  object ButtonCancel: TButton
    23     Left = 522
     14    Left = 1006
    2415    Height = 25
    25     Top = 486
     16    Top = 477
    2617    Width = 75
    27     Anchors = [akBottom]
     18    Anchors = [akRight, akBottom]
    2819    Caption = 'Cancel'
    2920    ModalResult = 2
    30     TabOrder = 1
     21    TabOrder = 0
    3122  end
    3223  object ButtonOk: TButton
    33     Left = 626
     24    Left = 1110
    3425    Height = 25
    35     Top = 486
     26    Top = 477
    3627    Width = 75
    3728    Anchors = [akRight, akBottom]
    3829    Caption = 'Ok'
    3930    ModalResult = 1
    40     TabOrder = 2
     31    TabOrder = 1
    4132  end
    4233  object PageControl1: TPageControl
    43     Left = 0
    44     Height = 465
    45     Top = 5
    46     Width = 745
    47     ActivePage = TabSheet3
     34    Left = 4
     35    Height = 457
     36    Top = 4
     37    Width = 1221
     38    ActivePage = TabSheet2
    4839    Align = alTop
    4940    Anchors = [akTop, akLeft, akRight, akBottom]
    50     TabIndex = 2
    51     TabOrder = 3
     41    BorderSpacing.Around = 4
     42    TabIndex = 1
     43    TabOrder = 2
    5244    object TabSheet1: TTabSheet
    5345      Caption = 'Players'
    54       ClientHeight = 425
    55       ClientWidth = 739
     46      ClientHeight = 414
     47      ClientWidth = 1215
    5648      object ListView1: TListView
    57         Left = 8
    58         Height = 368
    59         Top = 8
    60         Width = 713
     49        Left = 4
     50        Height = 364
     51        Top = 4
     52        Width = 1207
     53        Align = alTop
    6154        Anchors = [akTop, akLeft, akRight, akBottom]
     55        BorderSpacing.Around = 4
    6256        Columns = <       
    6357          item
    … …  
    7569          item
    7670            Caption = 'Start units'
    77             Width = 296
     71            Width = 790
    7872          end>
    7973        OwnerData = True
    … …  
    9185      end
    9286      object ButtonPlayerRemove: TButton
    93         Left = 240
    94         Height = 25
    95         Top = 384
     87        Left = 224
     88        Height = 25
     89        Top = 376
    9690        Width = 83
    9791        Action = APlayerRemove
    98         Anchors = [akRight, akBottom]
     92        Anchors = [akLeft, akBottom]
    9993        TabOrder = 1
    10094      end
    10195      object ButtonPlayerAdd: TButton
    102         Left = 32
    103         Height = 25
    104         Top = 384
     96        Left = 16
     97        Height = 25
     98        Top = 376
    10599        Width = 83
    106100        Action = APlayerAdd
    107         Anchors = [akRight, akBottom]
     101        Anchors = [akLeft, akBottom]
    108102        TabOrder = 2
    109103      end
    110104      object ButtonPlayerModify: TButton
    111         Left = 136
    112         Height = 25
    113         Top = 384
     105        Left = 120
     106        Height = 25
     107        Top = 376
    114108        Width = 83
    115109        Action = APlayerModify
    116         Anchors = [akRight, akBottom]
     110        Anchors = [akLeft, akBottom]
    117111        Caption = 'Modify'
    118112        TabOrder = 3
    … …  
    121115    object TabSheet2: TTabSheet
    122116      Caption = 'Map'
    123       ClientHeight = 425
    124       ClientWidth = 739
     117      ClientHeight = 414
     118      ClientWidth = 1215
    125119      object Label1: TLabel
    126120        Left = 8
    … …  
    163157        Height = 46
    164158        Top = 8
    165         Width = 488
     159        Width = 964
    166160        Max = 100
    167161        Min = 2
    … …  
    176170        Height = 46
    177171        Top = 49
    178         Width = 488
     172        Width = 964
    179173        Max = 100
    180174        Min = 2
    … …  
    234228        Height = 27
    235229        Top = 110
    236         Width = 151
     230        Width = 727
     231        Anchors = [akTop, akLeft, akRight]
     232        AutoSize = False
    237233        Caption = 'Symetric map'
    238234        TabOrder = 6
    … …  
    312308        Height = 35
    313309        Top = 184
    314         Width = 472
     310        Width = 948
    315311        Anchors = [akTop, akLeft, akRight]
    316312        TabOrder = 12
    317313      end
    318314      object ButtonImageBrowse: TButton
    319         Left = 624
     315        Left = 1100
    320316        Height = 25
    321317        Top = 192
    … …  
    337333    object TabSheet3: TTabSheet
    338334      Caption = 'Rules'
    339       ClientHeight = 425
    340       ClientWidth = 739
     335      ClientHeight = 414
     336      ClientWidth = 1215
    341337      object RadioGroupGrowCells: TRadioGroup
    342         Left = 8
     338        Left = 15
    343339        Height = 105
    344340        Top = 104
    … …  
    353349        ChildSizing.Layout = cclLeftToRightThenTopToBottom
    354350        ChildSizing.ControlsPerLine = 1
    355         ClientHeight = 81
     351        ClientHeight = 78
    356352        ClientWidth = 308
    357353        Items.Strings = (
    … …  
    364360      object Label6: TLabel
    365361        Left = 8
    366         Height = 22
     362        Height = 25
    367363        Top = 248
    368         Width = 114
     364        Width = 129
    369365        Caption = 'Win objective:'
    370366        ParentColor = False
    … …  
    372368      object ComboBoxWinObjective: TComboBox
    373369        Left = 232
    374         Height = 34
     370        Height = 33
    375371        Top = 240
    376372        Width = 328
    … …  
    399395        ChildSizing.Layout = cclLeftToRightThenTopToBottom
    400396        ChildSizing.ControlsPerLine = 1
    401         ClientHeight = 52
     397        ClientHeight = 49
    402398        ClientWidth = 301
    403399        Items.Strings = (
    … …  
    409405      object CheckBoxFogOfWar: TCheckBox
    410406        Left = 336
    411         Height = 24
     407        Height = 27
    412408        Top = 24
    413         Width = 106
     409        Width = 864
     410        Anchors = [akTop, akLeft, akRight]
     411        AutoSize = False
    414412        Caption = 'Fog of war'
    415413        TabOrder = 3
    … …  
    435433  end
    436434  object OpenPictureDialog1: TOpenPictureDialog
    437     left = 616
    438     top = 280
     435    left = 424
     436    top = 440
    439437  end
    440438  object PopupMenu1: TPopupMenu
    441439    left = 128
    442     top = 143
     440    top = 440
    443441    object MenuItem1: TMenuItem
    444442      Action = APlayerAdd

  • trunk/Forms/UFormNew.pas

    r90 r91  
    5555    SpinEditNeutralUnits: TSpinEdit;
    5656    SpinEditVoidPercent: TSpinEdit;
    57     Splitter1: TSplitter;
    5857    TabSheet1: TTabSheet;
    5958    TabSheet2: TTabSheet;
    … …  
    240239begin
    241240  ReloadView;
     241  //Height := Trunc(1.5 * Height);
    242242end;
    243243

  • trunk/Forms/UFormSettings.lfm

    r77 r91  
    4848    Height = 27
    4949    Top = 80
    50     Width = 176
     50    Width = 752
     51    Anchors = [akTop, akLeft, akRight]
     52    AutoSize = False
    5153    Caption = 'Developer mode'
    5254    TabOrder = 3
    5355  end
    5456  object SpinEditAnimSpeed: TSpinEdit
    55     Left = 184
     57    Left = 224
    5658    Height = 35
    5759    Top = 120
    … …  
    6870  end
    6971  object Label3: TLabel
    70     Left = 311
     72    Left = 360
    7173    Height = 25
    72     Top = 128
     74    Top = 130
    7375    Width = 17
    7476    Caption = '%'
    … …  
    7981    Height = 27
    8082    Top = 160
    81     Width = 287
     83    Width = 752
     84    Anchors = [akTop, akLeft, akRight]
     85    AutoSize = False
    8286    Caption = 'Autosave game on each turn'
    8387    TabOrder = 5

  • trunk/Languages/xtactics.cs.po

    r90 r91  
    7979msgstr "Nastavení aplikace"
    8080
     81#: tform1.button1.caption
     82msgid "Button1"
     83msgstr ""
     84
     85#: tform1.caption
     86msgid "Form1"
     87msgstr ""
     88
     89#: tform1.groupbox1.caption
     90msgid "GroupBox1"
     91msgstr ""
     92
     93#: tform1.tabsheet1.caption
     94msgid "TabSheet1"
     95msgstr ""
     96
     97#: tform1.tabsheet2.caption
     98msgid "TabSheet2"
     99msgstr ""
     100
     101#: tform1.tabsheet3.caption
     102msgid "TabSheet3"
     103msgstr ""
     104
    81105#: tformabout.caption
    82106msgctxt "tformabout.caption"
    … …  
    569593msgid "Wrong file format"
    570594msgstr "Chybný formát souboru"
     595
     596#: ugame.szerozoomnotalowed
     597msgid "Zero zoom not allowed"
     598msgstr ""
     599

  • trunk/Languages/xtactics.po

    r90 r91  
    7070msgstr ""
    7171
     72#: tform1.button1.caption
     73msgid "Button1"
     74msgstr ""
     75
     76#: tform1.caption
     77msgid "Form1"
     78msgstr ""
     79
     80#: tform1.groupbox1.caption
     81msgid "GroupBox1"
     82msgstr ""
     83
     84#: tform1.tabsheet1.caption
     85msgid "TabSheet1"
     86msgstr ""
     87
     88#: tform1.tabsheet2.caption
     89msgid "TabSheet2"
     90msgstr ""
     91
     92#: tform1.tabsheet3.caption
     93msgid "TabSheet3"
     94msgstr ""
     95
    7296#: tformabout.caption
    7397msgctxt "tformabout.caption"
    … …  
    556580msgstr ""
    557581
     582#: ugame.szerozoomnotalowed
     583msgid "Zero zoom not allowed"
     584msgstr ""
     585

  • trunk/Packages/Common/Common.lpk

    r43 r91  
    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="19">
     18    <Files Count="20">
    2519      <Item1>
    2620        <Filename Value="StopWatch.pas"/>
    … …  
    106100        <UnitName Value="UFindFile"/>
    107101      </Item19>
     102      <Item20>
     103        <Filename Value="UScaleDPI.pas"/>
     104        <HasRegisterProc Value="True"/>
     105        <UnitName Value="UScaleDPI"/>
     106      </Item20>
    108107    </Files>
    109108    <i18n>

  • trunk/Packages/Common/Common.pas

    r43 r91  
    1111  UMemory, UResetableThread, UPool, ULastOpenedList, URegistry,
    1212  UJobProgressView, UXMLUtils, UApplicationInfo, USyncCounter, UListViewSort,
    13   UPersistentForm, UFindFile, LazarusPackageIntf;
     13  UPersistentForm, UFindFile, UScaleDPI, LazarusPackageIntf;
    1414
    1515implementation
    … …  
    2424  RegisterUnit('UPersistentForm', @UPersistentForm.Register);
    2525  RegisterUnit('UFindFile', @UFindFile.Register);
     26  RegisterUnit('UScaleDPI', @UScaleDPI.Register);
    2627end;
    2728

  • trunk/Packages/Common/ULastOpenedList.pas

    r43 r91  
    66
    77uses
    8   Classes, SysUtils, Registry, URegistry, Menus;
     8  Classes, SysUtils, Registry, URegistry, Menus, XMLConf;
    99
    1010type
    … …  
    2727    procedure LoadFromRegistry(Context: TRegistryContext);
    2828    procedure SaveToRegistry(Context: TRegistryContext);
     29    procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; Path: string);
     30    procedure SaveToXMLConfig(XMLConfig: TXMLConfig; Path: string);
    2931    procedure AddItem(FileName: string);
    3032  published
    … …  
    143145end;
    144146
     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
    145179procedure TLastOpenedList.AddItem(FileName:string);
    146180begin

  • trunk/UCore.lfm

    r79 r91  
    20532053    top = 320
    20542054  end
     2055  object ScaleDPI1: TScaleDPI
     2056    left = 245
     2057    top = 54
     2058  end
    20552059end

  • trunk/UCore.pas

    r83 r91  
    77uses
    88  Classes, SysUtils, XMLConf, FileUtil, ActnList, Controls, Dialogs, Forms,
    9   UGame, UApplicationInfo, UPersistentForm, UCoolTranslator;
     9  UGame, UApplicationInfo, UPersistentForm, UScaleDPI, UCoolTranslator;
    1010
    1111type
    … …  
    3131    PersistentForm: TPersistentForm;
    3232    SaveDialog1: TSaveDialog;
     33    ScaleDPI1: TScaleDPI;
    3334    XMLConfig1: TXMLConfig;
    3435    procedure AAboutExecute(Sender: TObject);
    … …  
    4647  private
    4748    FInitialized: Boolean;
     49    StoredDimension: TControlDimension;
    4850    procedure DoOnMove(CellFrom, CellTo: TCell; var CountOnce,
    4951      CountRepeat: Integer; Update: Boolean; var Confirm: Boolean);
    … …  
    157159  AutoSaveEnabled := XMLConfig1.GetValue('AutoSave', True);
    158160  CoolTranslator1.Language := CoolTranslator1.Languages.SearchByCode(XMLConfig1.GetValue('Language', ''));
     161  ScaleDPI1.DPI := Point(XMLConfig1.GetValue('DPIX', 96), XMLConfig1.GetValue('DPIY', 96));
     162  ScaleDPI1.AutoDetect := XMLConfig1.GetValue('DPIAuto', True);
    159163end;
    160164
    … …  
    166170  XMLConfig1.SetValue('AnimationSpeed', AnimationSpeed);
    167171  XMLConfig1.SetValue('AutoSave', AutoSaveEnabled);
     172  XMLConfig1.SetValue('DPIX', ScaleDPI1.DPI.X);
     173  XMLConfig1.SetValue('DPIY', ScaleDPI1.DPI.Y);
     174  XMLConfig1.SetValue('DPIAuto', ScaleDPI1.AutoDetect);
    168175end;
    169176
    … …  
    291298  Game.OnWin := DoOnWin;
    292299  Game.OnNewTurn := GameNewTurnExecute;
     300  StoredDimension := TControlDimension.Create;
    293301end;
    294302
    295303procedure TCore.DataModuleDestroy(Sender: TObject);
    296304begin
     305  StoredDimension.Free;;
    297306  Game.SaveConfig(XMLConfig1, 'Game');
    298307  SaveConfig;
    … …  
    314323  Game.Running := True;
    315324  FormMain.AZoomAll.Execute;
     325  {with Core.ScaleDPI1 do begin
     326    //ApplyToAll(DesignDPI);
     327    FormNew.Show;
     328    for I := 0 to Screen.FormCount - 1 do begin
     329      StoreDimensions(Screen.Forms[I], StoredDimension);
     330      ScaleDimensions(Screen.Forms[I], StoredDimension);
     331    end;
     332    FormNew.Hide;
     333    ScaleImageList(Core.ImageListSmall, DesignDPI);
     334    ScaleImageList(Core.ImageListLarge, DesignDPI);
     335  end;}
    316336end;
    317337

  • trunk/UGame.pas

    r90 r91  
    426426  SUnfinishedBattle = 'Unfinished battle';
    427427  SNewGameFile = 'New game.xtg';
     428  SZeroZoomNotAlowed = 'Zero zoom not allowed';
    428429
    429430procedure InitStrings;
    … …  
    14291430begin
    14301431  if FZoom = AValue then Exit;
     1432  if AValue = 0 then
     1433    raise Exception.Create(SZeroZoomNotAlowed);
    14311434  FZoom := AValue;
    14321435  SourceRect := Bounds(Trunc(SourceRect.Left + (SourceRect.Right - SourceRect.Left) div 2 - (DestRect.Right - DestRect.Left) / Zoom / 2),

  • trunk/xtactics.lpi

    r90 r91  
    9595        <Filename Value="UGame.pas"/>
    9696        <IsPartOfProject Value="True"/>
    97         <UnitName Value="UGame"/>
    9897      </Unit1>
    9998      <Unit2>
    … …  
    111110        <HasResources Value="True"/>
    112111        <ResourceBaseClass Value="Form"/>
    113         <UnitName Value="UFormPlayer"/>
    114112      </Unit3>
    115113      <Unit4>
    … …  
    119117        <HasResources Value="True"/>
    120118        <ResourceBaseClass Value="Form"/>
    121         <UnitName Value="UFormSettings"/>
    122119      </Unit4>
    123120      <Unit5>
    … …  
    127124        <HasResources Value="True"/>
    128125        <ResourceBaseClass Value="Form"/>
    129         <UnitName Value="UFormMain"/>
    130126      </Unit5>
    131127      <Unit6>
    … …  
    135131        <HasResources Value="True"/>
    136132        <ResourceBaseClass Value="Form"/>
    137         <UnitName Value="UFormMove"/>
    138133      </Unit6>
    139134      <Unit7>
    … …  
    143138        <HasResources Value="True"/>
    144139        <ResourceBaseClass Value="Form"/>
    145         <UnitName Value="UFormNew"/>
    146140      </Unit7>
    147141      <Unit8>
Note: See TracChangeset for help on using the changeset viewer.