.#mainfrmex.pas.1.40

来自「群星医药系统源码」· 40 代码 · 共 828 行 · 第 1/2 页

    NavigationBox.Color := NavigationBack;
    Parent := NavigationBox;
    BackgroundColor := NavigationBox.Color;
    UseColoredTabs := false;
    FlatColor := clGradientActiveCaption;
    FlatColorAdjustment := 20;
    ShowCardFrame := true;
    ShowFocusRect := False;
    TabColors.Shadow := NavigationGradient;
    TabOrientation := toRight;
    TabHeight := 32;
    TabStyle := tsCutCorner;
    HotTrack :=false;
    Top := 32;
    Left := 32;
    Width := NavigationBox.ClientWidth - 64;
    Height := NavigationBox.ClientHeight - 64;
    Anchors := [akLeft,akTop,akRight,akBottom];
    OnDragOver := ParentAcceptDragListItems;
    OnDragDrop := ApplyDragListItems;
    OnMouseDown := OnNavigationMouseDown;
    OnChange := OnNavigationChanged;
    NavigationBox.OnMouseDown := OnNavigationMouseDown;
    Show;
  end;
end;

//接口函数，当前改变导航栏颜色等设置时或需要刷新显示时调用
procedure TMainFormEx.ChangeNavigationColor;
var
  i,j: integer;
begin
  DisplayNavigationData;
  if not FLocSetting.NavVisible then Exit;
  NavigationBox.Color := NavigationBack;
  FNavList.Color := NavigationBack;
  FNavList.TabColors.Shadow := NavigationGradient;
  for i:=0 to FNavList.ComponentCount -1 do
  begin
    if FNavList.Components[i] is TRzListView then
      TRzListView(FNavList.Components[i]).Color := NavigationBox.Color;
    for j:=0 to FNavList.Components[i].ComponentCount -1 do
      if FNavList.Components[i].Components[j] is TRzListView then
        TRzListView(FNavList.Components[i].Components[j]).Color := NavigationBox.Color;
  end;
end;

//显示导航数据
procedure TMainFormEx.DisplayNavigationData;
var
  lvTemp: TRzListView;
  ListItem: TListItem;
  vSheet: TRzTabSheet;
  i,j,k,x:  Integer;
  CommonImg: TImageList;
begin
  FCurListView := nil;
  if not IFmMain.NavVisible then
  begin
    if Assigned(FNavList) then
      FreeAndNil(FNavList);
    Exit;
  end;
  if FNavList<>nil then
    Exit
  else
    FNavList := CreateNavList;
  x := 10;
  CommonImg := IFmMain.GetBigImgList;
  FNavList.Images := CommonImg;
  with MainMenu do
  begin
    for i:=0 to Items.Count -1 do
    begin
      //标题页
      vSheet := TRzTabSheet.Create(FNavList);
      vSheet.Parent := FNavList;
      vSheet.ImageIndex := i;
      if x=CommonImg.Count then x:=10;//TListView中的图标从第11个图标开始
      Inc(x);
      vSheet.Caption := Items[i].Caption;
      vSheet.PageControl := FNavList;
      //列表视图
      lvTemp := TRzListView.Create(vSheet);
      lvTemp.Align := alClient;
      lvTemp.LargeImages := CommonImg;
      lvTemp.Parent := vSheet;
      lvTemp.BorderStyle := bsNone;
      lvTemp.Font.Color := clWindowText;
      lvTemp.ReadOnly := true;
      lvTemp.OnMouseDown := OnListViewMouseDown;
      lvTemp.OnMouseMove := OnListViewMouseMove;
      lvTemp.OnMouseUp := OnListViewMouseUp;  
      lvTemp.OnDragOver := AcceptDragListItems;
      lvTemp.OnKeyDown := PressReturnKeyOnListView;
      lvTemp.OnDblClick := CallModuleFunc;
      lvTemp.OnResize := OnListViewResize;
      lvTemp.MultiSelect := true;
      lvTemp.Ctl3D := false;
      lvTemp.FlatScrollBars := true;
      lvTemp.DoubleBuffered := true;
      lvTemp.Color := NavigationBox.Color;
      lvTemp.Visible := true;
      lvTemp.Parent.DoubleBuffered := true;
      lvTemp.IconOptions.AutoArrange := true;
      //子项(只搜索三层菜单，如果菜单超过三层，请修改此处代码
      for j:=0 to Items[i].Count -1 do
      begin
        if Items[i].Items[j].Action=nil then
        for k:=0 to Items[i].Items[j].Count -1 do
        begin
          if Items[i].Items[j].Items[k].Action=nil then Continue;
          ListItem := lvTemp.Items.Add;
          ListItem.Caption := Items[i].Items[j].Items[k].Caption;
          ListItem.Data := Items[i].Items[j].Items[k].Action;
          ListItem.ImageIndex := x;
          inc(x);
          if x > CommonImg.Count -1 then x :=0;
        end
        else
        begin
          ListItem := lvTemp.Items.Add;
          ListItem.Caption := Items[i].Items[j].Caption;
          ListItem.Data := Items[i].Items[j].Action;
          ListItem.ImageIndex := x;
          Inc(x);
          if x > CommonImg.Count -1 then x :=0;
        end;
      end;
    end;
  end;
  //取得当前用户的常用功能并加入到子项中
  with dmModules.cdsPublic do begin
    //标题页
    vSheet := TRzTabSheet.Create(FNavList);
    vSheet.Parent := FNavList;
    vSheet.ImageIndex := x;
    vSheet.Caption := '常用功能';
    vSheet.PageControl := FNavList;
    FNavList.ActivePage := vSheet;
    //列表视图
    lvTemp := TRzListView.Create(vSheet);
    lvTemp.Align := alClient;
    lvTemp.LargeImages := CommonImg;
    lvTemp.Parent := vSheet;
    lvTemp.BorderStyle := bsNone;
    lvTemp.Font.Color := clWindowText;
    lvTemp.ReadOnly := true;
    lvTemp.OnKeyDown := OnFavoritesKeyDown;
    lvTemp.OnDblClick := CallModuleFunc;
    lvTemp.OnResize := OnListViewResize;
    lvTemp.OnDragOver := AcceptDragListItems;
    lvTemp.OnDragDrop := ApplyDragListItems;
    lvTemp.MultiSelect := true;
    lvTemp.Ctl3D := false;
    lvTemp.FlatScrollBars := true;
    lvTemp.DoubleBuffered := true;
    lvTemp.Color := NavigationBox.Color;
    lvTemp.Visible := true;
    lvTemp.Parent.DoubleBuffered := true;
    lvTemp.IconOptions.AutoArrange := true;
    FFavoritesListView := lvTemp;
    //子项
    Close;
    CommandText :='select UserID, ModuleID, IconID from Favorites where UserID='+ FLogonInfo.UserID;
    Open;
    while not Eof do begin
      for i:=0 to Actions.ActionCount -1 do
      if Fields[1].AsInteger = TModlAction(Actions.Actions[i]).ActionID then
      begin
        ListItem := lvTemp.Items.Add;
        ListItem.Caption := TModlAction(Actions.Actions[i]).Caption;
        ListItem.Data := Actions.Actions[i];
        ListItem.ImageIndex := Fields[2].AsInteger;
        break;
      end;
      Next;
    end;
    Close;
  end;
end;

//响应TListView中的鼠标双击事件，调用模块功能
procedure TMainFormEx.CallModuleFunc(Sender: TObject);
var
  lvCommon: TRzListView;
  Item: TListItem;
  pt: TPoint;
  act: TAction;
begin
  if not (Sender is TRzListView) then exit;
  TListView(Sender).Selected := nil;
  lvCommon := TRzListView(Sender);
  GetCursorPos(pt);
  pt := lvCommon.ScreenToClient(pt);
  Item := lvCommon.GetItemAt(pt.X ,pt.Y);
  if Item = nil then exit;
  act := TAction(Item.Data);
  try
    screen.Cursor := crHourGlass;
    if act<>nil then act.Execute;
  finally
    screen.Cursor := crDefault;
  end;
end;

//处理'常用功能'的DragOver事件
procedure TMainFormEx.AcceptDragListItems(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
begin
  Accept := (Source is TRzListView)and(TRzListView(Source)<>FFavoritesListView);
end;

//处理'常用功能'的DragDrop事件
procedure TMainFormEx.ApplyDragListItems(Sender, Source: TObject; X,
  Y: Integer);
const
  sSQL = 'INSERT INTO Favorites(UserID, ModuleID, IconID)VALUES(%s,%d,%d)';
var
  lv: TRzListView;
  LI: TListItem;
  act: TModlAction;
  i: integer;

  function CheckExistsItem(AListItem: TListItem): boolean;
  var i: integer;
  begin
    Result := false;
    With FFavoritesListView.Items do
    for i:=0 to Count -1 do
    begin
      if not Assigned(AListItem.Data) then Continue;
      if TModlAction(AListItem.Data).ActionID = TModlAction(Item[i].Data).ActionID then
      begin
        Result := true;
        break;
      end;
    end;
  end;

begin
  if (not (Source is TRzListView))or(FFavoritesListView = nil) then exit;
  if (Sender is TRzPageControl)and(TRzPageControl(Sender).ActivePage.Caption <>'常用功能') then exit;
  lv := TRzListView(Source);
  if lv.SelCount>1 then
  for i:=0 to lv.Items.Count -1 do
  begin
    if lv.Items.Item[i].Selected then
    begin
      act := TModlAction(lv.Items.Item[i].Data);
      if act=nil then Continue;
      if CheckExistsItem(lv.Items.Item[i]) then Continue;
      LI := FFavoritesListView.Items.Add;
      LI.Caption :=lv.Items.Item[i].Caption;
      LI.Data := lv.Items.Item[i].Data;
      LI.ImageIndex := lv.Items.Item[i].ImageIndex;
      with dmModules.cdsPublic do
      begin
        Close;
        CommandText := Format(sSQL,[FLogonInfo.UserID,act.ActionID,LI.ImageIndex]);
        Execute;
      end;
    end;
  end
  else
  begin
    act := TModlAction(lv.Selected.Data);
    if act<>nil then
    with dmModules.cdsPublic do
    begin
      if CheckExistsItem(lv.Selected) then exit;
      LI := FFavoritesListView.Items.Add;
      LI.Caption :=lv.Selected.Caption;
      LI.Data := lv.Selected.Data;
      LI.ImageIndex := lv.Selected.ImageIndex;
      Close;
      CommandText := Format(sSQL,[FLogonInfo.UserID,act.ActionID,LI.ImageIndex]);
      Execute;
    end;
  end;
end;

//处理页面控件的的DragOver事件
procedure TMainFormEx.ParentAcceptDragListItems(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
var
  i: integer;
  c: string;
begin
  Accept := (Source is TRzListView)and(TRzListView(Source)<>FFavoritesListView);
  if not Accept then exit;
  if State <> dsDragLeave then begin
    i :=TRzPageControl(Sender).TabAtPos(x,y);
    if (i<0)or(i>TRzPageControl(Sender).PageCount-1) then exit;
    c := TRzPageControl(Sender).Pages[i].Caption ;
    if c = '常用功能' then
      TRzPageControl(Sender).ActivePageIndex := i
    else
      Accept :=false;
  end;
end;

//以下三个过程处理主要功能分类列表视图控件的Mouse事件，开始手动拖放
procedure TMainFormEx.OnListViewMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  FMousePressed := (Button = mbLeft);
  if Sender is TRzListView then
    FCurListView := TRzListView(Sender);
end;

procedure TMainFormEx.OnListViewMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  if (not (Sender is TRzListView))or(not FMousePressed) then exit;
  if (TListView(Sender).Selected<>nil)and(not TListView(Sender).Dragging) then
    TRzListView(Sender).BeginDrag(true);
end;

procedure TMainFormEx.OnListViewMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  FMousePressed := false;
end;

//'常用功能'中的按键（删除或调用功能）
procedure TMainFormEx.OnFavoritesKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
const
  sSQL = 'DELETE FROM Favorites WHERE UserID=%s AND ModuleID=%d';
var
  i:  integer;
  act: TModlAction;
begin
  if (Key=VK_DELETE)and(ssCtrl in Shift)and(FFavoritesListView.SelCount >0) then
  with dmModules.cdsPublic do
  begin
    for i:= FFavoritesListView.Items.Count -1 Downto 0 do
    begin
      if not FFavoritesListView.Items.Item[i].Selected then Continue;
      Close;
      act := TModlAction(FFavoritesListView.Items.Item[i].Data);
      CommandText := Format(sSQL,[FLogonInfo.UserID,act.ActionID]);
      Execute;
    end;
    FFavoritesListView.DeleteSelected;
  end;
  if Key=13 then PressReturnKeyOnListView(sender,key,shift);
end;

//按下回车键时执行
procedure TMainFormEx.PressReturnKeyOnListView(Sender: TObject;
  var Key: Word; Shift: TShiftState);
var
  lvCommon: TRzListView;
  Item: TListItem;
  act: TAction;
begin
  if (not (Sender is TRzListView))or(key<>13) then exit;
  lvCommon := TRzListView(Sender);
  Item := lvCommon.Selected;
  if Item = nil then exit;
  act := TAction(Item.Data);
  try
    screen.Cursor := crHourGlass;
    if act<>nil then act.Execute;
  finally
    screen.Cursor := crDefault;
  end;
end;

procedure TMainFormEx.OnListViewResize(Sender: TObject);
begin
  TListView(Sender).Realign;
end;

//用于复位拖放
procedure TMainFormEx.OnNavigationMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if FCurListView = nil then exit;
  with FCurListView do
  begin
    FMousePressed := false;
    EndDrag(false);
  end;
end;

//切换页面时，自动设置焦点到TListView，以便用户使用方向键操作
procedure TMainFormEx.OnNavigationChanged(Sender: TObject);
var
  nTab: TRzTabSheet;
  i: integer;
begin
  if not (Sender is TRzPageControl) then exit;
  nTab := TRzPageControl(Sender).ActivePage;
  if nTab<>nil then
    for i :=0 to nTab.ComponentCount - 1 do
      if nTab.Components[i] is TRzListView then
      begin
         if TRzListView(nTab.Components[i]).CanFocus then
           TRzListView(nTab.Components[i]).SetFocus;
         break;
      end;
end;

initialization
  RegisterClass(TMainFormEx);

finalization
  UnRegisterClass(TMainFormEx);

end.