BitCell

by **DarkByte** » 04 Jan 2010, 11:45

DarkByte Utils

Librarie (unit) Delphi

De ceva timp m-am apucat sa-mi creez un unit (librarie) pentru Delphi care sa contina functii/proceduri care le folosesc in mod uzual. Acest unit va poate ajuta sa lucrati cu bitii unui numar, sa modificati starea unei ferestre de prin Windows, sa verificati si sa schimbati starea Lock-urilor (Num Lock, Caps Lock, Scroll Lock), sa manipulati prin Registry in Windows... si altele.

Singura limitare legata de folosirea acestui unit este faptul ca sunteti rugat sa pastrati linia care specifica autorul si acest forum.

Sper sa va fie de ajutor

Line number On/Off | Expand/Contract | Select all

unit db_utils;
 
// by DarkByte - http://www.bitcell.info
 
interface
 
uses Windows, SysUtils, Graphics, ShellAPI, Registry;
 
// Bit manipulation - begin
function GetBit(const Value: DWord; const Bit: Byte): Boolean;
function ClearBit(const Value: DWord; const Bit: Byte): DWord;
function SetBit(const Value: DWord; const Bit: Byte): DWord;
function EnableBit(const Value: DWord; const Bit: Byte; const TurnOn: Boolean): DWord;
 
// Image manipulation
function GetLargeIconFromFile(FName: String; aIndex: Word; var Icon: TIcon): Boolean;
function GetSmallIconFromFile(FName: String; aIndex: Word; var Icon: TIcon): Boolean;
function IcoToBmp(Icon: TIcon; aSize: Integer = 16) : TBitmap;
 
// Window manipulation
procedure SetWindowOnTop(Handle: HWnd; aTop: Boolean);
function MakeWindowTransparent(Handle: HWND; aAlpha: Integer = 10) : Boolean;
 
// Keyboard manipulation
function IsModifierDown(aModifier: Integer): Boolean;   // VK_CTRL, VK_SHIFT, VK_MENU
function IsLockOn(aLock: Integer): Boolean;             // VK_NUMLOCK, VK_CAPITAL, VK_SCROLL
procedure SetLockState(aLock: Integer; aState: Boolean);
 
// Registry manipulation
function GetRegistryData(RootKey: HKEY; Key, Value: String): Variant;
procedure SetRegistryData(RootKey: HKEY; Key, Value: String; RegDataType: TRegDataType; Data: Variant);
 
implementation
 
// Bit manipulation - begin
function GetBit(const Value: DWord; const Bit: Byte): Boolean;
begin
  Result := (Value and (1 shl Bit)) <> 0;
end;
 
function ClearBit(const Value: DWord; const Bit: Byte): DWord;
begin
    Result := Value and not (1 shl Bit);
end;
 
function SetBit(const Value: DWord; const Bit: Byte): DWord;
begin
    Result := Value or (1 shl Bit);
end;
 
function EnableBit(const Value: DWord; const Bit: Byte; const TurnOn: Boolean): DWord;
begin
    Result := (Value or (1 shl Bit)) xor (Integer(not TurnOn) shl Bit);
end;
// Bit manipulation - end
 
// Image manipulation - begin
function GetLargeIconFromFile(FName: String; aIndex: Word; var Icon: TIcon): Boolean;
var LargeIcon, SmallIcon : HIcon;
begin
   ExtractIconEx(PChar(FName), aIndex, LargeIcon, SmallIcon, 1);
   if LargeIcon <= 1
     then Result := False
     else
       begin
         Icon.Handle := LargeIcon;
         Result := True;
       end;
end;
 
function GetSmallIconFromFile(FName: String; aIndex: Word; var Icon: TIcon): Boolean;
var LargeIcon, SmallIcon : HIcon;
begin
   ExtractIconEx(PChar(FName), aIndex, LargeIcon, SmallIcon, 1);
   if SmallIcon <= 1
     then Result := False
     else
       begin
         Icon.Handle := SmallIcon;
         Result := True;
       end;
end;
 
function IcoToBmp(Icon: TIcon; aSize: Integer = 16): TBitmap;
var lBitmap: TBitmap;
begin
  lBitmap := TBitmap.Create;
 
  lBitmap.Width := aSize;
  lBitmap.Height := aSize;
  lBitmap.PixelFormat := pf24bit;
 
  lBitmap.Canvas.Pixels[0, lBitmap.Width - 1];
  lBitmap.Transparent := True;
 
  lBitmap.Canvas.Draw(0, 0, Icon);
  Result := lBitmap;
end;
// Image manipulation - end
 
// Window manipulation - begin
procedure SetWindowOnTop(Handle: HWnd; aTop: Boolean);
begin
  if aTop
    then
      begin
        SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_SHOWWINDOW + SWP_NOMOVE + SWP_NOSIZE);
        SetWindowPos(Handle, HWND_TOP, 0, 0, 0, 0, SWP_SHOWWINDOW + SWP_NOMOVE + SWP_NOSIZE);
      End
    else SetWindowPos(Handle, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_SHOWWINDOW + SWP_NOMOVE + SWP_NOSIZE);
End;
 
function MakeWindowTransparent(Handle: HWND; aAlpha: Integer = 10): Boolean;
type TSetLayeredWindowAttributes = function(HWnd: HWND; crKey: ColorREF; bAlpha: Byte; DwFlags: Longint): Longint; stdcall;
const LWA_ColorKEY  = 1;
      LWA_ALPHA     = 2;
      WS_EX_LAYERED = $80000;
var hUser32: HMODULE;
    SetLayeredWindowAttributes: TSetLayeredWindowAttributes;
begin
  Result := False;
  hUser32 := GetModuleHandle('USER32.DLL');
  if hUser32 <> 0 then
    begin
      @SetLayeredWindowAttributes := GetProcAddress(hUser32, 'SetLayeredWindowAttributes');
      if @SetLayeredWindowAttributes <> nil then
        begin
          SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
          SetLayeredWindowAttributes(Handle, 0, Trunc((255 / 100) * (100 - aAlpha)), LWA_ALPHA);
          Result := True;
        End;
    End;
End;
// Window manipulation - end
 
// Keyboard manipulation - begin
function IsModifierDown(aModifier: Integer): Boolean;
var State : TKeyboardState;
begin
  GetKeyboardState(State) ;
  Result := ((State[aModifier] and 128) <> 0) ;
end;
 
function IsLockOn(aLock: Integer): Boolean;
begin
  Result := 0 <> (GetKeyState(aLock) and $01);
end;
 
procedure SetLockState(aLock: Integer; aState: Boolean);
var KeyState: TKeyboardState;
begin
  GetKeyboardState(KeyState);
  if (KeyState[aLock] = 0) and (aState)
    then
      begin
        Keybd_Event(aLock, 1, KEYEVENTF_EXTENDEDKEY or 0, 0);
        Keybd_Event(aLock, 1, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP, 0);
      end
    else
      if (KeyState[aLock] <> 0) and not (aState)
        then
          begin
            Keybd_Event(aLock, 0, KEYEVENTF_EXTENDEDKEY or 0, 0);
            Keybd_Event(aLock, 0, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP, 0);
          end;
end;
// Keyboard manipulation - end
 
// Registry manipulation - begin
function GetRegistryData(RootKey: HKEY; Key, Value: String): Variant;
var Reg: TRegistry;
    RegDataType: TRegDataType;
    DataSize, Len: integer;
    lValue: String;
begin
  Reg := nil;
  try
    Reg := TRegistry.Create(KEY_QUERY_VALUE);
    Reg.RootKey := RootKey;
    if Reg.OpenKeyReadOnly(Key)
      then
        begin
          try
            RegDataType := Reg.GetDataType(Value);
            if (RegDataType in [rdString, rdExpandString])
              then Result := Reg.ReadString(Value)
              else
            if RegDataType = rdInteger
              then Result := Reg.ReadInteger(Value)
              else
            if RegDataType = rdBinary
              then
                begin
                  DataSize := Reg.GetDataSize(Value);
                  if (DataSize <> -1)
                    then
                      begin
                        SetLength(lValue, DataSize);
                        Len := Reg.ReadBinaryData(Value, PChar(lValue)^, DataSize);
                        if Len = DataSize
                          then Result := lValue;
                      end;
                end;
          except
            lValue := EmptyStr;
            Reg.CloseKey;
            Raise;
          end;
      Reg.CloseKey;
        end
      else Raise Exception.Create(SysErrorMessage(GetLastError));
  except
    Reg.Free;
    Raise;
  end;
  Reg.Free;
end;
 
procedure SetRegistryData(RootKey: HKEY; Key, Value: String; RegDataType: TRegDataType; Data: Variant);
var Reg: TRegistry;
    lValue: String;
begin
  Reg := TRegistry.Create(KEY_WRITE);
  try
    Reg.RootKey := RootKey;
    if Reg.OpenKey(Key, True)
      then
        begin
          try
            if RegDataType = rdUnknown
              then RegDataType := Reg.GetDataType(Value);
            if RegDataType = rdString
              then Reg.WriteString(Value, Data)
              else
            if RegDataType = rdExpandString
              then Reg.WriteExpandString(Value, Data)
              else
            if RegDataType = rdInteger
              then Reg.WriteInteger(Value, Data)
              else
            if RegDataType = rdBinary
              then
                begin
                  lValue := Data;
                  Reg.WriteBinaryData(Value, PChar(lValue)^, Length(lValue));
                end
              else Raise Exception.Create(SysErrorMessage(ERROR_CANTWRITE));
          except
            Reg.CloseKey;
            Raise;
          end;
          Reg.CloseKey;
        end
      else Raise Exception.Create(SysErrorMessage(GetLastError));
  finally
    Reg.Free;
  end;
end;
// Registry manipulation - end
 
end. 

Daca aveti intrebari legate de cod, puteti posta aici.

BitCell

DarkByte Utils

DarkByte Utils

DarkByte Utils

Librarie (unit) Delphi

Who is online