Changeset 59
- Timestamp:
- Dec 3, 2014, 9:09:42 PM (10 years ago)
- Location:
- trunk
- Files:
-
- 6 added
- 28 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Forms/UFormCPU.lfm
r39 r59 7 7 ClientHeight = 287 8 8 ClientWidth = 414 9 LCLVersion = ' 0.9.31'9 LCLVersion = '1.3' 10 10 object Label4: TLabel 11 11 Left = 8 12 Height = 1813 Top = 4 214 Width = 8712 Height = 25 13 Top = 48 14 Width = 124 15 15 Caption = 'Step counter:' 16 16 ParentColor = False … … 18 18 object Label7: TLabel 19 19 Left = 8 20 Height = 1821 Top = 6222 Width = 4520 Height = 25 21 Top = 72 22 Width = 63 23 23 Caption = 'Speed:' 24 24 ParentColor = False 25 25 end 26 26 object LabelStepSpeed: TLabel 27 Left = 1 1928 Height = 1829 Top = 6230 Width = 1 327 Left = 192 28 Height = 25 29 Top = 72 30 Width = 15 31 31 Caption = ' ' 32 32 ParentColor = False 33 33 end 34 34 object LabelStepCounter: TLabel 35 Left = 1 1936 Height = 1837 Top = 4 238 Width = 1 335 Left = 192 36 Height = 25 37 Top = 48 38 Width = 15 39 39 Caption = ' ' 40 40 ParentColor = False 41 41 end 42 42 object LabelMemoryPointer: TLabel 43 Left = 1 1944 Height = 1843 Left = 192 44 Height = 25 45 45 Top = 24 46 Width = 1 346 Width = 15 47 47 Caption = ' ' 48 48 ParentColor = False 49 49 end 50 50 object LabelProgramPointer: TLabel 51 Left = 1 1952 Height = 1853 Top = 854 Width = 1 351 Left = 192 52 Height = 25 53 Top = 0 54 Width = 15 55 55 Caption = ' ' 56 56 ParentColor = False … … 58 58 object Label3: TLabel 59 59 Left = 8 60 Height = 1861 Top = 862 Width = 1 1060 Height = 25 61 Top = 0 62 Width = 159 63 63 Caption = 'Program pointer:' 64 64 ParentColor = False … … 66 66 object Label5: TLabel 67 67 Left = 8 68 Height = 1868 Height = 25 69 69 Top = 24 70 Width = 1 0870 Width = 156 71 71 Caption = 'Memory pointer:' 72 72 ParentColor = False -
trunk/Forms/UFormInput.lfm
r39 r59 7 7 ClientHeight = 240 8 8 ClientWidth = 320 9 LCLVersion = ' 0.9.31'9 LCLVersion = '1.3' 10 10 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 16 17 Font.Height = -12 17 18 Font.Name = 'Courier New' … … 22 23 end 23 24 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 28 31 Caption = 'Input:' 29 32 ParentColor = False -
trunk/Forms/UFormMain.lfm
r52 r59 1 1 object MainForm: TMainForm 2 Left = 2233 Height = 4304 Top = 1765 Width = 6702 Left = 408 3 Height = 586 4 Top = 311 5 Width = 860 6 6 Caption = 'LazFuck' 7 ClientHeight = 4118 ClientWidth = 6707 ClientHeight = 557 8 ClientWidth = 860 9 9 Menu = MainMenu1 10 10 OnCloseQuery = FormCloseQuery … … 12 12 OnDestroy = FormDestroy 13 13 OnShow = FormShow 14 LCLVersion = '1. 1'14 LCLVersion = '1.3' 15 15 WindowState = wsMaximized 16 16 object StatusBarMain: TStatusBar 17 17 Left = 0 18 Height = 2 019 Top = 39120 Width = 67018 Height = 29 19 Top = 528 20 Width = 860 21 21 Panels = < 22 22 item … … 35 35 Height = 26 36 36 Top = 0 37 Width = 67037 Width = 860 38 38 Images = ImageListMain 39 39 ParentShowHint = False … … 128 128 end 129 129 object PageControlRight: TPageControl 130 Left = 277131 Height = 365130 Left = 467 131 Height = 502 132 132 Top = 26 133 133 Width = 393 … … 139 139 object TabSheetDebug: TTabSheet 140 140 Caption = 'Debug' 141 ClientHeight = 357142 ClientWidth = 3 65141 ClientHeight = 496 142 ClientWidth = 315 143 143 object PanelInput: TPanel 144 144 Left = 0 145 145 Height = 64 146 146 Top = 0 147 Width = 3 65147 Width = 315 148 148 Align = alTop 149 149 BevelOuter = bvNone … … 155 155 Height = 5 156 156 Top = 64 157 Width = 3 65157 Width = 315 158 158 Align = alTop 159 159 ResizeAnchor = akTop … … 163 163 Height = 259 164 164 Top = 69 165 Width = 3 65165 Width = 315 166 166 Align = alTop 167 167 BevelOuter = bvNone … … 173 173 Height = 5 174 174 Top = 328 175 Width = 3 65175 Width = 315 176 176 Align = alTop 177 177 ResizeAnchor = akTop … … 181 181 Height = 86 182 182 Top = 333 183 Width = 3 65183 Width = 315 184 184 Align = alTop 185 185 BevelOuter = bvNone … … 190 190 Left = 0 191 191 Height = 5 192 Top = 357193 Width = 3 65192 Top = 419 193 Width = 315 194 194 Align = alTop 195 195 ResizeAnchor = akTop … … 197 197 object PanelMemory: TPanel 198 198 Left = 0 199 Height = 0200 Top = 357201 Width = 3 65199 Height = 72 200 Top = 424 201 Width = 315 202 202 Align = alClient 203 203 BevelOuter = bvNone … … 207 207 end 208 208 object Splitter1: TSplitter 209 Left = 272210 Height = 365209 Left = 462 210 Height = 502 211 211 Top = 26 212 212 Width = 5 … … 216 216 object PanelLeft: TPanel 217 217 Left = 0 218 Height = 365218 Height = 502 219 219 Top = 26 220 Width = 272220 Width = 462 221 221 Align = alClient 222 222 BevelOuter = bvNone 223 ClientHeight = 365224 ClientWidth = 272223 ClientHeight = 502 224 ClientWidth = 462 225 225 TabOrder = 4 226 226 object PageControlMain: TPageControl 227 227 Left = 0 228 Height = 242228 Height = 379 229 229 Top = 0 230 Width = 272230 Width = 462 231 231 ActivePage = TabSheetSource 232 232 Align = alClient … … 244 244 Left = 0 245 245 Height = 118 246 Top = 247247 Width = 272246 Top = 384 247 Width = 462 248 248 ActivePage = TabSheetMessages 249 249 Align = alBottom … … 259 259 Left = 0 260 260 Height = 5 261 Top = 242262 Width = 272261 Top = 379 262 Width = 462 263 263 Align = alBottom 264 264 ResizeAnchor = akBottom -
trunk/Forms/UFormMain.pas
r57 r59 197 197 procedure TMainForm.FormShow(Sender: TObject); 198 198 begin 199 with Core.ScaleDPI do begin 200 ApplyToAll(DesignDPI); 201 ScaleImageList(ImageListMain, DesignDPI); 202 end; 199 203 Core.CoolTranslator1.Translate; 200 204 LoadFromRegistry(HKEY(Core.ApplicationInfo.RegistryRoot), Core.ApplicationInfo.RegistryKey); … … 446 450 procedure TMainForm.AOptionsExecute(Sender: TObject); 447 451 begin 452 OptionsForm.Load; 448 453 //OptionsForm.LoadFromInterpretter(CurrentTarget); 449 454 if OptionsForm.ShowModal = mrOK then begin 450 455 //OptionsForm.SaveToInterpretter(CurrentTarget); 456 OptionsForm.Save; 451 457 end; 452 458 end; -
trunk/Forms/UFormMemory.lfm
r39 r59 7 7 ClientHeight = 259 8 8 ClientWidth = 391 9 LCLVersion = ' 0.9.31'9 LCLVersion = '1.3' 10 10 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 15 17 Caption = 'Memory:' 16 18 ParentColor = False 17 19 end 18 20 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 24 27 Columns = < 25 28 item -
trunk/Forms/UFormOptions.lfm
r37 r59 8 8 ClientWidth = 468 9 9 OnShow = FormShow 10 LCLVersion = ' 0.9.31'10 LCLVersion = '1.3' 11 11 object ButtonOk: TButton 12 12 Left = 389 … … 31 31 end 32 32 object SpinEditCellSize: TSpinEdit 33 Left = 1 3634 Height = 2133 Left = 165 34 Height = 35 35 35 Top = 40 36 36 Width = 130 … … 39 39 end 40 40 object SpinEditMemorySize: TSpinEdit 41 Left = 1 3642 Height = 2141 Left = 165 42 Height = 35 43 43 Top = 6 44 44 Width = 130 … … 48 48 object Label1: TLabel 49 49 Left = 8 50 Height = 1450 Height = 25 51 51 Top = 8 52 Width = 6452 Width = 123 53 53 Caption = 'Memory size:' 54 54 ParentColor = False … … 56 56 object Label2: TLabel 57 57 Left = 8 58 Height = 1458 Height = 25 59 59 Top = 40 60 Width = 4360 Width = 79 61 61 Caption = 'Cell size:' 62 62 ParentColor = False … … 64 64 object Label3: TLabel 65 65 Left = 8 66 Height = 1466 Height = 25 67 67 Top = 95 68 Width = 9768 Width = 179 69 69 Caption = 'Interface language:' 70 70 ParentColor = False … … 72 72 object CheckBox1: TCheckBox 73 73 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 77 79 Caption = 'Reopend last opened project' 78 80 TabOrder = 4 79 81 end 80 82 object ComboBoxLanguage: TComboBox 81 Left = 16282 Height = 2183 Top = 8 683 Left = 248 84 Height = 37 85 Top = 83 84 86 Width = 188 85 ItemHeight = 1387 ItemHeight = 0 86 88 Style = csDropDownList 87 89 TabOrder = 5 88 90 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 89 138 end -
trunk/Forms/UFormOptions.pas
r51 r59 1 1 unit UFormOptions; 2 2 3 {$mode objfpc}{$H+}3 {$mode delphi}{$H+} 4 4 5 5 interface … … 7 7 uses 8 8 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, 9 Spin, ComCtrls,UTargetInterpretter;9 Spin, UTargetInterpretter; 10 10 11 11 type … … 17 17 ButtonCancel: TButton; 18 18 CheckBox1: TCheckBox; 19 CheckBoxDPIAuto: TCheckBox; 19 20 ComboBoxLanguage: TComboBox; 20 21 Label1: TLabel; 21 22 Label2: TLabel; 22 23 Label3: TLabel; 24 LabelDPI: TLabel; 25 LabelX: TLabel; 26 SpinEditDPIX: TSpinEdit; 27 SpinEditDPIY: TSpinEdit; 23 28 SpinEditCellSize: TSpinEdit; 24 29 SpinEditMemorySize: TSpinEdit; 25 30 procedure ButtonOkClick(Sender: TObject); 31 procedure CheckBoxDPIAutoChange(Sender: TObject); 26 32 procedure FormShow(Sender: TObject); 27 33 private 28 34 { private declarations } 29 35 public 36 procedure UpdateInterface; 37 procedure Load; 38 procedure Save; 30 39 procedure LoadFromInterpretter(Interpretter: TTargetInterpretter); 31 40 procedure SaveToInterpretter(Interpretter: TTargetInterpretter); … … 52 61 end; 53 62 63 procedure TOptionsForm.UpdateInterface; 64 begin 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; 73 end; 74 75 procedure TOptionsForm.Load; 76 begin 77 SpinEditDPIX.Value := Core.ScaleDPI.DPI.X; 78 SpinEditDPIY.Value := Core.ScaleDPI.DPI.Y; 79 CheckBoxDPIAuto.Checked := Core.ScaleDPI.AutoDetect; 80 UpdateInterface; 81 end; 82 83 procedure TOptionsForm.Save; 84 begin 85 Core.ScaleDPI.DPI.X := SpinEditDPIX.Value; 86 Core.ScaleDPI.DPI.Y := SpinEditDPIY.Value; 87 Core.ScaleDPI.AutoDetect := CheckBoxDPIAuto.Checked; 88 end; 89 54 90 procedure TOptionsForm.ButtonOkClick(Sender: TObject); 55 91 begin … … 57 93 Core.CoolTranslator1.Language := TLanguage(ComboBoxLanguage.Items.Objects[ComboBoxLanguage.ItemIndex]); 58 94 Core.OpenProjectOnStart := CheckBox1.Checked; 95 end; 96 97 procedure TOptionsForm.CheckBoxDPIAutoChange(Sender: TObject); 98 begin 99 UpdateInterface; 59 100 end; 60 101 -
trunk/Forms/UFormOutput.lfm
r39 r59 1 1 object FormOutput: TFormOutput 2 2 Left = 256 3 Height = 2403 Height = 440 4 4 Top = 32 5 5 Width = 320 6 6 Caption = 'Output' 7 ClientHeight = 2407 ClientHeight = 440 8 8 ClientWidth = 320 9 LCLVersion = ' 0.9.31'9 LCLVersion = '1.3' 10 10 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 15 17 Caption = 'Output:' 16 18 ParentColor = False 17 19 end 18 20 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 24 27 Font.Height = -12 25 28 Font.Name = 'Courier New' -
trunk/Languages/LazFuckIDE.cs.po
r58 r59 521 521 msgstr "OtevÅÃt naposledy otevÅenÃœ projekt" 522 522 523 #: toptionsform.checkboxdpiauto.caption 524 msgid "Automatic DPI" 525 msgstr "Automatické DPI" 526 523 527 #: toptionsform.label1.caption 524 528 msgid "Memory size:" … … 532 536 msgid "Interface language:" 533 537 msgstr "Jazyk rozhranÃ:" 538 539 #: toptionsform.labeldpi.caption 540 msgctxt "toptionsform.labeldpi.caption" 541 msgid "DPI:" 542 msgstr "DPI:" 543 544 #: toptionsform.labelx.caption 545 msgctxt "toptionsform.labelx.caption" 546 msgid "x" 547 msgstr "x" 534 548 535 549 #: ubrainfuck.sjumptablecolision -
trunk/Languages/LazFuckIDE.po
r52 r59 508 508 msgstr "" 509 509 510 #: toptionsform.checkboxdpiauto.caption 511 msgid "Automatic DPI" 512 msgstr "" 513 510 514 #: toptionsform.label1.caption 511 515 msgid "Memory size:" … … 518 522 #: toptionsform.label3.caption 519 523 msgid "Interface language:" 524 msgstr "" 525 526 #: toptionsform.labeldpi.caption 527 msgctxt "TOPTIONSFORM.LABELDPI.CAPTION" 528 msgid "DPI:" 529 msgstr "" 530 531 #: toptionsform.labelx.caption 532 msgctxt "TOPTIONSFORM.LABELX.CAPTION" 533 msgid "x" 520 534 msgstr "" 521 535 -
trunk/LazFuckIDE.lpi
r55 r59 1 <?xml version="1.0" ?>1 <?xml version="1.0" encoding="UTF-8"?> 2 2 <CONFIG> 3 3 <ProjectOptions> … … 10 10 <ResourceType Value="res"/> 11 11 <UseXPManifest Value="True"/> 12 <XPManifest> 13 <DpiAware Value="True"/> 14 </XPManifest> 12 15 <Icon Value="0"/> 13 16 </General> … … 19 22 <StringTable ProductVersion=""/> 20 23 </VersionInfo> 24 <MacroValues Count="1"/> 21 25 <BuildModes Count="2"> 22 26 <Item1 Name="Debug" Default="True"/> … … 53 57 </Options> 54 58 </Linking> 55 <Other>56 <CompilerMessages>57 <MsgFileName Value=""/>58 </CompilerMessages>59 <CompilerPath Value="$(CompPath)"/>60 </Other>61 59 </CompilerOptions> 62 60 </Item2> 61 <SharedMatrixOptions Count="1"> 62 <Item1 ID="509373414797" Modes="Debug" Type="IDEMacro"/> 63 </SharedMatrixOptions> 63 64 </BuildModes> 64 65 <PublishOptions> … … 70 71 <local> 71 72 <FormatVersion Value="1"/> 72 <LaunchingApplication PathPlusParams="\usr\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>73 73 </local> 74 74 </RunParams> 75 <RequiredPackages Count=" 5">75 <RequiredPackages Count="6"> 76 76 <Item1> 77 <PackageName Value="FCL"/> 78 </Item1> 79 <Item2> 77 80 <PackageName Value="CoolTranslator"/> 78 81 <DefaultFilename Value="Packages\CoolTranslator\CoolTranslator.lpk" Prefer="True"/> 79 </Item 1>80 <Item 2>82 </Item2> 83 <Item3> 81 84 <PackageName Value="TemplateGenerics"/> 82 85 <DefaultFilename Value="Packages\TemplateGenerics\TemplateGenerics.lpk" Prefer="True"/> 83 </Item 2>84 <Item 3>86 </Item3> 87 <Item4> 85 88 <PackageName Value="Common"/> 86 89 <DefaultFilename Value="Packages\Common\Common.lpk" Prefer="True"/> 87 </Item3>88 <Item4>89 <PackageName Value="SynEdit"/>90 90 </Item4> 91 91 <Item5> 92 <PackageName Value="SynEdit"/> 93 </Item5> 94 <Item6> 92 95 <PackageName Value="LCL"/> 93 </Item 5>96 </Item6> 94 97 </RequiredPackages> 95 98 <Units Count="19"> … … 97 100 <Filename Value="LazFuckIDE.lpr"/> 98 101 <IsPartOfProject Value="True"/> 99 <UnitName Value="LazFuckIDE"/>100 102 </Unit0> 101 103 <Unit1> … … 129 131 <HasResources Value="True"/> 130 132 <ResourceBaseClass Value="Form"/> 131 <UnitName Value="UFormTargets"/>132 133 </Unit4> 133 134 <Unit5> … … 176 177 <IsPartOfProject Value="True"/> 177 178 <ComponentName Value="FormMemory"/> 179 <HasResources Value="True"/> 178 180 <ResourceBaseClass Value="Form"/> 179 181 <UnitName Value="UFormMemory"/> … … 197 199 <HasResources Value="True"/> 198 200 <ResourceBaseClass Value="Form"/> 199 <UnitName Value="UFormSourceCode"/>200 201 </Unit15> 201 202 <Unit16> … … 205 206 <HasResources Value="True"/> 206 207 <ResourceBaseClass Value="Form"/> 207 <UnitName Value="UFormTargetCode"/>208 208 </Unit16> 209 209 <Unit17> … … 239 239 <SyntaxOptions> 240 240 <SyntaxMode Value="Delphi"/> 241 <CStyleOperator Value="False"/> 242 <AllowLabel Value="False"/> 243 <CPPInline Value="False"/> 241 244 </SyntaxOptions> 242 245 </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>251 246 <Linking> 252 247 <Options> … … 256 251 </Options> 257 252 </Linking> 258 <Other>259 <CompilerMessages>260 <MsgFileName Value=""/>261 </CompilerMessages>262 <CompilerPath Value="$(CompPath)"/>263 </Other>264 253 </CompilerOptions> 265 254 <Debugging> -
trunk/Packages/Common/Common.lpk
r54 r59 1 <?xml version="1.0" ?>1 <?xml version="1.0" encoding="UTF-8"?> 2 2 <CONFIG> 3 3 <Package Version="4"> … … 12 12 <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 13 13 </SearchPaths> 14 <Other>15 <CompilerMessages>16 <UseMsgFile Value="True"/>17 </CompilerMessages>18 <CompilerPath Value="$(CompPath)"/>19 </Other>20 14 </CompilerOptions> 21 15 <Description Value="Various libraries"/> 22 16 <License Value="GNU/GPL"/> 23 17 <Version Minor="7"/> 24 <Files Count=" 15">18 <Files Count="20"> 25 19 <Item1> 26 20 <Filename Value="StopWatch.pas"/> … … 87 81 <UnitName Value="UApplicationInfo"/> 88 82 </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> 89 106 </Files> 90 107 <i18n> -
trunk/Packages/Common/Common.pas
r54 r59 10 10 StopWatch, UCommon, UDebugLog, UDelay, UPrefixMultiplier, UURI, UThreading, 11 11 UMemory, UResetableThread, UPool, ULastOpenedList, URegistry, 12 UJobProgressView, UXMLUtils, UApplicationInfo, LazarusPackageIntf; 12 UJobProgressView, UXMLUtils, UApplicationInfo, USyncCounter, UListViewSort, 13 UPersistentForm, UFindFile, UScaleDPI, LazarusPackageIntf; 13 14 14 15 implementation … … 20 21 RegisterUnit('UJobProgressView', @UJobProgressView.Register); 21 22 RegisterUnit('UApplicationInfo', @UApplicationInfo.Register); 23 RegisterUnit('UListViewSort', @UListViewSort.Register); 24 RegisterUnit('UPersistentForm', @UPersistentForm.Register); 25 RegisterUnit('UFindFile', @UFindFile.Register); 22 26 end; 23 27 -
trunk/Packages/Common/UApplicationInfo.pas
r54 r59 55 55 procedure Register; 56 56 begin 57 RegisterComponents(' Samples', [TApplicationInfo]);57 RegisterComponents('Common', [TApplicationInfo]); 58 58 end; 59 59 -
trunk/Packages/Common/UCommon.pas
r55 r59 48 48 function LoggedOnUserNameEx(Format: TUserNameFormat): string; 49 49 function SplitString(var Text: string; Count: Word): string; 50 function GetBitCount(Variable: QWord; MaxIndex: Integer): Integer; 50 51 function GetBit(Variable: QWord; Index: Byte): Boolean; 52 procedure SetBit(var Variable: Int64; Index: Byte; State: Boolean); overload; 51 53 procedure SetBit(var Variable: QWord; Index: Byte; State: Boolean); overload; 52 54 procedure SetBit(var Variable: Cardinal; Index: Byte; State: Boolean); overload; … … 336 338 end; 337 339 340 function GetBitCount(Variable: QWord; MaxIndex: Integer): Integer; 341 var 342 I: Integer; 343 begin 344 Result := 0; 345 for I := 0 to MaxIndex - 1 do 346 if ((Variable shr I) and 1) = 1 then Inc(Result); 347 end; 348 338 349 function GetBit(Variable:QWord;Index:Byte):Boolean; 339 350 begin … … 341 352 end; 342 353 354 procedure SetBit(var Variable: Int64; Index: Byte; State: Boolean); 355 begin 356 Variable := (Variable and ((1 shl Index) xor High(QWord))) or (Int64(State) shl Index); 357 end; 358 343 359 procedure SetBit(var Variable:QWord;Index:Byte;State:Boolean); overload; 344 360 begin 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); 346 362 end; 347 363 348 364 procedure SetBit(var Variable:Cardinal;Index:Byte;State:Boolean); overload; 349 365 begin 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); 351 367 end; 352 368 353 369 procedure SetBit(var Variable:Word;Index:Byte;State:Boolean); overload; 354 370 begin 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); 356 372 end; 357 373 -
trunk/Packages/Common/UDebugLog.pas
r54 r59 31 31 Items: TListObject; 32 32 Lock: TCriticalSection; 33 procedure Add( Group: string; Text: string);33 procedure Add(Text: string; Group: string = ''); 34 34 procedure WriteToFile(Text: string); 35 35 constructor Create(AOwner: TComponent); override; … … 52 52 procedure Register; 53 53 begin 54 RegisterComponents(' Samples', [TDebugLog]);54 RegisterComponents('Common', [TDebugLog]); 55 55 end; 56 56 … … 69 69 end; 70 70 71 procedure TDebugLog.Add( Group: string; Text: string);71 procedure TDebugLog.Add(Text: string; Group: string = ''); 72 72 var 73 73 NewItem: TDebugLogItem; -
trunk/Packages/Common/UFindFile.pas
r54 r59 64 64 procedure Register; 65 65 begin 66 RegisterComponents(' Samples', [TFindFile]);66 RegisterComponents('Common', [TFindFile]); 67 67 end; 68 68 -
trunk/Packages/Common/UJobProgressView.lfm
r54 r59 28 28 object LabelOperation: TLabel 29 29 Left = 8 30 Height = 1 430 Height = 13 31 31 Top = 8 32 Width = 6 732 Width = 66 33 33 Caption = 'Operations:' 34 34 Font.Height = -11 … … 80 80 object LabelEstimatedTimePart: TLabel 81 81 Left = 8 82 Height = 1 482 Height = 13 83 83 Top = -2 84 Width = 7 284 Width = 71 85 85 Caption = 'Estimated time:' 86 86 ParentColor = False … … 132 132 object LabelEstimatedTimeTotal: TLabel 133 133 Left = 8 134 Height = 1 4134 Height = 13 135 135 Top = 0 136 Width = 9 8136 Width = 97 137 137 Caption = 'Total estimated time:' 138 138 ParentColor = False -
trunk/Packages/Common/UJobProgressView.pas
r54 r59 111 111 Finished: Boolean; 112 112 FOnJobFinish: TJobProgressViewMethod; 113 FOnOwnerDraw: TNotifyEvent; 114 FOwnerDraw: Boolean; 113 115 FShowDelay: Integer; 114 116 FTerminate: Boolean; … … 116 118 TotalStartTime: TDateTime; 117 119 Log: TStringList; 118 Form: TFormJobProgressView;119 120 procedure SetTerminate(const AValue: Boolean); 120 121 procedure UpdateProgress; … … 122 123 procedure StartJobs; 123 124 procedure UpdateHeight; 125 procedure JobProgressChange(Sender: TObject); 124 126 public 127 Form: TFormJobProgressView; 125 128 Jobs: TObjectList; // TListObject<TJob> 126 129 CurrentJob: TJob; … … 136 139 property Terminate: Boolean read FTerminate write SetTerminate; 137 140 published 141 property OwnerDraw: Boolean read FOwnerDraw write FOwnerDraw; 138 142 property ShowDelay: Integer read FShowDelay write FShowDelay; 139 143 property AutoClose: Boolean read FAutoClose write FAutoClose; 140 144 property OnJobFinish: TJobProgressViewMethod read FOnJobFinish 141 145 write FOnJobFinish; 146 property OnOwnerDraw: TNotifyEvent read FOnOwnerDraw 147 write FOnOwnerDraw; 142 148 end; 143 149 … … 163 169 procedure Register; 164 170 begin 165 RegisterComponents(' Samples', [TJobProgressView]);171 RegisterComponents('Common', [TJobProgressView]); 166 172 end; 167 173 … … 196 202 NewJob.Progress.Max := 100; 197 203 NewJob.Progress.Reset; 204 NewJob.Progress.OnChange := JobProgressChange; 198 205 Jobs.Add(NewJob); 199 206 //ReloadJobList; … … 212 219 Terminate := False; 213 220 214 Form.BringToFront;221 if not OwnerDraw then Form.BringToFront; 215 222 216 223 Finished := False; … … 244 251 CurrentJobIndex := I; 245 252 CurrentJob := TJob(Jobs[I]); 253 JobProgressChange(Self); 246 254 StartTime := Now; 247 255 Form.LabelEstimatedTimePart.Caption := Format(SEstimatedTime, ['']); … … 339 347 end; 340 348 349 procedure TJobProgressView.JobProgressChange(Sender: TObject); 350 begin 351 if Assigned(FOnOwnerDraw) then 352 FOnOwnerDraw(Self); 353 end; 354 341 355 procedure TFormJobProgressView.TimerUpdateTimer(Sender: TObject); 342 356 var … … 357 371 if not Visible then begin 358 372 TimerUpdate.Interval := UpdateInterval; 359 Show;373 if not JobProgressView.OwnerDraw then Show; 360 374 end; 361 375 end; … … 509 523 destructor TJobProgressView.Destroy; 510 524 begin 511 Log.Free;512 Jobs.Free;513 inherited Destroy;525 FreeAndNil(Log); 526 FreeAndNil(Jobs); 527 inherited; 514 528 end; 515 529 … … 519 533 FLock.Acquire; 520 534 FMax := AValue; 535 if FMax < 1 then FMax := 1; 521 536 if FValue >= FMax then FValue := FMax; 522 537 finally … … 610 625 begin 611 626 Progress.Free; 612 inherited Destroy;627 inherited; 613 628 end; 614 629 -
trunk/Packages/Common/ULastOpenedList.pas
r55 r59 6 6 7 7 uses 8 Classes, SysUtils, Registry, URegistry, Menus ;8 Classes, SysUtils, Registry, URegistry, Menus, XMLConf; 9 9 10 10 type … … 18 18 procedure SetMaxCount(AValue: Integer); 19 19 procedure LimitMaxCount; 20 procedure ItemsChange(Sender: TObject); 21 procedure DoChange; 20 22 public 21 23 Items: TStringList; … … 25 27 procedure LoadFromRegistry(Context: TRegistryContext); 26 28 procedure SaveToRegistry(Context: TRegistryContext); 29 procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; Path: string); 30 procedure SaveToXMLConfig(XMLConfig: TXMLConfig; Path: string); 27 31 procedure AddItem(FileName: string); 28 32 published … … 38 42 procedure Register; 39 43 begin 40 RegisterComponents(' Samples', [TLastOpenedList]);44 RegisterComponents('Common', [TLastOpenedList]); 41 45 end; 42 46 … … 58 62 end; 59 63 64 procedure TLastOpenedList.ItemsChange(Sender: TObject); 65 begin 66 DoChange; 67 end; 68 69 procedure TLastOpenedList.DoChange; 70 begin 71 if Assigned(FOnChange) then 72 FOnChange(Self); 73 end; 74 60 75 constructor TLastOpenedList.Create(AOwner: TComponent); 61 76 begin 62 77 inherited; 63 78 Items := TStringList.Create; 79 Items.OnChange := ItemsChange; 64 80 MaxCount := 10; 65 81 end; … … 129 145 end; 130 146 147 procedure TLastOpenedList.LoadFromXMLConfig(XMLConfig: TXMLConfig; Path: string 148 ); 149 var 150 I: Integer; 151 Value: string; 152 Count: Integer; 153 begin 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; 165 end; 166 167 procedure TLastOpenedList.SaveToXMLConfig(XMLConfig: TXMLConfig; Path: string); 168 var 169 I: Integer; 170 begin 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; 177 end; 178 131 179 procedure TLastOpenedList.AddItem(FileName:string); 132 180 begin … … 134 182 Items.Insert(0, FileName); 135 183 LimitMaxCount; 136 if Assigned(FOnChange) then 137 FOnChange(Self); 184 DoChange; 138 185 end; 139 186 -
trunk/Packages/Common/UMemory.pas
r55 r59 24 24 constructor Create; 25 25 destructor Destroy; override; 26 procedure WriteMemory(Position: Integer; Memory: TMemory);27 procedure ReadMemory(Position: Integer; Memory: TMemory);28 26 property Data: PByte read FData; 29 27 property Size: Integer read FSize write SetSize; … … 110 108 end; 111 109 112 procedure TMemory.WriteMemory(Position: Integer; Memory: TMemory);113 begin114 Move(Memory.FData, PByte(@FData + Position)^, Memory.Size);115 end;116 117 procedure TMemory.ReadMemory(Position: Integer; Memory: TMemory);118 begin119 Move(PByte(@FData + Position)^, Memory.FData, Memory.Size);120 end;121 122 110 end. 123 111 -
trunk/Packages/Common/URegistry.pas
r55 r59 17 17 rrKeyDynData = HKEY($80000006)); 18 18 19 { TRegistryContext } 20 19 21 TRegistryContext = record 20 22 RootKey: HKEY; 21 23 Key: string; 24 class operator Equal(A, B: TRegistryContext): Boolean; 22 25 end; 23 26 … … 26 29 TRegistryEx = class(TRegistry) 27 30 private 31 function GetCurrentContext: TRegistryContext; 32 procedure SetCurrentContext(AValue: TRegistryContext); 28 33 public 29 34 function ReadBoolWithDefault(const Name: string; … … 35 40 function DeleteKeyRecursive(const Key: string): Boolean; 36 41 function OpenKey(const Key: string; CanCreate: Boolean): Boolean; 42 property CurrentContext: TRegistryContext read GetCurrentContext write SetCurrentContext; 37 43 end; 38 44 … … 46 52 Result.RootKey := RootKey; 47 53 Result.Key := Key; 54 end; 55 56 { TRegistryContext } 57 58 class operator TRegistryContext.Equal(A, B: TRegistryContext): Boolean; 59 begin 60 Result := (A.Key = B.Key) and (A.RootKey = B.RootKey); 48 61 end; 49 62 … … 106 119 end; 107 120 121 function TRegistryEx.GetCurrentContext: TRegistryContext; 122 begin 123 Result.Key := CurrentPath; 124 Result.RootKey := RootKey; 125 end; 126 127 procedure TRegistryEx.SetCurrentContext(AValue: TRegistryContext); 128 begin 129 RootKey := AValue.RootKey; 130 OpenKey(AValue.Key, True); 131 end; 132 108 133 function TRegistryEx.ReadBoolWithDefault(const Name: string; 109 134 DefaultValue: Boolean): Boolean; -
trunk/Packages/Common/UResetableThread.pas
r54 r59 104 104 105 105 procedure TResetableThread.WaitForStart; 106 var107 WaitResult: TWaitResult;106 //var 107 // WaitResult: TWaitResult; 108 108 begin 109 109 //try … … 127 127 128 128 procedure TResetableThread.WaitForStop; 129 var130 WaitState: TWaitResult;129 //var 130 // WaitState: TWaitResult; 131 131 begin 132 132 try -
trunk/Packages/Common/UURI.pas
r54 r59 326 326 Drive := Drive + DriveSeparator; 327 327 end else Drive := ''; 328 Directory.AsString := AValue; 328 if (Drive <> '') and (AValue = '') then 329 Directory.AsString := Directory.DirSeparator 330 else Directory.AsString := AValue; 329 331 end; 330 332 -
trunk/Target/UTargetPHP.pas
r52 r59 91 91 Inc(FProgramIndex); 92 92 end; 93 AddLine('');94 AddLine('?>');95 93 96 94 CompileToFile; -
trunk/UCore.lfm
r51 r59 4 4 OldCreateOrder = False 5 5 Height = 289 6 HorizontalOffset = 4217 VerticalOffset = 1876 HorizontalOffset = 529 7 VerticalOffset = 296 8 8 Width = 339 9 9 object ApplicationInfo: TApplicationInfo … … 22 22 RegistryKey = '\Software\Chronosoft\LazFuck' 23 23 RegistryRoot = rrKeyCurrentUser 24 left = 5624 left = 72 25 25 top = 16 26 26 end 27 27 object CoolTranslator1: TCoolTranslator 28 28 POFilesFolder = 'Languages' 29 left = 4829 left = 72 30 30 top = 72 31 31 end 32 32 object LastOpenedList: TLastOpenedList 33 33 MaxCount = 10 34 left = 4834 left = 72 35 35 top = 128 36 36 end -
trunk/UCore.pas
r55 r59 7 7 uses 8 8 Classes, SysUtils, FileUtil, UApplicationInfo, ULastOpenedList, 9 UCoolTranslator, UTarget, URegistry, Registry ;9 UCoolTranslator, UTarget, URegistry, Registry, XMLConf, Graphics, UScaleDPI; 10 10 11 11 type … … 21 21 private 22 22 public 23 ScaleDPI: TScaleDPI; 23 24 Modified: Boolean; 24 25 ProjectFileName: string; … … 31 32 var 32 33 Core: TCore; 34 33 35 34 36 implementation … … 44 46 procedure TCore.DataModuleCreate(Sender: TObject); 45 47 begin 48 ScaleDPI := TScaleDPI.Create; 46 49 Targets := TTargetList.Create; 47 50 Targets.Add(TTargetInterpretter.Create); … … 57 60 SaveToRegistry(HKEY(ApplicationInfo.RegistryRoot), ApplicationInfo.RegistryKey); 58 61 Targets.Free; 62 ScaleDPI.Free; 59 63 end; 60 64 … … 71 75 CoolTranslator1.Language := CoolTranslator1.Languages.SearchByCode(ReadStringWithDefault('LanguageCode', '')) 72 76 else CoolTranslator1.Language := CoolTranslator1.Languages.SearchByCode(''); 77 ScaleDPI.DPI := Point(ReadIntegerWithDefault('DPIX', 96), 78 ReadIntegerWithDefault('DPIY', 96)); 79 ScaleDPI.AutoDetect := ReadBoolWithDefault('DPIAuto', True); 73 80 finally 74 81 Free; … … 87 94 OpenKey(Key, True); 88 95 WriteBool('OpenProjectOnStart', OpenProjectOnStart); 96 WriteBool('DPIAuto', ScaleDPI.AutoDetect); 97 WriteInteger('DPIX', ScaleDPI.DPI.X); 98 WriteInteger('DPIY', ScaleDPI.DPI.Y); 89 99 if Assigned(CoolTranslator1.Language) and (CoolTranslator1.Language.Code <> '') then 90 100 WriteString('LanguageCode', CoolTranslator1.Language.Code)
Note:
See TracChangeset
for help on using the changeset viewer.