2020年12月15日 星期二

【Delphi Multi-Device Application】 SQLite掛載行動裝置的設定

我使用的是FDConnection 連接 SQLite,
首先FDConnection.DriverName選擇 SQLite,Params >  Database 選擇已建置好的SQLLite 資料庫

再配合 FDQuery 將資料取出反應在畫面的物件上,基本Application的架構這樣的設定就可以使用,要掛載到行動裝置需要再做以下的設定
Project > Deployment 設定發佈後SQLite的放置目錄,[Remote Path] 填入 assets\internal\ 
  • Remote Path on iOS Device platform: StartUp\Documents\
  • Remote Path on Android platform: assets\internal\

FDConnection BeforeConnection事件,在連線前變更讀取路徑

uses System.IOUtils;

procedure TForm1.FDConnection1BeforeConnect(Sender: TObject);
begin
{$IF DEFINED(iOS) or DEFINED(ANDROID)}
  FDConnection1.Params.Values['Database'] := TPath.Combine(TPath.GetDocumentsPath, 'WorkShifts.db');
{$ENDIF}
end;

資料庫有使用到中文的部份,記得將 FDConnection.Params.StringFormat設定為 stUnicode,才會在行動裝置上正確的顯示。



2020年11月17日 星期二

【Delphi Rx Multi-Device】 Andriod 環境建置

Delphi RX安裝時出現的提示畫面

需要下載 Java Se Development Kit 7

選擇[Y]會開啟Java Download的網頁,網頁自然會優先將最新版本顯示在網頁上,下載最新版本的JDK不會被Delphi套用,必須下載訊息畫面中Java SE Development Kit7的版本,在Java Download網頁我選擇下載的是 Java SE Development Kit 7u80 的版本。

安裝完 Java JDK、Delphi RX後,在Delphi Rx 選單 Tools 點選 Options來設定SDK Manager

Options

SDK Manager會有一組已存在的SDK Version的選項,建議刪除預設的SDK Version。
新增SDK Version設定適應的執行環境




圖中(1)(2)參考範例找到對應的SDK及NDK路徑,圖中(3)會自動帶出 (如果安裝的SDK版本沒有被Delphi接受,不會被自動帶出,即使手動填入也無法完成設定)。

完成SDK Manager設定,即可順利編譯Multi-Device的專案。

編譯後出現 [Exec Error] the command "PATH C:\Program files......的錯誤訊息

複製訊息,剔除訊息左邊第一個雙引號左邊的字串,及訊息最後一個雙引號右邊的字串,貼到 命令提示字元 中執行,結果出現 Could not create the Java Virtual Machine的錯誤

系統內容環境變數 裡新增系統變數



變數名稱 _JAVA_OPTIONS
變數值 -Xmx512m



2020年11月11日 星期三

【Delphi Multi-Device Application】 Menu選單

在畫面放置 [MultiView] ,再放置 [Button] 做事件觸發用,放置 [ShadowEffect][Multiview] 裡可以使 MultiView 有陰影的效果

在 MultiView屬性設定
  MasterButton 指向 Button1
  Mode 設定為 Drawer
MultiView設定

Button.StyleLookup 可以用來設定按鈕上的圖示

如果要做到 Button 觸發時,圖示轉動效果可以在 Button.OnClick 事件處理

--------------------
Button.OnClick
--------------------
  if button1.Tag=1 then
  begin
    Button1.AnimateFloat('RotationAngle', 0, 0.5);
    button1.Tag := 0;
  end
  else
  begin
    Button1.AnimateFloat('RotationAngle', 180, 0.5);
    button1.Tag := 1;
  end;

【Delphi Multi-Device Application】 觸控頁面滑動切換

 放置 [TabControl],並建立二個 [TabItem]TabControl.TabPosition屬性設置為None,如下圖

TabControl設定

放置 [ActionList],產生二個 ChangeTabAction,將Tab屬性分別對應到TabItem1、TabItem2
ActionList設定


放置 [GestureManager]
   TabControl.Touch選項
     GestureManager 指向 GestureManager1,
     Gestures → Standard觸控方向的動作,Left指向ChangeTabAction2,Right指向ChangeTabAction1。




2020年10月31日 星期六

【Delphi Multi-Device Application】 Button.Click 觸發頁面滑動切換

 放置 [TabControl],並建立二個 [TabItem]TabControl.TabPosition屬性設置為None,如下圖

TabControl設定

TabItem1裡放置 [Button1]TabItem2裡放置 [Button2] 做切換頁籤的觸發事件。

---------------------
Button1.OnClick
---------------------
  //滑動切換到第二個頁籤
  TabControl1.SetActiveTabWithTransition(Self.TabItem2, TTabTransition.Slide);

---------------------
Button2.OnClick
---------------------
  //滑動切換回第一個頁籤
  TabControl1.SetActiveTabWithTransition(Self.TabItem1, TTabTransition.Slide, TTabTransitionDirection.Reversed);


2020年9月18日 星期五

同樣是二戰戰敗國,為什麼德國擁有國防軍,而日本只有「自衛隊」

 原文網址:https://kknews.cc/history/rb4y8br.html

同樣是二戰戰敗國,為什麼德國擁有國防軍,而日本只有「自衛隊」

2018-07-26 由 軍林天下 發表于歷史

作為二戰戰敗國,德國和日本都被解除了武裝,照著《開羅宣言》和《波斯坦公告》來講,這兩個國家都不應該再擁有軍隊,然而為何現在德國擁有軍隊,日本卻沒有軍隊呢?

來看德國,德國有軍隊,而且是被歐美等國認可的。戰敗後的德國軍隊就地解散,國土分別被蘇聯和美國占領,分裂為東德和西德。蘇聯和美國本來就不對付,二戰剛結束那邊就開始冷戰。為了一決高下,東德和西德自然成了前沿戰場,蘇聯更是暗自組建東德軍隊。美國也不甘示弱,立即暗示西德也可以擁有自己的軍隊。於是本來就地解散的德國軍隊又回來了,西德第一任總理康拉德·阿登納在萊茵蘭-普法爾茨組建了新西德軍隊,並將軍隊改名為「聯邦國防軍」。

日本沒有軍隊,卻有一個和軍隊差不多意思的自衛隊。日本也是在1945年戰敗後被剝奪了武裝,軍事機構也被解散,美國直接大軍進駐日本。隨後,日本政府頒布《和平憲法》,宣布放棄戰爭放棄武力放棄宣戰權。整個日本幾乎成了美國的「中轉站」。直到韓戰爆發,美國發現日本手頭連拿的出手的警察都沒有,為了保證「中轉站」的「安全」,指示日本組建國家警察預備隊。到了1954年,日本政府受到美國指點,專門頒布了「防衛兩法」,日本自衛隊就出現在大家面前了。

日本自衛隊明面上是日本的警察隊伍,但是時至今日已經成為沒有名分的軍隊。一個警察隊伍,人數已經達到28萬餘人,甚至軍費與英法相當,排世界第五。日本右翼勢力近幾年瘋狂提出修改憲法的要求,出台各種海外派兵法,和美國簽訂安保協議,甚至直接出兵伊拉克、阿富汗。這支不是軍隊的日本自衛隊,在亞洲軍事實力排名相當靠前,比其他國家正規軍規模都要大,裝備、戰鬥力都要強。

2020年8月25日 星期二

Delphi 中GetLogicalDriveStrings 讀取磁碟代號列表

procedure TForm1.FormCreate(Sender: TObject);
var
  buf:array [0..MAX_PATH-1] of char;
  m_Result:Integer;
  i:Integer;
  str_temp:string;
begin
  m_Result:=GetLogicalDriveStrings(MAX_PATH,buf);
  for i:=0 to (m_Result div 4)-1 do
  begin
    str_temp:=string(buf[i*4]+buf[i*4+1]+buf[i*4+2]);
    ListBox1.Items.Add(str_temp);
  end;
 end;

轉貼至: https://www.codenong.com/cs105404755/

2020年7月30日 星期四

QuickReport 群組頁數/群組合計頁數

    ..
    labPageCount: TQRLabel;
    labTotalCount: TQRLabel;
    ..
  private
    { Private declarations }
    F_GroupPageCount:TStringList;
    F_GroupTotalCount:TStringList;
    ..
  end

procedure FormCreate(Sender: TObject);
begin
  F_GroupPageCount := TStringList.Create;
  F_GroupTotalCount := TStringList.Create;
end;


procedure labPageCountPrint(sender: TObject;  var Value: WideString);
var sGroupStr:String;
  iCount:Integer;
begin
  //群組頁數
  if QuickRep1.Printer.ShowingPreview or QuickRep1.QRPrinter.aPrinterSettings.Printer.Printing then
  begin
    sGroupStr := QuickRep1.DataSet.FieldByName('xxx').AsString;
    iCount := StrToIntDef(F_GroupPageCount.Values[sGroupStr], 0);
    F_GroupPageCount.Values[sGroupStr] := IntToStr(iCount + 1);
    Value := F_GroupPageCount.Values[sGroupStr];
  end;
end;


procedure labTotalCountPrint(sender: TObject;  var Value: WideString);
var sGroupStr:String;
  iCount:Integer;
begin
  //群組合計頁數 
  sGroupStr := QuickRep1.DataSet.FieldByName('xxx').AsString;
  if (not QuickRep1.Printer.ShowingPreview) and 
    (not QuickRep1.QRPrinter.aPrinterSettings.Printer.Printing) then
  begin
    iCount := StrToIntDef(F_GroupTotalCount.Values[sGroupStr], 0);
    F_GroupTotalCount.Values[sGroupStr] := IntToStr(iCount + 1);
  end
  Value := F_GroupTotalCount.Values[sGroupStr];
end;


procedure QuickRep1BeforePrint(Sender: TCustomQuickRep; var PrintReport: Boolean);
begin
  F_GroupPageCount.CommaText := '';
end;



QuickRep1.Prepare;
QuickRep1.PreviewModule;

2020年7月28日 星期二

TRegistry 操作

Uses Registry;

//取得RootKey下的節點
procedure TForm1.Button1Click(Sender: TObject);
var reg: TRegistry;
begin
  reg := TRegistry.Create;
  reg.RootKey := HKEY_LOCAL_MACHINE;
  reg.OpenKey('', False);
  reg.GetKeyNames(memo1.Lines); //取得RootKey下的節點
  reg.CloseKey;
  FreeandNil(reg);
end;

 
//取得節點內的設定
procedure TForm1.Button1Click(Sender: TObject);
var reg: TRegistry;
begin
  reg := TRegistry.Create;
  reg.RootKey := HKEY_LOCAL_MACHINE;
  reg.OpenKey('SOFTWARE\Microsoft\Jet\4.0\Engines\Excel', False);
  reg.GetValueNames(memo1.Lines); //取得節點內的設定
  reg.CloseKey;
  FreeandNil(reg);
end;


//取值
procedure TForm1.Button2Click(Sender: TObject);
var reg: TRegistry;
  sValue:Variant;
  sName:String;
begin
  reg := TRegistry.Create;
  reg.RootKey := HKEY_LOCAL_MACHINE;
  reg.OpenKey('SOFTWARE\Microsoft\Jet\4.0\Engines\Excel', False);   //
  sName := 'TypeGuessRows';
  if reg.ValueExists(sName) then
  begin
    //取節點內的設定值, 必須與設定值的資料型態相同
    if reg.GetDataType(sName)=rdInteger then
      sValue := reg.ReadInteger(sName)
    else if reg.GetDataType(sName)=rdString then
      sValue := reg.ReadString(sName);
  end;
  memo1.text := VarToStr(sValue);
  reg.CloseKey;
  FreeandNil(reg);
end;


//設定值
procedure TForm1.Button3Click(Sender: TObject);
var reg: TRegistry;
  sValue:Variant;
  sName:String;
begin
  reg := TRegistry.Create;
  reg.RootKey := HKEY_LOCAL_MACHINE;
  reg.OpenKey('SOFTWARE\Microsoft\Jet\4.0\Engines\Excel', False);
  sName := 'TypeGuessRows';
  if reg.ValueExists(sName) then
  begin
    //取節點內的設定值, 必須與設定值的資料型態相同
    if reg.GetDataType(sName)=rdInteger then
      reg.WriteInteger(sName, 0)
    else if reg.GetDataType(sName)=rdString then
      reg.WriteInteger(sName, 0)
  end;
  reg.CloseKey;
  FreeandNil(reg);
end;

2020年7月24日 星期五

Client:TSocketConnection和Server:Scktsrvr關系----壓縮數據傳輸

Client:TSocketConnection和Server:Scktsrvr關系----壓縮數據傳輸

一直用SocketConnection和服務端的傳輸數據在三層數據庫中,從來沒有注意到它們之間的數據傳輸,只是想著,管它了,網絡的事,前段時間在Delphi中的Demos中發現DemosMidasIntrcpt.dpr例子,呵呵,再看了半天的VCL發現可以將Client端發送的給Server的數據,和Server發送給Client的數據是可以進行壓縮的。呵呵,不敢藏私,Share給大家。


1:
准備工作,先delphi光盤中的infoextraszlibzlib.pas進行編繹,然後copy 到lib路徑中,因為要壓縮數據,必須要有壓縮功能,這個delphi已經自帶,它是基於流的方式對接口IDataBlock(TDataBlock實現,其實就是對TMemoryStream的操作)數據進行壓縮和解壓的。做了這個後,才能進行下面的工作。
2:
Open DemosMidasIntrcptIntrcpt.dpr 
complier....(如沒有做第一步,嘿嘿...)
生成Intrcpt.dll 
將Intrcpt.dll copy to System directory,或者你的程序下面。
注冊它:regsrvr32 Intrcpt.dll (為什麼,這個嘛...)
記住Intrcpt.dpr的那個GUID,你也可以自己重新生成一個(按Shift+Ctrl+G)
3:
Server: 
Open scktsrvr.exe,相信各位都很熟悉那界面,端口(TListbox),Thread Cache Size(TEdit), GUID(TEdit),好,我們要做的事,就是將注冊的Intrcpt.dll那個GUID填到這個GUID(TEdit)框框中,
只需填自己程序的的那個端口的GUID啊,別亂填,如果有別人用這個程序,出了什麼,別找我。OK,Apply.
Client:
你寫的程序中肯定有TSocketConnection,它有個屬性InterceptGUID: string;好了,將Intrcpt.dll的GUID填上去,它是跟Server中的一樣的。OK.還有別忘了,Regsrvr32 intrcpt.dll 在你的客戶端。不然,程序雖不會raise,但是Server傳過來的數據是壓縮的....  

好了,呵呵。就這些了。3步驟,很清楚吧(不會吧,還不懂,倒)

原理

scktsrvr.exe其實是一堆TServerSocket,一個端口代表了一個TServerSocket,每個TServerSocket是基於多線程方式與客戶端進行數據交換。它寫了個TServerClientThread(在服務端中的客戶端)的擴展
,多加了對客戶端數據接收的管理解析,還有ActivityDateTime,GUID,一般不管它。但是我們用到的壓縮只是跟這個GUID有關,其它費話少說。

Server接受一個Client連接,則加一個TServerClientThread到本地中,用來監控Client Read 和Close事件,所以Server中的scktsrvr中我們只要了解了TServerClientThread動作方式就行了。
(
題外話:Server Socket中有客戶端連接後,記錄ClientSocket.Handle,並且將根據這個Handle產生一個TServerClientWinSocket對象加入到Connections(TList)對象中,當任何對這個Client的動作也就是說Server 發送和接收數據都是根據這個Client Handle來進行的,相應的ServerSocket中的Connections中的ClientSocket也發生相應的變化。
)

有兩個類跟這個TServerClientThread(實現ISendDataBlock接口)有關

1: TDataBlockInterpreter(對發送過來的數據進行解析InterpretData(Data: IDataBlock))
  解析數據(水平有限,對它真是還是一知半解,有錯請指出)
    接口類IDataBlock,由TDataBlock通過TMemoryStream的讀寫來實現,其中Signature是其主要標識,說明這個IDataBlock的數據類型    ,TDataBlockInterpreter根據Signature來對應進行相應的調用,  如:
    Client端連接後,在Server要運行應用服務器(Application Server),
    Client端需要得到ServerName 列表,
    Client端得到Server 的DataBroker的列表,
    Client端斷開連接後,Server要Close應用服務器(Application Server),
    Client和Server的數據交換,也是由它來解析。
所以這個IDataBlock的數據很重要,而我們的壓縮和解壓就是針對於它,但是TDataBlockInterpreter是得到Data才對它解析,因而我們要在Send 和Recv 之前對它解壓和壓縮。這個任務在TSocketTransport身上。    

2: TSocketTransport;(數據進行發送和接收, 實現ITransport接口)
  Server端:
    在Server端,TSocketTransport其實就是一個用來管理對ClientSocket實例,它將ClientSocket.Handle生成一個對象後,ClientSocket發送和接收過來的Data,在發送Data之前,它將調用InterceptOutgoing(Data: IDataBlock)函數,這個函數的功能是:
如果InterceptGUID <> ,那麼它將根據這個GUID生成一個COM(Obj)對象,Obj.DataOut(Data: IDataBlock),也就是我們注冊的那個壓縮的DLL中的那個壓縮函數,將壓縮過後的Data再發送出去。這就完成compress and send Data.(我試過那個壓縮功能,壓縮比大概是1/9,像zip壓縮比差不多).
由客戶端傳過來的數據調用InterceptIncoming(Data: IDataBlock)函數,這就不多說了,Data := 解壓後的Data.  壓縮和解壓過後的Data交由TDataBlockInterpreter去解析,完成一次數據交換。  
  Client端:
    說完Server端,客戶端的道理也是差不多的。唯一不同的是Server端中不調用ITransport.SetConnected()方法,因為它是根據ClientSocket.Handle生成的對象,也就是它是已經連接的對象,而Client端的TSocktConnection調用Connected := True時,其實就是調用ITransport.SetConnect將一個ClientSocket連接到Server端中的TServerSocket中,然後TServerSocket根據這個ClientSocket.Handle生成了一個TServerClientThread對象保存在本地中,開始對這個ClientSocket的監控(FD_Read, FD_Close消息事件).

注:
  IDataBlock由TDataBlock實現,主要是管理TMemoryStream來存放數據
  ITransport由TSocketTransport實現,主要是用TClientSocket來連接TServerSocket,並和它進行交換數據。
  ISendDataBlock在Scktsrvr.exe中由TServerClientThread實現,通過TSocketTransport來發送數據.

轉貼至 http://www.aspphp.online/bianchen/gengduo/delphi/201701/221405.html

2020年7月20日 星期一

Display Menu Item Hints


  F_HintWindow:THintWindow;
  ..
  Private
    procedure WMMenuSelect(var Msg: TWMMenuSelect) ; message WM_MENUSELECT; 
  ..
  ..
procedure TForm1.WMMenuSelect(var Msg: TWMMenuSelect); 
var miSelectItem:TMenuItem;
  hSubMenu : HMENU;
begin
  if Msg.MenuFlag and MF_POPUP = MF_POPUP then
  begin
    hSubMenu := GetSubMenu(Msg.Menu, Msg.IDItem) ;
    miSelectItem := Self.Menu.FindItem(hSubMenu, fkHandle) ;
  end
  else
  begin
    miSelectItem := Self.Menu.FindItem(Msg.IDItem, fkCommand) ;
  end;
  //
  if not Assigned(miSelectItem) then
    Exit;
  //
  if True then
  begin
    pr_Show_HintWindow('Display Menu Item Hints');
  end
  else
  begin
    pr_Close_HintWindow;
  end;
end;

procedure TForm1.pr_Show_HintWindow(AText:String);
var pPoint:TPoint;
  iHeight, iWidth:Integer;
begin
  if not Assigned(F_HintWindow) then
    F_HintWindow := THintWindow.Create(Self);
  //
  pPoint := ClientToScreen(Mouse.CursorPos);
  iHeight := Canvas.TextHeight(AText);
  iWidth := Canvas.TextWidth(AText);
  F_HintWindow.ActivateHint(Rect(pPoint.X, pPoint.Y,pPoint.X+iWidth, pPoint.Y+iHeight), AText);
end;

procedure TForm1.pr_Close_HintWindow;
begin
  if Assigned(F_HintWindow) then
    F_HintWindow.ReleaseHandle;
end;

參考
  https://www.thoughtco.com/how-to-display-menu-item-hints-1058397

2020年6月30日 星期二

Delphi 執行檔,程式碼執行無法繼續,因為找不到Borlndmm.dll。...

Delphi 獨立執行檔(Exe),啟動後出現錯誤訊息
"程式碼執行無法繼續,因為找不到borlndmm.dll。重新安裝程式或許可以修正此問題。"


與 uese ShareMem有關

在字串中重複的出現次數


function fn_StrOccurrences(const ASubStr, AText:String):Integer; //在字串中重複的出現次數
var iOffset:Integer;
begin
  Result := 0;
  iOffset := PosEx(ASubStr, AText, 1);
  while iOffset<>0 do
  begin
    Inc(Result);
    iOffset := PosEx(ASubStr, AText, iOffset + Length(ASubStr));
  end;
end;

轉貼至:http://grandruru.blogspot.com/2016/08/blog-post.html

2020年6月25日 星期四

...import an Excel Table to a TStringgrid?

...import an Excel Table to a TStringgrid?
Autor: Thomas Stutz

uses
  ComObj;

function Xls_To_StringGrid(AGrid: TStringGrid; AXLSFile: string): Boolean;
const
  xlCellTypeLastCell = $0000000B;
var
  XLApp, Sheet: OLEVariant;
  RangeMatrix: Variant;
  x, y, k, r: Integer;
begin
  Result := False;
  // Create Excel-OLE Object
  XLApp := CreateOleObject('Excel.Application');
  try
    // Hide Excel
    XLApp.Visible := False;

    // Open the Workbook
    XLApp.Workbooks.Open(AXLSFile);

    // Sheet := XLApp.Workbooks[1].WorkSheets[1];
    Sheet := XLApp.Workbooks[ExtractFileName(AXLSFile)].WorkSheets[1];

    // In order to know the dimension of the WorkSheet, i.e the number of rows
    // and the number of columns, we activate the last non-empty cell of it

    Sheet.Cells.SpecialCells(xlCellTypeLastCell, EmptyParam).Activate;
    // Get the value of the last row
    x := XLApp.ActiveCell.Row;
    // Get the value of the last column
    y := XLApp.ActiveCell.Column;

    // Set Stringgrid's row &col dimensions.

    AGrid.RowCount := x;
    AGrid.ColCount := y;

    // Assign the Variant associated with the WorkSheet to the Delphi Variant

    RangeMatrix := XLApp.Range['A1', XLApp.Cells.Item[X, Y]].Value;
    //  Define the loop for filling in the TStringGrid
    k := 1;
    repeat
      for r := 1 to y do
        AGrid.Cells[(r - 1), (k - 1)] := RangeMatrix[K, R];
      Inc(k, 1);
      AGrid.RowCount := k + 1;
    until k > x;
    // Unassign the Delphi Variant Matrix
    RangeMatrix := Unassigned;

  finally
    // Quit Excel
    if not VarIsEmpty(XLApp) then
    begin
      // XLApp.DisplayAlerts := False;
      XLApp.Quit;
      XLAPP := Unassigned;
      Sheet := Unassigned;
      Result := True;
    end;
  end;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  if Xls_To_StringGrid(StringGrid1, 'C:\Table1.xls') then
    ShowMessage('Table has been exported!');
end;

轉貼至:https://www.swissdelphicenter.ch/en/showcode.php?id=1728

2020年6月9日 星期二

Table 分組後取最大的資料列


1.
  Select A.* 
  From [Table1] as A
  Inner Join (
              Select [Field01], Max([Score]) Score
              From [Table1]
              Group By [Field01) as B on A.[Field01]=B.[Field01] and A.[Score]=B.[Score] 
  Order By A.[Field01]

2.
  Select *
  From (
    Select ROW_NUMBER() OVER(PARTITION BY [Field01] ORDER BY [Score] DESC) as rowid, *
    FROM [Table1]
  )
  Where rowid=1

2020年4月27日 星期一

C# PadLeft / PadRight 字串補指定字元


string str="A";
str.PadLift(3,'0'); --> 00A 左邊補指定字元
str.PadRight(3, '0'); --> A00 右邊補指定字元

2020年4月21日 星期二

C# InputBox 輸入視窗

using System.Windows.Forms;
using System.Drawing;

public static DialogResult InputBox(string title, string promptText, ref string value)
{
  Form form = new Form();
  Label label = new Label();
  TextBox textBox = new TextBox();
  Button buttonOk = new Button();
  Button buttonCancel = new Button();

  form.Text = title;
  label.Text = promptText;
  textBox.Text = value;

  buttonOk.Text = "OK";
  buttonCancel.Text = "Cancel";
  buttonOk.DialogResult = DialogResult.OK;
  buttonCancel.DialogResult = DialogResult.Cancel;

  label.SetBounds(9, 20, 372, 13);
  textBox.SetBounds(12, 36, 372, 20);
  buttonOk.SetBounds(228, 72, 75, 23);
  buttonCancel.SetBounds(309, 72, 75, 23);

  label.AutoSize = true;
  textBox.Anchor = textBox.Anchor | AnchorStyles.Right;
  buttonOk.Anchor = AnchorStyles.Bottom | AnchorStyles.Right;
  buttonCancel.Anchor = AnchorStyles.Bottom | AnchorStyles.Right;

  form.ClientSize = new Size(396, 107);
  form.Controls.AddRange(new Control[] { label, textBox, buttonOk, buttonCancel });
  form.ClientSize = new Size(Math.Max(300, label.Right + 10), form.ClientSize.Height);
  form.FormBorderStyle = FormBorderStyle.FixedDialog;
  form.StartPosition = FormStartPosition.CenterScreen;
  form.MinimizeBox = false;
  form.MaximizeBox = false;
  form.AcceptButton = buttonOk;
  form.CancelButton = buttonCancel;

  DialogResult dialogResult = form.ShowDialog();
  value = textBox.Text;
  return dialogResult;
}




 Ex:

string value = "Document 1";

if (Tmp.InputBox("New document", "New document name:", ref value) == DialogResult.OK)
{
  myDocument.Name = value;
}

轉貼至 https://dotblogs.com.tw/aquarius6913/2014/09/03/146444

2020年3月24日 星期二

C# MessageBox 常用語法

  MessageBox.Show("Hello World");



  DialogResult result;
  result = MessageBox.Show("Are you OK?", "Question",
    MessageBoxButtons.YesNo,
    MessageBoxIcon.Question);
  if (result = DialogResult.Yes)
  {
    ...
  }


2020年3月20日 星期五

C# DevExpress PopupMenu




                    Point pointPos = new Point();
                    pointPos.X = button1.Left;
                    pointPos.Y = button1.Left + button1.Height;
                    pointPos = button1.PointToScreen(pointPos);
                    popupMenu1.ShowPopup(pointPos);

2020年3月5日 星期四

Which is the best way to load a string (HTML code) in TWebBrowser?

procedure THTMLEdit.EditText(CONST HTMLCode: string);
var
  Doc: Variant;
begin
  if NOT Assigned(wbBrowser.Document) then
    wbBrowser.Navigate('about:blank');

  Doc := wbBrowser.Document;
  Doc.Clear;
  Doc.Write(HTMLCode);
  Doc.Close;
end;


https://stackoverflow.com/questions/39773033/which-is-the-best-way-to-load-a-string-html-code-in-twebbrowser

2020年2月25日 星期二

URLDownloadToFile - some pages is not download

It seems that Win7 does some of the work for us - that is to say, I just tried the code in a virtual machine with XP and VS2005 - I got the same problem, i.e error (from the watch window) - "hRes 0x800401e4 Invalid syntax HRESULT"

Earlier in the evening I had read that you need to make sure COM is initialized for the thread. I disregarded this and plowed on - this was fine when I used Win7 and Vs2010.

Anyway, the fix was to use CoInitialize(NULL); before the call to URLDownloadToFile - after this change, hRes holds S_OK afterwards. :)

Listing as tested with VS2005 in XP
Hide   Copy Code
#include "stdafx.h"
#include <windows.h>
#include <urlmon.h>

int main()
{
CoInitialize(NULL);
HRESULT hRes;
hRes = URLDownloadToFile(NULL, L"http://www.google.com/", L"google.com.file", 0, NULL);

return 0;
}

Posted 12-Aug-12 9:03am
enhzflep


https://www.codeproject.com/Questions/439137/URLDownloadToFile-some-pages-is-not-download

DELPHI TDownLoadURL下载网络文件



unit Unit1;

interface

uses
  //引用   Vcl.ExtActns
  Vcl.ExtActns,
  System.SysUtils, System.Types, System.UITypes, System.Classes,
  System.Variants,
  FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, FMX.Edit;

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    ProgressBar1: TProgressBar;
    Edit1: TEdit;
    GroupBox2: TGroupBox;
    Edit3: TEdit;
    Edit4: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    procedure URL_OnDownloadProgress(Sender: TDownLoadURL;
    Progress, ProgressMax: Cardinal; StatusCode: TURLDownloadStatus;
    StatusText: String; var Cancel: Boolean);
  public
    { Public declarations }
  end;

var

  Form1: TForm1;

implementation

{$R *.fmx}

var

  DownLoadURL1:TDownLoadURL;


//url=网络文件  'http://helloroman.oicp.net:8000/test.rar';
//Filename=保存到本地文件 'D:\Administrator\Desktop\123.rar';

function DownLoadFile(url,Filename:string):boolean;
var
  DownLoadURL1:TDownLoadURL;
begin
  try
    DownLoadURL1:=TDownLoadURL.Create(Form1);
    DownLoadURL1.URL:= url;
    DownLoadURL1.Filename:= Filename;
    DownLoadURL1.OnDownloadProgress:=Form1.URL_OnDownloadProgress;
    DownLoadURL1.ExecuteTarget(nil);
    DownLoadURL1.Free;
    Result:=true;
  except
    Result:=false;
  end;
end;


procedure DownLoadThread;
begin
  Form1.label3.Text:='0 kb / 0 kb';
  if DirectoryExists(ExtractFilePath(Form1.edit4.text)) then
  begin
    if not DownLoadFile(Form1.edit3.text,Form1.edit4.text) then
      Form1.GroupBox1.Text:='下载失败'
    else
      Form1.GroupBox1.Text:='下载完毕';
  end
  else
     SHowMessage(Form1.edit4.text + '不存在!');
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  TThread.CreateAnonymousThread(DownLoadThread).Start;
end;

function BytesToStr(iBytes: Integer): String;
var
  iKb: Integer;
begin
  iKb := Round(iBytes / 1024);
  if iKb > 1000 then
    Result := Format('%.2f MB', [iKb / 1024])
  else
    Result := Format('%d KB', [iKb]);
end;

// 获取网络文件名
function GetUrlFileName(url:string):string;
var
 str:string;
begin
 url:=StringReplace(StrRScan(PChar(url),'/'), '/', '',[rfReplaceAll]);
 if Pos('=',url) > 0 then
    url:=StringReplace(StrRScan(PChar(url),'='), '=', '',[rfReplaceAll]);
 Result:=url;
end;

procedure TForm1.URL_OnDownloadProgress(Sender: TDownLoadURL;
  Progress, ProgressMax: Cardinal; StatusCode: TURLDownloadStatus;
  StatusText: String; var Cancel: Boolean);
begin
  ProgressBar1.Max := ProgressMax div 100;
  ProgressBar1.Value := Progress div 100;

  Caption := StatusText;

  case StatusCode of
    dsFindingResource:GroupBox1.Text:='查找资源...';
    dsConnecting:GroupBox1.Text:='连接中...';
    dsRedirecting:GroupBox1.Text:='';
    dsBeginDownloadData:GroupBox1.Text:='准备下载文件...';
    dsDownloadingData:GroupBox1.Text:='下载中...';
  end;


  Edit1.Text:= Format('文件名:%s',[GetUrlFileName(Edit3.Text)]);
  label3.Text := Format('%s / %s', [BytesToStr(Progress),BytesToStr(ProgressMax)]);
end;

end.



http://www.cnblogs.com/xe2011/p/3719454.html

2020年2月20日 星期四

How to download a file from the Internet


uses
  URLMon, ShellApi;

function fn_DownloadFile(ASourceFile, ADestFile: String): Boolean;
begin
  try
    Result := UrlDownloadToFile(nil, PChar(ASourceFile), PChar(ADestFile), 0, nil) = 0;
  except
    Result := False;
  end;
end;


URLDownloadToFile function

https://docs.microsoft.com/en-us/previous-versions/windows/internet-explorer/ie-developer/platform-apis/ms775123(v=vs.85)?redirectedfrom=MSDN

2020年2月13日 星期四

遞迴 SQL With...

  with [recursive] as(
    ----------------------
    --資料來源 begin
    ----------------------
    Select field1 , field2
    From Table a
    Where field1 = 1
    --------------------
    --資料來源 end
    -------------------
    Union All
    Select b.field1, b.field2
    From Table b
    Join [recursive] on b.field2 = [recursive].fied01
  )
  select * from [recursive]