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

📄 misc.pas

📁 Delphi LDAP Authentication Component delphi ldap控件
💻 PAS
📖 第 1 页 / 共 2 页
字号:
        ImageIndex := bmComputer               // else
      else                                     // it's samba user account
        ImageIndex := bmSamba3User;
      Container := false;
    end
    else if s = 'mailgroup' then
    begin
      ImageIndex := bmMailGroup;
      Container := false;
    end
    else if s = 'posixgroup' then
    begin
      ImageIndex := bmGroup;
      Container := false;
    end
    else if s = 'groupofuniquenames' then
    begin
      ImageIndex := bmGrOfUnqNames;
      Container := false;
    end
    else if s = 'transporttable' then
    begin
      ImageIndex := bmTransport;
      Container := false;
    end
    else if s = 'sudorole' then
    begin
      ImageIndex := bmSudoer;
      Container := false;
    end
    else if s = 'iphost' then
    begin
      ImageIndex := bmHost;
      Container := false;
    end
    else if s = 'locality' then
      ImageIndex := bmLocality
    else if s = 'sambadomain' then
    begin
      ImageIndex := bmSambaDomain;
      Container := false;
    end
    else if s = 'sambaunixidpool' then
    begin
      ImageIndex := bmIdPool;
      Container := false;
    end;
    Dec(j);
  end;
end;

function SupportedPropertyObjects(const Index: Integer): Boolean;
begin
  case Index of
    bmSamba2User,
    bmSamba3User,
    bmPosixUser,
    bmGroup,
    bmMailGroup,
    bmComputer,
    bmTransport,
    bmOu,
    bmLocality,
    bmHost: Result := true;
  else
    Result := false;
  end;
end;

{ TListViewSorter }

constructor TListViewSorter.Create;
begin
  inherited Create;
  FSortColumn:=nil;
  FSortAsc:=true;
  FBmp:=TBitmap.Create;
  FBmp.Width:=9;
  FBmp.Height:=5;
end;

destructor TListViewSorter.Destroy;
begin
  ListView:=nil;
  FBmp.Free;
  inherited;
end;

procedure TListViewSorter.DoColumnClick(Sender: TObject; Column: TListColumn);
begin
  if FSortColumn=Column then FSortAsc:=not FSortAsc
  else FSortAsc:=true;

  FSortColumn:=Column;
  SetSortMark;
  if assigned(FOnSort) then FOnSort(FSortColumn, FSortAsc)
  else FListView.AlphaSort;
  if assigned(FOnColumnClick) then FOnColumnClick(Sender, Column);
end;

procedure TListViewSorter.DoCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer);
begin
  Compare:=0;
  if FSortColumn=nil then exit;
  case FSortColumn.Index of
    0: Compare:=AnsiCompareStr(Item1.Caption,Item2.Caption);
    else begin
          if FSortColumn.Index>Item1.SubItems.Count then exit;
          if FSortColumn.Index>Item2.SubItems.Count then exit;
          Compare:=AnsiCompareStr(
            Item1.SubItems[FSortColumn.Index-1],
            Item2.SubItems[FSortColumn.Index-1]);
         end;
  end;
  if not FSortAsc then Compare:=-Compare;
end;

procedure TListViewSorter.DoCustomDraw(Sender: TCustomListView; const ARect: TRect; var DefaultDraw: Boolean);
begin
  SetSortMark;
  if assigned(FOnCustomDraw) then FOnCustomDraw(Sender,Arect, DefaultDraw);
end;

procedure TListViewSorter.SetListView(const Value: TListView);
begin
  if FListView<>nil then begin
    FListView.OnColumnClick:=FOnColumnClick;
    FListView.OnCustomDraw:=FOnCustomDraw;
  end;

  FListView := Value;

  if FListView=nil then exit;
  FOnColumnClick:=FListView.OnColumnClick;
  FOnCustomDraw:=FListView.OnCustomDraw;
  FListView.OnColumnClick:=DoColumnClick;
  FListView.OnCustomDraw:=DoCustomDraw;
  if not assigned(FListView.OnCompare) then FListView.OnCompare:=DoCompare;
end;

procedure TListViewSorter.SetSortMark;
var
  i: integer;
begin
  if FListView=nil then exit;
  for i:=0 to FListView.Columns.Count-1 do
    SetSortMark(FlistView.Columns[i]);
end;

procedure TListViewSorter.SetSortMark(Column: TListColumn);
var
 Align,hHeader: integer;
 HD: HD_ITEM;
begin
  if FListView=nil then exit;
  hHeader := SendMessage(FListView.Handle, LVM_GETHEADER, 0, 0);
  with HD do
  begin
    case Column.Alignment of
      taLeftJustify:  Align := HDF_LEFT;
      taCenter:       Align := HDF_CENTER;
      taRightJustify: Align := HDF_RIGHT;
    else
      Align := HDF_LEFT;
    end;
    mask := HDI_BITMAP or HDI_FORMAT;

    if Column=FSortColumn then begin
      with FBmp.Canvas do begin
        Brush.Color:=clBtnFace;
        FillRect(rect(0,0,Fbmp.Width,FBmp.Height));
        Brush.Color:=clBtnShadow;
        Pen.Color:=Brush.Color;
        if FSortAsc then Polygon([point(0,4),point(4,0), point(8,4)])
        else Polygon([point(0,0),point(4,4), point(8,0)]);
      end;
      hbm:=FBmp.Handle;
      fmt := HDF_STRING or HDF_BITMAP or HDF_BITMAP_ON_RIGHT;
    end
    else fmt := HDF_STRING or Align;

  end;
  SendMessage(hHeader, HDM_SETITEM, Column.Index, Integer(@HD));
end;

function CheckedMessageDlg(const Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; CbCaption: string; var CbChecked: Boolean): TModalResult;
var
  Form: TForm;
  i: integer;
  CheckCbx: TCheckBox;
begin
  Form:=CreateMessageDialog(Msg, DlgType, Buttons);
  with Form do
  try
      CheckCbx:=TCheckBox.Create(Form);
      CheckCbx.Parent:=Form;
      CheckCbx.Caption:=Caption;
      CheckCbx.Width:=Width - CheckCbx.Left;
      CheckCbx.Caption := CbCaption;
      CheckCbx.Checked := CbChecked;

      for i:=0 to ComponentCount-1 do begin
        if Components[i] is TLabel then begin
          TLabel(Components[i]).Top:=16;
          CheckCbx.Top:=TLabel(Components[i]).Top+TLabel(Components[i]).Height+16;
          CheckCbx.Left:=TLabel(Components[i]).Left;
        end;
      end;

      for i:=0 to ComponentCount-1 do begin
        if Components[i] is TButton then begin
          TButton(Components[i]).Top:=CheckCbx.Top+CheckCbx.Height+24;
          ClientHeight:=TButton(Components[i]).Top+TButton(Components[i]).Height+16;
        end;
      end;
      Result := ShowModal;
      CbChecked := CheckCbx.Checked;
  finally
    Form.Free;
  end;
end;

function ComboMessageDlg(const Msg: string; const csItems: string; var Text: string): TModalResult;
var
  Form: TForm;
  i: integer;
  Combo: TComboBox;
begin
  Form:=CreateMessageDialog(Msg, mtCustom, mbOkCancel);
  with Form do
  try
    Combo := TComboBox.Create(Form);
    Combo.Parent:=Form;
    Combo.Items.CommaText := csItems;
    Combo.Style := csDropDown;
    for i:=0 to ComponentCount-1 do begin
      if Components[i] is TLabel then begin
        TLabel(Components[i]).Top:=16;
        Width := TLabel(Components[i]).Width + 32;
        Combo.Top:=TLabel(Components[i]).Top+TLabel(Components[i]).Height+4;
        Combo.Left:=TLabel(Components[i]).Left;
      end;
    end;
    if Combo.Width > Width - 32 then
      Width := Combo.Width + 32;

    for i:=0 to ComponentCount-1 do begin
      if Components[i] is TButton then begin
        TButton(Components[i]).Top:=Combo.Top+Combo.Height+24;
        ClientHeight:=TButton(Components[i]).Top+TButton(Components[i]).Height+16;
      end;
    end;
    ActiveControl := Combo;
    Result := ShowModal;
    Text := Combo.Text;
  finally
    Form.Free;
  end;
end;

{ Uses Caption array to replaces captions and Events array to assign OnClick event to buttons}
function MessageDlgEx(const Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; Captions: array of string; Events: array of TNotifyEvent): TModalResult;
var
  Form: TForm;
  i, ci, ce: Integer;
begin
  Form:=CreateMessageDialog(Msg, DlgType, Buttons);
  with Form do
  try
    ci := 0;
    ce := 0;
    for i:=0 to ComponentCount - 1 do
    begin
      if (Components[i] is TButton) then with TButton(Components[i]) do
      begin
        if ci <= High(Captions) then
        begin
          if Captions[ci] <> '' then
            Caption := Captions[ci];
          inc(ci);
        end;
        if ce <= High(Events) then
        begin
          if Assigned(Events[ce]) then
            OnClick := Events[ce];
          inc(ce);
        end;
      end;
    end;
    Result := ShowModal;
  finally
    Form.Free;
  end;
end;

procedure RevealWindow(Form: TForm; MoveLeft, MoveTop: Boolean);
var
  R1, R2: TRect;
  o1, o2: Integer;

  procedure ToLeft;
  begin
    if R2.Left - o1 > 0 then
      Form.Left := R2.Left - o1
    else
      Form.Left := Form.Left + R2.Right - R1.Right + o1;
  end;

  procedure ToRight;
  begin
    if R2.Right + o1 > Screen.Width then
    begin
      Form.Left := R2.Left - o1;
      if Form.Left < 0 then Form.Left := 0;
    end
    else
      Form.Left := Form.Left + R2.Right - R1.Right + o1;
  end;

  procedure ToTop;
  begin
    if R2.Top - o2 > 0 then
      Form.Top := R2.Top - o2
    else
      Form.Top := Form.Top + R2.Bottom - R1.Bottom + o2;
  end;

  procedure ToBottom;
  begin
    if R2.Bottom + o2 > Screen.Height then
    begin
      Form.Top := R2.Top - o2;
      if Form.Top < 0 then Form.Top := 0;
    end
    else
      Form.Top := Form.Top + R2.Bottom - R1.Bottom + o2;
  end;

begin
  if fsShowing in Form.FormState then Exit;
  //if Application.MainForm.WindowState = wsMaximized then Exit;
  o1 := 48 + Random(32);
  o2 := 48 + Random(32);
  GetWindowRect(Form.Handle, R1);
  GetWindowRect(Application.MainForm.Handle, R2);
  if (R1.Top < R2.Top) or (R1.Bottom > R2.Bottom) or
     (R1.Left < R2.Left) or (R1.Right > R2.Right) then Exit;
  if MoveLeft then
    ToLeft
  else
    ToRight;
  if MoveTop then
    ToTop
  else
    ToBottom;
end;

end.

⌨️ 快捷键说明

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