pascal/lina-components
1
0
Fork 0
mirror of https://bitbucket.org/Dennis07/lina-components.git synced 2025-01-23 10:24:43 +02:00
Code Issues Actions Releases Activity

Version 1.0 DEV 1.14b

Browse Source 
Signed-off-by: Dennis07 <den.goehlert@t-online.de>
This commit is contained in:
Dennis07 2015-06-29 01:58:38 +02:00
parent a7d74d0161
commit 2fd0c3296e
30 changed files with 666 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
Example/TScrollListBox/pExample.dpr Normal file
View File

@ -0,0 +1,15 @@
program pExample;
uses
Vcl.Forms,
uMain in 'uMain.pas' {fmMain};
{$R *.res}
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.Title := 'Example';
Application.CreateForm(TfmMain, fmMain);
Application.Run;
end.

176
Example/TScrollListBox/pExample.dproj Normal file
View File

@ -0,0 +1,176 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{D28E4737-637C-4A11-9D4B-624FB1C78C89}</ProjectGuid>
<ProjectVersion>15.3</ProjectVersion>
<FrameworkType>VCL</FrameworkType>
<MainSource>pExample.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
<TargetedPlatforms>1</TargetedPlatforms>
<AppType>Application</AppType>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
<Base_Win32>true</Base_Win32>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Base)'=='true') or '$(Base_Win64)'!=''">
<Base_Win64>true</Base_Win64>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_1)'!=''">
<Cfg_1>true</Cfg_1>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''">
<Cfg_1_Win32>true</Cfg_1_Win32>
<CfgParent>Cfg_1</CfgParent>
<Cfg_1>true</Cfg_1>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_2)'!=''">
<Cfg_2>true</Cfg_2>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<Icon_MainIcon>$(BDS)\bin\delphi_PROJECTICON.ico</Icon_MainIcon>
<DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace)</DCC_Namespace>
<DCC_DcuOutput>.\$(Platform)\$(Config)</DCC_DcuOutput>
<DCC_ExeOutput>.\$(Platform)\$(Config)</DCC_ExeOutput>
<DCC_E>false</DCC_E>
<DCC_N>false</DCC_N>
<DCC_S>false</DCC_S>
<DCC_F>false</DCC_F>
<DCC_K>false</DCC_K>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
<VerInfo_Locale>1033</VerInfo_Locale>
<DCC_UsePackage>frxDB19;FireDACASADriver;FireDACSqliteDriver;bindcompfmx;DBXSqliteDriver;AbbreviaVCL;vcldbx;FireDACPgDriver;FireDACODBCDriver;VampyreImagingPackage.D2009;fmx;rtl;dbrtl;DbxClientDriver;IndySystem;FireDACCommon;bindcomp;frx19;TeeDB;vclib;inetdbbde;DBXInterBaseDriver;GR32_DSGN_RSXE5;DataSnapCommon;MiscrosoftScriptControls;pkCindyDERDXE5;Tee;vclFireDAC;xmlrtl;svnui;ibxpress;DbxCommonDriver;SVATimer_DXE5;vclimg;IndyProtocols;dbxcds;DBXMySQLDriver;PieLib;FireDACCommonDriver;MetropolisUILiveTile;djsonrt;bindengine;vclactnband;vcldb;soaprtl;bindcompdbx;vcldsnap;bindcompvcl;pkCindyPackDXE5;TeeUI;FMXTee;vclie;pkCindyIEDXE5;vclshlctrls;fmxFireDAC;FireDACADSDriver;vcltouch;pkCindyDBCtrlsPackDXE5;pkCindyDBXDXE5;LINA_D_XE5;CustomIPTransport;SynEdit_RXE5;vclribbon;VclSmp;FireDAC;dsnap;IndyIPServer;Intraweb;fmxase;vcl;IndyCore;VCLRESTComponents;GR32_RSXE5;IndyIPCommon;CloudService;CodeSiteExpressPkg;dsnapcon;FireDACIBDriver;DebenuPDFLibraryLite;inet;FmxTeeUI;fmxobj;DCEF_XE5;FireDACMySQLDriver;vclx;inetdbxpress;webdsnap;svn;fmxdae;frxe19;RESTComponents;bdertl;FireDACMSAccDriver;adortl;dbexpress;IndyIPClient;$(DCC_UsePackage)</DCC_UsePackage>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win64)'!=''">
<DCC_UsePackage>FireDACASADriver;FireDACSqliteDriver;bindcompfmx;DBXSqliteDriver;AbbreviaVCL;FireDACPgDriver;FireDACODBCDriver;fmx;rtl;dbrtl;DbxClientDriver;IndySystem;FireDACCommon;bindcomp;vclib;DBXInterBaseDriver;DataSnapCommon;vclFireDAC;xmlrtl;ibxpress;DbxCommonDriver;vclimg;IndyProtocols;dbxcds;DBXMySQLDriver;FireDACCommonDriver;MetropolisUILiveTile;bindengine;vclactnband;vcldb;soaprtl;bindcompdbx;vcldsnap;bindcompvcl;vclie;vclshlctrls;fmxFireDAC;FireDACADSDriver;vcltouch;LINA_D_XE5;CustomIPTransport;SynEdit_RXE5;vclribbon;VclSmp;FireDAC;dsnap;IndyIPServer;Intraweb;fmxase;vcl;IndyCore;VCLRESTComponents;IndyIPCommon;CloudService;dsnapcon;FireDACIBDriver;inet;fmxobj;FireDACMySQLDriver;vclx;inetdbxpress;webdsnap;fmxdae;RESTComponents;FireDACMSAccDriver;adortl;dbexpress;IndyIPClient;$(DCC_UsePackage)</DCC_UsePackage>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
<DCC_DebugDCUs>true</DCC_DebugDCUs>
<DCC_Optimize>false</DCC_Optimize>
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
<DCC_DebugInfoInExe>true</DCC_DebugInfoInExe>
<DCC_RemoteDebug>true</DCC_RemoteDebug>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
<VerInfo_Locale>1033</VerInfo_Locale>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<DCC_RemoteDebug>false</DCC_RemoteDebug>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<DCC_DebugInformation>0</DCC_DebugInformation>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="uMain.pas">
<Form>fmMain</Form>
<FormType>dfm</FormType>
</DCCReference>
<BuildConfiguration Include="Release">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
<BuildConfiguration Include="Debug">
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType/>
<BorlandProject>
<Delphi.Personality>
<VersionInfo>
<VersionInfo Name="IncludeVerInfo">False</VersionInfo>
<VersionInfo Name="AutoIncBuild">False</VersionInfo>
<VersionInfo Name="MajorVer">1</VersionInfo>
<VersionInfo Name="MinorVer">0</VersionInfo>
<VersionInfo Name="Release">0</VersionInfo>
<VersionInfo Name="Build">0</VersionInfo>
<VersionInfo Name="Debug">False</VersionInfo>
<VersionInfo Name="PreRelease">False</VersionInfo>
<VersionInfo Name="Special">False</VersionInfo>
<VersionInfo Name="Private">False</VersionInfo>
<VersionInfo Name="DLL">False</VersionInfo>
<VersionInfo Name="Locale">1031</VersionInfo>
<VersionInfo Name="CodePage">1252</VersionInfo>
</VersionInfo>
<VersionInfoKeys>
<VersionInfoKeys Name="CompanyName"/>
<VersionInfoKeys Name="FileDescription"/>
<VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys>
<VersionInfoKeys Name="InternalName"/>
<VersionInfoKeys Name="LegalCopyright"/>
<VersionInfoKeys Name="LegalTrademarks"/>
<VersionInfoKeys Name="OriginalFilename"/>
<VersionInfoKeys Name="ProductName"/>
<VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
<VersionInfoKeys Name="Comments"/>
<VersionInfoKeys Name="CFBundleName"/>
<VersionInfoKeys Name="CFBundleDisplayName"/>
<VersionInfoKeys Name="UIDeviceFamily"/>
<VersionInfoKeys Name="CFBundleIdentifier"/>
<VersionInfoKeys Name="CFBundleVersion"/>
<VersionInfoKeys Name="CFBundlePackageType"/>
<VersionInfoKeys Name="CFBundleSignature"/>
<VersionInfoKeys Name="CFBundleAllowMixedLocalizations"/>
<VersionInfoKeys Name="UISupportedInterfaceOrientations"/>
<VersionInfoKeys Name="CFBundleExecutable"/>
<VersionInfoKeys Name="CFBundleResourceSpecification"/>
<VersionInfoKeys Name="LSRequiresIPhoneOS"/>
<VersionInfoKeys Name="CFBundleInfoDictionaryVersion"/>
<VersionInfoKeys Name="CFBundleDevelopmentRegion"/>
<VersionInfoKeys Name="package"/>
<VersionInfoKeys Name="label"/>
<VersionInfoKeys Name="versionCode"/>
<VersionInfoKeys Name="versionName"/>
<VersionInfoKeys Name="persistent"/>
<VersionInfoKeys Name="restoreAnyVersion"/>
<VersionInfoKeys Name="installLocation"/>
<VersionInfoKeys Name="largeHeap"/>
<VersionInfoKeys Name="theme"/>
</VersionInfoKeys>
<Source>
<Source Name="MainSource">pExample.dpr</Source>
</Source>
<Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k190.bpl">Microsoft Office 2000 Beispiele für gekapselte Komponenten für Automatisierungsserver</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dclofficexp190.bpl">Microsoft Office XP Beispiele für gekapselte Komponenten für Automation Server</Excluded_Packages>
</Excluded_Packages>
</Delphi.Personality>
<Deployment/>
<Platforms>
<Platform value="Win32">True</Platform>
<Platform value="Win64">False</Platform>
</Platforms>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
<Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
</Project>

2
Example/TScrollListBox/pExample.dproj.local Normal file
View File

@ -0,0 +1,2 @@
<?xml version="1.0" encoding="utf-8"?>
<BorlandProject/>

BIN
Example/TScrollListBox/pExample.exe Normal file
View File

Binary file not shown.

BIN
Example/TScrollListBox/pExample.identcache Normal file
View File

Binary file not shown.

BIN
Example/TScrollListBox/pExample.res Normal file
View File

Binary file not shown.

80
Example/TScrollListBox/uMain.dfm Normal file
View File

@ -0,0 +1,80 @@
object fmMain: TfmMain
Left = 0
Top = 0
BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsSingle
Caption = 'LinaComponents "TScrollListBox" Example'
ClientHeight = 329
ClientWidth = 434
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
PixelsPerInch = 96
TextHeight = 13
object lbLines: TScrollListBox
Left = 0
Top = 0
Width = 264
Height = 329
Align = alClient
ItemHeight = 13
Items.Strings = (
'----------------------------------------------------------------' +
'---'
'Welcome to the TScrollBar example program of LinaComponents!'
'----------------------------------------------------------------' +
'---'
'How does it work?'
'Simply change the "oversize view" setting and see what happens.')
ScrollWidth = 100
TabOrder = 0
TopIndex = 0
end
object pnButtons: TPanel
Left = 264
Top = 0
Width = 170
Height = 329
Align = alRight
TabOrder = 1
object laOversizeView: TLabel
Left = 6
Top = 39
Width = 155
Height = 13
AutoSize = False
Caption = 'Oversize view:'
end
object btAdd: TButton
Left = 6
Top = 8
Width = 155
Height = 25
Caption = 'Add...'
TabOrder = 0
OnClick = btAddClick
end
object coOversizeView: TComboBox
Left = 6
Top = 58
Width = 155
Height = 21
Style = csDropDownList
ItemIndex = 0
TabOrder = 1
Text = 'None'
OnChange = coOversizeViewChange
Items.Strings = (
'None'
'Horizontal scroll bar'
'Word wrapping')
end
end
end

86
Example/TScrollListBox/uMain.pas Normal file
View File

@ -0,0 +1,86 @@
unit uMain;
//////////////////////////////////////
/// Lina File Tools Example ///
/// **************************** ///
/// (c) 2014 Dennis Göhlert a.o. ///
//////////////////////////////////////
{$IF CompilerVersion <> 26.0}
{$MESSAGE ERROR 'This example was written to compile under Delphi XE5'}
{$ENDIF}
interface
{ Dies ist ein Beispielprojekt, um den Umgang und die mögliche Verwendeng der
TScrollListBox-Komponents zu veranschaulichen.
Es darf als Grundlage für eingene Projekte ohne vorherige Einwilligung
verwendet werden, solange mindestens eine LinaComponents-Unit im Projekt
verarbeitet wird.
WICHTIG: Im Gegensatz zur Entwicklung der LinaComponents selbst wurde bei
diesem Beispielprojekt keinerlei Rücksicht auf Abwärtskompatibilität
genommen. Dieses Beispielprogramm wurde in Embarcadero Delphi XE5
erstellt, entwickelt und kompiliert und könnte bei älteren Delphi-
Versionen zu Kompilierungsfehlern führen. }
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, uBase, Vcl.StdCtrls, uAdvCtrls,
Vcl.ExtCtrls;
type
TfmMain = class(TForm)
lbLines: TScrollListBox;
pnButtons: TPanel;
btAdd: TButton;
laOversizeView: TLabel;
coOversizeView: TComboBox;
procedure btAddClick(Sender: TObject);
procedure coOversizeViewChange(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
fmMain: TfmMain;
implementation
{$R *.dfm}
procedure TfmMain.btAddClick(Sender: TObject);
var
NewLine: String;
begin
InputQuery('New line','Text:',NewLine);
NewLine := Trim(NewLine);
if Length(NewLine) <> 0 then
begin
lbLines.Items.Add(NewLine);
end;
end;
procedure TfmMain.coOversizeViewChange(Sender: TObject);
begin
case coOversizeView.ItemIndex of
0: begin
lbLines.Style := lbStandard;
lbLines.HorizontalScrollBar := False;
lbLines.WordWrap := False;
end;
1: begin
lbLines.WordWrap := False;
lbLines.Style := lbStandard;
lbLines.HorizontalScrollBar := True;
end;
2: begin
lbLines.HorizontalScrollBar := False;
lbLines.WordWrap := True;
end;
end;
end;
end.

2
Feedback/fb_config.res
View File

@ -9,4 +9,4 @@ feedback=fbk
[default]
language=English
program=Lina Components
version=1.0
version=Dev

2
Feedback/fb_language.res
View File

@ -95,7 +95,7 @@
420=Altre annotazioni:
; ------------------------------------------------
; NORWEGIAN
; TRANSLATION BY: Lennart von Aasenden
; TRANSLATION BY: Jon Lennart von Aasenden
[Norsk]
; APPLICATION
000=Tilbakemelding

1
Feedback/fb_program.res
View File

@ -2,6 +2,7 @@
; ALL VERSIONS WITHOUT A "=" IN THE END ARE INVISIBLE!
[Lina Components]
1.0=
Dev=
[BonniChat]
1.02.0=
1.02.1=

2
Information/Statistics.txt
View File

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

BIN
Package/Delphi_XE5/LINA_D_XE5.identcache
View File

Binary file not shown.

BIN
Source/Compiled/uAdvCtrls.dcu
View File

Binary file not shown.

BIN
Source/Compiled/uBase.dcu
View File

Binary file not shown.

BIN
Source/Compiled/uCalc.dcu
View File

Binary file not shown.

BIN
Source/Compiled/uCrypt.dcu
View File

Binary file not shown.

BIN
Source/Compiled/uFileCtrls.dcu
View File

Binary file not shown.

BIN
Source/Compiled/uFileTools.dcu
View File

Binary file not shown.

BIN
Source/Compiled/uFrmCtrls.dcu
View File

Binary file not shown.

BIN
Source/Compiled/uInit.dcu
View File

Binary file not shown.

BIN
Source/Compiled/uLocalMgr.dcu
View File

Binary file not shown.

BIN
Source/Compiled/uScriptMgr.dcu
View File

Binary file not shown.

BIN
Source/Compiled/uSysCtrls.dcu
View File

Binary file not shown.

BIN
Source/Compiled/uSysTools.dcu
View File

Binary file not shown.

BIN
Source/Compiled/uVirtObj.dcu
View File

Binary file not shown.

BIN
Source/Compiled/uWebCtrls.dcu
View File

Binary file not shown.

141
Source/uAdvCtrls.pas
View File

@ -17,7 +17,7 @@ interface
uses
{ Standard-Units }
SysUtils, Classes, StdCtrls, Windows, Messages, Graphics, Controls, Printers,
Contnrs,
Contnrs, Forms,
{ Andere Package-Units }
uBase, uSysTools, uFileTools;
@ -32,17 +32,27 @@ type
type
TCommandButton = class(TButton)
protected
procedure CreateWnd; override;
procedure Loaded; override;
procedure CreateParams(var Params: TCreateParams); override;
private
{ Private-Deklarationen }
FAbout: TComponentAbout;
FCommandLink: Boolean;
FNote: WideString;
FShield: Boolean;
FIcon: TIcon;
FReplaceCaption: Boolean;
{ Methoden }
procedure SetCommandLink(Value: Boolean);
procedure SetNote(Value: WideString);
procedure SetShield(Value: Boolean);
procedure SetIcon(Value: TIcon);
procedure FIconChange(Sender: TObject);
procedure SetReplaceCaption(Value: Boolean);
procedure IconChange(Sender: TObject);
procedure UpdateShield;
procedure UpdateIcon;
public
{ Public-Deklarationen }
constructor Create(AOwner: TComponent); override;
@ -50,17 +60,22 @@ type
published
{ Published-Deklarationen }
property About: TComponentAbout read FAbout;
property CommandLink: Boolean read FCommandLink write SetCommandLink default False;
property Note: WideString read FNote write SetNote;
property Shield: Boolean read FShield write SetShield default False;
property Icon: TIcon read FIcon write SetIcon;
property ReplaceCaption: Boolean read FReplaceCaption write SetReplaceCaption default False;
end;
TScrollListBox = class(TListBox)
protected
{ Protected-Deklarationen }
procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
procedure WndProc(var Message: TMessage); override;
private
{ Private-Deklarationen }
FAbout: TComponentAbout;
FHorizontalScrollBar: Boolean;
FHorizontalScrollWidth: Integer;
FWordWrap: Boolean;
FItemHeights: array of Integer;
{ Methoden }
@ -69,8 +84,8 @@ type
procedure SetHorizontalScrollBar(Value: Boolean);
procedure SetWordWrap(Value: Boolean);
function GetItemHeights(Index: Integer): Integer;
procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
procedure UpdateItemHeights;
procedure UpdateHorizontalScrollBar;
public
{ Public-Deklarationen }
constructor Create(AOwner: TComponent); override;
@ -82,7 +97,6 @@ type
property About: TComponentAbout read FAbout;
property TopIndex: Integer read GetTopIndex write SetTopIndex;
property HorizontalScrollBar: Boolean read FHorizontalScrollBar write SetHorizontalScrollBar default False;
property HorizontalScrollWidth: Integer read FHorizontalScrollWidth write FHorizontalScrollWidth default 48;
property WordWrap: Boolean read FWordWrap write SetWordWrap default False;
end;
@ -248,16 +262,19 @@ begin
end;
{ ----------------------------------------------------------------------------
TAdvancedButton
TCommandButton
---------------------------------------------------------------------------- }
constructor TCommandButton.Create(AOwner: TComponent);
begin
inherited;
FAbout := TComponentAbout.Create(TCommandButton,CommandButtonComponent_Version,CommandButtonComponent_Copyright,CommandButtonComponent_Author);
FCommandLink := False;
FShield := False;
FIcon := TIcon.Create;
FIcon.OnChange := FIconChange;
FIcon.OnChange := IconChange;
FReplaceCaption := False;
Width := 125;
end;
destructor TCommandButton.Destroy;
@ -267,27 +284,92 @@ begin
inherited;
end;
procedure TCommandButton.SetCommandLink(Value: Boolean);
begin
FCommandLink := Value;
RecreateWnd;
end;
procedure TCommandButton.SetNote(Value: WideString);
begin
SendMessage(Handle,BCM_SETNOTE,0,LParam(Pointer(Value)));
fNote := Value;
FNote := Value;
end;
procedure TCommandButton.SetShield(Value: Boolean);
begin
SendMessage(Handle,BCM_SETSHIELD,0,LParam(Value));
fShield := Value;
FShield := Value;
UpdateShield;
UpdateIcon;
end;
procedure TCommandButton.SetIcon(Value: TIcon);
begin
SendMessage(Handle,BM_SETIMAGE,1,LParam(Value.Handle));
fIcon.Assign(Value);
FIcon.Assign(Value);
UpdateShield;
UpdateIcon;
end;
procedure TCommandButton.FIconChange(Sender: TObject);
procedure TCommandButton.SetReplaceCaption(Value: Boolean);
begin
SendMessage(Handle,BM_SETIMAGE,1,LParam(FIcon.Handle));
FReplaceCaption := Value;
if Value = True then
begin
SetWindowLong(Handle,GWL_STYLE,GetWindowLong(Handle,GWL_STYLE) or BS_ICON);
end else
begin
SetWindowLong(Handle,GWL_STYLE,GetWindowLong(Handle,GWL_STYLE) and (not BS_ICON));
end;
UpdateShield;
UpdateIcon;
end;
procedure TCommandButton.CreateWnd;
begin
inherited;
if not (csLoading in ComponentState) then
begin
UpdateShield;
UpdateIcon;
end;
end;
procedure TCommandButton.Loaded;
begin
inherited;
UpdateShield;
UpdateIcon;
end;
procedure TCommandButton.CreateParams(var Params: TCreateParams);
begin
inherited;
if CommandLink = True then
begin
Params.Style := Params.Style or BS_COMMANDLINK;
end;
end;
procedure TCommandButton.IconChange(Sender: TObject);
begin
UpdateShield;
UpdateIcon;
end;
procedure TCommandButton.UpdateShield;
begin
if (Icon.Empty = True) and (Shield = True) then
begin
SendMessage(Handle,BCM_SETSHIELD,0,LParam(Shield));
end;
end;
procedure TCommandButton.UpdateIcon;
begin
if (Icon.Empty = False) or (Shield = False) then
begin
SendMessage(Handle,BM_SETIMAGE,1,LParam(Icon.Handle));
end;
end;
{ ----------------------------------------------------------------------------
@ -299,7 +381,6 @@ begin
inherited;
FAbout := TComponentAbout.Create(TScrollListBox,ScrollListBoxComponent_Version,ScrollListBoxComponent_Copyright,ScrollListBoxComponent_Author);
FHorizontalScrollBar := False;
FHorizontalScrollWidth := 48;
FWordWrap := False;
end;
@ -323,7 +404,7 @@ procedure TScrollListBox.SetHorizontalScrollBar(Value: Boolean);
begin
if Value = True then
begin
Perform(LB_SETHORIZONTALEXTENT,FHorizontalScrollWidth,Longint(0));
UpdateHorizontalScrollBar;
end else
begin
Perform(LB_SETHORIZONTALEXTENT,0,0);
@ -338,7 +419,6 @@ begin
Style := lbOwnerDrawVariable;
end;
FWordWrap := Value;
RecreateWnd;
end;
function TScrollListBox.GetItemHeights(Index: Integer): Integer;
@ -379,6 +459,15 @@ begin
end;
end;
procedure TScrollListBox.WndProc(var Message: TMessage);
begin
inherited;
if (HorizontalScrollBar = True) and (Message.Msg = LB_ADDSTRING) or (Message.Msg = LB_DELETESTRING) or (Message.Msg = LB_INSERTSTRING) then
begin
UpdateHorizontalScrollBar;
end;
end;
procedure TScrollListBox.UpdateItemHeights;
var
Index: Integer;
@ -392,6 +481,23 @@ begin
end;
end;
procedure TScrollListBox.UpdateHorizontalScrollBar;
var
Index: Integer;
MaxWidth: Integer;
begin
MaxWidth := 0;
for Index := 0 to Items.Count - 1 do
begin
if Canvas.TextWidth(Items[Index]) > MaxWidth then
begin
MaxWidth := Canvas.TextWidth(Items[Index]);
end;
end;
MaxWidth := MaxWidth + GetSystemMetrics(SM_CXFRAME);
Perform(LB_SETHORIZONTALEXTENT,MaxWidth,0);
end;
procedure TScrollListBox.ScrollTo(Index: Integer);
begin
Perform(LB_SETTOPINDEX,Index,0);
@ -466,7 +572,6 @@ begin
OnPaint(Self);
end;
end;
{ ----------------------------------------------------------------------------
TShortcutLabelFont
---------------------------------------------------------------------------- }

167
Source/uSysTools.pas
View File

@ -200,6 +200,7 @@ type
function WinUserAdmin: Boolean;
function WinUserExists(UsrNme: String): Boolean;
{ Array-Position }
function ArrayPos(const AValue; const AArray: array of const): Integer; overload;
function ArrayPos(const AValue: Variant; const AArray: array of Variant): Integer; overload;
function ArrayPos(const AValue: Char; const AArray: array of Char): Integer; overload;
function ArrayPos(const AValue: ShortString; const AArray: array of ShortString): Integer; overload;
@ -298,6 +299,16 @@ type
procedure SetMethodSubProp(Instance: TObject; const PropName: String; Value: TMethod);
function SubPropIsType(Instance: TObject; const PropName: String; TypeKind: TTypeKind): Boolean;
function SubPropType(Instance: TObject; const PropName: String): TTypeKind; overload;
{ Uhrzeit }
function SystemTime: TSystemTime;
function Year: Word;
function Month: Word;
function DayOfWeek: Word;
function Day: Word;
function Hour: Word;
function Minute: Word;
function Second: Word;
function Milliseconds: Word;
{ Sonstige }
function ExtractClassName(FullClassName: String; CaseSensitive: Boolean = True): String;
function CountLines(S: String): Integer;
@ -1143,6 +1154,51 @@ begin
end;
end;
function SystemTime: TSystemTime;
begin
GetLocalTime(Result);
end;
function Year: Word;
begin
Result := SystemTime.wYear;
end;
function Month: Word;
begin
Result := SystemTime.wMonth;
end;
function DayOfWeek: Word;
begin
Result := SystemTime.wDayOfWeek;
end;
function Day: Word;
begin
Result := SystemTime.wDay;
end;
function Hour: Word;
begin
Result := SystemTime.wHour;
end;
function Minute: Word;
begin
Result := SystemTime.wMinute;
end;
function Second: Word;
begin
Result := SystemTime.wSecond;
end;
function Milliseconds: Word;
begin
Result := SystemTime.wMilliseconds;
end;
function ExtractClassName(FullClassName: String; CaseSensitive: Boolean = True): String;
begin
if ((FullClassName[1] = 'T') or ((CaseSensitive = False) and (FullClassName[1] = 't'))) and ((FullClassName[2] in UppercaseLetters) or (CaseSensitive = False)) then
@ -1299,6 +1355,117 @@ begin
Result := Languages.NameFromLocaleID[Languages.UserDefaultLocale];
end;
function ArrayPos(const AValue; const AArray: array of const): Integer; overload;
{ Da diese Methode anonyme Parameter übergeben bekommt (bzw. die Parameter
anonym übergeben werden), entsteht aufgrund der Typenüberprüfung für jedes
Element von AArray eine erhebliche Performanzeinbuße.
Diese Methode sollte deswegen nur in Ausnamefällen verwendet werden.
Sofern möglich, sollte alternativ auch die Funktion ArrayPos(Variant, array of
Vairant) verwendet werden. }
var
Index: Integer;
begin
Result := Low(AArray) - 1;
for Index := Low(AArray) to High(AArray) do
begin
case AArray[Index].VType of
vtInteger: if AArray[Index].VInteger = Integer(AValue) then
begin
Result := Index;
Exit;
end;
vtBoolean: if AArray[Index].VBoolean = Boolean(AValue) then
begin
Result := Index;
Exit;
end;
vtChar: if AArray[Index].VChar = AnsiChar(AValue) then
begin
Result := Index;
Exit;
end;
vtExtended: if AArray[Index].VExtended = PExtended(AValue) then
begin
Result := Index;
Exit;
end;
vtString: if AArray[Index].VString = PShortString(AValue) then
begin
Result := Index;
Exit;
end;
vtPointer: if AArray[Index].VPointer = Pointer(AValue) then
begin
Result := Index;
Exit;
end;
vtPChar: if AArray[Index].VPChar = PAnsiChar(AValue) then
begin
Result := Index;
Exit;
end;
vtObject: if AArray[Index].VObject = TObject(AValue) then
begin
Result := Index;
Exit;
end;
vtClass: if AArray[Index].VClass = TClass(AValue) then
begin
Result := Index;
Exit;
end;
{$IFNDEF NO_UNICODE}
vtWideChar: if AArray[Index].VWideChar = Char(AValue) then
begin
Result := Index;
Exit;
end;
vtPWideChar: if AArray[Index].VWideChar = PChar(AValue) then
begin
Result := Index;
Exit;
end;
vtUnicodeString: if AArray[Index].VUnicodeString = Pointer(AValue) then
begin
Result := Index;
Exit;
end;
{$ENDIF}
vtAnsiString: if AArray[Index].VAnsiString = Pointer(AValue) then
begin
Result := Index;
Exit;
end;
vtCurrency: if AArray[Index].VCurrency = PCurrency(AValue) then
begin
Result := Index;
Exit;
end;
vtVariant: if AArray[Index].VVariant = PVariant(AValue) then
begin
Result := Index;
Exit;
end;
vtInterface: if AArray[Index].VInterface = Pointer(AValue) then
begin
Result := Index;
Exit;
end;
vtWideString: if AArray[Index].VWideString = Pointer(AValue) then
begin
Result := Index;
Exit;
end;
vtInt64: if AArray[Index].VInt64 = PInt64(AValue) then
begin
Result := Index;
Exit;
end;
end;
end;
end;
function ArrayPos(const AValue: Variant; const AArray: array of Variant): Integer; overload;
{ Da diese Funktion als Parametertyp Variants verwendet, wird von der Verwendung
bei komplexeren Abläufen aufgrund der geringen Performance varianter Typen

57
Source/uWebCtrls.pas
View File

@ -33,11 +33,6 @@ type
TDownloadWorkBeginEvent = procedure(Sender: TObject; AWorkMode: TWorkMode) of object;
TDownloadWorkEndEvent = procedure(Sender: TObject; AWorkMode: TWorkMode) of object;
type
{ Hilfsklassen }
TWebProtocol = String[8];
TWebProtocols = array[1..5] of TWebProtocol;
type
{ Hauptklassen }
TDownload = class(TComponent)
@ -86,13 +81,7 @@ type
property SSL: Boolean read FSSL write FSSL default False;
end;
var
WebProtocols: TWebProtocols;
WebProtocolsSimple: TWebProtocols;
WebProtocolsSpecial: TWebProtocols;
procedure InitializeProtocols;
function ValidProtocol(const Protocol: TWebProtocol; const Protocols: TWebProtocols): Boolean;
function ValidProtocol(const Protocol: String; const Protocols: array of String): Boolean;
function StrIsURL(const S: String): Boolean;
function GetTagParamValue(const S,Tag,Param: String): String;
@ -100,11 +89,14 @@ var
const
{ Web-Protokolle }
WP_HTTP: TWebProtocol = 'http://';
WP_HTTPS: TWebProtocol = 'https://';
WP_FTP: TWebProtocol = 'ftp://';
WP_CALL: TWebProtocol = 'callto:';
WP_MAIL: TWebProtocol = 'mailto:';
WP_HTTP = 'http://';
WP_HTTPS = 'https://';
WP_FTP = 'ftp://';
WP_CALL = 'callto:';
WP_MAIL = 'mailto:';
WebProtocols: array [0..4] of String = (WP_HTTP,WP_HTTPS,WP_FTP,WP_CALL,WP_MAIL);
WebProtocolsSimple: array [0..1] of String = (WP_MAIL,WP_CALL);
WebProtocolsSpecial: array [0..2] of String = (WP_HTTP,WP_HTTPS,WP_FTP);
{ Meta-Daten }
DownloadComponent_Version = '1.0';
DownloadComponent_Copyright = 'Copyright © 2015';
@ -117,35 +109,12 @@ begin
RegisterComponents(ComponentsPage,[TDownload]);
end;
procedure InitializeProtocols;
begin
WebProtocols[1] := WP_HTTP;
WebProtocols[2] := WP_HTTPS;
WebProtocols[3] := WP_FTP;
WebProtocols[4] := WP_CALL;
WebProtocols[5] := WP_MAIL;
WebProtocolsSimple[1] := WP_MAIL;
WebProtocolsSimple[2] := WP_CALL;
WebProtocolsSpecial[1] := WP_HTTP;
WebProtocolsSpecial[2] := WP_HTTPS;
WebProtocolsSpecial[3] := WP_FTP;
end;
function ValidProtocol(const Protocol: TWebProtocol;
const Protocols: TWebProtocols): Boolean;
function ValidProtocol(const Protocol: String;
const Protocols: array of String): Boolean;
var
Index: 1..5;
begin
InitializeProtocols;
Result := False;
for Index := Low(Protocols) to High(Protocols) do
begin
if Protocols[Index] = Protocol then
begin
Result := True;
Exit;
end;
end;
Result := (ArrayPos(Protocol,Protocols) <> -1);
end;
function StrIsURL(const S: String): Boolean;
@ -160,7 +129,7 @@ const
var
Index: Integer;
DomainLength: Integer;
Protocol: TWebProtocol;
Protocol: String;
ProtocolValid: Boolean;
DoubleSlashRequired: Boolean;
begin