home *** CD-ROM | disk | FTP | other *** search
/ Softwarová Záchrana 3 / Softwarova-zachrana-3.bin / ArsClip / source.zip / UnitFrmPreview.pas < prev    next >
Pascal/Delphi Source File  |  2004-01-13  |  3KB  |  141 lines
  1. unit UnitFrmPreview;
  2. {
  3.     Purpose:
  4.         Show a preview of a clipboard item
  5.         Allow for easy closing of the window by mouse click or keystroke
  6.  
  7.     Updates:
  8.         Fix for showing the preview on multiple monitors
  9.         ---------------
  10.         Support for Pictures
  11.  
  12.         Better positioning of Window
  13.  
  14.         Center Vertically
  15.         
  16.         Keystrokes also will close window
  17.         Preview text is read only
  18. }
  19.  
  20. interface
  21.  
  22. uses
  23.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  24.   Dialogs, StdCtrls, Buttons, ExtCtrls, ComCtrls;
  25.  
  26. type
  27.   TFrmPreview = class(TForm)
  28.     txtPreview: TMemo;
  29.     imgPreview: TImage;
  30.     Label1: TLabel;
  31.     rePreview: TRichEdit;
  32.     procedure bCloseClick(Sender: TObject);
  33.     procedure txtPreviewClick(Sender: TObject);
  34.     procedure FormClick(Sender: TObject);
  35.     procedure Label1Click(Sender: TObject);
  36.     procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
  37.       Shift: TShiftState; X, Y: Integer);
  38.     procedure FormKeyPress(Sender: TObject; var Key: Char);
  39.     procedure txtPreviewKeyPress(Sender: TObject; var Key: Char);
  40.     procedure FormShow(Sender: TObject);
  41.     procedure imgPreviewClick(Sender: TObject);
  42.     procedure FormResize(Sender: TObject);
  43.   private
  44.     { Private declarations }
  45.   public
  46.     { Public declarations }
  47.         procedure SetText(s : string);
  48.         procedure SetPicture;
  49.   end;
  50.  
  51. var
  52.   FrmPreview: TFrmPreview;
  53.  
  54. implementation
  55.  
  56. uses UnitFrmMainPopup;
  57.  
  58. {$R *.dfm}
  59. procedure TFrmPreview.SetText(s : string);
  60. begin
  61.     txtPreview.Text := s;
  62.     txtPreview.Visible := true;
  63.     imgPreview.Visible := false;
  64. end;
  65.  
  66. procedure TFrmPreview.SetPicture;
  67. begin
  68.     txtPreview.Visible := false;
  69.     imgPreview.Visible := true;
  70. end;
  71.  
  72. procedure TFrmPreview.bCloseClick(Sender: TObject);
  73. begin
  74.     self.ModalResult := mrOk;
  75. end;
  76.  
  77. procedure TFrmPreview.txtPreviewClick(Sender: TObject);
  78. begin
  79.     self.ModalResult := mrok;
  80. end;
  81.  
  82. procedure TFrmPreview.FormClick(Sender: TObject);
  83. begin
  84.     self.ModalResult := mrok;
  85. end;
  86.  
  87. procedure TFrmPreview.Label1Click(Sender: TObject);
  88. begin
  89.     self.ModalResult := mrok;
  90. end;
  91.  
  92. procedure TFrmPreview.FormMouseDown(Sender: TObject; Button: TMouseButton;
  93.   Shift: TShiftState; X, Y: Integer);
  94. begin
  95.     self.ModalResult := mrok;
  96. end;
  97.  
  98. procedure TFrmPreview.FormKeyPress(Sender: TObject; var Key: Char);
  99. begin
  100.     self.ModalResult := mrok;
  101. end;
  102.  
  103. procedure TFrmPreview.txtPreviewKeyPress(Sender: TObject; var Key: Char);
  104. begin
  105.     self.ModalResult := mrok;
  106. end;
  107.  
  108. procedure TFrmPreview.imgPreviewClick(Sender: TObject);
  109. begin
  110.     self.ModalResult := mrok;
  111. end;
  112.  
  113.  
  114. procedure TFrmPreview.FormShow(Sender: TObject);
  115. begin
  116.     //
  117.     // show window just above current mouse position
  118.     // Keep if rom falling off the top of the screen
  119.     //
  120.     self.Top := mouse.CursorPos.Y - 80;
  121.     if (self.top < 0) then self.Top := 0;
  122.  
  123.     //
  124.     // keep preview from falling off the bottom or right
  125.     // of the screen
  126.     //
  127.     if (self.Top + self.Height) > screen.Height then
  128.         self.top := screen.Height - self.Height;
  129.     if (self.Left + self.Width) > screen.Width then
  130.         self.Left := screen.Width - self.Width;
  131.  
  132. end;
  133.  
  134.  
  135. procedure TFrmPreview.FormResize(Sender: TObject);
  136. begin
  137.     self.ModalResult := 0;
  138. end;
  139.  
  140. end.
  141.