StatusBars.pas
上传用户:hylc_2004
上传日期:2014-01-23
资源大小:46800k
文件大小:5k
源码类别:

Delphi控件源码

开发平台:

Delphi

  1. unit StatusBars;
  2. interface
  3. uses
  4.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  5.   fcStatusBar, Menus, fcLabel, ComCtrls, Buttons, Db, DBTables, StdCtrls,
  6.   DBCtrls, ExtCtrls, Gauges, fcClearPanel, fcButtonGroup, ShellAPI,
  7.   fcButton, fcImgBtn, fcShapeBtn, fcDemoRichEdit, ImgList;
  8. type
  9.   TStatusBarDemoForm = class(TForm)
  10.     MainMenu1: TMainMenu;
  11.     Main1: TMenuItem;
  12.     Item11: TMenuItem;
  13.     Item1: TMenuItem;
  14.     Item3: TMenuItem;
  15.     Secondary1: TMenuItem;
  16.     psMenu1: TMenuItem;
  17.     Menu1: TMenuItem;
  18.     RichEditRowCol1: TMenuItem;
  19.     Control1: TMenuItem;
  20.     ImageList1: TImageList;
  21.     Timer1: TTimer;
  22.     PageControl1: TPageControl;
  23.     TabSheet2: TTabSheet;
  24.     TabSheet3: TTabSheet;
  25.     TabSheet4: TTabSheet;
  26.     TabSheet5: TTabSheet;
  27.     TabSheet6: TTabSheet;
  28.     TabSheet7: TTabSheet;
  29.     TabSheet8: TTabSheet;
  30.     fcDemoRichEdit2: TfcDemoRichEdit;
  31.     fcDemoRichEdit3: TfcDemoRichEdit;
  32.     fcDemoRichEdit4: TfcDemoRichEdit;
  33.     fcDemoRichEdit5: TfcDemoRichEdit;
  34.     fcDemoRichEdit6: TfcDemoRichEdit;
  35.     fcDemoRichEdit7: TfcDemoRichEdit;
  36.     fcDemoRichEdit8: TfcDemoRichEdit;
  37.     fcButtonGroup1: TfcButtonGroup;
  38.     Keyboardstyles: TfcImageBtn;
  39.     datetimestyles: TfcImageBtn;
  40.     computerinfostyle: TfcImageBtn;
  41.     imagestyle: TfcImageBtn;
  42.     hintsstyle: TfcImageBtn;
  43.     RichEditstyle: TfcImageBtn;
  44.     customcontrolstyle: TfcImageBtn;
  45.     fcStatusBar2: TfcStatusBar;
  46.     fcStatusBar3: TfcStatusBar;
  47.     fcStatusBar4: TfcStatusBar;
  48.     fcStatusBar5: TfcStatusBar;
  49.     fcStatusBar6: TfcStatusBar;
  50.     fcStatusBar7: TfcStatusBar;
  51.     fcStatusBar8: TfcStatusBar;
  52.     ProgressBar1: TProgressBar;
  53.     SpeedButton1: TSpeedButton;
  54.     Gauge1: TGauge;
  55.     Panel1: TPanel;
  56.     fcLabel1: TfcLabel;
  57.     Close1: TMenuItem;
  58.     procedure Item11Click(Sender: TObject);
  59.     procedure Timer1Timer(Sender: TObject);
  60.     procedure fcStatusBar3Panels3DrawText(Panel: TfcStatusPanel;
  61.       var Text: String; var Enabled:Boolean);
  62.     procedure fcStatusBar4Panels0DrawText(Panel: TfcStatusPanel;
  63.       var Text: String; var Enabled:Boolean);
  64.     procedure fcStatusBar4Panels1DrawText(Panel: TfcStatusPanel;
  65.       var Text: String; var Enabled:Boolean);
  66.     procedure fcStatusBar7Panels0DrawText(Panel: TfcStatusPanel;
  67.       var Text: String; var Enabled:Boolean);
  68.     procedure fcStatusBar7Panels1DrawText(Panel: TfcStatusPanel;
  69.       var Text: String; var Enabled:Boolean);
  70.     procedure fcStatusBar7Panels3DrawText(Panel: TfcStatusPanel;
  71.       var Text: String; var Enabled:Boolean);
  72.     procedure fcLabel1MouseEnter(Sender: TObject);
  73.     procedure fcLabel1MouseLeave(Sender: TObject);
  74.     procedure fcLabel1Click(Sender: TObject);
  75.     procedure Close1Click(Sender: TObject);
  76.     procedure fcButtonGroup1Change(ButtonGroup: TfcCustomButtonGroup;
  77.       OldSelected, Selected: TfcButtonGroupItem);
  78.   private
  79.     { Private declarations }
  80.   public
  81.     { Public declarations }
  82.   end;
  83. var
  84.   StatusBarDemoForm: TStatusBarDemoForm;
  85. implementation
  86. {$R *.DFM}
  87. procedure TStatusBarDemoForm.Item11Click(Sender: TObject);
  88. begin
  89.   fcButtonGroup1.ButtonItems[(Sender as TMenuItem).Tag].Button.Down := True;
  90. end;
  91. procedure TStatusBarDemoForm.Timer1Timer(Sender: TObject);
  92. begin
  93.   ProgressBar1.StepIt;
  94.   if Gauge1.Progress=100 then Gauge1.Progress := 0;
  95.   Gauge1.AddProgress(10);
  96. end;
  97. procedure TStatusBarDemoForm.fcStatusBar3Panels3DrawText(
  98.   Panel: TfcStatusPanel; var Text: String; var Enabled:Boolean);
  99. begin
  100.   Text := FormatDateTime('dddddd',Date);
  101. end;
  102. procedure TStatusBarDemoForm.fcStatusBar4Panels0DrawText(
  103.   Panel: TfcStatusPanel; var Text: String; var Enabled:Boolean);
  104. begin
  105.    Text := 'Computer Name: '+Text;
  106. end;
  107. procedure TStatusBarDemoForm.fcStatusBar4Panels1DrawText(
  108.   Panel: TfcStatusPanel; var Text: String; var Enabled:Boolean);
  109. begin
  110.    Text := 'User Name: '+Text;
  111. end;
  112. procedure TStatusBarDemoForm.fcStatusBar7Panels0DrawText(
  113.   Panel: TfcStatusPanel; var Text: String; var Enabled:Boolean);
  114. begin
  115.    Text := 'Current Line is: '+IntToStr(Panel.Row+1);
  116. end;
  117. procedure TStatusBarDemoForm.fcStatusBar7Panels1DrawText(
  118.   Panel: TfcStatusPanel; var Text: String; var Enabled:Boolean);
  119. begin
  120.    Text := 'Current Column is: '+IntToStr(Panel.Col);
  121. end;
  122. procedure TStatusBarDemoForm.fcStatusBar7Panels3DrawText(
  123.   Panel: TfcStatusPanel; var Text: String; var Enabled:Boolean);
  124. begin
  125.   Text := '('+IntToStr(Panel.Row+1)+','+IntToStr(Panel.Col)+')';
  126. end;
  127. procedure TStatusBarDemoForm.fcLabel1MouseEnter(Sender: TObject);
  128. begin
  129.   (Sender as TfcLabel).Font.Color := clBlue;
  130. end;
  131. procedure TStatusBarDemoForm.fcLabel1MouseLeave(Sender: TObject);
  132. begin
  133.   (Sender as TfcLabel).Font.Color := clBlack;
  134. end;
  135. procedure TStatusBarDemoForm.fcLabel1Click(Sender: TObject);
  136. begin
  137.    ShellExecute(Handle, 'OPEN',
  138.      PChar('https://www.he.net/cgi-bin/suid/~wol2wol/ordering/order.cgi'),
  139.            nil, nil, sw_shownormal);
  140. end;
  141. procedure TStatusBarDemoForm.Close1Click(Sender: TObject);
  142. begin
  143.   Close;
  144. end;
  145. procedure TStatusBarDemoForm.fcButtonGroup1Change(
  146.   ButtonGroup: TfcCustomButtonGroup; OldSelected,
  147.   Selected: TfcButtonGroupItem);
  148. begin
  149.   if OldSelected.Button <> nil then
  150.     OldSelected.Button.Font.Color := clBlack;
  151.   Selected.Button.Font.Color := clRed;
  152.   PageControl1.ActivePage :=
  153.      FindComponent('TabSheet'+IntToStr(Selected.Button.Tag)) as TTabSheet;
  154. end;
  155. end.