Archive

Archive for May, 2011

Using the Microsoft Translator V2 API from delphi

May 30, 2011 7 comments

Due which the Google Translate API has been officially deprecated is time to look for alternatives and a good one is the Microsoft Translator V2, in this article I will show how you can access this API from a Delphi desktop application.

In order to gain access to this API you must obtain a Bing AppID, so go to this page register and get your Bing AppID to play with this.

The Microsoft Translator V2 can be accessed via HTTP, Ajax or SOAP in this post we will use the HTTP interface to make the requests. Now to start using the HTTP API for the Microsoft Translator service you must send a request to the appropriate http://api.microsofttranslator.com/V2/HTTP.svc url and then parse the returned response.

This is the list of the functions supported by the HTTP API

Name Description
Microsoft.Translator.AddTranslation Method Adds a translation to the translation memory.
Microsoft.Translator.AddTranslationArray Method Adds an array of translations to the translation memory.
Microsoft.Translator.BreakSentences Method Returns an array of sentence lengths for each sentence of the given text.
Microsoft.Translator.Detect Method Detects the language of a selection of text.
Microsoft.Translator.DetectArray Method Detects the language of an array of strings.
Microsoft.Translator.GetAppIdToken Method Returns a tokenized AppID which can be used as AppID parameter in any method.
Microsoft.Translator.GetLanguageNames Method Obtains a list of the languages supported by the Translator Service.
Microsoft.Translator.GetLanguagesForSpeak Method Obtains a list of the language codes supported by the Translator Service for speech synthesis.
Microsoft.Translator.GetLanguagesForTranslate Method Obtains a list of the language codes supported by the Translator Service.
Microsoft.Translator.GetTranslations Method Returns an array of alternative translations of the given text.
Microsoft.Translator.GetTranslationsArray Method Returns an array of alternative translations of the passed array of text.
Microsoft.Translator.Speak Method Returns a stream of a wave-file speaking the passed-in text in the desired language.
Microsoft.Translator.Translate Method Converts a text string from one language to another.
Microsoft.Translator.TranslateArray Method Translates an array of texts into another language.

The next samples uses two helper functions to make a http request (off course which you can use you own method or component too)

uses
  Windows,
  WinInet;

procedure WinInet_HttpGet(const Url: string;Stream:TStream);overload;
const
BuffSize = 1024*1024;
var
  hInter   : HINTERNET;
  UrlHandle: HINTERNET;
  BytesRead: DWORD;
  Buffer   : Pointer;
begin
  hInter := InternetOpen('', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  if Assigned(hInter) then
    try
      Stream.Seek(0,0);
      GetMem(Buffer,BuffSize);
      try
          UrlHandle := InternetOpenUrl(hInter, PChar(Url), nil, 0, INTERNET_FLAG_RELOAD, 0);
          if Assigned(UrlHandle) then
          begin
            repeat
              InternetReadFile(UrlHandle, Buffer, BuffSize, BytesRead);
              if BytesRead>0 then
               Stream.WriteBuffer(Buffer^,BytesRead);
            until BytesRead = 0;
            InternetCloseHandle(UrlHandle);
          end;
      finally
        FreeMem(Buffer);
      end;
    finally
     InternetCloseHandle(hInter);
    end;
end;

function WinInet_HttpGet(const Url: string): string;overload;
Var
  StringStream : TStringStream;
begin
  Result:='';
    StringStream:=TStringStream.Create('',TEncoding.UTF8);
    try
        WinInet_HttpGet(Url,StringStream);
        if StringStream.Size>0 then
        begin
          StringStream.Seek(0,0);
          Result:=StringStream.ReadString(StringStream.Size);
        end;
    finally
      StringStream.Free;
    end;
end;

Translating a Text

To translate a given text you must use the Translate method  making  a request to this URL http://api.microsofttranslator.com/V2/Http.svc/Translate using these parameters

Parameter                                                 Description
appId A string containing the Bing AppID.
text A string representing the text to translate.
from A string representing the language code of the translation text.
to A string representing the language code to translate the text into.
contentType The format of the text being translated. The supported formats are “text/plain” and “text/html”. Any HTML needs to be well-formed.
category The category of the text to translate. The only supported category is “general”.

In delphi you can construct this URI in this way

const
  MicrosoftTranslatorTranslateUri = 'http://api.microsofttranslator.com/v2/Http.svc/Translate?appId=%s&text=%s&from=%s&to=%s';

Check this sample code which make a http request and a translate a text

function TranslateText(const AText,SourceLng,DestLng:string):string;
var
   XmlDoc : OleVariant;
   Node   : OleVariant;
begin
 //Make the http request
 Result:=WinInet_HttpGet(Format(MicrosoftTranslatorTranslateUri,[BingAppId,AText,SourceLng,DestLng]));
 //Create  a XML object o parse the result
  XmlDoc:= CreateOleObject(Msxml2_DOMDocument);
  try
    XmlDoc.Async := False;
    //load the XML retuned string
    XmlDoc.LoadXML(Result);
    if (XmlDoc.parseError.errorCode <> 0) then
     raise Exception.CreateFmt('Error in Xml Data %s',[XmlDoc.parseError]);
    Node:= XmlDoc.documentElement;
    if not VarIsClear(Node) then
     Result:=XmlDoc.Text;
  finally
     XmlDoc:=Unassigned;
  end;
end;

Detecting the language

To detect the language of a text you must use the Detect Method making a http request to this URI  http://api.microsofttranslator.com/V2/Http.svc/Detect with these parameters.

 Parameter Description
appId A string containing the Bing AppID.
text A string containing some text whose language is to be identified.

In delphi you can construct this URI in this way

const
  MicrosoftTranslatorDetectUri    = 'http://api.microsofttranslator.com/v2/Http.svc/Detect?appId=%s&text=%s';

function DetectLanguage(const AText:string ):string;
var
   XmlDoc : OleVariant;
   Node   : OleVariant;
begin
  //make the http request
  Result:=WinInet_HttpGet(Format(MicrosoftTranslatorDetectUri,[BingAppId,AText]));
  XmlDoc:= CreateOleObject(Msxml2_DOMDocument);
  try
    XmlDoc.Async := False;
    //load the returned xml string
    XmlDoc.LoadXML(Result);
    if (XmlDoc.parseError.errorCode <> 0) then
     raise Exception.CreateFmt('Error in Xml Data %s',[XmlDoc.parseError]);
    Node:= XmlDoc.documentElement;
   //get the detected language from the node
    if not VarIsClear(Node) then
      Result:=XmlDoc.Text;
  finally
     XmlDoc:=Unassigned;
  end;
end;
end;

Getting the list of supported languages

The GetLanguagesForTranslate method return a list of the supported languages for translation

The URL of this method is http://api.microsofttranslator.com/V2/Http.svc/GetLanguagesForTranslate and the parameters are

Parameter  Description
appId A string containing the Bing AppID.
The delphi equivalkent URI

const
MicrosoftTranslatorGetLngUri    = 'http://api.microsofttranslator.com/v2/Http.svc/GetLanguagesForTranslate?appId=%s';

And here you a have a sample code to make the request and parse the response

function GetLanguagesForTranslate: TList<string>;
var
   XmlDoc : OleVariant;
   Node   : OleVariant;
   Nodes  : OleVariant;
   lNodes : Integer;
   i      : Integer;
   sValue : string;
begin
  Result:=TList<string>.Create;
  //make the http request
  sValue:=WinInet_HttpGet(Format(MicrosoftTranslatorGetLngUri,[BingAppId]));
  XmlDoc:= CreateOleObject(Msxml2_DOMDocument);
  try
    XmlDoc.Async := False;
    XmlDoc.LoadXML(sValue);
    if (XmlDoc.parseError.errorCode <> 0) then
     raise Exception.CreateFmt('Error in Xml Data %s',[XmlDoc.parseError]);
    Node:= XmlDoc.documentElement;
    if not VarIsClear(Node) then
    begin
      //get the nodes
      Nodes := Node.childNodes;
       if not VarIsClear(Nodes) then
       begin
         lNodes:= Nodes.Length;
           for i:=0 to lNodes-1 do
            Result.Add(Nodes.Item(i).Text);
       end;
    end;
  finally
     XmlDoc:=Unassigned;
  end;
end;

Getting the list of supported languages for speak

the GetLanguagesForSpeak Method returns a list of the suported languages for speak, the URL for this method is http://api.microsofttranslator.com/V2/Http.svc/GetLanguagesForSpeak

Parameter Description
appId A string containing the Bing AppID.

the delphi equivalent declaration of the URI

const
  MicrosoftTranslatorGetSpkUri    = 'http://api.microsofttranslator.com/v2/Http.svc/GetLanguagesForSpeak?appId=%s';

Now the function to get the supported languages

function GetLanguagesForSpeak: TList<string>;
var
   XmlDoc : OleVariant;
   Node   : OleVariant;
   Nodes  : OleVariant;
   lNodes : Integer;
   i      : Integer;
   sValue : string;
begin
  Result:=TList<string>.Create;
  sValue:=WinInet_HttpGet(Format(MicrosoftTranslatorGetSpkUri,[BingAppId]));
  XmlDoc:= CreateOleObject(Msxml2_DOMDocument);
  try
    XmlDoc.Async := False;
    XmlDoc.LoadXML(sValue);
    if (XmlDoc.parseError.errorCode <> 0) then
     raise Exception.CreateFmt('Error in Xml Data %s',[XmlDoc.parseError]);
    Node:= XmlDoc.documentElement;
    if not VarIsClear(Node) then
    begin
      Nodes := Node.childNodes;
       if not VarIsClear(Nodes) then
       begin
         lNodes:= Nodes.Length;
           for i:=0 to lNodes-1 do
            Result.Add(Nodes.Item(i).Text);
       end;
    end;
  finally
     XmlDoc:=Unassigned;
  end;
end;

Making the API speak

The speak method returns a stream of a audio file speaking the passed-in text in the desired language. the URI of this function is http://api.microsofttranslator.com/V2/Http.svc/Speak and the parameters are

Parameter Description
appId A string containing the Bing AppID.
text A string containing a sentence or sentences of the specified language to be spoken for the wave stream.
language A string representing the supported language code to speak the text in. The code must be present in the list of codes returned from the method GetLanguagesForSpeak.
format Optional. A string specifying the format of the wafe-file to be returned. The default value is “audio/wav” which is the only currently allowed value.

The delphi equivalent URI

const
  MicrosoftTranslatorSpeakUri     = 'http://api.microsofttranslator.com/v2/Http.svc/Speak?appId=%s&text=%s&language=%s';

And the function to get the audio stream

procedure Speak(const FileName,AText,Lng:string);
var
  Stream : TFileStream;
begin
  Stream:=TFileStream.Create(FileName,fmCreate);
  try
    WinInet_HttpGet(Format(MicrosoftTranslatorSpeakUri,[BingAppId,AText,Lng]),Stream);
  finally
     Stream.Free;
  end;
end;

Finally this is the full code of a sample console application with all the funcions covered in this post

program MicrosoftTranslatorApi;

{$APPTYPE CONSOLE}

uses
  ShellApi,
  ActiveX,
  Classes,
  ComObj,
  Variants,
  Windows,
  WinInet,
  Generics.Collections,
  SysUtils;

const
   MicrosoftTranslatorTranslateUri = 'http://api.microsofttranslator.com/v2/Http.svc/Translate?appId=%s&text=%s&from=%s&to=%s';
   MicrosoftTranslatorDetectUri    = 'http://api.microsofttranslator.com/v2/Http.svc/Detect?appId=%s&text=%s';
   MicrosoftTranslatorGetLngUri    = 'http://api.microsofttranslator.com/v2/Http.svc/GetLanguagesForTranslate?appId=%s';
   MicrosoftTranslatorGetSpkUri    = 'http://api.microsofttranslator.com/v2/Http.svc/GetLanguagesForSpeak?appId=%s';
   MicrosoftTranslatorSpeakUri     = 'http://api.microsofttranslator.com/v2/Http.svc/Speak?appId=%s&text=%s&language=%s';
   //this AppId if for demo only please be nice and use your own , it's easy get one from here http://msdn.microsoft.com/en-us/library/ff512386.aspx
   BingAppId                       = '73C8F474CA4D1202AD60747126813B731199ECEA';
   Msxml2_DOMDocument              = 'Msxml2.DOMDocument.6.0';

procedure WinInet_HttpGet(const Url: string;Stream:TStream);overload;
const
BuffSize = 1024*1024;
var
  hInter   : HINTERNET;
  UrlHandle: HINTERNET;
  BytesRead: DWORD;
  Buffer   : Pointer;
begin
  hInter := InternetOpen('', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  if Assigned(hInter) then
    try
      Stream.Seek(0,0);
      GetMem(Buffer,BuffSize);
      try
          UrlHandle := InternetOpenUrl(hInter, PChar(Url), nil, 0, INTERNET_FLAG_RELOAD, 0);
          if Assigned(UrlHandle) then
          begin
            repeat
              InternetReadFile(UrlHandle, Buffer, BuffSize, BytesRead);
              if BytesRead>0 then
               Stream.WriteBuffer(Buffer^,BytesRead);
            until BytesRead = 0;
            InternetCloseHandle(UrlHandle);
          end;
      finally
        FreeMem(Buffer);
      end;
    finally
     InternetCloseHandle(hInter);
    end;
end;

function WinInet_HttpGet(const Url: string): string;overload;
Var
  StringStream : TStringStream;
begin
  Result:='';
    StringStream:=TStringStream.Create('',TEncoding.UTF8);
    try
        WinInet_HttpGet(Url,StringStream);
        if StringStream.Size>0 then
        begin
          StringStream.Seek(0,0);
          Result:=StringStream.ReadString(StringStream.Size);
        end;
    finally
      StringStream.Free;
    end;
end;

function TranslateText(const AText,SourceLng,DestLng:string):string;
var
   XmlDoc : OleVariant;
   Node   : OleVariant;
begin
  Result:=WinInet_HttpGet(Format(MicrosoftTranslatorTranslateUri,[BingAppId,AText,SourceLng,DestLng]));
  XmlDoc:= CreateOleObject(Msxml2_DOMDocument);
  try
    XmlDoc.Async := False;
    XmlDoc.LoadXML(Result);
    if (XmlDoc.parseError.errorCode <> 0) then
     raise Exception.CreateFmt('Error in Xml Data %s',[XmlDoc.parseError]);
    Node:= XmlDoc.documentElement;
    if not VarIsClear(Node) then
     Result:=XmlDoc.Text;
  finally
     XmlDoc:=Unassigned;
  end;
end;

function DetectLanguage(const AText:string ):string;
var
   XmlDoc : OleVariant;
   Node   : OleVariant;
begin
  Result:=WinInet_HttpGet(Format(MicrosoftTranslatorDetectUri,[BingAppId,AText]));
  XmlDoc:= CreateOleObject(Msxml2_DOMDocument);
  try
    XmlDoc.Async := False;
    XmlDoc.LoadXML(Result);
    if (XmlDoc.parseError.errorCode <> 0) then
     raise Exception.CreateFmt('Error in Xml Data %s',[XmlDoc.parseError]);
    Node:= XmlDoc.documentElement;
    if not VarIsClear(Node) then
      Result:=XmlDoc.Text;
  finally
     XmlDoc:=Unassigned;
  end;
end;

function GetLanguagesForTranslate: TList<string>;
var
   XmlDoc : OleVariant;
   Node   : OleVariant;
   Nodes  : OleVariant;
   lNodes : Integer;
   i      : Integer;
   sValue : string;
begin
  Result:=TList<string>.Create;
  sValue:=WinInet_HttpGet(Format(MicrosoftTranslatorGetLngUri,[BingAppId]));
  XmlDoc:= CreateOleObject(Msxml2_DOMDocument);
  try
    XmlDoc.Async := False;
    XmlDoc.LoadXML(sValue);
    if (XmlDoc.parseError.errorCode <> 0) then
     raise Exception.CreateFmt('Error in Xml Data %s',[XmlDoc.parseError]);
    Node:= XmlDoc.documentElement;
    if not VarIsClear(Node) then
    begin
      Nodes := Node.childNodes;
       if not VarIsClear(Nodes) then
       begin
         lNodes:= Nodes.Length;
           for i:=0 to lNodes-1 do
            Result.Add(Nodes.Item(i).Text);
       end;
    end;
  finally
     XmlDoc:=Unassigned;
  end;
end;

function GetLanguagesForSpeak: TList<string>;
var
   XmlDoc : OleVariant;
   Node   : OleVariant;
   Nodes  : OleVariant;
   lNodes : Integer;
   i      : Integer;
   sValue : string;
begin
  Result:=TList<string>.Create;
  sValue:=WinInet_HttpGet(Format(MicrosoftTranslatorGetSpkUri,[BingAppId]));
  XmlDoc:= CreateOleObject(Msxml2_DOMDocument);
  try
    XmlDoc.Async := False;
    XmlDoc.LoadXML(sValue);
    if (XmlDoc.parseError.errorCode <> 0) then
     raise Exception.CreateFmt('Error in Xml Data %s',[XmlDoc.parseError]);
    Node:= XmlDoc.documentElement;
    if not VarIsClear(Node) then
    begin
      Nodes := Node.childNodes;
       if not VarIsClear(Nodes) then
       begin
         lNodes:= Nodes.Length;
           for i:=0 to lNodes-1 do
            Result.Add(Nodes.Item(i).Text);
       end;
    end;
  finally
     XmlDoc:=Unassigned;
  end;
end;

procedure Speak(const FileName,AText,Lng:string);
var
  Stream : TFileStream;
begin
  Stream:=TFileStream.Create(FileName,fmCreate);
  try
    WinInet_HttpGet(Format(MicrosoftTranslatorSpeakUri,[BingAppId,AText,Lng]),Stream);
  finally
     Stream.Free;
  end;
end;

var
 lng       : TList<string>;
 s         : string;
 FileName  : string;

begin
 try
    ReportMemoryLeaksOnShutdown:=True;
    CoInitialize(nil);
    try
      Writeln(TranslateText('Hello World','en','es'));
      Writeln(DetectLanguage('Hello World'));

      Writeln('Languages for translate supported');
      lng:=GetLanguagesForTranslate;
      try
        for s in lng do
         Writeln(s);
      finally
        lng.free;
      end;

      Writeln('Languages for speak supported');
      lng:=GetLanguagesForSpeak;
      try
        for s in lng do
         Writeln(s);
      finally
        lng.free;
      end;

      FileName:=ExtractFilePath(ParamStr(0))+'Demo.wav';
      Speak(FileName,'This is a demo using the Microsoft Translator Api from delphi, enjoy','en');
      ShellExecute(0, 'open', PChar(FileName),nil,nil, SW_SHOWNORMAL) ;

    finally
      CoUninitialize;
    end;
 except
    on E:Exception do
        Writeln(E.Classname, ':', E.Message);
 end;
 Writeln('Press Enter to exit');
 Readln;
end.

Categories: Bing API, Delphi

Delphi IDE Theme Editor – New features added

May 22, 2011 5 comments

New features was added to the Delphi IDE Theme Editor.

Added Color dialog with color picker.

Added option to report bugs and suggestions directly

The themes included with the tool were improved.

Some Minor bugs fixed

Check the screenshots

To download the last version go to the main page of the project.

Remember. to make your suggestions or report bugs use the Issue page of the project.

Categories: Applications, Delphi

Changing the glass composition color (DWM) using delphi

May 5, 2011 6 comments

Before to read this post you must be aware which the material exposed  make uses of undocumented windows functions, so you must know the risks involved in using them.   If you are not comfortably with that please  skip this post.

Some days ago  reading this article,  I found a very nice application called Aura (Written in C#), which  calculates average color of  the desktop background image or the active window icon and sets it as Aero Glass color.

Check this demo video of Aura

After of that, I check the Desktop Window Manager (DWM) reference to find the functions which allow change the color of the  glass in Windows Vista/7,  but I can’t found any documented function to do this. Finally digging in the source code of the Aura application I found two undocumented functions called DwmGetColorizationParameters and DwmSetColorizationParameter which makes this task. Then I check the parameters, the call conventions and finally I took the dwmapi.dll file and after of analyze using IDA and the Microsoft public symbol server, I found a lot of undocumented functions.

At this point originally I was going to include the details of the disassembled code, but to avoid legal problems I just going to include the dump of the exported functions

This is the dump of the exported functions of this library (dwmapi.dll) , as you can see exist a lot of undocumented functions.

dwmapi.1; Index 100;undocumented
dwmapi.2; Index 101;undocumented
DwmEnableComposition; Index 102;
dwmapi.4; Index 103;undocumented
dwmapi.5; Index 104;undocumented
dwmapi.6; Index 105;undocumented
dwmapi.7; Index 106;undocumented
dwmapi.8; Index 107;undocumented
dwmapi.9; Index 108;undocumented
dwmapi.10; Index 109;undocumented
dwmapi.11; Index 110;undocumented
DwmAttachMilContent; Index 111;
dwmapi.13; Index 112;undocumented
dwmapi.14; Index 113;undocumented
dwmapi.15; Index 114;undocumented
dwmapi.16; Index 115;undocumented
DwmDefWindowProc; Index 116;
DwmDetachMilContent; Index 117;
dwmapi.19; Index 118;undocumented
dwmapi.20; Index 119;undocumented
dwmapi.21; Index 120;undocumented
dwmapi.22; Index 121;undocumented
DwmEnableBlurBehindWindow; Index 122;
DwmEnableMMCSS; Index 123;
dwmapi.25; Index 124;undocumented
dwmapi.26; Index 125;undocumented
dwmapi.27; Index 126;undocumented
dwmapi.28; Index 127;undocumented
dwmapi.29; Index 128;undocumented
dwmapi.30; Index 129;undocumented
dwmapi.31; Index 130;undocumented
dwmapi.32; Index 131;undocumented
dwmapi.33; Index 132;undocumented
dwmapi.34; Index 133;undocumented
dwmapi.35; Index 134;undocumented
DwmExtendFrameIntoClientArea; Index 135;
DwmFlush; Index 136;
DwmGetColorizationColor; Index 137;
DwmGetCompositionTimingInfo; Index 138;
DwmGetGraphicsStreamClient; Index 139;
DwmGetGraphicsStreamTransformHint; Index 140;
DwmGetTransportAttributes; Index 141;
DwmGetWindowAttribute; Index 142;
DwmInvalidateIconicBitmaps; Index 143;
DwmIsCompositionEnabled; Index 144;
DwmModifyPreviousDxFrameDuration; Index 145;
DwmQueryThumbnailSourceSize; Index 146;
DwmRegisterThumbnail; Index 147;
DwmSetDxFrameDuration; Index 148;
DwmSetIconicLivePreviewBitmap; Index 149;
DwmSetIconicThumbnail; Index 150;
DwmSetPresentParameters; Index 151;
DwmSetWindowAttribute; Index 152;
DwmUnregisterThumbnail; Index 153;
DwmUpdateThumbnailProperties; Index 154;

Now using the Microsoft public symbol server we can obtain the undocumented functions names.

dwmapi.1; Index 100;_DwmpDxGetWindowSharedSurface
dwmapi.2; Index 101;_DwmpDxUpdateWindowSharedSurface
DwmEnableComposition; Index 102;
dwmapi.4; Index 103;_DwmpRestartComposition
dwmapi.5; Index 104;_DwmpSetColorizationColor
dwmapi.6; Index 105;_DwmpStartOrStopFlip3D
dwmapi.7; Index 106;_DwmpIsCompositionCapable
dwmapi.8; Index 107;_DwmpGetGlobalState
dwmapi.9; Index 108;_DwmpEnableRedirection
dwmapi.10; Index 109;_DwmGetGraphicsStreamTransformHint
dwmapi.11; Index 110;_DwmpCloseGraphicsStream
DwmAttachMilContent; Index 111;
dwmapi.13; Index 112;_DwmpSetGraphicsStreamTransformHint
dwmapi.14; Index 113;_DwmpActivateLivePreview
dwmapi.15; Index 114;_DwmpQueryThumbnailType
dwmapi.16; Index 115;_DwmpStartupViaUserInit
DwmDefWindowProc; Index 116;
DwmDetachMilContent; Index 117;
dwmapi.19; Index 118;_DwmpGetAssessment
dwmapi.20; Index 119;_DwmpGetAssessmentUsage
dwmapi.21; Index 120;_DwmpSetAssessmentUsage
dwmapi.22; Index 121;_DwmpIsSessionDWM
DwmEnableBlurBehindWindow; Index 122;
DwmEnableMMCSS; Index 123;
dwmapi.25; Index 124;_DwmpRegisterThumbnail
dwmapi.26; Index 125;_DwmpDxBindSwapChain
dwmapi.27; Index 126;_DwmpDxUnbindSwapChain
dwmapi.28; Index 127;_DwmGetColorizationParameters
dwmapi.29; Index 128;_DwmpDxgiIsThreadDesktopComposited
dwmapi.30; Index 129;_DwmpDxgiDisableRedirection
dwmapi.31; Index 130;_DwmpDxgiEnableRedirection
dwmapi.32; Index 131;_DwmSetColorizationParameters
dwmapi.33; Index 132;_DwmpGetCompositionTimingInfoEx
dwmapi.34; Index 133;_DwmpDxUpdateWindowRedirectionBltSurface
dwmapi.35; Index 134;_DwmpDxSetContentHostingInformation
DwmExtendFrameIntoClientArea; Index 135;
DwmFlush; Index 136;
DwmGetColorizationColor; Index 137;
DwmGetCompositionTimingInfo; Index 138;
DwmGetGraphicsStreamClient; Index 139;
DwmGetGraphicsStreamTransformHint; Index 140;
DwmGetTransportAttributes; Index 141;
DwmGetWindowAttribute; Index 142;
DwmInvalidateIconicBitmaps; Index 143;
DwmIsCompositionEnabled; Index 144;
DwmModifyPreviousDxFrameDuration; Index 145;
DwmQueryThumbnailSourceSize; Index 146;
DwmRegisterThumbnail; Index 147;
DwmSetDxFrameDuration; Index 148;
DwmSetIconicLivePreviewBitmap; Index 149;
DwmSetIconicThumbnail; Index 150;
DwmSetPresentParameters; Index 151;
DwmSetWindowAttribute; Index 152;
DwmUnregisterThumbnail; Index 153;
DwmUpdateThumbnailProperties; Index 154;

In this article only we use the DwmGetColorizationParameters and DwmSetColorizationParameter functions,  the declaration of these in Delphi is

type
tagCOLORIZATIONPARAMS = record
clrColor        : COLORREF;  //ColorizationColor
clrAftGlow      : COLORREF;  //ColorizationAfterglow
nIntensity      : UINT;      //ColorizationColorBalance -> 0-100
clrAftGlowBal   : UINT;      //ColorizationAfterglowBalance
clrBlurBal      : UINT;      //ColorizationBlurBalance
clrGlassReflInt : UINT;      //ColorizationGlassReflectionIntensity
fOpaque         : BOOL;
end;

COLORIZATIONPARAMS=tagCOLORIZATIONPARAMS;
TColorizationParams=COLORIZATIONPARAMS;
PColorizationParams=^TColorizationParams;

TDwmGetColorizationParameters = procedure(out parameters :TColorizationParams); stdcall;
TDwmSetColorizationParameters = procedure(parameters :PColorizationParams;unknown:BOOL); stdcall;

To check the current values of the tagCOLORIZATIONPARAMS  structure  used by the DwmGetColorizationParameters and DwmSetColorizationParameters  functions, you can see the windows registry key HKEY_CURRENT_USER\Software\Microsoft\Windows\DWM

Now in order to change the colorization color of the glass from Delphi you must call these functions in this way

Procedure SetCompositionColor(AColor:TColor);
var
  Params : TColorizationParams;
begin
   //Convert the TColor to a valid color RGB -> BGR
   AColor:=RGB(GetBValue(AColor),GetGValue(AColor),GetRValue(AColor));
   ZeroMemory(@Params,SizeOf(Params));
   //Get the current values
   DwmGetColorizationParameters(Params);
   //Set the New Color
   Params.clrColor  :=AColor;
   //Call the function to set the new color
   DwmSetColorizationParameters(@Params,Bool(0));
end;

Check this delphi console application which change the color of the glass

program DwmDelphiDemo;

{$APPTYPE CONSOLE}
//Author  : Rodrigo Ruz V.
//2011-05-05

uses
  Graphics,
  Windows,
  SysUtils;

type
 tagCOLORIZATIONPARAMS = record
	clrColor        : COLORREF;  //ColorizationColor
        clrAftGlow      : COLORREF;  //ColorizationAfterglow
        nIntensity      : UINT;      //ColorizationColorBalance -> 0-100
	clrAftGlowBal   : UINT;      //ColorizationAfterglowBalance
	clrBlurBal      : UINT;      //ColorizationBlurBalance
	clrGlassReflInt : UINT;      //ColorizationGlassReflectionIntensity
	fOpaque         : BOOL;
end;

 COLORIZATIONPARAMS=tagCOLORIZATIONPARAMS;
 TColorizationParams=COLORIZATIONPARAMS;
 PColorizationParams=^TColorizationParams;

 TDwmGetColorizationParameters = procedure(out parameters :TColorizationParams); stdcall;
 TDwmSetColorizationParameters = procedure(parameters :PColorizationParams;unknown:BOOL); stdcall;
 TDwmIsCompositionEnabled      = function(out pfEnabled : BOOL): HRESULT; stdcall;

var
 DwmGetColorizationParameters : TDwmGetColorizationParameters;
 DwmSetColorizationParameters : TDwmSetColorizationParameters;
 DwmIsCompositionEnabled      : TDwmIsCompositionEnabled;
 hdwmapi                      : Cardinal;

function  IsAeroEnabled: Boolean;
var
  pfEnabled : BOOL;
begin
 Result:=False;
 if Assigned(DwmIsCompositionEnabled) and (DwmIsCompositionEnabled(pfEnabled)=S_OK) then
  Result:=pfEnabled;
end;

Procedure SetCompositionColor(AColor:TColor);
var
  Params : TColorizationParams;
begin
   //convert the TColor to a valid color RGB -> BGR
   AColor:=RGB(GetBValue(AColor),GetGValue(AColor),GetRValue(AColor));
   ZeroMemory(@Params,SizeOf(Params));
   //Get the current values
   DwmGetColorizationParameters(Params);
   //Set the New Color
   Params.clrColor  :=AColor;
   //Call the function to set the new color
   DwmSetColorizationParameters(@Params,Bool(0));
   //get the colorization parameters and show the details
   DwmGetColorizationParameters(Params);
   Writeln(format('Intensity %d - Colorization Color %.8x - Colorization Afterglow Color 2 %.8x',[Params.nIntensity,Params.clrColor,Params.clrAftGlow]));
end;

//load the functions to use
function Init_Dwm: Boolean;
begin
 Result:=False;
  hdwmapi := LoadLibrary('dwmapi.dll');
  if (hdwmapi <> 0) then
  begin
    @DwmIsCompositionEnabled      := GetProcAddress(hdwmapi, 'DwmIsCompositionEnabled');
    //load the DwmGetColorizationParameters  function from the 127 index
    @DwmGetColorizationParameters := GetProcAddress(hdwmapi, LPCSTR(127));
    //load the DwmSetColorizationParameters function from the 131 index
    @DwmSetColorizationParameters := GetProcAddress(hdwmapi, LPCSTR(131));
    Result:=(Assigned(DwmGetColorizationParameters)) and (Assigned(DwmSetColorizationParameters)) and IsAeroEnabled;
  end;
end;

procedure Done_Dwm;
begin
  if (hdwmapi <> 0) then
   FreeLibrary(hdwmapi);
end;

const
  MaxColors =10;
  Colors    : Array [0..MaxColors-1] of TColor =
  (clRed,clBlack,clBlue,clGreen,clYellow,clAqua,clFuchsia,clLime,clPurple,clDkGray);
var
   Params     : TColorizationParams;
   DwmActive  : Boolean;
   i          : Integer;
begin
  try
    DwmActive:=Init_Dwm;
    try
      if DwmActive then
      begin
        //Get the current settings
        DwmGetColorizationParameters(Params);
        Writeln('Current Values');
        Writeln(format('Intensity %d - Colorization Color  %.8x - Colorization Afterglow Color %.8x %d %d %d',[Params.nIntensity,Params.clrColor,Params.clrAftGlow,Params.clrAftGlowBal,Params.clrBlurBal,Params.clrGlassReflInt]));
        try

          for i:= low(Colors) to high(Colors) do
          begin
            SetCompositionColor(Colors[i]);
            Writeln('Press enter to continue');
            Readln;
          end;

        finally
        //Restore the original settings
            DwmSetColorizationParameters(@Params,Bool(0));
        end;
      end
      else
      Writeln('Glass is not active');
    finally
      Done_Dwm;
    end;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  Readln;
end.

and this is the result

Finally just for fun I wrote a similar application to Aura using delphi (just in 240 lines of code ;P and without Net framework) and this is the result.

you can download the source code of this application from here

Categories: Delphi, DWM, WinApi
Follow

Get every new post delivered to your Inbox.

Join 61 other followers