⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 untback.pas

📁 这是一个扑克牌游戏。 1.抓有黑桃7 的玩家首先出黑桃7。 2.然后按逆时针方向出牌。每位玩家依次出牌
💻 PAS
字号:
{
接龙游戏背景图案窗

黄文林 2006-02-13
}
unit untBack;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, CardLib;

type
  TfrmBack = class(TForm)
    btnOK: TButton;
    btnCancel: TButton;
    procedure FormPaint(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
  private
    { Private declarations }
    FCardIndex: Integer;    //背景图案索引(0 - 11)
  public
    { Public declarations }
  end;

var
  frmBack: TfrmBack;

implementation

uses
  untMain;

const
  CardWidth = 45;
  CardHeight = 72;

{$R *.dfm}

procedure TfrmBack.FormPaint(Sender: TObject);
var
  i, x, y: Integer;
begin
  //画背景图案
  for i := 0 to 11 do
  begin
    x := 10 + 55 * (i mod 6);
    y := 10 + 80 * (i div 6);
    Canvas.Pen.Color := $00C08000;
    if FCardIndex = i then
      Canvas.Rectangle(x - 3, y - 3, x + CardWidth + 3, y + CardHeight + 3);
    cdtDrawExt(Canvas.Handle, x, y, CardWidth, CardHeight, 54 + i, 1, clGreen);
  end;
end;

procedure TfrmBack.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  i, x1, y1 : Integer;
begin
  //逐行选择是否点击图案区域
  for i := 0 to 11 do
  begin
    if FCardIndex = i then Continue;  //排除原选择索引的区域
    x1 := 10 + 55 * (i mod 6);
    y1 := 10 + 80 * (i div 6);
    //当在区域的情况下
    if (x >= x1) and (y >= y1) and (x <= x1 + CardWidth) and (y <= y1 + CardHeight) then
    begin
      x1 := 10 + 55 * (FCardIndex mod 6);
      y1 := 10 + 80 * (FCardIndex div 6);
      Canvas.Pen.Color := clBtnFace;
      Canvas.Rectangle(x1 - 3, y1 - 3, x1 + CardWidth + 3, y1 + CardHeight + 3);
      FCardIndex := i;
      Paint;
      Exit;
    end;
  end;
end;

procedure TfrmBack.FormCreate(Sender: TObject);
begin
  Canvas.Pen.Width := 3;
  Canvas.Brush.Style := bsClear;
  //读入当前背景图案
  FCardIndex := frmMain.CardDraw.CardBackIndex - 54;
end;

procedure TfrmBack.btnOKClick(Sender: TObject);
begin
  //若背景图案选择了新的,则更新
  if frmMain.CardDraw.CardBackIndex <> FCardIndex then
  begin
    frmMain.CardDraw.CardBackIndex := FCardIndex + 54;
    Application.ProcessMessages;  //消除闪屏
  end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -