source: cprs/branches/foia-cprs/CPRS-Chart/Orders/fODChild.pas@ 1643

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

Adding foia-cprs branch

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