Pārlūkot izejas kodu

* First edit attempt for gtk

Michaël Van Canneyt 6 mēneši atpakaļ
vecāks
revīzija
1634f67575
4 mainītis faili ar 243 papildinājumiem un 37 dzēšanām
  1. 79 0
      demo/Edit/editdemo.lpi
  2. 15 0
      demo/Edit/editdemo.lpr
  3. 96 0
      demo/Edit/mainunit.pp
  4. 53 37
      src/base/fresnel.edit.pp

+ 79 - 0
demo/Edit/editdemo.lpi

@@ -0,0 +1,79 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="editdemo"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <CustomData Count="3">
+      <Item0 Name="OpenAPIBase"/>
+      <Item1 Name="OpenAPIConfig"/>
+      <Item2 Name="OpenAPIFile"/>
+    </CustomData>
+    <BuildModes>
+      <Item Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+    </RunParams>
+    <RequiredPackages>
+      <Item>
+        <PackageName Value="Fresnel"/>
+      </Item>
+      <Item>
+        <PackageName Value="FresnelBase"/>
+      </Item>
+    </RequiredPackages>
+    <Units>
+      <Unit>
+        <Filename Value="editdemo.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="mainunit.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="MainUnit"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="editdemo"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir);/home/michael/source/fpgui/src/corelib/"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Debugging>
+        <DebugInfoType Value="dsDwarf3"/>
+      </Debugging>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions>
+      <Item>
+        <Name Value="EAbort"/>
+      </Item>
+      <Item>
+        <Name Value="ECodetoolError"/>
+      </Item>
+      <Item>
+        <Name Value="EFOpenError"/>
+      </Item>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

+ 15 - 0
demo/Edit/editdemo.lpr

@@ -0,0 +1,15 @@
+program editdemo;
+
+uses
+  cthreads,
+  Fresnel, // initializes the widgetset
+  Fresnel.App,
+  MainUnit;
+
+begin
+  FresnelApplication.HookFresnelLog:=true;
+  FresnelApplication.Initialize;
+  FresnelApplication.CreateForm(TMainForm,MainForm);
+  FresnelApplication.Run;
+end.
+

+ 96 - 0
demo/Edit/mainunit.pp

@@ -0,0 +1,96 @@
+unit MainUnit;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Fresnel.Forms, Fresnel.Controls, Fresnel.Events,
+  FCL.Events, Fresnel.Edit;
+
+type
+
+  { TMainForm }
+
+  TMainForm = class(TFresnelForm)
+    Body1: TBody;
+    Div1: TDiv;
+    Label1: TLabel;
+    Edit1 : TEdit;
+    procedure Label1Click(Event: TAbstractEvent);
+  private
+    FBlocked : Boolean;
+  public
+    constructor CreateNew(aOwner: TComponent); override;
+  end;
+
+var
+  MainForm: TMainForm;
+
+implementation
+
+{ TMainForm }
+
+procedure TMainForm.Label1Click(Event: TAbstractEvent);
+begin
+  FBlocked:=Not FBlocked;
+  if FBlocked then
+    Label1.Caption:='Allow typing'
+  else
+    Label1.Caption:='Block typing';
+end;
+
+constructor TMainForm.CreateNew(aOwner: TComponent);
+begin
+  inherited CreateNew(aOWner);
+  Caption:='Edit demo';
+  FormLeft:= 450;
+  FormTop:= 300;
+  FormWidth := 350;
+  FormHeight := 255;
+  Stylesheet.Text:=
+    'div {'+
+    '  padding: 3px; '+
+    '  border: 2px solid black; '+
+    '  margin: 6px;'+
+    '}';
+  Body1:=TBody.Create(Self);
+  Body1.Parent:=Self;
+  Body1.Style:='border: 2px solid blue;'#10;
+  Body1.Name:='Body1';
+  Div1:=TDiv.Create(Self);
+  Div1.Parent:=Body1;
+  Div1.Style:='background-color: blue;'#10'border-color: black;'#10'height:30px;';
+  Div1.Name:='Div1';
+  Label1:=TLabel.Create(Self);
+  Label1.Parent:=Div1;
+  With Label1 do
+    begin
+    Name:='Label1';
+    Style := 'color: red;';
+    Caption := 'Block typing';
+    OnClick := @Label1Click;
+    end;
+  Stylesheet.Add('div {'
+    //+'  background:#44cc66;'
+    +'  background:linear-gradient(#ededed, #bab1ba);'
+    +'  border:7px solid #18ab29;'
+    +'  padding:16px 31px;'
+    +'  font-size:15px; '
+    +'  font-family:Arial; '
+    + ' font-weight:bold;'
+    +'  text-shadow: 0 1 1 #333;'
+    +'  color:#fff;'
+    +'}'
+    +'div:hover {'
+    +'  background:#88bb22;'
+    +'};');
+ Edit1:=TEdit.Create(Self);
+ Edit1.Name:='Edit1';
+ Edit1.Value:='Edit1';
+ Edit1.Parent:=Body1;
+ Edit1.Style:='font-size:15px; family:Arial; background-color: yellow;'#10'border-color: black;'#10; // 'height:30px;width: 100px;';
+ Edit1.Focus;
+end;
+
+end.

+ 53 - 37
src/base/fresnel.edit.pp

@@ -174,18 +174,8 @@ end;
 procedure TEdit.DoDeleteSelection;
 
 begin
-  if FSelectionStart=FSelectionEnd then
-    exit;
-  if FSelectionStart > FSelectionEnd then
-    begin
-    Delete(FValue,1 + FSelectionEnd, FSelectionStart-FSelectionEnd);
-    FSelectionStart:=FSelectionEnd;
-    end
-  else
-    begin
-    Delete(FValue,1 + FSelectionStart, FSelectionEnd-FSelectionStart);
-    FSelectionEnd:=FSelectionStart;
-    end;
+  NormalizeSelection;
+  Delete(FValue,1 + FSelectionStart,FSelectionStart-FSelectionEnd);
   EditParamsChanged;
 end;
 
@@ -305,9 +295,9 @@ begin
           else
             lOffset:=-1; // Todo: calc length of codepoint in bytes
           FCursorPos:=FCursorPos+lOffset;
-          FSelectionEnd:=FCursorPos;
+          FSelectionStart:=FCursorPos;
           if not aEvent.ShiftKey then
-            FSelectionStart:=FSelectionEnd;
+            FSelectionEnd:=FSelectionStart;
           end;
         end;
       TKeyCodes.ArrowRight :
@@ -355,8 +345,18 @@ begin
   lNewPos:=CalcCharOffset(aEvent.ControlX);
   if FCursorPos<>lNewPos then
     begin
+    NormalizeSelection;
+    // Outside current: extend in correct direction
+    if lNewPos<FSelectionStart then
+      FSelectionStart:=lNewPos
+    else if lNewPos>FSelectionEnd then
+      FSelectionEnd:=lNewPos
+    // Between : shrink in correct direction
+    else if lNewPos<FCursorPos then
+      FSelectionEnd:=lNewPos
+    else
+      FSelectionStart:=lNewPos;
     FCursorPos:=lNewPos;
-    FSelectionEnd:=FCursorPos;
     EditParamsChanged;
     end;
 end;
@@ -425,7 +425,7 @@ end;
 
 function TEdit.GetSelectionText: String;
 begin
-  Result:=UTF8Copy(FValue,FSelectionStart,FSelectionEnd-FSelectionStart);
+  Result:=UTF8Copy(FValue,FSelectionStart+1,FSelectionEnd-FSelectionStart);
 end;
 
 procedure TEdit.Blink(aVisible: Boolean);
@@ -443,10 +443,12 @@ end;
 class function TEdit.CalcCharSize(aFont : IFresnelFont; aUnicodeChar: String) : TFresnelLength;
 
 begin
-  if IsSpecialChar(aUnicodeChar) then
-    Result:=aFont.TextSize('W'+aUnicodeChar+'W').x-aFont.TextSize('WW').X
-  else
-    Result:=aFont.TextSize(aUnicodeChar).x;
+  Result:=aFont.TextSize(aUnicodeChar).x;
+  if Result=0 then
+    begin
+    Result:=aFont.TextSize('W'+aUnicodeChar+'W').x-aFont.TextSize('WW').X;
+    // Writeln(aUnicodeChar,' Result 0 -> ',Result)
+    end;
 end;
 
 procedure TEdit.CalcTextDrawInfo;
@@ -461,13 +463,24 @@ var
   lFirstVisibleIndex,lLastVisibleIndex: integer; // visible characters' start/end in utf-8 string, bytes
   lText: string; // text to draw.
   bestfx, bestlx: TFresnelLength;
-  lCharX: TFresnelLength;   // character X position relative to widget
+  lPrevCharX,lCharX: TFresnelLength;   // character X position relative to widget
   lTotalWidth: TFresnelLength;    // total characters width, that becomes FCursorPx relative to the beginning of the text
   lPreviousWidth: TFresnelLength;   // total width on the previous step
   lVisibleStartX, lVisibleEndX: TFresnelLength;    // visible area start and end, pixels
   lLeftSideMargin,lRightSideMargin : TFresnelLength;
   lFont : IFresnelFont;
 
+  procedure AdjustSelection;
+
+  begin
+    // Writeln('Selection match start (',lCharNum,' = ',FSelectionStart,'): ',lCharNum = FSelectionStart,' end (',lCharNum,'=',FSelectionEnd,'): ',lCharNum = FSelectionEnd,' pos, ',lPrevCharX:5:2);
+    if lCharNum = FSelectionStart then
+      FSelectionStartX := lPrevCharX;
+    if lCharNum = FSelectionEnd then
+      FSelectionEndX := lPrevCharX;
+  end;
+
+
 begin
   lFont:=GetFont;
   lLeftSideMargin:=GetComputedLength(fcaPaddingLeft);
@@ -482,24 +495,23 @@ begin
   lText := GetDrawText;
   lUnicodeChar := '';
   lTotalWidth := 0.0;
-  lPos  := 0;
+  lPos  := 1;
   lCharNum := 0;
   FDrawOffset := 0;
   while lPos <= Length(ltext) do
   begin
     lPrevPos := lPos;
+    lPrevCharX := lCharX;
     lpos := UTF8CharAtBytePos(lText, lpos, lUnicodeChar);
     lPreviousWidth := lTotalWidth;
+    // Writeln(lPos,': "',lUnicodeChar,'" -> ',CalcCharSize(lFont, lUnicodeChar),' width');
     lTotalWidth  := lTotalWidth + CalcCharSize(lFont, lUnicodeChar);
-    // Character position relative to edit margin. Text offset was calculated using cursor position.
-    lCharX := lTotalWidth - FTextOffset + lLeftSideMargin;
+    // lTotalWidth  := CalcCharSize(lFont, copy(lText,1,lPos-1));
+    // Character position relative to edit origin. Text offset was calculated using cursor position.
+    lCharX := lLeftSideMargin + lTotalWidth - FTextOffset;
+    AdjustSelection;
 
     // Adjust selection coordinates
-    if lCharNum = FSelectionStart then
-      FSelectionStartX := lCharX;
-    if lCharNum = FSelectionEnd then
-      FSelectionEndX := lCharX;
-
     // search for the first/last visible characters
     if abs(lCharX - lVisibleStartX) < abs(bestfx - lVisibleStartX) then
       begin
@@ -515,24 +527,29 @@ begin
       end
     else
       begin
-      Writeln('Premature break at ',lCharNum);
       break; // we can safely break after last visible character is found
       end;
     Inc(lCharNum);
     end;
+  // Writeln('Done: ',FSelectionStartX:5:2,' - ',FSelectionEndX:5:2);
+  lPrevCharX:=lCharX;
+  AdjustSelection;
 
   if FSelectionStartX < lVisibleStartX then
     FSelectionStartX := lVisibleStartX;
+  if FSelectionEndX < lVisibleStartX then
+    FSelectionEndX := lVisibleStartX;
   if FSelectionEndX > lVisibleEndX then
     FSelectionEndX := lVisibleEndX;
+  if FSelectionStartX >lVisibleEndX then
+    FSelectionStartX := lVisibleEndX;
 
   FVisibleText := Copy(lText, lFirstVisibleIndex, lLastVisibleIndex - lFirstVisibleIndex);
   FDrawOffset := FTextOffset - FDrawOffset;
-  Write('Value : "',FValue,'", Visible : "',FVisibleText,'"');
-  Write(', Sel: [',FSelectionStart,' - ',FSelectionEnd,']');
-  Write(', SelX: [',FSelectionStartX,' - ',FSelectionEndX,']');
-  WriteLn(', Cur: ',FCursorPos,', Cur X:  [',FCursorX,']');
 
+  // Write('Value: "',FValue,'", Visible: "',FVisibleText,'"');
+  // Write(', Sel: [Char:',FSelectionStart:2,' -',FSelectionEnd:5,', Pos:',FSelectionStartX:5:2,' -',FSelectionEndX:5:2,']');
+  // WriteLn(', Cur: [Char:',FCursorPos:2,', Pos:',FCursorX:5:2,']');
 end;
 
 Function TEdit.CalcCharOffset(aXOffset: TFresnelLength) : Integer;
@@ -566,6 +583,7 @@ begin
     lPos:=UTF8CharAtBytePos(lText,lPos,lChar);
     lCharWidth:=CalcCharSize(lFont,lChar);
     lCurrWidth  := lCurrWidth + lCharWidth;
+    // lCurrWidth  := CalcCharSize(lFont,Copy(lText,1,lPos));
     if abs(lCurrWidth - aXOffset) < abs(lClosestX - aXOffset) then
       begin
       // We're getting closer to the actual char.
@@ -642,8 +660,6 @@ begin
   FCursorX := lCursorX - FTextOffset + lLeftSideMargin;
 end;
 
-
-
 procedure TEdit.SetPlaceHolder(const aValue: TFresnelCaption);
 begin
   if FPlaceHolder=aValue then Exit;
@@ -792,7 +808,7 @@ begin
   // Selection background.
   RSel:=R;
   SelWidth:=Abs(FSelectionStartX-FSelectionEndX);
-  RSel.Left:=RSel.Left+lLeftSideMargin+FSelectionStartX;
+  RSel.Left:=RSel.Left+{lLeftSideMargin+}FSelectionStartX;
   RSel.Right:=RSel.Left+SelWidth;
   lBackColor:=fpimage.colDkBlue; // GetComputedColor(fcaSelectionBackGroundColor,colTransparent);
   aRenderer.FillRect(fpimage.colDkBlue,RSel);