qc_main.pas

DELPHI的接龙游戏

unit QC_Main;
  {          QCard32.dll demonstrator.

    Shows how to use Stephen Murphy's QCard32.dll,
    a FreeWare, Windows-based, playing card library.
    Translated from VB to Delphi by Dale Cotton.
  }

  {
    Delphi Implementation Notes (Dale Cotton):

    1) This unit translates Stephen's VB DLL_Test into Delphi.
    For the most part this involved simple syntax substitutions;
    consequently this unit does not take advantage of the powerful
    OO techniques that Object Pascal provides over VB. The one
    exception I made was to define vars like BlockDragging and
    SourceCard, which were necessarily globals in VB as members
    of the TfrmMain class. This confines the scope of unexpected
    interactions to the TfrmMain methods...admittedly no big
    improvement.

    2) I have retained and extended Stephen's use of "Hungarian"
    prefix notation for variables, such as the n in nLoc which
    reminds us it is of type Integer. Admittedly Hungarian breaks
    down under OO when an object may be of type TSpeedButton or
    TPayrollDeduction. Hungarian is no less useful as a documentation
    tool for simple types, even if we use some other mechanism for
    object types.

    3) Prefixing QCard32. to QCard32 proc names is only absolutely
    necessary for the QCard32 EndDrag function, which has same name as
    a Win API call, however, using it in all cases adds safety and
    helps document code. When you go back to it six months from now
    you won't have to scratch your head as to where DrawCard comes
    from. Similarly,

    4) Prefixing Self. to all class member methods and data
    provides similar clarification. However, a better mechanism
    would distinguish between defined class fields and inherited
    ones. In the code below Self.X refers to a field defined in
    the ancestor class TForm, while Self.nOldX is a field defined
    directly in TfrmMain.

    5) Because VCL handles window client area painting more like
    Win API based programs than VB, it proved necessary to remove
    the drawing work handled in the VB demo's menu click event
    handlers from the actual menu click event handlers in this
    demo. See the note to the mnuDrawDrawCardClick procedure for
    details.

    6) My comments below will be marked (DC) to distinguish them
    from Stephen's, which are unmarked.
  }

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls, Menus;

type
  TfrmMain = class(TForm)
    MainMenu1: TMainMenu;
    mnuDraw: TMenuItem;
    mnuDrawDrawCard: TMenuItem;
    mnuDrawDealCard: TMenuItem;
    mnuDrawDrawBack: TMenuItem;
    mnuDrawDrawSymbol: TMenuItem;
    mnuDrawRemoveCard: TMenuItem;
    N1: TMenuItem;
    mnuDrawExit: TMenuItem;
    mnuInfo: TMenuItem;
    mnuInfoCardInformation: TMenuItem;
    mnuDrag: TMenuItem;
    mnuDragDoDrag: TMenuItem;
    mnuHelp: TMenuItem;
    mnuHelpHowTo: TMenuItem;
    mnuHelpAbout: TMenuItem;
    Timer: TTimer;
    N2: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure mnuDrawDrawCardClick(Sender: TObject);
    procedure mnuDrawDealCardClick(Sender: TObject);
    procedure mnuDrawDrawBackClick(Sender: TObject);
    procedure mnuDrawDrawSymbolClick(Sender: TObject);
    procedure mnuDrawExitClick(Sender: TObject);
    procedure mnuInfoCardInformationClick(Sender: TObject);
    procedure mnuDrawRemoveCardClick(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
    procedure FormDblClick(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure mnuDragDoDragClick(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure mnuHelpHowToClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure mnuHelpAboutClick(Sender: TObject);
  private
    bIsMenuCall: Boolean;     { see CardInformationClick event (DC) }
  { declare some test switches: }
    bDragDemo: Boolean;
    bSingleDragging: Boolean;
    bBlockDragging: Boolean;
    bMouseMoved: Boolean;
    nDrawSelection: Integer;

  { declare some card identifiers: }
    nSourceCard: Integer;
    nSourceArrayID: Integer;
    nSourceArrayPos: Integer;
    nDestCard: Integer;
    nDestArrayID: Integer;
    nOldX: Integer;
    nOldY: Integer;
    { nBlockMove called Temp and dynamically sized in VB code: }
    nBlockMove: array[0..51] of Integer;
    cBlockMove: Integer;  {nItems in VB code: BlockMove array count (DC) }
    nInformationCard: Integer;

  { to save mouse position for double click event: }
    xDblClick: Integer;
    yDblClick: Integer;

  { set up a two dimensional array four arrays to hold
    the numbers of the cards in each pile: }
    nCardArray: array[1..4, 1..52] of Integer;

  { set up a counter to go along with each pile: }
    nCounter: array[1..4] of Integer; { sizes of each pile (DC) }

    procedure DrawCard_Demo;
    procedure DealCard_Demo(bMenuCall: Boolean);
    procedure DrawBack_Demo;
    procedure DrawSymbol_Demo;
    procedure RemoveCard_Demo;
    procedure CardInformation_Demo(bMenuCall: Boolean);
  public
  end;

var
  frmMain: TfrmMain;

implementation

uses QCard32, QC_About;

{$R *.DFM}

procedure TfrmMain.DrawCard_Demo;
{ Draw all card images using DrawCard; this does not update
  any of the properties of the cards. (DC) }
var i, nLoc: Integer;
begin
  nLoc := (Self.ClientWidth - 4 * CARDWIDTH) div 5;

  for i := 1 to 13 do
    QCard32.DrawCard(Self.Handle, i, nLoc, 10 + ((i - 1) * OFFSET));

  for i := 14 to 26 do
    QCard32.DrawCard(Self.Handle, i, nLoc * 2 + CARDWIDTH, 10 + ((i - 14) * OFFSET));

  for i := 27 to 39 do
    QCard32.DrawCard(Self.Handle, i, nLoc * 3 + CARDWIDTH * 2, 10 + ((i - 27) * OFFSET));

  for i := 40 to 52 do
    QCard32.DrawCard(Self.Handle, i, nLoc * 4 + CARDWIDTH * 3, 10 + ((i - 40) * OFFSET));
end;

procedure TfrmMain.DealCard_Demo(bMenuCall: Boolean);
{ Deal cards in a diagonal line. See QCard32.hlp on differences
  between DealCard and DrawCard. (DC) }
var i, xOffset, yOffset: Integer;

{sub}procedure Shuffle;
  var i, j, k, nTemp: Integer;
  begin
    for i := 1 to 52 do
      nCardArray[1, i] := i;
    for i := 1 to 10 do
      for j := 1 to 52 do
      begin
        k := Random(52) + 1;
        nTemp := nCardArray[1, j];
        nCardArray[1, j] := nCardArray[1, k];
        nCardArray[1, k] := nTemp;
      end;
  end;

begin
  Shuffle;
  xOffset := (Self.ClientWidth - CARDWIDTH) div 51;
  yOffset := (Self.ClientHeight - CARDHEIGHT) div 51;
  if bMenuCall then { called from menu, so must Deal not Draw: (DC) }
    for i := 1 to 52 do
      QCard32.DealCard(Self.Handle, nCardArray[1, i], (i - 1) * xOffset, (i - 1) * yOffset)
  else  { can use faster method since DealCard already used: (DC) }
    for i := 1 to 52 do
      QCard32.DrawCard(Self.Handle, nCardArray[1, i], (i - 1) * xOffset, (i - 1) * yOffset);
end;

procedure TfrmMain.DrawBack_Demo;
{ Draw six piles of face down cards offsetting by 2 pixels
  up and over. }
var xLoc, i, j: Integer;
begin
  xLoc := (Self.ClientWidth - (6 * CARDWIDTH)) div 7;
  for i := 1 to 6 do
    for j := 1 to 4 do
      QCard32.DrawBack(Self.Handle, i,
        ((i - 1) * CARDWIDTH) + i * xLoc + ((j - 1) * 2),
          50 - ((j - 1) * 2));
end;

procedure TfrmMain.DrawSymbol_Demo;
{ Draw in one of each of the three pile symbols in the
  QCard image set. }
var xLoc, i: Integer;
begin
  xLoc := (Self.ClientWidth - (3 * CARDWIDTH)) div 4;
  for i := 1 to 3 do
    QCard32.DrawSymbol(Self.Handle, i, (i * xLoc) + ((i - 1) * CARDWIDTH), 50);
end;

procedure TfrmMain.RemoveCard_Demo;
{ Deal 13 cards then enable the timer to remove them. }
var i: Integer;
begin
  for i := 1 to 13 do
    QCard32.DealCard(Self.Handle, i, (Self.ClientWidth - CARDWIDTH) div 2, 10 + ((i - 1) * 16));

  Self.Timer.Enabled := True;
end;

procedure TfrmMain.CardInformation_Demo(bMenuCall: Boolean);
{ Demonstrates use of the QCard GetCardxxxx calls. (DC) }
const
   i: Integer = 0;
   xLoc: Integer = 0;
   yLoc: Integer = 0;
   nTextWdt: Integer = 0;

{sub-}procedure DoText(iCardNo: Integer);
  var
     sText: String;
     nTextHgt: Integer;
  begin
    nTextHgt := Trunc( Self.Canvas.TextHeight('X') * 1.25);
    sText := 'Card number is ' + IntToStr(iCardNo);
    Self.Canvas.TextOut(2, nTextHgt, sText);
    sText := 'Card color is ' + IntToStr(GetCardColor(iCardNo));
    Self.Canvas.TextOut(2, nTextHgt * 2, sText);
    sText := 'Card value (rank) is ' + IntToStr(GetCardValue(iCardNo));
    Self.Canvas.TextOut(2, nTextHgt * 3, sText);
    sText := 'Card suit is ' + IntToStr(GetCardSuit(iCardNo));
    Self.Canvas.TextOut(2, nTextHgt * 4, sText);
    sText := 'Card x location is ' + IntToStr(GetCardX(iCardNo));
    Self.Canvas.TextOut(2, nTextHgt * 5, sText);
    sText := 'Card y location is ' + IntToStr(GetCardY(iCardNo));
    Self.Canvas.TextOut(2, nTextHgt * 6, sText);
    if GetCardStatus(iCardNo) then
       sText := 'Card Status (face-up) is True'
    else
       sText := 'Card Status (face-up) value is False';
    Self.Canvas.TextOut(2, nTextHgt * 7, sText);
    sText := 'Main Form ClientWidth is ' + IntToStr(Self.ClientWidth);
    Self.Canvas.TextOut(2, nTextHgt * 8, sText);
    sText := 'Main Form ClientHeight is ' + IntToStr(Self.ClientHeight);
    Self.Canvas.TextOut(2, nTextHgt * 9, sText);
  end; { sub DoText }

begin
  if bMenuCall then { Called by menu click not OnPaint (DC) }
  begin
    nTextWdt := Trunc(Self.Canvas.TextWidth('Main Form ClientHeight is 9999'));
    { pick a random card: }
    i := Random(52) + 1;

    { pick a random location in the form --
      Int((upperbound - lowerbound + 1) * Rnd + lowerbound): }
    xLoc := Random((Self.ClientWidth - CARDWIDTH) - nTextWdt + 1) + nTextWdt;
    yLoc := Random((Self.ClientHeight - CARDHEIGHT) {- 150} + 1) {+ 150};
  end;

  { set current information card for Paint event: }
  Self.nInformationCard := i;

  { deal the card: }
  QCard32.DealCard(Self.Handle, i, xLoc, yLoc);

  { draw in the text information: }
  DoText(Self.nInformationCard);
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
{ try to fire up the DLL. A False return value indicates problems: }
  if not QCard32.InitializeDeck(Self.Handle) then
  begin { The following error reports "Some other application is
          using QCard.DLL in 16-bit. This conflict does not apply
          in 32-bit. 32-bit allows multiple apps to use QCard.dll. (DC) }
    ShowMessage('Sorry. Unable to locate or open QCards32.DLL');
    Self.Close;
  end;

  Application.HelpFile :=
   LowerCase(ExtractFilePath(Application.ExeName))
    + Application.HelpFile;
  Randomize;

{ make form 3/4s of full screen: (DC) }
  Self.Width := (Screen.Width div 4) * 3;
  Self.Height := (Screen.Height div 4) * 3;

{ make some initial assigns:
  (actually unnecessary in Delphi which automatically
   initializes member vars to False/0) (DC) }
  Self.bDragDemo := False;
  Self.bSingleDragging := False;
  Self.bBlockDragging := False;
  Self.bMouseMoved := False;
  Self.nDrawSelection := 0;
  Self.nInformationCard := 0;
end;

procedure TfrmMain.mnuDrawDrawCardClick(Sender: TObject);
begin
  { User may have interrupted RemoveCard_Demo before
    it completed: (DC) }
  Self.Timer.Enabled := False;
  { Refresh first clears the main window client area,
    then sends a Paint message. The OnPaint event
    handler below uses nDrawSelection to know to
    call DrawCard_Demo to do the actual work. This
    round-about is necessary so that the program can
    respond to external events like a user over-lapping
    the main window then revealing it or the user dragging
    the resizing borders. Both of these invoke the
    OnPaint event, as well. (DC) }
  Self.nDrawSelection := 2;
  Self.Refresh;
end;

procedure TfrmMain.mnuDrawDealCardClick(Sender: TObject);
begin
  Self.Timer.Enabled := False;
  Self.nDrawSelection := 1;
  Self.bIsMenuCall := True;
  Self.Refresh;
  Self.bIsMenuCall := False;
end;

procedure TfrmMain.mnuDrawDrawBackClick(Sender: TObject);
begin
  Self.Timer.Enabled := False;
  Self.nDrawSelection := 3;
  Self.Refresh;
end;

procedure TfrmMain.mnuDrawDrawSymbolClick(Sender: TObject);
var xLoc, i: Integer;
begin
  Self.Timer.Enabled := False;
  Self.nDrawSelection := 4;
  Self.Refresh;
end;

procedure TfrmMain.mnuDrawExitClick(Sender: TObject);
begin
  Self.Timer.Enabled := False;
  Self.Close;
end;

procedure TfrmMain.mnuInfoCardInformationClick(Sender: TObject);
begin
  Self.Timer.Enabled := False;
  Self.nDrawSelection := 5;
  Self.bIsMenuCall := True;
  Self.Refresh;
  Self.bIsMenuCall := False;
end;

procedure TfrmMain.mnuDrawRemoveCardClick(Sender: TObject);
begin
  Self.nDrawSelection := 0;