DelphiDabbler Code Snippets Database

Snippet Selection

The following snippets from the Code Snippets Database have been requested.

AdjustBitmapBrightness

Changes the brightness of bitmap Bmp by a given Delta value in range -255..+255.

procedure AdjustBitmapBrightness(Bmp: Graphics.TBitmap; Delta: Integer);
var
  NewBmp: Graphics.TBitmap;     // brightness adjusted bitmap
  I: Integer;                   // loops thru pixels in a scanline
  J: Integer;                   // loops thru scanlines
  NewValue: Integer;            // new R, G or B colour value for a pixel
  RowIn: SysUtils.PByteArray;   // scanline from Bmp
  RowOut: SysUtils.PByteArray;  // scanline from NewBmp
begin
  Assert(Bmp.PixelFormat = Graphics.pf24bit);
  // Create temporary bitmap to contain brightness adjusted bitmap
  NewBmp := Graphics.TBitmap.Create;
  try
    NewBmp.Width  := Bmp.Width;
    NewBmp.Height := Bmp.Height;
    NewBmp.PixelFormat := Graphics.pf24bit;
    for J := 0 to Bmp.Height - 1 do
    begin
      RowIn  := Bmp.Scanline[J];
      RowOut := NewBmp.Scanline[J];
      for I := 0 to 3 * Bmp.Width-1 do
      begin
        // adjust intensity of color component
        // (treat all components the same way)
        NewValue := RowIn[i] + Delta;
        // force "ceiling" and "floor" values of 255 and 0
        if NewValue > 255 then
          NewValue := 255
        else if NewValue < 0 then
          NewValue := 0;
        RowOut[i] := Byte(NewValue);
      end;
    end;
    Bmp.Assign(NewBmp);
  finally
    NewBmp.Free
  end;
end;

Clamp

Returns integer Value, adjusted so that it falls in the range [RangeLo..RangeHi], where RangeLo <= RangeHi.

function Clamp(const Value, RangeLo, RangeHi: Integer ): Integer;
begin
  Assert(RangeLo <= RangeHi);
  if Value < RangeLo then
    Result := RangeLo
  else if Value > RangeHi then
    Result := RangeHi
  else
    Result := Value;
end;

DeleteFilesWithUndo

Deletes a list of files and sends them all to the recycle bin. Returns True if the files were deleted successfully and False if the function fails.

function DeleteFilesWithUndo(const FileList: Classes.TStrings): Boolean;
var
  FOS: ShellAPI.TSHFileOpStruct;  // contains info about required file operation
  FilesBufSize: Integer;          // size of buffer to store file names
  FilesBuf: PChar;                // buffer to store file names
begin
  FilesBuf := nil;
  FilesBufSize := StringsToMultiSz(FileList, nil, 0);
  try
    GetMem(FilesBuf, FilesBufSize);
    StringsToMultiSz(FileList, FilesBuf, FilesBufSize);
    // set up structure that determines file operation
    FillChar(FOS, SizeOf(FOS), 0);
    with FOS do
    begin
      wFunc := ShellAPI.FO_DELETE;      // we're deleting
      pFrom := PChar(FilesBuf);         // file list (#0#0 terminated)
      fFlags := ShellAPI.FOF_ALLOWUNDO  // with facility to undo op
        or ShellAPI.FOF_NOCONFIRMATION  // and we don't want any dialogs
        or ShellAPI.FOF_SILENT;
    end;
    // perform the operation
    Result := ShellAPI.SHFileOperation(FOS) = 0;
  finally
    FreeMem(FilesBuf, FilesBufSize);
  end;
end;

FormInstanceCount (class type overload)

Counts and returns the current number of form instances that have, or descend from, class AFormClass.

function FormInstanceCount(AFormClass: Forms.TFormClass): Integer; overload;
var
  I: Integer;  // loops through all forms
begin
  Result := 0;
  for I := 0 to Forms.Screen.FormCount - 1 do
    Inc(Result, Ord(Forms.Screen.Forms[I] is AFormClass));
end;

FormInstanceCount (class name overload)

Counts and returns the current number of form instances that have class name AFormClassName.

function FormInstanceCount(const AFormClassName: string): Integer; overload;
var
  I: Integer;  // loops through all forms
begin
  Result := 0;
  for I := 0 to Forms.Screen.FormCount - 1 do
    Inc(Result, Ord(Forms.Screen.Forms[I].ClassNameIs(AFormClassName)));
end;

MemoCursorPos

Returns a TPoint value containing the coordinates of the cursor in the given memo control.

function MemoCursorPos(const Memo: StdCtrls.TCustomMemo): Windows.TPoint;
var
  Row, Col: Integer;  // row and column containing cursor
begin
  Row := Windows.SendMessage(
    Memo.Handle, Messages.EM_LINEFROMCHAR, Memo.SelStart, 0
  );
  Col := Memo.SelStart - Windows.SendMessage(
    Memo.Handle, Messages.EM_LINEINDEX, Row, 0
  );
  Result.X := Col;
  Result.Y := Row;
end;

ProgIDInstalled

Checks if the given program identifier is known to the system, i.e. is installed.

function ProgIDInstalled(const PID: string): Boolean;
var
  WPID: WideString;  // PID as wide string
  Dummy: TGUID;      // unused out value from CLSIDFromProgID function
begin
  WPID := PID;
  Result := ActiveX.Succeeded(
    ActiveX.CLSIDFromProgID(PWideChar(WPID), Dummy)
  );
end;

SHIL_* Constants

Constants that can be passed as flags to specify the required image type in calls to the SysImageListHandleEx routine.

const
  SHIL_LARGE = $00;       // Image size 32x32px unless user specifies large
                          // icons when size is 48x48 px.
  SHIL_SMALL = $01;       // Image size 16x16px, but can be customized by user.
  SHIL_EXTRALARGE = $02;  // Shell standard extra-large icon size. Typically
                          // 48x48, but can be customized by the user.
  SHIL_SYSSMALL = $03;    // Image size as returned from GetSystemMetrics called
                          // with SM_CXSMICON and SM_CYSMICON.
  SHIL_JUMBO = $04;       // Windows Vista and later. Image size normally
                          // 256x256px.

SysImageListHandleEx

Returns a handle to the system image list. Flag specifies the size of the required images using one of the SHIL_* constants. Zero is returned if the handle can't be obtained.

function SysImageListHandleEx(Flag: Cardinal): CommCtrl.HIMAGELIST;
type
  TSHGetImageList = function(iImageList: Integer; const riid: TGUID;
    var ppv: Pointer): HRESULT; stdcall;
const
  // IImageList IID
  IID_IImageList: TGUID = '{46EB5926-582E-4017-9FDF-E8998DAA0950}';
var
  Handle: THandle;                 // handle to Shell32 DLL
  SHGetImageList: TSHGetImageList; // API function to get shell image list
begin
  Result := 0;
  Handle := Windows.LoadLibrary('Shell32.dll');
  if Handle <> S_OK then
    try
      SHGetImageList := Windows.GetProcAddress(Handle, PChar(727));
      if Assigned(SHGetImageList) and
        (SysUtils.Win32Platform = Windows.VER_PLATFORM_WIN32_NT) then
        SHGetImageList(Flag, IID_IImageList, Pointer(Result));
    finally
      Windows.FreeLibrary(Handle);
    end;
end;

View the whole database.

Go to the DelphiDabbler website.