282 lines
7.4 KiB
Plaintext
282 lines
7.4 KiB
Plaintext
// Based on demo created by Rodrigo Ruz
|
|
// https://theroadtodelphi.com/2011/09/01/exploring-delphi-xe2-vcl-styles-part-i/
|
|
|
|
// NOTE: VCL Theming requires XE2 or newer
|
|
|
|
unit uMain;
|
|
|
|
interface
|
|
|
|
uses
|
|
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
|
|
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls, Vcl.ExtCtrls, Vcl.ImgList,
|
|
hyieutils, iexBitmaps, hyiedefs, iesettings, iexLayers, iexRulers, iemview, iexFolderMView,
|
|
imageenview, ieview, ieopensavedlg;
|
|
|
|
type
|
|
TFrmMain = class(TForm)
|
|
PageControl1: TPageControl;
|
|
TabSheet1: TTabSheet;
|
|
TabSheet3: TTabSheet;
|
|
ListView1: TListView;
|
|
ImageList1: TImageList;
|
|
Panel2: TPanel;
|
|
ImageEnView1: TImageEnView;
|
|
ImageEnFolderMView1: TImageEnFolderMView;
|
|
ListBoxLoadedStyles: TListBox;
|
|
chkImageEnTheming: TCheckBox;
|
|
Panel3: TPanel;
|
|
Splitter1: TSplitter;
|
|
btnSaveAs: TButton;
|
|
chkRulers: TCheckBox;
|
|
SaveImageEnDialog1: TSaveImageEnDialog;
|
|
btnSaveProps: TButton;
|
|
chkEnabled: TCheckBox;
|
|
Label1: TLabel;
|
|
Label2: TLabel;
|
|
Splitter2: TSplitter;
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure btnSaveAsClick(Sender: TObject);
|
|
procedure btnSavePropsClick(Sender: TObject);
|
|
procedure chkEnabledClick(Sender: TObject);
|
|
procedure chkImageEnThemingClick(Sender: TObject);
|
|
procedure chkRulersClick(Sender: TObject);
|
|
procedure FormActivate(Sender: TObject);
|
|
procedure ImageEnFolderMView1Click(Sender: TObject);
|
|
procedure Label2Click(Sender: TObject);
|
|
procedure ListBoxLoadedStylesClick(Sender: TObject);
|
|
procedure TabSheet3Show(Sender: TObject);
|
|
private
|
|
procedure LoadStyles;
|
|
procedure GetStyleInfo;
|
|
end;
|
|
|
|
var
|
|
FrmMain: TFrmMain;
|
|
|
|
implementation
|
|
|
|
uses
|
|
TypInfo,
|
|
System.IOUtils,
|
|
Vcl.Styles,
|
|
Vcl.Themes,
|
|
ShellApi;
|
|
|
|
{$R *.dfm}
|
|
|
|
|
|
procedure TFrmMain.btnSaveAsClick(Sender: TObject);
|
|
begin
|
|
if SaveImageEnDialog1.execute then
|
|
ImageEnView1.IO.SaveToFile( SaveImageEnDialog1.Filename );
|
|
end;
|
|
|
|
procedure TFrmMain.btnSavePropsClick(Sender: TObject);
|
|
begin
|
|
ImageEnView1.IO.DoPreviews();
|
|
end;
|
|
|
|
procedure TFrmMain.chkEnabledClick(Sender: TObject);
|
|
begin
|
|
ImageEnFolderMView1 .Enabled := chkEnabled.checked;
|
|
ImageEnView1 .Enabled := chkEnabled.checked;
|
|
end;
|
|
|
|
procedure TFrmMain.chkImageEnThemingClick(Sender: TObject);
|
|
begin
|
|
IEGlobalSettings().EnableTheming := chkImageEnTheming.checked;
|
|
ImageEnView1.Update();
|
|
ImageEnFolderMView1.Update();
|
|
end;
|
|
|
|
procedure TFrmMain.chkRulersClick(Sender: TObject);
|
|
begin
|
|
if chkRulers.checked then
|
|
ImageEnView1.ShowRulers := [rdHorizontal,rdVertical]
|
|
else
|
|
ImageEnView1.ShowRulers := [];
|
|
end;
|
|
|
|
procedure TFrmMain.FormActivate(Sender: TObject);
|
|
begin
|
|
ImageEnFolderMView1.Update();
|
|
ImageEnView1.Blank();
|
|
end;
|
|
|
|
|
|
procedure TFrmMain.FormCreate(Sender: TObject);
|
|
begin
|
|
IEGlobalSettings().EnableTheming := True;
|
|
LoadStyles;
|
|
end;
|
|
|
|
|
|
|
|
procedure TFrmMain.ImageEnFolderMView1Click(Sender: TObject);
|
|
begin
|
|
ImageEnView1.ClearAll();
|
|
ImageEnView1.IO.LoadFromFile( ImageEnFolderMView1.SelectedFilename )
|
|
end;
|
|
|
|
|
|
procedure TFrmMain.LoadStyles;
|
|
Var
|
|
FileName, StyleName : string;
|
|
begin
|
|
// Load all found styles
|
|
for FileName in TDirectory.GetFiles(IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0)))+'Styles','*'+TStyleEngine.FileExtension) do
|
|
if TStyleManager.IsValidStyle( FileName ) then
|
|
TStyleManager.LoadFromFile( FileName );
|
|
|
|
// Get registered styles
|
|
ListBoxLoadedStyles.Clear();
|
|
for StyleName in TStyleManager.StyleNames do
|
|
ListBoxLoadedStyles.Items.Add( StyleName );
|
|
ListBoxLoadedStyles.ItemIndex := 0;
|
|
end;
|
|
|
|
procedure TFrmMain.TabSheet3Show(Sender: TObject);
|
|
begin
|
|
GetStyleInfo;
|
|
end;
|
|
|
|
|
|
// For more info, see: https://theroadtodelphi.com/2011/09/01/exploring-delphi-xe2-vcl-styles-part-i/
|
|
procedure TFrmMain.GetStyleInfo;
|
|
var
|
|
Style : TCustomStyleServices;
|
|
Details : TThemedElementDetails;
|
|
StyleColor : TStyleColor;
|
|
ElementColor: TElementColor;
|
|
AColor : TColor;
|
|
GridItem : TThemedGrid;
|
|
Name : string;
|
|
LVItem : TThemedListview;
|
|
Button : TThemedButton;
|
|
|
|
procedure CreateArrayBitmap(Width,Height:Word;Colors: Array of TColor;var bmp : TBitmap);
|
|
Var
|
|
i : integer;
|
|
w : integer;
|
|
begin
|
|
bmp.PixelFormat := pf24bit;
|
|
bmp.Width := Width;
|
|
bmp.Height := Height;
|
|
bmp.Canvas.Brush.Color := clBlack;
|
|
bmp.Canvas.FillRect(Rect(0,0, Width, Height));
|
|
|
|
w := (Width-2) div (High(Colors)+1);
|
|
for i := 0 to High(Colors) do
|
|
begin
|
|
bmp.Canvas.Brush.Color := Colors[i];
|
|
bmp.Canvas.FillRect(Rect((w*i)+1,1, w*(i+1)+1, Height-1))
|
|
end;
|
|
end;
|
|
|
|
procedure Add(Name: string; cl: TColor);
|
|
var
|
|
Bmp : TBitmap;
|
|
Item : TListItem;
|
|
begin
|
|
Bmp := TBitmap.Create;
|
|
try
|
|
CreateArrayBitmap(16,16,[AColor],Bmp);
|
|
ImageList1.Add(Bmp, nil);
|
|
|
|
Item := ListView1.Items.Add;
|
|
Item.ImageIndex := ImageList1.Count - 1;
|
|
Item.Caption := Name;
|
|
Item.SubItems.Add(ColorToString(AColor));
|
|
finally
|
|
Bmp.Free;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
Style := TStyleManager.Style[ListBoxLoadedStyles.Items[ListBoxLoadedStyles.ItemIndex]];
|
|
|
|
ListView1.Items.Clear;
|
|
ImageList1.Clear;
|
|
|
|
// Style Colors
|
|
for StyleColor := scBorder to scWindow do
|
|
begin
|
|
AColor := Style.GetStyleColor(StyleColor);
|
|
Name := GetEnumName(TypeInfo(TStyleColor), Ord(StyleColor));
|
|
Add( Name, AColor );
|
|
end;
|
|
|
|
// Grid Colors
|
|
for GridItem := tgGridDontCare to tgClassicFixedCellPressed do
|
|
begin
|
|
Details := Style.GetElementDetails( GridItem );
|
|
|
|
for ElementColor := ecBorderColor to ecEdgeHighLightColor do
|
|
begin
|
|
Style.GetElementColor( Details, ElementColor, AColor );
|
|
Name := GetEnumName(TypeInfo(TThemedGrid), Ord(GridItem)) + ' / ' + GetEnumName(TypeInfo(TElementColor), Ord(ElementColor));
|
|
Add( Name, AColor );
|
|
end;
|
|
end;
|
|
|
|
// ListView Colors
|
|
for LVItem := tlListviewDontCare to tlListSortDetail do
|
|
begin
|
|
Details := Style.GetElementDetails( LVItem );
|
|
|
|
for ElementColor := ecBorderColor to ecEdgeHighLightColor do
|
|
begin
|
|
Style.GetElementColor( Details, ElementColor, AColor );
|
|
Name := GetEnumName(TypeInfo(TThemedListview), Ord(LVItem)) + ' / ' + GetEnumName(TypeInfo(TElementColor), Ord(ElementColor));
|
|
Add( Name, AColor );
|
|
end;
|
|
end;
|
|
|
|
// Button colors
|
|
for Button := tbButtonDontCare to tbPushButtonDisabled do
|
|
begin
|
|
Details := Style.GetElementDetails( Button );
|
|
|
|
for ElementColor := ecBorderColor to ecEdgeHighLightColor do
|
|
begin
|
|
Style.GetElementColor( Details, ElementColor, AColor );
|
|
Name := GetEnumName(TypeInfo(TThemedButton), Ord(Button)) + ' / ' + GetEnumName(TypeInfo(TElementColor), Ord(ElementColor));
|
|
Add( Name, AColor );
|
|
end;
|
|
end;
|
|
|
|
|
|
// Font Colors
|
|
AColor := Style.GetSystemColor( clWindowText );
|
|
Name := 'clWindowText';
|
|
Add( Name, AColor );
|
|
|
|
AColor := Style.GetSystemColor( clHighlightText );
|
|
Name := 'clHighlightText';
|
|
Add( Name, AColor );
|
|
|
|
AColor := Style.GetSystemColor( clGrayText );
|
|
Name := 'clGrayText';
|
|
Add( Name, AColor );
|
|
end;
|
|
|
|
procedure TFrmMain.Label2Click(Sender: TObject);
|
|
begin
|
|
ShellExecute(0, 'OPEN', PChar( 'http://docwiki.embarcadero.com/RADStudio/XE3/en/VCL_Styles_Overview' ), '', '', SW_SHOWNORMAL);
|
|
end;
|
|
|
|
procedure TFrmMain.ListBoxLoadedStylesClick(Sender: TObject);
|
|
var
|
|
styleName: String;
|
|
begin
|
|
if ListBoxLoadedStyles.ItemIndex >= 0 then
|
|
begin
|
|
styleName := ListBoxLoadedStyles.Items[ListBoxLoadedStyles.ItemIndex];
|
|
TStyleManager.SetStyle( styleName );
|
|
end;
|
|
end;
|
|
|
|
end.
|
|
|