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

📄 demoform.pas

📁 Crlab公司用来连接MySQL数据库的控件
💻 PAS
字号:
{$I SBDemo.inc}

unit DemoForm;

interface

uses
{$IFNDEF WIN32}
  Types,
{$ENDIF}
  SysUtils, Classes,
{$IFDEF LINUX}
  QControls, QStdCtrls, QComCtrls, QGraphics, QMenus, QTypes, QImgList, QForms,  QButtons, QExtCtrls, Qt,
{$ELSE}
  Windows, Forms, Messages, Controls, StdCtrls,
  Graphics, ImgList,
  ComCtrls, Dialogs, ExtCtrls, Tabs, Menus, DBCtrls, Buttons,
{$IFNDEF VER130}
  Variants,
{$ENDIF}
{$ENDIF}
{$IFDEF CLR}
  System.ComponentModel,
{$ENDIF}
  DemoBase, DemoFrame
  {$IFDEF XPMAN}, UxTheme{$ENDIF}
  {$IFDEF USE_SYNEDIT}, SynMemo, SynEdit, SynEditHighlighter, SynHighlighterPas{$ENDIF}
  ;

type
  TDemoForm = class(TForm)
    MainPanel: TPanel;
    Shape1: TShape;
    pnTopLabel: TPanel;
    Panel2: TPanel;
    pnSource: TPanel;
    Panel6: TPanel;
    Panel3: TPanel;
    sbOpenDemoDir: TSpeedButton;
    pnDemo: TPanel;
    sbDemo: TSpeedButton;
    pnShowSource: TPanel;
    lbTitle: TLabel;
    Panel1: TPanel;
    btRandom: TSpeedButton;

    procedure FormCreate(Sender: TObject); virtual;
    procedure sbOpenDemoDirClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure sbDemoClick(Sender: TObject);
    procedure btRandomClick(Sender: TObject);

  protected
    Demos: TDemos;
    FRandomized: boolean;

    //Product customization
    function ApplicationTitle: string; virtual; abstract; //This function should return DAC product specific title
    procedure RegisterDemos; virtual; abstract;          //This procedure should regiter DAC product specific demos
    //XP manifest
    function GetIsXPMan: boolean;
  {$IFDEF XPMAN}
    procedure ReplaceFlatStyle(Control: TWinControl; Flat: boolean);
  {$ENDIF}
    //Demo selection
    procedure InitializeDemoFrame(Frame: TDemoFrame; DemoType: TDemoType); virtual;
    procedure UpdateDemo;
  public
{$IFDEF USE_SYNEDIT}
    SourceBrowser: TSynMemo;
{$ELSE}
    SourceBrowser: TMemo;
{$ENDIF}
    function ProductColor: TColor; virtual; abstract;     //This function should return DAC product specific color
    procedure Randomize;
    property Randomized: boolean read FRandomized;
  end;

implementation

{$IFDEF CLR}
{$R *.nfm}
{$ENDIF}
{$IFDEF WIN32}
{$R *.dfm}
{$ENDIF}
{$IFDEF LINUX}
{$R *.xfm}
{$ENDIF}

{$IFDEF XPMAN}
  {$R WindowsXP.res}
{$ENDIF}

uses
  RandomForm, ScBridge;

procedure TDemoForm.FormCreate(Sender: TObject);
begin
  Demos := TDemos.Create;
  RegisterDemos;
{$IFDEF XPMAN}
  if GetIsXPMan then begin
    ReplaceFlatStyle(Self, False);
    pnTopLabel.Color := ProductColor;
  end;
{$ENDIF}

{$IFDEF USE_SYNEDIT}
  SourceBrowser := TSynMemo.Create(pnSource);

  SourceBrowser.Highlighter := TSynPasSyn.Create(SourceBrowser);
  SourceBrowser.Options := [eoAltSetsColumnMode, eoAutoIndent, eoAutoSizeMaxScrollWidth, eoDisableScrollArrows, eoDragDropEditing, eoDropFiles, eoEnhanceEndKey, eoGroupUndo, eoHideShowScrollbars, eoKeepCaretX, eoShowScrollHint, eoSmartTabDelete, eoSmartTabs, eoTabIndent, eoTabsToSpaces];
  with SourceBrowser.Gutter do begin
    Visible := True;
    AutoSize := True;
    DigitCount := 3;
    LeftOffset := 0;
    RightOffset := 0;
    ShowLineNumbers := True;
    Width := 1;
 end;
{$ELSE}
  SourceBrowser := TMemo.Create(pnSource);
  SourceBrowser.ScrollBars := ssVertical;
  SourceBrowser.Font.Name := 'Courier New';
  SourceBrowser.Font.Size := 10;
{$ENDIF}
  with SourceBrowser do begin
    Parent := pnSource;
    Align := alClient;
    ReadOnly := True;
  end;
  Resize;
  UpdateDemo;
end;

procedure TDemoForm.FormDestroy(Sender: TObject);
begin
  Demos.Free;
end;

//Sizing constraints
function TDemoForm.GetIsXPMan: boolean;
begin
  Result := {$IFDEF XPMAN}UseThemes; {$ELSE} False;{$ENDIF}
end;

{$IFDEF XPMAN}
procedure TDemoForm.ReplaceFlatStyle(Control: TWinControl; Flat: boolean);
var
  i: integer;
begin
  for i := 0 to Control.ControlCount - 1 do
    if Control.Controls[i] is TSpeedButton then
      TSpeedButton(Control.Controls[i]).Flat := Flat
    else
    if Control.Controls[i] is TDBNavigator then
      TDBNavigator(Control.Controls[i]).Flat := Flat
    else
      if Control.Controls[i] is TWinControl then begin
        if Control.Controls[i] is TPanel then begin
          TPanel(Control.Controls[i]).ParentBackground := False;
          if Control.Controls[i].Tag <> 0 then
            TPanel(Control.Controls[i]).Color := ProductColor
          else
            TPanel(Control.Controls[i]).Color := clBtnFace;
        end;
        ReplaceFlatStyle(TWinControl(Control.Controls[i]), Flat);
      end;

end;
{$ENDIF}

//Demo Change
procedure TDemoForm.InitializeDemoFrame(Frame: TDemoFrame; DemoType: TDemoType);
begin
  Frame.Parent := pnDemo;
  Frame.Initialize;
{$IFDEF XPMAN}
  if GetIsXPMan then
    ReplaceFlatStyle(Frame, False);
{$ENDIF}
end;

procedure TDemoForm.UpdateDemo;
begin
//  for i := 1 to StatusBar.Panels.Count - 1 do
//    StatusBar.Panels[i].Text := '';

  with Demos.SelectDemo(1) do begin
    InitializeDemoFrame(Frame, DemoType);
    LoadDemoCode(SourceBrowser.Lines);            //Load demo sources
    if DemoType = dtCategory then begin
      pnSource.Visible := False;
      pnDemo.Visible := True;
      sbDemo.Enabled := False;
    end
    else begin
      sbDemo.Enabled := True;
      if sbDemo.Down then begin
        pnSource.Visible := True;
        pnDemo.Visible := False;
      end;
    end;
    Self.Caption := ApplicationTitle + ' - ' + Hint;
    Application.Title := Self.Caption;
  end;
//  StatusBar.Repaint;
end;

procedure TDemoForm.sbOpenDemoDirClick(Sender: TObject);
begin
  Demos.SelectedDemo.OpenDemoFolder;
end;

procedure TDemoForm.sbDemoClick(Sender: TObject);
begin
  with sbDemo do
    if {$IFDEF LINUX}not{$ENDIF} Down then begin
      pnSource.Visible := True;
      pnDemo.Visible := False;
      Caption := 'Show demo'
    end
    else begin
      pnSource.Visible := False;
      pnDemo.Visible := True;
      Caption := 'Show source'
    end;
end;

procedure TDemoForm.Randomize;
begin
  fmRandom := TfmRandom.Create(Self);
  try
    if fmRandom.ShowModal = mrOk then begin
      Random.Randomize(fmRandom.Data);
      FRandomized := True;
    end;
  finally
    fmRandom.Free;
  end;
end;

procedure TDemoForm.btRandomClick(Sender: TObject);
begin
  Self.Randomize;
end;

end.

⌨️ 快捷键说明

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