Awkwars's plugins - welcome to our trunk

git-svn-id: http://svn.miranda-ng.org/main/trunk@1822 1316c22d-e87f-b044-9b9b-93d7a3e3ba9c

1 files changed, 538 insertions, 0 deletions

diff --git a/plugins/Utils.pas/kolsizer.pas b/plugins/Utils.pas/kolsizer.pas
new file mode 100644
index 0000000000..28361a4585
--- /dev/null
+++ b/plugins/Utils.pas/kolsizer.pas
@@ -0,0 +1,538 @@
+unit KOLSizer;

+//

+// purpose: KOL control sizercontrol and design grid

+//  author: © 2004, Thaddy de Koning

+// Remarks: Tnx in part to Marco Cantu for the sizer idea in DDH3

+//          copyrighted freeware.

+//

+interface

+

+uses

+  Windows, Messages, Kol;

+

+const

+  DESIGNER_NORESIZE = 1;

+

+type

+  PDesigner=^TDesigner;

+  TDesigner=object(TStrlistEx)

+  private

+    fOwner:pControl;

+    fSpacing:Cardinal;

+    FOldPaint:TOnPaint;

+    fActive: boolean;

+    fSizer:PControl;

+    FOnControlChange: TonEvent;

+//    FOnDblClick:TOnEvent;

+//    FOnMouseDown:TOnMouse;

+    fCurrent: pControl;

+//    FAction:integer;

+

+    procedure setactive(const Value: boolean);

+    function PrepareClassname(aControl: PControl): KOLString;

+    function UniqueName(aName: KOLString; flags:cardinal): KOLString;

+    procedure SetCurrent(const Value: pControl);

+    procedure InternalControlChange(sender:pObj);

+    procedure Setspacing(Space:cardinal = 8);

+    function  GetFlags(aControl:pControl):cardinal;

+  protected

+    procedure init;virtual;

+    procedure DoKeyUp( Sender: PControl; var Key: Longint; Shift: DWORD);

+    procedure DoChar( Sender: PControl; var Key: KOLChar; Shift: DWORD);

+  public

+    destructor destroy;virtual;

+    procedure Connect(aName: KOLString; aControl: pControl; flags:cardinal=0);

+    procedure DisConnect(aControl: pControl);

+    procedure Paintgrid(sender:pControl;DC:HDC);

+

+    property Spacing:cardinal read fSpacing write setspacing;

+    property Active:boolean read fActive write setactive;

+//    property Action:integer read FAction write Faction;

+    property Current:pControl read fCurrent write SetCurrent;

+    property OnControlChange:TOnEvent Read FOnControlChange write FOnControlChange;

+//    property OnDblClick:TonEvent read fOnDblClick write FOnDblClick;

+//    property OnMouseDown:TOnMouse read FOnMouseDown write FOnMouseDown;

+  end;

+

+function NewSizerControl(AControl: PControl;aDesigner:PDesigner;flags:cardinal=0):PControl;

+function NewDesigner(aOwner:pControl):pDesigner;

+

+implementation

+

+const

+  FlagDelimeterChar='@';

+

+const

+  // Size and move commands for SysCommand

+  SZ_LEFT        = $F001;

+  SZ_RIGHT       = $F002;

+  SZ_TOP         = $F003;

+  SZ_TOPLEFT     = $F004;

+  SZ_TOPRIGHT    = $F005;

+  SZ_BOTTOM      = $F006;

+  SZ_BOTTOMLEFT  = $F007;

+  SZ_BOTTOMRIGHT = $F008;

+  SZ_MOVE        = $F012;

+

+type

+  TPosInfo = record

+    Rect     :Trect;

+    Pos      :integer;

+    Direction:integer;

+  end;

+

+  PSizerdata=^ TSizerdata;

+  TSizerdata= object(Tobj)

+    FControl :PControl;

+    FPosInfo :array [0..7] of TPosInfo;

+    Szflags  :cardinal;

+    Direction:longint;

+

+    procedure DoPaint(sender:pControl;DC:HDC);

+  end;

+

+  PHack =^ THack;

+  THack = object(Tcontrol)

+  end;

+

+var

+  LocalDesigner:PDesigner=nil;

+

+function DesignHandlerProc(Sender: PControl; var Msg: TMsg; var Rslt: Integer): Boolean;

+//var MouseData:TMouseEventData;

+begin

+  Result:=false;

+  case msg.message of

+{

+      WM_KEYUP,WM_SYSCHAR,WM_SYSKEYUP,

+      WM_CHAR: begin

+//        if loword(msg.wParam)=VK_TAB then

+          Messagebox(0,'222','',0);

+      end;

+}    WM_LBUTTONDOWN: begin

+      if LocalDesigner.fOwner<>Sender then LocalDesigner.Current:=Sender;

+      Result:=true;

+      {

+      if assigned(Localdesigner.OnMousedown) then

+      // Borrowed from KOL.pas

+      // enables us to pass on KOL mouse events back to the designer

+      // without having to connect to true KOL eventproperties.

+      with MouseData do

+      begin

+        Shift := Msg.wParam;

+        if GetKeyState(VK_MENU) < 0 then

+          Shift := Shift or MK_ALT;

+        X := LoWord(Msg.lParam);

+        Y := HiWord(Msg.lParam);

+        Button := mbNone;

+        StopHandling := true;

+        Rslt := 0; // needed ?

+        LocalDesigner.OnMousedown(sender,Mousedata);

+        Result:=true

+      end;

+       }

+    end

+  end;

+end;

+

+// TSizerControl methods

+function WndProcSizer( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;

+var

+  Pt: TPoint;

+  i: Integer;

+  R:Trect;

+  Data:PSizerData;

+begin

+  Data:=PSizerData(Sender.CustomObj);

+  Result:=True;

+  with Sender^, Data^ do

+  begin

+    case msg.message of

+{

+      WM_KEYUP,WM_SYSCHAR,WM_SYSKEYUP,

+      WM_CHAR: begin

+//        if loword(msg.wParam)=VK_TAB then

+          Messagebox(0,'111','',0);

+      end;

+}

+      WM_NCHITTEST: begin

+        Pt := MakePoint(loword(Msg.lparam), hiword(Msg.lparam));

+        Pt := Screen2Client (Pt);

+        Rslt:=0;

+        for i := 0 to 7 do

+          if PtInRect (FPosInfo [i].rect, Pt) then

+          begin

+            // The value of rslt is passed on and makes

+            // the system select the correct cursor

+            // without us having to do anything more.

+            Rslt     :=FPosInfo[i].pos;

+            Direction:=FPosInfo[i].direction;

+            break;

+          end;

+        if Rslt = 0 then

+          Result:=False;

+      end;

+

+      WM_SIZE: begin

+        R := BoundsRect;

+        InflateRect (R, -2, -2);

+        Fcontrol.BoundsRect := R;

+        FPosInfo[0].rect:=MakeRect (0            ,0             ,5            ,5);

+        FPosInfo[1].rect:=MakeRect (Width div 2-3,0             ,Width div 2+2,5);

+        FPosInfo[2].rect:=MakeRect (Width-5      ,0             ,Width        ,5);

+        FPosInfo[3].rect:=MakeRect (Width-5      ,Height div 2-3,Width        ,Height div 2+2);

+        FPosInfo[4].rect:=MakeRect (Width-5      ,Height-5      ,Width        ,Height);

+        FPosInfo[5].rect:=MakeRect (Width div 2-3,Height-5      ,Width div 2+2,Height);

+        FPosInfo[6].rect:=MakeRect (0            ,Height-5      ,5            ,Height);

+        FPosInfo[7].rect:=MakeRect (0            ,Height div 2-3,5            ,Height div 2+2);

+      end;

+

+      WM_NCLBUTTONDOWN: if (Szflags and DESIGNER_NORESIZE)=0 then

+        Perform (WM_SYSCOMMAND, Direction, 0);

+

+      WM_LBUTTONDOWN: Perform (WM_SYSCOMMAND, SZ_MOVE, 0);

+

+      WM_MOVE: begin

+        R := BoundsRect;

+        InflateRect (R, -2, -2);

+        fControl.Invalidate;

+        fControl.BoundsRect := R;

+      end;

+

+    else

+      Result:=false;

+    end;

+  end;

+end;

+

+function NewSizerControl(AControl: PControl;aDesigner:PDesigner;flags:cardinal):PControl;

+var

+  R: TRect;

+  Data:PSizerData;

+begin

+  New(Data,Create);

+  Result:={NewPanel(aControl,esNone);//}NewPaintBox(aControl);

+  Result.ExStyle:=Result.ExStyle or WS_EX_TRANSPARENT;

+//  Result.TabStop:=true;

+//  Result.OnChar:=aDesigner.DoChar;

+//  Result.OnKeyDown:=aDesigner.DoKeyUp;

+//  Result.OnKeyUp:=aDesigner.DoKeyUp;

+  if aDesigner.fowner<>aControl then

+    With result^, Data^  do

+    begin

+      Szflags  := flags;

+      FControl := AControl;

+      // set the size and position

+      R := aControl.BoundsRect;

+      InflateRect (R, 2, 2);

+      BoundsRect := R;

+      // set the parent

+      Parent := aControl.Parent;

+      // create the list of positions

+      FPosInfo [0].pos := htTopLeft    ; FPosInfo [0].direction := SZ_TOPLEFT;

+      FPosInfo [1].pos := htTop        ; FPosInfo [1].direction := SZ_TOP;

+      FPosInfo [2].pos := htTopRight   ; FPosInfo [2].direction := SZ_TOPRIGHT;

+      FPosInfo [3].pos := htRight      ; FPosInfo [3].direction := SZ_RIGHT;

+      FPosInfo [4].pos := htBottomRight; FPosInfo [4].direction := SZ_BOTTOMRIGHT;

+      FPosInfo [5].pos := htBottom     ; FPosInfo [5].direction := SZ_BOTTOM;

+      FPosInfo [6].pos := htBottomLeft ; FPosInfo [6].direction := SZ_BOTTOMLEFT;

+      FPosInfo [7].pos := htLeft       ; FPosInfo [7].direction := SZ_LEFT;

+      CustomObj:=Data;

+      OnPaint:=DoPaint;

+      AttachProc(WndProcSizer);

+      Bringtofront;

+      Focused:=true

+    end;

+end;

+

+procedure TSizerData.DoPaint(sender:pControl;DC:HDC);

+var

+  i: Integer;

+begin

+  // I simply use the current pen and brush

+  for i := 0 to  7 do

+    with pSizerdata(sender.Customobj).FPosInfo[i].Rect do

+      Rectangle(DC, Left, Top, Right, Bottom);

+end;

+

+{ TDesigner }

+function NewDesigner(aOwner:pControl):pDesigner;

+begin

+  if Assigned(LocalDesigner) then

+  begin

+    result:=LocalDesigner;

+  end

+  else

+  begin

+    New(Result,Create);

+    with result^ do

+    begin

+      Fowner:=aOwner;

+      Connect('',Fowner);

+      FOldPaint:=Fowner.OnPaint;

+      LocalDesigner:=Result;

+      //Result.Current:=aOwner;

+    end

+  end

+end;

+

+procedure TDesigner.init;

+begin

+  inherited;

+  Fspacing:=8;

+end;

+

+procedure TDesigner.PaintGrid(Sender: pControl; DC: HDC);

+var

+  i, j: Integer;

+begin

+  i := 0;

+  j := 0;

+  Sender.Canvas.FillRect(Sender.Canvas.ClipRect);

+  if Assigned(FOldPaint) then FOldPaint(Sender,DC);

+  repeat

+    repeat

+      MoveToEx(Dc,i, j,nil);

+      LineTo(Dc,i + 1,j);

+      inc(i, fSpacing);

+    until i > Sender.ClientWidth;

+    i := 0;

+    inc(j, fSpacing);

+  until j > Sender.ClientHeight;

+end;

+

+procedure TDesigner.SetSpacing(Space: cardinal);

+begin

+  fSpacing:=Space;

+  fOwner.invalidate;

+end;

+

+destructor TDesigner.destroy;

+begin

+  SetActive(false);

+  FOwner.OnPaint:=FOldPaint;

+  inherited;

+end;

+

+//Note: Make shure that whatever happens, all pointers are nil or valid!

+//      Took a long time to debug spurious crashes.

+//      So this is not excessively safe.

+procedure TDesigner.SetActive(const Value: boolean);

+var

+  i:integer;

+begin

+  FActive := Value;

+  if FActive then

+  begin

+    fOwner.OnPaint:=PaintGrid;

+    if count > 1 then

+    begin

+      if Assigned(fCurrent) then

+        fSizer:=NewSizerControl(fCurrent,@self,GetFlags(fCurrent));

+      for i:=0 to count -1 do

+       if not PControl(Objects[i]).IsprocAttached(DesignHandlerProc) then

+         PControl(Objects[i]).AttachProc(DesignHandlerProc);

+    end;

+  end

+  else

+  begin

+    if count > 0 then // always coz Owner is first

+      for i:=0 to count -1 do

+        PControl(Objects[i]).DetachProc(DesignHandlerProc);

+    if Assigned(fSizer) then

+    begin

+      fSizer.free;

+      fSizer:=nil;

+    end;

+    fCurrent:=nil;

+    fOwner.OnPaint:=FOldPaint;

+  end;

+  fOwner.Invalidate;

+end;

+

+procedure TDesigner.Connect(aName: KOLString; aControl: pControl; flags:cardinal=0);

+begin

+  if (IndexOfObj(aControl) = -1) then

+  begin

+    if aName = '' then

+      aName := PrepareClassName(aControl);

+    AddObject(UniqueName(aName,flags), Cardinal(aControl));

+    InternalControlChange(aControl);

+    SetCurrent(aControl);

+    if Active then

+      if not aControl.IsprocAttached(DesignHandlerProc) then

+        aControl.AttachProc(DesignHandlerProc);

+  end;

+end;

+

+procedure TDesigner.DisConnect(aControl: pControl);

+var

+  index: Integer;

+begin

+  index := IndexOfObj(aControl);

+  if index = -1 then

+    exit;

+  Delete(index);

+

+  InternalControlChange(nil);

+end;

+

+function TDesigner.GetFlags(aControl:pControl):cardinal;

+var

+  idx,dummy:integer;

+  tmpstr:KOLString;

+begin

+  idx:=IndexOfObj(aControl);

+  tmpstr:=Items[idx];

+  idx:=IndexOfChar(tmpstr,FlagDelimeterChar);

+  if idx<0 then result:=0

+  else

+  begin

+    val(copy(tmpstr,idx+1,15),result,dummy);

+  end;

+end;

+

+procedure TDesigner.SetCurrent(const Value: pControl);

+begin

+  if Assigned(fSizer) then

+  begin

+    fSizer.free;

+    fsizer:=nil;

+  end;

+  if Value <> nil then

+  begin

+

+    fCurrent := Value;

+    if fActive and (fCurrent<>nil) and (fCurrent<>fOwner) then

+      fSizer:=NewSizerControl(Value,@self,GetFlags(Value));

+

+    InternalControlChange(Value);

+  end;

+end;

+

+procedure TDesigner.InternalControlChange(sender: pObj);

+begin

+  if fActive then

+    if Assigned(OnControlChange)then

+      FOnControlChange(sender);

+end;

+

+procedure TDesigner.DoChar( Sender: PControl; var Key: KOLChar; Shift: DWORD);

+begin

+//   messagebox(0,'444','',0);

+end;

+

+procedure TDesigner.DoKeyUp(Sender: PControl; var Key: Integer; Shift: DWORD);

+

+  procedure DeleteControl(Index:integer);

+  var

+    i: Integer;

+    C:PControl;

+  begin

+    C:=PControl(Objects[index]);

+    // delete children, not owner

+    if C.ChildCount>0 then

+      for i:=C.ChildCount-1 downto 0 do

+        if C<>fOwner then DeleteControl(i);

+

+    if C<>fOwner then

+    begin

+      C.free;

+      Delete(0);

+    end;

+  end;

+

+var

+  i:integer;

+begin

+//   if Key = VK_TAB then

+//   messagebox(0,'333','',0);

+

+   if Key = VK_DELETE then

+   begin

+     i:=IndexOfObj(LocalDesigner.Current);

+     if i<>-1 then

+     begin

+       DeleteControl(i);

+       InternalControlChange(nil);

+       PostMessage(Sender.Handle,WM_CLOSE,0,0); //???

+     end;

+   end;

+end;

+

+  // Converts  an object name to a Delphi compatible control name that

+  // is unique for the designer, i.e 'Button' becomes 'Button1',

+  // the next button becomes 'Button2', always unless the

+  // control is already named by the user in which case the name is preserved

+  // unless there are conficts. In that case the control is silently

+  // renamed with a digit suffix without raising exceptions.

+  // Deleted names are re-used.

+  // It's not a beauty but it works.

+  // (A severe case of programming 48 hours without sleep)

+

+function TDesigner.UniqueName(aName: KOLString; flags:cardinal): KOLString;

+var

+  I, J: Integer;

+  T: KOLString;

+begin

+  // Strip obj_ prefix and all other prefix+underscores from

+  // subclassname property: 'obj_BUTTON' becomes 'Button'

+  T := LowerCase(aName);

+  while T <> '' do aName := Parse(T, '_');

+

+//  aName[1]:=UpCase(aName[1]);

+  //Propercase it

+  T := aName[1];

+  T := UpperCase(T);

+  aName[1] := T[1];

+

+  Result := aName;

+  // Add at least a 1 to the name if the last char

+  // is not a digit.

+  if not (AnsiChar(aName[length(aName)]) in ['0'..'9']) then

+    Result := Format('%s%d', [aName, 1]);

+  J := 1;

+  repeat

+    I := IndexOf(Result);

+    if I > -1 then

+    begin

+      inc(J);

+      Result := Format('%s%d', [aName, J]);

+    end;

+  until I = -1;

+  if flags<>0 then

+  begin

+    Str(flags,T);

+    Result:=Result+FlagDelimeterChar+T;

+  end;

+end;

+

+// This is probably not complete yet.

+function TDesigner.PrepareClassName(aControl: PControl): KOLString;

+begin

+  Result := aControl.subclassname;

+  with aControl^ do

+    if subClassname = 'obj_STATIC' then

+    begin

+      // Only place where panel and label differ

+      // consistently???

+      // why not aControl.SizeRedraw ??

+      if pHack(aControl).SizeRedraw = True then

+        Result := 'obj_LABEL'

+      else

+        Result := 'obj_PANEL'

+    end

+

+    else if subclassname = 'obj_BUTTON' then

+    begin

+      if      Boolean(Style and BS_AUTOCHECKBOX) then Result := 'obj_CHECKBOX'

+      else if Boolean(style and BS_RADIOBUTTON ) then Result := 'obj_RADIOBOX'

+      else if Boolean(style and BS_OWNERDRAW   ) then Result := 'obj_BITBTN'

+      else if Boolean(style and BS_GROUPBOX    ) then Result := 'obj_GROUPBOX';

+    end

+

+    else if IndexOfStr(UpperCase(subclassname), 'RICHEDIT')>-1 then

+      Result := 'obj_RICHEDIT';

+end;

+

+end.