HABExplora/Splash.pas at master · daveake/HABExplora · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
unit Splash;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls,
{$IFDEF ANDROID}
  FMX.Helpers.Android, FMX.Platform.Android,
  Androidapi.JNI.JavaTypes, Androidapi.Helpers,
  Androidapi.JNI.GraphicsContentViewText,
{$ENDIF}
{$IFDEF MSWINDOWS}
    Windows,
{$ENDIF}
  Base, FMX.Objects, FMX.Controls.Presentation, FMX.Layouts, FMX.ListBox, Math;

type
  TfrmSplash = class(TfrmBase)
    Image1: TImage;
    rectLoading: TRectangle;
    Label1: TLabel;
    lblVersion: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
    procedure Image1Resized(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure UnveilSplash;
  end;

var
  frmSplash: TfrmSplash;

implementation

{$R *.fmx}

uses Main, Misc, Debug;

procedure TfrmSplash.FormCreate(Sender: TObject);
var
    Bits: Integer;
{$IFDEF ANDROID}
    PackageManager: JPackageManager;
    PackageInfo: JPackageInfo;
{$ENDIF}
{$IFDEF MSWINDOWS}
    verblock:PVSFIXEDFILEINFO;
    versionMS,versionLS:cardinal;
    verlen:cardinal;
    rs:TResourceStream;
    m:TMemoryStream;
    p:pointer;
    s:cardinal;
{$ENDIF}
begin
    ApplicationName := 'HAB Explora';
    ApplicationVersion := '';
    Bits := SizeOf(Pointer) * 8;

{$IFDEF ANDROID}
    try
        PackageManager := TAndroidHelper.Context.getPackageManager; //SharedActivityContext.getPackageManager;
        PackageInfo := PackageManager.getPackageInfo(TAndroidHelper.Context.getPackageName, 0);  //SharedActivityContext.getPackageName, 0);
        ApplicationVersion := JStringToString(PackageInfo.versionName);
    except
    end;
{$ENDIF}
{$IFDEF MSWINDOWS}
    m:=TMemoryStream.Create;
    try
        rs:=TResourceStream.CreateFromID(HInstance,1,RT_VERSION);
        try
            m.CopyFrom(rs,rs.Size);
        finally
            rs.Free;
        end;

        m.Position:=0;

        if VerQueryValue(m.Memory,'\',pointer(verblock),verlen) then begin
            VersionMS:=verblock.dwFileVersionMS;
            VersionLS:=verblock.dwFileVersionLS;
            ApplicationVersion := 'V' +
                                  IntToStr(versionMS shr 16)+'.'+
                                  IntToStr(versionMS and $FFFF)+'.'+
                                  IntToStr(VersionLS shr 16)+'.'+
                                  IntToStr(VersionLS and $FFFF);
        end;

        if VerQueryValue(m.Memory,PChar('\\StringFileInfo\\'+
          IntToHex(GetThreadLocale,4)+IntToHex(GetACP,4)+'\\FileDescription'),p,s) or
            VerQueryValue(m.Memory,'\\StringFileInfo\\040904E4\\FileDescription',p,s) then begin
            ApplicationName := pChar(p);
        end else begin
            ApplicationName := Application.Title;
        end;

   finally
        m.Free;
    end;
{$ENDIF}

    lblVersion.Text := ApplicationName + ' ' + ApplicationVersion + ' ' + IntToStr(Bits) + ' bits';
end;

procedure TfrmSplash.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
    if frmDebug <> nil then begin
        frmMain.LoadForm(nil, frmDebug);
    end;
end;


procedure TfrmSplash.Image1Resized(Sender: TObject);
var
    UsedHeight, BlockHeight: Double;
begin
    UsedHeight := Min(Image1.Height, Image1.Width * Image1.Bitmap.Height / Image1.Bitmap.Width);

    BlockHeight := Image1.Height / 2 - UsedHeight * 0.34;

    rectLoading.Height := BlockHeight;

    // lblVersion.Height := BlockHeight;
end;

procedure TfrmSplash.UnveilSplash;
begin
    rectLoading.Visible := False;
end;

end.