ResPopupBrowser.pas

   1 unit ResPopupBrowser;
   2 interface
   3 uses
   4         Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
   5         ActiveX, OleCtrls, {HintWindow,} HTMLDocumentEvent, BoardGroup,
   6 {$IF Defined(DELPRO) }
   7         SHDocVw,
   8         MSHTML
   9 {$ELSE}
  10         SHDocVw_TLB,
  11         MSHTML_TLB
  12 {$IFEND}
  13 ;
  14
  15 type
  16     TGikoPopupType = (gptRaw, gptThread);
  17
  18         TResPopupBrowser = class(TWebBrowser)
  19         private
  20         FChild :TResPopupBrowser;
  21         FParentBrowser :TResPopupBrowser;
  22         FTitle :String;
  23         FRawDocument: String;
  24                 FPopupType: TGikoPopupType;
  25                 FEvent: THTMLDocumentEventSink;//\83u\83\89\83E\83U\83h\83L\83\85\83\81\83\93\83g\83C\83x\83\93\83g
  26         FThread: TThreadItem;
  27         function GetBodyStyle(OnlyTitle: Boolean = False): string;
  28         function GetWindowHeight : Integer;
  29         function GetTitle(OnlyTitle: Boolean): string;
  30                 function CalcRect(WorkArea: TRect; Scroll: Boolean): TRect;
  31         function ResPopupBrowserClick(Sender: TObject): WordBool;
  32         function ResPopupBrowserDbClick(Sender: TObject): WordBool;
  33         function GetThread: TThreadItem;
  34         protected
  35                 procedure CreateParams(var Params: TCreateParams); override;
  36         public
  37                 constructor Create(AOwner: TComponent); override;
  38                 destructor Destroy; override;
  39         property Child: TResPopupBrowser read FChild;
  40         property ParentBrowser:TResPopupBrowser read FParentBrowser write FParentBrowser;
  41         property Title: String read FTitle write FTitle;
  42         property RawDocument: String read FRawDocument write FRawDocument;
  43         property Thread: TThreadItem read GetThread write FThread;
  44         function CreateNewBrowser: TResPopupBrowser;
  45         function CurrentBrowser: TResPopupBrowser;
  46         procedure Write(ADocument: String; OnlyTitle: Boolean = False);
  47         procedure Clear;
  48         procedure ChildClear;
  49         procedure NavigateBlank(Forced: Boolean);
  50         property PopupType: TGikoPopupType read FPopupType write FPopupType;
  51         procedure TitlePopup;
  52         procedure Popup;
  53         procedure Blur;
  54         end;
  55
  56 implementation
  57 uses MojuUtils, GikoSystem, Setting, Giko, GikoDataModule, Preview;
  58
  59 constructor TResPopupBrowser.Create(AOwner: TComponent);
  60 begin
  61         inherited Create(AOwner);
  62     TOleControl(Self).Parent := nil;
  63     Visible := False;
  64     FChild := nil;
  65     Title := '';
  66     RawDocument := '';
  67     FEvent := nil;
  68     ShowWindow(Self.Handle, SW_HIDE);
  69 end;
  70
  71 destructor TResPopupBrowser.Destroy;
  72 begin
  73     Self.Blur;
  74     Self.OnEnter := nil;
  75     Self.OnBeforeNavigate2 := nil;
  76     Self.OnStatusTextChange := nil;
  77     Self.OnNewWindow2 := nil;
  78     if (FChild <> nil) then begin
  79         FChild.Free;
  80         FChild := nil;
  81     end;
  82     if (FEvent <> nil) then begin
  83         FEvent.Free;
  84         FEvent := nil;
  85     end;
  86     FThread := nil;
  87         inherited Destroy;
  88 end;
  89
  90 procedure TResPopupBrowser.CreateParams(var Params: TCreateParams);
  91 begin
  92         inherited;
  93     Params.Style := Params.Style or WS_EX_TOOLWINDOW;
  94
  95 end;
  96 function TResPopupBrowser.CreateNewBrowser: TResPopupBrowser;
  97 begin
  98     if (Self.Visible) then begin
  99         if (FChild <> nil) then begin
 100             if (FChild.Visible) then begin
 101                 Result := FChild.CreateNewBrowser;
 102             end else begin
 103                 Result := FChild;
 104             end;
 105         end else begin
 106             FChild := TResPopupBrowser.Create(Self.Owner);
 107             FChild.ParentBrowser := Self;
 108             FChild.NavigateBlank(False);
 109             FChild.OnEnter := GikoForm.BrowserEnter;
 110             FChild.OnBeforeNavigate2 := GikoForm.BrowserBeforeNavigate2;
 111             FChild.OnStatusTextChange := GikoForm.BrowserStatusTextChange;
 112             FChild.OnNewWindow2 := GikoForm.BrowserNewWindow2;
 113             SetWindowPos(FChild.Handle, HWND_BOTTOM,
 114                 0, 0, 0 , 0,
 115                 SWP_NOSIZE or SWP_NOMOVE or  SWP_NOACTIVATE or SWP_HIDEWINDOW);
 116             Result := FChild;
 117         end;
 118     end else begin
 119         FParentBrowser := nil;
 120         Self.NavigateBlank(False);
 121         Self.OnEnter := GikoForm.BrowserEnter;
 122         Self.OnBeforeNavigate2 := GikoForm.BrowserBeforeNavigate2;
 123         Self.OnStatusTextChange := GikoForm.BrowserStatusTextChange;
 124         Self.OnNewWindow2 := GikoForm.BrowserNewWindow2;
 125         SetWindowPos(Self.Handle, HWND_BOTTOM,
 126             0, 0, 0 , 0,
 127             SWP_NOSIZE or SWP_NOMOVE or  SWP_NOACTIVATE or SWP_HIDEWINDOW);
 128         Result := Self;
 129     end;
 130 end;
 131 function TResPopupBrowser.CurrentBrowser: TResPopupBrowser;
 132 begin
 133     Result := Self.CreateNewBrowser;
 134     if (Result.ParentBrowser <> nil) then
 135         Result := Result.ParentBrowser;
 136 end;
 137 procedure TResPopupBrowser.NavigateBlank(Forced: Boolean);
 138 begin
 139     if (not Assigned(Self.Document)) or (Forced) then begin
 140         Self.Navigate('about:blank');
 141     end;
 142     while (Self.ReadyState <> READYSTATE_COMPLETE) and
 143             (Self.ReadyState <> READYSTATE_INTERACTIVE) do begin
 144         Sleep(1);
 145         Forms.Application.ProcessMessages;
 146     end;
 147 end;
 148 procedure TResPopupBrowser.TitlePopup;
 149 begin
 150     Write('', True);
 151 end;
 152 procedure TResPopupBrowser.Popup;
 153 begin
 154     if (GetAsyncKeyState(VK_SHIFT) = Smallint($8001)) then begin
 155         // \83V\83t\83g\89\9f\82µ\82Ä\82é\8fê\8d\87\82Í\82»\82Ì\82Ü\82Ü\8fo\82·
 156         Write(Self.RawDocument, false);
 157     end else begin
 158         // éx\82µ\8aG\82ª\8c©\82¦\82é\82æ\82¤\82É\94¼\8ap\83X\83y\81[\83X*2\82ð&nbsp;*2\82É\92u\8a·\82·\82é
 159         Write(
 160             MojuUtils.CustomStringReplace(
 161                 Self.RawDocument, '  ', '&nbsp;&nbsp;'),
 162             false);
 163     end;
 164 end;
 165 procedure TResPopupBrowser.Write(ADocument: String; OnlyTitle: Boolean = False);
 166 var
 167         p: TPoint;
 168     doc: OleVariant;
 169         ARect: TRect;
 170 begin
 171     try
 172         // \83^\83X\83N\83o\81[\82©\82ç\8fÁ\82·
 173         SetWindowLongA(Self.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
 174         GetCursorpos(p);
 175         // \82¢\82Á\82½\82ñ\8fk\8f¬
 176         SetWindowPos(Self.Handle, HWND_BOTTOM,
 177             p.X, p.Y, 50 , 50,
 178             SWP_NOACTIVATE or SWP_HIDEWINDOW);
 179         doc := Self.OleObject.Document;
 180         doc.open;
 181         doc.charset := 'Shift_JIS';
 182         doc.Write('<html><head>'#13#10 +
 183                 '<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">'#13#10 +
 184                 '<meta http-equiv="Pragma" content="no-cache">'#13#10 +
 185                 '<meta http-equiv="Cache-Control" content="no-cache">'#13#10 +
 186                 GetBodyStyle(OnlyTitle) + '</head><body>'
 187                 + GetTitle(OnlyTitle)
 188                 + ADocument + '<a name="bottom"></a></body></html>');
 189
 190         doc.Close;
 191         // \83}\83\8b\83`\83\82\83j\83^\91Î\89\9e
 192         ARect := CalcRect(Screen.MonitorFromPoint(p).WorkareaRect,
 193                         not OnlyTitle);
 194
 195         FEvent := THTMLDocumentEventSink.Create(Self, Self.Document, HTMLDocumentEvents2);
 196         FEvent.OnClick := ResPopupBrowserClick;
 197         FEvent.OnDoubleClick := ResPopupBrowserDbClick;
 198         Self.Visible := True;
 199         SetWindowPos(Self.Handle, HWND_TOPMOST,
 200             ARect.Left, ARect.Top,
 201             (ARect.Right - ARect.Left) ,
 202             (ARect.Bottom - ARect.Top),
 203             SWP_NOACTIVATE or SWP_HIDEWINDOW);
 204         ShowWindow(Self.Handle, SW_SHOWNOACTIVATE);
 205     except
 206     end;
 207 end;
 208 function TResPopupBrowser.GetTitle(OnlyTitle: Boolean): string;
 209 begin
 210     Result := '<span id="hTitle">' + Title +'</span>';
 211     if OnlyTitle then Result := Result + '<BR>';
 212 end;
 213 function TResPopupBrowser.GetBodyStyle(OnlyTitle: Boolean = False): string;
 214 var
 215     i : Integer;
 216 begin
 217
 218     Result := '<style type="text/css">' +
 219             'dl { margin :0px; padding :0px}'#13#10 +
 220             'body { ' +
 221             'border-width: 1px; border-style: solid;white-space: nowrap; ' +
 222             'margin: 2px 4px 0px 0px; padding: 0px 4px 0px 0px; ';
 223
 224         if Length( GikoSys.Setting.HintFontName ) > 0 then
 225                 Result := Result + 'font-family:"' + GikoSys.Setting.HintFontName + '";';
 226         if GikoSys.Setting.HintFontSize <> 0 then
 227                 Result := Result + 'font-size:' + IntToStr( GikoSys.Setting.HintFontSize ) + 'pt;';
 228         if GikoSys.Setting.HintFontColor <> -1 then
 229                 Result := Result + 'color:#' + IntToHex( GikoSys.Setting.HintFontColor, 6 ) + ';';
 230         if GikoSys.Setting.HintBackColor <> -1 then begin
 231                 i := ColorToRGB( GikoSys.Setting.HintBackColor );
 232                 Result := Result + 'background-color:#' +
 233             IntToHex( (i shr 16) or (i and $ff00) or ((i and $ff) shl 16), 6 ) + ';';
 234     end;
 235     if OnlyTitle then
 236         Result := Result + 'overflow: hidden; ';
 237
 238     Result := Result + '}';
 239     if GikoSys.Setting.ResPopupHeaderBold then begin
 240         Result := Result + #13#10'span#hTitle{font-weight: bold; }';
 241     end;
 242     Result := Result + '</style>';
 243 end;
 244
 245 procedure TResPopupBrowser.Clear;
 246 begin
 247     ChildClear;
 248     if (Self.Visible) then begin
 249         Self.Title := '';
 250         Self.RawDocument := '';
 251         Self.FThread := nil;
 252         Self.FEvent.Free;
 253         Self.FEvent := nil;
 254         Self.Blur;
 255         ShowWindow(Self.Handle, SW_HIDE);
 256         Self.Visible := False;
 257     end;
 258 end;
 259 procedure TResPopupBrowser.ChildClear;
 260 begin
 261     if (FChild <> nil) then begin
 262         FChild.Clear;
 263     end;
 264 end;
 265
 266 function TResPopupBrowser.CalcRect(WorkArea: TRect; Scroll: Boolean): TRect;
 267 var
 268         p: TPoint;
 269     ele: IHTMLElement2;
 270     h, w, dx1, dx2, dy1, dy2: Integer;
 271     MaxWidth, MaxHeight: Integer;
 272     DIV_X, DIV_Y: Integer;
 273 begin
 274         GetCursorpos(p);
 275     ele := ((Self.Document as IHTMLDocument2).body as IHTMLElement2);
 276     if Scroll then begin
 277         h := GetWindowHeight + 10;
 278         w := ele.scrollWidth + 25
 279     end else begin
 280         h := GetWindowHeight + 5;
 281         w := ele.scrollWidth + 10;
 282     end;
 283
 284     DIV_X := GikoSys.Setting.RespopupDeltaX;
 285     DIV_Y := GikoSys.Setting.RespopupDeltaY;
 286
 287     dx1 := 0; dx2 := 0;
 288     dy1 := 0; dy2 := 0;
 289
 290         Result := Rect(0, 0, w, h);
 291     case GikoSys.Setting.PopupPosition of
 292         gppRightTop:
 293         begin
 294             dx1 := 0; dx2 := + DIV_X;
 295             dy1 := -h; dy2 := - DIV_Y;
 296         end;
 297         gppRight:
 298         begin
 299             dx1 := 0; dx2 := + DIV_X;
 300             dy1 := - (h div 2); dy2 := 0;
 301         end;
 302         gppRightBottom:
 303         begin
 304             dx1 := 0; dx2 := + DIV_X;
 305             dy1 := 0; dy2 := + DIV_Y;
 306         end;
 307         gppTop:
 308         begin
 309             dx1 := - (w div 2); dx2 := 0;
 310             dy1 := -h; dy2 := - DIV_Y;
 311         end;
 312         // \94p\8e~ gppCenter: OffsetRect(Result, p.x - (w div 2), p.y - (h div 2));
 313         gppBottom:
 314         begin
 315             dx1 := - (w div 2); dx2 := 0;
 316             dy1 := 0; dy2 := + DIV_Y;
 317         end;
 318         gppLeftTop:
 319         begin
 320             dx1 := -w; dx2 := - DIV_X ;
 321             dy1 := -h; dy2 := - DIV_Y;
 322         end;
 323         gppLeft:
 324         begin
 325             dx1 := -w; dx2 := - DIV_X;
 326             dy1 := - (h div 2); dy2 := 0;
 327         end;
 328         gppLeftBottom:
 329         begin
 330             dx1 := -w; dx2 := - DIV_X;
 331             dy1 := 0; dy2 := + DIV_Y;
 332         end;
 333     end;
 334     // \8f\89\8aú\88Ê\92u\82É\88Ú\93®
 335     OffsetRect(Result, p.x + dx1 + dx2, p.y + dy1 + dy2);
 336
 337     MaxWidth := WorkArea.Right - WorkArea.Left;
 338     MaxHeight := WorkArea.Bottom - WorkArea.Top;
 339     // \88È\89º\81A\8f\89\8aú\88Ê\92u\82É\96â\91è\82ª\82 \82é\82Æ\82«\82Ì\88Ú\93®
 340     if (Result.Left < WorkArea.Left) then begin
 341         // \8bt\83T\83C\83h\82É\97]\97T\82ª\82 \82ê\82Î\81A\8fo\97Í\88Ê\92u\82Ì\8d¶\89E\93]\8a·
 342         if ((p.X - WorkArea.Left) * 2 < MaxWidth) then begin
 343             if ( (GikoSys.Setting.PopupPosition = gppTop) or
 344                 (GikoSys.Setting.PopupPosition = gppBottom)) then begin
 345                 OffsetRect(Result, -Result.Left, 0);
 346             end else begin
 347                 OffsetRect(Result, - (dx1 + 2 * dx2), 0);
 348             end;
 349         end else begin
 350             // \89æ\96Ê\92[\82Ü\82Å\89æ\96Ê\95\9d\82ð\8f¬\82³\82\82·\82é
 351             Result := Rect(WorkArea.Left, Result.Top,
 352                 Result.Right, Result.Bottom);
 353         end;
 354     end;
 355     if (Result.Top < WorkArea.Top) then begin
 356         // \92ê\91¤\82É\97]\97T\82ª\82 \82ê\82Î\81A\8fo\97Í\88Ê\92u\82Ì\8fã\89º\93]\8a·
 357         if ((p.Y - WorkArea.Top) * 2 < MaxHeight) then begin
 358             OffsetRect(Result, 0, - (dy1 + 2 * dy2));
 359         end else begin
 360             // \89æ\96Ê\92[\82Ü\82Å\89æ\96Ê\8d\82\82ð\8f¬\82³\82\82·\82é
 361             Result := Rect(Result.Left, WorkArea.Top,
 362                 Result.Right, Result.Bottom);
 363         end;
 364     end;
 365     if (Result.Right > WorkArea.Right) then begin
 366         // \8bt\83T\83C\83h\82É\97]\97T\82ª\82 \82ê\82Î\81A\8fo\97Í\88Ê\92u\82Ì\8d¶\89E\93]\8a·
 367         if ((p.X - WorkArea.Left) * 2 > WorkArea.Right) then begin
 368             if( (GikoSys.Setting.PopupPosition = gppTop) or
 369                 (GikoSys.Setting.PopupPosition = gppBottom)) then begin
 370                 OffsetRect(Result, -(Result.Right - WorkArea.Right), 0);
 371             end else begin
 372                 OffsetRect(Result, -w - (dx1 + 2 * dx2), 0);
 373             end;
 374             // \8bt\83T\83C\83h\82É\83I\81[\83o\81[\82µ\82½\8fê\8d\87\82Í\89æ\96Ê\92[\82Ü\82Å\95\9d\82ð\8f¬\82³\82\82·\82é
 375             if (Result.Left < WorkArea.Left) then begin
 376                 Result := Rect(WorkArea.Left, Result.Top,
 377                     Result.Right, Result.Bottom);
 378             end;
 379         end else begin
 380             // \89æ\96Ê\92[\82Ü\82Å\89æ\96Ê\95\9d\82ð\8f¬\82³\82\82·\82é
 381             Result := Rect(Result.Left, Result.Top,
 382                 WorkArea.Right, Result.Bottom);
 383         end;
 384     end;
 385     if (Result.Bottom > WorkArea.Bottom) then begin
 386         // \8fã\91¤\82É\97]\97T\82ª\82 \82ê\82Î\81A\8fo\97Í\88Ê\92u\82Ì\8fã\89º\93]\8a·
 387         if ((p.Y - WorkArea.Top) * 2 > WorkArea.Bottom) then begin
 388             OffsetRect(Result, 0, -h - (dy1 + 2 * dy2));
 389             // \8fã\82É\8aÑ\82¢\82½\8fê\8d\87\82Í\81A
 390             if (Result.Top < WorkArea.Top) then begin
 391                 Result := Rect(Result.Left, WorkArea.Top,
 392                     Result.Right, Result.Bottom);
 393             end;
 394         end else begin
 395             // \89æ\96Ê\92[\82Ü\82Å\89æ\96Ê\8d\82\82ð\8f¬\82³\82\82·\82é
 396             Result := Rect(Result.Left, Result.Top,
 397                 Result.Right, WorkArea.Bottom);
 398         end;
 399     end;
 400 end;
 401 function TResPopupBrowser.GetWindowHeight : Integer;
 402 var
 403         top: Integer;
 404         item: OleVariant;
 405 begin
 406     Result := 0;
 407     //\83u\83\89\83E\83U\82ª\83f\81[\83^\82Ì\93Ç\82Ý\8d\9e\82Ý\92\86\82Ì\8e\9e\82Í\93Ç\82Ý\8d\9e\82Ý\82ð\91Ò\82Â
 408     while (Self.ReadyState <> READYSTATE_COMPLETE) and
 409                 (Self.ReadyState <> READYSTATE_INTERACTIVE) do begin
 410         Sleep(1);
 411         Forms.Application.ProcessMessages;
 412     end;
 413
 414     try
 415         top := 0;
 416         item := Self.OleObject.Document.anchors.item(OleVariant('bottom'));
 417         item.focus();
 418         repeat
 419             top := top + item.offsetTop;
 420             item := item.offsetParent;
 421         until AnsiCompareText(item.tagName, 'body' ) = 0;
 422         Result := top;
 423     except
 424     end;
 425 end;
 426 function TResPopupBrowser.ResPopupBrowserClick(Sender: TObject): WordBool;
 427 begin
 428     // \83M\83R\83i\83r\82Ì\83t\83H\81[\83J\83X\82ð\92D\82Á\82Ä\82é\82Ì\82Å\83t\83H\81[\83\80\82É\96³\97\9d\82â\82è\95Ô\82·
 429     Blur;
 430     Result := True;
 431 end;
 432 function TResPopupBrowser.GetThread: TThreadItem;
 433 begin
 434     Result := nil;
 435     if (FThread <> nil) then begin
 436         try
 437             // \96³\8cø\82È\83|\83C\83\93\83^\8c\9f\8d¸
 438             if (FThread.ParentBoard <> nil) then begin
 439                 Result := FThread
 440             end;
 441         except
 442             //\96³\8cø\82È\83|\83C\83\93\83^\82¾\82Á\82½
 443             Result := nil;
 444         end;
 445     end;
 446 end;
 447 procedure TResPopupBrowser.Blur;
 448 var
 449     FOleInPlaceActiveObject: IOleInPlaceActiveObject;
 450 begin
 451     FOleInPlaceActiveObject := Self.ControlInterface as IOleInPlaceActiveObject;
 452     FOleInPlaceActiveObject.OnFrameWindowActivate(False);
 453 end;
 454 function TResPopupBrowser.ResPopupBrowserDbClick(Sender: TObject): WordBool;
 455 begin
 456     // \83M\83R\83i\83r\82Ì\83t\83H\81[\83J\83X\82ð\92D\82Á\82Ä\82é\82Ì\82Å\83t\83H\81[\83\80\82É\96³\97\9d\82â\82è\95Ô\82·
 457     Blur;
 458     // \8e©\95ª\82Å\8e©\95ª\82Í\8fÁ\82¹\82È\82¢\82Ì\82Å\81A\83\81\83b\83Z\81[\83W\8co\97R\82Å\8fÁ\82µ\82Ä\82à\82ç\82¤
 459     PostMessage( GikoForm.Handle , USER_RESPOPUPCLEAR, Integer( Self ), 0 );
 460     Result := True;
 461 end;
 462 initialization
 463     OleInitialize(nil);
 464
 465 finalization
 466     OleUninitialize;
 467
 468 end.