Добро пожаловать на Форум SoftWeb.ru.
 
Зима

Нам нужна Ваша поддержка. Сбор средств на оплату дата-центра.

Форум SoftWeb.ru » Интернет » Программирование » Делаем программы вместе » Игра "Дурак"

Делаем программы вместе Коллективное создание программ

ОТВЕТИТЬ
Старый 02.01.2008, 22:29   #21
 
Статус: Гость
Сообщений: n/a
По умолчанию Re: Игра "Дурак"

да было тяжело но всетаки я его сделал ))
  ЦИТИРОВАТЬ
Объявление
Нам нужна Ваша поддержка. Сбор средств на оплату дата-центра.
Старый 02.01.2008, 22:37   #22
 
Статус: Гость
Сообщений: n/a
По умолчанию Re: Игра "Дурак"

лгоритм:
1. Создаем новую игру.
2. Выделяем масть "козырь".
3. Находим на "руках" младшую карту этой масти.
4. Начинает играть тот, у кого это младшая карта.
все запутано
  ЦИТИРОВАТЬ
Старый 03.01.2008, 00:13   #23
 
Статус: Гость
Сообщений: n/a
По умолчанию Re: Игра "Дурак"

БилГейтс, где скачать можно?
  ЦИТИРОВАТЬ
Старый 31.03.2008, 17:53   #24
 
Статус: Гость
Сообщений: n/a
По умолчанию Re: Игра "Дурак"

Тебе мой исходник???
  ЦИТИРОВАТЬ
Старый 31.03.2008, 23:48   #25
 
Статус: Гость
Сообщений: n/a
По умолчанию Re: Игра "Дурак"

exe'шник. Посмотреть, что получилось.
  ЦИТИРОВАТЬ
Старый 17.12.2008, 18:02   #26
 
Статус: Гость
Сообщений: n/a
По умолчанию Re: Игра "Дурак"

выложите исходник,посмотреть,пжалста
  ЦИТИРОВАТЬ
Старый 26.02.2009, 14:45   #27
 
Статус: Старшина
Регистрация: 30.01.2007
Сообщений: 145
СПАСИБО: 19
сказали Спасибо 66 раз(а) в 57 сообщении
Получено наград:
По умолчанию Re: Игра "Дурак"

Так где этот плод творческих мук. Как все это заценить?
victorvolkov вне форума   ЦИТИРОВАТЬ
Старый 20.03.2009, 12:05   #28
 
Статус: Гость
Сообщений: n/a
По умолчанию Re: Игра "Дурак"

три страницы текста... а программы нету...
  ЦИТИРОВАТЬ
Старый 25.03.2009, 20:29   #29
 
Статус: Гость
Сообщений: n/a
По умолчанию Re: Игра "Дурак"

кароч, над будет использовать библиотеку, код я завтра выложу, и модуль карты ) а вы сами скачайте библиотеку
главное там искуственный интелект

Последний раз редактировалось БилГейтс; 25.03.2009 в 20:35.
  ЦИТИРОВАТЬ
Старый 02.04.2009, 14:07   #30
 
Статус: Гость
Сообщений: n/a
По умолчанию Re: Игра "Дурак"

вот код, отсюда мона будет взять модуль + алгоритм хода компа, ну наверно разберетесь, да кстати модуль RXLib2_75XP
Код:
unit MainWin;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Menus, MMSystem, Buttons, CardsUnit;
type
  set36=set of 1..36;
  TMainFrm = class(TForm)
    MainMenu: TMainMenu;
    N1: TMenuItem;
    StartMI: TMenuItem;
    N3: TMenuItem;
    ExitMI: TMenuItem;
    N2: TMenuItem;
    AboutMI: TMenuItem;
    N4: TMenuItem;
    OkBtn: TBitBtn;
    MsgPanel: TPanel;
    K1MI: TMenuItem;
    K2MI: TMenuItem;
    K3MI: TMenuItem;
    K4MI: TMenuItem;
    RandMI: TMenuItem;
    N6: TMenuItem;
    K5MI: TMenuItem;
    SbrosMI: TMenuItem;
    ColorDesk: TMenuItem;
    N5: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ExitMIClick(Sender: TObject);
    procedure OkBtnClick(Sender: TObject);
    procedure StartMIClick(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure AboutMIClick(Sender: TObject);
    procedure SndMIClick(Sender: TObject);
    procedure K1MIClick(Sender: TObject);
    procedure ColorDeskClick(Sender: TObject);
    procedure RandMIClick(Sender: TObject);
    procedure MsgPanelDblClick(Sender: TObject);

  private
    Karta:array[1..36]of TCardImg;
    MastIco:array[0..3]of TIcon;
    Koloda,Sbros:array[1..36]of byte;
    Set1,Set2,SetKoz,SetSbros:set36;
    kol_v,kol_y,ostalos,kol_sbr,dobav:byte;
    CompImg,FonImg:TBitmap;
    You_vin,Comp_vin:integer;
    procedure Izobr;
    procedure Izobr_y;
    procedure CompHod;
    procedure Vibor(Kar:TObject);
    procedure MyDblClick(Kar:TObject);
    function AddKart(Comp:boolean):boolean;
    procedure RefrPanel(k:byte);
    function ReturnMno(NomKar:byte):set36;
    procedure OutText(S:string);
    procedure OutFon;
    procedure LoadCardPict(NomKol:byte);
  public
    OblozImg:TBitmap;
  end;
var
  MainFrm: TMainFrm;
  SndOk,AnimOk:boolean;
implementation
uses AboutWin, SbrosWin, RxGIF;
{$R *.DFM}
const
  h1=240; h2=h1+10;

procedure TMainFrm.FormCreate(Sender: TObject);
var
  i:byte;
begin
  SndOk:=true; AnimOk:=true;
  kol_y:=0; kol_v:=0; kol_sbr:=0; You_vin:=0; Comp_vin:=0;
  SetSbros:=[];

  CompImg:=TBitmap.Create; //Холст для рисования
  with CompImg.Canvas.Font do
  begin
    Name:='Amsterdam_vp';
    Style:=[fsbold,fsitalic];
  end;

  try
    FonImg:=TBitmap.Create;
    FonImg.LoadFromFile('Desk.bmp'); //фоновый рисунок
  except
    FonImg.Free;
    FonImg:=nil;
    ShowMessage('Не найден рисунок фона - файл "Desk.bmp"');
  end;

  with CompImg do
  begin
    Width:=ClientWidth;
    Height:=ClientHeight-MsgPanel.Height;
//    OutFon; OutText('"Дураки"');
  end;

  OblozImg:=TBitmap.Create;  OblozImg.Transparent:=true;
  AllCardBm:=TBitmap.Create;
  CardBm:=TBitmap.Create;    CardBm.Transparent:=true;

  Randomize;

  for i:=1 to 36 do
  begin
    Karta[i]:=TCardImg.Create(Self); //создаём объекты
    with Karta[i] do
    begin
      Parent:=Self;    //Установка родителя
      Cursor:=1;
      Hide;
      OnClick:=Vibor;  //нажатие кнопки
      Nomer:=i;
    end;
  end;

  for i:=0 to 3 do
  begin
    MastIco[i]:=TIcon.Create;
    MastIco[i].Handle:=LoadIcon(hInstance,PChar('ICO'+inttostr(i+1)));
  end;

  if not RandMI.Checked then K1MIClick(Application);
  OutText('"Дураки"');
end;

procedure TMainFrm.Izobr;
var
  i:byte;
  l,delta:integer;
begin
  with CompImg.Canvas do
  begin
    OutFon;
    l:=10;

    if kol_v>6 then delta:=round((490-CardW-l)/kol_v) else delta:=80;
    for i:=1 to kol_v do   //отображение карт компа
    begin
      Draw(l,5,OblozImg);
      inc(l,delta);
    end;
    if ostalos>0 then      //отображение колоды
    begin
      DrawCard(490,5,Koloda[1],CompImg.Canvas);  //козырная карта
      if ostalos>1 then
      for i:=1 to ostalos-1 do Draw(510+(i-1)*2,5+i*2,OblozImg);
    end;
    for i:=1 to kol_sbr do DrawCard(10+(i-1)*15,125,Sbros[i],CompImg.Canvas);
  end;
  OnPaint(Self);
end;

procedure TMainFrm.Vibor(Kar: TObject);
var
  i:byte;
begin
  for i:=1 to 36 do
  if Kar=Karta[i] then
  begin
    if Karta[i].Top=h1 then  //если карта уже приподнята
    begin
      MyDblClick(Kar);
      exit;
    end
    else Karta[i].Top:=h1; //приподнимаем карту
  end
  else if i in Set1 then Karta[i].Top:=h2; //отпускаем карту
end;

procedure TMainFrm.FormDestroy(Sender: TObject);
var
  i:byte;
begin
  OblozImg.Free;
  CompImg.Free;
  CardBm.Free;
  if FonImg<>nil then FonImg.Free;
  for i:=1 to 36 do Karta[i].Free;
  for i:=0 to 3 do MastIco[i].Free;
end;

procedure TMainFrm.ExitMIClick(Sender: TObject);
begin
  Close;
end;

procedure TMainFrm.Izobr_y;
var
  i:byte;
  l,delta:integer;
begin
  l:=10;
  if kol_y>6 then delta:=round((OkBtn.Left-CardW-l)/kol_y) else delta:=80;
  for i:=1 to 36 do
  with Karta[i] do
  begin
    if i in Set1 then
    begin
      Top:=h2;
      Left:=l;
      inc(l,delta);
    end;
    Visible:=i in Set1;
  end;
end;

procedure TMainFrm.StartMIClick(Sender: TObject);
var
  i,j,k,nom,min,Kozir:byte;
  Hod:boolean;
begin
  if RandMI.Checked then K1MIClick(Application);

  for i:=1 to 36 do Koloda[i]:=i; //установка по порядку
  for i:=36 downto 1 do //замес массива
  begin
    nom:=random(i)+1;
    k:=Koloda[nom];
    for j:=nom to i-1 do Koloda[j]:=Koloda[j+1];
    Koloda[i]:=k;
  end;
  ostalos:=24;kol_y:=6;kol_v:=6;kol_sbr:=0;
  Set1:=[];Set2:=[];SetKoz:=[];SetSbros:=[];
  Kozir:=Koloda[1] mod 4;
  Icon.Handle:=MastIco[Kozir].Handle;
  for i:=1 to 36 do if i mod 4=Kozir then include(SetKoz,i);
  Hod:=true;min:=37;
  for i:=36 downto 31 do
  begin
    if (Koloda[i] in SetKoz)and(Koloda[i]<min) then min:=Koloda[i];
    include(Set1,Koloda[i]);
  end;
  for i:=30 downto 25 do
  begin
    if (Koloda[i] in SetKoz)and(Koloda[i]<min) then Hod:=false;
    include(Set2,Koloda[i]);
  end;
  Izobr_y;Izobr;
  if Hod then RefrPanel(1) else CompHod;
end;

procedure TMainFrm.OkBtnClick(Sender: TObject);
procedure Bery;
var
  i,j,KolKart:byte;
  SbrSet,mno:set36;
begin
  KolKart:=kol_y-1; //сколько карт можно добавить игроку
  SbrSet:=[];
  for j:=1 to kol_sbr do
  begin
    mno:=ReturnMno(Sbros[j]);
    for i:=1 to 36 do
    if (i in Set2)and(i in mno)and not(i in SetKoz) then include(SbrSet,i);
  end;
  for i:=1 to 36 do
  if (i in SbrSet)and(KolKart>0) then
  begin
    exclude(Set2,i);
    dec(kol_v);dec(KolKart);inc(kol_sbr);
    Sbros[kol_sbr]:=i;
  end;
  for i:=1 to kol_sbr do
  begin
    include(Set1,Sbros[i]);
    inc(kol_y);
  end;

  kol_sbr:=0;
  if AddKart(true) then CompHod;  //Ход компа
end;

procedure AddComp;
var
  i:byte;
begin
  for i:=1 to kol_sbr do
  begin
    include(Set2,Sbros[i]);
    inc(kol_v);
  end;

  kol_sbr:=0;
  if AddKart(false) then RefrPanel(1);
end;
begin
  case OkBtn.Tag of
    0:StartMIClick(Sender);           //новая игра
    1:if AddKart(false) then CompHod; //бито, передача хода компу
    2:Bery;                           //беру
    3:AddComp;                        //всё - комп берёт
  end;
end;

procedure TMainFrm.MyDblClick(Kar: TObject);
var
  i,NomKar:byte;
  mno:set36;
  HodOk:boolean;
procedure CompOtbiv;
var
  i,NomKar:byte;              
begin
  dec(dobav);
  if OkBtn.Tag=3 then exit; //если комп берёт
  NomKar:=0;
  if Sbros[kol_sbr] in SetKoz then //если последняя карта козырная
  for i:=1 to 36 do
  begin
    if (i in Set2)and(i in SetKoz)and(i>Sbros[kol_sbr]) then
    begin
      NomKar:=i;break;
    end;
  end
  else
  begin
    for i:=1 to 36 do
    if (i in Set2)and(i mod 4=Sbros[kol_sbr] mod 4)and(i>Sbros[kol_sbr]) then
    begin
      NomKar:=i;break;
    end;
    if NomKar=0 then
    for i:=1 to 36 do
    if (i in Set2)and(i in SetKoz) then
    begin
      NomKar:=i;break;
    end;
  end;
  if NomKar>0 then
  begin
    exclude(Set2,NomKar);
    inc(kol_sbr);dec(kol_v);
    Sbros[kol_sbr]:=NomKar;
    izobr;

  end
  else RefrPanel(3); //карт для отбивки нет, обновляем панель
end;

procedure AddSbros(NomKar:byte);
begin
  exclude(Set1,NomKar);
  inc(kol_sbr);dec(kol_y);
  Sbros[kol_sbr]:=NomKar;
  izobr_y;izobr;

end;
begin
  NomKar:=0;
  for i:=1 to 36 do
  if Kar=Karta[i] then
  begin
    NomKar:=i;break;
  end;
  if NomKar=0 then exit; //на всякий случай
  case OkBtn.Tag of
  1,3:begin       //ход или добавление
        if kol_sbr=0 then    //первый ход
        begin
          AddSbros(NomKar);CompOtbiv;OkBtn.Show;
        end
        else
        begin
          mno:=ReturnMno(NomKar);
          for i:=1 to kol_sbr do
          if Sbros[i] in mno then
          begin
            AddSbros(NomKar);CompOtbiv;break;
          end;
        end;
        if (dobav=0)or(kol_y=0) then OkBtn.Click;
      end;
  2:begin  //отбивание игрока
      if Sbros[kol_sbr] in SetKoz then
        HodOk:=(NomKar>Sbros[kol_sbr])and(NomKar in SetKoz)
      else HodOk:=((NomKar>Sbros[kol_sbr])
                  and(NomKar mod 4=Sbros[kol_sbr] mod 4))
                  or(NomKar in SetKoz);
      if HodOk then //если ход принят
      begin
        AddSbros(NomKar);CompHod;
      end;
    end;
  end;
end;

procedure TMainFrm.CompHod;
var
  i,j,NomKar:byte;
  SbrSet,mno:set36;
procedure AddSbros(NomKar:byte);
begin
  exclude(Set2,NomKar);
  inc(kol_sbr);dec(kol_v);
  Sbros[kol_sbr]:=NomKar;
  izobr;

end;

procedure HodIgroka;
begin
  if AddKart(true) then RefrPanel(1);
end;
begin
  if (kol_y=0)or(kol_v=0) then HodIgroka
  else
  if kol_sbr=0 then      //первый ход
  begin
    RefrPanel(2);        //обновляем панель
    NomKar:=0;
    for i:=1 to 36 do
    if (i in Set2)and not(i in SetKoz) then
    begin
      NomKar:=i;break;
    end;
    if NomKar=0 then
    for i:=1 to 36 do
    if i in Set2 then
    begin
      NomKar:=i;break;
    end;
    AddSbros(NomKar);
  end
  else
  begin
    SbrSet:=[];
    for j:=1 to kol_sbr do
    begin
      mno:=ReturnMno(Sbros[j]);
      for i:=1 to 36 do
      if (i in Set2)and(i in mno)and not(i in SetKoz) then include(SbrSet,i);
    end;
    if SbrSet=[] then HodIgroka
    else
      for i:=1 to 36 do
      if i in SbrSet then
      begin
        AddSbros(i);break;
      end;
  end;
end;

function TMainFrm.ReturnMno(NomKar: byte): set36;
begin
  case NomKar of
    1..4:  Result:=[1..4];   //6
    5..8:  Result:=[5..8];   //7
    9..12: Result:=[9..12];  //8
    13..16:Result:=[13..16]; //9
    17..20:Result:=[17..20]; //10
    21..24:Result:=[21..24]; //В
    25..28:Result:=[25..28]; //К
    29..32:Result:=[29..32]; //Д
    33..36:Result:=[33..36]; //Т
  end;
end;

procedure TMainFrm.FormPaint(Sender: TObject);
begin
  Canvas.Draw(0,0,CompImg); //выводим изображение на канву формы
end;

procedure TMainFrm.AboutMIClick(Sender: TObject);
begin
  Application.CreateForm(TAboutFrm, AboutFrm);

  AboutFrm.ShowModal;

  AboutFrm.Free;
end;

procedure TMainFrm.SndMIClick(Sender: TObject);
begin
  SndOk:=not SndOk;//SndMI.Checked:=SndOk;
end;

procedure TMainFrm.RefrPanel(k: byte);
var
  s1,s2:string;
begin
  OkBtn.Tag:=k;OkBtn.Visible:=k<>1;
  case k of
    0:begin
        s1:='Новая игра (Ф5)';s2:='Старт';
      end;
    1:begin
        s1:='Ваш ход...';s2:='Бито';
        dobav:=kol_v;  //сколько карт можно дать компу
      end;
    2:begin
        s1:='Ход противника. Отбивайтесь...';s2:='Беру';
      end;
    3:begin
        s1:='Беру. Добавляйте...';s2:='Всё, нету...';
      end;
  end;
  MsgPanel.Caption:=s1; OkBtn.Caption:=s2;
end;

procedure TMainFrm.OutText(S:string);
var
  x,y:integer;
begin
  with CompImg.Canvas do
  begin
    Brush.Style:=bsClear;
    Font.Size:=50;
    while textwidth(S)<=ClientWidth-100 do Font.Size:=Font.Size+10;
    x:=(width-textwidth(S))div 2; y:=(height-textheight(S))div 2-50;
    Font.Color:=clBlack;   textout(x,y,S);
    Font.Color:=clBlue;    textout(x+1,y+1,S);
  end;
end;

function TMainFrm.AddKart(Comp: boolean):boolean;
var
  iz:boolean;
  i:byte;
procedure Plus_v;
begin
  iz:=true;
  while (kol_v<6)and(ostalos>0) do
  begin
    iz:=false;
    include(Set2,Koloda[ostalos]);
    inc(kol_v);dec(ostalos);
    if AnimOk then
    begin
      Izobr;
    end;
  end;
  if iz or not AnimOk then Izobr;
end;

procedure Plus_y;
begin
  while (kol_y<6)and(ostalos>0) do
  begin
    include(Set1,Koloda[ostalos]);
    inc(kol_y);dec(ostalos);

  end;
  Izobr; Izobr_y;
end;

procedure OutResultat;
var
  i,l,delta:integer;
  nomer:byte;
begin
  OutFon;
  if (kol_v=0)and(kol_y=0) then
  begin
    OutText('Ничья!!!');nomer:=1;
  end
  else if kol_v=0 then
  begin
    OutText('Проигрыш!!!');nomer:=2;inc(Comp_vin);
  end
  else
  with CompImg.Canvas do
  begin
    OutText('Победа!!!');nomer:=3;inc(You_vin);
    l:=10;
    if kol_v>6 then delta:=round((Width-CardW-l)/kol_v)
    else delta:=80;
    for i:=1 to 36 do
    if i in Set2 then
    begin
      DrawCard(l,5,i,CompImg.Canvas);
      inc(l,delta);
    end;
  end;
  OnPaint(Self);RefrPanel(0);
  Caption:=format('Игра в "Дурака" Счёт - %d:%d',[You_vin,Comp_vin]);
end;
begin
  for i:=1 to kol_sbr do include(SetSbros,Sbros[i]);
  kol_sbr:=0;
  if Comp then
  begin
    Plus_v;Plus_y;
  end
  else
  begin
    Plus_y;Plus_v;
  end;
  iz:=(kol_v=0)or(kol_y=0);
  if iz then OutResultat;
  Result:=not iz;
end;

procedure TMainFrm.OutFon;
var
  x,y:Integer;
begin
  with CompImg.Canvas do
  begin
    if not ColorDesk.Checked or (FonImg=nil)then
    begin
      Brush.Color:=clgreen;
      FillRect(ClipRect);
      exit;
    end;
    y:=0;
    while y<Height do
    begin
      x:=0;
      while x<Width do
      begin
        Draw(x,y,FonImg);
        x:=x+FonImg.Width;
      end;
      y:=y+FonImg.Height;
    end;
  end;
end;

procedure TMainFrm.K1MIClick(Sender: TObject);
var
  i:byte;
begin
  //(Sender as TMenuItem).Checked:=true;
  if Sender is TMenuItem then LoadCardPict((Sender as TMenuItem).Tag)
  else LoadCardPict(Random(5)+1);

  for i:=1 to 36 do
  begin
    Karta[i].RefreshRgn;
    Karta[i].Repaint;
  end;
  izobr; izobr_y; OnPaint(Self);
end;

procedure TMainFrm.LoadCardPict(NomKol:byte);
procedure LoadAllCards(S1,S2:string;R:integer);
var
  GifImg:TGifImage;
begin
  GifImg:=TGifImage.Create;
  GifImg.LoadFromResourceName(HINSTANCE,S1,'GIF');
  CardH:=GifImg.Height; CardW:=GifImg.Width;
  if R=5 then CardR:=9 else CardR:=16;
  {OblozImg.Width:=CardW; OblozImg.Height:=CardH;
  OblozImg.Canvas.Draw(0,0,GifImg);}
 OblozImg.Assign(GifImg);
  OblozImg.Transparent:=true;
  GifImg.LoadFromResourceName(HINSTANCE,S2,'GIF');
  {  AllCardBm.Width:=GifImg.Width; AllCardBm.Height:=GifImg.Height;
  AllCardBm.Canvas.Draw(0,0,GifImg);}
  AllCardBm.Assign(GifImg);
  GifImg.Free;
  CardBm.Width:=CardW; CardBm.Height:=CardH;
end;
begin
  LoadAllCards('O'+inttostr(NomKol),'K'+inttostr(NomKol),NomKol);
  case NomKol of
    1:K1MI.Checked:=true;
    2:K2MI.Checked:=true;
    3:K3MI.Checked:=true;
    4:K4MI.Checked:=true;
    5:K5MI.Checked:=true;
  end;
end;

procedure TMainFrm.ColorDeskClick(Sender: TObject);
begin
  ColorDesk.Checked:=not ColorDesk.Checked;
  izobr; izobr_y; OnPaint(Self);
end;

procedure TMainFrm.RandMIClick(Sender: TObject);
begin
  RandMI.Checked:=not RandMI.Checked;
end;

procedure TMainFrm.MsgPanelDblClick(Sender: TObject);
var
  i:byte;
begin
  LoadCardPict(6);
  for i:=1 to 36 do
  begin
    Karta[i].RefreshRgn;
    Karta[i].Repaint;
  end;
  izobr; izobr_y; OnPaint(Self);
end;


end.
Код:
unit CardsUnit;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls;
var
  CardH,CardW,CardR:integer;
  AllCardBm:TBitmap;
  CardBm:TBitmap;
const
  CardCount=9;
type
  TCardImg = class(TButton)
  private
    IsFocused:boolean;
    Canvas:TCanvas;
    procedure CNDrawItem(var Msg:TWMDrawItem);message cn_DrawItem;
    procedure WMLButtonDblClk(var Message:TWMLButtonDblClk);message wm_LButtonDblClk;
  protected
    procedure CreateWnd;override;
    procedure CreateParams(var Params:TCreateParams);override;
    procedure SetButtonStyle(ADefault:boolean);override;
  public
    Nomer:byte;
    constructor Create(AOwner:TComponent);override;
    destructor Destroy;override;
    procedure RefreshRgn;
  end;
procedure DrawCard(x,y:integer;CardNo:byte;Canvas:TCanvas);
implementation
procedure DrawCard(x,y:integer;CardNo:byte;Canvas:TCanvas);
var
  i,j:byte;
begin
  i:=CardNo mod 4; j:=(CardNo-1) div 4;
  CardBm.Canvas.CopyRect(Rect(0,0,CardW,CardH),AllCardBm.Canvas,
                         Rect(j*CardW,i*CardH,(j+1)*CardW,(i+1)*CardH));
  Canvas.Draw(x,y,CardBm);
end;
procedure TCardImg.CNDrawItem(var Msg: TWMDrawItem);
begin
  Canvas.Handle:=Msg.DrawItemStruct^.hDC;
  DrawCard(0,0,Nomer,Canvas);
  if Focused then Canvas.DrawFocusRect(Rect(3,3,CardW-3,CardH-3));
end;
constructor TCardImg.Create(AOwner: TComponent);
begin
  inherited;
  Canvas:=TCanvas.Create;
end;
procedure TCardImg.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do Style:=Style or BS_OWNERDRAW;
end;
procedure TCardImg.CreateWnd;
begin
  inherited;
  RefreshRgn;
end;
destructor TCardImg.Destroy;
begin
  inherited;
  Canvas.Free;
end;
procedure TCardImg.RefreshRgn;
var
  CardRgn:THandle;
begin
  SetBounds(Left,Top,CardW,CardH);
  CardRgn:=CreateRoundRectRgn(0,-1,CardW+1,CardH+1,CardR,CardR);
  SetWindowRgn(Handle,CardRgn,true);
end;
procedure TCardImg.SetButtonStyle(ADefault: boolean);
begin
  if ADefault<>IsFocused then
  begin
    IsFocused:=ADefault;
    Invalidate;
  end;
end;
procedure TCardImg.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
  Perform(WM_LBUTTONDOWN,Message.Keys,LongInt(Message.Pos));
end;
end.
  ЦИТИРОВАТЬ
Объявление
Нам нужна Ваша поддержка. Сбор средств на оплату дата-центра.
ОТВЕТИТЬ


Здесь присутствуют: 1 (пользователей: 0 , гостей: 1)
 
Опции темы
Опции просмотра

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Игра "Продолжи фразу..." Enix ФорумАльные игры 117 05.05.2015 17:01
как называется игра "продолжение" DOTa. n1mnull Strategy/Wargame 2 08.09.2011 00:45
Игра-симулятор "Русский Бильярд" Stas76 Заливаем и качаем игры 5 23.08.2009 00:35
"Игра Слов" Faetongold Мини-игры 0 16.12.2007 15:00
Игра "Нечто" Vanekpunk Обсуждение и вопросы по играм 3 18.04.2005 18:37


Часовой пояс GMT +3, время: 13:13.

Нам нужна Ваша поддержка. Сбор средств на оплату дата-центра.
Яндекс цитирования