Version 1.0 DEV 1.07d

Signed-off-by: Dennis07 <den.goehlert@t-online.de>

Information/Statistics.txt

@@ -1,4 +1,4 @@
 These statistics cover the official repository of Lina Components.
 
-Total lines of code (LoC): 4300+
+Total lines of code (LoC): 4400+
 Total visual components (VC): 11

Resource/LINA.rc

@@ -16,6 +16,9 @@ TDOWNLOAD32 BITMAP "Bitmap\Large\TDownload.bmp"
 //TLOCALIZATIONMANAGER BITMAP "TLocalizationManager.bmp"
 TLOCALIZATIONMANAGER16 BITMAP "Bitmap\Small\TLocalizationManager.bmp"
 TLOCALIZATIONMANAGER32 BITMAP "Bitmap\Large\TLocalizationManager.bmp"
+//TPAINTMEMO BITMAP "TPaintMemo.bmp"
+TPAINTMEMO16 BITMAP "Bitmap\Small\TPaintMemo.bmp"
+TPAINTMEMO32 BITMAP "Bitmap\Large\TPaintMemo.bmp"
 //TSCRIPTMANAGER BITMAP "TScriptManager.bmp"
 TSCRIPTMANAGER16 BITMAP "Bitmap\Small\TScriptManager.bmp"
 TSCRIPTMANAGER32 BITMAP "Bitmap\Large\TScriptManager.bmp"

Source/uAdvCtrls.pas

@@ -10,10 +10,18 @@ interface
 
 uses
   { Standard-Units }
-  SysUtils, Classes, StdCtrls, Windows, Messages, Graphics,
+  SysUtils, Classes, StdCtrls, Windows, Messages, Graphics, Controls,
   { Andere Package-Units }
   uBase;
 
+type
+  { Hilfsklassen }
+  TMemoCaptionMode = (mcmAnyState,mcmUnfocusedOnly);
+
+type
+  { Ereignisse }
+  TPaintMemoPaintEvent = procedure(Sender: TObject) of object;
+
 type
   TCommandButton = class(TButton)
   private
@@ -59,6 +67,39 @@ type
     property HorizontalScrollWidth: Integer read FHorizontalScrollWidth write FHorizontalScrollWidth default 48;
   end;
 
+  TPaintMemo = class(TMemo)
+  private
+    { Private-Deklarationen }
+    FAbout: TComponentAbout;
+    FShowCaption: Boolean;
+    FCaption: TCaption;
+    FCaptionFont: TFont;
+    FCaptionMode: TMemoCaptionMode;
+    FCaptionVisible: Boolean;
+    FCaptionPosition: TPoint;
+    { Ereignisse }
+    FPaintEvent: TPaintMemoPaintEvent;
+    { Methoden }
+    procedure SetShowCaption(Value: Boolean);
+    procedure SetCaptionFont(Value: TFont);
+    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
+  public
+    { Public-Deklarationen }
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    property CaptionVisible: Boolean read FCaptionVisible default False;
+  published
+    { Ereignisse}
+    property OnPaint: TPaintMemoPaintEvent read FPaintEvent write FPaintEvent;
+    { Published-Deklarationen }
+    property About: TComponentAbout read FAbout;
+    property ShowCaption: Boolean read FShowCaption write SetShowCaption default True;
+    property Caption: TCaption read FCaption write FCaption;
+    property CaptionFont: TFont read FCaptionFont write SetCaptionFont;
+    property CaptionMode: TMemoCaptionMode read FCaptionMode write FCaptionMode default mcmUnfocusedOnly;
+    property CaptionPosition: TPoint read FCaptionPosition write FCaptionPosition;
+  end;
+
 procedure Register;
 
 const
@@ -67,10 +108,16 @@ const
   CommandButtonComponent_Version = 1.0;
   CommandButtonComponent_Copyright = 'Copyright © 2014';
   CommandButtonComponent_Author = 'Dennis Göhlert a.o.';
+
   ScrollListBoxComponent_Name = 'ScrollListBox';
   ScrollListBoxComponent_Version = 1.0;
   ScrollListBoxComponent_Copyright = 'Copyright © 2014';
   ScrollListBoxComponent_Author = 'Dennis Göhlert a.o.';
+
+  PaintMemoComponent_Name = 'PaintMemo';
+  PaintMemoComponent_Version = 1.0;
+  PaintMemoComponent_Copyright = 'Copyright © 2014';
+  PaintMemoComponent_Author = 'Dennis Göhlert a.o.';
   { Messages }
   BS_COMMANDLINK = $0000000E;
   BM_SETIMAGE = $00F7;
@@ -82,7 +129,7 @@ implementation
 
 procedure Register;
 begin
-  RegisterComponents(ComponentsPage,[TCommandButton,TScrollListBox]);
+  RegisterComponents(ComponentsPage,[TCommandButton,TScrollListBox,TPaintMemo]);
 end;
 
 { ----------------------------------------------------------------------------
@@ -163,4 +210,73 @@ begin
   Perform(LB_SETTOPINDEX,Index,0);
 end;
 
+{ ----------------------------------------------------------------------------
+  TPaintMemo
+  ---------------------------------------------------------------------------- }
+
+constructor TPaintMemo.Create(AOwner: TComponent);
+begin
+  inherited;
+  FAbout := TComponentAbout.Create(PaintMemoComponent_Name,PaintMemoComponent_Version,PaintMemoComponent_Copyright,PaintMemoComponent_Author);
+  FShowCaption := True;
+  FCaptionFont := TFont.Create;
+  FCaptionFont.Assign(Font);
+  FCaptionFont.Color := clGray;
+  FCaptionFont.Style := [fsItalic];
+  FCaptionMode := mcmUnfocusedOnly;
+  FCaptionVisible := False;
+  FCaptionPosition.X := 5;
+  FCaptionPosition.Y := 0;
+end;
+
+destructor TPaintMemo.Destroy;
+begin
+  FAbout.Free;
+  FCaptionFont.Free;
+  inherited;
+end;
+
+procedure TPaintMemo.SetShowCaption(Value: Boolean);
+begin
+  FShowCaption := Value;
+  Repaint;
+end;
+
+procedure TPaintMemo.SetCaptionFont(Value: TFont);
+begin
+  FCaptionFont.Assign(Value);
+end;
+
+procedure TPaintMemo.WMPaint(var Message: TWMPaint);
+var
+  CCanvas: TControlCanvas;
+  CRect: TRect;
+begin
+  inherited;
+  FCaptionVisible := False;
+  if FShowCaption = True then
+  begin
+    if ((Focused = False) or (CaptionMode = mcmAnyState)) and (Length(Text) < 1) then
+    begin
+      CCanvas := TControlCanvas.Create;
+      try
+        CCanvas.Control := Self;
+        CCanvas.Brush.Color := Color;
+        CRect := ClientRect;
+        InflateRect(CRect,3,3);
+        CCanvas.FillRect(CRect);
+        CCanvas.Font.Assign(FCaptionFont);
+        CCanvas.TextOut(FCaptionPosition.X,FCaptionPosition.Y,FCaption);
+      finally
+        CCanvas.Free;
+      end;
+      FCaptionVisible := True;
+    end;
+  end;
+  if Assigned(OnPaint) = True then
+  begin
+    OnPaint(Self);
+  end;
+end;
+
 end.

Source/uCrypt.pas

@@ -270,20 +270,72 @@ begin
 end;
 
 procedure TVigenereCrypt.Decrypt;
-begin
-  //...
-  inherited;
-end;
-
-procedure TVigenereCrypt.Encrypt;
-{var
+var
   Encrypted: TStrings;
   LineIndex: Integer;
   CharIndex: Integer;
   Line: String;
-  Temp: Integer;
-  NormedKey: Integer;      }
+  KeyIndex: Integer;
+  CurKeyLetter: Integer;
+  CurLetter: Integer;
 begin
+  Encrypted := TStringList.Create;
+  try
+    Encrypted.Assign(Lines);
+    for LineIndex := 0 to Encrypted.Count do
+    begin
+      Line := Encrypted.Strings[LineIndex];
+      for CharIndex := 1 to Length(Line) do
+      begin
+        if Line[CharIndex] in ['A'..'Z'] then
+        begin
+          CurKeyLetter := Ord(KeyString[1 + (KeyIndex mod Length(KeyString))]) - Ord('A');
+          CurLetter := Ord(Line[CharIndex]) - Ord('A');
+          Line[CharIndex] := Chr(Ord('A') + ((26 + CurLetter - CurKeyLetter) mod 26));
+          Inc(KeyIndex);
+        end
+      end;
+      Encrypted.Strings[LineIndex] := Line;
+    end;
+    Lines.Assign(Encrypted);
+  finally
+    Encrypted.Free;
+  end;
+  inherited;
+end;
+
+procedure TVigenereCrypt.Encrypt;
+var
+  Encrypted: TStrings;
+  LineIndex: Integer;
+  CharIndex: Integer;
+  Line: String;
+  KeyIndex: Integer;
+  CurKeyLetter: Integer;
+  CurLetter: Integer;
+begin
+  Encrypted := TStringList.Create;
+  try
+    Encrypted.Assign(Lines);
+    for LineIndex := 0 to Encrypted.Count do
+    begin
+      Line := Encrypted.Strings[LineIndex];
+      for CharIndex := 1 to Length(Line) do
+      begin
+        if Line[CharIndex] in ['A'..'Z'] then
+        begin
+          CurKeyLetter := Ord(KeyString[1 + (KeyIndex mod Length(KeyString))]) - Ord('A');
+          CurLetter := Ord(Line[CharIndex]) - Ord('A');
+          Line[CharIndex] := Chr(Ord('A') + ((CurLetter + CurKeyLetter) mod 26));
+          Inc(KeyIndex);
+        end
+      end;
+      Encrypted.Strings[LineIndex] := Line;
+    end;
+    Lines.Assign(Encrypted);
+  finally
+    Encrypted.Free;
+  end;
   inherited;
 end;
 

Source/uSysTools.pas

@@ -91,6 +91,8 @@ type
   function RoundPos(Number: Extended; Pos: Byte): Extended;
   function CharLowerCase(Character: Char): Char;
   function CharUpperCase(Character: Char): Char;
+  function FontSizeToHeight(Size: Integer; PpI: Integer): Integer;
+  function FontHeightToSize(Height: Integer; PpI: Integer): Integer;
 
 const
   Spaces = [#9,#10,#13,#32,#160];
@@ -291,6 +293,17 @@ begin
   end;
 end;
 
+
+function FontSizeToHeight(Size: Integer; PpI: Integer): Integer;
+begin
+  Result := - Size * PpI div 72;
+end;
+
+function FontHeightToSize(Height: Integer; PpI: Integer): Integer;
+begin
+  Result := - Height * 72 div PpI;
+end;
+
 function WinUserName: String;
 var
   Buffer: array [0..255] of Char;