- Timestamp:
- May 8, 2019, 11:54:23 AM (6 years ago)
- Location:
- trunk
- Files:
-
- 8 added
- 5 deleted
- 40 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/CoolDisk.lpi
r40 r41 2 2 <CONFIG> 3 3 <ProjectOptions> 4 <Version Value=" 9"/>4 <Version Value="11"/> 5 5 <General> 6 6 <SessionStorage Value="InProjectDir"/> … … 18 18 <OutDir Value="Languages"/> 19 19 </i18n> 20 <VersionInfo> 21 <StringTable ProductVersion=""/> 22 </VersionInfo> 23 <BuildModes Count="4"> 20 <BuildModes Count="2"> 24 21 <Item1 Name="Debug" Default="True"/> 25 22 <Item2 Name="Release"> … … 32 29 <IncludeFiles Value="$(ProjOutDir)"/> 33 30 <OtherUnitFiles Value="Forms"/> 34 <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS) "/>31 <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)-$(BuildMode)"/> 35 32 </SearchPaths> 36 33 <Parsing> … … 61 58 </CompilerOptions> 62 59 </Item2> 63 <Item3 Name="Windows 32-bit"> 64 <CompilerOptions> 65 <Version Value="11"/> 66 <Target> 67 <Filename Value="lib/$(TargetCPU)-$(TargetOS)/CoolDisk"/> 68 </Target> 69 <SearchPaths> 70 <IncludeFiles Value="$(ProjOutDir)"/> 71 <OtherUnitFiles Value="Forms"/> 72 <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> 73 </SearchPaths> 74 <Parsing> 75 <SyntaxOptions> 76 <SyntaxMode Value="Delphi"/> 77 <CStyleOperator Value="False"/> 78 <AllowLabel Value="False"/> 79 <CPPInline Value="False"/> 80 </SyntaxOptions> 81 </Parsing> 82 <CodeGeneration> 83 <SmartLinkUnit Value="True"/> 84 <TargetCPU Value="i386"/> 85 <TargetOS Value="win32"/> 86 <Optimizations> 87 <OptimizationLevel Value="3"/> 88 </Optimizations> 89 </CodeGeneration> 90 <Linking> 91 <Debugging> 92 <GenerateDebugInfo Value="False"/> 93 </Debugging> 94 <LinkSmart Value="True"/> 95 <Options> 96 <Win32> 97 <GraphicApplication Value="True"/> 98 </Win32> 99 </Options> 100 </Linking> 101 </CompilerOptions> 102 </Item3> 103 <Item4 Name="Windows 64-bit"> 104 <CompilerOptions> 105 <Version Value="11"/> 106 <Target> 107 <Filename Value="lib/$(TargetCPU)-$(TargetOS)/CoolDisk"/> 108 </Target> 109 <SearchPaths> 110 <IncludeFiles Value="$(ProjOutDir)"/> 111 <OtherUnitFiles Value="Forms"/> 112 <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> 113 </SearchPaths> 114 <Parsing> 115 <SyntaxOptions> 116 <SyntaxMode Value="Delphi"/> 117 <CStyleOperator Value="False"/> 118 <AllowLabel Value="False"/> 119 <CPPInline Value="False"/> 120 </SyntaxOptions> 121 </Parsing> 122 <CodeGeneration> 123 <SmartLinkUnit Value="True"/> 124 <TargetCPU Value="x86_64"/> 125 <TargetOS Value="win64"/> 126 <Optimizations> 127 <OptimizationLevel Value="3"/> 128 </Optimizations> 129 </CodeGeneration> 130 <Linking> 131 <Debugging> 132 <GenerateDebugInfo Value="False"/> 133 </Debugging> 134 <LinkSmart Value="True"/> 135 <Options> 136 <Win32> 137 <GraphicApplication Value="True"/> 138 </Win32> 139 </Options> 140 </Linking> 141 </CompilerOptions> 142 </Item4> 60 <SharedMatrixOptions Count="2"> 61 <Item1 ID="307887130071" Targets="Common, CoolTranslator" Modes="Debug" Value="-g -gl -gh -CirotR -O1"/> 62 <Item2 ID="977980535563" Targets="Common, CoolTranslator" Modes="Release" Value="-CX -XX -O3"/> 63 </SharedMatrixOptions> 143 64 </BuildModes> 144 65 <PublishOptions> … … 146 67 </PublishOptions> 147 68 <RunParams> 148 <local> 149 <FormatVersion Value="1"/> 150 </local> 69 <FormatVersion Value="2"/> 70 <Modes Count="1"> 71 <Mode0 Name="default"/> 72 </Modes> 151 73 </RunParams> 152 <RequiredPackages Count=" 6">74 <RequiredPackages Count="5"> 153 75 <Item1> 154 76 <PackageName Value="CoolTranslator"/> … … 159 81 </Item2> 160 82 <Item3> 161 <PackageName Value=" TemplateGenerics"/>162 <DefaultFilename Value="Packages/ TemplateGenerics/TemplateGenerics.lpk" Prefer="True"/>83 <PackageName Value="Common"/> 84 <DefaultFilename Value="Packages/Common/Common.lpk" Prefer="True"/> 163 85 </Item3> 164 86 <Item4> 165 <PackageName Value="Common"/> 166 <DefaultFilename Value="Packages/Common/Common.lpk" Prefer="True"/> 87 <PackageName Value="tachartlazaruspkg"/> 167 88 </Item4> 168 89 <Item5> 169 <PackageName Value=" tachartlazaruspkg"/>90 <PackageName Value="LCL"/> 170 91 </Item5> 171 <Item6>172 <PackageName Value="LCL"/>173 </Item6>174 92 </RequiredPackages> 175 93 <Units Count="14"> … … 261 179 <IncludeFiles Value="$(ProjOutDir)"/> 262 180 <OtherUnitFiles Value="Forms"/> 263 <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS) "/>181 <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)-$(BuildMode)"/> 264 182 </SearchPaths> 265 183 <Parsing> … … 281 199 </CodeGeneration> 282 200 <Linking> 201 <Debugging> 202 <UseHeaptrc Value="True"/> 203 </Debugging> 283 204 <Options> 284 205 <Win32> -
trunk/CoolDisk.lpr
r34 r41 9 9 Interfaces, // this includes the LCL widgetset 10 10 Forms, tachartlazaruspkg, UProject, 11 UConfig, UBlockMap, UDriveScan, Common, TemplateGenerics,UFormProject,11 UConfig, UBlockMap, UDriveScan, Common, UFormProject, 12 12 UPhysDrive, UCore, UFileStreamEx, CoolTranslator, UFormMain, UFormBenchmark, 13 13 UFormOperation; -
trunk/Forms/UFormAbout.lfm
r37 r41 1 1 object FormAbout: TFormAbout 2 2 Left = 562 3 Height = 3353 Height = 502 4 4 Top = 339 5 Width = 5335 Width = 800 6 6 Caption = 'About' 7 ClientHeight = 335 8 ClientWidth = 533 7 ClientHeight = 502 8 ClientWidth = 800 9 DesignTimePPI = 144 9 10 OnCreate = FormCreate 10 11 OnShow = FormShow 11 12 Position = poScreenCenter 12 LCLVersion = ' 1.6.2.0'13 LCLVersion = '2.0.0.4' 13 14 object LabelDescription: TLabel 14 Left = 2015 Height = 5016 Top = 1 0817 Width = 49315 Left = 30 16 Height = 26 17 Top = 162 18 Width = 740 18 19 Align = alTop 19 BorderSpacing.Around = 2020 BorderSpacing.Around = 30 20 21 Caption = 'CoolDisk is helpful GUI application for various disk surface operations.' 21 22 ParentColor = False 23 ParentFont = False 22 24 WordWrap = True 23 25 end 24 26 object ButtonClose: TButton 25 Left = 42026 Height = 2527 Top = 29528 Width = 9327 Left = 630 28 Height = 38 29 Top = 442 30 Width = 140 29 31 Anchors = [akRight, akBottom] 30 32 Caption = 'Close' 31 33 ModalResult = 1 34 ParentFont = False 32 35 TabOrder = 0 33 36 end 34 37 object LabelContent: TLabel 35 Left = 2036 Height = 2 537 Top = 17838 Width = 49338 Left = 30 39 Height = 26 40 Top = 218 41 Width = 740 39 42 Align = alTop 40 BorderSpacing.Around = 2043 BorderSpacing.Around = 30 41 44 Caption = ' ' 42 45 ParentColor = False 46 ParentFont = False 43 47 end 44 48 object ButtonHomePage: TButton 45 Left = 1646 Height = 2547 Top = 29548 Width = 17649 Left = 24 50 Height = 38 51 Top = 442 52 Width = 264 49 53 Anchors = [akLeft, akBottom] 50 54 Caption = 'Home page' 51 55 OnClick = ButtonHomePageClick 56 ParentFont = False 52 57 TabOrder = 1 53 58 end 54 59 object Panel1: TPanel 55 60 Left = 0 56 Height = 8861 Height = 132 57 62 Top = 0 58 Width = 53363 Width = 800 59 64 Align = alTop 60 65 BevelOuter = bvNone 61 ClientHeight = 88 62 ClientWidth = 533 66 ClientHeight = 132 67 ClientWidth = 800 68 ParentFont = False 63 69 TabOrder = 2 64 70 object Image1: TImage 65 Left = 2466 Height = 6667 Top = 1668 Width = 6971 Left = 36 72 Height = 99 73 Top = 24 74 Width = 104 69 75 Picture.Data = { 70 76 1754506F727461626C654E6574776F726B47726170686963B30C000089504E47 … … 175 181 object LabelAppName: TLabel 176 182 Left = 104 177 Height = 54183 Height = 83 178 184 Top = 16 179 Width = 167185 Width = 261 180 186 Align = alCustom 181 BorderSpacing.Around = 20187 BorderSpacing.Around = 30 182 188 Caption = 'Cool Disk' 183 Font.Height = - 40189 Font.Height = -60 184 190 ParentColor = False 185 191 ParentFont = False -
trunk/Forms/UFormBenchmark.lfm
r22 r41 1 1 object FormBenchmark: TFormBenchmark 2 2 Left = 874 3 Height = 7114 Top = 3 725 Width = 7733 Height = 1066 4 Top = 316 5 Width = 1160 6 6 Caption = 'Benchmark' 7 ClientHeight = 711 8 ClientWidth = 773 9 LCLVersion = '1.7' 7 ClientHeight = 1066 8 ClientWidth = 1160 9 DesignTimePPI = 144 10 LCLVersion = '2.0.0.4' 10 11 object Chart1: TChart 11 Left = 2412 Height = 65613 Top = 4014 Width = 72812 Left = 36 13 Height = 984 14 Top = 60 15 Width = 1092 15 16 AxisList = < 16 17 item 18 Marks.LabelBrush.Style = bsClear 17 19 Minors = <> 18 20 Title.LabelFont.Orientation = 900 21 Title.LabelBrush.Style = bsClear 19 22 end 20 23 item 21 24 Alignment = calBottom 25 Marks.LabelBrush.Style = bsClear 22 26 Minors = <> 27 Title.LabelBrush.Style = bsClear 23 28 end> 24 29 Foot.Brush.Color = clBtnFace -
trunk/Forms/UFormMain.lfm
r34 r41 1 1 object FormMain: TFormMain 2 Left = 4333 Height = 1 0724 Top = 2045 Width = 1 7032 Left = 221 3 Height = 1108 4 Top = 169 5 Width = 1654 6 6 Caption = 'CoolDisk' 7 ClientHeight = 1040 8 ClientWidth = 1703 7 ClientHeight = 1074 8 ClientWidth = 1654 9 DesignTimePPI = 144 9 10 Menu = MainMenu1 10 11 OnClose = FormClose … … 13 14 OnDestroy = FormDestroy 14 15 OnShow = FormShow 15 LCLVersion = ' 1.6.0.4'16 LCLVersion = '2.0.0.4' 16 17 object ToolBar1: TToolBar 17 18 Left = 0 18 Height = 2619 Height = 39 19 20 Top = 0 20 Width = 1 70321 Width = 1654 21 22 Images = Core.ImageList1 23 ParentFont = False 22 24 TabOrder = 0 23 25 object ToolButton1: TToolButton … … 27 29 end 28 30 object ToolButton2: TToolButton 29 Left = 2431 Left = 36 30 32 Top = 2 31 33 Action = AScanStop 32 34 end 33 35 object ToolButton3: TToolButton 34 Left = 4736 Left = 71 35 37 Top = 2 36 38 Action = AScanContinue … … 39 41 object Panel2: TPanel 40 42 Left = 0 41 Height = 10 1442 Top = 2643 Width = 59243 Height = 1035 44 Top = 39 45 Width = 888 44 46 Align = alLeft 45 47 BevelOuter = bvNone 46 ClientHeight = 1014 47 ClientWidth = 592 48 ClientHeight = 1035 49 ClientWidth = 888 50 ParentFont = False 48 51 TabOrder = 1 49 52 object Panel3: TPanel 50 53 Left = 0 51 Height = 37954 Height = 568 52 55 Top = 0 53 Width = 59256 Width = 888 54 57 Align = alTop 55 58 BevelOuter = bvNone 56 ClientHeight = 379 57 ClientWidth = 592 59 ClientHeight = 568 60 ClientWidth = 888 61 ParentFont = False 58 62 TabOrder = 0 59 63 object Label1: TLabel 60 Left = 1661 Height = 2 462 Top = 17964 Left = 24 65 Height = 26 66 Top = 268 63 67 Width = 96 64 68 Caption = 'Sector size:' 65 69 ParentColor = False 70 ParentFont = False 66 71 end 67 72 object LabelSectorSize: TLabel 68 Left = 257 69 Height = 24 70 Top = 179 71 Width = 10 72 Caption = ' ' 73 ParentColor = False 73 Left = 386 74 Height = 26 75 Top = 268 76 Width = 10 77 Caption = ' ' 78 ParentColor = False 79 ParentFont = False 74 80 end 75 81 object LabelSectorCount: TLabel 76 Left = 257 77 Height = 24 78 Top = 208 79 Width = 10 80 Caption = ' ' 81 ParentColor = False 82 Left = 386 83 Height = 26 84 Top = 312 85 Width = 10 86 Caption = ' ' 87 ParentColor = False 88 ParentFont = False 82 89 end 83 90 object Label2: TLabel 84 Left = 1685 Height = 2 486 Top = 20891 Left = 24 92 Height = 26 93 Top = 312 87 94 Width = 113 88 95 Caption = 'Sector count:' 89 96 ParentColor = False 97 ParentFont = False 90 98 end 91 99 object LabelBlockCurrent: TLabel 92 Left = 257 93 Height = 24 94 Top = 240 95 Width = 10 96 Caption = ' ' 97 ParentColor = False 100 Left = 386 101 Height = 26 102 Top = 360 103 Width = 10 104 Caption = ' ' 105 ParentColor = False 106 ParentFont = False 98 107 end 99 108 object Label3: TLabel 100 Left = 16101 Height = 2 4102 Top = 240109 Left = 24 110 Height = 26 111 Top = 360 103 112 Width = 127 104 113 Caption = 'Current sector:' 105 114 ParentColor = False 115 ParentFont = False 106 116 end 107 117 object Label4: TLabel 108 Left = 16109 Height = 2 4110 Top = 272118 Left = 24 119 Height = 26 120 Top = 408 111 121 Width = 154 112 122 Caption = 'Damaged sectors:' 113 123 ParentColor = False 124 ParentFont = False 114 125 end 115 126 object LabelBlockDamaged: TLabel 116 Left = 257 117 Height = 24 118 Top = 268 119 Width = 10 120 Caption = ' ' 121 ParentColor = False 127 Left = 386 128 Height = 26 129 Top = 402 130 Width = 10 131 Caption = ' ' 132 ParentColor = False 133 ParentFont = False 122 134 end 123 135 object Label5: TLabel 124 Left = 16125 Height = 2 4126 Top = 300136 Left = 24 137 Height = 26 138 Top = 450 127 139 Width = 115 128 140 Caption = 'Elapsed time:' 129 141 ParentColor = False 142 ParentFont = False 130 143 end 131 144 object LabelElapsedTime: TLabel 132 Left = 257 133 Height = 24 134 Top = 296 135 Width = 10 136 Caption = ' ' 137 ParentColor = False 145 Left = 386 146 Height = 26 147 Top = 444 148 Width = 10 149 Caption = ' ' 150 ParentColor = False 151 ParentFont = False 138 152 end 139 153 object Label6: TLabel 140 Left = 16141 Height = 2 4142 Top = 328154 Left = 24 155 Height = 26 156 Top = 492 143 157 Width = 135 144 158 Caption = 'Estimated time:' 145 159 ParentColor = False 160 ParentFont = False 146 161 end 147 162 object LabelEstimatedTime: TLabel 148 Left = 258 149 Height = 24 150 Top = 324 151 Width = 10 152 Caption = ' ' 153 ParentColor = False 163 Left = 387 164 Height = 26 165 Top = 486 166 Width = 10 167 Caption = ' ' 168 ParentColor = False 169 ParentFont = False 154 170 end 155 171 object Label7: TLabel 156 Left = 16157 Height = 2 4158 Top = 148172 Left = 24 173 Height = 26 174 Top = 222 159 175 Width = 153 160 176 Caption = 'Sectors per Block:' 161 177 ParentColor = False 178 ParentFont = False 162 179 end 163 180 object LabelSectorPerBlock: TLabel 164 Left = 257 165 Height = 24 166 Top = 144 167 Width = 10 168 Caption = ' ' 169 ParentColor = False 181 Left = 386 182 Height = 26 183 Top = 216 184 Width = 10 185 Caption = ' ' 186 ParentColor = False 187 ParentFont = False 170 188 end 171 189 object LabelIOSpeed: TLabel 172 Left = 257 173 Height = 24 174 Top = 352 175 Width = 10 176 Caption = ' ' 177 ParentColor = False 190 Left = 386 191 Height = 26 192 Top = 528 193 Width = 10 194 Caption = ' ' 195 ParentColor = False 196 ParentFont = False 178 197 end 179 198 object Label8: TLabel 180 Left = 16181 Height = 2 4182 Top = 356199 Left = 24 200 Height = 26 201 Top = 534 183 202 Width = 88 184 203 Caption = 'I/O speed:' 185 204 ParentColor = False 205 ParentFont = False 186 206 end 187 207 object Label10: TLabel 188 Left = 16189 Height = 2 4190 Top = 1 16208 Left = 24 209 Height = 26 210 Top = 174 191 211 Width = 38 192 212 Caption = 'Size:' 193 213 ParentColor = False 214 ParentFont = False 194 215 end 195 216 object LabelSize: TLabel 196 Left = 257 197 Height = 24 198 Top = 112 199 Width = 10 200 Caption = ' ' 201 ParentColor = False 217 Left = 386 218 Height = 26 219 Top = 168 220 Width = 10 221 Caption = ' ' 222 ParentColor = False 223 ParentFont = False 202 224 end 203 225 object ButtonScan: TButton 204 Left = 16205 Height = 25206 Top = 72207 Width = 75226 Left = 24 227 Height = 38 228 Top = 108 229 Width = 112 208 230 Action = AScanStart 231 ParentFont = False 209 232 TabOrder = 0 210 233 end 211 234 object ButtonScan1: TButton 212 Left = 464213 Height = 25214 Top = 24215 Width = 1 20235 Left = 696 236 Height = 38 237 Top = 36 238 Width = 180 216 239 Action = AProjectOptions 217 240 Anchors = [akTop, akRight] 241 ParentFont = False 218 242 TabOrder = 1 219 243 end 220 244 object ButtonScan2: TButton 221 Left = 1 04222 Height = 25223 Top = 72224 Width = 75245 Left = 156 246 Height = 38 247 Top = 108 248 Width = 112 225 249 Action = AScanStop 250 ParentFont = False 226 251 TabOrder = 2 227 252 end 228 253 object Button2: TButton 229 Left = 192230 Height = 25231 Top = 72232 Width = 1 07254 Left = 288 255 Height = 38 256 Top = 108 257 Width = 160 233 258 Action = AScanContinue 259 ParentFont = False 234 260 TabOrder = 3 235 261 end 236 262 object Button3: TButton 237 Left = 312238 Height = 25239 Top = 72240 Width = 1 12263 Left = 468 264 Height = 38 265 Top = 108 266 Width = 168 241 267 Action = AOperationOptions 268 ParentFont = False 242 269 TabOrder = 4 243 270 end 244 271 object ComboBoxDrive: TComboBox 245 Left = 8246 Height = 38247 Top = 16248 Width = 440272 Left = 12 273 Height = 42 274 Top = 24 275 Width = 660 249 276 Anchors = [akTop, akLeft, akRight] 250 277 ItemHeight = 0 251 278 OnChange = ComboBoxDriveChange 279 ParentFont = False 252 280 Style = csDropDownList 253 281 TabOrder = 5 … … 257 285 Cursor = crVSplit 258 286 Left = 0 259 Height = 5260 Top = 379261 Width = 592287 Height = 8 288 Top = 568 289 Width = 888 262 290 Align = alTop 263 291 ResizeAnchor = akTop … … 265 293 object Panel4: TPanel 266 294 Left = 0 267 Height = 630268 Top = 384269 Width = 592295 Height = 459 296 Top = 576 297 Width = 888 270 298 Align = alClient 271 299 BevelOuter = bvNone 272 ClientHeight = 630 273 ClientWidth = 592 300 ClientHeight = 459 301 ClientWidth = 888 302 ParentFont = False 274 303 TabOrder = 2 275 304 object ListView1: TListView 276 Left = 16277 Height = 533278 Top = 48279 Width = 569305 Left = 24 306 Height = 313 307 Top = 72 308 Width = 854 280 309 Anchors = [akTop, akLeft, akRight, akBottom] 281 310 Columns = < 282 311 item 283 312 Caption = 'Name' 284 Width = 200313 Width = 300 285 314 end 286 315 item 287 316 Caption = 'Time start' 317 Width = 225 318 end 319 item 320 Caption = 'Time end' 321 Width = 225 322 end 323 item 324 Caption = 'First sector' 288 325 Width = 150 289 326 end 290 327 item 291 Caption = 'Time end'292 Width = 150293 end294 item295 Caption = 'First sector'296 Width = 100297 end298 item299 328 Caption = 'Last sector' 300 Width = 347329 Width = 520 301 330 end> 302 331 OwnerData = True 332 ParentFont = False 303 333 PopupMenu = PopupMenu1 304 334 ReadOnly = True … … 310 340 end 311 341 object Label11: TLabel 312 Left = 16313 Height = 2 4314 Top = 16342 Left = 24 343 Height = 26 344 Top = 24 315 345 Width = 100 316 346 Caption = 'Operations:' 317 347 ParentColor = False 348 ParentFont = False 318 349 end 319 350 object Button1: TButton 320 Left = 19321 Height = 25322 Top = 592323 Width = 1 04351 Left = 28 352 Height = 38 353 Top = 401 354 Width = 156 324 355 Action = AOperationAdd 325 356 Anchors = [akLeft, akBottom] 357 ParentFont = False 326 358 TabOrder = 1 327 359 end 328 360 object Button4: TButton 329 Left = 144330 Height = 25331 Top = 592332 Width = 1 15361 Left = 216 362 Height = 38 363 Top = 401 364 Width = 172 333 365 Action = AOperationRemove 334 366 Anchors = [akLeft, akBottom] 367 ParentFont = False 335 368 TabOrder = 2 336 369 end … … 338 371 end 339 372 object Splitter1: TSplitter 340 Left = 592341 Height = 10 14342 Top = 26343 Width = 5373 Left = 888 374 Height = 1035 375 Top = 39 376 Width = 8 344 377 end 345 378 object PageControl1: TPageControl 346 Left = 597347 Height = 10 14348 Top = 26349 Width = 1106379 Left = 896 380 Height = 1035 381 Top = 39 382 Width = 758 350 383 ActivePage = TabSheetSpeed 351 384 Align = alClient 385 ParentFont = False 352 386 TabIndex = 1 353 387 TabOrder = 3 354 388 object TabSheetSectors: TTabSheet 355 389 Caption = 'Sector map' 356 ClientHeight = 972 357 ClientWidth = 1100 390 ClientHeight = 995 391 ClientWidth = 748 392 ParentFont = False 358 393 object Image1: TImage 359 394 Left = 4 … … 362 397 Width = 1092 363 398 Align = alClient 364 BorderSpacing.Around = 4399 BorderSpacing.Around = 6 365 400 OnResize = Image1Resize 366 401 end … … 368 403 object TabSheetSpeed: TTabSheet 369 404 Caption = 'Transfer speed' 370 ClientHeight = 972 371 ClientWidth = 1100 405 ClientHeight = 995 406 ClientWidth = 748 407 ParentFont = False 372 408 object ChartSpeed: TChart 373 Left = 4374 Height = 9 64375 Top = 4376 Width = 1092409 Left = 6 410 Height = 983 411 Top = 6 412 Width = 736 377 413 AxisList = < 378 414 item 379 415 Marks.Format = '%0:.9g MB/s' 416 Marks.LabelBrush.Style = bsClear 380 417 Marks.Style = smsCustom 381 418 Minors = <> 382 419 Range.UseMin = True 383 420 Title.LabelFont.Orientation = 900 421 Title.LabelBrush.Style = bsClear 384 422 end 385 423 item 386 424 Alignment = calBottom 425 Marks.LabelBrush.Style = bsClear 387 426 Minors = <> 427 Title.LabelBrush.Style = bsClear 388 428 end> 389 429 Foot.Brush.Color = clBtnFace … … 395 435 ) 396 436 Align = alClient 397 BorderSpacing.Around = 4437 BorderSpacing.Around = 6 398 438 object ChartSpeedLineSeriesAvg: TLineSeries 399 439 LinePen.Color = clGreen … … 411 451 Interval = 500 412 452 OnTimer = Timer1Timer 413 left = 672414 top = 224453 left = 1008 454 top = 336 415 455 end 416 456 object ActionList1: TActionList 417 457 Images = Core.ImageList1 418 left = 672419 top = 291458 left = 1008 459 top = 437 420 460 object AScanStart: TAction 421 461 Caption = 'Start' … … 487 527 end 488 528 object OpenDialog1: TOpenDialog 489 left = 672490 top = 360529 left = 1008 530 top = 540 491 531 end 492 532 object SaveDialog1: TSaveDialog 493 left = 672494 top = 432533 left = 1008 534 top = 648 495 535 end 496 536 object MainMenu1: TMainMenu 497 537 Images = Core.ImageList1 498 left = 672499 top = 504538 left = 1008 539 top = 756 500 540 object MenuItem1: TMenuItem 501 541 Caption = 'File' … … 567 607 object LastOpenedList1: TLastOpenedList 568 608 MaxCount = 10 569 left = 672570 top = 144609 left = 1008 610 top = 216 571 611 end 572 612 object PopupMenu1: TPopupMenu 573 left = 320574 top = 664613 left = 432 614 top = 792 575 615 object MenuItem18: TMenuItem 576 616 Action = AOperationAdd -
trunk/Forms/UFormMain.pas
r34 r41 171 171 SModifiedFlag = '(modified)'; 172 172 SNewProject = 'New project'; 173 SSelectDriveForScan = 'Select drive for scan';174 173 SOpenStoredProject = 'Open stored scan project'; 175 174 SSaveProject = 'Save scan project'; … … 227 226 procedure TFormMain.FormCreate(Sender: TObject); 228 227 begin 229 PrefixMultiplier := TPrefixMultiplier.Create ;228 PrefixMultiplier := TPrefixMultiplier.Create(nil); 230 229 end; 231 230 … … 588 587 procedure TFormMain.SaveConfig; 589 588 begin 590 Core.XMLConfig1.SetValue('DriveName', LastDriveName);589 Core.XMLConfig1.SetValue('DriveName', UnicodeString(LastDriveName)); 591 590 LastOpenedList1.SaveToXMLConfig(Core.XMLConfig1, 'RecentProjects'); 592 591 Core.XMLConfig1.SetValue('ShowToolBar', ShowToolBar); … … 595 594 procedure TFormMain.LoadConfig; 596 595 begin 597 LastDriveName := Core.XMLConfig1.GetValue('DriveName', '');596 LastDriveName := string(Core.XMLConfig1.GetValue('DriveName', UnicodeString(''))); 598 597 LastOpenedList1.LoadFromXMLConfig(Core.XMLConfig1, 'RecentProjects'); 599 598 ShowToolBar := Core.XMLConfig1.GetValue('ShowToolBar', False); -
trunk/Forms/UFormOperation.lfm
r29 r41 1 1 object FormOperation: TFormOperation 2 2 Left = 558 3 Height = 4823 Height = 723 4 4 Top = 480 5 Width = 7255 Width = 1088 6 6 Caption = 'Operation settings' 7 ClientHeight = 482 8 ClientWidth = 725 9 LCLVersion = '1.7' 7 ClientHeight = 723 8 ClientWidth = 1088 9 DesignTimePPI = 144 10 LCLVersion = '2.0.0.4' 10 11 object ButtonOk: TButton 11 Left = 55912 Height = 2513 Top = 42714 Width = 7512 Left = 838 13 Height = 38 14 Top = 640 15 Width = 112 15 16 Caption = 'Ok' 16 17 ModalResult = 1 18 ParentFont = False 17 19 TabOrder = 0 18 20 end 19 21 object ButtonCancel: TButton 20 Left = 44821 Height = 2522 Top = 42423 Width = 7522 Left = 672 23 Height = 38 24 Top = 636 25 Width = 112 24 26 Caption = 'Cancel' 25 27 ModalResult = 2 28 ParentFont = False 26 29 TabOrder = 1 27 30 end 28 31 object ComboBoxRunMode: TComboBox 29 Left = 1630 Height = 3 431 Top = 1632 Width = 24732 Left = 24 33 Height = 38 34 Top = 24 35 Width = 370 33 36 ItemHeight = 0 34 37 ItemIndex = 0 … … 38 41 ) 39 42 OnChange = ComboBoxRunModeChange 43 ParentFont = False 40 44 Style = csDropDownList 41 45 TabOrder = 2 … … 43 47 end 44 48 object Label9: TLabel 45 Left = 1646 Height = 2 447 Top = 20048 Width = 1 7249 Left = 24 50 Height = 26 51 Top = 300 52 Width = 161 49 53 Caption = 'Write byte pattern:' 50 54 ParentColor = False 55 ParentFont = False 51 56 end 52 57 object EditPattern: TEdit 53 Left = 232 54 Height = 34 55 Top = 192 56 Width = 80 58 Left = 348 59 Height = 43 60 Top = 288 61 Width = 120 62 ParentFont = False 57 63 TabOrder = 3 58 64 Text = '0xff' 59 65 end 60 66 object Label2: TLabel 61 Left = 2462 Height = 2 463 Top = 6464 Width = 10 567 Left = 36 68 Height = 26 69 Top = 96 70 Width = 100 65 71 Caption = 'First sector:' 66 72 ParentColor = False 73 ParentFont = False 67 74 end 68 75 object SpinEditFirstSector: TSpinEdit 69 Left = 19270 Height = 3471 Top = 6472 Width = 16276 Left = 288 77 Height = 43 78 Top = 96 79 Width = 243 73 80 MaxValue = 100000 74 81 OnChange = SpinEditFirstSectorChange 82 ParentFont = False 75 83 TabOrder = 4 76 84 Value = 1 77 85 end 78 86 object SpinEditLastSector: TSpinEdit 79 Left = 19280 Height = 3481 Top = 1 0482 Width = 16287 Left = 288 88 Height = 43 89 Top = 156 90 Width = 243 83 91 MaxValue = 100000 84 92 OnChange = SpinEditLastSectorChange 93 ParentFont = False 85 94 TabOrder = 5 86 95 Value = 1 87 96 end 88 97 object Label3: TLabel 89 Left = 2490 Height = 2 491 Top = 1 0492 Width = 8198 Left = 36 99 Height = 26 100 Top = 156 101 Width = 77 93 102 Caption = 'Last size:' 94 103 ParentColor = False 104 ParentFont = False 95 105 end 96 106 object CheckBoxRandomPattern: TCheckBox 97 Left = 1698 Height = 2899 Top = 160100 Width = 1 74107 Left = 24 108 Height = 30 109 Top = 240 110 Width = 165 101 111 Caption = 'Random pattern' 102 112 OnChange = CheckBoxRandomPatternChange 113 ParentFont = False 103 114 TabOrder = 6 104 115 end -
trunk/Forms/UFormProject.lfm
r31 r41 1 1 object FormProject: TFormProject 2 2 Left = 537 3 Height = 3923 Height = 588 4 4 Top = 440 5 Width = 6125 Width = 918 6 6 Caption = 'Project settings' 7 ClientHeight = 392 8 ClientWidth = 612 9 LCLVersion = '1.7' 7 ClientHeight = 588 8 ClientWidth = 918 9 DesignTimePPI = 144 10 LCLVersion = '2.0.0.4' 10 11 object SpinEditSectorSize: TSpinEdit 11 Left = 22412 Height = 3413 Top = 15214 Width = 1 0112 Left = 336 13 Height = 43 14 Top = 228 15 Width = 152 15 16 MaxValue = 63 16 17 OnChange = SpinEditSectorSizeChange 18 ParentFont = False 17 19 TabOrder = 0 18 20 Value = 1 19 21 end 20 22 object Label1: TLabel 21 Left = 1622 Height = 2 423 Top = 16024 Width = 10123 Left = 24 24 Height = 26 25 Top = 240 26 Width = 96 25 27 Caption = 'Sector size:' 26 28 ParentColor = False 29 ParentFont = False 27 30 end 28 31 object Button1: TButton 29 Left = 32630 Height = 2531 Top = 28032 Width = 7532 Left = 489 33 Height = 38 34 Top = 420 35 Width = 112 33 36 Caption = 'Ok' 34 37 ModalResult = 1 38 ParentFont = False 35 39 TabOrder = 1 36 40 end 37 41 object Button2: TButton 38 Left = 22439 Height = 2540 Top = 28041 Width = 7542 Left = 336 43 Height = 38 44 Top = 420 45 Width = 112 42 46 Caption = 'Cancel' 43 47 ModalResult = 2 48 ParentFont = False 44 49 TabOrder = 2 45 50 end 46 51 object EditName: TEdit 47 Left = 192 48 Height = 34 49 Top = 8 50 Width = 240 52 Left = 288 53 Height = 43 54 Top = 12 55 Width = 360 56 ParentFont = False 51 57 TabOrder = 3 52 58 end 53 59 object Label2: TLabel 54 Left = 1655 Height = 2 456 Top = 1657 Width = 6060 Left = 24 61 Height = 26 62 Top = 24 63 Width = 56 58 64 Caption = 'Name:' 59 65 ParentColor = False 66 ParentFont = False 60 67 end 61 68 object ComboBoxDrive: TComboBox 62 Left = 19263 Height = 3864 Top = 5665 Width = 38469 Left = 288 70 Height = 42 71 Top = 84 72 Width = 576 66 73 ItemHeight = 0 74 ParentFont = False 67 75 Style = csDropDownList 68 76 TabOrder = 4 69 77 end 70 78 object Label3: TLabel 71 Left = 1672 Height = 2 473 Top = 6474 Width = 5379 Left = 24 80 Height = 26 81 Top = 96 82 Width = 49 75 83 Caption = 'Drive:' 76 84 ParentColor = False 85 ParentFont = False 77 86 end 78 87 object Label4: TLabel 79 Left = 1680 Height = 2 481 Top = 1 1282 Width = 11 988 Left = 24 89 Height = 26 90 Top = 168 91 Width = 113 83 92 Caption = 'Sector count:' 84 93 ParentColor = False 94 ParentFont = False 85 95 end 86 96 object LabelSectorCount: TLabel 87 Left = 19288 Height = 2 489 Top = 1 1297 Left = 288 98 Height = 26 99 Top = 168 90 100 Width = 15 91 101 Caption = ' ' 92 102 ParentColor = False 103 ParentFont = False 93 104 end 94 105 object Label5: TLabel 95 Left = 19296 Height = 2 497 Top = 16098 Width = 2 2106 Left = 288 107 Height = 26 108 Top = 240 109 Width = 20 99 110 Caption = '2^' 100 111 ParentColor = False 112 ParentFont = False 101 113 end 102 114 object Label6: TLabel 103 Left = 341104 Height = 2 4105 Top = 160106 Width = 1 1115 Left = 512 116 Height = 26 117 Top = 240 118 Width = 10 107 119 Caption = '=' 108 120 ParentColor = False 121 ParentFont = False 109 122 end 110 123 end -
trunk/Forms/UFormSettings.lfm
r34 r41 1 1 object FormSettings: TFormSettings 2 2 Left = 404 3 Height = 3273 Height = 490 4 4 Top = 574 5 Width = 5545 Width = 831 6 6 ActiveControl = ButtonOk 7 7 Caption = 'Settings' 8 ClientHeight = 327 9 ClientWidth = 554 10 Constraints.MinHeight = 327 11 Constraints.MinWidth = 554 8 ClientHeight = 490 9 ClientWidth = 831 10 Constraints.MinHeight = 490 11 Constraints.MinWidth = 831 12 DesignTimePPI = 144 12 13 OnCreate = FormCreate 13 14 OnShow = FormShow 14 15 Position = poMainFormCenter 15 LCLVersion = ' 1.6.0.4'16 LCLVersion = '2.0.0.4' 16 17 object ButtonOk: TButton 17 Left = 44418 Height = 2519 Top = 28420 Width = 7518 Left = 667 19 Height = 38 20 Top = 425 21 Width = 112 21 22 Anchors = [akRight, akBottom] 22 23 Caption = 'Ok' 23 24 ModalResult = 1 25 ParentFont = False 24 26 TabOrder = 0 25 27 end 26 28 object ButtonCancel: TButton 27 Left = 32228 Height = 2529 Top = 28430 Width = 7529 Left = 483 30 Height = 38 31 Top = 425 32 Width = 112 31 33 Anchors = [akRight, akBottom] 32 34 Caption = 'Cancel' 33 35 ModalResult = 2 36 ParentFont = False 34 37 TabOrder = 1 35 38 end 36 39 object PageControl1: TPageControl 37 Left = 438 Height = 26439 Top = 440 Width = 54640 Left = 6 41 Height = 425 42 Top = 6 43 Width = 819 41 44 ActivePage = TabSheetGeneral 42 45 Align = alTop 43 46 Anchors = [akTop, akLeft, akRight, akBottom] 44 BorderSpacing.Around = 4 47 BorderSpacing.Around = 6 48 ParentFont = False 45 49 TabIndex = 0 46 50 TabOrder = 2 47 51 object TabSheetGeneral: TTabSheet 48 52 Caption = 'General' 49 ClientHeight = 222 50 ClientWidth = 540 53 ClientHeight = 385 54 ClientWidth = 809 55 ParentFont = False 51 56 object Label1: TLabel 52 Left = 2053 Height = 2 454 Top = 2657 Left = 30 58 Height = 26 59 Top = 39 55 60 Width = 88 56 61 Caption = 'Language:' 57 62 ParentColor = False 63 ParentFont = False 58 64 end 59 65 object ComboBoxLanguage: TComboBox 60 Left = 17861 Height = 3862 Top = 2463 Width = 19666 Left = 267 67 Height = 42 68 Top = 36 69 Width = 294 64 70 ItemHeight = 0 71 ParentFont = False 65 72 Style = csDropDownList 66 73 TabOrder = 0 … … 69 76 object TabSheetDebug: TTabSheet 70 77 Caption = 'Debug' 71 ClientHeight = 222 72 ClientWidth = 540 78 ClientHeight = 385 79 ClientWidth = 809 80 ParentFont = False 73 81 object CheckBoxDevelMode: TCheckBox 74 Left = 1675 Height = 2776 Top = 13677 Width = 5 1482 Left = 24 83 Height = 40 84 Top = 204 85 Width = 503 78 86 Anchors = [akTop, akLeft, akRight] 79 87 AutoSize = False 80 88 Caption = 'Developer mode' 89 ParentFont = False 81 90 TabOrder = 0 82 91 end 83 92 object Label4: TLabel 84 Left = 1493 Left = 21 85 94 Height = 24 86 Top = 6795 Top = 100 87 96 Width = 35 88 97 Caption = 'DPI:' 89 98 ParentColor = False 99 ParentFont = False 90 100 end 91 101 object SpinEditX: TSpinEdit 92 Left = 1 04102 Left = 156 93 103 Height = 34 94 Top = 6495 Width = 96104 Top = 96 105 Width = 144 96 106 MaxValue = 500 97 107 MinValue = 20 108 ParentFont = False 98 109 TabOrder = 1 99 110 Value = 50 100 111 end 101 112 object SpinEditY: TSpinEdit 102 Left = 232113 Left = 348 103 114 Height = 34 104 Top = 64105 Width = 90115 Top = 96 116 Width = 135 106 117 MaxValue = 500 107 118 MinValue = 20 119 ParentFont = False 108 120 TabOrder = 2 109 121 Value = 20 110 122 end 111 123 object Label5: TLabel 112 Left = 208124 Left = 312 113 125 Height = 24 114 Top = 67126 Top = 100 115 127 Width = 10 116 128 Caption = 'x' 117 129 ParentColor = False 130 ParentFont = False 118 131 end 119 132 object CheckBox2: TCheckBox 120 Left = 16121 Height = 24122 Top = 32123 Width = 510133 Left = 24 134 Height = 36 135 Top = 48 136 Width = 497 124 137 Anchors = [akTop, akLeft, akRight] 125 138 AutoSize = False 126 139 Caption = 'Automatic DPI' 127 140 OnChange = CheckBox2Change 141 ParentFont = False 128 142 TabOrder = 3 129 143 end -
trunk/Languages/CoolDisk.po
r34 r41 21 21 22 22 #: tformabout.labelcontent.caption 23 msgctxt "tformabout.labelcontent.caption" 23 24 msgid " " 24 25 msgstr "" … … 26 27 #: tformabout.labeldescription.caption 27 28 msgid "CoolDisk is helpful GUI application for various disk surface operations." 29 msgstr "" 30 31 #: tformbenchmark.caption 32 msgid "Benchmark" 28 33 msgstr "" 29 34 … … 106 111 107 112 #: tformmain.label1.caption 113 msgctxt "tformmain.label1.caption" 108 114 msgid "Sector size:" 109 115 msgstr "" … … 118 124 119 125 #: tformmain.label2.caption 126 msgctxt "tformmain.label2.caption" 120 127 msgid "Sector count:" 121 128 msgstr "" … … 214 221 msgstr "" 215 222 216 #: tformmain.menuitem12.caption217 msgctxt "tformmain.menuitem12.caption"218 msgid "-"219 msgstr ""220 221 #: tformmain.menuitem14.caption222 msgctxt "TFORMMAIN.MENUITEM14.CAPTION"223 msgid "-"224 msgstr ""225 226 223 #: tformmain.menuitem16.caption 227 224 msgid "View" … … 252 249 msgstr "" 253 250 251 #: tformoperation.buttoncancel.caption 252 msgctxt "tformoperation.buttoncancel.caption" 253 msgid "Cancel" 254 msgstr "" 255 256 #: tformoperation.buttonok.caption 257 msgctxt "tformoperation.buttonok.caption" 258 msgid "Ok" 259 msgstr "" 260 261 #: tformoperation.caption 262 msgid "Operation settings" 263 msgstr "" 264 265 #: tformoperation.checkboxrandompattern.caption 266 msgid "Random pattern" 267 msgstr "" 268 269 #: tformoperation.comboboxrunmode.text 270 msgid "Read test" 271 msgstr "" 272 273 #: tformoperation.editpattern.text 274 msgid "0xff" 275 msgstr "" 276 277 #: tformoperation.label2.caption 278 msgid "First sector:" 279 msgstr "" 280 281 #: tformoperation.label3.caption 282 msgid "Last size:" 283 msgstr "" 284 285 #: tformoperation.label9.caption 286 msgid "Write byte pattern:" 287 msgstr "" 288 289 #: tformproject.button1.caption 290 msgctxt "tformproject.button1.caption" 291 msgid "Ok" 292 msgstr "" 293 294 #: tformproject.button2.caption 295 msgctxt "tformproject.button2.caption" 296 msgid "Cancel" 297 msgstr "" 298 299 #: tformproject.caption 300 msgid "Project settings" 301 msgstr "" 302 303 #: tformproject.label1.caption 304 msgctxt "tformproject.label1.caption" 305 msgid "Sector size:" 306 msgstr "" 307 308 #: tformproject.label2.caption 309 msgid "Name:" 310 msgstr "" 311 312 #: tformproject.label3.caption 313 msgid "Drive:" 314 msgstr "" 315 316 #: tformproject.label4.caption 317 msgctxt "tformproject.label4.caption" 318 msgid "Sector count:" 319 msgstr "" 320 321 #: tformproject.label5.caption 322 msgid "2^" 323 msgstr "" 324 325 #: tformproject.label6.caption 326 msgid "=" 327 msgstr "" 328 329 #: tformproject.labelsectorcount.caption 330 msgctxt "tformproject.labelsectorcount.caption" 331 msgid " " 332 msgstr "" 333 254 334 #: tformsettings.buttoncancel.caption 335 msgctxt "tformsettings.buttoncancel.caption" 255 336 msgid "Cancel" 256 337 msgstr "" 257 338 258 339 #: tformsettings.buttonok.caption 340 msgctxt "tformsettings.buttonok.caption" 259 341 msgid "Ok" 260 342 msgstr "" 261 343 262 344 #: tformsettings.caption 263 msgctxt " TFORMSETTINGS.CAPTION"345 msgctxt "tformsettings.caption" 264 346 msgid "Settings" 265 347 msgstr "" … … 353 435 msgstr "" 354 436 355 #: uformmain.sselectdriveforscan356 msgid "Select drive for scan"357 msgstr ""358 359 437 #: uphysdrive.sminsectorsize 360 438 msgid "Minimum sector size is 1" -
trunk/Packages/Common/Common.lpk
r40 r41 11 11 <PathDelim Value="\"/> 12 12 <SearchPaths> 13 <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS) "/>13 <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)-$(BuildMode)"/> 14 14 </SearchPaths> 15 <Parsing> 16 <SyntaxOptions> 17 <SyntaxMode Value="Delphi"/> 18 <CStyleOperator Value="False"/> 19 <AllowLabel Value="False"/> 20 <CPPInline Value="False"/> 21 </SyntaxOptions> 22 </Parsing> 23 <CodeGeneration> 24 <Optimizations> 25 <OptimizationLevel Value="0"/> 26 </Optimizations> 27 </CodeGeneration> 28 <Linking> 29 <Debugging> 30 <GenerateDebugInfo Value="False"/> 31 </Debugging> 32 </Linking> 33 <Other> 34 <CompilerMessages> 35 <IgnoredMessages idx5024="True"/> 36 </CompilerMessages> 37 </Other> 15 38 </CompilerOptions> 16 39 <Description Value="Various libraries"/> 17 40 <License Value="GNU/GPL"/> 18 41 <Version Minor="7"/> 19 <Files Count="2 0">42 <Files Count="22"> 20 43 <Item1> 21 44 <Filename Value="StopWatch.pas"/> … … 37 60 <Item5> 38 61 <Filename Value="UPrefixMultiplier.pas"/> 62 <HasRegisterProc Value="True"/> 39 63 <UnitName Value="UPrefixMultiplier"/> 40 64 </Item5> … … 106 130 <UnitName Value="UScaleDPI"/> 107 131 </Item20> 132 <Item21> 133 <Filename Value="UTheme.pas"/> 134 <HasRegisterProc Value="True"/> 135 <UnitName Value="UTheme"/> 136 </Item21> 137 <Item22> 138 <Filename Value="UStringTable.pas"/> 139 <UnitName Value="UStringTable"/> 140 </Item22> 108 141 </Files> 109 142 <i18n> … … 112 145 <EnableI18NForLFM Value="True"/> 113 146 </i18n> 114 <RequiredPkgs Count=" 3">147 <RequiredPkgs Count="2"> 115 148 <Item1> 116 149 <PackageName Value="LCL"/> 117 150 </Item1> 118 151 <Item2> 119 <PackageName Value="TemplateGenerics"/>120 </Item2>121 <Item3>122 152 <PackageName Value="FCL"/> 123 153 <MinVersion Major="1" Valid="True"/> 124 </Item 3>154 </Item2> 125 155 </RequiredPkgs> 126 156 <UsageOptions> -
trunk/Packages/Common/Common.pas
r33 r41 5 5 unit Common; 6 6 7 {$warn 5023 off : no warning about unused units} 7 8 interface 8 9 … … 11 12 UMemory, UResetableThread, UPool, ULastOpenedList, URegistry, 12 13 UJobProgressView, UXMLUtils, UApplicationInfo, USyncCounter, UListViewSort, 13 UPersistentForm, UFindFile, UScaleDPI, LazarusPackageIntf; 14 UPersistentForm, UFindFile, UScaleDPI, UTheme, UStringTable, 15 LazarusPackageIntf; 14 16 15 17 implementation … … 18 20 begin 19 21 RegisterUnit('UDebugLog', @UDebugLog.Register); 22 RegisterUnit('UPrefixMultiplier', @UPrefixMultiplier.Register); 20 23 RegisterUnit('ULastOpenedList', @ULastOpenedList.Register); 21 24 RegisterUnit('UJobProgressView', @UJobProgressView.Register); … … 25 28 RegisterUnit('UFindFile', @UFindFile.Register); 26 29 RegisterUnit('UScaleDPI', @UScaleDPI.Register); 30 RegisterUnit('UTheme', @UTheme.Register); 27 31 end; 28 32 -
trunk/Packages/Common/Languages/UJobProgressView.po
r40 r41 14 14 msgstr "" 15 15 16 #: ujobprogressview.soperations17 msgid "Operations"18 msgstr ""19 20 16 #: ujobprogressview.spleasewait 21 17 msgid "Please wait..." -
trunk/Packages/Common/Languages/UThreading.po
r4 r41 3 3 4 4 #: uthreading.scurrentthreadnotfound 5 #, fuzzy,badformat 5 6 msgid "Current thread ID %d not found in virtual thread list." 6 7 msgstr "Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8" -
trunk/Packages/Common/UApplicationInfo.pas
r4 r41 6 6 7 7 uses 8 SysUtils, Registry, Classes, Forms, URegistry;8 SysUtils, Classes, Forms, URegistry, Controls; 9 9 10 10 type … … 14 14 TApplicationInfo = class(TComponent) 15 15 private 16 FDescription: TCaption; 16 17 FIdentification: Byte; 17 18 FLicense: string; … … 33 34 constructor Create(AOwner: TComponent); override; 34 35 property Version: string read GetVersion; 36 function GetRegistryContext: TRegistryContext; 35 37 published 36 38 property Identification: Byte read FIdentification write FIdentification; … … 45 47 property EmailContact: string read FEmailContact write FEmailContact; 46 48 property AppName: string read FAppName write FAppName; 49 property Description: string read FDescription write FDescription; 47 50 property ReleaseDate: TDateTime read FReleaseDate write FReleaseDate; 48 51 property RegistryKey: string read FRegistryKey write FRegistryKey; … … 54 57 55 58 implementation 56 59 57 60 procedure Register; 58 61 begin … … 79 82 end; 80 83 84 function TApplicationInfo.GetRegistryContext: TRegistryContext; 85 begin 86 Result := TRegistryContext.Create(RegistryRoot, RegistryKey); 87 end; 88 81 89 end. -
trunk/Packages/Common/UCommon.pas
r40 r41 27 27 unfNameServicePrincipal = 10, // Generalized service principal name 28 28 unfDNSDomainName = 11); 29 30 TFilterMethod = function (FileName: string): Boolean of object; 31 TFileNameMethod = procedure (FileName: string) of object; 29 32 30 33 var … … 63 66 procedure OpenWebPage(URL: string); 64 67 procedure OpenFileInShell(FileName: string); 65 procedure ExecuteProgram( CommandLine:string);68 procedure ExecuteProgram(Executable: string; Parameters: array of string); 66 69 procedure FreeThenNil(var Obj); 67 70 function RemoveQuotes(Text: string): string; … … 71 74 function MergeArray(A, B: array of string): TArrayOfString; 72 75 function LoadFileToStr(const FileName: TFileName): AnsiString; 76 procedure SaveStringToFile(S, FileName: string); 77 procedure SearchFiles(AList: TStrings; Dir: string; 78 FilterMethod: TFilterMethod = nil; FileNameMethod: TFileNameMethod = nil); 79 function GetStringPart(var Text: string; Separator: string): string; 80 function StripTags(const S: string): string; 81 function PosFromIndex(SubStr: string; Text: string; 82 StartIndex: Integer): Integer; 83 function PosFromIndexReverse(SubStr: string; Text: string; 84 StartIndex: Integer): Integer; 85 procedure CopyStringArray(Dest: TStringArray; Source: array of string); 73 86 74 87 … … 98 111 I: Integer; 99 112 begin 113 Result := ''; 100 114 for I := 1 to Length(Source) do begin 101 115 Result := Result + LowerCase(IntToHex(Ord(Source[I]), 2)); … … 112 126 Path := IncludeTrailingPathDelimiter(APath); 113 127 114 Find := FindFirst( UTF8Decode(Path + AFileSpec), faAnyFile xor faDirectory, SearchRec);128 Find := FindFirst(Path + AFileSpec, faAnyFile xor faDirectory, SearchRec); 115 129 while Find = 0 do begin 116 DeleteFile(Path + UTF8Encode(SearchRec.Name));130 DeleteFile(Path + SearchRec.Name); 117 131 118 132 Find := SysUtils.FindNext(SearchRec); … … 429 443 end; 430 444 431 procedure ExecuteProgram( CommandLine:string);445 procedure ExecuteProgram(Executable: string; Parameters: array of string); 432 446 var 433 447 Process: TProcess; 448 I: Integer; 434 449 begin 435 450 try 436 451 Process := TProcess.Create(nil); 437 Process.CommandLine := CommandLine; 452 Process.Executable := Executable; 453 for I := 0 to Length(Parameters) - 1 do 454 Process.Parameters.Add(Parameters[I]); 438 455 Process.Options := [poNoConsole]; 439 456 Process.Execute; … … 456 473 procedure OpenFileInShell(FileName: string); 457 474 begin 458 ExecuteProgram('cmd.exe /c start "' + FileName + '"');475 ExecuteProgram('cmd.exe', ['/c', 'start', FileName]); 459 476 end; 460 477 … … 511 528 end; 512 529 530 function DefaultSearchFilter(const FileName: string): Boolean; 531 begin 532 Result := True; 533 end; 534 535 procedure SaveStringToFile(S, FileName: string); 536 var 537 F: TextFile; 538 begin 539 AssignFile(F, FileName); 540 try 541 ReWrite(F); 542 Write(F, S); 543 finally 544 CloseFile(F); 545 end; 546 end; 547 548 procedure SearchFiles(AList: TStrings; Dir: string; 549 FilterMethod: TFilterMethod = nil; FileNameMethod: TFileNameMethod = nil); 550 var 551 SR: TSearchRec; 552 begin 553 Dir := IncludeTrailingPathDelimiter(Dir); 554 if FindFirst(Dir + '*', faAnyFile, SR) = 0 then 555 try 556 repeat 557 if (SR.Name = '.') or (SR.Name = '..') or (Assigned(FilterMethod) and (not FilterMethod(SR.Name) or 558 not FilterMethod(Copy(Dir, 3, Length(Dir)) + SR.Name))) then Continue; 559 if Assigned(FileNameMethod) then 560 FileNameMethod(Dir + SR.Name); 561 AList.Add(Dir + SR.Name); 562 if (SR.Attr and faDirectory) <> 0 then 563 SearchFiles(AList, Dir + SR.Name, FilterMethod); 564 until FindNext(SR) <> 0; 565 finally 566 FindClose(SR); 567 end; 568 end; 569 570 function GetStringPart(var Text: string; Separator: string): string; 571 var 572 P: Integer; 573 begin 574 P := Pos(Separator, Text); 575 if P > 0 then begin 576 Result := Copy(Text, 1, P - 1); 577 Delete(Text, 1, P - 1 + Length(Separator)); 578 end else begin 579 Result := Text; 580 Text := ''; 581 end; 582 Result := Trim(Result); 583 Text := Trim(Text); 584 end; 585 586 function StripTags(const S: string): string; 587 var 588 Len: Integer; 589 590 function ReadUntil(const ReadFrom: Integer; const C: Char): Integer; 591 var 592 J: Integer; 593 begin 594 for J := ReadFrom to Len do 595 if (S[j] = C) then 596 begin 597 Result := J; 598 Exit; 599 end; 600 Result := Len + 1; 601 end; 602 603 var 604 I, APos: Integer; 605 begin 606 Len := Length(S); 607 I := 0; 608 Result := ''; 609 while (I <= Len) do begin 610 Inc(I); 611 APos := ReadUntil(I, '<'); 612 Result := Result + Copy(S, I, APos - i); 613 I := ReadUntil(APos + 1, '>'); 614 end; 615 end; 616 617 function PosFromIndex(SubStr: string; Text: string; 618 StartIndex: Integer): Integer; 619 var 620 I, MaxLen: SizeInt; 621 Ptr: PAnsiChar; 622 begin 623 Result := 0; 624 if (StartIndex < 1) or (StartIndex > Length(Text) - Length(SubStr)) then Exit; 625 if Length(SubStr) > 0 then begin 626 MaxLen := Length(Text) - Length(SubStr) + 1; 627 I := StartIndex; 628 Ptr := @Text[StartIndex]; 629 while (I <= MaxLen) do begin 630 if (SubStr[1] = Ptr^) and (CompareByte(Substr[1], Ptr^, Length(SubStr)) = 0) then begin 631 Result := I; 632 Exit; 633 end; 634 Inc(I); 635 Inc(Ptr); 636 end; 637 end; 638 end; 639 640 function PosFromIndexReverse(SubStr: string; Text: string; 641 StartIndex: Integer): Integer; 642 var 643 I: SizeInt; 644 Ptr: PAnsiChar; 645 begin 646 Result := 0; 647 if (StartIndex < 1) or (StartIndex > Length(Text)) then Exit; 648 if Length(SubStr) > 0 then begin 649 I := StartIndex; 650 Ptr := @Text[StartIndex]; 651 while (I > 0) do begin 652 if (SubStr[1] = Ptr^) and (CompareByte(Substr[1], Ptr^, Length(SubStr)) = 0) then begin 653 Result := I; 654 Exit; 655 end; 656 Dec(I); 657 Dec(Ptr); 658 end; 659 end; 660 end; 661 662 procedure CopyStringArray(Dest: TStringArray; Source: array of string); 663 var 664 I: Integer; 665 begin 666 SetLength(Dest, Length(Source)); 667 for I := 0 to Length(Dest) - 1 do 668 Dest[I] := Source[I]; 669 end; 513 670 514 671 -
trunk/Packages/Common/UDebugLog.pas
r4 r41 6 6 7 7 uses 8 Classes, SysUtils, FileUtil, SpecializedList, SyncObjs;8 Classes, SysUtils, FileUtil, fgl, SyncObjs; 9 9 10 10 type … … 29 29 procedure SetMaxCount(const AValue: Integer); 30 30 public 31 Items: T ListObject;31 Items: TFPGObjectList<TDebugLogItem>; 32 32 Lock: TCriticalSection; 33 33 procedure Add(Text: string; Group: string = ''); … … 104 104 if ExtractFileDir(FileName) <> '' then 105 105 ForceDirectories(ExtractFileDir(FileName)); 106 if FileExists(FileName) then LogFile := TFileStream.Create( UTF8Decode(FileName), fmOpenWrite)107 else LogFile := TFileStream.Create( UTF8Decode(FileName), fmCreate);106 if FileExists(FileName) then LogFile := TFileStream.Create(FileName, fmOpenWrite) 107 else LogFile := TFileStream.Create(FileName, fmCreate); 108 108 LogFile.Seek(0, soFromEnd); 109 109 Text := FormatDateTime('hh:nn:ss.zzz', Now) + ': ' + Text + LineEnding; … … 117 117 begin 118 118 inherited; 119 Items := T ListObject.Create;119 Items := TFPGObjectList<TDebugLogItem>.Create; 120 120 Lock := TCriticalSection.Create; 121 121 MaxCount := 100; -
trunk/Packages/Common/UFindFile.pas
r40 r41 24 24 25 25 uses 26 SysUtils, Classes, Graphics, Controls, Forms, Dialogs , FileCtrl;26 SysUtils, Classes, Graphics, Controls, Forms, Dialogs; 27 27 28 28 type … … 117 117 Attr := 0; 118 118 if ffaReadOnly in FileAttr then Attr := Attr + faReadOnly; 119 if ffaHidden in FileAttr then Attr := Attr + faHidden;120 if ffaSysFile in FileAttr then Attr := Attr + faSysFile;121 if ffaVolumeID in FileAttr then Attr := Attr + faVolumeID;119 if ffaHidden in FileAttr then Attr := Attr + 2; //faHidden; use constant to avoid platform warning 120 if ffaSysFile in FileAttr then Attr := Attr + 4; //faSysFile; use constant to avoid platform warning 121 // Deprecated: if ffaVolumeID in FileAttr then Attr := Attr + faVolumeID; 122 122 if ffaDirectory in FileAttr then Attr := Attr + faDirectory; 123 123 if ffaArchive in FileAttr then Attr := Attr + faArchive; 124 124 if ffaAnyFile in FileAttr then Attr := Attr + faAnyFile; 125 125 126 if SysUtils.FindFirst( UTF8Decode(inPath + FileMask), Attr, Rec) = 0 then126 if SysUtils.FindFirst(inPath + FileMask, Attr, Rec) = 0 then 127 127 try 128 128 repeat 129 s.Add(inPath + UTF8Encode(Rec.Name));129 s.Add(inPath + Rec.Name); 130 130 until SysUtils.FindNext(Rec) <> 0; 131 131 finally … … 135 135 If not InSubFolders then Exit; 136 136 137 if SysUtils.FindFirst( UTF8Decode(inPath + FilterAll), faDirectory, Rec) = 0 then137 if SysUtils.FindFirst(inPath + FilterAll, faDirectory, Rec) = 0 then 138 138 try 139 139 repeat 140 140 if ((Rec.Attr and faDirectory) > 0) and (Rec.Name <> '.') 141 141 and (Rec.Name <> '..') then 142 FileSearch(IncludeTrailingBackslash(inPath + UTF8Encode(Rec.Name)));142 FileSearch(IncludeTrailingBackslash(inPath + Rec.Name)); 143 143 until SysUtils.FindNext(Rec) <> 0; 144 144 finally -
trunk/Packages/Common/UJobProgressView.lfm
r40 r41 1 1 object FormJobProgressView: TFormJobProgressView 2 2 Left = 467 3 Height = 2463 Height = 345 4 4 Top = 252 5 Width = 3285 Width = 539 6 6 BorderIcons = [biSystemMenu] 7 ClientHeight = 246 8 ClientWidth = 328 9 Font.Height = -11 10 Font.Name = 'MS Sans Serif' 7 ClientHeight = 345 8 ClientWidth = 539 9 DesignTimePPI = 120 11 10 OnClose = FormClose 12 11 OnCloseQuery = FormCloseQuery 13 12 OnCreate = FormCreate 14 13 OnDestroy = FormDestroy 14 OnHide = FormHide 15 OnShow = FormShow 15 16 Position = poScreenCenter 16 LCLVersion = ' 1.6.0.4'17 LCLVersion = '2.0.2.0' 17 18 object PanelOperationsTitle: TPanel 18 19 Left = 0 19 Height = 2420 Height = 32 20 21 Top = 0 21 Width = 32822 Align = alTop 23 BevelOuter = bvNone 24 ClientHeight = 2425 ClientWidth = 32822 Width = 539 23 Align = alTop 24 BevelOuter = bvNone 25 ClientHeight = 32 26 ClientWidth = 539 26 27 FullRepaint = False 27 28 TabOrder = 0 28 29 object LabelOperation: TLabel 29 30 Left = 8 30 Height = 1331 Height = 20 31 32 Top = 8 32 Width = 6633 Width = 76 33 34 Caption = 'Operations:' 34 Font.Height = -1135 Font.Name = 'MS Sans Serif'36 Font.Style = [fsBold]37 35 ParentColor = False 38 36 ParentFont = False … … 41 39 object PanelLog: TPanel 42 40 Left = 0 43 Height = 1 2244 Top = 12445 Width = 32841 Height = 133 42 Top = 212 43 Width = 539 46 44 Align = alClient 47 45 BevelOuter = bvSpace 48 ClientHeight = 1 2249 ClientWidth = 32846 ClientHeight = 133 47 ClientWidth = 539 50 48 TabOrder = 1 51 49 object MemoLog: TMemo 52 50 Left = 8 53 Height = 1 0651 Height = 117 54 52 Top = 8 55 Width = 31253 Width = 523 56 54 Anchors = [akTop, akLeft, akRight, akBottom] 57 55 ReadOnly = True … … 62 60 object PanelProgress: TPanel 63 61 Left = 0 64 Height = 3865 Top = 5066 Width = 32867 Align = alTop 68 BevelOuter = bvNone 69 ClientHeight = 3870 ClientWidth = 32862 Height = 54 63 Top = 106 64 Width = 539 65 Align = alTop 66 BevelOuter = bvNone 67 ClientHeight = 54 68 ClientWidth = 539 71 69 TabOrder = 2 72 70 object ProgressBarPart: TProgressBar 73 Left = 874 Height = 1775 Top = 1676 Width = 31271 Left = 10 72 Height = 24 73 Top = 24 74 Width = 523 77 75 Anchors = [akTop, akLeft, akRight] 78 76 TabOrder = 0 … … 80 78 object LabelEstimatedTimePart: TLabel 81 79 Left = 8 82 Height = 1380 Height = 20 83 81 Top = -2 84 Width = 7182 Width = 103 85 83 Caption = 'Estimated time:' 86 84 ParentColor = False … … 89 87 object PanelOperations: TPanel 90 88 Left = 0 91 Height = 2692 Top = 2493 Width = 32894 Align = alTop 95 BevelOuter = bvNone 96 ClientHeight = 2697 ClientWidth = 32889 Height = 42 90 Top = 64 91 Width = 539 92 Align = alTop 93 BevelOuter = bvNone 94 ClientHeight = 42 95 ClientWidth = 539 98 96 FullRepaint = False 99 97 TabOrder = 3 100 98 object ListViewJobs: TListView 101 99 Left = 8 102 Height = 16100 Height = 32 103 101 Top = 5 104 Width = 312102 Width = 523 105 103 Anchors = [akTop, akLeft, akRight, akBottom] 106 104 AutoWidthLastColumn = True … … 109 107 Columns = < 110 108 item 111 Width = 312109 Width = 523 112 110 end> 113 111 OwnerData = True … … 122 120 object PanelProgressTotal: TPanel 123 121 Left = 0 124 Height = 36125 Top = 88126 Width = 328127 Align = alTop 128 BevelOuter = bvNone 129 ClientHeight = 36130 ClientWidth = 328122 Height = 52 123 Top = 160 124 Width = 539 125 Align = alTop 126 BevelOuter = bvNone 127 ClientHeight = 52 128 ClientWidth = 539 131 129 TabOrder = 4 132 130 object LabelEstimatedTimeTotal: TLabel 133 131 Left = 8 134 Height = 13132 Height = 20 135 133 Top = 0 136 Width = 97134 Width = 141 137 135 Caption = 'Total estimated time:' 138 136 ParentColor = False … … 140 138 object ProgressBarTotal: TProgressBar 141 139 Left = 8 142 Height = 16143 Top = 16144 Width = 312140 Height = 24 141 Top = 24 142 Width = 523 145 143 Anchors = [akTop, akLeft, akRight] 146 144 TabOrder = 0 145 end 146 end 147 object PanelText: TPanel 148 Left = 0 149 Height = 32 150 Top = 32 151 Width = 539 152 Align = alTop 153 BevelOuter = bvNone 154 ClientHeight = 32 155 ClientWidth = 539 156 TabOrder = 5 157 object LabelText: TLabel 158 Left = 8 159 Height = 24 160 Top = 8 161 Width = 525 162 Anchors = [akTop, akLeft, akRight] 163 AutoSize = False 164 ParentColor = False 147 165 end 148 166 end … … 223 241 Interval = 100 224 242 OnTimer = TimerUpdateTimer 225 left = 264243 left = 320 226 244 top = 8 227 245 end -
trunk/Packages/Common/UJobProgressView.pas
r40 r41 7 7 uses 8 8 SysUtils, Variants, Classes, Graphics, Controls, Forms, Syncobjs, 9 Dialogs, ComCtrls, StdCtrls, ExtCtrls, Contnrs, UThreading, 9 Dialogs, ComCtrls, StdCtrls, ExtCtrls, Contnrs, UThreading, Math, 10 10 DateUtils; 11 11 … … 13 13 EstimatedTimeShowTreshold = 4; 14 14 EstimatedTimeShowTresholdTotal = 1; 15 MemoLogHeight = 200;16 15 UpdateInterval = 100; // ms 17 16 … … 24 23 FLock: TCriticalSection; 25 24 FOnChange: TNotifyEvent; 25 FText: string; 26 26 FValue: Integer; 27 27 FMax: Integer; 28 28 procedure SetMax(const AValue: Integer); 29 procedure SetText(AValue: string); 29 30 procedure SetValue(const AValue: Integer); 30 31 public … … 35 36 property Value: Integer read FValue write SetValue; 36 37 property Max: Integer read FMax write SetMax; 38 property Text: string read FText write SetText; 37 39 property OnChange: TNotifyEvent read FOnChange write FOnChange; 38 40 end; … … 69 71 end; 70 72 73 TJobs = class(TObjectList) 74 end; 75 71 76 TJobThread = class(TListedThread) 72 77 procedure Execute; override; … … 80 85 TFormJobProgressView = class(TForm) 81 86 ImageList1: TImageList; 87 LabelText: TLabel; 82 88 Label2: TLabel; 83 89 LabelOperation: TLabel; … … 86 92 ListViewJobs: TListView; 87 93 MemoLog: TMemo; 94 PanelText: TPanel; 88 95 PanelProgressTotal: TPanel; 89 96 PanelOperationsTitle: TPanel; … … 94 101 ProgressBarTotal: TProgressBar; 95 102 TimerUpdate: TTimer; 103 procedure FormHide(Sender: TObject); 104 procedure FormShow(Sender: TObject); 105 procedure ReloadJobList; 96 106 procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); 97 107 procedure FormDestroy(Sender: TObject); … … 100 110 procedure FormCreate(Sender: TObject); 101 111 procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); 112 procedure UpdateHeight; 102 113 public 103 114 JobProgressView: TJobProgressView; … … 118 129 TotalStartTime: TDateTime; 119 130 Log: TStringList; 131 FForm: TFormJobProgressView; 120 132 procedure SetTerminate(const AValue: Boolean); 121 133 procedure UpdateProgress; 122 procedure ReloadJobList;123 procedure StartJobs;124 procedure UpdateHeight;125 134 procedure JobProgressChange(Sender: TObject); 126 135 public 127 Form: TFormJobProgressView; 128 Jobs: TObjectList; // TListObject<TJob> 136 Jobs: TJobs; 129 137 CurrentJob: TJob; 130 138 CurrentJobIndex: Integer; … … 132 140 destructor Destroy; override; 133 141 procedure Clear; 134 procedureAddJob(Title: string; Method: TJobProgressViewMethod;135 NoThreaded: Boolean = False; WaitFor: Boolean = False) ;136 procedure Start (AAutoClose: Boolean = True);142 function AddJob(Title: string; Method: TJobProgressViewMethod; 143 NoThreaded: Boolean = False; WaitFor: Boolean = False): TJob; 144 procedure Start; 137 145 procedure Stop; 138 146 procedure TermSleep(Delay: Integer); 147 property Form: TFormJobProgressView read FForm; 139 148 property Terminate: Boolean read FTerminate write SetTerminate; 140 149 published … … 166 175 STotalEstimatedTime = 'Total estimated time: %s'; 167 176 SFinished = 'Finished'; 168 SOperations = 'Operations';169 177 170 178 procedure Register; … … 172 180 RegisterComponents('Common', [TJobProgressView]); 173 181 end; 182 183 { TJobThread } 174 184 175 185 procedure TJobThread.Execute; … … 190 200 end; 191 201 192 procedure TJobProgressView.AddJob(Title: string; Method: TJobProgressViewMethod; 193 NoThreaded: Boolean = False; WaitFor: Boolean = False); 202 { TFormJobProgressView } 203 204 procedure TFormJobProgressView.UpdateHeight; 194 205 var 195 NewJob: TJob; 196 begin 197 NewJob := TJob.Create; 198 NewJob.ProgressView := Self; 199 NewJob.Title := Title; 200 NewJob.Method := Method; 201 NewJob.NoThreaded := NoThreaded; 202 NewJob.WaitFor := WaitFor; 203 NewJob.Progress.Max := 100; 204 NewJob.Progress.Reset; 205 NewJob.Progress.OnChange := JobProgressChange; 206 Jobs.Add(NewJob); 206 H: Integer; 207 PanelOperationsVisible: Boolean; 208 PanelOperationsHeight: Integer; 209 PanelProgressVisible: Boolean; 210 PanelProgressTotalVisible: Boolean; 211 PanelLogVisible: Boolean; 212 MemoLogHeight: Integer = 200; 213 I: Integer; 214 ItemRect: TRect; 215 MaxH: Integer; 216 begin 217 H := PanelOperationsTitle.Height; 218 PanelOperationsVisible := JobProgressView.Jobs.Count > 0; 219 if PanelOperationsVisible <> PanelOperations.Visible then 220 PanelOperations.Visible := PanelOperationsVisible; 221 if ListViewJobs.Items.Count > 0 then begin 222 Maxh := 0; 223 for I := 0 to ListViewJobs.Items.Count - 1 do 224 begin 225 ItemRect := ListViewJobs.Items[i].DisplayRect(drBounds); 226 Maxh := Max(Maxh, ItemRect.Top + (ItemRect.Bottom - ItemRect.Top)); 227 end; 228 PanelOperationsHeight := Scale96ToScreen(12) + Maxh; 229 end else PanelOperationsHeight := Scale96ToScreen(8); 230 if PanelOperationsHeight <> PanelOperations.Height then 231 PanelOperations.Height := PanelOperationsHeight; 232 if PanelOperationsVisible then 233 H := H + PanelOperations.Height; 234 235 PanelProgressVisible := (JobProgressView.Jobs.Count > 0) and not JobProgressView.Finished; 236 if PanelProgressVisible <> PanelProgress.Visible then 237 PanelProgress.Visible := PanelProgressVisible; 238 if PanelProgressVisible then 239 H := H + PanelProgress.Height; 240 PanelProgressTotalVisible := (JobProgressView.Jobs.Count > 1) and not JobProgressView.Finished; 241 if PanelProgressTotalVisible <> PanelProgressTotal.Visible then 242 PanelProgressTotal.Visible := PanelProgressTotalVisible; 243 if PanelProgressTotalVisible then 244 H := H + PanelProgressTotal.Height; 245 Constraints.MinHeight := H; 246 PanelLogVisible := MemoLog.Lines.Count > 0; 247 if PanelLogVisible <> PanelLog.Visible then 248 PanelLog.Visible := PanelLogVisible; 249 if PanelLogVisible then 250 H := H + Scale96ToScreen(MemoLogHeight); 251 if PanelText.Visible then 252 H := H + PanelText.Height; 253 if Height <> H then begin 254 Height := H; 255 Top := (Screen.Height - H) div 2; 256 end; 257 end; 258 259 procedure TFormJobProgressView.TimerUpdateTimer(Sender: TObject); 260 var 261 ProgressBarPartVisible: Boolean; 262 ProgressBarTotalVisible: Boolean; 263 begin 264 JobProgressView.UpdateProgress; 265 if Visible and (not ProgressBarPart.Visible) and 266 Assigned(JobProgressView.CurrentJob) and 267 (JobProgressView.CurrentJob.Progress.Value > 0) then begin 268 ProgressBarPartVisible := True; 269 if ProgressBarPartVisible <> ProgressBarPart.Visible then 270 ProgressBarPart.Visible := ProgressBarPartVisible; 271 ProgressBarTotalVisible := True; 272 if ProgressBarTotalVisible <> ProgressBarTotal.Visible then 273 ProgressBarTotal.Visible := ProgressBarTotalVisible; 274 end; 275 if not Visible then begin 276 TimerUpdate.Interval := UpdateInterval; 277 if not JobProgressView.OwnerDraw then Show; 278 end; 279 if Assigned(JobProgressView.CurrentJob) then begin 280 LabelText.Caption := JobProgressView.CurrentJob.Progress.Text; 281 if LabelText.Caption <> '' then begin 282 PanelText.Visible := True; 283 UpdateHeight; 284 end; 285 end; 286 end; 287 288 procedure TFormJobProgressView.FormDestroy(Sender:TObject); 289 begin 290 end; 291 292 procedure TFormJobProgressView.ListViewJobsData(Sender: TObject; Item: TListItem); 293 begin 294 if (Item.Index >= 0) and (Item.Index < JobProgressView.Jobs.Count) then 295 with TJob(JobProgressView.Jobs[Item.Index]) do begin 296 Item.Caption := Title; 297 if Item.Index = JobProgressView.CurrentJobIndex then Item.ImageIndex := 1 298 else if Finished then Item.ImageIndex := 0 299 else Item.ImageIndex := 2; 300 Item.Data := JobProgressView.Jobs[Item.Index]; 301 end; 302 end; 303 304 procedure TFormJobProgressView.FormClose(Sender: TObject; 305 var CloseAction: TCloseAction); 306 begin 307 end; 308 309 procedure TFormJobProgressView.FormCreate(Sender: TObject); 310 begin 311 Caption := SPleaseWait; 312 try 313 //Animate1.FileName := ExtractFileDir(UTF8Encode(Application.ExeName)) + 314 // DirectorySeparator + 'horse.avi'; 315 //Animate1.Active := True; 316 except 317 318 end; 319 end; 320 321 procedure TFormJobProgressView.ReloadJobList; 322 begin 323 // Workaround for not showing first line 324 //Form.ListViewJobs.Items.Count := Jobs.Count + 1; 325 //Form.ListViewJobs.Refresh; 326 327 if ListViewJobs.Items.Count <> JobProgressView.Jobs.Count then 328 ListViewJobs.Items.Count := JobProgressView.Jobs.Count; 329 ListViewJobs.Refresh; 330 Application.ProcessMessages; 331 UpdateHeight; 332 end; 333 334 procedure TFormJobProgressView.FormShow(Sender: TObject); 335 begin 336 ReloadJobList; 337 end; 338 339 procedure TFormJobProgressView.FormHide(Sender: TObject); 340 begin 341 JobProgressView.Jobs.Clear; 342 ReloadJobList; 343 end; 344 345 procedure TFormJobProgressView.FormCloseQuery(Sender: TObject; var CanClose: Boolean); 346 begin 347 CanClose := JobProgressView.Finished; 348 JobProgressView.Terminate := True; 349 Caption := SPleaseWait + STerminate; 350 end; 351 352 353 { TJobProgressView } 354 355 function TJobProgressView.AddJob(Title: string; Method: TJobProgressViewMethod; 356 NoThreaded: Boolean = False; WaitFor: Boolean = False): TJob; 357 begin 358 Result := TJob.Create; 359 Result.ProgressView := Self; 360 Result.Title := Title; 361 Result.Method := Method; 362 Result.NoThreaded := NoThreaded; 363 Result.WaitFor := WaitFor; 364 Result.Progress.Max := 100; 365 Result.Progress.Reset; 366 Result.Progress.OnChange := JobProgressChange; 367 Jobs.Add(Result); 207 368 //ReloadJobList; 208 369 end; 209 370 210 procedure TJobProgressView.Start(AAutoClose: Boolean = True); 211 begin 212 AutoClose := AAutoClose; 213 StartJobs; 214 end; 215 216 procedure TJobProgressView.StartJobs; 371 procedure TJobProgressView.Start; 217 372 var 218 373 I: Integer; … … 229 384 Form.MemoLog.Clear; 230 385 386 Form.PanelText.Visible := False; 231 387 Form.LabelEstimatedTimePart.Visible := False; 232 388 Form.LabelEstimatedTimeTotal.Visible := False; … … 258 414 Form.ProgressBarPart.Visible := False; 259 415 //Show; 260 ReloadJobList;416 Form.ReloadJobList; 261 417 Application.ProcessMessages; 262 418 if NoThreaded then begin … … 296 452 //if Visible then Hide; 297 453 Form.MemoLog.Lines.Assign(Log); 298 if (Form.MemoLog.Lines.Count = 0) and AutoClose then begin454 if (Form.MemoLog.Lines.Count = 0) and FAutoClose then begin 299 455 Form.Hide; 300 456 end; 301 Clear;457 if not Form.Visible then Clear; 302 458 Form.Caption := SFinished; 303 459 //LabelEstimatedTimePart.Visible := False; 304 460 Finished := True; 305 461 CurrentJobIndex := -1; 306 ReloadJobList; 307 end; 308 end; 309 310 procedure TJobProgressView.UpdateHeight; 311 var 312 H: Integer; 313 PanelOperationsVisible: Boolean; 314 PanelOperationsHeight: Integer; 315 PanelProgressVisible: Boolean; 316 PanelProgressTotalVisible: Boolean; 317 PanelLogVisible: Boolean; 318 begin 319 with Form do begin 320 H := PanelOperationsTitle.Height; 321 PanelOperationsVisible := Jobs.Count > 0; 322 if PanelOperationsVisible <> PanelOperations.Visible then 323 PanelOperations.Visible := PanelOperationsVisible; 324 PanelOperationsHeight := 8 + 18 * Jobs.Count; 325 if PanelOperationsHeight <> PanelOperations.Height then 326 PanelOperations.Height := PanelOperationsHeight; 327 if PanelOperationsVisible then 328 H := H + PanelOperations.Height; 329 330 PanelProgressVisible := (Jobs.Count > 0) and not Finished; 331 if PanelProgressVisible <> PanelProgress.Visible then 332 PanelProgress.Visible := PanelProgressVisible; 333 if PanelProgressVisible then 334 H := H + PanelProgress.Height; 335 PanelProgressTotalVisible := (Jobs.Count > 1) and not Finished; 336 if PanelProgressTotalVisible <> PanelProgressTotal.Visible then 337 PanelProgressTotal.Visible := PanelProgressTotalVisible; 338 if PanelProgressTotalVisible then 339 H := H + PanelProgressTotal.Height; 340 Constraints.MinHeight := H; 341 PanelLogVisible := MemoLog.Lines.Count > 0; 342 if PanelLogVisible <> PanelLog.Visible then 343 PanelLog.Visible := PanelLogVisible; 344 if PanelLogVisible then 345 H := H + MemoLogHeight; 346 if Height <> H then Height := H; 462 Form.ReloadJobList; 347 463 end; 348 464 end; … … 352 468 if Assigned(FOnOwnerDraw) then 353 469 FOnOwnerDraw(Self); 354 end;355 356 procedure TFormJobProgressView.TimerUpdateTimer(Sender: TObject);357 var358 ProgressBarPartVisible: Boolean;359 ProgressBarTotalVisible: Boolean;360 begin361 JobProgressView.UpdateProgress;362 if Visible and (not ProgressBarPart.Visible) and363 Assigned(JobProgressView.CurrentJob) and364 (JobProgressView.CurrentJob.Progress.Value > 0) then begin365 ProgressBarPartVisible := True;366 if ProgressBarPartVisible <> ProgressBarPart.Visible then367 ProgressBarPart.Visible := ProgressBarPartVisible;368 ProgressBarTotalVisible := True;369 if ProgressBarTotalVisible <> ProgressBarTotal.Visible then370 ProgressBarTotal.Visible := ProgressBarTotalVisible;371 end;372 if not Visible then begin373 TimerUpdate.Interval := UpdateInterval;374 if not JobProgressView.OwnerDraw then Show;375 end;376 end;377 378 procedure TFormJobProgressView.FormDestroy(Sender:TObject);379 begin380 end;381 382 procedure TFormJobProgressView.ListViewJobsData(Sender: TObject; Item: TListItem);383 begin384 if (Item.Index >= 0) and (Item.Index < JobProgressView.Jobs.Count) then385 with TJob(JobProgressView.Jobs[Item.Index]) do begin386 Item.Caption := Title;387 if Item.Index = JobProgressView.CurrentJobIndex then Item.ImageIndex := 1388 else if Finished then Item.ImageIndex := 0389 else Item.ImageIndex := 2;390 Item.Data := JobProgressView.Jobs[Item.Index];391 end;392 end;393 394 procedure TFormJobProgressView.FormClose(Sender: TObject;395 var CloseAction: TCloseAction);396 begin397 ListViewJobs.Clear;398 end;399 400 procedure TFormJobProgressView.FormCreate(Sender: TObject);401 begin402 Caption := SPleaseWait;403 try404 //Animate1.FileName := ExtractFileDir(UTF8Encode(Application.ExeName)) +405 // DirectorySeparator + 'horse.avi';406 //Animate1.Active := True;407 except408 409 end;410 470 end; 411 471 … … 426 486 Sleep(Quantum); 427 487 end; 428 end;429 430 procedure TFormJobProgressView.FormCloseQuery(Sender: TObject; var CanClose: Boolean);431 begin432 CanClose := JobProgressView.Finished;433 JobProgressView.Terminate := True;434 Caption := SPleaseWait + STerminate;435 488 end; 436 489 … … 490 543 end; 491 544 492 procedure TJobProgressView.ReloadJobList;493 begin494 UpdateHeight;495 // Workaround for not showing first line496 Form.ListViewJobs.Items.Count := Jobs.Count + 1;497 Form.ListViewJobs.Refresh;498 499 if Form.ListViewJobs.Items.Count <> Jobs.Count then500 Form.ListViewJobs.Items.Count := Jobs.Count;501 Form.ListViewJobs.Refresh;502 //Application.ProcessMessages;503 end;504 505 545 constructor TJobProgressView.Create(TheOwner: TComponent); 506 546 begin 507 547 inherited; 508 548 if not (csDesigning in ComponentState) then begin 509 F orm := TFormJobProgressView.Create(Self);510 F orm.JobProgressView := Self;511 end; 512 Jobs := T ObjectList.Create;549 FForm := TFormJobProgressView.Create(Self); 550 FForm.JobProgressView := Self; 551 end; 552 Jobs := TJobs.Create; 513 553 Log := TStringList.Create; 514 554 //PanelOperationsTitle.Height := 80; 515 ShowDelay := 0; //1000; // ms 555 AutoClose := True; 556 ShowDelay := 0; 516 557 end; 517 558 … … 519 560 begin 520 561 Jobs.Clear; 562 Log.Clear; 521 563 //ReloadJobList; 522 564 end; … … 528 570 inherited; 529 571 end; 572 573 { TProgress } 530 574 531 575 procedure TProgress.SetMax(const AValue: Integer); … … 536 580 if FMax < 1 then FMax := 1; 537 581 if FValue >= FMax then FValue := FMax; 582 finally 583 FLock.Release; 584 end; 585 end; 586 587 procedure TProgress.SetText(AValue: string); 588 begin 589 try 590 FLock.Acquire; 591 if FText = AValue then Exit; 592 FText := AValue; 538 593 finally 539 594 FLock.Release; … … 563 618 end; 564 619 565 { TProgress }566 567 620 procedure TProgress.Increment; 568 621 begin -
trunk/Packages/Common/ULastOpenedList.pas
r4 r41 6 6 7 7 uses 8 Classes, SysUtils, Registry, URegistry, Menus, XMLConf ;8 Classes, SysUtils, Registry, URegistry, Menus, XMLConf, DOM; 9 9 10 10 type … … 30 30 procedure SaveToXMLConfig(XMLConfig: TXMLConfig; Path: string); 31 31 procedure AddItem(FileName: string); 32 function GetFirstFileName: string; 32 33 published 33 34 property MaxCount: Integer read FMaxCount write SetMaxCount; … … 139 140 OpenKey(Context.Key, True); 140 141 for I := 0 to Items.Count - 1 do 141 WriteString('File' + IntToStr(I), UTF8Decode(Items[I]));142 WriteString('File' + IntToStr(I), Items[I]); 142 143 finally 143 144 Free; … … 153 154 begin 154 155 with XMLConfig do begin 155 Count := GetValue( Path + '/Count', 0);156 Count := GetValue(DOMString(Path + '/Count'), 0); 156 157 if Count > MaxCount then Count := MaxCount; 157 158 Items.Clear; 158 159 for I := 0 to Count - 1 do begin 159 Value := GetValue(Path + '/File' + IntToStr(I), '');160 Value := string(GetValue(DOMString(Path + '/File' + IntToStr(I)), '')); 160 161 if Trim(Value) <> '' then Items.Add(Value); 161 162 end; … … 170 171 begin 171 172 with XMLConfig do begin 172 SetValue( Path + '/Count', Items.Count);173 SetValue(DOMString(Path + '/Count'), Items.Count); 173 174 for I := 0 to Items.Count - 1 do 174 SetValue( Path + '/File' + IntToStr(I), Items[I]);175 SetValue(DOMString(Path + '/File' + IntToStr(I)), DOMString(Items[I])); 175 176 Flush; 176 177 end; … … 185 186 end; 186 187 188 function TLastOpenedList.GetFirstFileName: string; 189 begin 190 if Items.Count > 0 then Result := Items[0] 191 else Result := ''; 192 end; 193 187 194 end. 188 195 -
trunk/Packages/Common/UListViewSort.pas
r40 r41 9 9 uses 10 10 {$IFDEF Windows}Windows, CommCtrl, {$ENDIF}Classes, Graphics, ComCtrls, SysUtils, 11 Controls, DateUtils, Dialogs, SpecializedList, Forms, Grids, StdCtrls, ExtCtrls,11 Controls, DateUtils, Dialogs, fgl, Forms, Grids, StdCtrls, ExtCtrls, 12 12 LclIntf, LMessages, LclType, LResources; 13 13 … … 52 52 {$ENDIF} 53 53 public 54 List: T ListObject;55 Source: T ListObject;54 List: TFPGObjectList<TObject>; 55 Source: TFPGObjectList<TObject>; 56 56 constructor Create(AOwner: TComponent); override; 57 57 destructor Destroy; override; … … 81 81 FOnChange: TNotifyEvent; 82 82 FStringGrid1: TStringGrid; 83 procedure DoOnKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);84 procedure DoOnResize(Sender: TObject);83 procedure GridDoOnKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); 84 procedure GridDoOnResize(Sender: TObject); 85 85 public 86 86 constructor Create(AOwner: TComponent); override; … … 98 98 end; 99 99 100 { TListViewEx } 101 102 TListViewEx = class(TWinControl) 103 private 104 FFilter: TListViewFilter; 105 FListView: TListView; 106 FListViewSort: TListViewSort; 107 procedure ResizeHanlder; 108 public 109 constructor Create(TheOwner: TComponent); override; 110 destructor Destroy; override; 111 published 112 property ListView: TListView read FListView write FListView; 113 property ListViewSort: TListViewSort read FListViewSort write FListViewSort; 114 property Filter: TListViewFilter read FFilter write FFilter; 115 property Visible; 116 end; 117 100 118 procedure Register; 101 119 … … 105 123 procedure Register; 106 124 begin 107 RegisterComponents('Common', [TListViewSort, TListViewFilter]); 125 RegisterComponents('Common', [TListViewSort, TListViewFilter, TListViewEx]); 126 end; 127 128 { TListViewEx } 129 130 procedure TListViewEx.ResizeHanlder; 131 begin 132 end; 133 134 constructor TListViewEx.Create(TheOwner: TComponent); 135 begin 136 inherited Create(TheOwner); 137 Filter := TListViewFilter.Create(Self); 138 Filter.Parent := Self; 139 Filter.Align := alBottom; 140 ListView := TListView.Create(Self); 141 ListView.Parent := Self; 142 ListView.Align := alClient; 143 ListViewSort := TListViewSort.Create(Self); 144 ListViewSort.ListView := ListView; 145 end; 146 147 destructor TListViewEx.Destroy; 148 begin 149 inherited Destroy; 108 150 end; 109 151 110 152 { TListViewFilter } 111 153 112 procedure TListViewFilter. DoOnKeyUp(Sender: TObject; var Key: Word;154 procedure TListViewFilter.GridDoOnKeyUp(Sender: TObject; var Key: Word; 113 155 Shift: TShiftState); 114 156 begin … … 117 159 end; 118 160 119 procedure TListViewFilter. DoOnResize(Sender: TObject);161 procedure TListViewFilter.GridDoOnResize(Sender: TObject); 120 162 begin 121 163 FStringGrid1.DefaultRowHeight := FStringGrid1.Height; … … 135 177 FStringGrid1.Options := [goFixedHorzLine, goFixedVertLine, goVertLine, 136 178 goHorzLine, goRangeSelect, goEditing, goAlwaysShowEditor, goSmoothScroll]; 137 FStringGrid1.OnKeyUp := DoOnKeyUp;138 FStringGrid1.OnResize := DoOnResize;179 FStringGrid1.OnKeyUp := GridDoOnKeyUp; 180 FStringGrid1.OnResize := GridDoOnResize; 139 181 end; 140 182 … … 142 184 var 143 185 I: Integer; 186 R: TRect; 144 187 begin 145 188 with FStringGrid1 do begin 146 //Columns.Clear;147 189 while Columns.Count > ListView.Columns.Count do Columns.Delete(Columns.Count - 1); 148 190 while Columns.Count < ListView.Columns.Count do Columns.Add; 149 191 for I := 0 to ListView.Columns.Count - 1 do begin 150 192 Columns[I].Width := ListView.Columns[I].Width; 193 if Selection.Left = I then begin 194 R := CellRect(I, 0); 195 Editor.Left := R.Left + 2; 196 Editor.Width := R.Width - 4; 197 end; 151 198 end; 152 199 end; … … 197 244 if AMsg.Msg = WM_NOTIFY then 198 245 begin 199 Code := PHDNotify(vMsgNotify.NMHdr)^.Hdr.Code;246 Code := NMHDR(PHDNotify(vMsgNotify.NMHdr)^.Hdr).Code; 200 247 case Code of 201 248 HDN_ENDTRACKA, HDN_ENDTRACKW: … … 272 319 end; 273 320 321 var 322 ListViewSortCompare: TCompareEvent; 323 324 function ListViewCompare(const Item1, Item2: TObject): Integer; 325 begin 326 Result := ListViewSortCompare(Item1, Item2); 327 end; 328 274 329 procedure TListViewSort.Sort(Compare: TCompareEvent); 275 330 begin 331 // TODO: Because TFLGObjectList compare handler is not class method, 332 // it is necessary to use simple function compare handler with local variable 333 ListViewSortCompare := Compare; 276 334 if (List.Count > 0) then 277 List.Sort( Compare);335 List.Sort(ListViewCompare); 278 336 end; 279 337 … … 338 396 begin 339 397 inherited; 340 List := T ListObject.Create;341 List. OwnsObjects := False;398 List := TFPGObjectList<TObject>.Create; 399 List.FreeObjects := False; 342 400 end; 343 401 … … 353 411 TP1: TPoint; 354 412 XBias, YBias: Integer; 355 OldColor: TColor; 413 PenColor: TColor; 414 BrushColor: TColor; 356 415 BiasTop, BiasLeft: Integer; 357 416 Rect1: TRect; … … 365 424 Item.Left := 0; 366 425 GetCheckBias(XBias, YBias, BiasTop, BiasLeft, ListView); 367 OldColor := ListView.Canvas.Pen.Color; 426 PenColor := ListView.Canvas.Pen.Color; 427 BrushColor := ListView.Canvas.Brush.Color; 368 428 //TP1 := Item.GetPosition; 369 429 lRect := Item.DisplayRect(drBounds); // Windows 7 workaround … … 377 437 ItemLeft := Item.Left; 378 438 ItemLeft := 23; // Windows 7 workaround 379 439 380 440 Rect1.Left := ItemLeft - CheckWidth - BiasLeft + 1 + XBias; 381 441 //ShowMessage(IntToStr(Tp1.Y) + ', ' + IntToStr(BiasTop) + ', ' + IntToStr(XBias)); … … 408 468 end; 409 469 //ListView.Canvas.Brush.Color := ListView.Color; 410 ListView.Canvas.Brush.Color := clWindow;411 ListView.Canvas.Pen.Color := OldColor;470 ListView.Canvas.Brush.Color := BrushColor; 471 ListView.Canvas.Pen.Color := PenColor; 412 472 end; 413 473 … … 476 536 FHeaderHandle := ListView_GetHeader(FListView.Handle); 477 537 for I := 0 to FListView.Columns.Count - 1 do begin 538 {$push}{$warn 5057 off} 478 539 FillChar(Item, SizeOf(THDItem), 0); 540 {$pop} 479 541 Item.Mask := HDI_FORMAT; 480 542 Header_GetItem(FHeaderHandle, I, Item); -
trunk/Packages/Common/UMemory.pas
r4 r41 24 24 constructor Create; 25 25 destructor Destroy; override; 26 procedure WriteMemory(Position: Integer; Memory: TMemory); 27 procedure ReadMemory(Position: Integer; Memory: TMemory); 26 28 property Data: PByte read FData; 27 29 property Size: Integer read FSize write SetSize; … … 108 110 end; 109 111 112 procedure TMemory.WriteMemory(Position: Integer; Memory: TMemory); 113 begin 114 Move(Memory.FData, PByte(PByte(@FData) + Position)^, Memory.Size); 115 end; 116 117 procedure TMemory.ReadMemory(Position: Integer; Memory: TMemory); 118 begin 119 Move(PByte(PByte(@FData) + Position)^, Memory.FData, Memory.Size); 120 end; 121 110 122 end. 111 123 -
trunk/Packages/Common/UPersistentForm.pas
r40 r41 8 8 9 9 uses 10 Classes, SysUtils, Forms, URegistry, LCLIntf, Registry, Controls, ComCtrls; 10 Classes, SysUtils, Forms, URegistry, LCLIntf, Registry, Controls, ComCtrls, 11 ExtCtrls; 11 12 12 13 type … … 56 57 I: Integer; 57 58 WinControl: TWinControl; 58 Count: Integer;59 59 begin 60 60 if Control is TListView then begin … … 72 72 end; 73 73 74 if (Control is TPanel) then begin 75 with Form, TRegistryEx.Create do 76 try 77 RootKey := RegistryContext.RootKey; 78 OpenKey(RegistryContext.Key + '\Forms\' + Form.Name + '\' + Control.Name, True); 79 if (TPanel(Control).Align = alRight) or (TPanel(Control).Align = alLeft) then begin 80 if ValueExists('Width') then 81 TPanel(Control).Width := ReadInteger('Width'); 82 end; 83 if (TPanel(Control).Align = alTop) or (TPanel(Control).Align = alBottom) then begin 84 if ValueExists('Height') then 85 TPanel(Control).Height := ReadInteger('Height'); 86 end; 87 finally 88 Free; 89 end; 90 end; 91 74 92 if Control is TWinControl then begin 75 93 WinControl := TWinControl(Control); … … 96 114 for I := 0 to TListView(Control).Columns.Count - 1 do begin 97 115 WriteInteger('ColWidth' + IntToStr(I), TListView(Control).Columns[I].Width); 116 end; 117 finally 118 Free; 119 end; 120 end; 121 122 if (Control is TPanel) then begin 123 with Form, TRegistryEx.Create do 124 try 125 RootKey := RegistryContext.RootKey; 126 OpenKey(RegistryContext.Key + '\Forms\' + Form.Name + '\' + Control.Name, True); 127 if (TPanel(Control).Align = alRight) or (TPanel(Control).Align = alLeft) then begin 128 WriteInteger('Width', TPanel(Control).Width); 129 end; 130 if (TPanel(Control).Align = alTop) or (TPanel(Control).Align = alBottom) then begin 131 WriteInteger('Height', TPanel(Control).Height); 98 132 end; 99 133 finally … … 217 251 218 252 procedure TPersistentForm.Load(Form: TForm; DefaultMaximized: Boolean = False); 219 var220 LoadDefaults: Boolean;221 253 begin 222 254 Self.Form := Form; … … 230 262 231 263 if not EqualRect(FormNormalSize, FormRestoredSize) or 232 (LoadDefaults and DefaultMaximized)then begin264 DefaultMaximized then begin 233 265 // Restore to maximized state 234 266 Form.WindowState := wsNormal; -
trunk/Packages/Common/UPool.pas
r4 r41 6 6 7 7 uses 8 Classes, SysUtils, syncobjs, SpecializedList, UThreading;8 Classes, SysUtils, syncobjs, fgl, UThreading; 9 9 10 10 type … … 22 22 function NewItemObject: TObject; virtual; 23 23 public 24 Items: T ListObject;25 FreeItems: T ListObject;24 Items: TFPGObjectList<TObject>; 25 FreeItems: TFPGObjectList<TObject>; 26 26 function Acquire: TObject; virtual; 27 27 procedure Release(Item: TObject); virtual; … … 185 185 begin 186 186 inherited; 187 Items := T ListObject.Create;188 FreeItems := T ListObject.Create;189 FreeItems. OwnsObjects := False;187 Items := TFPGObjectList<TObject>.Create; 188 FreeItems := TFPGObjectList<TObject>.Create; 189 FreeItems.FreeObjects := False; 190 190 FReleaseEvent := TEvent.Create(nil, False, False, ''); 191 191 end; -
trunk/Packages/Common/UPrefixMultiplier.pas
r40 r41 21 21 { TPrefixMultiplier } 22 22 23 TPrefixMultiplier = class 23 TPrefixMultiplier = class(TComponent) 24 24 private 25 function TruncateDigits(Value: Double;Digits:Integer=3):Double;25 function TruncateDigits(Value: Double; Digits: Integer = 3): Double; 26 26 public 27 27 function Add(Value: Double; PrefixMultipliers: TPrefixMultiplierDef; … … 72 72 ); 73 73 74 procedure Register; 75 76 74 77 implementation 78 79 procedure Register; 80 begin 81 RegisterComponents('Common', [TPrefixMultiplier]); 82 end; 75 83 76 84 { TPrefixMultiplier } … … 92 100 end; 93 101 94 function TPrefixMultiplier.Add(Value: Double;PrefixMultipliers:TPrefixMultiplierDef95 ; UnitText:string;Digits:Integer):string;102 function TPrefixMultiplier.Add(Value: Double; PrefixMultipliers: TPrefixMultiplierDef 103 ; UnitText:string; Digits: Integer): string; 96 104 var 97 105 I: Integer; -
trunk/Packages/Common/URegistry.pas
r4 r41 9 9 10 10 type 11 TRegistryRoot = (rrKeyClassesRoot = HKEY($80000000), 12 rrKeyCurrentUser = HKEY($80000001), 13 rrKeyLocalMachine = HKEY($80000002), 14 rrKeyUsers = HKEY($80000003), 15 rrKeyPerformanceData = HKEY($80000004), 16 rrKeyCurrentConfig = HKEY($80000005), 17 rrKeyDynData = HKEY($80000006)); 11 TRegistryRoot = (rrKeyClassesRoot, rrKeyCurrentUser, rrKeyLocalMachine, 12 rrKeyUsers, rrKeyPerformanceData, rrKeyCurrentConfig, rrKeyDynData); 18 13 19 14 { TRegistryContext } … … 23 18 Key: string; 24 19 class operator Equal(A, B: TRegistryContext): Boolean; 20 function Create(RootKey: TRegistryRoot; Key: string): TRegistryContext; overload; 21 function Create(RootKey: HKEY; Key: string): TRegistryContext; overload; 25 22 end; 26 23 … … 32 29 procedure SetCurrentContext(AValue: TRegistryContext); 33 30 public 31 function ReadChar(const Name: string): Char; 32 procedure WriteChar(const Name: string; Value: Char); 34 33 function ReadBoolWithDefault(const Name: string; 35 34 DefaultValue: Boolean): Boolean; 36 35 function ReadIntegerWithDefault(const Name: string; DefaultValue: Integer): Integer; 37 36 function ReadStringWithDefault(const Name: string; DefaultValue: string): string; 37 function ReadCharWithDefault(const Name: string; DefaultValue: Char): Char; 38 38 function ReadFloatWithDefault(const Name: string; 39 39 DefaultValue: Double): Double; … … 43 43 end; 44 44 45 function RegContext(RootKey: HKEY; Key: string): TRegistryContext; 46 45 const 46 RegistryRootHKEY: array[TRegistryRoot] of HKEY = (HKEY_CLASSES_ROOT, 47 HKEY_CURRENT_USER, HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_PERFORMANCE_DATA, 48 HKEY_CURRENT_CONFIG, HKEY_DYN_DATA); 47 49 48 50 implementation 49 51 50 function RegContext(RootKey: HKEY; Key: string): TRegistryContext;51 begin52 Result.RootKey := RootKey;53 Result.Key := Key;54 end;55 52 56 53 { TRegistryContext } … … 59 56 begin 60 57 Result := (A.Key = B.Key) and (A.RootKey = B.RootKey); 58 end; 59 60 function TRegistryContext.Create(RootKey: TRegistryRoot; Key: string): TRegistryContext; 61 begin 62 Result.RootKey := RegistryRootHKEY[RootKey]; 63 Result.Key := Key; 64 end; 65 66 function TRegistryContext.Create(RootKey: HKEY; Key: string): TRegistryContext; 67 begin 68 Result.RootKey := RootKey; 69 Result.Key := Key; 61 70 end; 62 71 … … 79 88 else begin 80 89 WriteString(Name, DefaultValue); 90 Result := DefaultValue; 91 end; 92 end; 93 94 function TRegistryEx.ReadCharWithDefault(const Name: string; DefaultValue: Char 95 ): Char; 96 begin 97 if ValueExists(Name) then Result := ReadChar(Name) 98 else begin 99 WriteChar(Name, DefaultValue); 81 100 Result := DefaultValue; 82 101 end; … … 131 150 end; 132 151 152 function TRegistryEx.ReadChar(const Name: string): Char; 153 var 154 S: string; 155 begin 156 S := ReadString(Name); 157 if Length(S) > 0 then Result := S[1] 158 else Result := #0; 159 end; 160 161 procedure TRegistryEx.WriteChar(const Name: string; Value: Char); 162 begin 163 WriteString(Name, Value); 164 end; 165 133 166 function TRegistryEx.ReadBoolWithDefault(const Name: string; 134 167 DefaultValue: Boolean): Boolean; -
trunk/Packages/Common/UResetableThread.pas
r4 r41 156 156 FThread.Name := 'ResetableThread'; 157 157 FThread.Parent := Self; 158 FThread. Resume;158 FThread.Start; 159 159 end; 160 160 -
trunk/Packages/Common/UScaleDPI.pas
r40 r41 215 215 I: Integer; 216 216 begin 217 ImgList.BeginUpdate; 217 218 NewWidth := ScaleX(ImgList.Width, FromDPI.X); 218 219 NewHeight := ScaleY(ImgList.Height, FromDPI.Y); … … 248 249 Temp[i].Free; 249 250 end; 251 ImgList.EndUpdate; 250 252 end; 251 253 … … 284 286 WinControl: TWinControl; 285 287 ToolBarControl: TToolBar; 286 OldAnchors: TAnchors; 287 OldAutoSize: Boolean; 288 begin 288 //OldAnchors: TAnchors; 289 //OldAutoSize: Boolean; 290 begin 291 //if not (Control is TCustomPage) then 292 // Resize childs first 293 if Control is TWinControl then begin 294 WinControl := TWinControl(Control); 295 if WinControl.ControlCount > 0 then begin 296 for I := 0 to WinControl.ControlCount - 1 do begin 297 if WinControl.Controls[I] is TControl then begin 298 ScaleControl(WinControl.Controls[I], FromDPI); 299 end; 300 end; 301 end; 302 end; 303 289 304 //if Control is TMemo then Exit; 290 305 //if Control is TForm then … … 316 331 MinWidth := ScaleX(MinWidth, FromDPI.X); 317 332 MinHeight := ScaleY(MinHeight, FromDPI.Y); 318 Width := ScaleX(Width, FromDPI.X); 333 // Workaround to bad band width auto sizing 334 //Width := ScaleX(Width, FromDPI.X); 335 Width := ScaleX(Control.Width + 28, FromDPI.X); 319 336 //Control.Invalidate; 320 337 end; 338 // Workaround for bad autosizing of coolbar 339 if AutoSize then begin 340 AutoSize := False; 341 Height := ScaleY(Height, FromDPI.Y); 342 AutoSize := True; 343 end; 321 344 EndUpdate; 322 345 end; … … 330 353 end; 331 354 332 //if not (Control is TCustomPage) then333 if Control is TWinControl then begin334 WinControl := TWinControl(Control);335 if WinControl.ControlCount > 0 then begin336 for I := 0 to WinControl.ControlCount - 1 do begin337 if WinControl.Controls[I] is TControl then begin338 ScaleControl(WinControl.Controls[I], FromDPI);339 end;340 end;341 end;342 end;343 355 //if Control is TForm then 344 356 // Control.EnableAutoSizing; -
trunk/Packages/Common/UThreading.pas
r4 r41 30 30 Name: string; 31 31 procedure Execute; virtual; abstract; 32 procedure Resume; virtual; abstract;33 procedure Suspend; virtual; abstract;34 32 procedure Start; virtual; abstract; 35 33 procedure Terminate; virtual; abstract; … … 81 79 procedure Sleep(Delay: Integer); override; 82 80 procedure Execute; override; 83 procedure Resume; override;84 procedure Suspend; override;85 81 procedure Start; override; 86 82 procedure Terminate; override; … … 134 130 Thread.FreeOnTerminate := False; 135 131 Thread.Method := Method; 136 Thread. Resume;132 Thread.Start; 137 133 while (Thread.State = ttsRunning) or (Thread.State = ttsReady) do begin 138 134 if MainThreadID = ThreadID then Application.ProcessMessages; … … 155 151 Thread.Method := Method; 156 152 Thread.OnFinished := CallBack; 157 Thread. Resume;153 Thread.Start; 158 154 //if Thread.State = ttsExceptionOccured then 159 155 // raise Exception.Create(Thread.ExceptionMessage); … … 313 309 procedure TListedThread.Execute; 314 310 begin 315 end;316 317 procedure TListedThread.Resume;318 begin319 FThread.Resume;320 end;321 322 procedure TListedThread.Suspend;323 begin324 FThread.Suspend;325 311 end; 326 312 -
trunk/Packages/Common/UURI.pas
r4 r41 89 89 function LeftCutString(var Source: string; out Output: string; Delimiter: string; Allowed: string = ''): Boolean; 90 90 var 91 I , J: Integer;91 I: Integer; 92 92 Matched: Boolean; 93 93 begin … … 113 113 function RightCutString(var Source: string; out Output: string; Delimiter: string; Allowed: string = ''): Boolean; 114 114 var 115 I , J: Integer;115 I: Integer; 116 116 Matched: Boolean; 117 117 begin … … 202 202 203 203 procedure TURI.SetAsString(Value: string); 204 var205 HostAddr: string;206 HostPort: string;207 204 begin 208 205 LeftCutString(Value, Scheme, ':'); -
trunk/Packages/Common/UXMLUtils.pas
r32 r41 7 7 uses 8 8 {$IFDEF WINDOWS}Windows,{$ENDIF} 9 Classes, SysUtils, DateUtils, XMLRead, XMLWrite, DOM;9 Classes, SysUtils, DateUtils, DOM, xmlread; 10 10 11 11 function XMLTimeToDateTime(XMLDateTime: string): TDateTime; 12 function DateTimeToXMLTime(Value: TDateTime; ApplyLocalBias: Boolean = True): WideString;12 function DateTimeToXMLTime(Value: TDateTime; ApplyLocalBias: Boolean = True): string; 13 13 procedure WriteInteger(Node: TDOMNode; Name: string; Value: Integer); 14 14 procedure WriteInt64(Node: TDOMNode; Name: string; Value: Int64); … … 21 21 function ReadString(Node: TDOMNode; Name: string; DefaultValue: string): string; 22 22 function ReadDateTime(Node: TDOMNode; Name: string; DefaultValue: TDateTime): TDateTime; 23 procedure ReadXMLFileParser(out Doc: TXMLDocument; FileName: string); 23 24 24 25 25 26 implementation 27 28 procedure ReadXMLFileParser(out Doc: TXMLDocument; FileName: string); 29 var 30 Parser: TDOMParser; 31 Src: TXMLInputSource; 32 InFile: TFileStream; 33 begin 34 try 35 InFile := TFileStream.Create(FileName, fmOpenRead); 36 Src := TXMLInputSource.Create(InFile); 37 Parser := TDOMParser.Create; 38 Parser.Options.PreserveWhitespace := True; 39 Parser.Parse(Src, Doc); 40 finally 41 Src.Free; 42 Parser.Free; 43 InFile.Free; 44 end; 45 end; 26 46 27 47 function GetTimeZoneBias: Integer; … … 30 50 TimeZoneInfo: TTimeZoneInformation; 31 51 begin 52 {$push}{$warn 5057 off} 32 53 case GetTimeZoneInformation(TimeZoneInfo) of 33 TIME_ZONE_ID_STANDARD: Result := TimeZoneInfo.Bias + TimeZoneInfo.StandardBias;34 TIME_ZONE_ID_DAYLIGHT: Result := TimeZoneInfo.Bias + TimeZoneInfo.DaylightBias;54 TIME_ZONE_ID_STANDARD: Result := TimeZoneInfo.Bias + TimeZoneInfo.StandardBias; 55 TIME_ZONE_ID_DAYLIGHT: Result := TimeZoneInfo.Bias + TimeZoneInfo.DaylightBias; 35 56 else 36 57 Result := 0; 37 58 end; 59 {$pop} 38 60 end; 39 61 {$ELSE} … … 45 67 function LeftCutString(var Source: string; out Output: string; Delimiter: string; Allowed: string = ''): Boolean; 46 68 var 47 I , J: Integer;69 I: Integer; 48 70 Matched: Boolean; 49 71 begin … … 99 121 if Pos('Z', XMLDateTime) > 0 then 100 122 LeftCutString(XMLDateTime, Part, 'Z'); 101 SecondFraction := StrToFloat('0' + De cimalSeparator + Part);123 SecondFraction := StrToFloat('0' + DefaultFormatSettings.DecimalSeparator + Part); 102 124 Millisecond := Trunc(SecondFraction * 1000); 103 125 end else begin … … 118 140 end; 119 141 120 function DateTimeToXMLTime(Value: TDateTime; ApplyLocalBias: Boolean = True): WideString;142 function DateTimeToXMLTime(Value: TDateTime; ApplyLocalBias: Boolean = True): string; 121 143 const 122 144 Neg: array[Boolean] of string = ('+', '-'); … … 139 161 NewNode: TDOMNode; 140 162 begin 141 NewNode := Node.OwnerDocument.CreateElement( Name);142 NewNode.TextContent := IntToStr(Value);163 NewNode := Node.OwnerDocument.CreateElement(DOMString(Name)); 164 NewNode.TextContent := DOMString(IntToStr(Value)); 143 165 Node.AppendChild(NewNode); 144 166 end; … … 148 170 NewNode: TDOMNode; 149 171 begin 150 NewNode := Node.OwnerDocument.CreateElement( Name);151 NewNode.TextContent := IntToStr(Value);172 NewNode := Node.OwnerDocument.CreateElement(DOMString(Name)); 173 NewNode.TextContent := DOMString(IntToStr(Value)); 152 174 Node.AppendChild(NewNode); 153 175 end; … … 157 179 NewNode: TDOMNode; 158 180 begin 159 NewNode := Node.OwnerDocument.CreateElement( Name);160 NewNode.TextContent := BoolToStr(Value);181 NewNode := Node.OwnerDocument.CreateElement(DOMString(Name)); 182 NewNode.TextContent := DOMString(BoolToStr(Value)); 161 183 Node.AppendChild(NewNode); 162 184 end; … … 166 188 NewNode: TDOMNode; 167 189 begin 168 NewNode := Node.OwnerDocument.CreateElement( Name);169 NewNode.TextContent := Value;190 NewNode := Node.OwnerDocument.CreateElement(DOMString(Name)); 191 NewNode.TextContent := DOMString(Value); 170 192 Node.AppendChild(NewNode); 171 193 end; … … 175 197 NewNode: TDOMNode; 176 198 begin 177 NewNode := Node.OwnerDocument.CreateElement( Name);178 NewNode.TextContent := D ateTimeToXMLTime(Value);199 NewNode := Node.OwnerDocument.CreateElement(DOMString(Name)); 200 NewNode.TextContent := DOMString(DateTimeToXMLTime(Value)); 179 201 Node.AppendChild(NewNode); 180 202 end; … … 185 207 begin 186 208 Result := DefaultValue; 187 NewNode := Node.FindNode( Name);188 if Assigned(NewNode) then 189 Result := StrToInt( NewNode.TextContent);209 NewNode := Node.FindNode(DOMString(Name)); 210 if Assigned(NewNode) then 211 Result := StrToInt(string(NewNode.TextContent)); 190 212 end; 191 213 … … 195 217 begin 196 218 Result := DefaultValue; 197 NewNode := Node.FindNode( Name);198 if Assigned(NewNode) then 199 Result := StrToInt64( NewNode.TextContent);219 NewNode := Node.FindNode(DOMString(Name)); 220 if Assigned(NewNode) then 221 Result := StrToInt64(string(NewNode.TextContent)); 200 222 end; 201 223 … … 205 227 begin 206 228 Result := DefaultValue; 207 NewNode := Node.FindNode( Name);208 if Assigned(NewNode) then 209 Result := StrToBool( NewNode.TextContent);229 NewNode := Node.FindNode(DOMString(Name)); 230 if Assigned(NewNode) then 231 Result := StrToBool(string(NewNode.TextContent)); 210 232 end; 211 233 … … 215 237 begin 216 238 Result := DefaultValue; 217 NewNode := Node.FindNode( Name);218 if Assigned(NewNode) then 219 Result := NewNode.TextContent;239 NewNode := Node.FindNode(DOMString(Name)); 240 if Assigned(NewNode) then 241 Result := string(NewNode.TextContent); 220 242 end; 221 243 … … 226 248 begin 227 249 Result := DefaultValue; 228 NewNode := Node.FindNode( Name);229 if Assigned(NewNode) then 230 Result := XMLTimeToDateTime( NewNode.TextContent);250 NewNode := Node.FindNode(DOMString(Name)); 251 if Assigned(NewNode) then 252 Result := XMLTimeToDateTime(string(NewNode.TextContent)); 231 253 end; 232 254 -
trunk/Packages/CoolTranslator
-
Property svn:ignore
set to
lib
-
Property svn:ignore
set to
-
trunk/Packages/CoolTranslator/CoolTranslator.lpk
r40 r41 1 <?xml version="1.0" ?>1 <?xml version="1.0" encoding="UTF-8"?> 2 2 <CONFIG> 3 3 <Package Version="4"> 4 4 <PathDelim Value="\"/> 5 5 <Name Value="CoolTranslator"/> 6 <Type Value="RunAndDesignTime"/> 6 7 <AddToProjectUsesSection Value="True"/> 7 8 <Author Value="Chronos (robie@centrum.cz)"/> 8 9 <CompilerOptions> 9 <Version Value="1 0"/>10 <Version Value="11"/> 10 11 <PathDelim Value="\"/> 11 12 <SearchPaths> 12 <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS) "/>13 <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)-$(BuildMode)"/> 13 14 </SearchPaths> 15 <Parsing> 16 <SyntaxOptions> 17 <SyntaxMode Value="Delphi"/> 18 <CStyleOperator Value="False"/> 19 <AllowLabel Value="False"/> 20 <CPPInline Value="False"/> 21 </SyntaxOptions> 22 </Parsing> 23 <CodeGeneration> 24 <Optimizations> 25 <OptimizationLevel Value="0"/> 26 </Optimizations> 27 </CodeGeneration> 28 <Linking> 29 <Debugging> 30 <GenerateDebugInfo Value="False"/> 31 </Debugging> 32 </Linking> 14 33 <Other> 15 <CompilerPath Value="$(CompPath)"/> 34 <CompilerMessages> 35 <IgnoredMessages idx5024="True"/> 36 </CompilerMessages> 16 37 </Other> 17 38 </CompilerOptions> … … 38 59 <OutDir Value="Languages"/> 39 60 </i18n> 40 <Type Value="RunAndDesignTime"/>41 61 <RequiredPkgs Count="2"> 42 62 <Item1> -
trunk/Packages/CoolTranslator/UCoolTranslator.pas
r40 r41 127 127 I, J: Integer; 128 128 Po: TPoFile; 129 Item: TPOFileItem; 129 130 begin 130 131 TranslateComponentRecursive(Application); … … 136 137 with TPoFile(FPoFiles[I]) do 137 138 for J := 0 to Items.Count - 1 do 138 with TPoFileItem(Items[J]) do 139 Po.Add(IdentifierLow, Original, Translation, Comments, Context, 139 with TPoFileItem(Items[J]) do begin 140 Item := nil; 141 Po.FillItem(Item, IdentifierLow, Original, Translation, Comments, Context, 140 142 Flags, PreviousID); 143 end; 141 144 Translations.TranslateResourceStrings(Po); 142 145 finally … … 197 200 PropInfo: PPropInfo; 198 201 PropList: PPropList; 199 Excludes: TComponentExcludes;200 202 begin 201 203 Count := GetTypeData(Component.ClassInfo)^.PropCount; … … 250 252 if (UpperCase(PropType.Name) = 'TTRANSLATESTRING') then 251 253 //if not IsExcluded(Component, PropInfo^.Name) then 252 SetStrProp(Component, PropInfo, TranslateText(PropInfo^.Name, GetWideStrProp(Component, PropInfo)));254 SetStrProp(Component, PropInfo, TranslateText(PropInfo^.Name, string(GetWideStrProp(Component, PropInfo)))); 253 255 end; 254 256 tkClass: begin … … 295 297 Result := FPOFilesFolder; 296 298 if Copy(Result, 1, 1) <> DirectorySeparator then 297 Result := ExtractFileDir( UTF8Encode(Application.ExeName)) +299 Result := ExtractFileDir(Application.ExeName) + 298 300 DirectorySeparator + Result; 299 301 end; … … 412 414 Lang := ParamStr(i + 1); 413 415 end; 414 if Lang = '' then 415 LCLGetLanguageIDs(Lang, T); 416 if Lang = '' then begin 417 T := ''; 418 LazGetLanguageIDs(Lang, T); 419 end; 416 420 417 421 if Assigned(Language) and (Language.Code = '') and Assigned(FOnAutomaticLanguage) then begin … … 429 433 function TCoolTranslator.FindLocaleFileName(LCExt: string): string; 430 434 var 431 T: string;432 435 Lang: string; 433 436 begin -
trunk/UCore.lfm
r34 r41 3 3 OnDestroy = DataModuleDestroy 4 4 OldCreateOrder = False 5 Height = 539 6 HorizontalOffset = 763 7 VerticalOffset = 511 8 Width = 769 5 Height = 809 6 HorizontalOffset = 1145 7 VerticalOffset = 573 8 Width = 1154 9 PPI = 144 9 10 object PersistentForm1: TPersistentForm 10 11 MinVisiblePart = 50 11 12 EntireVisible = False 12 left = 22413 top = 20813 left = 336 14 top = 312 14 15 end 15 16 object ImageList1: TImageList 16 left = 22417 top = 13617 left = 336 18 top = 204 18 19 end 19 20 object XMLConfig1: TXMLConfig … … 21 22 RootName = 'CONFIG' 22 23 ReadOnly = False 23 left = 42424 top = 13624 left = 636 25 top = 204 25 26 end 26 27 object CoolTranslator1: TCoolTranslator 27 28 POFilesFolder = 'Languages' 28 left = 8829 top = 1 2829 left = 132 30 top = 192 30 31 end 31 32 object ApplicationInfo1: TApplicationInfo … … 36 37 VersionSuffix = 'alfa' 37 38 CompanyName = 'Chronosoft' 38 HomePage = 'http ://svn.zdechov.net/svn/CoolDisk'39 HomePage = 'https://app.zdechov.net/CoolDisk' 39 40 AuthorsName = 'Chronos' 40 41 EmailContact = 'robie@centrum.cz' 41 42 AppName = 'CoolDisk' 42 ReleaseDate = 4 271443 ReleaseDate = 43593 43 44 RegistryKey = '\Software\Chronosoft\CoolDisk' 44 45 RegistryRoot = rrKeyCurrentUser 45 46 License = 'CC0' 46 left = 8847 top = 5647 left = 132 48 top = 84 48 49 end 49 50 object ScaleDPI1: TScaleDPI 50 51 AutoDetect = False 51 left = 8852 top = 20052 left = 132 53 top = 300 53 54 end 54 55 end -
trunk/UCore.pas
r37 r41 58 58 procedure TCore.LoadConfig; 59 59 begin 60 RegistryContext := RegContext(HKEY(ApplicationInfo1.RegistryRoot), ApplicationInfo1.RegistryKey);60 RegistryContext := TRegistryContext.Create(ApplicationInfo1.RegistryRoot, ApplicationInfo1.RegistryKey); 61 61 PersistentForm1.RegistryContext := RegistryContext; 62 62 XMLConfig1.Filename := GetAppConfigDir(False) + 'Config.xml'; 63 63 ForceDirectories(ExtractFileDir(XMLConfig1.Filename)); 64 64 65 CoolTranslator1.Language := CoolTranslator1.Languages.SearchByCode( XMLConfig1.GetValue('Language', ''));65 CoolTranslator1.Language := CoolTranslator1.Languages.SearchByCode(string(XMLConfig1.GetValue('Language', unicodestring('')))); 66 66 end; 67 67 68 68 procedure TCore.SaveConfig; 69 69 begin 70 XMLConfig1.SetValue('Language', CoolTranslator1.Language.Code);70 XMLConfig1.SetValue('Language', UnicodeString(CoolTranslator1.Language.Code)); 71 71 end; 72 72 -
trunk/UDriveScan.pas
r31 r41 125 125 implementation 126 126 127 uses128 UFileStreamEx;129 130 127 resourcestring 131 128 SUnknownRunMode = 'Unknown run mode'; -
trunk/UPhysDrive.pas
r37 r41 107 107 PrefixMultiplier: TPrefixMultiplier; 108 108 begin 109 PrefixMultiplier := TPrefixMultiplier.Create ;109 PrefixMultiplier := TPrefixMultiplier.Create(nil); 110 110 try 111 111 while Strings.Count > Count do
Note:
See TracChangeset
for help on using the changeset viewer.