Текущий архив: 2003.08.21;
Скачать: CL | DM;

Вниз

Игральные карты   Найти похожие ветки 

← →
@@lex   (2003-08-06 10:28) [0]

Подскажите пожалуйста каким макаром выдернуть картинки стандартных виндошных карт.

---

← →
Palladin ©   (2003-08-06 10:58) [1]

Обрати внимание на свою папку %Delphi%\Demos
там есть такая Demo называется ResXplor

вперед и с песней

---

← →
Vlad Oshin ©   (2003-08-06 10:58) [2]

card.dll раздраконить

---

← →
Карелин Артем ©   (2003-08-06 11:21) [3]

PrintScreen бутон.

---

← →
vvvvvvvvv   (2003-08-06 12:13) [4]

Это кусок из сетевого преферанса, описанного в книге Дарахвелидзе и Маркова. Раньше вроде работало.


unit cards;

interface
uses Classes, Messages, Graphics, ExtCtrls;
type
TSuit = (sNone, sSpade, sClub, sDiamond, sHeart);
TWeight = (t7, t8, t9, t10, tJack, tQueen, tKing, tAce);

TCard = class(TShape)
private
FSuit : TSuit; //масть
FWeight : TWeight; //
FKnown : boolean;
FBitmap : Graphics.TBitmap;
protected
procedure WndProc(var Message: TMessage); override;
procedure Paint; Override;
public
constructor Create(AOwner:TComponent;S:TSuit;W:TWeight);
function GetOrder:Integer;
//procedure SetOrder(i:Integer);
procedure SetKnown(bk: boolean);
function GetCardName: string;
{}
property Suit: TSuit read FSuit write FSuit;
property Weight: TWeight read FWeight write FWeight;
property Order : Integer read GetOrder;// write SetOrder;
property CardName : string read GetCardName;
property Known: boolean read FKnown write SetKnown;
property OnClick;
property OnDblClick;
end;

TCardsList = class(TStringList)
private
function GetCard(Index: Integer): TCard;
procedure SetCard(Index: Integer; Item: TCard);
public
property Items[Index: Integer]: TCard read GetCard write SetCard; default;
end;

const {font must be "Symbol"}
SuitName : array [TSuit] of string = (" ",chr(170),chr(167),chr(168),chr(169));
SuitLongName : array [TSuit] of string = (" ","Пик","Треф","Бубен","Червей");

SuitColor : array [TSuit] of TColor = (clBlack, clBlack,clBlack,clRed,clRed);
WeightName : array [TWeight] of string = ("7","8","9","10","J","Q","K","A");

CardWidth : Integer = 50;
CardHeight : Integer = 70;

implementation
uses Windows, SysUtils, Controls;

var CardsDll : THandle;
BackBitmap : Graphics.TBitmap;

constructor TCard.Create(AOwner:TComponent;S:TSuit;W:TWeight);
var tw,ts: Integer;
begin
Inherited Create(AOwner);
FSuit := s;
FWeight := W;
FKnown := False;
Shape := stRoundRect;
Height := CardHeight;
Width := CardWidth;
Name := "C"+IntToStr(Order);
DragMode := dmAutomatic;
Canvas.Font.Name := "Symbol";
FBitmap := Graphics.TBitmap.Create;
ts := (Ord(Suit) + 2) mod 4;
tw := Ord(Weight) + 7; if tw=14 then tw:=1;
FBitmap.LoadFromResourceID(CardsDll,ts*13+tw);
//if FBitmap.
end;

procedure TCard.WndProc(var Message: TMessage);
begin
if Message.Msg=WM_LBUTTONDBLCLK then
Dispatch(Message) else
inherited;
end;

procedure TCard.Paint;
begin
if Known then
Canvas.StretchDraw(ClientRect,FBitmap)
else
Canvas.StretchDraw(ClientRect,BackBitmap)
end;


function TCard.GetOrder:Integer;
begin
Result := (Integer(Suit)-1)*8+Integer(Weight);
end;

procedure TCard.SetKnown(bk: boolean);
begin
if bk <> FKnown then
begin
FKnown := bk;
( Index: Integer) Это кусок из сетевого преферанса, описанного в книге Дарахвелидзе и Маркова. Раньше вроде работало.


unit cards;

interface
uses Classes, Messages, Graphics, ExtCtrls;
type
TSuit = (sNone, sSpade, sClub, sDiamond, sHeart);
TWeight = (t7, t8, t9, t10, tJack, tQueen, tKing, tAce);

TCard = class(TShape)
private
FSuit : TSuit; //масть
FWeight : TWeight; //
FKnown : boolean;
FBitmap : Graphics.TBitmap;
protected
procedure WndProc(var Message: TMessage); override;
procedure Paint; Override;
public
constructor Create(AOwner:TComponent;S:TSuit;W:TWeight);
function GetOrder:Integer;
//procedure SetOrder(i:Integer);
procedure SetKnown(bk: boolean);
function GetCardName: string;
{}
property Suit: TSuit read FSuit write FSuit;
property Weight: TWeight read FWeight write FWeight;
property Order : Integer read GetOrder;// write SetOrder;
property CardName : string read GetCardName;
property Known: boolean read FKnown write SetKnown;
property OnClick;
property OnDblClick;
end;

TCardsList = class(TStringList)
private
function GetCard(Index: Integer): TCard;
procedure SetCard(Index: Integer; Item: TCard);
public
property Items[Index: Integer]: TCard read GetCard write SetCard; default;
end;

const {font must be "Symbol"}
SuitName : array [TSuit] of string = (" ",chr(170),chr(167),chr(168),chr(169));
SuitLongName : array [TSuit] of string = (" ","Пик","Треф","Бубен","Червей");

SuitColor : array [TSuit] of TColor = (clBlack, clBlack,clBlack,clRed,clRed);
WeightName : array [TWeight] of string = ("7","8","9","10","J","Q","K","A");

CardWidth : Integer = 50;
CardHeight : Integer = 70;

implementation
uses Windows, SysUtils, Controls;

var CardsDll : THandle;
BackBitmap : Graphics.TBitmap;

constructor TCard.Create(AOwner:TComponent;S:TSuit;W:TWeight);
var tw,ts: Integer;
begin
Inherited Create(AOwner);
FSuit := s;
FWeight := W;
FKnown := False;
Shape := stRoundRect;
Height := CardHeight;
Width := CardWidth;
Name := "C"+IntToStr(Order);
DragMode := dmAutomatic;
Canvas.Font.Name := "Symbol";
FBitmap := Graphics.TBitmap.Create;
ts := (Ord(Suit) + 2) mod 4;
tw := Ord(Weight) + 7; if tw=14 then tw:=1;
FBitmap.LoadFromResourceID(CardsDll,ts*13+tw);
//if FBitmap.
end;

procedure TCard.WndProc(var Message: TMessage);
begin
if Message.Msg=WM_LBUTTONDBLCLK then
Dispatch(Message) else
inherited;
end;

procedure TCard.Paint;
begin
if Known then
Canvas.StretchDraw(ClientRect,FBitmap)
else
Canvas.StretchDraw(ClientRect,BackBitmap)
end;


function TCard.GetOrder:Integer;
begin
Result := (Integer(Suit)-1)*8+Integer(Weight);
end;

procedure TCard.SetKnown(bk: boolean);
begin
if bk <> FKnown then
begin
FKnown := bk;
Invalidate;
end;
end;

function TCard.GetCardName:string;
begin
Result := WeightName[Weight]+SuitName[Suit];
end;

{@|@|@|@|@|@|@|@|@|@|@|@|@|@|@|@|@}
function TCardsList.GetCard(Index: Integer): TCard;
begin
try
Result := Objects[Index] as TCard;
except
Result := nil;
end;
end;
procedure TCardsList.SetCard(Index: Integer; Item: TCard);
begin
if not Assigned(Item) then Exit;
Objects[Index] := Item;
end;

initialization
CardsDll := LoadLibraryEx("cards.dll",0, LOAD_LIBRARY_AS_DATAFILE);
BackBitmap := Graphics.TBitmap.Create;
BackBitmap.LoadFromResourceID(CardsDll,64);
finalization
BackBitmap.Free;
FreeLibrary(CardsDll);
end.

---

← →
Затейник - некрофил (клоны суксь)   (2003-08-06 14:00) [5]

В карты играть нехорошо. Азартная игра. Мнооооогих до добра не доводила.

---

← →
Danilka ©   (2003-08-06 14:05) [6]

А зачем их выдергивать? Они-же не порнографические.

---

Страницы: 1 вся ветка

Текущий архив: 2003.08.21;
Скачать: CL | DM;

Наверх

Память: 0.49 MB
Время: 0.014 c