home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d123456 / DFS.ZIP / DFSStickyForm.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-28  |  9KB  |  218 lines
  1. {$I DFS.INC}  { Standard defines for all Delphi Free Stuff components }
  2.  
  3. {------------------------------------------------------------------------------}
  4. { TdfsStickyForm v1.00 Beta 2                                                  }
  5. {------------------------------------------------------------------------------}
  6. { A TForm descendent that makes the window behave like it wants to "stick" to  }
  7. { any edge of the screen, that is, when it comes within a certain number of    }
  8. { pixels of a screen edge, the window will jump to that edge.                  }
  9. {                                                                              }
  10. { Copyright 2000-2001, Brad Stowers.  All Rights Reserved.                     }
  11. {                                                                              }
  12. { Copyright:                                                                   }
  13. { All Delphi Free Stuff (hereafter "DFS") source code is copyrighted by        }
  14. { Bradley D. Stowers (hereafter "author"), and shall remain the exclusive      }
  15. { property of the author.                                                      }
  16. {                                                                              }
  17. { Distribution Rights:                                                         }
  18. { You are granted a non-exlusive, royalty-free right to produce and distribute }
  19. { compiled binary files (executables, DLLs, etc.) that are built with any of   }
  20. { the DFS source code unless specifically stated otherwise.                    }
  21. { You are further granted permission to redistribute any of the DFS source     }
  22. { code in source code form, provided that the original archive as found on the }
  23. { DFS web site (http://www.delphifreestuff.com) is distributed unmodified. For }
  24. { example, if you create a descendant of TDFSColorButton, you must include in  }
  25. { the distribution package the colorbtn.zip file in the exact form that you    }
  26. { downloaded it from http://www.delphifreestuff.com/mine/files/colorbtn.zip.   }
  27. {                                                                              }
  28. { Restrictions:                                                                }
  29. { Without the express written consent of the author, you may not:              }
  30. {   * Distribute modified versions of any DFS source code by itself. You must  }
  31. {     include the original archive as you found it at the DFS site.            }
  32. {   * Sell or lease any portion of DFS source code. You are, of course, free   }
  33. {     to sell any of your own original code that works with, enhances, etc.    }
  34. {     DFS source code.                                                         }
  35. {   * Distribute DFS source code for profit.                                   }
  36. {                                                                              }
  37. { Warranty:                                                                    }
  38. { There is absolutely no warranty of any kind whatsoever with any of the DFS   }
  39. { source code (hereafter "software"). The software is provided to you "AS-IS", }
  40. { and all risks and losses associated with it's use are assumed by you. In no  }
  41. { event shall the author of the softare, Bradley D. Stowers, be held           }
  42. { accountable for any damages or losses that may occur from use or misuse of   }
  43. { the software.                                                                }
  44. {                                                                              }
  45. { Support:                                                                     }
  46. { Support is provided via the DFS Support Forum, which is a web-based message  }
  47. { system.  You can find it at http://www.delphifreestuff.com/discus/           }
  48. { All DFS source code is provided free of charge. As such, I can not guarantee }
  49. { any support whatsoever. While I do try to answer all questions that I        }
  50. { receive, and address all problems that are reported to me, you must          }
  51. { understand that I simply can not guarantee that this will always be so.      }
  52. {                                                                              }
  53. { Clarifications:                                                              }
  54. { If you need any further information, please feel free to contact me directly.}
  55. { This agreement can be found online at my site in the "Miscellaneous" section.}
  56. {------------------------------------------------------------------------------}
  57. { The lateset version of my components are always available on the web at:     }
  58. {   http://www.delphifreestuff.com/                                            }
  59. { See DFSStickyForm.txt for notes, known issues, and revision history.         }
  60. {------------------------------------------------------------------------------}
  61. { Date last modified:  June 28, 2001                                           }
  62. {------------------------------------------------------------------------------}
  63.  
  64. unit DFSStickyForm;
  65.  
  66. interface
  67.  
  68. uses
  69.   Windows, Messages, Forms, Classes;
  70.  
  71. const
  72.   { This shuts up C++Builder 3 about the redefiniton being different. There
  73.     seems to be no equivalent in C1.  Sorry. }
  74.   {$IFDEF DFS_CPPB_3_UP}
  75.   {$EXTERNALSYM DFS_COMPONENT_VERSION}
  76.   {$ENDIF}
  77.   DFS_COMPONENT_VERSION = 'TdfsStickyForm v1.00 Beta 2';
  78.  
  79. type
  80.   {$IFNDEF DFS_COMPILER_4_UP}
  81.   // Not defined before Delphi and Builder 4.
  82.   TWMSettingChange = packed record
  83.     Msg: Cardinal;
  84.     Flag: Integer;
  85.     Section: PChar;
  86.     Result: Longint;
  87.   end;
  88.   {$ENDIF}
  89.  
  90.   TdfsStickyObject = (soScreen, soParent, soOwner, soNothing);
  91.  
  92.   TdfsStickyForm = class(TForm)
  93.   private
  94.     FStuck: boolean;
  95.     FWorkArea: TRect;
  96.     FThreshold: integer;
  97.     FStickTo: TdfsStickyObject;
  98.     procedure WMWindowPosChanging(var Msg: TWMWindowPosMsg); message WM_WINDOWPOSCHANGING;
  99.     procedure WMSettingChange(var Msg: TWMSettingChange); message WM_SETTINGCHANGE;
  100.   protected
  101.     function GetStickyRect: TRect; virtual;
  102.     function GetVersion: string;
  103.     procedure SetVersion(const Val: string);
  104.     procedure UpdateWorkArea; virtual;
  105.   public
  106.     constructor Create(AOwner: TComponent); override;
  107.  
  108.     property Stuck: boolean read FStuck;
  109.     property StickyRect: TRect read GetStickyRect;
  110.   published
  111.     property StickTo: TdfsStickyObject
  112.       read FStickTo write FStickTo default soScreen;
  113.     property Threshold: integer
  114.       read FThreshold write FThreshold default 25;
  115.     property Version: string
  116.       read GetVersion write SetVersion stored FALSE;
  117.   end;
  118.  
  119. implementation
  120.  
  121. uses
  122.   Controls;
  123.  
  124. { TdfsStickyForm }
  125.  
  126. constructor TdfsStickyForm.Create(AOwner: TComponent);
  127. begin
  128.   FStuck := FALSE;
  129.   FStickTo := soScreen;
  130.   FThreshold := 25;
  131.   UpdateWorkArea;
  132.   inherited;
  133. end;
  134.  
  135. function TdfsStickyForm.GetStickyRect: TRect;
  136. begin
  137.   case StickTo of
  138.     soScreen:
  139.       Result := FWorkArea;
  140.     soParent:
  141.       if Parent <> NIL then
  142.         Result := Parent.ClientRect
  143.       else
  144.         Result := FWorkArea;
  145.     soOwner:
  146.       if (Owner <> NIL) and (Owner is TControl) then
  147.       begin
  148.         Result.TopLeft := TControl(Owner).ClientToScreen(TControl(Owner).ClientRect.TopLeft);
  149.         Result.BottomRight := TControl(Owner).ClientToScreen(TControl(Owner).ClientRect.BottomRight);
  150.       end
  151.       else
  152.         Result := FWorkArea;
  153.   else
  154.     SetRectEmpty(Result);
  155.   end;
  156. end;
  157.  
  158. function TdfsStickyForm.GetVersion: string;
  159. begin
  160.   Result := DFS_COMPONENT_VERSION;
  161. end;
  162.  
  163. procedure TdfsStickyForm.SetVersion(const Val: string);
  164. begin
  165.   { empty write method, just needed to get it to show up in Object Inspector }
  166. end;
  167.  
  168. procedure TdfsStickyForm.UpdateWorkArea;
  169. begin
  170.   SystemParametersInfo(SPI_GETWORKAREA, 0, @FWorkArea, 0);
  171. end;
  172.  
  173. procedure TdfsStickyForm.WMSettingChange(var Msg: TWMSettingChange);
  174. begin
  175.   UpdateWorkArea;
  176. end;
  177.  
  178. procedure TdfsStickyForm.WMWindowPosChanging(var Msg: TWMWindowPosMsg);
  179. var
  180.   SR: TRect;
  181. begin
  182.   if StickTo <> soNothing then
  183.   begin
  184.     SR := StickyRect;
  185.     with Msg.WindowPos^ do
  186.     begin
  187.       FStuck := FALSE;
  188.       // check if form is inside threshold limits of border
  189.       if x <= SR.Left + Threshold then
  190.       begin
  191.         x := SR.Left;
  192.         FStuck := TRUE;
  193.       end
  194.       else if x + cx >= SR.Right - Threshold then
  195.       begin
  196.         x := SR.Right - cx;
  197.         FStuck := TRUE;
  198.       end;
  199.  
  200.       if y <= SR.Top + Threshold then
  201.       begin
  202.         y := SR.Top;
  203.         FStuck := TRUE;
  204.       end
  205.       else if y + cy >= SR.Bottom - Threshold then
  206.       begin
  207.         y := SR.Bottom - cy;
  208.         FStuck := TRUE;
  209.       end;
  210.     end;
  211.   end;
  212.   // else it's teflon coated, won't stick to anything.
  213.  
  214.   inherited;
  215. end;
  216.  
  217. end.
  218.