git-svn-id: https://svn.code.sf.net/p/kolmck/code@8 91bb2d04-0c0c-4d2d-88a5-bbb6f4c1fa07
This commit is contained in:
dkolmck
BIN
Addons/MCKMHXP.dcr
Normal file
BIN
Addons/MCKMHXP.dcr
Normal file
Binary file not shown.
267
Addons/MCKMHXP.pas
Normal file
267
Addons/MCKMHXP.pas
Normal file
@ -0,0 +1,267 @@
|
||||
unit MCKMHXP;
|
||||
// MHXP ��������� (MHXP Component)
|
||||
// ����� (Author): ����� ������� (Zharov Dmitry) aka �������� (Gandalf)
|
||||
// ���� �������� (Create date): 14-���(nov)-2001
|
||||
// ���� ��������� (Last correction Date): 21-���(apr)-2003
|
||||
// ������ (Version): 1.17
|
||||
// EMail: Gandalf@kol.mastak.ru
|
||||
// WWW: http://kol.mastak.ru
|
||||
// ������������� (Thanks):
|
||||
// Alexander Pravdin
|
||||
// ����� � (New in):
|
||||
// V1.17
|
||||
// [+] ������� �������� (External manifest) [KOLnMCK]
|
||||
//
|
||||
// V1.16
|
||||
// [+] ��������� D7 (D7 Support) [KOLnMCK]
|
||||
//
|
||||
// V1.15
|
||||
// [+] ��������� D6 (D6 Support) <Thanks to Alexander Pravdin> [KOLnMCK]
|
||||
//
|
||||
// V1.14
|
||||
// [!.] ������� ��������� (Small Fixing) [MCK]
|
||||
//
|
||||
// V1.13
|
||||
// [+] Tag [MCK]
|
||||
// [*] Code MCK Optim-z [MCK]
|
||||
//
|
||||
// V1.12
|
||||
// [*] Hide Tag as unused [MCK]
|
||||
// [*] Del Unused modules [MCK]
|
||||
//
|
||||
// V1.11
|
||||
// [*] Needn't to create and free KOLObj [MCK]
|
||||
// [*] Nearly clear KOL-file [KOL]
|
||||
//
|
||||
// V1.1
|
||||
// [!] Resource Compile [MCK]
|
||||
//
|
||||
// ������ ��� (To-Do list):
|
||||
// 1. �������������� (Optimize)
|
||||
// 2. ���������� (Clear Stuff)
|
||||
// 3. XP ������ ���� ���� �� ������ (XP in Project must be ONE)
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
KOL, Mirror, Classes, Windows, Forms, SysUtils,
|
||||
{$WARNINGS OFF}
|
||||
ToolIntf, Exptintf
|
||||
{$WARNINGS ON}
|
||||
;
|
||||
|
||||
type
|
||||
|
||||
TKOLMHXP = class(TKOLObj)
|
||||
private
|
||||
FAppName: string;
|
||||
FDescription: string;
|
||||
FExternal: Boolean;
|
||||
procedure SetAppName(Value: string);
|
||||
procedure SetDescription(Value: string);
|
||||
procedure SetExternal(const Value: Boolean);
|
||||
protected
|
||||
function AdditionalUnits: string; override;
|
||||
procedure SetupFirst(SL: TStringList; const AName, AParent, Prefix: string); override;
|
||||
function NotAutoFree: Boolean; override;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
published
|
||||
property AppName: string read FAppName write SetAppName;
|
||||
property Description: string read FDescription write SetDescription;
|
||||
property External: Boolean read FExternal write SetExternal;
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
|
||||
{$R 'MCKMHXP.dcr'}
|
||||
|
||||
implementation
|
||||
|
||||
function SaveManifest(AppName, Description, ThemeName: string): Boolean;
|
||||
var
|
||||
RL: TStringList;
|
||||
begin
|
||||
|
||||
Result := True;
|
||||
RL := TStringList.Create;
|
||||
RL.Add('<?xml version="1.0" encoding="UTF-8" standalone="yes"?>');
|
||||
RL.Add('<assembly xmlns="urn:schemas-microsoft-com:asm.v1"');
|
||||
RL.Add('manifestVersion="1.0">');
|
||||
RL.Add('<assemblyIdentity');
|
||||
RL.Add(' name="' + AppName + '"');
|
||||
RL.Add(' processorArchitecture="x86"');
|
||||
RL.Add(' version="1.0.0.0"');
|
||||
RL.Add(' type="win32"/>');
|
||||
RL.Add('<description>' + Description + '</description>');
|
||||
RL.Add('<dependency>');
|
||||
RL.Add(' <dependentAssembly>');
|
||||
RL.Add(' <assemblyIdentity');
|
||||
RL.Add(' type="win32"');
|
||||
RL.Add(' name="Microsoft.Windows.Common-Controls"');
|
||||
RL.Add(' version="6.0.0.0"');
|
||||
RL.Add(' processorArchitecture="x86"');
|
||||
RL.Add(' publicKeyToken="6595b64144ccf1df"');
|
||||
RL.Add(' language="*"');
|
||||
RL.Add(' />');
|
||||
RL.Add(' </dependentAssembly>');
|
||||
RL.Add('</dependency>');
|
||||
RL.Add('</assembly>');
|
||||
|
||||
RL.SaveToFile(ThemeName);
|
||||
RL.Free;
|
||||
end;
|
||||
|
||||
procedure GenerateManifestResource(AppName, Description: string; const RsrcName, FileName: string;
|
||||
var Updated: Boolean);
|
||||
var
|
||||
RL: TStringList;
|
||||
Buf1, Buf2: PChar;
|
||||
S: string;
|
||||
I, J: Integer;
|
||||
F: THandle;
|
||||
begin
|
||||
if not SaveManifest(AppName, Description, ProjectSourcePath + RsrcName + '.manifest' {'themed.manifest'}) then
|
||||
Exit;
|
||||
RL := TStringList.Create;
|
||||
RL.Add('1 24 "' + RsrcName + '.manifest"'); {'themed.manifest'}
|
||||
RL.SaveToFile(ProjectSourcePath + FileName + '.rc');
|
||||
RL.Free;
|
||||
Buf1 := nil;
|
||||
Buf2 := nil;
|
||||
I := 0; J := 0;
|
||||
S := ProjectSourcePath + FileName + '.res';
|
||||
if FileExists(S) then
|
||||
begin
|
||||
I := FileSize(S);
|
||||
if I > 0 then
|
||||
begin
|
||||
GetMem(Buf1, I);
|
||||
F := KOL.FileCreate(S, ofOpenRead or ofShareDenyWrite or ofOpenExisting);
|
||||
if F <> THandle(-1) then
|
||||
begin
|
||||
KOL.FileRead(F, Buf1^, I);
|
||||
KOL.FileClose(F);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
ExecuteWait(ExtractFilePath(Application.ExeName) + 'brcc32.exe', '"' +
|
||||
ProjectSourcePath + FileName + '.rc' + '"',
|
||||
ProjectSourcePath, SW_HIDE, INFINITE, nil);
|
||||
if FileExists(S) then
|
||||
begin
|
||||
J := FileSize(S);
|
||||
if J > 0 then
|
||||
begin
|
||||
GetMem(Buf2, J);
|
||||
F := KOL.FileCreate(S, ofOpenRead or ofShareDenyWrite or ofOpenExisting);
|
||||
if F <> THandle(-1) then
|
||||
begin
|
||||
KOL.FileRead(F, Buf2^, J);
|
||||
KOL.FileClose(F);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
if (Buf1 = nil) or (I <> J) or
|
||||
(Buf2 <> nil) and not CompareMem(Buf1, Buf2, J) then
|
||||
begin
|
||||
Updated := TRUE;
|
||||
end;
|
||||
if Buf1 <> nil then FreeMem(Buf1);
|
||||
if Buf2 <> nil then FreeMem(Buf2);
|
||||
end;
|
||||
|
||||
constructor TKOLMHXP.Create(AOwner: TComponent);
|
||||
begin
|
||||
|
||||
inherited;
|
||||
FAppName := 'Organization.Division.Name';
|
||||
FDescription := 'Application description here';
|
||||
FExternal := True;
|
||||
|
||||
end;
|
||||
|
||||
destructor TKOLMHXP.Destroy;
|
||||
begin
|
||||
inherited;
|
||||
|
||||
end;
|
||||
|
||||
function TKOLMHXP.AdditionalUnits;
|
||||
begin
|
||||
Result := ', KOLMHXP';
|
||||
|
||||
end;
|
||||
|
||||
procedure TKOLMHXP.SetupFirst(SL: TStringList; const AName,
|
||||
AParent, Prefix: string);
|
||||
var
|
||||
RsrcFile, RsrcName, s: string;
|
||||
begin
|
||||
RsrcName := UpperCase(ParentKOLForm.FormName + '_' + Name);
|
||||
RsrcFile := ParentKOLForm.FormName + '_' + Name;
|
||||
SL.Add(Prefix + 'InitCommonControls;');
|
||||
if FExternal then
|
||||
begin
|
||||
if ToolServices <> nil then
|
||||
begin
|
||||
s := ToolServices.GetProjectName;
|
||||
Delete(s, Length(s) - Length(ExtractFileExt(s)) + 1, Length(ExtractFileExt(s)));
|
||||
s := s + '.exe';
|
||||
SaveManifest(AppName, Description, s + '.manifest');
|
||||
DeleteFile(ProjectSourcePath + RsrcName + '.manifest');
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
// SL.Add(Prefix + 'InitCommonControls;');
|
||||
SL.Add(Prefix + '{$R ' + RsrcFile + '.RES}');
|
||||
GenerateManifestResource(AppName, Description, RsrcName, RsrcFile, fUpdated);
|
||||
if ToolServices <> nil then
|
||||
begin
|
||||
s := ToolServices.GetProjectName;
|
||||
Delete(s, Length(s) - Length(ExtractFileExt(s)) + 1, Length(ExtractFileExt(s)));
|
||||
s := s + '.exe';
|
||||
DeleteFile(s + '.manifest');
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TKOLMHXP.NotAutoFree: Boolean;
|
||||
begin
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
procedure TKOLMHXP.SetAppName(Value: string);
|
||||
begin
|
||||
if FAppName <> Value then
|
||||
begin
|
||||
FAppName := Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
procedure TKOLMHXP.SetDescription(Value: string);
|
||||
begin
|
||||
if FDescription <> Value then
|
||||
begin
|
||||
FDescription := Value;
|
||||
Change;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TKOLMHXP.SetExternal(const Value: Boolean);
|
||||
begin
|
||||
FExternal := Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterComponents('KOLAddons', [TKOLMHXP]);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
104
Addons/MCKPageSetup.pas
Normal file
104
Addons/MCKPageSetup.pas
Normal file
@ -0,0 +1,104 @@
|
||||
unit mckPageSetup;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
KOL,KOLPageSetupDialog,Windows, Classes,Graphics,
|
||||
mirror,mckObjs ;
|
||||
|
||||
type
|
||||
|
||||
TKOLPageSetupDialog = class(TKOLObj)
|
||||
private
|
||||
fOptions : TPageSetupOptions;
|
||||
fAlwaysReset : Boolean;
|
||||
protected
|
||||
function AdditionalUnits: string; override;
|
||||
procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;
|
||||
procedure SetOptions(const Value : TPageSetupOptions);
|
||||
procedure SetAlwaysReset(const Value : Boolean);
|
||||
public
|
||||
constructor Create( AOwner: TComponent ); override;
|
||||
destructor Destroy;override;
|
||||
published
|
||||
property Options : TPageSetupOptions read fOptions write SetOptions;
|
||||
property AlwaysReset : Boolean read fAlwaysReset write SetAlwaysReset;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
procedure Register;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.dcr}
|
||||
|
||||
|
||||
|
||||
constructor TKOLPageSetupDialog.Create( AOwner: TComponent );
|
||||
begin
|
||||
inherited Create(Aowner);
|
||||
fAlwaysReset := false;
|
||||
fOptions := [psdMargins,psdOrientation,psdSamplePage,psdPaperControl,psdPrinterControl];
|
||||
end;
|
||||
|
||||
destructor TKOLPageSetupDialog.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
procedure TKOLPageSetupDialog.SetAlwaysReset(const Value: Boolean);
|
||||
begin
|
||||
fAlwaysReset := Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
|
||||
procedure TKOLPageSetupDialog.SetOptions(const Value : TPageSetupOptions);
|
||||
begin
|
||||
fOptions := Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
function TKOLPageSetupDialog.AdditionalUnits;
|
||||
begin
|
||||
Result := ', KOLPageSetupDialog';
|
||||
end;
|
||||
|
||||
|
||||
procedure TKOLPageSetupDialog.SetupFirst(SL: TStringList; const AName,
|
||||
AParent, Prefix: String);
|
||||
var
|
||||
s : String;
|
||||
begin
|
||||
if (psdMargins in fOptions) then s := s + ',psdMargins';
|
||||
if (psdOrientation in fOptions) then s := s + ',psdOrientation';
|
||||
if (psdSamplePage in fOptions) then s := s + ',psdSamplePage';
|
||||
if (psdPaperControl in fOptions) then s := s + ',psdPaperControl';
|
||||
if (psdPrinterControl in fOptions) then s := s + ',psdPrinterControl';
|
||||
if (psdHundredthsOfMillimeters in fOptions) then s := s + ',psdHundredthsOfMillimeters';
|
||||
if (psdThousandthsOfInches in fOptions) then s := s + ',psdThousandthsOfInches';
|
||||
if (psdUseMargins in fOptions) then s := s + ',psdUseMargins';
|
||||
if (psdUseMinMargins in fOptions) then s := s + ',psdUseMinMargins';
|
||||
if (psdWarning in fOptions) then s := s + ',psdWarning';
|
||||
if (psdHelp in fOptions) then s := s + ',psdHelp';
|
||||
if (psdReturnDC in fOptions) then s:= s + ',psdReturnDC';
|
||||
if s <> '' then
|
||||
if s[1] = ',' then s[1] := Chr(32);
|
||||
SL.Add(Prefix + AName + ' := NewPageSetupDialog(' + AParent + ',[' + s + ']);');
|
||||
if fAlwaysReset then SL.Add(Prefix + AName + '.AlwaysReset := True;');
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterComponents('KOLAddons', [TKOLPageSetupDialog]);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
144
Addons/MCKPrintDialogs.pas
Normal file
144
Addons/MCKPrintDialogs.pas
Normal file
@ -0,0 +1,144 @@
|
||||
unit mckPrintDialogs;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
KOL,KOLPrintDialogs,Windows, Classes,Graphics,
|
||||
mirror,mckObjs ;
|
||||
|
||||
type
|
||||
|
||||
TKOLPrintDialog = class(TKOLObj)
|
||||
private
|
||||
ftagPD : tagPD;
|
||||
fOptions : TPrintDlgOptions;
|
||||
fAlwaysReset : Boolean;
|
||||
protected
|
||||
function AdditionalUnits: string; override;
|
||||
procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;
|
||||
procedure SetOptions(const Value : TPrintDlgOptions);
|
||||
procedure SetFromPage(const Value : WORD);
|
||||
procedure SetToPage(const Value : WORD);
|
||||
procedure SetMinPage(const Value : WORD);
|
||||
procedure SetMaxPage(const Value : WORD);
|
||||
procedure SetCopies(const Value : WORD);
|
||||
procedure SetAlwaysReset(const Value : Boolean);
|
||||
public
|
||||
constructor Create( AOwner: TComponent ); override;
|
||||
published
|
||||
property FromPage : WORD read ftagPD.nFromPage write SetFromPage;
|
||||
property ToPage : WORD read ftagPD.nToPage write SetToPage;
|
||||
property MinPage : WORD read ftagPD.nMinPage write SetMinPage;
|
||||
property MaxPage : WORD read ftagPD.nMaxPage write SetMaxPage;
|
||||
property Copies : WORD read ftagPD.nCopies write SetCopies;
|
||||
property Options : TPrintDlgOptions read fOptions write SetOptions;
|
||||
property AlwaysReset : Boolean read fAlwaysReset write SetAlwaysReset;
|
||||
end;
|
||||
|
||||
|
||||
procedure Register;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.dcr}
|
||||
|
||||
|
||||
|
||||
|
||||
constructor TKOLPrintDialog.Create( AOwner: TComponent );
|
||||
begin
|
||||
inherited Create(Aowner);
|
||||
fAlwaysReset := false;
|
||||
FromPage := 1;
|
||||
ToPage := 1;
|
||||
MinPage := 1;
|
||||
MaxPage := 1;
|
||||
Copies := 1;
|
||||
end;
|
||||
|
||||
procedure TKOLPrintDialog.SetAlwaysReset(const Value : Boolean);
|
||||
begin
|
||||
fAlwaysReset := Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
procedure TKOLPrintDialog.SetOptions(const Value : TPrintDlgOptions);
|
||||
begin
|
||||
fOptions := Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
procedure TKOLPrintDialog.SetFromPage(const Value : WORD);
|
||||
begin
|
||||
ftagPD.nFromPage := Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
procedure TKOLPrintDialog.SetToPage(const Value : WORD);
|
||||
begin
|
||||
ftagPD.nToPage := Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
procedure TKOLPrintDialog.SetMinPage(const Value : WORD);
|
||||
begin
|
||||
ftagPD.nMinPage := Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
procedure TKOLPrintDialog.SetMaxPage(const Value : WORD);
|
||||
begin
|
||||
ftagPD.nMaxPage := Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
procedure TKOLPrintDialog.SetCopies(const Value : WORD);
|
||||
begin
|
||||
ftagPD.nCopies := Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
function TKOLPrintDialog.AdditionalUnits;
|
||||
begin
|
||||
Result := ', KOLPrintDialogs';
|
||||
end;
|
||||
|
||||
|
||||
procedure TKOLPrintDialog.SetupFirst(SL: TStringList; const AName,
|
||||
AParent, Prefix: String);
|
||||
var
|
||||
s : String;
|
||||
begin
|
||||
if (pdPrinterSetup in fOptions) then s := s + ',pdPrinterSetup';
|
||||
if (pdCollate in fOptions) then s := s + ',pdCollate';
|
||||
if (pdPrintToFile in fOptions) then s := s + ',pdPrintToFile';
|
||||
if (pdPageNums in fOptions) then s := s + ',pdPageNums';
|
||||
if (pdSelection in fOptions) then s := s + ',pdSelection';
|
||||
if (pdWarning in fOptions) then s := s + ',pdWarning';
|
||||
if (pdDeviceDepend in fOptions) then s := s + ',pdDeviceDepend';
|
||||
if (pdHelp in fOptions) then s := s + ',pdHelp';
|
||||
if (pdReturnDC in fOptions) then s:= s + ',pdReturnDC';
|
||||
if s <> '' then
|
||||
if s[1] = ',' then s[1] := Chr(32);
|
||||
SL.Add( Prefix + AName + ' := NewPrintDialog(' + AParent + ',[' + s + ']);');
|
||||
if fAlwaysReset then SL.Add(Prefix + AName + '.AlwaysReset := true;');
|
||||
SL.Add(Prefix + AName + '.FromPage :=' + Int2Str(Integer(ftagPD.nFromPage)) + ';');
|
||||
SL.Add(Prefix + AName + '.ToPage :=' + Int2Str(Integer(ftagPD.nToPage)) + ';');
|
||||
SL.Add(Prefix + AName + '.MinPage :=' + Int2Str(Integer(ftagPD.nMinPage)) + ';');
|
||||
SL.Add(Prefix + AName + '.MaxPage :=' + Int2Str(Integer(ftagPD.nMaxPage)) + ';');
|
||||
SL.Add(Prefix + AName + '.Copies :=' + Int2Str(Integer(ftagPD.nCopies)) + ';');
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterComponents('KOLAddons', [TKOLPrintDialog]);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
314
Addons/MCKReport.pas
Normal file
314
Addons/MCKReport.pas
Normal file
@ -0,0 +1,314 @@
|
||||
unit MCKReport;
|
||||
|
||||
interface
|
||||
|
||||
uses KOL, Windows, Messages, Dialogs, Forms, Classes, Controls, Graphics, SysUtils,
|
||||
mirror, mckCtrls, KOLReport;
|
||||
|
||||
type
|
||||
TKOLReport = class( TKOLObj )
|
||||
private
|
||||
FOnNewBand: TOnEvent;
|
||||
FOnPrint: TOnEvent;
|
||||
FOnNewPage: TOnEvent;
|
||||
FDoubleBufferedPreview: Boolean;
|
||||
FDocumentName: String;
|
||||
procedure SetOnNewBand(const Value: TOnEvent);
|
||||
procedure SetOnNewPage(const Value: TOnEvent);
|
||||
procedure SetOnPrint(const Value: TOnEvent);
|
||||
procedure SetDoubleBufferedPreview(const Value: Boolean);
|
||||
procedure SetDocumentName(const Value: String);
|
||||
protected
|
||||
function AdditionalUnits: String; override;
|
||||
procedure AssignEvents( SL: TStringList; const AName: String ); override;
|
||||
procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;
|
||||
published
|
||||
property OnPrint: TOnEvent read FOnPrint write SetOnPrint;
|
||||
property OnNewPage: TOnEvent read FOnNewPage write SetOnNewPage;
|
||||
property OnNewBand: TOnEvent read FOnNewBand write SetOnNewBand;
|
||||
property DoubleBufferedPreview: Boolean read FDoubleBufferedPreview write SetDoubleBufferedPreview;
|
||||
property DocumentName: String read FDocumentName write SetDocumentName;
|
||||
end;
|
||||
|
||||
TKOLBand = class( TKOLPanel )
|
||||
private
|
||||
FFrames: TFrames;
|
||||
procedure SetFrames(const Value: TFrames);
|
||||
protected
|
||||
function SetupParams( const AName, AParent: String ): String; override;
|
||||
function AdditionalUnits: String; override;
|
||||
function NoDrawFrame: Boolean; override;
|
||||
procedure Set_VA(const Value: TVerticalAlign); override;
|
||||
public
|
||||
constructor Create( AOwner: TComponent ); override;
|
||||
procedure Paint; override;
|
||||
published
|
||||
property Frames: TFrames read FFrames write SetFrames;
|
||||
end;
|
||||
|
||||
TKOLReportLabel = class( TKOLLabel )
|
||||
private
|
||||
FFrames: TFrames;
|
||||
procedure SetFrames(const Value: TFrames);
|
||||
protected
|
||||
function SetupParams( const AName, AParent: String ): String; override;
|
||||
function AdditionalUnits: String; override;
|
||||
function TypeName: String; override;
|
||||
function NoDrawFrame: Boolean; override;
|
||||
function AdjustVerticalAlign( Value: TVerticalAlign ): TVerticalAlign; override;
|
||||
public
|
||||
constructor Create( AOwner: TComponent ); override;
|
||||
procedure Paint; override;
|
||||
function BorderNeeded: Boolean; override;
|
||||
published
|
||||
property Frames: TFrames read FFrames write SetFrames;
|
||||
property Border;
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
|
||||
{$R KOLReport.dcr}
|
||||
|
||||
implementation
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterComponents( 'KOLAddons', [ TKOLReport, TKOLBand, TKOLReportLabel ] );
|
||||
end;
|
||||
|
||||
function CalcFrames( const Frames: TFrames ): String;
|
||||
begin
|
||||
Result := '';
|
||||
if frLeft in Frames then
|
||||
Result := 'frLeft,';
|
||||
if frTop in Frames then
|
||||
Result := Result + 'frTop,';
|
||||
if frRight in Frames then
|
||||
Result := Result + 'frRight,';
|
||||
if frBottom in Frames then
|
||||
Result := Result + 'frBottom,';
|
||||
if Result <> '' then
|
||||
Delete( Result, Length( Result ), 1 );
|
||||
Result := '[' + Result + ']';
|
||||
end;
|
||||
|
||||
type
|
||||
TFakeControl = class( TControl )
|
||||
public
|
||||
property Color;
|
||||
end;
|
||||
|
||||
{ TKOLReport }
|
||||
|
||||
function TKOLReport.AdditionalUnits: String;
|
||||
begin
|
||||
Result := inherited AdditionalUnits + ', KOLReport';
|
||||
end;
|
||||
|
||||
procedure TKOLReport.AssignEvents(SL: TStringList; const AName: String);
|
||||
begin
|
||||
inherited;
|
||||
DoAssignEvents( SL, AName, [ 'OnPrint', 'OnNewPage', 'OnNewBand' ],
|
||||
[ @ OnPrint, @ OnNewPage, @ OnNewBand ] );
|
||||
end;
|
||||
|
||||
procedure TKOLReport.SetDocumentName(const Value: String);
|
||||
begin
|
||||
FDocumentName := Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
procedure TKOLReport.SetDoubleBufferedPreview(const Value: Boolean);
|
||||
begin
|
||||
FDoubleBufferedPreview := Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
procedure TKOLReport.SetOnNewBand(const Value: TOnEvent);
|
||||
begin
|
||||
FOnNewBand := Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
procedure TKOLReport.SetOnNewPage(const Value: TOnEvent);
|
||||
begin
|
||||
FOnNewPage := Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
procedure TKOLReport.SetOnPrint(const Value: TOnEvent);
|
||||
begin
|
||||
FOnPrint := Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
procedure TKOLReport.SetupFirst(SL: TStringList; const AName, AParent,
|
||||
Prefix: String);
|
||||
begin
|
||||
inherited;
|
||||
if DoubleBufferedPreview then
|
||||
SL.Add( Prefix + AName + '.DoubleBufferedPreview := TRUE;' );
|
||||
if Trim( DocumentName ) <> '' then
|
||||
SL.Add( Prefix + AName + '.DocumentName := ' + String2PascalStrExpr( DocumentName ) + ';' );
|
||||
end;
|
||||
|
||||
{ TKOLBand }
|
||||
|
||||
function TKOLBand.AdditionalUnits: String;
|
||||
begin
|
||||
Result := inherited AdditionalUnits + ', KOLReport';
|
||||
end;
|
||||
|
||||
constructor TKOLBand.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited;
|
||||
EdgeStyle := esNone;
|
||||
if (AOwner <> nil) and (AOwner is TControl) and
|
||||
(TFakeControl(AOwner).Color = clWhite) then
|
||||
else
|
||||
begin
|
||||
ParentColor := FALSE;
|
||||
Color := clWhite;
|
||||
end;
|
||||
if (AOwner <> nil) and (AOwner is TControl) and
|
||||
(TFakeControl(AOwner).Font.Color = clBlack) and
|
||||
(TFakeControl(AOwner).Font.Name = 'Arial') then
|
||||
else
|
||||
begin
|
||||
ParentFont := FALSE;
|
||||
Font.Color := clBlack;
|
||||
Font.FontName := 'Arial';
|
||||
end;
|
||||
Width := 400;
|
||||
Height := 40;
|
||||
Border := 1;
|
||||
end;
|
||||
|
||||
function TKOLBand.NoDrawFrame: Boolean;
|
||||
begin
|
||||
Result := TRUE;
|
||||
end;
|
||||
|
||||
procedure TKOLBand.Paint;
|
||||
var W, H, B: Integer;
|
||||
begin
|
||||
inherited;
|
||||
Canvas.Brush.Color := Font.Color;
|
||||
W := ClientWidth;
|
||||
H := ClientHeight;
|
||||
B := Border;
|
||||
if frLeft in Frames then
|
||||
Canvas.FillRect( Rect( 0, 0, B, H ) );
|
||||
if frTop in Frames then
|
||||
Canvas.FillRect( Rect( 0, 0, W, B ) );
|
||||
if frRight in Frames then
|
||||
Canvas.FillRect( Rect( W - B, 0, W, H ) );
|
||||
if frBottom in Frames then
|
||||
Canvas.FillRect( Rect( 0, H - B, W, H ) );
|
||||
end;
|
||||
|
||||
procedure TKOLBand.SetFrames(const Value: TFrames);
|
||||
begin
|
||||
FFrames := Value;
|
||||
Change;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
function TKOLBand.SetupParams(const AName, AParent: String): String;
|
||||
begin
|
||||
Result := AParent + ', ' + CalcFrames( Frames );
|
||||
end;
|
||||
|
||||
procedure TKOLBand.Set_VA(const Value: TVerticalAlign);
|
||||
begin
|
||||
fVerticalAlign := Value;
|
||||
Change;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
{ TKOLReportLabel }
|
||||
|
||||
function TKOLReportLabel.AdditionalUnits: String;
|
||||
begin
|
||||
Result := inherited AdditionalUnits + ', KOLReport';
|
||||
end;
|
||||
|
||||
function TKOLReportLabel.AdjustVerticalAlign(
|
||||
Value: TVerticalAlign): TVerticalAlign;
|
||||
begin
|
||||
Result := Value;
|
||||
end;
|
||||
|
||||
function TKOLReportLabel.BorderNeeded: Boolean;
|
||||
begin
|
||||
Result := TRUE;
|
||||
end;
|
||||
|
||||
constructor TKOLReportLabel.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited;
|
||||
if (AOwner <> nil) and (AOwner is TControl) and
|
||||
(TFakeControl(AOwner).Color = clWhite) then
|
||||
else
|
||||
begin
|
||||
ParentColor := FALSE;
|
||||
Color := clWhite;
|
||||
end;
|
||||
if (AOwner <> nil) and (AOwner is TControl) and
|
||||
(TFakeControl(AOwner).Font.Color = clBlack) and
|
||||
(TFakeControl(AOwner).Font.Name = 'Arial') then
|
||||
else
|
||||
begin
|
||||
ParentFont := FALSE;
|
||||
Font.Color := clBlack;
|
||||
Font.FontName := 'Arial';
|
||||
end;
|
||||
Border := 1;
|
||||
DefaultAutoSize := TRUE;
|
||||
AutoSize := TRUE;
|
||||
end;
|
||||
|
||||
function TKOLReportLabel.NoDrawFrame: Boolean;
|
||||
begin
|
||||
Result := TRUE;
|
||||
end;
|
||||
|
||||
procedure TKOLReportLabel.Paint;
|
||||
var W, H, B: Integer;
|
||||
begin
|
||||
inherited;
|
||||
Canvas.Brush.Color := Font.Color;
|
||||
W := ClientWidth;
|
||||
H := ClientHeight;
|
||||
B := Border;
|
||||
if frLeft in Frames then
|
||||
Canvas.FillRect( Rect( 0, 0, B, H ) );
|
||||
if frTop in Frames then
|
||||
Canvas.FillRect( Rect( 0, 0, W, B ) );
|
||||
if frRight in Frames then
|
||||
Canvas.FillRect( Rect( W - B, 0, W, H ) );
|
||||
if frBottom in Frames then
|
||||
Canvas.FillRect( Rect( 0, H - B, W, H ) );
|
||||
end;
|
||||
|
||||
procedure TKOLReportLabel.SetFrames(const Value: TFrames);
|
||||
begin
|
||||
FFrames := Value;
|
||||
Change;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
function TKOLReportLabel.SetupParams(const AName, AParent: String): String;
|
||||
begin
|
||||
Result := inherited SetupParams( AName, AParent ) + ', ' + CalcFrames( Frames );
|
||||
end;
|
||||
|
||||
function TKOLReportLabel.TypeName: String;
|
||||
begin
|
||||
if WordWrap then
|
||||
Result := 'WordWrapReportLabel'
|
||||
else
|
||||
Result := 'ReportLabel';
|
||||
end;
|
||||
|
||||
end.
|
||||
216
Addons/mckHTTPDownload.pas
Normal file
216
Addons/mckHTTPDownload.pas
Normal file
@ -0,0 +1,216 @@
|
||||
{$IFDEF FPC}
|
||||
{$mode delphi}
|
||||
{$ENDIF}
|
||||
unit mckHTTPDownload;
|
||||
{
|
||||
|
||||
("`-''-/").___..--''"`-._
|
||||
`6_ 6 ) `-. ( ).`-.__.`)
|
||||
(_Y_.)' ._ ) `._ `. ``-..-'
|
||||
_..`--'_..-_/ /--'_.' ,'
|
||||
(il).-'' (li).' ((!.-'
|
||||
|
||||
Download with HTTP-protocol (MCK Classes)
|
||||
|
||||
Copyright � 2007-2008 Denis Fateyev (Danger)
|
||||
Website: <http://fateyev.com>
|
||||
E-Mail: <denis@fateyev.com>
|
||||
|
||||
}
|
||||
interface
|
||||
|
||||
// ----------------------------------------------------------
|
||||
uses
|
||||
Windows, Classes, Messages, Forms, SysUtils, mirror,
|
||||
KOL, KOLHTTPDownload {$IFDEF FPC}, LResources {$ENDIF};
|
||||
|
||||
// ----------------------------------------------------------
|
||||
type
|
||||
PKOLHttpDownload =^TKOLHttpDownload;
|
||||
TKOLHttpDownload = class( TKOLObj )
|
||||
|
||||
private
|
||||
fUserName: string;
|
||||
fUserPass: string;
|
||||
fProxyAddr: string;
|
||||
fProxyPort: Integer;
|
||||
fPreconfProxy: Boolean;
|
||||
|
||||
fOnError: THTTPErrorEvent;
|
||||
fOnDownload: THTTPDownloadEvent;
|
||||
fOnProgress: THTTPProgressEvent;
|
||||
fOnHeaderReceived: THTTPHdrRecvEvent;
|
||||
|
||||
public
|
||||
constructor Create( Owner: TComponent ); override;
|
||||
|
||||
protected
|
||||
function AdditionalUnits: string; override;
|
||||
procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: string ); override;
|
||||
procedure SetupLast( SL: TStringList; const AName, AParent, Prefix: string ); override;
|
||||
procedure AssignEvents( SL: TStringList; const AName: string ); override;
|
||||
|
||||
procedure SetUserName( Value: string );
|
||||
procedure SetUserPass( Value: string );
|
||||
procedure SetProxyAddr( Value: string );
|
||||
procedure SetProxyPort( Value: Integer );
|
||||
procedure SetPreconfProxy( Value: Boolean );
|
||||
|
||||
procedure SetOnDownload( Value: THTTPDownloadEvent );
|
||||
procedure SetOnError( Value: THTTPErrorEvent );
|
||||
procedure SetOnProgress( Value: THTTPProgressEvent );
|
||||
procedure SetOnHeaderReceived( Value: THTTPHdrRecvEvent );
|
||||
|
||||
published
|
||||
property authUserName : string read fUserName write SetUserName;
|
||||
property authPassword : string read fUserPass write SetUserPass;
|
||||
|
||||
property ProxyServer : string read fProxyAddr write SetProxyAddr;
|
||||
property ProxyPort : Integer read fProxyPort write SetProxyPort;
|
||||
property PreconfigProxy: Boolean read fPreconfProxy write SetPreconfProxy;
|
||||
|
||||
property OnDownload : THTTPDownloadEvent read fOnDownload write SetOnDownload;
|
||||
property OnProgress : THTTPProgressEvent read fOnProgress write SetOnProgress;
|
||||
property OnHeaderReceived : THTTPHdrRecvEvent read fOnHeaderReceived write SetOnHeaderReceived;
|
||||
property OnError : THTTPErrorEvent read fOnError write SetOnError;
|
||||
|
||||
end;
|
||||
|
||||
// ----------------------------------------------------------
|
||||
procedure Register;
|
||||
|
||||
implementation
|
||||
|
||||
// ----------------------------------------------------------
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterComponents('KOLAddons', [TKOLHttpDownload]);
|
||||
end;
|
||||
|
||||
// ----------------------------------------------------------
|
||||
{ TKOLHttpDownload }
|
||||
|
||||
constructor TKOLHttpDownload.Create;
|
||||
begin
|
||||
inherited Create( Owner );
|
||||
fPreconfProxy:= false;
|
||||
end;
|
||||
|
||||
// ----------------------------------------------------------
|
||||
procedure TKOLHttpDownload.SetUserName;
|
||||
begin
|
||||
fUserName:= Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
// ----------------------------------------------------------
|
||||
procedure TKOLHttpDownload.SetUserPass;
|
||||
begin
|
||||
fUserPass:= Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
// ----------------------------------------------------------
|
||||
procedure TKOLHttpDownload.SetProxyAddr;
|
||||
begin
|
||||
fProxyAddr:= Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
// ----------------------------------------------------------
|
||||
procedure TKOLHttpDownload.SetProxyPort;
|
||||
begin
|
||||
if fProxyAddr = '' then fProxyPort:= 0
|
||||
else fProxyPort := Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
// ----------------------------------------------------------
|
||||
procedure TKOLHttpDownload.SetPreconfProxy;
|
||||
begin
|
||||
fPreconfProxy:= Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
// ----------------------------------------------------------
|
||||
procedure TKOLHttpDownload.SetOnDownload;
|
||||
begin
|
||||
fOnDownload:= Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
// ----------------------------------------------------------
|
||||
procedure TKOLHttpDownload.SetOnError;
|
||||
begin
|
||||
fOnError:= Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
// ----------------------------------------------------------
|
||||
procedure TKOLHttpDownload.SetOnProgress;
|
||||
begin
|
||||
fOnProgress:= Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
// ----------------------------------------------------------
|
||||
procedure TKOLHttpDownload.SetOnHeaderReceived;
|
||||
begin
|
||||
fOnHeaderReceived := Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
// ----------------------------------------------------------
|
||||
function TKOLHttpDownload.AdditionalUnits;
|
||||
begin
|
||||
Result := ', KOLHTTPDownload';
|
||||
end;
|
||||
|
||||
// ----------------------------------------------------------
|
||||
procedure TKOLHttpDownload.SetupFirst(SL: TStringList; const AName,
|
||||
AParent, Prefix: String);
|
||||
begin
|
||||
SL.Add( Prefix + AName + ' := NewHTTPDownload;' );
|
||||
if ( fPreconfProxy ) then
|
||||
SL.Add( Prefix + AName + '.UsePreconfigProxy:= true; ')
|
||||
else
|
||||
begin
|
||||
if ( fProxyAddr <> '' ) then
|
||||
begin
|
||||
SL.Add( Prefix + AName + '.ProxyServer := ''' + fProxyAddr + ''';');
|
||||
if ( fProxyPort <> 0 ) then
|
||||
SL.Add( Prefix + AName + '.ProxyPort := ' + IntToStr( fProxyPort ) + ';');
|
||||
end;
|
||||
end;
|
||||
|
||||
if ( fUserName <> '' ) or ( fUserPass <> '' ) then
|
||||
SL.Add( Prefix + AName + '.SetAuthInfo( ''' + fUserName + ''', ''' + fUserPass +''' );');
|
||||
end;
|
||||
|
||||
// ----------------------------------------------------------
|
||||
procedure TKOLHttpDownload.SetupLast(SL: TStringList; const AName,
|
||||
AParent, Prefix: String);
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
// ----------------------------------------------------------
|
||||
procedure TKOLHttpDownload.AssignEvents(SL: TStringList; const AName: String);
|
||||
begin
|
||||
inherited;
|
||||
DoAssignEvents( SL, AName, [ 'OnDownload' ], [ @OnDownload ]);
|
||||
DoAssignEvents( SL, AName, [ 'OnProgress' ], [ @OnProgress ]);
|
||||
DoAssignEvents( SL, AName, [ 'OnHeaderReceived' ], [ @OnHeaderReceived ]);
|
||||
DoAssignEvents( SL, AName, [ 'OnError' ], [ @OnError ]);
|
||||
end;
|
||||
|
||||
// ----------------------------------------------------------
|
||||
{$IFDEF FPC}
|
||||
initialization
|
||||
{$I mckHTTPDownload.lrs}
|
||||
{$ENDIF}
|
||||
|
||||
// ----------------------------------------------------------
|
||||
|
||||
end.
|
||||
|
||||
BIN
Addons/mckKOLTable.dcr
Normal file
BIN
Addons/mckKOLTable.dcr
Normal file
Binary file not shown.
526
Addons/mckKOLTable.pas
Normal file
526
Addons/mckKOLTable.pas
Normal file
@ -0,0 +1,526 @@
|
||||
unit mckKOLTable;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Windows, Classes, Messages, Forms, SysUtils,
|
||||
mirror, mckCtrls, Graphics, KOLEdb, ADOdb,
|
||||
ADOConEd, mckListEdit, DB, KOL,
|
||||
ExptIntf, ToolIntf, EditIntf, // DsgnIntf
|
||||
//////////////////////////////////////////////////
|
||||
{$IFDEF VER140} //
|
||||
DesignIntf, DesignEditors, DesignConst, //
|
||||
Variants //
|
||||
{$ELSE} //
|
||||
DsgnIntf //
|
||||
{$ENDIF} //
|
||||
//////////////////////////////////////////////////
|
||||
{$IFNDEF VER90}{$IFNDEF VER100}, ToolsAPI{$ENDIF}{$ENDIF},
|
||||
TypInfo, Consts;
|
||||
|
||||
type
|
||||
|
||||
PKOLDataSource =^TKOLDataSource;
|
||||
TKOLDataSource = class(TKOLObj)
|
||||
private
|
||||
fConnection: WideString;
|
||||
AQ: TADOQuery;
|
||||
protected
|
||||
function AdditionalUnits: string; override;
|
||||
function TypeName: string; override;
|
||||
function CompareFirst( c, n: string): boolean; override;
|
||||
procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;
|
||||
function GetConnection: WideString;
|
||||
procedure SetConnection(Value: WideString);
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
published
|
||||
property Connection: WideString read GetConnection write SetConnection;
|
||||
end;
|
||||
|
||||
TKOLSession = class(TKOLObj)
|
||||
private
|
||||
fDataSource: TKOLDataSource;
|
||||
protected
|
||||
function AdditionalUnits: string; override;
|
||||
function TypeName: string; override;
|
||||
function CompareFirst( c, n: string): boolean; override;
|
||||
procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;
|
||||
procedure SetDataSource(DS: TKOLDataSource);
|
||||
published
|
||||
property DataSource: TKOLDataSource read fDataSource write SetDataSource;
|
||||
end;
|
||||
|
||||
TKOLQuery = class(TKOLObj)
|
||||
private
|
||||
fSession: TKOLSession;
|
||||
fTableName: WideString;
|
||||
fText: string;
|
||||
protected
|
||||
function AdditionalUnits: string; override;
|
||||
function TypeName: string; override;
|
||||
function CompareFirst( c, n: string): boolean; override;
|
||||
procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;
|
||||
procedure SetSession(SS: TKOLSession);
|
||||
procedure SetText (Tt: string);
|
||||
function GetTableName: WideString;
|
||||
procedure SetTableName(Value: WideString);
|
||||
published
|
||||
property Session: TKOLSession read fSession write SetSession;
|
||||
property SQL: string read fText write SetText;
|
||||
property TableName: WideString read GetTableName write SetTableName;
|
||||
end;
|
||||
|
||||
TTableStringProperty = class(TStringProperty)
|
||||
public
|
||||
function GetAttributes: TPropertyAttributes; override;
|
||||
procedure Edit; override;
|
||||
end;
|
||||
|
||||
TTableNameProperty = class(TStringProperty)
|
||||
private
|
||||
FConnection: TADOConnection;
|
||||
public
|
||||
function AutoFill: Boolean; override;
|
||||
function GetAttributes: TPropertyAttributes; override;
|
||||
function GetConnection(Opened: Boolean): TADOConnection;
|
||||
procedure GetValueList(List: TStrings);
|
||||
procedure GetValues(Proc: TGetStrProc); override;
|
||||
end;
|
||||
|
||||
TKOLListData = class(TKOLListEdit)
|
||||
private
|
||||
fAutoOpen: boolean;
|
||||
fOnRowChanged: TOnEvent;
|
||||
fQuery: TKOLQuery;
|
||||
fColCount: integer;
|
||||
protected
|
||||
function AdditionalUnits: string; override;
|
||||
procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;
|
||||
procedure SetupLast( SL: TStringList; const AName, AParent, Prefix: String ); override;
|
||||
procedure AssignEvents( SL: TStringList; const AName: String ); override;
|
||||
procedure SetAutoOpen(Value: boolean);
|
||||
function GetColCount: integer;
|
||||
procedure SetColCount(Value: integer);
|
||||
procedure SetQuery(Value: TKOLQuery);
|
||||
procedure SetOnRowChanged(Value: TOnEvent);
|
||||
procedure DoRequest(Full: boolean);
|
||||
procedure Loaded; override;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
procedure UpdateColumns; override;
|
||||
published
|
||||
property AutoOpen: boolean read fAutoOpen write SetAutoOpen;
|
||||
property ColCount read GetColCount write SetColCount;
|
||||
property Query: TKOLQuery read fQuery write SetQuery;
|
||||
property OnRowChanged: TOnEvent read fOnRowChanged write SetOnRowChanged;
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
|
||||
implementation
|
||||
|
||||
uses Ustr;
|
||||
|
||||
{$R *.dcr}
|
||||
|
||||
function TTableStringProperty.GetAttributes: TPropertyAttributes;
|
||||
begin
|
||||
Result := [paDialog];
|
||||
end;
|
||||
|
||||
procedure TTableStringProperty.Edit;
|
||||
begin
|
||||
if EditConnectionString((GetComponent(0) as TKOLDataSource).AQ) then begin
|
||||
Modified;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TKOLDataSource.Create;
|
||||
begin
|
||||
inherited;
|
||||
AQ := TADOQuery.Create(self);
|
||||
end;
|
||||
|
||||
function TKOLDataSource.AdditionalUnits;
|
||||
begin
|
||||
Result := ', OLETable, KOLEdb';
|
||||
end;
|
||||
|
||||
function TKOLDataSource.TypeName;
|
||||
begin
|
||||
Result := 'TKOLDataSource';
|
||||
end;
|
||||
|
||||
function TKOLDataSource.CompareFirst;
|
||||
begin
|
||||
Result := False;
|
||||
if c = '' then Result := True;
|
||||
end;
|
||||
|
||||
procedure TKOLDataSource.SetupFirst;
|
||||
var s: string;
|
||||
c: string;
|
||||
t: string;
|
||||
begin
|
||||
SL.Add( Prefix + AName + ' := NewDataSource(');
|
||||
c := '''' + fConnection + ''');';
|
||||
repeat
|
||||
t := Prefix + copy(c, 1, 77 - length(Prefix));
|
||||
delete(c, 1, 77 - length(Prefix));
|
||||
if c <> '' then begin
|
||||
t := t + ''' +';
|
||||
c := '''' + c;
|
||||
end;
|
||||
SL.Add(t);
|
||||
until length(c) = 0;
|
||||
end;
|
||||
|
||||
function TKOLDataSource.GetConnection;
|
||||
begin
|
||||
fConnection := AQ.ConnectionString;
|
||||
Result := fConnection;
|
||||
end;
|
||||
|
||||
procedure TKOLDataSource.SetConnection;
|
||||
begin
|
||||
fConnection := Value;
|
||||
AQ.ConnectionString := Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
function TKOLSession.AdditionalUnits;
|
||||
begin
|
||||
Result := ', OLETable, KOLEdb';
|
||||
end;
|
||||
|
||||
function TKOLSession.TypeName;
|
||||
begin
|
||||
Result := 'TKOLSession';
|
||||
end;
|
||||
|
||||
function TKOLSession.CompareFirst;
|
||||
begin
|
||||
Result := False;
|
||||
if c = '' then Result := True;
|
||||
if c = 'TKOLDataSource' then Result := True;
|
||||
end;
|
||||
|
||||
procedure TKOLSession.SetupFirst;
|
||||
begin
|
||||
SL.Add( Prefix + AName + ' := NewSession( Result.' + fDataSource.Name + ' );' );
|
||||
end;
|
||||
|
||||
procedure TKOLSession.SetDataSource;
|
||||
begin
|
||||
fDataSource := DS;
|
||||
Change;
|
||||
end;
|
||||
|
||||
function TKOLQuery.AdditionalUnits;
|
||||
begin
|
||||
Result := ', OLETable, KOLEdb';
|
||||
end;
|
||||
|
||||
function TKOLQuery.TypeName;
|
||||
begin
|
||||
Result := 'TKOLQuery';
|
||||
end;
|
||||
|
||||
function TKOLQuery.CompareFirst;
|
||||
begin
|
||||
Result := False;
|
||||
if c = '' then Result := True;
|
||||
if c = 'TKOLDataSource' then Result := True;
|
||||
if c = 'TKOLSession' then Result := True;
|
||||
end;
|
||||
|
||||
procedure TKOLQuery.SetupFirst;
|
||||
begin
|
||||
SL.Add( Prefix + AName + ' := NewQuery( Result.' + fSession.Name + ' );' );
|
||||
if fText <> '' then begin
|
||||
SL.Add( Prefix + AName + '.Text := ''' + fText + ''';');
|
||||
end else
|
||||
if fTableName <> '' then begin
|
||||
SL.Add( Prefix + AName + '.Text := ''Select * from ' + fTableName + ''';');
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TKOLQuery.SetSession;
|
||||
begin
|
||||
fSession := SS;
|
||||
Change;
|
||||
end;
|
||||
|
||||
procedure TKOLQuery.SetText;
|
||||
begin
|
||||
fText := Tt;
|
||||
Change;
|
||||
end;
|
||||
|
||||
function TTableNameProperty.GetAttributes: TPropertyAttributes;
|
||||
begin
|
||||
Result := [paValueList, paSortList, paMultiSelect];
|
||||
end;
|
||||
|
||||
function TTableNameProperty.GetConnection(Opened: Boolean): TADOConnection;
|
||||
var
|
||||
Component: TComponent;
|
||||
Connection: string;
|
||||
begin
|
||||
Result := FConnection;
|
||||
Component := (GetComponent(0) as TKOLQuery).Session.DataSource;
|
||||
Connection := TypInfo.GetStrProp(Component,
|
||||
TypInfo.GetPropInfo(Component.ClassInfo, 'Connection'));
|
||||
if Connection = '' then Exit;
|
||||
FConnection := TADOConnection.Create(nil);
|
||||
FConnection.ConnectionString := Connection;
|
||||
FConnection.LoginPrompt := False;
|
||||
Result := FConnection;
|
||||
Result.Open;
|
||||
end;
|
||||
|
||||
procedure TTableNameProperty.GetValueList(List: TStrings);
|
||||
var
|
||||
Connection: TADOConnection;
|
||||
begin
|
||||
Connection := GetConnection(True);
|
||||
if Assigned(Connection) then
|
||||
try
|
||||
Connection.GetTableNames(List);
|
||||
finally
|
||||
FConnection.Free;
|
||||
FConnection := nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTableNameProperty.GetValues;
|
||||
var l: TStringList;
|
||||
i: integer;
|
||||
begin
|
||||
l := TStringList.Create;
|
||||
GetValueList(l);
|
||||
for i := 0 to l.Count - 1 do
|
||||
Proc(l[i]);
|
||||
l.Free;
|
||||
end;
|
||||
|
||||
function TTableNameProperty.AutoFill: Boolean;
|
||||
var
|
||||
Connection: TADOConnection;
|
||||
begin
|
||||
Connection := GetConnection(False);
|
||||
Result := Assigned(Connection) and Connection.Connected;
|
||||
end;
|
||||
|
||||
constructor TKOLListData.Create;
|
||||
begin
|
||||
inherited;
|
||||
IsListData := True;
|
||||
end;
|
||||
|
||||
destructor TKOLListData.Destroy;
|
||||
begin
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TKOLListData.AdditionalUnits;
|
||||
begin
|
||||
Result := ', OLETable, KOLEdb';
|
||||
end;
|
||||
|
||||
procedure TKOLListData.SetupFirst;
|
||||
begin
|
||||
inherited;
|
||||
DoRequest(True);
|
||||
if fQuery <> nil then begin
|
||||
if not fQuery.fSession.fDataSource.AQ.Active then fAutoOpen := False;
|
||||
SL.Add( Prefix + AName + '.Query := Result.' + fQuery.Name + ';');
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TKOLListData.SetupLast;
|
||||
begin
|
||||
inherited;
|
||||
if fQuery <> nil then begin
|
||||
if fAutoOpen then
|
||||
SL.Add( Prefix + AName + '.Open;' );
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TKOLListData.AssignEvents;
|
||||
begin
|
||||
inherited;
|
||||
DoAssignEvents( SL, AName,
|
||||
[ 'OnRowChanged'],
|
||||
[ @OnRowChanged ]);
|
||||
end;
|
||||
|
||||
procedure TKOLListData.SetAutoOpen;
|
||||
begin
|
||||
fAutoOpen := Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
function TKOLListData.GetColCount;
|
||||
begin
|
||||
Result := fColCount;
|
||||
end;
|
||||
|
||||
procedure TKOLListData.SetColCount;
|
||||
var i: integer;
|
||||
n: integer;
|
||||
a: TADOQuery;
|
||||
t: TListEditColumnsItem;
|
||||
e: boolean;
|
||||
begin
|
||||
if Value > 0 then begin
|
||||
fColCount := Value;
|
||||
end;
|
||||
while Columns.Count > fColCount do begin
|
||||
Columns.Delete(Columns.Count - 1);
|
||||
end;
|
||||
DoRequest(True);
|
||||
a := nil;
|
||||
if fQuery <> nil then begin
|
||||
if fQuery.fSession <> nil then begin
|
||||
if fQuery.fSession.fDataSource <> nil then begin
|
||||
a := fQuery.fSession.fDataSource.AQ;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
if a <> nil then begin
|
||||
for i := 0 to a.FieldCount - 1 do begin
|
||||
e := True;
|
||||
for n := 0 to Columns.Count - 1 do begin
|
||||
t := Columns.Items[n];
|
||||
if t.FieldName = a.Fields[i].FieldName then begin
|
||||
e := False;
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
if e and (Columns.Count < fColCount) then begin
|
||||
t := TListEditColumnsItem(Columns.Add);
|
||||
t.Caption := a.Fields[i].FieldName;
|
||||
t.FieldName := a.Fields[i].FieldName;
|
||||
case a.Fields[i].DataType of
|
||||
ftString,
|
||||
ftWideString: t.Alignment := taLeftJustify;
|
||||
else
|
||||
t.Alignment := taRightJustify;
|
||||
end;
|
||||
t.Width := Canvas.TextWidth(Replicate('Q', a.Fields[i].DisplayWidth));
|
||||
end;
|
||||
end;
|
||||
UpDateColumns;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TKOLListData.SetOnRowChanged;
|
||||
begin
|
||||
fOnRowChanged := Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
procedure TKOLListData.DoRequest;
|
||||
begin
|
||||
if fQuery <> nil then begin
|
||||
if fQuery.fText <> '' then begin
|
||||
fQuery.fSession.fDataSource.AQ.SQL.Clear;
|
||||
{ fQuery.fSession.fDataSource.AQ.SQL.Add(fQuery.fText);}
|
||||
fQuery.fSession.fDataSource.AQ.SQL.Add('Select * from ' + fQuery.fTableName);
|
||||
try
|
||||
fQuery.fSession.fDataSource.AQ.Open;
|
||||
except
|
||||
on E: Exception do MsgOK(E.Message);
|
||||
end;
|
||||
end else
|
||||
if fQuery.fTableName <> '' then begin
|
||||
fQuery.fSession.fDataSource.AQ.SQL.Clear;
|
||||
fQuery.fSession.fDataSource.AQ.SQL.Add('Select * from ' + fQuery.fTableName);
|
||||
try
|
||||
fQuery.fSession.fDataSource.AQ.Open;
|
||||
except
|
||||
on E: Exception do MsgOK(E.Message);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TKOLListData.Loaded;
|
||||
var i: integer;
|
||||
n: integer;
|
||||
a: TADOQuery;
|
||||
t: TListEditColumnsItem;
|
||||
e: boolean;
|
||||
begin
|
||||
inherited;
|
||||
DoRequest(True);
|
||||
a := nil;
|
||||
if fQuery <> nil then begin
|
||||
if fQuery.fSession <> nil then begin
|
||||
if fQuery.fSession.fDataSource <> nil then begin
|
||||
a := fQuery.fSession.fDataSource.AQ;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
if a <> nil then begin
|
||||
Columns.FieldNames.Clear;
|
||||
for i := 0 to a.FieldCount - 1 do begin
|
||||
Columns.FieldNames.Add(a.Fields[i].FieldName);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TKOLListData.UpdateColumns;
|
||||
var s: string;
|
||||
i: integer;
|
||||
f: string;
|
||||
begin
|
||||
s := '';
|
||||
for i := 0 to Columns.Count - 1 do begin
|
||||
if Columns.Items[i].FieldName <> '' then begin
|
||||
s := s + '[' + Columns.Items[i].FieldName + ']' + ',';
|
||||
end;
|
||||
end;
|
||||
s := copy(s, 1, length(s) - 1);
|
||||
if fQuery = nil then begin
|
||||
MsgOK('Query is not defined !');
|
||||
exit;
|
||||
end;
|
||||
i := pos('FROM', UpSt(fQuery.fText));
|
||||
if i > 0 then f := copy(fQuery.fText, i + 5, length(fQuery.fText) - i - 4)
|
||||
else f := fQuery.TableName;
|
||||
if trim(s) = '' then s := '*';
|
||||
if trim(f) = '' then f := fQuery.TableName;
|
||||
fQuery.fText := 'Select ' + s + ' from ' + f;
|
||||
Change;
|
||||
end;
|
||||
|
||||
function TKOLQuery.GetTableName;
|
||||
begin
|
||||
Result := fTableName;
|
||||
end;
|
||||
|
||||
procedure TKOLQuery.SetTableName;
|
||||
begin
|
||||
fTableName := Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
procedure TKOLListData.SetQuery;
|
||||
begin
|
||||
fQuery := Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterComponents ('KOLData', [TKOLDataSource, TKOLSession, TKOLQuery, TKOLListData]);
|
||||
RegisterPropertyEditor (TypeInfo(WideString), TKOLDataSource, 'Connection', TTableStringProperty);
|
||||
RegisterPropertyEditor (TypeInfo(WideString), TKOLQuery, 'TableName', TTableNameProperty);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
BIN
Addons/mckListEdit.dcr
Normal file
BIN
Addons/mckListEdit.dcr
Normal file
Binary file not shown.
226
Addons/mckListEdit.pas
Normal file
226
Addons/mckListEdit.pas
Normal file
@ -0,0 +1,226 @@
|
||||
unit mckListEdit;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Windows, Classes, Messages, Forms, SysUtils,
|
||||
mckCtrls, Graphics;
|
||||
|
||||
type
|
||||
|
||||
TListEditColumns = class;
|
||||
|
||||
TKOLListEdit = class(TKOLListView)
|
||||
private
|
||||
fColumns: TListEditColumns;
|
||||
fColCount: integer;
|
||||
fListData: boolean;
|
||||
protected
|
||||
function AdditionalUnits: string; override;
|
||||
procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;
|
||||
procedure SetupLast( SL: TStringList; const AName, AParent, Prefix: String ); override;
|
||||
procedure AssignEvents( SL: TStringList; const AName: String ); override;
|
||||
function GetCaption: string;
|
||||
function GetStyle: TKOLListViewStyle;
|
||||
function GetOptions: TKOLListViewOptions;
|
||||
procedure SetOptions(v: TKOLListViewOptions);
|
||||
function GetColumns: TListEditColumns; virtual;
|
||||
procedure SetColumns(v: TListEditColumns);
|
||||
function GetColCount: integer;
|
||||
procedure SetColCount(v: integer);
|
||||
public
|
||||
constructor Create(Owner: TComponent); override;
|
||||
property IsListData: boolean read fListData write fListData;
|
||||
procedure UpdateColumns; virtual;
|
||||
published
|
||||
property Caption: string Read GetCaption;
|
||||
property Style: TKOLListViewStyle Read GetStyle;
|
||||
property Options: TKOLListViewOptions read GetOptions write SetOptions;
|
||||
property Columns: TListEditColumns read fColumns write SetColumns;
|
||||
property ColCount: integer read GetColCount write SetColCount;
|
||||
end;
|
||||
|
||||
TListEditColumnsItem = class(TCollectionItem)
|
||||
private
|
||||
fCaption: string;
|
||||
fAlign: TAlignment;
|
||||
fWidth: integer;
|
||||
fFieldName: string;
|
||||
protected
|
||||
procedure SetAlignment(a: TAlignment);
|
||||
procedure SetCaption(c: string);
|
||||
procedure SetWidth(w: integer);
|
||||
published
|
||||
property Alignment: TAlignment read fAlign write fAlign;
|
||||
property Caption: string read fCaption write fCaption;
|
||||
property Width: integer read fWidth write fWidth;
|
||||
property FieldName: string read fFieldName write fFieldName;
|
||||
end;
|
||||
|
||||
TListEditColumns = class(TCollection)
|
||||
private
|
||||
FOwner: TKOLListEdit;
|
||||
function GetItem(Index: Integer): TListEditColumnsItem;
|
||||
procedure SetItem(Index: Integer; Value: TListEditColumnsItem);
|
||||
protected
|
||||
function GetOwner: TPersistent; override;
|
||||
public
|
||||
FieldNames: TStringList;
|
||||
constructor Create(AOwner: TKOLListEdit);
|
||||
destructor Destroy; override;
|
||||
function Owner: TKOLListEdit;
|
||||
property Items[Index: Integer]: TListEditColumnsItem read GetItem write SetItem; default;
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.dcr}
|
||||
|
||||
constructor TKOLListEdit.Create;
|
||||
begin
|
||||
inherited;
|
||||
inherited Style := lvsDetail;
|
||||
inherited Options := [lvoRowSelect];
|
||||
Font.FontCharset := 204;
|
||||
fColumns := TListEditColumns.Create(self);
|
||||
end;
|
||||
|
||||
procedure TKOLListEdit.UpdateColumns;
|
||||
begin
|
||||
Change;
|
||||
end;
|
||||
|
||||
function TKOLListEdit.AdditionalUnits;
|
||||
begin
|
||||
Result := ', ListEdit';
|
||||
end;
|
||||
|
||||
procedure TKOLListEdit.SetupFirst;
|
||||
var i: integer;
|
||||
s: string;
|
||||
begin
|
||||
inherited;
|
||||
for i := 0 to fColumns.Count - 1 do begin
|
||||
case fColumns.Items[i].Alignment of
|
||||
taLeftJustify: s := 'taLeft';
|
||||
taCenter: s := 'taCenter';
|
||||
taRightJustify: s := 'taRight';
|
||||
end;
|
||||
SL.Add( Prefix + AName + '.LVColAdd(''' + fColumns.Items[i].Caption + ''',' + s + ' , ' + intTostr(fColumns.Items[i].Width) + ');' );
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TKOLListEdit.SetupLast;
|
||||
begin
|
||||
inherited AssignEvents(SL, AName);
|
||||
end;
|
||||
|
||||
procedure TKOLListEdit.AssignEvents;
|
||||
begin
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TKOLListEdit.GetCaption;
|
||||
begin
|
||||
Result := inherited Caption;
|
||||
end;
|
||||
|
||||
function TKOLListEdit.GetStyle;
|
||||
begin
|
||||
Result := lvsDetail;
|
||||
end;
|
||||
|
||||
function TKOLListEdit.GetOptions;
|
||||
begin
|
||||
Result := inherited Options;
|
||||
end;
|
||||
|
||||
procedure TKOLListEdit.SetOptions;
|
||||
begin
|
||||
inherited Options := v + [lvoRowSelect];
|
||||
end;
|
||||
|
||||
function TKOLListEdit.GetColumns;
|
||||
begin
|
||||
Result := fColumns;
|
||||
end;
|
||||
|
||||
procedure TKOLListEdit.SetColumns;
|
||||
begin
|
||||
fColumns.Assign(v);
|
||||
Change;
|
||||
end;
|
||||
|
||||
function TKOLListEdit.GetColCount;
|
||||
begin
|
||||
Result := fColumns.Count;
|
||||
end;
|
||||
|
||||
procedure TKOLListEdit.SetColCount;
|
||||
begin
|
||||
fColCount := v;
|
||||
if fColCount < 0 then fColCount := 0;
|
||||
while fColCount > fColumns.Count do fColumns.Add;
|
||||
while fColCount < fColumns.Count do fColumns[fColumns.Count - 1].Free;
|
||||
Change;
|
||||
end;
|
||||
|
||||
procedure TListEditColumnsItem.SetAlignment;
|
||||
begin
|
||||
fAlign := A;
|
||||
TListEditColumns(GetOwner).FOwner.Change;
|
||||
end;
|
||||
|
||||
procedure TListEditColumnsItem.SetCaption;
|
||||
begin
|
||||
fCaption := C;
|
||||
end;
|
||||
|
||||
procedure TListEditColumnsItem.SetWidth;
|
||||
begin
|
||||
fWidth := W;
|
||||
end;
|
||||
|
||||
constructor TListEditColumns.Create;
|
||||
begin
|
||||
inherited create(TListEditColumnsItem);
|
||||
fOwner := AOwner;
|
||||
FieldNames := TStringList.Create;
|
||||
end;
|
||||
|
||||
destructor TListEditColumns.Destroy;
|
||||
begin
|
||||
FieldNames.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TListEditColumns.GetItem;
|
||||
begin
|
||||
result := TListEditColumnsItem(inherited GetItem(Index));
|
||||
end;
|
||||
|
||||
procedure TListEditColumns.SetItem;
|
||||
begin
|
||||
inherited SetItem(Index, Value);
|
||||
FOwner.Change;
|
||||
end;
|
||||
|
||||
function TListEditColumns.GetOwner;
|
||||
begin
|
||||
result := FOwner;
|
||||
end;
|
||||
|
||||
function TListEditColumns.Owner;
|
||||
begin
|
||||
result := FOwner;
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterComponents('KOLAddons', [TKOLListEdit]);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
BIN
Addons/mckPageSetup.dcr
Normal file
BIN
Addons/mckPageSetup.dcr
Normal file
Binary file not shown.
BIN
Addons/mckPrintDialogs.dcr
Normal file
BIN
Addons/mckPrintDialogs.dcr
Normal file
Binary file not shown.
BIN
Addons/mckQProgBar.dcr
Normal file
BIN
Addons/mckQProgBar.dcr
Normal file
Binary file not shown.
1152
Addons/mckQProgBar.pas
Normal file
1152
Addons/mckQProgBar.pas
Normal file
File diff suppressed because it is too large
Load Diff
BIN
Addons/mckRAS.dcr
Normal file
BIN
Addons/mckRAS.dcr
Normal file
Binary file not shown.
94
Addons/mckRAS.pas
Normal file
94
Addons/mckRAS.pas
Normal file
@ -0,0 +1,94 @@
|
||||
unit mckRAS;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Windows, Classes, Messages, Forms, SysUtils,
|
||||
KOLRAS, mirror;
|
||||
|
||||
type
|
||||
|
||||
TKOLRAS = class(TKOLObj)
|
||||
private
|
||||
|
||||
fRASName: string;
|
||||
FOnConnecting: TOnConnectingEvent;
|
||||
FOnError: TOnErrorEvent;
|
||||
|
||||
protected
|
||||
|
||||
function AdditionalUnits: string; override;
|
||||
procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;
|
||||
procedure SetupLast( SL: TStringList; const AName, AParent, Prefix: String ); override;
|
||||
procedure AssignEvents( SL: TStringList; const AName: String ); override;
|
||||
|
||||
procedure SetRASName(Value: string);
|
||||
procedure SetOnConnecting(Value: TOnConnectingEvent);
|
||||
procedure SetOnError(Value: TOnErrorEvent);
|
||||
|
||||
published
|
||||
|
||||
property RASName: string read FRASName write SetRASName;
|
||||
property OnConnecting: TOnConnectingEvent read FOnConnecting write SetOnConnecting;
|
||||
property OnError: TOnErrorEvent read FOnError write SetOnError;
|
||||
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.dcr}
|
||||
|
||||
procedure TKOLRAS.SetRASName(Value: String);
|
||||
begin
|
||||
fRASName := Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
procedure TKOLRAS.SetOnConnecting;
|
||||
begin
|
||||
fOnConnecting := Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
procedure TKOLRAS.SetOnError;
|
||||
begin
|
||||
fOnError := Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
function TKOLRAS.AdditionalUnits;
|
||||
begin
|
||||
Result := ', KOLRAS';
|
||||
end;
|
||||
|
||||
procedure TKOLRAS.SetupFirst(SL: TStringList; const AName,
|
||||
AParent, Prefix: String);
|
||||
begin
|
||||
SL.Add( Prefix + AName + ' := NewRASObj;' );
|
||||
if fRASName <> '' then
|
||||
SL.Add( Prefix + AName + '.RASName := ''' + fRASName + ''';');
|
||||
end;
|
||||
|
||||
procedure TKOLRAS.SetupLast(SL: TStringList; const AName,
|
||||
AParent, Prefix: String);
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
procedure TKOLRAS.AssignEvents(SL: TStringList; const AName: String);
|
||||
begin
|
||||
inherited;
|
||||
DoAssignEvents( SL, AName,
|
||||
[ 'OnConnecting', 'OnError' ],
|
||||
[ @OnConnecting , @OnError ]);
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterComponents('KOLAddons', [TKOLRAS]);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
BIN
Addons/mckRarInfoBar.dcr
Normal file
BIN
Addons/mckRarInfoBar.dcr
Normal file
Binary file not shown.
372
Addons/mckRarInfoBar.pas
Normal file
372
Addons/mckRarInfoBar.pas
Normal file
@ -0,0 +1,372 @@
|
||||
unit mckRarInfoBar;
|
||||
|
||||
interface
|
||||
|
||||
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
|
||||
ComCtrls, ExtCtrls, Mirror;
|
||||
|
||||
const
|
||||
Boolean2Str: array [Boolean] of string = ('False','True');
|
||||
|
||||
type
|
||||
TRarInfoBar = class(TKOLControl)
|
||||
private
|
||||
{ Private declarations }
|
||||
FPosition: integer;
|
||||
FMin,FMax: integer;
|
||||
FShowPerc: boolean;
|
||||
|
||||
FLineColor,FTopColor,FSideColor1,FSideColor2,FEmptyColor1,FEmptyColor2,
|
||||
FEmptyFrameColor1,FEmptyFrameColor2,FBottomFrameColor,FBottomColor,
|
||||
FFilledFrameColor,FFilledColor,FFilledSideColor1,FFilledSideColor2: TColor;
|
||||
|
||||
TopX,TopY,Size: integer;
|
||||
|
||||
procedure SetPos(P: integer);
|
||||
procedure SetMin(M: integer);
|
||||
procedure SetMax(M: integer);
|
||||
procedure SetShowPerc(V: boolean);
|
||||
|
||||
procedure SetLineColor(C: TColor);
|
||||
procedure SetTopColor(C: TColor);
|
||||
procedure SetSideColor1(C: TColor);
|
||||
procedure SetSideColor2(C: TColor);
|
||||
procedure SetEmptyColor1(C: TColor);
|
||||
procedure SetEmptyColor2(C: TColor);
|
||||
procedure SetEmptyFrameColor1(C: TColor);
|
||||
procedure SetEmptyFrameColor2(C: TColor);
|
||||
procedure SetBottomFrameColor(C: TColor);
|
||||
procedure SetBottomColor(C: TColor);
|
||||
procedure SetFilledFrameColor(C: TColor);
|
||||
procedure SetFilledColor(C: TColor);
|
||||
procedure SetFilledSideColor1(C: TColor);
|
||||
procedure SetFilledSideColor2(C: TColor);
|
||||
protected
|
||||
{ Protected declarations }
|
||||
procedure Paint;
|
||||
procedure WMPaint(var Msg: TMessage); message WM_PAINT;
|
||||
procedure WMSize(var Msg: TMessage); message WM_SIZE;
|
||||
procedure WMActiv(var Msg: TMessage); message WM_SHOWWINDOW;
|
||||
function AdditionalUnits: string; override;
|
||||
procedure SetupFirst(SL: TStringList; const AName,AParent,Prefix: string); override;
|
||||
public
|
||||
{ Public declarations }
|
||||
constructor Create(Owner: TComponent); override;
|
||||
published
|
||||
{ Published declarations }
|
||||
property Position: integer read FPosition write SetPos;
|
||||
property Max: integer read FMax write SetMax;
|
||||
property Min: integer read FMin write SetMin;
|
||||
property ShowPercent: boolean read FShowPerc write SetShowPerc;
|
||||
|
||||
property LineColor: TColor read FLineColor write SetLineColor;
|
||||
property TopColor: TColor read FTopColor write SetTopColor;
|
||||
property SideColor1: TColor read FSideColor1 write SetSideColor1;
|
||||
property SideColor2: TColor read FSideColor2 write SetSideColor2;
|
||||
property EmptyColor1: TColor read FEmptyColor1 write SetEmptyColor1;
|
||||
property EmptyColor2: TColor read FEmptyColor2 write SetEmptyColor2;
|
||||
property EmptyFrameColor1: TColor read FEmptyFrameColor1 write SetEmptyFrameColor1;
|
||||
property EmptyFrameColor2: TColor read FEmptyFrameColor2 write SetEmptyFrameColor2;
|
||||
property BottomFrameColor: TColor read FBottomFrameColor write SetBottomFrameColor;
|
||||
property BottomColor: TColor read FBottomColor write SetBottomColor;
|
||||
property FilledFrameColor: TColor read FFilledFrameColor write SetFilledFrameColor;
|
||||
property FilledColor: TColor read FFilledColor write SetFilledColor;
|
||||
property FilledSideColor1: TColor read FFilledSideColor1 write SetFilledSideColor1;
|
||||
property FilledSideColor2: TColor read FFilledSideColor2 write SetFilledSideColor2;
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
|
||||
implementation
|
||||
|
||||
{$R mckRarInfoBar.dcr}
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterComponents('KOLAddons', [TRarInfoBar]);
|
||||
end;
|
||||
|
||||
constructor TRarInfoBar.Create;
|
||||
begin
|
||||
inherited;
|
||||
Width:=70;
|
||||
Height:=180;
|
||||
FMin:=0;
|
||||
FMax:=100;
|
||||
FPosition:=0;
|
||||
FLineColor:=$FFE0E0;
|
||||
FTopColor:=$FF8080;
|
||||
FSideColor1:=$E06868;
|
||||
FSideColor2:=$FF8080;
|
||||
FEmptyFrameColor1:=$A06868;
|
||||
FEmptyFrameColor2:=$BF8080;
|
||||
FEmptyColor1:=$C06868;
|
||||
FEmptyColor2:=$DF8080;
|
||||
FBottomFrameColor:=$64408C;
|
||||
FBottomColor:=$7A408C;
|
||||
FFilledFrameColor:=$8060A0;
|
||||
FFilledSideColor1:=$823C96;
|
||||
FFilledSideColor2:=$8848C0;
|
||||
FFilledColor:=$A060A0;
|
||||
FShowPerc:=True;
|
||||
Font.FontStyle:=[fsBold];
|
||||
Font.Color:=clPurple;
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.WMPaint;
|
||||
begin
|
||||
inherited;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.WMSize;
|
||||
begin
|
||||
inherited;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.WMActiv;
|
||||
begin
|
||||
inherited;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
function TRarInfoBar.AdditionalUnits;
|
||||
begin
|
||||
Result:=', KOLRarBar';
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.SetupFirst;
|
||||
begin
|
||||
inherited;
|
||||
SL.Add(Prefix+AName+'.Position := '+IntToStr(FPosition)+';');
|
||||
SL.Add(Prefix+AName+'.Min := '+IntToStr(FMin)+';');
|
||||
SL.Add(Prefix+AName+'.Max := '+IntToStr(FMax)+';');
|
||||
SL.Add(Prefix+AName+'.ShowPercent := '+Boolean2Str[FShowPerc]+';');
|
||||
SL.Add(Prefix+AName+'.LineColor := '+Color2Str(FLineColor)+';');
|
||||
SL.Add(Prefix+AName+'.TopColor := '+Color2Str(FTopColor)+';');
|
||||
SL.Add(Prefix+AName+'.SideColor1 := '+Color2Str(FSideColor1)+';');
|
||||
SL.Add(Prefix+AName+'.SideColor2 := '+Color2Str(FSideColor2)+';');
|
||||
SL.Add(Prefix+AName+'.EmptyFrameColor1 := '+Color2Str(FEmptyFrameColor1)+';');
|
||||
SL.Add(Prefix+AName+'.EmptyFrameColor2 := '+Color2Str(FEmptyFrameColor2)+';');
|
||||
SL.Add(Prefix+AName+'.EmptyColor1 := '+Color2Str(FEmptyColor1)+';');
|
||||
SL.Add(Prefix+AName+'.EmptyColor2 := '+Color2Str(FEmptyColor2)+';');
|
||||
SL.Add(Prefix+AName+'.BottomFrameColor := '+Color2Str(FBottomFrameColor)+';');
|
||||
SL.Add(Prefix+AName+'.BottomColor := '+Color2Str(FBottomColor)+';');
|
||||
SL.Add(Prefix+AName+'.FilledFrameColor := '+Color2Str(FFilledFrameColor)+';');
|
||||
SL.Add(Prefix+AName+'.FilledSideColor1 := '+Color2Str(FFilledSideColor1)+';');
|
||||
SL.Add(Prefix+AName+'.FilledSideColor2 := '+Color2Str(FFilledSideColor2)+';');
|
||||
SL.Add(Prefix+AName+'.FilledColor := '+Color2Str(FFilledColor)+';');
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.SetPos;
|
||||
begin
|
||||
if P>FMax then P:=FMax;
|
||||
FPosition:=P;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.SetMin;
|
||||
begin
|
||||
if M>FMax then M:=FMax;
|
||||
FMin:=M;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.SetMax;
|
||||
begin
|
||||
if M<FMin then M:=FMin;
|
||||
FMax:=M;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.SetLineColor;
|
||||
begin
|
||||
FLineColor:=C;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.SetTopColor;
|
||||
begin
|
||||
FTopColor:=C;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.SetSideColor1;
|
||||
begin
|
||||
FSideColor1:=C;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.SetSideColor2;
|
||||
begin
|
||||
FSideColor2:=C;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.SetEmptyColor1;
|
||||
begin
|
||||
FEmptyColor1:=C;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.SetEmptyColor2;
|
||||
begin
|
||||
FEmptyColor2:=C;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.SetEmptyFrameColor1;
|
||||
begin
|
||||
FEmptyFrameColor1:=C;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.SetEmptyFrameColor2;
|
||||
begin
|
||||
FEmptyFrameColor2:=C;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.SetBottomFrameColor;
|
||||
begin
|
||||
FBottomFrameColor:=C;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.SetBottomColor;
|
||||
begin
|
||||
FBottomColor:=C;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.SetFilledFrameColor;
|
||||
begin
|
||||
FFilledFrameColor:=C;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.SetFilledColor;
|
||||
begin
|
||||
FFilledColor:=C;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.SetFilledSideColor1;
|
||||
begin
|
||||
FFilledSideColor1:=C;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.SetFilledSideColor2;
|
||||
begin
|
||||
FFilledSideColor2:=C;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.SetShowPerc;
|
||||
begin
|
||||
FShowPerc:=V;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarInfoBar.Paint;
|
||||
procedure DrawFrame(C: TCanvas);
|
||||
begin
|
||||
C.Pen.Color:=FLineColor;
|
||||
C.Pen.Width:=1;
|
||||
C.Pen.Style:=psSolid;
|
||||
C.Pen.Mode:=pmCopy;
|
||||
C.MoveTo(TopX,TopY+5);
|
||||
C.LineTo(C.PenPos.X+15,C.PenPos.Y-5);
|
||||
C.LineTo(C.PenPos.X+15,C.PenPos.Y+5);
|
||||
C.LineTo(C.PenPos.X-15,C.PenPos.Y+5);
|
||||
C.LineTo(C.PenPos.X-15,C.PenPos.Y-5);
|
||||
C.LineTo(C.PenPos.X,C.PenPos.Y+(Size-10));
|
||||
C.LineTo(C.PenPos.X+15,C.PenPos.Y+5);
|
||||
C.LineTo(C.PenPos.X,C.PenPos.Y-(Size-10));
|
||||
C.MoveTo(C.PenPos.X,C.PenPos.Y+(Size-10));
|
||||
C.LineTo(C.PenPos.X+15,C.PenPos.Y-5);
|
||||
C.LineTo(C.PenPos.X,C.PenPos.Y-(Size-10));
|
||||
end;
|
||||
|
||||
var Points: array[1..4] of TPoint;
|
||||
Prog,Perc: integer;
|
||||
R: real;
|
||||
S: string;
|
||||
begin
|
||||
TopX:=0;
|
||||
TopY:=5;
|
||||
Size:=Height-TopY-5;
|
||||
if (Size=0) or ((FMax-FMin)=0) then
|
||||
begin
|
||||
Perc:=0;
|
||||
Prog:=0;
|
||||
end
|
||||
else
|
||||
begin
|
||||
R:=(FPosition-FMin)/((FMax-FMin)/(Size-10));
|
||||
Prog:=Round(R);
|
||||
Perc:=Round(R/((Size-10)/100));
|
||||
end;
|
||||
if Prog<0 then Prog:=0 else
|
||||
if Prog>Size-10 then Prog:=Size-10;
|
||||
Canvas.Brush.Color:=Color;
|
||||
Canvas.FillRect(Canvas.ClipRect);
|
||||
DrawFrame(Canvas);
|
||||
Canvas.Brush.Color:=FTopColor;
|
||||
Canvas.FloodFill(TopX+7,TopY+5,Canvas.Pixels[TopX+(15 div 2),TopY+5],fsSurface);
|
||||
Canvas.Brush.Color:=FSideColor1;
|
||||
Canvas.FloodFill(TopX+1,TopY+6,Canvas.Pixels[TopX+1,TopY+6],fsSurface);
|
||||
Canvas.Brush.Color:=FSideColor2;
|
||||
Canvas.FloodFill(TopX+29,TopY+6,Canvas.Pixels[TopX+29,TopY+6],fsSurface);
|
||||
if Prog>0 then
|
||||
begin
|
||||
Canvas.MoveTo(TopX,TopY+Size-5);
|
||||
Canvas.Pen.Color:=FBottomFrameColor;
|
||||
Canvas.LineTo(Canvas.PenPos.X+15,Canvas.PenPos.Y-5);
|
||||
Canvas.LineTo(Canvas.PenPos.X+15,Canvas.PenPos.Y+5);
|
||||
Canvas.Brush.Color:=FBottomColor;
|
||||
Canvas.FloodFill(TopX+7,TopY+Size-5,FSideColor1,fsSurface);
|
||||
Canvas.FloodFill(TopX+22,TopY+Size-5,FSideColor2,fsSurface);
|
||||
Canvas.Brush.Color:=FFilledColor;
|
||||
Canvas.Pen.Color:=FFilledFrameColor;
|
||||
Points[1]:=Point(TopX+15,TopY+Size-Prog);
|
||||
Points[2]:=Point(TopX,TopY+Size-Prog-5);
|
||||
Points[3]:=Point(TopX+15,TopY+Size-Prog-10);
|
||||
Points[4]:=Point(TopX+30,TopY+Size-Prog-5);
|
||||
Canvas.Polygon(Points);
|
||||
Canvas.Brush.Color:=FFilledSideColor1;
|
||||
Canvas.FloodFill(TopX+1,TopY+Size-5-(Prog div 2),FSideColor1,fsSurface);
|
||||
Canvas.Brush.Color:=FFilledSideColor2;
|
||||
Canvas.FloodFill(TopX+29,TopY+Size-5-(Prog div 2),FSideColor2,fsSurface);
|
||||
DrawFrame(Canvas);
|
||||
end
|
||||
else
|
||||
begin
|
||||
{EMPTY}
|
||||
Canvas.MoveTo(TopX,TopY+Size-5);
|
||||
Canvas.Pen.Color:=FEmptyFrameColor1;
|
||||
Canvas.LineTo(Canvas.PenPos.X+15,Canvas.PenPos.Y-5);
|
||||
Canvas.Pen.Color:=FEmptyFrameColor2;
|
||||
Canvas.LineTo(Canvas.PenPos.X+15,Canvas.PenPos.Y+5);
|
||||
DrawFrame(Canvas);
|
||||
Canvas.Brush.Color:=FEmptyColor1;
|
||||
Canvas.FloodFill(TopX+7,TopY+Size-5,FSideColor1,fsSurface);
|
||||
Canvas.Brush.Color:=FEmptyColor2;
|
||||
Canvas.FloodFill(TopX+22,TopY+Size-5,FSideColor2,fsSurface);
|
||||
end;
|
||||
if FShowPerc then
|
||||
begin
|
||||
Canvas.Font.Name:=Font.FontName;
|
||||
Canvas.Font.Height:=Font.FontHeight;
|
||||
Canvas.Font.Color:=Font.Color;
|
||||
Canvas.Font.Style:=Font.FontStyle;
|
||||
Canvas.Brush.Color:=Color;
|
||||
S:=IntToStr(Perc)+' %';
|
||||
Canvas.TextOut(TopX+33,TopY+Size-Prog-Canvas.TextHeight(S),S);
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
BIN
Addons/mckRarProgBar.dcr
Normal file
BIN
Addons/mckRarProgBar.dcr
Normal file
Binary file not shown.
368
Addons/mckRarProgBar.pas
Normal file
368
Addons/mckRarProgBar.pas
Normal file
@ -0,0 +1,368 @@
|
||||
//////////////////////////////////////////////////////////////////////
|
||||
// //
|
||||
// TRarProgressBar version 1.0 //
|
||||
// Description: TRarProgressBar is a component which //
|
||||
// displays dual progress bar like a WinRAR //
|
||||
// Author: Dimaxx //
|
||||
// //
|
||||
//////////////////////////////////////////////////////////////////////
|
||||
|
||||
unit mckRarProgBar;
|
||||
|
||||
interface
|
||||
|
||||
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
|
||||
ComCtrls, ExtCtrls, Mirror;
|
||||
|
||||
const
|
||||
Boolean2Str: array [Boolean] of string = ('False','True');
|
||||
|
||||
type
|
||||
TRarProgressBar = class(TKOLControl)
|
||||
private
|
||||
{ Private declarations }
|
||||
FPosition1: integer;
|
||||
FPosition2: integer;
|
||||
FMin,FMax: integer;
|
||||
|
||||
FPercent1,FPercent2: integer;
|
||||
FDouble: boolean;
|
||||
|
||||
FLightColor1,FDarkColor,FLightColor2,FFrameColor1,FFrameColor2,
|
||||
FFillColor1,FFillColor2,FBackFrameColor1,FBackFrameColor2,
|
||||
FBackFillColor,FShadowColor: TColor;
|
||||
|
||||
TopX,TopY,SizeX,SizeY: integer;
|
||||
|
||||
procedure SetPos1(P: integer);
|
||||
procedure SetPos2(P: integer);
|
||||
procedure SetMin(M: integer);
|
||||
procedure SetMax(M: integer);
|
||||
procedure SetDouble(D: boolean);
|
||||
|
||||
procedure SetLightColor1(C: TColor);
|
||||
procedure SetLightColor2(C: TColor);
|
||||
procedure SetDarkColor(C: TColor);
|
||||
procedure SetFrameColor1(C: TColor);
|
||||
procedure SetFrameColor2(C: TColor);
|
||||
procedure SetFillColor1(C: TColor);
|
||||
procedure SetFillColor2(C: TColor);
|
||||
procedure SetBackFrameColor1(C: TColor);
|
||||
procedure SetBackFrameColor2(C: TColor);
|
||||
procedure SetBackFillColor(C: TColor);
|
||||
procedure SetShadowColor(C: TColor);
|
||||
protected
|
||||
{ Protected declarations }
|
||||
procedure Paint;
|
||||
procedure WMPaint(var Msg: TMessage); message WM_PAINT;
|
||||
procedure WMSize(var Msg: TMessage); message WM_SIZE;
|
||||
procedure WMActiv(var Msg: TMessage); message WM_SHOWWINDOW;
|
||||
procedure SetupFirst(SL: TStringList; const AName,AParent,Prefix: string); override;
|
||||
function AdditionalUnits: string; override;
|
||||
public
|
||||
{ Public declarations }
|
||||
constructor Create(Owner: TComponent); override;
|
||||
published
|
||||
{ Published declarations }
|
||||
property Position1: integer read FPosition1 write SetPos1;
|
||||
property Position2: integer read FPosition2 write SetPos2;
|
||||
property Percent1: integer read FPercent1;
|
||||
property Percent2: integer read FPercent2;
|
||||
property Max: integer read FMax write SetMax;
|
||||
property Min: integer read FMin write SetMin;
|
||||
property Double: boolean read FDouble write SetDouble;
|
||||
|
||||
property LightColor1: TColor read FLightColor1 write SetLightColor1;
|
||||
property LightColor2: TColor read FLightColor2 write SetLightColor2;
|
||||
property DarkColor: TColor read FDarkColor write SetDarkColor;
|
||||
property FrameColor1: TColor read FFrameColor1 write SetFrameColor1;
|
||||
property FrameColor2: TColor read FFrameColor2 write SetFrameColor2;
|
||||
property FillColor1: TColor read FFillColor1 write SetFillColor1;
|
||||
property FillColor2: TColor read FFillColor2 write SetFillColor2;
|
||||
property BackFrameColor1: TColor read FBackFrameColor1 write SetBackFrameColor1;
|
||||
property BackFrameColor2: TColor read FBackFrameColor2 write SetBackFrameColor2;
|
||||
property BackFillColor: TColor read FBackFillColor write SetBackFillColor;
|
||||
property ShadowColor: TColor read FShadowColor write SetShadowColor;
|
||||
|
||||
procedure Add1(D: integer);
|
||||
procedure Add2(D: integer);
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
|
||||
implementation
|
||||
|
||||
{$R mckRarProgBar.dcr}
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterComponents('KOLAddons', [TRarProgressBar]);
|
||||
end;
|
||||
|
||||
constructor TRarProgressBar.Create;
|
||||
begin
|
||||
inherited;
|
||||
Width:=204;
|
||||
Height:=18;
|
||||
FMin:=0;
|
||||
FMax:=100;
|
||||
FPosition1:=0;
|
||||
FPosition2:=0;
|
||||
FDouble:=False;
|
||||
FPercent1:=0;
|
||||
FPercent2:=0;
|
||||
FLightColor1:=clWhite;
|
||||
FDarkColor:=$606060;
|
||||
FLightColor2:=$C0FFFF;
|
||||
FFrameColor1:=$EEE8E8;
|
||||
FFrameColor2:=$B4D4E4;
|
||||
FFillColor1:=$DCD6D6;
|
||||
FFillColor2:=$A0C0D0;
|
||||
FBackFrameColor1:=$9494B4;
|
||||
FBackFrameColor2:=$80809E;
|
||||
FBackFillColor:=$6E6E94;
|
||||
FShadowColor:=$464040;
|
||||
end;
|
||||
|
||||
procedure TRarProgressBar.WMPaint;
|
||||
begin
|
||||
inherited;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarProgressBar.WMSize;
|
||||
begin
|
||||
inherited;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarProgressBar.WMActiv;
|
||||
begin
|
||||
inherited;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
function TRarProgressBar.AdditionalUnits;
|
||||
begin
|
||||
Result:=', KOLRarProgBar';
|
||||
end;
|
||||
|
||||
procedure TRarProgressBar.SetupFirst;
|
||||
begin
|
||||
inherited;
|
||||
SL.Add(Prefix+AName+'.Position1 := '+IntToStr(FPosition1)+';');
|
||||
SL.Add(Prefix+AName+'.Position2 := '+IntToStr(FPosition2)+';');
|
||||
SL.Add(Prefix+AName+'.Min := '+IntToStr(FMin)+';');
|
||||
SL.Add(Prefix+AName+'.Max := '+IntToStr(FMax)+';');
|
||||
SL.Add(Prefix+AName+'.Double := '+Boolean2Str[FDouble]+';');
|
||||
SL.Add(Prefix+AName+'.LightColor1 := '+Color2Str(FLightColor1)+';');
|
||||
SL.Add(Prefix+AName+'.LightColor2 := '+Color2Str(FLightColor2)+';');
|
||||
SL.Add(Prefix+AName+'.DarkColor := '+Color2Str(FDarkColor)+';');
|
||||
SL.Add(Prefix+AName+'.FrameColor1 := '+Color2Str(FFrameColor1)+';');
|
||||
SL.Add(Prefix+AName+'.FrameColor2 := '+Color2Str(FFrameColor2)+';');
|
||||
SL.Add(Prefix+AName+'.FillColor1 := '+Color2Str(FFillColor1)+';');
|
||||
SL.Add(Prefix+AName+'.FillColor2 := '+Color2Str(FFillColor2)+';');
|
||||
SL.Add(Prefix+AName+'.BackFrameColor1 := '+Color2Str(FBackFrameColor1)+';');
|
||||
SL.Add(Prefix+AName+'.BackFrameColor2 := '+Color2Str(FBackFrameColor2)+';');
|
||||
SL.Add(Prefix+AName+'.BackFillColor := '+Color2Str(FBackFillColor)+';');
|
||||
SL.Add(Prefix+AName+'.ShadowColor := '+Color2Str(FShadowColor)+';');
|
||||
end;
|
||||
|
||||
procedure TRarProgressBar.SetPos1;
|
||||
begin
|
||||
if FDouble then if P<FPosition2 then P:=FPosition2;
|
||||
if P>FMax then P:=FMax;
|
||||
FPosition1:=P;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarProgressBar.SetPos2;
|
||||
begin
|
||||
if FDouble then if P>FPosition1 then P:=FPosition1;
|
||||
FPosition2:=P;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarProgressBar.SetMin;
|
||||
begin
|
||||
if M>FMax then M:=FMax;
|
||||
FMin:=M;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarProgressBar.SetMax;
|
||||
begin
|
||||
if M<FMin then M:=FMin;
|
||||
FMax:=M;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarProgressBar.SetDouble;
|
||||
begin
|
||||
FDouble:=D;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarProgressBar.SetLightColor1;
|
||||
begin
|
||||
FLightColor1:=C;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarProgressBar.SetLightColor2;
|
||||
begin
|
||||
FLightColor2:=C;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarProgressBar.SetDarkColor;
|
||||
begin
|
||||
FDarkColor:=C;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarProgressBar.SetFrameColor1;
|
||||
begin
|
||||
FFrameColor1:=C;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarProgressBar.SetFrameColor2;
|
||||
begin
|
||||
FFrameColor2:=C;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarProgressBar.SetFillColor1;
|
||||
begin
|
||||
FFillColor1:=C;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarProgressBar.SetFillColor2;
|
||||
begin
|
||||
FFillColor2:=C;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarProgressBar.SetBackFrameColor1;
|
||||
begin
|
||||
FBackFrameColor1:=C;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarProgressBar.SetBackFrameColor2;
|
||||
begin
|
||||
FBackFrameColor2:=C;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarProgressBar.SetBackFillColor;
|
||||
begin
|
||||
FBackFillColor:=C;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarProgressBar.SetShadowColor;
|
||||
begin
|
||||
FShadowColor:=C;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarProgressBar.Paint;
|
||||
var R: real;
|
||||
Prog: Integer;
|
||||
begin
|
||||
TopX:=2;
|
||||
TopY:=2;
|
||||
SizeX:=Width-TopX-2;
|
||||
SizeY:=Height-TopY-4;
|
||||
if (SizeX=0) or (SizeY=0) or (FMax-FMin=0) then Exit;
|
||||
|
||||
///////////////////////////////////////////////////////////////////////////////
|
||||
// Drawing base
|
||||
///////////////////////////////////////////////////////////////////////////////
|
||||
|
||||
Canvas.Brush.Style:=bsSolid;
|
||||
Canvas.Brush.Color:=Color;
|
||||
Canvas.FillRect(Bounds(0,0,Width,Height));
|
||||
Canvas.Brush.Color:=FShadowColor;
|
||||
Canvas.FillRect(Bounds(TopX+1,TopY+2,SizeX,SizeY));
|
||||
Canvas.Brush.Color:=FBackFillColor;
|
||||
Canvas.FillRect(Bounds(TopX,TopY,SizeX,SizeY+1));
|
||||
Canvas.Brush.Color:=FDarkColor;
|
||||
Canvas.FrameRect(Bounds(TopX,TopY,SizeX,SizeY+1));
|
||||
Canvas.Brush.Color:=FBackFrameColor1;
|
||||
Canvas.FrameRect(Bounds(TopX,TopY,SizeX,SizeY));
|
||||
Canvas.Brush.Color:=FBackFrameColor2;
|
||||
Canvas.FrameRect(Bounds(TopX+1,TopY+1,SizeX-2,SizeY-2));
|
||||
|
||||
///////////////////////////////////////////////////////////////////////////////
|
||||
// Drawing first bar
|
||||
///////////////////////////////////////////////////////////////////////////////
|
||||
|
||||
R:=(FPosition1-FMin)/((FMax-FMin)/SizeX);
|
||||
Prog:=Round(R);
|
||||
FPercent1:=Byte(Round(R/(SizeX/100)));
|
||||
if Prog<>0 then
|
||||
begin
|
||||
Canvas.Brush.Color:=FLightColor1;
|
||||
Canvas.FillRect(Bounds(TopX,TopY,TopX+Prog-2,TopY+SizeY-2));
|
||||
if Prog>1 then
|
||||
begin
|
||||
Canvas.Brush.Color:=FFillColor1;
|
||||
Canvas.FillRect(Bounds(TopX+1,TopY+1,TopX+Prog-3,TopY+SizeY-3));
|
||||
Canvas.Brush.Color:=FFrameColor1;
|
||||
Canvas.FrameRect(Bounds(TopX+1,TopY+1,TopX+Prog-3,TopY+SizeY-3));
|
||||
end;
|
||||
Canvas.Brush.Color:=FDarkColor;
|
||||
Canvas.FillRect(Bounds(TopX+Prog,TopY,1,TopY+SizeY-1));
|
||||
if Prog<SizeX-1 then
|
||||
begin
|
||||
Canvas.Brush.Color:=FBackFillColor;
|
||||
Canvas.FillRect(Bounds(TopX+Prog+1,TopY,SizeX-Prog-1,SizeY));
|
||||
Canvas.Brush.Color:=FBackFrameColor1;
|
||||
Canvas.FrameRect(Bounds(TopX+Prog+1,TopY,SizeX-Prog-1,SizeY));
|
||||
Canvas.Brush.Color:=FBackFrameColor2;
|
||||
Canvas.FrameRect(Bounds(TopX+Prog+1,TopY+1,SizeX-Prog-2,SizeY-2));
|
||||
end;
|
||||
end;
|
||||
|
||||
///////////////////////////////////////////////////////////////////////////////
|
||||
// Drawing second bar
|
||||
///////////////////////////////////////////////////////////////////////////////
|
||||
|
||||
if FDouble then
|
||||
begin
|
||||
R:=(FPosition2-FMin)/((FMax-FMin)/SizeX);
|
||||
Prog:=Round(R);
|
||||
FPercent2:=Byte(Round(R/(SizeX/100)));
|
||||
if Prog<>0 then
|
||||
begin
|
||||
Canvas.Brush.Color:=FLightColor2;
|
||||
Canvas.FillRect(Bounds(TopX,TopY,TopX+Prog-2,TopY+SizeY-2));
|
||||
if Prog>1 then
|
||||
begin
|
||||
Canvas.Brush.Color:=FFillColor2;
|
||||
Canvas.FillRect(Bounds(TopX+1,TopY+1,TopX+Prog-3,TopY+SizeY-3));
|
||||
Canvas.Brush.Color:=FFrameColor2;
|
||||
Canvas.FrameRect(Bounds(TopX+1,TopY+1,TopX+Prog-3,TopY+SizeY-3));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRarProgressBar.Add1;
|
||||
begin
|
||||
Inc(FPosition1,D);
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TRarProgressBar.Add2;
|
||||
begin
|
||||
Inc(FPosition2,D);
|
||||
Paint;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
BIN
Addons/mckSocket.dcr
Normal file
BIN
Addons/mckSocket.dcr
Normal file
Binary file not shown.
Reference in New Issue
Block a user