} //---------- 结构体、常量的声明部分 ---------- ShortCuts: array[0..108] of TShortCut = ( scNone, Byte('A') or scCtrl, Byte('B') or scCtrl, Byte('C') or scCtrl, Byte('D') or scCtrl, Byte('E') or scCtrl, Byte('F') or scCtrl, Byte('G') or scCtrl, Byte('H') or scCtrl, Byte('I') or scCtrl, Byte('J') or scCtrl, Byte('K') or scCtrl, Byte('L') or scCtrl, Byte('M') or scCtrl, Byte('N') or scCtrl, Byte('O') or scCtrl, Byte('P') or scCtrl, Byte('Q') or scCtrl, Byte('R') or scCtrl, Byte('S') or scCtrl, Byte('T') or scCtrl, Byte('U') or scCtrl, Byte('V') or scCtrl, Byte('W') or scCtrl, Byte('X') or scCtrl, Byte('Y') or scCtrl, Byte('Z') or scCtrl, Byte('A') or scCtrl or scAlt, Byte('B') or scCtrl or scAlt, Byte('C') or scCtrl or scAlt, Byte('D') or scCtrl or scAlt, Byte('E') or scCtrl or scAlt, Byte('F') or scCtrl or scAlt, Byte('G') or scCtrl or scAlt, Byte('H') or scCtrl or scAlt, Byte('I') or scCtrl or scAlt, Byte('J') or scCtrl or scAlt, Byte('K') or scCtrl or scAlt, Byte('L') or scCtrl or scAlt, Byte('M') or scCtrl or scAlt, Byte('N') or scCtrl or scAlt, Byte('O') or scCtrl or scAlt, Byte('P') or scCtrl or scAlt, Byte('Q') or scCtrl or scAlt, Byte('R') or scCtrl or scAlt, Byte('S') or scCtrl or scAlt, Byte('T') or scCtrl or scAlt, Byte('U') or scCtrl or scAlt, Byte('V') or scCtrl or scAlt, Byte('W') or scCtrl or scAlt, Byte('X') or scCtrl or scAlt, Byte('Y') or scCtrl or scAlt, Byte('Z') or scCtrl or scAlt, VK_F1, VK_F2, VK_F3, VK_F4, VK_F5, VK_F6, VK_F7, VK_F8, VK_F9, VK_F10, VK_F11, VK_F12, VK_F1 or scCtrl, VK_F2 or scCtrl, VK_F3 or scCtrl, VK_F4 or scCtrl, VK_F5 or scCtrl, VK_F6 or scCtrl, VK_F7 or scCtrl, VK_F8 or scCtrl, VK_F9 or scCtrl, VK_F10 or scCtrl, VK_F11 or scCtrl, VK_F12 or scCtrl, VK_F1 or scShift, VK_F2 or scShift, VK_F3 or scShift, VK_F4 or scShift, VK_F5 or scShift, VK_F6 or scShift, VK_F7 or scShift, VK_F8 or scShift, VK_F9 or scShift, VK_F10 or scShift, VK_F11 or scShift, VK_F12 or scShift, VK_F1 or scShift or scCtrl, VK_F2 or scShift or scCtrl, VK_F3 or scShift or scCtrl, VK_F4 or scShift or scCtrl, VK_F5 or scShift or scCtrl, VK_F6 or scShift or scCtrl, VK_F7 or scShift or scCtrl, VK_F8 or scShift or scCtrl, VK_F9 or scShift or scCtrl, VK_F10 or scShift or scCtrl, VK_F11 or scShift or scCtrl, VK_F12 or scShift or scCtrl, VK_INSERT, VK_INSERT or scShift, VK_INSERT or scCtrl, VK_DELETE, VK_DELETE or scShift, VK_DELETE or scCtrl, VK_BACK or scAlt, VK_BACK or scShift or scAlt);
type PMenuData = ^TMenuData; TMenuData = record Id: Integer; Name: string; OperMode: Integer; OperContext: string; PermId: Integer; ShortCut: TShortCut; end;
//---------- TMenuItemEx 类的声明部分 ---------- type TMenuItemEx = class(TMenuItem) private { Private declarations } protected { Protected declarations } public { Public declarations } Data: Pointer; published { Published declarations } end;
//---------- 相关函数的声明 ---------- function GetSingleValue(ACon: TADOConnection; ASQL: string; AFieldName: string=''): string; var fTmp: Fields; begin Result := '';
fTmp := GetSingleRow(ACon, ASQL);
if not Assigned(fTmp) then Exit;
if AFieldName = '' then Result := VarToStr(fTmp[0].Value) else Result := VarToStr(fTmp[AFieldName].Value); end;
if pMenuDataA^.OperMode <> -1 then oMenuItem.OnClick := AMenuItemClick;
if (pMenuDataA^.OperMode = 3) and (Assigned(Self.MethodAddress(pMenuDataA^.OperContext))) then begin MenuItemMethod.Code := Self.MethodAddress(pMenuDataA^.OperContext); MenuItemMethod.Data := oMenuItem; oMenuItem.OnClick := TNotifyEvent(MenuItemMethod); end;
if not Assigned(AMenuItem) then mmMain.Items.Add(oMenuItem) else AMenuItem.Add(oMenuItem);
if StrToIntDef(GetSingleValue(FrmData.conMain, 'SELECT COUNT(*) FROM SysMenu WHERE ParentId=' + IntToStr(AMenuId)), 0) > 0 then CreateSysMenu(oRs.Fields['Id'].Value, oMenuItem);
oRs.MoveNext; end; end;
function TMainFrm.AdjustMenuSplit(AMenuItem: TMenuItem): Boolean; function IsSubItemVisible(BMenuItem: TMenuItem): Boolean; var j: Integer; begin Result := False;
for j := 0 to BMenuItem.Count - 1 do if (BMenuItem.Items[j].Caption <> '-') and (BMenuItem.Items[j].Visible) then Result := True; end; var i: Integer; IsPrevSplit: Boolean; begin Result := False;
if AMenuItem = nil then AMenuItem := mmMain.Items;
IsPrevSplit := True; for i := 0 to AMenuItem.Count -1 do begin
if AMenuItem.Items[i].Count > 0 then begin if (AMenuItem.Items[i].Visible) and (not IsSubItemVisible(AMenuItem.Items[i])) then Result := True;
if AMenuItem.Items[i].Visible then if AMenuItem.Items[i].Caption = '-' then begin if IsPrevSplit then AMenuItem.Items[i].Visible := False;
IsPrevSplit := True; end else IsPrevSplit := False; end; end;
procedure TMainFrm.AdjustMenuSplit_(AMenuItem: TMenuItem); function GetNextVisbleItem(CMenuItem: TMenuItem; AItemIndex: Integer) :TMenuItem; var k: Integer; begin Result := nil;
for k := AItemIndex to CMenuItem.Count - 1 do if CMenuItem.Items[k].Visible then begin Result := CMenuItem.Items[k]; Exit; end; end; var i: Integer; NextVisbleItem: TMenuItem; begin if AMenuItem = nil then AMenuItem := mmMain.Items;
for i := 0 to AMenuItem.Count -1 do begin
if AMenuItem.Items[i].Count > 0 then AdjustMenuSplit_(AMenuItem.Items[i]);
if (AMenuItem.Items[i].Visible) and (AMenuItem.Items[i].Caption = '-') then begin NextVisbleItem := GetNextVisbleItem(AMenuItem, i + 1);
if Assigned(NextVisbleItem) then AMenuItem.Items[i].Visible := not (NextVisbleItem.Caption = '-') else AMenuItem.Items[i].Visible := False; end; end; end;
procedure TMainFrm.InitiSysMenu; begin mmMain.Items.Clear; CreateSysMenu;
while AdjustMenuSplit do AdjustMenuSplit_; end;
procedure TMainFrm.AMenuItemClick(Sender: TObject); var pMenuDataA: PMenuData; begin if (Assigned(Sender)) and (Sender is TMenuItemEx) then begin pMenuDataA := TMenuItemEx(Sender).Data;
case pMenuDataA^.OperMode of 0: OpenFrm(pMenuDataA^.OperContext); 1: OpenQry(pMenuDataA^.OperContext); 2: ExecScript(pMenuDataA^.OperContext); end; end; end;
procedure TMainFrm.OpenFrm(AFrmClsName: string); var clsFrm: TFormClass; oFrm: TForm; begin clsFrm := TFormClass(GetClass(AFrmClsName)); if Assigned(clsFrm) then begin if not FrmExist(AFrmClsName) then begin oFrm := clsFrm.Create(Self); oFrm.Show; end; end else raise Exception.Create('无法打开窗体,窗体类 ' + AFrmClsName + ' 没有注册。'); end;
procedure TMainFrm.OpenQry(AQryName: string); var ofrmQry: TfrmPubQry; begin ofrmQry := TfrmPubQry.Create(Self, AQryName); ofrmQry.Show; end;
procedure TMainFrm.ExecCustomMethod(AMethod: string; Sender: TObject); begin // end;
procedure TMainFrm.ExecScript(AScript: string); begin //可以使用常规的 Script 引擎来实现比如 FastScript ..... end;