首页  编辑  

滑动窗口

Tags: /超级猛料/Friends.网友专栏/zswang/   Date Created:

////unit1.pas

unit Unit1;

interface

uses

 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

 ExtCtrls, StdCtrls, Buttons;

type

 TForm1 = class(TForm)

   ImageRight: TImage;

   ImageDown: TImage;

   Panel1: TPanel;

   ImageCenter: TImage;

   MemoRight: TMemo;

   MemoDown: TMemo;

   SpeedButtonRight: TSpeedButton;

   SpeedButtonDown: TSpeedButton;

   procedure SpeedButtonRightClick(Sender: TObject);

   procedure FormCreate(Sender: TObject);

   procedure SpeedButtonDownClick(Sender: TObject);

   procedure FormDestroy(Sender: TObject);

   procedure ImageCenterMouseDown(Sender: TObject; Button: TMouseButton;

     Shift: TShiftState; X, Y: Integer);

 private

   { Private declarations }

   FRGNRight: HRGN;

   FRGNDown: HRGN;

   FRGNCenter: HRGN;

   FRGNForm: HRGN;

   FShowRight: Boolean;

   FShowDown: Boolean;

   procedure SetShowRight(const Value: Boolean);

   procedure SetShowDown(const Value: Boolean);

   procedure ShowFormRgn;

 public

   { Public declarations }

   property ShowRight: Boolean read FShowRight write SetShowRight;

   property ShowDown: Boolean read FShowDown write SetShowDown;

 end;

var

 Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.SpeedButtonRightClick(Sender: TObject);

begin

 ShowRight := not ShowRight;

end;

procedure TForm1.SpeedButtonDownClick(Sender: TObject);

begin

 ShowDown := not ShowDown;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

 ///////Begin 创建不规则的区域

 { TODO : 修改区域 }

 FRGNRight := CreateRectRgn(

   ImageRight.BoundsRect.Left,

   ImageRight.BoundsRect.Top,

   ImageRight.BoundsRect.Right,

   ImageRight.BoundsRect.Bottom);

 FRGNDown := CreateRectRgn(

   ImageDown.BoundsRect.Left,

   ImageDown.BoundsRect.Top,

   ImageDown.BoundsRect.Right,

   ImageDown.BoundsRect.Bottom);

 FRGNCenter :=  CreateRectRgn(

   ImageCenter.BoundsRect.Left,

   ImageCenter.BoundsRect.Top,

   ImageCenter.BoundsRect.Right,

   ImageCenter.BoundsRect.Bottom);

 ///////End 创建不规则的区域

 

 ShowFormRgn;

 DoubleBuffered := True;

 FShowRight := False;

 FShowDown := False;

end;

procedure TForm1.SetShowRight(const Value: Boolean);

const

 {$J+}vChanging: Boolean = False;

const

 cOffset = 3;

var

 I: Integer;

 vStart, vEnd: Integer;

 vOffset: Integer; //偏移量

begin

 if FShowRight = Value then Exit;

 if vChanging then Exit;

 FShowRight := Value;

 vChanging := True;

 if FShowRight then begin

   vOffset := -cOffset;

   vStart := ImageRight.Left;

   vEnd := ImageRight.Left - ImageRight.Width + 20;

 end else begin

   vOffset := +cOffset;

   vStart := ImageRight.Left;

   vEnd := ImageRight.Left + ImageRight.Width - 20;

 end;

 I := vStart;

 while Abs(I - vEnd) > Abs(vOffset) do begin

   ImageRight.Left := I;

   MemoRight.Left := I + 1;

   SpeedButtonRight.Left := I + 170;

   Application.ProcessMessages;

   OffsetRgn(FRGNRight, vOffset, 0); //偏移区域

   ShowFormRgn;

   ClientWidth := I + ImageRight.Width + 2; //宽度改变

   Update;

   I := I + vOffset;

 end;

 vChanging := False;

end;

procedure TForm1.SetShowDown(const Value: Boolean);

const

 {$J+}vChanging: Boolean = False;

const

 cOffset = 3;

var

 I: Integer;

 vStart, vEnd: Integer;

 vOffset: Integer; //偏移量

begin

 if FShowDown = Value then Exit;

 if vChanging then Exit;

 FShowDown := Value;

 vChanging := True;

 if FShowDown then begin

   vOffset := -cOffset;

   vStart := ImageDown.Top;

   vEnd := ImageDown.Top - ImageDown.Height + 20;

 end else begin

   vOffset := +cOffset;

   vStart := ImageDown.Top;

   vEnd := ImageDown.Top + ImageDown.Height - 20;

 end;

 I := vStart;

 while Abs(I - vEnd) > Abs(vOffset) do begin

   ImageDown.Top := I;

   MemoDown.Top := I + 1;

   SpeedButtonDown.Top := I + 95;

   Application.ProcessMessages;

   OffsetRgn(FRGNDown, 0, vOffset); //偏移区域

   ShowFormRgn;

   ClientHeight := I + ImageDown.Height + 2; //宽度改变

   Update;

   I := I + vOffset;

 end;

 vChanging := False;

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

 DeleteObject(FRGNRight);

 DeleteObject(FRGNDown);

 DeleteObject(FRGNCenter);

 DeleteObject(FRGNForm);

end;

procedure TForm1.ShowFormRgn;

begin

 ///////Begin 清除区域

 DeleteObject(FRGNForm);

 FRGNForm := CreateRectRgn(0, 0, 0, 0);

 ///////End 清除区域

 CombineRgn(FRGNForm, FRGNCenter, FRGNRight, RGN_OR);

 CombineRgn(FRGNForm, FRGNForm, FRGNDown, RGN_OR);

 SetWindowRgn(Handle, FRGNForm, True);

end;

procedure TForm1.ImageCenterMouseDown(Sender: TObject;

 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

 ReleaseCapture;

 Perform(WM_SYSCOMMAND, SC_MOVE + 1, 0);

end;

end.

///////unit1.dfm

object Form1: TForm1

 Left = 97

 Top = 22

 BorderStyle = bsNone

 Caption = 'Form1'

 ClientHeight = 486

 ClientWidth = 602

 Color = clBtnFace

 Font.Charset = DEFAULT_CHARSET

 Font.Color = clWindowText

 Font.Height = -11

 Font.Name = 'MS Sans Serif'

 Font.Style = []

 OldCreateOrder = False

 OnCreate = FormCreate

 OnDestroy = FormDestroy

 PixelsPerInch = 96

 TextHeight = 13

 object ImageRight: TImage

   Left = 408

   Top = 36

   Width = 190

   Height = 263

 end

 object ImageDown: TImage

   Left = 64

   Top = 368

   Width = 294

   Height = 115

 end

 object SpeedButtonRight: TSpeedButton

   Left = 576

   Top = 140

   Width = 17

   Height = 33

   OnClick = SpeedButtonRightClick

 end

 object SpeedButtonDown: TSpeedButton

   Left = 192

   Top = 464

   Width = 41

   Height = 17

   OnClick = SpeedButtonDownClick

 end

 object MemoDown: TMemo

   Left = 83

   Top = 369

   Width = 256

   Height = 80

   Lines.Strings = (

     'MemoDown')

   TabOrder = 2

 end

 object MemoRight: TMemo

   Left = 410

   Top = 52

   Width = 156

   Height = 225

   Lines.Strings = (

     'MemoRight')

   TabOrder = 1

 end

 object Panel1: TPanel

   Left = 0

   Top = 0

   Width = 409

   Height = 369

   BevelOuter = bvNone

   TabOrder = 0

   object ImageCenter: TImage

     Left = -2

     Top = 0

     Width = 411

     Height = 369

     ParentShowHint = False

     ShowHint = False

     OnMouseDown = ImageCenterMouseDown

   end

 end

end