Source code of file oscpmwin_v0.1.1.875/progress.pas from the
osCommerce Product Manager for Windows.
0000: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
0001: osCommerce Product Manager for Windows (oscpmwin).
0002: Copyright �2003,2004,2005 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 progress;
0023:
0024: interface
0025:
0026: uses
0027: Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
0028: Dialogs, StdCtrls, Buttons, ComCtrls, ExtCtrls;
0029:
0030: CONST
0031: PDCallDebug = TRUE;
0032:
0033: type
0034: Topm_Form_Progress = class(TForm)
0035: Panel1: TPanel;
0036: opm_Label_ProgressMsg1: TLabel;
0037: opm_ProgressBar_Progress1: TProgressBar;
0038: opm_ProgressBar_Progress2: TProgressBar;
0039: opm_BitBtn_ProgressCancel: TBitBtn;
0040: opm_Label_ProgressMsg2: TLabel;
0041: procedure FormCreate(Sender: TObject);
0042: procedure FormShow(Sender: TObject);
0043: procedure opm_BitBtn_ProgressCancelClick(Sender: TObject);
0044: procedure FormClose(Sender: TObject; var Action: TCloseAction);
0045: private
0046: PDCanClose : BOOLEAN;
0047: PDIntProgress : LONGINT;
0048: PDWinList : POINTER;
0049: PDNowPlaying : BOOLEAN;
0050: public
0051: PDAllowCancel : BOOLEAN;
0052: PDCanceled : BOOLEAN;
0053: PDDoubleBars : BOOLEAN;
0054: PDMessage1 : STRING;
0055: PDMessage2 : STRING;
0056: PDIgnoreProgress : BOOLEAN;
0057: PROCEDURE PRopm_PDUpdate_Progress (Position, Bar : LONGINT; ProgressMessage : STRING);
0058: PROCEDURE PRopm_PDShow (AllowCancel, TwoBars : BOOLEAN);
0059: PROCEDURE PRopm_PDClose;
0060: end;
0061:
0062: var
0063: opm_Form_Progress: Topm_Form_Progress;
0064:
0065: implementation
0066:
0067: {$R *.dfm}
0068:
0069: uses gnugettext, balloons, attention, oscpmdata;
0070:
0071:
0072: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0073: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0074: procedure Topm_Form_Progress.FormCreate(Sender: TObject);
0075: begin
0076: PDCanClose := TRUE;
0077: PDAllowCancel := FALSE;
0078: PDCanceled := FALSE;
0079: PDDoubleBars := TRUE;
0080: PDMessage1 := '';
0081: PDMessage2 := '';
0082: PDIgnoreProgress := FALSE;
0083: PDIntProgress := 0;
0084: PDWinList := NIL;
0085: PDNowPlaying := FALSE;
0086: TranslateComponent (self);
0087: end;
0088:
0089:
0090: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0091: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0092: procedure Topm_Form_Progress.FormShow(Sender: TObject);
0093: begin
0094: PDCanClose := FALSE;
0095: PDNowPlaying := TRUE;
0096: PDCanceled := FALSE;
0097: IF (PDDoubleBars = TRUE) THEN
0098: BEGIN
0099: opm_ProgressBar_Progress1.Height := 16;
0100: opm_ProgressBar_Progress2.Visible := TRUE;
0101: END
0102: ELSE
0103: BEGIN
0104: opm_ProgressBar_Progress1.Height := 32;
0105: opm_ProgressBar_Progress2.Visible := FALSE;
0106: END;
0107: opm_ProgressBar_Progress1.Position := 0;
0108: opm_ProgressBar_Progress1.Min := 0;
0109: opm_ProgressBar_Progress1.Max := 100;
0110: opm_ProgressBar_Progress2.Position := 0;
0111: opm_ProgressBar_Progress2.Min := 0;
0112: opm_ProgressBar_Progress2.Max := 100;
0113: IF (PDAllowCancel = TRUE) THEN
0114: BEGIN
0115: opm_BitBtn_ProgressCancel.Visible := TRUE;
0116: opm_Form_Progress.Height := opm_BitBtn_ProgressCancel.Top + opm_BitBtn_ProgressCancel.Height + (opm_BitBtn_ProgressCancel.Height DIV 2);
0117: Screen.Cursor := opmC_Normal_Mouse;
0118: END
0119: ELSE
0120: BEGIN
0121: opm_BitBtn_ProgressCancel.Visible := FALSE;
0122: opm_Form_Progress.Height := opm_BitBtn_ProgressCancel.Top + (opm_BitBtn_ProgressCancel.Height DIV 2);
0123: Screen.Cursor := opmC_Wait_Mouse;
0124: END;
0125: opm_Label_ProgressMsg1.Caption := PDMessage1;
0126: opm_Label_ProgressMsg2.Caption := PDMessage2;
0127: PDIntProgress := 0;
0128: Application.ProcessMessages;
0129: end;
0130:
0131:
0132:
0133: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0134: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0135: PROCEDURE Topm_Form_Progress.PRopm_PDUpdate_Progress (Position, Bar : LONGINT; ProgressMessage : STRING);
0136: BEGIN
0137: IF ((PDWinList <> NIL) AND (PDNowPlaying = TRUE)) THEN
0138: BEGIN
0139: IF (PDIgnoreProgress = FALSE) THEN
0140: BEGIN
0141: IF (PDDoubleBars = TRUE) THEN
0142: BEGIN
0143: IF (Bar = 1) THEN
0144: BEGIN
0145: IF (Position > opm_ProgressBar_Progress1.Max) THEN Position := opm_ProgressBar_Progress1.Max;
0146: opm_ProgressBar_Progress1.Position := Position;
0147: IF (ProgressMessage <> '') THEN opm_Label_ProgressMsg1.Caption := ProgressMessage;
0148: END
0149: ELSE
0150: BEGIN
0151: IF (Position > opm_ProgressBar_Progress2.Max) THEN Position := opm_ProgressBar_Progress2.Max;
0152: opm_ProgressBar_Progress2.Position := Position;
0153: IF (ProgressMessage <> '') THEN opm_Label_ProgressMsg2.Caption := ProgressMessage;
0154: END;
0155: END
0156: ELSE
0157: BEGIN
0158: IF (Position > opm_ProgressBar_Progress1.Max) THEN Position := opm_ProgressBar_Progress1.Max;
0159: opm_ProgressBar_Progress1.Position := Position;
0160: IF (ProgressMessage <> '') THEN opm_Label_ProgressMsg1.Caption := ProgressMessage;
0161: END;
0162: END
0163: ELSE
0164: BEGIN
0165: IF (PDIntProgress < 100) THEN INC (PDIntProgress, 10) ELSE PDIntProgress := 0;
0166: opm_ProgressBar_Progress1.Position := PDIntProgress;
0167: END;
0168: END
0169: ELSE IF (PDCallDebug = TRUE) THEN FNopm_Message ('Progress Coding Error UPDATE', mtWarning, [mbOk], opmG_UISilent);
0170: Application.ProcessMessages;
0171: END;
0172:
0173:
0174:
0175: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0176: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0177: PROCEDURE Topm_Form_Progress.PRopm_PDClose;
0178: BEGIN
0179: IF ((PDWinList <> NIL) AND (PDNowPlaying = TRUE)) THEN
0180: BEGIN
0181: EnableTaskWindows (PDWinList);
0182: PDWinList := NIL;
0183: PDNowPlaying := FALSE;
0184: PDCanClose := TRUE;
0185: Close;
0186: END
0187: ELSE IF (PDCallDebug = TRUE) THEN FNopm_Message ('Progress Coding Error CLOSE', mtWarning, [mbOk], opmG_UISilent);
0188: END;
0189:
0190:
0191: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0192: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0193: PROCEDURE Topm_Form_Progress.PRopm_PDShow (AllowCancel, TwoBars : BOOLEAN);
0194: BEGIN
0195: IF ((PDWinList = NIL) AND (PDNowPlaying = FALSE)) THEN
0196: BEGIN
0197: PDWinList := DisableTaskWindows (Handle);
0198: PDAllowCancel := AllowCancel;
0199: PDDoubleBars := TwoBars;
0200: PDNowPlaying := TRUE;
0201: Show;
0202: END
0203: ELSE IF (PDCallDebug = TRUE) THEN FNopm_Message ('Progress Coding Error SHOW', mtWarning, [mbOk], opmG_UISilent);
0204: END;
0205:
0206:
0207: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0208: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0209: procedure Topm_Form_Progress.opm_BitBtn_ProgressCancelClick (Sender: TObject);
0210: BEGIN
0211: PDCanceled := TRUE;
0212: END;
0213:
0214:
0215: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0216: {%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
0217: procedure Topm_Form_Progress.FormClose(Sender: TObject; var Action: TCloseAction);
0218: BEGIN
0219: IF (PDCanClose = TRUE) THEN
0220: BEGIN
0221: Screen.Cursor := opmC_Normal_Mouse;
0222: Action := caHide;
0223: END
0224: ELSE Action := caNone;
0225: END;
0226:
0227: end.
