⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 ufacefun.pas

📁 a voice guide client ,it is the second part of voice guide center
💻 PAS
字号:
unit uFaceFun;

interface

uses
  ComCtrls, Classes, GisTargetCommander, uPubFun, uGPSClientCarInfoListDisplay,
  uBaseDBDefs, VirtualTrees;

type
  TListViewCopyRange = (caSelected, caUnSelected, caAll);

//procedure CarListFill(CarList: TListView; AddSendResult: Boolean);
//procedure CarListHead(CarList: TListView; AddSendResult: Boolean);
procedure CarListAddSendResult(CarList: TListView; AData: Integer; ASendResult, ACmdStr: string);
procedure CarTreeAddSendResult(CarTree: TVirtualStringTree;AData: Integer;
  ASendResult, ACmdStr: string);
procedure CarListClearSendResult(CarList: TListView);
procedure CarTreeClearSendResult(CarTree: TVirtualStringTree);
function  updateCommandSendResult(_vt_treeview: TVirtualStringTree;
  _p_node: PVirtualNode; _command_result: string;
  _command_desc: string): Boolean;


procedure ListViewSelAll(List: TListView);
procedure ListViewSelOppose(List: TListView);
procedure ListViewSelAllNo(List: TListView);

procedure ListTreeSelAll(Tree: TVirtualStringTree);
procedure ListTreeSelOppose(Tree: TVirtualStringTree);
procedure ListTreeSelAllNo(Tree: TVirtualStringTree);

procedure ListViewAutoReWide(List: TListView);

//procedure SetAllTargetName(TargetCmd: TTargetCommander;
//  CarInfoList, CarId2TargetId: TStringList; ShowCarInfoType: TCarInfoType);
procedure SetAllTargetName(TargetCmd: TTargetCommander;
  CarInfoList, CarId2TargetId: TStringList; ShowCarInfoIndex: Integer);
procedure SetTargetName(_target: TGIS_Target; _car_info: TCarInfo;
  _target_name_field_index: Integer);

//Copy From
procedure CopyFromListView(ListView: TListview; CopyRange: TListViewCopyRange);
procedure CopyFromTree(_vt_tree: TVirtualStringTree);

//procedure

implementation

uses SysUtils, Clipbrd;

resourcestring
  rsLVCol_No = 'NO';
  rsLVCol_SendResult = '发送结果';
  rsLVCol_CmdScript =  '命令描述';

procedure CarListAddSendResult(CarList: TListView; AData: Integer;
  ASendResult, ACmdStr: string);
var
  ListItem: TListItem;
  n: Integer;
begin
  ListItem:= CarList.FindData(0, Pointer(AData), True, False );
  if not Assigned(ListItem) then Exit;
  n:= ListItem.SubItems.Count;
  if n>=2 then begin
    ListItem.SubItems[n-2]:= ASendResult;
    ListItem.SubItems[n-1]:= ACmdStr;
  end;
end;

function  updateCommandSendResult(_vt_treeview: TVirtualStringTree;
  _p_node: PVirtualNode; _command_result: string;
  _command_desc: string): Boolean;
var
  p_my_data             : PMyNodeData;
  p_info_data           : PCarInfoData;
begin
  Result := False;

  // 取得节点数据
  p_my_data := _vt_treeview.GetNodeData(_p_node);
  if not Assigned(p_my_data) then
    Exit;

  p_info_data := p_my_data^.my_data_ptr;

  if not Assigned(p_info_data) then
    Exit;

  TCarInfo.SetVarToFieldValue(TCarInfo(p_info_data^.PInfo), 'CMD_Result', _command_result);
  TCarInfo.SetVarToFieldValue(TCarInfo(p_info_data^.PInfo), 'CMD_Desc', _command_desc);

  Result := True;

  _vt_treeview.Invalidate;
end;

procedure CarTreeAddSendResult(CarTree: TVirtualStringTree;AData: Integer;
  ASendResult, ACmdStr: string);
var
  p_node : PVirtualNode;
begin
  p_node := TGPSClientCarInfoListDisplay.GetPNodeByCarID(CarTree, AData);

  if not Assigned(p_node) then
    Exit;

  updateCommandSendResult(CarTree, p_node, ASendResult, ACmdStr);
//  n := CarTree.Header.Columns.Count;
//  if n > 2 then
//  begin
//    CarTree.Text[p_node, n - 1] := ASendResult;
//    CarTree.Text[p_node, n] := ACmdStr;
//  end;
end;

procedure CarListClearSendResult(CarList: TListView);
var
  i, n: Integer;
  ListItem: TListItem;
begin
  for i:= 0 to CarList.Items.Count -1 do begin
    ListItem:= CarList.Items[i];
    n:= ListItem.SubItems.Count;
    if n>=2 then begin
      ListItem.SubItems[n-2]:= '';
      ListItem.SubItems[n-1]:= '';
    end;
  end;
end;

procedure CarTreeClearSendResult(CarTree: TVirtualStringTree);
var
  p_node  : PVirtualNode;
begin
  p_node := CarTree.GetFirst;

//  .SetVarToFieldValue();
//  n      := CarTree.Header.Columns.Count;

  while Assigned(p_node) do
  begin
//    CarTree.Text[p_node, n-1] := '';
//    CarTree.Text[p_node, n] := '';
    updateCommandSendResult(CarTree, p_node, '', '');

    p_node := CarTree.GetNext(p_node);
  end;
end;

procedure ListViewSelAll(List: TListView);
var
  i: Integer;
begin
  if List.Checkboxes then
    for i:= 0 to List.Items.Count- 1 do
      List.Items[i].Checked:= True
  else List.SelectAll;
end;

procedure ListTreeSelAll(Tree: TVirtualStringTree);
begin
  Tree.SelectAll(True);
end;

procedure ListViewSelOppose(List: TListView);
var
  i: Integer;
begin
  if List.Checkboxes then
    for i:= 0 to List.Items.Count- 1 do
      List.Items[i].Checked:= not List.Items[i].Checked
  else
    for i:= 0 to List.Items.Count- 1 do
      List.Items[i].Selected:= not List.Items[i].Selected;
end;

procedure ListTreeSelOppose(Tree: TVirtualStringTree);
var
  tree_node : PVirtualNode;
begin
  tree_node := Tree.GetFirst;

  while tree_node <> nil do
  begin
    Tree.Selected[tree_node] := not Tree.Selected[tree_node];
    tree_node := Tree.GetNext(tree_node);
  end;
end;

procedure ListViewSelAllNo(List: TListView);
var
  i: Integer;
begin
  if List.Checkboxes then
    for i:= 0 to List.Items.Count- 1 do
      List.Items[i].Checked:= False
  else List.Selected:= nil;
end;

procedure ListTreeSelAllNo(Tree: TVirtualStringTree);
var
  tree_node : PVirtualNode;
begin
  tree_node := Tree.GetFirst;

  while tree_node <> nil do
  begin
    Tree.Selected[tree_node] := False;
    tree_node := Tree.GetNext(tree_node);
  end;
end;

procedure ListViewAutoReWide(List: TListView);
{-----------------------------------------------------------------------------
  自动修改ListView中Report,最后一列的宽度
-----------------------------------------------------------------------------}
var
  i, TotalWide: Integer;
begin
  if List.ViewStyle<> vsReport then Exit;
  TotalWide:= 0;
  for i:= 0 to List.Columns.Count -2 do begin
    TotalWide:= TotalWide+ List.Columns[i].Width;
  end;
  if (TotalWide< List.Width-4) then begin
    i:= List.Columns.Count -1;
    if i>=0 then List.Columns[i].Width:= List.Width- TotalWide -25;
  end;
end;

procedure SetTargetName(_target: TGIS_Target; _car_info: TCarInfo;
  _target_name_field_index: Integer);
begin
  case _target_name_field_index of
    // 无
    0: _target.TargetName := '';
    // 车牌号码
    1: _target.TargetName := _car_info.VehicleRegistrationNO;
    // 车辆名称
    2: _target.TargetName := _car_info.VehicleOwnerName;
    // 车主姓名
    3: _target.TargetName := _car_info.VehicleOwnerName;
    // 车主电话
    4: _target.TargetName := TCarInfo.GetFieldValueStrByName(_car_info, 'CarOwnerPhone');
    // 通用属性
    5: _target.TargetName := TCarInfo.GetFieldValueStrByName(_car_info, 'CommAttribute');
    // 司机姓名
    6: _target.TargetName := TCarInfo.GetFieldValueStrByName(_car_info, 'DriverName');
    // 通讯号
    7: _target.TargetName := _car_info.VehicleCommIDStringLong;
  end;
end;

procedure SetAllTargetName(TargetCmd: TTargetCommander;
  CarInfoList, CarId2TargetId: TStringList; ShowCarInfoIndex: Integer);
{-----------------------------------------------------------------------------
  Date:      12-十二月-2003
  Arguments: None
  Result:    None
-----------------------------------------------------------------------------}
var
  i, TargetId   : Integer;
  sCarId        : string;
  CarInfo       : TCarInfo;
  Target        : TGIS_Target;
begin
  if not Assigned(CarInfoList) then
    Exit;

  for i := 0 to CarInfoList.Count - 1 do
  begin
    CarInfo   := TCarInfo(CarInfoList.Objects[i]);
    sCarId    := CarInfoList[i];
    TargetId  := StrToIntDef(CarId2TargetId.Values[sCarId], -1);
    Target    := TargetCmd.TargetByID(TargetId);
//ruihanxl
    if not Assigned(Target) then
      Continue;
    SetTargetName(Target, CarInfo, ShowCarInfoIndex);
  end;
end;

procedure CopyFromListView(ListView: TListview; CopyRange: TListViewCopyRange);
var
  i, j: Integer;
  ListItem: TListItem;
  sCopy, sLine: string;
begin
  sCopy:= '';
  for i:= 0 to ListView.Columns.Count -1 do
    if sCopy='' then sCopy:= ListView.Columns[i].Caption
    else sCopy:= sCopy+ #9+ ListView.Columns[i].Caption;
  for i:= 0 to ListView.Items.Count -1 do begin
    ListItem:= ListView.Items[i];
    case CopyRange of
      caSelected: if not ListItem.Selected then Continue;
      caUnSelected: if ListItem.Selected then Continue;
    end;
    sLine:= ListItem.Caption;
    for j:= 0 to ListItem.SubItems.Count -1 do
      sLine:= sLine+ #9+ ListItem.SubItems[j];
    if sLine<>'' then sCopy:= sCopy+ #13#10+ sLine;
  end;
  if sCopy<>'' then Clipboard.AsText:= sCopy;
end;

procedure CopyFromTree(_vt_tree: TVirtualStringTree);
var
  i, j          : Integer;
  sCopy, sLine  : string;
  p_node        : PVirtualNode;
begin
  // 初始化返回值
  sCopy := '';

  // 遍历数据列,复制列名称
  for i := 0 to _vt_tree.Header.Columns.Count -1 do
  begin
    if sCopy = '' then
      sCopy := _vt_tree.Header.Columns.Items[i].Text
    else
      sCopy := sCopy + #9 + _vt_tree.Header.Columns.Items[i].Text;
  end;

  p_node := _vt_tree.GetFirst;

  while Assigned(p_node) do
  begin
    sLine := '';

    if not _vt_tree.Selected[p_node] then
    begin
      p_node := _vt_tree.GetNext(p_node);
      Continue;
    end;

    for j := 0 to _vt_tree.Header.Columns.Count - 1 do
    begin
      if sLine = '' then
        sLine := _vt_tree.Text[p_node, j]
      else
        sLine := sLine + #9 + _vt_tree.Text[p_node, j];
    end;

    if sLine <> '' then
      sCopy := sCopy + #13#10 + sLine;

    p_node := _vt_tree.GetNext(p_node);
  end;

//  for i:= 0 to ListView.Items.Count -1 do begin
//    ListItem:= ListView.Items[i];
//    case CopyRange of
//      caSelected: if not ListItem.Selected then Continue;
//      caUnSelected: if ListItem.Selected then Continue;
//    end;
//    sLine:= ListItem.Caption;
//    for j:= 0 to ListItem.SubItems.Count -1 do
//      sLine:= sLine+ #9+ ListItem.SubItems[j];
//    if sLine<>'' then sCopy:= sCopy+ #13#10+ sLine;
//  end;
  if sCopy <> '' then Clipboard.AsText := sCopy;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -