DelphiDabbler Code Snippets Database

Snippet Selection

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

GetIdleTime

Returns the time ellapsed since the last user input.

function GetIdleTime: Cardinal;
var
  LastInput: Windows.TLastInputInfo;  // details of last user input
  TickCount: Int64;                   // ticks since system start
begin
  LastInput.cbSize := SizeOf(Windows.TLastInputInfo);
  Windows.GetLastInputInfo(LastInput);
  TickCount := Windows.GetTickCount;
  if TickCount < LastInput.dwTime then
    // tick count has wrapped round: adjust it
    TickCount := TickCount + High(Windows.DWORD);
  Result := TickCount - LastInput.dwTime;
end;

HalftoneStretch (TCanvas overload)

Performs a high quality stretch copy operation from canvas SrcCvs to DestCvs. The image occupying the area defined by SrcRect on SrcCvs is stretched to fill the area defined by DestRect on DestCvs.

procedure HalftoneStretch(DestCvs: Graphics.TCanvas; DestRect: Types.TRect;
  SrcCvs: Graphics.TCanvas; SrcRect: Types.TRect); overload;
var
  OldMode: Integer;  // saves stretch blt mode for later restoration
begin
  if not Assigned(DestCvs) then
    Exit;
  if not Assigned(SrcCvs) then
    Exit;
  OldMode := Windows.GetStretchBltMode(DestCvs.Handle);
  Windows.SetStretchBltMode(DestCvs.Handle, Windows.HALFTONE);
  // following is equivalent to DestCvs.CopyRect(DestRect, SrcCvs, SrcRect);
  try
    Windows.StretchBlt(
      DestCvs.Handle,
      DestRect.Left,
      DestRect.Top,
      DestRect.Right - DestRect.Left,
      DestRect.Bottom - DestRect.Top,
      SrcCvs.Handle,
      SrcRect.Left,
      SrcRect.Top,
      SrcRect.Right - SrcRect.Left,
      SrcRect.Bottom - SrcRect.Top,
      DestCvs.CopyMode
    );
  finally
    Windows.SetStretchBltMode(DestCvs.Handle, OldMode);
  end;
end;

HalftoneStretch (TBitmap overload)

Performs a high quality stretch copy of bitmap SrcBmp to bitmap DestBmp. The image is stretched to completely fill DestBmp.

procedure HalftoneStretch(DestBmp, SrcBmp: Graphics.TBitmap); overload;
begin
  if not Assigned(DestBmp) or not Assigned(SrcBmp) then
    Exit;
  if (DestBmp.Width <= 0) or (DestBmp.Height <= 0) or
    (SrcBmp.Width <= 0) or (SrcBmp.Height <= 0) then
    Exit;
  HalftoneStretch(
    DestBmp.Canvas,
    Types.Rect(0, 0, DestBmp.Width, DestBmp.Height),
    SrcBmp.Canvas,
    Types.Rect(0, 0, SrcBmp.Width, SrcBmp.Height)
  );
end;

IsSubClassOf

Checks if object instance AnInstance is a sub-class of, or the same class as, class AClass.

function IsSubClassOf(AnInstance: TObject; AClass: TClass): boolean;
var
  ClassRef: TClass;
begin
  ClassRef := AnInstance.ClassType;
  repeat
    Result := (ClassRef = AClass);
    ClassRef := ClassRef.ClassParent;
  until Result or not Assigned(ClassRef);
end;

MoveRectToOrigin

Translates the give rectangle to the origin. The top and left co-ordinates are set to zero and the bottom and right co-ordinates are adjusted accordingly.

function MoveRectToOrigin(const R: Types.TRect): Types.TRect;
begin
  Result := R;
  Types.OffsetRect(Result, -R.Left, -R.Top);
end;

RFC2822Date

Returns the RFC 2822 representation of the date (in local time) specified in the LocalTime parameter. The IsDST parameter indicates whether LocalTime is in daylight saving time or not.

function RFC2822Date(const LocalDate: TDateTime; const IsDST: Boolean): string;
const
  // Days of week and months of year: must be in English for RFC882
  Days: array[1..7] of string = (
    'Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat'
  );
  Months: array[1..12] of string = (
    'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
    'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'
  );
var
  Day, Month, Year: Word;             // parts of LocalDate
  TZ : Windows.TIME_ZONE_INFORMATION; // time zone information
  Bias: Integer;                      // bias in seconds
  BiasTime: TDateTime;                // bias in hrs / mins to display
  GMTOffset: string;                  // bias as offset from GMT
begin
  // get year, month and day from date
  SysUtils.DecodeDate(LocalDate, Year, Month, Day);
  // compute GMT Offset bias
  Windows.GetTimeZoneInformation(TZ);
  Bias := TZ.Bias;
  if IsDST then
    Bias := Bias + TZ.DaylightBias
  else
    Bias := Bias + TZ.StandardBias;
  BiasTime := SysUtils.EncodeTime(Abs(Bias div 60), Abs(Bias mod 60), 0, 0);
  if Bias < 0 then
    GMTOffset := '-' + SysUtils.FormatDateTime('hhnn', BiasTime)
  else
    GMTOffset := '+' + SysUtils.FormatDateTime('hhnn', BiasTime);
  // build final string
  Result := Days[DayOfWeek(LocalDate)] + ', '
    + SysUtils.IntToStr(Day) + ' '
    + Months[Month] + ' '
    + SysUtils.IntToStr(Year) + ' '
    + SysUtils.FormatDateTime('hh:nn:ss', LocalDate) + ' '
    + GMTOffset;
end;

TColorRec

Cracker record that provides several different views of a TColor value and allows it to be assembled from its constituent parts.

type
  TColorRec = packed record
    case Integer of
      0:
        // TColor as Cardinal value
        (Color: Cardinal);
      1:
        // Array access to the 4 bytes of the TColor
        (Bytes: array[0..3] of Byte);
      2:
        // Red, Green, Blue and Alpha transparency values of the TColor
        (R, G, B, Alpha: Byte);
      3:
        // When SysFlag = $FF the TColor could be a system colour, in which case
        // SysColor identifies the system colour concerned.
        // WARNING: A colour with alpha transparency of $FF will also appear to
        // be a system colour, so use with care.
        (SysColor: Word; UnUsed, SysFlag: Byte);
  end;

ZoomRatio (Integer overload)

Calculates and returns the largest scaling that can be applied to a rectangle of width SrcWidth and height SrcHeight to fit it, without changing the aspect ratio, within a second rectangle of width DestWidth and height DestHeight.

function ZoomRatio(const DestWidth, DestHeight, SrcWidth, SrcHeight: Integer):
  Double; overload;
begin
  Result := Math.Min(DestWidth / SrcWidth, DestHeight / SrcHeight);
end;

ZoomRatio (TSize overload)

Calculates and returns the largest scaling that can be applied to a rectangle of size SrcSize to fit it, without changing the aspect ratio, within a second rectangle of size DestSize.

function ZoomRatio(const DestSize, SrcSize: Types.TSize): Double; overload;
begin
  Result := ZoomRatio(DestSize.cx, DestSize.cy, SrcSize.cx, SrcSize.cy);
end;

ZoomRatio (TRect overload)

Calculates and returns the laregest scaling that can be applied to rectangle SrcRect to fit it, without changing the aspect ratio, within rectangle DestRect.

function ZoomRatio(const DestRect, SrcRect: Types.TRect): Double; overload;
begin
  Result := ZoomRatio(RectSize(DestRect), RectSize(SrcRect));
end;

View the whole database.

Go to the DelphiDabbler website.