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

📄 ebarmegademomain.pas

📁 胜天进销存源码,国产优秀的进销存
💻 PAS
📖 第 1 页 / 共 3 页
字号:
unit EBarMegaDemoMain;

{$I ..\cxVer.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  dxBar, ExtCtrls, dxsbar, dxBarExtItems, ComCtrls, StdCtrls,
  OleCtrls, dxBarExtDBItems, dxBarDBNav, Db, DBTables,{$IFDEF DELPHI6} Variants, {$ENDIF}
  SHDocVw_TLB, Grids, DBGrids, ActiveX, RichEdit, Menus, ImgList, ActnList, EBarsUtils;

type
  TEBarMegaDemoMainForm = class(TForm)
    dxSideBarStore: TdxSideBarStore;
    dxSideBarStoreItem1: TdxStoredSideItem;
    dxSideBarStoreItem2: TdxStoredSideItem;
    dxSideBarStoreItem3: TdxStoredSideItem;
    BarManager: TdxBarManager;
    dxBarButtonNew: TdxBarLargeButton;
    dxBarButtonOpen: TdxBarLargeButton;
    dxBarButtonClose: TdxBarLargeButton;
    dxBarButtonSave: TdxBarLargeButton;
    dxBarButtonSaveAs: TdxBarLargeButton;
    dxBarSubItemFile: TdxBarSubItem;
    dxBarSubItemEdit: TdxBarSubItem;
    dxBarSubItemFormat: TdxBarSubItem;
    dxBarButtonPrint: TdxBarLargeButton;
    dxBarButtonExit: TdxBarLargeButton;
    dxBarButtonUndo: TdxBarLargeButton;
    dxBarButtonCut: TdxBarLargeButton;
    dxBarButtonCopy: TdxBarLargeButton;
    dxBarButtonPaste: TdxBarLargeButton;
    dxBarButtonClear: TdxBarLargeButton;
    dxBarButtonSelectAll: TdxBarLargeButton;
    dxBarButtonFind: TdxBarLargeButton;
    dxBarButtonReplace: TdxBarLargeButton;
    dxBarComboFontSize: TdxBarCombo;
    dxBarButtonBold: TdxBarLargeButton;
    dxBarButtonItalic: TdxBarLargeButton;
    dxBarButtonUnderline: TdxBarLargeButton;
    dxBarButtonBullets: TdxBarLargeButton;
    dxBarButtonAlignLeft: TdxBarLargeButton;
    dxBarButtonCenter: TdxBarLargeButton;
    dxBarButtonAlignRight: TdxBarLargeButton;
    dxBarButtonURLDetection: TdxBarLargeButton;
    dxBarSubItemHelp: TdxBarSubItem;
    dxBarButtonFont: TdxBarLargeButton;
    Splitter: TSplitter;
    OpenDialog: TOpenDialog;
    dxBarPopupMenu: TdxBarPopupMenu;
    SaveDialog: TSaveDialog;
    PrintDialog: TPrintDialog;
    FontDialog: TFontDialog;
    dxBarComboFontName: TdxBarFontNameCombo;
    dxBarComboFontColor: TdxBarColorCombo;
    LargeImage: TImageList;
    SmallImage: TImageList;
    dxBackBtn: TdxBarLargeButton;
    dxForwardBtn: TdxBarLargeButton;
    dxStopBtn: TdxBarLargeButton;
    dxRefreshBtn: TdxBarLargeButton;
    dxHomeBtn: TdxBarLargeButton;
    dxSearchBtn: TdxBarLargeButton;
    dxAddressCombo: TdxBarCombo;
    dxLinks: TdxBarStatic;
    dxProductsBtn: TdxBarLargeButton;
    dxDownloadsBtn: TdxBarLargeButton;
    BackPopupMenu: TdxBarPopupMenu;
    ForwardPopupMenu: TdxBarPopupMenu;
    dxBarHistory: TdxBarLargeButton;
    dxCityCombo: TdxBarTreeViewCombo;
    dxProductsCombo: TdxBarLookupCombo;
    dxDate: TdxBarDateCombo;
    dxIESelectAllBtn: TdxBarLargeButton;
    dxIEView: TdxBarSubItem;
    dxIEStop: TdxBarLargeButton;
    dxGo: TdxBarSubItem;
    dxIERefreshBtn: TdxBarLargeButton;
    dxIEBackBtn: TdxBarLargeButton;
    dxIEForwardBtn: TdxBarLargeButton;
    dxFavorites: TdxBarSubItem;
    dxIELinks: TdxBarSubItem;
    dxClearBtn: TdxBarLargeButton;
    dxBarDBNavigator: TdxBarDBNavigator;
    GridImageList: TImageList;
    dxFilter: TdxBarSubItem;
    dxDBNavig: TdxBarSubItem;
    dxOptions: TdxBarButton;
    Panel3: TPanel;
    dxFORUMBtn: TdxBarLargeButton;
    dxTypeCombo: TdxBarImageCombo;
    dxSideBarPopupMenu: TdxSideBarPopupMenu;
    FindDialog: TFindDialog;
    ReplaceDialog: TReplaceDialog;
    dxBarGroup: TdxBarGroup;
    dxBSPosition: TdxBarStatic;
    dxBSStatus: TdxBarStatic;
    dxBarProgress: TdxBarProgressItem;
    Panel1: TPanel;
    dxSideBar: TdxSideBar;
    Image: TImage;
    Panel2: TPanel;
    Nb: TNotebook;
    PanelRE: TPanel;
    Editor: TRichEdit;
    HTMLPanel: TPanel;
    DBGrid1: TDBGrid;
    dxBDStatus: TdxBarDockControl;
    dxBSIEStatus: TdxBarStatic;
    dxBarButtonAbout: TdxBarLargeButton;
    dxBarButtonDXDownloads: TdxBarLargeButton;
    dxBarButtonDXOntheweb: TdxBarLargeButton;
    dxBarButtonHelp: TdxBarLargeButton;
    dxBarButtonProducts: TdxBarLargeButton;
    dxBarButtonForum: TdxBarLargeButton;
    dxBarDBNavFirst1: TdxBarDBNavButton;
    dxBarDBNavPrev1: TdxBarDBNavButton;
    dxBarDBNavNext1: TdxBarDBNavButton;
    dxBarDBNavLast1: TdxBarDBNavButton;
    dxBarDBNavInsert1: TdxBarDBNavButton;
    dxBarDBNavDelete1: TdxBarDBNavButton;
    dxBarDBNavEdit1: TdxBarDBNavButton;
    dxBarDBNavPost1: TdxBarDBNavButton;
    dxBarDBNavCancel1: TdxBarDBNavButton;
    dxBarDBNavRefresh1: TdxBarDBNavButton;
    dxBarButton1: TdxBarLargeButton;
    ilDisabledImages: TImageList;
    ilHotImages: TImageList;
    Images: TImageList;
    dxBarLargeButton1: TdxBarLargeButton;
    dxBarLargeButton2: TdxBarLargeButton;
    procedure FormCreate(Sender: TObject);
    procedure dxSideBarItemClick(Sender: TObject; Item: TdxSideBarItem);
    procedure dxBarButtonNewClick(Sender: TObject);
    procedure dxBarButtonOpenClick(Sender: TObject);
    procedure dxBarButtonCloseClick(Sender: TObject);
    procedure EditorChange(Sender: TObject);
    procedure EditorSelectionChange(Sender: TObject);
    procedure dxBarButtonExitClick(Sender: TObject);
    procedure dxBarButtonSaveClick(Sender: TObject);
    procedure dxBarButtonSaveAsClick(Sender: TObject);
    procedure dxBarButtonPrintClick(Sender: TObject);
    procedure dxBarButtonUndoClick(Sender: TObject);
    procedure dxBarButtonCutClick(Sender: TObject);
    procedure dxBarButtonCopyClick(Sender: TObject);
    procedure dxBarButtonPasteClick(Sender: TObject);
    procedure dxBarButtonClearClick(Sender: TObject);
    procedure dxBarButtonSelectAllClick(Sender: TObject);
    procedure dxBarButtonFindClick(Sender: TObject);
    procedure dxBarButtonReplaceClick(Sender: TObject);
    procedure dxBarButtonFontClick(Sender: TObject);
    procedure dxBarButtonBulletsClick(Sender: TObject);
    procedure dxBarButtonProtectedClick(Sender: TObject);
    procedure dxBarComboFontColorChange(Sender: TObject);
    procedure dxBarComboFontColorClick(Sender: TObject);
    procedure dxBarComboHighlightClick(Sender: TObject);
    procedure dxBarButtonURLDetectionClick(Sender: TObject);
    procedure dxBarComboFontNameChange(Sender: TObject);
    procedure dxBarComboFontNameClick(Sender: TObject);
    procedure dxBarComboFontSizeChange(Sender: TObject);
    procedure dxBarComboFontSizeClick(Sender: TObject);
    procedure dxBarButtonBoldClick(Sender: TObject);
    procedure dxBarButtonItalicClick(Sender: TObject);
    procedure dxBarButtonUnderlineClick(Sender: TObject);
    procedure dxBarButtonAlignLeftClick(Sender: TObject);
    procedure dxBarButtonCenterClick(Sender: TObject);
    procedure dxBarButtonAlignRightClick(Sender: TObject);
    procedure dxAddressComboKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure dxAddressComboDrawItem(Sender: TdxBarCustomCombo;
      AIndex: Integer; ARect: TRect; AState: TOwnerDrawState);
    procedure dxStopBtnClick(Sender: TObject);
    procedure dxRefreshBtnClick(Sender: TObject);
    procedure dxHomeBtnClick(Sender: TObject);
    procedure dxProductsBtnClick(Sender: TObject);
    procedure dxAddressComboChange(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure dxBackBtnClick(Sender: TObject);
    procedure dxForwardBtnClick(Sender: TObject);
    procedure dxBarHistoryClick(Sender: TObject);
    procedure dxSearchBtnClick(Sender: TObject);
    procedure dxCityComboChange(Sender: TObject);
    procedure dxClearBtnClick(Sender: TObject);
    procedure dxProductsComboChange(Sender: TObject);
    procedure dxDateChange(Sender: TObject);
    procedure dxOptionsClick(Sender: TObject);
    procedure dxTypeComboChange(Sender: TObject);
    procedure FindDialogFind(Sender: TObject);
    procedure ReplaceDialogReplace(Sender: TObject);
  private
    FUpdating: Boolean;
    FHistoryIndex: Integer;
    FHistoryList: TStringList;
    FUpdateCombo: Boolean;
    FFileName : string;
    FAddress : string;
    FHTML: TWebBrowser;
    procedure UpdateToolBar( index : integer);
    procedure FindAddress;
  public
    function SaveFile(ASaveAs: Boolean): Boolean;
    function AskSaveFile: Boolean;
    procedure SetModified(Value: Boolean);
    procedure ShowItems(AShow: Boolean);
    procedure SetFilter;
    procedure StatusTextChange(Sender: TObject; const Text: WideString);
    procedure TitleChange(Sender: TObject; const Text: WideString);
    procedure DocumentComplete(Sender: TObject; pDisp: IDispatch; var URL: OleVariant);
    procedure ProgressChange(Sender: TObject; Progress, ProgressMax: Integer);
    procedure BeforeNavigate(Sender: TObject; pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool);

  end;

var EBarMegaDemoMainForm : TEBarMegaDemoMainForm;

implementation

uses EBarMegaDemoOptions, EBarMegaDemoData, EBarMegaDemoAbout;

{$R *.DFM}
{$R windowsxp.res}

procedure TEBarMegaDemoMainForm.FormCreate(Sender: TObject);
const
  Filter = 'Rich Text Files (*.RTF)|*.RTF';
begin
  dmCommonData.AboutFormClass := TEBarMegaDemoAboutForm;

  FHTML := TWebBrowser.Create(HTMLPanel);
  TWinControl(FHTML).Parent := HTMLPanel;

  FHTML.OnDocumentComplete := DocumentComplete;
  FHTML.OnProgressChange := ProgressChange;
  FHTML.OnBeforeNavigate2 := BeforeNavigate;
  FHTML.OnStatusTextChange := StatusTextChange;
  FHTML.OnTitleChange := TitleChange;

  FHTML.Align := alClient;

  FAddress := '';
  ShortDateFormat := 'mm/dd/yyyy';
  FUpdateCombo := True;
  OpenDialog.Filter := Filter;
  SaveDialog.Filter := Filter;
  OpenDialog.InitialDir := ExtractFilePath(ParamStr(0));
  SaveDialog.InitialDir := OpenDialog.InitialDir;
  Editor.Clear;
  PanelRE.Visible := False;
  SetModified(False);
  ShowItems(False);
  BarManager.LockUpdate := True;
  UpdateToolBar(0);
  BarManager.LockUpdate := False;
  FHistoryIndex := -1;
  FHistoryList := TStringList.Create;
  with EBarMegaDemoMainDM do
  begin
    tblProducts.Close;
    tblContacts.Close;
    tblProducts.Open;
    tblContacts.Open;
  end;
  dxDate.Text := '';
  Editor.Lines.LoadFromFile('lipsum.rtf');
  SetModified(False);
  ShowItems(True);
  dxSideBarItemClick(nil, dxSideBar.Groups[0].Items[0]);
  dxSideBar.SelectedItem := dxSideBar.Groups[0].Items[0];
end;

procedure TEBarMegaDemoMainForm.UpdateToolBar(Index: Integer);

type TVisibleItems = set of Char;

const
  VisibleBars: array [0..3] of TVisibleItems = ([#0], [#0..#3,#9], [#0, #4..#6,#9], [#0,#7,#8]);
  VisibleCategories: array [0..3] of TVisibleItems = ([#0,#4,#5], [#0..#5], [#0,#1,#5,#4,#6,#7,#8,#10,#11], [#0,#4,#5,#9,#12]);
var
  I : Integer;
begin
  with BarManager do
  begin
    for I := 0 to Categories.Count - 1 do
      CategoryVisible[I] := (Chr(I) in VisibleCategories[Index]);
    for I := Bars.Count - 1 downto 0 do
      if (not(Chr(I) in VisibleBars[Index])) or (I = 0) then
      begin
        Bars[I].Visible := False;
        Bars[I].Hidden := True;
      end;
    for I := 0 to ItemCount - 1 do
      if (Items[I].Tag = 0 ) or (Items[I].Tag = Index) then
       Items[I].Visible := ivAlways
      else
       Items[I].Visible := ivNever;
    for i := 0 to Bars.Count - 1 do
      if (Chr(I) in VisibleBars[Index]) or (I = 0) then
      begin
        Bars[I].Visible := True;
        Bars[I].Hidden := False;
      end;
    NB.PageIndex := Index;
  end;
  dxBSIEStatus.Caption := '';
  dxBSStatus.Caption := '';
  dxBSPosition.Caption := '';
  dxBarProgress.Position := 0;
  dxBSIEStatus.Glyph := nil;
  if Index = 2 then
    dxBSIEStatus.Glyph.Assign(Image.Picture.Bitmap);
end;

procedure TEBarMegaDemoMainForm.dxSideBarItemClick(Sender: TObject;
  Item: TdxSideBarItem);
begin
  Caption := 'ExpressBars6 Mega Demo';
  LockWindowUpdate(Self.Handle);
  BarManager.LockUpdate := True;
  UpdateToolBar(Item.Tag);
  BarManager.LockUpdate := False;
  LockWindowUpdate(0);
end;

procedure TEBarMegaDemoMainForm.dxBarButtonNewClick(Sender: TObject);
var
  Res : Integer;
begin
  if Editor.Modified then
  begin
    Res := Application.MessageBox(PChar(Format('Do you want to save the changes you made ?',
      [FFileName])), PChar(FFileName), MB_ICONQUESTION or MB_YESNOCANCEL);
    case Res of
      ID_YES:
        if SaveFile(False) then
          Editor.Lines.Clear
        else
          exit;
      ID_NO:
        Editor.Lines.Clear;
      ID_CANCEL:
        exit;
    end;
  end;
  Editor.Lines.Clear;
  FFileName := '';
  ShowItems(True);
end;

⌨️ 快捷键说明

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