Developpment & Palm Tips khertan on 16 Jan 2007 04:56 pm
Previewing and Adjusting Forms in 320*480 with Bird.
Yesterday i ve trying to modified a 320*480 form with 54 buttons ... So editing for testing each button from it s pixel position is boring. Bird is a great tool and can adjust object in a form with the rocker ... but only in 320*320 ... So it s a problem for me because some button couldn't be adjusted.
Bird source code was on my palm, so i ve modified the form editor to be able to display and adjust 320*480 forms.
And now i share my hack. (It s not a very good implementation of the dynamic pen input area management ... but it has been made quick ! Well quick ... and dirty) ...
Here the source code of the modified file : Builder3.pas.
//--------------------
// resource builder
// 'code 3' segment :
// Forms
//--------------------
{$code appl,bIrD,code,3}
program Bird;
{$define AllowInternalAccess}
{$i PalmAPI1.pas}
{$i builderglobals.pas}
function FrmGetNumberOfObjects(frmP:FormPtr):UInt16;inline($4e4f,$a17f);
function CtlNewControl(var formp:FormPtr;ID:UInt16;style:ControlStyleType;const text:string;x,y,width,height:Coord;font:FontID;group:UInt8;leftAnchor:Boolean):ControlPtr;inline($4e4f,$a32c);
procedure EvtAddEventToQueue(var event:EventType);inline($4e4f,$a11b);
function FrmHandleEvent(frm:FormPtr;var event:eventType):boolean;inline($4e4f,$a17a);
procedure WinSetBounds(winH: WinHandle; var rP: RectangleType); inline($4e4f,$a300);
type
FormActiveStateType = array[0..10] of UInt16;
function FrmActiveState(var state:FormActiveStateType;save:boolean):err;inline($4e4f,$a33b);
//function CtlNewControl(var formp:FormPtr;id:UInt16;style:ControlStyleType;const text:string;x,y,width,height:Coord;font:FontID;group:UInt8;leftAnchor:boolean):ControlPtr;inline($4e4f,$a32c);
// for debug purpose only, display integer
// in a box value
procedure IntAlert(n:integer);
var s:string[15];
begin
StrIToA(s,n);
errAlertCustom(0,@s,nil,nil);
end;
/////////////////////////////////////
// StringToRessourceLab
/////////////////////////////////////
function StringToRessourceLab(const sMyString:string):integer;
begin
StringToRessourceLab:=
Ord(sMyString[4])+
256*Ord(sMyString[3])+
65536*Ord(sMyString[2])+
16777216*Ord(sMyString[1]);
end;
// utilities
//----------
procedure bip;
begin
SndPlaySystemSound(snderror);
end;
function GetFormObjPtr(frm:FormPtr;id:UInt16):pointer;
begin
GetFormObjPtr:=frmGetObjectPtr(frm,frmGetObjectindex(frm,id));
end;
function GetObjPtr(id:UInt16):pointer;
begin
GetObjPtr:=GetFormObjPtr(FrmGetActiveForm,id);
end;
procedure InitTextFieldID(id:Uint16;const s:string;redraw:boolean);
begin
FarInitTextField(GetObjPtr(id),s,redraw);
end;
type WindowType=record // 40 bytes
DisplayidthV20,
DisplayHeightV20 : Coord;
displayAddrV20 : pointer;
windowFlags : UInt16;
windowBounds : RectangleType;
clippingBounds : AbsRectType;
bitmapP : BitmapPtr;
frameType : UInt16;
drawStateP : pointer;
nextWindow : ^WindowType;
end;
// WinfowFlag :
// modal : $2000
// frame :
// b8..b15 : corner diam
// b4 : 3D
// b3 b2 : shadowWidth
// b1 b0 : width
// standards frames
{
const
noFrame = 0;
simpleFrame = 1; // = rectangleframe
simple3DFrame = $0012;
roundFrame = $0401;
boldRoundFrame = $0702;
popupFrame = $0205; // = menuframe
dialogFrame = $0302;
}
//------------
// controls
//------------
// contolAttrType
// b7 : usable $8000
// b6 : enabled $4000
// b5 : visible $2000
// b4 : on $1000
// leftAnchor $$0800 -- set if bounds expand to the right
// frame $0700 -- noFrame, Standard, bold, rectangle
// drawnAsSelected $0080
// graphical $0040
// vertical $0020 -- set for vertical sliders
// unused $001f
type
FieldType=record
id : UInt16;
rect : RectangleType;
attr : UInt16;
text,textHandle,lines : pointer;
textlen,textBlockSize : UInt16;
maxChars : UInt16;
selFirstPos,selLastPos,insptXPos,insptYPos : UInt16;
font : FontID;
maxVisibleLines : UInt8;
end;
{
controlType=record
id : UInt16;
bounds : RectangleType;
text : StringPtr;
attr : UInt16;
style : ControlStyleType; // ( enum )
font : FontID;
group : UInt8;
reserved : UInt8;
end;
}
graphicControlType=record
id : UInt16;
bounds : RectangleType;
bitmapID : UInt16;
selectedBitmapID : UInt16;
attr : UInt16;
style : ControlStyleType;
unused : FontID;
group : UInt8;
reserved : UInt8;
end;
slidercontroltype=record
id : UInt16;
bounds : RectangleType;
thumbID : UInt16;
backgroundID : UInt16;
attr : UInt16; // graphical is set
style : ControlStyleType;
reserved : UInt8;
minvalue : Int16;
maxvalue : Int16;
pagesize : Int16;
value : Int16;
activeSliderP : pointer;
end;
{
itemsTextType = array[0..255] of StringPtr;
itemsTextPtr = ^ItemsTextType;
ListType=record
id : UInt16;
bounds : rectangleType;
attr : UInt16;
itemsText : itemsTextPtr;
numItems : Int16;
currentItem : Int16;
topItem : Int16;
font : FontID;
reserved : UInt8;
popupwin : MemHandle;
drawItemsCallback : pointer;
end;
}
tableItemStyleType=
( checkboxTableItem,
customTableItem,
dateTableItem,
labelTableItem,
numerictableItem,
popuptriggerTableItem,
textTableItem,
textwithnoteTableItem,
timeTableItem,
NarrowTextTableItem,
tallCustomtableItem );
tableItemType=record
itemType : TableItemStyleType;
font : FontID;
intValue : Int16;
ptr : pointer;
end;
tableitemsType=array[0..255] of tableItemType;
tableitemsPtr = ^tableItemsType;
tableColumnAttrType=record
width : Coord;
attr : UInt16;
spacing : Coord;
drawCallback,
loaddatacallback,
savedatacallback : pointer;
end;
tableColumnAttrsType=array[0..15] of tableColumnAttrType;
tableColumnAttrsPtr=^tableColumnAttrsType;
tableRowAttrType=record
id : UInt16;
height : Coord;
data : UInt32;
attr : UInt16;
reserved3 : UInt16;
end;
tableRowAttrsType=array[0..23] of tableRowAttrType;
tablerowAttrsPtr=^tableRowAttrsType;
tabletype=record
id : UInt16;
bounds : rectangleType;
attr : UInt16;
numColumns : Int16;
numRows : Int16;
currentrow : Int16;
currentColumn : Int16;
toprow : Int16;
columnAttrs : tableColumnAttrsPtr;
rowAttrs : TableRowAttrsPtr;
items : TableitemsPtr;
currentField : FieldType;
end;
FormBitmapType = record
attr : UInt16;
pos : PointType;
rscID : UInt16;
end;
FormLabelType=record
id : UInt16;
pos : PointType;
attr : UInt16;
font : FontID;
reserved : UInt8;
text : StringPtr;
end;
FormTitleType=record
rect : rectangleType;
text : StringPtr;
end;
FormPopupType=record
controlID : UInt16;
listID : UInt16;
end;
FrmGraffitiStateType=record
pos : PointType;
end;
FormGadgetType=record
id : UInt16;
attr : UInt16;
rect : RectangleType;
data : pointer;
handler : pointer;
end;
ScrollBarType=record
bounds : RectangleType;
id : UInt16;
attr : UInt16;
value,
minvalue,
maxvalue,
pagesize,
penPosInCar,
savePos : Int16;
end;
FormObjectType=record case objectType:FormObjectKind of
frmFieldObj:(field:^FieldType);
frmControlObj:(control:^ControlType);
frmListObj:(list:^ListType);
frmTableObj:(table:^TableType);
frmBitmapObj:(bitmap:^FormBitmapType);
frmLineObj:(sliderControl:^SliderControlType);
frmFrameObj:(graphicControl:^GraphicControlType);
frmRectangleObj:(w : memoryword);
frmLabelObj:(FormLabel:^FormLabelType);
frmTitleObj:(title:^FormTitleType);
frmPopupObj:(popup:^FormPopupType);
frmGraffitiStateObj:(grfState:^FrmGraffitiStateType);
frmGadgetObj:(gadget:^FormGadgetType);
frmScrollbarObj:(scrollBar:^ScrollBarType)
end;
FormObjectPtr=^FormObjectType;
//--------------
// Form Editor
//--------------
FormObjArrayType=array[0..511] of FormObjectType;
FormObjArrayPtr = ^FormObjArrayType;
type
// internal form type
FormType = record
window : WindowType; // 40
formID : UInt16;
attr : UInt32;
bitsBehindForm : WinHandle;
handler : pointer;
focus : UInt16;
defaultButton : UInt16;
helpRscId : UInt16;
MenuRscID : UInt16;
numObjects : Int16; // 62
objects : FormObjArrayPtr;
end;
IControlType=record
next : ^IcontrolType;
end;
//---------------
// PalmOS Glue
//---------------
function AccessorTrapPresent:boolean;
var v : UInt32;
begin
AccessorTrapPresent:=false;
if FtrGet(sysFtrCreator,25,v)=0 then
if v<>0 then AccessorTrapPresent:=true;
end;
function LstGetFont(lst:ListPtr):FontID;inline($7400+19,$4e4f,$a3f4);
function LstGetItemsText(pl:ListPtr):pointer;
inline($7400+21,$4e4f,$a3f4);
function LstGlueGetItemsText(pl:ListPtr):pointer;
begin
if AccessorTrapPresent then LstGlueGetItemsText:=LstGetItemstext(pl)
else LstGlueGetItemsText:=pl^.itemsText;
end;
function LstGlueGetFont(lst:ListPtr):FontID;
begin
if AccessorTrapPresent then LstGlueGetFont:=LstGetFont(lst)
else LstGlueGetFont:=lst^.font;
end;
function CtlGetControlStyle(ctl:ControlPtr):ControlStyleType;inline($7400+0,$4e4f,$a3f4);
function CtlGlueGetControlStyle(ctl:ControlPtr):ControlStyleType;
begin
if AccessorTrapPresent then CtlGlueGetControlStyle:=CtlGetControlStyle(ctl)
else CtlGlueGetControlStyle:=ctl^.style;
end;
//----------------------
// PreviewEventHandler
//----------------------
// returns true if this event ends preview dialog
function EndPreview(var event:EventType):boolean;
begin
EndPreview:=
(event.etype=keydownevent) and
((event.keydown.chr=$108) or
(event.keydown.chr=$136) or
((event.keydown.chr=1283) and (event.keydown.keycode=4096)));
end;
//DIAs functions
function FrmSetDIAPolicyAttr(form:formPtr;pol:UInt16):Err;inline($740E,SYSTRAP,$A470);
function SetDIAState(pol:UInt16):UInt16;inline($7400,SYSTRAP,$A470);
function WinSetConstraintsSize(winH:WinHandle;minH:UInt16;prefH:UInt16;maxH:UInt16;minW:UInt16;prefW:UInt16;maxW:UInt16):Err;inline($740D,SYSTRAP,$A470);
function FrmGetWindowHandle(form:formPtr):WinHandle;inline(SYSTRAP,$A17C);
function PINSetInputTriggerState(state:UInt16):Err;inline($7402,SYSTRAP,$A470);
//Procedure WinSetBounds(winH:WinHandle;r:RectangleTypePtr);inline(SYSTRAP,$A300);
function GetDIAState:UInt16;inline($7401,SYSTRAP,$A470);
function GetLandState:UInt16;inline($7413,SYSTRAP,$A470);
function SetLandState(pol:UInt16):UInt16;inline($7414,SYSTRAP,$A470);
/////////////////////////////////////
// DIA: Set DIA
/////////////////////////////////////
procedure setDIA(f:FormPtr;resize:Boolean);
var
error:Err;
version:UInt32;
w:WinHandle;
r:RectangleType;
v:UInt16;
begin
r.topLeft.x:=0;
r.topLeft.y:=0;
r.extent.x:=160;
r.extent.y:=160;
error:=FtrGet(StringToRessourceLab('pins'),1,version);
//error:=1;
f:=FrmGetActiveForm;
if (error=0) then
begin
if (version>0) then
begin
//on recupere le formulaire courant
//. f:=FrmGetActiveForm;
if (GetDIAState<>2) then begin
//on recupere la fenetre courante
w:=FrmGetWindowHandle(f);
//on defini les tailles prªfªrªs, maxi et mini
WinSetConstraintsSize(w,240,240,240,240,160,160);
//on indique que celui ci accepte que la zone virtuelle soit fermer
FrmSetDIAPolicyAttr(f,1);
//On va cacher la zone virtuelle
SetDIAState(1);
//On va donner une valeur par defaut
//au boutton permettant de cacher la
//zone virtuelle.
PINSetInputTriggerState(1);
r.extent.x:=240;
r.extent.y:=240;
end;
end;
end;
//On crªe un rectangle pour
//Redimensionner notre fenetre
if resize then begin
w:=FrmGetWindowHandle(f);
//on la redimensionne
WinSetBounds(w,r);
// WinGetBounds(WinGetDisplayWindow,r);
// WinSetBounds(FrmGetWindowHandle(f),r);
end;
end;
procedure PreviewDialog(frm:FormPtr);
label 11,10;
var
state : FormActiveStateType;
event : EventType;
e :UInt16;
begin
FrmActiveState(state,true);
FrmSetActiveForm(frm);
FrmDrawForm(frm);
SetDia(frm,true);
repeat
11:
EvtGetEvent(event,-1);
// capture end preview event
if EndPreview(event) then //( (event.etype=keydownevent) and (event.keydown.chr=$108) ) then
begin
FrmDispatchEvent(event); // to validate adjust modifs
goto 10;
end;
if FrmDispatchEvent(event) then goto 11;
if SysHandleEvent(event) then goto 11;
if MenuHandleEvent(nil,event,e) then goto 11;
// if FrmDispatchEvent(event) then goto 11;
if event.etype=appstopevent then
begin
EvtAddEventToqueue(event);
goto 10;
end;
until false;
10:
FrmEraseForm(frm); // if this is not done, simulator complains
FrmActiveState(state,false);
end;
{
function PreviewFormEventHandler(var event:eventType):boolean;
begin
pushregs;
PreviewFormEventHandler:=false;
case event.etype of
keyDownEvent:
begin
if event.keydown.chr=$108 then
begin
PreviewFormEventHandler:=true;
end;
end;
end;
popregs;
end;
}
procedure DrawObjFrame(rec:RectangleType);
begin
rec.topleft.x:=rec.topleft.x-1;
rec.topleft.y:=rec.topleft.y-1;
rec.extent.x:=rec.extent.x+2;
rec.extent.y:=rec.extent.y+2;
WinDrawGrayRectangleFrame(simpleFrame,rec);
end;
procedure SetObjectPosition(const obj:FormObjectType;x,y:Coord);
begin
with obj do case ObjectType of
FrmPopupObj:;
FrmGraffitiStateObj,
FrmScrollBarObj:
with GrfState^ do
begin
Pos.x:=x;
Pos.y:=y;
end;
FrmGadgetObj: with gadget^ do
begin
rect.topleft.x:=x;
rect.topleft.y:=y;
end;
else with FormLabel^ do
begin
Pos.x:=x;
Pos.y:=y;
end;
end;
end;
procedure SetPositions;
var pf : ^FormType;
rec : RectangleType;
i : Int16;
frm : FormPtr;
begin
frm:=FrmGetActiveForm;
pf:=DataPointer;
with pf^ do
for i:=0 to numObjects-1 do
begin
FrmGetObjectBounds(frm,i,rec);
SetObjectPosition(objects^[i],rec.topleft.x,rec.topleft.y);
end;
end;
function AdjustEventHandler(var event:eventType):boolean;
label 10,11,12;
var i : Int16;
frm : FormPtr;
rec : rectangleType;
begin
// pushregs;
AdjustEventHandler:=false;
if EndPreview(event) then
begin
SetPositions;
AdjustEventHandler:=true;
end
else
case event.etype of
penDownEvent:
begin
frm:=FrmGetActiveForm;
for i:=0 to FrmGetNumberOfObjects(Frm)-1 do
begin
frmGetObjectBounds(frm,i,rec);
if RctPtInRectangle(event.ScreenX,event.ScreenY,rec) then
begin
CurrObjInd:=i;
FrmDrawForm(frm);
DrawObjFrame(rec);
goto 10;
end;
end;
10:
AdjustEventHandler:=true;
end;
keyDownEvent:
begin
case event.keydown.chr of
11:
begin
if CurrObjInd>=0 then
begin
frm:=FrmGetActiveForm;
FrmGetObjectBounds(frm,CurrObjInd,rec);
rec.topleft.y:=rec.topleft.y-1;
FrmSetObjectBounds(frm,CurrObjInd,rec);
FrmDrawForm(frm);
DrawObjFrame(rec);
end;
end;
12:
begin
if CurrObjInd>=0 then
begin
frm:=FrmGetActiveForm;
FrmGetObjectBounds(frm,CurrObjInd,rec);
rec.topleft.y:=rec.topleft.y+1;
FrmSetObjectBounds(frm,CurrObjInd,rec);
FrmDrawForm(frm);
DrawObjFrame(rec);
end;
end;
$206,$135 : goto 11;
$205,$134 : goto 12;
1283:
begin
case event.keydown.keycode of
2056,8: // right
if CurrObjInd>=0 then
begin
11:
frm:=FrmGetActiveForm;
FrmGetObjectBounds(frm,CurrObjInd,rec);
rec.topleft.x:=rec.topleft.x+1;
FrmSetObjectBounds(frm,CurrObjInd,rec);
FrmDrawForm(frm);
DrawObjFrame(rec);
AdjustEventHandler:=true;
end;
1028,4: // left
if CurrObjInd>=0 then
begin
12:
frm:=FrmGetActiveForm;
FrmGetObjectBounds(frm,CurrObjInd,rec);
rec.topleft.x:=rec.topleft.x-1;
FrmSetObjectBounds(frm,CurrObjInd,rec);
FrmDrawForm(frm);
DrawObjFrame(rec);
AdjustEventHandler:=true;
end;
end;
end;
end;
end;
end;
// popregs;
end;
//-------------
// Title Dialog
//-------------
function GetNewTextField(frm:FormPtr;id:UInt16):StringPtr;
var ps : StringPtr;
nt : StringPtr;
begin
ps:=FldGetTextPtr(GetFormObjPtr(frm,id));
if ps=nil then
begin
nt:=MemPtrNew(2);
nt^:='';
end
else
begin
nt:=MemPtrNew(StrLen(ps^)+1);
StrCopy(nt^,ps^);
end;
GetNewTextField:=nt;
end;
procedure TitleDialog;
var frm : FormPtr;
pt : ^FormTitleType;
ps : StringPtr;
fldind : UInt16;
fld : FieldPtr;
begin
frm:=FrmInitForm(2300);
fldind :=FrmGetObjectIndex(frm,2301);
fld:=FrmGetObjectPtr(frm,fldind);
if ObjectP<>nil then
begin
pt:=ObjectP;
// copy text and set selection
FarInitTextField(fld,pt^.text^,false);
FldSetSelection(fld,0,StrLen(pt^.text^){length(pt^.text^)});
end
// the field needs to be initialised to non nil text in ordre
// to display focus
else FarInitTextField(fld,'',false);
FrmSetFocus(frm,fldind);
if FrmDoDialog(frm)=2302 then
begin
if ObjectP<>nil then MemPtrFree(pt^.text)
else
begin
ObjectP:=MemPtrNew(Sizeof(FormTitleType));
MemSet(ObjectP^,Sizeof(FormTitleType),0);
pt:=ObjectP;
end;
pt^.text:=GetNewTextField(frm,2301);
end;
FrmDeleteForm(frm);
end;
//---------------
// Label Dialog
//---------------
procedure InitDecimalField(frm:FormPtr;id:Uint16;x:UInt16);
var
buffer : String[7];
begin
StrIToA(buffer,x);
FarInitTextField(GetFormObjPtr(frm,id),buffer,false);
end;
function CheckField(frm : FormPtr;id:UInt16):boolean;
var ps : StringPtr;
begin
CheckField:=true;
ps:=FldGetTextPtr(GetFormObjPtr(frm,id));
if (ps=nil) or (ps^='') then
begin
CheckField:=false;
bip;
FrmSetFocus(frm,FrmGetObjectIndex(frm,id));
end;
end;
function GetDecimal(frm:FormPtr;id:UInt16):UInt16;
var ps : StringPtr;
begin
ps:=FldGetTextPtr(GetFormObjPtr(frm,id));
GetDecimal:=StrAToI(ps^);
end;
procedure SetCheck(frm:FormPtr;id:UInt16;value:UInt16);
begin
CtlSetValue(GetFormObjPtr(frm,id),value);
end;
function GetCheck(frm:FormPtr;id:UInt16):UInt16;
begin
GetCheck:=CtlGetValue(GetFormObjPtr(frm,id));
end;
function GetListSel(frm:FormPtr;id:UInt16):Int16;
begin
GetListSel:=LstGetSelection(GetFormObjPtr(frm,id));
end;
procedure SetListSel(frm:FormPtr;id:UInt16;sel:Int16);
begin
LstSetSelection(GetFormObjPtr(frm,id),sel);
end;
function LabelDialogEventHandler(var event:EventType):boolean;
var frm : FormPtr;
begin
pushregs;
LabelDialogEventHandler:=false;
if not FarHandleEditMenuEvent(event) then
case event.etype of
ctlSelectEvent:
if event.ctlSelect.ControlID=1901 then
begin // control that numerics fields are not empty
frm:=FrmGetActiveForm;
LabelDialogEventHandler:=not
( checkField(frm,1910) and
CheckField(frm,1908) and
CheckField(frm,1911) ) ;
end;
fldChangedEvent:
begin
if event.fldChanged.fieldID=1701 then FarUpdateScrollbar;
end;
sclRepeatEvent:
begin
with event.sclRepeat do FarScrollLines(newvalue-value);
LabelDialogEventHandler:=false;
end;
end;
popregs;
end;
procedure LabelDialog;
var
frm : FormPtr;
pl : ^FormLabelType;
lb : FormLabelType;
begin
frm:=FrmInitForm(1900);
FrmSetEventHandler(frm,LabelDialogEventHandler);
// field init
if ObjectP<>nil then
begin
pl:=ObjectP;
lb:=pl^;
end
else MemSet(lb,Sizeof(FormLabelType),0);
// objects initialisation
InitDecimalField(frm,1910,lb.pos.y);
InitDecimalField(frm,1908,lb.pos.x);
InitDecimalField(frm,1911,lb.id);
LstSetSelection(GetFormObjPtr(frm,1904),lb.font);
// CtlSetValue(GetFormObjPtr(frm,1914),lusable shr 15);
SetCheck(frm,1914,lb.attr shr 15);
if lb.text<>nil then
FarInitTextField(GetFormObjPtr(frm,1701),lb.text^,false);
if FrmDoDialog(frm)=1901 then
begin
if ObjectP<>nil then MemPtrFree(pl^.text)
else
begin
ObjectP:=MemPtrNew(Sizeof(FormLabelType));
pl:=ObjectP;
MemSet(pl^,sizeof(FormLabelType),0);
end;
with pl^ do
begin
pos.y:=GetDecimal(frm,1910);
pos.x:=GetDecimal(frm,1908);
id:=GetDecimal(frm,1911);
// ltext:=FldGetTextPtr(GetFormObjPtr(frm,1701));
attr:=CtlGetValue(GetFormObjPtr(frm,1914)) shl 15;
font:=LstGetSelection(GetFormObjPtr(frm,1904));
text:=GetNewTextField(frm,1701);
// if ltext=nil then
// begin
// text:=MemPtrNew(2);
// MemSet(text^,2,0);
// end
// else
// begin
// text:=MemPtrNew(length(ltext^)+1);
// StrCopy(text^,ltext^); //}text^:=ltext^;
// end;
end;
end;
FrmDeleteForm(frm);
end;
//-----------------------
// GraffitiState Dialog
//-----------------------
function GraffitiStateDialogEventHandler(var event:EventType):boolean;
var frm : FormPtr;
begin
pushregs;
GraffitiStateDialogEventHandler:=false;
case event.etype of
ctlSelectEvent:
if event.ctlSelect.ControlID=2501 then
begin // control that numerics fields are not empty
frm:=FrmGetActiveForm;
GraffitiStateDialogEventHandler:=not
( checkField(frm,2506) and
CheckField(frm,2505) ) ;
end;
end;
popregs;
end;
procedure GraffitiStateDialog;
var
frm : FormPtr;
pg : ^FrmGraffitiStateType;
top,left : Int16;
// buffer : string[7];
begin
frm:=FrmInitForm(2500);
FrmSetEventHandler(frm,GraffitiStateDialogEventHandler);
if ObjectP<>nil then
begin
pg:=ObjectP;
top:=pg^.pos.y;
left:=pg^.pos.y;
end
else
begin
top:=0;
left:=0;
end;
InitDecimalField(frm,2506,top);
InitDecimalField(frm,2505,left);
if FrmDoDialog(frm)=2501 then
begin
if ObjectP=nil then
begin
ObjectP:=MemPtrNew(Sizeof(FrmGraffitiStatetype));
end;
pg:=objectP;
with pg^ do
begin
pos.y:=GetDecimal(frm,2506);
pos.x:=GetDecimal(frm,2505);
end;
end;
FrmDeleteForm(frm);
end;
//----------------
// Control Dialog
//----------------
function ControlDialogEventHandler(var event:eventType):boolean;
var
frm : FormPtr;
ps : StringPtr;
width : Int16;
font : FontID;
begin
pushregs;
ControlDialogEventHandler:=false;
if not FarHandleEditMenuEvent(event) then
case event.etype of
ctlSelectEvent:
case event.ctlSelect.controlID of
1611: // OK
begin
frm:=FrmGetActiveForm;
ControlDialogEventHandler:= not
(CheckField(frm,1605) and
CheckField(frm,1603) and
CheckField(frm,1608) and
CheckField(frm,1610) and
CheckField(frm,1626) and
CheckField(frm,1620));
end;
1631: // calc width
begin
frm:=FrmGetActiveForm;
Font:=FntSetFont(LstGetSelection(GetFormObjPtr(frm,1625)));
ps:=FldGetTextPtr(GetFormObjPtr(frm,1601));
width:=FntCharsWidth(ps^,StrLen(ps^));
case LstGetSelection(GetFormObjPtr(frm,1615)) of
2,3 : width:=width+16;
// 3 : width:=width+15;
else width:=width+4;
end;
FntSetFont(Font);
InitDecimalField(frm,1608,width);
FldDrawField(GetFormObjPtr(frm,1608));
ControlDialogEventHandler:=true;
end;
end;
end
else ControlDialogEventHandler:=true;
popregs;
end;
function StyleLstGetSelection(ListP:ListPtr):ControlStyleType; inline(SYSTRAP,$A1B3);
procedure ControlDialog;
var frm : FormPtr;
pc : ^ControlType;
cont : ControlType;
begin
frm:=FrmInitForm(1600);
FrmSetEventHandler(frm,ControlDialogEventHandler);
if ObjectP<>nil then
begin
pc:=ObjectP;
MemMove(cont,pc^,sizeof(ControlType));//cont:=pc^;
end
else with cont do
begin
MemSet(cont,sizeof(ControlType),0);
end;
// objects initialisation
InitDecimalField(frm,1603,cont.bounds.topleft.y);
InitDecimalField(frm,1605,cont.bounds.topleft.x);
InitDecimalField(frm,1608,cont.bounds.extent.x);
InitDecimalField(frm,1610,cont.bounds.extent.y);
InitDecimalField(frm,1620,cont.id);
InitDecimalField(frm,1626,cont.group);
if cont.text=nil then
FarInitTextField(GetFormObjPtr(frm,1601),'',false)
else
FarInitTextField(GetFormObjPtr(frm,1601),cont.text^,false);
// usable
SetCheck(frm,1619,cont.attr shr 15);
// CtlSetValue(GetFormObjPtr(frm,1619),(cont.attr shr 15) and 1);
// selected
SetCheck(frm,1616,(cont.attr shr 12) and 1);
// CtlSetValue(GetFormObjPtr(frm,1616),(cont.attr shr 12) and 1);
// enabled
SetCheck(frm,1622,(cont.attr shr 14) and 1);
// CtlSetValue(GetFormObjPtr(frm,1622),(cont.attr shr 14) and 1);
// left anchor
SetCheck(frm,1623,(cont.attr shr 11) and 1);
// CtlSetValue(GetFormObjPtr(frm,1623),(cont.attr shr 11) and 1);
// drawn as selected
CtlSetValue(GetFormObjPtr(frm,1632),(cont.attr shr 7) and 1);
// frame type
SetListSel(frm,1618,(cont.attr shr 8) and 7);
// LstSetSelection(GetFormObjPtr(frm,1618),(cont.attr shr 8) and 7);
// font
SetListSel(frm,1625,cont.font);
// LstSetSelection(GetFormObjPtr(frm,1625),cont.font);
// style
SetListSel(frm,1615,ord(cont.style));
// LstSetSelection(GetFormObjPtr(frm,1615),ord(cont.style));
if FrmDoDialog(frm)=1611 then
begin
if ObjectP<>nil then MemPtrFree(pc^.Text)
else
begin
ObjectP:=MemPtrNew(sizeof(ControlType));
pc:=ObjectP;
MemSet(pc^,sizeof(ControlType),0);
end;
with pc^ do
begin // initialise fields
bounds.topleft.y:=GetDecimal(frm,1603);
bounds.topleft.x:=GetDecimal(frm,1605);
bounds.extent.x:=GetDecimal(frm,1608);
bounds.extent.y:=GetDecimal(frm,1610);
group:=GetDecimal(frm,1626);
Font:=LstGetSelection(GetFormObjPtr(frm,1625));
id:=GetDecimal(frm,1620);
attr:=
(GetCheck(frm,1619) shl 15)+
(GetCheck(frm,1616) shl 12)+
(GetCheck(frm,1622) shl 14)+
(GetCheck(frm,1623) shl 11)+
(GetCheck(frm,1632) shl 7)+
(GetListSel(frm,1618) shl 8);
style:=StyleLstGetSelection(GetFormObjPtr(frm,1615));
text:=GetNewTextField(frm,1601);
reserved:=0;
end;
end;
FrmDeleteForm(frm);
end;
//--------------------
// Popop Editor
//--------------------
function PopupDialogEventHandler(var event:eventType):boolean;
var frm : FormPtr;
begin
pushregs;
PopupDialogEventHandler:=false;
if event.etype=ctlSelectEvent then
if event.ctlSelect.ControlID=2802 then
begin
frm:=FrmGetActiveForm;
PopupDialogEventHandler:= not
(CheckField(frm,2803) and CheckField(frm,2806));
end;
popregs;
end;
procedure PopupDialog;
var frm:formPtr;
pp : ^FormPopupType;
pu : FormPopupType;
begin
frm:=FrmInitForm(2800);
FrmSetEventHandler(frm,PopupDialogEventHandler);
if ObjectP<>nil then
begin
pp:=ObjectP;
pu:=pp^;
end
else
begin
pu.ControlID:=0;
pu.ListID:=0;
end;
InitDecimalField(frm,2803,pu.ControlID);
InitDecimalField(frm,2806,pu.ListID);
if FrmDoDialog(frm)=2802 then
begin
if ObjectP=nil then
begin
ObjectP:=MemPtrNew(sizeof(FormPopupType));
pp:=ObjectP;
end;
with pp^ do
begin
controlID:=GetDecimal(frm,2803);
ListID:=GetDecimal(frm,2806);
end;
end;
FrmDeleteForm(frm);
end;
//--------------------
// Gadget dialog
//--------------------
function GadgetEventHandler(var event:eventType):boolean;
var frm : FormPtr;
begin
pushregs;
GadgetEventHandler:=false;
if event.etype=ctlSelectEvent then
if event.ctlSelect.ControlID=2802 then
begin
frm:=FrmGetActiveForm;
GadgetEventHandler:= not
(CheckField(frm,2902) and
CheckField(frm,2907) and
CheckField(frm,2904) and
CheckField(frm,2908) and
CheckField(frm,2910));
end;
popregs;
end;
procedure GadgetDialog;
var frm : FormPtr;
pg : ^FormGadgetType;
gd : FormGadgetType;
begin
frm:=FrmInitForm(2900);
FrmSetEventHandler(frm,GadgetEventHandler);
if ObjectP<>nil then
begin
pg:=ObjectP;
gd:=pg^;
end
else MemSet(gd,sizeof(FormGadgetType),0);
InitDecimalField(frm,2902,gd.rect.topleft.y);
InitDecimalField(frm,2904,gd.rect.topleft.x);
InitDecimalField(frm,2907,gd.rect.extent.x);
InitDecimalField(frm,2908,gd.rect.extent.y);
InitDecimalField(frm,2910,gd.id);
SetCheck(frm,2913,gd.attr shr 15);
SetCheck(frm,2914,(gd.attr shr 14) and 1);
if frmDoDialog(frm)=2911 then
begin
if ObjectP=nil then
begin
ObjectP:=MemPtrNew(sizeof(formGadgetType));
pg:=ObjectP;
MemSet(pg^,sizeof(formGadgetType),0); // v 1.04
end;
with pg^ do
begin
rect.topleft.y:=GetDecimal(frm,2902);
rect.topleft.x:=GetDecimal(frm,2904);
rect.extent.x:=GetDecimal(frm,2907);
rect.extent.y:=GetDecimal(frm,2908);
id:=GetDecimal(frm,2910);
attr:=
(GetCheck(frm,2913) shl 15) +
(GetCheck(frm,2914) shl 14) ;
end;
end;
FrmDeleteForm(frm);
end;
//----------------------
// Field dialog editor
//----------------------
function FieldEventHandler(var event:eventType):boolean;
var frm : FormPtr;
begin
pushregs;
FieldEventHandler:=false;
if event.eType=ctlSelectEvent then
if event.ctlSelect.ControlID=1819 then
begin
frm:=FrmGetActiveFOrm;
FieldEventHandler:= not (
CheckField(frm,1808) and
CheckField(frm,1806) and
CheckField(frm,1803) and
CheckField(frm,1810) and
CheckField(frm,1817) );
end;
popregs;
end;
procedure FieldDialog;
var
frm : FormPtr;
pf : ^FieldType;
fd : FieldType;
begin
frm:=FrmInitForm(1800);
FrmSetEventHandler(frm,FieldEventHandler);
if ObjectP<>nil then
begin
pf:=ObjectP;
fd:=pf^;
end
else MemSet(fd,sizeof(fieldtype),0);
InitDecimalField(frm,1808,fd.rect.topleft.y);
InitDecimalField(frm,1806,fd.rect.topleft.x);
InitDecimalField(frm,1803,fd.rect.extent.x);
InitDecimalField(frm,1802,fd.rect.extent.y);
InitDecimalField(frm,1810,fd.id);
InitDecimalField(frm,1817,fd.MaxChars);
SetCheck(frm,1814,(fd.attr shr 13) and 1); // editable
SetCheck(frm,1815,fd.attr shr 15); // usable
SetCheck(frm,1824,(fd.attr shr 10) and 1); // dynamic
setCheck(frm,1813,(fd.attr shr 6) and 1); // underline
setCheck(frm,1816,(fd.attr shr 1) and 1); //numeric
setCheck(frm,1823,(fd.attr shr 3) and 1); //autoshift
setCheck(frm,1812,(fd.attr shr 12) and 1); //singleline
setCheck(frm,1826,(fd.attr shr 2) and 1); //scrollbar
// alignement
SetListSel(frm,1825,(fd.attr shr 4) and 3);
// font
SetListSel(frm,1821,fd.font);
if FrmDoDialog(frm)=1819 then
begin
if ObjectP=nil then
begin
ObjectP:=MemPtrNew(sizeof(FieldType));
pf:=ObjectP;
MemSet(pf^,sizeof(FieldType),0); // v 1.04
end;
with pf^ do
begin
rect.topleft.y:=GetDecimal(frm,1808);
rect.topleft.x:=GetDecimal(frm,1806);
rect.extent.x:=GetDecimal(frm,1803);
rect.extent.y:=GetDecimal(frm,1802);
id:=GetDecimal(frm,1810);
MaxChars:=GetDecimal(frm,1817);
attr:=(GetCheck(frm,1814) shl 13) +
(GetCheck(frm,1815) shl 15) +
(GetCheck(frm,1824) shl 10) +
(GetCheck(frm,1813) shl 6) +
(GetCheck(frm,1816) shl 1) +
(GetCheck(frm,1823) shl 3) +
(GetCheck(frm,1812) shl 12) +
(GetCheck(frm,1826) shl 2) +
(GetListSel(frm,1827) shl 4);
font:=GetListSel(frm,1821);
end;
end;
FrmDeleteForm(frm);
end;
//---------------------
// Form Bitmap dialog
//---------------------
function FormBitmapEventHandler(var event:eventType):boolean;
var frm : FormPtr;
begin
pushregs;
FormBitmapEventHandler:=false;
if event.etype = ctlSelectEvent then
begin
if event.ctlSelect.ControlID=3008 then
begin
frm:=FrmGetActiveForm;
FormBitmapEventHandler:=not (
CheckField(frm,3003) and
CheckField(frm,3004) and
CheckField(frm,3006) );
end;
end;
popregs;
end;
procedure FormBitmapDialog;
var
frm : FormPtr;
pb : ^FormBitmapType;
bp : FormBitmapType;
begin
frm:=FrmInitForm(3000);
FrmSetEventHandler(frm,FormBitmapEventHandler);
if ObjectP<>nil then
begin
pb:=ObjectP;
bp:=pb^;
end
else MemSet(bp,sizeof(FormBitmapType),0);
InitDecimalField(frm,3003,bp.pos.y);
InitDecimalField(frm,3004,bp.pos.x);
InitDecimalField(frm,3006,bp.rscID);
SetCheck(frm,3007,bp.attr shr 15);
if FrmDoDialog(frm)=3008 then
begin
if ObjectP=nil then
begin
ObjectP:=MemPtrNew(sizeof(FormBitmapType));
pb:=ObjectP;
MemSet(pb^,sizeof(FormBitmapType),0); // v 1.04
end;
with pb^ do
begin
pos.y:=GetDecimal(frm,3003);
pos.x:=GetDecimal(frm,3004);
rscID:=GetDecimal(frm,3006);
attr:=GetCheck(frm,3007) shl 15;
end;
end;
FrmDeleteForm(frm);
end;
//-------------------
// List Dialog
//--------------------
//const sysFtrCreator=ord('p') shl 24+ord('s') shl 16+ord('y') shl 8+ord('s');
procedure ListCalcWidth;
var
frm : FormPtr;
itemsText:itemsTextPtr;
lst : ListPtr;
numItems : Int16;
i : Int16;
fnt : FontID;
width,t : UInt16;
ps : StringPtr;
begin
frm:=FrmGetActiveForm;
lst:=GetFormObjPtr(frm,2409);
itemsText:=LstGlueGetItemsText(lst);
numItems:=LstGetNumberOfItems(lst);
if numItems>0 then
begin
fnt:=LstGlueGetFont(lst);
width:=0;
for i:=0 to numItems-1 do
begin
ps:=ItemsText^[i];
t:=FntCharsWidth(ps^,StrLen(ps^));
if t>width then width:=t;
end;
width:=width+4;
InitDecimalField(frm,2612,width);
FldDrawField(GetFormObjPtr(frm,2612));
FntSetFont(fnt);
end
else bip;
end;
procedure ListNewItem;
var
buffer : string;
lst : ListPtr;
i : Int16;
itemsText : itemsTextPtr;
num : Int16;
begin
buffer:='';
lst:=GetFormObjPtr(FrmGetActiveForm,2409);
num:=LstGetnumberOfItems(lst);
if num<256 then
if farTextDialog('New Item',buffer,63,false) then
begin
i:=LstGetSelection(lst);
itemsText:=LstGlueGetItemsText(lst);
i:=i+1;
for i:=num-1 downto i do
itemsText^[i+1]:=itemsText^[i];
itemsText^[i]:=MemPtrNew(StrLen(buffer)+1);
itemsText^[i]^:=buffer;
LstSetListChoices(lst,itemsText,num+1);
LstSetSelection(lst,i);
LstDrawList(lst);
end;
end;
procedure ListEditItem;
var buffer : string;
lst : ListPtr;
sel : Int16;
itemsText:ItemsTextPtr;
begin
lst:=GetFormObjPtr(FrmGetActiveForm,2409);
sel:=LstGetSelection(lst);
if sel>=0 then
begin
itemsText:=LstGlueGetItemsText(lst);
buffer:=itemstext^[sel]^;
if FarTextDialog('Edit Item',buffer,63,false) then
begin
MemPtrFree(itemsText^[sel]);
itemsText^[sel]:=MemPtrNew(StrLen(buffer)+1);
itemsText^[sel]^:=buffer;
// I don't understand why the following line is required
LstSetListChoices(lst,itemstext,LstGetNumberOfItems(lst));
LstDrawList(lst);
end;
end
else bip;
end;
procedure ListDelItem;
var
lst : ListPtr;
itemsText : ItemsTextPtr;
num: Int16;
sel: Int16;
i : Int16;
begin
lst:=GetFormObjPtr(FrmGetActiveForm,2409);
itemsText:=LstGlueGetItemsText(lst);
num:=LstGetNumberOfItems(lst);
if num>0 then
begin
sel:=LstGetSelection(lst);
for i:=sel to num-2 do itemsText^[i]:=itemsText^[i+1];
num:=num-1;
LstSetListChoices(lst,itemsText,num);
if sel=num then LstSetSelection(lst,sel-1);
LstDrawList(lst);
end
else bip;
end;
function ListEventHandler(var event:eventType):boolean;
var
frm : FormPtr;
begin
pushregs;
ListEventHandler:=false;
if not farListHardButtonsEventHandler(event,ListEditItem) then
case event.eType of
ctlSelectEvent:
case event.ctlSelect.ControlID of
2601: // OK
begin
frm:=FrmGetActiveForm;
ListEventHandler:= not (
CheckField(frm,2607) and
CheckField(frm,2612) and
CheckField(frm,2608) and
CheckField(frm,2613) and
CheckField(frm,2619) );
end;
2621: // calc width
begin
ListCalcWidth;
ListEventHandler:=true;
end;
2618: // New
begin
ListNewItem;
ListEventHandler:=true;
end;
2617: // Del
begin
ListDelItem;
ListEventHandler:=true;
end;
// 2401: // Edit
// begin
// ListEditItem;
// ListEventHandler:=true;
// end;
end;
KeyDownEvent:;
end;
popregs;
end;
procedure ListDialog;
var
frm : FormPtr;
pl : ^ListType;
ls : ListType;
i : Int16;
ps1, ps2 : StringPtr;
begin
frm:=FrmInitForm(2600);
FrmSetEventHandler(frm,ListEventHandler);
if ObjectP<>nil then
begin
pl:=ObjectP;
ls:=pl^;
end
else MemSet(ls,sizeof(ListType),0);
InitDecimalField(frm,2607,ls.bounds.topleft.y);
InitDecimalField(frm,2608,ls.bounds.topleft.x);
InitDecimalField(frm,2612,ls.bounds.extent.x);
InitDecimalField(frm,2613,ls.bounds.extent.y);
InitDecimalField(frm,2619,ls.id);
SetCheck(frm,2614,ls.attr shr 15);
SetListSel(frm,2615,ls.font);
New(ls.itemsText); // allocate list of items ptr
for i:=0 to ls.numItems-1 do // copy texts if any
begin // not called for new list
ps1:=pl^.itemsText^[i];
ps2:=MemPtrNew(StrLen(ps1^)+1);
ps2^:=ps1^;
ls.itemsText^[i]:=ps2;// not called for new list
end;
LstSetListChoices(GetFormObjPtr(frm,2409),ls.itemsText,ls.numItems);
if FrmDoDialog(frm)=2601 then
begin
if ObjectP<>nil then
begin
// free old texts and itemstext
for i:=0 to pl^.numItems-1 do MemPtrFree(pl^.itemsText^[i]);
dispose(pl^.itemsText);
end
else
begin
ObjectP:=MemPtrNew(sizeof(ListType));
pl:=ObjectP;
MemSet(pl^,sizeof(ListType),0); // v 1.04
end;
with pl^ do
begin
itemsText:=ls.itemsText;
font:=GetListSel(frm,2615);
bounds.topleft.y:=GetDecimal(frm,2607);
bounds.topleft.x:=GetDecimal(frm,2608);
bounds.extent.x:=GetDecimal(frm,2612);
bounds.extent.y:=GetDecimal(frm,2613);
id:=GetDecimal(frm,2619);
attr:=GetCheck(frm,2614) shl 15;
numItems:=LstGetnumberOfItems(GetFormObjPtr(frm,2409));
end;
end;
FrmDeleteForm(frm);
end;
//-------------
// scroll Bar
//-------------
function ScrollBarEventHandler(var event:eventType):boolean;
var frm : FormPtr;
begin
pushregs;
ScrollBarEventHandler:=false;
if event.etype = ctlSelectEvent then
begin
if event.ctlSelect.ControlID=2719 then
begin
frm:=FrmGetActiveForm;
ScrollBarEventHandler:=not (
CheckField(frm,2701) and
CheckField(frm,2704) and
CheckField(frm,2707) and
CheckField(frm,2708) and
CheckField(frm,2710) and
CheckField(frm,2712) and
CheckField(frm,2714) and
CheckField(frm,2716) and
CheckField(frm,2720) );
end;
end;
popregs;
end;
procedure ScrollBarDialog;
var
frm : FormPtr;
ps : ^ScrollBarType;
sb : ScrollBarType;
begin
frm:=FrmInitForm(2700);
FrmSetEventHandler(frm,ScrollBarEventHandler);
if ObjectP<>nil then
begin
ps:=ObjectP;
sb:=ps^;
end
else MemSet(sb,sizeof(ScrollBarType),0);
InitDecimalField(frm,2701,sb.bounds.topleft.y);
InitDecimalField(frm,2704,sb.bounds.topleft.x);
InitDecimalField(frm,2707,sb.bounds.extent.x);
InitDecimalField(frm,2708,sb.bounds.extent.y);
InitDecimalField(frm,2710,sb.id);
InitDecimalField(frm,2712,sb.value);
InitDecimalField(frm,2714,sb.minvalue);
InitDecimalField(frm,2716,sb.maxvalue);
InitDecimalField(frm,2720,sb.pagesize);
SetCheck(frm,2717,sb.attr shr 15);
if FrmDoDialog(frm)=2719 then
begin
if ObjectP=nil then
begin
ObjectP:=MemPtrNew(sizeof(ScrollBarType));
ps:=ObjectP;
MemSet(ps^,sizeof(ScrollBarType),0); // v 1.04
end;
with ps^ do
begin
bounds.topleft.y:=GetDecimal(frm,2701);
bounds.topleft.x:=GetDecimal(frm,2704);
bounds.extent.y:=GetDecimal(frm,2708);
bounds.extent.x:=GetDecimal(frm,2707);
id:=GetDecimal(frm,2710);
value:=GetDecimal(frm,2712);
minvalue:=GetDecimal(frm,2714);
maxvalue:=GetDecimal(frm,2716);
pagesize:=GetDecimal(frm,2720);
attr:=GetCheck(frm,2717) shl 15;
end;
end;
FrmDeleteForm(frm);
end;
//-----------------------
// Table dialog
//-----------------------
const ColumnWidth = 'Column Width';
procedure TableEditCol;
var
buffer : string[9];
pc : TableColumnAttrsPtr;
sel : Int16;
lst : ListPtr;
begin
lst:=GetFormObjPtr(FrmGetActiveForm,2409);
sel:=LstGetSelection(lst);
if sel>=0 then
begin
pc:=LstGlueGetItemsText(lst);
StrIToA(buffer,pc^[sel].width);
if FarTextDialog(ColumnWidth,buffer,3,true) then
begin
pc^[sel].width:=StrAToI(buffer);
LstDrawList(lst);
end;
end;
end;
procedure TableNewCol;
var
buffer : String[9];
lst : ListPtr;
i,num : Int16;
pc : TableColumnAttrsPtr;
begin
buffer:='0';
lst:=GetFormObjPtr(FrmGetActiveForm,2409);
num:=LstGetNumberOfItems(lst);
if num<16 then
if FarTextDialog('Column Width',buffer,3,true) then
begin
i:=LstGetSelection(lst);
pc:=LstGlueGetItemsText(lst);
i:=i+1;
for i:=num-1 downto i do pc^[i+1]:=pc^[i];
pc^[i].width:=StrAToI(buffer);
LstSetListChoices(lst,pc,num+1);
LstSetSelection(lst,i);
LstDrawList(lst);
end;
end;
procedure TableDelCol;
var lst : ListPtr;
pc : TableColumnAttrsPtr;
num,sel,i : Int16;
begin
lst:=GetFormObjPtr(FrmGetActiveForm,2409);
pc:=LstGlueGetItemsText(lst);
num:=LstGetNumberOfItems(lst);
if num>0 then
begin
sel:=LstGetSelection(lst);
for i:=sel to num-2 do pc^[i]:=pc^[i+1];
num:=num-1;
LstSetListChoices(lst,pc,num);
if sel=num then LstSetSelection(lst,sel-1);
LstDrawList(lst);
end
else bip;
end;
function TableEventHandler(var event:eventType):boolean;
var
frm : FormPtr;
ps : StringPtr;
rows : Int16;
begin
pushregs;
TableEventHandler:=false;
if not farListHardButtonsEventHandler(event,TableEditCol) then
case event.etype of
ctlselectEvent:
case event.ctlSelect.ControlID of
3318:
begin
frm:=FrmGetActiveForm;
if CheckField(frm,3312) then
begin
ps:=FldGetTextPtr(GetFormObjPtr(frm,3312));
rows:=StrAToI(ps^);
if (rows<=0) or (rows>24) then
begin
TableEventHandler:=true;
bip;
FrmSetFocus(frm,FrmGetObjectIndex(frm,3312));
end
else TableEventHandler:= not (
CheckField(frm,3305) and
CheckField(frm,3301) and
CheckField(frm,3308) and
CheckField(frm,3309) );
end
else TableEventHandler:=true;
end;
// 2401: // edit
// begin
// TableEditCol;
// TableEventHandler:=true;
// end;
3316: // del
begin
TableDelCol;
TableEventHandler:=true;
end;
3317: // new
begin
TableNewCol;
TableEventHandler:=true;
end;
end;
end;
popregs;
end;
procedure TableListDrawItem(itemnum:Int16;var bounds:RectangleType;p:pointer);
var
pc : TableColumnAttrsPtr;
buffer : String[7];
begin
pushregs;
pc:=p;
StrVPrintf(buffer,'#%d',itemNum);
windrawchars(buffer,StrLen(buffer),bounds.topleft.x,bounds.topleft.y);
StrIToA(buffer,pc^[itemnum].width);
windrawchars(buffer,StrLen(buffer),bounds.topleft.x+30,bounds.topleft.y);
popregs;
end;
procedure TableDialog;
var
frm : FormPtr;
pt : ^TableType;
tb : TableType;
i : Int16;
lst : ListPtr;
k : Int16;
begin
frm:=FrmInitForm(3300);
FrmSetEventHandler(frm,TableEventHandler);
if ObjectP<>nil then
begin
pt:=ObjectP;
tb:=pt^;
end
else Memset(tb,sizeof(TableType),0);
// initialises attrs
new(tb.columnAttrs);
new(tb.rowAttrs);
new(tb.items);
if ObjectP<>nil then
begin
// MemMove(tb.columnAttrs^,pt^.columnAttrs,sizeof(TableColumnAttrType)*tb.numColumns);
for i:=0 to tb.numColumns-1 do tb.columnattrs^[i]:=pt^.columnAttrs^[i];
for i:=0 to tb.numRows-1 do tb.rowAttrs^[i]:=pt^.rowAttrs^[i];
for i:=0 to tb.numColumns*tb.numRows-1 do tb.items^[i]:=pt^.items^[i];
end
else
begin
MemSet(tb.columnAttrs^,sizeof(TableColumnAttrsType),0);
MemSet(tb.rowAttrs^,sizeof(TablerowAttrsType),0);
MemSet(tb.items^,sizeof(TableItemsType),0);
end;
// initialise fields
InitDecimalField(frm,3305,tb.bounds.topleft.y);
InitDecimalField(frm,3301,tb.bounds.topleft.x);
InitDecimalField(frm,3308,tb.bounds.extent.x);
InitDecimalField(frm,3303,tb.bounds.extent.y);
InitDecimalField(frm,3309,tb.id);
InitDecimalField(frm,3312,tb.numRows);
SetCheck(frm,3311,(tb.attr shr 14) and 1);
// initialise list
lst:=GetFormObjPtr(frm,2409);
LstSetDrawFunction(lst,TableListDrawItem);
LstSetListChoices(lst,tb.ColumnAttrs,tb.numColumns);
if FrmDoDialog(frm)=3318 then
begin
if ObjectP<>nil then
begin
MemPtrFree(pt^.columnAttrs);
MemPtrFree(pt^.rowAttrs);
MemPtrFree(pt^.items);
end
else
begin
new(pt);
ObjectP:=pt;
pt^:=tb;
end;
with pt^ do
begin
columnAttrs:=tb.columnAttrs;
rowAttrs:=tb.rowAttrs;
items:=tb.items;
bounds.topleft.y:=GetDecimal(frm,3305);
bounds.topleft.x:=GetDecimal(frm,3301);
bounds.extent.x:=GetDecimal(frm,3308);
bounds.extent.y:=GetDecimal(frm,3303);
id:=GetDecimal(frm,3309);
numRows:=GetDecimal(frm,3312);
numColumns:=LstGetNumberOfItems(lst);
attr:=GetCheck(frm,3311) shl 14;
// initialise row height
k:=bounds.extent.y div numRows;
for i:=0 to numRows-1 do rowAttrs^[i].height:=k;
end;
end;
FrmDeleteForm(frm);
end;
//------------------------
// Graphic control Dialog
//------------------------
function GraphicControlEventHandler(var event:eventType):boolean;
var
frm:FormPtr;
begin
pushregs;
GraphicControlEventHandler:=false;
if event.eType=ctlSelectEvent then
if event.ctlSelect.ControlID=4411 then
begin
frm:=FrmGetActiveForm;
GraphicControlEventHandler:= not (
CheckField(frm,4401) and
CheckField(frm,4403) and
CheckField(frm,4405) and
CheckField(frm,4408) and
CheckField(frm,4410) and
CheckField(frm,4426) and
CheckField(frm,4420) and
CheckField(frm,4424) );
end;
end;
procedure GraphicControlDialog;
var
frm : FormPtr;
pg : ^GraphicControlType;
gc : GraphicControlType;
lststyle,lstframe : ListPtr;
begin
frm:=FrmInitForm(4400);
FrmSetEventHandler(frm,GraphicControlEventHandler);
if ObjectP<>nil then
begin
pg:=ObjectP;
gc:=pg^;
end
else MemSet(gc,sizeof(GraphicControlType),0);
InitDecimalField(frm,4403,gc.bounds.topleft.y);
InitDecimalField(frm,4405,gc.bounds.topleft.x);
InitDecimalField(frm,4408,gc.bounds.extent.x);
InitDecimalField(frm,4410,gc.bounds.extent.y);
InitDecimalField(frm,4426,gc.group);
InitDecimalField(frm,4401,gc.id);
InitDecimalField(frm,4420,gc.BitmapID);
InitDecimalField(frm,4424,gc.SelectedBitmapID);
SetCheck(frm,4422,(gc.attr shr 14) and 1);
SetCheck(frm,4423,(gc.attr shr 11) and 1);
SetCheck(frm,4419, gc.attr shr 15);
SetCheck(frm,4416,(gc.attr shr 12) and 1);
lststyle:=GetFormObjPtr(frm,4415);
lstframe:=GetFormObjPtr(frm,4418);
LstSetSelection(lstframe,(gc.attr shr 8) and 7);
LstSetSelection(lststyle,ord(gc.style));
if FrmDoDialog(frm)=4411 then
begin
if ObjectP=nil then
begin
new(pg);
ObjectP:=pg;
end;
with pg^ do
begin
attr:=$40 + // graphical
(GetCheck(frm,4422) shl 14) +
(GetCheck(frm,4423) shl 11) +
(GetCheck(frm,4419) shl 15) +
(GetCheck(frm,4416) shl 12) +
(LstGetSelection(lstframe) shl 8);
id:=GetDecimal(frm,4401);
bounds.topleft.y:=GetDecimal(frm,4403);
bounds.topleft.x:=GetDecimal(frm,4405);
bounds.extent.x:=GetDecimal(frm,4408);
bounds.extent.y:=GetDecimal(frm,4410);
group:=GetDecimal(frm,4426);
BitmapID:=GetDecimal(frm,4420);
SelectedBitmapID:=GetDecimal(frm,4424);
style:=StyleLstGetSelection(lstStyle);
end;
end;
FrmDeleteForm(frm);
end;
//------------------------
// Slider ontrol Dialog
//------------------------
function SliderEventHandler(var event:eventType):boolean;
var
frm:FormPtr;
begin
pushregs;
SliderEventHandler:=false;
if event.eType=ctlSelectEvent then
if event.ctlSelect.ControlID=4511 then
begin
frm:=FrmGetActiveForm;
SliderEventHandler:= not (
CheckField(frm,4501) and
CheckField(frm,4503) and
CheckField(frm,4505) and
CheckField(frm,4508) and
CheckField(frm,4510) and
CheckField(frm,4520) and
CheckField(frm,4524) and
CheckField(frm,4528) and
CheckField(frm,4530) and
CheckField(frm,4517) and
CheckField(frm,4526) );
end;
popregs;
end;
procedure SliderDialog;
var frm : FormPtr;
ps : ^SliderControlType;
sc : SliderControlType;
begin
frm:=FrmInitForm(4500);
frmSetEventHandler(frm,SliderEventHandler);
if ObjectP<>nil then
begin
ps:=ObjectP;
sc:=ps^;
end
else MemSet(sc,sizeof(SliderControlType),0);
InitDecimalField(frm,4501,sc.id);
InitDecimalField(frm,4503,sc.bounds.topleft.y);
InitDecimalField(frm,4505,sc.bounds.topleft.x);
InitDecimalField(frm,4508,sc.bounds.extent.x);
InitDecimalField(frm,4510,sc.bounds.extent.y);
InitDecimalField(frm,4520,sc.thumbID);
InitDecimalField(frm,4524,sc.backgroundID);
InitDecimalField(frm,4528,sc.MinValue);
InitDecimalField(frm,4530,sc.MaxValue);
InitDecimalField(frm,4517,sc.PageSize);
InitDecimalField(frm,4526,sc.Value);
SetCheck(frm,4519,sc.attr shr 15);
SetCheck(frm,4516,(sc.attr shr 14) and 1);
SetCheck(frm,4514,ord(sc.style=FeedBackSliderCtl));
if frmDoDialog(frm)=4511 then
begin
if ObjectP=nil then
begin
new(ps);
ObjectP:=ps;
end;
with ps^ do
begin
id:=GetDecimal(frm,4501);
bounds.topleft.y:=GetDecimal(frm,4503);
bounds.topleft.x:=GetDecimal(frm,4505);
bounds.extent.x:=GetDecimal(frm,4508);
bounds.extent.y:=GetDecimal(frm,4510);
ThumbID:=GetDecimal(frm,4520);
BackgroundID:=GetDecimal(frm,4524);
MinValue:=GetDecimal(frm,4528);
MaxValue:=GetDecimal(frm,4530);
PageSize:=GetDecimal(frm,4517);
Value:=GetDecimal(frm,4526);
if GetCheck(frm,4514)=0 then style:=SliderCtl
else style:=FeedbackSliderCtl;
attr:=$40+ (GetCheck(frm,4519) shl 15) +
(GetCheck(frm,4516) shl 14);
// set vertical bit
if bounds.extent.x<bounds.extent.y then attr:=attr + $20;
end;
end;
frmDeleteForm(frm);
end;
// load form from pointer
//------------------------
// returns memory size of object
// data offset are relatve to base pointer
// absolute when loaded in memory
// resource based in resource
function SizeObject(object:FormObjectType;base:pointer):integer;
var s : integer;
pw : MemoryWord;
begin
case object.objectType of
frmFieldObj:s:=Sizeof(FieldType);
frmControlObj:
begin
pw.p:=base;
object.w.i:=object.w.i+pw.i;
if (object.control^.style=SliderCtl) or
(object.control^.style=FeedbackSliderCtl) then
s:=sizeof(SliderControlType)
else s:=Sizeof(ControlType);
end;
frmListObj:s:=Sizeof(ListType);
frmTableObj:s:=Sizeof(TableType);
frmBitmapObj:s:=Sizeof(FormBitmapType);
frmLabelObj:s:=Sizeof(FormLabelType);
frmTitleObj:s:=Sizeof(FormTitleType);
frmPopupObj:s:=Sizeof(FormPopupType);
frmGraffitiStateObj:s:=Sizeof(frmGraffitiStateType);
frmGadgetObj:s:=Sizeof(FormGadgetType);
frmScrollbarObj:s:=Sizeof(ScrollBarType);
end;
SizeObject:=s;
end;
function GetFormTitle(p:pointer):StringPtr;
label 10;
var pw,pv : MemoryWord;
pf : ^FormType;
pa : FormObjArrayPtr;
i : Int16;
begin
pv.p:=p;
pf:=p;
pw.i:=pv.i+SizeOf(FormType);
pa:=pw.p;
for i:=0 to pf^.numObjects-1 do with pa^[i] do
begin
if objectType=frmTitleObj then
begin
pw.i:=pv.i+w.i+sizeof(FormTitleType);
GetFormTitle:=pw.p;
goto 10;
end;
end;
GetFormTitle:=nil;
10:
end;
// set name of the object
procedure ObjectName(var name:string;const object:FormObjectType);
label 10,11;
begin
if object.objectType=frmControlObj then
case object.control^.style of
SliderCtl: goto 10;
FeedbackSliderCtl : goto 10;
else
begin
if (object.control^.attr and $0040)<>0 then
name:='Graphic' else
// goto 11;
10: name:=ControlNames[object.control^.style];
end;
end
else 11: name:=FormObjectsNames[object.objectType];
end;
// return object ID $ffff if none
function ObjectID(const obj:FormObjectType):UInt16;
begin
case obj.objectType of
frmTitleObj,frmGraffitiStateObj,frmPopupObj:
ObjectID:=$ffff;
frmBitmapObj:
begin
ObjectID:=obj.bitmap^.RscID;
end;
frmScrollBarObj:
begin
ObjectID:=obj.scrollbar^.id;
end;
else
begin
ObjectID:=obj.control^.id;
end;
end;
end;
// callback list drawing item procedure
procedure ControlListDraw(itemnum:Int16;var bounds:RectangleType;p:pointer);
//label 10;
var pf : ^FormType;
buffer : string[15];
obj : FormObjectType;
id : UInt16;
x : Coord;
begin
pushregs;
pf:=p;
obj:=pf^.Objects^[itemnum];
ObjectName(buffer,obj);
WinDrawChars(buffer,StrLen(buffer),bounds.topleft.x,bounds.topleft.y);
id:=ObjectID(obj);
if id<>$ffff then
begin
// case obj.objectType of
// frmTitleObj,frmGraffitiStateObj,frmPopupObj:;
// frmBitmapObj:
// begin
// id:=obj.bitmap^.RscID;
// goto 10;
// end;
// frmScrollBarObj:
// begin
// id:=obj.scrollbar^.id;
// goto 10;
// end;
// else
// begin
// Id:=obj.control^.id;
//10:
if bounds.topleft.x+bounds.extent.x<83 then
begin
buffer:='...';
x:=73;
end
else
begin
StrIToA(buffer,id);
x:=bounds.topleft.x+84-5*StrLen(buffer);
end;
WinDrawChars(buffer,StrLen(buffer),x,bounds.topleft.y);
end;
popregs;
end;
// pd (dest) and ps (source) are pointer to Form object
// initialise data field of pd with those from ps
function InitObject(var d : FormObjectType;s:pointer):FormObjectPtr;
var pw : MemoryWord;
ps : StringPtr;
i : Int16;
size : integer;
begin
pw.p:=s;
case d.objectType of
FrmTitleObj: with d.title^ do
begin
pw.i:=pw.i+SizeOf(FormTitleType);
text:=MemPtrNew(StrLen(pw.ps^)+1);
if text<>nil then text^:=pw.ps^;
end;
FrmLabelObj: with d.FormLabel^ do
begin
pw.i:=pw.i+SizeOf(FormLabelType);
text:=MemPtrNew(length(pw.ps^)+1);
if text<>nil then text^:=pw.ps^;
end;
FrmControlObj: with d.control^ do
if (attr and $0040)=0 then
begin // for non graphic controls only
pw.i:=pw.i+SizeOf(ControlType);
text:=MemPtrNew(length(pw.ps^)+1);
if text<>nil then text^:=pw.ps^;
end;
FrmTableObj: with d.table^ do
begin
new(columnAttrs);
new(rowAttrs);
new(items);
pw.i:=pw.i+Sizeof(TableType);
size:=numColumns*sizeof(TableColumnAttrType);
if size>0 then MemMove(columnAttrs^,pw.p^,size);
pw.i:=pw.i+size;
size:=numRows*sizeof(TableRowAttrType);
if size>0 then MemMove(rowAttrs^,pw.p^,size);
pw.i:=pw.i+size;
size:=numRows*numColumns*sizeof(TableItemType);
if size>0 then MemMove(items^,pw.p^,size);
end;
FrmListObj: with d.list^ do
begin
new(itemsText);
if itemsText<>nil then
begin
pw.i:=pw.i+Sizeof(ListType)+numItems*4;
// MOTOS : numItems>256 not checked !!!
for i:=0 to numItems-1 do
begin
ps:=MemPtrNew(length(pw.ps^)+1);
if ps<>nil then ps^:=pw.ps^;
itemsText^[i]:=ps;
pw.i:=pw.i+length(pw.ps^)+1;
end;
end;
end;
end;
end;
// free title handle of object po
procedure FreeObj(var o:FormObjectType);
var i : Int16;
begin
// free components of the object
case o.objectType of
FrmTitleObj:
MemPtrFree(o.title^.text);
FrmControlObj: with o.control^ do
if (attr and $0040)=0 then MemPtrFree(text);
FrmLabelObj:
MemPtrFree(o.formLabel^.text);
FrmListObj: with o.list^ do
begin
for i:=0 to numItems-1 do
MemPtrFree(itemsText^[i]);
dispose(itemsText);
end;
FrmTableObj: with o.table^ do
begin
dispose(columnAttrs);
dispose(rowAttrs);
dispose(items);
end;
end;
// free the object itself
if o.w.p<>nil then MemPtrFree(o.w.p);
end;
// load object in memory from resource
// dest is the object destination
// p is base object data destination
function LoadObject(var dst:FormObjectType;const src:FormObjectType;base : pointer):pointer;
var s : integer;
q : pointer;
w : MemoryWord;
begin
dst.objectType:=src.objectType;
s:=SizeObject(src,base);
q:=MemPtrNew(s);
dst.w.p:=q;
// compute data origin data
w.p:=base;
w.i:=w.i+src.w.i;
// copy object
MemMove(q^,w.p^,s);
// initialise additional data (text, etc.)
InitObject(dst,w.p);
end;
procedure LoadFormPtr(p : pointer);
label 99;
var
pf,qf : ^FormType;
pObjs, qObjs : FormObjArrayPtr;
w : MemoryWord;
num : UInt16;
i : Int16;
// s : integer;
// q : pointer;
begin
qf:=p;
// allocate form
New(pf);
DataPointer:=pf;
if pf=nil then goto 99;
num:=qf^.numObjects;
MemMove(pf^,qf^,SizeOf(FormType));
// allocate objects table
New(pObjs);
if pObjs=nil then goto 99;
pf^.objects:=pObjs;
w.p:=p;
w.i:=w.i+sizeof(FormType);
qObjs:=w.p;
// initialise objects table
for i:=0 to num-1 do
begin
LoadObject(pObjs^[i],qObjs^[i],p);
end;
99:
end;
procedure NewForm;
var pf :^FormType;
pObjs :FormObjArrayPtr;
begin
new(pf);
MemSet(pf^,Sizeof(FormType),0);
if pf<>nil then new(pf^.objects);
DataPointer:=pf;
end;
// set control title in apropriate field
procedure ControlTitle(redraw:boolean);
var
sel : Int16;
pf :^FormType;
begin
pf:=DataPointer;
sel:=LstGetSelection(GetObjPtr(2409));
if sel>=0 then with pf^.objects^[sel] do
begin
case objectType of
FrmControlObj: with control^ do
if (attr and $0040)=0 then
begin
FldSetFont(GetObjPtr(1525),font);
InitTextFieldID(1525,control^.text^,redraw);
end;
FrmTitleObj:
begin
FldSetFont(GetObjPtr(1525),0);
InitTextFieldID(1525,title^.text^,redraw);
end;
FrmLabelObj: with FormLabel^ do
begin
FldSetFont(GetObjPtr(1525),font);
InitTextFieldID(1525,text^,redraw);
end;
else InitTextFieldID(1525,'',redraw);
end;
end
else InitTextFieldID(1525,'',redraw);
end;
procedure LoadForm;
var
lst : ListPtr;
pf : ^FormType;
num : Int16;
buffer : string[9];
pw : MemoryWord;
k : Int16;
begin
if DataMemPtr<>nil then
begin // if restaured from feature memory
LoadFormPtr(DataMemPtr);
DataMemPtr:=nil;
FarFtrMemFree(1);
end
else if DataHandle<>nil then
begin // of open existing resource
LoadFormPtr(MemHandleLock(DataHandle));
MemHandleUnlock(DataHandle);
end
else
begin // if new resource
NewForm;
end;
// initialise controls
lst:=GetObjPtr(2409);
pf:=DataPointer;
num:=pf^.numObjects;
LstSetListChoices(lst,DataPointer,num);
LstSetDrawFunction(lst,ControlListDraw);
LstSetSelection(lst,-ord(num=0));
// modal CheckBox
CtlSetValue(GetObjPtr(1514),(pf^.window.windowflags shr 13) and 1);
// usable CheckBox
CtlSetValue(GetObjPtr(1513),(pf^.attr shr 31) and 1);
// Savebehind checkbox
CtlSetValue(GetObjPtr(1515),(pf^.attr shr 27) and 1);
// top field
StrIToA(buffer,pf^.window.windowbounds.topleft.y);
InitTextFieldID(1503,buffer,false);
// left field
StrIToA(buffer,pf^.window.windowbounds.topleft.x);
InitTextFieldID(1505,buffer,false);
// width field
StrIToA(buffer,pf^.window.windowbounds.extent.x);
InitTextFieldID(1508,buffer,false);
// height field
StrIToA(buffer,pf^.window.windowbounds.extent.y);
InitTextFieldID(1510,buffer,false);
// Default button
StrIToA(buffer,pf^.defaultButton);
InitTextFieldID(1521,buffer,false);
// Menu bar ID
StrIToA(buffer,pf^.menuRscID);
InitTextFieldID(1520,buffer,false);
// helpID
StrIToA(buffer,pf^.helpRscID);
InitTextFieldID(1519,buffer,false);
// frame field
pw.p:=StrIToH(buffer,pf^.window.frameType);
pw.i:=pw.i+4;
InitTextFieldID(1526,pw.ps^,false);
// title
ControlTitle(false);
// frame popup
case pf^.window.frameType of
$0 : k:=0;
1 : k:=1;
$401 : k:=2;
$702 : k:=3;
$205 : k:=4;
$302 : k:=5;
else k:=-1;
end;
LstSetSelection(GetObjPtr(1527),k);
end;
procedure FreeForm;
var pf : ^FormType;
pObjs : FormObjArrayPtr;
i : Int16;
begin
pf:=DataPointer;
pObjs:=pf^.objects;
for i:=0 to pf^.NumObjects-1 do FreeObj(pObjs^[i]);
MemPtrFree(pObjs);
MemPtrFree(pf);
end;
// returns true size of object obj
// including additionnal data (text, etc.)
// defined in resource
function TrueObjectSize(const obj:FormObjectType):UInt16;
var
ts : UInt16;
j : Int16;
begin
ts:=SizeObject(obj,nil);
with obj do
case ObjectType of
frmControlObj: with control^ do
begin
if (attr and $0040)=0 then ts:=ts+StrLen(text^)+1;
end;
frmTitleObj: with title^ do
begin
ts:=ts+StrLen(text^)+1;
end;
frmLabelObj: with FormLabel^ do
begin
ts:=ts+StrLen(text^)+1;
end;
frmTableObj: with table^ do
begin
ts:=ts+numColumns*sizeof(TableColumnAttrType)+
numRows*sizeof(TableRowAttrType)+
numRows*numColumns*sizeof(TableItemType);
end;
frmListObj: with list^ do
begin
ts:=ts+numItems*4;
for j:=0 to numItems-1 do
ts:=ts+StrLen(itemsText^[j]^)+1;
end;
end;
ts:=ts+(ts and 1); // word alignement
TrueObjectSize:=ts;
end;
// returns total size of compacted form
function TotalSize:Uint16;
var
ts : UInt16;
pf : ^FormType;
i : Int16;
begin
pf:=DataPointer;
ts:=Sizeof(FormType)+6*pf^.numobjects;
for i:=0 to pf^.numObjects-1 do with pf^.objects^[i] do
begin
ts:=ts+TrueObjectSize(pf^.objects^[i]);
end;
//intalert(ts);
TotalSize:=ts;
end;
// write object obj to storage pointer p[offset]
// returns new offset
function WriteObject(p:pointer;offset:integer;const obj:FormObjectType):integer;
var
size:integer;
j : Int16;
begin
size:=SizeObject(obj,nil);
DmWrite(p,offset,obj.w.p,size);
offset:=offset+size;
// additionnal data
with obj do
case objectType of
frmControlObj: with control^ do
if (attr and $0040)=0 then
begin
// clear text pointer
DmSet(p,offset-10,4,0);
// string
size:=StrLen(text^)+1;
DmWrite(p,offset,text,size);
offset:=offset+size;
end;
frmTitleObj: with title^ do
begin
// clear text pointer
DmSet(p,offset-4,4,0);
// string
size:=StrLen(text^)+1;
DmWrite(p,offset,text,size);
offset:=offset+size;
end;
frmLabelObj: with FormLabel^ do
begin
// clear text pointer
DmSet(p,offset-4,4,0);
// string
size:=StrLen(text^)+1;
DmWrite(p,offset,text,size);
offset:=offset+size;
end;
frmTableObj: with table^ do
begin
// clear pointers
DmSet(p,offset-12-sizeof(FieldType),12,0);
// copy column attrs
size:=numColumns*sizeof(TableColumnAttrType);
DmWrite(p,offset,columnAttrs,size);
offset:=offset+size;
size:=numRows*sizeof(TableRowAttrType);
DmWrite(p,offset,rowattrs,size);
offset:=offset+Size;
size:=numRows*numColumns*sizeof(tableItemType);
DmWrite(p,offset,items,size);
offset:=offset+Size;
end;
frmListObj: with list^ do
begin
// clear itemsText pointer
DmSet(p,offset-20,4,0);
// clear itemsText table
size:=numItems*4;
if size>0 then DmSet(p,offset,size,0);
offset:=offset+size;
// write item's texts
for j:=0 to numItems-1 do
begin
size:=StrLen(itemstext^[j]^)+1;
DmWrite(p,offset,itemsText^[j],size);
offset:=offset+size;
end;
end;
end;
if odd(offset) then
begin
DmSet(p,offset,1,0);
offset:=offset+1;
end;
WriteObject:=offset;
end;
// write form to storage pointer
procedure writeForm(p:pointer);
var
offset,size : integer;
pf : ^FormType;
i,j : Int16;
begin
offset:=0;
pf:=DataPointer;
// form but objects pointer
size:=SizeOf(FormType)-4;
DmWrite(p,0,pf,size);
offset:=offset+size;
// objects ptr
DmSet(p,offset,4,0);
offset:=offset+4;
// objects table
size:=6*pf^.NumObjects;
if size<>0 then
begin
DmWrite(p,Offset,pf^.objects,size);
offset:=offset+size;
end;
// objects
for i:=0 to pf^.NumObjects-1 do
begin
// write offset
DmWrite(p,sizeof(FormType)+2+6*i,@offset,4);
// write object
offset:=writeObject(p,offset,pf^.objects^[i]);
{
size:=SizeObject(pf^.objects^[i],nil);
DmWrite(p,offset,pf^.objects^[i].w.p,size);
offset:=offset+size;
// additionnal data
with pf^.objects^[i] do
case objectType of
frmControlObj: with control^ do
if (attr and $0040)=0 then
begin
// clear text pointer
DmSet(p,offset-10,4,0);
// string
size:=StrLen(text^)+1;
DmWrite(p,offset,text,size);
offset:=offset+size;
end;
frmTitleObj: with title^ do
begin
// clear text pointer
DmSet(p,offset-4,4,0);
// string
size:=StrLen(text^)+1;
DmWrite(p,offset,text,size);
offset:=offset+size;
end;
frmLabelObj: with FormLabel^ do
begin
// clear text pointer
DmSet(p,offset-4,4,0);
// string
size:=StrLen(text^)+1;
DmWrite(p,offset,text,size);
offset:=offset+size;
end;
frmTableObj: with table^ do
begin
// clear pointers
DmSet(p,offset-12-sizeof(FieldType),12,0);
// copy column attrs
size:=numColumns*sizeof(TableColumnAttrType);
DmWrite(p,offset,columnAttrs,size);
offset:=offset+size;
size:=numRows*sizeof(TableRowAttrType);
DmWrite(p,offset,rowattrs,size);
offset:=offset+Size;
size:=numRows*numColumns*sizeof(tableItemType);
DmWrite(p,offset,items,size);
offset:=offset+Size;
end;
frmListObj: with list^ do
begin
// clear itemsText pointer
DmSet(p,offset-20,4,0);
// clear itemsText table
size:=numItems*4;
if size>0 then DmSet(p,offset,size,0);
offset:=offset+size;
// write item's texts
for j:=0 to numItems-1 do
begin
size:=StrLen(itemstext^[j]^)+1;
DmWrite(p,offset,itemsText^[j],size);
offset:=offset+size;
end;
end;
end;
if odd(offset) then
begin
DmSet(p,offset,1,0);
offset:=offset+1;
end;
}
end;
end;
// get uint16 data in field id
function getDecimalData(id:UInt16):UInt16;
var ind : UInt16;
ps : StringPtr;
begin
ind:=FrmGetObjectIndex(ActiveForm,id);
ps:=FldGetTextPtr(FrmGetObjectPtr(ActiveForm,ind));
if (ps=nil) or (ps^='') then
begin
Bip;
frmSetFocus(ActiveForm,FrmGetObjectIndex(ActiveForm,id));
fldDrawField(getObjPtr(id));
exit(0);
end;
getDecimalData:=StrAToI(ps^);
end;
function getHexaData(id : UInt16):UInt16;
var i : integer;
begin
if not farGetHexaField(GetObjPtr(id),i) then
begin
Bip;
frmSetFocus(ActiveForm,FrmGetObjectIndex(ActiveForm,id));
fldDrawField(getObjPtr(id));
exit(0);
end;
GetHexaData:=i;
end;
// save data
procedure FormSaveData;
var pf : ^FormType;
ps : StringPtr;
fld : FieldPtr;
begin
pf:=DataPointer;
// top
pf^.window.windowbounds.topleft.y:=GetDecimalData(1503);
// left
pf^.window.windowbounds.topleft.x:=GetDecimalData(1505);
//width
pf^.window.windowbounds.extent.x:=GetDecimalData(1508);
//height
pf^.window.windowbounds.extent.y:=GetDecimalData(1510);
// default button
pf^.defaultButton:=GetDecimalData(1521);
// MenubarID
pf^.menuRscID:=GetDecimalData(1520);
// Help ID
pf^.helpRscID:=GetDecimalData(1519);
// frame
pf^.window.FrameType:=GetHexaData(1526);
// modal check box
if CtlGetValue(GetObjPtr(1514))=0 then
pf^.window.windowflags:=pf^.window.windowflags and not (1 shl 13)
else
pf^.window.windowflags:=pf^.window.windowflags or (1 shl 13);
// usable check box
if CtlGetValue(GetObjPtr(1513))=0 then
pf^.attr:=pf^.attr and not (1 shl 31)
else
pf^.attr:=pf^.attr or (1 shl 31);
// SaveBehind
if CtlGetValue(GetObjPtr(1515))=0 then
pf^.attr:=pf^.attr and not (1 shl 27)
else
pf^.attr:=pf^.attr or (1 shl 27);
// set form id
pf^.formID:=ResID;
end;
// copy resource from srddb to dstdb
procedure CopyResource(dstdb,srcdb:DmOpenRef;restype:UInt32;resid:UInt16);
label 99;
var
s : integer;
srcH,dstH : MemHandle;
ind : UInt16;
rt : soruType;
buffer : string[7];
begin
if resid>=10000 then goto 99;
SrcH:=nil;
ind:=DmFindResource(srcdb,resType,ResID,nil);
if Ind<>$ffff then
srcH:=DmGetResourceIndex(srcdb,Ind);
if srcH=nil then
begin
rt.u:=restype;
rt.s[5]:=chr(0);
StrIToA(buffer,resID);
FrmCustomAlert(1200,rt.s,buffer,nil);
exit(0);
end;
s:=MemHandleSize(srcH);
dstH:=DmNewResource(dstdb,restype,resid,s);
if dstH=nil then exit(0);
DmWrite(MemHandleLock(dstH),0,MemHandleLock(srcH),s);
MemHandleUnlock(dstH);
MemHandleUnlock(srcH);
DmReleaseResource(srcH);
DmReleaseResource(dstH);
99:
end;
function AddRequiredResources(dstdb,srcdb:dmOpenref):boolean;
var pf : ^FormType;
i : Int16;
begin
tag;
pf:=DataPointer;
with pf^ do
begin
// add Help string if any
if HelpRscID<>0 then
CopyResource(dstdb,srcdb,strRsc,pf^.HelprscID);
// add menubar resource
if menurscID<>0 then
CopyResource(dstdb,srcdb,MenuRscType,pf^.MenuRscID);
// search for required bitmap
for i:=0 to numObjects-1 do with objects^[i] do
begin
case ObjectType of
FrmBitmapObj:
// if bitmap^.rscID<10000 then
CopyResource(dstdb,srcdb,bitmaprsc,bitmap^.rscID);
FrmControlObj: with control^ do
if (attr and $40)<>0
then
if (style<SliderCtl) then with graphicControl^ do
begin
if BitmapID<>0 then
CopyResource(dstdb,srcdb,bitmaprsc,BitmapID);
if selectedBitmapID<>0 then
CopyResource(dstdb,srcdb,bitmaprsc,SelectedBitmapID);
end
else with slidercontrol^ do
begin
if ThumbID<>0 then
CopyResource(dstdb,srcdb,bitmaprsc,ThumbID);
if backgroundID<>0 then
CopyResource(dstdb,srcdb,bitmaprsc,backgroundID);
end;
end;
end;
end;
AddRequiredResources:=true;
end;
// returns true if object id exists in form
function IDExists(id:UInt16):boolean;
label 99;
var
pf : ^FormType;
j : Int16;
begin
IDExists:=true;
pf:=DataPointer;
with pf^ do
begin
for j:=0 to numObjects-1 do with objects^[j] do
case ObjectType of
FrmBitmapObj,
frmTitleObj,
frmPopupObj,
frmGraffitiStateObj:;
frmScrollBarObj:if id=ScrollBar^.id then goto 99;
else if id=control^.id then goto 99;
end;
end;
IDExists:=false;
99:
end;
procedure FormPreview(function EventHandler(var event:eventType):boolean);
label 99,98;
var
pf :^FormType;
HelpH : MemHandle;
h : MemHandle;
db : dmOpenRef;
s : integer;
lid : LocalID;
id : UInt16;
frm : FormPtr;
rec : RectangleType;
begin
tag;
pf:=DataPointer;
FormSaveData;
// set usable bit
pf^.Attr:=pf^.Attr or (1 shl 31);
opendb:=DmOpenDatabase(0,seldbid,dmModeReadOnly);
// open temporary database
lid:=DmFindDatabase(0,dbName);
if lid<>0 then DmDeleteDatabase(0,lid);
if DmCreateDatabase(0,dbName,AppCreatorID,TempID,true)<>0 then goto 99;
lid:=DmFindDatabase(0,dbName);
db:=DmOpenDatabase(0,lid,dmModeReadWrite);
s:=TotalSize;
h:=DmNewResource(db,FormRscType,9999,s);
if h=nil then goto 98;
WriteForm(MemHandleLock(h));
MemHandleUnlock(h);
// add required resources if any
if not AddRequiredResources(db,opendb) then goto 98;
//search for a free id for additionnal control
// id:=9999;
// repeat id:=id+1 until not IDExists(id);
Frm:=FrmInitForm(9999);
// DummyCtl:=CtlNewControl(Frm,10000,ButtonCtl,nil,-1,-1,1,1,0,0,false);
// SetDia(frm,true);
FrmSetEventHandler(frm,EventHandler);
// SetDia(frm,true);
RctSetRectangle(rec,0,0,160,160);
WinEraseRectangle(rec,0);
// FrmDoDialog(frm);
PreviewDialog(frm);
// SetDia(frm,true);
// reload form
{ FreeForm;
LoadFormPtr(MemHandleLock(h));
MemHandleUnlock(h);}
DmReleaseResource(h);
FrmDeleteForm(frm);
FrmDrawForm(ActiveForm);
// SetDia(ActiveForm,true);
98:
// close database
DmCloseDatabase(opendb);
opendb:=nil;
DmCloseDatabase(db);
DmDeleteDatabase(0,lid);
99:
end;
// response to 'Del' button
procedure FormDel;
var
pf : ^FormType;
sel : Int16;
buff1 : string[15];
buff2 : string[7];
id : UInt16;
pobj : ^FormObjectType;
i : Int16;
lst : ListPtr;
begin
pf:=DataPointer;
lst:=GetObjPtr(2409);
sel:=LstGetSelection(lst);
if (sel>=0) and not readonlydb then
begin
pobj:=@pf^.objects^[sel];
ObjectName(buff1,pobj^);
id :=ObjectID(pobj^);
buff2:='';
if id<>$ffff then StrIToA(buff2,id);
if FrmCustomAlert(1600,nil,buff1,buff2)=0 then
begin // delete object
FreeObj(pObj^);
// remove from table
for i:=sel+1 to pf^.numObjects-1 do
pf^.objects^[i-1]:=pf^.objects^[i];
// update number of objects
pf^.numObjects:=pf^.numObjects-1;
LstSetListChoices(lst,DataPointer,pf^.numObjects);
// update selection
if sel=pf^.NumObjects then
begin
LstSetSelection(lst,sel-1);
end;
// redraw list
ControlTitle(true);
LstDrawList(lst);
end;
end;
end;
// response to frame popup list
procedure FormFrame(no:Int16);
var
pf:^FormType;
pw : MemoryWord;
buffer : String[9];
begin
pf:=DataPointer;
case no of
0: // no frame
pf^.window.frameType:=$0;
1: // simple frame
pf^.window.frameType:=$1;
2: // round
pf^.window.frameType:=$401;
3: // boldround
pf^.window.frameType:=$702;
4: // popup
pf^.window.frameType:=$205;
5: // dialog
pf^.window.frameType:=$302;
end;
pw.p:=StrIToH(buffer,pf^.window.frametype);
pw.i:=pw.i+4;
InitTextFieldID(1526,pw.ps^,true);
end;
// returns true if there is two objects with the same id
// in this case, assign id
// else returns false
function DuplicateID(var id:UInt16):boolean;
label 99;
var pf : ^FormType;
i,j : Int16;
begin
DuplicateID:=true;
pf:=DataPointer;
with pf^ do
begin
for i:=0 to numObjects-1 do with Objects^[i] do
begin
case ObjectType of
FrmBitmapObj,
frmTitleObj,
frmPopupObj,
frmGraffitiStateObj:id:=$ffff;
frmScrollBarObj:id:=ScrollBar^.id;
else id:=control^.id;
end;
if id<>$ffff then
for j:=i+1 to numObjects-1 do with objects^[j] do
case ObjectType of
FrmBitmapObj,
frmTitleObj,
frmPopupObj,
frmGraffitiStateObj:;
frmScrollBarObj:if id=ScrollBar^.id then goto 99;
else if id=control^.id then goto 99;
end;
end;
end;
DuplicateID:=false;
99:
end;
// response to OK button
procedure FormOK;
label 98,99;
var ind : UInt16; // old resource index
s : integer;
h : MemHandle;
id : UInt16;
buffer : string[7];
begin
if readonlydb then goto 98;
if DuplicateID(id) then
begin
StrIToA(buffer,id);
if FrmCustomAlert(1300,buffer,nil,nil)<>0 then goto 99;
end;
FormSaveData;
// opendb
opendb:=DmOpenDatabase(0,seldbid,dmModeReadWrite);
ind:=DmFIndResource(opendb,resType,resID,nil);
// remove old resource if any
if not Prefs.WasNew then DmRemoveResource(opendb,ind);
// create new resource
s:=TotalSize;
h:=DmNewResource(opendb,resType,resID,s);
if h=nil then goto 98;
WriteForm(MemHandleLock(h));
MemHandleUnlock(h);
// prepare for resource list selection
selrec:=-1;
selRsrcInd:=DmFindResource(opendb,0,0,h);
DmReleaseResource(h);
DmCloseDatabase(opendb);
opendb:=nil;
FrmGotoForm(1100);
goto 99;
98:
Bip;
99:
end;
// response to 'Open' button
procedure FormOpen;
var
pf : ^FormType;
sel : Int16;
pc : ^ControlType;
begin
pf:=DataPointer;
sel:=LstGetSelection(GetObjPtr(2409));
if sel >=0 then
begin
objectP:=pf^.objects^[sel].w.p;
case pf^.objects^[sel].objectType of
frmFieldObj: // field
FieldDialog;
frmControlObj: // control
begin
pc:=pf^.objects^[sel].w.p;
if pc^.style>=sliderCtl then SliderDialog
else if (pc^.attr and (1 shl 6))=0 then ControlDialog
else GraphicControlDialog;
end;
frmListObj: // list
ListDialog;
frmTableObj: // table
TableDialog;
frmBitmapObj: // Form bitmap
FormBitmapDialog;
frmLabelObj: // Label
LabelDialog;
frmTitleObj: // title
TitleDialog;
frmPopupObj: // popup
PopupDialog;
frmGraffitiStateObj: // GraffitiState
GraffitiStateDialog;
frmGadgetObj:
GadgetDialog;
frmScrollBarObj: // Scrollbar
ScrollBarDialog;
end;
ControlTitle(true);
end;
LstDrawList(GetObjPtr(2409));
end;
// Form objects clipboard opearations
//-----------------------------------
// objects are memorised in feature memory
// number 4
// format
// object : FormObjectType with relative reference (offse 6)
// data
//
// copy object
function FormObjCopy:boolean;
label 99;
var
obj : FormObjectType;
ss : string;
s : integer;
pf : ^FormType;
sel : Int16;
p : pointer;
begin
FormObjCopy:=false;
// delete old objectg clipboard
FarFtrMemFree(4);
// get object to copy
pf:=DataPointer;
if pf^.numObjects=0 then goto 99;
sel:=LstGetSelection(GetObjPtr(2409));
if sel<0 then goto 99;
obj:=pf^.objects^[sel];
// allocate
s:=TrueObjectSize(obj);
if FtrPtrNew(AppCreatorID,4,s+6,p)<>0 then goto 99;
// write data
WriteObject(p,6,obj);
obj.w.i:=6;
DmWrite(p,0,@obj,6);
FormObjCopy:=true;
99:
end;
function FormObjPaste:boolean;
label 99;
var
p : MemoryWord;
pf : ^FormType;
po : ^FormObjectType;
lst : ListPtr;
begin
FormObjPaste:=false;
if readonlydb then goto 99;
if FtrGet(AppCreatorID,4,p.u)<>0 then goto 99;
po:=p.p;
pf:=DataPointer;
with pf^ do
begin
if numObjects>511 then goto 99;
LoadObject(objects^[numObjects],po^,p.p);
numObjects:=numObjects+1;
lst:=GetObjPtr(2409);
LstSetListChoices(lst,DataPointer,numObjects);
LstSetSelection(lst,numObjects-1);
ControlTitle(true);
LstDrawList(lst);
end;
formObjPaste:=true;
99:
end;
// cut object
function FormObjCut:boolean;
label 99;
var
lst : ListPtr;
i : Int16;
pf : ^FormType;
sel : Int16;
begin
FormObjCut:=false;
if readonlydb then goto 99;
if not FormObjCopy then goto 99;
pf:=DataPointer;
lst:=GetObjPtr(2409);
sel:=LstGetSelection(lst);
if sel<0 then goto 99;
with pf^ do
begin
// free object
FreeObj(objects^[sel]);
// remove from table
for i:=sel+1 to numObjects-1 do objects^[i-1]:=objects^[i];
numObjects:=numObjects-1;
// update list
lstSetListChoices(lst,DataPointer,numObjects);
if sel=numObjects then lstSetSelection(lst,sel-1);
ControlTitle(true);
LstDrawList(lst);
end;
FormObjCut:=true;
99:
end;
procedure FormNewObj(n:Int16);
var
pf : ^FormType;
lst : ListPtr;
objType : FormObjectKind;
begin
objectP:=nil;
case n of
0: // field
begin
objType:=FrmFieldObj;
FieldDialog;
end;
1: // control
begin
objType:=FrmControlObj;
ControlDialog;
end;
2: // list
begin
objType:=FrmListObj;
ListDialog;
end;
3: // table
begin
objType:=FrmTableObj;
TableDialog;
end;
4: // form bitmap
begin
ObjType:=FrmBitmapObj;
FormBitmapDialog;
end;
5: // label
begin
objType:=FrmLabelObj;
LabelDialog;
end;
6: // title
begin
objType:=FrmTitleObj;
titleDialog;
end;
7: // popup
begin
objType:=FrmPopupObj;
PopupDialog;
end;
8: // GraffitiState
begin
objType:=FrmGraffitiStateObj;
GraffitiStateDialog;
end;
9: // gadget
begin
objType:=FrmGadgetObj;
GadgetDialog;
end;
10: // scrollbar
begin
objType:=FrmScrollBarObj;
ScrollBarDialog;
end;
11: // graphic control
begin
objType:=FrmControlObj;
GraphicControlDialog;
end;
12:
begin
objType:=FrmControlObj;
SliderDialog;
end;
end;
if objectP<>nil then
begin // new object
pf:=DataPointer;
with pf^.objects^[pf^.numObjects] do
begin
objectType:=ObjType;
w.p:=objectP;
end;
Lst:=GetObjPtr(2409);
pf^.numObjects:=pf^.numObjects+1;
LstSetListChoices(lst,DataPointer,pf^.numObjects);
LstSetSelection(lst,pf^.numObjects-1);
ControlTitle(true);
end;
end;
procedure FormSaveContext;
var p:pointer;
begin
prefs.resType:=resType;
FarFtrMemFree(1);
FormSaveData;
if FtrPtrNew(AppCreatorID,1,TotalSize,p)=0 then
begin
WriteForm(p);
end
else
begin
Prefs.FormID:=1000;
end;
end;
// form editor event handler
//--------------------------
function FormEditEventHandler(var event:EventType):boolean;
begin
pushregs;
FormEditEventHandler:=false;
if farListHardButtonsEventHandler(event,FormOpen) then
ControlTitle(true)
else
case event.eType of
frmOpenEvent:
begin
LoadForm;
FrmDrawForm(ActiveForm);
FormEditEventHandler:=true;
end;
frmCloseEvent:
begin
FreeForm;
end;
ctlSelectEvent:
begin
case event.ctlSelect.ControlID of
1501: // preview
begin
FormPreview(EndPreview{PreviewFormEventHandler});
FormEditEventHandler:=true;
end;
1528: // adjust
begin
CurrObjInd:=$ffff;
FormPreview(AdjustEventHandler);
FormEditEventHandler:=true;
end;
1511: // OK
FormOK;
1512: // cancel
begin
FrmGotoForm(1100);
FormEditEventHandler:=true;
end;
// 2401: // open
// FormOpen;
1529: // Del
FormDel;
end;
end;
lstSelectEvent:
if event.lstSelect.listID=2409 then
begin
ControlTitle(true);
FrmSetFocus(ActiveForm,noFocus);
end;
popSelectEvent:
begin
case event.popselect.ListID of
1527 : FormFrame(event.popselect.selection);
1531 :
begin
FormNewObj(event.popselect.selection);
FormEditEventHandler:=true;
end;
end;
FormEditEventHandler:=true;
end;
menuEvent:
begin
case event.menu.itemID of
1100 : FormEditEventHandler:=FormObjCut;
1101 : FormEditEventHandler:=FormObjCopy;
1102 : FormEditEventHandler:=FormObjPaste;
end;
end;
appStopEvent:
begin
FormSaveContext;
FormEditEventHandler:=false;
end;
end;
popregs;
end;
//-------------
// Main
//-------------
begin
FarFormEditEventHandler:=FormEditEventHandler;
FarGetFormTitle:=GetFormTitle;
// FarPreviewFormEventHandler:=PreviewFormEventHandler;
end.
// end of file 'builder3.pas'
Bird source code was on my palm, so i ve modified the form editor to be able to display and adjust 320*480 forms.
And now i share my hack. (It s not a very good implementation of the dynamic pen input area management ... but it has been made quick ! Well quick ... and dirty) ...
Here the source code of the modified file : Builder3.pas.
//--------------------
// resource builder
// 'code 3' segment :
// Forms
//--------------------
{$code appl,bIrD,code,3}
program Bird;
{$define AllowInternalAccess}
{$i PalmAPI1.pas}
{$i builderglobals.pas}
function FrmGetNumberOfObjects(frmP:FormPtr):UInt16;inline($4e4f,$a17f);
function CtlNewControl(var formp:FormPtr;ID:UInt16;style:ControlStyleType;const text:string;x,y,width,height:Coord;font:FontID;group:UInt8;leftAnchor:Boolean):ControlPtr;inline($4e4f,$a32c);
procedure EvtAddEventToQueue(var event:EventType);inline($4e4f,$a11b);
function FrmHandleEvent(frm:FormPtr;var event:eventType):boolean;inline($4e4f,$a17a);
procedure WinSetBounds(winH: WinHandle; var rP: RectangleType); inline($4e4f,$a300);
type
FormActiveStateType = array[0..10] of UInt16;
function FrmActiveState(var state:FormActiveStateType;save:boolean):err;inline($4e4f,$a33b);
//function CtlNewControl(var formp:FormPtr;id:UInt16;style:ControlStyleType;const text:string;x,y,width,height:Coord;font:FontID;group:UInt8;leftAnchor:boolean):ControlPtr;inline($4e4f,$a32c);
// for debug purpose only, display integer
// in a box value
procedure IntAlert(n:integer);
var s:string[15];
begin
StrIToA(s,n);
errAlertCustom(0,@s,nil,nil);
end;
/////////////////////////////////////
// StringToRessourceLab
/////////////////////////////////////
function StringToRessourceLab(const sMyString:string):integer;
begin
StringToRessourceLab:=
Ord(sMyString[4])+
256*Ord(sMyString[3])+
65536*Ord(sMyString[2])+
16777216*Ord(sMyString[1]);
end;
// utilities
//----------
procedure bip;
begin
SndPlaySystemSound(snderror);
end;
function GetFormObjPtr(frm:FormPtr;id:UInt16):pointer;
begin
GetFormObjPtr:=frmGetObjectPtr(frm,frmGetObjectindex(frm,id));
end;
function GetObjPtr(id:UInt16):pointer;
begin
GetObjPtr:=GetFormObjPtr(FrmGetActiveForm,id);
end;
procedure InitTextFieldID(id:Uint16;const s:string;redraw:boolean);
begin
FarInitTextField(GetObjPtr(id),s,redraw);
end;
type WindowType=record // 40 bytes
DisplayidthV20,
DisplayHeightV20 : Coord;
displayAddrV20 : pointer;
windowFlags : UInt16;
windowBounds : RectangleType;
clippingBounds : AbsRectType;
bitmapP : BitmapPtr;
frameType : UInt16;
drawStateP : pointer;
nextWindow : ^WindowType;
end;
// WinfowFlag :
// modal : $2000
// frame :
// b8..b15 : corner diam
// b4 : 3D
// b3 b2 : shadowWidth
// b1 b0 : width
// standards frames
{
const
noFrame = 0;
simpleFrame = 1; // = rectangleframe
simple3DFrame = $0012;
roundFrame = $0401;
boldRoundFrame = $0702;
popupFrame = $0205; // = menuframe
dialogFrame = $0302;
}
//------------
// controls
//------------
// contolAttrType
// b7 : usable $8000
// b6 : enabled $4000
// b5 : visible $2000
// b4 : on $1000
// leftAnchor $$0800 -- set if bounds expand to the right
// frame $0700 -- noFrame, Standard, bold, rectangle
// drawnAsSelected $0080
// graphical $0040
// vertical $0020 -- set for vertical sliders
// unused $001f
type
FieldType=record
id : UInt16;
rect : RectangleType;
attr : UInt16;
text,textHandle,lines : pointer;
textlen,textBlockSize : UInt16;
maxChars : UInt16;
selFirstPos,selLastPos,insptXPos,insptYPos : UInt16;
font : FontID;
maxVisibleLines : UInt8;
end;
{
controlType=record
id : UInt16;
bounds : RectangleType;
text : StringPtr;
attr : UInt16;
style : ControlStyleType; // ( enum )
font : FontID;
group : UInt8;
reserved : UInt8;
end;
}
graphicControlType=record
id : UInt16;
bounds : RectangleType;
bitmapID : UInt16;
selectedBitmapID : UInt16;
attr : UInt16;
style : ControlStyleType;
unused : FontID;
group : UInt8;
reserved : UInt8;
end;
slidercontroltype=record
id : UInt16;
bounds : RectangleType;
thumbID : UInt16;
backgroundID : UInt16;
attr : UInt16; // graphical is set
style : ControlStyleType;
reserved : UInt8;
minvalue : Int16;
maxvalue : Int16;
pagesize : Int16;
value : Int16;
activeSliderP : pointer;
end;
{
itemsTextType = array[0..255] of StringPtr;
itemsTextPtr = ^ItemsTextType;
ListType=record
id : UInt16;
bounds : rectangleType;
attr : UInt16;
itemsText : itemsTextPtr;
numItems : Int16;
currentItem : Int16;
topItem : Int16;
font : FontID;
reserved : UInt8;
popupwin : MemHandle;
drawItemsCallback : pointer;
end;
}
tableItemStyleType=
( checkboxTableItem,
customTableItem,
dateTableItem,
labelTableItem,
numerictableItem,
popuptriggerTableItem,
textTableItem,
textwithnoteTableItem,
timeTableItem,
NarrowTextTableItem,
tallCustomtableItem );
tableItemType=record
itemType : TableItemStyleType;
font : FontID;
intValue : Int16;
ptr : pointer;
end;
tableitemsType=array[0..255] of tableItemType;
tableitemsPtr = ^tableItemsType;
tableColumnAttrType=record
width : Coord;
attr : UInt16;
spacing : Coord;
drawCallback,
loaddatacallback,
savedatacallback : pointer;
end;
tableColumnAttrsType=array[0..15] of tableColumnAttrType;
tableColumnAttrsPtr=^tableColumnAttrsType;
tableRowAttrType=record
id : UInt16;
height : Coord;
data : UInt32;
attr : UInt16;
reserved3 : UInt16;
end;
tableRowAttrsType=array[0..23] of tableRowAttrType;
tablerowAttrsPtr=^tableRowAttrsType;
tabletype=record
id : UInt16;
bounds : rectangleType;
attr : UInt16;
numColumns : Int16;
numRows : Int16;
currentrow : Int16;
currentColumn : Int16;
toprow : Int16;
columnAttrs : tableColumnAttrsPtr;
rowAttrs : TableRowAttrsPtr;
items : TableitemsPtr;
currentField : FieldType;
end;
FormBitmapType = record
attr : UInt16;
pos : PointType;
rscID : UInt16;
end;
FormLabelType=record
id : UInt16;
pos : PointType;
attr : UInt16;
font : FontID;
reserved : UInt8;
text : StringPtr;
end;
FormTitleType=record
rect : rectangleType;
text : StringPtr;
end;
FormPopupType=record
controlID : UInt16;
listID : UInt16;
end;
FrmGraffitiStateType=record
pos : PointType;
end;
FormGadgetType=record
id : UInt16;
attr : UInt16;
rect : RectangleType;
data : pointer;
handler : pointer;
end;
ScrollBarType=record
bounds : RectangleType;
id : UInt16;
attr : UInt16;
value,
minvalue,
maxvalue,
pagesize,
penPosInCar,
savePos : Int16;
end;
FormObjectType=record case objectType:FormObjectKind of
frmFieldObj:(field:^FieldType);
frmControlObj:(control:^ControlType);
frmListObj:(list:^ListType);
frmTableObj:(table:^TableType);
frmBitmapObj:(bitmap:^FormBitmapType);
frmLineObj:(sliderControl:^SliderControlType);
frmFrameObj:(graphicControl:^GraphicControlType);
frmRectangleObj:(w : memoryword);
frmLabelObj:(FormLabel:^FormLabelType);
frmTitleObj:(title:^FormTitleType);
frmPopupObj:(popup:^FormPopupType);
frmGraffitiStateObj:(grfState:^FrmGraffitiStateType);
frmGadgetObj:(gadget:^FormGadgetType);
frmScrollbarObj:(scrollBar:^ScrollBarType)
end;
FormObjectPtr=^FormObjectType;
//--------------
// Form Editor
//--------------
FormObjArrayType=array[0..511] of FormObjectType;
FormObjArrayPtr = ^FormObjArrayType;
type
// internal form type
FormType = record
window : WindowType; // 40
formID : UInt16;
attr : UInt32;
bitsBehindForm : WinHandle;
handler : pointer;
focus : UInt16;
defaultButton : UInt16;
helpRscId : UInt16;
MenuRscID : UInt16;
numObjects : Int16; // 62
objects : FormObjArrayPtr;
end;
IControlType=record
next : ^IcontrolType;
end;
//---------------
// PalmOS Glue
//---------------
function AccessorTrapPresent:boolean;
var v : UInt32;
begin
AccessorTrapPresent:=false;
if FtrGet(sysFtrCreator,25,v)=0 then
if v<>0 then AccessorTrapPresent:=true;
end;
function LstGetFont(lst:ListPtr):FontID;inline($7400+19,$4e4f,$a3f4);
function LstGetItemsText(pl:ListPtr):pointer;
inline($7400+21,$4e4f,$a3f4);
function LstGlueGetItemsText(pl:ListPtr):pointer;
begin
if AccessorTrapPresent then LstGlueGetItemsText:=LstGetItemstext(pl)
else LstGlueGetItemsText:=pl^.itemsText;
end;
function LstGlueGetFont(lst:ListPtr):FontID;
begin
if AccessorTrapPresent then LstGlueGetFont:=LstGetFont(lst)
else LstGlueGetFont:=lst^.font;
end;
function CtlGetControlStyle(ctl:ControlPtr):ControlStyleType;inline($7400+0,$4e4f,$a3f4);
function CtlGlueGetControlStyle(ctl:ControlPtr):ControlStyleType;
begin
if AccessorTrapPresent then CtlGlueGetControlStyle:=CtlGetControlStyle(ctl)
else CtlGlueGetControlStyle:=ctl^.style;
end;
//----------------------
// PreviewEventHandler
//----------------------
// returns true if this event ends preview dialog
function EndPreview(var event:EventType):boolean;
begin
EndPreview:=
(event.etype=keydownevent) and
((event.keydown.chr=$108) or
(event.keydown.chr=$136) or
((event.keydown.chr=1283) and (event.keydown.keycode=4096)));
end;
//DIAs functions
function FrmSetDIAPolicyAttr(form:formPtr;pol:UInt16):Err;inline($740E,SYSTRAP,$A470);
function SetDIAState(pol:UInt16):UInt16;inline($7400,SYSTRAP,$A470);
function WinSetConstraintsSize(winH:WinHandle;minH:UInt16;prefH:UInt16;maxH:UInt16;minW:UInt16;prefW:UInt16;maxW:UInt16):Err;inline($740D,SYSTRAP,$A470);
function FrmGetWindowHandle(form:formPtr):WinHandle;inline(SYSTRAP,$A17C);
function PINSetInputTriggerState(state:UInt16):Err;inline($7402,SYSTRAP,$A470);
//Procedure WinSetBounds(winH:WinHandle;r:RectangleTypePtr);inline(SYSTRAP,$A300);
function GetDIAState:UInt16;inline($7401,SYSTRAP,$A470);
function GetLandState:UInt16;inline($7413,SYSTRAP,$A470);
function SetLandState(pol:UInt16):UInt16;inline($7414,SYSTRAP,$A470);
/////////////////////////////////////
// DIA: Set DIA
/////////////////////////////////////
procedure setDIA(f:FormPtr;resize:Boolean);
var
error:Err;
version:UInt32;
w:WinHandle;
r:RectangleType;
v:UInt16;
begin
r.topLeft.x:=0;
r.topLeft.y:=0;
r.extent.x:=160;
r.extent.y:=160;
error:=FtrGet(StringToRessourceLab('pins'),1,version);
//error:=1;
f:=FrmGetActiveForm;
if (error=0) then
begin
if (version>0) then
begin
//on recupere le formulaire courant
//. f:=FrmGetActiveForm;
if (GetDIAState<>2) then begin
//on recupere la fenetre courante
w:=FrmGetWindowHandle(f);
//on defini les tailles prªfªrªs, maxi et mini
WinSetConstraintsSize(w,240,240,240,240,160,160);
//on indique que celui ci accepte que la zone virtuelle soit fermer
FrmSetDIAPolicyAttr(f,1);
//On va cacher la zone virtuelle
SetDIAState(1);
//On va donner une valeur par defaut
//au boutton permettant de cacher la
//zone virtuelle.
PINSetInputTriggerState(1);
r.extent.x:=240;
r.extent.y:=240;
end;
end;
end;
//On crªe un rectangle pour
//Redimensionner notre fenetre
if resize then begin
w:=FrmGetWindowHandle(f);
//on la redimensionne
WinSetBounds(w,r);
// WinGetBounds(WinGetDisplayWindow,r);
// WinSetBounds(FrmGetWindowHandle(f),r);
end;
end;
procedure PreviewDialog(frm:FormPtr);
label 11,10;
var
state : FormActiveStateType;
event : EventType;
e :UInt16;
begin
FrmActiveState(state,true);
FrmSetActiveForm(frm);
FrmDrawForm(frm);
SetDia(frm,true);
repeat
11:
EvtGetEvent(event,-1);
// capture end preview event
if EndPreview(event) then //( (event.etype=keydownevent) and (event.keydown.chr=$108) ) then
begin
FrmDispatchEvent(event); // to validate adjust modifs
goto 10;
end;
if FrmDispatchEvent(event) then goto 11;
if SysHandleEvent(event) then goto 11;
if MenuHandleEvent(nil,event,e) then goto 11;
// if FrmDispatchEvent(event) then goto 11;
if event.etype=appstopevent then
begin
EvtAddEventToqueue(event);
goto 10;
end;
until false;
10:
FrmEraseForm(frm); // if this is not done, simulator complains
FrmActiveState(state,false);
end;
{
function PreviewFormEventHandler(var event:eventType):boolean;
begin
pushregs;
PreviewFormEventHandler:=false;
case event.etype of
keyDownEvent:
begin
if event.keydown.chr=$108 then
begin
PreviewFormEventHandler:=true;
end;
end;
end;
popregs;
end;
}
procedure DrawObjFrame(rec:RectangleType);
begin
rec.topleft.x:=rec.topleft.x-1;
rec.topleft.y:=rec.topleft.y-1;
rec.extent.x:=rec.extent.x+2;
rec.extent.y:=rec.extent.y+2;
WinDrawGrayRectangleFrame(simpleFrame,rec);
end;
procedure SetObjectPosition(const obj:FormObjectType;x,y:Coord);
begin
with obj do case ObjectType of
FrmPopupObj:;
FrmGraffitiStateObj,
FrmScrollBarObj:
with GrfState^ do
begin
Pos.x:=x;
Pos.y:=y;
end;
FrmGadgetObj: with gadget^ do
begin
rect.topleft.x:=x;
rect.topleft.y:=y;
end;
else with FormLabel^ do
begin
Pos.x:=x;
Pos.y:=y;
end;
end;
end;
procedure SetPositions;
var pf : ^FormType;
rec : RectangleType;
i : Int16;
frm : FormPtr;
begin
frm:=FrmGetActiveForm;
pf:=DataPointer;
with pf^ do
for i:=0 to numObjects-1 do
begin
FrmGetObjectBounds(frm,i,rec);
SetObjectPosition(objects^[i],rec.topleft.x,rec.topleft.y);
end;
end;
function AdjustEventHandler(var event:eventType):boolean;
label 10,11,12;
var i : Int16;
frm : FormPtr;
rec : rectangleType;
begin
// pushregs;
AdjustEventHandler:=false;
if EndPreview(event) then
begin
SetPositions;
AdjustEventHandler:=true;
end
else
case event.etype of
penDownEvent:
begin
frm:=FrmGetActiveForm;
for i:=0 to FrmGetNumberOfObjects(Frm)-1 do
begin
frmGetObjectBounds(frm,i,rec);
if RctPtInRectangle(event.ScreenX,event.ScreenY,rec) then
begin
CurrObjInd:=i;
FrmDrawForm(frm);
DrawObjFrame(rec);
goto 10;
end;
end;
10:
AdjustEventHandler:=true;
end;
keyDownEvent:
begin
case event.keydown.chr of
11:
begin
if CurrObjInd>=0 then
begin
frm:=FrmGetActiveForm;
FrmGetObjectBounds(frm,CurrObjInd,rec);
rec.topleft.y:=rec.topleft.y-1;
FrmSetObjectBounds(frm,CurrObjInd,rec);
FrmDrawForm(frm);
DrawObjFrame(rec);
end;
end;
12:
begin
if CurrObjInd>=0 then
begin
frm:=FrmGetActiveForm;
FrmGetObjectBounds(frm,CurrObjInd,rec);
rec.topleft.y:=rec.topleft.y+1;
FrmSetObjectBounds(frm,CurrObjInd,rec);
FrmDrawForm(frm);
DrawObjFrame(rec);
end;
end;
$206,$135 : goto 11;
$205,$134 : goto 12;
1283:
begin
case event.keydown.keycode of
2056,8: // right
if CurrObjInd>=0 then
begin
11:
frm:=FrmGetActiveForm;
FrmGetObjectBounds(frm,CurrObjInd,rec);
rec.topleft.x:=rec.topleft.x+1;
FrmSetObjectBounds(frm,CurrObjInd,rec);
FrmDrawForm(frm);
DrawObjFrame(rec);
AdjustEventHandler:=true;
end;
1028,4: // left
if CurrObjInd>=0 then
begin
12:
frm:=FrmGetActiveForm;
FrmGetObjectBounds(frm,CurrObjInd,rec);
rec.topleft.x:=rec.topleft.x-1;
FrmSetObjectBounds(frm,CurrObjInd,rec);
FrmDrawForm(frm);
DrawObjFrame(rec);
AdjustEventHandler:=true;
end;
end;
end;
end;
end;
end;
// popregs;
end;
//-------------
// Title Dialog
//-------------
function GetNewTextField(frm:FormPtr;id:UInt16):StringPtr;
var ps : StringPtr;
nt : StringPtr;
begin
ps:=FldGetTextPtr(GetFormObjPtr(frm,id));
if ps=nil then
begin
nt:=MemPtrNew(2);
nt^:='';
end
else
begin
nt:=MemPtrNew(StrLen(ps^)+1);
StrCopy(nt^,ps^);
end;
GetNewTextField:=nt;
end;
procedure TitleDialog;
var frm : FormPtr;
pt : ^FormTitleType;
ps : StringPtr;
fldind : UInt16;
fld : FieldPtr;
begin
frm:=FrmInitForm(2300);
fldind :=FrmGetObjectIndex(frm,2301);
fld:=FrmGetObjectPtr(frm,fldind);
if ObjectP<>nil then
begin
pt:=ObjectP;
// copy text and set selection
FarInitTextField(fld,pt^.text^,false);
FldSetSelection(fld,0,StrLen(pt^.text^){length(pt^.text^)});
end
// the field needs to be initialised to non nil text in ordre
// to display focus
else FarInitTextField(fld,'',false);
FrmSetFocus(frm,fldind);
if FrmDoDialog(frm)=2302 then
begin
if ObjectP<>nil then MemPtrFree(pt^.text)
else
begin
ObjectP:=MemPtrNew(Sizeof(FormTitleType));
MemSet(ObjectP^,Sizeof(FormTitleType),0);
pt:=ObjectP;
end;
pt^.text:=GetNewTextField(frm,2301);
end;
FrmDeleteForm(frm);
end;
//---------------
// Label Dialog
//---------------
procedure InitDecimalField(frm:FormPtr;id:Uint16;x:UInt16);
var
buffer : String[7];
begin
StrIToA(buffer,x);
FarInitTextField(GetFormObjPtr(frm,id),buffer,false);
end;
function CheckField(frm : FormPtr;id:UInt16):boolean;
var ps : StringPtr;
begin
CheckField:=true;
ps:=FldGetTextPtr(GetFormObjPtr(frm,id));
if (ps=nil) or (ps^='') then
begin
CheckField:=false;
bip;
FrmSetFocus(frm,FrmGetObjectIndex(frm,id));
end;
end;
function GetDecimal(frm:FormPtr;id:UInt16):UInt16;
var ps : StringPtr;
begin
ps:=FldGetTextPtr(GetFormObjPtr(frm,id));
GetDecimal:=StrAToI(ps^);
end;
procedure SetCheck(frm:FormPtr;id:UInt16;value:UInt16);
begin
CtlSetValue(GetFormObjPtr(frm,id),value);
end;
function GetCheck(frm:FormPtr;id:UInt16):UInt16;
begin
GetCheck:=CtlGetValue(GetFormObjPtr(frm,id));
end;
function GetListSel(frm:FormPtr;id:UInt16):Int16;
begin
GetListSel:=LstGetSelection(GetFormObjPtr(frm,id));
end;
procedure SetListSel(frm:FormPtr;id:UInt16;sel:Int16);
begin
LstSetSelection(GetFormObjPtr(frm,id),sel);
end;
function LabelDialogEventHandler(var event:EventType):boolean;
var frm : FormPtr;
begin
pushregs;
LabelDialogEventHandler:=false;
if not FarHandleEditMenuEvent(event) then
case event.etype of
ctlSelectEvent:
if event.ctlSelect.ControlID=1901 then
begin // control that numerics fields are not empty
frm:=FrmGetActiveForm;
LabelDialogEventHandler:=not
( checkField(frm,1910) and
CheckField(frm,1908) and
CheckField(frm,1911) ) ;
end;
fldChangedEvent:
begin
if event.fldChanged.fieldID=1701 then FarUpdateScrollbar;
end;
sclRepeatEvent:
begin
with event.sclRepeat do FarScrollLines(newvalue-value);
LabelDialogEventHandler:=false;
end;
end;
popregs;
end;
procedure LabelDialog;
var
frm : FormPtr;
pl : ^FormLabelType;
lb : FormLabelType;
begin
frm:=FrmInitForm(1900);
FrmSetEventHandler(frm,LabelDialogEventHandler);
// field init
if ObjectP<>nil then
begin
pl:=ObjectP;
lb:=pl^;
end
else MemSet(lb,Sizeof(FormLabelType),0);
// objects initialisation
InitDecimalField(frm,1910,lb.pos.y);
InitDecimalField(frm,1908,lb.pos.x);
InitDecimalField(frm,1911,lb.id);
LstSetSelection(GetFormObjPtr(frm,1904),lb.font);
// CtlSetValue(GetFormObjPtr(frm,1914),lusable shr 15);
SetCheck(frm,1914,lb.attr shr 15);
if lb.text<>nil then
FarInitTextField(GetFormObjPtr(frm,1701),lb.text^,false);
if FrmDoDialog(frm)=1901 then
begin
if ObjectP<>nil then MemPtrFree(pl^.text)
else
begin
ObjectP:=MemPtrNew(Sizeof(FormLabelType));
pl:=ObjectP;
MemSet(pl^,sizeof(FormLabelType),0);
end;
with pl^ do
begin
pos.y:=GetDecimal(frm,1910);
pos.x:=GetDecimal(frm,1908);
id:=GetDecimal(frm,1911);
// ltext:=FldGetTextPtr(GetFormObjPtr(frm,1701));
attr:=CtlGetValue(GetFormObjPtr(frm,1914)) shl 15;
font:=LstGetSelection(GetFormObjPtr(frm,1904));
text:=GetNewTextField(frm,1701);
// if ltext=nil then
// begin
// text:=MemPtrNew(2);
// MemSet(text^,2,0);
// end
// else
// begin
// text:=MemPtrNew(length(ltext^)+1);
// StrCopy(text^,ltext^); //}text^:=ltext^;
// end;
end;
end;
FrmDeleteForm(frm);
end;
//-----------------------
// GraffitiState Dialog
//-----------------------
function GraffitiStateDialogEventHandler(var event:EventType):boolean;
var frm : FormPtr;
begin
pushregs;
GraffitiStateDialogEventHandler:=false;
case event.etype of
ctlSelectEvent:
if event.ctlSelect.ControlID=2501 then
begin // control that numerics fields are not empty
frm:=FrmGetActiveForm;
GraffitiStateDialogEventHandler:=not
( checkField(frm,2506) and
CheckField(frm,2505) ) ;
end;
end;
popregs;
end;
procedure GraffitiStateDialog;
var
frm : FormPtr;
pg : ^FrmGraffitiStateType;
top,left : Int16;
// buffer : string[7];
begin
frm:=FrmInitForm(2500);
FrmSetEventHandler(frm,GraffitiStateDialogEventHandler);
if ObjectP<>nil then
begin
pg:=ObjectP;
top:=pg^.pos.y;
left:=pg^.pos.y;
end
else
begin
top:=0;
left:=0;
end;
InitDecimalField(frm,2506,top);
InitDecimalField(frm,2505,left);
if FrmDoDialog(frm)=2501 then
begin
if ObjectP=nil then
begin
ObjectP:=MemPtrNew(Sizeof(FrmGraffitiStatetype));
end;
pg:=objectP;
with pg^ do
begin
pos.y:=GetDecimal(frm,2506);
pos.x:=GetDecimal(frm,2505);
end;
end;
FrmDeleteForm(frm);
end;
//----------------
// Control Dialog
//----------------
function ControlDialogEventHandler(var event:eventType):boolean;
var
frm : FormPtr;
ps : StringPtr;
width : Int16;
font : FontID;
begin
pushregs;
ControlDialogEventHandler:=false;
if not FarHandleEditMenuEvent(event) then
case event.etype of
ctlSelectEvent:
case event.ctlSelect.controlID of
1611: // OK
begin
frm:=FrmGetActiveForm;
ControlDialogEventHandler:= not
(CheckField(frm,1605) and
CheckField(frm,1603) and
CheckField(frm,1608) and
CheckField(frm,1610) and
CheckField(frm,1626) and
CheckField(frm,1620));
end;
1631: // calc width
begin
frm:=FrmGetActiveForm;
Font:=FntSetFont(LstGetSelection(GetFormObjPtr(frm,1625)));
ps:=FldGetTextPtr(GetFormObjPtr(frm,1601));
width:=FntCharsWidth(ps^,StrLen(ps^));
case LstGetSelection(GetFormObjPtr(frm,1615)) of
2,3 : width:=width+16;
// 3 : width:=width+15;
else width:=width+4;
end;
FntSetFont(Font);
InitDecimalField(frm,1608,width);
FldDrawField(GetFormObjPtr(frm,1608));
ControlDialogEventHandler:=true;
end;
end;
end
else ControlDialogEventHandler:=true;
popregs;
end;
function StyleLstGetSelection(ListP:ListPtr):ControlStyleType; inline(SYSTRAP,$A1B3);
procedure ControlDialog;
var frm : FormPtr;
pc : ^ControlType;
cont : ControlType;
begin
frm:=FrmInitForm(1600);
FrmSetEventHandler(frm,ControlDialogEventHandler);
if ObjectP<>nil then
begin
pc:=ObjectP;
MemMove(cont,pc^,sizeof(ControlType));//cont:=pc^;
end
else with cont do
begin
MemSet(cont,sizeof(ControlType),0);
end;
// objects initialisation
InitDecimalField(frm,1603,cont.bounds.topleft.y);
InitDecimalField(frm,1605,cont.bounds.topleft.x);
InitDecimalField(frm,1608,cont.bounds.extent.x);
InitDecimalField(frm,1610,cont.bounds.extent.y);
InitDecimalField(frm,1620,cont.id);
InitDecimalField(frm,1626,cont.group);
if cont.text=nil then
FarInitTextField(GetFormObjPtr(frm,1601),'',false)
else
FarInitTextField(GetFormObjPtr(frm,1601),cont.text^,false);
// usable
SetCheck(frm,1619,cont.attr shr 15);
// CtlSetValue(GetFormObjPtr(frm,1619),(cont.attr shr 15) and 1);
// selected
SetCheck(frm,1616,(cont.attr shr 12) and 1);
// CtlSetValue(GetFormObjPtr(frm,1616),(cont.attr shr 12) and 1);
// enabled
SetCheck(frm,1622,(cont.attr shr 14) and 1);
// CtlSetValue(GetFormObjPtr(frm,1622),(cont.attr shr 14) and 1);
// left anchor
SetCheck(frm,1623,(cont.attr shr 11) and 1);
// CtlSetValue(GetFormObjPtr(frm,1623),(cont.attr shr 11) and 1);
// drawn as selected
CtlSetValue(GetFormObjPtr(frm,1632),(cont.attr shr 7) and 1);
// frame type
SetListSel(frm,1618,(cont.attr shr 8) and 7);
// LstSetSelection(GetFormObjPtr(frm,1618),(cont.attr shr 8) and 7);
// font
SetListSel(frm,1625,cont.font);
// LstSetSelection(GetFormObjPtr(frm,1625),cont.font);
// style
SetListSel(frm,1615,ord(cont.style));
// LstSetSelection(GetFormObjPtr(frm,1615),ord(cont.style));
if FrmDoDialog(frm)=1611 then
begin
if ObjectP<>nil then MemPtrFree(pc^.Text)
else
begin
ObjectP:=MemPtrNew(sizeof(ControlType));
pc:=ObjectP;
MemSet(pc^,sizeof(ControlType),0);
end;
with pc^ do
begin // initialise fields
bounds.topleft.y:=GetDecimal(frm,1603);
bounds.topleft.x:=GetDecimal(frm,1605);
bounds.extent.x:=GetDecimal(frm,1608);
bounds.extent.y:=GetDecimal(frm,1610);
group:=GetDecimal(frm,1626);
Font:=LstGetSelection(GetFormObjPtr(frm,1625));
id:=GetDecimal(frm,1620);
attr:=
(GetCheck(frm,1619) shl 15)+
(GetCheck(frm,1616) shl 12)+
(GetCheck(frm,1622) shl 14)+
(GetCheck(frm,1623) shl 11)+
(GetCheck(frm,1632) shl 7)+
(GetListSel(frm,1618) shl 8);
style:=StyleLstGetSelection(GetFormObjPtr(frm,1615));
text:=GetNewTextField(frm,1601);
reserved:=0;
end;
end;
FrmDeleteForm(frm);
end;
//--------------------
// Popop Editor
//--------------------
function PopupDialogEventHandler(var event:eventType):boolean;
var frm : FormPtr;
begin
pushregs;
PopupDialogEventHandler:=false;
if event.etype=ctlSelectEvent then
if event.ctlSelect.ControlID=2802 then
begin
frm:=FrmGetActiveForm;
PopupDialogEventHandler:= not
(CheckField(frm,2803) and CheckField(frm,2806));
end;
popregs;
end;
procedure PopupDialog;
var frm:formPtr;
pp : ^FormPopupType;
pu : FormPopupType;
begin
frm:=FrmInitForm(2800);
FrmSetEventHandler(frm,PopupDialogEventHandler);
if ObjectP<>nil then
begin
pp:=ObjectP;
pu:=pp^;
end
else
begin
pu.ControlID:=0;
pu.ListID:=0;
end;
InitDecimalField(frm,2803,pu.ControlID);
InitDecimalField(frm,2806,pu.ListID);
if FrmDoDialog(frm)=2802 then
begin
if ObjectP=nil then
begin
ObjectP:=MemPtrNew(sizeof(FormPopupType));
pp:=ObjectP;
end;
with pp^ do
begin
controlID:=GetDecimal(frm,2803);
ListID:=GetDecimal(frm,2806);
end;
end;
FrmDeleteForm(frm);
end;
//--------------------
// Gadget dialog
//--------------------
function GadgetEventHandler(var event:eventType):boolean;
var frm : FormPtr;
begin
pushregs;
GadgetEventHandler:=false;
if event.etype=ctlSelectEvent then
if event.ctlSelect.ControlID=2802 then
begin
frm:=FrmGetActiveForm;
GadgetEventHandler:= not
(CheckField(frm,2902) and
CheckField(frm,2907) and
CheckField(frm,2904) and
CheckField(frm,2908) and
CheckField(frm,2910));
end;
popregs;
end;
procedure GadgetDialog;
var frm : FormPtr;
pg : ^FormGadgetType;
gd : FormGadgetType;
begin
frm:=FrmInitForm(2900);
FrmSetEventHandler(frm,GadgetEventHandler);
if ObjectP<>nil then
begin
pg:=ObjectP;
gd:=pg^;
end
else MemSet(gd,sizeof(FormGadgetType),0);
InitDecimalField(frm,2902,gd.rect.topleft.y);
InitDecimalField(frm,2904,gd.rect.topleft.x);
InitDecimalField(frm,2907,gd.rect.extent.x);
InitDecimalField(frm,2908,gd.rect.extent.y);
InitDecimalField(frm,2910,gd.id);
SetCheck(frm,2913,gd.attr shr 15);
SetCheck(frm,2914,(gd.attr shr 14) and 1);
if frmDoDialog(frm)=2911 then
begin
if ObjectP=nil then
begin
ObjectP:=MemPtrNew(sizeof(formGadgetType));
pg:=ObjectP;
MemSet(pg^,sizeof(formGadgetType),0); // v 1.04
end;
with pg^ do
begin
rect.topleft.y:=GetDecimal(frm,2902);
rect.topleft.x:=GetDecimal(frm,2904);
rect.extent.x:=GetDecimal(frm,2907);
rect.extent.y:=GetDecimal(frm,2908);
id:=GetDecimal(frm,2910);
attr:=
(GetCheck(frm,2913) shl 15) +
(GetCheck(frm,2914) shl 14) ;
end;
end;
FrmDeleteForm(frm);
end;
//----------------------
// Field dialog editor
//----------------------
function FieldEventHandler(var event:eventType):boolean;
var frm : FormPtr;
begin
pushregs;
FieldEventHandler:=false;
if event.eType=ctlSelectEvent then
if event.ctlSelect.ControlID=1819 then
begin
frm:=FrmGetActiveFOrm;
FieldEventHandler:= not (
CheckField(frm,1808) and
CheckField(frm,1806) and
CheckField(frm,1803) and
CheckField(frm,1810) and
CheckField(frm,1817) );
end;
popregs;
end;
procedure FieldDialog;
var
frm : FormPtr;
pf : ^FieldType;
fd : FieldType;
begin
frm:=FrmInitForm(1800);
FrmSetEventHandler(frm,FieldEventHandler);
if ObjectP<>nil then
begin
pf:=ObjectP;
fd:=pf^;
end
else MemSet(fd,sizeof(fieldtype),0);
InitDecimalField(frm,1808,fd.rect.topleft.y);
InitDecimalField(frm,1806,fd.rect.topleft.x);
InitDecimalField(frm,1803,fd.rect.extent.x);
InitDecimalField(frm,1802,fd.rect.extent.y);
InitDecimalField(frm,1810,fd.id);
InitDecimalField(frm,1817,fd.MaxChars);
SetCheck(frm,1814,(fd.attr shr 13) and 1); // editable
SetCheck(frm,1815,fd.attr shr 15); // usable
SetCheck(frm,1824,(fd.attr shr 10) and 1); // dynamic
setCheck(frm,1813,(fd.attr shr 6) and 1); // underline
setCheck(frm,1816,(fd.attr shr 1) and 1); //numeric
setCheck(frm,1823,(fd.attr shr 3) and 1); //autoshift
setCheck(frm,1812,(fd.attr shr 12) and 1); //singleline
setCheck(frm,1826,(fd.attr shr 2) and 1); //scrollbar
// alignement
SetListSel(frm,1825,(fd.attr shr 4) and 3);
// font
SetListSel(frm,1821,fd.font);
if FrmDoDialog(frm)=1819 then
begin
if ObjectP=nil then
begin
ObjectP:=MemPtrNew(sizeof(FieldType));
pf:=ObjectP;
MemSet(pf^,sizeof(FieldType),0); // v 1.04
end;
with pf^ do
begin
rect.topleft.y:=GetDecimal(frm,1808);
rect.topleft.x:=GetDecimal(frm,1806);
rect.extent.x:=GetDecimal(frm,1803);
rect.extent.y:=GetDecimal(frm,1802);
id:=GetDecimal(frm,1810);
MaxChars:=GetDecimal(frm,1817);
attr:=(GetCheck(frm,1814) shl 13) +
(GetCheck(frm,1815) shl 15) +
(GetCheck(frm,1824) shl 10) +
(GetCheck(frm,1813) shl 6) +
(GetCheck(frm,1816) shl 1) +
(GetCheck(frm,1823) shl 3) +
(GetCheck(frm,1812) shl 12) +
(GetCheck(frm,1826) shl 2) +
(GetListSel(frm,1827) shl 4);
font:=GetListSel(frm,1821);
end;
end;
FrmDeleteForm(frm);
end;
//---------------------
// Form Bitmap dialog
//---------------------
function FormBitmapEventHandler(var event:eventType):boolean;
var frm : FormPtr;
begin
pushregs;
FormBitmapEventHandler:=false;
if event.etype = ctlSelectEvent then
begin
if event.ctlSelect.ControlID=3008 then
begin
frm:=FrmGetActiveForm;
FormBitmapEventHandler:=not (
CheckField(frm,3003) and
CheckField(frm,3004) and
CheckField(frm,3006) );
end;
end;
popregs;
end;
procedure FormBitmapDialog;
var
frm : FormPtr;
pb : ^FormBitmapType;
bp : FormBitmapType;
begin
frm:=FrmInitForm(3000);
FrmSetEventHandler(frm,FormBitmapEventHandler);
if ObjectP<>nil then
begin
pb:=ObjectP;
bp:=pb^;
end
else MemSet(bp,sizeof(FormBitmapType),0);
InitDecimalField(frm,3003,bp.pos.y);
InitDecimalField(frm,3004,bp.pos.x);
InitDecimalField(frm,3006,bp.rscID);
SetCheck(frm,3007,bp.attr shr 15);
if FrmDoDialog(frm)=3008 then
begin
if ObjectP=nil then
begin
ObjectP:=MemPtrNew(sizeof(FormBitmapType));
pb:=ObjectP;
MemSet(pb^,sizeof(FormBitmapType),0); // v 1.04
end;
with pb^ do
begin
pos.y:=GetDecimal(frm,3003);
pos.x:=GetDecimal(frm,3004);
rscID:=GetDecimal(frm,3006);
attr:=GetCheck(frm,3007) shl 15;
end;
end;
FrmDeleteForm(frm);
end;
//-------------------
// List Dialog
//--------------------
//const sysFtrCreator=ord('p') shl 24+ord('s') shl 16+ord('y') shl 8+ord('s');
procedure ListCalcWidth;
var
frm : FormPtr;
itemsText:itemsTextPtr;
lst : ListPtr;
numItems : Int16;
i : Int16;
fnt : FontID;
width,t : UInt16;
ps : StringPtr;
begin
frm:=FrmGetActiveForm;
lst:=GetFormObjPtr(frm,2409);
itemsText:=LstGlueGetItemsText(lst);
numItems:=LstGetNumberOfItems(lst);
if numItems>0 then
begin
fnt:=LstGlueGetFont(lst);
width:=0;
for i:=0 to numItems-1 do
begin
ps:=ItemsText^[i];
t:=FntCharsWidth(ps^,StrLen(ps^));
if t>width then width:=t;
end;
width:=width+4;
InitDecimalField(frm,2612,width);
FldDrawField(GetFormObjPtr(frm,2612));
FntSetFont(fnt);
end
else bip;
end;
procedure ListNewItem;
var
buffer : string;
lst : ListPtr;
i : Int16;
itemsText : itemsTextPtr;
num : Int16;
begin
buffer:='';
lst:=GetFormObjPtr(FrmGetActiveForm,2409);
num:=LstGetnumberOfItems(lst);
if num<256 then
if farTextDialog('New Item',buffer,63,false) then
begin
i:=LstGetSelection(lst);
itemsText:=LstGlueGetItemsText(lst);
i:=i+1;
for i:=num-1 downto i do
itemsText^[i+1]:=itemsText^[i];
itemsText^[i]:=MemPtrNew(StrLen(buffer)+1);
itemsText^[i]^:=buffer;
LstSetListChoices(lst,itemsText,num+1);
LstSetSelection(lst,i);
LstDrawList(lst);
end;
end;
procedure ListEditItem;
var buffer : string;
lst : ListPtr;
sel : Int16;
itemsText:ItemsTextPtr;
begin
lst:=GetFormObjPtr(FrmGetActiveForm,2409);
sel:=LstGetSelection(lst);
if sel>=0 then
begin
itemsText:=LstGlueGetItemsText(lst);
buffer:=itemstext^[sel]^;
if FarTextDialog('Edit Item',buffer,63,false) then
begin
MemPtrFree(itemsText^[sel]);
itemsText^[sel]:=MemPtrNew(StrLen(buffer)+1);
itemsText^[sel]^:=buffer;
// I don't understand why the following line is required
LstSetListChoices(lst,itemstext,LstGetNumberOfItems(lst));
LstDrawList(lst);
end;
end
else bip;
end;
procedure ListDelItem;
var
lst : ListPtr;
itemsText : ItemsTextPtr;
num: Int16;
sel: Int16;
i : Int16;
begin
lst:=GetFormObjPtr(FrmGetActiveForm,2409);
itemsText:=LstGlueGetItemsText(lst);
num:=LstGetNumberOfItems(lst);
if num>0 then
begin
sel:=LstGetSelection(lst);
for i:=sel to num-2 do itemsText^[i]:=itemsText^[i+1];
num:=num-1;
LstSetListChoices(lst,itemsText,num);
if sel=num then LstSetSelection(lst,sel-1);
LstDrawList(lst);
end
else bip;
end;
function ListEventHandler(var event:eventType):boolean;
var
frm : FormPtr;
begin
pushregs;
ListEventHandler:=false;
if not farListHardButtonsEventHandler(event,ListEditItem) then
case event.eType of
ctlSelectEvent:
case event.ctlSelect.ControlID of
2601: // OK
begin
frm:=FrmGetActiveForm;
ListEventHandler:= not (
CheckField(frm,2607) and
CheckField(frm,2612) and
CheckField(frm,2608) and
CheckField(frm,2613) and
CheckField(frm,2619) );
end;
2621: // calc width
begin
ListCalcWidth;
ListEventHandler:=true;
end;
2618: // New
begin
ListNewItem;
ListEventHandler:=true;
end;
2617: // Del
begin
ListDelItem;
ListEventHandler:=true;
end;
// 2401: // Edit
// begin
// ListEditItem;
// ListEventHandler:=true;
// end;
end;
KeyDownEvent:;
end;
popregs;
end;
procedure ListDialog;
var
frm : FormPtr;
pl : ^ListType;
ls : ListType;
i : Int16;
ps1, ps2 : StringPtr;
begin
frm:=FrmInitForm(2600);
FrmSetEventHandler(frm,ListEventHandler);
if ObjectP<>nil then
begin
pl:=ObjectP;
ls:=pl^;
end
else MemSet(ls,sizeof(ListType),0);
InitDecimalField(frm,2607,ls.bounds.topleft.y);
InitDecimalField(frm,2608,ls.bounds.topleft.x);
InitDecimalField(frm,2612,ls.bounds.extent.x);
InitDecimalField(frm,2613,ls.bounds.extent.y);
InitDecimalField(frm,2619,ls.id);
SetCheck(frm,2614,ls.attr shr 15);
SetListSel(frm,2615,ls.font);
New(ls.itemsText); // allocate list of items ptr
for i:=0 to ls.numItems-1 do // copy texts if any
begin // not called for new list
ps1:=pl^.itemsText^[i];
ps2:=MemPtrNew(StrLen(ps1^)+1);
ps2^:=ps1^;
ls.itemsText^[i]:=ps2;// not called for new list
end;
LstSetListChoices(GetFormObjPtr(frm,2409),ls.itemsText,ls.numItems);
if FrmDoDialog(frm)=2601 then
begin
if ObjectP<>nil then
begin
// free old texts and itemstext
for i:=0 to pl^.numItems-1 do MemPtrFree(pl^.itemsText^[i]);
dispose(pl^.itemsText);
end
else
begin
ObjectP:=MemPtrNew(sizeof(ListType));
pl:=ObjectP;
MemSet(pl^,sizeof(ListType),0); // v 1.04
end;
with pl^ do
begin
itemsText:=ls.itemsText;
font:=GetListSel(frm,2615);
bounds.topleft.y:=GetDecimal(frm,2607);
bounds.topleft.x:=GetDecimal(frm,2608);
bounds.extent.x:=GetDecimal(frm,2612);
bounds.extent.y:=GetDecimal(frm,2613);
id:=GetDecimal(frm,2619);
attr:=GetCheck(frm,2614) shl 15;
numItems:=LstGetnumberOfItems(GetFormObjPtr(frm,2409));
end;
end;
FrmDeleteForm(frm);
end;
//-------------
// scroll Bar
//-------------
function ScrollBarEventHandler(var event:eventType):boolean;
var frm : FormPtr;
begin
pushregs;
ScrollBarEventHandler:=false;
if event.etype = ctlSelectEvent then
begin
if event.ctlSelect.ControlID=2719 then
begin
frm:=FrmGetActiveForm;
ScrollBarEventHandler:=not (
CheckField(frm,2701) and
CheckField(frm,2704) and
CheckField(frm,2707) and
CheckField(frm,2708) and
CheckField(frm,2710) and
CheckField(frm,2712) and
CheckField(frm,2714) and
CheckField(frm,2716) and
CheckField(frm,2720) );
end;
end;
popregs;
end;
procedure ScrollBarDialog;
var
frm : FormPtr;
ps : ^ScrollBarType;
sb : ScrollBarType;
begin
frm:=FrmInitForm(2700);
FrmSetEventHandler(frm,ScrollBarEventHandler);
if ObjectP<>nil then
begin
ps:=ObjectP;
sb:=ps^;
end
else MemSet(sb,sizeof(ScrollBarType),0);
InitDecimalField(frm,2701,sb.bounds.topleft.y);
InitDecimalField(frm,2704,sb.bounds.topleft.x);
InitDecimalField(frm,2707,sb.bounds.extent.x);
InitDecimalField(frm,2708,sb.bounds.extent.y);
InitDecimalField(frm,2710,sb.id);
InitDecimalField(frm,2712,sb.value);
InitDecimalField(frm,2714,sb.minvalue);
InitDecimalField(frm,2716,sb.maxvalue);
InitDecimalField(frm,2720,sb.pagesize);
SetCheck(frm,2717,sb.attr shr 15);
if FrmDoDialog(frm)=2719 then
begin
if ObjectP=nil then
begin
ObjectP:=MemPtrNew(sizeof(ScrollBarType));
ps:=ObjectP;
MemSet(ps^,sizeof(ScrollBarType),0); // v 1.04
end;
with ps^ do
begin
bounds.topleft.y:=GetDecimal(frm,2701);
bounds.topleft.x:=GetDecimal(frm,2704);
bounds.extent.y:=GetDecimal(frm,2708);
bounds.extent.x:=GetDecimal(frm,2707);
id:=GetDecimal(frm,2710);
value:=GetDecimal(frm,2712);
minvalue:=GetDecimal(frm,2714);
maxvalue:=GetDecimal(frm,2716);
pagesize:=GetDecimal(frm,2720);
attr:=GetCheck(frm,2717) shl 15;
end;
end;
FrmDeleteForm(frm);
end;
//-----------------------
// Table dialog
//-----------------------
const ColumnWidth = 'Column Width';
procedure TableEditCol;
var
buffer : string[9];
pc : TableColumnAttrsPtr;
sel : Int16;
lst : ListPtr;
begin
lst:=GetFormObjPtr(FrmGetActiveForm,2409);
sel:=LstGetSelection(lst);
if sel>=0 then
begin
pc:=LstGlueGetItemsText(lst);
StrIToA(buffer,pc^[sel].width);
if FarTextDialog(ColumnWidth,buffer,3,true) then
begin
pc^[sel].width:=StrAToI(buffer);
LstDrawList(lst);
end;
end;
end;
procedure TableNewCol;
var
buffer : String[9];
lst : ListPtr;
i,num : Int16;
pc : TableColumnAttrsPtr;
begin
buffer:='0';
lst:=GetFormObjPtr(FrmGetActiveForm,2409);
num:=LstGetNumberOfItems(lst);
if num<16 then
if FarTextDialog('Column Width',buffer,3,true) then
begin
i:=LstGetSelection(lst);
pc:=LstGlueGetItemsText(lst);
i:=i+1;
for i:=num-1 downto i do pc^[i+1]:=pc^[i];
pc^[i].width:=StrAToI(buffer);
LstSetListChoices(lst,pc,num+1);
LstSetSelection(lst,i);
LstDrawList(lst);
end;
end;
procedure TableDelCol;
var lst : ListPtr;
pc : TableColumnAttrsPtr;
num,sel,i : Int16;
begin
lst:=GetFormObjPtr(FrmGetActiveForm,2409);
pc:=LstGlueGetItemsText(lst);
num:=LstGetNumberOfItems(lst);
if num>0 then
begin
sel:=LstGetSelection(lst);
for i:=sel to num-2 do pc^[i]:=pc^[i+1];
num:=num-1;
LstSetListChoices(lst,pc,num);
if sel=num then LstSetSelection(lst,sel-1);
LstDrawList(lst);
end
else bip;
end;
function TableEventHandler(var event:eventType):boolean;
var
frm : FormPtr;
ps : StringPtr;
rows : Int16;
begin
pushregs;
TableEventHandler:=false;
if not farListHardButtonsEventHandler(event,TableEditCol) then
case event.etype of
ctlselectEvent:
case event.ctlSelect.ControlID of
3318:
begin
frm:=FrmGetActiveForm;
if CheckField(frm,3312) then
begin
ps:=FldGetTextPtr(GetFormObjPtr(frm,3312));
rows:=StrAToI(ps^);
if (rows<=0) or (rows>24) then
begin
TableEventHandler:=true;
bip;
FrmSetFocus(frm,FrmGetObjectIndex(frm,3312));
end
else TableEventHandler:= not (
CheckField(frm,3305) and
CheckField(frm,3301) and
CheckField(frm,3308) and
CheckField(frm,3309) );
end
else TableEventHandler:=true;
end;
// 2401: // edit
// begin
// TableEditCol;
// TableEventHandler:=true;
// end;
3316: // del
begin
TableDelCol;
TableEventHandler:=true;
end;
3317: // new
begin
TableNewCol;
TableEventHandler:=true;
end;
end;
end;
popregs;
end;
procedure TableListDrawItem(itemnum:Int16;var bounds:RectangleType;p:pointer);
var
pc : TableColumnAttrsPtr;
buffer : String[7];
begin
pushregs;
pc:=p;
StrVPrintf(buffer,'#%d',itemNum);
windrawchars(buffer,StrLen(buffer),bounds.topleft.x,bounds.topleft.y);
StrIToA(buffer,pc^[itemnum].width);
windrawchars(buffer,StrLen(buffer),bounds.topleft.x+30,bounds.topleft.y);
popregs;
end;
procedure TableDialog;
var
frm : FormPtr;
pt : ^TableType;
tb : TableType;
i : Int16;
lst : ListPtr;
k : Int16;
begin
frm:=FrmInitForm(3300);
FrmSetEventHandler(frm,TableEventHandler);
if ObjectP<>nil then
begin
pt:=ObjectP;
tb:=pt^;
end
else Memset(tb,sizeof(TableType),0);
// initialises attrs
new(tb.columnAttrs);
new(tb.rowAttrs);
new(tb.items);
if ObjectP<>nil then
begin
// MemMove(tb.columnAttrs^,pt^.columnAttrs,sizeof(TableColumnAttrType)*tb.numColumns);
for i:=0 to tb.numColumns-1 do tb.columnattrs^[i]:=pt^.columnAttrs^[i];
for i:=0 to tb.numRows-1 do tb.rowAttrs^[i]:=pt^.rowAttrs^[i];
for i:=0 to tb.numColumns*tb.numRows-1 do tb.items^[i]:=pt^.items^[i];
end
else
begin
MemSet(tb.columnAttrs^,sizeof(TableColumnAttrsType),0);
MemSet(tb.rowAttrs^,sizeof(TablerowAttrsType),0);
MemSet(tb.items^,sizeof(TableItemsType),0);
end;
// initialise fields
InitDecimalField(frm,3305,tb.bounds.topleft.y);
InitDecimalField(frm,3301,tb.bounds.topleft.x);
InitDecimalField(frm,3308,tb.bounds.extent.x);
InitDecimalField(frm,3303,tb.bounds.extent.y);
InitDecimalField(frm,3309,tb.id);
InitDecimalField(frm,3312,tb.numRows);
SetCheck(frm,3311,(tb.attr shr 14) and 1);
// initialise list
lst:=GetFormObjPtr(frm,2409);
LstSetDrawFunction(lst,TableListDrawItem);
LstSetListChoices(lst,tb.ColumnAttrs,tb.numColumns);
if FrmDoDialog(frm)=3318 then
begin
if ObjectP<>nil then
begin
MemPtrFree(pt^.columnAttrs);
MemPtrFree(pt^.rowAttrs);
MemPtrFree(pt^.items);
end
else
begin
new(pt);
ObjectP:=pt;
pt^:=tb;
end;
with pt^ do
begin
columnAttrs:=tb.columnAttrs;
rowAttrs:=tb.rowAttrs;
items:=tb.items;
bounds.topleft.y:=GetDecimal(frm,3305);
bounds.topleft.x:=GetDecimal(frm,3301);
bounds.extent.x:=GetDecimal(frm,3308);
bounds.extent.y:=GetDecimal(frm,3303);
id:=GetDecimal(frm,3309);
numRows:=GetDecimal(frm,3312);
numColumns:=LstGetNumberOfItems(lst);
attr:=GetCheck(frm,3311) shl 14;
// initialise row height
k:=bounds.extent.y div numRows;
for i:=0 to numRows-1 do rowAttrs^[i].height:=k;
end;
end;
FrmDeleteForm(frm);
end;
//------------------------
// Graphic control Dialog
//------------------------
function GraphicControlEventHandler(var event:eventType):boolean;
var
frm:FormPtr;
begin
pushregs;
GraphicControlEventHandler:=false;
if event.eType=ctlSelectEvent then
if event.ctlSelect.ControlID=4411 then
begin
frm:=FrmGetActiveForm;
GraphicControlEventHandler:= not (
CheckField(frm,4401) and
CheckField(frm,4403) and
CheckField(frm,4405) and
CheckField(frm,4408) and
CheckField(frm,4410) and
CheckField(frm,4426) and
CheckField(frm,4420) and
CheckField(frm,4424) );
end;
end;
procedure GraphicControlDialog;
var
frm : FormPtr;
pg : ^GraphicControlType;
gc : GraphicControlType;
lststyle,lstframe : ListPtr;
begin
frm:=FrmInitForm(4400);
FrmSetEventHandler(frm,GraphicControlEventHandler);
if ObjectP<>nil then
begin
pg:=ObjectP;
gc:=pg^;
end
else MemSet(gc,sizeof(GraphicControlType),0);
InitDecimalField(frm,4403,gc.bounds.topleft.y);
InitDecimalField(frm,4405,gc.bounds.topleft.x);
InitDecimalField(frm,4408,gc.bounds.extent.x);
InitDecimalField(frm,4410,gc.bounds.extent.y);
InitDecimalField(frm,4426,gc.group);
InitDecimalField(frm,4401,gc.id);
InitDecimalField(frm,4420,gc.BitmapID);
InitDecimalField(frm,4424,gc.SelectedBitmapID);
SetCheck(frm,4422,(gc.attr shr 14) and 1);
SetCheck(frm,4423,(gc.attr shr 11) and 1);
SetCheck(frm,4419, gc.attr shr 15);
SetCheck(frm,4416,(gc.attr shr 12) and 1);
lststyle:=GetFormObjPtr(frm,4415);
lstframe:=GetFormObjPtr(frm,4418);
LstSetSelection(lstframe,(gc.attr shr 8) and 7);
LstSetSelection(lststyle,ord(gc.style));
if FrmDoDialog(frm)=4411 then
begin
if ObjectP=nil then
begin
new(pg);
ObjectP:=pg;
end;
with pg^ do
begin
attr:=$40 + // graphical
(GetCheck(frm,4422) shl 14) +
(GetCheck(frm,4423) shl 11) +
(GetCheck(frm,4419) shl 15) +
(GetCheck(frm,4416) shl 12) +
(LstGetSelection(lstframe) shl 8);
id:=GetDecimal(frm,4401);
bounds.topleft.y:=GetDecimal(frm,4403);
bounds.topleft.x:=GetDecimal(frm,4405);
bounds.extent.x:=GetDecimal(frm,4408);
bounds.extent.y:=GetDecimal(frm,4410);
group:=GetDecimal(frm,4426);
BitmapID:=GetDecimal(frm,4420);
SelectedBitmapID:=GetDecimal(frm,4424);
style:=StyleLstGetSelection(lstStyle);
end;
end;
FrmDeleteForm(frm);
end;
//------------------------
// Slider ontrol Dialog
//------------------------
function SliderEventHandler(var event:eventType):boolean;
var
frm:FormPtr;
begin
pushregs;
SliderEventHandler:=false;
if event.eType=ctlSelectEvent then
if event.ctlSelect.ControlID=4511 then
begin
frm:=FrmGetActiveForm;
SliderEventHandler:= not (
CheckField(frm,4501) and
CheckField(frm,4503) and
CheckField(frm,4505) and
CheckField(frm,4508) and
CheckField(frm,4510) and
CheckField(frm,4520) and
CheckField(frm,4524) and
CheckField(frm,4528) and
CheckField(frm,4530) and
CheckField(frm,4517) and
CheckField(frm,4526) );
end;
popregs;
end;
procedure SliderDialog;
var frm : FormPtr;
ps : ^SliderControlType;
sc : SliderControlType;
begin
frm:=FrmInitForm(4500);
frmSetEventHandler(frm,SliderEventHandler);
if ObjectP<>nil then
begin
ps:=ObjectP;
sc:=ps^;
end
else MemSet(sc,sizeof(SliderControlType),0);
InitDecimalField(frm,4501,sc.id);
InitDecimalField(frm,4503,sc.bounds.topleft.y);
InitDecimalField(frm,4505,sc.bounds.topleft.x);
InitDecimalField(frm,4508,sc.bounds.extent.x);
InitDecimalField(frm,4510,sc.bounds.extent.y);
InitDecimalField(frm,4520,sc.thumbID);
InitDecimalField(frm,4524,sc.backgroundID);
InitDecimalField(frm,4528,sc.MinValue);
InitDecimalField(frm,4530,sc.MaxValue);
InitDecimalField(frm,4517,sc.PageSize);
InitDecimalField(frm,4526,sc.Value);
SetCheck(frm,4519,sc.attr shr 15);
SetCheck(frm,4516,(sc.attr shr 14) and 1);
SetCheck(frm,4514,ord(sc.style=FeedBackSliderCtl));
if frmDoDialog(frm)=4511 then
begin
if ObjectP=nil then
begin
new(ps);
ObjectP:=ps;
end;
with ps^ do
begin
id:=GetDecimal(frm,4501);
bounds.topleft.y:=GetDecimal(frm,4503);
bounds.topleft.x:=GetDecimal(frm,4505);
bounds.extent.x:=GetDecimal(frm,4508);
bounds.extent.y:=GetDecimal(frm,4510);
ThumbID:=GetDecimal(frm,4520);
BackgroundID:=GetDecimal(frm,4524);
MinValue:=GetDecimal(frm,4528);
MaxValue:=GetDecimal(frm,4530);
PageSize:=GetDecimal(frm,4517);
Value:=GetDecimal(frm,4526);
if GetCheck(frm,4514)=0 then style:=SliderCtl
else style:=FeedbackSliderCtl;
attr:=$40+ (GetCheck(frm,4519) shl 15) +
(GetCheck(frm,4516) shl 14);
// set vertical bit
if bounds.extent.x<bounds.extent.y then attr:=attr + $20;
end;
end;
frmDeleteForm(frm);
end;
// load form from pointer
//------------------------
// returns memory size of object
// data offset are relatve to base pointer
// absolute when loaded in memory
// resource based in resource
function SizeObject(object:FormObjectType;base:pointer):integer;
var s : integer;
pw : MemoryWord;
begin
case object.objectType of
frmFieldObj:s:=Sizeof(FieldType);
frmControlObj:
begin
pw.p:=base;
object.w.i:=object.w.i+pw.i;
if (object.control^.style=SliderCtl) or
(object.control^.style=FeedbackSliderCtl) then
s:=sizeof(SliderControlType)
else s:=Sizeof(ControlType);
end;
frmListObj:s:=Sizeof(ListType);
frmTableObj:s:=Sizeof(TableType);
frmBitmapObj:s:=Sizeof(FormBitmapType);
frmLabelObj:s:=Sizeof(FormLabelType);
frmTitleObj:s:=Sizeof(FormTitleType);
frmPopupObj:s:=Sizeof(FormPopupType);
frmGraffitiStateObj:s:=Sizeof(frmGraffitiStateType);
frmGadgetObj:s:=Sizeof(FormGadgetType);
frmScrollbarObj:s:=Sizeof(ScrollBarType);
end;
SizeObject:=s;
end;
function GetFormTitle(p:pointer):StringPtr;
label 10;
var pw,pv : MemoryWord;
pf : ^FormType;
pa : FormObjArrayPtr;
i : Int16;
begin
pv.p:=p;
pf:=p;
pw.i:=pv.i+SizeOf(FormType);
pa:=pw.p;
for i:=0 to pf^.numObjects-1 do with pa^[i] do
begin
if objectType=frmTitleObj then
begin
pw.i:=pv.i+w.i+sizeof(FormTitleType);
GetFormTitle:=pw.p;
goto 10;
end;
end;
GetFormTitle:=nil;
10:
end;
// set name of the object
procedure ObjectName(var name:string;const object:FormObjectType);
label 10,11;
begin
if object.objectType=frmControlObj then
case object.control^.style of
SliderCtl: goto 10;
FeedbackSliderCtl : goto 10;
else
begin
if (object.control^.attr and $0040)<>0 then
name:='Graphic' else
// goto 11;
10: name:=ControlNames[object.control^.style];
end;
end
else 11: name:=FormObjectsNames[object.objectType];
end;
// return object ID $ffff if none
function ObjectID(const obj:FormObjectType):UInt16;
begin
case obj.objectType of
frmTitleObj,frmGraffitiStateObj,frmPopupObj:
ObjectID:=$ffff;
frmBitmapObj:
begin
ObjectID:=obj.bitmap^.RscID;
end;
frmScrollBarObj:
begin
ObjectID:=obj.scrollbar^.id;
end;
else
begin
ObjectID:=obj.control^.id;
end;
end;
end;
// callback list drawing item procedure
procedure ControlListDraw(itemnum:Int16;var bounds:RectangleType;p:pointer);
//label 10;
var pf : ^FormType;
buffer : string[15];
obj : FormObjectType;
id : UInt16;
x : Coord;
begin
pushregs;
pf:=p;
obj:=pf^.Objects^[itemnum];
ObjectName(buffer,obj);
WinDrawChars(buffer,StrLen(buffer),bounds.topleft.x,bounds.topleft.y);
id:=ObjectID(obj);
if id<>$ffff then
begin
// case obj.objectType of
// frmTitleObj,frmGraffitiStateObj,frmPopupObj:;
// frmBitmapObj:
// begin
// id:=obj.bitmap^.RscID;
// goto 10;
// end;
// frmScrollBarObj:
// begin
// id:=obj.scrollbar^.id;
// goto 10;
// end;
// else
// begin
// Id:=obj.control^.id;
//10:
if bounds.topleft.x+bounds.extent.x<83 then
begin
buffer:='...';
x:=73;
end
else
begin
StrIToA(buffer,id);
x:=bounds.topleft.x+84-5*StrLen(buffer);
end;
WinDrawChars(buffer,StrLen(buffer),x,bounds.topleft.y);
end;
popregs;
end;
// pd (dest) and ps (source) are pointer to Form object
// initialise data field of pd with those from ps
function InitObject(var d : FormObjectType;s:pointer):FormObjectPtr;
var pw : MemoryWord;
ps : StringPtr;
i : Int16;
size : integer;
begin
pw.p:=s;
case d.objectType of
FrmTitleObj: with d.title^ do
begin
pw.i:=pw.i+SizeOf(FormTitleType);
text:=MemPtrNew(StrLen(pw.ps^)+1);
if text<>nil then text^:=pw.ps^;
end;
FrmLabelObj: with d.FormLabel^ do
begin
pw.i:=pw.i+SizeOf(FormLabelType);
text:=MemPtrNew(length(pw.ps^)+1);
if text<>nil then text^:=pw.ps^;
end;
FrmControlObj: with d.control^ do
if (attr and $0040)=0 then
begin // for non graphic controls only
pw.i:=pw.i+SizeOf(ControlType);
text:=MemPtrNew(length(pw.ps^)+1);
if text<>nil then text^:=pw.ps^;
end;
FrmTableObj: with d.table^ do
begin
new(columnAttrs);
new(rowAttrs);
new(items);
pw.i:=pw.i+Sizeof(TableType);
size:=numColumns*sizeof(TableColumnAttrType);
if size>0 then MemMove(columnAttrs^,pw.p^,size);
pw.i:=pw.i+size;
size:=numRows*sizeof(TableRowAttrType);
if size>0 then MemMove(rowAttrs^,pw.p^,size);
pw.i:=pw.i+size;
size:=numRows*numColumns*sizeof(TableItemType);
if size>0 then MemMove(items^,pw.p^,size);
end;
FrmListObj: with d.list^ do
begin
new(itemsText);
if itemsText<>nil then
begin
pw.i:=pw.i+Sizeof(ListType)+numItems*4;
// MOTOS : numItems>256 not checked !!!
for i:=0 to numItems-1 do
begin
ps:=MemPtrNew(length(pw.ps^)+1);
if ps<>nil then ps^:=pw.ps^;
itemsText^[i]:=ps;
pw.i:=pw.i+length(pw.ps^)+1;
end;
end;
end;
end;
end;
// free title handle of object po
procedure FreeObj(var o:FormObjectType);
var i : Int16;
begin
// free components of the object
case o.objectType of
FrmTitleObj:
MemPtrFree(o.title^.text);
FrmControlObj: with o.control^ do
if (attr and $0040)=0 then MemPtrFree(text);
FrmLabelObj:
MemPtrFree(o.formLabel^.text);
FrmListObj: with o.list^ do
begin
for i:=0 to numItems-1 do
MemPtrFree(itemsText^[i]);
dispose(itemsText);
end;
FrmTableObj: with o.table^ do
begin
dispose(columnAttrs);
dispose(rowAttrs);
dispose(items);
end;
end;
// free the object itself
if o.w.p<>nil then MemPtrFree(o.w.p);
end;
// load object in memory from resource
// dest is the object destination
// p is base object data destination
function LoadObject(var dst:FormObjectType;const src:FormObjectType;base : pointer):pointer;
var s : integer;
q : pointer;
w : MemoryWord;
begin
dst.objectType:=src.objectType;
s:=SizeObject(src,base);
q:=MemPtrNew(s);
dst.w.p:=q;
// compute data origin data
w.p:=base;
w.i:=w.i+src.w.i;
// copy object
MemMove(q^,w.p^,s);
// initialise additional data (text, etc.)
InitObject(dst,w.p);
end;
procedure LoadFormPtr(p : pointer);
label 99;
var
pf,qf : ^FormType;
pObjs, qObjs : FormObjArrayPtr;
w : MemoryWord;
num : UInt16;
i : Int16;
// s : integer;
// q : pointer;
begin
qf:=p;
// allocate form
New(pf);
DataPointer:=pf;
if pf=nil then goto 99;
num:=qf^.numObjects;
MemMove(pf^,qf^,SizeOf(FormType));
// allocate objects table
New(pObjs);
if pObjs=nil then goto 99;
pf^.objects:=pObjs;
w.p:=p;
w.i:=w.i+sizeof(FormType);
qObjs:=w.p;
// initialise objects table
for i:=0 to num-1 do
begin
LoadObject(pObjs^[i],qObjs^[i],p);
end;
99:
end;
procedure NewForm;
var pf :^FormType;
pObjs :FormObjArrayPtr;
begin
new(pf);
MemSet(pf^,Sizeof(FormType),0);
if pf<>nil then new(pf^.objects);
DataPointer:=pf;
end;
// set control title in apropriate field
procedure ControlTitle(redraw:boolean);
var
sel : Int16;
pf :^FormType;
begin
pf:=DataPointer;
sel:=LstGetSelection(GetObjPtr(2409));
if sel>=0 then with pf^.objects^[sel] do
begin
case objectType of
FrmControlObj: with control^ do
if (attr and $0040)=0 then
begin
FldSetFont(GetObjPtr(1525),font);
InitTextFieldID(1525,control^.text^,redraw);
end;
FrmTitleObj:
begin
FldSetFont(GetObjPtr(1525),0);
InitTextFieldID(1525,title^.text^,redraw);
end;
FrmLabelObj: with FormLabel^ do
begin
FldSetFont(GetObjPtr(1525),font);
InitTextFieldID(1525,text^,redraw);
end;
else InitTextFieldID(1525,'',redraw);
end;
end
else InitTextFieldID(1525,'',redraw);
end;
procedure LoadForm;
var
lst : ListPtr;
pf : ^FormType;
num : Int16;
buffer : string[9];
pw : MemoryWord;
k : Int16;
begin
if DataMemPtr<>nil then
begin // if restaured from feature memory
LoadFormPtr(DataMemPtr);
DataMemPtr:=nil;
FarFtrMemFree(1);
end
else if DataHandle<>nil then
begin // of open existing resource
LoadFormPtr(MemHandleLock(DataHandle));
MemHandleUnlock(DataHandle);
end
else
begin // if new resource
NewForm;
end;
// initialise controls
lst:=GetObjPtr(2409);
pf:=DataPointer;
num:=pf^.numObjects;
LstSetListChoices(lst,DataPointer,num);
LstSetDrawFunction(lst,ControlListDraw);
LstSetSelection(lst,-ord(num=0));
// modal CheckBox
CtlSetValue(GetObjPtr(1514),(pf^.window.windowflags shr 13) and 1);
// usable CheckBox
CtlSetValue(GetObjPtr(1513),(pf^.attr shr 31) and 1);
// Savebehind checkbox
CtlSetValue(GetObjPtr(1515),(pf^.attr shr 27) and 1);
// top field
StrIToA(buffer,pf^.window.windowbounds.topleft.y);
InitTextFieldID(1503,buffer,false);
// left field
StrIToA(buffer,pf^.window.windowbounds.topleft.x);
InitTextFieldID(1505,buffer,false);
// width field
StrIToA(buffer,pf^.window.windowbounds.extent.x);
InitTextFieldID(1508,buffer,false);
// height field
StrIToA(buffer,pf^.window.windowbounds.extent.y);
InitTextFieldID(1510,buffer,false);
// Default button
StrIToA(buffer,pf^.defaultButton);
InitTextFieldID(1521,buffer,false);
// Menu bar ID
StrIToA(buffer,pf^.menuRscID);
InitTextFieldID(1520,buffer,false);
// helpID
StrIToA(buffer,pf^.helpRscID);
InitTextFieldID(1519,buffer,false);
// frame field
pw.p:=StrIToH(buffer,pf^.window.frameType);
pw.i:=pw.i+4;
InitTextFieldID(1526,pw.ps^,false);
// title
ControlTitle(false);
// frame popup
case pf^.window.frameType of
$0 : k:=0;
1 : k:=1;
$401 : k:=2;
$702 : k:=3;
$205 : k:=4;
$302 : k:=5;
else k:=-1;
end;
LstSetSelection(GetObjPtr(1527),k);
end;
procedure FreeForm;
var pf : ^FormType;
pObjs : FormObjArrayPtr;
i : Int16;
begin
pf:=DataPointer;
pObjs:=pf^.objects;
for i:=0 to pf^.NumObjects-1 do FreeObj(pObjs^[i]);
MemPtrFree(pObjs);
MemPtrFree(pf);
end;
// returns true size of object obj
// including additionnal data (text, etc.)
// defined in resource
function TrueObjectSize(const obj:FormObjectType):UInt16;
var
ts : UInt16;
j : Int16;
begin
ts:=SizeObject(obj,nil);
with obj do
case ObjectType of
frmControlObj: with control^ do
begin
if (attr and $0040)=0 then ts:=ts+StrLen(text^)+1;
end;
frmTitleObj: with title^ do
begin
ts:=ts+StrLen(text^)+1;
end;
frmLabelObj: with FormLabel^ do
begin
ts:=ts+StrLen(text^)+1;
end;
frmTableObj: with table^ do
begin
ts:=ts+numColumns*sizeof(TableColumnAttrType)+
numRows*sizeof(TableRowAttrType)+
numRows*numColumns*sizeof(TableItemType);
end;
frmListObj: with list^ do
begin
ts:=ts+numItems*4;
for j:=0 to numItems-1 do
ts:=ts+StrLen(itemsText^[j]^)+1;
end;
end;
ts:=ts+(ts and 1); // word alignement
TrueObjectSize:=ts;
end;
// returns total size of compacted form
function TotalSize:Uint16;
var
ts : UInt16;
pf : ^FormType;
i : Int16;
begin
pf:=DataPointer;
ts:=Sizeof(FormType)+6*pf^.numobjects;
for i:=0 to pf^.numObjects-1 do with pf^.objects^[i] do
begin
ts:=ts+TrueObjectSize(pf^.objects^[i]);
end;
//intalert(ts);
TotalSize:=ts;
end;
// write object obj to storage pointer p[offset]
// returns new offset
function WriteObject(p:pointer;offset:integer;const obj:FormObjectType):integer;
var
size:integer;
j : Int16;
begin
size:=SizeObject(obj,nil);
DmWrite(p,offset,obj.w.p,size);
offset:=offset+size;
// additionnal data
with obj do
case objectType of
frmControlObj: with control^ do
if (attr and $0040)=0 then
begin
// clear text pointer
DmSet(p,offset-10,4,0);
// string
size:=StrLen(text^)+1;
DmWrite(p,offset,text,size);
offset:=offset+size;
end;
frmTitleObj: with title^ do
begin
// clear text pointer
DmSet(p,offset-4,4,0);
// string
size:=StrLen(text^)+1;
DmWrite(p,offset,text,size);
offset:=offset+size;
end;
frmLabelObj: with FormLabel^ do
begin
// clear text pointer
DmSet(p,offset-4,4,0);
// string
size:=StrLen(text^)+1;
DmWrite(p,offset,text,size);
offset:=offset+size;
end;
frmTableObj: with table^ do
begin
// clear pointers
DmSet(p,offset-12-sizeof(FieldType),12,0);
// copy column attrs
size:=numColumns*sizeof(TableColumnAttrType);
DmWrite(p,offset,columnAttrs,size);
offset:=offset+size;
size:=numRows*sizeof(TableRowAttrType);
DmWrite(p,offset,rowattrs,size);
offset:=offset+Size;
size:=numRows*numColumns*sizeof(tableItemType);
DmWrite(p,offset,items,size);
offset:=offset+Size;
end;
frmListObj: with list^ do
begin
// clear itemsText pointer
DmSet(p,offset-20,4,0);
// clear itemsText table
size:=numItems*4;
if size>0 then DmSet(p,offset,size,0);
offset:=offset+size;
// write item's texts
for j:=0 to numItems-1 do
begin
size:=StrLen(itemstext^[j]^)+1;
DmWrite(p,offset,itemsText^[j],size);
offset:=offset+size;
end;
end;
end;
if odd(offset) then
begin
DmSet(p,offset,1,0);
offset:=offset+1;
end;
WriteObject:=offset;
end;
// write form to storage pointer
procedure writeForm(p:pointer);
var
offset,size : integer;
pf : ^FormType;
i,j : Int16;
begin
offset:=0;
pf:=DataPointer;
// form but objects pointer
size:=SizeOf(FormType)-4;
DmWrite(p,0,pf,size);
offset:=offset+size;
// objects ptr
DmSet(p,offset,4,0);
offset:=offset+4;
// objects table
size:=6*pf^.NumObjects;
if size<>0 then
begin
DmWrite(p,Offset,pf^.objects,size);
offset:=offset+size;
end;
// objects
for i:=0 to pf^.NumObjects-1 do
begin
// write offset
DmWrite(p,sizeof(FormType)+2+6*i,@offset,4);
// write object
offset:=writeObject(p,offset,pf^.objects^[i]);
{
size:=SizeObject(pf^.objects^[i],nil);
DmWrite(p,offset,pf^.objects^[i].w.p,size);
offset:=offset+size;
// additionnal data
with pf^.objects^[i] do
case objectType of
frmControlObj: with control^ do
if (attr and $0040)=0 then
begin
// clear text pointer
DmSet(p,offset-10,4,0);
// string
size:=StrLen(text^)+1;
DmWrite(p,offset,text,size);
offset:=offset+size;
end;
frmTitleObj: with title^ do
begin
// clear text pointer
DmSet(p,offset-4,4,0);
// string
size:=StrLen(text^)+1;
DmWrite(p,offset,text,size);
offset:=offset+size;
end;
frmLabelObj: with FormLabel^ do
begin
// clear text pointer
DmSet(p,offset-4,4,0);
// string
size:=StrLen(text^)+1;
DmWrite(p,offset,text,size);
offset:=offset+size;
end;
frmTableObj: with table^ do
begin
// clear pointers
DmSet(p,offset-12-sizeof(FieldType),12,0);
// copy column attrs
size:=numColumns*sizeof(TableColumnAttrType);
DmWrite(p,offset,columnAttrs,size);
offset:=offset+size;
size:=numRows*sizeof(TableRowAttrType);
DmWrite(p,offset,rowattrs,size);
offset:=offset+Size;
size:=numRows*numColumns*sizeof(tableItemType);
DmWrite(p,offset,items,size);
offset:=offset+Size;
end;
frmListObj: with list^ do
begin
// clear itemsText pointer
DmSet(p,offset-20,4,0);
// clear itemsText table
size:=numItems*4;
if size>0 then DmSet(p,offset,size,0);
offset:=offset+size;
// write item's texts
for j:=0 to numItems-1 do
begin
size:=StrLen(itemstext^[j]^)+1;
DmWrite(p,offset,itemsText^[j],size);
offset:=offset+size;
end;
end;
end;
if odd(offset) then
begin
DmSet(p,offset,1,0);
offset:=offset+1;
end;
}
end;
end;
// get uint16 data in field id
function getDecimalData(id:UInt16):UInt16;
var ind : UInt16;
ps : StringPtr;
begin
ind:=FrmGetObjectIndex(ActiveForm,id);
ps:=FldGetTextPtr(FrmGetObjectPtr(ActiveForm,ind));
if (ps=nil) or (ps^='') then
begin
Bip;
frmSetFocus(ActiveForm,FrmGetObjectIndex(ActiveForm,id));
fldDrawField(getObjPtr(id));
exit(0);
end;
getDecimalData:=StrAToI(ps^);
end;
function getHexaData(id : UInt16):UInt16;
var i : integer;
begin
if not farGetHexaField(GetObjPtr(id),i) then
begin
Bip;
frmSetFocus(ActiveForm,FrmGetObjectIndex(ActiveForm,id));
fldDrawField(getObjPtr(id));
exit(0);
end;
GetHexaData:=i;
end;
// save data
procedure FormSaveData;
var pf : ^FormType;
ps : StringPtr;
fld : FieldPtr;
begin
pf:=DataPointer;
// top
pf^.window.windowbounds.topleft.y:=GetDecimalData(1503);
// left
pf^.window.windowbounds.topleft.x:=GetDecimalData(1505);
//width
pf^.window.windowbounds.extent.x:=GetDecimalData(1508);
//height
pf^.window.windowbounds.extent.y:=GetDecimalData(1510);
// default button
pf^.defaultButton:=GetDecimalData(1521);
// MenubarID
pf^.menuRscID:=GetDecimalData(1520);
// Help ID
pf^.helpRscID:=GetDecimalData(1519);
// frame
pf^.window.FrameType:=GetHexaData(1526);
// modal check box
if CtlGetValue(GetObjPtr(1514))=0 then
pf^.window.windowflags:=pf^.window.windowflags and not (1 shl 13)
else
pf^.window.windowflags:=pf^.window.windowflags or (1 shl 13);
// usable check box
if CtlGetValue(GetObjPtr(1513))=0 then
pf^.attr:=pf^.attr and not (1 shl 31)
else
pf^.attr:=pf^.attr or (1 shl 31);
// SaveBehind
if CtlGetValue(GetObjPtr(1515))=0 then
pf^.attr:=pf^.attr and not (1 shl 27)
else
pf^.attr:=pf^.attr or (1 shl 27);
// set form id
pf^.formID:=ResID;
end;
// copy resource from srddb to dstdb
procedure CopyResource(dstdb,srcdb:DmOpenRef;restype:UInt32;resid:UInt16);
label 99;
var
s : integer;
srcH,dstH : MemHandle;
ind : UInt16;
rt : soruType;
buffer : string[7];
begin
if resid>=10000 then goto 99;
SrcH:=nil;
ind:=DmFindResource(srcdb,resType,ResID,nil);
if Ind<>$ffff then
srcH:=DmGetResourceIndex(srcdb,Ind);
if srcH=nil then
begin
rt.u:=restype;
rt.s[5]:=chr(0);
StrIToA(buffer,resID);
FrmCustomAlert(1200,rt.s,buffer,nil);
exit(0);
end;
s:=MemHandleSize(srcH);
dstH:=DmNewResource(dstdb,restype,resid,s);
if dstH=nil then exit(0);
DmWrite(MemHandleLock(dstH),0,MemHandleLock(srcH),s);
MemHandleUnlock(dstH);
MemHandleUnlock(srcH);
DmReleaseResource(srcH);
DmReleaseResource(dstH);
99:
end;
function AddRequiredResources(dstdb,srcdb:dmOpenref):boolean;
var pf : ^FormType;
i : Int16;
begin
tag;
pf:=DataPointer;
with pf^ do
begin
// add Help string if any
if HelpRscID<>0 then
CopyResource(dstdb,srcdb,strRsc,pf^.HelprscID);
// add menubar resource
if menurscID<>0 then
CopyResource(dstdb,srcdb,MenuRscType,pf^.MenuRscID);
// search for required bitmap
for i:=0 to numObjects-1 do with objects^[i] do
begin
case ObjectType of
FrmBitmapObj:
// if bitmap^.rscID<10000 then
CopyResource(dstdb,srcdb,bitmaprsc,bitmap^.rscID);
FrmControlObj: with control^ do
if (attr and $40)<>0
then
if (style<SliderCtl) then with graphicControl^ do
begin
if BitmapID<>0 then
CopyResource(dstdb,srcdb,bitmaprsc,BitmapID);
if selectedBitmapID<>0 then
CopyResource(dstdb,srcdb,bitmaprsc,SelectedBitmapID);
end
else with slidercontrol^ do
begin
if ThumbID<>0 then
CopyResource(dstdb,srcdb,bitmaprsc,ThumbID);
if backgroundID<>0 then
CopyResource(dstdb,srcdb,bitmaprsc,backgroundID);
end;
end;
end;
end;
AddRequiredResources:=true;
end;
// returns true if object id exists in form
function IDExists(id:UInt16):boolean;
label 99;
var
pf : ^FormType;
j : Int16;
begin
IDExists:=true;
pf:=DataPointer;
with pf^ do
begin
for j:=0 to numObjects-1 do with objects^[j] do
case ObjectType of
FrmBitmapObj,
frmTitleObj,
frmPopupObj,
frmGraffitiStateObj:;
frmScrollBarObj:if id=ScrollBar^.id then goto 99;
else if id=control^.id then goto 99;
end;
end;
IDExists:=false;
99:
end;
procedure FormPreview(function EventHandler(var event:eventType):boolean);
label 99,98;
var
pf :^FormType;
HelpH : MemHandle;
h : MemHandle;
db : dmOpenRef;
s : integer;
lid : LocalID;
id : UInt16;
frm : FormPtr;
rec : RectangleType;
begin
tag;
pf:=DataPointer;
FormSaveData;
// set usable bit
pf^.Attr:=pf^.Attr or (1 shl 31);
opendb:=DmOpenDatabase(0,seldbid,dmModeReadOnly);
// open temporary database
lid:=DmFindDatabase(0,dbName);
if lid<>0 then DmDeleteDatabase(0,lid);
if DmCreateDatabase(0,dbName,AppCreatorID,TempID,true)<>0 then goto 99;
lid:=DmFindDatabase(0,dbName);
db:=DmOpenDatabase(0,lid,dmModeReadWrite);
s:=TotalSize;
h:=DmNewResource(db,FormRscType,9999,s);
if h=nil then goto 98;
WriteForm(MemHandleLock(h));
MemHandleUnlock(h);
// add required resources if any
if not AddRequiredResources(db,opendb) then goto 98;
//search for a free id for additionnal control
// id:=9999;
// repeat id:=id+1 until not IDExists(id);
Frm:=FrmInitForm(9999);
// DummyCtl:=CtlNewControl(Frm,10000,ButtonCtl,nil,-1,-1,1,1,0,0,false);
// SetDia(frm,true);
FrmSetEventHandler(frm,EventHandler);
// SetDia(frm,true);
RctSetRectangle(rec,0,0,160,160);
WinEraseRectangle(rec,0);
// FrmDoDialog(frm);
PreviewDialog(frm);
// SetDia(frm,true);
// reload form
{ FreeForm;
LoadFormPtr(MemHandleLock(h));
MemHandleUnlock(h);}
DmReleaseResource(h);
FrmDeleteForm(frm);
FrmDrawForm(ActiveForm);
// SetDia(ActiveForm,true);
98:
// close database
DmCloseDatabase(opendb);
opendb:=nil;
DmCloseDatabase(db);
DmDeleteDatabase(0,lid);
99:
end;
// response to 'Del' button
procedure FormDel;
var
pf : ^FormType;
sel : Int16;
buff1 : string[15];
buff2 : string[7];
id : UInt16;
pobj : ^FormObjectType;
i : Int16;
lst : ListPtr;
begin
pf:=DataPointer;
lst:=GetObjPtr(2409);
sel:=LstGetSelection(lst);
if (sel>=0) and not readonlydb then
begin
pobj:=@pf^.objects^[sel];
ObjectName(buff1,pobj^);
id :=ObjectID(pobj^);
buff2:='';
if id<>$ffff then StrIToA(buff2,id);
if FrmCustomAlert(1600,nil,buff1,buff2)=0 then
begin // delete object
FreeObj(pObj^);
// remove from table
for i:=sel+1 to pf^.numObjects-1 do
pf^.objects^[i-1]:=pf^.objects^[i];
// update number of objects
pf^.numObjects:=pf^.numObjects-1;
LstSetListChoices(lst,DataPointer,pf^.numObjects);
// update selection
if sel=pf^.NumObjects then
begin
LstSetSelection(lst,sel-1);
end;
// redraw list
ControlTitle(true);
LstDrawList(lst);
end;
end;
end;
// response to frame popup list
procedure FormFrame(no:Int16);
var
pf:^FormType;
pw : MemoryWord;
buffer : String[9];
begin
pf:=DataPointer;
case no of
0: // no frame
pf^.window.frameType:=$0;
1: // simple frame
pf^.window.frameType:=$1;
2: // round
pf^.window.frameType:=$401;
3: // boldround
pf^.window.frameType:=$702;
4: // popup
pf^.window.frameType:=$205;
5: // dialog
pf^.window.frameType:=$302;
end;
pw.p:=StrIToH(buffer,pf^.window.frametype);
pw.i:=pw.i+4;
InitTextFieldID(1526,pw.ps^,true);
end;
// returns true if there is two objects with the same id
// in this case, assign id
// else returns false
function DuplicateID(var id:UInt16):boolean;
label 99;
var pf : ^FormType;
i,j : Int16;
begin
DuplicateID:=true;
pf:=DataPointer;
with pf^ do
begin
for i:=0 to numObjects-1 do with Objects^[i] do
begin
case ObjectType of
FrmBitmapObj,
frmTitleObj,
frmPopupObj,
frmGraffitiStateObj:id:=$ffff;
frmScrollBarObj:id:=ScrollBar^.id;
else id:=control^.id;
end;
if id<>$ffff then
for j:=i+1 to numObjects-1 do with objects^[j] do
case ObjectType of
FrmBitmapObj,
frmTitleObj,
frmPopupObj,
frmGraffitiStateObj:;
frmScrollBarObj:if id=ScrollBar^.id then goto 99;
else if id=control^.id then goto 99;
end;
end;
end;
DuplicateID:=false;
99:
end;
// response to OK button
procedure FormOK;
label 98,99;
var ind : UInt16; // old resource index
s : integer;
h : MemHandle;
id : UInt16;
buffer : string[7];
begin
if readonlydb then goto 98;
if DuplicateID(id) then
begin
StrIToA(buffer,id);
if FrmCustomAlert(1300,buffer,nil,nil)<>0 then goto 99;
end;
FormSaveData;
// opendb
opendb:=DmOpenDatabase(0,seldbid,dmModeReadWrite);
ind:=DmFIndResource(opendb,resType,resID,nil);
// remove old resource if any
if not Prefs.WasNew then DmRemoveResource(opendb,ind);
// create new resource
s:=TotalSize;
h:=DmNewResource(opendb,resType,resID,s);
if h=nil then goto 98;
WriteForm(MemHandleLock(h));
MemHandleUnlock(h);
// prepare for resource list selection
selrec:=-1;
selRsrcInd:=DmFindResource(opendb,0,0,h);
DmReleaseResource(h);
DmCloseDatabase(opendb);
opendb:=nil;
FrmGotoForm(1100);
goto 99;
98:
Bip;
99:
end;
// response to 'Open' button
procedure FormOpen;
var
pf : ^FormType;
sel : Int16;
pc : ^ControlType;
begin
pf:=DataPointer;
sel:=LstGetSelection(GetObjPtr(2409));
if sel >=0 then
begin
objectP:=pf^.objects^[sel].w.p;
case pf^.objects^[sel].objectType of
frmFieldObj: // field
FieldDialog;
frmControlObj: // control
begin
pc:=pf^.objects^[sel].w.p;
if pc^.style>=sliderCtl then SliderDialog
else if (pc^.attr and (1 shl 6))=0 then ControlDialog
else GraphicControlDialog;
end;
frmListObj: // list
ListDialog;
frmTableObj: // table
TableDialog;
frmBitmapObj: // Form bitmap
FormBitmapDialog;
frmLabelObj: // Label
LabelDialog;
frmTitleObj: // title
TitleDialog;
frmPopupObj: // popup
PopupDialog;
frmGraffitiStateObj: // GraffitiState
GraffitiStateDialog;
frmGadgetObj:
GadgetDialog;
frmScrollBarObj: // Scrollbar
ScrollBarDialog;
end;
ControlTitle(true);
end;
LstDrawList(GetObjPtr(2409));
end;
// Form objects clipboard opearations
//-----------------------------------
// objects are memorised in feature memory
// number 4
// format
// object : FormObjectType with relative reference (offse 6)
// data
//
// copy object
function FormObjCopy:boolean;
label 99;
var
obj : FormObjectType;
ss : string;
s : integer;
pf : ^FormType;
sel : Int16;
p : pointer;
begin
FormObjCopy:=false;
// delete old objectg clipboard
FarFtrMemFree(4);
// get object to copy
pf:=DataPointer;
if pf^.numObjects=0 then goto 99;
sel:=LstGetSelection(GetObjPtr(2409));
if sel<0 then goto 99;
obj:=pf^.objects^[sel];
// allocate
s:=TrueObjectSize(obj);
if FtrPtrNew(AppCreatorID,4,s+6,p)<>0 then goto 99;
// write data
WriteObject(p,6,obj);
obj.w.i:=6;
DmWrite(p,0,@obj,6);
FormObjCopy:=true;
99:
end;
function FormObjPaste:boolean;
label 99;
var
p : MemoryWord;
pf : ^FormType;
po : ^FormObjectType;
lst : ListPtr;
begin
FormObjPaste:=false;
if readonlydb then goto 99;
if FtrGet(AppCreatorID,4,p.u)<>0 then goto 99;
po:=p.p;
pf:=DataPointer;
with pf^ do
begin
if numObjects>511 then goto 99;
LoadObject(objects^[numObjects],po^,p.p);
numObjects:=numObjects+1;
lst:=GetObjPtr(2409);
LstSetListChoices(lst,DataPointer,numObjects);
LstSetSelection(lst,numObjects-1);
ControlTitle(true);
LstDrawList(lst);
end;
formObjPaste:=true;
99:
end;
// cut object
function FormObjCut:boolean;
label 99;
var
lst : ListPtr;
i : Int16;
pf : ^FormType;
sel : Int16;
begin
FormObjCut:=false;
if readonlydb then goto 99;
if not FormObjCopy then goto 99;
pf:=DataPointer;
lst:=GetObjPtr(2409);
sel:=LstGetSelection(lst);
if sel<0 then goto 99;
with pf^ do
begin
// free object
FreeObj(objects^[sel]);
// remove from table
for i:=sel+1 to numObjects-1 do objects^[i-1]:=objects^[i];
numObjects:=numObjects-1;
// update list
lstSetListChoices(lst,DataPointer,numObjects);
if sel=numObjects then lstSetSelection(lst,sel-1);
ControlTitle(true);
LstDrawList(lst);
end;
FormObjCut:=true;
99:
end;
procedure FormNewObj(n:Int16);
var
pf : ^FormType;
lst : ListPtr;
objType : FormObjectKind;
begin
objectP:=nil;
case n of
0: // field
begin
objType:=FrmFieldObj;
FieldDialog;
end;
1: // control
begin
objType:=FrmControlObj;
ControlDialog;
end;
2: // list
begin
objType:=FrmListObj;
ListDialog;
end;
3: // table
begin
objType:=FrmTableObj;
TableDialog;
end;
4: // form bitmap
begin
ObjType:=FrmBitmapObj;
FormBitmapDialog;
end;
5: // label
begin
objType:=FrmLabelObj;
LabelDialog;
end;
6: // title
begin
objType:=FrmTitleObj;
titleDialog;
end;
7: // popup
begin
objType:=FrmPopupObj;
PopupDialog;
end;
8: // GraffitiState
begin
objType:=FrmGraffitiStateObj;
GraffitiStateDialog;
end;
9: // gadget
begin
objType:=FrmGadgetObj;
GadgetDialog;
end;
10: // scrollbar
begin
objType:=FrmScrollBarObj;
ScrollBarDialog;
end;
11: // graphic control
begin
objType:=FrmControlObj;
GraphicControlDialog;
end;
12:
begin
objType:=FrmControlObj;
SliderDialog;
end;
end;
if objectP<>nil then
begin // new object
pf:=DataPointer;
with pf^.objects^[pf^.numObjects] do
begin
objectType:=ObjType;
w.p:=objectP;
end;
Lst:=GetObjPtr(2409);
pf^.numObjects:=pf^.numObjects+1;
LstSetListChoices(lst,DataPointer,pf^.numObjects);
LstSetSelection(lst,pf^.numObjects-1);
ControlTitle(true);
end;
end;
procedure FormSaveContext;
var p:pointer;
begin
prefs.resType:=resType;
FarFtrMemFree(1);
FormSaveData;
if FtrPtrNew(AppCreatorID,1,TotalSize,p)=0 then
begin
WriteForm(p);
end
else
begin
Prefs.FormID:=1000;
end;
end;
// form editor event handler
//--------------------------
function FormEditEventHandler(var event:EventType):boolean;
begin
pushregs;
FormEditEventHandler:=false;
if farListHardButtonsEventHandler(event,FormOpen) then
ControlTitle(true)
else
case event.eType of
frmOpenEvent:
begin
LoadForm;
FrmDrawForm(ActiveForm);
FormEditEventHandler:=true;
end;
frmCloseEvent:
begin
FreeForm;
end;
ctlSelectEvent:
begin
case event.ctlSelect.ControlID of
1501: // preview
begin
FormPreview(EndPreview{PreviewFormEventHandler});
FormEditEventHandler:=true;
end;
1528: // adjust
begin
CurrObjInd:=$ffff;
FormPreview(AdjustEventHandler);
FormEditEventHandler:=true;
end;
1511: // OK
FormOK;
1512: // cancel
begin
FrmGotoForm(1100);
FormEditEventHandler:=true;
end;
// 2401: // open
// FormOpen;
1529: // Del
FormDel;
end;
end;
lstSelectEvent:
if event.lstSelect.listID=2409 then
begin
ControlTitle(true);
FrmSetFocus(ActiveForm,noFocus);
end;
popSelectEvent:
begin
case event.popselect.ListID of
1527 : FormFrame(event.popselect.selection);
1531 :
begin
FormNewObj(event.popselect.selection);
FormEditEventHandler:=true;
end;
end;
FormEditEventHandler:=true;
end;
menuEvent:
begin
case event.menu.itemID of
1100 : FormEditEventHandler:=FormObjCut;
1101 : FormEditEventHandler:=FormObjCopy;
1102 : FormEditEventHandler:=FormObjPaste;
end;
end;
appStopEvent:
begin
FormSaveContext;
FormEditEventHandler:=false;
end;
end;
popregs;
end;
//-------------
// Main
//-------------
begin
FarFormEditEventHandler:=FormEditEventHandler;
FarGetFormTitle:=GetFormTitle;
// FarPreviewFormEventHandler:=PreviewFormEventHandler;
end.
// end of file 'builder3.pas'