Code Snippets Database

Requested snippets

This page displays 9 requested snippets.

You can choose a category, perform a search or generate a Pascal unit containing the snippets by using the Control Box.

ProgIDInstalled

Checks if a 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;

Kind of Snippet: Routine

Required units: ActiveX.

Required snippets: None.

See also: None.

Supported Compilers:

D2	D3	D4	D5	D6	D7	D2005 (Win32)	D2006 (Win32)	D2007	D2009 (Win32)	D2010 (Win32)	Free Pascal

SHIL_Enum

Constants that can be passed as flags to determine the 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.

Kind of Snippet: Constant

Required units: None.

Required snippets: None.

See also: SysImageListHandleEx.

Supported Compilers:

D2	D3	D4	D5	D6	D7	D2005 (Win32)	D2006 (Win32)	D2007	D2009 (Win32)	D2010 (Win32)	Free Pascal

This snippet cannot be included in generated units.

SysImageListHandleEx

Returns a handle to the system image list. 0 is returned if handle can't be obtained. Specify the size of image required by setting the Flag parameter to one of the SHIL_* constants.

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;

Kind of Snippet: Routine

Required units: ShellAPI, Windows, CommCtrl.

Required snippets: None.

See also: SHIL_Enum.

Supported Compilers:

D2	D3	D4	D5	D6	D7	D2005 (Win32)	D2006 (Win32)	D2007	D2009 (Win32)	D2010 (Win32)	Free Pascal

Contributed by Bill Miller.

MemoCursorPos

Returns the X and Y position of the cursor in a 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;

Kind of Snippet: Routine

Required units: Messages, Windows, StdCtrls.

Required snippets: None.

See also: None.

Supported Compilers:

D2	D3	D4	D5	D6	D7	D2005 (Win32)	D2006 (Win32)	D2007	D2009 (Win32)	D2010 (Win32)	Free Pascal

Based on code contributed by Shlomo Abuisak.

AdjustBitmapBrightness

Changes the brightness of a bitmap 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;

Kind of Snippet: Routine

Required units: SysUtils, Graphics.

Required snippets: None.

See also: AdjustColorBrightness.

Supported Compilers:

D2	D3	D4	D5	D6	D7	D2005 (Win32)	D2006 (Win32)	D2007	D2009 (Win32)	D2010 (Win32)	Free Pascal

Clamp

Adjusts a value so that it falls within a specified range.

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;

Kind of Snippet: Routine

Required units: None.

Required snippets: None.

See also: None.

Supported Compilers:

D2	D3	D4	D5	D6	D7	D2005 (Win32)	D2006 (Win32)	D2007	D2009 (Win32)	D2010 (Win32)	Free Pascal

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;

Kind of Snippet: Routine

Required units: Classes, ShellAPI.

Required snippets: None.

See also: EmptyRecycleBin, DeleteFiles, DeleteFileWithUndo, [Show All].

Supported Compilers:

D2	D3	D4	D5	D6	D7	D2005 (Win32)	D2006 (Win32)	D2007	D2009 (Win32)	D2010 (Win32)	Free Pascal

If any of the listed files don't exist none will be deleted and the function will fail.

FormInstanceCount_A

Returns how many instances of a form class and its descendants currently exist.

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;

Kind of Snippet: Routine

Required units: Forms.

Required snippets: None.

See also: FormInstanceCount_B.

Supported Compilers:

D2	D3	D4	D5	D6	D7	D2005 (Win32)	D2006 (Win32)	D2007	D2009 (Win32)	D2010 (Win32)	Free Pascal

This snippet cannot be included in generated units.

FormInstanceCount_B

Returns how many form instances exist with a given class name currently exist.

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;

Kind of Snippet: Routine

Required units: Forms.

Required snippets: None.

See also: FormInstanceCount_A.

Supported Compilers:

D2	D3	D4	D5	D6	D7	D2005 (Win32)	D2006 (Win32)	D2007	D2009 (Win32)	D2010 (Win32)	Free Pascal

This snippet cannot be included in generated units.