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