Changeset 31


Ignore:
Timestamp:
Jun 24, 2010, 4:18:03 PM (14 years ago)
Author:
george
Message:
  • Opravy a rozšíření funkčností některých tříd
Files:
2 added
12 edited

Legend:

Unmodified
Added
Removed

  • BitStream/UBitStream.pas

    r30 r31  
    88
    99uses
    10   Classes, SysUtils, RtlConsts;
     10  Classes, SysUtils, RtlConsts, Math;
    1111
    1212type
    … …  
    1717  TBitStream = class
    1818  private
     19    function GetBit(Index: Integer):Boolean; virtual;
    1920    function GetPosition: LongInt; virtual;
    2021    function GetSize: LongInt; virtual;
     22    procedure SetBit(Index: Integer;const AValue: Boolean); virtual;
    2123    procedure SetPosition(const AValue: LongInt); virtual;
    2224    procedure SetSize(const AValue: LongInt); virtual;
    … …  
    3032    property Position: LongInt read GetPosition write SetPosition;
    3133    property Size: LongInt read GetSize write SetSize;
     34    property Bit[Index: Integer]: Boolean read GetBit write SetBit;
     35
     36    function ReadBit: Boolean;
     37    procedure WriteBit(AValue: Boolean);
     38    function ReadByte: Byte;
     39    procedure WriteByte(AValue: Byte);
    3240  end;
    3341
    … …  
    4351    procedure SetPosition(const AValue: LongInt); override;
    4452    procedure SetSize(const AValue: LongInt); override;
     53    function WriteToByte(var Data: Byte; NewData, Pos, Count: Byte): Byte;
    4554  public
    4655    function Read(var Buffer; Count: Longint): Longint; override;
    … …  
    5665{ TBitStream }
    5766
     67function TBitStream.GetBit(Index: Integer):Boolean;
     68begin
     69  Seek(Index, soBeginning);
     70  Read(Result, 1);
     71end;
     72
    5873function TBitStream.GetPosition:LongInt;
    5974begin
    … …  
    6883  GetSize := Seek(0, soEnd);
    6984  Seek(p, soBeginning);
     85end;
     86
     87procedure TBitStream.SetBit(Index: Integer;const AValue: Boolean);
     88begin
     89  Seek(Index, soBeginning);
     90  Write(AValue, 1);
    7091end;
    7192
    … …  
    123144end;
    124145
     146function TBitStream.ReadBit:Boolean;
     147begin
     148  Read(Result, 1);
     149  Result := Boolean(Integer(Result) and 1);
     150end;
     151
     152procedure TBitStream.WriteBit(AValue:Boolean);
     153begin
     154  Write(AValue, 1);
     155end;
     156
     157function TBitStream.ReadByte:Byte;
     158begin
     159  Read(Result, 8);
     160end;
     161
     162procedure TBitStream.WriteByte(AValue:Byte);
     163begin
     164  Write(AValue, 8);
     165end;
     166
    125167{ TMemoryBitStream }
    126168
    … …  
    143185begin
    144186  FSize := AValue;
    145   Stream.Size := Trunc(AValue / 8) + 1;
     187  Stream.Size := Ceil(AValue / 8);
     188  if FPosition > FSize then FPosition := FSize;
     189end;
     190
     191function TMemoryBitStream.WriteToByte(var Data: Byte; NewData,Pos,Count:Byte):Byte;
     192begin
     193  Data := Byte(Data and not (((1 shl Count) - 1) shl Pos) // Make zero space for new data
     194     or ((NewData and ((1 shl Count) - 1)) shl Pos));  // Write new data
     195  Result := Count;
     196  if Result > (8 - Pos) then Result := 8 - Pos;
    146197end;
    147198
    … …  
    153204  Data: Byte;
    154205begin
    155   if (FPosition + Count) > FSize then Count := FSize - FPosition;
    156   ByteCount := Trunc(Count / 8) + 1;
    157   BytePos := FPosition mod 8;
    158   Stream.Position := Trunc(FPosition / 8);
    159   Data := Stream.ReadByte;
    160   for I := 0 to ByteCount - 1 do begin
    161     TBytes(Buffer)[I] := (Data shr BytePos) and ((1 shl (8 - BytePos)) - 1);
    162     if I <> (ByteCount - 1) then
    163       Data := Stream.ReadByte;
    164     if BytePos > 0 then
    165       TBytes(Buffer)[I] := TBytes(Buffer)[I] or (Data and ((1 shl BytePos) - 1)) shl (8 - BytePos);
    166     if I = (ByteCount - 1) then
    167       TBytes(Buffer)[I] := TBytes(Buffer)[I] and ((1 shl (Count mod 8)) - 1);
    168   end;
    169   Inc(FPosition, Count);
    170   Result := Count;
     206  Result := 0;
     207  if (FSize > 0) and (FPosition < FSize) and (FPosition >= 0) then begin
     208    if (FPosition + Count) > FSize then Count := FSize - FPosition;
     209    ByteCount := Ceil(Count / 8);
     210    BytePos := FPosition mod 8;
     211    Stream.Position := Trunc(FPosition / 8);
     212    Data := Stream.ReadByte;
     213    for I := 0 to ByteCount - 1 do begin
     214      TBytes(Buffer)[I] := (Data shr BytePos) and ((1 shl (8 - BytePos)) - 1);
     215      if I <> (ByteCount - 1) then
     216        Data := Stream.ReadByte;
     217      if BytePos > 0 then
     218        TBytes(Buffer)[I] := TBytes(Buffer)[I] or (Data and ((1 shl BytePos) - 1)) shl (8 - BytePos);
     219      if (I = (ByteCount - 1)) and (BytePos > 0) then
     220        TBytes(Buffer)[I] := TBytes(Buffer)[I] and ((1 shl (Count mod 8)) - 1);
     221    end;
     222    Inc(FPosition, Count);
     223    Result := Count;
     224  end;
    171225end;
    172226
    … …  
    174228var
    175229  ByteCount: LongInt;
     230  BitCount: LongInt;
    176231  I: LongInt;
    177232  BytePos: Byte;
    178233  Data: Byte;
    179 begin
    180   ByteCount := Trunc(Count / 8) + 1;
     234function Min(Value1, Value2: Integer): Integer;
     235begin
     236  if Value1 < Value2 then Result := Value1 else Result := Value2;
     237end;
     238
     239begin
     240  BitCount := Count;
     241  ByteCount := Ceil(Count / 8);
    181242  BytePos := FPosition mod 8;
    182243  Stream.Position := Trunc(FPosition / 8);
    … …  
    186247  end else Data := 0;
    187248  for I := 0 to ByteCount - 1 do begin
    188     Data := (Data and ((1 shl BytePos) - 1)) or
    189       ((TBytes(Buffer)[I] and ((1 shl (8 - BytePos)) - 1)) shl BytePos);
    190     if I = (ByteCount - 1) then
    191       Data := Data and ((1 shl (Count mod 8)) - 1);
     249    Dec(BitCount, WriteToByte(Data, TBytes(Buffer)[I], BytePos, Min(8 - BytePos, BitCount)));
    192250    Stream.WriteByte(Data);
    193     Data := (TBytes(Buffer)[I] shr (8 - BytePos)) and ((1 shl BytePos) - 1);
     251    Data := 0;
     252    if (BitCount > 0) and (BytePos > 0) then begin
     253      if (I = (ByteCount - 1)) and (Stream.Position < Stream.Size) then begin
     254        Data := Stream.ReadByte;
     255        Stream.Position := Stream.Position - 1;
     256      end;
     257      Dec(BitCount, WriteToByte(Data, TBytes(Buffer)[I] shr (8 - BytePos), 0, Min(BytePos, BitCount)));
     258      if I = (ByteCount - 1) then
     259        Stream.WriteByte(Data);
     260    end;
    194261  end;
    195262  Inc(FPosition, Count);
    … …  
    205272    soCurrent: FPosition := FPosition + Offset;
    206273  end;
    207   if FPosition > FSize then FPosition := FSize;
     274  //if FPosition > FSize then FPosition := FSize;
    208275  Result := FPosition;
    209276end;

  • BitStream/test.lpi

    r30 r31  
    3434      </local>
    3535    </RunParams>
    36     <Units Count="5">
     36    <Units Count="7">
    3737      <Unit0>
    3838        <Filename Value="test.lpr"/>
    3939        <IsPartOfProject Value="True"/>
    4040        <UnitName Value="test"/>
     41        <IsVisibleTab Value="True"/>
    4142        <EditorIndex Value="0"/>
    4243        <WindowIndex Value="0"/>
    43         <TopLine Value="42"/>
    44         <CursorPos X="26" Y="56"/>
    45         <UsageCount Value="20"/>
    46         <Loaded Value="True"/>
     44        <TopLine Value="54"/>
     45        <CursorPos X="54" Y="59"/>
     46        <UsageCount Value="23"/>
     47        <Loaded Value="True"/>
     48        <DefaultSyntaxHighlighter Value="Delphi"/>
    4749      </Unit0>
    4850      <Unit1>
    4951        <Filename Value="E:\Programy\Lazarus_0.9.29\fpc\2.4.1\source\packages\fcl-base\src\custapp.pp"/>
    5052        <UnitName Value="CustApp"/>
    51         <EditorIndex Value="4"/>
     53        <EditorIndex Value="6"/>
    5254        <WindowIndex Value="0"/>
    5355        <TopLine Value="284"/>
    5456        <CursorPos X="3" Y="286"/>
    55         <UsageCount Value="10"/>
     57        <UsageCount Value="11"/>
    5658        <Loaded Value="True"/>
    5759      </Unit1>
    … …  
    5961        <Filename Value="UBitStream.pas"/>
    6062        <UnitName Value="UBitStream"/>
    61         <IsVisibleTab Value="True"/>
    6263        <EditorIndex Value="1"/>
    6364        <WindowIndex Value="0"/>
    64         <TopLine Value="82"/>
    65         <CursorPos X="29" Y="85"/>
    66         <UsageCount Value="10"/>
     65        <TopLine Value="241"/>
     66        <CursorPos X="45" Y="253"/>
     67        <UsageCount Value="11"/>
    6768        <Loaded Value="True"/>
    6869        <DefaultSyntaxHighlighter Value="Delphi"/>
    … …  
    7071      <Unit3>
    7172        <Filename Value="E:\Programy\Lazarus_0.9.29\fpc\2.4.1\source\rtl\objpas\classes\classesh.inc"/>
    72         <EditorIndex Value="2"/>
    73         <WindowIndex Value="0"/>
    74         <TopLine Value="778"/>
    75         <CursorPos X="1" Y="783"/>
    76         <UsageCount Value="10"/>
     73        <EditorIndex Value="4"/>
     74        <WindowIndex Value="0"/>
     75        <TopLine Value="868"/>
     76        <CursorPos X="26" Y="876"/>
     77        <UsageCount Value="11"/>
    7778        <Loaded Value="True"/>
    7879      </Unit3>
    7980      <Unit4>
    8081        <Filename Value="E:\Programy\Lazarus_0.9.29\fpc\2.4.1\source\rtl\objpas\classes\streams.inc"/>
     82        <EditorIndex Value="5"/>
     83        <WindowIndex Value="0"/>
     84        <TopLine Value="532"/>
     85        <CursorPos X="10" Y="544"/>
     86        <UsageCount Value="11"/>
     87        <Loaded Value="True"/>
     88      </Unit4>
     89      <Unit5>
     90        <Filename Value="E:\Programy\Lazarus_0.9.29\fpc\2.4.1\source\rtl\inc\systemh.inc"/>
    8191        <EditorIndex Value="3"/>
    8292        <WindowIndex Value="0"/>
    83         <TopLine Value="140"/>
    84         <CursorPos X="24" Y="166"/>
     93        <TopLine Value="813"/>
     94        <CursorPos X="11" Y="827"/>
    8595        <UsageCount Value="10"/>
    8696        <Loaded Value="True"/>
    87       </Unit4>
     97      </Unit5>
     98      <Unit6>
     99        <Filename Value="E:\Programy\Lazarus_0.9.29\fpc\2.4.1\source\rtl\objpas\math.pp"/>
     100        <UnitName Value="math"/>
     101        <EditorIndex Value="2"/>
     102        <WindowIndex Value="0"/>
     103        <TopLine Value="310"/>
     104        <CursorPos X="10" Y="326"/>
     105        <UsageCount Value="10"/>
     106        <Loaded Value="True"/>
     107      </Unit6>
    88108    </Units>
    89109    <JumpHistory Count="30" HistoryIndex="29">
    90110      <Position1>
    91111        <Filename Value="UBitStream.pas"/>
    92         <Caret Line="158" Column="1" TopLine="141"/>
     112        <Caret Line="118" Column="1" TopLine="103"/>
    93113      </Position1>
    94114      <Position2>
    95115        <Filename Value="UBitStream.pas"/>
    96         <Caret Line="159" Column="1" TopLine="141"/>
     116        <Caret Line="119" Column="1" TopLine="103"/>
    97117      </Position2>
    98118      <Position3>
    99119        <Filename Value="UBitStream.pas"/>
    100         <Caret Line="160" Column="1" TopLine="141"/>
     120        <Caret Line="120" Column="1" TopLine="103"/>
    101121      </Position3>
    102122      <Position4>
    103123        <Filename Value="UBitStream.pas"/>
    104         <Caret Line="161" Column="1" TopLine="141"/>
     124        <Caret Line="121" Column="1" TopLine="103"/>
    105125      </Position4>
    106126      <Position5>
    107127        <Filename Value="UBitStream.pas"/>
    108         <Caret Line="162" Column="1" TopLine="141"/>
     128        <Caret Line="122" Column="1" TopLine="103"/>
    109129      </Position5>
    110130      <Position6>
    111131        <Filename Value="UBitStream.pas"/>
    112         <Caret Line="163" Column="1" TopLine="141"/>
     132        <Caret Line="240" Column="1" TopLine="226"/>
    113133      </Position6>
    114134      <Position7>
    115135        <Filename Value="UBitStream.pas"/>
    116         <Caret Line="165" Column="1" TopLine="142"/>
     136        <Caret Line="241" Column="1" TopLine="226"/>
    117137      </Position7>
    118138      <Position8>
    119139        <Filename Value="UBitStream.pas"/>
    120         <Caret Line="161" Column="1" TopLine="142"/>
     140        <Caret Line="242" Column="1" TopLine="235"/>
    121141      </Position8>
    122142      <Position9>
    123143        <Filename Value="UBitStream.pas"/>
    124         <Caret Line="162" Column="1" TopLine="142"/>
     144        <Caret Line="243" Column="1" TopLine="235"/>
    125145      </Position9>
    126146      <Position10>
    127147        <Filename Value="UBitStream.pas"/>
    128         <Caret Line="161" Column="19" TopLine="142"/>
     148        <Caret Line="247" Column="1" TopLine="235"/>
    129149      </Position10>
    130150      <Position11>
    131151        <Filename Value="UBitStream.pas"/>
    132         <Caret Line="165" Column="1" TopLine="142"/>
     152        <Caret Line="248" Column="1" TopLine="235"/>
    133153      </Position11>
    134154      <Position12>
    135155        <Filename Value="UBitStream.pas"/>
    136         <Caret Line="161" Column="1" TopLine="142"/>
     156        <Caret Line="249" Column="1" TopLine="235"/>
    137157      </Position12>
    138158      <Position13>
    139159        <Filename Value="UBitStream.pas"/>
    140         <Caret Line="162" Column="1" TopLine="142"/>
     160        <Caret Line="250" Column="1" TopLine="235"/>
    141161      </Position13>
    142162      <Position14>
    143163        <Filename Value="UBitStream.pas"/>
    144         <Caret Line="163" Column="1" TopLine="142"/>
     164        <Caret Line="244" Column="1" TopLine="235"/>
    145165      </Position14>
    146166      <Position15>
    147167        <Filename Value="UBitStream.pas"/>
    148         <Caret Line="165" Column="1" TopLine="142"/>
     168        <Caret Line="252" Column="1" TopLine="235"/>
    149169      </Position15>
    150170      <Position16>
    151171        <Filename Value="UBitStream.pas"/>
    152         <Caret Line="161" Column="1" TopLine="142"/>
     172        <Caret Line="253" Column="1" TopLine="235"/>
    153173      </Position16>
    154174      <Position17>
    155175        <Filename Value="UBitStream.pas"/>
    156         <Caret Line="162" Column="1" TopLine="142"/>
     176        <Caret Line="251" Column="1" TopLine="241"/>
    157177      </Position17>
    158178      <Position18>
    159179        <Filename Value="UBitStream.pas"/>
    160         <Caret Line="163" Column="1" TopLine="142"/>
     180        <Caret Line="257" Column="1" TopLine="241"/>
    161181      </Position18>
    162182      <Position19>
    163183        <Filename Value="UBitStream.pas"/>
    164         <Caret Line="165" Column="1" TopLine="142"/>
     184        <Caret Line="253" Column="45" TopLine="241"/>
    165185      </Position19>
    166186      <Position20>
    167         <Filename Value="UBitStream.pas"/>
    168         <Caret Line="161" Column="1" TopLine="142"/>
     187        <Filename Value="test.lpr"/>
     188        <Caret Line="68" Column="1" TopLine="54"/>
    169189      </Position20>
    170190      <Position21>
    171         <Filename Value="UBitStream.pas"/>
    172         <Caret Line="162" Column="1" TopLine="142"/>
     191        <Filename Value="test.lpr"/>
     192        <Caret Line="70" Column="1" TopLine="54"/>
    173193      </Position21>
    174194      <Position22>
    175         <Filename Value="UBitStream.pas"/>
    176         <Caret Line="163" Column="1" TopLine="142"/>
     195        <Filename Value="test.lpr"/>
     196        <Caret Line="71" Column="1" TopLine="54"/>
    177197      </Position22>
    178198      <Position23>
    179         <Filename Value="UBitStream.pas"/>
    180         <Caret Line="165" Column="1" TopLine="142"/>
     199        <Filename Value="test.lpr"/>
     200        <Caret Line="69" Column="1" TopLine="54"/>
    181201      </Position23>
    182202      <Position24>
    183         <Filename Value="UBitStream.pas"/>
    184         <Caret Line="161" Column="1" TopLine="142"/>
     203        <Filename Value="test.lpr"/>
     204        <Caret Line="73" Column="1" TopLine="54"/>
    185205      </Position24>
    186206      <Position25>
    187         <Filename Value="UBitStream.pas"/>
    188         <Caret Line="162" Column="1" TopLine="142"/>
     207        <Filename Value="test.lpr"/>
     208        <Caret Line="69" Column="1" TopLine="54"/>
    189209      </Position25>
    190210      <Position26>
    191         <Filename Value="UBitStream.pas"/>
    192         <Caret Line="163" Column="1" TopLine="142"/>
     211        <Filename Value="test.lpr"/>
     212        <Caret Line="70" Column="1" TopLine="54"/>
    193213      </Position26>
    194214      <Position27>
    195         <Filename Value="UBitStream.pas"/>
    196         <Caret Line="165" Column="1" TopLine="142"/>
     215        <Filename Value="test.lpr"/>
     216        <Caret Line="72" Column="1" TopLine="54"/>
    197217      </Position27>
    198218      <Position28>
    199         <Filename Value="UBitStream.pas"/>
    200         <Caret Line="161" Column="1" TopLine="142"/>
     219        <Filename Value="test.lpr"/>
     220        <Caret Line="71" Column="1" TopLine="54"/>
    201221      </Position28>
    202222      <Position29>
    203         <Filename Value="UBitStream.pas"/>
    204         <Caret Line="166" Column="62" TopLine="142"/>
     223        <Filename Value="test.lpr"/>
     224        <Caret Line="72" Column="1" TopLine="54"/>
    205225      </Position29>
    206226      <Position30>
    207227        <Filename Value="test.lpr"/>
    208         <Caret Line="56" Column="26" TopLine="42"/>
     228        <Caret Line="73" Column="1" TopLine="54"/>
    209229      </Position30>
    210230    </JumpHistory>

  • BitStream/test.lpr

    r30 r31  
    1616
    1717  TTest = class(TCustomApplication)
     18  private
     19    procedure PrintBitStream(Stream:TBitStream);
    1820  protected
    1921    procedure DoRun; override;
    … …  
    3941  Buffer[2] := $56;
    4042  Buffer[3] := $78;
     43  WriteLn('Source data:');
    4144  PrintData(Buffer);
    4245
    43   BitStream.Write(Buffer[0], 27);
     46  BitStream.Write(Buffer[0], 28);
     47  WriteLn('Write data to stream:');
     48  PrintBitStream(BitStream);
    4449  // Write second bit array after first which lead to store data as shifted
    45   BitStream.Write(Buffer[0], 27);
    46 
    47   BitStream.Stream.Position := 0;
    48   PrintStream(BitStream.Stream);
     50  BitStream.Write(Buffer[0], 28);
     51  WriteLn('Append shifted data to stream:');
     52  PrintBitStream(BitStream);
    4953
    5054  // Read test of sub bit array
    51   BitStream.Position := 5;
    52   BitStream.Read(Buffer[0], 18);
     55  BitStream.Position := 1;
     56  BitStream.Read(Buffer[0], 32);
     57  WriteLn('Read bit data part:');
    5358  PrintData(Buffer);
    5459
    5560  // Test stream copy
    56   BitStream.Position := 2;
    57   BitStream2.CopyFrom(BitStream, BitStream.Size);
    58   PrintStream(BitStream2.Stream);
     61  WriteLn('Copy bit block to another stream:');
     62  for I := 0 to BitStream.Size do begin
     63    BitStream.Position := I;
     64    BitStream2.Size := 0;
     65    BitStream2.CopyFrom(BitStream, BitStream.Size);
     66    PrintBitStream(BitStream2);
     67  end;
     68  for I := 0 to BitStream.Size do begin
     69    BitStream.Position := 0;
     70    BitStream2.Size := 0;
     71    BitStream2.Position := I;
     72    BitStream2.CopyFrom(BitStream, BitStream.Size);
     73    PrintBitStream(BitStream2);
     74  end;
    5975
    6076  BitStream.Destroy;
    … …  
    6884var
    6985  I: Integer;
     86  B: Integer;
     87  OneByte: Byte;
    7088begin
    71   for I := 0 to High(Data) do
    72     Write(IntToHex(Data[I], 2) + ' ');
     89  for I := 0 to High(Data) do begin
     90    OneByte := Data[I];
     91    for B := 0 to 7 do
     92      Write(IntToStr((OneByte shr B) and 1));
     93  end;
    7394  WriteLn;
    7495end;
    … …  
    7798var
    7899  I: Integer;
     100  B: Integer;
     101  Data: Byte;
     102begin
     103  Stream.Position := 0;
     104  for I := 0 to Stream.Size - 1 do begin
     105    Data := Stream.ReadByte;
     106    for B := 0 to 7 do
     107      Write(IntToStr((Data shr B) and 1));
     108  end;
     109  WriteLn;
     110end;
     111
     112procedure TTest.PrintBitStream(Stream: TBitStream);
     113var
     114  I: Integer;
    79115begin
    80116  Stream.Position := 0;
    81117  for I := 0 to Stream.Size - 1 do
    82     Write(IntToHex(Stream.ReadByte, 2) + ' ');
     118    Write(IntToStr(Integer(Stream.ReadBit)));
    83119  WriteLn;
    84120end;

  • Comm/UCommSerialPort.pas

    r26 r31  
    4545destructor TCommSerialPort.Destroy;
    4646begin
    47   FreeAndNil(DataPin);
     47  OnReceiveData := nil;
     48  DataPin.Destroy;
    4849  inherited;
    4950end;

  • Comm/USerialPort.pas

    r26 r31  
    7777    constructor Create;
    7878    destructor Destroy; override;
     79    procedure Assign(Source: TObject);
    7980  end;
    8081
    … …  
    175176  FReceiveThread.Destroy;
    176177  inherited Destroy;
     178end;
     179
     180procedure TSerialPort.Assign(Source:TObject);
     181begin
     182  if Source is TSerialPort then begin
     183    Name := TSerialPort(Source).Name;
     184    BaudRate := TSerialPort(Source).BaudRate;
     185    Parity := TSerialPort(Source).Parity;
     186    StopBits := TSerialPort(Source).StopBits;
     187    DataBits := TSerialPort(Source).DataBits;
     188    FlowControl := TSerialPort(Source).FlowControl;
     189    DTR := TSerialPort(Source).DTR;
     190    RTS := TSerialPort(Source).RTS;
     191  end else raise Exception.Create('Assignment error');
    177192end;
    178193

  • Common/UCommon.pas

    r26 r31  
    44
    55uses
    6   Windows, SysUtils, ShFolder;
     6  Windows, SysUtils, ShFolder, ShellAPI;
    77
    88type
    99  TArrayOfByte = array of Byte;
    1010  TArrayOfString = array of string;
    11  
     11
     12function DelTree(DirName : string): Boolean;
    1213function IntToBin(Data: Cardinal; Count: Byte): string;
    1314function TryHexToInt(Data: string; var Value: Integer): Boolean;
    … …  
    1819function GetUserName: string;
    1920function SplitString(var Text: string; Count: Word): string;
     21function GetBit(Variable: QWord; Index: Byte): Boolean;
     22procedure SetBit(var Variable: QWord; Index: Byte; State: Boolean);
     23procedure SetBit(var Variable: Cardinal; Index: Byte; State: Boolean);
     24procedure SetBit(var Variable: Word; Index: Byte; State: Boolean);
     25function AddLeadingZeroes(const aNumber, Length : integer) : string;
    2026
    2127implementation
     28
     29function DelTree(DirName : string): Boolean;
     30var
     31  SHFileOpStruct : TSHFileOpStruct;
     32  DirBuf : array [0..255] of char;
     33begin
     34  DirName := UTF8Decode(DirName);
     35  try
     36    Fillchar(SHFileOpStruct,Sizeof(SHFileOpStruct),0) ;
     37    FillChar(DirBuf, Sizeof(DirBuf), 0 ) ;
     38    StrPCopy(DirBuf, DirName) ;
     39    with SHFileOpStruct do begin
     40      Wnd := 0;
     41      pFrom := @DirBuf;
     42      wFunc := FO_DELETE;
     43      fFlags := FOF_ALLOWUNDO;
     44      fFlags := fFlags or FOF_NOCONFIRMATION;
     45      fFlags := fFlags or FOF_SILENT;
     46    end;
     47    Result := (SHFileOperation(SHFileOpStruct) = 0) ;
     48  except
     49     Result := False;
     50  end;
     51end;
    2252
    2353function BCDToInt(Value: Byte): Byte;
    … …  
    3262  Path: array[0..MAX_PATH] of Char;
    3363begin
     64  Result := 'C:\Test';
    3465  if SUCCEEDED(SHGetFolderPath(0, Folder, 0, SHGFP_TYPE_CURRENT, @path[0])) then
    3566    Result := path
    … …  
    133164end;
    134165
     166function GetBit(Variable:QWord;Index:Byte):Boolean;
     167begin
     168  Result := ((Variable shr Index) and 1) = 1;
     169end;
     170
     171procedure SetBit(var Variable:QWord;Index:Byte;State:Boolean); overload;
     172begin
     173  Variable := (Variable and ((1 shl Index) xor QWord($ffffffffffffffff))) or (QWord(State) shl Index);
     174end;
     175
     176procedure SetBit(var Variable:Cardinal;Index:Byte;State:Boolean); overload;
     177begin
     178  Variable := (Variable and ((1 shl Index) xor Cardinal($ffffffff))) or (Cardinal(State) shl Index);
     179end;
     180
     181procedure SetBit(var Variable:Word;Index:Byte;State:Boolean); overload;
     182begin
     183  Variable := (Variable and ((1 shl Index) xor Word($ffff))) or (Word(State) shl Index);
     184end;
     185
     186function AddLeadingZeroes(const aNumber, Length : integer) : string;
     187begin
     188  Result := SysUtils.Format('%.*d', [Length, aNumber]) ;
     189end;
     190
    135191end.

  • FindFile/UFindFile.pas

    r26 r31  
    2727
    2828type
     29  EDirNotFound = class(Exception);
     30
    2931  TFileAttrKind = (ffaReadOnly, ffaHidden, ffaSysFile, ffaVolumeID, ffaDirectory, ffaArchive, ffaAnyFile);
    3032  TFileAttr = set of TFileAttrKind;
    … …  
    8385    if Value <> '' then
    8486      if DirectoryExists(UTF8Decode(Value)) then
    85         fPath := IncludeTrailingBackslash(Value);
     87        fPath := IncludeTrailingBackslash(Value)
     88        else raise EDirNotFound.Create('Adresář nenalezen');
    8689  end;
    8790end;

  • MemoryStreamEx/UMemoryStreamEx.pas

    r26 r31  
    8585    if Position >= Size then Break;
    8686    Data := Chr(ReadByte);
    87     if Data <> Terminator[I] then Result := Result + Data
    88       else Inc(I);
     87    if Data <> Terminator[I] then begin
     88      Result := Result + Data;
     89      I := 1;
     90    end else Inc(I);
    8991  until I > Length(Terminator);
    9092  if not (I > Length(Terminator)) then begin

  • PersistentForm/UPersistentForm.pas

    r29 r31  
    3030var
    3131  RestoredLeft, RestoredTop, RestoredWidth, RestoredHeight: Integer;
     32  RestoredWindowState: TWindowState;
    3233begin
    3334  with TRegistryEx.Create do
    … …  
    4849      if Form.Top > (Screen.Height - 50) then
    4950        Form.Top := Screen.Height - 50;
    50       Form.WindowState := TWindowState(ReadIntegerWithDefault('WindowState', Integer(wsNormal)));
    51       if Form.WindowState = wsMaximized then begin
     51      RestoredWindowState := TWindowState(ReadIntegerWithDefault('WindowState', Integer(wsNormal)));
     52      if RestoredWindowState = wsMaximized then begin
    5253        RestoredWidth := ReadIntegerWithDefault('RestoredWidth', Form.RestoredWidth);
    5354        RestoredHeight := ReadIntegerWithDefault ('RestoredHeight', Form.RestoredHeight);
    … …  
    5657        Form.SetRestoredBounds(RestoredLeft, RestoredTop, RestoredWidth, RestoredHeight);
    5758      end;
     59      Form.WindowState := RestoredWindowState;
    5860
    5961      if ReadBoolWithDefault('Visible', False) then Form.Show;

  • PrefixMultiplier/UPrefixMultiplier.pas

    r27 r31  
    11unit UPrefixMultiplier;
     2
     3// Date: 2010-06-01
    24
    35{$mode delphi}

  • VarIntSerializer/UVarIntSerializer.pas

    r26 r31  
    1111
    1212uses
    13   Classes, DateUtils, UMemoryStreamEx, Math, Dialogs, SysUtils;
     13  Classes, DateUtils, UMemoryStreamEx, Math, Dialogs, SysUtils, USubStream;
    1414
    1515const
    … …  
    4242
    4343    // Misc methods
    44     function TestMask(Mask, BitIndex: Integer): Boolean;
     44    function TestMask(Mask: QWord; BitIndex: Byte): Boolean;
    4545    procedure ReadItemByMaskIndex(Index: Integer; Data: TVarIntSerializer);
     46    procedure ReadItemRefByMaskIndex(Index: Integer; Data: TSubStream);
    4647    procedure BlockEnclose;
    4748    procedure BlockUnclose;
    … …  
    310311end;
    311312
    312 function TVarIntSerializer.TestMask(Mask, BitIndex: Integer): Boolean;
     313function TVarIntSerializer.TestMask(Mask: QWord; BitIndex: Byte): Boolean;
    313314begin
    314315  Result := ((Mask shr BitIndex) and 1) = 1;
    … …  
    322323begin
    323324  Position := 0;
     325  Data.Size := 0;
    324326  Mask := ReadVarUInt;
    325327  I := 0;
    … …  
    330332  if TestMask(Mask, Index) then
    331333    ReadStream(TStream(Data), GetVarSize);
     334  Data.Position := 0;
     335end;
     336
     337procedure TVarIntSerializer.ReadItemRefByMaskIndex(Index:Integer;Data:TSubStream
     338  );
     339var
     340  Mask: Integer;
     341  I: Integer;
     342begin
     343  Position := 0;
     344  Data.Size := 0;
     345  Mask := ReadVarUInt;
     346  I := 0;
     347  while (Position < Size) and (I < Index) do begin
     348    if TestMask(Mask, I) then Position := Position + GetVarSize;
     349    Inc(I);
     350  end;
     351  if TestMask(Mask, Index) then begin
     352    if TStream(Self) is TSubStream then begin
     353      // Recalculate substream
     354      Data.Source := TSubStream(Self).Source;
     355      Data.SourcePosition := TSubStream(Self).SourcePosition + Position;
     356    end else begin
     357      Data.Source := Self;
     358      Data.SourcePosition := Position;
     359    end;
     360    Data.Size := GetVarSize;
     361  end;
     362  Data.Position := 0;
    332363end;
    333364

  • VectorObject/UVectorObject.pas

    r26 r31  
    66
    77uses
    8   Classes, SysUtils, Graphics;
     8  Classes, SysUtils, Graphics, Contnrs;
    99
    1010type
    … …  
    3636
    3737  TVectorLine = class(TVectorObject)
    38     Points: TList; // of TVectorDot
     38    Points: TObjectList; // of TVectorDot
    3939    procedure Add(Position: TPoint);
    4040    procedure Draw; override;
    … …  
    8080  public
    8181    Brush: TBrush;
    82     Objects: TList; // of TVectorObject
     82    Objects: TObjectList; // of TVectorObject
    8383    BitmapCanvas: TCanvas;
    8484    Pen: TPen;
    … …  
    136136  NewPoint := TVectorDot.Create;
    137137  NewPoint.Position := Position;
     138  Points.Add(NewPoint);
    138139end;
    139140
    … …  
    155156begin
    156157  inherited;
    157   Points := TList.Create;
     158  Points := TObjectList.Create;
    158159end;
    159160
    160161destructor TVectorLine.Destroy;
    161 var
    162   I: Integer;
    163 begin
    164   for I := 0 to Points.Count - 1 do
    165     TVectorObject(Points[I]).Destroy;
     162begin
    166163  Points.Destroy;
    167164  inherited Destroy;
    … …  
    210207begin
    211208  inherited;
    212   Objects := TList.Create;
     209  Objects := TObjectList.Create;
    213210  Brush := TBrush.Create;
    214211  Pen := TPen.Create;
    … …  
    223220  Pen.Destroy;
    224221  Brush.Destroy;
    225   for I := 0 to Objects.Count - 1 do
    226     TVectorObject(Objects[I]).Destroy;
    227222  Objects.Destroy;
    228223  inherited Destroy;
Note: See TracChangeset for help on using the changeset viewer.