unit U_AnswerToQuast; interface uses Windows, U_LNG, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, shellApi, cxControls, cxContainer, cxEdit, cxTextEdit, cxMemo, ComCtrls, Buttons, RzSpnEdt, ActnList, siComp, siLngLnk, RzBHints; type TF_AnswerToQuast = class(TForm) MsgText: TMemo; TimerHelp: TTimer; ActionList1: TActionList; Act_Close: TAction; lng_Forms: TsiLangLinked; Timer_Hide: TTimer; procedure FormClick(Sender: TObject); procedure FormShow(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure TimerHelpTimer(Sender: TObject); procedure Act_CloseExecute(Sender: TObject); procedure FormDeactivate(Sender: TObject); procedure Timer_HideTimer(Sender: TObject); private FsbPosX: Integer; FsbPosY: Integer; FPrevHintText: String; FHintWnd: THintWindow; FSavedOnMessage: TMessageEvent; function GetHintShowing: Boolean; procedure WMMouseWheel(var Msg: TWMMOUSEWHEEL); message WM_MOUSEWHEEL; public { Public declarations } GCaption: String; GAnswer: String; property HintShowing: Boolean read GetHintShowing; procedure Action(var Msg: TMsg; var Handled: boolean); procedure HideHint; procedure ShowContextHelp(ACAption, AContent: String; AModal: Boolean = false); procedure ShowHint(ACaption: String; AInterval: Integer); end; TESHintWindow = class(TRzCustomHintWindow) end; implementation {$R *.dfm} procedure TF_AnswerToQuast.FormClick(Sender: TObject); begin Close; end; procedure TF_AnswerToQuast.FormShow(Sender: TObject); var Point : Tpoint; Point1 : Tpoint; LargeWidth: Integer; LargeHeight: Integer; i: Integer; MaxTextLength: Integer; lptm: tagTEXTMETRICA; DC_RE: HDC; begin GetCursorPos(Point); point1 := CalcCursorPos; {Memo_Answ.Lines.Clear; Memo_Answ.Lines.Add(GAnswer);} {Label_Caption.Caption := GCaption; Label_Content.Caption := GAnswer; if Label_Caption.Caption = '' then begin Label_Content.Top := Label_Caption.Top; Label_Content.Left := Label_Caption.Left; end else begin Label_Content.Top := Label_Caption.Top + 24; Label_Content.Left := 8; end; LargeHeight := Label_Content.Top + Label_Content.Height + 5; if Label_Caption.Width > Label_Content.Width then LargeWidth := Label_Caption.Left + Label_Caption.Width + 20 else LargeWidth := Label_Content.Left + Label_Content.Width + 20; Width := LargeWidth; Height:= Label_Content.Top + Label_Content.Height + 20; Panel_Hint.Width := LargeWidth; Panel_Hint.Height := LargeHeight; } //GetTextMetrics {RichEdit.Lines.Clear; if GCaption <> '' then begin RichEdit.SelAttributes.Style := [fsBold]; RichEdit.Lines.Add(GCaption); RichEdit.SelAttributes.Style := RichEdit.DefAttributes.Style - [fsBold]; RichEdit.Lines.Add(#13); end; RichEdit.Lines.Add(GAnswer); MaxTextLength := 0; for i := 0 to RichEdit.Lines.Count - 1 do if Length(RichEdit.Lines[i]) > MaxTextLength then MaxTextLength := Length(RichEdit.Lines[i]); Width := MaxTextLength * (RichEdit.Font.Size + RichEdit.Font.Size div 2); RichEdit.Width := Width; //MaxTextLength + 10; Height := RichEdit.Lines.Count * (RichEdit.Font.Size + RichEdit.Font.Size div 2); RichEdit.Height := Height; //RichEdit.Lines.Count * 8; } // Width := 0; // Height := 0; // Panel_Content.Width := 0; // Panel_Content.Height := 0; Self.Caption := GCaption; MsgText.Lines.Text := GAnswer; // if Label_Caption.Caption = '' then // begin // //Label_Content.Top := Label_Caption.Top; // //Label_Content.Left := Label_Caption.Left; // ScrollBox.Top := Label_Caption.Top; // ScrollBox.Left := Label_Caption.Left; // end // else // begin // //Label_Content.Top := Label_Caption.Top + 24; // //Label_Content.Left := 8; // ScrollBox.Top := Label_Caption.Top + Label_Caption.Height + 5; // ScrollBox.Left := 0; // end; //DC_RE := GetDC(RichEdit.Brush.Handle); //DC_RE := GetDC(Label_Content.Canvas.Handle); //GetTextMetrics(DC_RE, lptm); //Panel_Text.Height := lptm.tmDigitizedAspectY; //Panel_Text.Width := lptm.tmDigitizedAspectY; // Panel_Content.Height := Label_Content.Top + Label_Content.Height + 30; // Panel_Content.Width := Label_Content.Left + Label_Content.Width + 30; //*** Определение максимальных размеров формы // if Point.X > Screen.Width div 2 then // Self.Constraints.MaxWidth := Point.X // else // Self.Constraints.MaxWidth := Screen.Width - Point.X; // if Point.Y > Screen.Height div 2 then // Self.Constraints.MaxHeight := Point.Y // else // Self.Constraints.MaxHeight := Screen.Height - Point.Y; // // if Self.Constraints.MaxWidth > Screen.Width div 2 then // Self.Constraints.MaxWidth := Screen.Width div 2; // if Self.Constraints.MaxHeight > Screen.Height div 2 then // Self.Constraints.MaxHeight := Screen.Height div 2; // if Self.Constraints.MaxHeight - 20 > 0 then // ScrollBox.Constraints.MaxHeight := Self.Constraints.MaxHeight - 30; // if Self.Constraints.MaxWidth - 20 > 0 then // ScrollBox.Constraints.MaxWidth := Self.Constraints.MaxWidth - 30; // if Self.Constraints.MinHeight - 20 > 0 then // ScrollBox.Constraints.MinHeight := Self.Constraints.MinHeight - 30; // if Self.Constraints.MinWidth - 20 > 0 then // ScrollBox.Constraints.MinWidth := Self.Constraints.MinWidth - 30; // ScrollBox.Width := Panel_Content.Left + Panel_Content.Width + 5; // ScrollBox.Height := Panel_Content.Top + Panel_Content.Height + 5; // Width := ScrollBox.Left + ScrollBox.Width + 2; // Height := ScrollBox.Top + ScrollBox.Height + 2; //*** Оределение точки Left/Top // if Point.X > Screen.Width div 2 then // Left := Point.X - Width // else // Left := Point.X; // if Point.Y < Self.Height then // Top := Point.Y // else // Top := Point.Y - Height //if Point.Y > Screen.Height div 2 then // Top := Point.Y - Height //else // Top := Point.Y; //FsbPosX := GetScrollPos(ScrollBox.Handle, SB_HORZ); //FsbPosY := GetScrollPos(ScrollBox.Handle, SB_VERT); end; function TF_AnswerToQuast.GetHintShowing: Boolean; begin Result := false; if (FHintWnd <> nil) and (FHintWnd.Showing) then Result := true; end; procedure TF_AnswerToQuast.WMMouseWheel(var Msg: TWMMOUSEWHEEL); begin // end; procedure TF_AnswerToQuast.Action(var Msg: TMsg; var Handled: boolean); begin if (Msg.message = WM_LBUTTONDOWN) or (Msg.message = WM_LBUTTONDBLCLK) or (Msg.message = WM_RBUTTONDOWN) or (Msg.message = WM_RBUTTONDBLCLK) or (Msg.message = WM_KEYDOWN) or (Msg.message = WM_MOUSEWHEEL) then begin HideHint; //if Assigned(FHintWnd) then //FHintWnd.ReleaseHandle; Close; end; end; procedure TF_AnswerToQuast.HideHint; begin if Assigned(FHintWnd) then FHintWnd.ReleaseHandle; end; procedure TF_AnswerToQuast.ShowContextHelp(ACAption, AContent: String; AModal: Boolean = false); begin GCaption := ACAption; GAnswer := AContent; if AModal then ShowModal else Show; end; procedure TF_AnswerToQuast.ShowHint(ACaption: String; AInterval: Integer); var Point: TPoint; X, Y: integer; Rect: TRect; begin TimerHelp.Enabled := false; if (ACaption = '') {or (FPrevHintText = ACaption)} then Exit; FPrevHintText := ACaption; //F_NormBase.GroupBox_Cost.Caption := screen.activecontrol.classname; if Assigned(FHintWnd) then FHintWnd.ReleaseHandle else FHintWnd := THintWindow.create(self); //18.06.2009 Rect := FHintWnd.CalcHintRect(Round(Screen.Width/2), ACaption, nil); Rect := FHintWnd.CalcHintRect(Round(Screen.WorkAreaWidth/2), ACaption, nil); GetCursorPos(Point); X := Point.X - (rect.Right - rect.Left) + 5; Y := Point.Y - (rect.Bottom - rect.Top) + 5; //27.05.2009 Y := Point.Y - (rect.Bottom - rect.Top) - 20; if (X < 0) or (X > Screen.WorkAreaWidth) then //18.06.2009 if (X < 0) or (X > Screen.Width) then X := 1; if (Y < 0) or (Y > Screen.WorkAreaHeight) then //18.06.2009 if (Y < 0) or (Y > Screen.Height) then Y := 1; rect.Left := rect.Left + X; rect.Right := rect.Right + X; rect.Top := rect.Top + Y; rect.Bottom := rect.Bottom + Y; FHintWnd.Color := clInfoBk; FHintWnd.ActivateHint(rect, ACaption); //Application.ActivateHint(); if @FSavedOnMessage <> @Application.OnMessage then FSavedOnMessage := Application.OnMessage; Application.OnMessage := Action; if AInterval <> 0 then begin TimerHelp.Interval := AInterval; TimerHelp.Enabled := true; end else Timer_Hide.Enabled := true; end; procedure TF_AnswerToQuast.FormClose(Sender: TObject; var Action: TCloseAction); begin //Application.OnMessage := nil; if Assigned(FSavedOnMessage) then Application.OnMessage := FSavedOnMessage else Application.OnMessage := nil; end; procedure TF_AnswerToQuast.TimerHelpTimer(Sender: TObject); begin TTimer(Sender).Enabled := false; HideHint; //FHintWnd.ReleaseHandle; end; procedure TF_AnswerToQuast.Timer_HideTimer(Sender: TObject); var Pos: TPoint; CheckRect: TRect; begin CheckRect := FHintWnd.ClientRect; GetCursorPos(Pos); Pos := FHintWnd.ScreenToClient(Pos); if Not PtInRect(CheckRect, Pos) then begin TTimer(Sender).Enabled := false; HideHint; end; end; procedure TF_AnswerToQuast.Act_CloseExecute(Sender: TObject); begin Close; end; procedure TF_AnswerToQuast.FormDeactivate(Sender: TObject); begin Close; end; end.