/ИНТЕРФЕЙСЫ/ATA/Орфей/soft_all/soft/chars/dialogs.pp
https://bitbucket.org/Alchemist197/elektronika-osnovnoe · Puppet · 217 lines · 191 code · 26 blank · 0 comment · 18 complexity · 2b8a93a5b8fe7464be7c3f9b0742c6d2 MD5 · raw file
- unit Dialogs;
- interface
- uses Inferno, Alf, Mikky, X, XLib, XUtil, VGAColors, Ini;
- type
- TdgType = (dgDivider, dgRemark, dgBoolean, dgString, dgInt, dgOk, dgCancel, dgRadio);
- TdgItem = Record
- st : String;
- bC, fC : LongInt;
- ms : RngMouseArea;
- case tp : TdgType of
- dgDivider : ();
- dgRemark : ();
- dgBoolean : (vl_b: Boolean);
- dgString : (vl_s: String);
- dgInt : (vl_i: LongInt);
- dgOk,
- dgCancel : (res : Boolean);
- dgRadio : (id_l, vl_l: LongInt);
- end;
- function Dialog(var d: Array of TdgItem): Boolean;
- implementation
- type
- ExitState = (esNo, esRetOk, esRetEsc);
- const
- FontItem : AnsiString = '-*-*-medium-r-*-*-15-*-*-*-*-*-koi8-*';
- FontEnSt : AnsiString = '-*-*-medium-o-*-*-17-*-*-*-*-*-koi8-*';
- BorderX = 8; // -
- BorderY = 8;
- iBorderX = 4; //
- iBorderY = 4;
- OffsetY = 15;
- MaxStrX = 100; //
- OfsStrX = 20; //
- ColB = 12; // Boolean
- var
- Wnd : TWindow;
- Event : TXEvent;
- GC : TGC;
- xl, yl, maxX : LongInt;
- DrawNeed : Boolean;
- procedure DrawDiv(const Wnd: TWindow; var GC: TGC; const Colors: TColors; var dt);
- begin with TdgItem(dt) do begin
- xl := 0; yl := 5;
- end end;
- procedure DrawRem(const Wnd: TWindow; var GC: TGC; const Colors: TColors; var dt);
- begin with TdgItem(dt) do begin
- AlfSetFont(GC, fontItem);
- xl := AlfWidth(st) + iBorderX*2;
- yl := AlfHeight(st) + iBorderY*2;
- if DrawNeed then begin
- XSetWindowBorder(prDisplay, Wnd, Colors[0]);
- XSetWindowBackGround(prDisplay, Wnd, Colors[bC]);
- AlfCenter := True;
- AlfOutTextXY(Wnd, GC, maxX div 2, iBorderY, st);
- AlfCenter := False;
- end;
- end end;
- procedure DrawBool(const Wnd: TWindow; var GC: TGC; const Colors: TColors; var dt);
- begin with TdgItem(dt) do begin
- AlfSetFont(GC, fontItem);
- yl := AlfHeight(st) + iBorderY*2;
- xl := AlfWidth(st) + yl + iBorderX*2;;
- if DrawNeed then begin
- XSetWindowBackground(prDisplay, Wnd, Colors[bC]);
- XSetForeGround(prDisplay, GC, Colors[bC]);
- XFillRectangle(prDisplay, Wnd, GC, 0, 0, yl, yl);
- XSetForeGround(prDisplay, GC, Colors[fC]);
- XDrawRectangle(prDisplay, Wnd, GC, iBorderX, iBorderY, yl - iBorderX*2, yl - iBorderY*2);
- AlfOutTextXY(Wnd, GC, yl + iBorderX, iBorderY, st);
- if vl_b then begin
- XSetForeGround(prDisplay, GC, Colors[ColB]);
- XDrawLine(prDisplay, Wnd, GC, 2 + iBorderX, 5 + iBorderY, (yl - iBorderX*2) div 2 + iBorderX, iBorderY + yl - iBorderY*2);
- XDrawLine(prDisplay, Wnd, GC, (yl - iBorderX*2) div 2 + iBorderX, iBorderY + yl - iBorderY*2, iBorderX + yl - iBorderX*2, 0);
- end;
- end;
- end end;
- procedure CommonDrawStr(const Wnd: TWindow; var GC: TGC; const Colors: TColors; var dt; const s: String);
- var ey, i: LongInt;
- begin with TdgItem(dt) do begin
- AlfSetFont(GC, fontItem);
- yl := AlfHeight(st) + iBorderY*2;
- xl := AlfWidth(st) + MaxStrX + OfsStrX + iBorderX*2;
- AlfSetFont(GC, fontEnSt);
- ey := AlfHeight(s) + iBorderY*2;
- if yl < ey then yl := ey;
- if DrawNeed then begin
- AlfOutTextXY(Wnd, GC, iBorderX, iBorderY, '');
- for i := 1 to Length(s) do if AlfX + AlfWidth(s[i]) < MaxStrX then AlfOutText(Wnd, GC, s[i]) else break;
- AlfSetFont(GC, fontItem);
- AlfOutTextXY(Wnd, GC, MaxStrX + OfsStrX + iBorderX, iBorderY, st);
- end;
- end end;
- procedure DrawStr(const Wnd: TWindow; var GC: TGC; const Colors: TColors; var dt);
- begin
- CommonDrawStr(Wnd, GC, Colors, dt, TdgItem(dt).vl_s);
- end;
- procedure DrawInt(const Wnd: TWindow; var GC: TGC; const Colors: TColors; var dt);
- begin
- CommonDrawStr(Wnd, GC, Colors, dt, ValToStrG(TdgItem(dt).vl_i));
- end;
- procedure DrawBut(const Wnd: TWindow; var GC: TGC; const Colors: TColors; var dt);
- begin with TdgItem(dt) do begin
- AlfSetFont(GC, fontItem);
- xl := AlfWidth(st) + iBorderX * 2;
- yl := AlfHeight(st) + iBorderY * 2;
- if DrawNeed then begin
- XSetWindowBackGround(prDisplay, Wnd, Colors[bC]);
- AlfCenter := True;
- AlfOutTextXY(Wnd, GC, maxX div 2, iBorderY, st);
- AlfCenter := False;
- end;
- end end;
- procedure DrawRadio(const Wnd: TWindow; var GC: TGC; const Colors: TColors; var dt);
- begin
- runerror(245);
- end;
- const
- DrawProc : Array[TdgType] of TButDrawProc = (@DrawDiv, @DrawRem, @DrawBool, @DrawStr, @DrawInt, @DrawBut, @DrawBut, @DrawRadio);
- procedure MouseRegDlg(var d: Array of TdgItem);
- var i, x, y: LongInt; Col: TColors;
- begin
- DrawNeed := False;
- maxX := 0;
- For i := Low(d) to High(d) do With d[i] do begin
- DrawProc[tp](Wnd, GC, Col, d[i]);
- if xl > maxX then maxX := xl;
- end;
- y := BorderY;
- For i := Low(d) to High(d) do With d[i] do begin
- DrawProc[tp](Wnd, GC, Col, d[i]);
- if tp <> dgDivider then begin
- NewMouseArea(Wnd, ms);
- SetMouseArea(ms, msActive, BorderX, y, maxX, yl, fC, bC, '', DefaultMouseCursor);
- SetMouseRoutines(ms, DrawProc[tp], d[i], Nil, Nil, Nil);
- end;
- if tp in [dgCancel, dgOk] then res := False;
- inc(y, yl + OffsetY);
- end;
- x := maxX + BorderX*2; y := y - OffsetY + BorderY;
- XMoveResizeWindow(prDisplay, Wnd, (GetMaxX - x) div 2, (GetMaxY - y) div 2, x, y);
- DrawNeed := True;
- end;
- function MouseProc(var d: Array of TdgItem): ExitState;
- var i: LongInt;
- begin
- MouseProc := esNo;
- For i := Low(d) to High(d) do With d[i] do if MouseInArea(ms) then case tp of
- dgBoolean : begin vl_b := not vl_b; DrawButton(ms) end;
- dgString : begin if AlfEnterString(vl_s, st + ': ', MouseXroot, MouseYroot) then else DrawButton(ms) end;
- dgInt : begin if AlfEnterValue (vl_i, st + ': ', MouseXroot, MouseYroot) then else DrawButton(ms) end;
- dgOk : begin res := True; MouseProc := esRetOk end;
- dgCancel : begin res := True; MouseProc := esRetEsc end;
- end;
- end;
- procedure MouseUnRegDlg(var d: Array of TdgItem);
- var i: LongInt;
- begin
- For i := Low(d) to High(d) do With d[i] do if tp <> dgDivider then SetMouseArea(ms, msFree, 1, 1, 1, 1, 0, 0, '', DefaultMouseCursor);
- end;
- function Dialog(var d: Array of TdgItem): Boolean;
- var fn: ExitState;
- begin
- NewRootWindow(1, 1, 1, 1, 1, 1, '', '', Wnd);
- GC := XCreateGC(prDisplay, Wnd, 0, Nil);
- MouseRegDlg(d);
- fn := esNo;
- Repeat
- FlTmWithPause(Event, True);
- case Event.EventType of
- // Expose:
- DeleteNotify: fn := esRetEsc;
- KeyPress: case KeyInResult of
- XK_Return: fn := esRetOk;
- XK_Escape: fn := esRetEsc;
- end;
-
- ButtonRelease: // Dialog buttonpress=0. ButtonRelease
- fn := MouseProc(d);
- end;
- Until fn <> esNo;
- MouseUnRegDlg(d);
- XFreeGC(prDisplay, GC);
- XDestroyWindow(prDisplay, Wnd);
- Dialog := fn = esRetOk;
- KeyInResult := 0;
- end;
- begin
- IniOpen('Dialog');
- IniGet('FontItem', FontItem);
- IniGet('FontVarString', FontEnSt);
- IniClose;
- end.