RnQ/RnQ/aboutDlg.pas

{
  This file is part of R&Q.
  Under same license
}
unit aboutDlg;
{$I RnQConfig.inc}

interface

uses
  Windows, SysUtils, Classes, Graphics, Controls, Forms, Variants, StrUtils,
  Sciter, SciterApi;

{$I NoRTTI.inc}

type
  TAboutFrm = class(TForm)
    About: TSciter;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure AboutLoadData(ASender: TObject; const url: WideString; resType: SciterResourceType; requestId: Pointer;
      out discard, delay: Boolean);
    procedure AboutScriptingCall(ASender: TObject; const Args: TElementOnScriptingCallArgs);
  public
    procedure View;
    procedure CreateParams(var Params: TCreateParams); override;
    // public procedure destroyHandle;
  end;

  procedure FormCloseCustom(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;

var
  aboutFrm: TAboutFrm = nil;

implementation

uses
  UITypes, RQUtil, RnQLangs, RnQPics, utilLib, globalLib;

{$R *.DFM}

procedure TAboutFrm.AboutLoadData(ASender: TObject; const url: WideString; resType: SciterResourceType;
  requestId: Pointer; out discard, delay: Boolean);
var
  realurl: String;
  FDataStream: TMemoryStream;
begin
  if StartsText('template:', url) then
  begin
    realurl := copy(url, 10, Length(url));
    FDataStream := TMemoryStream.Create;
    (ASender as TSciter).GetPackedItem('template', PWideChar(realurl), FDataStream);
    (ASender as TSciter).DataReady(url, FDataStream.Memory, FDataStream.Size);
    FDataStream.Free;
  end
end;

procedure TAboutFrm.AboutScriptingCall(ASender: TObject; const Args: TElementOnScriptingCallArgs);
begin
  if Args.Method = 'getNativeApi' then
  with TSciter do
  begin
    RegisterNativeFunctor(Args.ReturnSciterValue, 'GetTranslation', @GetTrans);
    RegisterNativeFunctor(Args.ReturnSciterValue, 'FormClose', @FormCloseCustom, Self);
    Args.Handled := True;
  end;
end;

procedure TAboutFrm.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    // Style := Style and (not WS_CAPTION);
    // Style := Style and not WS_OVERLAPPEDWINDOW or WS_BORDER and (not WS_CAPTION);
    // Style := (Style or WS_POPUP) and (not WS_DLGFRAME);
    ExStyle := ExStyle or WS_EX_APPWINDOW
  end;
end;

procedure TAboutFrm.View;
var
  bt: TDateTime;
  params: OleVariant;
  ver, build: String;
  mem: TMemoryStream;
  buf: Pointer;
  ico: TIcon;
begin
  ver := IntToStr(RnQBuild) + ' ' + getTranslation('Build') + ' ' + IntToStr(RnQBuildCustom);
{$IFDEF CPUX64}
  ver := ver + ' x64';
{$ENDIF CPUX64}
{$IFDEF UNICODE}
{$ELSE nonUNICODE}
  ver := ver + ' Ansi';
{$ENDIF UNICODE}
  bt := builtTime;
  build := getTranslation('Built at') + ' ' + DateTimeToStr(bt) + ' [Mikanoshi]';
  About.Call('setLabels', [ver, build]);

  ico := TIcon.Create;
  ico.Handle := LoadImage(hInstance, PIC_RNQ_NEW, IMAGE_ICON, 48, 48, LR_DEFAULTCOLOR);
  mem := TMemoryStream.Create;
  try
    ico.SaveToStream(mem);
    mem.Seek(0, soBeginning);
    params := VarArrayCreate([0, mem.Size - 1], varByte);
    buf := VarArrayLock(params);
    mem.ReadBuffer(buf^, mem.Size);
    VarArrayUnlock(params);
  finally
    ico.Free;
    mem.Free;
  end;
  About.Call('setLogo', [params]);

  showForm(Self);
end;

procedure TAboutFrm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  aboutFrm := nil;
  Action := caFree;
end;

procedure TAboutFrm.FormCreate(Sender: TObject);
begin
  Icon.Handle := LoadIcon(hInstance, PIC_RNQ_NEW);
  LoadTemplate(About, 'template', 'about.htm');
end;

procedure FormCloseCustom(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
  if Assigned(tag) then
    TAboutFrm(tag).Close;
end;

procedure TAboutFrm.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #27 then
  begin
    Close;
    Key := #0;
  end;
end;

end.