seths.pas

文本编辑程序

unit Seths;

interface

uses
  Windows, Messages, SysUtils, Graphics, Classes;

type TDeBuffered = record
  Str, Extra: String;
end;

//VB function IIF, If Expression then Result := TruePart else Result := FalsePart;
function IIF( Expression: Boolean; TruePart, FalsePart: Variant): Variant;
//API used to change a windows parent
function APISetParent(hwndChild: LongInt; hwndParent: LongInt): LongInt; stdcall;
external 'user32.dll' name 'SetParent';
//Useful for socket communications.....
function BufferString(S: String): String;
function UnBufferString(S: String): TDeBuffered;
//Wont give you an error message when converting bad values
function StringToInt( S: String ): LongInt;
//Does the annoying stuff for you :-)
function APIGetWindowText( HWnd: LongInt ): String;
//Makes a window region based off of a bitmap
function SethGetWindowRegion( OurBMP: TBitmap; TransColor: TColor ): LongInt;

type
  TPointerArray = class(TComponent)
  private
    { Private declarations }
    pArray: Pointer;
  public
    destructor Destroy; override;
    procedure FreeArray;
    procedure Redim(lngUBound: LongInt);
    procedure RedimPreserve(lngUBound: LongInt);
    procedure SetElement(lngElement: LongInt; pNewValue: Pointer);
    function UBound: LongInt;
    function GetElement(lngElement: LongInt): Pointer;
    function AddrElement(lngElement: LongInt): Pointer;
    { Public declarations }
  end;
  TLongArray = class(TComponent)
  private
    { Private declarations }
    pArray: Pointer;
  public
    destructor Destroy; override;
    procedure FreeArray;
    procedure Redim(lngUBound: LongInt);
    procedure RedimPreserve(lngUBound: LongInt);
    procedure SetElement(lngElement, lngNewValue: LongInt);
    function UBound: LongInt;
    function GetElement(lngElement: LongInt): LongInt;
    function AddrElement(lngElement: LongInt): Pointer;
    { Public declarations }
  end;
  TByteArray = class(TComponent)
  private
    { Private declarations }
    pArray: Pointer;
  public
    destructor Destroy; override;
    procedure FreeArray;
    procedure Redim(lngUBound: LongInt);
    procedure RedimPreserve(lngUBound: LongInt);
    procedure SetElement(lngElement: LongInt; bytNewValue: Byte);
    function UBound: LongInt;
    function GetElement(lngElement: LongInt): Byte;
    function AddrElement(lngElement: LongInt): Pointer;
    { Public declarations }
  end;

const
  str255 = '                                                                                                                                                                                                                                                               ';
//  TDigit = ;

implementation

destructor TPointerArray.Destroy;
begin
  Self.FreeArray;
end;
function TPointerArray.UBound: LongInt;
begin
  Result := 0;
  if Self.pArray <> nil then
    CopyMemory( @Result, Self.pArray, 4 );
end;
procedure TPointerArray.FreeArray;
var
  lngSize: LongInt;
begin if Self.pArray <> nil then begin
  lngSize := Self.UBound;
  FillMemory( Self.pArray, (lngSize * 4) + 8, 0);
  FreeMem( Self.pArray, (lngSize * 4) + 8);
  Self.pArray := nil;
end; end;
function TPointerArray.GetElement(lngElement: LongInt): Pointer;
var
  TempPointer: Pointer;
begin if Self.pArray <> nil then begin
  lngElement := (lngElement * 4) + LongInt(Self.pArray) + 4;
  Move(Pointer(lngElement)^, TempPointer, 4);
  Result := TempPointer;
end else Result := nil; end;
function TPointerArray.AddrElement(lngElement: LongInt): Pointer;
begin if Self.pArray <> nil then begin
  Result := Pointer((lngElement * 4) + LongInt(Self.pArray) + 4);
end else Result := nil; end;
procedure TPointerArray.SetElement(lngElement: LongInt; pNewValue: Pointer);
begin if Self.pArray <> nil then begin
  lngElement := (lngElement * 4) + LongInt(Self.pArray) + 4;
  Move( pNewValue, Pointer(lngElement)^, 4);
end; end;
procedure TPointerArray.Redim(lngUBound: LongInt);
var
  lngSize: LongInt;
begin
  if Self.pArray <> nil then begin
    lngSize := (Self.UBound * 4) + 8;
    FreeMem(Self.pArray, lngSize);
  end;
  GetMem(Self.pArray, (lngUBound * 4) + 8);
  FillMemory(Self.pArray, (lngUBound * 4) + 4, 0);
  MoveMemory( Self.pArray, @lngUBound, 4 );
end;
procedure TPointerArray.RedimPreserve(lngUBound: LongInt);
var
  lngSize: LongInt;
  pTemp: Pointer;
begin
  if Self.pArray <> nil then begin
//Figure out how many to preserve
    if lngUBound > Self.UBound then lngSize := Self.UBound else lngSize := lngUBound;
    lngSize := lngSize + 1;
//Generate a new temporary array
    GetMem( pTemp, lngSize * 4 );
    CopyMemory( pTemp, Self.AddrElement(0), (lngSize * 4));
//Clear then rebuild array to desired size
    Self.FreeArray;
    GetMem( Self.pArray, (lngUBound * 4) + 8);
    FillMemory( Self.pArray, (lngUBound * 4) + 8, 0 );
//Copy elements from temporary array into new array
    CopyMemory( Self.AddrElement(0), pTemp, (lngSize * 4) );
//Set the UBound variable
  MoveMemory( Self.pArray, @lngUBound, 4 );
  end else Self.Redim(lngUbound);
end;

destructor TLongArray.Destroy;
begin
  Self.FreeArray;
end;
function TLongArray.UBound: LongInt;
begin
  Result := 0;
  if Self.pArray <> nil then
    CopyMemory( @Result, Self.pArray, 4 );
end;
procedure TLongArray.FreeArray;
var
  lngSize: LongInt;
begin if Self.pArray <> nil then begin
  lngSize := Self.UBound;
  FillMemory( Self.pArray, (lngSize * 4) + 8, 0);
  FreeMem( Self.pArray, (lngSize * 4) + 8);
  Self.pArray := nil;
end; end;
function TLongArray.GetElement(lngElement: LongInt): LongInt;
var
  TempLong: LongInt;
begin if Self.pArray <> nil then begin
  lngElement := (lngElement * 4) + LongInt(Self.pArray) + 4;
  Move(Pointer(lngElement)^, TempLong, 4);
  Result := TempLong;
end else Result := 0; end;
function TLongArray.AddrElement(lngElement: LongInt): Pointer;
begin if Self.pArray <> nil then begin
  Result := Pointer((lngElement * 4) + LongInt(Self.pArray) + 4);
end else Result := nil; end;
procedure TLongArray.SetElement(lngElement, lngNewValue: LongInt);
begin if Self.pArray <> nil then begin
  lngElement := (lngElement * 4) + LongInt(Self.pArray) + 4;
  Move( lngNewValue, Pointer(lngElement)^, 4);
end; end;
procedure TLongArray.Redim(lngUBound: LongInt);
var
  lngSize: LongInt;
begin
  if Self.pArray <> nil then begin
    lngSize := (Self.UBound * 4) + 8;
    FreeMem(Self.pArray, lngSize);
  end;
  GetMem(Self.pArray, (lngUBound * 4) + 8);
  FillMemory(Self.pArray, (lngUBound * 4) + 4, 0);
  Self.SetElement(-1, lngUBound);
end;
procedure TLongArray.RedimPreserve(lngUBound: LongInt);
var
  lngSize: LongInt;
  pTemp: Pointer;
begin
  if Self.pArray <> nil then begin
//Figure out how many to preserve
    if lngUBound > Self.UBound then lngSize := Self.UBound else lngSize := lngUBound;
    lngSize := lngSize + 1;
//Generate a new temporary array
    GetMem( pTemp, lngSize * 4 );
    CopyMemory( pTemp, Self.AddrElement(0), (lngSize * 4));
//Clear then rebuild array to desired size
    Self.FreeArray;
    GetMem( Self.pArray, (lngUBound * 4) + 8);
    FillMemory( Self.pArray, (lngUBound * 4) + 8, 0 );
//Copy elements from temporary array into new array
    CopyMemory( Self.AddrElement(0), pTemp, (lngSize * 4) );
//Set the UBound variable
    Self.SetElement(-1, lngUBound);
  end else Self.Redim(lngUbound);
end;

destructor TByteArray.Destroy;
begin
  Self.FreeArray;
end;
function TByteArray.UBound: LongInt;
begin
  Result := 0;
  if Self.pArray <> nil then
    CopyMemory( @Result, Self.pArray, 4 );
end;
procedure TByteArray.FreeArray;
var
  lngSize: LongInt;
begin if Self.pArray <> nil then begin
  lngSize := Self.UBound + 5;
  FillMemory( Self.pArray, lngSize, 0);
  FreeMem( Self.pArray, lngSize);
  Self.pArray := nil;
end; end;
procedure TByteArray.Redim(lngUBound: LongInt);
var
  lngSize: LongInt;
begin
  if Self.pArray <> nil then begin
    lngSize := Self.UBound + 5;
    FreeMem(Self.pArray, lngSize);
  end;
  GetMem(Self.pArray, lngUBound + 5);
  FillMemory(Self.pArray, lngUBound + 5, 0);
  MoveMemory( Self.pArray, @lngUBound, 4 );
end;
procedure TByteArray.RedimPreserve(lngUBound: LongInt);
var
  lngSize: LongInt;
  pTemp: Pointer;
begin
  if Self.pArray <> nil then begin
//Figure out how many to preserve
    if lngUBound > Self.UBound then lngSize := Self.UBound else lngSize := lngUBound;
    lngSize := lngSize + 1;
//Generate a new temporary array
    GetMem( pTemp, lngSize );
    CopyMemory( pTemp, Self.AddrElement(0), lngSize);
//Clear then rebuild array to desired size
    Self.FreeArray;
    GetMem( Self.pArray, lngUBound + 5);
    FillMemory( Self.pArray, lngUBound + 5, 0 );
//Copy elements from temporary array into new array
    CopyMemory( Self.AddrElement(0), pTemp, lngSize );
//Set the UBound variable
    MoveMemory( Self.pArray, @lngUBound, 4 );
  end else Self.Redim(lngUbound);
end;
procedure TByteArray.SetElement(lngElement: LongInt; bytNewValue: Byte);
begin if Self.pArray <> nil then begin
  lngElement := lngElement + LongInt(Self.pArray) + 4;
  Move( bytNewValue, Pointer(lngElement)^, 1);
end; end;
function TByteArray.GetElement(lngElement: LongInt): Byte;
var
  TempLong: LongInt;
begin if Self.pArray <> nil then begin
  lngElement := lngElement + LongInt(Self.pArray) + 4;
  Move(Pointer(lngElement)^, TempLong, 1);
  Result := TempLong;
end else Result := 0; end;
function TByteArray.AddrElement(lngElement: LongInt): Pointer;
begin if Self.pArray <> nil then begin
  Result := Pointer(lngElement + LongInt(Self.pArray) + 4);
end else Result := nil; end;


function IIF( Expression: Boolean; TruePart, FalsePart: Variant): Variant;
begin
   if Expression then Result := TruePart else Result := FalsePart;
end;

function BufferString(S: String): String;
var
  L: Word;
begin

  L := Length(s);
  Result := 'aa' + S;
  Move( L, Result[1], 2 );

end;

function UnBufferString(S: String): TDeBuffered;
var
  L: Word;
begin

  Move( S[1], L, 2 );
  Result.Str := Copy(S, 3, L);
  Result.Extra := Copy(S, L + 3, Length(S) );

end;

function StringToInt( S: String ): LongInt;
var
  I, P, T: Integer;
  D: set of Char;
begin

  Result := 0;
  if S = '' then exit;

  D := ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9'];
  I := 1;
  for P := Length(S) downto 1 do begin
    if (S[P] in D) then begin
      T := StrToInt(S[P]);
      Result := Result + (T * I);
      I := I * 10;
    end;
  end;
  if Result = 19887536 then Result := 0;

end;

function APIGetWindowText( HWnd: LongInt ): String;
begin

  Result := str255;
  HWnd := GetWindowText( HWnd, @Result[1], 255 );
  Result := Copy( Result, 1, HWnd );

end;

function SethGetWindowRegion( OurBMP: TBitmap; TransColor: TColor ): LongInt;
var
  Rgn, TempRgn: LongInt;
  A: LongInt;
  L, T: LongInt;
begin

  Rgn := CreateRectRgn(0, 0, OurBMP.Width, OurBMP.Height);
  TempRgn := CreateRectRgn(0,0,OurBMP.Width, OurBMP.Height);
  CombineRgn( Rgn, Rgn, TempRgn, RGN_DIFF );
  DeleteObject( TempRgn );
  A := 0;
  for T := 0 to OurBMP.Height do begin
    for L := 0 to OurBMP.Width do begin
      if ourBMP.Canvas.Pixels[L,T] <> TransColor then begin
        A := A + 1;
      end else begin
        if A > 0 then begin
          TempRgn := CreateRectRgn(L - A, T, L, T + 1 );
          CombineRgn( Rgn, Rgn, TempRgn, RGN_OR );
          DeleteObject( TempRgn );
          A := 0;
        end;
      end;
    end;
  end;
  Result := Rgn;

end;

end.