MCdemo: Delphi Version

The Delphi version of MCdemo activates the new cursor by assigning its handle to the form's Cursor property near the end of the OnCreate event handler. This makes our new cursor the default cursor within the window's client area. Delphi automatically frees the mouse cursor resources when the program exits, so we don't need to call DestroyCursor() as we do for C/C++.

{*****************************************************************************
*                                                                            *
*  MCdemo.dpr                                                                *
*  MCdemoU.pas                                                               *
*                                                                            *
*  This program shows how to change the shape of the mouse cursor.           *
*                                                                            *
*****************************************************************************}
unit MCdemoU;
interface
uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, FGWin;
type
  TForm1 = class(TForm)
    procedure AppOnActivate(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  end;
var
  Form1: TForm1;
implementation
{$J+}
{$R *.DFM}
const
  vbWidth  = 320;
  vbHeight = 240;
  Cross : array [1..32] of word = (
              $E03F,$E03F,$E03F,$0007,$0007,$0007,$0007,$0007,
              $0007,$0007,$E03F,$E03F,$E03F,$FFFF,$FFFF,$FFFF,
              $0000,$0F80,$0F80,$0F80,$7FF0,$7FF0,$7FF0,$7FF0,
              $7FF0,$0F80,$0F80,$0F80,$0000,$0000,$0000,$0000);
var
  dc     : hDC;
  hPal   : hPalette;
  hVB    : integer;
  cxClient, cyClient : integer;
procedure TForm1.AppOnActivate(Sender: TObject);
begin
  fg_realize(hPal);
  Invalidate;
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
  fg_realize(hPal);
end;
procedure TForm1.FormCreate(Sender: TObject);
const
  crMyCursor = 1;
begin
  dc := GetDC(Form1.Handle);
  fg_setdc(dc);
  hPal := fg_defpal;
  fg_realize(hPal);
  fg_vbinit;
  hVB := fg_vballoc(vbWidth,vbHeight);
  fg_vbopen(hVB);
  fg_vbcolors;
  fg_setcolor(20);
  fg_fillpage;
  fg_mouseini;
  Screen.Cursors[crMyCursor] := fg_mouseptr(Cross,6,6);
  Cursor := crMyCursor;
  Application.OnActivate := AppOnActivate;
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
  fg_vbscale(0,vbWidth-1,0,vbHeight-1,0,cxClient-1,0,cyClient-1);
end;
procedure TForm1.FormResize(Sender: TObject);
begin
  cxClient := ClientWidth;
  cyClient := ClientHeight;
  Invalidate;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
  fg_vbclose;
  fg_vbfree(hVB);
  fg_vbfin;
  DeleteObject(hPal);
  ReleaseDC(Form1.Handle,dc);
end;
end.