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