source: cprs/branches/tmg-cprs/CPRS-Chart/Orders/fODChild.pas@ 794

Last change on this file since 794 was 453, checked in by Kevin Toppenberg, 16 years ago

Initial upload of TMG-CPRS 1.0.26.69

File size: 3.6 KB
Line 
1//kt -- Modified with SourceScanner on 8/8/2007
2unit fODChild;
3
4interface
5
6uses
7 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
8 ExtCtrls, StdCtrls, fAutoSZ, ORFn, DKLang;
9
10type
11 TfrmODChild = class(TfrmAutoSz)
12 lblWarning: TLabel;
13 Panel1: TPanel;
14 lstODComplex: TListBox;
15 Panel2: TPanel;
16 btnOK: TButton;
17 btnCancel: TButton;
18 DKLanguageController1: TDKLanguageController;
19 procedure FormCreate(Sender: TObject);
20 procedure lstODComplexDrawItem(Control: TWinControl; Index: Integer;
21 TheRect: TRect; State: TOwnerDrawState);
22 procedure lstODComplexMeasureItem(Control: TWinControl; Index: Integer;
23 var TheHeight: Integer);
24 procedure btnOKClick(Sender: TObject);
25 procedure btnCancelClick(Sender: TObject);
26 private
27 { Private declarations }
28 FCmdOK: boolean;
29 public
30 { Public declarations }
31 end;
32
33function ActionOnComplexOrder(AnList: TStringList; CaptionTxt: string = ''; ShowCancel: boolean = False): boolean;
34implementation
35
36{$R *.DFM}
37function ActionOnComplexOrder(AnList: TStringList; CaptionTxt: string; ShowCancel: boolean): boolean;
38var
39 i: integer;
40 frmODChild: TfrmODChild;
41begin
42 frmODChild := TfrmODChild.Create(nil);
43 try
44 try
45 ResizeFormToFont(TForm(frmODChild));
46 if Length(CaptionTxt)>0 then
47 frmODChild.lblWarning.Caption := CaptionTxt;
48
49 for i := 0 to AnList.count - 1 do
50 frmODChild.lstODComplex.Items.Add(AnList[i]);
51
52 if not ShowCancel then
53 begin
54 frmODChild.btnOK.Visible := False;
55 frmODChild.btnCancel.Caption := 'OK';
56 end;
57
58 frmODChild.ShowModal;
59 if frmODChild.FCmdOK then Result := True else Result := False;
60 except
61 on e: Exception do
62 Result := False;
63 end;
64 finally
65 frmODChild.Release;
66 end;
67end;
68
69procedure TfrmODChild.FormCreate(Sender: TObject);
70begin
71 FCmdOK := False;
72end;
73
74procedure TfrmODChild.lstODComplexDrawItem(Control: TWinControl;
75 Index: Integer; TheRect: TRect; State: TOwnerDrawState);
76var
77 x: string;
78 ARect: TRect;
79 SaveColor: TColor;
80begin
81 inherited;
82 with lstODComplex do
83 begin
84 ARect := TheRect;
85 ARect.Left := ARect.Left + 2;
86 Canvas.FillRect(ARect);
87 Canvas.Pen.Color := clSilver;
88 SaveColor := Canvas.Brush.Color;
89 Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);
90 Canvas.LineTo(ARect.Right, ARect.Bottom - 1);
91 if Index < Items.Count then
92 begin
93 x := Piece(Items[index],'^',2);
94 DrawText(Canvas.Handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
95 Canvas.Brush.Color := SaveColor;
96 ARect.Right := ARect.Right + 4;
97 end;
98 end;
99end;
100
101procedure TfrmODChild.lstODComplexMeasureItem(Control: TWinControl;
102 Index: Integer; var TheHeight: Integer);
103var
104 x :string;
105 tempHeight: integer;
106 R: TRect;
107begin
108 inherited;
109 tempHeight := 0;
110 TheHeight := MainFontHeight + 2;
111 with lstODComplex do if Index < Items.Count then
112 begin
113 R := ItemRect(Index);
114 R.Left := 0;
115 R.Right := R.Right - 4;
116 R.Top := 0;
117 R.Bottom := 0;
118 x := Piece(Items[index],'^',2);
119 TempHeight := WrappedTextHeightByFont(Canvas, Font, x, R);
120 TempHeight := HigherOf(TempHeight,TheHeight);
121 if TempHeight > 255 then TempHeight := 255;
122 if TempHeight < 13 then TempHeight := 13;
123 end;
124 TheHeight := TempHeight;
125end;
126
127procedure TfrmODChild.btnOKClick(Sender: TObject);
128begin
129 FCmdOK := True;
130 Close;
131end;
132
133procedure TfrmODChild.btnCancelClick(Sender: TObject);
134begin
135 FCmdOK := False;
136 Close;
137end;
138
139end.
Note: See TracBrowser for help on using the repository browser.