Паскаль / do11 / tmtp390d / SAMPLES / GRAPH / Gfxmouse

(***********************************************)
(*                                             *)
(* Mouse Unit Demo                             *)
(* Copyright (c) 1998 by TMT Development Corp. *)
(* Author: Vadim Bodrov, TMT Development Corp. *)
(*                                             *)
(* Targets:                                    *)
(*   MS-DOS 32-bit protected mode              *)
(*   Win32 application                         *)
(***********************************************)

uses Mouse, CRT, Graph;

const
  MousePtr: array [0..255] of Byte =
  ($0F,$0F,$0F,$0F,$0F,$0F,$0F,$0F,$0F,$0F,$0F,$0F,$0F,$00,$00,$00,
   $0F,$0F,$0F,$0F,$0F,$0F,$0F,$0F,$0F,$0F,$0F,$0F,$00,$00,$00,$00,
   $0F,$0F,$0F,$0F,$0F,$0F,$0F,$0F,$0F,$0F,$0F,$00,$00,$00,$00,$00,
   $0F,$0F,$0F,$0F,$0F,$0F,$0F,$0F,$0F,$0F,$00,$00,$00,$00,$00,$00,
   $0F,$0F,$0F,$0F,$0F,$0F,$0F,$0F,$0F,$00,$00,$00,$00,$00,$00,$00,
   $0F,$0F,$0F,$0F,$0F,$0F,$0F,$0F,$0F,$0F,$00,$00,$00,$00,$00,$00,
   $0F,$0F,$0F,$0F,$0F,$0F,$0F,$0F,$0F,$0F,$0F,$00,$00,$00,$00,$00,
   $0F,$0F,$0F,$0F,$0F,$0F,$0F,$0F,$0F,$0F,$0F,$0F,$00,$00,$00,$00,
   $0F,$0F,$0F,$0F,$00,$0F,$0F,$0F,$0F,$0F,$0F,$0F,$0F,$00,$00,$00,
   $0F,$0F,$0F,$00,$00,$00,$0F,$0F,$0F,$0F,$0F,$0F,$0F,$0F,$00,$00,
   $0F,$0F,$00,$00,$00,$00,$00,$0F,$0F,$0F,$0F,$0F,$0F,$0F,$0F,$00,
   $0F,$0F,$00,$00,$00,$00,$00,$00,$0F,$0F,$0F,$0F,$0F,$0F,$0F,$0F,
   $0F,$00,$00,$00,$00,$00,$00,$00,$00,$0F,$0F,$0F,$0F,$0F,$0F,$0F,
   $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$0F,$0F,$0F,$0F,$0F,$00,
   $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$0F,$0F,$0F,$00,$00,
   $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$0F,$00,$00,$00);

var
  X, Y, LX, LY, GX, GY: Word;
  DrawFlag: Boolean := false;
  Color: DWord;

procedure DrawMouse(X,Y: Word);
begin
 PutSprite(X, Y, X + 15, Y + 15, MousePtr);
end;

procedure DrawPalette;
var
  i: DWord;
  k: Real := 0;
  s: Real;
begin
 s := GetMaxColor / GetMaxX;
 for i := 0 to GetMaxX do begin
  SetColor(Trunc(k));
  Line(i, GetMaxY - 20, i, GetMaxY);
  k := k + s;
 end;
end;

begin
 SetSVGAMode(640, 480, 8, LfbOrBanked);
 if GraphResult <> grOk then begin
  Writeln('Required video mode is not supported..');
  Halt(0);
 end;
 SetFillColor(clWhite);
 DrawPalette;
 InitMouse;
 HideMouse;
 SetMouseRange(0, 0, GetMaxX, GetMaxY);
 SetWriteMode(XorPut);
 SetMousePos(GetMaxX div 2, GetMaxY div 2);
 DrawMouse(LX, LY);
 Color := clWhite;
 repeat
  X := GetMouseX;
  Y := GetMouseY;
  if (X <> LX) or (Y <> LY) then begin
   if (LeftButtonPressed) and (Y < GetMaxY - 20) then begin
    DrawMouse(LX, LY);
    if DrawFlag then begin
     SetColor(Color);
     SetWriteMode(NormalPut);
     Line(GX, GY, X, Y);
     SetWriteMode(XORPut);
    end;
    DrawMouse(X, Y);
    GX := X;
    GY := Y;
    DrawFlag := true;
   end else begin
    DrawFlag := false;
    DrawMouse(LX, LY);
    DrawMouse(X, Y);
   end;
    LX := X;
   LY := Y;
  end;
  if (LeftButtonPressed) and (Y > GetMaxY - 20) then begin
   DrawMouse(X, Y);
   Color := GetPixel(X, Y);
   DrawMouse(X, Y);
  end;
  if (RightButtonPressed) and (Y < GetMaxY - 20) then begin
   DrawMouse(X, Y);
   SetFillColor(Color);
   ExpandFill(X, Y);
   DrawMouse(X, Y);
  end;
 until KeyPressed;
 ReadKey;
 DoneMouse;
 RestoreCRTMode;
end.