customvariantsu1.pas

这是用DELPHI做改变windows XP的主题的源代码

unit CustomVariantsU1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DBXpress, DB, SqlExpr, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    Memo1: TMemo;
    Button9: TButton;
    Button10: TButton;
    Button11: TButton;
    Button12: TButton;
    Button13: TButton;
    GroupBox1: TGroupBox;
    Memo2: TMemo;
    Button14: TButton;
    Button15: TButton;
    Button16: TButton;
    Button17: TButton;
    GroupBox2: TGroupBox;
    Memo3: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure Button10Click(Sender: TObject);
    procedure Button11Click(Sender: TObject);
    procedure Button12Click(Sender: TObject);
    procedure Button13Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button14Click(Sender: TObject);
    procedure Button15Click(Sender: TObject);
    procedure Button16Click(Sender: TObject);
    procedure Button17Click(Sender: TObject);
  private
    procedure SubProc(var vSuits: variant);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  SetOfSuitVariant;

procedure TForm1.Button1Click(Sender: TObject);
var
  vSuits: variant;
begin
  vSuits:=VarSetOfSuitsCreate([Hearts, Clubs]);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  vSuits1: variant;
  vSuits2: variant;
begin
  vSuits1:=VarSetOfSuitsCreate([Hearts, Clubs]);
  vSuits2:=VarSetOfSuitsCreate([Diamonds]);
  vSuits1:=vSuits2;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  vSuits: variant;
begin
  vSuits:=VarSetOfSuitsCreate([Hearts, Clubs]);
  Memo1.Lines.Add('The suits are: '+String(vSuits));
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  vSuits: variant;
begin
  vSuits:=VarSetOfSuitsCreate([Hearts, Clubs]);
  Memo1.Lines.Add(IntToStr(Integer(vSuits)));
end;

procedure TForm1.Button5Click(Sender: TObject);
var
  vSuits: variant;
begin
  vSuits:=VarSetOfSuitsCreate([Hearts, Clubs]);
  Memo1.Lines.Add('The suits are: '+vSuits);
end;

procedure TForm1.Button6Click(Sender: TObject);
var
  vSuits: variant;
begin
  vSuits:=VarSetOfSuitsCreate([Hearts, Clubs]);
  Memo1.Lines.Add(vSuits + 'Diamonds');
end;

procedure TForm1.Button7Click(Sender: TObject);
var
  vSuits: variant;
begin
  vSuits:=VarSetOfSuitsCreate([Hearts, Clubs]);
  Memo1.Lines.Add(vSuits + Diamonds);
end;

procedure TForm1.Button8Click(Sender: TObject);
var
  vSuits: variant;
begin
  vSuits:=VarSetOfSuitsCreate([Hearts, Clubs]);
  // poDefaultPosOnly has the ordinal value of 2 so it is treated the same as for Diamonds
  // which also has the ordinal value of 2
  Memo1.Lines.Add(vSuits + poDefaultPosOnly);
end;

procedure TForm1.Button9Click(Sender: TObject);
var
  vSuits: variant;
begin
  vSuits:=VarSetOfSuitsCreate([]);
  if VarIsClear(vSuits) then
    Memo1.Lines.Add('Clear')
  else
    Memo1.Lines.Add('Not Clear');

  if VarIsEmpty(vSuits) then
    Memo1.Lines.Add('Empty')
  else
    Memo1.Lines.Add('Not Empty');

  if VarIsNull(vSuits) then
    Memo1.Lines.Add('Null')
  else
    Memo1.Lines.Add('Not Null');
end;

procedure TForm1.Button10Click(Sender: TObject);
var
  vSuits: variant;
begin
  vSuits:=VarSetOfSuitsCreate([Hearts, Clubs]);
  SubProc(vSuits);
end;

procedure TForm1.SubProc(var vSuits: variant);
begin
  Memo1.Lines.Add(vSuits);
end;

procedure TForm1.Button11Click(Sender: TObject);
var
  vSuits: variant;
begin
  vSuits:=VarSetOfSuitsCreate([Hearts, Clubs]);
  vSuits:=- vSuits;
  Memo1.Lines.Add('The suits are: '+vSuits);
end;

procedure TForm1.Button12Click(Sender: TObject);
var
  vSuits1: variant;
  vSuits2: variant;
begin
  vSuits1:=VarSetOfSuitsCreate([Hearts, Clubs]);
  vSuits2:=VarSetOfSuitsCreate([Hearts, Clubs]);
  if vSuits1 = vSuits2 then
    Memo1.Lines.Add('Equal')
  else
    Memo1.Lines.Add('Not Equal');
end;

procedure TForm1.Button13Click(Sender: TObject);
var
  vSuits1: variant;
  vSuits2: variant;
begin
  vSuits1:=VarSetOfSuitsCreate([Hearts, Clubs]);
  vSuits2:=VarSetOfSuitsCreate([Diamonds, Spades]);
  if vSuits1 < vSuits2 then
    Memo1.Lines.Add('Less than')
  else
    Memo1.Lines.Add('Not less than');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  {$IFDEF SUPPORTSORDER}
  Button12.Enabled:=False;
  {$ELSE}
  Button13.Enabled:=False;
  {$ENDIF}
  {$IFDEF PUBLISHABLE}
  Button15.Enabled:=False;
  Button16.Enabled:=False;
  {$ELSE}
  Button17.Enabled:=False;
  {$ENDIF}
end;

procedure TForm1.Button14Click(Sender: TObject);
var
  vSuits: variant;
begin
  vSuits:=VarSetOfSuitsCreate([Hearts, Clubs]);
  vSuits.SaveToFile('Set.Txt');
end;

procedure TForm1.Button15Click(Sender: TObject);
var
  vSuits: variant;
begin
  vSuits:=VarSetOfSuitsCreate([Hearts, Clubs]);
  if vSuits.SaveAsXML then
    Memo1.Lines.Add('XML')
  else
    Memo1.Lines.Add('Default');
end;

procedure TForm1.Button16Click(Sender: TObject);
var
  vSuits: variant;
begin
  vSuits:=VarSetOfSuitsCreate([Hearts, Clubs]);
  vSuits.SaveAsXML:=True;
  if vSuits.SaveAsXML then
    Memo1.Lines.Add('XML')
  else
    Memo1.Lines.Add('Default');
end;

procedure TForm1.Button17Click(Sender: TObject);
var
  vSuits: variant;
begin
  vSuits:=VarSetOfSuitsCreate([Hearts, Clubs]);
  vSuits.IncludeJokers:=True;
  if vSuits.IncludeJokers then
    Memo1.Lines.Add('Jokers')
  else
    Memo1.Lines.Add('No Jokers');
end;

end.