Стартовый пул

RXLib/.svn/pristine/84/840ce8b5e2770e5dfb086e79a8318bd0d4065b4e.svn-base

@@ -0,0 +1,694 @@
+{ curredit unit
+
+  Copyright (C) 2005-2017 Lagunov Aleksey alexs75@yandex.ru and Lazarus team
+  original conception from rx library for Delphi (c)
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version with the following modification:
+
+  As a special exception, the copyright holders of this library give you
+  permission to link this library with independent modules to produce an
+  executable, regardless of the license terms of these independent modules,and
+  to copy and distribute the resulting executable under terms of your choice,
+  provided that you also meet, for each linked independent module, the terms
+  and conditions of the license of that module. An independent module is a
+  module which is not derived from or based on this library. If you modify
+  this library, you may extend this exception to your version of the library,
+  but you are not obligated to do so. If you do not wish to do so, delete this
+  exception statement from your version.
+
+  This program is distributed in the hope that it will be useful, but WITHOUT
+  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+
+unit rxcurredit;
+
+{$I rx.inc}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, LMessages,
+  MaskEdit;
+
+type
+
+  { TCustomNumEdit }
+
+  TCustomNumEdit = class(TCustomMaskEdit)
+  private
+    FEditFormat: string;
+    FFocusedDisplay: boolean;
+    FBeepOnError: Boolean;
+    FCheckOnExit: Boolean;
+    FDecimalPlaces: Cardinal;
+    FDisplayFormat: string;
+//    FFormatOnEditing: Boolean;
+    FFormatting: Boolean;
+    FMaxValue: Extended;
+    FMinValue: Extended;
+    FValue: Extended;
+    FFocused: Boolean;
+    FZeroEmpty: Boolean;
+    function GetAsInteger: Longint;
+    function GetIsNull: boolean;
+    function GetText: string;
+    function GetValue: Extended;
+    procedure SetAsInteger(const AValue: Longint);
+    procedure SetBeepOnError(const AValue: Boolean);
+    procedure SetDecimalPlaces(const AValue: Cardinal);
+    procedure SetDisplayFormat(const AValue: string);
+    procedure SetEditFormat(AValue: string);
+//    procedure SetFormatOnEditing(const AValue: Boolean);
+    procedure SetMaxValue(const AValue: Extended);
+    procedure SetMinValue(const AValue: Extended);
+    procedure SetText(const AValue: string);
+    procedure SetValue(const AValue: Extended);
+    procedure SetZeroEmpty(const AValue: Boolean);
+    function TextToValText(const AValue: string): string;
+    function CheckValue(NewValue: Extended; RaiseOnError: Boolean): Extended;
+//    procedure SetFocused(Value: Boolean);
+  protected
+    //messages
+{    procedure CMEnabledChanged(var Message: TLMessage); message CM_ENABLEDCHANGED;
+    procedure CMEnter(var Message: TLMEnter); message LM_ENTER;
+    procedure WMExit(var Message: TLMExit); message LM_EXIT; }
+
+    procedure WMSetFocus(var Message: TLMSetFocus); message LM_SETFOCUS;
+    procedure WMKillFocus(var Message: TLMKillFocus); message LM_KILLFOCUS;
+
+//    procedure CMFontChanged(var Message: TLMessage); message CM_FONTCHANGED;
+//    procedure WMPaint(var Message: TLMPaint); message LM_PAINT;
+    procedure WMPaste(var Message: TLMessage); message LM_PASTE;
+//    procedure GetSel(var ASelStart: Integer; var SelStop: Integer);
+{    procedure DoEnter; override;
+    procedure DoExit; override;}
+//    procedure AcceptValue(const Value: Variant); override;
+
+//    procedure Change; override;
+//    procedure ReformatEditText; dynamic;
+    procedure DataChanged; virtual;
+    procedure KeyPress(var Key: Char); override;
+    function IsValidChar(Key: Char): Boolean; virtual;
+    function FormatDisplayText(Value: Extended): string;
+    function GetDisplayText: string; virtual;
+    procedure Reset; override;
+    procedure CheckRange;
+    procedure UpdateData;
+    property Formatting: Boolean read FFormatting;
+    property BeepOnError: Boolean read FBeepOnError write SetBeepOnError
+      default True;
+    property CheckOnExit: Boolean read FCheckOnExit write FCheckOnExit default False;
+    property DecimalPlaces: Cardinal read FDecimalPlaces write SetDecimalPlaces
+      default 2;
+    property DisplayFormat: string read FDisplayFormat write SetDisplayFormat;
+    property EditFormat: string read FEditFormat write SetEditFormat;
+    property MaxValue: Extended read FMaxValue write SetMaxValue;
+    property MinValue: Extended read FMinValue write SetMinValue;
+//    property FormatOnEditing: Boolean read FFormatOnEditing write SetFormatOnEditing default False;
+    property Text: string read GetText write SetText stored False;
+    property MaxLength default 0;
+    property ZeroEmpty: Boolean read FZeroEmpty write SetZeroEmpty default True;
+  public
+    constructor Create(AOwner: TComponent); override;
+    procedure Clear;
+    property AsInteger: Longint read GetAsInteger write SetAsInteger;
+    property DisplayText: string read GetDisplayText;
+    property Value: Extended read GetValue write SetValue;
+    property IsNull:boolean read GetIsNull;
+  published
+    { Published declarations }
+  end;
+  
+  { TCurrencyEdit }
+
+  TCurrencyEdit = class(TCustomNumEdit)
+  protected
+  public
+  published
+    property Alignment;
+    property AutoSelect;
+    property AutoSize;
+    property BeepOnError;
+    property BorderStyle;
+    property BorderSpacing;
+    property CheckOnExit;
+    property Color;
+    property DecimalPlaces;
+    property DisplayFormat;
+    property EditFormat;
+    property DragCursor;
+    property DragMode;
+    property Enabled;
+    property Font;
+    property HideSelection;
+    property Anchors;
+    property BiDiMode;
+    property Constraints;
+    property DragKind;
+    property ParentBiDiMode;
+{$IFDEF WIN32}
+  {$IFNDEF VER90}
+//    property ImeMode;
+//    property ImeName;
+  {$ENDIF}
+{$ENDIF}
+    property MaxLength;
+    property MaxValue;
+    property MinValue;
+    property ParentColor;
+    property ParentFont;
+    property ParentShowHint;
+    property PopupMenu;
+    property ReadOnly;
+    property ShowHint;
+    property TabOrder;
+    property TabStop;
+    property Text;
+    property Value;
+    property Visible;
+    property ZeroEmpty;
+    property OnChange;
+    property OnClick;
+    property OnDblClick;
+    property OnDragDrop;
+    property OnDragOver;
+    property OnEndDrag;
+    property OnEnter;
+    property OnExit;
+    property OnKeyDown;
+    property OnKeyPress;
+    property OnKeyUp;
+    property OnMouseDown;
+    property OnMouseMove;
+    property OnMouseUp;
+    property OnMouseWheel;
+    property OnMouseWheelDown;
+    property OnMouseWheelUp;
+
+    property OnContextPopup;
+    property OnStartDrag;
+    property OnEndDock;
+    property OnStartDock;
+  end;
+
+implementation
+uses strutils, Math, rxtooledit, rxconst;
+
+function IsValidFloat(const Value: string; var RetValue: Extended): Boolean;
+var
+  I: Integer;
+  Buffer: array[0..63] of Char;
+begin
+  Result := False;
+  for I := 1 to Length(Value) do
+    if not (Value[I] in [DefaultFormatSettings.DecimalSeparator, '-', '+', '0'..'9', 'e', 'E']) then
+      Exit;
+  Result := TextToFloat(StrPLCopy(Buffer, Value,
+    SizeOf(Buffer) - 1), RetValue, fvExtended);
+end;
+
+function FormatFloatStr(const S: string; Thousands: Boolean): string;
+var
+  I, MaxSym, MinSym, Group: Integer;
+  IsSign: Boolean;
+begin
+  Result := '';
+  MaxSym := Length(S);
+  IsSign := (MaxSym > 0) and (S[1] in ['-', '+']);
+  if IsSign then MinSym := 2
+  else MinSym := 1;
+  I := Pos(DefaultFormatSettings.DecimalSeparator, S);
+  if I > 0 then MaxSym := I - 1;
+  I := Pos('E', AnsiUpperCase(S));
+  if I > 0 then MaxSym := Min(I - 1, MaxSym);
+  Result := Copy(S, MaxSym + 1, MaxInt);
+  Group := 0;
+  for I := MaxSym downto MinSym do begin
+    Result := S[I] + Result;
+    Inc(Group);
+    if (Group = 3) and Thousands and (I > MinSym) then begin
+      Group := 0;
+      Result := DefaultFormatSettings.ThousandSeparator + Result;
+    end;
+  end;
+  if IsSign then Result := S[1] + Result;
+end;
+
+{ TCustomNumEdit }
+
+function TCustomNumEdit.GetAsInteger: Longint;
+begin
+  Result := Trunc(Value);
+end;
+
+function TCustomNumEdit.GetIsNull: boolean;
+begin
+  Result:=false;
+end;
+
+function TCustomNumEdit.GetDisplayText: string;
+begin
+  Result := FormatDisplayText(Value);
+end;
+
+procedure TCustomNumEdit.Reset;
+begin
+  DataChanged;
+  SelectAll;
+end;
+
+procedure TCustomNumEdit.CheckRange;
+begin
+  if not (csDesigning in ComponentState) and CheckOnExit then
+    CheckValue(StrToFloat(TextToValText(EditText)), True);
+end;
+
+procedure TCustomNumEdit.UpdateData;
+begin
+  ValidateEdit;
+  FValue := CheckValue(StrToFloat(TextToValText(EditText)), False);
+end;
+
+constructor TCustomNumEdit.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  ControlStyle := ControlStyle - [csSetCaption];
+  MaxLength := 0;
+  FBeepOnError := True;
+  FDecimalPlaces := 2;
+  FZeroEmpty := True;
+  inherited Text := '';
+  Alignment := taRightJustify;
+  DataChanged;
+  ControlState := ControlState + [csCreating];
+end;
+
+function TCustomNumEdit.GetText: string;
+begin
+  if (FValue = 0) and FZeroEmpty then
+    Result:=''
+  else
+  begin
+    if FEditFormat <> '' then
+      Result := FormatFloat(FEditFormat, FValue)
+    else
+      Result := FloatToStr(FValue);
+  end;
+end;
+
+function TCustomNumEdit.GetValue: Extended;
+begin
+  if (not (csDesigning in ComponentState)) and FFocusedDisplay then
+  begin
+    try
+      UpdateData;
+    except
+      FValue := FMinValue;
+    end;
+  end;
+  Result := FValue;
+end;
+
+procedure TCustomNumEdit.SetAsInteger(const AValue: Longint);
+begin
+  SetValue(AValue);
+end;
+
+procedure TCustomNumEdit.SetBeepOnError(const AValue: Boolean);
+begin
+  if FBeepOnError=AValue then exit;
+  FBeepOnError:=AValue;
+end;
+
+procedure TCustomNumEdit.SetDecimalPlaces(const AValue: Cardinal);
+begin
+  if FDecimalPlaces=AValue then exit;
+  FDecimalPlaces:=AValue;
+  DataChanged;
+  Invalidate;
+end;
+
+procedure TCustomNumEdit.SetDisplayFormat(const AValue: string);
+begin
+  if FDisplayFormat=AValue then exit;
+  FDisplayFormat:=AValue;
+  DataChanged;
+end;
+
+procedure TCustomNumEdit.SetEditFormat(AValue: string);
+begin
+  if FEditFormat=AValue then Exit;
+  FEditFormat:=AValue;
+  DataChanged;
+end;
+
+{
+procedure TCustomNumEdit.SetFormatOnEditing(const AValue: Boolean);
+begin
+  if FFormatOnEditing=AValue then exit;
+  FFormatOnEditing:=AValue;
+  if FFormatOnEditing and FFocused then
+    ReformatEditText
+  else
+  if FFocused then
+  begin
+    UpdateData;
+    DataChanged;
+  end;
+end;
+}
+procedure TCustomNumEdit.SetMaxValue(const AValue: Extended);
+begin
+  if FMaxValue=AValue then exit;
+  FMaxValue:=AValue;
+  if Value > AValue then
+    Value:=AValue;
+end;
+
+procedure TCustomNumEdit.SetMinValue(const AValue: Extended);
+begin
+  if FMinValue=AValue then exit;
+  FMinValue:=AValue;
+  if Value < AValue then
+    Value:=AValue;
+end;
+
+procedure TCustomNumEdit.SetText(const AValue: string);
+begin
+  if not (csReading in ComponentState) then
+  begin
+    FValue := CheckValue(StrToFloat(TextToValText(AValue)), False);
+    DataChanged;
+    Invalidate;
+  end;
+end;
+
+procedure TCustomNumEdit.SetValue(const AValue: Extended);
+begin
+  FValue := CheckValue(AValue, False);
+  DataChanged;
+  Invalidate;
+end;
+
+procedure TCustomNumEdit.SetZeroEmpty(const AValue: Boolean);
+begin
+  if FZeroEmpty=AValue then exit;
+  FZeroEmpty:=AValue;
+  DataChanged;
+end;
+
+function TCustomNumEdit.TextToValText(const AValue: string): string;
+begin
+  Result := Trim(AValue);
+  if DefaultFormatSettings.DecimalSeparator <> DefaultFormatSettings.ThousandSeparator then begin
+    Result := DelChars(Result, ThousandSeparator);
+  end;
+  if (DefaultFormatSettings.DecimalSeparator <> '.') and (DefaultFormatSettings.ThousandSeparator <> '.') then
+    Result := StringReplace(Result, '.', DefaultFormatSettings.DecimalSeparator, [rfReplaceAll]);
+  if (DefaultFormatSettings.DecimalSeparator <> ',') and (DefaultFormatSettings.ThousandSeparator <> ',') then
+    Result := StringReplace(Result, ',', DefaultFormatSettings.DecimalSeparator, [rfReplaceAll]);
+  if Result = '' then Result := '0'
+  else if Result = '-' then Result := '-0';
+end;
+
+function TCustomNumEdit.CheckValue(NewValue: Extended; RaiseOnError: Boolean
+  ): Extended;
+begin
+  Result := NewValue;
+  if (FMaxValue <> FMinValue) then begin
+    if (FMaxValue > FMinValue) then begin
+      if NewValue < FMinValue then Result := FMinValue
+      else if NewValue > FMaxValue then Result := FMaxValue;
+    end
+    else begin
+      if FMaxValue = 0 then begin
+        if NewValue < FMinValue then Result := FMinValue;
+      end
+      else if FMinValue = 0 then begin
+        if NewValue > FMaxValue then Result := FMaxValue;
+      end;
+    end;
+    if RaiseOnError and (Result <> NewValue) then
+      raise ERangeError.CreateFmt(StringReplace(SOutOfRange, '%d', '%.*f', [rfReplaceAll]),
+        [DecimalPlaces, FMinValue, DecimalPlaces, FMaxValue]);
+  end;
+end;
+{
+procedure TCustomNumEdit.SetFocused(Value: Boolean);
+begin
+  if FFocused <> Value then
+  begin
+    FFocused := Value;
+    Invalidate;
+    FFormatting := True;
+    try
+      DataChanged;
+    finally
+      FFormatting := False;
+    end;
+  end;
+end;
+}
+procedure TCustomNumEdit.WMSetFocus(var Message: TLMSetFocus);
+begin
+  inherited WMSetFocus(Message);
+  // some widgetsets do not notify clipboard actions properly. Put at edit state at entry
+  if FFocusedDisplay then
+    exit;
+  FFocusedDisplay := true;
+  Reset;
+end;
+
+procedure TCustomNumEdit.WMKillFocus(var Message: TLMKillFocus);
+begin
+  inherited WMKillFocus(Message);
+  FFocusedDisplay := False;
+  UpdateData;
+  if not Focused then
+      DisableMask(GetDisplayText);
+end;
+
+{
+procedure TCustomNumEdit.CMEnabledChanged(var Message: TLMessage);
+begin
+  inherited;
+  if NewStyleControls and not FFocused then Invalidate;
+end;
+
+procedure TCustomNumEdit.CMEnter(var Message: TLMEnter);
+begin
+  SetFocused(True);
+  if FFormatOnEditing then ReformatEditText;
+  inherited;
+end;
+
+procedure TCustomNumEdit.WMExit(var Message: TLMExit);
+begin
+  inherited;
+  try
+    CheckRange;
+    UpdateData;
+  except
+    SelectAll;
+    if CanFocus then SetFocus;
+    raise;
+  end;
+  SetFocused(False);
+  Cursor:=0;
+  DoExit;
+end;
+
+procedure TCustomNumEdit.CMFontChanged(var Message: TLMessage);
+begin
+  inherited;
+  Invalidate;
+end;
+
+procedure TCustomNumEdit.WMPaint(var Message: TLMPaint);
+var
+  S: string;
+begin
+  S := GetDisplayText;
+//  if not FFocused then
+//  else
+//  if not PaintComboEdit(Self, S, FAlignment, FFocused {and not PopupVisible}, FCanvas, Message) then
+  inherited WMPaint(Message);
+end;
+}
+procedure TCustomNumEdit.WMPaste(var Message: TLMessage);
+var
+  S: string;
+begin
+  S := EditText;
+  try
+    inherited;
+    UpdateData;
+  except
+    EditText := S;
+    SelectAll;
+    if CanFocus then SetFocus;
+//    if BeepOnError then MessageBeep(0);
+  end;
+end;
+{
+procedure TCustomNumEdit.GetSel(var ASelStart: Integer; var SelStop: Integer);
+begin
+  ASelStart:=SelStart;
+  SelStop:=SelStart + SelLength;
+end;
+
+
+procedure TCustomNumEdit.DoEnter;
+begin
+  SetFocused(True);
+  if FFormatOnEditing then ReformatEditText;
+  inherited DoEnter;
+end;
+
+procedure TCustomNumEdit.DoExit;
+begin
+  try
+    CheckRange;
+    UpdateData;
+  except
+    SelectAll;
+    if CanFocus then SetFocus;
+    raise;
+  end;
+  SetFocused(False);
+  Cursor:=0;
+
+  inherited DoExit;
+  Invalidate;
+end;
+
+procedure TCustomNumEdit.AcceptValue(const Value: Variant);
+begin
+  inherited AcceptValue(Value);
+end;
+
+procedure TCustomNumEdit.Change;
+begin
+  if not FFormatting then
+  begin
+    if FFormatOnEditing and FFocused then ReformatEditText;
+    inherited Change;
+  end;
+end;
+
+procedure TCustomNumEdit.ReformatEditText;
+var
+  S: string;
+  IsEmpty: Boolean;
+  OldLen, ASelStart, SelStop: Integer;
+begin
+  FFormatting := True;
+  try
+    S := inherited Text;
+    OldLen := Length(S);
+    IsEmpty := (OldLen = 0) or (S = '-');
+    if HandleAllocated then GetSel(ASelStart, SelStop);
+    if not IsEmpty then S := TextToValText(S);
+    S := FormatFloatStr(S, Pos(',', DisplayFormat) > 0);
+    inherited Text := S;
+{    if HandleAllocated and (GetFocus = Handle) and not
+      (csDesigning in ComponentState) then
+    begin
+      Inc(ASelStart, Length(S) - OldLen);
+      SetCursor(ASelStart);
+    end;}
+  finally
+    FFormatting := False;
+  end;
+end;
+}
+procedure TCustomNumEdit.DataChanged;
+begin
+  if FFocusedDisplay then
+    RestoreMask(GetText)
+  else
+    DisableMask(GetDisplayText)
+end;
+
+procedure TCustomNumEdit.KeyPress(var Key: Char);
+begin
+  if Key in ['.', ','] - [DefaultFormatSettings.ThousandSeparator] then
+    Key := DefaultFormatSettings.DecimalSeparator;
+  inherited KeyPress(Key);
+  if (Key in [#32..#255]) and not IsValidChar(Key) then
+  begin
+//    if BeepOnError then MessageBeep(0);
+    Key := #0;
+  end
+  else
+  if Key = #27 then
+  begin
+    Reset;
+    Key := #0;
+  end;
+end;
+
+function TCustomNumEdit.IsValidChar(Key: Char): Boolean;
+var
+  S: string;
+  ASelStart, SelStop, DecPos: Integer;
+  RetValue: Extended;
+begin
+  Result := False;
+  S := EditText;
+  GetSel(ASelStart, SelStop);
+  System.Delete(S, ASelStart + 1, SelStop - ASelStart);
+  System.Insert(Key, S, ASelStart + 1);
+  S := TextToValText(S);
+  DecPos := Pos(DefaultFormatSettings.DecimalSeparator, S);
+  if (DecPos > 0) then
+  begin
+    ASelStart := Pos('E', UpperCase(S));
+    if (ASelStart > DecPos) then
+      DecPos := ASelStart - DecPos
+    else
+      DecPos := Length(S) - DecPos;
+    if DecPos > Integer(FDecimalPlaces) then
+      Exit;
+
+    if S[1] = DefaultFormatSettings.DecimalSeparator then
+      s := '0' + s;
+  end;
+  Result := IsValidFloat(S, RetValue);
+  if Result and (FMinValue >= 0) and (FMaxValue > 0) and (RetValue < 0) then
+    Result := False;
+end;
+
+function TCustomNumEdit.FormatDisplayText(Value: Extended): string;
+var
+  Digits : integer;
+begin
+  if FZeroEmpty and (Value = 0) then
+    Result:=''
+  else
+  if DisplayFormat <> '' then
+    Result:=FormatFloat(DisplayFormat, Value)
+  else
+  begin
+    Digits := DefaultFormatSettings.CurrencyDecimals;
+    Result:=FloatToStrF(Value, ffCurrency, DecimalPlaces, Digits);
+  end;
+end;
+
+procedure TCustomNumEdit.Clear;
+begin
+  Text:='';
+end;
+
+initialization
+  RegisterPropertyToSkip( TCustomNumEdit, 'FormatOnEditing', 'This property depricated', '');
+end.

RXLib/.svn/pristine/84/844aab450e0d8a9523d250dce05a8f90bac4d69f.svn-base

@@ -0,0 +1,61 @@
+{ rxlclconst unit
+
+  Copyright (C) 2005-2017 Lagunov Aleksey alexs75@yandex.ru and Lazarus team
+  original conception from rx library for Delphi (c)
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version with the following modification:
+
+  As a special exception, the copyright holders of this library give you
+  permission to link this library with independent modules to produce an
+  executable, regardless of the license terms of these independent modules,and
+  to copy and distribute the resulting executable under terms of your choice,
+  provided that you also meet, for each linked independent module, the terms
+  and conditions of the license of that module. An independent module is a
+  module which is not derived from or based on this library. If you modify
+  this library, you may extend this exception to your version of the library,
+  but you are not obligated to do so. If you do not wish to do so, delete this
+  exception statement from your version.
+
+  This program is distributed in the hope that it will be useful, but WITHOUT
+  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+
+unit rxlclconst;
+
+interface
+
+{$I RX.INC}
+
+uses LMessages, Controls;
+
+const
+{ Command message for Speedbar editor }
+  CM_SPEEDBARCHANGED = CM_BASE + 80;
+{ Command message for TRxSpeedButton }
+  CM_RXBUTTONPRESSED = CM_BASE + 81;
+{ Command messages for TRxWindowHook }
+  CM_RECREATEWINDOW  = CM_BASE + 82;
+  CM_DESTROYHOOK     = CM_BASE + 83;
+{ Notify message for TRxTrayIcon }
+  CM_TRAYICON        = CM_BASE + 84;
+{
+const
+  crHand     = TCursor(14000);
+  crDragHand = TCursor(14001);
+}
+//const
+//{ TBitmap.GetTransparentColor from GRAPHICS.PAS uses this value }
+//  PaletteMask = $02000000;
+
+implementation
+
+end.

RXLib/.svn/pristine/84/8459908c736ec9a1ef7f3ece3aadb9d50e14b5f8.svn-base

@@ -0,0 +1,614 @@
+{*******************************************************}
+{                                                       }
+{         Delphi VCL Extensions (RX)                    }
+{                                                       }
+{         Copyright (c) 1997, 1998 Master-Bank          }
+{                                                       }
+{*******************************************************}
+
+{$mode objfpc}
+{$h+}
+
+unit MRUList;
+
+interface
+
+uses SysUtils, Classes, LResources, Menus, IniFiles, Placement;
+
+type
+  TRecentStrings = class;
+
+{ TMRUManager }
+
+  TGetItemEvent = procedure (Sender: TObject; var ACaption: string;
+    var ShortCut: TShortCut; UserData: Longint) of object;
+  TReadItemEvent = procedure (Sender: TObject; IniFile: TCustomInifile;
+    const Section: string; Index: Integer; var RecentName: string;
+    var UserData: Longint) of object;
+  TWriteItemEvent = procedure (Sender: TObject; IniFile: TCustomIniFile;
+    const Section: string; Index: Integer; const RecentName: string;
+    UserData: Longint) of object;
+  TClickMenuEvent = procedure (Sender: TObject; const RecentName,
+    ACaption: string; UserData: PtrInt) of object;
+
+  TAccelDelimiter = (adTab, adSpace);
+  TRecentMode = (rmInsert, rmAppend);
+
+  TMRUManager = class(TComponent)
+  private
+    FList: TStrings;
+    FItems: TList;
+    FIniLink: TIniLink;
+    FSeparateSize: Word;
+    FAutoEnable: Boolean;
+    FAutoUpdate: Boolean;
+    FShowAccelChar: Boolean;
+    FRemoveOnSelect: Boolean;
+    FStartAccel: Cardinal;
+    FAccelDelimiter: TAccelDelimiter;
+    FRecentMenu: TMenuItem;
+    FOnChange: TNotifyEvent;
+    FOnGetItem: TGetItemEvent;
+    FOnClick: TClickMenuEvent;
+    FOnReadItem: TReadItemEvent;
+    FOnWriteItem: TWriteItemEvent;
+    procedure ListChanged(Sender: TObject);
+    procedure ClearRecentMenu;
+    procedure SetRecentMenu(Value: TMenuItem);
+    procedure SetSeparateSize(Value: Word);
+    function GetStorage: TFormPlacement;
+    procedure SetStorage(Value: TFormPlacement);
+    function GetCapacity: Integer;
+    procedure SetCapacity(Value: Integer);
+    function GetMode: TRecentMode;
+    procedure SetMode(Value: TRecentMode);
+    procedure SetStartAccel(Value: Cardinal);
+    procedure SetShowAccelChar(Value: Boolean);
+    procedure SetAccelDelimiter(Value: TAccelDelimiter);
+    procedure SetAutoEnable(Value: Boolean);
+    procedure AddMenuItem(Item: TMenuItem);
+    procedure MenuItemClick(Sender: TObject);
+    procedure IniSave(Sender: TObject);
+    procedure IniLoad(Sender: TObject);
+    procedure InternalLoad(Ini: TCustomInifile; const Section: string);
+    procedure InternalSave(Ini: TCustomIniFile; const Section: string);
+  protected
+    procedure Change; dynamic;
+    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+    procedure DoReadItem(Ini: TCustomIniFile; const Section: string;
+      Index: Integer; var RecentName: string; var UserData: Longint); dynamic;
+    procedure DoWriteItem(Ini: TCustomIniFile; const Section: string; Index: Integer;
+      const RecentName: string; UserData: Longint); dynamic;
+    procedure GetItemData(var Caption: string; var ShortCut: TShortCut;
+      UserData: Longint); dynamic;
+    procedure DoClick(const RecentName, Caption: string; UserData: PtrInt); dynamic;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure Add(const RecentName: string; UserData: Longint);
+    procedure Clear;
+    procedure Remove(const RecentName: string);
+    procedure UpdateRecentMenu;
+    procedure LoadFromIni(Ini: TCustomIniFile; const Section: string);
+    procedure SaveToIni(Ini: TCustomIniFile; const Section: string);
+    property Strings: TStrings read FList;
+  published
+    property AccelDelimiter: TAccelDelimiter read FAccelDelimiter write SetAccelDelimiter default adTab;
+    property AutoEnable: Boolean read FAutoEnable write SetAutoEnable default True;
+    property AutoUpdate: Boolean read FAutoUpdate write FAutoUpdate default True;
+    property Capacity: Integer read GetCapacity write SetCapacity default 10;
+    property Mode: TRecentMode read GetMode write SetMode default rmInsert;
+    property RemoveOnSelect: Boolean read FRemoveOnSelect write FRemoveOnSelect default False;
+    property IniStorage: TFormPlacement read GetStorage write SetStorage;
+    property SeparateSize: Word read FSeparateSize write SetSeparateSize default 0;
+    property RecentMenu: TMenuItem read FRecentMenu write SetRecentMenu;
+    property ShowAccelChar: Boolean read FShowAccelChar write SetShowAccelChar default True;
+    property StartAccel: Cardinal read FStartAccel write SetStartAccel default 1;
+    property OnChange: TNotifyEvent read FOnChange write FOnChange;
+    property OnClick: TClickMenuEvent read FOnClick write FOnClick;
+    property OnGetItemData: TGetItemEvent read FOnGetItem write FOnGetItem;
+    property OnReadItem: TReadItemEvent read FOnReadItem write FOnReadItem;
+    property OnWriteItem: TWriteItemEvent read FOnWriteItem write FOnWriteItem;
+  end;
+
+{ TRecentStrings }
+
+  TRecentStrings = class(TStringList)
+  private
+    FMaxSize: Integer;
+    FMode: TRecentMode;
+    procedure SetMaxSize(Value: Integer);
+  public
+    constructor Create;
+    function Add(const S: string): Integer; override;
+    procedure AddStrings(NewStrings: TStrings); override;
+    procedure DeleteExceed;
+    procedure Remove(const S: String);
+    property MaxSize: Integer read FMaxSize write SetMaxSize;
+    property Mode: TRecentMode read FMode write FMode;
+  end;
+
+Procedure Register;
+
+implementation
+
+{$R mrulist.res}
+
+uses Controls, AppUtils;
+
+const
+  siRecentItem = 'Item_%d';
+  siRecentData = 'User_%d';
+
+Procedure Register;
+
+begin
+ RegisterComponents('RX Controls',[TMRUManager]);
+end;
+
+
+{ TMRUManager }
+
+constructor TMRUManager.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FList := TRecentStrings.Create;
+  FItems := TList.Create;
+  TRecentStrings(FList).OnChange := @ListChanged;
+  FIniLink := TIniLink.Create;
+  FIniLink.OnSave := @IniSave;
+  FIniLink.OnLoad := @IniLoad;
+  FAutoUpdate := True;
+  FAutoEnable := True;
+  FShowAccelChar := True;
+  FStartAccel := 1;
+end;
+
+destructor TMRUManager.Destroy;
+begin
+  ClearRecentMenu;
+  FIniLink.Free;
+  TRecentStrings(FList).OnChange := nil;
+  FList.Free;
+  FItems.Free;
+  FItems := nil;
+  inherited Destroy;
+end;
+
+procedure TMRUManager.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+  inherited Notification(AComponent, Operation);
+  if (AComponent = RecentMenu) and (Operation = opRemove) then
+    RecentMenu := nil;
+end;
+
+procedure TMRUManager.GetItemData(var Caption: string; var ShortCut: TShortCut;
+  UserData: Longint);
+begin
+  if Assigned(FOnGetItem) then FOnGetItem(Self, Caption, ShortCut, UserData);
+end;
+
+procedure TMRUManager.DoClick(const RecentName, Caption: string; UserData: PtrInt);
+begin
+  if Assigned(FOnClick) then FOnClick(Self, RecentName, Caption, UserData);
+end;
+
+procedure TMRUManager.MenuItemClick(Sender: TObject);
+var
+  I: Integer;
+begin
+  if Sender is TMenuItem then begin
+    I := TMenuItem(Sender).Tag;
+    if (I >= 0) and (I < FList.Count) then
+      try
+        DoClick(FList[I], TMenuItem(Sender).Caption, PtrInt(FList.Objects[I]));
+      finally
+        if RemoveOnSelect then Remove(FList[I]);
+      end;
+  end;
+end;
+
+function TMRUManager.GetCapacity: Integer;
+begin
+  Result := TRecentStrings(FList).MaxSize;
+end;
+
+procedure TMRUManager.SetCapacity(Value: Integer);
+begin
+  TRecentStrings(FList).MaxSize := Value;
+end;
+
+function TMRUManager.GetMode: TRecentMode;
+begin
+  Result := TRecentStrings(FList).Mode;
+end;
+
+procedure TMRUManager.SetMode(Value: TRecentMode);
+begin
+  TRecentStrings(FList).Mode := Value;
+end;
+
+function TMRUManager.GetStorage: TFormPlacement;
+begin
+  Result := FIniLink.Storage;
+end;
+
+procedure TMRUManager.SetStorage(Value: TFormPlacement);
+begin
+  FIniLink.Storage := Value;
+end;
+
+procedure TMRUManager.SetAutoEnable(Value: Boolean);
+begin
+  if FAutoEnable <> Value then begin
+    FAutoEnable := Value;
+    if Assigned(FRecentMenu) and FAutoEnable then
+      FRecentMenu.Enabled := FRecentMenu.Count > 0;
+  end;
+end;
+
+procedure TMRUManager.SetStartAccel(Value: Cardinal);
+begin
+  if FStartAccel <> Value then begin
+    FStartAccel := Value;
+    if FAutoUpdate then UpdateRecentMenu;
+  end;
+end;
+
+procedure TMRUManager.SetAccelDelimiter(Value: TAccelDelimiter);
+begin
+  if FAccelDelimiter <> Value then begin
+    FAccelDelimiter := Value;
+    if FAutoUpdate and ShowAccelChar then UpdateRecentMenu;
+  end;
+end;
+
+procedure TMRUManager.SetShowAccelChar(Value: Boolean);
+begin
+  if FShowAccelChar <> Value then begin
+    FShowAccelChar := Value;
+    if FAutoUpdate then UpdateRecentMenu;
+  end;
+end;
+
+procedure TMRUManager.Add(const RecentName: string; UserData: Longint);
+begin
+  FList.AddObject(RecentName, TObject(PtrInt(UserData)));
+end;
+
+procedure TMRUManager.Clear;
+begin
+  FList.Clear;
+end;
+
+procedure TMRUManager.Remove(const RecentName: string);
+begin
+  TRecentStrings(FList).Remove(RecentName);
+end;
+
+procedure TMRUManager.AddMenuItem(Item: TMenuItem);
+begin
+  if Assigned(Item) then begin
+    FRecentMenu.Add(Item);
+    FItems.Add(Item);
+  end;
+end;
+
+{ Must be moved to Controls}
+Function GetShortHint(const Hint: WideString): WideString;
+var
+  I: Integer;
+begin
+  I := Pos('|', Hint);
+  if I = 0 then
+    Result := Hint
+  else
+    Result := Copy(Hint, 1, I - 1);
+end;
+function GetLongHint(const Hint: WideString): WideString;
+var
+  I: Integer;
+begin
+  I := Pos('|', Hint);
+  if I = 0 then
+    Result := Hint
+  else
+    Result := Copy(Hint, I + 1, Maxint);
+end;
+
+{ Must be moved to Menus}
+function NewLine: TMenuItem;
+begin
+  Result := TMenuItem.Create(nil);
+  Result.Caption := '-';
+end;
+
+function NewItem(const ACaption: WideString; AShortCut: TShortCut;
+  AChecked, AEnabled: Boolean; AOnClick: TNotifyEvent; hCtx: THelpContext;
+  const AName: string): TMenuItem;
+begin
+  Result := TMenuItem.Create(nil);
+  with Result do
+  begin
+    Caption := ACaption;
+    ShortCut := AShortCut;
+    OnClick := AOnClick;
+    HelpContext := hCtx;
+    Checked := AChecked;
+    Enabled := AEnabled;
+    Name := AName;
+  end;
+end;
+
+
+procedure TMRUManager.UpdateRecentMenu;
+const
+  AccelDelimChars: array[TAccelDelimiter] of Char = (#9, ' ');
+var
+  I: Integer;
+  L: Cardinal;
+  S: string;
+  C: string[2];
+  ShortCut: TShortCut;
+  Item: TMenuItem;
+begin
+  ClearRecentMenu;
+  if Assigned(FRecentMenu) then begin
+    if (FList.Count > 0) and (FRecentMenu.Count > 0) then
+      AddMenuItem(NewLine);
+    for I := 0 to FList.Count - 1 do begin
+      if (FSeparateSize > 0) and (I > 0) and (I mod FSeparateSize = 0) then
+        AddMenuItem(NewLine);
+      S := FList[I];
+      ShortCut := scNone;
+      GetItemData(S, ShortCut, Longint(PtrInt(FList.Objects[I])));
+      Item := NewItem(GetShortHint(S), ShortCut, False, True,
+        @MenuItemClick, 0, '');
+      Item.Hint := GetLongHint(S);
+      if FShowAccelChar then begin
+        L := Cardinal(I) + FStartAccel;
+        if L < 10 then
+          C := '&' + Char(Ord('0') + L)
+        else if L <= (Ord('Z') + 10) then
+          C := '&' + Char(L + Ord('A') - 10)
+        else
+          C := ' ';
+        Item.Caption := C + AccelDelimChars[FAccelDelimiter] + Item.Caption;
+      end;
+      Item.Tag := I;
+      AddMenuItem(Item);
+    end;
+    if AutoEnable then FRecentMenu.Enabled := FRecentMenu.Count > 0;
+  end;
+end;
+
+procedure TMRUManager.ClearRecentMenu;
+var
+  Item: TMenuItem;
+begin
+  while FItems.Count > 0 do begin
+    Item := TMenuItem(FItems.Last);
+    if Assigned(FRecentMenu) and (FRecentMenu.IndexOf(Item) >= 0) then
+      Item.Free;
+    FItems.Remove(Item);
+  end;
+  if Assigned(FRecentMenu) and AutoEnable then
+    FRecentMenu.Enabled := FRecentMenu.Count > 0;
+end;
+
+procedure TMRUManager.SetRecentMenu(Value: TMenuItem);
+begin
+  ClearRecentMenu;
+  FRecentMenu := Value;
+{$IFDEF MSWINDOWS}
+  if Value <> nil then Value.FreeNotification(Self);
+{$ENDIF}
+  UpdateRecentMenu;
+end;
+
+procedure TMRUManager.SetSeparateSize(Value: Word);
+begin
+  if FSeparateSize <> Value then begin
+    FSeparateSize := Value;
+    if FAutoUpdate then UpdateRecentMenu;
+  end;
+end;
+
+procedure TMRUManager.ListChanged(Sender: TObject);
+begin
+  if Sender=nil then ;
+  Change;
+  if FAutoUpdate then UpdateRecentMenu;
+end;
+
+procedure TMRUManager.IniSave(Sender: TObject);
+begin
+  if Sender=nil then ;
+  if (Name <> '') and (FIniLink.IniObject <> nil) then
+    InternalSave(FIniLink.IniObject, FIniLink.RootSection +
+      GetDefaultSection(Self));
+end;
+
+procedure TMRUManager.IniLoad(Sender: TObject);
+begin
+  if Sender=nil then ;
+  if (Name <> '') and (FIniLink.IniObject <> nil) then
+    InternalLoad(FIniLink.IniObject, FIniLink.RootSection +
+      GetDefaultSection(Self));
+end;
+
+procedure TMRUManager.Change;
+begin
+  if Assigned(FOnChange) then FOnChange(Self);
+end;
+
+procedure TMRUManager.DoReadItem(Ini: TCustomIniFile; const Section: string;
+  Index: Integer; var RecentName: string; var UserData: Longint);
+begin
+  if Assigned(FOnReadItem) then
+    FOnReadItem(Self, Ini, Section, Index, RecentName, UserData)
+  else begin
+    RecentName := Ini.ReadString( Section, Format(siRecentItem, [Index]), RecentName);
+    UserData := Ini.ReadInteger( Section, Format(siRecentData, [Index]), UserData);
+  end;
+end;
+
+procedure TMRUManager.DoWriteItem(Ini: TCustomIniFile; const Section: string;
+  Index: Integer; const RecentName: string; UserData: Longint);
+begin
+  if Assigned(FOnWriteItem) then
+    FOnWriteItem(Self, Ini, Section, Index, RecentName, UserData)
+  else begin
+    Ini.WriteString(Section, Format(siRecentItem, [Index]), RecentName);
+    if UserData = 0 then
+      Ini.DeleteKey(Section, Format(siRecentData, [Index]))
+    else
+      Ini.WriteInteger(Section, Format(siRecentData, [Index]), UserData);
+  end;
+end;
+
+procedure TMRUManager.InternalLoad(Ini: TCustomIniFile; const Section: string);
+var
+  I: Integer;
+  S: string;
+  UserData: Longint;
+  AMode: TRecentMode;
+begin
+  AMode := Mode;
+  FList.BeginUpdate;
+  try
+    FList.Clear;
+    Mode := rmInsert;
+    for I := TRecentStrings(FList).MaxSize - 1 downto 0 do begin
+      S := '';
+      UserData := 0;
+      DoReadItem(Ini,Section, I, S, UserData);
+      if S <> '' then Add(S, UserData);
+    end;
+  finally
+    Mode := AMode;
+    FList.EndUpdate;
+  end;
+end;
+
+procedure TMRUManager.InternalSave(Ini: TCustomInifile; const Section: string);
+var
+  I: Integer;
+begin
+  Ini.EraseSection(Section);
+  for I := 0 to FList.Count - 1 do
+    DoWriteItem(Ini, Section, I, FList[I], Longint(PtrInt(FList.Objects[I])));
+end;
+
+procedure TMRUManager.LoadFromIni(Ini: TCustomIniFile; const Section: string);
+begin
+  InternalLoad(Ini, Section);
+end;
+
+procedure TMRUManager.SaveToIni(Ini: TCustomIniFile; const Section: string);
+begin
+  InternalSave(Ini, Section);
+end;
+
+{ TRecentStrings }
+
+constructor TRecentStrings.Create;
+begin
+  inherited Create;
+  FMaxSize := 10;
+  FMode := rmInsert;
+end;
+
+Function Max(A,B : Integer) : Integer;
+
+begin
+  If A>B then
+    Result:=A
+  else
+    Result:=B;
+end;
+
+Function Min(A,B : Integer) : Integer;
+
+begin
+  If A>B then
+    Result:=B
+  else
+    Result:=A;
+end;
+
+procedure TRecentStrings.SetMaxSize(Value: Integer);
+begin
+  if FMaxSize <> Value then begin
+    FMaxSize := Max(1, Value);
+    DeleteExceed;
+  end;
+end;
+
+procedure TRecentStrings.DeleteExceed;
+var
+  I: Integer;
+begin
+  BeginUpdate;
+  try
+    if FMode = rmInsert then begin
+      for I := Count - 1 downto FMaxSize do Delete(I);
+    end
+    else begin { rmAppend }
+      while Count > FMaxSize do Delete(0);
+    end;
+  finally
+    EndUpdate;
+  end;
+end;
+
+procedure TRecentStrings.Remove(const S: String);
+var
+  I: Integer;
+begin
+  I := IndexOf(S);
+  if I >= 0 then Delete(I);
+end;
+
+function TRecentStrings.Add(const S: String): Integer;
+begin
+  Result := IndexOf(S);
+  if Result >= 0 then begin
+    if FMode = rmInsert then Move(Result, 0)
+    else { rmAppend } Move(Result, Count - 1);
+  end
+  else begin
+    BeginUpdate;
+    try
+      if FMode = rmInsert then Insert(0, S)
+      else { rmAppend } Insert(Count, S);
+      DeleteExceed;
+    finally
+      EndUpdate;
+    end;
+  end;
+  if FMode = rmInsert then Result := 0
+  else { rmAppend } Result := Count - 1;
+end;
+
+procedure TRecentStrings.AddStrings(NewStrings: TStrings);
+var
+  I: Integer;
+begin
+  BeginUpdate;
+  try
+    if FMode = rmInsert then begin
+      for I := Min(NewStrings.Count, FMaxSize) - 1 downto 0 do
+        AddObject(NewStrings[I], NewStrings.Objects[I]);
+    end
+    else begin { rmAppend }
+      for I := 0 to Min(NewStrings.Count, FMaxSize) - 1 do
+        AddObject(NewStrings[I], NewStrings.Objects[I]);
+    end;
+    DeleteExceed;
+  finally
+    EndUpdate;
+  end;
+end;
+
+end.