mainWin.pas

Filename: C:\Users\Andreas Rejbrand\Documents\UxTheme\mainWin.pas

Time: 2010-10-24 20:32:27


unit mainWin;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, UxTheme, StdCtrls, ButtonGroup, RejbrandCommon,
  PartsAndStates, ComCtrls, ImgList;

type
  TForm4 = class(TForm)
    lbClass: TListBox;
    StaticText1: TStaticText;
    StaticText2: TStaticText;
    lbParts: TListBox;
    StaticText3: TStaticText;
    lbStates: TListBox;
    ButtonGroup1: TButtonGroup;
    Timer: TTimer;
    TrackBar1: TTrackBar;
    StaticText4: TStaticText;
    staticSpeed: TStaticText;
    ImageList1: TImageList;
    GroupBox1: TGroupBox;
    PaintBox1: TPaintBox;
    
procedure lbClassClick(Sender: TObject);
    
procedure lbPartsClick(Sender: TObject);
    
procedure TestControl;
    
procedure FormCreate(Sender: TObject);
    
procedure lbStatesClick(Sender: TObject);
    
procedure ButtonGroup1ButtonClicked(Sender: TObject; Index: Integer);
    
procedure TimerTimer(Sender: TObject);
    
procedure TrackBar1Change(Sender: TObject);
    
procedure lbClassDblClick(Sender: TObject);
  
private
    procedure NextItemInPart;
    
procedure NextItemInClass;
    
{ Private declarations }
  public
    { Public declarations }
    procedure NextItem;
    
procedure PrevItem;
  
end;

var
  Form4: TForm4;
  DrawRect: TRect;
  DrawRectSmall: TRect;
  DrawRectXSmall: TRect;
  DrawRectXXSmall: TRect;
  DrawRectXXXSmall: TRect;
  TextRect: TRect;

implementation

{$R *.dfm}

procedure TForm4.NextItem;
begin
  if lbStates.ItemIndex < lbStates.Count - 1 then
    lbStates.ItemIndex := lbStates.ItemIndex + 1
  else if lbParts.ItemIndex < lbParts.Count - 1 then
  begin
    lbParts.ItemIndex := lbParts.ItemIndex + 1;
    lbPartsClick(Self);
    
if lbStates.Count > 0 then
      lbStates.ItemIndex := 0
    else
      lbStates.ItemIndex := -1;
  
end
  else
  begin
    lbClass.ItemIndex := (lbClass.ItemIndex + 1mod lbClass.Count;
    lbClassClick(Self);
    lbParts.ItemIndex := 
0;
    lbPartsClick(Self);
    
if lbStates.Count > 0 then
      lbStates.ItemIndex := 0
    else
      lbStates.ItemIndex := -1;
  
end;
  TestControl;
end;

procedure TForm4.NextItemInPart;
begin
  if lbStates.Count > 0 then
    lbStates.ItemIndex := (lbStates.ItemIndex + 1mod lbStates.Count;
  TestControl;
end;

procedure TForm4.NextItemInClass;
begin
  if lbStates.ItemIndex < lbStates.Count - 1 then
    lbStates.ItemIndex := lbStates.ItemIndex + 1
  else
  begin
    lbParts.ItemIndex := (lbParts.ItemIndex + 1mod lbParts.Count;
    lbPartsClick(Self);
    
if lbStates.Count > 0 then
      lbStates.ItemIndex := 0
    else
      lbStates.ItemIndex := -1;
  
end;
  TestControl;
end;

procedure TForm4.PrevItem;
begin
  if lbStates.ItemIndex > 0 then
    lbStates.ItemIndex := lbStates.ItemIndex - 1
  else if lbParts.ItemIndex > 0 then
  begin
    lbParts.ItemIndex := lbParts.ItemIndex - 1;
    lbPartsClick(Self);
    lbStates.ItemIndex := lbStates.Count - 
1;
  
end
  else
  begin
    lbClass.ItemIndex := (lbClass.Count + lbClass.ItemIndex - 1mod lbClass.Count;
    lbClassClick(Self);
    lbParts.ItemIndex := lbParts.Count - 
1;
    lbPartsClick(Self);
    lbStates.ItemIndex := lbStates.Count - 
1;
  
end;
  TestControl;
end;

const
  BTN_NEXT = 0;
  BTN_PREVIOUS = 
1;
  BTN_PLAY_ALL = 
2;
  BTN_PLAY_
CLASS = 3;
  BTN_PLAY_PART = 
4;
  BTN_STOP = 
5;

procedure TForm4.ButtonGroup1ButtonClicked(Sender: TObject; Index: Integer);
begin
  Timer.Tag := Index;
  
case Index of
    BTN_NEXT:
      NextItem;
    BTN_PREVIOUS:
      PrevItem;
    BTN_PLAY_ALL, BTN_PLAY_
CLASS, BTN_PLAY_PART:
      Timer.Enabled := true;
    BTN_STOP:
      Timer.Enabled := false;
  
end;
end;

procedure TForm4.FormCreate(Sender: TObject);
begin
  if not InitThemeLibrary then
  begin
    MessageBox(Handle, 'Themes not supported.', PChar(Caption), MB_ICONERROR);
    Application.Terminate;
  
end;
  DrawRect := Rect(
444 + 644 + 64);
  DrawRectSmall := Rect(
84484 + 324 + 32);
  DrawRectXSmall := Rect(
1324132 + 164 + 16);
  TextRect := Rect(
4844 + 25684 + 64);
  lbClass.ItemIndex := 
0;
  lbClassClick(Self);
  lbParts.ItemIndex := 
0;
  lbPartsClick(Self);
  lbStates.ItemIndex := 
0;
  lbStatesClick(Self);
//  ImageList1.AddIcon(Application.Icon);
end;

procedure TForm4.lbClassClick(Sender: TObject);
var
  str: string;
begin
  if lbClass.ItemIndex <> -1 then
    with lbParts.Items do
    begin
      BeginUpdate;
      
try
        Clear;
        
for str in GetParts(lbClass.Items[lbClass.ItemIndex]) do
          Add(str);
      
finally
        EndUpdate;
      
end;
    
end;
end;

procedure TForm4.lbClassDblClick(Sender: TObject);
begin
  TestControl;
end;

procedure TForm4.lbPartsClick(Sender: TObject);
var
  str: string;
begin
  if lbParts.ItemIndex <> -1 then
    with lbStates.Items do
    begin
      BeginUpdate;
      
try
        Clear;
        
for str in GetStates(lbParts.Items[lbParts.ItemIndex]) do
          Add(str);
      
finally
        EndUpdate;
      
end;
    
end;
end;

procedure TForm4.lbStatesClick(Sender: TObject);
begin
  TestControl;
end;

procedure TForm4.TestControl;
var
  AClass: string;
  APart, AState: integer;
  h: HTHEME;
  s: 
string;
begin
  AClass := '';
  APart := 
0;
  AState := 
0;
  
if lbClass.ItemIndex <> -1 then
    AClass := lbClass.Items[lbClass.ItemIndex];
  
if lbParts.ItemIndex <> -1 then
    APart := ParseIdent(lbParts.Items[lbParts.ItemIndex]);
  
if lbStates.ItemIndex <> -1 then
    AState := ParseIdent(lbStates.Items[lbStates.ItemIndex]);

  PaintBox1.Canvas.Brush.Color := clBtnFace;
  PaintBox1.Canvas.FillRect(PaintBox1.ClientRect);

  h := OpenThemeData(Handle, PChar(AClass));
  
if h <> 0 then
    try
      DrawThemeBackground(h, PaintBox1.Canvas.Handle, APart, AState, DrawRect, nil);
      DrawThemeBackground(h, PaintBox1.Canvas.Handle, APart, AState, DrawRectSmall, 
nil);
      DrawThemeBackground(h, PaintBox1.Canvas.Handle, APart, AState, DrawRectXSmall, 
nil);
//      DrawThemeBackground(h, PaintBox1.Canvas.Handle, APart, AState, DrawRectXXSmall, nil);
//      DrawThemeBackground(h, PaintBox1.Canvas.Handle, APart, AState, DrawRectXXXSmall, nil);
      DrawThemeText(h, PaintBox1.Canvas.Handle, APart, AState, 'Sample Text'11, DT_SINGLELINE, 0, TextRect);
    
finally
      CloseThemeData(h);
    
end;

    
if lbParts.ItemIndex <> -1 then
    begin
      s := lbParts.Items[lbParts.ItemIndex] + ': ' + IntToStr(APart);
      TextOut(PaintBox1.Canvas.Handle, 
264416, PChar(s), length(s));
    
end;

    
if lbStates.ItemIndex <> -1 then
    begin
      s := lbStates.Items[lbStates.ItemIndex] + ': ' + IntToStr(AState);
      TextOut(PaintBox1.Canvas.Handle, 
264432, PChar(s), length(s));
    
end;

end;

procedure TForm4.TimerTimer(Sender: TObject);
begin
  case Timer.Tag of
    BTN_PLAY_ALL: NextItem;
    BTN_PLAY_
CLASS: NextItemInClass;
    BTN_PLAY_PART: NextItemInPart;
  
end;
end;

procedure TForm4.TrackBar1Change(Sender: TObject);
begin
  Timer.Interval := 20 * (100 - TrackBar1.Position);
  staticSpeed.Caption := FormatFloat(
'#.0', Timer.Interval / 1000) + ' sec';
end;

end.