記憶體資料表 TMemDataset 控件的使用

bruce0829

分類 : win32 版本

TMemDataset 就是存在記憶體上的資料表 (Table) 控件, 可供我們臨時存放二維資料之用, 也可當陣列使用, 處理一些需要在背景即時處理的資料運算功能, 像是收銀機上的刷入商品交易明細 Table, 每筆交易結帳後產生交易資料電文檔後即清空(等待下一個來客交易), 它就可以直接拿 TMemDataset  來用, 不用實際在硬碟中開一個實體 Table 檔, 免除 FILE I/O 的動作

■ TMemDataset 的問題
Lazarus 的 MemDataset  控件固然好用, 但它還有一些 bug, 像是它沒有一般 Table 控件都有的 搜尋Locate(), 排序索引(Index), 清空 EmptyTable() 等功能無法運作, 或是有該功能 Function 但使用時無反應 (如 Locate() ), 不過這些都是小事情, 今天要介紹的就是如何幫 MemDataset  控件加入這些功能, 讓它跟一般的 Table 控件一樣方便 ; 換句話說, 經過以下函式的加強與處理,  MemDataset  控件就有完整的搜尋, 排序功能 (我把學校書本中學過的快速排序法都拿出來實做了)


■ 相關公用函式介紹
寫了一些公用函式, 主要是做字串處理的, 不只今天介紹的加強 MemDataset 功能會用到, 以後在別的地方也可以用
//------------------------------------------------------------------------------------------------------------------------------------
// 函數名稱：function _StrSeg(Str ,SegSymbol: String ; SegIndex: integer): String;
// 中文說明：依照逗點或其他分隔符號,取出字串中某一區段  
// 傳 回 值：原始字串中第某段的字串
// 參    數：(原始字串, 分隔符號, 段別)
// 機能說明：分隔符號可以是任何字元(如逗點,分號,或是空白),甚至可以多 Byte 字串當分隔符號
//           例如有個字串(原始字串) S 內容為 'A,B,C,D,E;F,G'
//           _StrSeg(S,',',2); 表以逗點當分隔字元識別,並取出第二段內容->'A,B,C,D,E;F,G' -> 即取出'B'
//           _StrSeg(S,';',2); 表以分號當分隔字元識別,並取出第二段內容->'A,B,C,D,E;F,G' -> 即取出'F,G'
//           _StrSeg(S,'D,E',2); 表以'D,E'(多 Byte 字串)當分隔字元識別,並取出第二段內容->'A,B,C,D,E;F,G' -> 即取出';F,G'
//------------------------------------------------------------------------------------------------------------------------------------
function _StrSeg(Str ,SegSymbol: String ; SegIndex: integer): String;
var r,c,s,sTmp : String;
    i:integer;
begin
  r:='';
  if ((Str='') or (SegIndex<1)) then
     begin
       result:=r;
       exit;
     end;
  c:=UTF8ToAnsi(SegSymbol);
  if (c='') then c:=',';
  i:=0;
  s:=UTF8ToAnsi(Str);
  sTmp:='';
  while Pos(c,s)>0 do
        begin
          i:=i+1;
          sTmp := Copy(s,1,Pos(c,s)-1);
          if (SegIndex=i) then
             begin
               r:=AnsiToUTF8(sTmp);
               break;
             end;
          s:=Copy(s , Pos(c,s)+Length(c) , Length(s)-(Pos(c,s)+Length(c))+1);
        end;
  if SegIndex=(i+1) then
     begin
       r:=AnsiToUTF8(s);
     end;
  result:=r;
end;      


//------------------------------------------------------------------------------------------------------------------------------------
// 函數名稱：function _StrSegCount(Str,SegSymbol: String): integer;
// 中文說明：依照分隔符號,求區段數
// 傳 回 值：段數
// 參    數：：(原始字串, 分隔符號, 段別)
// 機能說明：
//------------------------------------------------------------------------------------------------------------------------------------
function _StrSegCount(Str,SegSymbol: String): integer;
var r,i:integer;
    c,s,sTmp : String;
begin
  r:=0;
  if (Str='') then
     begin
       result:=r;
       exit;
     end;
  c:=UTF8ToAnsi(SegSymbol);
  if (c='') then c:=',';
  i:=0;
  s:=UTF8ToAnsi(Str);
  sTmp:='';
  while Pos(c,s)>0 do
        begin
          i:=i+1;
          sTmp := Copy(s,1,Pos(c,s)-1);
          s:=Copy(s , Pos(c,s)+Length(c) , Length(s)-(Pos(c,s)+Length(c))+1);
        end;
  r:=i+1;
  result:=r;
end;      

■ 主要函式介紹

//------------------------------------------------------------------------------------------------------------------------------------
// 函數名稱：procedure _EmptyMemDataSet(DataSet:TMemDataSet);
// 中文說明：清空 MemDataSet
//網路抄來的 EmptyMemDataSet(), 原作提到
//Looping deletion of records seems to be increadibly slow.
//Therefore I use my EmptyMemDataset procedure instead of while not EOF do Delete;
//------------------------------------------------------------------------------------------------------------------------------------
procedure _EmptyMemDataSet(DataSet:TMemDataSet);
var
  vTemporaryMemDataSet:TMemDataSet;
  vFieldDef:TFieldDef;
  I:Integer;
begin
  try
    //Create temporary MemDataSet
    vTemporaryMemDataSet:=TMemDataSet.Create(nil);
    //Store FieldDefs to Temporary MemDataSet
    for I:=0 to DataSet.FieldDefs.Count-1 do begin
      vFieldDef:=vTemporaryMemDataSet.FieldDefs.AddFieldDef;
      with DataSet.FieldDefs[I] do begin
        vFieldDef.Name:=Name;
        vFieldDef.DataType:=DataType;
        vFieldDef.Size:=Size;
        vFieldDef.Required:=Required;
      end;
    end;
    //Clear existing fielddefs
    DataSet.Clear;
    //Restore fielddefs
    DataSet.FieldDefs:=vTemporaryMemDataSet.FieldDefs;
    DataSet.Active:=True;
  finally
  vTemporaryMemDataSet.Clear;
  vTemporaryMemDataSet.Free;
  end;
end;                              


//------------------------------------------------------------------------------------------------------------------------------------
// 函數名稱：function _LocateMemDataSet(DataSet:TMemDataSet; FieldNames:String; FieldValues:String): Boolean;
// 中文說明：搜尋 MemDataSet 中的資料 (可使用複合欄位)
// 範    例： if LocateMemDataSet(MemDataset1,'GRP_NO;GRP_PQTY','d001;400') then
//------------------------------------------------------------------------------------------------------------------------------------
function _LocateMemDataSet(DataSet:TMemDataSet; FieldNames:String; FieldValues:String): Boolean;
var field_count:integer;
    i,j:integer;
    is_find:boolean;
begin
  is_find:=false;
  DataSet.First;
  while not DataSet.Eof do
  begin
    is_find:=true;
    for i:=1 to _StrSegCount(FieldNames,';') do
    begin
      if (DataSet.FieldByName(_StrSeg(FieldNames,';',i)).AsString<>_StrSeg(FieldValues,';',i)) then is_find:=false;
    end;
    if is_find then break;
    DataSet.Next;
  end;
  result:=is_find;
end;                           


//------------------------------------------------------------------------------------------------------------------------------------
// 函數名稱：procedure _SortMemDataSet(DataSet:TMemDataSet; FieldNames:String; desc:integer);
// 中文說明：排序 MemDataSet 中的資料 (可使用複合欄位)
// 範    例：  _SortMemDataSet(MemDataset1,'GRP_NO;GRP_PQTY',0);  //升冪排序
//                  _SortMemDataSet(MemDataset1,'GRP_NO;GRP_PQTY',1);   //降冪排序(Descending)
//------------------------------------------------------------------------------------------------------------------------------------
procedure _SortMemDataSet(DataSet:TMemDataSet; FieldNames:String; desc:integer);
var bookmark1,bookmark2:TBookmark;
    left,right:String;
    i:integer;
begin
  DataSet.DisableControls;
  if desc=0 then
    _QuickSort(DataSet, FieldNames, 0, DataSet.RecordCount-1)  //升冪
  else
    _QuickSortDesc(DataSet, FieldNames, 0, DataSet.RecordCount-1); //降冪
  DataSet.EnableControls;
end;         
         

//------------------------------------------------------------------------------------------------------------------------------------
//快速排序法(QUICK SORT)-升冪(一般)
//------------------------------------------------------------------------------------------------------------------------------------
procedure _QuickSort(DataSet: TMemDataSet; FieldNames: String; left, right: integer);
var i,j,k: integer;
    pivot, tmp: string;
begin
  if (left >= right) then Exit;
  DataSet.First; DataSet.MoveBy(left);
  pivot:='';
  for k:=1 to _StrSegCount(FieldNames,';') do
  begin
    //pivot:=pivot+DataSet.FieldByName(_StrSeg(FieldNames,';',k)).AsString;
    pivot:=pivot+_FieldValueAsString(DataSet, _StrSeg(FieldNames,';',k));
  end;
  i := left + 1;
  j := right;
  while (true) do
  begin
    while (i <= right) do
    begin
      DataSet.First; DataSet.MoveBy(i);
      tmp:='';
      for k:=1 to _StrSegCount(FieldNames,';') do
      begin
        //tmp:=tmp+DataSet.FieldByName(_StrSeg(FieldNames,';',k)).AsString;
        tmp:=tmp+_FieldValueAsString(DataSet, _StrSeg(FieldNames,';',k));
      end;
      if (tmp > pivot) then
      begin
        break;
      end;
      i := i + 1;
    end;
    while (j > left) do
    begin
      DataSet.First; DataSet.MoveBy(j);
      tmp:='';
      for k:=1 to _StrSegCount(FieldNames,';') do
      begin
        //tmp:=tmp+DataSet.FieldByName(_StrSeg(FieldNames,';',k)).AsString;
        tmp:=tmp+_FieldValueAsString(DataSet, _StrSeg(FieldNames,';',k));
      end;
      if (tmp < pivot) then
      begin
        break;
      end;
      j := j - 1;
    end;
    if (i > j) then  break;
    _Swap(DataSet, i, j);
  end;
  _Swap(DataSet, left, j);
  _QuickSort(DataSet, FieldNames, left, j - 1);
  _QuickSort(DataSet, FieldNames, j + 1, right);
end;


//------------------------------------------------------------------------------------------------------------------------------------
//快速排序法(QUICK SORT)-降冪
//------------------------------------------------------------------------------------------------------------------------------------
procedure _QuickSortDesc(DataSet: TMemDataSet; FieldNames: String; left, right: integer);
var i,j,k: integer;
    pivot, tmp: string;
begin
  if (left >= right) then Exit;
  DataSet.First; DataSet.MoveBy(left);
  pivot:='';
  for k:=1 to _StrSegCount(FieldNames,';') do
  begin
    //pivot:=pivot+DataSet.FieldByName(_StrSeg(FieldNames,';',k)).AsString;
    pivot:=pivot+_FieldValueAsString(DataSet, _StrSeg(FieldNames,';',k));
  end;
  i := left + 1;
  j := right;
  while (true) do
  begin
    while (i <= right) do
    begin
      DataSet.First; DataSet.MoveBy(i);
      tmp:='';
      for k:=1 to _StrSegCount(FieldNames,';') do
      begin
        //tmp:=tmp+DataSet.FieldByName(_StrSeg(FieldNames,';',k)).AsString;
        tmp:=tmp+_FieldValueAsString(DataSet, _StrSeg(FieldNames,';',k));
      end;
      if (tmp < pivot) then  //** 降冪修改這裡
      begin
        break;
      end;
      i := i + 1;
    end;
    while (j > left) do
    begin
      DataSet.First; DataSet.MoveBy(j);
      tmp:='';
      for k:=1 to _StrSegCount(FieldNames,';') do
      begin
        //tmp:=tmp+DataSet.FieldByName(_StrSeg(FieldNames,';',k)).AsString;
        tmp:=tmp+_FieldValueAsString(DataSet, _StrSeg(FieldNames,';',k));
      end;
      if (tmp > pivot) then //** 降冪修改這裡
      begin
        break;
      end;
      j := j - 1;
    end;
    if (i > j) then  break;
    _Swap(DataSet, i, j);
  end;
  _Swap(DataSet, left, j);
  _QuickSortDesc(DataSet, FieldNames, left, j - 1);  //** 降冪修改這裡
  _QuickSortDesc(DataSet, FieldNames, j + 1, right); //** 降冪修改這裡
end;

//------------------------------------------------------------------------------------------------------------------------------------
//將兩個不同的資料列(Row)中所有欄位值做交換
//------------------------------------------------------------------------------------------------------------------------------------
procedure _Swap(DataSet: TMemDataSet; row1, row2: integer);
var i:Integer;
    var tmp: array[0..99] of Variant;
    var tmp2: array[0..99] of Variant;
begin
  DataSet.First; DataSet.MoveBy(row1);
  for i:=0 to DataSet.FieldCount-1 do
  begin
    tmp:=DataSet.Fields.Fields.AsVariant;
  end;
  DataSet.First; DataSet.MoveBy(row2);
  for i:=0 to DataSet.FieldCount-1 do
  begin
    tmp2:=DataSet.Fields.Fields.AsVariant;
  end;
  DataSet.First; DataSet.MoveBy(row1);
  DataSet.Edit;
  for i:=0 to DataSet.FieldCount-1 do
  begin
    DataSet.Fields.Fields.AsVariant:=tmp2;
  end;
  DataSet.Post;
  DataSet.First; DataSet.MoveBy(row2);
  DataSet.Edit;
  for i:=0 to DataSet.FieldCount-1 do
  begin
    DataSet.Fields.Fields.AsVariant:=tmp;
  end;
  DataSet.Post;
end;


//------------------------------------------------------------------------------------------------------------------------------------
//數值欄位比大小的特別處理
//------------------------------------------------------------------------------------------------------------------------------------
function _FieldValueAsString(DataSet: TMemDataSet; fieldname: String): String;
var r:string;
begin
  r:='';
  case DataSet.FieldByName(fieldname).DataType of
       ftSmallint : r:=FormatFloat('00000',DataSet.FieldByName(fieldname).AsInteger);
       ftInteger  : r:=FormatFloat('0000000000',DataSet.FieldByName(fieldname).AsInteger);
       ftFloat    : r:=FormatFloat('0000000000.00',DataSet.FieldByName(fieldname).AsFloat);
  else
    r:=DataSet.FieldByName(fieldname).AsString;
  end;
  result:=r;
end;

bruce0829

貼一個跟技術無關, 屬於商業邏輯的部份, 可以看得出內部運\算需要一個可以放二維資料運\算的記憶體空間, 你可以用 Array, structure 等等, 不過更方便的是用 MEMORY TABLE, 運\算處理過程需要比大小, 排序 (升冪或降冪, 也就是由小到大, 或由大到小) 搜尋等等, Lazarus 內建的 MEMORY TABLE 並沒有搜尋或是排序功能, 上面的東西就是在講如何幫 MEMORY TABLE 加上搜尋或是排序 ; 而下面是一個商業邏輯的需求

收銀系統組合促銷範例與實作 - 任買特價 (群組促銷)

  名詞解釋
群組促銷是多樣商品搭配促銷的手段之一, 沒有標準制式的玩法或規定, 每家用的名詞或玩的內容也不完全一樣, 這邊只是以我客戶的規則來定義; 群組促銷是指 - 先定義同類型或同廠商商品多個為一群 (有一個群編號), 單買商品時為原價, 若同時買同一群組中的多個商品時則給予額外的折扣


  範例條件
群組編號 D001 , 有 A,B,C 三個商品 , 任買 2 個 60 元 (均一價為 30 元)
群組編號 D001, A 商品原價 31
群組編號 D001, B 商品原價 32
群組編號 D001, C 商品原價 33


  客戶可能的買法 (任買 2 個 60 元)
單買 1 個 A (或 B 或 C) : 原價 31 (或 32, 或 33)
買 1 個 A + 1 個 B = 60 元  (共 2 個商品, 成立一組 "任買 2 個 60 元" 條件)
買 2 個 A = 60 元 (共 2 個商品, 成立一組 "任買 2 個 60 元" 條件)
買 4 個 A = 120 元 (共 4 個商品, 成立二組 "任買 2 個 60 元" 條件)
買 3 個 A + 1 個 B = 120 元 (共 4 個商品, 成立二組 "任買 2 個 60 元" 條件)
買 1 個 A + 1 個 B + 2 個 C = 120 元 (共 4 個商品, 成立二組 "任買 2 個 60 元" 條件)
買 1 個 A + 2 個 B + 3 個 C = 180 元 (共 6 個商品, 成立三組 "任買 2 個 60 元" 條件)

注意 , 客戶也可能這樣買 (不為 任買 2 個的倍數, 多餘的商品則為原價) :
買 1 個 A + 2 個 C = 93 元 (共 3 個商品, 只成立一組 "任買 2 個 60 元" 條件, 多一個 C 商品則為原價)


  最佳化的問題
所謂最佳化, 是以站在客戶角度有利為考量點 (不然會招致客訴) , 以剛才最後一個例子而言, 同樣的買法, 但程式計算折扣可能就會因商品刷入的先後順序而有不同折扣
買 1 個 A + 2 個 C = 93 元  (這可不一定喔 ??)
當你程式計算為 :  
方式一  -> 1 個 A + 1 個 C  (任買 2 個 60 元) + 1 個 C (單價 33) = 93
方式二  -> 2 個 C (任買 2 個 60 元) + 1 個 A (單價 31) = 91
同樣的購買內容, 只因商品排列順序不同, 便造成計算結果不同, 以對客戶有利的角度來看, 當然是賣客戶 91 元才對, 也就是程式計算折扣時尚需做最佳化處理
此問題最佳化的處理手段, 便是不管商品刷入順序, 先將所有商品按單價價格高低做降冪排列 (單價高者排前面, 單價低者排後面), 從高價者開始計算群組(看成立幾組任買特價), 剩餘的或無法成立群組的個體一定是單價低的, 此時計算出的總金額折扣一定是對客戶最有利的

群組促銷折扣最佳化 - 演算法 :
1.不管商品條碼刷入順序
2.將商品根據其所屬群組編號做群集(GROUP)
3.將每一群集中之商品, 按商品價格做降冪排列
4.計算每一群集中, 成立幾組任買特價, 並加上剩餘無法成立任買特價的零散商品之原價, 計算出每一群集之總售價, 總折扣


  促銷條件參數
以上舉例中 ,  群組編號 D001 任買 2 個 60 元, 群組編號 D002 任買 5 個 70 元, 都是設定在促銷參數的 Table 中, 該 Table 的欄位內容主要有

群組編號	任買幾個	多少錢	均一價	不均一價差
D001	2	60	30
D002	5	70	14
D003	3	20	7	1

均一價 : 本促銷折扣之平均單價 => 商品原價  減  均一價 = 折扣
不均一價差 : 只是一個觀念值, 用來平衡折扣計算 ; 均一價無法除盡算出者, 找一個大於真實均一價的整數當均一價, 如 3 個 20 元, 真實均一價為 6.666666666...... , 此時用 7 當均一價參數, 但 3 個 均一價 為 7 的商品應為 21 元 , 不是參數中的 20 元, 但我們又要玩  3 個 20 元 的促銷 CASE, 所以透過不均一價差 來平衡與計算折扣參數


  多群處理
客戶買的東西天南地北, 他可能買 A, B, C 商品 (同一群組編號 D001, 促銷條件為 任買 2 個 60 元 ), 也可能又買 D, E, F 商品 (假設為另一群組編號 D002 下之商品, 促銷條件為 任買 5 個 70 元) , 所以針對客戶所買商品內容, 都要針對商品所屬的每一群組做 GROUP , 再個別處理計算折扣
另外還有所謂 "多群(套餐)折扣", 也就是除了 群組編號 D001 任買 2 個 60 元, 群組編號 D002 任買 5 個 70 元外; 當你同時成立 D001 及 D002 兩個群組時, 可能又符合多群套餐折扣條件 - 任買兩群 55 元 ; 不過 "多群(套餐)折扣" 我想放到下個章節討論, 不在本節討論


  測試程式資料及資料結構樣本


商品主檔 (從總部下傳的實體檔案)

條碼	中文品名	群組編號	單價
4710000000001	A 商品	D001	31
4710000000002	B 商品	D001	32
4710000000003	C 商品	D001	33
4710000000004	D 商品	D002	15
4710000000005	E 商品	D002	16
4710000000006	F 商品	D002	17
4710000000007	G 商品	D003	8
4710000000008	H 商品	D003	8
4710000000009	I 商品	D003	9
4710000000010	J 商品	D003	11
4710000000011	K 商品	D003	10

　
促銷參數 TABLE (從總部下傳的實體檔案)

群組編號	任買幾個	多少錢	均一價	不均一價差
D001	2	60	30
D002	5	70	14
D003	3	20	7	1

　
交易明細 - 記憶體 TABLE (供刷入客戶商品條碼的臨時 TABLE, 結帳完產生交易明細電文檔後清空)

條碼	中文品名	單價	數量	小計

　
折扣計算 - 記憶體 TABLE (在背景計算任買特價所成立的折扣)

群組編號	任買幾個	多少錢	均一價	不均一價差	折扣合計	不均一價差合計	條碼	單價	數量	任買特價成立組數

　
　

xusonglie

向楼主学习！真的吗！

roolive

......  顶一个

chenyuchih

詳細又有其專業.......好文一定要推的啦！

雖然去年的文現在才看到.....不過還是要對b大無私分享的精神說聲感謝！

1234567

先收藏了,谢谢LZ