Changeset 89
- Timestamp:
- Jun 7, 2024, 4:35:46 PM (7 months ago)
- Location:
- trunk
- Files:
-
- 15 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Forms/FormNew.lfm
r86 r89 1 1 object FormNew: TFormNew 2 Left = 7033 Height = 2664 Top = 6945 Width = 5 012 Left = 1029 3 Height = 322 4 Top = 587 5 Width = 514 6 6 Caption = 'New game' 7 ClientHeight = 2668 ClientWidth = 5 017 ClientHeight = 322 8 ClientWidth = 514 9 9 DesignTimePPI = 144 10 10 OnCreate = FormCreate 11 11 LCLVersion = '3.4.0.0' 12 object Label1: TLabel 13 Left = 16 14 Height = 26 15 Top = 16 16 Width = 93 17 Caption = 'Board size:' 18 ParentColor = False 19 end 20 object ComboBoxSize: TComboBox 21 Left = 173 12 object ButtonCancel: TButton 13 Left = 255 22 14 Height = 38 23 Top = 11 24 Width = 262 25 ItemHeight = 0 26 Items.Strings = ( 27 '2 x 2' 28 '3 x 3' 29 '4 x 4' 30 '5 x 5' 31 '6 x 6' 32 '7 x 7' 33 '8 x 8' 34 '9 x 9' 35 '10 x 10 ' 36 '11 x 11' 37 '12 x 12' 38 ) 39 Style = csDropDownList 15 Top = 271 16 Width = 116 17 Anchors = [akRight, akBottom] 18 Caption = 'Cancel' 19 ModalResult = 2 40 20 TabOrder = 0 41 21 end 42 object Button Cancel: TButton43 Left = 12022 object ButtonOk: TButton 23 Left = 391 44 24 Height = 38 45 Top = 2 1246 Width = 11 347 Anchors = [ak Left, akBottom]48 Caption = ' Cancel'49 ModalResult = 225 Top = 271 26 Width = 116 27 Anchors = [akRight, akBottom] 28 Caption = 'OK' 29 ModalResult = 1 50 30 TabOrder = 1 51 31 end 52 object ButtonOk: TButton 53 Left = 280 54 Height = 38 55 Top = 212 56 Width = 113 57 Anchors = [akLeft, akBottom] 58 Caption = 'OK' 59 ModalResult = 1 32 object ScrollBox1: TScrollBox 33 Left = 8 34 Height = 247 35 Top = 8 36 Width = 497 37 HorzScrollBar.Page = 435 38 VertScrollBar.Page = 214 39 Anchors = [akTop, akLeft, akRight, akBottom] 40 ClientHeight = 245 41 ClientWidth = 495 60 42 TabOrder = 2 61 end 62 object CheckBoxUndoEnabled: TCheckBox 63 Left = 16 64 Height = 30 65 Top = 56 66 Width = 145 67 Caption = 'Undo enabled' 68 TabOrder = 3 69 end 70 object CheckBoxRecordHistory: TCheckBox 71 Left = 16 72 Height = 30 73 Top = 88 74 Width = 209 75 Caption = 'Record moves history' 76 TabOrder = 4 77 end 78 object Label2: TLabel 79 Left = 16 80 Height = 26 81 Top = 125 82 Width = 75 83 Caption = 'Tile skin:' 84 ParentColor = False 85 end 86 object ComboBoxSkin: TComboBox 87 Left = 173 88 Height = 38 89 Top = 120 90 Width = 262 91 ItemHeight = 0 92 Items.Strings = ( 93 '' 94 ) 95 Style = csDropDownList 96 TabOrder = 5 43 object Label1: TLabel 44 Left = 16 45 Height = 26 46 Top = 16 47 Width = 93 48 Caption = 'Board size:' 49 ParentColor = False 50 end 51 object ComboBoxSize: TComboBox 52 Left = 173 53 Height = 38 54 Top = 11 55 Width = 262 56 ItemHeight = 0 57 Items.Strings = ( 58 '2 x 2' 59 '3 x 3' 60 '4 x 4' 61 '5 x 5' 62 '6 x 6' 63 '7 x 7' 64 '8 x 8' 65 '9 x 9' 66 '10 x 10 ' 67 '11 x 11' 68 '12 x 12' 69 ) 70 Style = csDropDownList 71 TabOrder = 0 72 end 73 object CheckBoxUndoEnabled: TCheckBox 74 Left = 16 75 Height = 30 76 Top = 56 77 Width = 145 78 Caption = 'Undo enabled' 79 TabOrder = 1 80 end 81 object CheckBoxRecordHistory: TCheckBox 82 Left = 16 83 Height = 30 84 Top = 88 85 Width = 209 86 Caption = 'Record moves history' 87 TabOrder = 2 88 end 89 object Label2: TLabel 90 Left = 16 91 Height = 26 92 Top = 133 93 Width = 75 94 Caption = 'Tile skin:' 95 ParentColor = False 96 end 97 object ComboBoxSkin: TComboBox 98 Left = 173 99 Height = 38 100 Top = 128 101 Width = 262 102 ItemHeight = 0 103 Items.Strings = ( 104 '' 105 ) 106 Style = csDropDownList 107 TabOrder = 3 108 end 109 object Label3: TLabel 110 Left = 16 111 Height = 26 112 Top = 181 113 Width = 113 114 Caption = 'Color palette:' 115 ParentColor = False 116 end 117 object ComboBoxColorPalette: TComboBox 118 Left = 173 119 Height = 38 120 Top = 176 121 Width = 262 122 ItemHeight = 0 123 Items.Strings = ( 124 'RGB' 125 'RBG' 126 'GRB' 127 'GBR' 128 'BGR' 129 'BRG' 130 ) 131 Style = csDropDownList 132 TabOrder = 4 133 end 97 134 end 98 135 end -
trunk/Forms/FormNew.lrj
r86 r89 1 1 {"version":1,"strings":[ 2 2 {"hash":211211125,"name":"tformnew.caption","sourcebytes":[78,101,119,32,103,97,109,101],"value":"New game"}, 3 {"hash":103901194,"name":"tformnew.label1.caption","sourcebytes":[66,111,97,114,100,32,115,105,122,101,58],"value":"Board size:"},4 3 {"hash":77089212,"name":"tformnew.buttoncancel.caption","sourcebytes":[67,97,110,99,101,108],"value":"Cancel"}, 5 4 {"hash":1339,"name":"tformnew.buttonok.caption","sourcebytes":[79,75],"value":"OK"}, 5 {"hash":103901194,"name":"tformnew.label1.caption","sourcebytes":[66,111,97,114,100,32,115,105,122,101,58],"value":"Board size:"}, 6 6 {"hash":260260820,"name":"tformnew.checkboxundoenabled.caption","sourcebytes":[85,110,100,111,32,101,110,97,98,108,101,100],"value":"Undo enabled"}, 7 7 {"hash":146862089,"name":"tformnew.checkboxrecordhistory.caption","sourcebytes":[82,101,99,111,114,100,32,109,111,118,101,115,32,104,105,115,116,111,114,121],"value":"Record moves history"}, 8 {"hash":125677626,"name":"tformnew.label2.caption","sourcebytes":[84,105,108,101,32,115,107,105,110,58],"value":"Tile skin:"} 8 {"hash":125677626,"name":"tformnew.label2.caption","sourcebytes":[84,105,108,101,32,115,107,105,110,58],"value":"Tile skin:"}, 9 {"hash":35322186,"name":"tformnew.label3.caption","sourcebytes":[67,111,108,111,114,32,112,97,108,101,116,116,101,58],"value":"Color palette:"} 9 10 ]} -
trunk/Forms/FormNew.pas
r86 r89 16 16 CheckBoxRecordHistory: TCheckBox; 17 17 CheckBoxUndoEnabled: TCheckBox; 18 ComboBoxColorPalette: TComboBox; 18 19 ComboBoxSize: TComboBox; 19 20 ComboBoxSkin: TComboBox; 20 21 Label1: TLabel; 21 22 Label2: TLabel; 23 Label3: TLabel; 24 ScrollBox1: TScrollBox; 22 25 procedure FormCreate(Sender: TObject); 23 26 public … … 31 34 {$R *.lfm} 32 35 33 uses34 Core;35 36 36 { TFormNew } 37 37 38 38 procedure TFormNew.FormCreate(Sender: TObject); 39 39 var 40 I: TTileSkin; 40 TileSkin: TTileSkin; 41 ColorPalette: TColorPalette; 41 42 begin 42 43 ComboBoxSkin.Items.BeginUpdate; 43 44 try 44 45 ComboBoxSkin.Items.Clear; 45 for I:= Low(SkinText) to High(SkinText) do46 ComboBoxSkin.Items.Add(SkinText[ I]);46 for TileSkin := Low(SkinText) to High(SkinText) do 47 ComboBoxSkin.Items.Add(SkinText[TileSkin]); 47 48 finally 48 49 ComboBoxSkin.Items.EndUpdate; 50 end; 51 52 ComboBoxColorPalette.Items.BeginUpdate; 53 try 54 ComboBoxColorPalette.Items.Clear; 55 for ColorPalette := Low(ColorPaletteText) to High(ColorPaletteText) do 56 ComboBoxColorPalette.Items.Add(ColorPaletteText[ColorPalette]); 57 finally 58 ComboBoxColorPalette.Items.EndUpdate; 49 59 end; 50 60 end; … … 56 66 CheckBoxRecordHistory.Checked := Game.RecordHistory; 57 67 ComboBoxSkin.ItemIndex := Integer(Game.Skin); 68 ComboBoxColorPalette.ItemIndex := Integer(Game.ColorPalette); 58 69 end; 59 70 … … 64 75 Game.RecordHistory := CheckBoxRecordHistory.Checked; 65 76 Game.Skin := TTileSkin(ComboBoxSkin.ItemIndex); 77 Game.ColorPalette := TColorPalette(ComboBoxColorPalette.ItemIndex); 66 78 end; 67 79 -
trunk/Forms/FormSettings.lfm
r86 r89 1 1 object FormSettings: TFormSettings 2 Left = 9793 Height = 3 604 Top = 3855 Width = 4802 Left = 838 3 Height = 331 4 Top = 468 5 Width = 612 6 6 Caption = 'Settings' 7 ClientHeight = 3 608 ClientWidth = 4807 ClientHeight = 331 8 ClientWidth = 612 9 9 DesignTimePPI = 144 10 10 OnCreate = FormCreate 11 11 OnShow = FormShow 12 12 LCLVersion = '3.4.0.0' 13 object Label1: TLabel 14 Left = 19 15 Height = 26 16 Top = 24 17 Width = 170 18 Caption = 'Animation duration:' 19 ParentColor = False 20 end 21 object TrackBar1: TTrackBar 22 Left = 208 23 Height = 58 24 Top = 16 25 Width = 240 26 Max = 1000 27 Position = 0 28 Anchors = [akTop, akLeft, akRight] 13 object ButtonOk: TButton 14 Left = 488 15 Height = 38 16 Top = 283 17 Width = 113 18 Anchors = [akRight, akBottom] 19 Caption = 'OK' 29 20 TabOrder = 0 30 end31 object ButtonOk: TButton32 Left = 11233 Height = 3834 Top = 29135 Width = 11336 Anchors = [akLeft, akBottom]37 Caption = 'OK'38 TabOrder = 139 21 OnClick = ButtonOkClick 40 22 end 41 23 object ButtonCancel: TButton 42 Left = 25624 Left = 352 43 25 Height = 38 44 Top = 28 826 Top = 283 45 27 Width = 113 46 Anchors = [ak Left, akBottom]28 Anchors = [akRight, akBottom] 47 29 Caption = 'Cancel' 48 TabOrder = 230 TabOrder = 1 49 31 OnClick = ButtonCancelClick 50 32 end 51 object ComboBoxLanguage: TComboBox 52 Left = 208 53 Height = 42 54 Top = 86 55 Width = 230 56 ItemHeight = 0 57 Style = csDropDownList 58 TabOrder = 3 59 end 60 object Label2: TLabel 61 Left = 19 62 Height = 26 63 Top = 94 64 Width = 88 65 Caption = 'Language:' 66 ParentColor = False 67 end 68 object ComboBoxTheme: TComboBox 69 Left = 208 70 Height = 42 71 Top = 136 72 Width = 230 73 ItemHeight = 0 74 Style = csDropDownList 75 TabOrder = 4 76 end 77 object Label3: TLabel 78 Left = 19 79 Height = 26 80 Top = 144 81 Width = 63 82 Caption = 'Theme:' 83 ParentColor = False 33 object ScrollBox1: TScrollBox 34 Left = 8 35 Height = 262 36 Top = 8 37 Width = 595 38 HorzScrollBar.Page = 438 39 VertScrollBar.Page = 178 40 Anchors = [akTop, akLeft, akRight, akBottom] 41 ClientHeight = 260 42 ClientWidth = 593 43 TabOrder = 2 44 object Label1: TLabel 45 Left = 19 46 Height = 26 47 Top = 24 48 Width = 170 49 Caption = 'Animation duration:' 50 ParentColor = False 51 end 52 object TrackBar1: TTrackBar 53 Left = 208 54 Height = 58 55 Top = 16 56 Width = 372 57 Max = 1000 58 Position = 0 59 Anchors = [akTop, akLeft, akRight] 60 TabOrder = 0 61 end 62 object ComboBoxLanguage: TComboBox 63 Left = 208 64 Height = 42 65 Top = 86 66 Width = 230 67 ItemHeight = 0 68 Style = csDropDownList 69 TabOrder = 1 70 end 71 object Label2: TLabel 72 Left = 19 73 Height = 26 74 Top = 94 75 Width = 88 76 Caption = 'Language:' 77 ParentColor = False 78 end 79 object ComboBoxTheme: TComboBox 80 Left = 208 81 Height = 42 82 Top = 136 83 Width = 230 84 ItemHeight = 0 85 Style = csDropDownList 86 TabOrder = 2 87 end 88 object Label3: TLabel 89 Left = 19 90 Height = 26 91 Top = 144 92 Width = 63 93 Caption = 'Theme:' 94 ParentColor = False 95 end 84 96 end 85 97 end -
trunk/Forms/FormSettings.lrj
r86 r89 1 1 {"version":1,"strings":[ 2 2 {"hash":213582195,"name":"tformsettings.caption","sourcebytes":[83,101,116,116,105,110,103,115],"value":"Settings"}, 3 {"hash":10139450,"name":"tformsettings.label1.caption","sourcebytes":[65,110,105,109,97,116,105,111,110,32,100,117,114,97,116,105,111,110,58],"value":"Animation duration:"},4 3 {"hash":1339,"name":"tformsettings.buttonok.caption","sourcebytes":[79,75],"value":"OK"}, 5 4 {"hash":77089212,"name":"tformsettings.buttoncancel.caption","sourcebytes":[67,97,110,99,101,108],"value":"Cancel"}, 5 {"hash":10139450,"name":"tformsettings.label1.caption","sourcebytes":[65,110,105,109,97,116,105,111,110,32,100,117,114,97,116,105,111,110,58],"value":"Animation duration:"}, 6 6 {"hash":82521866,"name":"tformsettings.label2.caption","sourcebytes":[76,97,110,103,117,97,103,101,58],"value":"Language:"}, 7 7 {"hash":95339402,"name":"tformsettings.label3.caption","sourcebytes":[84,104,101,109,101,58],"value":"Theme:"} -
trunk/Forms/FormSettings.pas
r86 r89 19 19 Label2: TLabel; 20 20 Label3: TLabel; 21 ScrollBox1: TScrollBox; 21 22 TrackBar1: TTrackBar; 22 23 procedure ButtonCancelClick(Sender: TObject); -
trunk/Game.pas
r86 r89 11 11 TMoveDirection = (drNone, drLeft, drUp, drRight, drDown); 12 12 TTileAction = (taNone, taMove, taMerge, taAppear); 13 TColorPalette = (cpOrangeYellow, cpGreenYellow, cpPinkBlue, cpBlueCyan, 14 cpGreenCyan, cpPinkRed); 13 15 14 16 { TTile } … … 109 111 FCanUndo: Boolean; 110 112 FBoardUndo: TBoard; 113 FColorPalette: TColorPalette; 111 114 FSkin: TTileSkin; 112 115 function GetTileColor(Value: Integer): TColor; … … 117 120 procedure RenderTile(Canvas: TCanvas; Tile: TTile; TileRect: TRect; WithText: Boolean); 118 121 procedure GameOver; 122 procedure SetColorPalette(AValue: TColorPalette); 119 123 procedure SetSkin(AValue: TTileSkin); 120 124 procedure Win; … … 162 166 property RecordHistory: Boolean read FRecordHistory write SetRecordHistory; 163 167 property Skin: TTileSkin read FSkin write SetSkin; 168 property ColorPalette: TColorPalette read FColorPalette write SetColorPalette; 164 169 end; 165 170 … … 169 174 var 170 175 SkinText: array[TTileSkin] of string; 176 ColorPaletteText: array[TColorPalette] of string; 171 177 172 178 const … … 187 193 STileShouldBeEmpty = 'Tile should be empty'; 188 194 195 // Color palette 196 SOrangeYellow = 'Orange - yellow'; 197 SGreenYellow = 'Green - yellow'; 198 SPinkBlue = 'Pink - blue'; 199 SBlueCyan = 'Blue - cyan'; 200 SGreenCyan = 'Green - cyan'; 201 SPinkRed = 'Pink - red'; 189 202 190 203 procedure Translate; … … 194 207 195 208 uses 196 Core, MetaCanvas ;209 Core, MetaCanvas, PixelPointer; 197 210 198 211 procedure Translate; … … 203 216 SkinText[tsRoman] := SSkinRoman; 204 217 SkinText[tsBinary] := SSkinBinary; 218 219 ColorPaletteText[cpOrangeYellow] := SOrangeYellow; 220 ColorPaletteText[cpGreenYellow] := SGreenYellow; 221 ColorPaletteText[cpPinkBlue] := SPinkBlue; 222 ColorPaletteText[cpBlueCyan] := SBlueCyan; 223 ColorPaletteText[cpGreenCyan] := SGreenCyan; 224 ColorPaletteText[cpPinkRed] := SPinkRed; 205 225 end; 206 226 … … 267 287 GameStep.Board.Clear; 268 288 GameStep.Skin := Game.Skin; 289 GameStep.ColorPalette := Game.ColorPalette; 269 290 GameStep.Score := 0; 270 291 for I := 0 to Length(InitialTiles) - 1 do … … 293 314 begin 294 315 FreeAndNil(Moves); 295 inherited Destroy;316 inherited; 296 317 end; 297 318 … … 442 463 begin 443 464 Size := Point(0, 0); 444 inherited Destroy;465 inherited; 445 466 end; 446 467 … … 519 540 if Running and Assigned(FOnGameOver) then FOnGameOver(Self); 520 541 Running := False; 542 end; 543 544 procedure TGame.SetColorPalette(AValue: TColorPalette); 545 begin 546 if FColorPalette = AValue then Exit; 547 FColorPalette := AValue; 548 DoPaint; 521 549 end; 522 550 … … 579 607 FRunning := Source.FRunning; 580 608 Skin := Source.Skin; 609 ColorPalette := Source.ColorPalette; 581 610 end; 582 611 … … 1174 1203 WriteBool('RecordHistory', RecordHistory); 1175 1204 WriteInteger('Skin', Integer(Skin)); 1205 WriteInteger('ColorPalette', Integer(ColorPalette)); 1176 1206 FBoardUndo.SaveToRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\BoardUndo')); 1177 1207 Board.SaveToRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\Board')); … … 1198 1228 RecordHistory := ReadBoolWithDefault('RecordHistory', False); 1199 1229 Skin := TTileSkin(ReadIntegerWithDefault('Skin', Integer(tsPowerOfTwo))); 1230 ColorPalette := TColorPalette(ReadIntegerWithDefault('ColorPalette', Integer(cpOrangeYellow))); 1200 1231 FBoardUndo.LoadFromRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\BoardUndo')); 1201 1232 Board.LoadFromRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\Board')); … … 1229 1260 1230 1261 function TGame.GetTileColor(Value: Integer): TColor; 1262 var 1263 Color: TPixel32; 1231 1264 begin 1232 1265 if Core.Core.ThemeManager1.Theme.Name = 'Dark' then begin … … 1263 1296 end; 1264 1297 end; 1298 1299 Color.RGB := Result; 1300 case ColorPalette of 1301 cpOrangeYellow: Result := TColor(TPixel32.CreateRGB(Color.R, Color.G, Color.B)); 1302 cpGreenYellow: Result := TColor(TPixel32.CreateRGB(Color.R, Color.B, Color.G)); 1303 cpPinkBlue: Result := TColor(TPixel32.CreateRGB(Color.B, Color.R, Color.G)); 1304 cpBlueCyan: Result := TColor(TPixel32.CreateRGB(Color.B, Color.G, Color.R)); 1305 cpGreenCyan: Result := TColor(TPixel32.CreateRGB(Color.G, Color.B, Color.R)); 1306 cpPinkRed: Result := TColor(TPixel32.CreateRGB(Color.G, Color.R, Color.B)); 1307 end; 1265 1308 end; 1266 1309 -
trunk/Languages/Game2048.cs.po
r88 r89 68 68 msgstr "Změna jazyka" 69 69 70 #: game.sbluecyan 71 msgid "Blue - cyan" 72 msgstr "Modrá - tyrkysová" 73 74 #: game.sgreencyan 75 msgid "Green - cyan" 76 msgstr "Zelená - tyrkysová" 77 78 #: game.sgreenyellow 79 msgid "Green - yellow" 80 msgstr "Zelená - žlutá" 81 82 #: game.sorangeyellow 83 msgid "Orange - yellow" 84 msgstr "Oranžová - žlutá" 85 86 #: game.spinkblue 87 msgid "Pink - blue" 88 msgstr "Růžová - modrá" 89 90 #: game.spinkred 91 msgid "Pink - red" 92 msgstr "Růžová - červená" 93 70 94 #: game.sscore 71 95 msgctxt "game.sscore" … … 238 262 msgstr "Povrch dlaždic:" 239 263 264 #: tformnew.label3.caption 265 msgid "Color palette:" 266 msgstr "Barevná paleta:" 267 240 268 #: tformsettings.buttoncancel.caption 241 269 msgctxt "tformsettings.buttoncancel.caption" -
trunk/Packages/Common/FindFile.pas
r85 r89 75 75 constructor TFindFile.Create(AOwner: TComponent); 76 76 begin 77 inherited Create(AOwner);77 inherited; 78 78 Path := IncludeTrailingBackslash(UTF8Encode(GetCurrentDir)); 79 79 FileMask := FilterAll; -
trunk/Packages/Common/ListViewSort.pas
r85 r89 136 136 constructor TListViewEx.Create(TheOwner: TComponent); 137 137 begin 138 inherited Create(TheOwner);138 inherited; 139 139 Filter := TListViewFilter.Create(Self); 140 140 Filter.Parent := Self; … … 172 172 constructor TListViewFilter.Create(AOwner: TComponent); 173 173 begin 174 inherited Create(AOwner);174 inherited; 175 175 FStringGrid1 := TStringGrid.Create(Self); 176 176 FStringGrid1.Align := alClient; -
trunk/Packages/Common/PixelPointer.pas
r85 r89 18 18 function GetRGB: Cardinal; inline; 19 19 public 20 class function CreateRGB(R, G, B: Byte): TPixel32; static; 21 class function CreateRGBA(R, G, B, A: Byte): TPixel32; static; 20 22 property RGB: Cardinal read GetRGB write SetRGB; 21 23 case Integer of … … 104 106 end; 105 107 108 class function TPixel32.CreateRGB(R, G, B: Byte): TPixel32; 109 begin 110 Result.R := R; 111 Result.G := G; 112 Result.B := B; 113 Result.A := 0; 114 end; 115 116 class function TPixel32.CreateRGBA(R, G, B, A: Byte): TPixel32; 117 begin 118 Result.R := R; 119 Result.G := G; 120 Result.B := B; 121 Result.A := A; 122 end; 123 106 124 procedure TPixel32.SetRGB(AValue: Cardinal); 107 125 begin -
trunk/Packages/Common/Pool.pas
r85 r89 57 57 try 58 58 Lock.Acquire; 59 inherited SetTotalCount(AValue);59 inherited; 60 60 finally 61 61 Lock.Release; … … 67 67 try 68 68 Lock.Acquire; 69 Result := inherited GetUsedCount;69 Result := inherited; 70 70 finally 71 71 Lock.Release; … … 88 88 end; 89 89 end; 90 Result := inherited Acquire;90 Result := inherited; 91 91 finally 92 92 Lock.Release; … … 98 98 try 99 99 Lock.Acquire; 100 inherited Release(Item);100 inherited; 101 101 finally 102 102 Lock.Release; … … 113 113 begin 114 114 TotalCount := 0; 115 Lock.Free;115 FreeAndNil(Lock); 116 116 inherited; 117 117 end; -
trunk/Packages/Common/RegistryEx.pas
r85 r89 133 133 //CloseKey; 134 134 {$ENDIF} 135 Result := inherited OpenKey(Key, CanCreate);135 Result := inherited; 136 136 end; 137 137 -
trunk/Packages/Common/StopWatch.pas
r85 r89 13 13 TStopWatch = class 14 14 private 15 fFrequency: TLargeInteger;16 fIsRunning: Boolean;17 fIsHighResolution: Boolean;18 fStartCount, fStopCount: TLargeInteger;19 procedure SetTickStamp(var lInt : TLargeInteger);15 FFrequency: TLargeInteger; 16 FIsRunning: Boolean; 17 FIsHighResolution: Boolean; 18 FStartCount, fStopCount: TLargeInteger; 19 procedure SetTickStamp(var Value: TLargeInteger); 20 20 function GetElapsedTicks: TLargeInteger; 21 21 function GetElapsedMiliseconds: TLargeInteger; 22 22 function GetElapsed: string; 23 23 public 24 constructor Create(const startOnCreate: Boolean = False) ;24 constructor Create(const StartOnCreate: Boolean = False) ; 25 25 procedure Start; 26 26 procedure Stop; 27 property IsHighResolution : Boolean read fIsHighResolution;28 property ElapsedTicks 29 property ElapsedMiliseconds 30 property Elapsed 31 property IsRunning : Boolean read fIsRunning;27 property IsHighResolution: Boolean read FIsHighResolution; 28 property ElapsedTicks: TLargeInteger read GetElapsedTicks; 29 property ElapsedMiliseconds: TLargeInteger read GetElapsedMiliseconds; 30 property Elapsed: string read GetElapsed; 31 property IsRunning: Boolean read FIsRunning; 32 32 end; 33 33 … … 35 35 implementation 36 36 37 constructor TStopWatch.Create(const startOnCreate : boolean = false);37 constructor TStopWatch.Create(const StartOnCreate: Boolean = False); 38 38 begin 39 inherited Create; 40 41 fIsRunning := False; 39 FIsRunning := False; 42 40 43 41 {$IFDEF WINDOWS} 44 42 fIsHighResolution := QueryPerformanceFrequency(fFrequency) ; 45 43 {$ELSE} 46 fIsHighResolution := False;44 FIsHighResolution := False; 47 45 {$ENDIF} 48 if NOT fIsHighResolution then fFrequency := MSecsPerSec;46 if NOT FIsHighResolution then FFrequency := MSecsPerSec; 49 47 50 48 if StartOnCreate then Start; … … 53 51 function TStopWatch.GetElapsedTicks: TLargeInteger; 54 52 begin 55 Result := fStopCount - fStartCount;53 Result := FStopCount - FStartCount; 56 54 end; 57 55 58 procedure TStopWatch.SetTickStamp(var lInt : TLargeInteger);56 procedure TStopWatch.SetTickStamp(var Value: TLargeInteger); 59 57 begin 60 if fIsHighResolution then58 if FIsHighResolution then 61 59 {$IFDEF Windows} 62 60 QueryPerformanceCounter(lInt) … … 64 62 {$ENDIF} 65 63 else 66 lInt := MilliSecondOf(Now);64 Value := MilliSecondOf(Now); 67 65 end; 68 66 69 67 function TStopWatch.GetElapsed: string; 70 68 var 71 dt: TDateTime;69 Elapsed: TDateTime; 72 70 begin 73 dt:= ElapsedMiliseconds / MSecsPerSec / SecsPerDay;74 result := Format('%d days, %s', [Trunc(dt), FormatDateTime('hh:nn:ss.z', Frac(dt))]) ;71 Elapsed := ElapsedMiliseconds / MSecsPerSec / SecsPerDay; 72 Result := Format('%d days, %s', [Trunc(Elapsed), FormatDateTime('hh:nn:ss.z', Frac(Elapsed))]) ; 75 73 end; 76 74 77 75 function TStopWatch.GetElapsedMiliseconds: TLargeInteger; 78 76 begin 79 Result := (MSecsPerSec * (fStopCount - fStartCount)) div fFrequency;77 Result := (MSecsPerSec * (fStopCount - FStartCount)) div FFrequency; 80 78 end; 81 79 82 80 procedure TStopWatch.Start; 83 81 begin 84 SetTickStamp( fStartCount);85 fIsRunning := True;82 SetTickStamp(FStartCount); 83 FIsRunning := True; 86 84 end; 87 85 88 86 procedure TStopWatch.Stop; 89 87 begin 90 SetTickStamp( fStopCount);91 fIsRunning := False;88 SetTickStamp(FStopCount); 89 FIsRunning := False; 92 90 end; 93 91 -
trunk/Packages/Common/Threading.pas
r85 r89 188 188 constructor TThreadList.Create; 189 189 begin 190 inherited Create;190 inherited; 191 191 end; 192 192
Note:
See TracChangeset
for help on using the changeset viewer.