source: trunk/UBlockMap.pas@ 11

Last change on this file since 11 was 10, checked in by chronos, 9 years ago
  • Added support for continue previous stopped scan.
  • Modified: Allow to scan only part of drive by specifiing start and end sector.
  • Added: Table showing list of operations in project.
  • Added: Allow to create new project and close project.
File size: 11.9 KB
Line 
1unit UBlockMap;
2
3{$mode delphi}
4
5interface
6
7uses
8 Classes, SysUtils, Graphics, Math, Contnrs, Dialogs, DOM, XMLRead, XMLWrite,
9 UXMLUtils;
10
11type
12 TSectorState = (bsNone, bsOk, bsDamaged);
13
14 TChange = class
15 Index: Integer;
16 Value: TSectorState;
17 end;
18
19 { TBlockMap }
20
21 TBlockMap = class
22 private
23 FBlockSize: TPoint;
24 FDrawSize: TPoint;
25 FSectorPerBlock: Integer;
26 FSectorCount: Integer;
27 FBlockCount: Integer;
28 FChanges: TObjectList; // TObjectList<TChange>
29 function GetBlockCount: Integer;
30 function GetSector(Index: Integer): TSectorState;
31 procedure SetBlockCount(AValue: Integer);
32 procedure SetBlockSize(AValue: TPoint);
33 procedure SetDrawSize(AValue: TPoint);
34 procedure SetSector(Index: Integer; AValue: TSectorState);
35 procedure SetSectorCount(AValue: Integer);
36 procedure SetSectorPerBlock(AValue: Integer);
37 procedure UpdateBlockSize;
38 function FindChange(Index: Integer): TChange;
39 function GetCombinedSectors(StartIndex, EndIndex: Integer): TSectorState;
40 public
41 ItemsCount: TPoint;
42 procedure Draw(Canvas: TCanvas);
43 procedure Clear;
44 constructor Create;
45 destructor Destroy; override;
46 procedure SaveToNode(Node: TDOMNode);
47 procedure LoadFromNode(Node: TDOMNode);
48 property BlockSize: TPoint read FBlockSize write SetBlockSize;
49 property DrawSize: TPoint read FDrawSize write SetDrawSize;
50 property SectorPerBlock: Integer read FSectorPerBlock write SetSectorPerBlock;
51 property SectorCount: Integer read FSectorCount write SetSectorCount;
52 property BlockCount: Integer read GetBlockCount;
53 property Sectors[Index: Integer]: TSectorState read GetSector write SetSector;
54 end;
55
56
57implementation
58
59resourcestring
60 SBlockSizeZeroNotAllowed = 'BlockSize can''t be set to 0';
61 SIndexOutOfRange = 'Index %d out of range';
62 SEmptyChangesList = 'Empty changes list';
63 SUnexpectedCombination = 'Unexpected combination';
64
65{ TBlockMap }
66
67procedure TBlockMap.SetBlockCount(AValue: Integer);
68begin
69 if FBlockCount = AValue then Exit;
70 FBlockCount := AValue;
71end;
72
73procedure TBlockMap.SetBlockSize(AValue: TPoint);
74begin
75 if (FBlockSize.X = AValue.X) and (FBlockSize.Y = AValue.Y) then Exit;
76 if (AValue.X = 0) or (AValue.Y = 0) then
77 raise Exception.Create(SBlockSizeZeroNotAllowed);
78 FBlockSize := AValue;
79end;
80
81procedure TBlockMap.SetDrawSize(AValue: TPoint);
82begin
83 if (FDrawSize.X = AValue.X) and (FDrawSize.Y = AValue.Y) then Exit;
84 FDrawSize := AValue;
85 UpdateBlockSize;
86end;
87
88function TBlockMap.GetSector(Index: Integer): TSectorState;
89var
90 Change: TChange;
91begin
92 if Index < FSectorCount then begin
93 Change := FindChange(Index);
94 if Assigned(Change) then Result := Change.Value
95 else raise Exception.Create(SIndexOutOfRange);
96 end else raise Exception.Create(SIndexOutOfRange);
97end;
98
99function TBlockMap.GetBlockCount: Integer;
100begin
101 Result := FBlockCount;
102end;
103
104procedure TBlockMap.SetSector(Index: Integer; AValue: TSectorState);
105var
106 LeftBeforeSame, RightBeforeSame: Boolean;
107 LeftAfterSame, RightAfterSame: Boolean;
108 Change: TChange;
109 ChangeIndex: Integer;
110begin
111 Change := FindChange(Index);
112 if Assigned(Change) then begin
113 if Change.Value = AValue then Exit;
114
115 ChangeIndex := FChanges.IndexOf(Change);
116 // Before
117 if ChangeIndex > 0 then begin
118 if (Index - TChange(FChanges[ChangeIndex]).Index) > 0 then LeftBeforeSame := True
119 else LeftBeforeSame := TChange(FChanges[ChangeIndex - 1]).Value = Change.Value;
120 end else begin
121 LeftBeforeSame := Change.Value = bsNone;
122 end;
123 if ChangeIndex < (FChanges.Count - 1) then begin
124 if (TChange(FChanges[ChangeIndex]).Index - Index) > 0 then RightBeforeSame := True
125 else RightBeforeSame := TChange(FChanges[ChangeIndex + 1]).Value = Change.Value;
126 end else begin
127 RightBeforeSame := Change.Value = bsNone;
128 end;
129 // After
130 if ChangeIndex > 0 then begin
131 if (Index - TChange(FChanges[ChangeIndex]).Index) > 0 then LeftAfterSame := True
132 else LeftAfterSame := TChange(FChanges[ChangeIndex - 1]).Value = AValue;
133 end else begin
134 LeftAfterSame := AValue = bsNone;
135 end;
136 if ChangeIndex < (FChanges.Count - 1) then begin
137 if (TChange(FChanges[ChangeIndex]).Index - Index) > 0 then RightAfterSame := True
138 else RightAfterSame := TChange(FChanges[ChangeIndex + 1]).Value = AValue;
139 end else begin
140 RightAfterSame := AValue = bsNone;
141 end;
142
143 // Update items
144 if not LeftBeforeSame and not RightBeforeSame and not LeftAfterSame and not RightAfterSame then begin
145 Change.Value := AValue
146 end else
147 if not LeftBeforeSame and not RightBeforeSame and not LeftAfterSame and RightAfterSame then begin
148 FChanges.Delete(ChangeIndex + 1);
149 Change.Value := AValue;
150 end else
151 if not LeftBeforeSame and not RightBeforeSame and LeftAfterSame and not RightAfterSame then begin
152 FChanges.Delete(ChangeIndex);
153 end else
154 if not LeftBeforeSame and not RightBeforeSame and LeftAfterSame and RightAfterSame then begin
155 FChanges.Delete(ChangeIndex + 1);
156 FChanges.Delete(ChangeIndex);
157 end else
158 if not LeftBeforeSame and RightBeforeSame and not LeftAfterSame and not RightAfterSame then begin
159 FChanges.Insert(ChangeIndex + 1, TChange.Create);
160 TChange(FChanges[ChangeIndex + 1]).Index := Index + 1;
161 TChange(FChanges[ChangeIndex + 1]).Value := Change.Value;
162 Change.Value := AValue;
163 end else
164 if not LeftBeforeSame and RightBeforeSame and LeftAfterSame and not RightAfterSame then begin
165 Change.Index := Index + 1;
166 end else
167 if not LeftBeforeSame and RightBeforeSame and not LeftAfterSame and not RightAfterSame then begin
168 FChanges.Insert(ChangeIndex, TChange.Create);
169 TChange(FChanges[ChangeIndex]).Index := Index;
170 TChange(FChanges[ChangeIndex]).Value := AValue;
171 end else
172 if LeftBeforeSame and not RightBeforeSame and not LeftAfterSame and RightAfterSame then begin
173 TChange(FChanges[ChangeIndex + 1]).Index := Index;
174 end else
175 if LeftBeforeSame and RightBeforeSame and not LeftAfterSame and not RightAfterSame then begin
176 if ChangeIndex > 0 then begin
177 FChanges.Insert(ChangeIndex, TChange.Create);
178 TChange(FChanges[ChangeIndex]).Index := Index;
179 TChange(FChanges[ChangeIndex]).Value := AValue;
180 end;
181 FChanges.Insert(ChangeIndex + 1, TChange.Create);
182 TChange(FChanges[ChangeIndex + 1]).Index := Index + 1;
183 TChange(FChanges[ChangeIndex + 1]).Value := Change.Value;
184 if ChangeIndex = 0 then begin
185 TChange(FChanges[ChangeIndex]).Index := Index;
186 TChange(FChanges[ChangeIndex]).Value := AValue;
187 FChanges.Insert(ChangeIndex, TChange.Create);
188 TChange(FChanges[ChangeIndex]).Index := 0;
189 TChange(FChanges[ChangeIndex]).Value := bsNone;
190 end;
191 end else raise Exception.Create(SUnexpectedCombination);
192 end else raise Exception.Create(Format(SIndexOutOfRange, [Index]));
193end;
194
195procedure TBlockMap.SetSectorCount(AValue: Integer);
196var
197 I: Integer;
198begin
199 if FSectorCount = AValue then Exit;
200 if (FChanges.Count = 0) and (AValue > 0) then begin
201 FChanges.Add(TChange.Create);
202 TChange(FChanges[0]).Index := 0;
203 TChange(FChanges[0]).Value := bsNone;
204 end;
205 FSectorCount := AValue;
206
207 // Cut changes outside of max sector count
208 I := FChanges.Count - 1;
209 while (I >= 0) and (TChange(FChanges[I]).Index >= FSectorCount) do Dec(I);
210 if (I >= 0) and (TChange(FChanges[I]).Index >= FSectorCount) then FChanges.Count := I;
211
212 UpdateBlockSize;
213end;
214
215procedure TBlockMap.SetSectorPerBlock(AValue: Integer);
216begin
217 if FSectorPerBlock = AValue then Exit;
218 FSectorPerBlock := AValue;
219 UpdateBlockSize;
220end;
221
222procedure TBlockMap.UpdateBlockSize;
223begin
224 ItemsCount := Point(Trunc(FDrawSize.X / BlockSize.X), Trunc(FDrawSize.Y / BlockSize.Y));
225 FSectorPerBlock := Ceil(SectorCount / (ItemsCount.X * ItemsCount.Y));
226 SetBlockCount(Ceil(SectorCount / FSectorPerBlock));
227end;
228
229function TBlockMap.FindChange(Index: Integer): TChange;
230var
231 LeftIndex, MiddleIndex, RightIndex: Integer;
232begin
233 if Fchanges.Count = 0 then raise Exception.Create(SEmptyChangesList);
234 if FChanges.Count = 1 then begin
235 Result := TChange(FChanges[0]);
236 Exit;
237 end;
238 Result := nil;
239 LeftIndex := 0;
240 RightIndex := FChanges.Count - 1;
241 while (LeftIndex <= RightIndex) do begin
242 MiddleIndex := LeftIndex + (RightIndex - LeftIndex) div 2;
243 if (TChange(FChanges[MiddleIndex]).Index <= Index) and
244 ((FChanges.Count = (MiddleIndex + 1)) or
245 (TChange(FChanges[MiddleIndex + 1]).Index > Index)) then begin
246 Result := TChange(FChanges[MiddleIndex]);
247 Break;
248 end;
249 // Cut interval in half and use nearest section
250 if TChange(FChanges[MiddleIndex]).Index < Index then begin
251 if MiddleIndex = LeftIndex then Inc(LeftIndex)
252 else LeftIndex := MiddleIndex
253 end else begin
254 if MiddleIndex = RightIndex then Dec(RightIndex)
255 else RightIndex := MiddleIndex
256 end;
257 end;
258end;
259
260function TBlockMap.GetCombinedSectors(StartIndex, EndIndex: Integer
261 ): TSectorState;
262var
263 Change: TChange;
264 ChangeIndex: Integer;
265begin
266 Result := bsNone;
267 Change := FindChange(StartIndex);
268 if Assigned(Change) then begin
269 ChangeIndex := FChanges.IndexOf(Change);
270 while (ChangeIndex < FChanges.Count) and
271 (TChange(FChanges[ChangeIndex]).Index <= EndIndex) do begin
272 if (Result = bsNone) and (TChange(FChanges[ChangeIndex]).Value = bsOk) then Result := bsOk
273 else if TChange(FChanges[ChangeIndex]).Value = bsDamaged then Result := bsDamaged;
274 Inc(ChangeIndex);
275 end;
276 end;
277end;
278
279procedure TBlockMap.Draw(Canvas: TCanvas);
280var
281 I: Integer;
282 Rect: TRect;
283 BlockState: TSectorState;
284begin
285 Canvas.Pen.Style := psSolid;
286 Canvas.Pen.Color := clBlack;
287 // Clean background
288 Canvas.Brush.Style := bsSolid;
289 Canvas.Brush.Color := clBlack;
290 Canvas.FillRect(0, 0, Canvas.Width, Canvas.Height);
291
292 DrawSize := Point(Canvas.Width, Canvas.Height);
293 if SectorPerBlock >= 1 then begin
294 for I := 0 to BlockCount - 1 do begin
295 Rect := Bounds((I mod ItemsCount.X) * BlockSize.X,
296 (I div ItemsCount.X) * BlockSize.Y, BlockSize.X - 1, BlockSize.Y - 1);
297 BlockState := GetCombinedSectors(I * SectorPerBlock, (I + 1) * SectorPerBlock);
298 if BlockState = bsOk then Canvas.Brush.Color := clGreen
299 else if BlockState = bsDamaged then Canvas.Brush.Color := clRed
300 else Canvas.Brush.Color := clSilver;
301 Canvas.FillRect(Rect);
302 //Canvas.TextOut(Rect.Left, Rect.Top, IntToStr(I));
303 end;
304 end;
305end;
306
307procedure TBlockMap.Clear;
308begin
309 FChanges.Clear;
310 if FSectorCount > 0 then begin
311 FChanges.Add(TChange.Create);
312 TChange(FChanges[0]).Index := 0;
313 TChange(FChanges[0]).Value := bsNone;
314 end;
315end;
316
317constructor TBlockMap.Create;
318begin
319 FChanges := TObjectList.Create;
320 FBlockSize := Point(12, 12);
321 SectorPerBlock := 1;
322 FSectorCount := 0;
323end;
324
325destructor TBlockMap.Destroy;
326begin
327 FreeAndNil(FChanges);
328 inherited Destroy;
329end;
330
331procedure TBlockMap.SaveToNode(Node: TDOMNode);
332var
333 NewNode: TDOMNode;
334 NewNode2: TDOMNode;
335 I: Integer;
336begin
337 NewNode := Node.OwnerDocument.CreateElement('Changes');
338 Node.AppendChild(NewNode);
339 for I := 0 to FChanges.Count - 1 do begin
340 NewNode2 := NewNode.OwnerDocument.CreateElement('Change');
341 NewNode.AppendChild(NewNode2);
342 WriteInteger(NewNode2, 'Index', TChange(FChanges[I]).Index);
343 WriteInteger(NewNode2, 'Value', Integer(TChange(FChanges[I]).Value));
344 end;
345end;
346
347procedure TBlockMap.LoadFromNode(Node: TDOMNode);
348var
349 NewNode: TDOMNode;
350 NewNode2: TDOMNode;
351 NewChange: TChange;
352begin
353 NewNode := Node.FindNode('Changes');
354 if Assigned(NewNode) then begin
355 FChanges.Count := 0;
356 NewNode2 := NewNode.FirstChild;
357 while Assigned(NewNode2) and (NewNode2.NodeName = 'Change') do begin
358 NewChange := TChange.Create;
359 NewChange.Index := ReadInteger(NewNode2, 'Index', 0);
360 NewChange.Value := TSectorState(ReadInteger(NewNode2, 'Value', 0));
361 FChanges.Add(NewChange);
362 NewNode2 := NewNode2.NextSibling;
363 end;
364 end;
365end;
366
367end.
368
Note: See TracBrowser for help on using the repository browser.