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

📄 unit1.~pas

📁 医院信息系统 方法一: 1.运行SQL Server 2000的查询分析器
💻 ~PAS
📖 第 1 页 / 共 2 页
字号:
End;

Procedure TMainWindow.Button1Click( Sender: TObject );
Var
  _Header: TmxHeader;
Begin
  _Header := mxOutlookBarPro.AddHeader;
  _Header.Caption := Edit1.Text;
  ListBox.Items.Add( _Header.Name );
End;

Procedure TMainWindow.ListBoxClick( Sender: TObject );
Begin
  Button2.Enabled := ListBox.ItemIndex <> -1;
  Button7.Enabled := ListBox.ItemIndex <> -1;
  Edit2Change( Self );
End;

Procedure TMainWindow.Button2Click( Sender: TObject );
Begin
  mxOutlookBarPro.DeleteHeader( ListBox.ItemIndex );
  ListBox.Items.Delete( ListBox.ItemIndex );
End;

Procedure TMainWindow.Edit2Change( Sender: TObject );
Begin
  Button3.Enabled := ( ListBox.ItemIndex <> -1 ) And ( Edit2.Text <> '' );
End;

Procedure TMainWindow.Button3Click( Sender: TObject );
Var
  Button: TmxButton;
Begin
  Button := mxOutlookBarPro.HeaderByIndex( ListBox.ItemIndex ).AddButton;
  Button.Caption := Edit2.Text;
End;

Procedure TMainWindow.ListBox1Click( Sender: TObject );
Begin
  Button4.Enabled := ListBox1.ItemIndex <> -1;
  TrackBar2.Enabled := Button4.Enabled;
End;

Procedure TMainWindow.TrackBar1Change( Sender: TObject );
Begin
  mxOutlookBarPro.Background.AlphaBlend := TrackBar1.Position;
End;

Procedure TMainWindow.Button5Click( Sender: TObject );
Begin
  ColorDialog.Color := mxOutlookBarPro.Background.Color;
  If ColorDialog.Execute Then
    mxOutlookBarPro.Background.Color := ColorDialog.Color;
End;

Procedure TMainWindow.Button4Click( Sender: TObject );
Var
  Header: TmxHeader;
Begin
  Header := mxOutlookBarPro.HeaderByIndex( ListBox1.ItemIndex );
  ColorDialog.Color := Header.Background.Color;
  If ColorDialog.Execute Then
    Header.Background.Color := ColorDialog.Color;
End;

Procedure TMainWindow.TrackBar2Change( Sender: TObject );
Begin
  mxOutlookBarPro.HeaderByIndex( ListBox1.ItemIndex ).Background.AlphaBlend := TrackBar2.Position;
End;

Procedure TMainWindow.CheckBox4Click( Sender: TObject );
Begin
  If CheckBox4.Checked Then
    mxOutlookBarPro.Settings.CaptionStyle := csCustomDraw Else
    mxOutlookBarPro.Settings.CaptionStyle := csButtonStyle;
End;

Procedure TMainWindow.Button6Click( Sender: TObject );
Var
  I: Integer;
Begin
  With mxOutlookBarPro.Settings.ButtonUp Do
  Begin
    Style := btGradient;
    Gradient.BeginColor := clWhite;
    Gradient.EndColor := $00CC5E2E;
  End;

  With mxOutlookBarPro.Settings.ButtonFocused Do
  Begin
    Style := btGradient;
    Gradient.BeginColor := $00CC5E2E;
    Gradient.EndColor := clWhite;
  End;

  For I := 0 To mxOutlookBarPro.HeaderCount - 1 Do
  Begin
    mxOutlookBarPro.HeaderByIndex( I ).Options := mxOutlookBarPro.HeaderByIndex( I ).Options + [ hoDrawFocusedButton ];
  End;

  mxOutlookBarPro.Settings.CaptionStyle := csCustomDraw;
End;

Procedure TMainWindow.Button7Click( Sender: TObject );
Begin
  mxOutlookBarPro.RenameHeaderByIndex( ListBox.ItemIndex );
End;

Procedure TMainWindow.mxOutlookBarProHeaders0Buttons0Click( Sender: TObject );
Begin
  MessageDlg( 'You have pressed the button', mtWarning, [ mbOK ], 0 );
End;

Procedure TMainWindow.mxOutlookBarProDragDrop( Sender: TmxOutlookBarPro;
  Source: TObject; DataObject: IDataObject; Const Formats: Array Of Word;
  Shift: TShiftState; Pt: TPoint; Var Effect: Integer; Mode: TmxDropMode );
Var
  Button: TmxButton;
  medium: TStgMedium;
  DropFiles: PDropFiles;
  Filename: PChar;

  Procedure CreateButton( FileName: String );
  Begin
    Button := Sender.CurrentTargetHeader.AddButton;
    Button.ImageIndex := 41;
    Button.Caption := FileName;
    Button.Hint := FileName;
    Button.ImageIndex := 23;
    Sender.ProcessOuterDrop( DataObject, Button, Sender.CurrentTargetButton, Effect, Sender.CurrentTargetButton.HitStatus );
  End;

Begin
  { You need to change this code to your own }
  If Mode = dmButton Then
  Begin
    If ( DataObject.GetData( HDropFormatEtc, medium ) <> S_OK ) Then exit;

    Try
      If ( medium.tymed = TYMED_HGLOBAL ) Then
      Begin
        DropFiles := PDropFiles( GlobalLock( medium.HGlobal ) );
        Try
          Filename := PChar( DropFiles ) + DropFiles^.pFiles;
          While ( Filename^ <> #0 ) Do
          Begin
            If ( DropFiles^.fWide ) Then
            Begin
              CreateButton( PWideChar( FileName ) );
              Inc( Filename, ( Length( PWideChar( FileName ) ) + 1 ) * 2 );
            End
            Else
            Begin
              CreateButton( Filename );
              Inc( Filename, Length( Filename ) + 1 );
            End;
          End;
        Finally
          GlobalUnlock( medium.HGlobal );
        End;
      End;
    Finally
      ReleaseStgMedium( medium );
    End;
  End
  Else
    MessageDlg( 'You have dropped something on the outlookbar!!', mtWarning, [ mbOK ], 0 );
End;

Procedure TMainWindow.CheckBox5Click( Sender: TObject );
Begin
  If CheckBox5.Checked Then
  Begin
    mxOutlookBarPro.DragMode := dmAutomatic;
    mxOutlookBarPro.Options := mxOutlookBarPro.Options + [ boInternalDrop ];
  End
  Else
  Begin
    mxOutlookBarPro.DragMode := dmManual;
    mxOutlookBarPro.Options := mxOutlookBarPro.Options - [ boInternalDrop ];
  End;
End;

Procedure TMainWindow.CheckBox6Click( Sender: TObject );
Begin
  If CheckBox6.Checked Then
    mxOutlookBarPro.Options := mxOutlookBarPro.Options + [ boAcceptOLEDrop ] Else
    mxOutlookBarPro.Options := mxOutlookBarPro.Options - [ boAcceptOLEDrop ];
End;

Procedure TMainWindow.CheckBox7Click( Sender: TObject );
Begin
  If CheckBox7.Checked Then
    mxOutlookBarPro.Options := mxOutlookBarPro.Options + [ boAutoChangeHeader ] Else
    mxOutlookBarPro.Options := mxOutlookBarPro.Options - [ boAutoChangeHeader ];
End;

Procedure TMainWindow.CheckBox8Click( Sender: TObject );
Begin
  If CheckBox8.Checked Then
    mxOutlookBarPro.Options := mxOutlookBarPro.Options + [ boAutoScroll ] Else
    mxOutlookBarPro.Options := mxOutlookBarPro.Options - [ boAutoScroll ];
End;

Procedure TMainWindow.Button9Click( Sender: TObject );
Begin
  ColorDialog.Color := mxOutlookBarPro.DropMarkColor;
  If ColorDialog.Execute Then
    mxOutlookBarPro.DropMarkColor := ColorDialog.Color;
End;

Procedure TMainWindow.Button8Click( Sender: TObject );
Var
  Button: TmxButton;
Begin
  If mxOutlookBarPro.HeaderCount > 0 Then
    If mxOutlookBarPro.Headers[ 0 ].ButtonCount > 0 Then
      Button := mxOutlookBarPro.Headers[ 0 ].ButtonByIndex( 0 ) Else
    MessageDlg( 'There is not any button in the first header.', mtWarning, [ mbOK ], 0 ) Else
    MessageDlg( 'There is not any header in the bar.', mtWarning, [ mbOK ], 0 );

  If Assigned( Button ) Then Button.Alert;
End;

Procedure TMainWindow.CheckBox9Click( Sender: TObject );
Begin
  mxOutlookBarPro.Background.Grayscale := CheckBox9.Checked;
End;

Procedure TMainWindow.RadioGroup3Click( Sender: TObject );
Begin
  mxOutlookBarPro.Background.Gradient.Direction := TmxGradientDirection( RadioGroup3.ItemIndex );

End;

Procedure TMainWindow.RadioGroup4Click( Sender: TObject );
Begin
  mxOutlookBarPro.Background.Gradient.DrawStyle := TmxGradientStyle( RadioGroup4.ItemIndex );
End;

Procedure TMainWindow.Button10Click( Sender: TObject );
Begin
  ColorDialog.Color := mxOutlookBarPro.Background.Gradient.BeginColor;
  If ColorDialog.Execute Then
    mxOutlookBarPro.Background.Gradient.BeginColor := ColorDialog.Color;
End;

Procedure TMainWindow.Button11Click( Sender: TObject );
Begin
  ColorDialog.Color := mxOutlookBarPro.Background.Gradient.EndColor;
  If ColorDialog.Execute Then
    mxOutlookBarPro.Background.Gradient.EndColor := ColorDialog.Color;
End;

Procedure TMainWindow.mxOutlookBarProContextPopup( Sender: TObject; MousePos: TPoint; Var Handled: Boolean );
Var
  Pos: TPoint;
Begin
  Pos := ClientToScreen( MOUSEPOS );

  If Sender Is TmxButton Then
  Begin
    PopupMenu3.Popup( Pos.X, Pos.Y );
    Handled := True;
  End;
  If Sender Is TmxHeader Then
  Begin
    PopupMenu2.Popup( Pos.X, Pos.Y );
    Handled := True;
  End;
  If Sender Is TmxOutlookBarPro Then
  Begin
    PopupMenu1.Popup( Pos.X, Pos.Y );
    Handled := True;
  End;
End;

Procedure TMainWindow.mxOutlookBarProDragAllowed( Sender: TmxOutlookBarPro; Button: TmxButton; Var Allowed: Boolean );
Begin
  If Assigned( Button ) Then
    Allowed := Button.ButtonKind = bkButton;
End;

End.

⌨️ 快捷键说明

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