个人收集及编写的一个通用函数集.pas

个人收集及编写的一个通用函数集

{$IFNDEF K_CB5}
procedure DrawBlockFrameSmall(vleft, vtop, vright,
  vbuttom: integer; DrawColor : TColor;Canvas : TCanvas);
var
  vcolor : DWORD;
  mPen : TPen;
begin
  mPen := TPen.Create;
  try
    mPen.Assign(Canvas.Pen);
    with Canvas do begin
      Brush.Color := DrawColor;
      Pen.Width := cFrame;
      Pen.Style := psclear;
      Rectangle(vLeft,vtop,vright,vbuttom);  //画主色哉
      vcolor := DWord(DrawColor);
      Pen.Style := psSolid;
      Pen.Color := GetColor(true,vcolor);         //画亮线
      MoveTo(vRight - cFrame, vTop);
      LineTo(vLeft,vTop);
      LineTo(vLeft,vButtom-cFrame);
      Pen.Color :=GetColor(false,vcolor);              //画暗线
      MoveTo(vLeft,vButtom - cFrame);
      LineTo(vRight- cFrame ,vButtom-cFrame);
      LineTo(vRight-cFrame,vTop);

      Pen.Width := 1;
    end;
    Canvas.Pen.Assign(mPen);
  finally
    mPen.Free;
  end;
end;

procedure DrawBlockFrameSmall(mRect: TRect; DrawColor: TColor;Canvas : TCanvas);
var
  vleft,vtop,vright,vbottom : integer;
begin
  vleft := mRect.Left;
  vtop := mRect.Top;
  vright := mRect.Right;
  vbottom := mRect.Bottom;
  DrawBlockFrameSmall(vleft,vtop,vright,vbottom,Drawcolor,Canvas);
end;

procedure DrawBlockFrameOnner(vleft, vtop, vright,
  vbuttom: integer; DrawColor : TColor;Canvas : TCanvas);
var
  vcolor : DWORD;
  mPen : TPen;
begin
  mPen := TPen.Create;
  try
    mPen.Assign(Canvas.Pen);
    with Canvas do begin
      Brush.Color := DrawColor;
      Pen.Width := cFrame;
      Pen.Style := psclear;
      Rectangle(vLeft,vtop,vright,vbuttom);  //画主色哉
      vcolor := DWord(DrawColor);
      Pen.Style := psSolid;
      Pen.Color := GetColorA(true,vcolor);         //画亮线
      MoveTo(vRight - cFrame, vTop);
      LineTo(vLeft,vTop);
      LineTo(vLeft,vButtom-cFrame);
      Pen.Color :=GetColorA(false,vcolor);              //画暗线
      MoveTo(vLeft,vButtom - cFrame);
      LineTo(vRight- cFrame ,vButtom-cFrame);
      LineTo(vRight-cFrame,vTop);

      Pen.Width := 1;
    end;
    Canvas.Pen.Assign(mPen);
  finally
    mPen.Free;
  end;
end;

procedure DrawBlockFrameOnner(mRect: TRect; DrawColor: TColor;Canvas : TCanvas);
var
  vleft,vtop,vright,vbottom : integer;
begin
  vleft := mRect.Left;
  vtop := mRect.Top;
  vright := mRect.Right;
  vbottom := mRect.Bottom;
  DrawBlockFrameOnner(vleft,vtop,vright,vbottom,Drawcolor,Canvas);
end;

procedure DrawBlockFrameInner(mRect: TRect;
  DrawColor: TColor ;Canvas : TCanvas);
var
  vleft,vtop,vright,vbottom : integer;
begin
  vleft := mRect.Left;
  vtop := mRect.Top;
  vright := mRect.Right;
  vbottom := mRect.Bottom;
  DrawBlockFrameInner(vleft,vtop,vright,vbottom,Drawcolor,Canvas);
end;

procedure DrawBlockFrameInner(vleft, vtop, vright,
  vbuttom: integer; DrawColor: TColor;Canvas : TCanvas);
var
  vcolor : DWORD;
  mPen : TPen;
begin
  mPen := TPen.Create;
  try
    mPen.Assign(Canvas.Pen);
    with Canvas do begin
      Brush.Color := DrawColor;
      Pen.Width := cFrame;
      Pen.Style := psclear;
      Rectangle(vLeft,vtop,vright,vbuttom);  //画主色哉
      vcolor := DWord(DrawColor);
      Pen.Style := psSolid;
      Pen.Color := GetColor(false,vcolor);         //画暗线
      MoveTo(vRight - cFrame, vTop);
      LineTo(vLeft,vTop);
      LineTo(vLeft,vButtom-cFrame);
      Pen.Color :=GetColor(true,vcolor);              //画亮线
      MoveTo(vLeft,vButtom - cFrame);
      LineTo(vRight- cFrame ,vButtom-cFrame);
      LineTo(vRight-cFrame,vTop);

      Pen.Width := 1;
    end;
    Canvas.Pen.Assign(mPen);
  finally
    mPen.Free;
  end;
end;

procedure DrawBlockFrameSiGuo(vleft, vtop, vright,
  vbuttom: integer; Canvas : TCanvas);
var
  mPen : TPenReCall;
begin
  mPen := TPenReCall.Create(Canvas.Pen);
  try
    with Canvas do begin
      Pen.Width := cFrame;
      Pen.Color := $00323456;
      MoveTo(vLeft + 10, vTop +1);
      LineTo(vLeft+1,vTop+1);
      LineTo(vLeft+1,vTop + 10);
      MoveTo(vRight - 10,vButtom- 1);
      LineTo(vRight-1,vButtom- 1);
      LineTo(vRight-1,vButtom - 10);
    end;
  finally
    mPen.Free;
  end;
end;

procedure DrawBlockFrameSiGuo(mRect: TRect; Canvas : TCanvas);
var
  vleft,vtop,vright,vbottom : integer;
begin
  vleft := mRect.Left;
  vtop := mRect.Top;
  vright := mRect.Right;
  vbottom := mRect.Bottom;
  DrawBlockFrameSiGuo(vleft,vtop,vright,vbottom,Canvas);
end;

{$Endif}

var
  vBuffer: array[0..MAX_PATH] of Char;
////////////////////快速字符串////////////////////////////////////

const
  cDeltaSize = 1.5;

var
  GUpcaseTable : array[0..255] of char;
  GUpcaseLUT: Pointer;

//NOTE : FastCharPos and FastCharPosNoCase do not require you to pass the length
//       of the string, this was only done in FastPos and FastPosNoCase because
//       they are used by FastReplace many times over, thus saving a LENGTH()
//       operation each time.  I can't see you using these two routines for the
//       same purposes so I didn't do that this time !
function FastCharPos(const aSource : String; const C: Char; StartPos : Integer) : Integer;
var
  L                           : Integer;
begin
  //If this assert failed, it is because you passed 0 for StartPos, lowest value is 1 !!
  Assert(StartPos > 0);
  
  Result := 0;
  L := Length(aSource);
  if L = 0 then exit;
  if StartPos > L then exit;
  Dec(StartPos);
  asm
      PUSH EDI                 //Preserve this register

      mov  EDI, aSource        //Point EDI at aSource
      add  EDI, StartPos
      mov  ECX, L              //Make a note of how many chars to search through
      sub  ECX, StartPos
      mov  AL,  C              //and which char we want
    @Loop:
      cmp  Al, [EDI]           //compare it against the SourceString
      jz   @Found
      inc  EDI
      dec  ECX
      jnz  @Loop
      jmp  @NotFound
    @Found:
      sub  EDI, aSource        //EDI has been incremented, so EDI-OrigAdress = Char pos !
      inc  EDI
      mov  Result,   EDI
    @NotFound:

      POP  EDI
  end;
end;

function FastCharPosNoCase(const aSource : String; C: Char; StartPos : Integer) : Integer;
var
  L                           : Integer;
begin
  Result := 0;
  L := Length(aSource);
  if L = 0 then exit;
  if StartPos > L then exit;
  Dec(StartPos);
  if StartPos < 0 then StartPos := 0;

  asm
      PUSH EDI                 //Preserve this register
      PUSH EBX
      mov  EDX, GUpcaseLUT

      mov  EDI, aSource        //Point EDI at aSource
      add  EDI, StartPos
      mov  ECX, L              //Make a note of how many chars to search through
      sub  ECX, StartPos

      xor  EBX, EBX
      mov  BL,  C
      mov  AL, [EDX+EBX]
    @Loop:
      mov  BL, [EDI]
      inc  EDI
      cmp  Al, [EDX+EBX]
      jz   @Found
      dec  ECX
      jnz  @Loop
      jmp  @NotFound
    @Found:
      sub  EDI, aSource        //EDI has been incremented, so EDI-OrigAdress = Char pos !
      mov  Result,   EDI
    @NotFound:

      POP  EBX
      POP  EDI
  end;
end;

function FastmemPos(const aSource, aFind; const aSourceLen, aFindLen : integer) : Pointer;
asm
          push ESI
          push EDI
          push EBX

          mov  ESI, aFind
          mov  EDI, aSource
          mov  ECX, aSourceLen

  //Quick exit code
          mov  Result, 0
  //SourceLen < FindLen
          cmp  ECX, aFindLen
          jl   @TheEnd
  //FindLen < 1
          cmp  aFindLen, 1
          jl   @TheEnd

  //Now DEC aSourceLen by aFindLen-1
          sub  ECX, aFindLen
          inc  ECX

  //Get the first char of aFindString, note how it is done outside
  //of the main loop, as it never changes !
          Mov  Al, [ESI]
          jmp  @Scasb
  @FindNext:
          inc  EDI  //Done only when returning from CompareStrings
          dec  ECX
          jz   @NotFound

  //Now the FindFirstCharacter loop !
  @ScaSB:
  //Get the value of the current character in aSourceString
  //This is equal to ah := EDI^, that is what the [] are around [EDI]
  //compare this character with aDestString[1]
          cmp [EDI], al
  //If they are equal we compare the strings

          jz   @CompareStrings
          inc  EDI
          dec  ECX
          jnz  @ScaSB
          jmp  @NotFound

  @CompareStrings:
  //Put the length of aFindLen in EBX
          mov  EBX, aFindLen

  @CompareNext:
  //We DEC EBX to point to the end of the string, ie, we dont
  //want to add the whole length as this would point past the end of string
          dec  EBX
          jz   @FullMatch

  //here is another optimization tip !
  //People at this point usually PUSH ESI etc and then POP ESI etc
  //at the end, instead I opted not to change ESI etc at all.
  //This saves lots of pushing and popping !

  //Get aFindString character + aFindStringLength (the last char)
          mov  Ah, [ESI+EBX]

  //Get aSourceString character (current position + aFindStringLength)
  //Compare them
          cmp  Ah, [EDI+EBX]
          Jnz  @FindNext

          Jmp  @CompareNext

    @FullMatch:
          //Move the address of the *current* character in EDI
          //note, we have not altered EDI since the first char was found
          mov  Result, EDI
          jmp  @TheEnd
    @NotFound:
          //The substring was not found
          mov  Result, 0

  @TheEnd:
          pop  EBX
          pop  EDI
          pop  ESI
end;

function FastmemPosNC(const aSource, aFind; const aSourceLen, aFindLen : integer) : Pointer;
asm
          push ESI
          push EDI
          push EBX

          mov  ESI, aFind
          mov  EDI, aSource
          mov  ECX, aSourceLen

  //Quick exit code
          mov  Result, 0
  //SourceLen < FindLen
          cmp  ECX, aFindLen
          jl   @TheEnd
  //FindLen < 1
          cmp  aFindLen, 1
          jl   @TheEnd

  //Now DEC aSourceLen by aFindLen-1
          sub  ECX, aFindLen
          inc  ECX

  //Get the first char of aFindString, note how it is done outside
  //of the main loop, as it never changes !
          mov  EDX, GUpcaseLUT
          xor  EBX, EBX
          jmp  @FindFirst
  @FindNext:
          inc  EDI  //Done only when returning from CompareStrings
          dec  ECX
          jz   @NotFound
  @FindFirst:
          mov  Bl, [ESI]
          mov  AL, [EDX+EBX]

  //Now the FindFirstCharacter loop !
  @ScaSB:
  //Get the value of the current character in aSourceString
  //This is equal to ah := EDI^, that is what the [] are around [EDI]
  //compare this character with aDestString[1]
          mov  Bl, [EDI]
          cmp  Al, [EDX+EBX]
  //If they are equal we compare the strings

          jz   @CompareStrings
          inc  EDI
          dec  ECX
          jnz  @ScaSB
          jmp  @NotFound

  @CompareStrings:
  //Save ECX
          push ECX
          mov  ECX, aFindLen

  @CompareNext:
          dec  ECX
          jz   @FullMatch

          mov  Bl, [ESI+ECX]
          mov  Al, [EDX+EBX]

          mov  Bl, [EDI+ECX]
          cmp  Al, [EDX+EBX]
          jz   @KeepChecking

          POP  ECX
          jmp  @FindNext

    @KeepChecking:
          Jmp  @CompareNext

    @FullMatch:
          pop  ECX
          mov  Result, EDI
          jmp  @TheEnd

    @NotFound:
          mov  Result, 0

  @TheEnd:
          pop  EBX
          pop  EDI
          pop  ESI