(*----------------------------------- RectとPointを処理するユニット 更新履歴 2006/07/10(月) ・RectWidth/HeightをGetRectWidth/Heightに名前変更 ・RectSetWidth/HeightをSetRectWidth/Heightに名前変更 //-----------------------------------*) unit RectPointUnit; interface uses Types; function PointEqual(const A, B: TPoint): Boolean; function RectEqual(const A, B: TRect): Boolean; function PointInRect(Point1: TPoint; Rect1: TRect): Boolean; function PointPlus(Point1, Point2: TPoint): TPoint; function PointMinus(Point1, Point2: TPoint): TPoint; function GetRectWidth(Rect: TRect): Integer; procedure SetRectWidth(var Rect: TRect; Width: Integer); function GetRectHeight(Rect: TRect): Integer; procedure SetRectHeight(var Rect: TRect; Height: Integer); function RectCenter(Rect: TRect): TPoint; function RectMove(const Rect: TRect; X, Y: Integer): TRect; function RectMovePoint(const Rect: TRect; MovePoint: TPoint): TRect; function RectMoveCenter(const MoveRect, BaseRect: TRect): TRect; function RectSquare(Left, Top, Width, Hight: Integer): TRect; function PopupRect(BaseRect, RectValue: TRect; PopupPoint: TPoint): TRect; function OutsideRectMoveInside(BaseRect, TargetRect: TRect; TopFit: Boolean = True; BottomFit: Boolean = True; LeftFit: Boolean = True; RightFit: Boolean = True): TRect; function RectSizePlus(const Rect: TRect; LeftValue, TopValue, RightValue, BottomValue: Integer): TRect; type { ----------------------------------- //Rectのサイズを表す構造体 戻り値: TRectSize 履歴: 2001/03/22 //----------------------------------- } TRectSize = record Width: Cardinal; Height:Cardinal; end; function RectSize(Width, Height: Cardinal): TRectSize; overload; function RectSize(const Rect: TRect): TRectSize; overload; function RectSizeEqual(const A, B: TRectSize): Boolean; function RectDirectionRatio(Source: TRectSize; Percent: Cardinal): TRectSize; function FitRectSize(Original, FitSize: TRectSize): TRectSize; function RectInRect(InCheckRect, BaseRect: TRect): Boolean; function RectOutRect(OutCheckRect, BaseRect: TRect): Boolean; implementation {------------------------------- // Point/Rectの一致を調べます。 処理: 単に中身を比較するだけ。 備考: Delphi6での話しだが、同機能の関数が それぞれ PointsEqual EqualRect という VCL標準関数で実装されているが Classesというusesすると勝手にバイナリサイズが増加する ユニットに含まれているので (EqualRectはTypesにも実装されているようだが) 独自実装した方がましだと判断。関数名もあえて変えている 履歴: 2002/11/18 //------------------------------} function PointEqual(const A, B: TPoint): Boolean; begin Result := (A.X = B.X) and (A.Y = B.Y); end; function RectEqual(const A, B: TRect): Boolean; begin Result := (A.Left = B.Left) and (A.Top = B.Top) and (A.Right = B.Right) and (A.Bottom = B.Bottom) end; function RectSizeEqual(const A, B: TRectSize): Boolean; begin Result := (A.Width = B.Width) and (A.Height = B.Height); end; //------------------------------ {------------------------------- // PointがRectの中に含まれるかどうかを調べる 機能: RectのLeft〜Right/Top〜Bottomの間に Pointgaがあるかどうかを調べている。 備考: 似たような関数にTypes.PtInRectがありますが 独自実装した方が安心そうなのでVCL標準を無視 PtInRectはHELPの記述もなんか怪しい 履歴: 2002/11/18 //------------------------------} function PointInRect(Point1: TPoint; Rect1: TRect): Boolean; begin Result := (Rect1.Left <= Point1.X) and (Point1.X <= Rect1.Right) and (Rect1.Top <= Point1.Y) and (Point1.Y <= Rect1.Bottom); end; //------------------------------ {------------------------------- // Pointを演算します。 PointPlus/PointMinus 機能: Point.XとPoint.Yをそれぞれ足し引きします 備考: 履歴: 2002/11/25 //------------------------------} function PointPlus(Point1, Point2: TPoint): TPoint; begin Result := Types.Point(Point1.X + Point2.X , Point1.Y + Point2.Y); end; function PointMinus(Point1, Point2: TPoint): TPoint; begin Result := Types.Point(Point1.X - Point2.X , Point1.Y - Point2.Y); end; //------------------------------ (*------------------------------- //Rectの幅 機能: Rect.Right - Rect.Left 履歴: 2000/11/16 -------------------------------*) function GetRectWidth(Rect: TRect): Integer; begin Result := Rect.Right - Rect.Left; end; procedure SetRectWidth(var Rect: TRect; Width: Integer); begin Rect.Right := Rect.Left + Width; end; (*------------------------------- //Rectの高さ 機能: Rect.Bottom - Rect.Top 履歴: 2000/11/16 -------------------------------*) function GetRectHeight(Rect: TRect): Integer; begin Result := Rect.Bottom - Rect.Top; end; procedure SetRectHeight(var Rect: TRect; Height: Integer); begin Rect.Bottom := Rect.Top + Height; end; {------------------------------- // Rectの中央位置 備考: Types.CenterPointと同じだと思う 履歴: 2000/11/16 2002/11/18 Typesに(VCL標準で同じ機能の)変な関数 があることに気がついた。 //------------------------------} function RectCenter(Rect: TRect): TPoint; begin Result.x := (GetRectWidth(Rect) div 2) + Rect.Left; Result.y := (GetRectHeight(Rect) div 2) + Rect.Top; end; //------------------------------ {------------------------------- //Rectを上下左右に移動 機能: RectMove:指定Pixelだけ上下に移動させる RectMovePoint:指定Point位置をTopLeftする移動 履歴: 2000/11/16 //------------------------------} function RectMove(const Rect: TRect; X, Y: Integer): TRect; overload; begin Result := Types.Rect(Rect.Left+X, Rect.Top+Y, Rect.Right+X, Rect.Bottom+Y); end; function RectMovePoint(const Rect: TRect; MovePoint: TPoint): TRect; overload; begin Result := Types.Rect(MovePoint.X, MovePoint.Y, MovePoint.X + GetRectWidth(Rect), MovePoint.Y + GetRectHeight(Rect)); end; //------------------------------ {------------------------------- // Rectを中央に移動 機能: BaseRectの中心部にMoveRectが移動した場合の Rectを返す関数 備考: 履歴: 2006/05/24(水) 00:07 //------------------------------} function RectMoveCenter(const MoveRect, BaseRect: TRect): TRect; var BaseRectCenter, MoveRectCenter: TPoint; begin BaseRectCenter := RectCenter(BaseRect); MoveRectCenter := RectCenter(MoveRect); Result := RectMove(MoveRect, BaseRectCenter.X-MoveRectCenter.X, BaseRectCenter.Y-MoveRectCenter.Y); end; //------------------------------ //------------------------------- //TRectSizeを作成する関数 function RectSize(Width, Height: Cardinal): TRectSize; overload; begin Result.Width := Width; Result.Height := Height; end; function RectSize(const Rect: TRect): TRectSize; overload; begin Result.Width := GetRectWidth(Rect); Result.Height:= GetRectHeight(Rect); end; {------------------------------- // Rectを%で拡大縮小する 備考: 履歴: //------------------------------} function RectDirectionRatio(Source: TRectSize; Percent: Cardinal): TRectSize; begin Result := RectSize(0, 0); if (Percent<=0) or (Source.Width<=0) or (Source.Height<=0) then Exit; Result.Width := Round(Source.Width * Percent /100.0); Result.Height:= Round(Source.Height* Percent /100.0); end; //------------------------------ {------------------------------- // 特定サイズにFitさせて(枠内に収まるように)戻す関数 機能: FitSizeに640x480を指定しておくと 640x480の枠内に収まるように Originalサイズを縦横比を保持して変更したサイズを戻す関数 縦か横かがサイズをはみ出さないように拡大/縮小するように なっている。 処理： ・Source/Target: TRectを用意 ・Target.Widht / Source.Width →Targetに対して何％かがわかる ・Source.Width * X% = Target.Width ・if Source.Height * X% <= Target.Height then いいんだけど ・elseなら ・Source.Height * Y% = Target.Height ・if Source.Widht * Y% <= Target.Widht then になるはず ・elseになったらエラーだな。 備考: 履歴: 2000/00/00 //------------------------------} function FitRectSize(Original, FitSize: TRectSize): TRectSize; var XPercent, YPercent: Real; begin XPercent := (FitSize.Width / Original.Width *100.0); YPercent := (FitSize.Height/ Original.Height*100.0); if (Original.Height * YPercent/100.0) <= FitSize.Height then begin Result.Width := Round(Original.Width * YPercent/100.0); Result.Height := Round(Original.Height * YPercent/100.0); end else begin Result.Width := Round(Original.Width * XPercent/100.0); Result.Height := Round(Original.Height * XPercent/100.0); end; (* 以下のようなやり方をすると誤差で適切なサイズにならない場合がある のでやっちゃだめです if (Original.Height * YPercent/100.0) <= FitSize.Height then begin Result.Width := Round(Original.Width * YPercent/100.0); Result.Height := Round(Original.Height * YPercent/100.0); end else if (Original.Width * XPercent/100.0) <= FitSize.Width then begin Result.Width := Round(Original.Width * XPercent/100.0); Result.Height := Round(Original.Height * XPercent/100.0); end else begin raise Exception.Create('サイズFitにてエラーです'); Result := RectSize(0,0); end; *) //------------------------------ end; (*------------------------------- //Rectがちゃんと内部に入っているかどうか確認する関数 機能: 引数説明: InCheckRect: 中に入っていると想定するRect BaseRect: 外を囲っていると想定するRect 戻り値: true:内部にある false:はみ出ているか完全に外部にある 備考: 境界線上で位置が重なっても 内部と判断している 履歴: 2000/10/19 -------------------------------*) function RectInRect(InCheckRect, BaseRect: TRect): Boolean; begin Result := false; if (BaseRect.Left <= InCheckRect.Left) and (InCheckRect.Right <= BaseRect.Right) and (BaseRect.Top <= InCheckRect.Top) and (InCheckRect.Bottom <= BaseRect.Bottom) then begin Result := true; end; end; (*------------------------------- //Rectがちゃんと外部になっているかどうか確認する関数 機能: 引数説明: OutCheckRect: 外に出ていると想定するRect BaseRect: このRectに対してCheckRectの関係を確認してる 戻り値: true:外部にある false:内部にあるか一部重なっている 備考: 境界線上で位置が重なっても 内部と判断している 履歴: 2000/10/19 -------------------------------*) function RectOutRect(OutCheckRect, BaseRect: TRect): Boolean; begin Result := false; if (OutCheckRect.Bottom < BaseRect.Top) or (BaseRect.Bottom < OutCheckRect.Top) or (OutCheckRect.Right < BaseRect.Left) or (BaseRect.Right < OutCheckRect.Left) then begin Result := true; end; end; {------------------------------- // RectをWidthとHightで生成します 備考: 標準関数ではLeft,Top,Right,Bottomで Rectを指定するので、 Width,Hightで指定する関数を作ってみた 履歴: 2005/07/09 //------------------------------} function RectSquare(Left, Top, Width, Hight: Integer): TRect; begin Result := Types.Rect( Left, Top, Left+Width, Top+Hight); end; //------------------------------ {------------------------------- // ポップアップする場所を返します 機能: 引数説明: BaseRect:ポップアップする領域を指定します デスクトップのWorkAreaなど指定してください。 RectValue:ポップアップする窓のRectを指定します PopupPoint:ポップアップ開始位置を指定します。 マウスカーソル位置などを指定してください。 戻り値: ポップアップするべき位置を返します 備考: 履歴: 2005/07/09 //------------------------------} function PopupRect(BaseRect, RectValue: TRect; PopupPoint: TPoint): TRect; begin if PointInRect(PopupPoint, BaseRect) = False then Exit; RectValue := RectMovePoint(RectValue, PopupPoint); if BaseRect.Right <= PopupPoint.X + GetRectWidth(RectValue) then begin RectValue := RectMove(RectValue, -GetRectWidth(RectValue), 0); end; if BaseRect.Bottom <= PopupPoint.Y + GetRectHeight(RectValue) then begin RectValue := RectMove(RectValue, 0, -GetRectHeight(RectValue)); end; Result := RectValue end; //------------------------------ {------------------------------- // 指定したRectからはみ出たRectを指定したRectに収まるように動かす関数 機能: BaseRect:基準となる大きいRect TargetRect:動かすRect 備考: BaseRectには次のような値を取得する場合が多い NoneTaskBarDesktopRect タスクバーを含まないDesktop領域 GetDesktopRect マルチディスプレイ環境でもデスクトップ領域全体を示す 履歴: 2006/12/23(土) 12:17 //------------------------------} function OutsideRectMoveInside(BaseRect, TargetRect: TRect; TopFit: Boolean = True; BottomFit: Boolean = True; LeftFit: Boolean = True; RightFit: Boolean = True): TRect; begin {↓WindowのRectを取得} // GetWindowRect(WndHandle, WinRect); {↓WindowがDesktop領域より大きければサイズ修正} if GetRectWidth(BaseRect) < GetRectWidth(TargetRect) then TargetRect.Right := GetRectWidth(BaseRect) + TargetRect.Left; if GetRectHeight(BaseRect) < GetRectHeight(TargetRect) then TargetRect.Bottom := GetRectHeight(BaseRect) + TargetRect.Top; {↓上の位置が限界より更に上なら} if TopFit and (TargetRect.Top < BaseRect.Top) then begin {↓Topを上端に移動} TargetRect := RectMove(TargetRect, 0, BaseRect.Top - TargetRect.Top); end; {↓下の位置が限界より更に下なら} if BottomFit and (BaseRect.Bottom < TargetRect.Bottom) then begin {↓Bottomを下端に移動} TargetRect := RectMove(TargetRect, 0, -(TargetRect.Bottom - BaseRect.Bottom)); end; {↓左の位置が限界より更に左なら} if LeftFit and (TargetRect.Left < BaseRect.Left) then begin {↓Leftを左端に移動} TargetRect := RectMove(TargetRect, BaseRect.Left - TargetRect.Left, 0); end; {↓右の位置が限界より更に右なら} if RightFit and (BaseRect.Right < TargetRect.Right) then begin {↓Bottomを右端に移動} TargetRect := RectMove(TargetRect, -(TargetRect.Right - BaseRect.Right), 0); end; Result := TargetRect; end; //------------------------------ {------------------------------- // Rectサイズをそれぞれの位置に対して増減させます 機能: 枠を大きくしたり小さくしたりできます 1,1,1,1と指定すると、枠が1ピクセル分大きくなります 備考: 履歴: 2007/05/25(金) 11:45 //------------------------------} function RectSizePlus(const Rect: TRect; LeftValue, TopValue, RightValue, BottomValue: Integer): TRect; begin Result := Types.Rect( Rect.Left - LeftValue, Rect.Top - TopValue, Rect.Right + RightValue, Rect.Bottom + BottomValue); end; //------------------------------ end.