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: Variant;
 169         ARect: TRect;
 170     FDispHtmlDocument: DispHTMLDocument;
 171 begin
 172     try
 173         // \83^\83X\83N\83o\81[\82©\82ç\8fÁ\82·
 174         SetWindowLongA(Self.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
 175         GetCursorpos(p);
 176         // \82¢\82Á\82½\82ñ\8fk\8f¬
 177         SetWindowPos(Self.Handle, HWND_BOTTOM,
 178             p.X, p.Y, 50 , 50,
 179             SWP_NOACTIVATE or SWP_HIDEWINDOW);
 180         doc := Idispatch( olevariant(Self.ControlInterface).Document) as IHTMLDocument2;
 181         doc.open;
 182         doc.charset := 'Shift_JIS';
 183         doc.Write('<html><head>'#13#10 +
 184                 '<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">'#13#10 +
 185                 '<meta http-equiv="Pragma" content="no-cache">'#13#10 +
 186                 '<meta http-equiv="Cache-Control" content="no-cache">'#13#10 +
 187                 GetBodyStyle(OnlyTitle) + '</head><body>'
 188                 + GetTitle(OnlyTitle)
 189                 + ADocument + '<a name="bottom"></a></body></html>');
 190
 191         doc.Close;
 192
 193         ARect := CalcRect(Screen.WorkAreaRect, not OnlyTitle);
 194
 195         FDispHtmlDocument := Idispatch(OleVariant(Self.ControlInterface).Document) as DispHTMLDocument;
 196         FEvent := THTMLDocumentEventSink.Create(Self, FDispHtmlDocument, HTMLDocumentEvents2);
 197         FEvent.OnClick := ResPopupBrowserClick;
 198         FEvent.OnDoubleClick := ResPopupBrowserDbClick;
 199         Self.Visible := True;
 200         SetWindowPos(Self.Handle, HWND_TOPMOST,
 201             ARect.Left, ARect.Top,
 202             (ARect.Right - ARect.Left) ,
 203             (ARect.Bottom - ARect.Top),
 204             SWP_NOACTIVATE or SWP_HIDEWINDOW);
 205         ShowWindow(Self.Handle, SW_SHOWNOACTIVATE);
 206     except
 207     end;
 208 end;
 209 function TResPopupBrowser.GetTitle(OnlyTitle: Boolean): string;
 210 begin
 211     Result := '<span id="hTitle">' + Title +'</span>';
 212     if OnlyTitle then Result := Result + '<BR>';
 213 end;
 214 function TResPopupBrowser.GetBodyStyle(OnlyTitle: Boolean = False): string;
 215 var
 216     i : Integer;
 217 begin
 218
 219     Result := '<style type="text/css">' +
 220             'dl { margin :0px; padding :0px}'#13#10 +
 221             'body { ' +
 222             'border-width: 1px; border-style: solid;white-space: nowrap; ' +
 223             'margin: 2px 4px 0px 0px; padding: 0px 4px 0px 0px; ';
 224
 225         if Length( GikoSys.Setting.HintFontName ) > 0 then
 226                 Result := Result + 'font-family:"' + GikoSys.Setting.HintFontName + '";';
 227         if GikoSys.Setting.HintFontSize <> 0 then
 228                 Result := Result + 'font-size:' + IntToStr( GikoSys.Setting.HintFontSize ) + 'pt;';
 229         if GikoSys.Setting.HintFontColor <> -1 then
 230                 Result := Result + 'color:#' + IntToHex( GikoSys.Setting.HintFontColor, 6 ) + ';';
 231         if GikoSys.Setting.HintBackColor <> -1 then begin
 232                 i := ColorToRGB( GikoSys.Setting.HintBackColor );
 233                 Result := Result + 'background-color:#' +
 234             IntToHex( (i shr 16) or (i and $ff00) or ((i and $ff) shl 16), 6 ) + ';';
 235     end;
 236     if OnlyTitle then
 237         Result := Result + 'overflow: hidden; ';
 238
 239     Result := Result + '}';
 240     if GikoSys.Setting.ResPopupHeaderBold then begin
 241         Result := Result + #13#10'span#hTitle{font-weight: bold; }';
 242     end;
 243     Result := Result + '</style>';
 244 end;
 245
 246 procedure TResPopupBrowser.Clear;
 247 begin
 248     ChildClear;
 249     if (Self.Visible) then begin
 250         Self.Title := '';
 251         Self.RawDocument := '';
 252         Self.FThread := nil;
 253         Self.FEvent.Free;
 254         Self.FEvent := nil;
 255         Self.Blur;
 256         ShowWindow(Self.Handle, SW_HIDE);
 257         Self.Visible := False;
 258     end;
 259 end;
 260 procedure TResPopupBrowser.ChildClear;
 261 begin
 262     if (FChild <> nil) then begin
 263         FChild.Clear;
 264     end;
 265 end;
 266
 267 function TResPopupBrowser.CalcRect(WorkArea: TRect; Scroll: Boolean): TRect;
 268 var
 269         p: TPoint;
 270     ele: IHTMLElement2;
 271     h, w, dx1, dx2, dy1, dy2: Integer;
 272     MaxWidth, MaxHeight: Integer;
 273     DIV_X, DIV_Y: Integer;
 274 begin
 275         GetCursorpos(p);
 276     ele := ((Self.Document as IHTMLDocument2).body as IHTMLElement2);
 277     if Scroll then begin
 278         h := GetWindowHeight + 10;
 279         w := ele.scrollWidth + 25
 280     end else begin
 281         h := GetWindowHeight + 5;
 282         w := ele.scrollWidth + 10;
 283     end;
 284
 285     DIV_X := GikoSys.Setting.RespopupDeltaX;
 286     DIV_Y := GikoSys.Setting.RespopupDeltaY;
 287
 288     dx1 := 0; dx2 := 0;
 289     dy1 := 0; dy2 := 0;
 290
 291         Result := Rect(0, 0, w, h);
 292     case GikoSys.Setting.PopupPosition of
 293         gppRightTop:
 294         begin
 295             dx1 := 0; dx2 := + DIV_X;
 296             dy1 := -h; dy2 := - DIV_Y;
 297         end;
 298         gppRight:
 299         begin
 300             dx1 := 0; dx2 := + DIV_X;
 301             dy1 := - (h div 2); dy2 := 0;
 302         end;
 303         gppRightBottom:
 304         begin
 305             dx1 := 0; dx2 := + DIV_X;
 306             dy1 := 0; dy2 := + DIV_Y;
 307         end;
 308         gppTop:
 309         begin
 310             dx1 := - (w div 2); dx2 := 0;
 311             dy1 := -h; dy2 := - DIV_Y;
 312         end;
 313         // \94p\8e~ gppCenter: OffsetRect(Result, p.x - (w div 2), p.y - (h div 2));
 314         gppBottom:
 315         begin
 316             dx1 := - (w div 2); dx2 := 0;
 317             dy1 := 0; dy2 := + DIV_Y;
 318         end;
 319         gppLeftTop:
 320         begin
 321             dx1 := -w; dx2 := - DIV_X ;
 322             dy1 := -h; dy2 := - DIV_Y;
 323         end;
 324         gppLeft:
 325         begin
 326             dx1 := -w; dx2 := - DIV_X;
 327             dy1 := - (h div 2); dy2 := 0;
 328         end;
 329         gppLeftBottom:
 330         begin
 331             dx1 := -w; dx2 := - DIV_X;
 332             dy1 := 0; dy2 := + DIV_Y;
 333         end;
 334     end;
 335     // \8f\89\8aú\88Ê\92u\82É\88Ú\93®
 336     OffsetRect(Result, p.x + dx1 + dx2, p.y + dy1 + dy2);
 337
 338     MaxWidth := WorkArea.Right - WorkArea.Left;
 339     MaxHeight := WorkArea.Bottom - WorkArea.Top;
 340     // \88È\89º\81A\8f\89\8aú\88Ê\92u\82É\96â\91è\82ª\82 \82é\82Æ\82«\82Ì\88Ú\93®
 341     if (Result.Left < WorkArea.Left) then begin
 342         // \8bt\83T\83C\83h\82É\97]\97T\82ª\82 \82ê\82Î\81A\8fo\97Í\88Ê\92u\82Ì\8d¶\89E\93]\8a·
 343         if (p.X * 2 < MaxWidth) then begin
 344             if ( (GikoSys.Setting.PopupPosition = gppTop) or
 345                 (GikoSys.Setting.PopupPosition = gppBottom)) then begin
 346                 OffsetRect(Result, -Result.Left, WorkArea.Left);
 347             end else begin
 348                 OffsetRect(Result, - (dx1 + 2 * dx2), 0);
 349             end;
 350         end else begin
 351             // \89æ\96Ê\92[\82Ü\82Å\89æ\96Ê\95\9d\82ð\8f¬\82³\82\82·\82é
 352             Result := Rect(0, Result.Top,
 353                 Result.Right, Result.Bottom);
 354         end;
 355     end;
 356     if (Result.Top < WorkArea.Top) then begin
 357         // \92ê\91¤\82É\97]\97T\82ª\82 \82ê\82Î\81A\8fo\97Í\88Ê\92u\82Ì\8fã\89º\93]\8a·
 358         if (p.Y * 2 < MaxHeight) then begin
 359             OffsetRect(Result, 0, - (dy1 + 2 * dy2));
 360         end else begin
 361             // \89æ\96Ê\92[\82Ü\82Å\89æ\96Ê\8d\82\82ð\8f¬\82³\82\82·\82é
 362             Result := Rect(Result.Left, WorkArea.Top,
 363                 Result.Right, Result.Bottom);
 364         end;
 365     end;
 366     if (Result.Right > WorkArea.Right) then begin
 367         // \8bt\83T\83C\83h\82É\97]\97T\82ª\82 \82ê\82Î\81A\8fo\97Í\88Ê\92u\82Ì\8d¶\89E\93]\8a·
 368         if (p.X * 2 > WorkArea.Right) then begin
 369             if( (GikoSys.Setting.PopupPosition = gppTop) or
 370                 (GikoSys.Setting.PopupPosition = gppBottom)) then begin
 371                 OffsetRect(Result, -(Result.Right - WorkArea.Right), 0);
 372             end else begin
 373                 OffsetRect(Result, -w - (dx1 + 2 * dx2), 0);
 374             end;
 375             // \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é
 376             if (Result.Left < WorkArea.Left) then begin
 377                 Result := Rect(WorkArea.Left, Result.Top,
 378                     Result.Right, Result.Bottom);
 379             end;
 380         end else begin
 381             // \89æ\96Ê\92[\82Ü\82Å\89æ\96Ê\95\9d\82ð\8f¬\82³\82\82·\82é
 382             Result := Rect(Result.Left, Result.Top,
 383                 WorkArea.Right, Result.Bottom);
 384         end;
 385     end;
 386     if (Result.Bottom > WorkArea.Bottom) then begin
 387         // \8fã\91¤\82É\97]\97T\82ª\82 \82ê\82Î\81A\8fo\97Í\88Ê\92u\82Ì\8fã\89º\93]\8a·
 388         if (p.Y * 2 > WorkArea.Bottom) then begin
 389             OffsetRect(Result, 0, -h - (dy1 + 2 * dy2));
 390             // \8fã\82É\8aÑ\82¢\82½\8fê\8d\87\82Í\81A
 391             if (Result.Top < WorkArea.Top) then begin
 392                 Result := Rect(Result.Left, WorkArea.Top,
 393                     Result.Right, Result.Bottom);
 394             end;
 395         end else begin
 396             // \89æ\96Ê\92[\82Ü\82Å\89æ\96Ê\8d\82\82ð\8f¬\82³\82\82·\82é
 397             Result := Rect(Result.Left, Result.Top,
 398                 Result.Right, WorkArea.Bottom);
 399         end;
 400     end;
 401 end;
 402 function TResPopupBrowser.GetWindowHeight : Integer;
 403 var
 404         top: Integer;
 405         item: OleVariant;
 406 begin
 407     Result := 0;
 408     //\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Â
 409     while (Self.ReadyState <> READYSTATE_COMPLETE) and
 410                 (Self.ReadyState <> READYSTATE_INTERACTIVE) do begin
 411         Sleep(1);
 412         Forms.Application.ProcessMessages;
 413     end;
 414
 415     try
 416         top := 0;
 417         item := OleVariant( Self.Document as IHTMLDocument2)
 418                 .anchors.item(OleVariant('bottom'));
 419         item.focus();
 420         repeat
 421             top := top + item.offsetTop;
 422             item := item.offsetParent;
 423         until AnsiCompareText(item.tagName, 'body' ) = 0;
 424         Result := top;
 425     except
 426     end;
 427 end;
 428 function TResPopupBrowser.ResPopupBrowserClick(Sender: TObject): WordBool;
 429 begin
 430     // \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·
 431     Blur;
 432     Result := True;
 433 end;
 434 function TResPopupBrowser.GetThread: TThreadItem;
 435 begin
 436     Result := nil;
 437     if (FThread <> nil) then begin
 438         try
 439             // \96³\8cø\82È\83|\83C\83\93\83^\8c\9f\8d¸
 440             if (FThread.ParentBoard <> nil) then begin
 441                 Result := FThread
 442             end;
 443         except
 444             //\96³\8cø\82È\83|\83C\83\93\83^\82¾\82Á\82½
 445             Result := nil;
 446         end;
 447     end;
 448 end;
 449 procedure TResPopupBrowser.Blur;
 450 var
 451     FOleInPlaceActiveObject: IOleInPlaceActiveObject;
 452 begin
 453     FOleInPlaceActiveObject := Self.ControlInterface as IOleInPlaceActiveObject;
 454     FOleInPlaceActiveObject.OnFrameWindowActivate(False);
 455 end;
 456 function TResPopupBrowser.ResPopupBrowserDbClick(Sender: TObject): WordBool;
 457 begin
 458     // \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·
 459     Blur;
 460     // \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¤
 461     PostMessage( GikoForm.Handle , USER_RESPOPUPCLEAR, Integer( Self ), 0 );
 462     Result := True;
 463 end;
 464 initialization
 465     OleInitialize(nil);
 466
 467 finalization
 468     OleUninitialize;
 469
 470 end.