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 + 1) mod 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 + 1) mod 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 + 1) mod 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 - 1) mod 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(4, 4, 4 + 64, 4 + 64);
DrawRectSmall := Rect(84, 4, 84 + 32, 4 + 32);
DrawRectXSmall := Rect(132, 4, 132 + 16, 4 + 16);
TextRect := Rect(4, 84, 4 + 256, 84 + 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, 264, 416, PChar(s), length(s));
end;
if lbStates.ItemIndex <> -1 then
begin
s := lbStates.Items[lbStates.ItemIndex] + ': ' + IntToStr(AState);
TextOut(PaintBox1.Canvas.Handle, 264, 432, 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.