Source code of file oscpmwin/balloons.pas from the
osCommerce Product Manager for Windows.
0000: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0001: osCommerce Product Manager for Windows (oscpmwin).
0002: Copyright �2003-2006 by Mario A. Valdez-Ramirez.
0003:
0004: You can contact Mario A. Valdez-Ramirez
0005: by email at mario@mariovaldez.org or paper mail at
0006: Olmos 809, San Nicolas, NL. 66495, Mexico.
0007:
0008: This program is free software; you can redistribute it and/or modify
0009: it under the terms of the GNU General Public License as published by
0010: the Free Software Foundation; either version 2 of the License, or (at
0011: your option) any later version.
0012:
0013: This program is distributed in the hope that it will be useful, but
0014: WITHOUT ANY WARRANTY; without even the implied warranty of
0015: MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
0016: General Public License for more details.
0017:
0018: You should have received a copy of the GNU General Public License
0019: along with this program; if not, write to the Free Software
0020: Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
0021: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0022: unit balloons;
0023:
0024: interface
0025:
0026: USES Windows, Forms, Controls, Classes;
0027:
0028: CONST
0029: mvHint_XMargin = 16;
0030: mvHint_YMargin = 16;
0031: mvHint_YInterMargin = 3;
0032: mvHint_MaxWidth = 300;
0033: mvHint_IconX = 20;
0034: mvHint_IconText = '?';
0035: mvHint_Delay = 30000;
0036: mvHint_IniDelay = 500;
0037: mvHint_Separator = '|';
0038: mvHint_MaxChars = 800;
0039:
0040:
0041: TYPE
0042: mvHint_Window = CLASS (THintWindow)
0043: CONSTRUCTOR Create (AOwner: TComponent); OVERRIDE;
0044: PRIVATE
0045: FActivating: BOOLEAN;
0046: PUBLIC
0047: TitleHeight : LONGINT;
0048: BodyHeight : LONGINT;
0049: HintTitle : STRING;
0050: HintBody : STRING;
0051: PROCEDURE ActivateHint (Rect: TRect; CONST AHint: STRING); OVERRIDE;
0052: PROTECTED
0053: PROCEDURE Paint; OVERRIDE;
0054: PUBLISHED
0055: PROPERTY Caption;
0056: END;
0057:
0058: PROCEDURE PRmvHint_EnableHints (UseHints : BOOLEAN);
0059:
0060:
0061: IMPLEMENTATION
0062:
0063: USES Graphics, SysUtils, gnugettext;
0064:
0065:
0066:
0067: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0068: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0069: CONSTRUCTOR mvHint_Window.Create (AOwner: TComponent);
0070: BEGIN
0071: TitleHeight := 0;
0072: BodyHeight := 0;
0073: INHERITED Create(AOwner);
0074: END;
0075:
0076:
0077:
0078: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0079: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0080: PROCEDURE mvHint_Window.Paint;
0081: VAR
0082: WArea, WLIcon, WTextArea : TRect;
0083: OldFontHeight : LONGINT;
0084: BEGIN
0085: WArea := ClientRect;
0086: WLIcon := WArea;
0087: WLIcon.Right := WLIcon.Left + mvHint_IconX;
0088: Canvas.Brush.Style := bsSolid;
0089: Canvas.Brush.Color := clInfoBk;
0090: Canvas.Pen.Color := clInfoText;
0091: Canvas.Rectangle (WArea);
0092: Canvas.Brush.Style := bsSolid;
0093: Canvas.Brush.Color := clActiveCaption;
0094: Canvas.Pen.Color := clBlack;
0095: Canvas.Rectangle (WLIcon);
0096: OldFontHeight := Canvas.Font.Height;
0097: Canvas.Font.Style := [fsBold];
0098: Canvas.Font.Color := clCaptionText;
0099: Canvas.Font.Height := (mvHint_IconX);
0100: Canvas.TextOut (WLIcon.Right - ((WLIcon.Right - WLIcon.Left) DIV 2) - (Canvas.TextWidth (mvHint_IconText) DIV 2),
0101: 2, mvHint_IconText);
0102: WTextArea := WArea;
0103: IF (TitleHeight > 0) THEN
0104: BEGIN
0105: WTextArea.Top := WTextArea.Top + (mvHint_YMargin DIV 2) + mvHint_YInterMargin + TitleHeight;
0106: WTextArea.Bottom := WTextArea.Top + mvHint_YMargin + mvHint_YInterMargin + TitleHeight + BodyHeight;
0107: END
0108: ELSE
0109: BEGIN
0110: WTextArea.Top := WTextArea.Top + (mvHint_YMargin DIV 2);
0111: WTextArea.Bottom := WTextArea.Top + mvHint_YMargin + BodyHeight;
0112: END;
0113: WTextArea.Left := WTextArea.Left + (mvHint_XMargin DIV 2) + mvHint_IconX - 1;
0114: WTextArea.Right := WTextArea.Right - (mvHint_XMargin DIV 2) + 1;
0115: Color := clInfoBk;
0116: Canvas.Font.Style := [];
0117: Canvas.Font.Color := clInfoText;
0118: Canvas.Font.Height := OldFontHeight;
0119: Canvas.Brush.Color := clInfoBk;
0120: Canvas.Brush.Style := bsSolid;
0121: DrawText (Canvas.Handle, PCHAR (HintBody), -1, WTextArea, DT_WORDBREAK OR DT_LEFT);
0122:
0123: IF (TitleHeight > 0) THEN
0124: BEGIN
0125: WTextArea := WArea;
0126: WTextArea.Top := WTextArea.Top + (mvHint_YMargin DIV 2);
0127: WTextArea.Left := WTextArea.Left + (mvHint_XMargin DIV 2) + mvHint_IconX - 1;
0128: WTextArea.Bottom := WTextArea.Top + (mvHint_YMargin DIV 3) + mvHint_YInterMargin + TitleHeight;
0129: WTextArea.Right := WTextArea.Right - (mvHint_XMargin DIV 2) + 1;
0130: Color := clInfoBk;
0131: Canvas.Font.Style := [fsBold];
0132: Canvas.Font.Color := clInfoText;
0133: Canvas.Font.Height := OldFontHeight;
0134: Canvas.Brush.Color := clInfoBk;
0135: Canvas.Brush.Style := bsSolid;
0136: DrawText (Canvas.Handle, PCHAR (HintTitle), -1, WTextArea, DT_WORDBREAK OR DT_LEFT);
0137: END;
0138: END;
0139:
0140:
0141:
0142: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0143: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0144: PROCEDURE mvHint_Window.ActivateHint (Rect: TRect; CONST AHint: STRING);
0145: VAR
0146: WBodyY, WTitleY, WBodyX, WTitleX : LONGINT;
0147: TitleMsg, BodyMsg : STRING;
0148: BEGIN
0149: FActivating := TRUE;
0150: TRY
0151: TitleMsg := '';
0152: IF ((GetLongHint (Application.Hint) <> '') AND (GetLongHint (Application.Hint) <> AHint)) THEN
0153: BodyMsg := ANSISTRING (_(AHint + '|' + GetLongHint (Application.Hint)))
0154: ELSE
0155: BodyMsg := ANSISTRING (_(AHint));
0156: IF (ANSIPOS (mvHint_Separator, BodyMsg) > 0) THEN
0157: BEGIN
0158: TitleMsg := TRIM (COPY (BodyMsg, 1, (ANSIPOS (mvHint_Separator, BodyMsg) - 1)));
0159: BodyMsg := TRIM (COPY (BodyMsg, (ANSIPOS (mvHint_Separator, BodyMsg) + 1), mvHint_MaxChars));
0160: END
0161: ELSE BodyMsg := TRIM (COPY (BodyMsg, 1, mvHint_MaxChars));
0162: IF (TitleMsg = BodyMsg) THEN TitleMsg := '';
0163: Caption := BodyMsg;
0164: HintTitle := TitleMsg;
0165: HintBody := BodyMsg;
0166:
0167: IF (TitleMsg <> '') THEN
0168: BEGIN
0169: Rect.Right := Rect.Left + mvHint_MaxWidth;
0170: WTitleY := DrawText (Canvas.Handle, PCHAR (TitleMsg), -1, Rect, DT_CALCRECT OR DT_WORDBREAK OR DT_LEFT);
0171: WTitleX := Rect.Right - Rect.Left;
0172: TitleHeight := WTitleY;
0173: END
0174: ELSE
0175: BEGIN
0176: WTitleY := 0;
0177: WTitleX := 0;
0178: TitleHeight := 0;
0179: END;
0180:
0181: Rect.Right := Rect.Left + mvHint_MaxWidth;
0182: WBodyY := DrawText (Canvas.Handle, PCHAR (BodyMsg), -1, Rect, DT_CALCRECT OR DT_WORDBREAK OR DT_LEFT);
0183: WBodyX := Rect.Right - Rect.Left;
0184: BodyHeight := WBodyY;
0185:
0186: IF (WTitleX > WBodyX) THEN Rect.Right := Rect.Left + WTitleX + mvHint_XMargin + mvHint_IconX
0187: ELSE Rect.Right := Rect.Left + WBodyX + mvHint_XMargin + mvHint_IconX;
0188: IF (TitleHeight > 0) THEN Rect.Bottom := Rect.Top + mvHint_YMargin + mvHint_YInterMargin + WTitleY + WBodyY
0189: ELSE Rect.Bottom := Rect.Top + mvHint_YMargin + WBodyY;
0190:
0191: UpdateBoundsRect (Rect);
0192:
0193: IF (Rect.Right > Screen.DesktopWidth) THEN Rect.Left := Screen.DesktopWidth - Width;
0194: IF (Rect.Bottom > Screen.DesktopHeight) THEN Rect.Top := Screen.DesktopHeight - Height;
0195:
0196: SetWindowPos (Handle, HWND_TOPMOST, Rect.Left, Rect.Top, Width, Height, SWP_SHOWWINDOW OR SWP_NOACTIVATE);
0197: Invalidate;
0198: FINALLY
0199: FActivating := FALSE;
0200: END;
0201: END;
0202:
0203:
0204:
0205: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0206: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0207: PROCEDURE PRmvHint_EnableHints (UseHints : BOOLEAN);
0208: BEGIN
0209: Application.ShowHint := NOT (UseHints);
0210: Application.ShowHint := UseHints;
0211: Application.HintPause := mvHint_IniDelay;
0212: Application.HintShortPause := mvHint_IniDelay DIV 2;
0213: Application.HintHidePause := mvHint_Delay;
0214: END;
0215:
0216:
0217:
0218:
0219: INITIALIZATION
0220: HintWindowClass := mvHint_Window;
0221: PRmvHint_EnableHints (FALSE);
0222:
0223:
0224:
0225:
0226:
0227: end.
