main.pas

纸牌程序代码源于一个古老的纸牌算命

unit main;

interface

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

type
  Tfrm_main = class(TForm)
    BB_Start: TBitBtn;
    Image1: TImage;
    Timer1: TTimer;
    BB_Exit: TBitBtn;
    RadioGroup1: TRadioGroup;
    Label1: TLabel;
    Label2: TLabel;
    BB_Pause: TBitBtn;
    BB_Reset: TBitBtn;
    Label3: TLabel;
    BB_About: TBitBtn;
    ListBox1: TListBox;
    RadioGroup2: TRadioGroup;
    procedure BB_StartClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure BB_ExitClick(Sender: TObject);
    procedure BB_PauseClick(Sender: TObject);
    procedure BB_ResetClick(Sender: TObject);
    procedure RadioGroup2Click(Sender: TObject);
    procedure BB_AboutClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    Seeds:byte;
    CurrCard:byte;
    Big,MeFirst:boolean;
    Step:byte;
    Cards:array[0..27] of TImage;
    procedure CurrCards;
    procedure AddDetail(IsMe:boolean;Cards:integer);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frm_main: Tfrm_main;

implementation

{$R *.DFM}

function drawcard(bmp:tbitmap;num:integer):integer;far;
  external 'gbhcards.dll';

procedure Tfrm_main.BB_StartClick(Sender: TObject);
begin
  Step:=0;
  BB_Start.Enabled:=false;
  BB_Pause.Enabled:=true;
  case RadioGroup1.ItemIndex of
    0:big:=true;
    1:big:=false;
  end;
  MeFirst:=false;
  RadioGroup1.Enabled:=false;
  timer1.Enabled:=true;
end;

procedure Tfrm_main.AddDetail(IsMe:boolean;Cards:integer);
var
  tmpstr:string;
begin
  if IsMe then tmpStr:='你' else tmpStr:='她/他';
  case Cards of
    0: ListBox1.Items.Add('草花A，'+tmpStr+'的身高较低噢，中等偏下！');
    13:ListBox1.Items.Add('方片A，'+tmpStr+'的身高不错噢，中等！');
    26:ListBox1.Items.Add('红桃A，'+tmpStr+'的身高好高高，绝对高！');
    39:ListBox1.Items.Add('黑桃A，'+tmpStr+'好矮，二级残废！');
    1: ListBox1.Items.Add('草花2，'+tmpStr+'的相貌不怎么样噢，只能勉强接受！');
    14:ListBox1.Items.Add('方片2，'+tmpStr+'的相貌不错，中等水平！');
    27:ListBox1.Items.Add('红桃2，'+tmpStr+'的相貌好好噢，不是帅哥就是靓妹！');
    40:ListBox1.Items.Add('黑桃2，'+tmpStr+'的相貌好差，丑八怪！');
    2: ListBox1.Items.Add('草花3，'+tmpStr+'的心地有点黑噢，注意一点！');
    15:ListBox1.Items.Add('方片3，'+tmpStr+'的心地一般般，中等！');
    28:ListBox1.Items.Add('红桃3，'+tmpStr+'的心地善良噢，绝对好人一个！');
    41:ListBox1.Items.Add('黑桃3，'+tmpStr+'的良心大大的黑，坏儿童！');
    3: ListBox1.Items.Add('草花4，'+tmpStr+'的事业很一般噢，中等偏下！');
    16:ListBox1.Items.Add('方片4，'+tmpStr+'的事业平平庸庸，中等！');
    29:ListBox1.Items.Add('红桃4，'+tmpStr+'的事业如日东升，好！');
    42:ListBox1.Items.Add('黑桃4，'+tmpStr+'的事业将一事无成，悲惨！');
    4: ListBox1.Items.Add('草花5，'+tmpStr+'的前途太一般了，中等偏下！');
    17:ListBox1.Items.Add('方片5，'+tmpStr+'的前途未扑，中等！');
    30:ListBox1.Items.Add('红桃5，'+tmpStr+'的前途一片光明，栋梁之才！');
    43:ListBox1.Items.Add('黑桃5，'+tmpStr+'的前途黑暗，没得混了！');
    5: ListBox1.Items.Add('草花6，'+tmpStr+'的富裕般般，普通白领！');
    18:ListBox1.Items.Add('方片6，'+tmpStr+'的富裕程度中等偏下，普通老百姓！');
    31:ListBox1.Items.Add('红桃6，'+tmpStr+'的衰运当头，穷死啦！');
    44:ListBox1.Items.Add('黑桃6，'+tmpStr+'的财运当头，发达啦！');
    6: ListBox1.Items.Add('草花7，'+tmpStr+'的运气中等偏下，踏实点吧！');
    19:ListBox1.Items.Add('方片7，'+tmpStr+'的运气一般般罗，中等！');
    32:ListBox1.Items.Add('红桃7，'+tmpStr+'的福星高照，运气好好！');
    45:ListBox1.Items.Add('黑桃7，'+tmpStr+'的运气惨惨不忍睹，哭吧！');
    7: ListBox1.Items.Add('草花8，'+tmpStr+'的嗜烟一般噢，抽着玩而已！');
    20:ListBox1.Items.Add('方片8，'+tmpStr+'的嗜烟可以噢，小烟民一个！');
    33:ListBox1.Items.Add('红桃8，'+tmpStr+'的嗜烟如命，不抽烟会死人的！');
    46:ListBox1.Items.Add('黑桃8，'+tmpStr+'的嗜烟没有，一根不抽！');
    8: ListBox1.Items.Add('草花9，'+tmpStr+'的嗜酒一般噢，喝着玩而已！');
    21:ListBox1.Items.Add('方片9，'+tmpStr+'的嗜酒可以噢，小酒鬼一个！');
    34:ListBox1.Items.Add('红桃9，'+tmpStr+'的嗜酒如命，不喝酒会死人的！');
    47:ListBox1.Items.Add('黑桃9，'+tmpStr+'的嗜酒没有，滴酒不沾！');
    9: ListBox1.Items.Add('草花10，'+tmpStr+'对对方的爱不怎么的，偏下！');
    22:ListBox1.Items.Add('方片10，'+tmpStr+'对对方的爱一般般，可以啦！');
    35:ListBox1.Items.Add('红桃10，'+tmpStr+'对对方的爱好深，爱死啦！');
    48:ListBox1.Items.Add('黑桃10，'+tmpStr+'对对方的爱一点没有！');
    10: ListBox1.Items.Add('草花J，'+tmpStr+'的母亲不太看好对方，感觉偏下！');
    23:ListBox1.Items.Add('方片J，'+tmpStr+'的母亲较看好对方，偏上！');
    36:ListBox1.Items.Add('红桃J，'+tmpStr+'的母亲好喜欢对方，满意！');
    49:ListBox1.Items.Add('黑桃J，'+tmpStr+'的母亲好讨厌对方，没戏！');
    11: ListBox1.Items.Add('草花Q，'+tmpStr+'的父亲不太看好对方，感觉偏下！');
    24:ListBox1.Items.Add('方片Q，'+tmpStr+'的父亲较看好对方，偏上！');
    37:ListBox1.Items.Add('红桃Q，'+tmpStr+'的父亲好喜欢对方，满意！');
    50:ListBox1.Items.Add('黑桃Q，'+tmpStr+'的父亲好讨厌对方，没戏！');
    12: ListBox1.Items.Add('草花K，你们不会结婚，成为很普通的朋友！');
    25:ListBox1.Items.Add('方片K，你们不会结婚，但成为很好的朋友！');
    38:ListBox1.Items.Add('红桃K，哈哈，你们结婚罗，恭喜恭喜！');
    51:ListBox1.Items.Add('黑桃K，结婚？不可能！仇家道是可能！');
  end;
end;

procedure Tfrm_main.CurrCards;
begin
  Case Step of
  0:  begin
        if Seeds=52 then //bigking
        begin
          if big then
          begin
            drawcard(Cards[0].Picture.Bitmap,Seeds);
            Cards[0].Tag:=1;
          end else
          begin
            drawcard(Cards[14].Picture.Bitmap,Seeds);
            Cards[14].Tag:=1;
          end;
          if (Cards[14].Tag=0) then
            MeFirst:=true;
        end;
        if Seeds=53 then //smallking
        begin
          if big then
          begin
            drawcard(Cards[14].Picture.Bitmap,Seeds);
            Cards[14].Tag:=1;
          end else
          begin
            drawcard(Cards[0].Picture.Bitmap,Seeds);
            Cards[0].Tag:=1;
          end;
          if (Cards[14].Tag=0) then
            MeFirst:=true;
        end;
        //wether first step be end
        if (Cards[0].Tag<>0)and(Cards[14].Tag<>0)then
        begin
          if MeFirst then
          begin
            ListBox1.Items.Add('最新报告：是你先追她/他的！')
          end else
          begin
            ListBox1.Items.Add('最新报告：是她/他先追你的！');
          end;
          CurrCard:=0;
          Step:=1;
        end;
      end;
  1,3,5,7,9,11,13,15,17,19,21,23:
      begin
        if (Seeds=CurrCard)or(Seeds=CurrCard+13)or(Seeds=CurrCard+26)or(Seeds=CurrCard+39) then
        begin
          ListBox1.Items.Add('             ※※※');
          if MeFirst then
          begin
            Cards[(Step div 2)+1].BringToFront;
            drawcard(Cards[(Step div 2)+1].Picture.Bitmap,Seeds);
            Cards[(Step div 2)+1].Tag:=1;
            AddDetail(MeFirst,Seeds);
          end else
          begin
            Cards[(Step div 2)+15].BringToFront;
            drawcard(Cards[(Step div 2)+15].Picture.Bitmap,Seeds);
            Cards[(Step div 2)+15].Tag:=1;
            AddDetail(MeFirst,Seeds);
          end;
          Inc(Step);
        end;
      end;
  2,4,6,8,10,12,14,16,18,20,22,24:
      begin
        if (Seeds=CurrCard)or(Seeds=CurrCard+13)or(Seeds=CurrCard+26)or(Seeds=CurrCard+39) then
        begin
          if MeFirst then
          begin
            Cards[(Step div 2)+14].BringToFront;
            drawcard(Cards[(Step div 2)+14].Picture.Bitmap,Seeds);
            Cards[(Step div 2)+14].Tag:=1;
            AddDetail(not MeFirst,Seeds);
          end else
          begin
            Cards[(Step div 2)].BringToFront;
            drawcard(Cards[(Step div 2)].Picture.Bitmap,Seeds);
            Cards[(Step div 2)].Tag:=1;
            AddDetail(not MeFirst,Seeds);
          end;
          Inc(Step);
          Inc(CurrCard);
        end;
      end;
  25: begin
        if (Seeds=CurrCard)or(Seeds=CurrCard+13)or(Seeds=CurrCard+26)or(Seeds=CurrCard+39) then
        begin
          ListBox1.Items.Add('　　　     　※最终大结局出来啦※');
          Cards[27].BringToFront;
          drawcard(Cards[27].Picture.Bitmap,Seeds);
          Cards[27].Tag:=1;
          AddDetail(MeFirst,Seeds);
          Inc(Step);
        end;
      end;
  26: begin
       timer1.Enabled:=false;
//       ListBox1.Items.Append('            #######测试完成#######');
       BB_Pause.Enabled:=false;
      end;
  end;
end;

procedure Tfrm_main.Timer1Timer(Sender: TObject);
begin
  Randomize;
  Seeds:=Random(54);
  CurrCards;
  drawcard(Image1.Picture.Bitmap,Seeds);
end;

procedure Tfrm_main.BB_ExitClick(Sender: TObject);
begin
  Close;
end;

procedure Tfrm_main.BB_PauseClick(Sender: TObject);
begin
  timer1.Enabled:=not timer1.Enabled;
  if timer1.Enabled then BB_Pause.Caption:='暂停' else
    BB_Pause.Caption:='继续';
end;

procedure Tfrm_main.BB_ResetClick(Sender: TObject);
var
  i:byte;
begin
  for i:=0 to 27 do
  begin
    Cards[i].Picture.Assign(nil);
    Cards[i].Tag:=0;
  end;
//  Step:=0;
  MeFirst:=false;
  ListBox1.Items.Clear;
  ListBox1.Items.Add('                ☆纸牌算命罗☆');
  timer1.Enabled:=false;
  RadioGroup1.Enabled:=true;
  BB_Pause.Enabled:=false;
  BB_Start.Enabled:=true;
end;

procedure Tfrm_main.RadioGroup2Click(Sender: TObject);
begin
  Case RadioGroup2.ItemIndex of
  0:  Timer1.Interval:=500;
  1:  Timer1.Interval:=100;
  2:  Timer1.Interval:=1;
  end;
end;

procedure Tfrm_main.BB_AboutClick(Sender: TObject);
begin
  ShowMessage('孜孜作品 - 2000年12月'+#13+' 网址:www.tenew.com');
end;

procedure Tfrm_main.FormCreate(Sender: TObject);
var
  i:byte;
begin
  for i:=0 to 27 do
  begin
    Cards[i]:=TImage.Create(Self);
    with cards[i] do
    begin
      parent:=frm_main;
      width:=71;
      height:=96;
      if i<14 then
      begin
        Top:=I*30+24;
        Left:=16;
      end else
      begin
        Top:=(I-14)*30+24;
        Left:=104;
      end;
      if i=27 then
      begin
        Top:=408;
        Left:=60;
      end;
      transparent:=true;
//      AutoSize:=true;
      visible:=true;
      Tag:=0;
    end;
  end;
end;

procedure Tfrm_main.FormClose(Sender: TObject; var Action: TCloseAction);
var
  i:byte;
begin
  for i:=0 to 27 do
  begin
    Cards[i].Free;
  end;
end;

end.