library desktop;

uses Windows, Comobj, ShlObj, sysutils;//, forms;

type
  VarConstants = (
    INST_0,
    INST_1,       // $1
    INST_2,       // $2
    INST_3,       // $3
    INST_4,       // $4
    INST_5,       // $5
    INST_6,       // $6
    INST_7,       // $7
    INST_8,       // $8
    INST_9,       // $9
    INST_R0,      // $R0
    INST_R1,      // $R1
    INST_R2,      // $R2
    INST_R3,      // $R3
    INST_R4,      // $R4
    INST_R5,      // $R5
    INST_R6,      // $R6
    INST_R7,      // $R7
    INST_R8,      // $R8
    INST_R9,      // $R9
    INST_CMDLINE, // $CMDLINE
    INST_INSTDIR, // $INSTDIR
    INST_OUTDIR,  // $OUTDIR
    INST_EXEDIR,  // $EXEDIR
    __INST_LAST
    );
  TVariableList = INST_0..__INST_LAST;
  pstack_t = ^stack_t;
  stack_t = record
    next: pstack_t;
    text: PChar;
  end;

var
  g_stringsize: integer;
  g_stacktop: ^pstack_t;
  g_variables: PChar;
  g_hwndParent: HWND;

function PopString(str: PChar):integer;
var
  th: pstack_t;
begin
  if integer(g_stacktop^) = 0 then
    begin
    Result:=1;
    Exit;
    end;
  th:=g_stacktop^;
  lstrcpy(str,@th.text);
  g_stacktop^ := th.next;
  GlobalFree(HGLOBAL(th));
  Result:=0;
end;

function PushString(str: PChar):integer;
var
  th: pstack_t;
begin
  if integer(g_stacktop) = 0 then
    begin
    Result:=1;
    Exit;
    end;
  th:=pstack_t(GlobalAlloc(GPTR,sizeof(stack_t)+g_stringsize));
  lstrcpyn(@th.text,str,g_stringsize);
  th.next:=g_stacktop^;
  g_stacktop^:=th;
  Result:=0;
end;

function d_width(hwndParent: HWND; string_size: integer; variables: PChar; stacktop: pointer):integer; cdecl;
var c: integer;
begin
  // set up global variables
  g_stringsize:=string_size;
  g_hwndParent:=hwndParent;
  g_stacktop:=stacktop;
  g_variables:=variables;

  c:=GetSystemMetrics(SM_CXSCREEN);
  PushString(PChar(inttostr(c)));
  Result:=1;
end;

function d_color(hwndParent: HWND; string_size: integer; variables: PChar; stacktop: pointer):integer; cdecl;
var x,y: array[1..1] of integer;
r,g,b: integer;
rbuf,gbuf,bbuf: array[0..1024] of char;
begin
  // set up global variables
  g_stringsize:=string_size;
  g_hwndParent:=hwndParent;
  g_stacktop:=stacktop;
  g_variables:=variables;

  //Color
  PopString(@bbuf);
  PopString(@gbuf);
  PopString(@rbuf);
  b:=strtoint(bbuf);
  g:=strtoint(gbuf);
  r:=strtoint(rbuf);
  x[1]:=COLOR_BACKGROUND;
  y[1]:=RGB(r,g,b);
  SetSysColors(1,x,y);
  Result:=1;
end;

function d_paper(hwndParent: HWND; string_size: integer; variables: PChar; stacktop: pointer):integer; cdecl;
const
  CLSID_ActiveDesktop: TGUID = '{75048700-EF1F-11D0-9888-006097DEACF9}';
var
  buf: array[0..1024] of char;
  hObj: IUnknown;
  ADesktop: IActiveDesktop;
  wstr: PWideChar;
begin
  // set up global variables
  g_stringsize:=string_size;
  g_hwndParent:=hwndParent;
  g_stacktop:=stacktop;
  g_variables:=variables;

  //Active Desktop Wallpaper
  PopString(@buf);
  hObj     := CreateComObject(CLSID_ActiveDesktop);
  ADesktop := hObj as IActiveDesktop;
  wstr := AllocMem(MAX_PATH);
  try
    StringToWideChar(PChar(@buf), wstr, MAX_PATH);
    ADesktop.SetWallpaper(wstr, 0);
    ADesktop.ApplyChanges(AD_APPLY_ALL or AD_APPLY_FORCE);
  finally
    FreeMem(wstr);
  end;
  Result:=1;
end;

exports d_width, d_color, d_paper;

begin
end.