Ah More's blog: May 2018

Tuesday, 22 May 2018

RAD Studio 10.1 Berlin - Delphi Barcode Scanner Android 行動條碼掃描

RAD Studio 10 Seattle - Delphi QRCode 條碼掃描功能

https://www.youtube.com/watch?v=gd9nsW_jLwA

Delphi 10 Seattle: Android Services and iOS Background Mode

Android Notification

unit UnitNotification;

interface

uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
System.Notification, FMX.Controls.Presentation, FMX.StdCtrls;

type
TForm1 = class(TForm)
    NotificationCenter1: TNotificationCenter;
    Button1: TButton;
     procedure DoNotification(aName, aTitle, aBody: string);
    procedure Button1Click(Sender: TObject);
private
    { Private declarations }
public
    { Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.DoNotification(aName, aTitle, aBody: string);
var
    appNotification: TNotification;
begin
    appNotification := NotificationCenter1.CreateNotification;
    try
        appNotification.Name := aName;
        appNotification.Title := aTitle;
        appNotification.AlertBody := aBody;
        NotificationCenter1.PresentNotification(appNotification);
    finally
        appNotification.Free;
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   DoNotification('Test Name', 'Test Title', 'This is an example');
end;

end.

Monday, 21 May 2018

System tray icon in Windows for FireMonkey app, examples

http://www.devsuperpage.com/search/Articles.aspx?G=2&ArtID=135482

Is not an option.

procedure Tmain_form.FormCreate(Sender: TObject);
var
   nid : TNotifyIconData;
   A: array [0..78] of Char;
begin
  StrPCopy(A, ParamStr(0));
  with nid do
  begin
    cbSize := SizeOf;
    Wnd := FmxHandleToHWND(self.Handle);
    uID := 1;
    uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
    uCallbackMessage := 100;
    hIcon := ExtractIconW(HInstance, A, 0);
    StrPCopy(szTip, 'This is my icon');
  end;
  Shell_NotifyIcon( NIM_ADD, @nid );
end;

This is my idea, but needs refinement.

[worked] FireMonkey隐藏任务栏图标

ＦＭＸ（FireMonkey）可以轻松实现很多ＶＣＬ无法或难以实现的特效，所以将ＦＭＸ程序作为界面，打包入ＤＬＬ由ＶＣＬ程序调用，是一个不错的方案。为了程序的完整性，你不想看见ＦＭＸ程序在任务栏上显示图标。可是普通的Windows函数似乎没有作用，比如你取得FMX窗体的句柄后，使用ShowWindow函数隐藏任务栏图标，结果是毫无作用。其实原因很简单，只是你使用的句柄不正确而已。
正确的源代码我贴出来，具体我就不解释了，相信有基础的人都能看懂。

unit Unit1;

interface

uses
Winapi.Windows,
Winapi.Messages,
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Platform.Win,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
FMX.Controls.Presentation, FMX.StdCtrls;

type
TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
private
    { Private declarations }
public
    { Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.Button1Click(Sender: TObject);
begin
//隐藏主程序在任务栏的图标
ShowWindow(ApplicationHWND, SW_HIDE);
//隐藏主程序在alt+tab中的图标
SetWindowLong(ApplicationHWND, GWL_EXSTYLE, WS_EX_TOOLWINDOW Or GetWindowLong(ApplicationHWND, GWL_EXSTYLE));
end;

end.

Wednesday, 2 May 2018

Delphi - How to get list of USB removable hard drives and memory sticks?

https://stackoverflow.com/questions/3718192/delphi-how-to-get-list-of-usb-removable-hard-drives-and-memory-sticks?utm_medium=organic&utm_source=google_rich_qa&utm_campaign=google_rich_qa

{$MINENUMSIZE 4}
const
  IOCTL_STORAGE_QUERY_PROPERTY =  $002D1400;

type
  STORAGE_QUERY_TYPE = (PropertyStandardQuery = 0, PropertyExistsQuery, PropertyMaskQuery, PropertyQueryMaxDefined);
  TStorageQueryType = STORAGE_QUERY_TYPE;

  STORAGE_PROPERTY_ID = (StorageDeviceProperty = 0, StorageAdapterProperty);
  TStoragePropertyID = STORAGE_PROPERTY_ID;

  STORAGE_PROPERTY_QUERY = packed record
    PropertyId: STORAGE_PROPERTY_ID;
    QueryType: STORAGE_QUERY_TYPE;
    AdditionalParameters: array [0..9] of AnsiChar;
  end;
  TStoragePropertyQuery = STORAGE_PROPERTY_QUERY;

  STORAGE_BUS_TYPE = (BusTypeUnknown = 0, BusTypeScsi, BusTypeAtapi, BusTypeAta, BusType1394, BusTypeSsa, BusTypeFibre,
    BusTypeUsb, BusTypeRAID, BusTypeiScsi, BusTypeSas, BusTypeSata, BusTypeMaxReserved = $7F);
  TStorageBusType = STORAGE_BUS_TYPE;

  STORAGE_DEVICE_DESCRIPTOR = packed record
    Version: DWORD;
    Size: DWORD;
    DeviceType: Byte;
    DeviceTypeModifier: Byte;
    RemovableMedia: Boolean;
    CommandQueueing: Boolean;
    VendorIdOffset: DWORD;
    ProductIdOffset: DWORD;
    ProductRevisionOffset: DWORD;
    SerialNumberOffset: DWORD;
    BusType: STORAGE_BUS_TYPE;
    RawPropertiesLength: DWORD;
    RawDeviceProperties: array [0..0] of AnsiChar;
  end;
  TStorageDeviceDescriptor = STORAGE_DEVICE_DESCRIPTOR;

function GetBusType(Drive: AnsiChar): TStorageBusType;
var
  H: THandle;
  Query: TStoragePropertyQuery;
  dwBytesReturned: DWORD;
  Buffer: array [0..1023] of Byte;
  sdd: TStorageDeviceDescriptor absolute Buffer;
  OldMode: UINT;
begin
  Result := BusTypeUnknown;

  OldMode := SetErrorMode(SEM_FAILCRITICALERRORS);
  try
    H := CreateFile(PChar(Format('\\.\%s:', [AnsiLowerCase(Drive)])), 0, FILE_SHARE_READ or FILE_SHARE_WRITE, nil,
      OPEN_EXISTING, 0, 0);
    if H <> INVALID_HANDLE_VALUE then
    begin
      try
        dwBytesReturned := 0;
        FillChar(Query, SizeOf(Query), 0);
        FillChar(Buffer, SizeOf(Buffer), 0);
        sdd.Size := SizeOf(Buffer);
        Query.PropertyId := StorageDeviceProperty;
        Query.QueryType := PropertyStandardQuery;
        if DeviceIoControl(H, IOCTL_STORAGE_QUERY_PROPERTY, @Query, SizeOf(Query), @Buffer, SizeOf(Buffer), dwBytesReturned, nil) then
          Result := sdd.BusType;
      finally
        CloseHandle(H);
      end;
    end;
  finally
    SetErrorMode(OldMode);
  end;
end;


procedure GetUsbDrives(List: TStrings);
var
  DriveBits: set of 0..25;
  I: Integer;
  Drive: AnsiChar;
begin
  List.BeginUpdate;
  try
    Cardinal(DriveBits) := GetLogicalDrives;

    for I := 0 to 25 do
      if I in DriveBits then
      begin
        Drive := Chr(Ord('a') + I);
        if GetBusType(Drive) = BusTypeUsb then
          List.Add(Drive);
      end;
  finally
    List.EndUpdate;
  end;
end;

Spesifikasi Harga Teripang

http://sinarlautannusantara.blogspot.my/p/spesifikasi-harga-teripang.html

I. Jenis Teripang buang kulit
1. Ukuran 06 - 10 ekor/ kg Rp. 600,000,.
2. Ukuran 10 - 15 ekor/ kg Rp. 450,000,.
3. Ukuran 15 – 20 ekor / kg Rp. 355,500,.
4. Ukuran 20 – 25 ekor / kg Rp. 307,500,.
5. Ukuran 25 – 30 ekor / kg Rp. 260,000,.
6. Ukuran 30 – 35 ekor / kg Rp. 245,000,.
7. Ukuran 40 – 45 ekor / kg Rp. 220,000,.
8. Ukuran 45 – 60 ekor / kg Rp. 210,000,.
9. Ukuran 80 – 100 ekor / kg Rp. 180,000,.
10. Ukuran 100 – 125 ekor / kg Rp. 160,000,.
11. Ukuran 125 – 150 ekor / kg Rp. 150,000,.
12. Ukuran 150 – 200 ekor / kg Rp. 140,000,.
13. Ukuran 200 – 250 ekor / kg Rp. 130,000,.
14. Ukuran 250 – 300 ekor / kg Rp. 95,500,.
15. Ukuran 300 – 400 ekor / kg Rp. 85,000,.
16. Ukuran 400 – 600 ekor / kg Rp. 75,000,.
17. Ukuran 600 – 1000 ekor / kg Rp. 50,500,.

II. Jenis Teripang Susu
1. Ukuran 3 – 4 ekor / kg Rp. 325,000,.
2. Ukuran 4 – 5 ekor / kg Rp. 215,000,.
3. Ukuran 7 – 8 ekor / kg Rp. 210,000,.

III. Jenis Teripang TKK
1. TKK Super 10 cm UP Rp. 277,000,.
2. TKK Besar 9 cm UP Rp. 245,000,.
3. TKK Sedang 6 cm UP Rp. 180,000,.
4. TKK Kecil 4 cm UP Rp. 62,500,.
5. TKK Halus 3 cm UP Rp. 23,750,.

IV. Jenis Terpang Kapuk
1. Ukuran 15 – 17 ekor / kg Rp. 325,000,.
2. Ukuran 20 – 30 ekor / kg Rp. 145,000,.
3. Ukuran 40 – 60 ekor / kg Rp. 72,500,.
4. Ukuran 80 – 100 ekor / kg Rp. 62,500,.

V. Jenis Teripang Nanas
1. Ukuran 6 – 10 ekor / kg Rp. 350,000,.
2. Ukuran 10 – 15 ekor / kg Rp. 275,000,.

VI. Jenis Teripang Sepatu
1. Ukuran 10 – 15 ekor / kg Rp. 225,000,.
2. Ukuran 15 – 25 ekor / kg Rp. 125,000,.
3. Ukuran 40 – 60 ekor / kg Rp. 75,500,.
4. Ukuran 80 – 100 ekor / kg Rp. 54,500,.

VII. Jenis Teripang Jepung
1. Ukuran 80 – 100 ekor / kg Rp. 305,500,.
2. Ukuran 100 – 180 ekor / kg Rp. 244,500,.

VIII. Jenis Teripang Kapuk Bola
1. Ukuran 10 – 17 ekor / kg Rp. 450,000,.
2. Ukuran 17 – 25 ekor / kg Rp. 230,000,.

IX. Jenis Teripang Gama
1. Gama Bintik Besar u/k 10 – 20 ekor / kg Rp. 125,000,.
2. Gama Bintik Sedang u/k 25 –30 ekor/ kg Rp. 75,250,.
3. Gama Bintik Kecil u/k 40 – 45 ekor / kg Rp. 65,500,.

Ah More's blog