A screensaver from the past

I was browsing around the files on my Windows Live share, and came across a screensaver that I wrote way back in 2006. (The only screensaver I ever wrote.) The thing is, it still works, to my amazement. On Windows 7, that is; I haven’t made the move to Windows 8 yet. What really amazes me is that I wrote it in Delphi. (I don’t even remember Delphi, or want to really.)

Desktop scroller (source code and compiled .SCR file)

OK, so I don’t expect anybody to download it. The main reason I’m putting here is as a permanent reminder to myself to rewrite it in C#. In 2010, I worked for a company that still used Delphi, so I recompiled it there, and foolishly updated the year in the version info, but there is still one file in the zip with the original date. At that point, I promised myself I would rewrite it in c#, and then promptly forgot about it, until today.

The screensaver’s main action is to create a screenshot of your desktop, then scroll it up the screen. Actually it looks quite cool. It even runs in the child window of the screen saver settings control panel applet.

The funny thing, looking at this vintage code makes me feel dumb. In addition to going all out and writing my own mini-framework for creating screensavers (which I of course never touched again), all painting is done in a thread, and for whatever reason (I think it was to properly support 16 bit bitmaps), I recreated the wheel (actually the Bitmap) and wrote my own versions of Delphi’s Graphics.InitializeBitmapInfoHeader and Graphics.GetDIBSizes. At the time, I’d read about the funky Stopwatch class in c# 1.0, so I wrote my own version in Delphi.

The scrolling effect was achieved by directly manipulating the bitmap scanlines (i.e. the bitmap row bytes in memory). I don’t even know how to do that in c#. I think I used pointers in c# once, and I can’t remember how they worked.

What happened to that clever version of me from the past? That guy who happily tackled the most obscure APIs without hesitation? I could sure use his help these days.

Anyway, here is some of that Delphi code. Maybe a fellow .Net programmer can look at this, with vague memories of stuff they used to know, and feel as dumb as I do now.

The painter thread class code that scrolls the bitmap:

procedure TScrollingBitmapPainter.ScrollBitmap;
var
  W, H, LineBytes: Integer;
  Line: PByteArray;
  
  procedure CopyScanLines(const ABitmap: TBitmap);
  var
    i, j: Integer;
  begin
    for i := 0 to H - 1 do
    begin
      // exit the for loop if user cancels
      if Terminated then
        Break;
  
      // copy the first line
      Move((ABitmap.ScanLine[0])^, Line^, LineBytes);
      // for every line
      for J := 1 to H - 1 do
      begin
        // move line to the previous one
        Move((ABitmap.ScanLine[J])^, (ABitmap.ScanLine[J - 1])^, LineBytes);
        // every FUpdateBitmapByNLines update the output
        if (J mod FUpdateBitmapByNLines = 0) then
        begin
          FRect := Rect(0, J - FUpdateBitmapByNLines, W, J);
          FActiveBitmap := ABitmap;
          Synchronize(UpdateBitmap);
          if Terminated then
            Break;
        end;
      end;
      // move back the first line to the end
      Move(Line^, (ABitmap.ScanLine[ABitmap.Height - 1])^, LineBytes);
      // update the final portion of the bitmap
      FRect := Rect(0, H - FUpdateBitmapByNLines, W, H);
      FActiveBitmap := ABitmap;
      Synchronize(UpdateBitmap);
      if Terminated then
        Break;

      // It's much too fast when this is a child window of display properties
      if FForm.Windowed then
        WaitforTimer(childWindowWaitInterval);
    end;
  end;
  
begin
  if (FBitmap <> nil) then
  begin
    { Resize the bitmap if its dimensions are different to display window.
      This should only happen when the form is owned by display properties.
      - application was launched with: DScroll.scr /p <handle> }
    if (FBitmap.Width <> FForm.Width) or (FBitmap.Height <> FForm.Height) then
    begin
      ResizeBitmap(FBitmap, FForm.Width, FForm.Height);
      FUpdateBitmapByNLines := FBitmap.Height;
    end;
  
    W := FBitmap.Width;
    H := FBitmap.Height;
  
    // allocate enough memory for one line
    LineBytes := Abs(Integer(FBitmap.ScanLine[1]) - Integer(FBitmap.ScanLine[0]));
    Line := AllocMem(LineBytes);
    try
      // scroll how many items as there are lines
      if not Terminated then
      try
        CopyScanLines(FBitmap);
        if Terminated then
          Exit;
      except
        on E: Exception do
        begin
          TLogWriter.Instance.LogError(E.Message);
          TLogWriter.Instance.LogError('Aborting painter thread. The bitmap has changed.');
        end;
      end;
    finally
      FreeMem(Line);
    end;

    ReturnValue := 0;
  end
  else begin
    ReturnValue := 1;
    Terminate;
  end;
end;

Code from the unit that resizes bitmaps:

// similar to Graphics.InitializeBitmapInfoHeader
procedure GetBitmapHeader(const Bitmap: HBITMAP; var Header: TBitmapInfoHeader);
var
  lDibSection: TDIBSection;
  lBytes: Integer;
begin
  lDibSection.dsbmih.biSize := 0;

  lBytes := GetObject(Bitmap, SizeOf(DibSection), @lDibSection);
  if lBytes = 0 then
    raise EInvalidGraphic.Create(ErrorInvalidBitmap)
  else if (lBytes >= (SizeOf(lDibSection.dsbm) + SizeOf(lDibSection.dsbmih))) and
          (lDibSection.dsbmih.biSize >= (SizeOf(lDibSection.dsbmih))) then
    Header := lDibSection.dsbmih
  else
  begin
    FillChar(Header, SizeOf(Header), 0);
    Header.biSize   := SizeOf(Header);
    Header.biWidth  := lDibSection.dsbm.bmWidth;
    Header.biHeight := lDibSection.dsbm.bmHeight;
  end;
  Header.biBitCount := lDibSection.dsbm.bmBitsPixel * lDibSection.dsbm.bmPlanes;

  if Header.biBitCount in [16, 32] then
  begin
    Header.biBitCount := 24; // only 24 bit bitmaps supported
    Header.biSizeImage := 0; // force recalculating size with new bit count
  end;

  Header.biPlanes := 1;

  // According to MSDN this may be 0 if biCompression = BI_RGB, but that breaks the code for 16 bit images
  if (Header.biSizeImage = 0) then
    Header.biSizeImage := ComputeScanLineSize(Header.biWidth, Header.biBitCount) * Abs(Header.biHeight);
end;

// similar to GetDIBSizes in Graphics.pas
procedure GetDIBSizes(const BitmapHandle: HBITMAP; var InfoHeaderSize: DWORD; var ImageSize: DWORD);
var
  Header: TBitmapInfoHeader;
begin
  GetBitmapHeader(BitmapHandle, Header);
  if Header.biBitCount > 8 then
  begin
    InfoHeaderSize := SizeOf(TBitmapInfoHeader);
    if (Header.biCompression and BI_BITFIELDS) <> 0 then
      Inc(InfoHeaderSize, 12);
  end
  else
    InfoHeaderSize := SizeOf(TBitmapInfoHeader) + SizeOf(TRGBQuad) * (1 shl Header.biBitCount);

  ImageSize := Header.biSizeImage;
end;

// similar to Graphics.GetDIB and Graphics.InternalGetDIB
function GetDIB(const BitmapHandle: HBITMAP; var BitmapInfo: TBitmapInfo; const Bits: PByteArray): Boolean;
var
  lDC: HDC;
  lSavedHeader: TBitmapInfoHeader;
begin
  GetBitmapHeader(BitmapHandle, BitmapInfo.bmiHeader);
  lDC := CreateCompatibleDC(0);
  try
    // GetDIBits seems to overwrite the biClrUsed field, so a temporary copy is saved.
    lSavedHeader := BitmapInfo.bmiHeader;

    Result := GetDIBits(lDC, BitmapHandle, 0, BitmapInfo.bmiHeader.biHeight, Bits, BitmapInfo, DIB_RGB_COLORS) <> 0;

    BitmapInfo.bmiHeader := lSavedHeader;
  finally
    DeleteDC(lDC);
  end;
end;

procedure TResizeBitmap.Apply(const Bitmap: TBitmap);
var
  lTempBitmap: TBitmap;
  lBitmapInfo: PBitmapInfo;
  lbits: PByteArray;
  lInfoHeaderSize, ImageSize: DWORD;
  lPixelFormat: TPixelFormat;
begin
  if Bitmap.Empty then
    raise EInvalidGraphic.Create(ErrorBitmapEmpty);
  
  if (FWidth = Bitmap.Width) and (FHeight = Bitmap.Height) then
    Exit;
  
  lPixelFormat := pf24bit;
  
  { In order to get to the BitmapInfo struct and the bits of the TBitmap,
  convert it to a DDB, and then use GetDIB to convert back to DIB.}
  Bitmap.HandleType := bmDDB;
  
  lTempBitmap := TBitmap.Create;
  try
    lTempBitmap.Width := FWidth;
    lTempBitmap.Height := FHeight;
  
    if ((FWidth * FHeight) <= (32 * 32)) or (Bitmap.PixelFormat <> pf24bit) then
      SetStretchBltMode(lTempBitmap.Canvas.Handle, Windows.COLORONCOLOR)
    else
      SetStretchBltMode(lTempBitmap.Canvas.Handle, HALFTONE);
    SetBrushOrgEx(lTempBitmap.Canvas.Handle, 0, 0, nil);
  
    // Note: Graphics.GetDIBSizes doesn't work for 16 bit images
    GetDIBSizes(Bitmap.Handle, lInfoHeaderSize, ImageSize);
  
    GetMem(lBitmapInfo, lInfoHeaderSize);
    GetMem(lbits, ImageSize);
    try
      // Note: The similar GetDIB function in Graphics.pas always fails.
      if not GetDIB(Bitmap.Handle, lBitmapInfo^, lbits) then
        raise EInvalidGraphicOperation.Create(ErrorGetDIBfailed);
  
      // 24 bit should be most suitable (and is preferable since it'as the native uncompressed windows
      // bitmap format), but try to produce the best possible output for non-true-colour images.
      case lBitmapInfo^.bmiHeader.biBitCount of
      1:  lPixelFormat := pf1bit;
      4:  lPixelFormat := pf4bit;
      8:  lPixelFormat := pf8bit;
      else // true-colour
        lPixelFormat := pf24bit;
      end;
  
      if StretchDiBits(lTempBitmap.Canvas.Handle, 0, 0, FWidth, FHeight, 0, 0, Bitmap.Width,
                       Bitmap.Height, lbits, lBitmapInfo^, DIB_RGB_COLORS, SRCCOPY) <= 0 then
        raise EInvalidGraphicOperation.Create(ErrorResizeFailed);
    finally
      FreeMem(lbits);
      FreeMem(lBitmapInfo);
    end;
    Bitmap.Assign(lTempBitmap);
  
    Bitmap.PixelFormat := lPixelFormat;
  finally
    lTempBitmap.Free;
  end;
end;

The Stopwatch type:

unit uStopwatch;

interface

type
  { A stopwatch class to time operations accurately rather than using the system
    time or GetTickCount. }
  TStopwatch = class(TObject)
  private
    FEndTime: Int64;
    FFrequency: Int64;
    FStartTime: Int64;
    function GetElapsed: Extended;
    procedure ResetCounter;
  public
    procedure Start;
    procedure Stop;
    property Elapsed: Extended read GetElapsed;
  end;
  
implementation

uses
  Windows;

function TStopwatch.GetElapsed: Extended;
begin
  if (FFrequency = 0) or (FStartTime = 0) then
    Result := 0 else
  begin
    if FEndTime = 0 then
      Stop;
    Result := (FEndTime - FStartTime) / FFrequency;
  end;
end;

procedure TStopwatch.ResetCounter;
begin
  FFrequency := 0;
  FStartTime := 0;
  FEndTime := 0;
end;

procedure TStopwatch.Start;
begin
  ResetCounter;
  QueryPerformanceFrequency(FFrequency);
  QueryPerformanceCounter(FStartTime);
end;

procedure TStopwatch.Stop;
begin
  QueryPerformanceCounter(FEndTime);
end;

end.
Advertisements

About Jerome

I am a senior C# developer in Johannesburg, South Africa. I am also a recovering addict, who spent nearly eight years using methamphetamine. I write on my recovery blog about my lessons learned and sometimes give advice to others who have made similar mistakes, often from my viewpoint as an atheist, and I also write some C# programming articles on my programming blog.
This entry was posted in Programming and tagged . Bookmark the permalink.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s