Source code of file oscpmwin_v0.1.2.450/balloons.pas from the
osCommerce Product Manager for Windows.


0000:   {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0001:   osCommerce Product Manager for Windows (oscpmwin).
0002:   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.
 
 
NA fum/lmd: 2007.07.15
Copyright ©1994-2017 by Mario A. Valdez-Ramírez.
no siga este enlace / do not follow this link