cardpp.pas

《Delphi开发人员指南》配书原码

unit CardPP;

interface

uses SysUtils, Windows, Messages, Classes, Graphics, Controls, StdCtrls,
  ExtCtrls, Forms, ComServ, ComObj, StdVcl, AxCtrls, Buttons, Cards,
  AxCard_TLB;

type
  TCardPropPage = class(TPropertyPage)
    Card1: TCard;
    ValueGroup: TGroupBox;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    SpeedButton5: TSpeedButton;
    SpeedButton6: TSpeedButton;
    SpeedButton7: TSpeedButton;
    SpeedButton8: TSpeedButton;
    SpeedButton9: TSpeedButton;
    SpeedButton10: TSpeedButton;
    SpeedButton11: TSpeedButton;
    SpeedButton12: TSpeedButton;
    SuitGroup: TGroupBox;
    SpeedButton13: TSpeedButton;
    SpeedButton14: TSpeedButton;
    SpeedButton15: TSpeedButton;
    SpeedButton16: TSpeedButton;
    SpeedButton17: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
  public
    procedure UpdatePropertyPage; override;
    procedure UpdateObject; override;
  end;

const
  Class_CardPropPage: TGUID = '{C06EFEA1-06B2-11D1-A9BF-B18A9F703311}';

implementation

{$R *.DFM}

procedure TCardPropPage.UpdatePropertyPage;
var
  i: Integer;
  AValue, ASuit: Integer;
begin
  // get suit and value
  AValue := OleObject.Value;
  ASuit := OleObject.Suit;
  // set card correctly
  Card1.Value := TCardValue(AValue);
  Card1.Suit := TCardSuit(ASuit);
  // set correct value speedbutton
  with ValueGroup do
    for i := 0 to ControlCount - 1 do
      if (Controls[i] is TSpeedButton) and
        (TSpeedButton(Controls[i]).Tag = AValue) then
        TSpeedButton(Controls[i]).Down := True;
  // set correct suit speedbutton
  with SuitGroup do
    for i := 0 to ControlCount - 1 do
      if (Controls[i] is TSpeedButton) and
        (TSpeedButton(Controls[i]).Tag = ASuit) then
        TSpeedButton(Controls[i]).Down := True;
end;

procedure TCardPropPage.UpdateObject;
var
  i: Integer;
begin
  // set correct value speedbutton
  with ValueGroup do
    for i := 0 to ControlCount - 1 do
      if (Controls[i] is TSpeedButton) and TSpeedButton(Controls[i]).Down then
      begin
        OleObject.Value := TSpeedButton(Controls[i]).Tag;
        Break;
      end;
  // set correct suit speedbutton
  with SuitGroup do
    for i := 0 to ControlCount - 1 do
      if (Controls[i] is TSpeedButton) and TSpeedButton(Controls[i]).Down then
      begin
        OleObject.Suit := TSpeedButton(Controls[i]).Tag;
        Break;
      end;
end;

procedure TCardPropPage.FormCreate(Sender: TObject);
const
  // ordinal values of "suit" characters in Symbol font:
  SSuits: PChar = #167#168#169#170;
var
  i: Integer;
begin
  // set up captions of suit speedbuttons using high
  // characters in Symbol font
  with SuitGroup do
    for i := 0 to ControlCount - 1 do
      if Controls[i] is TSpeedButton then
        TSpeedButton(Controls[i]).Caption := SSuits[i];
end;

procedure TCardPropPage.SpeedButton1Click(Sender: TObject);
begin
  if Sender is TSpeedButton then
  begin
    with TSpeedButton(Sender) do
    begin
      if Parent = ValueGroup then
        Card1.Value := TCardValue(Tag)
      else if Parent = SuitGroup then
        Card1.Suit := TCardSuit(Tag);
    end;
    Modified;
  end;
end;

initialization
  TActiveXPropertyPageFactory.Create(
    ComServer,
    TCardPropPage,
    Class_CardPropPage);
end.