zoukankan      html  css  js  c++  java
  • 发现 TSplitter 在嵌套时不好用, 索性写了个替代品(处理MouseDown,MouseMove,MouseUp,然后设定控件的Left值就可以了)

    代替 TSplitter 的 TDirPanel 类:


    unit DirPanel;
    
    interface
    
    uses
      Classes, Controls, Forms, ExtCtrls;
    
    type
      TDirPanel = class(TCustomPanel)
      private
        FLine: TPanel;
        B: Boolean;
        F: Integer;
      protected
        procedure LineMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer);
        procedure LineMouseMove(Sender: TObject; Shift: TShiftState; X: Integer; Y: Integer);
        procedure LineMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer);
      public
        constructor Create(AOwner: TComponent; aAlign: TAlign = alLeft); reintroduce;
        destructor Destroy; override;
      published
    
      end;
    
    implementation
    
    { TDirPanel }
    
    constructor TDirPanel.Create(AOwner: TComponent; aAlign: TAlign);
    begin
      inherited Create(AOwner);
      FLine := TPanel.Create(Self);
      FLine.Parent := Self;
      case aAlign of
        alTop: begin
          FLine.Align := alBottom;
          FLine.Height := 5;
          FLine.Cursor := crVSplit;
          Constraints.MaxHeight := Screen.Height div 4;
          Constraints.MinHeight := FLine.Height;
        end;
        alLeft: begin
          FLine.Align := alRight;
          FLine.Width := 5;
          FLine.Cursor := crHSplit;
          Constraints.MinWidth := FLine.Width;
          Constraints.MaxWidth := Screen.Width div 2;
        end;
      end;
    
      Align := aAlign;
      BevelOuter := bvNone;
    
      FLine.OnMouseDown := LineMouseDown;
      FLine.OnMouseMove := LineMouseMove;
      FLine.OnMouseUp := LineMouseUp;
    end;
    
    destructor TDirPanel.Destroy;
    begin
      FLine.Free;
      inherited;
    end;
    
    procedure TDirPanel.LineMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    begin
      B := True;
      case Align of
        alTop:  F := Y;
        alLeft: F := X;
      end;
    end;
    
    procedure TDirPanel.LineMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    begin
      if not B then Exit;
      case Align of
        alTop: Height := Height + Y - F;
        alLeft: Width := Width + X - F;
      end;
    end;
    
    procedure TDirPanel.LineMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    begin
      B := False;
    end;
    
    end.
    


    调用测试:


    unit Unit1;
    
    interface
    
    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, StdCtrls, ExtCtrls, OleCtrls, SHDocVw, DirPanel;
    
    type
      TForm1 = class(TForm)
        procedure FormCreate(Sender: TObject);
      end;
    
    var
      Form1: TForm1;
    
    implementation
    
    {$R *.dfm}
    
    var
      dir1,dir2: TDirPanel;
      body: TPanel;
      web: TWebBrowser;
      memo: TMemo;
    
    procedure TForm1.FormCreate(Sender: TObject);
    begin
      body := TPanel.Create(Self);
      body.Parent := Self;
      body.Align := alClient;
      body.BevelOuter := bvNone;
    
      dir1 := TDirPanel.Create(Self);
      dir2 := TDirPanel.Create(Self, alTop);
      dir1.Parent := Self;
      dir2.Parent := body;
    
      web := TWebBrowser.Create(Self);
      TControl(web).Parent := dir1;
      web.Align := alClient;
      web.Navigate('http://del.cnblogs.com');
    
      memo := TMemo.Create(Self);
      memo.Parent := dir2;
      memo.Align := alClient;
      memo.Text := 'memo';
    end;
    
    end.

    http://www.cnblogs.com/del/archive/2011/05/12/2044635.html

  • 相关阅读:
    AS3中的xml
    HTML5 tools, Animation tools Adobe Edge Preview
    重新审视php+mssql
    SVN合并分支,从主干合并到分支
    AIR HTML相关资料[js部分]
    USACO 1.1friday
    H.High String
    POJ 3670 Eating Together
    HDU 1203:I NEED A OFFER!
    CodeForces #1 B. Spreadsheets
  • 原文地址:https://www.cnblogs.com/findumars/p/6028376.html
Copyright © 2011-2022 走看看