commit b0116562cd43513f4f745b97ff0dea08e1e255a8 Author: jdg Date: Sun Sep 12 21:54:38 2021 +0200 First commit 19/07/1998 diff --git a/CDopping.bpi b/CDopping.bpi new file mode 100644 index 0000000..313a04b Binary files /dev/null and b/CDopping.bpi differ diff --git a/CDopping.bpk b/CDopping.bpk new file mode 100644 index 0000000..4595a61 --- /dev/null +++ b/CDopping.bpk @@ -0,0 +1,133 @@ +# --------------------------------------------------------------------------- +VERSION = BCB.03 +# --------------------------------------------------------------------------- +!ifndef BCB +BCB = $(MAKEDIR)\.. +!endif +# --------------------------------------------------------------------------- +PROJECT = CDopping.bpl +OBJFILES = CDopping\ActvApp\ActivApp.obj CDopping\CoolForm\CoolForm.obj \ + CDopping\DialUp\Dialup.obj CDopping\Tb97\Tb97.obj \ + CDopping\CoolForm\CoolButton.obj CDopping\Phanton\Phantom.obj CDopping.obj +RESFILES = CDopping.res cdopping\actvapp\ActivApp.dcr cdopping\dialup\Dialup.dcr \ + CDopping\Tb97\Tb97.dcr CDopping\Phanton\Phantom.dcr +RESDEPEN = $(RESFILES) +LIBFILES = +LIBRARIES = INET35.lib vcldb35.lib +SPARELIBS = vcl35.lib vcldb35.lib INET35.lib +PACKAGES = VCLX35.bpi VCL35.bpi +PATHASM = .;CDopping\ActvApp;CDopping\CoolForm;CDopping\DialUp;CDopping\Tb97;CDopping\Phanton +PATHCPP = .; +PATHPAS = .; +PATHRC = .; +DEBUGLIBPATH = $(BCB)\lib\debug +RELEASELIBPATH = $(BCB)\lib\release +DEFFILE = +# --------------------------------------------------------------------------- +CFLAG1 = -Od -Hc -w -Ve -r- -k -y -v -vi- -c -b- -w-par -w-inl -Vx +CFLAG2 = -DUSEPACKAGES \ + -Icdopping\phanton;..\ctrlmstr;cdopping\actbtn;"cdopping\desktop lock";cdopping\tb97;cdopping\dialup;cdopping\coolform;cdopping\actvapp;"..\jd soft\jd";"l:\programación (-cbuilder-)\jd soft\jd";l:\cbuilder\cbuilder\objrepos;j:\cbuilder\cbuilder\bin;j:\cbuilder\cbuilder\bin;j:\cbuilder\cbuilder\objrepos;$(BCB)\bin;$(BCB)\objrepos;"j:\cbuilder\jd soft";"j:\progwin95\jd soft";$(BCB)\projects;$(BCB)\include;$(BCB)\include\vcl \ + -H=$(BCB)\lib\vcld.csm +CFLAG3 = -5 +PFLAGS = -AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE \ + -DUSEPACKAGES \ + -U"..\jd soft";cdopping\phanton;..\ctrlmstr;cdopping\actbtn;"cdopping\desktop lock";cdopping\tb97;cdopping\dialup;cdopping\coolform;cdopping\actvapp;"..\jd soft\jd";"l:\programación (-cbuilder-)\jd soft\jd";l:\cbuilder\cbuilder\objrepos;j:\cbuilder\cbuilder\bin;j:\cbuilder\cbuilder\bin;j:\cbuilder\cbuilder\objrepos;$(BCB)\bin;$(BCB)\objrepos;"j:\cbuilder\jd soft";"j:\progwin95\jd soft";$(BCB)\projects;$(BCB)\lib\obj;$(BCB)\lib;$(DEBUGLIBPATH) \ + -Icdopping\phanton;..\ctrlmstr;cdopping\actbtn;"cdopping\desktop lock";cdopping\tb97;cdopping\dialup;cdopping\coolform;cdopping\actvapp;"..\jd soft\jd";"l:\programación (-cbuilder-)\jd soft\jd";l:\cbuilder\cbuilder\objrepos;j:\cbuilder\cbuilder\bin;j:\cbuilder\cbuilder\bin;j:\cbuilder\cbuilder\objrepos;$(BCB)\bin;$(BCB)\objrepos;"j:\cbuilder\jd soft";"j:\progwin95\jd soft";$(BCB)\projects;$(BCB)\include;$(BCB)\include\vcl \ + -H -$Y -$W -$O- -v -JPHNV -M +RFLAGS = -DUSEPACKAGES \ + -icdopping\phanton;..\ctrlmstr;cdopping\actbtn;"cdopping\desktop lock";cdopping\tb97;cdopping\dialup;cdopping\coolform;cdopping\actvapp;"..\jd soft\jd";"l:\programación (-cbuilder-)\jd soft\jd";l:\cbuilder\cbuilder\objrepos;j:\cbuilder\cbuilder\bin;j:\cbuilder\cbuilder\bin;j:\cbuilder\cbuilder\objrepos;$(BCB)\bin;$(BCB)\objrepos;"j:\cbuilder\jd soft";"j:\progwin95\jd soft";$(BCB)\projects;$(BCB)\include;$(BCB)\include\vcl +AFLAGS = /icdopping\phanton /i..\ctrlmstr /icdopping\actbtn /i"cdopping\desktop lock" \ + /icdopping\tb97 /icdopping\dialup /icdopping\coolform /icdopping\actvapp \ + /i"..\jd soft\jd" /i"l:\programación (-cbuilder-)\jd soft\jd" \ + /il:\cbuilder\cbuilder\objrepos /ij:\cbuilder\cbuilder\bin \ + /ij:\cbuilder\cbuilder\bin /ij:\cbuilder\cbuilder\objrepos /i$(BCB)\bin \ + /i$(BCB)\objrepos /i"j:\cbuilder\jd soft" /i"j:\progwin95\jd soft" \ + /i$(BCB)\projects /i$(BCB)\include /i$(BCB)\include\vcl /dUSEPACKAGES /mx /w2 /zd +LFLAGS = -L"..\jd soft";cdopping\phanton;..\ctrlmstr;cdopping\actbtn;"cdopping\desktop lock";cdopping\tb97;cdopping\dialup;cdopping\coolform;cdopping\actvapp;"..\jd soft\jd";"l:\programación (-cbuilder-)\jd soft\jd";l:\cbuilder\cbuilder\objrepos;j:\cbuilder\cbuilder\bin;j:\cbuilder\cbuilder\bin;j:\cbuilder\cbuilder\objrepos;$(BCB)\bin;$(BCB)\objrepos;"j:\cbuilder\jd soft";"j:\progwin95\jd soft";$(BCB)\projects;$(BCB)\lib\obj;$(BCB)\lib;$(DEBUGLIBPATH) \ + -aa -Tpp -x -Gl -Gi -v +IFLAGS = -g +LINKER = ilink32 +# --------------------------------------------------------------------------- +ALLOBJ = c0pkg32.obj $(PACKAGES) sysinit.obj $(OBJFILES) +ALLRES = $(RESFILES) +ALLLIB = $(LIBFILES) $(LIBRARIES) import32.lib cp32mt.lib +# --------------------------------------------------------------------------- +.autodepend + +!ifdef IDEOPTIONS + +[Version Info] +IncludeVerInfo=1 +AutoIncBuild=1 +MajorVer=1 +MinorVer=0 +Release=0 +Build=56 +Debug=1 +PreRelease=0 +Special=0 +Private=0 +DLL=0 +Locale=3082 +CodePage=1252 + +[Version Info Keys] +CompanyName=JD soft. +FileDescription=Gestión integral de múltiples empresas,\n con múltiples terminales. +FileVersion=1.0.0.56 +InternalName=Tpv for Windows +LegalCopyright=Copyright (C) JD soft. 1990-1998 +LegalTrademarks= +OriginalFilename=Tpv +ProductName=Tpv for Win98 +ProductVersion=1.0.0.0 +Comments=e-mail: Jose-David.Guillen@cs.us.es + +[HistoryLists\hlIncludePath] +Count=2 +Item0=cdopping\phanton;..\ctrlmstr;cdopping\actbtn;cdopping\desktop lock;cdopping\tb97;cdopping\dialup;cdopping\coolform;cdopping\actvapp;..\jd soft\jd;l:\programación (-cbuilder-)\jd soft\jd;l:\cbuilder\cbuilder\objrepos;j:\cbuilder\cbuilder\bin;j:\cbuilder\cbuilder\bin;j:\cbuilder\cbuilder\objrepos;$(BCB)\bin;$(BCB)\objrepos;j:\cbuilder\jd soft;j:\progwin95\jd soft;$(BCB)\projects;$(BCB)\include;$(BCB)\include\vcl +Item1=..\jd soft\jd;l:\programación (-cbuilder-)\jd soft\jd;l:\cbuilder\cbuilder\objrepos;j:\cbuilder\cbuilder\bin;j:\cbuilder\cbuilder\bin;j:\cbuilder\cbuilder\objrepos;$(BCB)\bin;$(BCB)\objrepos;j:\cbuilder\jd soft;j:\progwin95\jd soft;$(BCB)\projects;$(BCB)\include;$(BCB)\include\vcl + +[HistoryLists\hlLibraryPath] +Count=2 +Item0=..\jd soft;cdopping\phanton;..\ctrlmstr;cdopping\actbtn;cdopping\desktop lock;cdopping\tb97;cdopping\dialup;cdopping\coolform;cdopping\actvapp;..\jd soft\jd;l:\programación (-cbuilder-)\jd soft\jd;l:\cbuilder\cbuilder\objrepos;j:\cbuilder\cbuilder\bin;j:\cbuilder\cbuilder\bin;j:\cbuilder\cbuilder\objrepos;$(BCB)\bin;$(BCB)\objrepos;j:\cbuilder\jd soft;j:\progwin95\jd soft;$(BCB)\projects;$(BCB)\lib\obj;$(BCB)\lib +Item1=..\jd soft\jd;l:\programación (-cbuilder-)\jd soft\jd;l:\cbuilder\cbuilder\objrepos;j:\cbuilder\cbuilder\bin;j:\cbuilder\cbuilder\bin;j:\cbuilder\cbuilder\objrepos;$(BCB)\bin;$(BCB)\objrepos;j:\cbuilder\jd soft;j:\progwin95\jd soft;$(BCB)\projects;$(BCB)\lib\obj;$(BCB)\lib + +[HistoryLists\hlUnitAliases] +Count=1 +Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE + +[Debugging] +DebugSourceDirs= + +[Parameters] +RunParams= +HostApplication= + +!endif + +$(PROJECT): $(OBJFILES) $(RESDEPEN) $(DEFFILE) + $(BCB)\BIN\$(LINKER) @&&! + $(LFLAGS) + + $(ALLOBJ), + + $(PROJECT),, + + $(ALLLIB), + + $(DEFFILE), + + $(ALLRES) +! + +.pas.hpp: + $(BCB)\BIN\dcc32 $(PFLAGS) { $** } + +.pas.obj: + $(BCB)\BIN\dcc32 $(PFLAGS) { $** } + +.cpp.obj: + $(BCB)\BIN\bcc32 $(CFLAG1) $(CFLAG2) -o$* $* + +.c.obj: + $(BCB)\BIN\bcc32 $(CFLAG1) $(CFLAG2) -o$* $** + +.rc.res: + $(BCB)\BIN\brcc32 $(RFLAGS) $< +#----------------------------------------------------------------------------- diff --git a/CDopping.bpl b/CDopping.bpl new file mode 100644 index 0000000..ca22521 Binary files /dev/null and b/CDopping.bpl differ diff --git a/CDopping.cpp b/CDopping.cpp new file mode 100644 index 0000000..10e95e4 --- /dev/null +++ b/CDopping.cpp @@ -0,0 +1,26 @@ +//--------------------------------------------------------------------------- +#include +#pragma hdrstop +USERES("CDopping.res"); +USEPACKAGE("VCLX35.bpi"); +USEPACKAGE("VCL35.bpi"); +USEUNIT("CDopping\ActvApp\ActivApp.pas"); +USERES("cdopping\actvapp\ActivApp.dcr"); +USEUNIT("CDopping\CoolForm\CoolForm.pas"); +USEUNIT("CDopping\DialUp\Dialup.pas"); +USERES("cdopping\dialup\Dialup.dcr"); +USEUNIT("CDopping\Tb97\Tb97.pas"); +USERES("CDopping\Tb97\Tb97.dcr"); +USEUNIT("CDopping\CoolForm\CoolButton.pas"); +USERES("CDopping\Phanton\Phantom.dcr"); +USEUNIT("CDopping\Phanton\Phantom.pas"); +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +// Package source. +//--------------------------------------------------------------------------- +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- diff --git a/CDopping.lib b/CDopping.lib new file mode 100644 index 0000000..b4d6b9d Binary files /dev/null and b/CDopping.lib differ diff --git a/CDopping.obj b/CDopping.obj new file mode 100644 index 0000000..c82eaba Binary files /dev/null and b/CDopping.obj differ diff --git a/CDopping.res b/CDopping.res new file mode 100644 index 0000000..6ab90b4 Binary files /dev/null and b/CDopping.res differ diff --git a/CDopping/ActBtn/ActBtn.dcr b/CDopping/ActBtn/ActBtn.dcr new file mode 100644 index 0000000..f314138 Binary files /dev/null and b/CDopping/ActBtn/ActBtn.dcr differ diff --git a/CDopping/ActBtn/ActImg.dcr b/CDopping/ActBtn/ActImg.dcr new file mode 100644 index 0000000..f314138 Binary files /dev/null and b/CDopping/ActBtn/ActImg.dcr differ diff --git a/CDopping/ActBtn/actbtn.cpp b/CDopping/ActBtn/actbtn.cpp new file mode 100644 index 0000000..36572df --- /dev/null +++ b/CDopping/ActBtn/actbtn.cpp @@ -0,0 +1,64 @@ +//--------------------------------------------------------------------------- +#include +#pragma hdrstop + +#include "actbtn.h" +//--------------------------------------------------------------------------- +static inline TActiveButton *ValidCtrCheck() +{ + return new TActiveButton(NULL); +} +//--------------------------------------------------------------------------- +__fastcall TActiveButton::TActiveButton(TComponent* Owner) + : TBitBtn(Owner) +{ + captured = false; + Glyph1 = new Graphics::TBitmap; + FGlyph2 = new Graphics::TBitmap; +} +//--------------------------------------------------------------------------- +__fastcall TActiveButton::~TActiveButton() +{ + delete Glyph1; + delete FGlyph2; +} +//--------------------------------------------------------------------------- +void __fastcall TActiveButton::MouseMove( Classes::TShiftState Shift, int X, int Y) +{ + if( !captured){ + SetCapture( Handle); + captured = true; + Glyph1->Assign( Glyph); // save old glyph + Glyph = Glyph2; // show new glyph + } + if( (X<0) || (Y<0) || (X>Width) || (Y>Height)){ + ReleaseCapture(); + captured = false; + Glyph = Glyph1; // restore old glyph + }else{ + TBitBtn::MouseMove( Shift, X, Y); + } +} +//--------------------------------------------------------------------------- +void __fastcall TActiveButton::Click( void) +{ + TBitBtn::Click(); + ReleaseCapture(); + captured = false; + Glyph = Glyph1; +} +//--------------------------------------------------------------------------- +void __fastcall TActiveButton::SetGlyph2( Graphics::TBitmap *val) +{ + Glyph2->Assign( val); +} +//--------------------------------------------------------------------------- +namespace Actbtn +{ + void __fastcall Register() + { + TComponentClass classes[1] = {__classid(TActiveButton)}; + RegisterComponents("Extras", classes, 0); + } +} +//--------------------------------------------------------------------------- diff --git a/CDopping/ActBtn/actbtn.h b/CDopping/ActBtn/actbtn.h new file mode 100644 index 0000000..946e870 --- /dev/null +++ b/CDopping/ActBtn/actbtn.h @@ -0,0 +1,31 @@ +//--------------------------------------------------------------------------- +#ifndef ActBtnH +#define ActBtnH +//--------------------------------------------------------------------------- +#include +#include +#include +#include +#include +#include +//--------------------------------------------------------------------------- +class TActiveButton : public TBitBtn +{ +private: + bool captured; + void __fastcall MouseMove( Classes::TShiftState Shift, int X, int Y); + +protected: + Graphics::TBitmap *Glyph1,*FGlyph2; + void __fastcall SetGlyph2( Graphics::TBitmap* val); + void __fastcall Click( void); + +public: + __fastcall TActiveButton(TComponent* Owner); + __fastcall ~TActiveButton(); + +__published: +__property Graphics::TBitmap *Glyph2={read=FGlyph2, write=SetGlyph2}; +}; +//--------------------------------------------------------------------------- +#endif diff --git a/CDopping/ActBtn/actimg.cpp b/CDopping/ActBtn/actimg.cpp new file mode 100644 index 0000000..2720cdc --- /dev/null +++ b/CDopping/ActBtn/actimg.cpp @@ -0,0 +1,63 @@ +//--------------------------------------------------------------------------- +#include +#pragma hdrstop + +#include "actimg.h" +//--------------------------------------------------------------------------- +static inline TActiveImage *ValidCtrCheck() +{ + return new TActiveImage(NULL); +} +//--------------------------------------------------------------------------- +__fastcall TActiveImage::TActiveImage(TComponent* Owner) + : TImage(Owner) +{ + captured = false; + GlyphNormal = new Graphics::TPicture; + GlyphOver = new Graphics::TPicture; + GlyphPress = new Graphics::TPicture; +} +//--------------------------------------------------------------------------- +__fastcall TActiveImage::~TActiveImage() +{ + delete GlyphNormal; + delete GlyphOver; + delete GlyphPress; +} +//--------------------------------------------------------------------------- +void __fastcall TActiveImage::MouseMove( Classes::TShiftState Shift, int X, int Y ) +{ + if( !captured ) + { + SetCapture( Parent ); + captured = true; + GlyphNormal = Picture; // save old glyph + Picture = GlyphOver; // show new glyph + } + if( (X<0) || (Y<0) || (X>Width) || (Y>Height)) + { + ReleaseCapture(); + captured = false; + Picture = GlyphNormal; // restore old glyph + }else{ + TImage::MouseMove( Shift, X, Y ); + } +} +//--------------------------------------------------------------------------- +void __fastcall TActiveImage::Click( void ) +{ + TImage::Click(); + ReleaseCapture(); + captured = false; + Picture = GlyphNormal; +} +//--------------------------------------------------------------------------- +namespace Actimg +{ + void __fastcall Register() + { + TComponentClass classes[1] = {__classid(TActiveImage)}; + RegisterComponents("JD Soft.", classes, 0); + } +} +//--------------------------------------------------------------------------- diff --git a/CDopping/ActBtn/actimg.h b/CDopping/ActBtn/actimg.h new file mode 100644 index 0000000..40fc793 --- /dev/null +++ b/CDopping/ActBtn/actimg.h @@ -0,0 +1,32 @@ +//--------------------------------------------------------------------------- +#ifndef ActBtnH +#define ActBtnH +//--------------------------------------------------------------------------- +#include +#include +#include +#include +#include +#include +//--------------------------------------------------------------------------- +class TActiveImage : public TImage +{ +private: + bool captured; + void __fastcall MouseMove( Classes::TShiftState Shift, int X, int Y); + +protected: + Graphics::TPicture *GlyphOver,*GlyphNormal, *GlyphPress; + + void __fastcall Click( void); + +public: + __fastcall TActiveImage(TComponent* Owner); + __fastcall ~TActiveImage(); + +__published: +__property Graphics::TPicture *Picture_Over={read=GlyphOver, write=GlyphOver}; +__property Graphics::TPicture *Picture_Press={read=GlyphPress, write=GlyphPress}; +}; +//--------------------------------------------------------------------------- +#endif diff --git a/CDopping/ActvApp/ActivApp.OBJ b/CDopping/ActvApp/ActivApp.OBJ new file mode 100644 index 0000000..7b434a7 Binary files /dev/null and b/CDopping/ActvApp/ActivApp.OBJ differ diff --git a/CDopping/ActvApp/ActivApp.Txt b/CDopping/ActvApp/ActivApp.Txt new file mode 100644 index 0000000..23dae18 --- /dev/null +++ b/CDopping/ActvApp/ActivApp.Txt @@ -0,0 +1,18 @@ + Allows switching between open delphi applications and/or lauching (any) application + Note: App to Switch too must have TActivateApp component + two Methods: 1) ActivateApp - Switch to open App, if App Closed Then Launch It + 2) ExecuteApp - Launch App + one Event: 1) BeforeLaunchApp - Allows one to discontinue Lauching of app when + ActivateApp senses app to switch to is not open, does not stop + launching of app when execute method used. + Properties: 1) MainFormTitle - Title On Main form of Application to Activate when + using AppActivate Method only. IF An MDI Application then included the + FULL title displayed on the titlebar of the main form + 2) ExePath - Full path to executable including Exe name and any parameters + Used by both ActivateApp & Execute App + Freeware Use & Abuse + Author: Edward de la Rey + edwardr@mailbox.ru.ac.za + USE AT OWN RISK + For Delphi 1,2,3 Will Automatically pickup the correct DCR File, + D16 is for Delphi1, D32 for Delphi 2&3, Don't rename them. \ No newline at end of file diff --git a/CDopping/ActvApp/ActivApp.d32 b/CDopping/ActvApp/ActivApp.d32 new file mode 100644 index 0000000..9c5d1b6 Binary files /dev/null and b/CDopping/ActvApp/ActivApp.d32 differ diff --git a/CDopping/ActvApp/ActivApp.dcr b/CDopping/ActvApp/ActivApp.dcr new file mode 100644 index 0000000..9c5d1b6 Binary files /dev/null and b/CDopping/ActvApp/ActivApp.dcr differ diff --git a/CDopping/ActvApp/ActivApp.dcu b/CDopping/ActvApp/ActivApp.dcu new file mode 100644 index 0000000..2447760 Binary files /dev/null and b/CDopping/ActvApp/ActivApp.dcu differ diff --git a/CDopping/ActvApp/ActivApp.hpp b/CDopping/ActvApp/ActivApp.hpp new file mode 100644 index 0000000..6801cec --- /dev/null +++ b/CDopping/ActvApp/ActivApp.hpp @@ -0,0 +1,62 @@ +// Borland C++ Builder +// Copyright (c) 1995, 1998 by Borland International +// All rights reserved + +// (DO NOT EDIT: machine generated header) 'ActivApp.pas' rev: 3.00 + +#ifndef ActivAppHPP +#define ActivAppHPP +#include +#include +#include +#include +#include +#include +#include + +//-- user supplied ----------------------------------------------------------- + +namespace Activapp +{ +//-- type declarations ------------------------------------------------------- +typedef void __fastcall (__closure *TMYParamEvent)(System::TObject* Sender, bool &Continue); + +typedef void __fastcall (__closure *TSuccess)(System::TObject* Sender, bool Result); + +class DELPHICLASS TActivApp; +class PASCALIMPLEMENTATION TActivApp : public Classes::TComponent +{ + typedef Classes::TComponent inherited; + +private: + System::AnsiString GetAppToActivate; + System::AnsiString GetExePath; + TMYParamEvent EBeforeLaunchApp; + void __fastcall SetAppToActivate(System::AnsiString Value); + void __fastcall SetExePath(System::AnsiString Value); + +protected: + void __fastcall ShowYourSelf(tagMSG &Msg, bool &Handled); + +__published: + __fastcall virtual TActivApp(Classes::TComponent* AOwner); + void __fastcall ActivateApp(void); + void __fastcall ExecuteApp(bool Success); + __property System::AnsiString MainFormTitle = {read=GetAppToActivate, write=SetAppToActivate}; + __property System::AnsiString ExePath = {read=GetExePath, write=SetExePath}; + __property TMYParamEvent BeforeLaunchApp = {read=EBeforeLaunchApp, write=EBeforeLaunchApp}; +public: + /* TComponent.Destroy */ __fastcall virtual ~TActivApp(void) { } + +}; + +//-- var, const, procedure --------------------------------------------------- +#define WM_ShowYourSelf (Word)(1426) +extern PACKAGE void __fastcall Register(void); + +} /* namespace Activapp */ +#if !defined(NO_IMPLICIT_NAMESPACE_USE) +using namespace Activapp; +#endif +//-- end unit ---------------------------------------------------------------- +#endif // ActivApp diff --git a/CDopping/ActvApp/ActivApp.pas b/CDopping/ActvApp/ActivApp.pas new file mode 100644 index 0000000..e40e28a --- /dev/null +++ b/CDopping/ActvApp/ActivApp.pas @@ -0,0 +1,144 @@ +unit ActivApp; +{ Allows switching between open delphi applications and/or lauching (any) application + Note: App to Switch too must have TActivateApp component + two Methods: 1) ActivateApp - Switch to open App, if App Closed Then Launch It + 2) ExecuteApp - Launch App + one Event: 1) BeforeLaunchApp - Allows one to discontinue Lauching of app when + ActivateApp senses app to switch to is not open, does not stop + launching of app when execute method used. + Properties: 1) MainFormTitle - Title On Main form of Application to Activate when + using AppActivate Method only. IF An MDI Application then included the + FULL title displayed on the titlebar of the main form + 2) ExePath - Full path to executable including Exe name and any parameters + Used by both ActivateApp & Execute App + Freeware Use & Abuse + Author: Edward de la Rey + edwardr@mailbox.ru.ac.za + USE AT OWN RISK + For Delphi 1,2,3 Will Automatically pickup the correct DCR File, + D16 is for Delphi1, D32 for Delphi 2&3, Don't rename them.} + + +interface + +{$IFDEF WIN32} +uses + Windows, Messages, SysUtils, Classes, Forms; +{$ELSE} +uses + SysUtils, WinTypes, WinProcs, Messages, Classes, Forms; +{$ENDIF} + +const +WM_ShowYourSelf = WM_USER + 402; + +type + TMYParamEvent = Procedure (Sender:TObject;var Continue:Boolean) of object; + TSuccess = Procedure (Sender:TObject;Result:Boolean) of object; + TActivApp = class(Tcomponent) + private + GetAppToActivate:String; + GetExePath:String; + EBeforeLaunchApp:TMYParamEvent; + Procedure SetAppToActivate(Value:String); + Procedure SetExePath(Value:String); + protected + { Protected declarations } + procedure ShowYourSelf(var Msg: TMsg; var Handled: Boolean); + public + { Public declarations } + published + Constructor Create(AOwner: TComponent); override; + Procedure ActivateApp; + Procedure ExecuteApp (Success:Boolean); + Property MainFormTitle:String Read GetAppToActivate Write SetAppToActivate; + Property ExePath:String Read GetExePath Write SetExePath; + Property BeforeLaunchApp:TMYParamEvent Read EBeforeLaunchApp Write EBeforeLaunchApp; + end; + +procedure Register; + +implementation + +{$IFDEF WIN32} +{$R *.D32} +{$ELSE} +{$R *.D16} +{$ENDIF} + +constructor TActivApp.Create(AOwner: TComponent); +begin + INHERITED CREATE(Aowner); + GetAppToActivate:='MyOtherApp'; + GetExePath:=ExtractFilePath(application.ExeName); + if not (csDesigning in ComponentState) then + Application.OnMessage:=ShowYourSelf; +End; + +procedure TActivApp.ShowYourSelf(var Msg: TMsg; var Handled: Boolean); +begin + {This procedure handles messages sent from other Apps} + Handled:=false; + if msg.message = WM_ShowYourSelf then + begin + Application.Restore; + application.BringToFront; + Handled:=true; + end; +End; + +Procedure TActivApp.ExecuteApp(Success:Boolean); +Var +It:PChar; +Ans:integer; +begin + it:=Stralloc ((length(GetExePath))+2); + strPCopy(It,GetExePath); + Ans:=WinExec(It,SW_SHOW); + strDispose(it); + Success:= Ans > 31; +end; + +procedure TActivApp.ActivateApp; +Var + it,AppToActiv:PChar; + MyHandle:HWnd; + Success:Integer; + Continue:Boolean; +begin + AppToActiv:=Stralloc ((length(GetAppToActivate))+2); + strPCopy(AppToActiv,GetAppToActivate); + MyHandle := FindWindow(nil,AppToActiv); + strDispose(ApptoActiv); + if MyHandle <> 0 then begin + PostMessage(MyHandle,WM_ShowYourSelf,0,0); {Unminimize and bring to front} + {nb Must use PostMessage Only} + end {My Handle <> 0} + else begin + Continue:=true; + If Assigned(EBeforeLaunchApp) Then EBeforeLaunchApp(Self,Continue); + if Continue Then begin + it:=Stralloc ((length(GetExePath))+2); + strPCopy(It,GetExePath); + Success:=WinExec(It,SW_SHOW); + strDispose(it); + end; {Continue} + end;{Else MyHAndle = 0} + end; + +procedure TActivApp.SetAppToActivate (Value:String); +begin + GetAppToActivate:=Value; +end; + +procedure TActivApp.SetExePath (Value:String); +begin + GetExePath:=Value; +end; + +procedure Register; +begin + RegisterComponents('Freeware', [TActivApp]); +end; + +end. diff --git a/CDopping/ActvApp/CloseApp.OBJ b/CDopping/ActvApp/CloseApp.OBJ new file mode 100644 index 0000000..6ae3322 Binary files /dev/null and b/CDopping/ActvApp/CloseApp.OBJ differ diff --git a/CDopping/ActvApp/CloseApp.dcu b/CDopping/ActvApp/CloseApp.dcu new file mode 100644 index 0000000..d473b09 Binary files /dev/null and b/CDopping/ActvApp/CloseApp.dcu differ diff --git a/CDopping/ActvApp/CloseApp.hpp b/CDopping/ActvApp/CloseApp.hpp new file mode 100644 index 0000000..cea2f2b --- /dev/null +++ b/CDopping/ActvApp/CloseApp.hpp @@ -0,0 +1,26 @@ +// Borland C++ Builder +// Copyright (c) 1995, 1998 by Borland International +// All rights reserved + +// (DO NOT EDIT: machine generated header) 'CloseApp.pas' rev: 3.00 + +#ifndef CloseAppHPP +#define CloseAppHPP +#include +#include +#include + +//-- user supplied ----------------------------------------------------------- + +namespace Closeapp +{ +//-- type declarations ------------------------------------------------------- +//-- var, const, procedure --------------------------------------------------- +extern PACKAGE void __fastcall CloseAppFromInst(int HInst); + +} /* namespace Closeapp */ +#if !defined(NO_IMPLICIT_NAMESPACE_USE) +using namespace Closeapp; +#endif +//-- end unit ---------------------------------------------------------------- +#endif // CloseApp diff --git a/CDopping/ActvApp/CloseApp.pas b/CDopping/ActvApp/CloseApp.pas new file mode 100644 index 0000000..a193724 --- /dev/null +++ b/CDopping/ActvApp/CloseApp.pas @@ -0,0 +1,34 @@ +unit CloseApp; + +{ By Duncan McNiven, duncan.mcniven@lecs.inet.fi } +{ Comments by Brad Stowers, bstowers@pobox.com } + +interface + +uses WinTypes; + +procedure CloseAppFromInst(HInst: THandle); + +implementation + +uses WinProcs, Messages; + +{ Callback function that has each top-level window passed to it. } +{ Return true to continue enumerating, false to stop. } +function EnumWindowsProc(Handle: HWND; Info: Pointer): boolean; export; +begin + Result := TRUE; { continue enumeration } + { Does this app have the same instance as what we are looking for? } + if GetWindowWord(Handle, GWL_HINSTANCE) = LongInt(Info) then begin + PostMessage(Handle, WM_CLOSE, 0, 0); { Close the app } + Result := FALSE; { stop enumerating windows, we are done. } + end; +end; + +procedure CloseAppFromInst(HInst: THandle); +begin + EnumWindows(@EnumWindowsProc, LongInt(HInst)); +end; + +end. + diff --git a/CDopping/CoolForm/Cool.res b/CDopping/CoolForm/Cool.res new file mode 100644 index 0000000..dbef42d Binary files /dev/null and b/CDopping/CoolForm/Cool.res differ diff --git a/CDopping/CoolForm/CoolButton.OBJ b/CDopping/CoolForm/CoolButton.OBJ new file mode 100644 index 0000000..6b0f636 Binary files /dev/null and b/CDopping/CoolForm/CoolButton.OBJ differ diff --git a/CDopping/CoolForm/CoolButton.dcu b/CDopping/CoolForm/CoolButton.dcu new file mode 100644 index 0000000..d3b555a Binary files /dev/null and b/CDopping/CoolForm/CoolButton.dcu differ diff --git a/CDopping/CoolForm/CoolButton.hpp b/CDopping/CoolForm/CoolButton.hpp new file mode 100644 index 0000000..3143714 --- /dev/null +++ b/CDopping/CoolForm/CoolButton.hpp @@ -0,0 +1,123 @@ +// Borland C++ Builder +// Copyright (c) 1995, 1998 by Borland International +// All rights reserved + +// (DO NOT EDIT: machine generated header) 'CoolButton.pas' rev: 3.00 + +#ifndef CoolButtonHPP +#define CoolButtonHPP +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +//-- user supplied ----------------------------------------------------------- + +namespace Coolbutton +{ +//-- type declarations ------------------------------------------------------- +enum TButtonLayout { blGlyphLeft, blGlyphRight, blGlyphTop, blGlyphBottom }; + +enum TButtonState { bsUp, bsDisabled, bsDown, bsExclusive }; + +enum TButtonStyle { bsAutoDetect, bsWin31, bsNew }; + +typedef Shortint TNumGlyphs; + +class DELPHICLASS TCoolButton; +class PASCALIMPLEMENTATION TCoolButton : public Controls::TGraphicControl +{ + typedef Controls::TGraphicControl inherited; + +private: + int FGroupIndex; + void *FGlyph; + bool FDown; + bool FDragging; + bool FAllowAllUp; + TButtonLayout FLayout; + int FSpacing; + int FMargin; + bool FMouseInControl; + void __fastcall GlyphChanged(System::TObject* Sender); + void __fastcall UpdateExclusive(void); + Graphics::TBitmap* __fastcall GetGlyph(void); + void __fastcall SetGlyph(Graphics::TBitmap* Value); + TNumGlyphs __fastcall GetNumGlyphs(void); + void __fastcall SetNumGlyphs(TNumGlyphs Value); + void __fastcall SetDown(bool Value); + void __fastcall SetAllowAllUp(bool Value); + void __fastcall SetGroupIndex(int Value); + void __fastcall SetLayout(TButtonLayout Value); + void __fastcall SetSpacing(int Value); + void __fastcall SetMargin(int Value); + void __fastcall UpdateTracking(void); + HIDESBASE MESSAGE void __fastcall WMLButtonDblClk(Messages::TWMMouse &Message); + HIDESBASE MESSAGE void __fastcall CMEnabledChanged(Messages::TMessage &Message); + MESSAGE void __fastcall CMButtonPressed(Messages::TMessage &Message); + MESSAGE void __fastcall CMDialogChar(Messages::TWMKey &Message); + HIDESBASE MESSAGE void __fastcall CMFontChanged(Messages::TMessage &Message); + MESSAGE void __fastcall CMTextChanged(Messages::TMessage &Message); + MESSAGE void __fastcall CMSysColorChange(Messages::TMessage &Message); + HIDESBASE MESSAGE void __fastcall CMMouseLeave(Messages::TMessage &Message); + MESSAGE void __fastcall WMEraseBkgnd(Messages::TWMEraseBkgnd &message); + HIDESBASE MESSAGE void __fastcall WMPaint(Messages::TWMPaint &message); + MESSAGE void __fastcall WMNCPaint(Messages::TWMNoParams &message); + +protected: + TButtonState FState; + DYNAMIC HPALETTE __fastcall GetPalette(void); + virtual void __fastcall Loaded(void); + DYNAMIC void __fastcall MouseDown(Controls::TMouseButton Button, Classes::TShiftState Shift, int X, + int Y); + DYNAMIC void __fastcall MouseMove(Classes::TShiftState Shift, int X, int Y); + DYNAMIC void __fastcall MouseUp(Controls::TMouseButton Button, Classes::TShiftState Shift, int X, int + Y); + virtual void __fastcall Paint(void); + +public: + __fastcall virtual TCoolButton(Classes::TComponent* AOwner); + __fastcall virtual ~TCoolButton(void); + DYNAMIC void __fastcall Click(void); + +__published: + __property bool AllowAllUp = {read=FAllowAllUp, write=SetAllowAllUp, default=0}; + __property int GroupIndex = {read=FGroupIndex, write=SetGroupIndex, default=0}; + __property bool Down = {read=FDown, write=SetDown, default=0}; + __property Caption ; + __property Enabled ; + __property Font ; + __property Graphics::TBitmap* Glyph = {read=GetGlyph, write=SetGlyph}; + __property TButtonLayout Layout = {read=FLayout, write=SetLayout, default=0}; + __property int Margin = {read=FMargin, write=SetMargin, default=-1}; + __property TNumGlyphs NumGlyphs = {read=GetNumGlyphs, write=SetNumGlyphs, default=4}; + __property ParentFont ; + __property ParentShowHint ; + __property ShowHint ; + __property int Spacing = {read=FSpacing, write=SetSpacing, default=4}; + __property Visible ; + __property OnClick ; + __property OnDblClick ; + __property OnMouseDown ; + __property OnMouseMove ; + __property OnMouseUp ; +}; + +//-- var, const, procedure --------------------------------------------------- +extern PACKAGE void __fastcall Register(void); +extern PACKAGE Windows::TRect __fastcall DrawButtonFace(Graphics::TCanvas* Canvas, const Windows::TRect + &Client, int BevelWidth, TButtonStyle Style, bool IsRounded, bool IsDown, bool IsFocused); + +} /* namespace Coolbutton */ +#if !defined(NO_IMPLICIT_NAMESPACE_USE) +using namespace Coolbutton; +#endif +//-- end unit ---------------------------------------------------------------- +#endif // CoolButton diff --git a/CDopping/CoolForm/CoolButton.pas b/CDopping/CoolForm/CoolButton.pas new file mode 100644 index 0000000..4e24d6d --- /dev/null +++ b/CDopping/CoolForm/CoolButton.pas @@ -0,0 +1,1133 @@ +unit CoolButton; + +{$S-,W-,R-} +{$C PRELOAD} + +interface + +uses Windows, Messages, Classes, Controls, Forms, Graphics, StdCtrls, + ExtCtrls, CommCtrl; + +type + TButtonLayout = (blGlyphLeft, blGlyphRight, blGlyphTop, blGlyphBottom); + TButtonState = (bsUp, bsDisabled, bsDown, bsExclusive); + TButtonStyle = (bsAutoDetect, bsWin31, bsNew); + TNumGlyphs = 1..4; + + TCoolButton = class(TGraphicControl) + private + FGroupIndex: Integer; + FGlyph: Pointer; + FDown: Boolean; + FDragging: Boolean; + FAllowAllUp: Boolean; + FLayout: TButtonLayout; + FSpacing: Integer; + FMargin: Integer; + FMouseInControl: Boolean; +// FMouseinMask: Boolean; + procedure GlyphChanged(Sender: TObject); + procedure UpdateExclusive; + function GetGlyph: TBitmap; + procedure SetGlyph(Value: TBitmap); + function GetNumGlyphs: TNumGlyphs; + procedure SetNumGlyphs(Value: TNumGlyphs); + procedure SetDown(Value: Boolean); + procedure SetAllowAllUp(Value: Boolean); + procedure SetGroupIndex(Value: Integer); + procedure SetLayout(Value: TButtonLayout); + procedure SetSpacing(Value: Integer); + procedure SetMargin(Value: Integer); + procedure UpdateTracking; + procedure WMLButtonDblClk(var Message: TWMLButtonDown); message WM_LBUTTONDBLCLK; + procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED; + procedure CMButtonPressed(var Message: TMessage); message CM_BUTTONPRESSED; + procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR; + procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED; + procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED; + procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE; + procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE; + procedure WMEraseBkgnd( var message:TWMEraseBkgnd); message WM_ERASEBKGND; + procedure WMPaint( var message:TWMPaint); message WM_PAINT; + procedure WMNCPaint( var message:TWMNCPaint); message WM_NCPAINT; + protected + FState: TButtonState; + function GetPalette: HPALETTE; override; + procedure Loaded; override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; + procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; + procedure Paint; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure Click; override; + published + property AllowAllUp: Boolean read FAllowAllUp write SetAllowAllUp default False; + property GroupIndex: Integer read FGroupIndex write SetGroupIndex default 0; + property Down: Boolean read FDown write SetDown default False; + property Caption; + property Enabled; +property Font; + property Glyph: TBitmap read GetGlyph write SetGlyph; + property Layout: TButtonLayout read FLayout write SetLayout default blGlyphLeft; + property Margin: Integer read FMargin write SetMargin default -1; + property NumGlyphs: TNumGlyphs read GetNumGlyphs write SetNumGlyphs default 4; + property ParentFont; + property ParentShowHint; + property ShowHint; + property Spacing: Integer read FSpacing write SetSpacing default 4; + property Visible; + property OnClick; + property OnDblClick; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + end; + +function DrawButtonFace(Canvas: TCanvas; const Client: TRect; + BevelWidth: Integer; Style: TButtonStyle; IsRounded, IsDown, + IsFocused: Boolean): TRect; + +procedure Register; + +implementation + +uses Consts, SysUtils; + + +procedure Register; +begin + RegisterComponents('Cool!', [TCoolButton]); +end; + + + +{ DrawButtonFace - returns the remaining usable area inside the Client rect.} +function DrawButtonFace(Canvas: TCanvas; const Client: TRect; + BevelWidth: Integer; Style: TButtonStyle; IsRounded, IsDown, + IsFocused: Boolean): TRect; +var + NewStyle: Boolean; + R: TRect; + DC: THandle; +begin + NewStyle := ((Style = bsAutoDetect) and NewStyleControls) or (Style = bsNew); + + R := Client; + with Canvas do + begin + if NewStyle then + begin + Brush.Color := clBtnFace; + Brush.Style := bsSolid; + DC := Canvas.Handle; { Reduce calls to GetHandle } + + if IsDown then + begin { DrawEdge is faster than Polyline } + DrawEdge(DC, R, BDR_SUNKENINNER, BF_TOPLEFT); { black } + DrawEdge(DC, R, BDR_SUNKENOUTER, BF_BOTTOMRIGHT); { btnhilite } + Dec(R.Bottom); + Dec(R.Right); + Inc(R.Top); + Inc(R.Left); + DrawEdge(DC, R, BDR_SUNKENOUTER, BF_TOPLEFT or BF_MIDDLE); { btnshadow } + end + else + begin + DrawEdge(DC, R, BDR_RAISEDOUTER, BF_BOTTOMRIGHT); { black } + Dec(R.Bottom); + Dec(R.Right); + DrawEdge(DC, R, BDR_RAISEDINNER, BF_TOPLEFT); { btnhilite } + Inc(R.Top); + Inc(R.Left); + DrawEdge(DC, R, BDR_RAISEDINNER, BF_BOTTOMRIGHT or BF_MIDDLE); { btnshadow } + end; + end + else + begin + Pen.Color := clWindowFrame; + Brush.Color := clBtnFace; + Brush.Style := bsSolid; + Rectangle(R.Left, R.Top, R.Right, R.Bottom); + + { round the corners - only applies to Win 3.1 style buttons } + if IsRounded then + begin + Pixels[R.Left, R.Top] := clBtnFace; + Pixels[R.Left, R.Bottom - 1] := clBtnFace; + Pixels[R.Right - 1, R.Top] := clBtnFace; + Pixels[R.Right - 1, R.Bottom - 1] := clBtnFace; + end; + + if IsFocused then + begin + InflateRect(R, -1, -1); + Brush.Style := bsClear; + Rectangle(R.Left, R.Top, R.Right, R.Bottom); + end; + + InflateRect(R, -1, -1); + if not IsDown then + Frame3D(Canvas, R, clBtnHighlight, clBtnShadow, BevelWidth) + else + begin + Pen.Color := clBtnShadow; + PolyLine([Point(R.Left, R.Bottom - 1), Point(R.Left, R.Top), + Point(R.Right, R.Top)]); + end; + end; + end; + + Result := Rect(Client.Left + 1, Client.Top + 1, + Client.Right - 2, Client.Bottom - 2); + if IsDown then OffsetRect(Result, 1, 1); +end; + + +type + TGlyphList = class(TImageList) + private + Used: TBits; + FCount: Integer; + function AllocateIndex: Integer; + public + constructor CreateSize(AWidth, AHeight: Integer); + destructor Destroy; override; + function AddMasked(Image: TBitmap; MaskColor: TColor): Integer; + procedure Delete(Index: Integer); + property Count: Integer read FCount; + end; + + TGlyphCache = class + private + GlyphLists: TList; + public + constructor Create; + destructor Destroy; override; + function GetList(AWidth, AHeight: Integer): TGlyphList; + procedure ReturnList(List: TGlyphList); + function Empty: Boolean; + end; + + TButtonGlyph = class + private + FOriginal: TBitmap; + FGlyphList: TGlyphList; + FIndexs: array[TButtonState] of Integer; + FTransparentColor: TColor; + FNumGlyphs: TNumGlyphs; + FOnChange: TNotifyEvent; + procedure GlyphChanged(Sender: TObject); + procedure SetGlyph(Value: TBitmap); + procedure SetNumGlyphs(Value: TNumGlyphs); + procedure Invalidate; + function CreateButtonGlyph(State: TButtonState): Integer; + procedure DrawButtonGlyph(Canvas: TCanvas; const GlyphPos: TPoint; + State: TButtonState; Transparent: Boolean); + procedure DrawButtonText(Canvas: TCanvas; const Caption: string; + TextBounds: TRect; State: TButtonState); + procedure CalcButtonLayout(Canvas: TCanvas; const Client: TRect; + const Offset: TPoint; const Caption: string; Layout: TButtonLayout; + Margin, Spacing: Integer; var GlyphPos: TPoint; var TextBounds: TRect); + public + constructor Create; + destructor Destroy; override; + { return the text rectangle } + function Draw(Canvas: TCanvas; const Client: TRect; const Offset: TPoint; + const Caption: string; Layout: TButtonLayout; Margin, Spacing: Integer; + State: TButtonState; Transparent: Boolean): TRect; + property Glyph: TBitmap read FOriginal write SetGlyph; + property NumGlyphs: TNumGlyphs read FNumGlyphs write SetNumGlyphs; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + end; + +{ TGlyphList } + +constructor TGlyphList.CreateSize(AWidth, AHeight: Integer); +begin + inherited CreateSize(AWidth, AHeight); + Used := TBits.Create; +end; + +destructor TGlyphList.Destroy; +begin + Used.Free; + inherited Destroy; +end; + +function TGlyphList.AllocateIndex: Integer; +begin + Result := Used.OpenBit; + if Result >= Used.Size then + begin + Result := inherited Add(nil, nil); + Used.Size := Result + 1; + end; + Used[Result] := True; +end; + +function TGlyphList.AddMasked(Image: TBitmap; MaskColor: TColor): Integer; +begin + Result := AllocateIndex; + ReplaceMasked(Result, Image, MaskColor); + Inc(FCount); +end; + +procedure TGlyphList.Delete(Index: Integer); +begin + if Used[Index] then + begin + Dec(FCount); + Used[Index] := False; + end; +end; + +{ TGlyphCache } + +constructor TGlyphCache.Create; +begin + inherited Create; + GlyphLists := TList.Create; +end; + +destructor TGlyphCache.Destroy; +begin + GlyphLists.Free; + inherited Destroy; +end; + +function TGlyphCache.GetList(AWidth, AHeight: Integer): TGlyphList; +var + I: Integer; +begin + for I := GlyphLists.Count - 1 downto 0 do + begin + Result := GlyphLists[I]; + with Result do + if (AWidth = Width) and (AHeight = Height) then Exit; + end; + Result := TGlyphList.CreateSize(AWidth, AHeight); + GlyphLists.Add(Result); +end; + +procedure TGlyphCache.ReturnList(List: TGlyphList); +begin + if List = nil then Exit; + if List.Count = 0 then + begin + GlyphLists.Remove(List); + List.Free; + end; +end; + +function TGlyphCache.Empty: Boolean; +begin + Result := GlyphLists.Count = 0; +end; + +var + GlyphCache: TGlyphCache = nil; + Pattern: TBitmap = nil; + ButtonCount: Integer = 0; + +procedure CreateBrushPattern; +var + X, Y: Integer; +begin + Pattern := TBitmap.Create; + Pattern.Width := 8; + Pattern.Height := 8; + with Pattern.Canvas do + begin + Brush.Style := bsSolid; + Brush.Color := clBtnFace; + FillRect(Rect(0, 0, Pattern.Width, Pattern.Height)); + for Y := 0 to 7 do + for X := 0 to 7 do + if (Y mod 2) = (X mod 2) then { toggles between even/odd pixles } + Pixels[X, Y] := clBtnHighlight; { on even/odd rows } + end; +end; + + +{ TButtonGlyph } + +constructor TButtonGlyph.Create; +var + I: TButtonState; +begin + inherited Create; + FOriginal := TBitmap.Create; + FOriginal.OnChange := GlyphChanged; + FTransparentColor := clOlive; + FNumGlyphs := 1; + for I := Low(I) to High(I) do + FIndexs[I] := -1; + if GlyphCache = nil then GlyphCache := TGlyphCache.Create; +end; + +destructor TButtonGlyph.Destroy; +begin + FOriginal.Free; + Invalidate; + if Assigned(GlyphCache) and GlyphCache.Empty then + begin + GlyphCache.Free; + GlyphCache := nil; + end; + inherited Destroy; +end; + +procedure TButtonGlyph.Invalidate; +var + I: TButtonState; +begin + for I := Low(I) to High(I) do + begin + if FIndexs[I] <> -1 then FGlyphList.Delete(FIndexs[I]); + FIndexs[I] := -1; + end; + GlyphCache.ReturnList(FGlyphList); + FGlyphList := nil; +end; + +procedure TButtonGlyph.GlyphChanged(Sender: TObject); +begin + if Sender = FOriginal then + begin + FTransparentColor := FOriginal.TransparentColor; + Invalidate; + if Assigned(FOnChange) then FOnChange(Self); + end; +end; + +procedure TButtonGlyph.SetGlyph(Value: TBitmap); +var + Glyphs: Integer; +begin + Invalidate; + FOriginal.Assign(Value); + if (Value <> nil) and (Value.Height > 0) then + begin + FTransparentColor := Value.TransparentColor; + if Value.Width mod Value.Height = 0 then + begin + Glyphs := Value.Width div Value.Height; + if Glyphs > 4 then Glyphs := 1; + SetNumGlyphs(Glyphs); + end; + end; +end; + +procedure TButtonGlyph.SetNumGlyphs(Value: TNumGlyphs); +begin + if (Value <> FNumGlyphs) and (Value > 0) then + begin + Invalidate; + FNumGlyphs := Value; + GlyphChanged(Glyph); + end; +end; + +function TButtonGlyph.CreateButtonGlyph(State: TButtonState): Integer; +const + ROP_DSPDxax = $00E20746; +var + TmpImage, DDB, MonoBmp: TBitmap; + IWidth, IHeight: Integer; + IRect, ORect: TRect; + I: TButtonState; + DestDC: HDC; +begin + if (State = bsDown) and (NumGlyphs < 3) then State := bsUp; + Result := FIndexs[State]; + if Result <> -1 then Exit; + if (FOriginal.Width or FOriginal.Height) = 0 then Exit; + IWidth := FOriginal.Width div FNumGlyphs; + IHeight := FOriginal.Height; + if FGlyphList = nil then + begin + if GlyphCache = nil then GlyphCache := TGlyphCache.Create; + FGlyphList := GlyphCache.GetList(IWidth, IHeight); + end; + TmpImage := TBitmap.Create; + try + TmpImage.Width := IWidth; + TmpImage.Height := IHeight; + IRect := Rect(0, 0, IWidth, IHeight); + TmpImage.Canvas.Brush.Color := clBtnFace; + TmpImage.Palette := CopyPalette(FOriginal.Palette); + I := State; + if Ord(I) >= NumGlyphs then I := bsUp; + ORect := Rect(Ord(I) * IWidth, 0, (Ord(I) + 1) * IWidth, IHeight); + case State of + bsUp, bsDown, + bsExclusive: + begin + TmpImage.Canvas.CopyRect(IRect, FOriginal.Canvas, ORect); + if FOriginal.TransparentMode = tmFixed then + FIndexs[State] := FGlyphList.AddMasked(TmpImage, FTransparentColor) + else + FIndexs[State] := FGlyphList.AddMasked(TmpImage, clDefault); + end; + bsDisabled: + begin + MonoBmp := nil; + DDB := nil; + try + MonoBmp := TBitmap.Create; + DDB := TBitmap.Create; + DDB.Assign(FOriginal); + DDB.HandleType := bmDDB; + if NumGlyphs > 1 then + with TmpImage.Canvas do + begin { Change white & gray to clBtnHighlight and clBtnShadow } + CopyRect(IRect, DDB.Canvas, ORect); + MonoBmp.Monochrome := True; + MonoBmp.Width := IWidth; + MonoBmp.Height := IHeight; + + { Convert white to clBtnHighlight } + DDB.Canvas.Brush.Color := clWhite; + MonoBmp.Canvas.CopyRect(IRect, DDB.Canvas, ORect); + Brush.Color := clBtnHighlight; + DestDC := Handle; + SetTextColor(DestDC, clBlack); + SetBkColor(DestDC, clWhite); + BitBlt(DestDC, 0, 0, IWidth, IHeight, + MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax); + + { Convert gray to clBtnShadow } + DDB.Canvas.Brush.Color := clGray; + MonoBmp.Canvas.CopyRect(IRect, DDB.Canvas, ORect); + Brush.Color := clBtnShadow; + DestDC := Handle; + SetTextColor(DestDC, clBlack); + SetBkColor(DestDC, clWhite); + BitBlt(DestDC, 0, 0, IWidth, IHeight, + MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax); + + { Convert transparent color to clBtnFace } + DDB.Canvas.Brush.Color := ColorToRGB(FTransparentColor); + MonoBmp.Canvas.CopyRect(IRect, DDB.Canvas, ORect); + Brush.Color := clBtnFace; + DestDC := Handle; + SetTextColor(DestDC, clBlack); + SetBkColor(DestDC, clWhite); + BitBlt(DestDC, 0, 0, IWidth, IHeight, + MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax); + end + else + begin + { Create a disabled version } + with MonoBmp do + begin + Assign(FOriginal); + HandleType := bmDDB; + Canvas.Brush.Color := clBlack; + Width := IWidth; + if Monochrome then + begin + Canvas.Font.Color := clWhite; + Monochrome := False; + Canvas.Brush.Color := clWhite; + end; + Monochrome := True; + end; + with TmpImage.Canvas do + begin + Brush.Color := clBtnFace; + FillRect(IRect); + Brush.Color := clBtnHighlight; + SetTextColor(Handle, clBlack); + SetBkColor(Handle, clWhite); + BitBlt(Handle, 1, 1, IWidth, IHeight, + MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax); + Brush.Color := clBtnShadow; + SetTextColor(Handle, clBlack); + SetBkColor(Handle, clWhite); + BitBlt(Handle, 0, 0, IWidth, IHeight, + MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax); + end; + end; + finally + DDB.Free; + MonoBmp.Free; + end; + FIndexs[State] := FGlyphList.AddMasked(TmpImage, clDefault); + end; + end; + finally + TmpImage.Free; + end; + Result := FIndexs[State]; + FOriginal.Dormant; +end; + +procedure TButtonGlyph.DrawButtonGlyph(Canvas: TCanvas; const GlyphPos: TPoint; + State: TButtonState; Transparent: Boolean); +var + Index: Integer; +begin + if FOriginal = nil then Exit; + if (FOriginal.Width = 0) or (FOriginal.Height = 0) then Exit; + Index := CreateButtonGlyph(State); + with GlyphPos do + if Transparent or (State = bsExclusive) then + ImageList_DrawEx(FGlyphList.Handle, Index, Canvas.Handle, X, Y, 0, 0, + clNone, clNone, ILD_Transparent) + else + ImageList_DrawEx(FGlyphList.Handle, Index, Canvas.Handle, X, Y, 0, 0, + clNone, clNone, ILD_Transparent); +end; + +procedure TButtonGlyph.DrawButtonText(Canvas: TCanvas; const Caption: string; + TextBounds: TRect; State: TButtonState); +begin + with Canvas do + begin + Brush.Style := bsClear; + if State = bsDisabled then + begin + OffsetRect(TextBounds, 1, 1); + Font.Color := clBtnHighlight; + DrawText(Handle, PChar(Caption), Length(Caption), TextBounds, 0); + OffsetRect(TextBounds, -1, -1); + Font.Color := clBtnShadow; + DrawText(Handle, PChar(Caption), Length(Caption), TextBounds, 0); + end else + DrawText(Handle, PChar(Caption), Length(Caption), TextBounds, + DT_CENTER or DT_VCENTER or DT_SINGLELINE); + end; +end; + +procedure TButtonGlyph.CalcButtonLayout(Canvas: TCanvas; const Client: TRect; + const Offset: TPoint; const Caption: string; Layout: TButtonLayout; Margin, + Spacing: Integer; var GlyphPos: TPoint; var TextBounds: TRect); +var + TextPos: TPoint; + ClientSize, GlyphSize, TextSize: TPoint; + TotalSize: TPoint; +begin + { calculate the item sizes } + ClientSize := Point(Client.Right - Client.Left, Client.Bottom - + Client.Top); + + if FOriginal <> nil then + GlyphSize := Point(FOriginal.Width div FNumGlyphs, FOriginal.Height) else + GlyphSize := Point(0, 0); + + if Length(Caption) > 0 then + begin + TextBounds := Rect(0, 0, Client.Right - Client.Left, 0); + DrawText(Canvas.Handle, PChar(Caption), Length(Caption), TextBounds, DT_CALCRECT); + TextSize := Point(TextBounds.Right - TextBounds.Left, TextBounds.Bottom - + TextBounds.Top); + end + else + begin + TextBounds := Rect(0, 0, 0, 0); + TextSize := Point(0,0); + end; + + if Layout in [blGlyphLeft, blGlyphRight] then + begin + GlyphPos.Y := 0; + TextPos.Y := (ClientSize.Y - TextSize.Y + 1) div 2; + end + else + begin + GlyphPos.X := 0; + TextPos.X := (ClientSize.X - TextSize.X + 1) div 2; + end; + + { if there is no text or no bitmap, then Spacing is irrelevant } + if (TextSize.X = 0) or (GlyphSize.X = 0) then + Spacing := 0; + + { adjust Margin and Spacing } + if Margin = -1 then + begin + if Spacing = -1 then + begin + TotalSize := Point(GlyphSize.X + TextSize.X, GlyphSize.Y + TextSize.Y); + if Layout in [blGlyphLeft, blGlyphRight] then + Margin := (ClientSize.X - TotalSize.X) div 3 + else + Margin := (ClientSize.Y - TotalSize.Y) div 3; + Spacing := Margin; + end + else + begin + TotalSize := Point(GlyphSize.X + Spacing + TextSize.X, GlyphSize.Y + + Spacing + TextSize.Y); + if Layout in [blGlyphLeft, blGlyphRight] then + Margin := (ClientSize.X - TotalSize.X + 1) div 2 + else + Margin := (ClientSize.Y - TotalSize.Y + 1) div 2; + end; + end + else + begin + if Spacing = -1 then + begin + TotalSize := Point(ClientSize.X - (Margin + GlyphSize.X), ClientSize.Y - + (Margin + GlyphSize.Y)); + if Layout in [blGlyphLeft, blGlyphRight] then + Spacing := (TotalSize.X - TextSize.X) div 2 + else + Spacing := (TotalSize.Y - TextSize.Y) div 2; + end; + end; + + case Layout of + blGlyphLeft: + begin + GlyphPos.X := Margin; + TextPos.X := GlyphPos.X + GlyphSize.X + Spacing; + end; + blGlyphRight: + begin + GlyphPos.X := ClientSize.X - Margin - GlyphSize.X; + TextPos.X := GlyphPos.X - Spacing - TextSize.X; + end; + blGlyphTop: + begin + GlyphPos.Y := Margin; + TextPos.Y := GlyphPos.Y + GlyphSize.Y + Spacing; + end; + blGlyphBottom: + begin + GlyphPos.Y := ClientSize.Y - Margin - GlyphSize.Y; + TextPos.Y := GlyphPos.Y - Spacing - TextSize.Y; + end; + end; + + { fixup the result variables } + with GlyphPos do + begin + Inc(X, Client.Left + Offset.X); + Inc(Y, Client.Top + Offset.Y); + end; + OffsetRect(TextBounds, TextPos.X + Client.Left + Offset.X, + TextPos.Y + Client.Top + Offset.X); +end; + +function TButtonGlyph.Draw(Canvas: TCanvas; const Client: TRect; + const Offset: TPoint; const Caption: string; Layout: TButtonLayout; + Margin, Spacing: Integer; State: TButtonState; Transparent: Boolean): TRect; +var + GlyphPos: TPoint; +begin + CalcButtonLayout(Canvas, Client, Offset, Caption, Layout, Margin, Spacing, + GlyphPos, Result); + DrawButtonGlyph(Canvas, GlyphPos, State, Transparent); + DrawButtonText(Canvas, Caption, Result, State); +end; + +{ TCoolButton } + +constructor TCoolButton.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + SetBounds(0, 0, 25, 25); + ControlStyle := [csCaptureMouse, csOpaque, csDoubleClicks]; + FGlyph := TButtonGlyph.Create; + TButtonGlyph(FGlyph).OnChange := GlyphChanged; + ParentFont := True; + FSpacing := 4; + FMargin := -1; + FLayout := blGlyphLeft; + Inc(ButtonCount); + numglyphs:=4; +end; + +destructor TCoolButton.Destroy; +begin + TButtonGlyph(FGlyph).Free; + Dec(ButtonCount); + if ButtonCount = 0 then + begin + Pattern.Free; + Pattern := nil; + end; + inherited Destroy; +end; + +procedure TCoolButton.Paint; +const + DownStyles: array[Boolean] of Integer = (BDR_RAISEDINNER, BDR_SUNKENOUTER); + FillStyles: array[Boolean] of Integer = (0, 0); +var + PaintRect: TRect; + Offset: TPoint; +begin +{ if not Enabled then + begin + FState := bsDisabled; + FDragging := False; + end + else if FState = bsDisabled then + begin + if FDown and (GroupIndex <> 0) then + FState := bsExclusive + else + FState := bsUp; + end else + if FState<>bsDown then if FMouseIncontrol then FState:=bsExclusive else FState:=bsUp; + } + if Enabled then + begin + if FMouseInControl then + begin + if FState<>bsDown then FState:=bsExclusive; + end else Fstate:=bsUp; + end else FState:=bsDisabled; + Canvas.Font := Self.Font; + PaintRect := Rect(0, 0, Width, Height); + if (FState in [bsDown, bsExclusive]) or + (FMouseInControl and (FState <> bsDisabled)) or + (csDesigning in ComponentState) then + if csDesigning in ComponentState then DrawEdge(Canvas.Handle, PaintRect, DownStyles[FState in [bsDown, bsExclusive]], + FillStyles[true] or BF_RECT); +if FState in [bsDown, bsExclusive] then + begin + if (FState = bsExclusive) and (not FMouseInControl) then + begin +// if Pattern = nil then CreateBrushPattern; +// Canvas.Brush.Bitmap := Pattern; +// Canvas.FillRect(PaintRect); + end; + Offset.X := 0; + Offset.Y := 0; + end + else + begin + Offset.X := 0; + Offset.Y := 0; + end; + TButtonGlyph(FGlyph).Draw(Canvas, PaintRect, Offset, Caption, FLayout, FMargin, + FSpacing, FState,true); +end; + +procedure TCoolButton.UpdateTracking; +var + P: TPoint; +begin +if Enabled then + begin + GetCursorPos(P); + FMouseInControl := not (FindDragTarget(P, True) = Self); + if FMouseInControl then + Perform(CM_MOUSELEAVE, 0, 0); + end; +end; + +procedure TCoolButton.Loaded; +var + State: TButtonState; +begin + inherited Loaded; + if Enabled then + State := bsUp + else + State := bsDisabled; + TButtonGlyph(FGlyph).CreateButtonGlyph(State); +end; + +procedure TCoolButton.MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + inherited MouseDown(Button, Shift, X, Y); + if (Button = mbLeft) and Enabled then + begin + if not FDown then + begin + FState := bsDown; + Invalidate; + end; + FDragging := True; + end; +end; + +procedure TCoolButton.MouseMove(Shift: TShiftState; X, Y: Integer); +var + NewState : TButtonState; + P, P2 : TPoint; + OldState : Boolean; + +begin + OldState := FMouseInControl; + GetCursorPos(P); + P2 := ScreenToClient (P); + FMouseInControl := (TButtonGlyph(FGlyph).Glyph.Canvas.Pixels[P2.x, P2.y] <> TButtonGlyph(FGlyph).Glyph.Canvas.Pixels[0, Glyph.Height - 1]) and + (P2.X < Glyph.Width) and (P2.Y < Glyph.Height) and (FindDragTarget(P, True) = Self); + inherited MouseMove(Shift, X, Y); + if FDragging then + begin + if not FDown then NewState := bsUp + else NewState := bsExclusive; + if (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight) then + if FDown then NewState := bsExclusive else NewState := bsDown; + if (NewState <> FState) then + begin + FState := NewState; + end; + end; + If (OldState <> FMouseInControl) then Invalidate; +end; + +procedure TCoolButton.MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +var + DoClick: Boolean; +begin + inherited MouseUp(Button, Shift, X, Y); + if FDragging then + begin + FDragging := False; + DoClick := (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight); + if FGroupIndex = 0 then + begin + { Redraw face in-case mouse is captured } + FState := bsUp; + FMouseInControl := False; + if DoClick and not (FState in [bsExclusive, bsDown]) then + Invalidate; + end + else + if DoClick then + begin + SetDown(not FDown); + if FDown then Repaint; + end + else + begin + if FDown then FState := bsExclusive; + Repaint; + end; + if DoClick then Click; + UpdateTracking; + end; +end; + +procedure TCoolButton.Click; +begin + inherited Click; +end; + +function TCoolButton.GetPalette: HPALETTE; +begin + Result := Glyph.Palette; +end; + +function TCoolButton.GetGlyph: TBitmap; +begin + Result := TButtonGlyph(FGlyph).Glyph; +end; + +procedure TCoolButton.SetGlyph(Value: TBitmap); +begin + TButtonGlyph(FGlyph).Glyph := Value; + Invalidate; +end; + +function TCoolButton.GetNumGlyphs: TNumGlyphs; +begin + Result := TButtonGlyph(FGlyph).NumGlyphs; +end; + +procedure TCoolButton.SetNumGlyphs(Value: TNumGlyphs); +begin + if Value < 0 then Value := 1 + else if Value > 4 then Value := 4; + if Value <> TButtonGlyph(FGlyph).NumGlyphs then + begin + TButtonGlyph(FGlyph).NumGlyphs := Value; + Invalidate; + end; +end; + +procedure TCoolButton.GlyphChanged(Sender: TObject); +begin + Invalidate; +end; + +procedure TCoolButton.UpdateExclusive; +var + Msg: TMessage; +begin + if (FGroupIndex <> 0) and (Parent <> nil) then + begin + Msg.Msg := CM_BUTTONPRESSED; + Msg.WParam := FGroupIndex; + Msg.LParam := Longint(Self); + Msg.Result := 0; + Parent.Broadcast(Msg); + end; +end; + +procedure TCoolButton.SetDown(Value: Boolean); +begin + if FGroupIndex = 0 then Value := False; + if Value <> FDown then + begin + if FDown and (not FAllowAllUp) then Exit; + FDown := Value; + if Value then + begin + if FState = bsUp then Invalidate; + FState := bsExclusive + end + else + begin + FState := bsUp; + Repaint; + end; + if Value then UpdateExclusive; + end; +end; + +procedure TCoolButton.SetGroupIndex(Value: Integer); +begin + if FGroupIndex <> Value then + begin + FGroupIndex := Value; + UpdateExclusive; + end; +end; + +procedure TCoolButton.SetLayout(Value: TButtonLayout); +begin + if FLayout <> Value then + begin + FLayout := Value; + Invalidate; + end; +end; + +procedure TCoolButton.SetMargin(Value: Integer); +begin + if (Value <> FMargin) and (Value >= -1) then + begin + FMargin := Value; + Invalidate; + end; +end; + +procedure TCoolButton.SetSpacing(Value: Integer); +begin + if Value <> FSpacing then + begin + FSpacing := Value; + Invalidate; + end; +end; + +procedure TCoolButton.SetAllowAllUp(Value: Boolean); +begin + if FAllowAllUp <> Value then + begin + FAllowAllUp := Value; + UpdateExclusive; + end; +end; + +procedure TCoolButton.WMLButtonDblClk(var Message: TWMLButtonDown); +begin + inherited; + if FDown then DblClick; +end; + +procedure TCoolButton.CMEnabledChanged(var Message: TMessage); +const + NewState: array[Boolean] of TButtonState = (bsDisabled, bsUp); +begin + TButtonGlyph(FGlyph).CreateButtonGlyph(NewState[Enabled]); + UpdateTracking; + Repaint; +end; + +procedure TCoolButton.CMButtonPressed(var Message: TMessage); +var + Sender: TCoolButton; +begin + if Message.WParam = FGroupIndex then + begin + Sender := TCoolButton(Message.LParam); + if Sender <> Self then + begin + if Sender.Down and FDown then + begin + FDown := False; + FState := bsUp; + Invalidate; + end; + FAllowAllUp := Sender.AllowAllUp; + end; + end; +end; + +procedure TCoolButton.CMDialogChar(var Message: TCMDialogChar); +begin + with Message do + if IsAccel(CharCode, Caption) and Enabled then + begin + Click; + Result := 1; + end else + inherited; +end; + +procedure TCoolButton.CMFontChanged(var Message: TMessage); +begin + Invalidate; +end; + +procedure TCoolButton.CMTextChanged(var Message: TMessage); +begin + Invalidate; +end; + +procedure TCoolButton.CMSysColorChange(var Message: TMessage); +begin + with TButtonGlyph(FGlyph) do + begin + Invalidate; + CreateButtonGlyph(FState); + end; +end; + +procedure TCoolButton.WMEraseBkgnd( var message:TWMEraseBkgnd); +begin + message.Result:=0; +end; + + + +procedure TCoolButton.CMMouseLeave(var Message: TMessage); +begin + inherited; + if FMouseInControl and Enabled and not FDragging then + begin + FMouseInControl := False; + Invalidate; + end; +end; + +procedure TCoolButton.WMPaint( var message:TWMPaint); +begin + Paint; + message.Result:=0; +end; +procedure TCoolButton.WMNCPaint( var message:TWMNCPaint); +begin + Paint; + message.Result:=0; +end; + + +end. diff --git a/CDopping/CoolForm/CoolForm.OBJ b/CDopping/CoolForm/CoolForm.OBJ new file mode 100644 index 0000000..f0996bb Binary files /dev/null and b/CDopping/CoolForm/CoolForm.OBJ differ diff --git a/CDopping/CoolForm/CoolForm.dcu b/CDopping/CoolForm/CoolForm.dcu new file mode 100644 index 0000000..875085e Binary files /dev/null and b/CDopping/CoolForm/CoolForm.dcu differ diff --git a/CDopping/CoolForm/CoolForm.hpp b/CDopping/CoolForm/CoolForm.hpp new file mode 100644 index 0000000..9400adf --- /dev/null +++ b/CDopping/CoolForm/CoolForm.hpp @@ -0,0 +1,96 @@ +// Borland C++ Builder +// Copyright (c) 1995, 1998 by Borland International +// All rights reserved + +// (DO NOT EDIT: machine generated header) 'CoolForm.pas' rev: 3.00 + +#ifndef CoolFormHPP +#define CoolFormHPP +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +//-- user supplied ----------------------------------------------------------- + +namespace Coolform +{ +//-- type declarations ------------------------------------------------------- +class DELPHICLASS TRegionType; +class DELPHICLASS TCoolForm; +class PASCALIMPLEMENTATION TCoolForm : public Extctrls::TImage +{ + typedef Extctrls::TImage inherited; + +private: + TRegionType* Fregion; + _RGNDATA *FOrgRgn; + int FOrgSize; + TRegionType* Dummy; + bool FDraggable; + HIDESBASE void __fastcall PictureChanged(System::TObject* Sender); + void __fastcall ReadMask(Classes::TStream* Reader); + void __fastcall WriteMask(Classes::TStream* Writer); + DYNAMIC void __fastcall MouseDown(Controls::TMouseButton Button, Classes::TShiftState Shift, int X, + int Y); + virtual void __fastcall DefineProperties(Classes::TFiler* Filer); + MESSAGE void __fastcall WMEraseBkgnd(Messages::TWMEraseBkgnd &Message); + +protected: + void __fastcall SetRegion(TRegionType* Value); + virtual void __fastcall SetParent(Controls::TWinControl* Value); + HIDESBASE virtual void __fastcall SetTop(int Value); + HIDESBASE virtual void __fastcall SetLeft(int Value); + HIDESBASE virtual void __fastcall Setwidth(int Value); + HIDESBASE virtual void __fastcall SetHeight(int Value); + TRegionType* __fastcall GetRegion(void); + void __fastcall size(void); + +public: + __fastcall virtual TCoolForm(Classes::TComponent* Aowner); + __fastcall virtual ~TCoolForm(void); + __property TRegionType* Mask2 = {read=Dummy, write=Dummy}; + bool __fastcall LoadMaskFromFile(System::AnsiString FileName); + void __fastcall RefreshRegion(void); + +__published: + __property TRegionType* Mask = {read=GetRegion, write=SetRegion}; + __property bool Draggable = {read=FDraggable, write=FDraggable, default=1}; + __property int top = {write=SetTop}; + __property int left = {write=SetLeft}; + __property int width = {write=Setwidth}; + __property int height = {write=SetHeight}; +}; + +class PASCALIMPLEMENTATION TRegionType : public Classes::TPersistent +{ + typedef Classes::TPersistent inherited; + +public: + HRGN Fregion; + TCoolForm* owner; +public: + /* TPersistent.Destroy */ __fastcall virtual ~TRegionType(void) { } + +public: + /* TObject.Create */ __fastcall TRegionType(void) : Classes::TPersistent() { } + +}; + +//-- var, const, procedure --------------------------------------------------- +extern PACKAGE void __fastcall Register(void); + +} /* namespace Coolform */ +#if !defined(NO_IMPLICIT_NAMESPACE_USE) +using namespace Coolform; +#endif +//-- end unit ---------------------------------------------------------------- +#endif // CoolForm diff --git a/CDopping/CoolForm/CoolForm.pas b/CDopping/CoolForm/CoolForm.pas new file mode 100644 index 0000000..7232026 --- /dev/null +++ b/CDopping/CoolForm/CoolForm.pas @@ -0,0 +1,314 @@ +unit CoolForm; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + ExtCtrls ,dsgnintf; + +type + TCoolForm = class; + + TRegionType = class(TPersistent) + public + Fregion:hrgn; + owner:TCoolForm; + end; + + TCoolForm = class(TImage) + private + Fregion : TRegionType; + FOrgRgn : PRgnData; + FOrgSize : Integer; + // the dummy is necessary (or maybe not) as a public property for the writing of the + // mask into a stream (btter leyve it as it is, never touch a running system) + Dummy:TRegionType; + FDraggable:boolean; + procedure PictureChanged(Sender:TObject); + procedure ReadMask(Reader: TStream); + procedure WriteMask(Writer: TStream); + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);override; + procedure DefineProperties(Filer: TFiler);override; + procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND; + protected + procedure SetRegion(Value:TRegionType); + procedure SetParent(Value:TWinControl); override; + procedure SetTop(Value:integer); virtual; + procedure SetLeft(Value:integer); virtual; + procedure Setwidth(Value:integer); virtual; + procedure SetHeight(Value:integer); virtual; + function GetRegion:TRegionType; + procedure size; + public + constructor Create(Aowner:TComponent); override; + destructor Destroy; override; + property Mask2:TRegionType read Dummy write Dummy; + function LoadMaskFromFile (FileName: String): Boolean; + procedure RefreshRegion; + published + property Mask:TRegionType read GetRegion write SetRegion; + property Draggable:boolean read FDraggable write FDraggable default true; + property top write settop; + property left write setleft; + property width write setwidth; + property height write setheight; + end; + +procedure Register; + +implementation +uses + MaskEditor; + +procedure Register; +begin + RegisterComponents ('Cool!', [TCoolForm]); + RegisterPropertyEditor (TypeInfo(TRegionType), TCoolForm, 'Mask', TCoolMaskEditor); +end; + + +// The next two procedures are there to ensure hat the component always sits in the top left edge of the window +procedure TCoolForm.SetTop(Value:integer); +begin + inherited top := 0; +end; + +procedure TCoolForm.SetLeft(Value:integer); +begin + inherited left := 0; +end; + +procedure TCoolForm.RefreshRegion; +begin + FRegion.FRegion := ExtCreateRegion (nil, FOrgSize, FOrgRgn^); + SetWindowRgn (parent.handle, FRegion.Fregion, true); +end; + + + +destructor TCoolForm.destroy; +begin + If FOrgRgn <> Nil then + FreeMem (FOrgRgn, FOrgSize); + + if fregion.fregion <> 0 then deleteobject (fregion.fregion); + Dummy.Free; + FRegion.free; + inherited; +end; + +constructor TCoolForm.create(Aowner:TComponent); +begin + inherited; + // make it occupy all of the form + Align := alClient; + Fregion := TRegionType.Create; + Dummy := TRegionType.Create; + Fregion.Fregion := 0; + Fregion.owner := self; + Picture.OnChange := PictureChanged; + // if draggable is false, it will be overwritten later by delphi`s runtime component loader + Draggable := true; +end; + +procedure TCoolForm.PictureChanged(Sender:TObject); +begin + if (parent <> nil) and (picture.bitmap <> nil) then + begin + // resize the form to fit the bitmap +{ width:=picture.bitmap.Width; + height:=picture.bitmap.height; + parent.clientwidth:=picture.bitmap.Width; + parent.clientheight:=picture.bitmap.height; +} end; + if Fregion.FRegion<>0 then + begin + // if somehow there`s a region already, delete it + deleteObject (FRegion.FRegion); + FRegion.Fregion := 0; + end; +end; + +function TCoolForm.GetRegion:TRegionType; +begin + result := FRegion; +end; + +procedure TCoolForm.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + // if dragging is on, start the dragging process + If button = mbleft then + begin + releasecapture; + TWincontrol (Parent).perform (WM_syscommand, $F012, 0); + end; +end; + +// This is used by delphi`s component streaming system +// it is called whenever delphi reads the componnt from the .dfm +procedure TCoolForm.ReadMask(Reader: TStream); +begin + // read the size of the region data to come + reader.read (FOrgSize, 4); + if FOrgSize <> 0 then + begin + // if we have region data, allocate memory for it + getmem (FOrgRgn, FOrgSize); + // read the data + reader.read (FOrgRgn^, FOrgSize); + // create the region + FRegion.FRegion := ExtCreateRegion (nil, FOrgSize, FOrgRgn^); + if not (csDesigning in ComponentState) and (FRegion.FRegion <> 0) then + SetWindowRgn (parent.handle, FRegion.Fregion, true); + // dispose of the memory + end else fregion.fregion := 0; +end; + + +// This is pretty much the same stuff as above. Only it`s written this time +procedure TCoolForm.WriteMask(Writer: TStream); +var + size : integer; + rgndata : pRGNData; + +begin + if (fregion.fregion<>0) then + begin + // get the region data`s size + size:=getregiondata (FRegion.FRegion, 0, nil); + getmem (rgndata,size); + // get the data itself + getregiondata (FRegion.FRegion, size, rgndata); + // write it + writer.write (size,sizeof (size)); + writer.write (rgndata^, size); + freemem (rgndata, size); + end else + begin + // if there`s no region yet (from the mask editor), then write a size of zero + size := 0; + writer.write (size, sizeof (size)); + end; +end; + + +// This tells Delphi to read the public property `Mask 2` from the stream, +// That`s what we need the dummy for. +procedure TCoolForm.DefineProperties(Filer: TFiler); +begin + inherited DefineProperties(Filer); + // tell Delphi which methods to call when reading the property data from the stream + Filer.DefineBinaryProperty ('Mask2', ReadMask, WriteMask, true); +end; + + + +procedure TCoolForm.SetRegion(Value:TRegionType); +begin + if Value <> nil then + begin + FRegion := Value; + // The owner is for the property editor to find the component + FRegion.owner := self; + end; +end; + + +procedure TCoolForm.SetParent(Value:TWinControl); +begin + inherited; + if Value <> nil then + if not (Value is TWinControl) then + begin + raise Exception.Create ('Drop the CoolForm on a FORM!'); + end else + with TWincontrol (Value) do + begin + if Value is TForm then TForm (Value).borderstyle := bsNone; + end; + top := 0; + left := 0; +end; + +procedure TCoolForm.WMEraseBkgnd(var Message: TWMEraseBkgnd); +begin + message.Result := 1; +end; + +function TCoolForm.LoadMaskFromFile (FileName: String): Boolean; +var + reader : TFileStream; + +begin + // read the size of the region data to come + + try + reader := TFileStream.Create (FileName, fmOpenRead); + reader.read (FOrgSize, 4); + if FOrgSize <> 0 then + begin + If ForgRgn <> Nil then + FreeMem (FOrgRgn, FOrgSize); + // if we have region data, allocate memory for it + getmem(FOrgRgn, FOrgSize); + // read the data + reader.read (FOrgRgn^, FOrgSize); + // create the region + FRegion.FRegion:=ExtCreateRegion(nil,FOrgSize,FOrgRgn^); + // if runtime, set the region for the window... Tadaaa + if not (csDesigning in ComponentState) and (FRegion.FRegion <> 0) then + begin + SetWindowRgn (parent.handle, FRegion.Fregion, true); + end; + // dispose of the memory + end else fregion.fregion := 0; + reader.free; + Result := True; + except + Result := False; + end; + +end; + +procedure TCoolForm.size; +var + size : integer; + rgndata : pRGNData; + xf : TXform; + +begin + if (fregion.fregion<>0) then + begin + // get the region data`s size + size := getregiondata (FRegion.FRegion, 0, nil); + getmem (rgndata, size); + // get the data itself + getregiondata (FRegion.FRegion, size, rgndata); + // write it + + xf.eM11 := 1;//Width / Picture.Bitmap.Width; + xf.eM12 := 0; + xf.eM21 := 0; + xf.eM22 := 1;//Height / Picture.Bitmap.Height; + xf.eDx := 0; + xf.eDy := 0; + FRegion.FRegion := ExtCreateRegion (nil, size, rgndata^); + + if not (csDesigning in ComponentState) and (FRegion.FRegion <> 0) then + SetWindowRgn (parent.handle, FRegion.Fregion, true); + end; +end; + +procedure TCoolForm.Setwidth(Value:integer); +begin + inherited Width := Value; +// Size; +end; + +procedure TCoolForm.SetHeight(Value:integer); +begin + inherited Height := Value; +// Size; +end; + +end. diff --git a/CDopping/CoolForm/CoolForm.rar b/CDopping/CoolForm/CoolForm.rar new file mode 100644 index 0000000..31485c0 Binary files /dev/null and b/CDopping/CoolForm/CoolForm.rar differ diff --git a/CDopping/CoolForm/MaskEditor.OBJ b/CDopping/CoolForm/MaskEditor.OBJ new file mode 100644 index 0000000..9a14f3a Binary files /dev/null and b/CDopping/CoolForm/MaskEditor.OBJ differ diff --git a/CDopping/CoolForm/MaskEditor.dcu b/CDopping/CoolForm/MaskEditor.dcu new file mode 100644 index 0000000..8cf7a8f Binary files /dev/null and b/CDopping/CoolForm/MaskEditor.dcu differ diff --git a/CDopping/CoolForm/MaskEditor.hpp b/CDopping/CoolForm/MaskEditor.hpp new file mode 100644 index 0000000..52b619d --- /dev/null +++ b/CDopping/CoolForm/MaskEditor.hpp @@ -0,0 +1,58 @@ +// Borland C++ Builder +// Copyright (c) 1995, 1998 by Borland International +// All rights reserved + +// (DO NOT EDIT: machine generated header) 'MaskEditor.pas' rev: 3.00 + +#ifndef MaskEditorHPP +#define MaskEditorHPP +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +//-- user supplied ----------------------------------------------------------- + +namespace Maskeditor +{ +//-- type declarations ------------------------------------------------------- +class DELPHICLASS TCoolMaskEditor; +class PASCALIMPLEMENTATION TCoolMaskEditor : public Dsgnintf::TPropertyEditor +{ + typedef Dsgnintf::TPropertyEditor inherited; + +private: + System::AnsiString FValue; + +public: + __fastcall virtual ~TCoolMaskEditor(void); + virtual void __fastcall Edit(void); + virtual Dsgnintf::TPropertyAttributes __fastcall GetAttributes(void); + virtual System::AnsiString __fastcall getname(); + virtual System::AnsiString __fastcall getValue(); + +__published: + __property System::AnsiString Value = {read=FValue, write=FValue}; +public: + /* TObject.Create */ __fastcall TCoolMaskEditor(void) : Dsgnintf::TPropertyEditor() { } + +}; + +//-- var, const, procedure --------------------------------------------------- +extern PACKAGE bool FormCreated; + +} /* namespace Maskeditor */ +#if !defined(NO_IMPLICIT_NAMESPACE_USE) +using namespace Maskeditor; +#endif +//-- end unit ---------------------------------------------------------------- +#endif // MaskEditor diff --git a/CDopping/CoolForm/MaskEditor.pas b/CDopping/CoolForm/MaskEditor.pas new file mode 100644 index 0000000..07ff24a --- /dev/null +++ b/CDopping/CoolForm/MaskEditor.pas @@ -0,0 +1,90 @@ +unit MaskEditor; + +interface +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + ExtCtrls, maskgenerator, dsgnintf; + + +type + TCoolMaskEditor = class(TPropertyEditor) + private + FValue:string; + public + destructor destroy;override; + procedure Edit;override; + function GetAttributes: TPropertyAttributes;override; + function getname:string; override; + function getValue:string; override; + published + property Value:string read FValue write FValue; + end; + +var + FormCreated:boolean=false; + +implementation + +uses + CoolForm; + +function TCoolMaskEditor.getname:string; +begin + result:='Mask'; +end; + + +function TCoolMaskEditor.getValue:string; +begin + result:='Mask'; +end; + + + +destructor TCoolMaskEditor.Destroy; +begin + if Formmaskgenerator<>nil then + begin + FormMaskGenerator.Free; + FormMaskGenerator:=nil; + FormCreated:=false; + end; + inherited; +end; + +function TCoolMaskEditor.GetAttributes: TPropertyAttributes; +begin + // Make Delphi display the (...) button in the objectinspector + Result := [paDialog]; +end; + + +procedure TCoolMaskEditor.Edit; +//******************* Unknown ************************* +begin + // Create the maskeditorform if it doesn`t exist yet + if not assigned(FormMaskGenerator) then + begin + formMaskGenerator:=TFormMaskGenerator.Create(nil); + formMaskGenerator.OriginalRegionData:=nil; + formMaskGenerator.SaveOriginalRegionData; + FormCreated:=true; + end; + with formMaskGenerator do + begin + // Set the existing mask in the editor + formMaskGenerator.Rgn1:=hrgn(TRegionType(GetOrdValue).Fregion); + // copy the bitmap into the editor + Image1.picture.bitmap.Assign(TRegionType(GetOrdValue).owner.picture.bitmap); + opendialog1.filename:=''; + Showmodal; + // get the new region from the editor + hrgn(TRegionType(GetOrdValue).Fregion):=formMaskGenerator.Rgn1; + // note: the editorform must not be freed here + // if done, delphi eats lines of the sourcecode of the form in which coolform is used + // (every line where a visible component is defined) ... rather strange + end; +end; + + +end. diff --git a/CDopping/CoolForm/ReadMe.txt b/CDopping/CoolForm/ReadMe.txt new file mode 100644 index 0000000..8965265 --- /dev/null +++ b/CDopping/CoolForm/ReadMe.txt @@ -0,0 +1,133 @@ +CoolForm 1.5 component for Delphi 3 AND 4 + + +IMPORTANT + + You can download new versions directly at http://www.lawrenz.com/coolform/ + +VERY IMPORTANT!!!!!!!!!!!! +As we haven't received ANY beer yet, we would strongly advise you to get in gear and send some brew. Or else! + + + + +New Features: + + 15.9.1998 + Coolform1.5 compatible with Delphi 4 + Included unit ExtMaskgenerator (see below) + Fixed several bugs + had to buy some beer + 14.9.1998 + got very thirsty + 13.9.1998 + got thirsty + 3.5.1998 + Added loading of masks at runtime. + Added 0.9 to the version number. + (That's what most of you've been asking for, ain't it?) + 2.5.1998 + Fixed the IDE Hangups when black is selected as transparent color + Replaced the OpenDialog with OpenPictureDialog + (Thanks, Garth!) + 1.3.1998 + CoolButton included + 25.2.1998 + Fixed the Access Violation Problem + Fixed the 'Canvas does not allow drawing' Problem + Improved the performance of the mask generator + + + +Authors: + + Tim Lawrenz + tim@lawrenz.com + + Max Muermann + muermann@stud.uni-frankfurt.de + + +Legal Notice: + + This component is BeerWare for personal use. No responsibilities taken whatsoever. + BeerWare means: + + 1) If you want to use this component for commercial use or + 2) if you want to use this component for personal use and think that this + component is worth to do it, + + you have to send us 20 bottles of beer (or the money for it) (or for german developers: + 'nen Kasten Bier). + + +Installation: + + From the Delphi IDE, choose Components/install packages from the menu, Select + 'Add' (or something like that, only german version available here). Find Component\Cool.dpl, + Click OK. There should be a new tab in the component palette named 'Cool'. + +Usage: + + ExtMaskgenerator + + The unit ExtMaskGenerator.pas contains one function: ExtGenerateMask(TBitmap, TColor, String); + You call the function with the bitmap you want to use as the mask, the color that will be transparent + and the filename where you want to store the mask data. You can then load the mask into a TCoolForm + with LoadMaskFromFile. + See XDollDemo.zip for some source and a nice picture. + + CoolForm 1.5 + + Just drop the CoolForm component directly on a Form. + Load a bitmap, just like with any TImage component. + Double-click the Mask property. (the cool-looking mask editor appears) + You can use the image you just loaded as a source for the mask, or you can load an + external bmp to use as mask source. + Clicking anywhere on the image selects the transparent color. This color is + shown in the upper right corner of the window. + The Ok-Button (checkmark) starts the mask generation (takes some time, no optimizations yet), + but you'll have to do it only once. + Compile and start your program and marvel at the wonders to behold. + If you want your form to be draggable, set the Draggable property to true, otherwise don't. + You can place any standard delphi component on the CoolForm, just bear in mind that components + outside the masked area don't show. We suggest using BitButtons with Flat set to true. + Look at the demo. + + + Runtime loading: In the maskeditor, hit the 'save mask' AFTER having created a mask (you'll have + to bring up the maskeditor twice, sorry). + In your application, call CoolForm1.LoadMaskFromFile (FileName); It will return true if successfull, + false if not. + + CoolButton 1.3 + + The TCoolButton component is a button derived from a standard delphi SpeedButton - only cooler. + The glyph *HAS* to contain four (4) equally sized bitmaps, of which the first describes the + button in normal state, the second is the disabled button, the third one contains the image + if the pressed button, the fourth one is displayed when the mouse cursor is over the button. + We're drunk, so don't blame us. + Oh, man, it's just a simple button! What do you want to know about it? + + + + +Future enhancements: + + If we don't receive some beer soon, there will be no more enhancements. Thats it. + +Bugreports: + + Please report any bugs you should encounter with a detailed + description (or even some source code) to any of the abovementioned EMail-addresses + +MailingList: + + Visit the Coolform Homepage for instructions on how to get on the mailinglist (we don't quite remember now). + + + + Have fun. + + + diff --git a/CDopping/CoolForm/TrMemo.dcu b/CDopping/CoolForm/TrMemo.dcu new file mode 100644 index 0000000..0b5f217 Binary files /dev/null and b/CDopping/CoolForm/TrMemo.dcu differ diff --git a/CDopping/CoolForm/TrMemo.pas b/CDopping/CoolForm/TrMemo.pas new file mode 100644 index 0000000..fd08a0b --- /dev/null +++ b/CDopping/CoolForm/TrMemo.pas @@ -0,0 +1,100 @@ +unit TrMemo; +{$R-} +interface +uses Messages, Controls, StdCtrls,classes; +const TMWM__SpecialInvalidate=WM_USER+1111; +type + TTransparentMemo = class(TMemo) + private + procedure SpecialInvalidate(var Message:TMessage); message +TMWM__SpecialInvalidate; + procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL; + procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL; + procedure WMSetText(var Message:TWMSetText); message WM_SETTEXT; + procedure CNCTLCOLOREDIT(var Message:TWMCTLCOLOREDIT); message +CN_CTLCOLOREDIT; + procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN; + procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND; + protected + procedure CreateParams(var Params: TCreateParams); override; + public +constructor Create(AOwner: TComponent); override; + end; +procedure Register; +implementation +uses Windows; +{ TTransparentMemo } +procedure TTransparentMemo.WMHScroll(var Message: TWMHScroll); +begin + inherited; + PostMessage(Handle,TMWM__SpecialInvalidate,0,0); +end; +procedure TTransparentMemo.WMVScroll(var Message: TWMVScroll); +begin + SendMessage(Handle,TMWM__SpecialInvalidate,0,0); + inherited; + PostMessage(Handle,TMWM__SpecialInvalidate,0,0); +end; +procedure TTransparentMemo.CNCTLCOLOREDIT(var Message:TWMCTLCOLOREDIT); +begin + with Message do + begin + SetBkMode(ChildDC,TRANSPARENT); + Result:=GetStockObject(HOLLOW_BRUSH) + end +end; +procedure TTransparentMemo.WMSetText(var Message:TWMSetText); +begin + inherited; + if not (csDesigning in ComponentState) then + PostMessage(Handle,TMWM__SpecialInvalidate,0,0) +end; +procedure TTransparentMemo.SpecialInvalidate(var Message:TMessage); +var r:TRect; +begin + if Parent<>nil then + begin + r:=ClientRect; + r.TopLeft:=Parent.ScreenToClient(ClientToScreen(r.TopLeft)); + r.BottomRight:=Parent.ScreenToClient(ClientToScreen(r.BottomRight)); + InvalidateRect(Parent.Handle,@r,true); + RedrawWindow(Handle,nil,0,RDW_FRAME+RDW_INVALIDATE) + end; +end; +procedure TTransparentMemo.WMKeyDown(var Message: TWMKeyDown); +begin + SendMessage(Handle,TMWM__SpecialInvalidate,0,0); + inherited; + PostMessage(Handle,TMWM__SpecialInvalidate,0,0); +end; +procedure TTransparentMemo.WMEraseBkgnd(var Message: TWMEraseBkgnd); +begin + Message.Result:=1 +end; + +constructor TTransparentMemo.Create(AOwner: TComponent); +begin +inherited; +ControlStyle:=[csCaptureMouse, csDesignInteractive, +csClickEvents, csSetCaption, csOpaque, csDoubleClicks, + csReplicatable, csNoStdEvents]; +end; + +procedure TTransparentMemo.CreateParams(var Params: TCreateParams); +begin + inherited CreateParams(Params); + with Params do + begin + ExStyle:=ExStyle or WS_EX_TRANSPARENT and not WS_EX_WINDOWEDGE + and not WS_EX_STATICEDGE and not WS_EX_DLGMODALFRAME and not + WS_EX_CLIENTEDGE; + end; +end; +procedure Register; +begin + RegisterComponents('cool!', [tTransparentMemo]); +end; +end. + + + diff --git a/CDopping/CoolForm/cool.dcp b/CDopping/CoolForm/cool.dcp new file mode 100644 index 0000000..069a5ac Binary files /dev/null and b/CDopping/CoolForm/cool.dcp differ diff --git a/CDopping/CoolForm/cool.dcu b/CDopping/CoolForm/cool.dcu new file mode 100644 index 0000000..b72e6cf Binary files /dev/null and b/CDopping/CoolForm/cool.dcu differ diff --git a/CDopping/CoolForm/cool.dpk b/CDopping/CoolForm/cool.dpk new file mode 100644 index 0000000..9644636 --- /dev/null +++ b/CDopping/CoolForm/cool.dpk @@ -0,0 +1,37 @@ +package cool; + +{$R *.RES} +{$ALIGN ON} +{$ASSERTIONS OFF} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$IMPLICITBUILD ON} + +requires + vcl30; + +contains + CoolButton, + CoolForm, + MaskEditor, + maskgenerator, + TrMemo; + +end. diff --git a/CDopping/CoolForm/cool.dpl b/CDopping/CoolForm/cool.dpl new file mode 100644 index 0000000..84de2e6 Binary files /dev/null and b/CDopping/CoolForm/cool.dpl differ diff --git a/CDopping/CoolForm/maskgenerator.OBJ b/CDopping/CoolForm/maskgenerator.OBJ new file mode 100644 index 0000000..fd41060 Binary files /dev/null and b/CDopping/CoolForm/maskgenerator.OBJ differ diff --git a/CDopping/CoolForm/maskgenerator.dcu b/CDopping/CoolForm/maskgenerator.dcu new file mode 100644 index 0000000..589454b Binary files /dev/null and b/CDopping/CoolForm/maskgenerator.dcu differ diff --git a/CDopping/CoolForm/maskgenerator.dfm b/CDopping/CoolForm/maskgenerator.dfm new file mode 100644 index 0000000..0d6b75c Binary files /dev/null and b/CDopping/CoolForm/maskgenerator.dfm differ diff --git a/CDopping/CoolForm/maskgenerator.hpp b/CDopping/CoolForm/maskgenerator.hpp new file mode 100644 index 0000000..8651f14 --- /dev/null +++ b/CDopping/CoolForm/maskgenerator.hpp @@ -0,0 +1,88 @@ +// Borland C++ Builder +// Copyright (c) 1995, 1998 by Borland International +// All rights reserved + +// (DO NOT EDIT: machine generated header) 'maskgenerator.pas' rev: 3.00 + +#ifndef maskgeneratorHPP +#define maskgeneratorHPP +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +//-- user supplied ----------------------------------------------------------- + +namespace Maskgenerator +{ +//-- type declarations ------------------------------------------------------- +class DELPHICLASS TFormMaskGenerator; +class PASCALIMPLEMENTATION TFormMaskGenerator : public Forms::TForm +{ + typedef Forms::TForm inherited; + +__published: + Buttons::TSpeedButton* SpeedButton1; + Buttons::TSpeedButton* SpeedButton2; + Buttons::TSpeedButton* SpeedButton3; + Extctrls::TPanel* Panel1; + Coolform::TCoolForm* CoolForm1; + Extctrls::TImage* Image1; + Extdlgs::TOpenPictureDialog* OpenDialog1; + Buttons::TSpeedButton* SpeedButton4; + Dialogs::TSaveDialog* SaveDialog1; + void __fastcall SpeedButton1Click(System::TObject* Sender); + void __fastcall SpeedButton2Click(System::TObject* Sender); + void __fastcall SpeedButton3Click(System::TObject* Sender); + void __fastcall Image1MouseMove(System::TObject* Sender, Classes::TShiftState Shift, int X, int Y); + + void __fastcall Image1MouseDown(System::TObject* Sender, Controls::TMouseButton Button, Classes::TShiftState + Shift, int X, int Y); + void __fastcall BitMapChange(System::TObject* Sender); + void __fastcall FormCreate(System::TObject* Sender); + void __fastcall SpeedButton4Click(System::TObject* Sender); + +private: + int oldleft; + int oldtop; + bool generating; + +public: + int OriginalRegionSize; + _RGNDATA *OriginalRegiondata; + HRGN rgn1; + void __fastcall SaveOriginalRegionData(void); + __fastcall virtual ~TFormMaskGenerator(void); +public: + /* TCustomForm.Create */ __fastcall virtual TFormMaskGenerator(Classes::TComponent* AOwner) : Forms:: + TForm(AOwner) { } + /* TCustomForm.CreateNew */ __fastcall TFormMaskGenerator(Classes::TComponent* AOwner, int Dummy) : + Forms::TForm(AOwner, Dummy) { } + +public: + /* TWinControl.CreateParented */ __fastcall TFormMaskGenerator(HWND ParentWindow) : Forms::TForm(ParentWindow + ) { } + +}; + +//-- var, const, procedure --------------------------------------------------- +extern PACKAGE TFormMaskGenerator* FormMaskGenerator; + +} /* namespace Maskgenerator */ +#if !defined(NO_IMPLICIT_NAMESPACE_USE) +using namespace Maskgenerator; +#endif +//-- end unit ---------------------------------------------------------------- +#endif // maskgenerator diff --git a/CDopping/CoolForm/maskgenerator.pas b/CDopping/CoolForm/maskgenerator.pas new file mode 100644 index 0000000..b5fa400 --- /dev/null +++ b/CDopping/CoolForm/maskgenerator.pas @@ -0,0 +1,261 @@ +unit maskgenerator; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, ComCtrls, Buttons, ExtCtrls, CoolForm, ExtDlgs; + +type + TFormMaskGenerator = class(TForm) + SpeedButton1: TSpeedButton; + SpeedButton2: TSpeedButton; + SpeedButton3: TSpeedButton; + Panel1: TPanel; + CoolForm1: TCoolForm; + Image1: TImage; + OpenDialog1: TOpenPictureDialog; + SpeedButton4: TSpeedButton; + SaveDialog1: TSaveDialog; + procedure SpeedButton1Click(Sender: TObject); + procedure SpeedButton2Click(Sender: TObject); + procedure SpeedButton3Click(Sender: TObject); + procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer); + procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer); + procedure BitMapChange(Sender:TObject); + procedure FormCreate(Sender: TObject); + procedure SpeedButton4Click(Sender: TObject); + private + oldleft,oldtop:integer; + generating:boolean; + public + OriginalRegionSize:integer; + OriginalRegiondata:pRGNData; + rgn1:hrgn; + procedure SaveOriginalRegionData; + destructor destroy; override; + end; + +var + FormMaskGenerator: TFormMaskGenerator; + + +implementation + +{$R *.DFM} + +procedure TFormMaskGenerator.SpeedButton1Click(Sender: TObject); +begin + if Opendialog1.Execute then image1.Picture.bitmap.LoadFromFile(opendialog1.filename); +end; + + +// This method is necessary to react to changes in the size of the bitmap +procedure TFormMaskGenerator.BitMapChange(Sender:TObject); +var + tr2,temprgn:hrgn; + x:pxform; +begin + if not generating then + begin + // This is the transformation matrix to be used in the region generating process + // will be used in future releases + x:=new(pxform); + x.eM11:=1; + x.eM12:=0; + x.eM21:=0; + x.eM22:=1; + x.eDx:=-oldleft; + x.eDy:=-oldtop; + + // the original region is created (the generator form only) + temprgn:=ExtCreateRegion(x,originalRegionSize,OriginalRegionData^); + image1.width:=image1.picture.bitmap.width; + image1.height:=image1.picture.bitmap.height; + clientwidth:=image1.Left+image1.Width; + clientHeight:=image1.Top+image1.Height; + if clientwidth<=150 then ClientWidth:=150; + if clientHeight<=150 then ClientHeight:=150; + + // a region for the bitmap is created + tr2:=CreateRectRgn(image1.left,image1.top,image1.left+image1.width,image1.top+image1.height); + // the two regions are combined + CombineRgn(temprgn,temprgn,tr2,RGN_OR); + // set the new region + DeleteObject(CoolForm1.Mask.fregion); + CoolForm1.Mask.Fregion:=tempRgn; + SetWindowRgn(handle,temprgn,true); + // clean up + DeleteObject(tr2); + image1.repaint; + dispose(x); + end; +end; + + +// this method is called by the Propertyeditor to backup the maskgenerator`s mask generated at design-time +procedure TFormMaskGenerator.SaveOriginalRegionData; +begin + // clean up + if OriginalRegionData<>nil then + begin + freemem(OriginalRegionData); + OriginalRegionData:=nil; + end; + // save original mask information + oldleft:=left; + oldtop:=top; + OriginalRegionsize:=GetRegionData(CoolForm1.Mask.Fregion,0,nil); + getmem(OriginalRegionData,OriginalRegionsize); + getregiondata(CoolForm1.Mask.FRegion,OriginalRegionsize,OriginalRegiondata); +end; + +destructor TFormMaskGenerator.destroy; +begin + // clean up + if OriginalRegionData<>nil then + begin + freemem(originalregiondata); + end; + OriginalRegionData:=nil; + inherited; +end; + + +procedure TFormMaskGenerator.SpeedButton2Click(Sender: TObject); +begin + close; +end; + +// This is called when the User clicks the OK Button +procedure TFormMaskGenerator.SpeedButton3Click(Sender: TObject); +var +// stream : TFileStream; + size : integer; +// rgndata : pRGNData; + x,y : integer; + transparentcolor : tcolor; + rgn2 : hrgn; + startx,endx : integer; + R : TRect; + +begin + if Panel1.Color = clNone then + Begin + ShowMessage('You must select the colour to be masked out.'#13+ + 'Click on the mask colour in the bitmap. '#13 + + '(It will appear in the square to the right of the load button).'); + Exit; + End; + generating:=true; + // clean up + if rgn1<>0 then deleteObject(rgn1); + rgn1 := 0; + // set the transparent color + transparentcolor:=Panel1.color; + // if necessary, load another mask (don`t know why again... should be redundant) + if opendialog1.filename<>'' then image1.picture.bitmap.loadfromfile(opendialog1.filename); + + // for every line do... + for y := 0 to image1.Picture.Height-1 do + begin + // don`t look as if we were locked up + Application.ProcessMessages; + x:=0; + endx:=x; + // no flicker + lockWindowUpdate(FormMaskGenerator.handle); + repeat + // look for the beginning of a stretch of non-transparent pixels + while (image1.picture.bitmap.canvas.pixels[x,y]=transparentcolor) and (x<=image1.picture.width) do + inc(x); + startx:=x; + // paint the pixels up to here black + for size:=endx to startx do image1.picture.bitmap.canvas.pixels[size,y]:=image1.picture.bitmap.canvas.pixels[size,y] xor $FFFFFF; + // look for the end of a stretch of non-transparent pixels + inc(x); + while (image1.picture.bitmap.canvas.pixels[x,y]<>transparentcolor) and (x<=image1.picture.width) do + inc(x); + endx:=x; + // do we have some pixels? + if startx<>image1.Picture.Width then + begin + if endx= image1.Picture.Width then dec(endx); + // do we have a region already? + if rgn1 = 0 then + begin + // Create a region to start with + rgn1:=createrectrgn(startx+1,y,endx,y+1); + end else + begin + // Add to the existing region + rgn2:=createrectrgn(startx+1,y,endx,y+1); + if rgn2<>0 then combinergn(rgn1,rgn1,rgn2,RGN_OR); + deleteobject(rgn2); + end; + // Paint the pixels white + for size:=startx to endx do image1.picture.bitmap.canvas.pixels[size,y]:=image1.picture.bitmap.canvas.pixels[size,y] xor $FFFFFF; + end; + until x>=image1.picture.width-1; + // flicker on + lockwindowUpdate(0); + // tell windows to repaint only the line of the bitmap we just processed + R.top:=image1.top+y; + r.Bottom:=image1.top+y+1; + r.left:=image1.left; + r.right:=image1.left+image1.Width; + invalidaterect(formmaskgenerator.handle,@R,false); + formmaskgenerator.Update; + end; + generating:=false; + close; +end; + + +procedure TFormMaskGenerator.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer); +begin + if ssLeft in Shift then + begin + panel1.color:=image1.picture.bitmap.canvas.pixels[x,y]; + end; +end; + + +procedure TFormMaskGenerator.Image1MouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer); +begin + panel1.color:=image1.picture.bitmap.canvas.pixels[x,y]; +end; + + +procedure TFormMaskGenerator.FormCreate(Sender: TObject); +begin + image1.picture.OnChange:=BitMapChange; +end; + +procedure TFormMaskGenerator.SpeedButton4Click(Sender: TObject); +var + size : integer; + rgndata : pRGNData; + writer : TFileStream; + +begin + If SaveDialog1.Execute then + begin + if (rgn1<>0) then + begin + writer :=TFileStream.Create (SaveDialog1.Filename, fmCreate); + // get the region data`s size + size:=getregiondata (rgn1, 0, nil); + getmem (rgndata, size); + // get the data itself + getregiondata(rgn1, size, rgndata); + // write it + writer.write (size, sizeof(size)); + writer.write (rgndata^, size); + freemem(rgndata, size); + writer.Free; + end; + end; +end; + +end. diff --git a/CDopping/DialUp/DIALUP.DCR b/CDopping/DialUp/DIALUP.DCR new file mode 100644 index 0000000..2412b2c Binary files /dev/null and b/CDopping/DialUp/DIALUP.DCR differ diff --git a/CDopping/DialUp/DIALUP.DCU b/CDopping/DialUp/DIALUP.DCU new file mode 100644 index 0000000..109452b Binary files /dev/null and b/CDopping/DialUp/DIALUP.DCU differ diff --git a/CDopping/DialUp/DialUp.h b/CDopping/DialUp/DialUp.h new file mode 100644 index 0000000..d8ba6c2 --- /dev/null +++ b/CDopping/DialUp/DialUp.h @@ -0,0 +1,951 @@ +// Borland C++ Builder +// Copyright (c) 1995, 1998 by Borland International +// All rights reserved + +// (DO NOT EDIT: machine generated header) 'DialUp.pas' rev: 3.00 + +#ifndef DialUpHPP +#define DialUpHPP +#include +#include +#include +#include +#include +#include +#include +#include +#include + +//-- user supplied ----------------------------------------------------------- + +namespace Dialup +{ +//-- type declarations ------------------------------------------------------- +typedef int *LPHRasConn; + +typedef int THRasConn; + +struct TRasConnW; +typedef TRasConnW *LPRasConnW; + +struct TRasConnW +{ + int dwSize; + int hrasconn; + wchar_t szEntryName[257]; + wchar_t szDeviceType[17]; + wchar_t szDeviceName[129]; +} ; + +struct TRasConnA; +typedef TRasConnA *LPRasConnA; + +struct TRasConnA +{ + int dwSize; + int hrasconn; + char szEntryName[257]; + char szDeviceType[17]; + char szDeviceName[129]; +} ; + +typedef TRasConnA *LPRasConn; + +typedef TRasConnA TRasConn; + +typedef int *LPRasConnState; + +typedef int TRasConnState; + +struct TRasConnStatusW; +typedef TRasConnStatusW *LPRasConnStatusW; + +struct TRasConnStatusW +{ + int dwSize; + int rasconnstate; + int dwError; + wchar_t szDeviceType[17]; + wchar_t szDeviceName[129]; +} ; + +struct TRasConnStatusA; +typedef TRasConnStatusA *LPRasConnStatusA; + +struct TRasConnStatusA +{ + int dwSize; + int rasconnstate; + int dwError; + char szDeviceType[17]; + char szDeviceName[129]; +} ; + +typedef TRasConnStatusA *LPRasConnStatus; + +typedef TRasConnStatusA TRasConnStatus; + +struct TRasDialParamsW; +typedef TRasDialParamsW *LPRasDialParamsW; + +struct TRasDialParamsW +{ + int dwSize; + wchar_t szEntryName[257]; + wchar_t szPhoneNumber[129]; + wchar_t szCallbackNumber[129]; + wchar_t szUserName[257]; + wchar_t szPassword[257]; + wchar_t szDomain[16]; +} ; + +struct TRasDialParamsA; +typedef TRasDialParamsA *LPRasDialParamsA; + +struct TRasDialParamsA +{ + int dwSize; + char szEntryName[257]; + char szPhoneNumber[129]; + char szCallbackNumber[129]; + char szUserName[257]; + char szPassword[257]; + char szDomain[16]; +} ; + +typedef TRasDialParamsA *LPRasDialParams; + +typedef TRasDialParamsA TRasDialParams; + +struct TRasDialExtensions; +typedef TRasDialExtensions *LPRasDialExtensions; + +struct TRasDialExtensions +{ + int dwSize; + int dwfOptions; + HWND hwndParent; + int reserved; +} ; + +struct TRasEntryNameW; +typedef TRasEntryNameW *LPRasEntryNameW; + +struct TRasEntryNameW +{ + int dwSize; + wchar_t szEntryName[257]; +} ; + +struct TRasEntryNameA; +typedef TRasEntryNameA *LPRasEntryNameA; + +struct TRasEntryNameA +{ + int dwSize; + char szEntryName[257]; +} ; + +typedef TRasEntryNameA *LPRasEntryName; + +typedef TRasEntryNameA TRasEntryName; + +typedef int *LPRasProjection; + +typedef int TRasProjection; + +struct TRasAmbW; +typedef TRasAmbW *LPRasAmbW; + +struct TRasAmbW +{ + int dwSize; + int dwError; + wchar_t szNetBiosError[17]; + Byte bLana; +} ; + +struct TRasAmbA; +typedef TRasAmbA *LPRasAmbA; + +struct TRasAmbA +{ + int dwSize; + int dwError; + char szNetBiosError[17]; + Byte bLana; +} ; + +typedef TRasAmbA *LPRasAmb; + +typedef TRasAmbA TRasAmb; + +struct TRasPppNbfW; +typedef TRasPppNbfW *LPRasPppNbfW; + +struct TRasPppNbfW +{ + int dwSize; + int dwError; + int dwNetBiosError; + wchar_t szNetBiosError[17]; + wchar_t szWorkstationName[17]; + Byte bLana; +} ; + +struct TRasPppNbfA; +typedef TRasPppNbfA *LPRasPppNbfA; + +struct TRasPppNbfA +{ + int dwSize; + int dwError; + int dwNetBiosError; + char szNetBiosError[17]; + char szWorkstationName[17]; + Byte bLana; +} ; + +typedef TRasPppNbfA *LpRaspppNbf; + +typedef TRasPppNbfA TRasPppNbf; + +struct TRasPppIpxW; +typedef TRasPppIpxW *LPRasPppIpxW; + +struct TRasPppIpxW +{ + int dwSize; + int dwError; + wchar_t szIpxAddress[22]; +} ; + +struct TRasPppIpxA; +typedef TRasPppIpxA *LPRasPppIpxA; + +struct TRasPppIpxA +{ + int dwSize; + int dwError; + char szIpxAddress[22]; +} ; + +typedef TRasPppIpxA *LPRasPppIpx; + +typedef TRasPppIpxA TRasPppIpx; + +struct TRasPppIpW; +typedef TRasPppIpW *LPRasPppIpW; + +struct TRasPppIpW +{ + int dwSize; + int dwError; + wchar_t szIpAddress[16]; + wchar_t szServerIpAddress[16]; +} ; + +struct TRasPppIpA; +typedef TRasPppIpA *LPRasPppIpA; + +struct TRasPppIpA +{ + int dwSize; + int dwError; + char szIpAddress[16]; + char szServerIpAddress[16]; +} ; + +typedef TRasPppIpA *LPRasPppIp; + +typedef TRasPppIpA TRasPppIp; + +struct TRasIPAddr; +typedef TRasIPAddr *LPRasIPAddr; + +#pragma pack(push, 1) +struct TRasIPAddr +{ + Byte A; + Byte B; + Byte C; + Byte D; +} ; +#pragma pack(pop) + +struct TRasEntryA; +typedef TRasEntryA *LPRasEntryA; + +struct TRasEntryA +{ + int dwSize; + int dwfOptions; + int dwCountryID; + int dwCountryCode; + char szAreaCode[11]; + char szLocalPhoneNumber[129]; + int dwAlternatesOffset; + TRasIPAddr ipaddr; + TRasIPAddr ipaddrDns; + TRasIPAddr ipaddrDnsAlt; + TRasIPAddr ipaddrWins; + TRasIPAddr ipaddrWinsAlt; + int dwFrameSize; + int dwfNetProtocols; + int dwFramingProtocol; + char szScript[260]; + char szAutodialDll[260]; + char szAutodialFunc[260]; + char szDeviceType[17]; + char szDeviceName[129]; + char szX25PadType[33]; + char szX25Address[201]; + char szX25Facilities[201]; + char szX25UserData[201]; + int dwChannels; + int dwReserved1; + int dwReserved2; +} ; + +struct TRasEntryW; +typedef TRasEntryW *LPRasEntryW; + +struct TRasEntryW +{ + int dwSize; + int dwfOptions; + int dwCountryID; + int dwCountryCode; + wchar_t szAreaCode[11]; + wchar_t szLocalPhoneNumber[129]; + int dwAlternatesOffset; + TRasIPAddr ipaddr; + TRasIPAddr ipaddrDns; + TRasIPAddr ipaddrDnsAlt; + TRasIPAddr ipaddrWins; + TRasIPAddr ipaddrWinsAlt; + int dwFrameSize; + int dwfNetProtocols; + int dwFramingProtocol; + wchar_t szScript[260]; + wchar_t szAutodialDll[260]; + wchar_t szAutodialFunc[260]; + wchar_t szDeviceType[17]; + wchar_t szDeviceName[129]; + wchar_t szX25PadType[33]; + wchar_t szX25Address[201]; + wchar_t szX25Facilities[201]; + wchar_t szX25UserData[201]; + int dwChannels; + int dwReserved1; + int dwReserved2; +} ; + +typedef TRasEntryA *LPRasEntry; + +typedef TRasEntryA TRasEntry; + +struct TRasCtryInfo +{ + int dwSize; + int dwCountryID; + int dwNextCountryID; + int dwCountryCode; + int dwCountryNameOffset; +} ; + +typedef TRasCtryInfo *LPRasCtryInfo; + +struct TRasDevInfoA; +typedef TRasDevInfoA *LPRasDevInfoA; + +struct TRasDevInfoA +{ + int dwSize; + char szDeviceType[17]; + char szDeviceName[129]; +} ; + +struct TRasDevInfoW; +typedef TRasDevInfoW *LPRasDevInfoW; + +struct TRasDevInfoW +{ + int dwSize; + wchar_t szDeviceType[17]; + wchar_t szDeviceName[129]; +} ; + +typedef TRasDevInfoA *LPRasDevInfo; + +typedef TRasDevInfoA TRasDevInfo; + +typedef void __fastcall (__closure *TOnEntryGet)(System::TObject* Sender, System::AnsiString EntryName + ); + +typedef void __fastcall (__closure *TStandartEv)(System::TObject* Sender); + +typedef void __fastcall (__closure *TOnNotConn)(System::TObject* Sender, int ErrorCode, System::AnsiString + ErrorMessage); + +typedef void __fastcall (__closure *TOnAsyncEvent)(System::TObject* Sender, int State, int Error, System::AnsiString + MessageText); + +typedef void __fastcall (__closure *TOnError)(System::TObject* Sender, int ErrorCode, System::AnsiString + ErrorMessage); + +typedef void __fastcall (__closure *TOnActiveConn)(System::TObject* Sender, int Handle, const TRasConnStatusA + &Status, System::AnsiString StatusString, System::AnsiString EntryName, System::AnsiString DeviceType + , System::AnsiString DeviceName); + +enum TDialMode { dmAsync, dmSync }; + +enum TLanguage { English, Czech }; + +class DELPHICLASS TDialUp; +class PASCALIMPLEMENTATION TDialUp : public Classes::TComponent +{ + typedef Classes::TComponent inherited; + +private: + Classes::TStringList* FEntries; + TDialMode FDialMode; + System::AnsiString FEntry2Dial; + TLanguage FLanguage; + Extctrls::TTimer* FTimer; + TOnEntryGet FOnEntryGet; + TStandartEv FOnDialing; + TStandartEv FOnConnected; + TOnNotConn FOnNotConnected; + TOnAsyncEvent FOnAsyncEvent; + TOnError FOnError; + TOnActiveConn FOnActiveConn; + +protected: + virtual void __fastcall Timer(System::TObject* Sender); + +public: + int hRAS; + bool AsyncStatus; + int AMsg; + int AError; + int AState; + __fastcall virtual TDialUp(Classes::TComponent* AOwner); + __fastcall virtual ~TDialUp(void); + int __fastcall Dial(void); + int __fastcall GetEntries(void); + int __fastcall GetConnections(void); + int __fastcall HangUp(void); + int __fastcall HangUpConn(int Handle); + int __fastcall CreateEntry(void); + int __fastcall EditEntry(void); + int __fastcall DeleteEntry(void); + int __fastcall RenameEntryTo(System::AnsiString S); + int __fastcall SetEntryUserName(System::AnsiString Value); + int __fastcall SetEntryPassword(System::AnsiString Value); + int __fastcall RemovePassword(void); + int __fastcall GetEntryUserName(System::AnsiString &Value); + int __fastcall GetEntryPassword(System::AnsiString &Value); + System::AnsiString __fastcall StatusString(int State, int Error); + System::AnsiString __fastcall StatusStringCZ(int State, int Error); + +__published: + __property Name ; + __property Tag ; + __property TDialMode DialMode = {read=FDialMode, write=FDialMode, nodefault}; + __property Classes::TStringList* Entries = {read=FEntries}; + __property System::AnsiString Entry = {read=FEntry2Dial, write=FEntry2Dial}; + __property TLanguage Language = {read=FLanguage, write=FLanguage, nodefault}; + __property TOnEntryGet OnEntryGet = {read=FOnEntryGet, write=FOnEntryGet}; + __property TStandartEv OnDialing = {read=FOnDialing, write=FOnDialing}; + __property TStandartEv OnConnect = {read=FOnConnected, write=FOnConnected}; + __property TOnNotConn OnNotConnected = {read=FOnNotConnected, write=FOnNotConnected}; + __property TOnAsyncEvent OnAsyncEvent = {read=FOnAsyncEvent, write=FOnAsyncEvent}; + __property TOnError OnError = {read=FOnError, write=FOnError}; + __property TOnActiveConn OnActiveConnection = {read=FOnActiveConn, write=FOnActiveConn}; +}; + +//-- var, const, procedure --------------------------------------------------- +#define DNLEN (Byte)(15) +#define UNLEN (Word)(256) +#define PWLEN (Word)(256) +#define NETBIOS_NAME_LEN (Byte)(16) +#define RAS_MaxDeviceType (Byte)(16) +#define RAS_MaxPhoneNumber (Byte)(128) +#define RAS_MaxIpAddress (Byte)(15) +#define RAS_MaxIpxAddress (Byte)(21) +#define RAS_MaxEntryName (Word)(256) +#define RAS_MaxDeviceName (Byte)(128) +#define RAS_MaxCallbackNumber (Byte)(128) +#define RASCS_PAUSED (Word)(4096) +#define RASCS_DONE (Word)(8192) +#define RASCS_OpenPort (Byte)(0) +#define RASCS_PortOpened (Byte)(1) +#define RASCS_ConnectDevice (Byte)(2) +#define RASCS_DeviceConnected (Byte)(3) +#define RASCS_AllDevicesConnected (Byte)(4) +#define RASCS_Authenticate (Byte)(5) +#define RASCS_AuthNotify (Byte)(6) +#define RASCS_AuthRetry (Byte)(7) +#define RASCS_AuthCallback (Byte)(8) +#define RASCS_AuthChangePassword (Byte)(9) +#define RASCS_AuthProject (Byte)(10) +#define RASCS_AuthLinkSpeed (Byte)(11) +#define RASCS_AuthAck (Byte)(12) +#define RASCS_ReAuthenticate (Byte)(13) +#define RASCS_Authenticated (Byte)(14) +#define RASCS_PrepareForCallback (Byte)(15) +#define RASCS_WaitForModemReset (Byte)(16) +#define RASCS_WaitForCallback (Byte)(17) +#define RASCS_Projected (Byte)(18) +#define RASCS_StartAuthentication (Byte)(19) +#define RASCS_CallbackComplete (Byte)(20) +#define RASCS_LogonNetwork (Byte)(21) +#define RASCS_Interactive (Word)(4096) +#define RASCS_RetryAuthentication (Word)(4097) +#define RASCS_CallbackSetByCaller (Word)(4098) +#define RASCS_PasswordExpired (Word)(4099) +#define RASCS_Connected (Word)(8192) +#define RASCS_Disconnected (Word)(8193) +#define RDEOPT_UsePrefixSuffix (Byte)(1) +#define RDEOPT_PausedStates (Byte)(2) +#define RDEOPT_IgnoreModemSpeaker (Byte)(4) +#define RDEOPT_SetModemSpeaker (Byte)(8) +#define RDEOPT_IgnoreSoftwareCompression (Byte)(16) +#define RDEOPT_SetSoftwareCompression (Byte)(32) +#define RASP_Amb (int)(65536) +#define RASP_PppNbf (int)(32831) +#define RASP_PppIpx (int)(32811) +#define RASP_PppIp (int)(32801) +#define RASDIALEVENT "RasDialEvent" +#define WM_RASDIALEVENT (int)(52429) +#define RASBASE (Word)(600) +#define SUCCESS (Byte)(0) +#define PENDING (Word)(600) +#define ERROR_INVALID_PORT_HANDLE (Word)(601) +#define ERROR_PORT_ALREADY_OPEN (Word)(602) +#define ERROR_BUFFER_TOO_SMALL (Word)(603) +#define ERROR_WRONG_INFO_SPECIFIED (Word)(604) +#define ERROR_CANNOT_SET_PORT_INFO (Word)(605) +#define ERROR_PORT_NOT_CONNECTED (Word)(606) +#define ERROR_EVENT_INVALID (Word)(607) +#define ERROR_DEVICE_DOES_NOT_EXIST (Word)(608) +#define ERROR_DEVICETYPE_DOES_NOT_EXIST (Word)(609) +#define ERROR_BUFFER_INVALID (Word)(610) +#define ERROR_ROUTE_NOT_AVAILABLE (Word)(611) +#define ERROR_ROUTE_NOT_ALLOCATED (Word)(612) +#define ERROR_INVALID_COMPRESSION_SPECIFIED (Word)(613) +#define ERROR_OUT_OF_BUFFERS (Word)(614) +#define ERROR_PORT_NOT_FOUND (Word)(615) +#define ERROR_ASYNC_REQUEST_PENDING (Word)(616) +#define ERROR_ALREADY_DISCONNECTING (Word)(617) +#define ERROR_PORT_NOT_OPEN (Word)(618) +#define ERROR_PORT_DISCONNECTED (Word)(619) +#define ERROR_NO_ENDPOINTS (Word)(620) +#define ERROR_CANNOT_OPEN_PHONEBOOK (Word)(621) +#define ERROR_CANNOT_LOAD_PHONEBOOK (Word)(622) +#define ERROR_CANNOT_FIND_PHONEBOOK_ENTRY (Word)(623) +#define ERROR_CANNOT_WRITE_PHONEBOOK (Word)(624) +#define ERROR_CORRUPT_PHONEBOOK (Word)(625) +#define ERROR_CANNOT_LOAD_STRING (Word)(626) +#define ERROR_KEY_NOT_FOUND (Word)(627) +#define ERROR_DISCONNECTION (Word)(628) +#define ERROR_REMOTE_DISCONNECTION (Word)(629) +#define ERROR_HARDWARE_FAILURE (Word)(630) +#define ERROR_USER_DISCONNECTION (Word)(631) +#define ERROR_INVALID_SIZE (Word)(632) +#define ERROR_PORT_NOT_AVAILABLE (Word)(633) +#define ERROR_CANNOT_PROJECT_CLIENT (Word)(634) +#define ERROR_UNKNOWN (Word)(635) +#define ERROR_WRONG_DEVICE_ATTACHED (Word)(636) +#define ERROR_BAD_STRING (Word)(637) +#define ERROR_REQUEST_TIMEOUT (Word)(638) +#define ERROR_CANNOT_GET_LANA (Word)(639) +#define ERROR_NETBIOS_ERROR (Word)(640) +#define ERROR_SERVER_OUT_OF_RESOURCES (Word)(641) +#define ERROR_NAME_EXISTS_ON_NET (Word)(642) +#define ERROR_SERVER_GENERAL_NET_FAILURE (Word)(643) +#define WARNING_MSG_ALIAS_NOT_ADDED (Word)(644) +#define ERROR_AUTH_INTERNAL (Word)(645) +#define ERROR_RESTRICTED_LOGON_HOURS (Word)(646) +#define ERROR_ACCT_DISABLED (Word)(647) +#define ERROR_PASSWD_EXPIRED (Word)(648) +#define ERROR_NO_DIALIN_PERMISSION (Word)(649) +#define ERROR_SERVER_NOT_RESPONDING (Word)(650) +#define ERROR_FROM_DEVICE (Word)(651) +#define ERROR_UNRECOGNIZED_RESPONSE (Word)(652) +#define ERROR_MACRO_NOT_FOUND (Word)(653) +#define ERROR_MACRO_NOT_DEFINED (Word)(654) +#define ERROR_MESSAGE_MACRO_NOT_FOUND (Word)(655) +#define ERROR_DEFAULTOFF_MACRO_NOT_FOUND (Word)(656) +#define ERROR_FILE_COULD_NOT_BE_OPENED (Word)(657) +#define ERROR_DEVICENAME_TOO_LONG (Word)(658) +#define ERROR_DEVICENAME_NOT_FOUND (Word)(659) +#define ERROR_NO_RESPONSES (Word)(660) +#define ERROR_NO_COMMAND_FOUND (Word)(661) +#define ERROR_WRONG_KEY_SPECIFIED (Word)(662) +#define ERROR_UNKNOWN_DEVICE_TYPE (Word)(663) +#define ERROR_ALLOCATING_MEMORY (Word)(664) +#define ERROR_PORT_NOT_CONFIGURED (Word)(665) +#define ERROR_DEVICE_NOT_READY (Word)(666) +#define ERROR_READING_INI_FILE (Word)(667) +#define ERROR_NO_CONNECTION (Word)(668) +#define ERROR_BAD_USAGE_IN_INI_FILE (Word)(669) +#define ERROR_READING_SECTIONNAME (Word)(670) +#define ERROR_READING_DEVICETYPE (Word)(671) +#define ERROR_READING_DEVICENAME (Word)(672) +#define ERROR_READING_USAGE (Word)(673) +#define ERROR_READING_MAXCONNECTBPS (Word)(674) +#define ERROR_READING_MAXCARRIERBPS (Word)(675) +#define ERROR_LINE_BUSY (Word)(676) +#define ERROR_VOICE_ANSWER (Word)(677) +#define ERROR_NO_ANSWER (Word)(678) +#define ERROR_NO_CARRIER (Word)(679) +#define ERROR_NO_DIALTONE (Word)(680) +#define ERROR_IN_COMMAND (Word)(681) +#define ERROR_WRITING_SECTIONNAME (Word)(682) +#define ERROR_WRITING_DEVICETYPE (Word)(683) +#define ERROR_WRITING_DEVICENAME (Word)(684) +#define ERROR_WRITING_MAXCONNECTBPS (Word)(685) +#define ERROR_WRITING_MAXCARRIERBPS (Word)(686) +#define ERROR_WRITING_USAGE (Word)(687) +#define ERROR_WRITING_DEFAULTOFF (Word)(688) +#define ERROR_READING_DEFAULTOFF (Word)(689) +#define ERROR_EMPTY_INI_FILE (Word)(690) +#define ERROR_AUTHENTICATION_FAILURE (Word)(691) +#define ERROR_PORT_OR_DEVICE (Word)(692) +#define ERROR_NOT_BINARY_MACRO (Word)(693) +#define ERROR_DCB_NOT_FOUND (Word)(694) +#define ERROR_STATE_MACHINES_NOT_STARTED (Word)(695) +#define ERROR_STATE_MACHINES_ALREADY_STARTED (Word)(696) +#define ERROR_PARTIAL_RESPONSE_LOOPING (Word)(697) +#define ERROR_UNKNOWN_RESPONSE_KEY (Word)(698) +#define ERROR_RECV_BUF_FULL (Word)(699) +#define ERROR_CMD_TOO_LONG (Word)(700) +#define ERROR_UNSUPPORTED_BPS (Word)(701) +#define ERROR_UNEXPECTED_RESPONSE (Word)(702) +#define ERROR_INTERACTIVE_MODE (Word)(703) +#define ERROR_BAD_CALLBACK_NUMBER (Word)(704) +#define ERROR_INVALID_AUTH_STATE (Word)(705) +#define ERROR_WRITING_INITBPS (Word)(706) +#define ERROR_X25_DIAGNOSTIC (Word)(707) +#define ERROR_ACCT_EXPIRED (Word)(708) +#define ERROR_CHANGING_PASSWORD (Word)(709) +#define ERROR_OVERRUN (Word)(710) +#define ERROR_RASMAN_CANNOT_INITIALIZE (Word)(711) +#define ERROR_BIPLEX_PORT_NOT_AVAILABLE (Word)(712) +#define ERROR_NO_ACTIVE_ISDN_LINES (Word)(713) +#define ERROR_NO_ISDN_CHANNELS_AVAILABLE (Word)(714) +#define ERROR_TOO_MANY_LINE_ERRORS (Word)(715) +#define ERROR_IP_CONFIGURATION (Word)(716) +#define ERROR_NO_IP_ADDRESSES (Word)(717) +#define ERROR_PPP_TIMEOUT (Word)(718) +#define ERROR_PPP_REMOTE_TERMINATED (Word)(719) +#define ERROR_PPP_NO_PROTOCOLS_CONFIGURED (Word)(720) +#define ERROR_PPP_NO_RESPONSE (Word)(721) +#define ERROR_PPP_INVALID_PACKET (Word)(722) +#define ERROR_PHONE_NUMBER_TOO_LONG (Word)(723) +#define ERROR_IPXCP_NO_DIALOUT_CONFIGURED (Word)(724) +#define ERROR_IPXCP_NO_DIALIN_CONFIGURED (Word)(725) +#define ERROR_IPXCP_DIALOUT_ALREADY_ACTIVE (Word)(726) +#define ERROR_ACCESSING_TCPCFGDLL (Word)(727) +#define ERROR_NO_IP_RAS_ADAPTER (Word)(728) +#define ERROR_SLIP_REQUIRES_IP (Word)(729) +#define ERROR_PROJECTION_NOT_COMPLETE (Word)(730) +#define ERROR_PROTOCOL_NOT_CONFIGURED (Word)(731) +#define ERROR_PPP_NOT_CONVERGING (Word)(732) +#define ERROR_PPP_CP_REJECTED (Word)(733) +#define ERROR_PPP_LCP_TERMINATED (Word)(734) +#define ERROR_PPP_REQUIRED_ADDRESS_REJECTED (Word)(735) +#define ERROR_PPP_NCP_TERMINATED (Word)(736) +#define ERROR_PPP_LOOPBACK_DETECTED (Word)(737) +#define ERROR_PPP_NO_ADDRESS_ASSIGNED (Word)(738) +#define ERROR_CANNOT_USE_LOGON_CREDENTIALS (Word)(739) +#define ERROR_TAPI_CONFIGURATION (Word)(740) +#define ERROR_NO_LOCAL_ENCRYPTION (Word)(741) +#define ERROR_NO_REMOTE_ENCRYPTION (Word)(742) +#define ERROR_REMOTE_REQUIRES_ENCRYPTION (Word)(743) +#define ERROR_IPXCP_NET_NUMBER_CONFLICT (Word)(744) +#define ERROR_INVALID_SMM (Word)(745) +#define ERROR_SMM_UNINITIALIZED (Word)(746) +#define ERROR_NO_MAC_FOR_PORT (Word)(747) +#define ERROR_SMM_TIMEOUT (Word)(748) +#define ERROR_BAD_PHONE_NUMBER (Word)(749) +#define ERROR_WRONG_MODULE (Word)(750) +#define RASBASEEND (Word)(750) +#define RAS_MaxAreaCode (Byte)(10) +#define RAS_MaxPadType (Byte)(32) +#define RAS_MaxX25Address (Byte)(200) +#define RAS_MaxFacilities (Byte)(200) +#define RAS_MaxUserData (Byte)(200) +#define RASEO_UseCountryAndAreaCodes (Byte)(1) +#define RASEO_SpecificIpAddr (Byte)(2) +#define RASEO_SpecificNameServers (Byte)(4) +#define RASEO_IpHeaderCompression (Byte)(8) +#define RASEO_RemoteDefaultGateway (Byte)(16) +#define RASEO_DisableLcpExtensions (Byte)(32) +#define RASEO_TerminalBeforeDial (Byte)(64) +#define RASEO_TerminalAfterDial (Byte)(128) +#define RASEO_ModemLights (Word)(256) +#define RASEO_SwCompression (Word)(512) +#define RASEO_RequireEncryptedPw (Word)(1024) +#define RASEO_RequireMsEncryptedPw (Word)(2048) +#define RASEO_RequireDataEncryption (Word)(4096) +#define RASEO_NetworkLogon (Word)(8192) +#define RASEO_UseLogonCredentials (Word)(16384) +#define RASEO_PromoteAlternates (int)(32768) +#define RASNP_Netbeui (Byte)(1) +#define RASNP_Ipx (Byte)(2) +#define RASNP_Ip (Byte)(4) +#define RASFP_Ppp (Byte)(1) +#define RASFP_Slip (Byte)(2) +#define RASFP_Ras (Byte)(4) +#define RASDT_Modem "modem" +#define RASDT_Isdn "isdn" +#define RASDT_X25 "x25" +#define MaxEntries (Byte)(100) +extern PACKAGE void __fastcall Register(void); +extern "C" int __stdcall RasCreatePhonebookEntryA(HWND hwndParentWindow, char * lpszPhoneBook); +extern "C" int __stdcall RasCreatePhonebookEntryW(HWND hwndParentWindow, wchar_t * lpszPhoneBook); +extern "C" int __stdcall RasCreatePhonebookEntry(HWND hwndParentWindow, char * lpszPhoneBook); +extern "C" int __stdcall RasDialA(LPRasDialExtensions lpRasDialExt, char * lpszPhoneBook, TRasDialParamsA + ¶ms, int dwNotifierType, void * lpNotifier, int &rasconn); +extern "C" int __stdcall RasDialW(LPRasDialExtensions lpRasDialExt, wchar_t * lpszPhoneBook, TRasDialParamsW + ¶ms, int dwNotifierType, void * lpNotifier, int &rasconn); +extern "C" int __stdcall RasDial(LPRasDialExtensions lpRasDialExt, char * lpszPhoneBook, TRasDialParamsA + ¶ms, int dwNotifierType, void * lpNotifier, int &rasconn); +extern "C" int __stdcall RasEditPhonebookEntryA(HWND hwndParentWindow, char * lpszPhoneBook, char * + lpszEntryName); +extern "C" int __stdcall RasEditPhonebookEntryW(HWND hwndParentWindow, wchar_t * lpszPhoneBook, wchar_t * + lpszEntryName); +extern "C" int __stdcall RasEditPhonebookEntry(HWND hwndParentWindow, char * lpszPhoneBook, char * lpszEntryName + ); +extern "C" int __stdcall RasEnumConnectionsA(LPRasConnA RasConnArray, int &lpcb, int &lpcConnections + ); +extern "C" int __stdcall RasEnumConnectionsW(LPRasConnW RasConnArray, int &lpcb, int &lpcConnections + ); +extern "C" int __stdcall RasEnumConnections(LPRasConn RasConnArray, int &lpcb, int &lpcConnections); + +extern "C" int __stdcall RasEnumEntriesA(char * Reserved, char * lpszPhoneBook, LPRasEntryNameA entrynamesArray + , int &lpcb, int &lpcEntries); +extern "C" int __stdcall RasEnumEntriesW(wchar_t * reserved, wchar_t * lpszPhoneBook, LPRasEntryNameW + entrynamesArray, int &lpcb, int &lpcEntries); +extern "C" int __stdcall RasEnumEntries(char * reserved, char * lpszPhoneBook, LPRasEntryName entrynamesArray + , int &lpcb, int &lpcEntries); +extern "C" int __stdcall RasGetConnectStatusA(int hConn, TRasConnStatusA &lpStatus); +extern "C" int __stdcall RasGetConnectStatusW(int hConn, TRasConnStatusW &lpStatus); +extern "C" int __stdcall RasGetConnectStatus(int hConn, TRasConnStatusA &lpStatus); +extern "C" int __stdcall RasGetEntryDialParamsA(char * lpszPhoneBook, TRasDialParamsA &lpDialParams, + BOOL &lpfPassword); +extern "C" int __stdcall RasGetEntryDialParamsW(wchar_t * lpszPhoneBook, TRasDialParamsW &lpDialParams + , BOOL &lpfPassword); +extern "C" int __stdcall RasGetEntryDialParams(char * lpszPhoneBook, TRasDialParamsA &lpDialParams, + BOOL &lpfPassword); +extern "C" int __stdcall RasGetErrorStringA(int errorValue, char * erroString, int cBufSize); +extern "C" int __stdcall RasGetErrorStringW(int errorValue, wchar_t * erroString, int cBufSize); +extern "C" int __stdcall RasGetErrorString(int errorValue, char * erroString, int cBufSize); +extern "C" int __stdcall RasGetProjectionInfoA(int hConn, int rasproj, void * lpProjection, int &lpcb + ); +extern "C" int __stdcall RasGetProjectionInfoW(int hConn, int rasproj, void * lpProjection, int &lpcb + ); +extern "C" int __stdcall RasGetProjectionInfo(int hConn, int rasproj, void * lpProjection, int &lpcb + ); +extern "C" int __stdcall RasHangUpA(int hConn); +extern "C" int __stdcall RasHangUpW(int hConn); +extern "C" int __stdcall RasHangUp(int hConn); +extern "C" int __stdcall RasSetEntryDialParamsA(char * lpszPhoneBook, TRasDialParamsA &lpDialParams, + BOOL fRemovePassword); +extern "C" int __stdcall RasSetEntryDialParamsW(wchar_t * lpszPhoneBook, TRasDialParamsW &lpDialParams + , BOOL fRemovePassword); +extern "C" int __stdcall RasSetEntryDialParams(char * lpszPhoneBook, TRasDialParamsA &lpDialParams, + BOOL fRemovePassword); +extern "C" int __stdcall RasValidateEntryNameA(char * lpszPhonebook, char * szEntry); +extern "C" int __stdcall RasValidateEntryNameW(wchar_t * lpszPhonebook, wchar_t * szEntry); +extern "C" int __stdcall RasRenameEntryA(char * lpszPhonebook, char * szEntryOld, char * szEntryNew) + ; +extern "C" int __stdcall RasRenameEntryW(wchar_t * lpszPhonebook, wchar_t * szEntryOld, wchar_t * szEntryNew + ); +extern "C" int __stdcall RasDeleteEntryA(char * lpszPhonebook, char * szEntry); +extern "C" int __stdcall RasDeleteEntryW(wchar_t * lpszPhonebook, wchar_t * szEntry); +extern "C" int __stdcall RasGetEntryPropertiesA(char * lpszPhonebook, char * szEntry, void * lpbEntry + , int &lpdwEntrySize, void * lpbDeviceInfo, int &lpdwDeviceInfoSize); +extern "C" int __stdcall RasGetEntryPropertiesW(wchar_t * lpszPhonebook, wchar_t * szEntry, void * lpbEntry + , int &lpdwEntrySize, void * lpbDeviceInfo, int &lpdwDeviceInfoSize); +extern "C" int __stdcall RasSetEntryPropertiesA(char * lpszPhonebook, char * szEntry, void * lpbEntry + , int dwEntrySize, void * lpbDeviceInfo, int dwDeviceInfoSize); +extern "C" int __stdcall RasSetEntryPropertiesW(wchar_t * lpszPhonebook, wchar_t * szEntry, void * lpbEntry + , int dwEntrySize, void * lpbDeviceInfo, int dwDeviceInfoSize); +extern "C" int __stdcall RasGetCountryInfoA(TRasCtryInfo &lpCtryInfo, int &lpdwSize); +extern "C" int __stdcall RasGetCountryInfoW(TRasCtryInfo &lpCtryInfo, int &lpdwSize); +extern "C" int __stdcall RasEnumDevicesA(LPRasDevInfoA lpBuff, int &lpcbSize, int &lpcDevices); +extern "C" int __stdcall RasEnumDevicesW(LPRasDevInfoW lpBuff, int &lpcbSize, int &lpcDevices); +extern PACKAGE int __stdcall RasValidateEntryName(char * lpszPhonebook, char * szEntry); +extern PACKAGE int __stdcall RasRenameEntry(char * lpszPhonebook, char * szEntryOld, char * szEntryNew + ); +extern PACKAGE int __stdcall RasDeleteEntry(char * lpszPhonebook, char * szEntry); +extern PACKAGE int __stdcall RasGetEntryProperties(char * lpszPhonebook, char * szEntry, void * lpbEntry + , int &lpdwEntrySize, void * lpbDeviceInfo, int &lpdwDeviceInfoSize); +extern PACKAGE int __stdcall RasSetEntryProperties(char * lpszPhonebook, char * szEntry, void * lpbEntry + , int dwEntrySize, void * lpbDeviceInfo, int dwDeviceInfoSize); +extern PACKAGE int __stdcall RasGetCountryInfo(TRasCtryInfo &lpCtryInfo, int &lpdwSize); +extern PACKAGE int __stdcall RasEnumDevices(LPRasDevInfo lpBuff, int &lpcbSize, int &lpcDevices); + +#if defined(UNICODE) +inline int __stdcall RasDial(LPRasDialExtensions lpRasDialExt, char * lpszPhoneBook, TRasDialParamsA + ¶ms, int dwNotifierType, void * lpNotifier, int &rasconn) +{ + return RasDialW(lpRasDialExt, lpszPhoneBook, params, dwNotifierType, lpNotifier, rasconn); +} +#else +inline int __stdcall RasDial(LPRasDialExtensions lpRasDialExt, char * lpszPhoneBook, TRasDialParamsA + ¶ms, int dwNotifierType, void * lpNotifier, int &rasconn) +{ + return RasDialA(lpRasDialExt, lpszPhoneBook, params, dwNotifierType, lpNotifier, rasconn); +} +#endif + + +#if defined(UNICODE) +inline int __stdcall RasEnumConnections(LPRasConn RasConnArray, int &lpcb, int &lpcConnections) +{ + return RasEnumConnectionsW(RasConnArray, lpcb, lpcConnections); +} +#else +inline int __stdcall RasEnumConnections(LPRasConn RasConnArray, int &lpcb, int &lpcConnections) +{ + return RasEnumConnectionsA(RasConnArray, lpcb, lpcConnections); +} +#endif + + +#if defined(UNICODE) +inline int __stdcall RasEnumEntries(char * reserved, char * lpszPhoneBook, LPRasEntryName entrynamesArray + , int &lpcb, int &lpcEntries) +{ + return RasEnumEntriesW(reserved, lpszPhoneBook, entrynamesArray, lpcb, lpcEntries); +} +#else +inline int __stdcall RasEnumEntries(char * reserved, char * lpszPhoneBook, LPRasEntryName entrynamesArray + , int &lpcb, int &lpcEntries) +{ + return RasEnumEntriesA(reserved, lpszPhoneBook, entrynamesArray, lpcb, lpcEntries); +} +#endif + + +#if defined(UNICODE) +inline int __stdcall RasGetConnectStatus(int hConn, TRasConnStatusA &lpStatus) +{ + return RasGetConnectStatusW(hConn, lpStatus); +} +#else +inline int __stdcall RasGetConnectStatus(int hConn, TRasConnStatusA &lpStatus) +{ + return RasGetConnectStatusA(hConn, lpStatus); +} +#endif + + +#if defined(UNICODE) +inline int __stdcall RasGetErrorString(int errorValue, char * erroString, int cBufSize) +{ + return RasGetErrorStringW(errorValue, erroString, cBufSize); +} +#else +inline int __stdcall RasGetErrorString(int errorValue, char * erroString, int cBufSize) +{ + return RasGetErrorStringA(errorValue, erroString, cBufSize); +} +#endif + + +#if defined(UNICODE) +inline int __stdcall RasHangUp(int hConn) +{ + return RasHangUpW(hConn); +} +#else +inline int __stdcall RasHangUp(int hConn) +{ + return RasHangUpA(hConn); +} +#endif + + +#if defined(UNICODE) +inline int __stdcall RasGetProjectionInfo(int hConn, int rasproj, void * lpProjection, int &lpcb) +{ + return RasGetProjectionInfoW(hConn, rasproj, lpProjection, lpcb); +} +#else +inline int __stdcall RasGetProjectionInfo(int hConn, int rasproj, void * lpProjection, int &lpcb) +{ + return RasGetProjectionInfoA(hConn, rasproj, lpProjection, lpcb); +} +#endif + + +#if defined(UNICODE) +inline int __stdcall RasCreatePhonebookEntry(HWND hwndParentWindow, char * lpszPhoneBook) +{ + return RasCreatePhonebookEntryW(hwndParentWindow, lpszPhoneBook); +} +#else +inline int __stdcall RasCreatePhonebookEntry(HWND hwndParentWindow, char * lpszPhoneBook) +{ + return RasCreatePhonebookEntryA(hwndParentWindow, lpszPhoneBook); +} +#endif + + +#if defined(UNICODE) +inline int __stdcall RasEditPhonebookEntry(HWND hwndParentWindow, char * lpszPhoneBook, char * lpszEntryName + ) +{ + return RasEditPhonebookEntryW(hwndParentWindow, lpszPhoneBook, lpszEntryName); +} +#else +inline int __stdcall RasEditPhonebookEntry(HWND hwndParentWindow, char * lpszPhoneBook, char * lpszEntryName + ) +{ + return RasEditPhonebookEntryA(hwndParentWindow, lpszPhoneBook, lpszEntryName); +} +#endif + + +#if defined(UNICODE) +inline int __stdcall RasSetEntryDialParams(char * lpszPhoneBook, TRasDialParamsA &lpDialParams, BOOL + fRemovePassword) +{ + return RasSetEntryDialParamsW(lpszPhoneBook, lpDialParams, fRemovePassword); +} +#else +inline int __stdcall RasSetEntryDialParams(char * lpszPhoneBook, TRasDialParamsA &lpDialParams, BOOL + fRemovePassword) +{ + return RasSetEntryDialParamsA(lpszPhoneBook, lpDialParams, fRemovePassword); +} +#endif + + +#if defined(UNICODE) +inline int __stdcall RasGetEntryDialParams(char * lpszPhoneBook, TRasDialParamsA &lpDialParams, BOOL + &lpfPassword) +{ + return RasGetEntryDialParamsW(lpszPhoneBook, lpDialParams, lpfPassword); +} +#else +inline int __stdcall RasGetEntryDialParams(char * lpszPhoneBook, TRasDialParamsA &lpDialParams, BOOL + &lpfPassword) +{ + return RasGetEntryDialParamsA(lpszPhoneBook, lpDialParams, lpfPassword); +} +#endif + + +} /* namespace Dialup */ +#if !defined(NO_IMPLICIT_NAMESPACE_USE) +using namespace Dialup; +#endif +//-- end unit ---------------------------------------------------------------- +#endif // DialUp diff --git a/CDopping/DialUp/Dialup.OBJ b/CDopping/DialUp/Dialup.OBJ new file mode 100644 index 0000000..bc43aef Binary files /dev/null and b/CDopping/DialUp/Dialup.OBJ differ diff --git a/CDopping/DialUp/Dialup.hpp b/CDopping/DialUp/Dialup.hpp new file mode 100644 index 0000000..00efeed --- /dev/null +++ b/CDopping/DialUp/Dialup.hpp @@ -0,0 +1,951 @@ +// Borland C++ Builder +// Copyright (c) 1995, 1998 by Borland International +// All rights reserved + +// (DO NOT EDIT: machine generated header) 'DialUp.pas' rev: 3.00 + +#ifndef DialUpHPP +#define DialUpHPP +#include +#include +#include +#include +#include +#include +#include +#include +#include + +//-- user supplied ----------------------------------------------------------- + +namespace Dialup +{ +//-- type declarations ------------------------------------------------------- +typedef int *LPHRasConn; + +typedef int THRasConn; + +struct TRasConnW; +typedef TRasConnW *LPRasConnW; + +struct TRasConnW +{ + int dwSize; + int hrasconn; + wchar_t szEntryName[257]; + wchar_t szDeviceType[17]; + wchar_t szDeviceName[129]; +} ; + +struct TRasConnA; +typedef TRasConnA *LPRasConnA; + +struct TRasConnA +{ + int dwSize; + int hrasconn; + char szEntryName[257]; + char szDeviceType[17]; + char szDeviceName[129]; +} ; + +typedef TRasConnA *LPRasConn; + +typedef TRasConnA TRasConn; + +typedef int *LPRasConnState; + +typedef int TRasConnState; + +struct TRasConnStatusW; +typedef TRasConnStatusW *LPRasConnStatusW; + +struct TRasConnStatusW +{ + int dwSize; + int rasconnstate; + int dwError; + wchar_t szDeviceType[17]; + wchar_t szDeviceName[129]; +} ; + +struct TRasConnStatusA; +typedef TRasConnStatusA *LPRasConnStatusA; + +struct TRasConnStatusA +{ + int dwSize; + int rasconnstate; + int dwError; + char szDeviceType[17]; + char szDeviceName[129]; +} ; + +typedef TRasConnStatusA *LPRasConnStatus; + +typedef TRasConnStatusA TRasConnStatus; + +struct TRasDialParamsW; +typedef TRasDialParamsW *LPRasDialParamsW; + +struct TRasDialParamsW +{ + int dwSize; + wchar_t szEntryName[257]; + wchar_t szPhoneNumber[129]; + wchar_t szCallbackNumber[129]; + wchar_t szUserName[257]; + wchar_t szPassword[257]; + wchar_t szDomain[16]; +} ; + +struct TRasDialParamsA; +typedef TRasDialParamsA *LPRasDialParamsA; + +struct TRasDialParamsA +{ + int dwSize; + char szEntryName[257]; + char szPhoneNumber[129]; + char szCallbackNumber[129]; + char szUserName[257]; + char szPassword[257]; + char szDomain[16]; +} ; + +typedef TRasDialParamsA *LPRasDialParams; + +typedef TRasDialParamsA TRasDialParams; + +struct TRasDialExtensions; +typedef TRasDialExtensions *LPRasDialExtensions; + +struct TRasDialExtensions +{ + int dwSize; + int dwfOptions; + HWND hwndParent; + int reserved; +} ; + +struct TRasEntryNameW; +typedef TRasEntryNameW *LPRasEntryNameW; + +struct TRasEntryNameW +{ + int dwSize; + wchar_t szEntryName[257]; +} ; + +struct TRasEntryNameA; +typedef TRasEntryNameA *LPRasEntryNameA; + +struct TRasEntryNameA +{ + int dwSize; + char szEntryName[257]; +} ; + +typedef TRasEntryNameA *LPRasEntryName; + +typedef TRasEntryNameA TRasEntryName; + +typedef int *LPRasProjection; + +typedef int TRasProjection; + +struct TRasAmbW; +typedef TRasAmbW *LPRasAmbW; + +struct TRasAmbW +{ + int dwSize; + int dwError; + wchar_t szNetBiosError[17]; + Byte bLana; +} ; + +struct TRasAmbA; +typedef TRasAmbA *LPRasAmbA; + +struct TRasAmbA +{ + int dwSize; + int dwError; + char szNetBiosError[17]; + Byte bLana; +} ; + +typedef TRasAmbA *LPRasAmb; + +typedef TRasAmbA TRasAmb; + +struct TRasPppNbfW; +typedef TRasPppNbfW *LPRasPppNbfW; + +struct TRasPppNbfW +{ + int dwSize; + int dwError; + int dwNetBiosError; + wchar_t szNetBiosError[17]; + wchar_t szWorkstationName[17]; + Byte bLana; +} ; + +struct TRasPppNbfA; +typedef TRasPppNbfA *LPRasPppNbfA; + +struct TRasPppNbfA +{ + int dwSize; + int dwError; + int dwNetBiosError; + char szNetBiosError[17]; + char szWorkstationName[17]; + Byte bLana; +} ; + +typedef TRasPppNbfA *LpRaspppNbf; + +typedef TRasPppNbfA TRasPppNbf; + +struct TRasPppIpxW; +typedef TRasPppIpxW *LPRasPppIpxW; + +struct TRasPppIpxW +{ + int dwSize; + int dwError; + wchar_t szIpxAddress[22]; +} ; + +struct TRasPppIpxA; +typedef TRasPppIpxA *LPRasPppIpxA; + +struct TRasPppIpxA +{ + int dwSize; + int dwError; + char szIpxAddress[22]; +} ; + +typedef TRasPppIpxA *LPRasPppIpx; + +typedef TRasPppIpxA TRasPppIpx; + +struct TRasPppIpW; +typedef TRasPppIpW *LPRasPppIpW; + +struct TRasPppIpW +{ + int dwSize; + int dwError; + wchar_t szIpAddress[16]; + wchar_t szServerIpAddress[16]; +} ; + +struct TRasPppIpA; +typedef TRasPppIpA *LPRasPppIpA; + +struct TRasPppIpA +{ + int dwSize; + int dwError; + char szIpAddress[16]; + char szServerIpAddress[16]; +} ; + +typedef TRasPppIpA *LPRasPppIp; + +typedef TRasPppIpA TRasPppIp; + +struct TRasIPAddr; +typedef TRasIPAddr *LPRasIPAddr; + +#pragma pack(push, 1) +struct TRasIPAddr +{ + Byte A; + Byte B; + Byte C; + Byte D; +} ; +#pragma pack(pop) + +struct TRasEntryA; +typedef TRasEntryA *LPRasEntryA; + +struct TRasEntryA +{ + int dwSize; + int dwfOptions; + int dwCountryID; + int dwCountryCode; + char szAreaCode[11]; + char szLocalPhoneNumber[129]; + int dwAlternatesOffset; + TRasIPAddr ipaddr; + TRasIPAddr ipaddrDns; + TRasIPAddr ipaddrDnsAlt; + TRasIPAddr ipaddrWins; + TRasIPAddr ipaddrWinsAlt; + int dwFrameSize; + int dwfNetProtocols; + int dwFramingProtocol; + char szScript[260]; + char szAutodialDll[260]; + char szAutodialFunc[260]; + char szDeviceType[17]; + char szDeviceName[129]; + char szX25PadType[33]; + char szX25Address[201]; + char szX25Facilities[201]; + char szX25UserData[201]; + int dwChannels; + int dwReserved1; + int dwReserved2; +} ; + +struct TRasEntryW; +typedef TRasEntryW *LPRasEntryW; + +struct TRasEntryW +{ + int dwSize; + int dwfOptions; + int dwCountryID; + int dwCountryCode; + wchar_t szAreaCode[11]; + wchar_t szLocalPhoneNumber[129]; + int dwAlternatesOffset; + TRasIPAddr ipaddr; + TRasIPAddr ipaddrDns; + TRasIPAddr ipaddrDnsAlt; + TRasIPAddr ipaddrWins; + TRasIPAddr ipaddrWinsAlt; + int dwFrameSize; + int dwfNetProtocols; + int dwFramingProtocol; + wchar_t szScript[260]; + wchar_t szAutodialDll[260]; + wchar_t szAutodialFunc[260]; + wchar_t szDeviceType[17]; + wchar_t szDeviceName[129]; + wchar_t szX25PadType[33]; + wchar_t szX25Address[201]; + wchar_t szX25Facilities[201]; + wchar_t szX25UserData[201]; + int dwChannels; + int dwReserved1; + int dwReserved2; +} ; + +typedef TRasEntryA *LPRasEntry; + +typedef TRasEntryA TRasEntry; + +struct TRasCtryInfo +{ + int dwSize; + int dwCountryID; + int dwNextCountryID; + int dwCountryCode; + int dwCountryNameOffset; +} ; + +typedef TRasCtryInfo *LPRasCtryInfo; + +struct TRasDevInfoA; +typedef TRasDevInfoA *LPRasDevInfoA; + +struct TRasDevInfoA +{ + int dwSize; + char szDeviceType[17]; + char szDeviceName[129]; +} ; + +struct TRasDevInfoW; +typedef TRasDevInfoW *LPRasDevInfoW; + +struct TRasDevInfoW +{ + int dwSize; + wchar_t szDeviceType[17]; + wchar_t szDeviceName[129]; +} ; + +typedef TRasDevInfoA *LPRasDevInfo; + +typedef TRasDevInfoA TRasDevInfo; + +typedef void __fastcall (__closure *TOnEntryGet)(System::TObject* Sender, System::AnsiString EntryName + ); + +typedef void __fastcall (__closure *TStandartEv)(System::TObject* Sender); + +typedef void __fastcall (__closure *TOnNotConn)(System::TObject* Sender, int ErrorCode, System::AnsiString + ErrorMessage); + +typedef void __fastcall (__closure *TOnAsyncEvent)(System::TObject* Sender, int State, int Error, System::AnsiString + MessageText); + +typedef void __fastcall (__closure *TOnError)(System::TObject* Sender, int ErrorCode, System::AnsiString + ErrorMessage); + +typedef void __fastcall (__closure *TOnActiveConn)(System::TObject* Sender, int Handle, const TRasConnStatusA + &Status, System::AnsiString StatusString, System::AnsiString EntryName, System::AnsiString DeviceType + , System::AnsiString DeviceName); + +enum TDialMode { dmAsync, dmSync }; + +enum TLanguage { English, Czech }; + +class DELPHICLASS TDialUp; +class PASCALIMPLEMENTATION TDialUp : public Classes::TComponent +{ + typedef Classes::TComponent inherited; + +private: + Classes::TStringList* FEntries; + TDialMode FDialMode; + System::AnsiString FEntry2Dial; + TLanguage FLanguage; + Extctrls::TTimer* FTimer; + TOnEntryGet FOnEntryGet; + TStandartEv FOnDialing; + TStandartEv FOnConnected; + TOnNotConn FOnNotConnected; + TOnAsyncEvent FOnAsyncEvent; + TOnError FOnError; + TOnActiveConn FOnActiveConn; + +protected: + virtual void __fastcall Timer(System::TObject* Sender); + +public: + int hRAS; + bool AsyncStatus; + int AMsg; + int AError; + int AState; + __fastcall virtual TDialUp(Classes::TComponent* AOwner); + __fastcall virtual ~TDialUp(void); + int __fastcall Dial(void); + int __fastcall GetEntries(void); + int __fastcall GetConnections(void); + int __fastcall HangUp(void); + int __fastcall HangUpConn(int Handle); + int __fastcall CreateEntry(void); + int __fastcall EditEntry(void); + int __fastcall DeleteEntry(void); + int __fastcall RenameEntryTo(System::AnsiString S); + int __fastcall SetEntryUserName(System::AnsiString Value); + int __fastcall SetEntryPassword(System::AnsiString Value); + int __fastcall RemovePassword(void); + int __fastcall GetEntryUserName(System::AnsiString &Value); + int __fastcall GetEntryPassword(System::AnsiString &Value); + System::AnsiString __fastcall StatusString(int State, int Error); + System::AnsiString __fastcall StatusStringCZ(int State, int Error); + +__published: + __property Name ; + __property Tag ; + __property TDialMode DialMode = {read=FDialMode, write=FDialMode, nodefault}; + __property Classes::TStringList* Entries = {read=FEntries}; + __property System::AnsiString Entry = {read=FEntry2Dial, write=FEntry2Dial}; + __property TLanguage Language = {read=FLanguage, write=FLanguage, nodefault}; + __property TOnEntryGet OnEntryGet = {read=FOnEntryGet, write=FOnEntryGet}; + __property TStandartEv OnDialing = {read=FOnDialing, write=FOnDialing}; + __property TStandartEv OnConnect = {read=FOnConnected, write=FOnConnected}; + __property TOnNotConn OnNotConnected = {read=FOnNotConnected, write=FOnNotConnected}; + __property TOnAsyncEvent OnAsyncEvent = {read=FOnAsyncEvent, write=FOnAsyncEvent}; + __property TOnError OnError = {read=FOnError, write=FOnError}; + __property TOnActiveConn OnActiveConnection = {read=FOnActiveConn, write=FOnActiveConn}; +}; + +//-- var, const, procedure --------------------------------------------------- +#define DNLEN (Byte)(15) +#define UNLEN (Word)(256) +#define PWLEN (Word)(256) +#define NETBIOS_NAME_LEN (Byte)(16) +#define RAS_MaxDeviceType (Byte)(16) +#define RAS_MaxPhoneNumber (Byte)(128) +#define RAS_MaxIpAddress (Byte)(15) +#define RAS_MaxIpxAddress (Byte)(21) +#define RAS_MaxEntryName (Word)(256) +#define RAS_MaxDeviceName (Byte)(128) +#define RAS_MaxCallbackNumber (Byte)(128) +#define RASCS_PAUSED (Word)(4096) +#define RASCS_DONE (Word)(8192) +#define RASCS_OpenPort (Byte)(0) +#define RASCS_PortOpened (Byte)(1) +#define RASCS_ConnectDevice (Byte)(2) +#define RASCS_DeviceConnected (Byte)(3) +#define RASCS_AllDevicesConnected (Byte)(4) +#define RASCS_Authenticate (Byte)(5) +#define RASCS_AuthNotify (Byte)(6) +#define RASCS_AuthRetry (Byte)(7) +#define RASCS_AuthCallback (Byte)(8) +#define RASCS_AuthChangePassword (Byte)(9) +#define RASCS_AuthProject (Byte)(10) +#define RASCS_AuthLinkSpeed (Byte)(11) +#define RASCS_AuthAck (Byte)(12) +#define RASCS_ReAuthenticate (Byte)(13) +#define RASCS_Authenticated (Byte)(14) +#define RASCS_PrepareForCallback (Byte)(15) +#define RASCS_WaitForModemReset (Byte)(16) +#define RASCS_WaitForCallback (Byte)(17) +#define RASCS_Projected (Byte)(18) +#define RASCS_StartAuthentication (Byte)(19) +#define RASCS_CallbackComplete (Byte)(20) +#define RASCS_LogonNetwork (Byte)(21) +#define RASCS_Interactive (Word)(4096) +#define RASCS_RetryAuthentication (Word)(4097) +#define RASCS_CallbackSetByCaller (Word)(4098) +#define RASCS_PasswordExpired (Word)(4099) +#define RASCS_Connected (Word)(8192) +#define RASCS_Disconnected (Word)(8193) +#define RDEOPT_UsePrefixSuffix (Byte)(1) +#define RDEOPT_PausedStates (Byte)(2) +#define RDEOPT_IgnoreModemSpeaker (Byte)(4) +#define RDEOPT_SetModemSpeaker (Byte)(8) +#define RDEOPT_IgnoreSoftwareCompression (Byte)(16) +#define RDEOPT_SetSoftwareCompression (Byte)(32) +#define RASP_Amb (int)(65536) +#define RASP_PppNbf (int)(32831) +#define RASP_PppIpx (int)(32811) +#define RASP_PppIp (int)(32801) +#define RASDIALEVENT "RasDialEvent" +#define WM_RASDIALEVENT (int)(52429) +#define RASBASE (Word)(600) +#define SUCCESS (Byte)(0) +#define PENDING (Word)(600) +#define ERROR_INVALID_PORT_HANDLE (Word)(601) +#define ERROR_PORT_ALREADY_OPEN (Word)(602) +#define ERROR_BUFFER_TOO_SMALL (Word)(603) +#define ERROR_WRONG_INFO_SPECIFIED (Word)(604) +#define ERROR_CANNOT_SET_PORT_INFO (Word)(605) +#define ERROR_PORT_NOT_CONNECTED (Word)(606) +#define ERROR_EVENT_INVALID (Word)(607) +#define ERROR_DEVICE_DOES_NOT_EXIST (Word)(608) +#define ERROR_DEVICETYPE_DOES_NOT_EXIST (Word)(609) +#define ERROR_BUFFER_INVALID (Word)(610) +#define ERROR_ROUTE_NOT_AVAILABLE (Word)(611) +#define ERROR_ROUTE_NOT_ALLOCATED (Word)(612) +#define ERROR_INVALID_COMPRESSION_SPECIFIED (Word)(613) +#define ERROR_OUT_OF_BUFFERS (Word)(614) +#define ERROR_PORT_NOT_FOUND (Word)(615) +#define ERROR_ASYNC_REQUEST_PENDING (Word)(616) +#define ERROR_ALREADY_DISCONNECTING (Word)(617) +#define ERROR_PORT_NOT_OPEN (Word)(618) +#define ERROR_PORT_DISCONNECTED (Word)(619) +#define ERROR_NO_ENDPOINTS (Word)(620) +#define ERROR_CANNOT_OPEN_PHONEBOOK (Word)(621) +#define ERROR_CANNOT_LOAD_PHONEBOOK (Word)(622) +#define ERROR_CANNOT_FIND_PHONEBOOK_ENTRY (Word)(623) +#define ERROR_CANNOT_WRITE_PHONEBOOK (Word)(624) +#define ERROR_CORRUPT_PHONEBOOK (Word)(625) +#define ERROR_CANNOT_LOAD_STRING (Word)(626) +#define ERROR_KEY_NOT_FOUND (Word)(627) +#define ERROR_DISCONNECTION (Word)(628) +#define ERROR_REMOTE_DISCONNECTION (Word)(629) +#define ERROR_HARDWARE_FAILURE (Word)(630) +#define ERROR_USER_DISCONNECTION (Word)(631) +#define ERROR_INVALID_SIZE (Word)(632) +#define ERROR_PORT_NOT_AVAILABLE (Word)(633) +#define ERROR_CANNOT_PROJECT_CLIENT (Word)(634) +#define ERROR_UNKNOWN (Word)(635) +#define ERROR_WRONG_DEVICE_ATTACHED (Word)(636) +#define ERROR_BAD_STRING (Word)(637) +#define ERROR_REQUEST_TIMEOUT (Word)(638) +#define ERROR_CANNOT_GET_LANA (Word)(639) +#define ERROR_NETBIOS_ERROR (Word)(640) +#define ERROR_SERVER_OUT_OF_RESOURCES (Word)(641) +#define ERROR_NAME_EXISTS_ON_NET (Word)(642) +#define ERROR_SERVER_GENERAL_NET_FAILURE (Word)(643) +#define WARNING_MSG_ALIAS_NOT_ADDED (Word)(644) +#define ERROR_AUTH_INTERNAL (Word)(645) +#define ERROR_RESTRICTED_LOGON_HOURS (Word)(646) +#define ERROR_ACCT_DISABLED (Word)(647) +#define ERROR_PASSWD_EXPIRED (Word)(648) +#define ERROR_NO_DIALIN_PERMISSION (Word)(649) +#define ERROR_SERVER_NOT_RESPONDING (Word)(650) +#define ERROR_FROM_DEVICE (Word)(651) +#define ERROR_UNRECOGNIZED_RESPONSE (Word)(652) +#define ERROR_MACRO_NOT_FOUND (Word)(653) +#define ERROR_MACRO_NOT_DEFINED (Word)(654) +#define ERROR_MESSAGE_MACRO_NOT_FOUND (Word)(655) +#define ERROR_DEFAULTOFF_MACRO_NOT_FOUND (Word)(656) +#define ERROR_FILE_COULD_NOT_BE_OPENED (Word)(657) +#define ERROR_DEVICENAME_TOO_LONG (Word)(658) +#define ERROR_DEVICENAME_NOT_FOUND (Word)(659) +#define ERROR_NO_RESPONSES (Word)(660) +#define ERROR_NO_COMMAND_FOUND (Word)(661) +#define ERROR_WRONG_KEY_SPECIFIED (Word)(662) +#define ERROR_UNKNOWN_DEVICE_TYPE (Word)(663) +#define ERROR_ALLOCATING_MEMORY (Word)(664) +#define ERROR_PORT_NOT_CONFIGURED (Word)(665) +#define ERROR_DEVICE_NOT_READY (Word)(666) +#define ERROR_READING_INI_FILE (Word)(667) +#define ERROR_NO_CONNECTION (Word)(668) +#define ERROR_BAD_USAGE_IN_INI_FILE (Word)(669) +#define ERROR_READING_SECTIONNAME (Word)(670) +#define ERROR_READING_DEVICETYPE (Word)(671) +#define ERROR_READING_DEVICENAME (Word)(672) +#define ERROR_READING_USAGE (Word)(673) +#define ERROR_READING_MAXCONNECTBPS (Word)(674) +#define ERROR_READING_MAXCARRIERBPS (Word)(675) +#define ERROR_LINE_BUSY (Word)(676) +#define ERROR_VOICE_ANSWER (Word)(677) +#define ERROR_NO_ANSWER (Word)(678) +#define ERROR_NO_CARRIER (Word)(679) +#define ERROR_NO_DIALTONE (Word)(680) +#define ERROR_IN_COMMAND (Word)(681) +#define ERROR_WRITING_SECTIONNAME (Word)(682) +#define ERROR_WRITING_DEVICETYPE (Word)(683) +#define ERROR_WRITING_DEVICENAME (Word)(684) +#define ERROR_WRITING_MAXCONNECTBPS (Word)(685) +#define ERROR_WRITING_MAXCARRIERBPS (Word)(686) +#define ERROR_WRITING_USAGE (Word)(687) +#define ERROR_WRITING_DEFAULTOFF (Word)(688) +#define ERROR_READING_DEFAULTOFF (Word)(689) +#define ERROR_EMPTY_INI_FILE (Word)(690) +#define ERROR_AUTHENTICATION_FAILURE (Word)(691) +#define ERROR_PORT_OR_DEVICE (Word)(692) +#define ERROR_NOT_BINARY_MACRO (Word)(693) +#define ERROR_DCB_NOT_FOUND (Word)(694) +#define ERROR_STATE_MACHINES_NOT_STARTED (Word)(695) +#define ERROR_STATE_MACHINES_ALREADY_STARTED (Word)(696) +#define ERROR_PARTIAL_RESPONSE_LOOPING (Word)(697) +#define ERROR_UNKNOWN_RESPONSE_KEY (Word)(698) +#define ERROR_RECV_BUF_FULL (Word)(699) +#define ERROR_CMD_TOO_LONG (Word)(700) +#define ERROR_UNSUPPORTED_BPS (Word)(701) +#define ERROR_UNEXPECTED_RESPONSE (Word)(702) +#define ERROR_INTERACTIVE_MODE (Word)(703) +#define ERROR_BAD_CALLBACK_NUMBER (Word)(704) +#define ERROR_INVALID_AUTH_STATE (Word)(705) +#define ERROR_WRITING_INITBPS (Word)(706) +#define ERROR_X25_DIAGNOSTIC (Word)(707) +#define ERROR_ACCT_EXPIRED (Word)(708) +#define ERROR_CHANGING_PASSWORD (Word)(709) +#define ERROR_OVERRUN (Word)(710) +#define ERROR_RASMAN_CANNOT_INITIALIZE (Word)(711) +#define ERROR_BIPLEX_PORT_NOT_AVAILABLE (Word)(712) +#define ERROR_NO_ACTIVE_ISDN_LINES (Word)(713) +#define ERROR_NO_ISDN_CHANNELS_AVAILABLE (Word)(714) +#define ERROR_TOO_MANY_LINE_ERRORS (Word)(715) +#define ERROR_IP_CONFIGURATION (Word)(716) +#define ERROR_NO_IP_ADDRESSES (Word)(717) +#define ERROR_PPP_TIMEOUT (Word)(718) +#define ERROR_PPP_REMOTE_TERMINATED (Word)(719) +#define ERROR_PPP_NO_PROTOCOLS_CONFIGURED (Word)(720) +#define ERROR_PPP_NO_RESPONSE (Word)(721) +#define ERROR_PPP_INVALID_PACKET (Word)(722) +#define ERROR_PHONE_NUMBER_TOO_LONG (Word)(723) +#define ERROR_IPXCP_NO_DIALOUT_CONFIGURED (Word)(724) +#define ERROR_IPXCP_NO_DIALIN_CONFIGURED (Word)(725) +#define ERROR_IPXCP_DIALOUT_ALREADY_ACTIVE (Word)(726) +#define ERROR_ACCESSING_TCPCFGDLL (Word)(727) +#define ERROR_NO_IP_RAS_ADAPTER (Word)(728) +#define ERROR_SLIP_REQUIRES_IP (Word)(729) +#define ERROR_PROJECTION_NOT_COMPLETE (Word)(730) +#define ERROR_PROTOCOL_NOT_CONFIGURED (Word)(731) +#define ERROR_PPP_NOT_CONVERGING (Word)(732) +#define ERROR_PPP_CP_REJECTED (Word)(733) +#define ERROR_PPP_LCP_TERMINATED (Word)(734) +#define ERROR_PPP_REQUIRED_ADDRESS_REJECTED (Word)(735) +#define ERROR_PPP_NCP_TERMINATED (Word)(736) +#define ERROR_PPP_LOOPBACK_DETECTED (Word)(737) +#define ERROR_PPP_NO_ADDRESS_ASSIGNED (Word)(738) +#define ERROR_CANNOT_USE_LOGON_CREDENTIALS (Word)(739) +#define ERROR_TAPI_CONFIGURATION (Word)(740) +#define ERROR_NO_LOCAL_ENCRYPTION (Word)(741) +#define ERROR_NO_REMOTE_ENCRYPTION (Word)(742) +#define ERROR_REMOTE_REQUIRES_ENCRYPTION (Word)(743) +#define ERROR_IPXCP_NET_NUMBER_CONFLICT (Word)(744) +#define ERROR_INVALID_SMM (Word)(745) +#define ERROR_SMM_UNINITIALIZED (Word)(746) +#define ERROR_NO_MAC_FOR_PORT (Word)(747) +#define ERROR_SMM_TIMEOUT (Word)(748) +#define ERROR_BAD_PHONE_NUMBER (Word)(749) +#define ERROR_WRONG_MODULE (Word)(750) +#define RASBASEEND (Word)(750) +#define RAS_MaxAreaCode (Byte)(10) +#define RAS_MaxPadType (Byte)(32) +#define RAS_MaxX25Address (Byte)(200) +#define RAS_MaxFacilities (Byte)(200) +#define RAS_MaxUserData (Byte)(200) +#define RASEO_UseCountryAndAreaCodes (Byte)(1) +#define RASEO_SpecificIpAddr (Byte)(2) +#define RASEO_SpecificNameServers (Byte)(4) +#define RASEO_IpHeaderCompression (Byte)(8) +#define RASEO_RemoteDefaultGateway (Byte)(16) +#define RASEO_DisableLcpExtensions (Byte)(32) +#define RASEO_TerminalBeforeDial (Byte)(64) +#define RASEO_TerminalAfterDial (Byte)(128) +#define RASEO_ModemLights (Word)(256) +#define RASEO_SwCompression (Word)(512) +#define RASEO_RequireEncryptedPw (Word)(1024) +#define RASEO_RequireMsEncryptedPw (Word)(2048) +#define RASEO_RequireDataEncryption (Word)(4096) +#define RASEO_NetworkLogon (Word)(8192) +#define RASEO_UseLogonCredentials (Word)(16384) +#define RASEO_PromoteAlternates (int)(32768) +#define RASNP_Netbeui (Byte)(1) +#define RASNP_Ipx (Byte)(2) +#define RASNP_Ip (Byte)(4) +#define RASFP_Ppp (Byte)(1) +#define RASFP_Slip (Byte)(2) +#define RASFP_Ras (Byte)(4) +#define RASDT_Modem "modem" +#define RASDT_Isdn "isdn" +#define RASDT_X25 "x25" +#define MaxEntries (Byte)(100) +extern PACKAGE void __fastcall Register(void); +extern "C" int __stdcall RasCreatePhonebookEntryA(HWND hwndParentWindow, char * lpszPhoneBook); +extern "C" int __stdcall RasCreatePhonebookEntryW(HWND hwndParentWindow, wchar_t * lpszPhoneBook); +extern "C" int __stdcall RasCreatePhonebookEntry(HWND hwndParentWindow, char * lpszPhoneBook); +extern "C" int __stdcall RasDialA(LPRasDialExtensions lpRasDialExt, char * lpszPhoneBook, TRasDialParamsA + ¶ms, int dwNotifierType, void * lpNotifier, int &rasconn); +extern "C" int __stdcall RasDialW(LPRasDialExtensions lpRasDialExt, wchar_t * lpszPhoneBook, TRasDialParamsW + ¶ms, int dwNotifierType, void * lpNotifier, int &rasconn); +extern "C" int __stdcall RasDial(LPRasDialExtensions lpRasDialExt, char * lpszPhoneBook, TRasDialParamsA + ¶ms, int dwNotifierType, void * lpNotifier, int &rasconn); +extern "C" int __stdcall RasEditPhonebookEntryA(HWND hwndParentWindow, char * lpszPhoneBook, char * + lpszEntryName); +extern "C" int __stdcall RasEditPhonebookEntryW(HWND hwndParentWindow, wchar_t * lpszPhoneBook, wchar_t * + lpszEntryName); +extern "C" int __stdcall RasEditPhonebookEntry(HWND hwndParentWindow, char * lpszPhoneBook, char * lpszEntryName + ); +extern "C" int __stdcall RasEnumConnectionsA(LPRasConnA RasConnArray, int &lpcb, int &lpcConnections + ); +extern "C" int __stdcall RasEnumConnectionsW(LPRasConnW RasConnArray, int &lpcb, int &lpcConnections + ); +extern "C" int __stdcall RasEnumConnections(LPRasConn RasConnArray, int &lpcb, int &lpcConnections); + +extern "C" int __stdcall RasEnumEntriesA(char * Reserved, char * lpszPhoneBook, LPRasEntryNameA entrynamesArray + , int &lpcb, int &lpcEntries); +extern "C" int __stdcall RasEnumEntriesW(wchar_t * reserved, wchar_t * lpszPhoneBook, LPRasEntryNameW + entrynamesArray, int &lpcb, int &lpcEntries); +extern "C" int __stdcall RasEnumEntries(char * reserved, char * lpszPhoneBook, LPRasEntryName entrynamesArray + , int &lpcb, int &lpcEntries); +extern "C" int __stdcall RasGetConnectStatusA(int hConn, TRasConnStatusA &lpStatus); +extern "C" int __stdcall RasGetConnectStatusW(int hConn, TRasConnStatusW &lpStatus); +extern "C" int __stdcall RasGetConnectStatus(int hConn, TRasConnStatusA &lpStatus); +extern "C" int __stdcall RasGetEntryDialParamsA(char * lpszPhoneBook, TRasDialParamsA &lpDialParams, + BOOL &lpfPassword); +extern "C" int __stdcall RasGetEntryDialParamsW(wchar_t * lpszPhoneBook, TRasDialParamsW &lpDialParams + , BOOL &lpfPassword); +extern "C" int __stdcall RasGetEntryDialParams(char * lpszPhoneBook, TRasDialParamsA &lpDialParams, + BOOL &lpfPassword); +extern "C" int __stdcall RasGetErrorStringA(int errorValue, char * erroString, int cBufSize); +extern "C" int __stdcall RasGetErrorStringW(int errorValue, wchar_t * erroString, int cBufSize); +extern "C" int __stdcall RasGetErrorString(int errorValue, char * erroString, int cBufSize); +extern "C" int __stdcall RasGetProjectionInfoA(int hConn, int rasproj, void * lpProjection, int &lpcb + ); +extern "C" int __stdcall RasGetProjectionInfoW(int hConn, int rasproj, void * lpProjection, int &lpcb + ); +extern "C" int __stdcall RasGetProjectionInfo(int hConn, int rasproj, void * lpProjection, int &lpcb + ); +extern "C" int __stdcall RasHangUpA(int hConn); +extern "C" int __stdcall RasHangUpW(int hConn); +extern "C" int __stdcall RasHangUp(int hConn); +extern "C" int __stdcall RasSetEntryDialParamsA(char * lpszPhoneBook, TRasDialParamsA &lpDialParams, + BOOL fRemovePassword); +extern "C" int __stdcall RasSetEntryDialParamsW(wchar_t * lpszPhoneBook, TRasDialParamsW &lpDialParams + , BOOL fRemovePassword); +extern "C" int __stdcall RasSetEntryDialParams(char * lpszPhoneBook, TRasDialParamsA &lpDialParams, + BOOL fRemovePassword); +extern "C" int __stdcall RasValidateEntryNameA(char * lpszPhonebook, char * szEntry); +extern "C" int __stdcall RasValidateEntryNameW(wchar_t * lpszPhonebook, wchar_t * szEntry); +extern "C" int __stdcall RasRenameEntryA(char * lpszPhonebook, char * szEntryOld, char * szEntryNew) + ; +extern "C" int __stdcall RasRenameEntryW(wchar_t * lpszPhonebook, wchar_t * szEntryOld, wchar_t * szEntryNew + ); +extern "C" int __stdcall RasDeleteEntryA(char * lpszPhonebook, char * szEntry); +extern "C" int __stdcall RasDeleteEntryW(wchar_t * lpszPhonebook, wchar_t * szEntry); +extern "C" int __stdcall RasGetEntryPropertiesA(char * lpszPhonebook, char * szEntry, void * lpbEntry + , int &lpdwEntrySize, void * lpbDeviceInfo, int &lpdwDeviceInfoSize); +extern "C" int __stdcall RasGetEntryPropertiesW(wchar_t * lpszPhonebook, wchar_t * szEntry, void * lpbEntry + , int &lpdwEntrySize, void * lpbDeviceInfo, int &lpdwDeviceInfoSize); +extern "C" int __stdcall RasSetEntryPropertiesA(char * lpszPhonebook, char * szEntry, void * lpbEntry + , int dwEntrySize, void * lpbDeviceInfo, int dwDeviceInfoSize); +extern "C" int __stdcall RasSetEntryPropertiesW(wchar_t * lpszPhonebook, wchar_t * szEntry, void * lpbEntry + , int dwEntrySize, void * lpbDeviceInfo, int dwDeviceInfoSize); +extern "C" int __stdcall RasGetCountryInfoA(TRasCtryInfo &lpCtryInfo, int &lpdwSize); +extern "C" int __stdcall RasGetCountryInfoW(TRasCtryInfo &lpCtryInfo, int &lpdwSize); +extern "C" int __stdcall RasEnumDevicesA(LPRasDevInfoA lpBuff, int &lpcbSize, int &lpcDevices); +extern "C" int __stdcall RasEnumDevicesW(LPRasDevInfoW lpBuff, int &lpcbSize, int &lpcDevices); +extern PACKAGE int __stdcall RasValidateEntryName(char * lpszPhonebook, char * szEntry); +extern PACKAGE int __stdcall RasRenameEntry(char * lpszPhonebook, char * szEntryOld, char * szEntryNew + ); +extern PACKAGE int __stdcall RasDeleteEntry(char * lpszPhonebook, char * szEntry); +extern PACKAGE int __stdcall RasGetEntryProperties(char * lpszPhonebook, char * szEntry, void * lpbEntry + , int &lpdwEntrySize, void * lpbDeviceInfo, int &lpdwDeviceInfoSize); +extern PACKAGE int __stdcall RasSetEntryProperties(char * lpszPhonebook, char * szEntry, void * lpbEntry + , int dwEntrySize, void * lpbDeviceInfo, int dwDeviceInfoSize); +extern PACKAGE int __stdcall RasGetCountryInfo(TRasCtryInfo &lpCtryInfo, int &lpdwSize); +extern PACKAGE int __stdcall RasEnumDevices(LPRasDevInfo lpBuff, int &lpcbSize, int &lpcDevices); + +#if defined(UNICODE) +inline int __stdcall RasDial(LPRasDialExtensions lpRasDialExt, char * lpszPhoneBook, TRasDialParamsA + ¶ms, int dwNotifierType, void * lpNotifier, int &rasconn) +{ + return RasDialW(lpRasDialExt, lpszPhoneBook, params, dwNotifierType, lpNotifier, rasconn); +} +#else +inline int __stdcall RasDial(LPRasDialExtensions lpRasDialExt, char * lpszPhoneBook, TRasDialParamsA + ¶ms, int dwNotifierType, void * lpNotifier, int &rasconn) +{ + return RasDialA(lpRasDialExt, lpszPhoneBook, params, dwNotifierType, lpNotifier, rasconn); +} +#endif + + +#if defined(UNICODE) +inline int __stdcall RasEnumConnections(LPRasConn RasConnArray, int &lpcb, int &lpcConnections) +{ + return RasEnumConnectionsW(RasConnArray, lpcb, lpcConnections); +} +#else +inline int __stdcall RasEnumConnections(LPRasConn RasConnArray, int &lpcb, int &lpcConnections) +{ + return RasEnumConnectionsA(RasConnArray, lpcb, lpcConnections); +} +#endif + + +#if defined(UNICODE) +inline int __stdcall RasEnumEntries(char * reserved, char * lpszPhoneBook, LPRasEntryName entrynamesArray + , int &lpcb, int &lpcEntries) +{ + return RasEnumEntriesW(reserved, lpszPhoneBook, entrynamesArray, lpcb, lpcEntries); +} +#else +inline int __stdcall RasEnumEntries(char * reserved, char * lpszPhoneBook, LPRasEntryName entrynamesArray + , int &lpcb, int &lpcEntries) +{ + return RasEnumEntriesA(Reserved, lpszPhoneBook, entrynamesArray, lpcb, lpcEntries); +} +#endif + + +#if defined(UNICODE) +inline int __stdcall RasGetConnectStatus(int hConn, TRasConnStatusA &lpStatus) +{ + return RasGetConnectStatusW(hConn, lpStatus); +} +#else +inline int __stdcall RasGetConnectStatus(int hConn, TRasConnStatusA &lpStatus) +{ + return RasGetConnectStatusA(hConn, lpStatus); +} +#endif + + +#if defined(UNICODE) +inline int __stdcall RasGetErrorString(int errorValue, char * erroString, int cBufSize) +{ + return RasGetErrorStringW(errorValue, erroString, cBufSize); +} +#else +inline int __stdcall RasGetErrorString(int errorValue, char * erroString, int cBufSize) +{ + return RasGetErrorStringA(errorValue, erroString, cBufSize); +} +#endif + + +#if defined(UNICODE) +inline int __stdcall RasHangUp(int hConn) +{ + return RasHangUpW(hConn); +} +#else +inline int __stdcall RasHangUp(int hConn) +{ + return RasHangUpA(hConn); +} +#endif + + +#if defined(UNICODE) +inline int __stdcall RasGetProjectionInfo(int hConn, int rasproj, void * lpProjection, int &lpcb) +{ + return RasGetProjectionInfoW(hConn, rasproj, lpProjection, lpcb); +} +#else +inline int __stdcall RasGetProjectionInfo(int hConn, int rasproj, void * lpProjection, int &lpcb) +{ + return RasGetProjectionInfoA(hConn, rasproj, lpProjection, lpcb); +} +#endif + + +#if defined(UNICODE) +inline int __stdcall RasCreatePhonebookEntry(HWND hwndParentWindow, char * lpszPhoneBook) +{ + return RasCreatePhonebookEntryW(hwndParentWindow, lpszPhoneBook); +} +#else +inline int __stdcall RasCreatePhonebookEntry(HWND hwndParentWindow, char * lpszPhoneBook) +{ + return RasCreatePhonebookEntryA(hwndParentWindow, lpszPhoneBook); +} +#endif + + +#if defined(UNICODE) +inline int __stdcall RasEditPhonebookEntry(HWND hwndParentWindow, char * lpszPhoneBook, char * lpszEntryName + ) +{ + return RasEditPhonebookEntryW(hwndParentWindow, lpszPhoneBook, lpszEntryName); +} +#else +inline int __stdcall RasEditPhonebookEntry(HWND hwndParentWindow, char * lpszPhoneBook, char * lpszEntryName + ) +{ + return RasEditPhonebookEntryA(hwndParentWindow, lpszPhoneBook, lpszEntryName); +} +#endif + + +#if defined(UNICODE) +inline int __stdcall RasSetEntryDialParams(char * lpszPhoneBook, TRasDialParamsA &lpDialParams, BOOL + fRemovePassword) +{ + return RasSetEntryDialParamsW(lpszPhoneBook, lpDialParams, fRemovePassword); +} +#else +inline int __stdcall RasSetEntryDialParams(char * lpszPhoneBook, TRasDialParamsA &lpDialParams, BOOL + fRemovePassword) +{ + return RasSetEntryDialParamsA(lpszPhoneBook, lpDialParams, fRemovePassword); +} +#endif + + +#if defined(UNICODE) +inline int __stdcall RasGetEntryDialParams(char * lpszPhoneBook, TRasDialParamsA &lpDialParams, BOOL + &lpfPassword) +{ + return RasGetEntryDialParamsW(lpszPhoneBook, lpDialParams, lpfPassword); +} +#else +inline int __stdcall RasGetEntryDialParams(char * lpszPhoneBook, TRasDialParamsA &lpDialParams, BOOL + &lpfPassword) +{ + return RasGetEntryDialParamsA(lpszPhoneBook, lpDialParams, lpfPassword); +} +#endif + + +} /* namespace Dialup */ +#if !defined(NO_IMPLICIT_NAMESPACE_USE) +using namespace Dialup; +#endif +//-- end unit ---------------------------------------------------------------- +#endif // DialUp diff --git a/CDopping/DialUp/Dialup.pas b/CDopping/DialUp/Dialup.pas new file mode 100644 index 0000000..4b63855 --- /dev/null +++ b/CDopping/DialUp/Dialup.pas @@ -0,0 +1,1561 @@ +(****************************************** |****************************************** + * DIALUP, telefonicke pripojeni site * |* DIALUP, dial-up networking component * + * komponenta pro Delphi 3 (32b) * |* for Delphi 3 (32b) * + * (c) 1998 BEALsoft * |* (c) 1998 BEALsoft * + * v1.0 * |* v1.0 * + *________________________________________* |*________________________________________* + * !! TATO KOMPONENTA JE ZDARMA !! * |* !! THIS COMPONENT IS FREE !! * + ****************************************** |******************************************) +// Kontakt na autora // Contact to author : +// aberka@usa.net, ICQ UIN 2365308, http://members.xoom.com/aberka +// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +// See README.TXT for details, description of properties and methods +// Prectete si CTIMNE.TXT, kde jsou popsany vsechny dulezite funkce a vlastnosti + +// Thanx to Davide Moretti for his RAS API header (Some code in this component +// was written by him). You can reach him via e-mail: dmoretti@iper.net + +unit DialUp; + +interface + +uses + SysUtils, Windows, Dialogs, Classes, ExtCtrls, Forms, Messages; + +{******************************************************} +{******************************************************} +{******************************************************} +// RAS API header by Davide Moretti +{******************************************************} +{******************************************************} +{******************************************************} +(*RASAPI*){* Copyright (c) 1992-1995, Microsoft Corporation, all rights reserved +(*RASAPI*)** +(*RASAPI*)** ras.h +(*RASAPI*)** Remote Access external API +(*RASAPI*)** Public header for external API clients +(*RASAPI*)*} +(*RASAPI*) +(*RASAPI*){ Delphi conversion by Davide Moretti } +(*RASAPI*){ Note: All functions and structures defaults to Ansi. If you want to use +(*RASAPI*) Unicode structs and funcs, use the names ending with 'W' } +(*RASAPI*) +(*RASAPI*)const +(*RASAPI*){ These are from lmcons.h } +(*RASAPI*) DNLEN = 15; // Maximum domain name length +(*RASAPI*) UNLEN = 256; // Maximum user name length +(*RASAPI*) PWLEN = 256; // Maximum password length +(*RASAPI*) NETBIOS_NAME_LEN = 16; // NetBIOS net name (bytes) +(*RASAPI*) +(*RASAPI*) RAS_MaxDeviceType = 16; +(*RASAPI*) RAS_MaxPhoneNumber = 128; +(*RASAPI*) RAS_MaxIpAddress = 15; +(*RASAPI*) RAS_MaxIpxAddress = 21; +(*RASAPI*) RAS_MaxEntryName = 256; +(*RASAPI*) RAS_MaxDeviceName = 128; +(*RASAPI*) RAS_MaxCallbackNumber = RAS_MaxPhoneNumber; +(*RASAPI*) +(*RASAPI*)type +(*RASAPI*) LPHRasConn = ^THRasConn; +(*RASAPI*) THRasConn = Longint; +(*RASAPI*) +(*RASAPI*){* Identifies an active RAS connection. (See RasEnumConnections) *} +(*RASAPI*) LPRasConnW = ^TRasConnW; +(*RASAPI*) TRasConnW = record +(*RASAPI*) dwSize : Longint; +(*RASAPI*) hrasconn : THRasConn; +(*RASAPI*) szEntryName : Array[0..RAS_MaxEntryName] of WideChar; +(*RASAPI*) szDeviceType : Array[0..RAS_MaxDeviceType] of WideChar; +(*RASAPI*) szDeviceName : Array[0..RAS_MaxDeviceName] of WideChar; +(*RASAPI*) end; +(*RASAPI*) +(*RASAPI*) LPRasConnA = ^TRasConnA; +(*RASAPI*) TRasConnA = record +(*RASAPI*) dwSize : Longint; +(*RASAPI*) hrasconn : THRasConn; +(*RASAPI*) szEntryName : Array[0..RAS_MaxEntryName] of AnsiChar; +(*RASAPI*) szDeviceType : Array[0..RAS_MaxDeviceType] of AnsiChar; +(*RASAPI*) szDeviceName : Array[0..RAS_MaxDeviceName] of AnsiChar; +(*RASAPI*) end; +(*RASAPI*) +(*RASAPI*) LPRasConn = ^TRasConn; +(*RASAPI*) TRasConn = TRasConnA; +(*RASAPI*) +(*RASAPI*)const +(*RASAPI*){* Enumerates intermediate states to a connection. (See RasDial) *} +(*RASAPI*) RASCS_PAUSED = $1000; +(*RASAPI*) RASCS_DONE = $2000; +(*RASAPI*) +(*RASAPI*)type +(*RASAPI*) LPRasConnState = ^TRasConnState; +(*RASAPI*) TRasConnState = Integer; +(*RASAPI*) +(*RASAPI*)const +(*RASAPI*) RASCS_OpenPort = 0; +(*RASAPI*) RASCS_PortOpened = 1; +(*RASAPI*) RASCS_ConnectDevice = 2; +(*RASAPI*) RASCS_DeviceConnected = 3; +(*RASAPI*) RASCS_AllDevicesConnected = 4; +(*RASAPI*) RASCS_Authenticate = 5; +(*RASAPI*) RASCS_AuthNotify = 6; +(*RASAPI*) RASCS_AuthRetry = 7; +(*RASAPI*) RASCS_AuthCallback = 8; +(*RASAPI*) RASCS_AuthChangePassword = 9; +(*RASAPI*) RASCS_AuthProject = 10; +(*RASAPI*) RASCS_AuthLinkSpeed = 11; +(*RASAPI*) RASCS_AuthAck = 12; +(*RASAPI*) RASCS_ReAuthenticate = 13; +(*RASAPI*) RASCS_Authenticated = 14; +(*RASAPI*) RASCS_PrepareForCallback = 15; +(*RASAPI*) RASCS_WaitForModemReset = 16; +(*RASAPI*) RASCS_WaitForCallback = 17; +(*RASAPI*) RASCS_Projected = 18; +(*RASAPI*) RASCS_StartAuthentication = 19; +(*RASAPI*) RASCS_CallbackComplete = 20; +(*RASAPI*) RASCS_LogonNetwork = 21; +(*RASAPI*) +(*RASAPI*) RASCS_Interactive = RASCS_PAUSED; +(*RASAPI*) RASCS_RetryAuthentication = RASCS_PAUSED + 1; +(*RASAPI*) RASCS_CallbackSetByCaller = RASCS_PAUSED + 2; +(*RASAPI*) RASCS_PasswordExpired = RASCS_PAUSED + 3; +(*RASAPI*) +(*RASAPI*) RASCS_Connected = RASCS_DONE; +(*RASAPI*) RASCS_Disconnected = RASCS_DONE + 1; +(*RASAPI*) +(*RASAPI*)type +(*RASAPI*){* Describes the status of a RAS connection. (See RasConnectionStatus)*} +(*RASAPI*) LPRasConnStatusW = ^TRasConnStatusW; +(*RASAPI*) TRasConnStatusW = record +(*RASAPI*) dwSize : Longint; +(*RASAPI*) rasconnstate : TRasConnState; +(*RASAPI*) dwError : LongInt; +(*RASAPI*) szDeviceType : Array[0..RAS_MaxDeviceType] of WideChar; +(*RASAPI*) szDeviceName : Array[0..RAS_MaxDeviceName] of WideChar; +(*RASAPI*) end; +(*RASAPI*) +(*RASAPI*) LPRasConnStatusA = ^TRasConnStatusA; +(*RASAPI*) TRasConnStatusA = record +(*RASAPI*) dwSize : Longint; +(*RASAPI*) rasconnstate : TRasConnState; +(*RASAPI*) dwError : LongInt; +(*RASAPI*) szDeviceType : Array[0..RAS_MaxDeviceType] of AnsiChar; +(*RASAPI*) szDeviceName : Array[0..RAS_MaxDeviceName] of AnsiChar; +(*RASAPI*) end; +(*RASAPI*) +(*RASAPI*) LPRasConnStatus = ^TRasConnStatus; +(*RASAPI*) TRasConnStatus = TRasConnStatusA; +(*RASAPI*) +(*RASAPI*){* Describes connection establishment parameters. (See RasDial)*} +(*RASAPI*) LPRasDialParamsW = ^TRasDialParamsW; +(*RASAPI*) TRasDialParamsW = record +(*RASAPI*) dwSize : LongInt; +(*RASAPI*) szEntryName : Array[0..RAS_MaxEntryName] of WideChar; +(*RASAPI*) szPhoneNumber : Array[0..RAS_MaxPhoneNumber] of WideChar; +(*RASAPI*) szCallbackNumber : Array[0..RAS_MaxCallbackNumber] of WideChar; +(*RASAPI*) szUserName : Array[0..UNLEN] of WideChar; +(*RASAPI*) szPassword : Array[0..PWLEN] of WideChar; +(*RASAPI*) szDomain : Array[0..DNLEN] of WideChar; +(*RASAPI*) end; +(*RASAPI*) +(*RASAPI*) LPRasDialParamsA = ^TRasDialParamsA; +(*RASAPI*) TRasDialParamsA = record +(*RASAPI*) dwSize : LongInt; +(*RASAPI*) szEntryName : Array[0..RAS_MaxEntryName] of AnsiChar; +(*RASAPI*) szPhoneNumber : Array[0..RAS_MaxPhoneNumber] of AnsiChar; +(*RASAPI*) szCallbackNumber : Array[0..RAS_MaxCallbackNumber] of AnsiChar; +(*RASAPI*) szUserName : Array[0..UNLEN] of AnsiChar; +(*RASAPI*) szPassword : Array[0..PWLEN] of AnsiChar; +(*RASAPI*) szDomain : Array[0..DNLEN] of AnsiChar; +(*RASAPI*) end; +(*RASAPI*) +(*RASAPI*) LPRasDialParams = ^TRasDialParams; +(*RASAPI*) TRasDialParams = TRasDialParamsA; +(*RASAPI*) +(*RASAPI*){* Describes extended connection establishment options. (See RasDial)*} +(*RASAPI*) LPRasDialExtensions = ^TRasDialExtensions; +(*RASAPI*) TRasDialExtensions = record +(*RASAPI*) dwSize : LongInt; +(*RASAPI*) dwfOptions : LongInt; +(*RASAPI*) hwndParent : HWND; +(*RASAPI*) reserved : LongInt; +(*RASAPI*) end; +(*RASAPI*) +(*RASAPI*)const +(*RASAPI*){* 'dwfOptions' bit flags.*} +(*RASAPI*) RDEOPT_UsePrefixSuffix = $00000001; +(*RASAPI*) RDEOPT_PausedStates = $00000002; +(*RASAPI*) RDEOPT_IgnoreModemSpeaker = $00000004; +(*RASAPI*) RDEOPT_SetModemSpeaker = $00000008; +(*RASAPI*) RDEOPT_IgnoreSoftwareCompression = $00000010; +(*RASAPI*) RDEOPT_SetSoftwareCompression = $00000020; +(*RASAPI*) +(*RASAPI*) +(*RASAPI*)type +(*RASAPI*) +(*RASAPI*){* Describes an enumerated RAS phone book entry name. (See RasEntryEnum)*} +(*RASAPI*) LPRasEntryNameW = ^TRasEntryNameW; +(*RASAPI*) TRasEntryNameW = record +(*RASAPI*) dwSize : Longint; +(*RASAPI*) szEntryName : Array[0..RAS_MaxEntryName] of WideChar; +(*RASAPI*) end; +(*RASAPI*) +(*RASAPI*) LPRasEntryNameA = ^TRasEntryNameA; +(*RASAPI*) TRasEntryNameA = record +(*RASAPI*) dwSize : Longint; +(*RASAPI*) szEntryName : Array[0..RAS_MaxEntryName] of AnsiChar; +(*RASAPI*) end; +(*RASAPI*) +(*RASAPI*) LPRasEntryName = ^TRasEntryName; +(*RASAPI*) TRasEntryName = TRasEntryNameA; +(*RASAPI*) +(*RASAPI*){* Protocol code to projection data structure mapping.*} +(*RASAPI*) LPRasProjection = ^TRasProjection; +(*RASAPI*) TRasProjection = Integer; +(*RASAPI*) +(*RASAPI*)const +(*RASAPI*) RASP_Amb = $10000; +(*RASAPI*) RASP_PppNbf = $803F; +(*RASAPI*) RASP_PppIpx = $802B; +(*RASAPI*) RASP_PppIp = $8021; +(*RASAPI*) +(*RASAPI*) +(*RASAPI*)type +(*RASAPI*){* Describes the result of a RAS AMB (Authentication Message Block) +(*RASAPI*)** projection. This protocol is used with NT 3.1 and OS/2 1.3 downlevel +(*RASAPI*)** RAS servers.*} +(*RASAPI*) LPRasAmbW = ^TRasAmbW; +(*RASAPI*) TRasAmbW = record +(*RASAPI*) dwSize : Longint; +(*RASAPI*) dwError : Longint; +(*RASAPI*) szNetBiosError : Array[0..NETBIOS_NAME_LEN] of WideChar; +(*RASAPI*) bLana : Byte; +(*RASAPI*) end; +(*RASAPI*) +(*RASAPI*) LPRasAmbA = ^TRasAmbA; +(*RASAPI*) TRasAmbA = record +(*RASAPI*) dwSize : Longint; +(*RASAPI*) dwError : Longint; +(*RASAPI*) szNetBiosError : Array[0..NETBIOS_NAME_LEN] of AnsiChar; +(*RASAPI*) bLana : Byte; +(*RASAPI*) end; +(*RASAPI*) +(*RASAPI*) LPRasAmb = ^TRasAmb; +(*RASAPI*) TRasAmb = TRasAmbA; +(*RASAPI*) +(*RASAPI*){* Describes the result of a PPP NBF (NetBEUI) projection.*} +(*RASAPI*) LPRasPppNbfW = ^TRasPppNbfW; +(*RASAPI*) TRasPppNbfW = record +(*RASAPI*) dwSize : Longint; +(*RASAPI*) dwError : Longint; +(*RASAPI*) dwNetBiosError : Longint; +(*RASAPI*) szNetBiosError : Array[0..NETBIOS_NAME_LEN] of WideChar; +(*RASAPI*) szWorkstationName : Array[0..NETBIOS_NAME_LEN] of WideChar; +(*RASAPI*) bLana : Byte; +(*RASAPI*) end; +(*RASAPI*) +(*RASAPI*) LPRasPppNbfA = ^TRasPppNbfA; +(*RASAPI*) TRasPppNbfA = record +(*RASAPI*) dwSize : Longint; +(*RASAPI*) dwError : Longint; +(*RASAPI*) dwNetBiosError : Longint; +(*RASAPI*) szNetBiosError : Array[0..NETBIOS_NAME_LEN] of AnsiChar; +(*RASAPI*) szWorkstationName : Array[0..NETBIOS_NAME_LEN] of AnsiChar; +(*RASAPI*) bLana : Byte; +(*RASAPI*) end; +(*RASAPI*) +(*RASAPI*) LpRaspppNbf = ^TRasPppNbf; +(*RASAPI*) TRasPppNbf = TRasPppNbfA; +(*RASAPI*) +(*RASAPI*){* Describes the results of a PPP IPX (Internetwork Packet Exchange) +(*RASAPI*)** projection.*} +(*RASAPI*) LPRasPppIpxW = ^TRasPppIpxW; +(*RASAPI*) TRasPppIpxW = record +(*RASAPI*) dwSize : Longint; +(*RASAPI*) dwError : Longint; +(*RASAPI*) szIpxAddress : Array[0..RAS_MaxIpxAddress] of WideChar; +(*RASAPI*) end; +(*RASAPI*) +(*RASAPI*) LPRasPppIpxA = ^TRasPppIpxA; +(*RASAPI*) TRasPppIpxA = record +(*RASAPI*) dwSize : Longint; +(*RASAPI*) dwError : Longint; +(*RASAPI*) szIpxAddress : Array[0..RAS_MaxIpxAddress] of AnsiChar; +(*RASAPI*) end; +(*RASAPI*) +(*RASAPI*) LPRasPppIpx = ^TRasPppIpx; +(*RASAPI*) TRasPppIpx = TRasPppIpxA; +(*RASAPI*) +(*RASAPI*){* Describes the results of a PPP IP (Internet) projection.*} +(*RASAPI*) LPRasPppIpW = ^TRasPppIpW; +(*RASAPI*) TRasPppIpW = record +(*RASAPI*) dwSize : Longint; +(*RASAPI*) dwError : Longint; +(*RASAPI*) szIpAddress : Array[0..RAS_MaxIpAddress] of WideChar; +(*RASAPI*) +(*RASAPI*){$IFNDEF WINNT35COMPATIBLE} +(*RASAPI*) {* This field was added between Windows NT 3.51 beta and Windows NT 3.51 +(*RASAPI*) ** final, and between Windows 95 M8 beta and Windows 95 final. If you do +(*RASAPI*) ** not require the server address and wish to retrieve PPP IP information +(*RASAPI*) ** from Windows NT 3.5 or early Windows NT 3.51 betas, or on early Windows +(*RASAPI*) ** 95 betas, define WINNT35COMPATIBLE. +(*RASAPI*) ** +(*RASAPI*) ** The server IP address is not provided by all PPP implementations, +(*RASAPI*) ** though Windows NT server's do provide it. *} +(*RASAPI*) szServerIpAddress: Array[0..RAS_MaxIpAddress] of WideChar; +(*RASAPI*){$ENDIF} +(*RASAPI*) end; +(*RASAPI*) +(*RASAPI*) LPRasPppIpA = ^TRasPppIpA; +(*RASAPI*) TRasPppIpA = record +(*RASAPI*) dwSize : Longint; +(*RASAPI*) dwError : Longint; +(*RASAPI*) szIpAddress : Array[0..RAS_MaxIpAddress] of AnsiChar; +(*RASAPI*) +(*RASAPI*){$IFNDEF WINNT35COMPATIBLE} {* See RASPPPIPW comment. *} +(*RASAPI*) szServerIpAddress: Array[0..RAS_MaxIpAddress] of AnsiChar; +(*RASAPI*){$ENDIF} +(*RASAPI*) end; +(*RASAPI*) +(*RASAPI*) LPRasPppIp = ^TRasPppIp; +(*RASAPI*) TRasPppIp = TRasPppIpA; +(*RASAPI*) +(*RASAPI*) +(*RASAPI*)const +(*RASAPI*){* If using RasDial message notifications, get the notification message code +(*RASAPI*)** by passing this string to the RegisterWindowMessageA() API. +(*RASAPI*)** WM_RASDIALEVENT is used only if a unique message cannot be registered.*} +(*RASAPI*) RASDIALEVENT = 'RasDialEvent'; +(*RASAPI*) WM_RASDIALEVENT = $CCCD; +(*RASAPI*) +(*RASAPI*) +(*RASAPI*){* Prototypes for caller's RasDial callback handler. Arguments are the +(*RASAPI*)** message ID (currently always WM_RASDIALEVENT), the current RASCONNSTATE and +(*RASAPI*)** the error that has occurred (or 0 if none). Extended arguments are the +(*RASAPI*)** handle of the RAS connection and an extended error code. +(*RASAPI*)*} +(*RASAPI*){ +(*RASAPI*)typedef VOID (WINAPI *RASDIALFUNC)( UINT, RASCONNSTATE, DWORD ); +(*RASAPI*)typedef VOID (WINAPI *RASDIALFUNC1)( HRASCONN, UINT, RASCONNSTATE, DWORD, DWORD ); +(*RASAPI*) +(*RASAPI*)For Delphi: Just define the callback as +(*RASAPI*)procedure RASCallback(msg: Integer; state: TRasConnState; +(*RASAPI*) dwError: Longint); stdcall; +(*RASAPI*) or +(*RASAPI*)procedure RASCallback1(hConn: THRasConn; msg: Integer; +(*RASAPI*) state: TRasConnState; dwError: Longint; dwEexterror: Longint); stdcall; +(*RASAPI*)} +(*RASAPI*) +(*RASAPI*){* External RAS API function prototypes. +(*RASAPI*)*} +(*RASAPI*){Note: for Delphi the function without 'A' or 'W' is the Ansi one +(*RASAPI*) as on the other Delphi headers} +(*RASAPI*) +(*RASAPI*)function RasDialA(lpRasDialExt: LPRasDialExtensions; lpszPhoneBook: PAnsiChar; +(*RASAPI*) var params: TRasDialParamsA; dwNotifierType: Longint; +(*RASAPI*) lpNotifier: Pointer; var rasconn: THRasConn): Longint; stdcall; +(*RASAPI*)function RasDialW(lpRasDialExt: LPRasDialExtensions; lpszPhoneBook: PWideChar; +(*RASAPI*) var params: TRasDialParamsW; dwNotifierType: Longint; +(*RASAPI*) lpNotifier: Pointer; var rasconn: THRasConn): Longint; stdcall; +(*RASAPI*)function RasDial(lpRasDialExt: LPRasDialExtensions; lpszPhoneBook: PAnsiChar; +(*RASAPI*) var params: TRasDialParams; dwNotifierType: Longint; +(*RASAPI*) lpNotifier: Pointer; var rasconn: THRasConn): Longint; stdcall; +(*RASAPI*) +(*RASAPI*)function RasEnumConnectionsA(RasConnArray: LPRasConnA; var lpcb: Longint; +(*RASAPI*) var lpcConnections: Longint): Longint; stdcall; +(*RASAPI*)function RasEnumConnectionsW(RasConnArray: LPRasConnW; var lpcb: Longint; +(*RASAPI*) var lpcConnections: Longint): Longint; stdcall; +(*RASAPI*)function RasEnumConnections(RasConnArray: LPRasConn; var lpcb: Longint; +(*RASAPI*) var lpcConnections: Longint): Longint; stdcall; +(*RASAPI*) +(*RASAPI*)function RasEnumEntriesA(Reserved: PAnsiChar; lpszPhoneBook: PAnsiChar; +(*RASAPI*) entrynamesArray: LPRasEntryNameA; var lpcb: Longint; +(*RASAPI*) var lpcEntries: Longint): Longint; stdcall; +(*RASAPI*)function RasEnumEntriesW(reserved: PWideChar; lpszPhoneBook: PWideChar; +(*RASAPI*) entrynamesArray: LPRasEntryNameW; var lpcb: Longint; +(*RASAPI*) var lpcEntries: Longint): Longint; stdcall; +(*RASAPI*)function RasEnumEntries(reserved: PAnsiChar; lpszPhoneBook: PAnsiChar; +(*RASAPI*) entrynamesArray: LPRasEntryName; var lpcb: Longint; +(*RASAPI*) var lpcEntries: Longint): Longint; stdcall; +(*RASAPI*) +(*RASAPI*)function RasGetConnectStatusA(hConn: THRasConn; var lpStatus: TRasConnStatusA): Longint; stdcall; +(*RASAPI*)function RasGetConnectStatusW(hConn: THRasConn;var lpStatus: TRasConnStatusW): Longint; stdcall; +(*RASAPI*)function RasGetConnectStatus(hConn: THRasConn;var lpStatus: TRasConnStatus): Longint; stdcall; +(*RASAPI*) +(*RASAPI*)function RasGetErrorStringA(errorValue: Integer;erroString: PAnsiChar;cBufSize: Longint): Longint; stdcall; +(*RASAPI*)function RasGetErrorStringW(errorValue: Integer;erroString: PWideChar;cBufSize: Longint): Longint; stdcall; +(*RASAPI*)function RasGetErrorString(errorValue: Integer;erroString: PAnsiChar;cBufSize: Longint): Longint; stdcall; +(*RASAPI*) +(*RASAPI*)function RasHangUpA(hConn: THRasConn): Longint; stdcall; +(*RASAPI*)function RasHangUpW(hConn: THRasConn): Longint; stdcall; +(*RASAPI*)function RasHangUp(hConn: THRasConn): Longint; stdcall; +(*RASAPI*) +(*RASAPI*)function RasGetProjectionInfoA(hConn: THRasConn; rasproj: TRasProjection; +(*RASAPI*) lpProjection: Pointer; var lpcb: Longint): Longint; stdcall; +(*RASAPI*)function RasGetProjectionInfoW(hConn: THRasConn; rasproj: TRasProjection; +(*RASAPI*) lpProjection: Pointer; var lpcb: Longint): Longint; stdcall; +(*RASAPI*)function RasGetProjectionInfo(hConn: THRasConn; rasproj: TRasProjection; +(*RASAPI*) lpProjection: Pointer; var lpcb: Longint): Longint; stdcall; +(*RASAPI*) +(*RASAPI*)function RasCreatePhonebookEntryA(hwndParentWindow: HWND;lpszPhoneBook: PAnsiChar): Longint; stdcall; +(*RASAPI*)function RasCreatePhonebookEntryW(hwndParentWindow: HWND;lpszPhoneBook: PWideChar): Longint; stdcall; +(*RASAPI*)function RasCreatePhonebookEntry(hwndParentWindow: HWND;lpszPhoneBook: PAnsiChar): Longint; stdcall; +(*RASAPI*) +(*RASAPI*)function RasEditPhonebookEntryA(hwndParentWindow: HWND; lpszPhoneBook: PAnsiChar; +(*RASAPI*) lpszEntryName: PAnsiChar): Longint; stdcall; +(*RASAPI*)function RasEditPhonebookEntryW(hwndParentWindow: HWND; lpszPhoneBook: PWideChar; +(*RASAPI*) lpszEntryName: PWideChar): Longint; stdcall; +(*RASAPI*)function RasEditPhonebookEntry(hwndParentWindow: HWND; lpszPhoneBook: PAnsiChar; +(*RASAPI*) lpszEntryName: PAnsiChar): Longint; stdcall; +(*RASAPI*) +(*RASAPI*)function RasSetEntryDialParamsA(lpszPhoneBook: PAnsiChar; var lpDialParams: TRasDialParamsA; +(*RASAPI*) fRemovePassword: LongBool): Longint; stdcall; +(*RASAPI*)function RasSetEntryDialParamsW(lpszPhoneBook: PWideChar; var lpDialParams: TRasDialParamsW; +(*RASAPI*) fRemovePassword: LongBool): Longint; stdcall; +(*RASAPI*)function RasSetEntryDialParams(lpszPhoneBook: PAnsiChar; var lpDialParams: TRasDialParams; +(*RASAPI*) fRemovePassword: LongBool): Longint; stdcall; +(*RASAPI*) +(*RASAPI*)function RasGetEntryDialParamsA(lpszPhoneBook: PAnsiChar; var lpDialParams: TRasDialParamsA; +(*RASAPI*) var lpfPassword: LongBool): Longint; stdcall; +(*RASAPI*)function RasGetEntryDialParamsW(lpszPhoneBook: PWideChar; var lpDialParams: TRasDialParamsW; +(*RASAPI*) var lpfPassword: LongBool): Longint; stdcall; +(*RASAPI*)function RasGetEntryDialParams(lpszPhoneBook: PAnsiChar; var lpDialParams: TRasDialParams; +(*RASAPI*) var lpfPassword: LongBool): Longint; stdcall; +(*RASAPI*) +(*RASAPI*){** +(*RASAPI*)** raserror.h +(*RASAPI*)** Remote Access external API +(*RASAPI*)** RAS specific error codes *} +(*RASAPI*) +(*RASAPI*)const +(*RASAPI*) RASBASE = 600; +(*RASAPI*) SUCCESS = 0; +(*RASAPI*) +(*RASAPI*) PENDING = (RASBASE+0); +(*RASAPI*) ERROR_INVALID_PORT_HANDLE = (RASBASE+1); +(*RASAPI*) ERROR_PORT_ALREADY_OPEN = (RASBASE+2); +(*RASAPI*) ERROR_BUFFER_TOO_SMALL = (RASBASE+3); +(*RASAPI*) ERROR_WRONG_INFO_SPECIFIED = (RASBASE+4); +(*RASAPI*) ERROR_CANNOT_SET_PORT_INFO = (RASBASE+5); +(*RASAPI*) ERROR_PORT_NOT_CONNECTED = (RASBASE+6); +(*RASAPI*) ERROR_EVENT_INVALID = (RASBASE+7); +(*RASAPI*) ERROR_DEVICE_DOES_NOT_EXIST = (RASBASE+8); +(*RASAPI*) ERROR_DEVICETYPE_DOES_NOT_EXIST = (RASBASE+9); +(*RASAPI*) ERROR_BUFFER_INVALID = (RASBASE+10); +(*RASAPI*) ERROR_ROUTE_NOT_AVAILABLE = (RASBASE+11); +(*RASAPI*) ERROR_ROUTE_NOT_ALLOCATED = (RASBASE+12); +(*RASAPI*) ERROR_INVALID_COMPRESSION_SPECIFIED = (RASBASE+13); +(*RASAPI*) ERROR_OUT_OF_BUFFERS = (RASBASE+14); +(*RASAPI*) ERROR_PORT_NOT_FOUND = (RASBASE+15); +(*RASAPI*) ERROR_ASYNC_REQUEST_PENDING = (RASBASE+16); +(*RASAPI*) ERROR_ALREADY_DISCONNECTING = (RASBASE+17); +(*RASAPI*) ERROR_PORT_NOT_OPEN = (RASBASE+18); +(*RASAPI*) ERROR_PORT_DISCONNECTED = (RASBASE+19); +(*RASAPI*) ERROR_NO_ENDPOINTS = (RASBASE+20); +(*RASAPI*) ERROR_CANNOT_OPEN_PHONEBOOK = (RASBASE+21); +(*RASAPI*) ERROR_CANNOT_LOAD_PHONEBOOK = (RASBASE+22); +(*RASAPI*) ERROR_CANNOT_FIND_PHONEBOOK_ENTRY = (RASBASE+23); +(*RASAPI*) ERROR_CANNOT_WRITE_PHONEBOOK = (RASBASE+24); +(*RASAPI*) ERROR_CORRUPT_PHONEBOOK = (RASBASE+25); +(*RASAPI*) ERROR_CANNOT_LOAD_STRING = (RASBASE+26); +(*RASAPI*) ERROR_KEY_NOT_FOUND = (RASBASE+27); +(*RASAPI*) ERROR_DISCONNECTION = (RASBASE+28); +(*RASAPI*) ERROR_REMOTE_DISCONNECTION = (RASBASE+29); +(*RASAPI*) ERROR_HARDWARE_FAILURE = (RASBASE+30); +(*RASAPI*) ERROR_USER_DISCONNECTION = (RASBASE+31); +(*RASAPI*) ERROR_INVALID_SIZE = (RASBASE+32); +(*RASAPI*) ERROR_PORT_NOT_AVAILABLE = (RASBASE+33); +(*RASAPI*) ERROR_CANNOT_PROJECT_CLIENT = (RASBASE+34); +(*RASAPI*) ERROR_UNKNOWN = (RASBASE+35); +(*RASAPI*) ERROR_WRONG_DEVICE_ATTACHED = (RASBASE+36); +(*RASAPI*) ERROR_BAD_STRING = (RASBASE+37); +(*RASAPI*) ERROR_REQUEST_TIMEOUT = (RASBASE+38); +(*RASAPI*) ERROR_CANNOT_GET_LANA = (RASBASE+39); +(*RASAPI*) ERROR_NETBIOS_ERROR = (RASBASE+40); +(*RASAPI*) ERROR_SERVER_OUT_OF_RESOURCES = (RASBASE+41); +(*RASAPI*) ERROR_NAME_EXISTS_ON_NET = (RASBASE+42); +(*RASAPI*) ERROR_SERVER_GENERAL_NET_FAILURE = (RASBASE+43); +(*RASAPI*) WARNING_MSG_ALIAS_NOT_ADDED = (RASBASE+44); +(*RASAPI*) ERROR_AUTH_INTERNAL = (RASBASE+45); +(*RASAPI*) ERROR_RESTRICTED_LOGON_HOURS = (RASBASE+46); +(*RASAPI*) ERROR_ACCT_DISABLED = (RASBASE+47); +(*RASAPI*) ERROR_PASSWD_EXPIRED = (RASBASE+48); +(*RASAPI*) ERROR_NO_DIALIN_PERMISSION = (RASBASE+49); +(*RASAPI*) ERROR_SERVER_NOT_RESPONDING = (RASBASE+50); +(*RASAPI*) ERROR_FROM_DEVICE = (RASBASE+51); +(*RASAPI*) ERROR_UNRECOGNIZED_RESPONSE = (RASBASE+52); +(*RASAPI*) ERROR_MACRO_NOT_FOUND = (RASBASE+53); +(*RASAPI*) ERROR_MACRO_NOT_DEFINED = (RASBASE+54); +(*RASAPI*) ERROR_MESSAGE_MACRO_NOT_FOUND = (RASBASE+55); +(*RASAPI*) ERROR_DEFAULTOFF_MACRO_NOT_FOUND = (RASBASE+56); +(*RASAPI*) ERROR_FILE_COULD_NOT_BE_OPENED = (RASBASE+57); +(*RASAPI*) ERROR_DEVICENAME_TOO_LONG = (RASBASE+58); +(*RASAPI*) ERROR_DEVICENAME_NOT_FOUND = (RASBASE+59); +(*RASAPI*) ERROR_NO_RESPONSES = (RASBASE+60); +(*RASAPI*) ERROR_NO_COMMAND_FOUND = (RASBASE+61); +(*RASAPI*) ERROR_WRONG_KEY_SPECIFIED = (RASBASE+62); +(*RASAPI*) ERROR_UNKNOWN_DEVICE_TYPE = (RASBASE+63); +(*RASAPI*) ERROR_ALLOCATING_MEMORY = (RASBASE+64); +(*RASAPI*) ERROR_PORT_NOT_CONFIGURED = (RASBASE+65); +(*RASAPI*) ERROR_DEVICE_NOT_READY = (RASBASE+66); +(*RASAPI*) ERROR_READING_INI_FILE = (RASBASE+67); +(*RASAPI*) ERROR_NO_CONNECTION = (RASBASE+68); +(*RASAPI*) ERROR_BAD_USAGE_IN_INI_FILE = (RASBASE+69); +(*RASAPI*) ERROR_READING_SECTIONNAME = (RASBASE+70); +(*RASAPI*) ERROR_READING_DEVICETYPE = (RASBASE+71); +(*RASAPI*) ERROR_READING_DEVICENAME = (RASBASE+72); +(*RASAPI*) ERROR_READING_USAGE = (RASBASE+73); +(*RASAPI*) ERROR_READING_MAXCONNECTBPS = (RASBASE+74); +(*RASAPI*) ERROR_READING_MAXCARRIERBPS = (RASBASE+75); +(*RASAPI*) ERROR_LINE_BUSY = (RASBASE+76); +(*RASAPI*) ERROR_VOICE_ANSWER = (RASBASE+77); +(*RASAPI*) ERROR_NO_ANSWER = (RASBASE+78); +(*RASAPI*) ERROR_NO_CARRIER = (RASBASE+79); +(*RASAPI*) ERROR_NO_DIALTONE = (RASBASE+80); +(*RASAPI*) ERROR_IN_COMMAND = (RASBASE+81); +(*RASAPI*) ERROR_WRITING_SECTIONNAME = (RASBASE+82); +(*RASAPI*) ERROR_WRITING_DEVICETYPE = (RASBASE+83); +(*RASAPI*) ERROR_WRITING_DEVICENAME = (RASBASE+84); +(*RASAPI*) ERROR_WRITING_MAXCONNECTBPS = (RASBASE+85); +(*RASAPI*) ERROR_WRITING_MAXCARRIERBPS = (RASBASE+86); +(*RASAPI*) ERROR_WRITING_USAGE = (RASBASE+87); +(*RASAPI*) ERROR_WRITING_DEFAULTOFF = (RASBASE+88); +(*RASAPI*) ERROR_READING_DEFAULTOFF = (RASBASE+89); +(*RASAPI*) ERROR_EMPTY_INI_FILE = (RASBASE+90); +(*RASAPI*) ERROR_AUTHENTICATION_FAILURE = (RASBASE+91); +(*RASAPI*) ERROR_PORT_OR_DEVICE = (RASBASE+92); +(*RASAPI*) ERROR_NOT_BINARY_MACRO = (RASBASE+93); +(*RASAPI*) ERROR_DCB_NOT_FOUND = (RASBASE+94); +(*RASAPI*) ERROR_STATE_MACHINES_NOT_STARTED = (RASBASE+95); +(*RASAPI*) ERROR_STATE_MACHINES_ALREADY_STARTED = (RASBASE+96); +(*RASAPI*) ERROR_PARTIAL_RESPONSE_LOOPING = (RASBASE+97); +(*RASAPI*) ERROR_UNKNOWN_RESPONSE_KEY = (RASBASE+98); +(*RASAPI*) ERROR_RECV_BUF_FULL = (RASBASE+99); +(*RASAPI*) ERROR_CMD_TOO_LONG = (RASBASE+100); +(*RASAPI*) ERROR_UNSUPPORTED_BPS = (RASBASE+101); +(*RASAPI*) ERROR_UNEXPECTED_RESPONSE = (RASBASE+102); +(*RASAPI*) ERROR_INTERACTIVE_MODE = (RASBASE+103); +(*RASAPI*) ERROR_BAD_CALLBACK_NUMBER = (RASBASE+104); +(*RASAPI*) ERROR_INVALID_AUTH_STATE = (RASBASE+105); +(*RASAPI*) ERROR_WRITING_INITBPS = (RASBASE+106); +(*RASAPI*) ERROR_X25_DIAGNOSTIC = (RASBASE+107); +(*RASAPI*) ERROR_ACCT_EXPIRED = (RASBASE+108); +(*RASAPI*) ERROR_CHANGING_PASSWORD = (RASBASE+109); +(*RASAPI*) ERROR_OVERRUN = (RASBASE+110); +(*RASAPI*) ERROR_RASMAN_CANNOT_INITIALIZE = (RASBASE+111); +(*RASAPI*) ERROR_BIPLEX_PORT_NOT_AVAILABLE = (RASBASE+112); +(*RASAPI*) ERROR_NO_ACTIVE_ISDN_LINES = (RASBASE+113); +(*RASAPI*) ERROR_NO_ISDN_CHANNELS_AVAILABLE = (RASBASE+114); +(*RASAPI*) ERROR_TOO_MANY_LINE_ERRORS = (RASBASE+115); +(*RASAPI*) ERROR_IP_CONFIGURATION = (RASBASE+116); +(*RASAPI*) ERROR_NO_IP_ADDRESSES = (RASBASE+117); +(*RASAPI*) ERROR_PPP_TIMEOUT = (RASBASE+118); +(*RASAPI*) ERROR_PPP_REMOTE_TERMINATED = (RASBASE+119); +(*RASAPI*) ERROR_PPP_NO_PROTOCOLS_CONFIGURED = (RASBASE+120); +(*RASAPI*) ERROR_PPP_NO_RESPONSE = (RASBASE+121); +(*RASAPI*) ERROR_PPP_INVALID_PACKET = (RASBASE+122); +(*RASAPI*) ERROR_PHONE_NUMBER_TOO_LONG = (RASBASE+123); +(*RASAPI*) ERROR_IPXCP_NO_DIALOUT_CONFIGURED = (RASBASE+124); +(*RASAPI*) ERROR_IPXCP_NO_DIALIN_CONFIGURED = (RASBASE+125); +(*RASAPI*) ERROR_IPXCP_DIALOUT_ALREADY_ACTIVE = (RASBASE+126); +(*RASAPI*) ERROR_ACCESSING_TCPCFGDLL = (RASBASE+127); +(*RASAPI*) ERROR_NO_IP_RAS_ADAPTER = (RASBASE+128); +(*RASAPI*) ERROR_SLIP_REQUIRES_IP = (RASBASE+129); +(*RASAPI*) ERROR_PROJECTION_NOT_COMPLETE = (RASBASE+130); +(*RASAPI*) ERROR_PROTOCOL_NOT_CONFIGURED = (RASBASE+131); +(*RASAPI*) ERROR_PPP_NOT_CONVERGING = (RASBASE+132); +(*RASAPI*) ERROR_PPP_CP_REJECTED = (RASBASE+133); +(*RASAPI*) ERROR_PPP_LCP_TERMINATED = (RASBASE+134); +(*RASAPI*) ERROR_PPP_REQUIRED_ADDRESS_REJECTED = (RASBASE+135); +(*RASAPI*) ERROR_PPP_NCP_TERMINATED = (RASBASE+136); +(*RASAPI*) ERROR_PPP_LOOPBACK_DETECTED = (RASBASE+137); +(*RASAPI*) ERROR_PPP_NO_ADDRESS_ASSIGNED = (RASBASE+138); +(*RASAPI*) ERROR_CANNOT_USE_LOGON_CREDENTIALS = (RASBASE+139); +(*RASAPI*) ERROR_TAPI_CONFIGURATION = (RASBASE+140); +(*RASAPI*) ERROR_NO_LOCAL_ENCRYPTION = (RASBASE+141); +(*RASAPI*) ERROR_NO_REMOTE_ENCRYPTION = (RASBASE+142); +(*RASAPI*) ERROR_REMOTE_REQUIRES_ENCRYPTION = (RASBASE+143); +(*RASAPI*) ERROR_IPXCP_NET_NUMBER_CONFLICT = (RASBASE+144); +(*RASAPI*) ERROR_INVALID_SMM = (RASBASE+145); +(*RASAPI*) ERROR_SMM_UNINITIALIZED = (RASBASE+146); +(*RASAPI*) ERROR_NO_MAC_FOR_PORT = (RASBASE+147); +(*RASAPI*) ERROR_SMM_TIMEOUT = (RASBASE+148); +(*RASAPI*) ERROR_BAD_PHONE_NUMBER = (RASBASE+149); +(*RASAPI*) ERROR_WRONG_MODULE = (RASBASE+150); +(*RASAPI*) +(*RASAPI*) RASBASEEND = (RASBASE+150); +(*RASAPI*) +(*RASAPI*){* Copyright (c) 1995, Microsoft Corporation, all rights reserved +(*RASAPI*)** +(*RASAPI*)** rnaph.h (to be merged with ras.h) +(*RASAPI*)** +(*RASAPI*)** Remote Access external API +(*RASAPI*)** Public header for external API clients +(*RASAPI*)**} +(*RASAPI*) +(*RASAPI*){* +(*RASAPI*) Original conversion by Gideon le Grange +(*RASAPI*) Merged with ras.pas by Davide Moretti +(*RASAPI*)*} +(*RASAPI*) +(*RASAPI*)const +(*RASAPI*) RAS_MaxAreaCode = 10; +(*RASAPI*) RAS_MaxPadType = 32; +(*RASAPI*) RAS_MaxX25Address = 200; +(*RASAPI*) RAS_MaxFacilities = 200; +(*RASAPI*) RAS_MaxUserData = 200; +(*RASAPI*) +(*RASAPI*) +(*RASAPI*)type +(*RASAPI*)(* Describes a RAS IP Address *) +(*RASAPI*) LPRasIPAddr = ^TRasIPAddr; +(*RASAPI*) TRasIPAddr = record +(*RASAPI*) A, B, C, D: Byte; +(*RASAPI*) end; +(*RASAPI*) +(*RASAPI*)(* Describes a RAS phonebook entry *) +(*RASAPI*) LPRasEntryA = ^TRasEntryA; +(*RASAPI*) TRasEntryA = record +(*RASAPI*) dwSize, +(*RASAPI*) dwfOptions, +(*RASAPI*) dwCountryID, +(*RASAPI*) dwCountryCode : Longint; +(*RASAPI*) szAreaCode : array[0.. RAS_MaxAreaCode] of AnsiChar; +(*RASAPI*) szLocalPhoneNumber : array[0..RAS_MaxPhoneNumber] of AnsiChar; +(*RASAPI*) dwAlternatesOffset : Longint; +(*RASAPI*) ipaddr, +(*RASAPI*) ipaddrDns, +(*RASAPI*) ipaddrDnsAlt, +(*RASAPI*) ipaddrWins, +(*RASAPI*) ipaddrWinsAlt : TRasIPAddr; +(*RASAPI*) dwFrameSize, +(*RASAPI*) dwfNetProtocols, +(*RASAPI*) dwFramingProtocol : Longint; +(*RASAPI*) szScript : Array[0..MAX_PATH - 1] of AnsiChar; +(*RASAPI*) szAutodialDll : Array [0..MAX_PATH - 1] of AnsiChar; +(*RASAPI*) szAutodialFunc : Array [0..MAX_PATH - 1] of AnsiChar; +(*RASAPI*) szDeviceType : Array [0..RAS_MaxDeviceType] of AnsiChar; +(*RASAPI*) szDeviceName : Array [0..RAS_MaxDeviceName] of AnsiChar; +(*RASAPI*) szX25PadType : Array [0..RAS_MaxPadType] of AnsiChar; +(*RASAPI*) szX25Address : Array [0..RAS_MaxX25Address] of AnsiChar; +(*RASAPI*) szX25Facilities : Array [0..RAS_MaxFacilities] of AnsiChar; +(*RASAPI*) szX25UserData : Array [0..RAS_MaxUserData] of AnsiChar; +(*RASAPI*) dwChannels, +(*RASAPI*) dwReserved1, +(*RASAPI*) dwReserved2 : Longint; +(*RASAPI*) end; +(*RASAPI*) +(*RASAPI*) LPRasEntryW = ^TRasEntryW; +(*RASAPI*) TRasEntryW = record +(*RASAPI*) dwSize, +(*RASAPI*) dwfOptions, +(*RASAPI*) dwCountryID, +(*RASAPI*) dwCountryCode : Longint; +(*RASAPI*) szAreaCode : array[0.. RAS_MaxAreaCode] of WideChar; +(*RASAPI*) szLocalPhoneNumber : array[0..RAS_MaxPhoneNumber] of WideChar; +(*RASAPI*) dwAlternatesOffset : Longint; +(*RASAPI*) ipaddr, +(*RASAPI*) ipaddrDns, +(*RASAPI*) ipaddrDnsAlt, +(*RASAPI*) ipaddrWins, +(*RASAPI*) ipaddrWinsAlt : TRasIPAddr; +(*RASAPI*) dwFrameSize, +(*RASAPI*) dwfNetProtocols, +(*RASAPI*) dwFramingProtocol : Longint; +(*RASAPI*) szScript : Array[0..MAX_PATH - 1] of WideChar; +(*RASAPI*) szAutodialDll : Array [0..MAX_PATH - 1] of WideChar; +(*RASAPI*) szAutodialFunc : Array [0..MAX_PATH - 1] of WideChar; +(*RASAPI*) szDeviceType : Array [0..RAS_MaxDeviceType] of WideChar; +(*RASAPI*) szDeviceName : Array [0..RAS_MaxDeviceName] of WideChar; +(*RASAPI*) szX25PadType : Array [0..RAS_MaxPadType] of WideChar; +(*RASAPI*) szX25Address : Array [0..RAS_MaxX25Address] of WideChar; +(*RASAPI*) szX25Facilities : Array [0..RAS_MaxFacilities] of WideChar; +(*RASAPI*) szX25UserData : Array [0..RAS_MaxUserData] of WideChar; +(*RASAPI*) dwChannels, +(*RASAPI*) dwReserved1, +(*RASAPI*) dwReserved2 : Longint; +(*RASAPI*) end; +(*RASAPI*) +(*RASAPI*) LPRasEntry = ^TRasEntry; +(*RASAPI*) TRasEntry = TRasEntryA; +(*RASAPI*) +(*RASAPI*)(* Describes Country Information *) +(*RASAPI*) LPRasCtryInfo = ^TRasCtryInfo; +(*RASAPI*) TRasCtryInfo = record +(*RASAPI*) dwSize, +(*RASAPI*) dwCountryID, +(*RASAPI*) dwNextCountryID, +(*RASAPI*) dwCountryCode, +(*RASAPI*) dwCountryNameOffset : Longint; +(*RASAPI*) end; +(*RASAPI*) +(*RASAPI*)(* Describes RAS Device Information *) +(*RASAPI*) LPRasDevInfoA = ^TRasDevInfoA; +(*RASAPI*) TRasDevInfoA = record +(*RASAPI*) dwSize : Longint; +(*RASAPI*) szDeviceType : Array[0..RAS_MaxDeviceType] of AnsiChar; +(*RASAPI*) szDeviceName : Array[0..RAS_MaxDeviceName] of AnsiChar; +(*RASAPI*) end; +(*RASAPI*) +(*RASAPI*) LPRasDevInfoW = ^TRasDevInfoW; +(*RASAPI*) TRasDevInfoW = record +(*RASAPI*) dwSize : Longint; +(*RASAPI*) szDeviceType : Array[0..RAS_MaxDeviceType] of WideChar; +(*RASAPI*) szDeviceName : Array[0..RAS_MaxDeviceName] of WideChar; +(*RASAPI*) end; +(*RASAPI*) +(*RASAPI*) LPRasDevInfo = ^TRasDevInfo; +(*RASAPI*) TRasDevInfo = TRasDevInfoA; +(*RASAPI*) +(*RASAPI*)const +(*RASAPI*)(* TRasEntry 'dwfOptions' bit flags. *) +(*RASAPI*) RASEO_UseCountryAndAreaCodes = $00000001; +(*RASAPI*) RASEO_SpecificIpAddr = $00000002; +(*RASAPI*) RASEO_SpecificNameServers = $00000004; +(*RASAPI*) RASEO_IpHeaderCompression = $00000008; +(*RASAPI*) RASEO_RemoteDefaultGateway = $00000010; +(*RASAPI*) RASEO_DisableLcpExtensions = $00000020; +(*RASAPI*) RASEO_TerminalBeforeDial = $00000040; +(*RASAPI*) RASEO_TerminalAfterDial = $00000080; +(*RASAPI*) RASEO_ModemLights = $00000100; +(*RASAPI*) RASEO_SwCompression = $00000200; +(*RASAPI*) RASEO_RequireEncryptedPw = $00000400; +(*RASAPI*) RASEO_RequireMsEncryptedPw = $00000800; +(*RASAPI*) RASEO_RequireDataEncryption = $00001000; +(*RASAPI*) RASEO_NetworkLogon = $00002000; +(*RASAPI*) RASEO_UseLogonCredentials = $00004000; +(*RASAPI*) RASEO_PromoteAlternates = $00008000; +(*RASAPI*) +(*RASAPI*)(* TRasEntry 'dwfNetProtocols' bit flags. (session negotiated protocols) *) +(*RASAPI*) RASNP_Netbeui = $00000001; // Negotiate NetBEUI +(*RASAPI*) RASNP_Ipx = $00000002; // Negotiate IPX +(*RASAPI*) RASNP_Ip = $00000004; // Negotiate TCP/IP +(*RASAPI*) +(*RASAPI*)(* TRasEntry 'dwFramingProtocols' (framing protocols used by the server) *) +(*RASAPI*) RASFP_Ppp = $00000001; // Point-to-Point Protocol (PPP) +(*RASAPI*) RASFP_Slip = $00000002; // Serial Line Internet Protocol (SLIP) +(*RASAPI*) RASFP_Ras = $00000004; // Microsoft proprietary protocol +(*RASAPI*) +(*RASAPI*)(* TRasEntry 'szDeviceType' strings *) +(*RASAPI*) RASDT_Modem = 'modem'; // Modem +(*RASAPI*) RASDT_Isdn = 'isdn'; // ISDN +(*RASAPI*) RASDT_X25 = 'x25'; // X.25 +(*RASAPI*) +(*RASAPI*)(* RAS functions found in RNAPH.DLL *) +(*RASAPI*)function RasValidateEntryNameA(lpszPhonebook,szEntry: PAnsiChar): Longint; stdcall; +(*RASAPI*)function RasValidateEntryNameW(lpszPhonebook,szEntry: PWideChar): Longint; stdcall; +(*RASAPI*)function RasValidateEntryName(lpszPhonebook,szEntry: PAnsiChar): Longint; stdcall; +(*RASAPI*) +(*RASAPI*)function RasRenameEntryA(lpszPhonebook,szEntryOld,szEntryNew: PAnsiChar): Longint; stdcall; +(*RASAPI*)function RasRenameEntryW(lpszPhonebook,szEntryOld,szEntryNew: PWideChar): Longint; stdcall; +(*RASAPI*)function RasRenameEntry(lpszPhonebook,szEntryOld,szEntryNew: PAnsiChar): Longint; stdcall; +(*RASAPI*) +(*RASAPI*)function RasDeleteEntryA(lpszPhonebook,szEntry: PAnsiChar): Longint; stdcall; +(*RASAPI*)function RasDeleteEntryW(lpszPhonebook,szEntry: PWideChar): Longint; stdcall; +(*RASAPI*)function RasDeleteEntry(lpszPhonebook,szEntry: PAnsiChar): Longint; stdcall; +(*RASAPI*) +(*RASAPI*)function RasGetEntryPropertiesA(lpszPhonebook, szEntry: PAnsiChar; lpbEntry: Pointer; +(*RASAPI*) var lpdwEntrySize: Longint; lpbDeviceInfo: Pointer; +(*RASAPI*) var lpdwDeviceInfoSize: Longint): Longint; stdcall; +(*RASAPI*)function RasGetEntryPropertiesW(lpszPhonebook, szEntry: PWideChar; lpbEntry: Pointer; +(*RASAPI*) var lpdwEntrySize: Longint; lpbDeviceInfo: Pointer; +(*RASAPI*) var lpdwDeviceInfoSize: Longint): Longint; stdcall; +(*RASAPI*)function RasGetEntryProperties(lpszPhonebook, szEntry: PAnsiChar; lpbEntry: Pointer; +(*RASAPI*) var lpdwEntrySize: Longint; lpbDeviceInfo: Pointer; +(*RASAPI*) var lpdwDeviceInfoSize: Longint): Longint; stdcall; +(*RASAPI*) +(*RASAPI*)function RasSetEntryPropertiesA(lpszPhonebook, szEntry: PAnsiChar; lpbEntry: Pointer; +(*RASAPI*) dwEntrySize: Longint; lpbDeviceInfo: Pointer; +(*RASAPI*) dwDeviceInfoSize: Longint): Longint; stdcall; +(*RASAPI*)function RasSetEntryPropertiesW(lpszPhonebook, szEntry: PWideChar; lpbEntry: Pointer; +(*RASAPI*) dwEntrySize: Longint; lpbDeviceInfo: Pointer; +(*RASAPI*) dwDeviceInfoSize: Longint): Longint; stdcall; +(*RASAPI*)function RasSetEntryProperties(lpszPhonebook, szEntry: PAnsiChar; lpbEntry: Pointer; +(*RASAPI*) dwEntrySize: Longint; lpbDeviceInfo: Pointer; +(*RASAPI*) dwDeviceInfoSize: Longint): Longint; stdcall; +(*RASAPI*) +(*RASAPI*)function RasGetCountryInfoA(var lpCtryInfo: TRasCtryInfo;var lpdwSize: Longint): Longint; stdcall; +(*RASAPI*)function RasGetCountryInfoW(var lpCtryInfo: TRasCtryInfo;var lpdwSize: Longint): Longint; stdcall; +(*RASAPI*)function RasGetCountryInfo(var lpCtryInfo: TRasCtryInfo;var lpdwSize: Longint): Longint; stdcall; +(*RASAPI*) +(*RASAPI*)function RasEnumDevicesA(lpBuff: LpRasDevInfoA; var lpcbSize: Longint; +(*RASAPI*) var lpcDevices: Longint): Longint; stdcall; +(*RASAPI*)function RasEnumDevicesW(lpBuff: LpRasDevInfoW; var lpcbSize: Longint; +(*RASAPI*) var lpcDevices: Longint): Longint; stdcall; +(*RASAPI*)function RasEnumDevices(lpBuff: LpRasDevInfo; var lpcbSize: Longint; +(*RASAPI*) var lpcDevices: Longint): Longint; stdcall; +(*RASAPI*) +{******************************************************} +{******************************************************} +{******************************************************} +{******************************************************} +{******************************************************} +{******************************************************} + +const MaxEntries = 100; //It's enough + +type + +(* TOnEntryGet = procedure (Sender : TObject; EntryName : Array of {Ansi}Char) of Object;*) + TOnEntryGet = procedure (Sender : TObject; EntryName : String ) of Object; + TStandartEv = procedure (Sender : TObject) of object; + TOnNotConn = procedure (Sender : TObject; ErrorCode : Integer; ErrorMessage : String) of object; + TOnAsyncEvent = procedure (Sender : TObject; State : TRasConnState; Error : Integer; + MessageText : String) of object; + TOnError = procedure (Sender : TObject; ErrorCode : Integer; ErrorMessage : String) of Object; + TOnActiveConn = procedure (Sender : TObject; Handle : THRasConn; Status : TRasConnStatus; + StatusString : String; + EntryName, DeviceType, DeviceName : String ) of object; +// EntryName, DeviceType, DeviceName : Array of Char) of object; + + TDialMode = (dmAsync,dmSync); //dmAsync - Function will exit BEFORE finishing dialing + // Events : onDialing,onError,onAsyncEvent + //dmSync - Function will exit AFTER finishing dialing + // Events : onDialing,onConnect,onNotConnected + + TLanguage = (English,Czech); + + TDialUp = class(TComponent) + private + FEntries : TStringList; + FDialMode : TDialMode; + FEntry2Dial : String; + FLanguage : TLanguage; + + FTimer : TTimer; + + FOnEntryGet : TOnEntryGet; + FOnDialing, FOnConnected : TStandartEv; + FOnNotConnected : TOnNotConn; + FOnAsyncEvent : TOnAsyncEvent; + FOnError : TOnError; + FOnActiveConn : TOnActiveConn; + + protected + procedure Timer(Sender: TObject); virtual; + + public + hRAS : ThRASConn; {Handle to RAS connection dialed with by this component when connected} + AsyncStatus : Boolean; + AMsg,AError : Integer; + AState : TRasConnState; + + constructor Create(AOwner:TComponent); override; + destructor Destroy; override; + function Dial : Integer; + function GetEntries : Integer; + function GetConnections : Integer; + function HangUp : Integer; + function HangUpConn(Handle : THRasConn) : Integer; + function CreateEntry : Integer; + function EditEntry : Integer; + function DeleteEntry : Integer; + function RenameEntryTo(S : String) : Integer; + function SetEntryUserName(Value : String) : Integer; + function SetEntryPassword(Value : String) : Integer; + function RemovePassword : Integer; + function GetEntryUserName(var Value : String) : Integer; + function GetEntryPassword(var Value : String) : Integer; + function StatusString(State: TRasConnState; Error: Integer): String; + function StatusStringCZ(State: TRasConnState; Error: Integer): String; + + published + property Name; + property Tag; + property DialMode : TDialMode + read FDialMode write FDialMode; + property Entries : TStringList + read FEntries; + property Entry : String + read FEntry2Dial write FEntry2Dial; + property Language : TLanguage + read FLanguage write FLanguage; + + property OnEntryGet : TOnEntryGet + read FOnEntryGet write FOnEntryGet; + property OnDialing : TStandartEv + read FOnDialing write FOnDialing; + property OnConnect : TStandartEv + read FOnConnected write FOnConnected; + property OnNotConnected : TOnNotConn + read FOnNotConnected write FOnNotConnected; + property OnAsyncEvent : TOnAsyncEvent + read FOnAsyncEvent write FOnAsyncEvent; + property OnError : TOnError + read FOnError write FOnError; + property OnActiveConnection : TOnActiveConn + read FOnActiveConn write FOnActiveConn; + +end; + +procedure Register; + +implementation + +var xSelf : Pointer; + +procedure TDialUp.Timer(Sender: TObject); +begin + FTimer.Enabled:=False; + if AsyncStatus=False then Exit; + if Language=Czech then + begin + if Assigned(FOnAsyncEvent) then FOnAsyncEvent(Self,AState,AError,StatusStringCZ(AState, AError)); + end else + begin + if Assigned(FOnAsyncEvent) then FOnAsyncEvent(Self,AState,AError,StatusString(AState, AError)); + end; + AsyncStatus:=False; +end; + + +procedure RasCallback(msg: Integer; state: TRasConnState; + error: Integer); stdcall; +begin + While TDialUp(xSelf).AsyncStatus=True do ; + TDialUp(xSelf).AsyncStatus:=True; + TDialUp(xSelf).AMsg:=Msg; + TDialUp(xSelf).AState:=State; + TDialUp(xSelf).AError:=Error; + TDialUp(xSelf).FTimer.Enabled:=True; +// TDialUp(xSelf).FOnDialing(xSelf); +// TDialUp(xSelf).OnAsyncEvent(xSelf,State,Error,TDialUp(xSelf).StatusString(state, error)); +end; +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} + +//procedure RasCallback(Msg: Integer; State: TRasConnState; Error: Integer); stdcall; forward; + +procedure Register; +begin + RegisterComponents('Internet',[TDialUp]); +end; + + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} + +constructor TDialUp.Create(AOwner:TComponent); +begin + inherited Create(AOwner); + AsyncStatus:=False; + FEntries:=TStringList.Create; + FTimer:=TTimer.Create(Self); + FTimer.Enabled:=False; FTimer.Interval:=1; + FTimer.OnTimer:=Timer; +end; + + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} + +destructor TDialUp.Destroy; +begin + inherited Destroy; + FEntries.Free; +end; + + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} + +Function TDialUp.Dial : Integer; +var + Fp : LongBool; + R : Integer; + C : Array[0..100] of Char; + ErrS : String; + DialParams : TRasDialParams; + +begin + HangUp; + + FillChar(DialParams, SizeOf(TRasDialParams), 0); + with DialParams do + begin + dwSize:=Sizeof(TRasDialParams); + StrPCopy(szEntryName, FEntry2Dial); + end; + + R:=RasGetEntryDialParams(nil, DialParams, Fp); + if R<>0 then + begin + Result:=R; + if Assigned(FOnError) then FOnError(Self,R,'GetEntryDialParams failed'); + Exit; + end; + + hRAS:=0; + if DialMode=dmSync then // Synchronous dial + begin + if Assigned(FOnDialing) then FOnDialing(Self); + R:=RasDial(nil, nil, DialParams, 0, nil, hRAS); + if R=0 then + begin + if Assigned(FOnConnected) then + FOnConnected(Self) + end else + begin + if hRas<>0 then + RasHangUp(hRas); + RasGetErrorString(R, C, 100); ErrS:=C; + if Assigned(FOnNotConnected) then FOnNotConnected(Self,R,ErrS); + end; + end else // Asynchronous dial + + begin + // Async dial + xSelf:=Self; + if Assigned(FOnDialing) then FOnDialing(Self); + R:=RasDial(nil, nil, DialParams, 0, @RasCallback, hRAS); + if R<>0 then + begin + RasGetErrorString(R,C,100); + if Assigned(FOnError) then FOnError(Self,R,C); + end; + end; + Result:=R; +end; + + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} + +Function TDialUp.GetEntries : Integer; +var + BuffSize : Integer; + Entries : Integer; + Entry : Array[1..MaxEntries] of TRasEntryName; + X,Result_ : Integer; +begin + Result:=0; + FEntries.Clear; + Entry[1].dwSize:=SizeOf(TRasEntryName); + BuffSize:=SizeOf(TRasEntryName)*MaxEntries; + Result_:=RasEnumEntries(nil, nil, @Entry[1], BuffSize, Entries); + if (Result_=0) and (Entries>0) then + begin + for X:=1 to Entries do + begin + FEntries.Add(Entry[x].szEntryName); + If Assigned(FOnEntryGet) then FOnEntryGet(Self,Entry[x].szEntryName); + end; + end else + Result:=Result_; +end; + + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} + +Function TDialUp.GetConnections : Integer; +var + BufSize : Integer; + NumEntries : Integer; + X : Integer; + Entries : Array[1..MaxEntries] of TRasConn; + Stat : TRasConnStatus; + Result_ : Integer; + S : String; +begin + Result:=0; + + Entries[1].dwSize := SizeOf(TRasConn); + Bufsize:=SizeOf(TRasConn)*MaxEntries; + FillChar(Stat, Sizeof(TRasConnStatus), 0); + Stat.dwSize:=Sizeof(TRasConnStatus); + + Result_:=RasEnumConnections(@Entries[1], BufSize, NumEntries); + if Result_=0 then + begin + if NumEntries > 0 then + + for X:=1 to NumEntries do + begin + RasGetConnectStatus(Entries[X].HRasConn, Stat); + if Language=Czech then S:=StatusStringCZ(Stat.RasConnState, Stat.dwError) else + S:=StatusString(Stat.RasConnState, Stat.dwError); + if Assigned(FOnActiveConn) then FOnActiveConn(Self, Entries[X].HRasConn, + Stat, S, + Entries[X].szEntryName, + Entries[X].szDeviceType, + Entries[X].szDeviceName); + end; + end else Result:=Result_; +end; + + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} + +Function TDialUp.HangUp : Integer; +begin + Result:=RasHangUp(hRas); +end; + + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} + +Function TDialUp.HangUpConn(Handle : THRasConn) : Integer; +begin + Result:=RasHangUp(Handle); +end; + + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} + + +Function TDialUp.CreateEntry : Integer; +begin + if (Owner is TForm) then + Result:=RasCreatePhonebookEntry((Owner as TForm).Handle, nil) else + Result:=RasCreatePhonebookEntry(0, nil); +end; + + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} + +Function TDialUp.EditEntry : Integer; +begin + if (Owner is TForm) then + Result:=RasEditPhonebookEntry((Owner as TForm).Handle, nil, PChar(FEntry2Dial)) else + Result:=RasEditPhonebookEntry(0, nil, PChar(FEntry2Dial)); +end; + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} + +Function TDialUp.RenameEntryTo(S : String) : Integer; +begin + Result:=RasRenameEntry(nil, PChar(FEntry2Dial), PChar(S)); +end; + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} + +Function TDialUp.DeleteEntry : Integer; +begin + Result:=RasDeleteEntry(nil, PChar(FEntry2Dial)) +end; + + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} + +function TDialUp.SetEntryUserName(Value : String) : Integer; +var DialParams : TRasDialParams; +begin + with DialParams do + begin + dwSize:=Sizeof(TRasDialParams); + StrPCopy(szEntryName, PChar(FEntry2Dial)); + StrPCopy(szUserName, Value); + end; + Result:=RasSetEntryDialParams(nil, DialParams, False); +end; + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} + +function TDialUp.SetEntryPassword(Value : String) : Integer; +var DialParams : TRasDialParams; +begin + with DialParams do + begin + dwSize:=Sizeof(TRasDialParams); + StrPCopy(szEntryName, PChar(FEntry2Dial)); + StrPCopy(szPassword, Value); + end; + Result:=RasSetEntryDialParams(nil, DialParams, False); +end; + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} + +function TDialUp.RemovePassword : Integer; +var DialParams : TRasDialParams; +begin + with DialParams do + begin + dwSize:=Sizeof(TRasDialParams); + StrPCopy(szEntryName, PChar(FEntry2Dial)); + end; + Result:=RasSetEntryDialParams(nil, DialParams, True); +end; + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} + +function TDialUp.GetEntryUserName(var Value : String) : Integer; +var + Fp : LongBool; + R : Integer; +// C : Array[0..100] of Char; + DialParams : TRasDialParams; +begin + FillChar(DialParams, SizeOf(TRasDialParams), 0); + with DialParams do + begin + dwSize:=Sizeof(TRasDialParams); + StrPCopy(szEntryName, FEntry2Dial); + end; + R:=RasGetEntryDialParams(nil, DialParams, Fp); + if R=0 then + with DialParams do + begin + Value:=szUserName; + end; + Result:=R; +end; + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} + +function TDialUp.GetEntryPassword(var Value : String) : Integer; +var + Fp : LongBool; + R : Integer; +// C : Array[0..100] of Char; + DialParams : TRasDialParams; +begin + FillChar(DialParams, SizeOf(TRasDialParams), 0); + with DialParams do + begin + dwSize:=Sizeof(TRasDialParams); + StrPCopy(szEntryName, FEntry2Dial); + end; + R:=RasGetEntryDialParams(nil, DialParams, Fp); + if R=0 then + with DialParams do + begin + if Fp then + Value:=szPassword else Value:=''; + end; + Result:=R; +end; + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} + +function TDialUp.StatusString(State: TRasConnState; Error: Integer): String; +var + C : Array[0..100] of Char; + S : String; +begin + if Error<>0 then + begin + RasGetErrorString(Error, C, 100); + Result:=C; + end else + begin + S:=''; + case State of + RASCS_OpenPort: + S:='Opening port'; + RASCS_PortOpened: + S:='Port opened'; + RASCS_ConnectDevice: + S:='Connecting device'; + RASCS_DeviceConnected: + S:='Device connected'; + RASCS_AllDevicesConnected: + S:='All devices connected'; + RASCS_Authenticate: + S:='Start authenticating'; + RASCS_AuthNotify: + S:='Authentication: notify'; + RASCS_AuthRetry: + S:='Authentication: retry'; + RASCS_AuthCallback: + S:='Authentication: callback'; + RASCS_AuthChangePassword: + S:='Authentication: change password'; + RASCS_AuthProject: + S:='Authentication: projecting'; + RASCS_AuthLinkSpeed: + S:='Authentication: link speed'; + RASCS_AuthAck: + S:='Authentication: acknowledge'; + RASCS_ReAuthenticate: + S:='Authentication: reauthenticate'; + RASCS_Authenticated: + S:='Authenticated'; + RASCS_PrepareForCallback: + S:='Preparing for callback'; + RASCS_WaitForModemReset: + S:='Waiting for modem reset'; + RASCS_WaitForCallback: + S:='Waiting for callback'; + RASCS_Projected: + S:='Projected'; + RASCS_StartAuthentication: + S:='Start authentication'; + RASCS_CallbackComplete: + S:='Callback complete'; + RASCS_LogonNetwork: + S:='Logging on network'; + + RASCS_Interactive: + S:='Interactive'; + RASCS_RetryAuthentication: + S:='Retry Authentication'; + RASCS_CallbackSetByCaller: + S:='Callback set by caller'; + RASCS_PasswordExpired: + S:='Password expired'; + + RASCS_Connected: + S:='Connected'; + RASCS_Disconnected: + S:='Disconnected'; + end; + Result:=S; + end; +end; +function TDialUp.StatusStringCZ(State: TRasConnState; Error: Integer): String; +var + C : Array[0..100] of Char; + S : String; +begin + if Error<>0 then + begin + RasGetErrorString(Error, C, 100); + Result:=C; + end else + begin + S:=''; + case State of + RASCS_OpenPort: + S:='Otevírá se port'; + RASCS_PortOpened: + S:='Port otevøen'; + RASCS_ConnectDevice: + S:='Probíhá spojování'; + RASCS_DeviceConnected: + S:='Navázáno spojení'; + RASCS_AllDevicesConnected: + S:='Všechna zaøízení spojena'; + RASCS_Authenticate: + S:='Zaèínají se ovìøovat uživatelské informace'; + RASCS_AuthNotify: + S:='Ovìøení: oznámení'; + RASCS_AuthRetry: + S:='Ovìøení: opakování'; + RASCS_AuthCallback: + S:='Ovìøení: zpìtné volání'; + RASCS_AuthChangePassword: + S:='Ovìøení: zmìna hesla'; + RASCS_AuthProject: + S:='Ovìøení: návrh'; + RASCS_AuthLinkSpeed: + S:='Ovìøení: spojovací rychlost'; + RASCS_AuthAck: + S:='Ovìøení: potvrzení'; + RASCS_ReAuthenticate: + S:='Ovìøení: znovuovìøení'; + RASCS_Authenticated: + S:='Ovìøeno'; + RASCS_PrepareForCallback: + S:='Pøíprava na zpetné volání'; + RASCS_WaitForModemReset: + S:='Èeká se na reset modemu'; + RASCS_WaitForCallback: + S:='Èeká se na zpìtné volání'; + RASCS_Projected: + S:='Navrhnuto'; + RASCS_StartAuthentication: + S:='Ovìøování uživatelských informací'; + RASCS_CallbackComplete: + S:='Zpetné volání hotovo'; + RASCS_LogonNetwork: + S:='Pøipojuje se na sí'; + + RASCS_Interactive: + S:='Interakce'; + RASCS_RetryAuthentication: + S:='Opakování oveøení'; + RASCS_CallbackSetByCaller: + S:='Zpeìtné volání zvoleno uživatelem'; + RASCS_PasswordExpired: + S:='Platnost hesla vypršela'; + + RASCS_Connected: + S:='Spojeno'; + RASCS_Disconnected: + S:='Rozpojeno'; + end; + Result:=S; + end; +end; + +{****************************************************************************} +{****************************************************************************} +{****************************************************************************} +{****************************************************************************} + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} +function RasCreatePhonebookEntryA; external 'rasapi32.dll' name 'RasCreatePhonebookEntryA'; +function RasCreatePhonebookEntryW; external 'rasapi32.dll' name 'RasCreatePhonebookEntryW'; +function RasCreatePhonebookEntry; external 'rasapi32.dll' name 'RasCreatePhonebookEntryA'; +function RasDialA; external 'rasapi32.dll' name 'RasDialA'; +function RasDialW; external 'rasapi32.dll' name 'RasDialW'; +function RasDial; external 'rasapi32.dll' name 'RasDialA'; +function RasEditPhonebookEntryA; external 'rasapi32.dll' name 'RasEditPhonebookEntryA'; +function RasEditPhonebookEntryW; external 'rasapi32.dll' name 'RasEditPhonebookEntryW'; +function RasEditPhonebookEntry; external 'rasapi32.dll' name 'RasEditPhonebookEntryA'; +function RasEnumConnectionsA; external 'rasapi32.dll' name 'RasEnumConnectionsA'; +function RasEnumConnectionsW; external 'rasapi32.dll' name 'RasEnumConnectionsW'; +function RasEnumConnections; external 'rasapi32.dll' name 'RasEnumConnectionsA'; +function RasEnumEntriesA; external 'rasapi32.dll' name 'RasEnumEntriesA'; +function RasEnumEntriesW; external 'rasapi32.dll' name 'RasEnumEntriesW'; +function RasEnumEntries; external 'rasapi32.dll' name 'RasEnumEntriesA'; +function RasGetConnectStatusA; external 'rasapi32.dll' name 'RasGetConnectStatusA'; +function RasGetConnectStatusW; external 'rasapi32.dll' name 'RasGetConnectStatusW'; +function RasGetConnectStatus; external 'rasapi32.dll' name 'RasGetConnectStatusA'; +function RasGetEntryDialParamsA; external 'rasapi32.dll' name 'RasGetEntryDialParamsA'; +function RasGetEntryDialParamsW; external 'rasapi32.dll' name 'RasGetEntryDialParamsW'; +function RasGetEntryDialParams; external 'rasapi32.dll' name 'RasGetEntryDialParamsA'; +function RasGetErrorStringA; external 'rasapi32.dll' name 'RasGetErrorStringA'; +function RasGetErrorStringW; external 'rasapi32.dll' name 'RasGetErrorStringW'; +function RasGetErrorString; external 'rasapi32.dll' name 'RasGetErrorStringA'; +function RasGetProjectionInfoA; external 'rasapi32.dll' name 'RasGetProjectionInfoA'; +function RasGetProjectionInfoW; external 'rasapi32.dll' name 'RasGetProjectionInfoW'; +function RasGetProjectionInfo; external 'rasapi32.dll' name 'RasGetProjectionInfoA'; +function RasHangUpA; external 'rasapi32.dll' name 'RasHangUpA'; +function RasHangUpW; external 'rasapi32.dll' name 'RasHangUpW'; +function RasHangUp; external 'rasapi32.dll' name 'RasHangUpA'; +function RasSetEntryDialParamsA; external 'rasapi32.dll' name 'RasSetEntryDialParamsA'; +function RasSetEntryDialParamsW; external 'rasapi32.dll' name 'RasSetEntryDialParamsW'; +function RasSetEntryDialParams; external 'rasapi32.dll' name 'RasSetEntryDialParamsA'; +function RasValidateEntryNameA; external 'rasapi32.dll' name 'RasValidateEntryNameA'; +function RasValidateEntryNameW; external 'rasapi32.dll' name 'RasValidateEntryNameW'; +function RasRenameEntryA; external 'rasapi32.dll' name 'RasRenameEntryA'; +function RasRenameEntryW; external 'rasapi32.dll' name 'RasRenameEntryW'; +function RasDeleteEntryA; external 'rasapi32.dll' name 'RasDeleteEntryA'; +function RasDeleteEntryW; external 'rasapi32.dll' name 'RasDeleteEntryW'; +function RasGetEntryPropertiesA; external 'rasapi32.dll' name 'RasGetEntryPropertiesA'; +function RasGetEntryPropertiesW; external 'rasapi32.dll' name 'RasGetEntryPropertiesW'; +function RasSetEntryPropertiesA; external 'rasapi32.dll' name 'RasSetEntryPropertiesA'; +function RasSetEntryPropertiesW; external 'rasapi32.dll' name 'RasSetEntryPropertiesW'; +function RasGetCountryInfoA; external 'rasapi32.dll' name 'RasGetCountryInfoA'; +function RasGetCountryInfoW; external 'rasapi32.dll' name 'RasGetCountryInfoW'; +function RasEnumDevicesA; external 'rasapi32.dll' name 'RasEnumDevicesA'; +function RasEnumDevicesW; external 'rasapi32.dll' name 'RasEnumDevicesW'; + +var + Rnaph_Initialized : Boolean = False; + Is_Rnaph : Boolean = False; + Lib : HModule; + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} + +function Rnaph_(const func: String): Pointer; +begin + if not Rnaph_Initialized then + begin + // Try first with RASAPI32.DLL + Lib:=LoadLibrary('rasapi32.dll'); + if Lib<>0 then + begin + Result:=GetProcAddress(Lib, PChar(Func+'A')); + if Result<>nil then + begin + Rnaph_Initialized:=True; + Exit; + end; + end else raise Exception.Create('Error opening rasapi.dll'); + // function not found - try rnaph.dll + Lib:=LoadLibrary('rnaph.dll'); + if Lib<>0 then + begin + Result:=GetProcAddress(Lib, PChar(Func)); + if Result <> nil then + begin + Rnaph_Initialized:=True; + Is_Rnaph:=True; + Exit; + end else raise Exception.Create('Function '+Func+' not found!'); + end else raise Exception.Create('Error opening rnaph.dll'); + end else + begin + if Is_Rnaph then Result:=GetProcAddress(Lib,PChar(Func)) + else Result:=GetProcAddress(lib,PChar(Func+'A')); + if Result=nil then raise Exception.Create('Function '+Func+' not found!'); + end; +end; + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} + +function RasValidateEntryName(lpszPhonebook, szEntry: PAnsiChar): Longint; +var + F : Function(lpszPhonebook, szEntry: PAnsiChar): Longint; stdcall; +begin + @F:=Rnaph_('RasValidateEntryName'); + Result:=F(lpszPhonebook, szEntry); +end; + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} + +function RasRenameEntry(lpszPhonebook, szEntryOld, szEntryNew: PAnsiChar): Longint; +var + F : function(lpszPhonebook, szEntryOld, szEntryNew: PAnsiChar): Longint; stdcall; +begin + @F:=rnaph_('RasRenameEntry'); + Result:=F(lpszPhonebook, szEntryOld, szEntryNew); +end; + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} + +function RasDeleteEntry(lpszPhonebook, szEntry: PAnsiChar): Longint; +var + F : function(lpszPhonebook, szEntry: PAnsiChar): Longint; stdcall; +begin + @F:=Rnaph_('RasDeleteEntry'); + Result:=F(lpszPhonebook, szEntry); +end; + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} + +function RasGetEntryProperties(lpszPhonebook, szEntry: PAnsiChar; lpbEntry: Pointer; + var lpdwEntrySize: Longint; lpbDeviceInfo: Pointer; + var lpdwDeviceInfoSize: Longint): Longint; +var + F : function(lpszPhonebook, szEntry: PAnsiChar; lpbEntry: Pointer; + lpdwEntrySize : Longint; + lpbDeviceInfo : Pointer; + lpdwDeviceInfoSize : Longint): Longint; stdcall; +begin + @F:=Rnaph_('RasGetEntryProperties'); + Result:=F(lpszPhonebook, szEntry, lpbEntry, lpdwEntrySize, lpbDeviceInfo, lpdwDeviceInfoSize); +end; + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} + +function RasSetEntryProperties(lpszPhonebook, szEntry: PAnsiChar; + lpbEntry: Pointer; dwEntrySize: Longint; lpbDeviceInfo: Pointer; + dwDeviceInfoSize: Longint): Longint; +var + F : function(lpszPhonebook, szEntry: PAnsiChar; + lpbEntry: Pointer; dwEntrySize: Longint; + lpbDeviceInfo: Pointer; + dwDeviceInfoSize: Longint): Longint; stdcall; +begin + @F:=Rnaph_('RasSetEntryProperties'); + Result:=F(lpszPhonebook, szEntry, lpbEntry, dwEntrySize, lpbDeviceInfo, dwDeviceInfoSize); +end; + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} + +function RasGetCountryInfo(var lpCtryInfo: TRasCtryInfo; var lpdwSize: Longint): Longint; +var + F : function(var lpCtryInfo: TRasCtryInfo; + var lpdwSize: Longint): Longint; stdcall; +begin + @F:=Rnaph_('RasGetCountryInfo'); + Result:=F(lpCtryInfo, lpdwSize); +end; + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} + +function RasEnumDevices(lpBuff: LpRasDevInfo; var lpcbSize: Longint; + var lpcDevices: Longint): Longint; +var + F : function(lpBuff: LpRasDevInfo; var lpcbSize: Longint; + var lpcDevices: Longint): Longint; stdcall; +begin + @F:=Rnaph_('RasEnumDevices'); + Result:=F(lpBuff, lpcbSize, lpcDevices); +end; + +{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} + +initialization + +finalization + if Rnaph_initialized and Is_rnaph then FreeLibrary(lib); +end. + diff --git a/CDopping/Leeme.txt b/CDopping/Leeme.txt new file mode 100644 index 0000000..281d2be --- /dev/null +++ b/CDopping/Leeme.txt @@ -0,0 +1,30 @@ +TElasticForm + +Cracked By --- Sol Negro (c)--- + +Time to crack: 2 min. +--- The most easy program, never cracked. + +¿¿¿¿¿?????? +Bytes changed: + 8B45FC + 33D2 + 895060 + 8B45FC + F6402010 + 75 <-----------[ EB ] +37 bytes more down: + 75 <-----------[ EB ] + + +¿ How did I cracked the program ? + +Easy, I built a program using that component, then I search the entry point to nags screen. +I written down this asm instrucctions ( opcodes ) which it wasn't jump or call instruction. +Do you remember this? .LIB or .DLL are mirrors of code in .EXE. WOOOOOUU, +Searching this opcodes on .LIB or .DLL we can crack those files. + + +¿ Why is it this document in (bad) English ? + +Easy, to DESpist: ¿Where are --Sol Negro--? diff --git a/CDopping/QSElFrm.bpi b/CDopping/QSElFrm.bpi new file mode 100644 index 0000000..45ca16a Binary files /dev/null and b/CDopping/QSElFrm.bpi differ diff --git a/CDopping/QSElFrm.bpl b/CDopping/QSElFrm.bpl new file mode 100644 index 0000000..cc1a80d Binary files /dev/null and b/CDopping/QSElFrm.bpl differ diff --git a/CDopping/QSElFrm.lib b/CDopping/QSElFrm.lib new file mode 100644 index 0000000..53334c0 Binary files /dev/null and b/CDopping/QSElFrm.lib differ diff --git a/CDopping/TElasticForm.zip b/CDopping/TElasticForm.zip new file mode 100644 index 0000000..bbcf9d7 Binary files /dev/null and b/CDopping/TElasticForm.zip differ diff --git a/CDopping/Tb97/TB97.DCR b/CDopping/Tb97/TB97.DCR new file mode 100644 index 0000000..3d6d400 Binary files /dev/null and b/CDopping/Tb97/TB97.DCR differ diff --git a/CDopping/Tb97/TB97.PAS b/CDopping/Tb97/TB97.PAS new file mode 100644 index 0000000..ff007d9 --- /dev/null +++ b/CDopping/Tb97/TB97.PAS @@ -0,0 +1,7135 @@ +unit TB97; + +{ + + Toolbar97 version 1.63 (with Delphi 4 support) + Copyright (C) 1998 by Jordan Russell + + e-mail: jordanr@iname.com + home page: http://www.connect.net/jordanr/ + (alternate address: http://www.digicron.com/jordanr/) + + *PLEASE NOTE* Before making any bug reports please first verify you are + using the latest version by checking my home page. And if + you do report a bug, please, if applicable, include a code + sample. + + You are free to use Toolbar97 in compiled form for any purpose. However, + use in commercial or shareware applications requires registration. The + Toolbar97 source code or DCU, in whole or in part, modified or unmodified, + may not be redistributed for profit or as part of another commercial or + shareware software package without express written permission from me. + + This code is distributed "as is" without any warranties, express or implied. + + Notes: + - I cannot support modified versions of this code. So if you encounter a + possible bug while using a modified version, always first revert back to + the my original code before making an attempt to contact me. + - While debugging the toolbar code you might want to enable the + 'TB97DisableLock' conditional define, as described below. + - In the WM_NCPAINT handlers, GetWindowRect is used to work around a possible + VCL problem. The Width, Height, and BoundsRect properties are sometimes + wrong. So it avoids any use of these properties in the WM_NCPAINT handlers. + - In case you are unsure of its meaning, NewStyleControls is a VCL variable + set to True at application startup if the user is running Windows 95 or NT + 4.0 or later. +} + +{$IFNDEF WIN32} Delphi 1 is not supported. {$ENDIF} + +{$ALIGN ON} +{$BOOLEVAL OFF} +{$LONGSTRINGS ON} +{$WRITEABLECONST ON} + +{x$DEFINE TB97DisableLock} +{ Remove the 'x' to enable the define. It will disable calls to + LockWindowUpdate, which it calls to disable screen updates while dragging. + You should temporarily enable that while debugging so you are able to see + your code window if you have something like a breakpoint that's set inside + the dragging routines } + +{ Determine Delphi/C++Builder version } +{$IFNDEF VER90} { if it's not Delphi 2.0 } + {$IFNDEF VER93} { and it's not C++Builder 1.0 } + {$DEFINE TB97Delphi3orHigher} { then it must be Delphi 3 or C++Builder 3 } + {$ENDIF} +{$ENDIF} + + +interface + +uses + Windows, Messages, Classes, Controls, Forms, Menus, Graphics, Buttons, + StdCtrls, ExtCtrls; + +const + Toolbar97Version = '1.63'; + + WM_TB97DoneCreating = WM_USER + 5038; { used internally } + WM_TB97DoneCreating_Magic = $73A590F4; { used internally } + WM_TB97PaintDockedNCArea = WM_USER + 5039; { used internally } + +type + { TDock97 } + + TDockBoundLinesValues = (blTop, blBottom, blLeft, blRight); + TDockBoundLines = set of TDockBoundLinesValues; + TDockPosition = (dpTop, dpBottom, dpLeft, dpRight); + TDockType = (dtNotDocked, dtTopBottom, dtLeftRight); + TDockableTo = set of TDockPosition; + + TCustomToolWindow97 = class; + + TInsertRemoveEvent = procedure(Sender: TObject; Inserting: Boolean; + Bar: TCustomToolWindow97) of object; + TRequestDockEvent = procedure(Sender: TObject; Bar: TCustomToolWindow97; + var Accept: Boolean) of object; + + TDock97 = class(TCustomControl) + private + { Property values } + FPosition: TDockPosition; + FAllowDrag: Boolean; + FBoundLines: TDockBoundLines; + FBkg, FBkgCache: TBitmap; + FBkgTransparent, FBkgOnToolbars: Boolean; + FFixAlign: Boolean; + FLimitToOneRow: Boolean; + FOnInsertRemoveBar: TInsertRemoveEvent; + FOnRequestDock: TRequestDockEvent; + FOnResize: TNotifyEvent; + + { Internal } + DisableArrangeToolbars: Integer; { Increment to disable ArrangeToolbars } + DockList: TList; { List of the visible toolbars docked. Items are casted in TCustomToolWindow97's. + But, at design time, all docked toolbars are here regardless of visibility } + RowSizes: TList; { List of the width or height of each row, depending on what Position is set to. + Items are casted info Longint's } + + { Property access methods } + procedure SetAllowDrag (Value: Boolean); + procedure SetBackground (Value: TBitmap); + procedure SetBackgroundOnToolbars (Value: Boolean); + procedure SetBackgroundTransparent (Value: Boolean); + procedure SetBoundLines (Value: TDockBoundLines); + procedure SetFixAlign (Value: Boolean); + procedure SetPosition (Value: TDockPosition); + + function GetToolbarCount: Integer; + function GetToolbars (Index: Integer): TCustomToolWindow97; + + { Internal } + procedure FreeRowInfo; + function GetRowOf (const XY: Integer; var Before: Boolean): Integer; + function GetDesignModeRowOf (const XY: Integer): Integer; + function GetHighestRow: Integer; + function GetNumberOfToolbarsOnRow (const Row: Integer; + const NotIncluding: TCustomToolWindow97): Integer; + procedure RemoveBlankRows; + procedure InsertRowBefore (const BeforeRow: Integer); + procedure BuildRowInfo; + procedure ChangeDockList (const Insert: Boolean; const Bar: TCustomToolWindow97; + const IsVisible: Boolean); + procedure ChangeWidthHeight (const IsClientWidthAndHeight: Boolean; + NewWidth, NewHeight: Integer); + procedure ArrangeToolbars; + procedure DrawBackground (const DC: HDC; + const IntersectClippingRect: TRect; const ExcludeClippingRect: PRect; + const DrawRect: TRect); + procedure InvalidateBackgrounds; + procedure BackgroundChanged (Sender: TObject); + function UsingBackground: Boolean; + + { Messages } + procedure CMColorChanged (var Message: TMessage); message CM_COLORCHANGED; + procedure CMSysColorChange (var Message: TMessage); message CM_SYSCOLORCHANGE; + procedure WMMove (var Message: TWMMove); message WM_MOVE; + procedure WMSize (var Message: TWMSize); message WM_SIZE; + procedure WMNCCalcSize (var Message: TWMNCCalcSize); message WM_NCCALCSIZE; + procedure WMNCPaint (var Message: TMessage); message WM_NCPAINT; + protected + procedure AlignControls (AControl: TControl; var Rect: TRect); override; + function GetPalette: HPALETTE; override; + procedure Loaded; override; + procedure SetParent (AParent: TWinControl); override; + procedure Paint; override; + procedure VisibleChanging; override; + public + constructor Create (AOwner: TComponent); override; + procedure CreateParams (var Params: TCreateParams); override; + destructor Destroy; override; + + function GetRowSize (const Row: Integer; + const DefaultToolbar: TCustomToolWindow97): Integer; + + property ToolbarCount: Integer read GetToolbarCount; + property Toolbars[Index: Integer]: TCustomToolWindow97 read GetToolbars; + published + property AllowDrag: Boolean read FAllowDrag write SetAllowDrag default True; + property Background: TBitmap read FBkg write SetBackground; + property BackgroundOnToolbars: Boolean read FBkgOnToolbars write SetBackgroundOnToolbars default True; + property BackgroundTransparent: Boolean read FBkgTransparent write SetBackgroundTransparent default False; + property BoundLines: TDockBoundLines read FBoundLines write SetBoundLines default []; + property Color default clBtnFace; + property FixAlign: Boolean read FFixAlign write SetFixAlign default False; + property LimitToOneRow: Boolean read FLimitToOneRow write FLimitToOneRow default False; + property PopupMenu; + property Position: TDockPosition read FPosition write SetPosition default dpTop; + + property OnInsertRemoveBar: TInsertRemoveEvent read FOnInsertRemoveBar write FOnInsertRemoveBar; + property OnRequestDock: TRequestDockEvent read FOnRequestDock write FOnRequestDock; + property OnResize: TNotifyEvent read FOnResize write FOnResize; + end; + + { TCustomToolWindow97 } + + TToolWindowArrangeType = (atNone, atMoveControls, atMoveControlsAndResize); + TToolWindowParams = record + CallAlignControls, ResizeEightCorner, ResizeClipCursor: Boolean; + end; + TPositionReadIntProc = function(const ToolbarName, Value: String; const Default: Longint; + const ExtraData: Pointer): Longint; + TPositionReadStringProc = function(const ToolbarName, Value, Default: String; + const ExtraData: Pointer): String; + TPositionWriteIntProc = procedure(const ToolbarName, Value: String; const Data: Longint; + const ExtraData: Pointer); + TPositionWriteStringProc = procedure(const ToolbarName, Value, Data: String; + const ExtraData: Pointer); + + TCustomToolWindow97 = class(TCustomControl) + private + { Property variables } + FDockPos, FDockRow: Integer; + FDocked: Boolean; + FDockedTo, FDefaultDock: TDock97; + FOnClose, FOnDockChanged, FOnDockChanging, FOnRecreated, FOnRecreating, + FOnResize, FOnVisibleChanged: TNotifyEvent; + FActivateParent, FHideWhenInactive, FCloseButton, FFullSize, FResizable, + FDragHandle: Boolean; + FDockableTo: TDockableTo; + FParams: TToolWindowParams; + + { Misc. } + FUpdatingBounds, { Incremented while internally changing the bounds. This allows + it to move the toolbar freely in design mode and prevents the + SizeChanging protected method from begin called } + FDisableArrangeControls, { Incremented to disable ArrangeControls } + FHidden: Integer; { Incremented while the toolbar is temporarily hidden } + FArrangeNeeded: Boolean; + FInactiveCaption: Boolean; { True when the caption of the toolbar is currently the inactive color } + FFloatingTopLeft: TPoint; + + { When floating. These are not used (and FloatParent isn't created) in design mode } + FloatParent: TWinControl; { The actual Parent of the toolbar when it is floating } + MDIParentForm: TForm; { Either the owner form, or the MDI parent if the owner form is an MDI child form } + NotOnScreen: Boolean; { True if the toolbar is currently hidden from view. + This is True while the toolbar is creating or when the application is deactivated } + CloseButtonDown: Boolean; { True if Close button is currently depressed } + + { Property access methods } + procedure SetCloseButton (Value: Boolean); + procedure SetDefaultDock (Value: TDock97); + procedure SetDockedTo (Value: TDock97); + procedure SetDockPos (Value: Integer); + procedure SetDockRow (Value: Integer); + procedure SetDragHandle (Value: Boolean); + procedure SetFullSize (Value: Boolean); + procedure SetResizable (Value: Boolean); + + { Internal } + procedure MoveOnScreen (const OnlyIfFullyOffscreen: Boolean); + procedure CustomArrangeControls (const ArrangeType: TToolWindowArrangeType; + const WasDockedTo, DockingTo: TDock97; var NewClientSize: TPoint); + procedure ArrangeControls; + procedure DrawDraggingOutline (const DC: HDC; const NewRect, OldRect: PRect; + const NewDocking, OldDocking: Boolean); + class function NewMainWindowHook (var Message: TMessage): Boolean; + procedure BeginMoving (const InitX, InitY: Integer); + procedure BeginSizing (const HitTestValue: Integer; var Accept: Boolean; + var NewRect: TRect); + procedure DrawFloatingNCArea (const Clip: HRGN; const RedrawBorder, RedrawCaption, RedrawCloseButton: Boolean); + procedure DrawDockedNCArea (const Clip: HRGN); + procedure InvalidateDockedNCArea; + procedure ValidateDockedNCArea; + procedure SetNotOnScreen (const Value: Boolean); + procedure SetInactiveCaption (const Value: Boolean); + + { Messages } + procedure CMColorChanged (var Message: TMessage); message CM_COLORCHANGED; + procedure CMTextChanged (var Message: TMessage); message CM_TEXTCHANGED; + procedure CMShowingChanged (var Message: TMessage); message CM_SHOWINGCHANGED; + procedure CMVisibleChanged (var Message: TMessage); message CM_VISIBLECHANGED; + procedure WMActivate (var Message: TWMActivate); message WM_ACTIVATE; + procedure WMClose (var Message: TWMClose); message WM_CLOSE; + procedure WMGetMinMaxInfo (var Message: TWMGetMinMaxInfo); message WM_GETMINMAXINFO; + procedure WMMove (var Message: TWMMove); message WM_MOVE; + procedure WMMouseActivate (var Message: TWMMouseActivate); message WM_MOUSEACTIVATE; + procedure WMNCCalcSize (var Message: TWMNCCalcSize); message WM_NCCALCSIZE; + procedure WMNCHitTest (var Message: TWMNCHitTest); message WM_NCHITTEST; + procedure WMNCLButtonDown (var Message: TWMNCLButtonDown); message WM_NCLBUTTONDOWN; + procedure WMNCPaint (var Message: TMessage); message WM_NCPAINT; + procedure WMTB97PaintDockedNCArea (var Message: TMessage); message WM_TB97PaintDockedNCArea; + procedure WMSize (var Message: TWMSize); message WM_SIZE; + protected + property ActivateParent: Boolean read FActivateParent write FActivateParent default True; + property Color default clBtnFace; + property CloseButton: Boolean read FCloseButton write SetCloseButton default True; + property DefaultDock: TDock97 read FDefaultDock write SetDefaultDock; + property DockableTo: TDockableTo read FDockableTo write FDockableTo default [dpTop, dpBottom, dpLeft, dpRight]; + property DockedTo: TDock97 read FDockedTo write SetDockedTo; + property DockPos: Integer read FDockPos write SetDockPos default -1; + property DockRow: Integer read FDockRow write SetDockRow default 0; + property DragHandle: Boolean read FDragHandle write SetDragHandle default True; + property FullSize: Boolean read FFullSize write SetFullSize default False; + property HideWhenInactive: Boolean read FHideWhenInactive write FHideWhenInactive default True; + property Params: TToolWindowParams read FParams; + property Resizable: Boolean read FResizable write SetResizable default True; + + property OnClose: TNotifyEvent read FOnClose write FOnClose; + property OnDockChanged: TNotifyEvent read FOnDockChanged write FOnDockChanged; + property OnDockChanging: TNotifyEvent read FOnDockChanging write FOnDockChanging; + property OnRecreated: TNotifyEvent read FOnRecreated write FOnRecreated; + property OnRecreating: TNotifyEvent read FOnRecreating write FOnRecreating; + property OnResize: TNotifyEvent read FOnResize write FOnResize; + property OnVisibleChanged: TNotifyEvent read FOnVisibleChanged write FOnVisibleChanged; + + { Overridden methods } + procedure AlignControls (AControl: TControl; var Rect: TRect); override; + procedure CreateParams (var Params: TCreateParams); override; + function GetPalette: HPALETTE; override; + procedure Loaded; override; + procedure MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure Notification (AComponent: TComponent; Operation: TOperation); override; + procedure Paint; override; + function PaletteChanged (Foreground: Boolean): Boolean; override; + procedure SetParent (AParent: TWinControl); override; + + { Methods accessible to descendants } + procedure ReadPositionData (const ReadIntProc: TPositionReadIntProc; + const ReadStringProc: TPositionReadStringProc; const ExtraData: Pointer); dynamic; + procedure DoneReadingPositionData; dynamic; + procedure WritePositionData (const WriteIntProc: TPositionWriteIntProc; + const WriteStringProc: TPositionWriteStringProc; const ExtraData: Pointer); dynamic; + procedure GetParams (var Params: TToolWindowParams); dynamic; + procedure ResizeBegin (HitTestValue: Integer); dynamic; + procedure ResizeTrack (var Rect: TRect; const OrigRect: TRect); dynamic; + procedure ResizeEnd (Accept: Boolean); dynamic; + procedure GetBarSize (var ASize: Integer; const DockType: TDockType); virtual; abstract; + procedure GetDockRowSize (var AHeightOrWidth: Integer); + procedure GetMinimumSize (var AClientWidth, AClientHeight: Integer); virtual; abstract; + procedure InitializeOrdering; dynamic; + procedure OrderControls (const CanMoveControls: Boolean; + const WasDockedTo, DockingTo: TDock97; var NewClientSize: TPoint); virtual; abstract; + procedure SizeChanging (const AWidth, AHeight: Integer); virtual; + public + property Docked: Boolean read FDocked; + + constructor Create (AOwner: TComponent); override; + destructor Destroy; override; + procedure SetBounds (ALeft, ATop, AWidth, AHeight: Integer); override; + + procedure BeginUpdate; + procedure EndUpdate; + published + property Height stored False; + property Width stored False; + property ClientHeight stored True; + property ClientWidth stored True; + end; + + { TCustomToolbar97 } + + TCustomToolbar97 = class(TCustomToolWindow97) + private + FFloatingRightX: Integer; + SizeData: Pointer; + + { Lists } + SlaveInfo, { List of slave controls. Items are pointers to TSlaveInfo's } + GroupInfo, { List of the control "groups". List items are pointers to TGroupInfo's } + LineSeps, { List of the Y locations of line separators. Items are casted in TLineSep's } + OrderList: TList; { List of the child controls, arranged using the current "OrderIndex" values } + + { Property access methods } + function GetOrderIndex (Control: TControl): Integer; + procedure SetOrderIndex (Control: TControl; Value: Integer); + + { Internal } + function ShouldBeVisible (const Control: TControl; const LeftOrRight: Boolean; + const SetIt: Boolean): Boolean; + procedure FreeGroupInfo (const List: TList); + procedure BuildGroupInfo (const List: TList; const TranslateSlave: Boolean; + const OldDockType, NewDockType: TDockType); + + { Messages } + procedure CMControlListChange (var Message: TCMControlListChange); message CM_CONTROLLISTCHANGE; + protected + procedure Paint; override; + + procedure ReadPositionData (const ReadIntProc: TPositionReadIntProc; + const ReadStringProc: TPositionReadStringProc; const ExtraData: Pointer); override; + procedure WritePositionData (const WriteIntProc: TPositionWriteIntProc; + const WriteStringProc: TPositionWriteStringProc; const ExtraData: Pointer); override; + procedure GetParams (var Params: TToolWindowParams); override; + procedure ResizeBegin (HitTestValue: Integer); override; + procedure ResizeTrack (var Rect: TRect; const OrigRect: TRect); override; + procedure ResizeEnd (Accept: Boolean); override; + + procedure GetBarSize (var ASize: Integer; const DockType: TDockType); override; + procedure GetMinimumSize (var AClientWidth, AClientHeight: Integer); override; + procedure InitializeOrdering; override; + procedure OrderControls (const CanMoveControls: Boolean; + const WasDockedTo, DockingTo: TDock97; var NewClientSize: TPoint); override; + public + property OrderIndex[Control: TControl]: Integer read GetOrderIndex write SetOrderIndex; + constructor Create (AOwner: TComponent); override; + destructor Destroy; override; + procedure SetSlaveControl (const ATopBottom, ALeftRight: TControl); + published + property ClientHeight stored False; + property ClientWidth stored False; + end; + + { TToolbar97 } + + TToolbar97 = class(TCustomToolbar97) + published + property ActivateParent; + property Caption; + property Color; + property CloseButton; + property DefaultDock; + property DockableTo; + property DockedTo; + property DockPos; + property DockRow; + property DragHandle; + property FullSize; + property HideWhenInactive; + property ParentShowHint; + property PopupMenu; + property ShowHint; + property TabOrder; + property Visible; + + property OnClose; + property OnDragDrop; + property OnDragOver; + property OnRecreated; + property OnRecreating; + property OnDockChanged; + property OnDockChanging; + property OnResize; + property OnVisibleChanged; + end; + + { TToolWindow97 } + + TToolWindow97 = class(TCustomToolWindow97) + private + FMinClientWidth, FMinClientHeight: Integer; + FBarHeight, FBarWidth: Integer; + protected + procedure CreateParams (var Params: TCreateParams); override; + + procedure ReadPositionData (const ReadIntProc: TPositionReadIntProc; + const ReadStringProc: TPositionReadStringProc; const ExtraData: Pointer); override; + procedure WritePositionData (const WriteIntProc: TPositionWriteIntProc; + const WriteStringProc: TPositionWriteStringProc; const ExtraData: Pointer); override; + procedure GetBarSize (var ASize: Integer; const DockType: TDockType); override; + procedure GetMinimumSize (var AClientWidth, AClientHeight: Integer); override; + procedure OrderControls (const CanMoveControls: Boolean; + const WasDockedTo, DockingTo: TDock97; var NewClientSize: TPoint); override; + procedure SizeChanging (const AWidth, AHeight: Integer); override; + public + constructor Create (AOwner: TComponent); override; + published + property ActivateParent; + property Caption; + property Color; + property CloseButton; + property DefaultDock; + property DockableTo; + property DockedTo; + property DockPos; + property DockRow; + property DragHandle; + property FullSize; + property HideWhenInactive; + property MinClientHeight: Integer read FMinClientHeight write FMinClientHeight default 32; + property MinClientWidth: Integer read FMinClientWidth write FMinClientWidth default 32; + property ParentShowHint; + property PopupMenu; + property Resizable; + property ShowHint; + property TabOrder; + property Visible; + + property OnClose; + property OnDragDrop; + property OnDragOver; + property OnDockChanged; + property OnDockChanging; + property OnRecreated; + property OnRecreating; + property OnResize; + property OnVisibleChanged; + end; + + { TToolbarSep97 } + + TToolbarSepSize = 1..MaxInt; + + TToolbarSep97 = class(TGraphicControl) + private + FBlank: Boolean; + FSizeHorz, FSizeVert: TToolbarSepSize; + procedure SetBlank (Value: Boolean); + procedure SetSizeHorz (Value: TToolbarSepSize); + procedure SetSizeVert (Value: TToolbarSepSize); + protected + procedure MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure Paint; override; + procedure SetParent (AParent: TWinControl); override; + public + constructor Create (AOwner: TComponent); override; + published + { These two properties don't need to be stored since it automatically gets + resized based on the setting of SizeHorz and SizeVert } + property Width stored False; + property Height stored False; + property Blank: Boolean read FBlank write SetBlank default False; + property SizeHorz: TToolbarSepSize read FSizeHorz write SetSizeHorz default 6; + property SizeVert: TToolbarSepSize read FSizeVert write SetSizeVert default 6; + end; + + { TToolbarButton97 } + + TButtonDisplayMode = (dmBoth, dmGlyphOnly, dmTextOnly); + TButtonState97 = (bsUp, bsDisabled, bsDown, bsExclusive, bsMouseIn); + TNumGlyphs97 = 1..5; + + TToolbarButton97 = class(TGraphicControl) + private + FAllowAllUp: Boolean; + FDisplayMode: TButtonDisplayMode; + FDown: Boolean; + FDropdownArrow: Boolean; + FDropdownCombo: Boolean; + FDropdownMenu: TPopupMenu; + FFlat: Boolean; + FGlyph: Pointer; + FGroupIndex: Integer; + FLayout: TButtonLayout; + FMargin: Integer; + FModalResult: TModalResult; + FNoBorder: Boolean; + FOldDisabledStyle: Boolean; + FOpaque: Boolean; + FRepeating: Boolean; + FRepeatDelay, FRepeatInterval: Integer; + FShowBorderWhenInactive: Boolean; + FSpacing: Integer; + FWordWrap: Boolean; + FOnMouseEnter, FOnMouseExit: TNotifyEvent; + { Internal } + FInClick: Boolean; + FMouseInControl: Boolean; + FMouseIsDown: Boolean; + FMenuIsDown: Boolean; + FHooked: Boolean; + FUsesDropdown: Boolean; + FRepeatTimer: TTimer; + procedure GlyphChanged(Sender: TObject); + procedure UpdateExclusive; + procedure SetAllowAllUp (Value: Boolean); + function GetCallDormant: Boolean; + procedure SetCallDormant (Value: Boolean); + procedure SetDown (Value: Boolean); + procedure SetDisplayMode (Value: TButtonDisplayMode); + procedure SetDropdownArrow (Value: Boolean); + procedure SetDropdownCombo (Value: Boolean); + procedure SetDropdownMenu (Value: TPopupMenu); + procedure SetFlat (Value: Boolean); + function GetGlyph: TBitmap; + procedure SetGlyph (Value: TBitmap); + function GetGlyphMask: TBitmap; + procedure SetGlyphMask (Value: TBitmap); + procedure SetGroupIndex (Value: Integer); + procedure SetLayout (Value: TButtonLayout); + procedure SetMargin (Value: Integer); + procedure SetNoBorder (Value: Boolean); + function GetNumGlyphs: TNumGlyphs97; + procedure SetNumGlyphs (Value: TNumGlyphs97); + procedure SetOldDisabledStyle (Value: Boolean); + procedure SetOpaque (Value: Boolean); + procedure SetSpacing (Value: Integer); + procedure SetWordWrap (Value: Boolean); + procedure UpdateTracking; + procedure Redraw (const Erase: Boolean); + function PointInButton (X, Y: Integer): Boolean; + procedure ButtonMouseTimerHandler (Sender: TObject); + procedure RepeatTimerHandler (Sender: TObject); + class function DeactivateHook (var Message: TMessage): Boolean; + procedure WMLButtonDblClk (var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK; + procedure CMEnabledChanged (var Message: TMessage); message CM_ENABLEDCHANGED; + procedure CMButtonPressed (var Message: TMessage); message CM_BUTTONPRESSED; + procedure CMDialogChar (var Message: TCMDialogChar); message CM_DIALOGCHAR; + procedure CMFontChanged (var Message: TMessage); message CM_FONTCHANGED; + procedure CMTextChanged (var Message: TMessage); message CM_TEXTCHANGED; + procedure CMSysColorChange (var Message: TMessage); message CM_SYSCOLORCHANGE; + procedure CMMouseLeave (var Message: TMessage); message CM_MOUSELEAVE; + procedure WMCancelMode (var Message: TWMCancelMode); message WM_CANCELMODE; + protected + FState: TButtonState97; + function GetPalette: HPALETTE; override; + procedure Loaded; override; + procedure Notification (AComponent: TComponent; Operation: TOperation); override; + procedure MouseDown (Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; + procedure MouseMove (Shift: TShiftState; X, Y: Integer); override; + procedure MouseUp (Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; + procedure Paint; override; + public + property CallDormant: Boolean read GetCallDormant write SetCallDormant; + + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure Click; override; + procedure MouseEntered; + procedure MouseLeft; + published + property AllowAllUp: Boolean read FAllowAllUp write SetAllowAllUp default False; + property GroupIndex: Integer read FGroupIndex write SetGroupIndex default 0; + property DisplayMode: TButtonDisplayMode read FDisplayMode write SetDisplayMode default dmBoth; + property Down: Boolean read FDown write SetDown default False; + property DragCursor; + property DragMode; + property DropdownArrow: Boolean read FDropdownArrow write SetDropdownArrow default True; + property DropdownCombo: Boolean read FDropdownCombo write SetDropdownCombo default False; + property DropdownMenu: TPopupMenu read FDropdownMenu write SetDropdownMenu; + property Caption; + property Enabled; + property Flat: Boolean read FFlat write SetFlat default True; + property Font; + property Glyph: TBitmap read GetGlyph write SetGlyph; + property GlyphMask: TBitmap read GetGlyphMask write SetGlyphMask; + property Layout: TButtonLayout read FLayout write SetLayout default blGlyphLeft; + property Margin: Integer read FMargin write SetMargin default -1; + property ModalResult: TModalResult read FModalResult write FModalResult default 0; + property NoBorder: Boolean read FNoBorder write SetNoBorder default False; + property NumGlyphs: TNumGlyphs97 read GetNumGlyphs write SetNumGlyphs default 1; + property OldDisabledStyle: Boolean read FOldDisabledStyle write SetOldDisabledStyle default False; + property Opaque: Boolean read FOpaque write SetOpaque default True; + property ParentFont; + property ParentShowHint; + property Repeating: Boolean read FRepeating write FRepeating default False; + property RepeatDelay: Integer read FRepeatDelay write FRepeatDelay default 400; + property RepeatInterval: Integer read FRepeatInterval write FRepeatInterval default 100; + property ShowBorderWhenInactive: Boolean read FShowBorderWhenInactive write FShowBorderWhenInactive default False; + property ShowHint; + property Spacing: Integer read FSpacing write SetSpacing default 4; + property Visible; + property WordWrap: Boolean read FWordWrap write SetWordWrap default False; + + property OnClick; + property OnDblClick; + property OnDragDrop; + property OnDragOver; + property OnEndDrag; + property OnMouseDown; + property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter; + property OnMouseExit: TNotifyEvent read FOnMouseExit write FOnMouseExit; + property OnMouseMove; + property OnMouseUp; + property OnStartDrag; + end; + + { TEdit97 } + + TEdit97 = class(TCustomEdit) + private + MouseInControl: Boolean; + procedure RedrawBorder (const Clip: HRGN); + procedure NewAdjustHeight; + procedure CMEnabledChanged (var Message: TMessage); message CM_ENABLEDCHANGED; + procedure CMFontChanged (var Message: TMessage); message CM_FONTCHANGED; + procedure CMMouseEnter (var Message: TMessage); message CM_MOUSEENTER; + procedure CMMouseLeave (var Message: TMessage); message CM_MOUSELEAVE; + procedure WMSetFocus (var Message: TWMSetFocus); message WM_SETFOCUS; + procedure WMKillFocus (var Message: TWMKillFocus); message WM_KILLFOCUS; + procedure WMNCCalcSize (var Message: TWMNCCalcSize); message WM_NCCALCSIZE; + procedure WMNCPaint (var Message: TMessage); message WM_NCPAINT; + protected + procedure Loaded; override; + public + constructor Create (AOwner: TComponent); override; + published + property CharCase; + property DragCursor; + property DragMode; + property Enabled; + property Font; + property HideSelection; + {$IFDEF TB97Delphi3orHigher} + property ImeMode; + property ImeName; + {$ENDIF} + property MaxLength; + property OEMConvert; + property ParentColor; + property ParentCtl3D; + property ParentFont; + property ParentShowHint; + property PasswordChar; + property PopupMenu; + property ReadOnly; + property ShowHint; + property TabOrder; + property TabStop; + property Text; + property Visible; + property OnChange; + property OnClick; + property OnDblClick; + property OnDragDrop; + property OnDragOver; + property OnEndDrag; + property OnEnter; + property OnExit; + property OnKeyDown; + property OnKeyPress; + property OnKeyUp; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnStartDrag; + end; + +procedure RegLoadToolbarPositions (const Form: TForm; const BaseRegistryKey: String); +procedure RegSaveToolbarPositions (const Form: TForm; const BaseRegistryKey: String); +procedure IniLoadToolbarPositions (const Form: TForm; const Filename: String); +procedure IniSaveToolbarPositions (const Form: TForm; const Filename: String); + +procedure CustomLoadToolbarPositions (const Form: TForm; + const ReadIntProc: TPositionReadIntProc; + const ReadStringProc: TPositionReadStringProc; const ExtraData: Pointer); +procedure CustomSaveToolbarPositions (const Form: TForm; + const WriteIntProc: TPositionWriteIntProc; + const WriteStringProc: TPositionWriteStringProc; const ExtraData: Pointer); + +procedure AddFloatingNCAreaToRect (var R: TRect; const Resizable: Boolean); +function GetDockTypeOf (const Control: TDock97): TDockType; + +procedure Register; + +var + ButtonMouseInControl: TToolbarButton97 = nil; + +implementation + +uses + CommCtrl, Registry, IniFiles, SysUtils, Consts; + +const + { Exception messages } + STB97DockNotFormOwner = 'TDock97 must be owned by a form'; + STB97DockParentNotAllowed = 'A TDock97 control cannot be placed inside a tool window or another TDock97'; + STB97DockCannotHide = 'Cannot hide a TDock97'; + STB97DockCannotChangePosition = 'Cannot change Position of a TDock97 if it already contains controls'; + STB97ToolwinNotFormOwner = 'Tool windows must be owned by a form'; + STB97ToolwinNameNotSet = 'Cannot save tool window''s position because Name property is not set'; + STB97ToolwinDockedToNameNotSet = 'Cannot save tool window''s position because DockedTo''s Name property not set'; + STB97ToolwinParentNotAllowed = 'A tool window can only be placed on a TDock97 or directly on the form'; + STB97ToolbarControlNotChildOfToolbar = 'Control is not a child of the toolbar'; + STB97SepParentNotAllowed = 'TToolbarSep97 can only be placed on a TToolbar97'; + + { All spacing & margin values are here. It's recommended that you don't + try changing any of this! } + LineSpacing = 6; + DropdownComboWidth = 11; + TopMarginNotDocked = 2; + TopMargin: array[Boolean] of Integer = (TopMarginNotDocked, 0); + BottomMarginNotDocked = 1; + BottomMargin: array[Boolean] of Integer = (BottomMarginNotDocked, 0); + LeftMarginNotDocked = 4; + LeftMargin: array[Boolean] of Integer = (LeftMarginNotDocked, 0); + RightMarginNotDocked = 4; + RightMargin: array[Boolean] of Integer = (RightMarginNotDocked, 0); + DockedBorderSize = 2; + DockedBorderSize2 = DockedBorderSize*2; + DragHandleSize = 9; + + DefaultBarWidthHeight = 8; + + ForceDockAtTopRow = 0; + ForceDockAtLeftPos = -8; + + PositionLeftOrRight = [dpLeft, dpRight]; + + { Constants for TCustomToolWindow97 registry values/data. + Don't localize any of these names! } + rvRev = 'Rev'; + rdCurrentRev = 2; + rvVisible = 'Visible'; + rvDockedTo = 'DockedTo'; + rdDockedToFloating = '+'; + rvDockRow = 'DockRow'; + rvDockPos = 'DockPos'; + rvFloatLeft = 'FloatLeft'; + rvFloatTop = 'FloatTop'; + { TCustomToolbar97 specific } + rvFloatRightX = 'FloatRightX'; + { TToolWindow97 specific } + rvClientWidth = 'ClientWidth'; + rvClientHeight = 'ClientHeight'; + +type + { Used internally by the TCustomToolbar97.Resize* procedures } + PToolbar97SizeData = ^TToolbar97SizeData; + TToolbar97SizeData = record + HitTest: Integer; + NewSizes: TList; { List of valid new sizes. Items are casted into TSmallPoints } + CurRightX: Integer; + DisableSensCheck, OpSide: Boolean; + SizeSens: Integer; + end; + + { Used in TCustomToolbar97.GroupInfo lists } + PGroupInfo = ^TGroupInfo; + TGroupInfo = record + GroupWidth, { Width in pixels of the group, if all controls were + lined up left-to-right } + GroupHeight: Integer; { Heights in pixels of the group, if all controls were + lined up top-to-bottom } + Members: TList; + end; + + { Used in TCustomToolbar97.SlaveInfo lists } + PSlaveInfo = ^TSlaveInfo; + TSlaveInfo = record + LeftRight, + TopBottom: TControl; + end; + + { Used in TCustomToolbar97.LineSeps lists } + TLineSep = packed record + Y: SmallInt; + Blank: Boolean; + Unused: Boolean; + end; + + { Use by CompareControls } + PCompareExtra = ^TCompareExtra; + TCompareExtra = record + Toolbar: TCustomToolbar97; + ComparePositions: Boolean; + CurDockType: TDockType; + end; + + TFloatParent = class(TWinControl) + protected + procedure CreateParams (var Params: TCreateParams); override; + end; + + THookedFormID = (hkParentForm, hkChildForm); + PHookedFormInfo = ^THookedFormInfo; + THookedFormInfo = record + Form: TForm; + ID: THookedFormID; + InstalledMainHook: Boolean; + SaveActiveControl: HWND; + RefCount: Integer; + end; + PMainHookedFormInfo = ^TMainHookedFormInfo; + TMainHookedFormInfo = record + Form: TForm; + RefCount: Integer; + end; + +procedure InstallHooks (const AID: THookedFormID; const AForm: TForm; + const InstallMainHook: Boolean); forward; +procedure UninstallHooks (const AID: THookedFormID; const AForm: TForm); forward; + +var + HookedForms, MainHookedForms, DoneCreatingList: TList; + CWPHookHandle: HHOOK; + + ButtonHookRefCount: Longint = 0; + + { See TToolbarButton97.ButtonMouseTimerHandler for info on this } + ButtonMouseTimer: TTimer = nil; + +procedure Register; +begin + RegisterComponents ('Toolbar97', + [TDock97, TToolbar97, TToolWindow97, TToolbarButton97, TToolbarSep97, TEdit97]); +end; + + +{ Misc. functions } + +function GetSmallCaptionHeight: Integer; +{ Returns height of the caption of a small window } +begin + if NewStyleControls then + Result := GetSystemMetrics(SM_CYSMCAPTION) + else + { Win 3.x doesn't support small captions, so, like Office 97, use the size + of normal captions minus one } + Result := GetSystemMetrics(SM_CYCAPTION) - 1; +end; +function GetBorderSize (const Resizable: Boolean): TPoint; +{ Returns size of a thick border. Note that, depending on the Windows version, + this may not be the same as the actual window metrics since it draws its + own border } +const + XMetrics: array[Boolean] of Integer = (SM_CXDLGFRAME, SM_CXFRAME); + YMetrics: array[Boolean] of Integer = (SM_CYDLGFRAME, SM_CYFRAME); +begin + Result.X := GetSystemMetrics(XMetrics[Resizable]); + Result.Y := GetSystemMetrics(YMetrics[Resizable]); +end; + +procedure AddFloatingNCAreaToRect (var R: TRect; const Resizable: Boolean); +begin + with GetBorderSize(Resizable) do begin + Dec (R.Left, X); + Inc (R.Right, X); + Inc (R.Bottom, GetSmallCaptionHeight + Y*2); + end; +end; +procedure AddDockedNCAreaToSize (var S: TPoint; const LeftRight, DragHandle: Boolean); +begin + if not LeftRight then begin + Inc (S.X, DockedBorderSize2 + (Ord(DragHandle) * DragHandleSize)); + Inc (S.Y, DockedBorderSize2); + end + else begin + Inc (S.X, DockedBorderSize2); + Inc (S.Y, DockedBorderSize2 + (Ord(DragHandle) * DragHandleSize)); + end; +end; + +(* not currently used +function GetDragFullWindows: Boolean; +var + S: BOOL; +begin + Result := False; + if SystemParametersInfo(SPI_GETDRAGFULLWINDOWS, 0, @S, 0) then + Result := S; +end; +*) + +function GetDesktopArea: TRect; +{ Returns a rectangle of the screen. But, under Win95 and NT 4.0, it excludes + the area taken up by the taskbar. } +begin + if not SystemParametersInfo(SPI_GETWORKAREA, 0, @Result, 0) then + { SPI_GETWORKAREA is only supported by Win95 and NT 4.0. So it fails under + Win 3.x. In that case, return a rectangle of the entire screen } + Result := Rect(0, 0, GetSystemMetrics(SM_CXSCREEN), + GetSystemMetrics(SM_CYSCREEN)); +end; + +function GetMDIParent (const Form: TForm): TForm; +{ Returns the parent of the specified MDI child form. But, if Form isn't a + MDI child, it simply returns Form. } +var + I, J: Integer; +begin + Result := Form; + if Form = nil then Exit; + if Form.FormStyle = fsMDIChild then + for I := 0 to Screen.FormCount-1 do + with Screen.Forms[I] do begin + if FormStyle <> fsMDIForm then Continue; + for J := 0 to MDIChildCount-1 do + if MDIChildren[J] = Form then begin + Result := Screen.Forms[I]; + Exit; + end; + end; +end; + +function GetDockTypeOf (const Control: TDock97): TDockType; +begin + if Control = nil then + Result := dtNotDocked + else begin + if not(Control.Position in PositionLeftOrRight) then + Result := dtTopBottom + else + Result := dtLeftRight; + end; +end; + +procedure ShowHideFloatParents (const Form: TForm; const AppActive: Boolean); +var + HideFloatingToolbars: Boolean; + I: Integer; + ParentForm: TForm; +begin + { First call ShowHideFloatParent on child forms } + for I := 0 to Form.MDIChildCount-1 do + ShowHideFloatParents (Form.MDIChildren[I], AppActive); + + { Hide any child toolbars if: the application is not active or is + minimized, or the form (or its MDI parent) is not visible or is minimized } + HideFloatingToolbars := IsIconic(Application.Handle) or + not IsWindowVisible(Form.Handle) or IsIconic(Form.Handle); + ParentForm := GetMDIParent(Form); + if ParentForm <> Form then + HideFloatingToolbars := HideFloatingToolbars or + not IsWindowVisible(ParentForm.Handle) or IsIconic(ParentForm.Handle); + for I := 0 to Form.ComponentCount-1 do + if Form.Components[I] is TCustomToolWindow97 then + with TCustomToolWindow97(Form.Components[I]) do begin + SetNotOnScreen (not Docked and (HideFloatingToolbars or (FHideWhenInactive and not AppActive))); + SetInactiveCaption (not Docked and (not FHideWhenInactive and not AppActive)); + end; +end; + +function FormCallWndProcHook (Code: Integer; WParam: WPARAM; LParam: LPARAM): LRESULT; +stdcall; +var + I: Integer; + Wnd: HWND; + Ctl: TWinControl; +begin + if Code = HC_ACTION then begin + case PCWPStruct(LParam).Message of + WM_DESTROY, WM_SETFOCUS, WM_WINDOWPOSCHANGED: begin + for I := 0 to HookedForms.Count-1 do + with PHookedFormInfo(HookedForms.List[I])^ do begin { uses List property for speed } + Wnd := PCWPStruct(LParam).hwnd; + case PCWPStruct(LParam).Message of + WM_DESTROY: + if Wnd = SaveActiveControl then + SaveActiveControl := 0; + WM_SETFOCUS: begin + if Form.HandleAllocated and IsChild(Form.Handle, Wnd) then begin + SaveActiveControl := 0; + while True do begin + Ctl := FindControl(Wnd); + if Ctl <> nil then begin + if (Ctl <> Form) and Ctl.HandleAllocated and + (GetParentForm(Ctl) = Form) then + SaveActiveControl := Ctl.Handle; + Break; + end; + Wnd := GetParent(Wnd); + if Wnd = 0 then Break; + end; + Break; + end; + end; + WM_WINDOWPOSCHANGED: + if Form.HandleAllocated and (Wnd = Form.Handle) then + ShowHideFloatParents (Form, Application.Active); + end; + end; + end; + end; + end; + Result := CallNextHookEx(CWPHookHandle, Code, WParam, LParam); +end; + +procedure InstallHooks (const AID: THookedFormID; const AForm: TForm; + const InstallMainHook: Boolean); +var + I: Integer; + Info: PHookedFormInfo; + AlreadyExists: Boolean; + MainInfo: PMainHookedFormInfo; +begin + for I := 0 to HookedForms.Count-1 do + with PHookedFormInfo(HookedForms[I])^ do + { If AForm already exists in list with the same ID, only increment + the reference count } + if (ID = AID) and (Form = AForm) then begin + Inc (RefCount); + Exit; + end; + New (Info); + try + with Info^ do begin + Form := AForm; + ID := AID; + InstalledMainHook := InstallMainHook; + if InstallMainHook then begin + AlreadyExists := False; + for I := 0 to MainHookedForms.Count-1 do + with PMainHookedFormInfo(MainHookedForms[I])^ do + if (Form = AForm) then begin + Inc (RefCount); + AlreadyExists := True; + Break; + end; + if not AlreadyExists then begin + New (MainInfo); + with MainInfo^ do begin + Form := AForm; + RefCount := 1; + end; + MainHookedForms.Add (MainInfo); + if MainHookedForms.Count = 1 then + Application.HookMainWindow (TCustomToolWindow97.NewMainWindowHook); + end; + end; + SaveActiveControl := 0; + RefCount := 1; + end; + HookedForms.Add (Info); + if HookedForms.Count = 1 then + CWPHookHandle := SetWindowsHookEx(WH_CALLWNDPROC, FormCallWndProcHook, 0, GetCurrentThreadId); + except + Dispose (Info); + raise; + end; +end; + +procedure UninstallHooks (const AID: THookedFormID; const AForm: TForm); +var + I, J: Integer; +begin + for I := HookedForms.Count-1 downto 0 do + with PHookedFormInfo(HookedForms[I])^ do + if (ID = AID) and (Form = AForm) then begin + Dec (RefCount); + if RefCount = 0 then begin + if InstalledMainHook then begin + for J := MainHookedForms.Count-1 downto 0 do + with PMainHookedFormInfo(MainHookedForms[J])^ do + if (Form = AForm) then begin + Dec (RefCount); + if RefCount = 0 then begin + Dispose (PMainHookedFormInfo(MainHookedForms[J])); + MainHookedForms.Delete (J); + if MainHookedForms.Count = 0 then + Application.UnhookMainWindow (TCustomToolWindow97.NewMainWindowHook); + end; + end; + end; + Dispose (PHookedFormInfo(HookedForms[I])); + HookedForms.Delete (I); + if HookedForms.Count = 0 then begin + UnhookWindowsHookEx (CWPHookHandle); + CWPHookHandle := 0; + end; + end; + end; +end; + +type + TListSortExCompare = function (const Item1, Item2, ExtraData: Pointer): Integer; +procedure ListSortEx (const List: TList; const Compare: TListSortExCompare; + const ExtraData: Pointer); +{ Similar to TList.Sort, but lets you pass a user-defined ExtraData pointer } + procedure QuickSortEx (L: Integer; const R: Integer); + var + I, J: Integer; + P: Pointer; + begin + repeat + I := L; + J := R; + P := List[(L + R) shr 1]; + repeat + while Compare(List[I], P, ExtraData) < 0 do Inc(I); + while Compare(List[J], P, ExtraData) > 0 do Dec(J); + if I <= J then + begin + List.Exchange (I, J); + Inc (I); + Dec (J); + end; + until I > J; + if L < J then QuickSortEx (L, J); + L := I; + until I >= R; + end; +begin + if List.Count > 1 then + QuickSortEx (0, List.Count-1); +end; + +procedure ProcessPaintMessages; +{ Dispatches all pending WM_PAINT messages. In effect, this is like an + 'UpdateWindow' on all visible windows } +var + Msg: TMsg; +begin + while PeekMessage(Msg, 0, WM_PAINT, WM_PAINT, PM_NOREMOVE) do begin + case Integer(GetMessage(Msg, 0, WM_PAINT, WM_PAINT)) of + -1: Break; { if GetMessage failed } + 0: begin + { Repost WM_QUIT messages } + PostQuitMessage (Msg.WParam); + Break; + end; + end; + DispatchMessage (Msg); + end; +end; + +{$IFNDEF TB97Delphi3orHigher} +type + PMaxLogPalette = ^TMaxLogPalette; + TMaxLogPalette = packed record + palVersion: Word; + palNumEntries: Word; + palPalEntry: array[Byte] of TPaletteEntry; + end; +function CopyPalette (Palette: HPALETTE): HPALETTE; +var + PaletteSize: Integer; + LogPal: TMaxLogPalette; +begin + Result := 0; + if Palette = 0 then Exit; + PaletteSize := 0; + if GetObject(Palette, SizeOf(PaletteSize), @PaletteSize) = 0 then Exit; + if PaletteSize = 0 then Exit; + with LogPal do begin + palVersion := $0300; + palNumEntries := PaletteSize; + GetPaletteEntries (Palette, 0, PaletteSize, palPalEntry); + end; + Result := CreatePalette(PLogPalette(@LogPal)^); +end; +{$ENDIF} + + +{ TDock97 - internal } + +constructor TDock97.Create (AOwner: TComponent); +begin + inherited; + + if not(AOwner is TForm) then + raise EInvalidOperation.Create(STB97DockNotFormOwner); + { because TCustomToolWindow97 depends on docks being in the form's component list } + + FAllowDrag := True; + FBkgOnToolbars := True; + DockList := TList.Create; + RowSizes := TList.Create; + + Inc (DisableArrangeToolbars); + try + ControlStyle := ControlStyle + + [csAcceptsControls, csNoStdEvents] - + [csClickEvents, csCaptureMouse, csOpaque]; + FBkg := TBitmap.Create; + FBkg.OnChange := BackgroundChanged; + Position := dpTop; + Color := clBtnFace; + finally + Dec (DisableArrangeToolbars); + end; + { Rearranging was disabled, so manually rearrange it now } + ArrangeToolbars; +end; + +procedure TDock97.CreateParams (var Params: TCreateParams); +begin + inherited; + { Disable complete redraws when size changes. CS_H/VREDRAW cause flicker + and are not necessary for this control at run time } + if not(csDesigning in ComponentState) then + with Params.WindowClass do + Style := Style and not(CS_HREDRAW or CS_VREDRAW); +end; + +destructor TDock97.Destroy; +begin + FBkgCache.Free; + FBkg.Free; + FreeRowInfo; + RowSizes.Free; + DockList.Free; + inherited; +end; + +procedure TDock97.SetParent (AParent: TWinControl); +begin + if (AParent is TCustomToolWindow97) or (AParent is TDock97) then + raise EInvalidOperation.Create(STB97DockParentNotAllowed); + + inherited; +end; + +procedure TDock97.VisibleChanging; +begin + if Visible then + raise EInvalidOperation.Create(STB97DockCannotHide); + inherited; +end; + +procedure TDock97.FreeRowInfo; +begin + if Assigned(RowSizes) then + RowSizes.Clear; +end; + +procedure TDock97.BuildRowInfo; +var + R, I, Size, HighestSize: Integer; +begin + FreeRowInfo; + for R := 0 to GetHighestRow do begin + HighestSize := DefaultBarWidthHeight; + for I := 0 to DockList.Count-1 do begin + with TCustomToolWindow97(DockList[I]) do begin + if FDockRow <> R then Continue; + GetBarSize (Size, GetDockTypeOf(Self)); + if Size > HighestSize then HighestSize := Size; + end; + end; + RowSizes.Add (Pointer(HighestSize)); + end; +end; + +function TDock97.GetRowSize (const Row: Integer; + const DefaultToolbar: TCustomToolWindow97): Integer; +begin + if Row < RowSizes.Count then + Result := Longint(RowSizes[Row]) + else begin + { If it's out of bounds } + if DefaultToolbar = nil then + Result := 0 + else + DefaultToolbar.GetBarSize (Result, GetDockTypeOf(Self)); + end; +end; + +function TDock97.GetRowOf (const XY: Integer; var Before: Boolean): Integer; +{ Returns row number of the specified coordinate. Before is set to True if it + was close to being in between two rows. } +var + HighestRow, R, CurY, NextY: Integer; +begin + Result := 0; Before := False; + HighestRow := GetHighestRow; + CurY := 0; + for R := 0 to HighestRow+1 do begin + if R <= HighestRow then + NextY := CurY + GetRowSize(R, nil) + DockedBorderSize2 + else + NextY := High(NextY); + if XY <= CurY+5 then begin + Result := R; + Before := True; + Break; + end; + if (XY >= CurY+5) and (XY <= NextY-5) then begin + Result := R; + Break; + end; + CurY := NextY; + end; +end; + +function TDock97.GetDesignModeRowOf (const XY: Integer): Integer; +{ Similar to GetRowOf, but is a little different to accomidate design mode + better } +var + HighestRowPlus1, R, CurY, NextY: Integer; +begin + Result := 0; + HighestRowPlus1 := GetHighestRow+1; + CurY := 0; + for R := 0 to HighestRowPlus1 do begin + Result := R; + if R = HighestRowPlus1 then Break; + NextY := CurY + GetRowSize(R, nil) + DockedBorderSize2; + if XY < NextY then + Break; + CurY := NextY; + end; +end; + +function TDock97.GetHighestRow: Integer; +{ Returns highest used row number, or -1 if no rows are used } +var + I: Integer; +begin + Result := -1; + for I := 0 to DockList.Count-1 do + with TCustomToolWindow97(DockList[I]) do + if FDockRow > Result then + Result := FDockRow; +end; + +function TDock97.GetNumberOfToolbarsOnRow (const Row: Integer; + const NotIncluding: TCustomToolWindow97): Integer; +{ Returns number of toolbars on the specified row. The toolbar specified by + "NotIncluding" is not included in the count. } +var + I: Integer; +begin + Result := 0; + for I := 0 to DockList.Count-1 do + if (TCustomToolWindow97(DockList[I]).FDockRow = Row) and + (DockList[I] <> NotIncluding) then + Inc (Result); +end; + +procedure TDock97.RemoveBlankRows; +{ Deletes any blank row numbers, adjusting the docked toolbars' FDockRow as + needed } +var + HighestRow, R, I: Integer; + RowIsEmpty: Boolean; +begin + HighestRow := GetHighestRow; + R := 0; + while R <= HighestRow do begin + RowIsEmpty := True; + for I := 0 to DockList.Count-1 do + if TCustomToolWindow97(DockList[I]).FDockRow = R then begin + RowIsEmpty := False; + Break; + end; + if RowIsEmpty then begin + { Shift all ones higher than R back one } + for I := 0 to DockList.Count-1 do + with TCustomToolWindow97(DockList[I]) do + if FDockRow > R then + Dec (FDockRow); + Dec (HighestRow); + end; + Inc (R); + end; +end; + +procedure TDock97.InsertRowBefore (const BeforeRow: Integer); +{ Inserts a blank row before BeforeRow, adjusting all the docked toolbars' + FDockRow as needed } +var + I: Integer; +begin + for I := 0 to DockList.Count-1 do + with TCustomToolWindow97(DockList[I]) do + if FDockRow >= BeforeRow then + Inc (FDockRow); +end; + +procedure TDock97.ChangeWidthHeight (const IsClientWidthAndHeight: Boolean; + NewWidth, NewHeight: Integer); +{ Same as setting Width/Height or ClientWidth/ClientHeight directly, but does + not lose Align position. } +begin + if IsClientWidthAndHeight then begin + Inc (NewWidth, Width-ClientWidth); + Inc (NewHeight, Height-ClientHeight); + end; + case Align of + alTop, alLeft: + SetBounds (Left, Top, NewWidth, NewHeight); + alBottom: + SetBounds (Left, Top-NewHeight+Height, NewWidth, NewHeight); + alRight: + SetBounds (Left-NewWidth+Width, Top, NewWidth, NewHeight); + end; +end; + +procedure TDock97.AlignControls (AControl: TControl; var Rect: TRect); +begin + ArrangeToolbars; +end; + +function CompareDockRowPos (const Item1, Item2, ExtraData: Pointer): Integer; far; +begin + if TCustomToolWindow97(Item1).FDockRow <> TCustomToolWindow97(Item2).FDockRow then + Result := TCustomToolWindow97(Item1).FDockRow - TCustomToolWindow97(Item2).FDockRow + else + Result := TCustomToolWindow97(Item1).FDockPos - TCustomToolWindow97(Item2).FDockPos; +end; + +procedure TDock97.ArrangeToolbars; +{ The main procedure to arrange all the toolbars docked to it } +var + LeftRight: Boolean; + EmptySize: Integer; + HighestRow, R, CurDockPos, CurRowPixel, I, J, K: Integer; + HighestRowSize, CurRowSize: Integer; +begin + if (DisableArrangeToolbars > 0) or (csLoading in ComponentState) then + Exit; + + { Work around VCL alignment bug when docking toolbars taller or wider than + the client height or width of the form. } + if not(csDesigning in ComponentState) and HandleAllocated then + SetWindowPos (Handle, HWND_TOP, 0, 0, 0, 0, + SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE); + + LeftRight := Position in PositionLeftOrRight; + + if DockList.Count = 0 then begin + EmptySize := Ord(FFixAlign); + if csDesigning in ComponentState then + EmptySize := 9; + if not LeftRight then + ChangeWidthHeight (False, Width, EmptySize) + else + ChangeWidthHeight (False, EmptySize, Height); + Exit; + end; + + { Ensure list is in correct ordering according to DockRow/DockPos } + ListSortEx (DockList, CompareDockRowPos, nil); + + { If LimitToOneRow is True, only use the first row } + if FLimitToOneRow then + for I := 0 to DockList.Count-1 do + with TCustomToolWindow97(DockList[I]) do + FDockRow := 0; + { Remove any blank rows } + RemoveBlankRows; + + { Find highest row number } + HighestRow := GetHighestRow; + { Arrange, first without actually moving the toolbars onscreen } + R := 0; + while R <= HighestRow do begin + CurDockPos := 0; + for I := 0 to DockList.Count-1 do begin + with TCustomToolWindow97(DockList[I]) do begin + if FDockRow <> R then Continue; + if FullSize then + { If FullSize, make sure there aren't any other toolbars on the same + row. If there are, shift them down a row. } + for J := 0 to DockList.Count-1 do + if (J <> I) and (TCustomToolWindow97(DockList[J]).FDockRow = R) then begin + for K := 0 to DockList.Count-1 do + with TCustomToolWindow97(DockList[K]) do + if (K <> I) and (FDockRow >= R) then begin + Inc (FDockRow); + if FDockRow > HighestRow then + HighestRow := FDockRow; + end; + Break; + end; + if FDockPos <= CurDockPos then + FDockPos := CurDockPos + else + CurDockPos := FDockPos; + if not LeftRight then + Inc (CurDockPos, Width) + else + Inc (CurDockPos, Height); + end; + end; + Inc (R); + end; + { Rebuild the RowInfo, since rows numbers may have shifted } + BuildRowInfo; + { Try to move all the toolbars that are offscreen to a fully visible position } + for R := 0 to HighestRow do begin + for I := 0 to DockList.Count-1 do begin + with TCustomToolWindow97(DockList[I]) do begin + if FDockRow <> R then Continue; + if FullSize then + FDockPos := 0 + else + for J := DockList.Count-1 downto I do begin + with TCustomToolWindow97(DockList[J]) do begin + if FDockRow <> R then Continue; + if not LeftRight then begin + if FDockPos+Width > Self.ClientWidth then begin + Dec (TCustomToolWindow97(DockList[I]).FDockPos, + ((FDockPos+Width) - Self.ClientWidth)); + Break; + end; + end + else begin + if FDockPos+Height > Self.ClientHeight then begin + Dec (TCustomToolWindow97(DockList[I]).FDockPos, + ((FDockPos+Height) - Self.ClientHeight)); + Break; + end; + end; + end; + end; + end; + end; + end; + { Arrange again, this time actually moving the toolbars } + CurRowPixel := 0; + for R := 0 to HighestRow do begin + CurDockPos := 0; + HighestRowSize := DefaultBarWidthHeight; + for I := 0 to DockList.Count-1 do begin + with TCustomToolWindow97(DockList[I]) do begin + if FDockRow <> R then Continue; + CurRowSize := DockedBorderSize2 + GetRowSize(FDockRow, TCustomToolWindow97(DockList[I])); + if CurRowSize > HighestRowSize then + HighestRowSize := CurRowSize; + if FDockPos <= CurDockPos then + FDockPos := CurDockPos + else + CurDockPos := FDockPos; + Inc (FUpdatingBounds); + try + if not LeftRight then begin + J := Width; + if FullSize then J := Self.ClientWidth; + SetBounds (CurDockPos, CurRowPixel, J, CurRowSize) + end + else begin + J := Height; + if FullSize then J := Self.ClientHeight; + SetBounds (CurRowPixel, CurDockPos, CurRowSize, J); + end; + finally + Dec (FUpdatingBounds); + end; + if not LeftRight then + Inc (CurDockPos, Width) + else + Inc (CurDockPos, Height); + end; + end; + Inc (CurRowPixel, HighestRowSize); + end; + + { Set the size of the dock } + if not LeftRight then + ChangeWidthHeight (True, ClientWidth, CurRowPixel) + else + ChangeWidthHeight (True, CurRowPixel, ClientHeight); +end; + +procedure TDock97.ChangeDockList (const Insert: Boolean; + const Bar: TCustomToolWindow97; const IsVisible: Boolean); +{ Inserts or removes Bar. It inserts only if IsVisible is True, or is in + design mode } +var + Modified: Boolean; +begin + Modified := False; + + if Insert then begin + { Delete if already exists } + if DockList.IndexOf(Bar) <> -1 then + DockList.Remove (Bar); + { Only add to dock list if visible } + if (csDesigning in ComponentState) or IsVisible then begin + DockList.Add (Bar); + Modified := True; + end; + end + else begin + if DockList.IndexOf(Bar) <> -1 then begin + DockList.Remove (Bar); + Modified := True; + end; + end; + + if Modified then begin + ArrangeToolbars; + { This corrects a problem in past versions when toolbar is shown after it + was initially hidden } + Bar.ArrangeControls; + + if Assigned(FOnInsertRemoveBar) then + FOnInsertRemoveBar (Self, Insert, Bar); + end; +end; + +procedure TDock97.Loaded; +begin + inherited; + { Rearranging is disabled while the component is loading, so now that it's + loaded, rearrange it. } + ArrangeToolbars; +end; + +function TDock97.GetPalette: HPALETTE; +begin + Result := FBkg.Palette; +end; + +procedure TDock97.DrawBackground (const DC: HDC; + const IntersectClippingRect: TRect; const ExcludeClippingRect: PRect; + const DrawRect: TRect); +var + UseBmp: TBitmap; + R2: TRect; + SaveIndex: Integer; +begin + UseBmp := FBkg; + { When FBkgTransparent is True, it keeps a cached copy of the + background that has the transparent color already translated. Without the + cache, redraws can be very slow. + Note: The cache is cleared in the OnChange event of FBkg } + if FBkgTransparent then begin + if FBkgCache = nil then begin + FBkgCache := TBitmap.Create; + with FBkgCache do begin + Palette := CopyPalette(FBkg.Palette); + Width := FBkg.Width; + Height := FBkg.Height; + Canvas.Brush.Color := Self.Color; + Canvas.BrushCopy (Rect(0, 0, Width, Height), FBkg, + Rect(0, 0, Width, Height), FBkg.Canvas.Pixels[0, Height-1] or $02000000); + end; + end; + UseBmp := FBkgCache; + end; + + SaveIndex := SaveDC(DC); + try + with IntersectClippingRect do + IntersectClipRect (DC, Left, Top, Right, Bottom); + if Assigned(ExcludeClippingRect) then + with ExcludeClippingRect^ do + ExcludeClipRect (DC, Left, Top, Right, Bottom); + if UseBmp.Palette <> 0 then begin + SelectPalette (DC, UseBmp.Palette, True); + RealizePalette (DC); + end; + R2 := DrawRect; + while R2.Left < R2.Right do begin + while R2.Top < R2.Bottom do begin + BitBlt (DC, R2.Left, R2.Top, UseBmp.Width, UseBmp.Height, + UseBmp.Canvas.Handle, 0, 0, SRCCOPY); + + Inc (R2.Top, UseBmp.Height); + end; + R2.Top := DrawRect.Top; + Inc (R2.Left, UseBmp.Width); + end; + finally + { Restores the clipping region and palette back } + RestoreDC (DC, SaveIndex); + end; +end; + +procedure TDock97.Paint; +var + R, R2: TRect; + P1, P2: TPoint; +begin + inherited; + with Canvas do begin + R := ClientRect; + + { Draw dotted border in design mode } + if csDesigning in ComponentState then begin + Pen.Style := psDot; + Pen.Color := clBtnShadow; + Brush.Style := bsClear; + Rectangle (R.Left, R.Top, R.Right, R.Bottom); + Pen.Style := psSolid; + InflateRect (R, -1, -1); + end; + + { Draw the Background } + if UsingBackground then begin + R2 := ClientRect; + { Make up for nonclient area } + P1 := ClientToScreen(Point(0, 0)); + P2 := Parent.ClientToScreen(BoundsRect.TopLeft); + Dec (R2.Left, Left + (P1.X-P2.X)); + Dec (R2.Top, Top + (P1.Y-P2.Y)); + DrawBackground (Canvas.Handle, R, nil, R2); + end; + end; +end; + +procedure TDock97.WMMove (var Message: TWMMove); +begin + inherited; + if UsingBackground then + InvalidateBackgrounds; +end; + +procedure TDock97.WMSize (var Message: TWMSize); +begin + inherited; + ArrangeToolbars; + if Assigned(FOnResize) then + FOnResize (Self); +end; + +procedure TDock97.WMNCCalcSize (var Message: TWMNCCalcSize); +begin + inherited; + with Message.CalcSize_Params^.rgrc[0] do begin + { Don't add a border when width or height is zero (or one in case of + FixAlign=True) } + if ((Right-Left) <= 1) or ((Bottom-Top) <= 1) then + Exit; + if blTop in BoundLines then Inc (Top); + if blBottom in BoundLines then Dec (Bottom); + if blLeft in BoundLines then Inc (Left); + if blRight in BoundLines then Dec (Right); + end; +end; + +procedure TDock97.WMNCPaint (var Message: TMessage); +var + R, R2: TRect; + DC: HDC; + NewClipRgn: HRGN; + HighlightPen, ShadowPen, SavePen: HPEN; +begin + { This works around WM_NCPAINT problem described at top of source code } + {no! R := Rect(0, 0, Width, Height);} + GetWindowRect (Handle, R); OffsetRect (R, -R.Left, -R.Top); + + { Don't draw border when width or height is zero (or one in case of + FixAlign=True) } + if ((R.Right-R.Left) <= 1) or ((R.Bottom-R.Top) <= 1) then + Exit; + + DC := GetWindowDC(Handle); + try + { Use update region } + if (Message.WParam <> 0) and (Message.WParam <> 1) then begin + GetWindowRect (Handle, R2); + if SelectClipRgn(DC, Message.WParam) = ERROR then begin + NewClipRgn := CreateRectRgnIndirect(R2); + SelectClipRgn (DC, NewClipRgn); + DeleteObject (NewClipRgn); + end; + OffsetClipRgn (DC, -R2.Left, -R2.Top); + end; + + { Draw BoundLines } + HighlightPen := CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNHIGHLIGHT)); + ShadowPen := CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNSHADOW)); + if blTop in BoundLines then begin + SavePen := SelectObject(DC, ShadowPen); + MoveToEx (DC, R.Left, R.Top, nil); LineTo (DC, R.Right, R.Top); + SelectObject (DC, SavePen); + end; + if blLeft in BoundLines then begin + SavePen := SelectObject(DC, ShadowPen); + MoveToEx (DC, R.Left, R.Top, nil); LineTo (DC, R.Left, R.Bottom); + SelectObject (DC, SavePen); + end; + if blBottom in BoundLines then begin + SavePen := SelectObject(DC, HighlightPen); + MoveToEx (DC, R.Left, R.Bottom-1, nil); LineTo (DC, R.Right, R.Bottom-1); + SelectObject (DC, SavePen); + end; + if blRight in BoundLines then begin + SavePen := SelectObject(DC, HighlightPen); + MoveToEx (DC, R.Right-1, R.Top, nil); LineTo (DC, R.Right-1, R.Bottom); + SelectObject (DC, SavePen); + end; + DeleteObject (ShadowPen); + DeleteObject (HighlightPen); + finally + ReleaseDC (Handle, DC); + end; +end; + +procedure TDock97.CMColorChanged (var Message: TMessage); +begin + if UsingBackground then + { Erase the cache } + BackgroundChanged (FBkg); + inherited; +end; + +procedure TDock97.CMSysColorChange (var Message: TMessage); +begin + inherited; + if UsingBackground then + { Erase the cache } + BackgroundChanged (FBkg); +end; + +{ TDock97 - property access methods } + +procedure TDock97.SetAllowDrag (Value: Boolean); +var + I: Integer; +begin + if FAllowDrag <> Value then begin + FAllowDrag := Value; + for I := 0 to ControlCount-1 do + if (Controls[I] is TCustomToolWindow97) and + TCustomToolWindow97(Controls[I]).HandleAllocated then + { Recalculate the non-client area } + SetWindowPos (TCustomToolWindow97(Controls[I]).Handle, 0, 0, 0, 0, 0, + SWP_FRAMECHANGED or SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER); + end; +end; + +procedure TDock97.SetBackground (Value: TBitmap); +begin + FBkg.Assign (Value); +end; + +function TDock97.UsingBackground: Boolean; +begin + Result := (FBkg.Width <> 0) and (FBkg.Height <> 0); +end; + +procedure TDock97.InvalidateBackgrounds; +{ Called after background is changed } +var + I: Integer; +begin + Invalidate; + { Synchronize child toolbars also } + for I := 0 to DockList.Count-1 do + with TCustomToolWindow97(DockList[I]) do begin + InvalidateDockedNCArea; + Invalidate; + end; +end; + +procedure TDock97.BackgroundChanged (Sender: TObject); +begin + { Erase the cache } + FBkgCache.Free; + FBkgCache := nil; + InvalidateBackgrounds; +end; + +procedure TDock97.SetBackgroundOnToolbars (Value: Boolean); +begin + if FBkgOnToolbars <> Value then begin + FBkgOnToolbars := Value; + InvalidateBackgrounds; + end; +end; + +procedure TDock97.SetBackgroundTransparent (Value: Boolean); +begin + if FBkgTransparent <> Value then begin + FBkgTransparent := Value; + if UsingBackground then + { Erase the cache } + BackgroundChanged (FBkg); + end; +end; + +procedure TDock97.SetBoundLines (Value: TDockBoundLines); +begin + if FBoundLines <> Value then begin + FBoundLines := Value; + + { Recalculate the non-client area } + SetWindowPos (Handle, 0, 0, 0, 0, 0, SWP_FRAMECHANGED or + SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER); + end; +end; + +procedure TDock97.SetFixAlign (Value: Boolean); +begin + if FFixAlign <> Value then begin + FFixAlign := Value; + ArrangeToolbars; + end; +end; + +procedure TDock97.SetPosition (Value: TDockPosition); +begin + if ControlCount <> 0 then + raise EInvalidOperation.Create(STB97DockCannotChangePosition); + FPosition := Value; + case Position of + dpTop: Align := alTop; + dpBottom: Align := alBottom; + dpLeft: Align := alLeft; + dpRight: Align := alRight; + end; +end; + +function TDock97.GetToolbarCount: Integer; +begin + Result := DockList.Count; +end; + +function TDock97.GetToolbars (Index: Integer): TCustomToolWindow97; +begin + Result := TCustomToolWindow97(DockList[Index]); +end; + + +{ TFloatParent - Internal } + +procedure TFloatParent.CreateParams (var Params: TCreateParams); +begin + inherited; + with Params do begin + Style := WS_CHILD; + ExStyle := 0; + end; +end; + + +{ Global procedures } + +procedure CustomLoadToolbarPositions (const Form: TForm; + const ReadIntProc: TPositionReadIntProc; + const ReadStringProc: TPositionReadStringProc; const ExtraData: Pointer); + + function FindDock (AName: String): TDock97; + var + I: Integer; + begin + Result := nil; + for I := 0 to Form.ComponentCount-1 do + if (Form.Components[I] is TDock97) and (Form.Components[I].Name = AName) then begin + Result := TDock97(Form.Components[I]); + Break; + end; + end; + procedure ReadValues (const Toolbar: TCustomToolWindow97; const NewDock: TDock97); + begin + with Toolbar do begin + FDockRow := ReadIntProc(Name, rvDockRow, FDockRow, ExtraData); + FDockPos := ReadIntProc(Name, rvDockPos, FDockPos, ExtraData); + FFloatingTopLeft.X := ReadIntProc(Name, rvFloatLeft, 0, ExtraData); + FFloatingTopLeft.Y := ReadIntProc(Name, rvFloatTop, 0, ExtraData); + ReadPositionData (ReadIntProc, ReadStringProc, ExtraData); + DockedTo := NewDock; + DoneReadingPositionData; + end; + end; +var + DocksDisabled: TList; + I: Integer; + ADock: TDock97; + DockedToName: String; +begin + DocksDisabled := TList.Create; + try + with Form do + for I := 0 to ComponentCount-1 do + if Components[I] is TDock97 then begin + Inc (TDock97(Components[I]).DisableArrangeToolbars); + DocksDisabled.Add (Components[I]); + end; + + for I := 0 to Form.ComponentCount-1 do + if Form.Components[I] is TCustomToolWindow97 then + with TCustomToolWindow97(Form.Components[I]) do begin + if Name = '' then + raise Exception.Create (STB97ToolWinNameNotSet); + if ReadIntProc(Name, rvRev, 0, ExtraData) = rdCurrentRev then begin + Visible := ReadIntProc(Name, rvVisible, Ord(Visible), ExtraData) <> 0; + DockedToName := ReadStringProc(Name, rvDockedTo, '', ExtraData); + if DockedToName <> '' then begin + if DockedToName <> rdDockedToFloating then begin + ADock := FindDock(DockedToName); + if (ADock <> nil) and (ADock.FAllowDrag) then + ReadValues (TCustomToolWindow97(Form.Components[I]), ADock); + end + else begin + ReadValues (TCustomToolWindow97(Form.Components[I]), nil); + MoveOnScreen (True); + end; + end; + end; + end; + finally + for I := DocksDisabled.Count-1 downto 0 do begin + Dec (TDock97(DocksDisabled[I]).DisableArrangeToolbars); + TDock97(DocksDisabled[I]).ArrangeToolbars; + end; + DocksDisabled.Free; + end; +end; + +procedure CustomSaveToolbarPositions (const Form: TForm; + const WriteIntProc: TPositionWriteIntProc; + const WriteStringProc: TPositionWriteStringProc; const ExtraData: Pointer); +var + I: Integer; + N: String; +begin + for I := 0 to Form.ComponentCount-1 do + if Form.Components[I] is TCustomToolWindow97 then + with TCustomToolWindow97(Form.Components[I]) do begin + if Name = '' then + raise Exception.Create (STB97ToolwinNameNotSet); + if not Docked then + N := rdDockedToFloating + else begin + if DockedTo.FAllowDrag then begin + N := DockedTo.Name; + if N = '' then + raise Exception.Create (STB97ToolwinDockedToNameNotSet); + end + else + N := ''; + end; + WriteIntProc (Name, rvRev, rdCurrentRev, ExtraData); + WriteIntProc (Name, rvVisible, Ord(Visible), ExtraData); + with TCustomToolWindow97(Form.Components[I]) do begin + WriteStringProc (Name, rvDockedTo, N, ExtraData); + WriteIntProc (Name, rvDockRow, FDockRow, ExtraData); + WriteIntProc (Name, rvDockPos, FDockPos, ExtraData); + WriteIntProc (Name, rvFloatLeft, FFloatingTopLeft.X, ExtraData); + WriteIntProc (Name, rvFloatTop, FFloatingTopLeft.Y, ExtraData); + WritePositionData (WriteIntProc, WriteStringProc, ExtraData); + end; + end; +end; + +function IniReadInt (const ToolbarName, Value: String; const Default: Longint; + const ExtraData: Pointer): Longint; far; +begin + Result := TIniFile(ExtraData).ReadInteger(ToolbarName, Value, Default); +end; +function IniReadString (const ToolbarName, Value, Default: String; + const ExtraData: Pointer): String; far; +begin + Result := TIniFile(ExtraData).ReadString(ToolbarName, Value, Default); +end; +procedure IniWriteInt (const ToolbarName, Value: String; const Data: Longint; + const ExtraData: Pointer); far; +begin + TIniFile(ExtraData).WriteInteger (ToolbarName, Value, Data); +end; +procedure IniWriteString (const ToolbarName, Value, Data: String; + const ExtraData: Pointer); far; +begin + TIniFile(ExtraData).WriteString (ToolbarName, Value, Data); +end; + +procedure IniLoadToolbarPositions (const Form: TForm; const Filename: String); +var + Ini: TIniFile; +begin + Ini := TIniFile.Create(Filename); + try + CustomLoadToolbarPositions (Form, IniReadInt, IniReadString, Ini); + finally + Ini.Free; + end; +end; + +procedure IniSaveToolbarPositions (const Form: TForm; const Filename: String); +var + Ini: TIniFile; +begin + Ini := TIniFile.Create(Filename); + try + CustomSaveToolbarPositions (Form, IniWriteInt, IniWriteString, Ini); + finally + Ini.Free; + end; +end; + +function RegReadInt (const ToolbarName, Value: String; const Default: Longint; + const ExtraData: Pointer): Longint; far; +begin + Result := TRegIniFile(ExtraData).ReadInteger(ToolbarName, Value, Default); +end; +function RegReadString (const ToolbarName, Value, Default: String; + const ExtraData: Pointer): String; far; +begin + Result := TRegIniFile(ExtraData).ReadString(ToolbarName, Value, Default); +end; +procedure RegWriteInt (const ToolbarName, Value: String; const Data: Longint; + const ExtraData: Pointer); far; +begin + TRegIniFile(ExtraData).WriteInteger (ToolbarName, Value, Data); +end; +procedure RegWriteString (const ToolbarName, Value, Data: String; + const ExtraData: Pointer); far; +begin + TRegIniFile(ExtraData).WriteString (ToolbarName, Value, Data); +end; + +procedure RegLoadToolbarPositions (const Form: TForm; const BaseRegistryKey: String); +var + Reg: TRegIniFile; +begin + Reg := TRegIniFile.Create(BaseRegistryKey); + try + CustomLoadToolbarPositions (Form, RegReadInt, RegReadString, Reg); + finally + Reg.Free; + end; +end; + +procedure RegSaveToolbarPositions (const Form: TForm; const BaseRegistryKey: String); +var + Reg: TRegIniFile; +begin + Reg := TRegIniFile.Create(BaseRegistryKey); + try + CustomSaveToolbarPositions (Form, RegWriteInt, RegWriteString, Reg); + finally + Reg.Free; + end; +end; + + +{ TCustomToolWindow97 - Internal } + +constructor TCustomToolWindow97.Create (AOwner: TComponent); +begin + inherited; + + GetParams (FParams); + + if not(AOwner is TForm) then + raise EInvalidOperation.Create(STB97ToolwinNotFormOwner); + { because it frequently casts Owner into a TForm } + MDIParentForm := GetMDIParent(TForm(AOwner)); + + Inc (FDisableArrangeControls); + try + ControlStyle := ControlStyle + + [csAcceptsControls, csClickEvents, csDoubleClicks, csSetCaption] - + [csCaptureMouse{capturing is done manually}, csOpaque]; + + if not(csDesigning in ComponentState) then begin + FloatParent := TFloatParent.Create(TForm(AOwner)); + FloatParent.Parent := MDIParentForm; + { Set up the hooks for the parent form of the toolbar, and a main + window hook } + InstallHooks (hkParentForm, MDIParentForm, True); + { Add a another hook if it's owner is an MDI child } + if TForm(AOwner).FormStyle = fsMDIChild then + InstallHooks (hkChildForm, TForm(AOwner), False); + { Need to move it offscreen while loading to prevent any flashing as it's + updating } + SetNotOnScreen (True); + end + else + FloatParent := TForm(AOwner); + + FInactiveCaption := not Application.Active; + FActivateParent := True; + FDockableTo := [dpTop, dpBottom, dpLeft, dpRight]; + FCloseButton := True; + FDragHandle := True; + FResizable := True; + FHideWhenInactive := True; + FDockPos := -1; + Color := clBtnFace; + DockedTo := nil; + + if not(csDesigning in ComponentState) then begin + { Since SetNotOnScreen(True) was called, it needs to restore the toolbars + back by posting a message which will be processed once it's done + loading. } + if DoneCreatingList.IndexOf(Self) = -1 then { can't have duplicates } + DoneCreatingList.Add (Self); + PostMessage (Application.Handle, WM_TB97DoneCreating, + WM_TB97DoneCreating_Magic, WM_TB97DoneCreating_Magic); + end; + finally + Dec (FDisableArrangeControls); + end; +end; + +destructor TCustomToolWindow97.Destroy; +begin + if not(csDesigning in ComponentState) then begin + DoneCreatingList.Remove (Self); { just in case } + UninstallHooks (hkParentForm, MDIParentForm); + if TForm(Owner).FormStyle = fsMDIChild then + UninstallHooks (hkChildForm, TForm(Owner)); + end; + + inherited; +end; + +procedure TCustomToolWindow97.SetNotOnScreen (const Value: Boolean); +begin + if NotOnScreen <> Value then begin + NotOnScreen := Value; + { Update the actual visibility of the toolbar by sending a + CM_SHOWINGCHANGED message. CM_SHOWINGCHANGED cannot be sent if the + handle has not been allocated yet, so check HandleAllocated first } + if HandleAllocated then + Perform (CM_SHOWINGCHANGED, 0, 0); + end; +end; + +procedure TCustomToolWindow97.SetInactiveCaption (const Value: Boolean); +begin + if FInactiveCaption <> Value then begin + FInactiveCaption := Value; + DrawFloatingNCArea (0, False, True, False); + end; +end; + +procedure TCustomToolWindow97.WMMove (var Message: TWMMove); +begin + inherited; + if Docked and DockedTo.UsingBackground then begin + { Needs to redraw so that background is lined up with the dock at the + new position } + InvalidateDockedNCArea; + { To minimize flicker, InvalidateRect is called with the Erase parameter + set to False instead of calling the Invalidate method } + if HandleAllocated then + InvalidateRect (Handle, nil, False); + end; +end; + +procedure TCustomToolWindow97.WMSize (var Message: TWMSize); +begin + inherited; + if Assigned(FOnResize) then + FOnResize (Self); +end; + +procedure TCustomToolWindow97.WMGetMinMaxInfo (var Message: TWMGetMinMaxInfo); +begin + inherited; + { Because the window uses the WS_THICKFRAME style (but not for the usual + purpose), it must process the WM_GETMINMAXINFO message to remove the + minimum and maximum size limits it imposes by default. } + with Message.MinMaxInfo^ do begin + with ptMinTrackSize do begin + X := 1; + Y := 1; + { Note to self: Don't put GetMinimumSize code here, since + ClientWidth/Height values are sometimes invalid during a RecreateWnd } + end; + with ptMaxTrackSize do begin + { Because of the 16-bit (signed) size limitations of Windows 95, + Smallints must be used instead of Integers or Longints } + X := High(Smallint); + Y := High(Smallint); + end; + end; +end; + +procedure TCustomToolWindow97.CMShowingChanged (var Message: TMessage); +const + ShowFlags: array[Boolean] of UINT = ( + SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or SWP_HIDEWINDOW, + SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or SWP_SHOWWINDOW); +begin + { inherited isn't called since TCustomToolWindow97 handles CM_SHOWINGCHANGED + itself. For reference, the original TWinControl implementation is: + const + ShowFlags: array[Boolean] of Word = ( + SWP_NOSIZE + SWP_NOMOVE + SWP_NOZORDER + SWP_NOACTIVATE + SWP_HIDEWINDOW, + SWP_NOSIZE + SWP_NOMOVE + SWP_NOZORDER + SWP_NOACTIVATE + SWP_SHOWWINDOW); + begin + SetWindowPos(FHandle, 0, 0, 0, 0, 0, ShowFlags[FShowing]); + end; + } + SetWindowPos (Handle, 0, 0, 0, 0, 0, ShowFlags[Showing and not NotOnScreen]); +end; + +procedure TCustomToolWindow97.CreateParams (var Params: TCreateParams); +begin + inherited; + if Parent = FloatParent then + with Params do begin + { Note: WS_THICKFRAME and WS_BORDER styles are included to ensure that + sizing grips are displayed on child controls with scrollbars. The + thick frame or border is not drawn by Windows; TCustomToolWindow97 + handles all border drawing by itself. } + if not(csDesigning in ComponentState) then + Style := WS_POPUP or WS_THICKFRAME or WS_BORDER + else + Style := Style or WS_THICKFRAME or WS_BORDER; + ExStyle := 0; + end; +end; + +procedure TCustomToolWindow97.Notification (AComponent: TComponent; Operation: TOperation); +begin + inherited; + if (Operation = opRemove) and (AComponent = FDefaultDock) then + FDefaultDock := nil; +end; + +procedure TCustomToolWindow97.MoveOnScreen (const OnlyIfFullyOffscreen: Boolean); +{ Moves the (floating) toolbar so that it is fully (or at least mostly) in + view on the screen } +var + R, S, Test: TRect; +begin + if not Docked then begin + R := BoundsRect; + S := GetDesktopArea; + + if OnlyIfFullyOffscreen and IntersectRect(Test, R, S) then + Exit; + + if R.Right > S.Right then + OffsetRect (R, S.Right - R.Right, 0); + if R.Bottom > S.Bottom then + OffsetRect (R, 0, S.Bottom - R.Bottom); + if R.Left < S.Left then + OffsetRect (R, S.Left - R.Left, 0); + if R.Top < S.Top then + OffsetRect (R, 0, S.Top - R.Top); + BoundsRect := R; + end; +end; + +procedure TCustomToolWindow97.ReadPositionData (const ReadIntProc: TPositionReadIntProc; + const ReadStringProc: TPositionReadStringProc; const ExtraData: Pointer); +begin +end; + +procedure TCustomToolWindow97.DoneReadingPositionData; +begin +end; + +procedure TCustomToolWindow97.WritePositionData (const WriteIntProc: TPositionWriteIntProc; + const WriteStringProc: TPositionWriteStringProc; const ExtraData: Pointer); +begin +end; + +procedure TCustomToolWindow97.InitializeOrdering; +begin +end; + +procedure TCustomToolWindow97.GetDockRowSize (var AHeightOrWidth: Integer); +begin + GetBarSize (AHeightOrWidth, GetDockTypeOf(DockedTo)); + if Docked then + with DockedTo do begin + BuildRowInfo; + AHeightOrWidth := DockedTo.GetRowSize(FDockRow, Self); + end; +end; + +procedure TCustomToolWindow97.SizeChanging (const AWidth, AHeight: Integer); +begin +end; + +procedure TCustomToolWindow97.Loaded; +var + R: TRect; +begin + inherited; + { Adjust coordinates if it was initially floating } + if not(csDesigning in ComponentState) and not Docked then begin + R := BoundsRect; + MapWindowPoints (TForm(Owner).Handle, 0, R, 2); + BoundsRect := R; + MoveOnScreen (False); + end; + InitializeOrdering; + { Arranging of controls is disabled while component was loading, so rearrange + it now } + ArrangeControls; +end; + +procedure TCustomToolWindow97.BeginUpdate; +begin + Inc (FDisableArrangeControls); +end; + +procedure TCustomToolWindow97.EndUpdate; +begin + Dec (FDisableArrangeControls); + if FArrangeNeeded and (FDisableArrangeControls = 0) then + ArrangeControls; +end; + +procedure TCustomToolWindow97.CustomArrangeControls (const ArrangeType: TToolWindowArrangeType; + const WasDockedTo, DockingTo: TDock97; var NewClientSize: TPoint); +var + WH: Integer; +begin + if (FDisableArrangeControls > 0) or + { Prevent flicker while loading or destroying } + (csLoading in ComponentState) or + { Following line added in 1.53 to stop the access violations that 1.52 was + causing while destroying. } + (csDestroying in ComponentState) or + (Parent = nil) or + (Parent.HandleAllocated and (csDestroying in Parent.ComponentState)) then begin + FArrangeNeeded := True; + Exit; + end; + + FArrangeNeeded := False; + NewClientSize.X := 0; + NewClientSize.Y := 0; + + Inc (FDisableArrangeControls); + try + OrderControls (ArrangeType <> atNone, WasDockedTo, DockingTo, NewClientSize); + + if ArrangeType = atMoveControlsAndResize then + with NewClientSize do begin + if Docked then begin + GetDockRowSize (WH); + if not(DockedTo.Position in PositionLeftOrRight) then begin + if WH > Y then Y := WH; + if FullSize then + X := DockedTo.ClientWidth - (Width-ClientWidth); + end + else begin + if WH > X then X := WH; + if FullSize then + Y := DockedTo.ClientHeight - (Height-ClientHeight); + end; + end; + if (ClientWidth <> X) or (ClientHeight <> Y) then begin + Inc (FUpdatingBounds); + try + SetBounds (Left, Top, (Width-ClientWidth) + X, (Height-ClientHeight) + Y); + finally + Dec (FUpdatingBounds); + end; + end; + end; + finally + Dec (FDisableArrangeControls); + end; +end; + +procedure TCustomToolWindow97.ArrangeControls; +var + TempSize: TPoint; +begin + CustomArrangeControls (atMoveControlsAndResize, DockedTo, DockedTo, TempSize); +end; + +procedure TCustomToolWindow97.AlignControls (AControl: TControl; var Rect: TRect); +{ VCL calls this whenever any child controls in the toolbar are moved, sized, + inserted, etc. It doesn't need to make use of the AControl and Rect + parameters. } +begin + if Params.CallAlignControls then + inherited; + ArrangeControls; +end; + +procedure TCustomToolWindow97.SetBounds (ALeft, ATop, AWidth, AHeight: Integer); +begin + if (FUpdatingBounds = 0) and ((AWidth <> Width) or (AHeight <> Height)) then + SizeChanging (AWidth, AHeight); + { This allows you to drag the toolbar around the dock at design time } + if (csDesigning in ComponentState) and not(csLoading in ComponentState) and + Docked and (FUpdatingBounds = 0) and ((ALeft <> Left) or (ATop <> Top)) then begin + if not(DockedTo.Position in PositionLeftOrRight) then begin + FDockRow := DockedTo.GetDesignModeRowOf(ATop+(Height div 2)); + FDockPos := ALeft; + end + else begin + FDockRow := DockedTo.GetDesignModeRowOf(ALeft+(Width div 2)); + FDockPos := ATop; + end; + inherited SetBounds (Left, Top, AWidth, AHeight); { only pass any size changes } + DockedTo.ArrangeToolbars; { let ArrangeToolbars take care of position changes } + end + else begin + inherited; + if not(csLoading in ComponentState) and not Docked and (FUpdatingBounds = 0) then + FFloatingTopLeft := BoundsRect.TopLeft; + end; +end; + +procedure TCustomToolWindow97.SetParent (AParent: TWinControl); +begin + if not(csDesigning in ComponentState) and (AParent = TForm(Owner)) then + AParent := FloatParent; + + if (AParent <> nil) and not(AParent is TDock97) and + not(AParent = Owner) and not(AParent is TFloatParent) then + raise EInvalidOperation.Create(STB97ToolwinParentNotAllowed); + + if not(csDestroying in ComponentState) and Assigned(FOnRecreating) then + FOnRecreating (Self); + + if Parent is TDock97 then + TDock97(Parent).ChangeDockList (False, Self, Visible or (FHidden <> 0)); + + { Ensure that the handle is destroyed now so that any messages in the queue + get flushed. This is neccessary since existing messages may reference + FDockedTo or FDocked, which is changed below. } + inherited SetParent (nil); + { ^ Note to self: SetParent is used instead of DestroyHandle because it does + additional processing } + if not(AParent is TDock97) then + FDockedTo := nil + else + FDockedTo := TDock97(AParent); + FDocked := FDockedTo <> nil; + try + inherited; + except + { Failure is rare, but just in case, restore FDockedTo and FDocked back. } + if not(Parent is TDock97) then + FDockedTo := nil + else + FDockedTo := TDock97(Parent); + FDocked := FDockedTo <> nil; + raise; + end; + + if Parent is TDock97 then + TDock97(Parent).ChangeDockList (True, Self, Visible or (FHidden <> 0)); + + if not(csDestroying in ComponentState) and Assigned(FOnRecreated) then + FOnRecreated (Self); +end; + +function GetCaptionRect (const Control: TCustomToolWindow97; + const AdjustForBorder, MinusCloseButton: Boolean): TRect; +begin + Result := Rect(0, 0, Control.ClientWidth, GetSmallCaptionHeight-1); + if MinusCloseButton then + Dec (Result.Right, GetSmallCaptionHeight-1); + if AdjustForBorder then + with GetBorderSize(Control.Resizable) do + OffsetRect (Result, X, Y); +end; + +function GetCloseButtonRect (const Control: TCustomToolWindow97; + const AdjustForBorder: Boolean): TRect; +begin + Result := Rect(0, 0, Control.ClientWidth, GetSmallCaptionHeight-1); + if AdjustForBorder then + with GetBorderSize(Control.Resizable) do + OffsetRect (Result, X, Y); + Result.Left := Result.Right - (GetSmallCaptionHeight-1); +end; + +procedure TCustomToolWindow97.WMNCCalcSize (var Message: TWMNCCalcSize); +begin + { Doesn't call inherited since it overrides the normal NC sizes } + Message.Result := 0; + with Message.CalcSize_Params^ do begin + if not Docked then begin + with GetBorderSize(Resizable) do + InflateRect (rgrc[0], -X, -Y); + Inc (rgrc[0].Top, GetSmallCaptionHeight); + end + else begin + InflateRect (rgrc[0], -DockedBorderSize, -DockedBorderSize); + if DockedTo.FAllowDrag and FDragHandle then begin + if not(DockedTo.Position in PositionLeftOrRight) then + Inc (rgrc[0].Left, DragHandleSize) + else + Inc (rgrc[0].Top, DragHandleSize); + end; + end; + end; +end; + +procedure TCustomToolWindow97.DrawFloatingNCArea (const Clip: HRGN; + const RedrawBorder, RedrawCaption, RedrawCloseButton: Boolean); +{ Redraws all the non-client area (the border, title bar, and close button) of + the toolbar when it is floating. } +const + CaptionBkColors: array[Boolean] of Integer = + (COLOR_ACTIVECAPTION, COLOR_INACTIVECAPTION); + CaptionTextColors: array[Boolean] of Integer = + (COLOR_CAPTIONTEXT, COLOR_INACTIVECAPTIONTEXT); + + procedure Win3DrawCaption (const DC: HDC; const R: TRect); + { Emulates DrawCaption, which isn't supported in Win 3.x } + const + Ellipsis = '...'; + var + R2: TRect; + SaveTextColor, SaveBkColor: TColorRef; + SaveFont: HFONT; + Cap: String; + + function CaptionTextWidth: Integer; + var + Size: TSize; + begin + GetTextExtentPoint32 (DC, PChar(Cap), Length(Cap), Size); + Result := Size.cx; + end; + begin + R2 := R; + + { Fill the rectangle } + FillRect (DC, R2, GetSysColorBrush(CaptionBkColors[FInactiveCaption])); + + Inc (R2.Left); + Dec (R2.Right); + + SaveFont := SelectObject(DC, CreateFont(-11, 0, 0, 0, FW_NORMAL, 0, 0, 0, 0, 0, 0, 0, 0, 'MS Sans Serif')); + + { Add ellipsis to caption if necessary } + Cap := Caption; + if CaptionTextWidth > R2.Right-R2.Left then begin + Cap := Cap + Ellipsis; + while (CaptionTextWidth > R2.Right-R2.Left) and (Length(Cap) > 4) do + Delete (Cap, Length(Cap)-Length(Ellipsis), 1) + end; + + { Draw the text } + SaveBkColor := SetBkColor(DC, GetSysColor(CaptionBkColors[FInactiveCaption])); + SaveTextColor := SetTextColor(DC, GetSysColor(CaptionTextColors[FInactiveCaption])); + DrawText (DC, PChar(Cap), Length(Cap), R2, DT_SINGLELINE or DT_NOPREFIX or DT_VCENTER); + SetTextColor (DC, SaveTextColor); + SetBkColor (DC, SaveBkColor); + + DeleteObject (SelectObject(DC, SaveFont)); + end; +const + CloseButtonState: array[Boolean] of UINT = (0, DFCS_PUSHED); + ActiveCaptionFlags: array[Boolean] of UINT = (DC_ACTIVE, 0); +var + DC: HDC; + R: TRect; + NewClipRgn: HRGN; + NewDrawCaption: function(p1: HWND; p2: HDC; const p3: TRect; p4: UINT): BOOL; stdcall; + SavePen: HPEN; + SaveIndex: Integer; + I: Integer; +begin + if Docked then Exit; + + DC := GetWindowDC(Handle); + try + { Use update region } + if (Clip <> 0) and (Clip <> 1) then begin + GetWindowRect (Handle, R); + if SelectClipRgn(DC, Clip) = ERROR then begin + NewClipRgn := CreateRectRgnIndirect(R); + SelectClipRgn (DC, NewClipRgn); + DeleteObject (NewClipRgn); + end; + OffsetClipRgn (DC, -R.Left, -R.Top); + end; + + { Border } + if RedrawBorder then begin + { This works around WM_NCPAINT problem described at top of source code } + {no! R := Rect(0, 0, Width, Height);} + GetWindowRect (Handle, R); OffsetRect (R, -R.Left, -R.Top); + for I := 1 to GetBorderSize(Resizable).X do + case I of + 1: DrawEdge (DC, R, EDGE_RAISED, BF_RECT or BF_ADJUST); + 2: ; + else + FrameRect (DC, R, GetSysColorBrush(COLOR_BTNFACE)); + InflateRect (R, -1, -1); + end; + end; + + if RedrawCaption and FCloseButton and RedrawCloseButton then + SaveIndex := SaveDC(DC) + else + SaveIndex := 0; + try + if SaveIndex <> 0 then + with GetCloseButtonRect(Self, True) do + { Reduces flicker } + ExcludeClipRect (DC, Left, Top, Right, Bottom); + + { Caption } + if RedrawCaption then begin + R := GetCaptionRect(Self, True, FCloseButton); + if NewStyleControls then begin + { Use a dynamic import of DrawCaption since it's Win95/NT 4.0 only. + Also note that Delphi's Win32 help for DrawCaption is totally wrong! + I got updated info from www.microsoft.com/msdn/sdk/ } + NewDrawCaption := GetProcAddress(GetModuleHandle(user32), 'DrawCaption'); + NewDrawCaption (Handle, DC, R, DC_TEXT or DC_SMALLCAP or + ActiveCaptionFlags[FInactiveCaption]); + end + else + Win3DrawCaption (DC, R); + + { Line below caption } + R := GetCaptionRect(Self, True, False); + SavePen := SelectObject(DC, CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNFACE))); + MoveToEx (DC, R.Left, R.Bottom, nil); + LineTo (DC, R.Right, R.Bottom); + DeleteObject (SelectObject(DC, SavePen)); + end; + finally + if SaveIndex <> 0 then + RestoreDC (DC, SaveIndex); + end; + + { Close button } + if FCloseButton then begin + if RedrawCloseButton then begin + R := GetCloseButtonRect(Self, True); + InflateRect (R, -1, -1); + DrawFrameControl (DC, R, DFC_CAPTION, DFCS_CAPTIONCLOSE or + CloseButtonState[CloseButtonDown]); + end; + if RedrawCaption then begin + { Caption-colored frame around close button } + R := GetCloseButtonRect(Self, True); + FrameRect (DC, R, GetSysColorBrush(CaptionBkColors[FInactiveCaption])); + end; + end; + finally + ReleaseDC (Handle, DC); + end; +end; + +procedure TCustomToolWindow97.ValidateDockedNCArea; +var + Msg: TMsg; +begin + if HandleAllocated then + while PeekMessage(Msg, Handle, WM_TB97PaintDockedNCArea, + WM_TB97PaintDockedNCArea, PM_REMOVE or PM_NOYIELD) do ; +end; + +procedure TCustomToolWindow97.InvalidateDockedNCArea; +begin + ValidateDockedNCArea; + if HandleAllocated then + PostMessage (Handle, WM_TB97PaintDockedNCArea, 0, 0); +end; + +procedure TCustomToolWindow97.WMTB97PaintDockedNCArea (var Message: TMessage); +begin + DrawDockedNCArea (0); +end; + +procedure TCustomToolWindow97.DrawDockedNCArea (const Clip: HRGN); +{ Redraws all the non-client area of the toolbar when it is docked. } +var + DC: HDC; + R: TRect; + NewClipRgn: HRGN; + DockType: TDockType; + X, Y: Integer; + R2, R3, R4: TRect; + P1, P2: TPoint; + Brush: HBRUSH; + Clr: TColorRef; + UsingBackground: Boolean; + procedure DrawRaisedEdge (R: TRect; const FillInterior: Boolean); + const + FillMiddle: array[Boolean] of UINT = (0, BF_MIDDLE); + begin + DrawEdge (DC, R, BDR_RAISEDINNER, BF_RECT or FillMiddle[FillInterior]); + end; +begin + ValidateDockedNCArea; + if not Docked then Exit; + + DC := GetWindowDC(Handle); + try + { Use update region } + if (Clip <> 0) and (Clip <> 1) then begin + GetWindowRect (Handle, R); + if SelectClipRgn(DC, Clip) = ERROR then begin + NewClipRgn := CreateRectRgnIndirect(R); + SelectClipRgn (DC, NewClipRgn); + DeleteObject (NewClipRgn); + end; + OffsetClipRgn (DC, -R.Left, -R.Top); + end; + + { This works around WM_NCPAINT problem described at top of source code } + {no! R := Rect(0, 0, Width, Height);} + GetWindowRect (Handle, R); OffsetRect (R, -R.Left, -R.Top); + + if not(DockedTo.Position in PositionLeftOrRight) then + DockType := dtTopBottom + else + DockType := dtLeftRight; + + Brush := CreateSolidBrush(ColorToRGB(Color)); + + { Border } + DrawRaisedEdge (R, False); + R2 := R; + InflateRect (R2, -1, -1); + FrameRect (DC, R2, Brush); + + UsingBackground := DockedTo.UsingBackground and DockedTo.FBkgOnToolbars; + + { Draw the Background } + if UsingBackground then begin + R2 := R; + P1 := DockedTo.ClientToScreen(Point(0, 0)); + P2 := DockedTo.Parent.ClientToScreen(DockedTo.BoundsRect.TopLeft); + Dec (R2.Left, Left + DockedTo.Left + (P1.X-P2.X)); + Dec (R2.Top, Top + DockedTo.Top + (P1.Y-P2.Y)); + InflateRect (R, -1, -1); + GetWindowRect (Handle, R4); + R3 := ClientRect; + with ClientToScreen(Point(0, 0)) do + OffsetRect (R3, X-R4.Left, Y-R4.Top); + DockedTo.DrawBackground (DC, R, @R3, R2); + end; + + { The drag handle at the left, or top } + if DockedTo.FAllowDrag and FDragHandle then begin + Clr := GetSysColor(COLOR_BTNHIGHLIGHT); + if DockType <> dtLeftRight then begin + Y := ClientHeight+2; + if not UsingBackground then begin + FillRect (DC, Rect(2, 2, 4, Y), Brush); + FillRect (DC, Rect(10, 2, 11, Y), Brush); + end; + DrawRaisedEdge (Rect(4, 2, 7, Y), True); + SetPixelV (DC, 4, Y-1, Clr); + DrawRaisedEdge (Rect(7, 2, 10, Y), True); + SetPixelV (DC, 7, Y-1, Clr); + end + else begin + X := ClientWidth+2; + if not UsingBackground then begin + FillRect (DC, Rect(2, 2, X, 4), Brush); + FillRect (DC, Rect(2, 10, X, 11), Brush); + end; + DrawRaisedEdge (Rect(2, 4, X, 7), True); + SetPixelV (DC, X-1, 4, Clr); + DrawRaisedEdge (Rect(2, 7, X, 10), True); + SetPixelV (DC, X-1, 7, Clr); + end; + end; + + DeleteObject (Brush); + finally + ReleaseDC (Handle, DC); + end; +end; + +procedure TCustomToolWindow97.WMNCPaint (var Message: TMessage); +begin + { Don't call inherited because it overrides the default NC painting } + if Docked then + DrawDockedNCArea (Message.WParam) + else + DrawFloatingNCArea (Message.WParam, True, True, True); +end; + +procedure TCustomToolWindow97.Paint; +var + R, R2, R3: TRect; + P1, P2: TPoint; +begin + inherited; + + if Docked and DockedTo.UsingBackground and DockedTo.FBkgOnToolbars then begin + R := ClientRect; + R2 := R; + P1 := DockedTo.ClientToScreen(Point(0, 0)); + P2 := DockedTo.Parent.ClientToScreen(DockedTo.BoundsRect.TopLeft); + Dec (R2.Left, Left + DockedTo.Left + (P1.X-P2.X)); + Dec (R2.Top, Top + DockedTo.Top + (P1.Y-P2.Y)); + GetWindowRect (Handle, R3); + with ClientToScreen(Point(0, 0)) do begin + Inc (R2.Left, R3.Left-X); + Inc (R2.Top, R3.Top-Y); + end; + DockedTo.DrawBackground (Canvas.Handle, R, nil, R2); + end; +end; + +function TCustomToolWindow97.GetPalette: HPALETTE; +begin + if Docked and DockedTo.UsingBackground then + Result := DockedTo.FBkg.Palette + else + Result := 0; +end; + +function TCustomToolWindow97.PaletteChanged (Foreground: Boolean): Boolean; +begin + Result := inherited PaletteChanged(Foreground); + if Result and not Foreground then begin + { There seems to be a bug in Delphi's palette handling. When the form is + inactive and another window realizes a palette, docked TToolbar97s + weren't getting redrawn. So this workaround code was added. } + InvalidateDockedNCArea; + Invalidate; + end; +end; + +procedure DrawDragRect (const DC: HDC; const NewRect, OldRect: PRect; + const NewSize, OldSize: TSize; const Brush: HBRUSH; BrushLast: HBRUSH); +{ Draws a dragging outline, hiding the old one if neccessary. This is + completely flicker free, unlike the old DrawFocusRect method. In case + you're wondering, I got a lot of ideas from the MFC sources. + + Either NewRect or OldRect can be nil or empty. + + NOTE: If the specific DC had a clipping region, it will be gone when this + function exits. } +const + BlankRect: TRect = (Left: 0; Top: 0; Right: 0; Bottom: 0); +var + rgnNew, rgnOutside, rgnInside, rgnLast, rgnUpdate: HRGN; + R: TRect; + SaveBrush: HBRUSH; +begin + rgnLast := 0; + rgnUpdate := 0; + + { First, determine the update region and select it } + if NewRect = nil then begin + R := BlankRect; + rgnOutside := CreateRectRgnIndirect(R); + end + else begin + R := NewRect^; + rgnOutside := CreateRectRgnIndirect(R); + InflateRect (R, -NewSize.cx, -NewSize.cy); + IntersectRect (R, R, NewRect^); + end; + rgnInside := CreateRectRgnIndirect(R); + rgnNew := CreateRectRgnIndirect(BlankRect); + CombineRgn (rgnNew, rgnOutside, rgnInside, RGN_XOR); + + if BrushLast = 0 then + BrushLast := Brush; + + if OldRect <> nil then begin + { Find difference between new region and old region } + rgnLast := CreateRectRgnIndirect(BlankRect); + with OldRect^ do + SetRectRgn (rgnOutside, Left, Top, Right, Bottom); + R := OldRect^; + InflateRect (R, -OldSize.cx, -OldSize.cy); + IntersectRect (R, R, OldRect^); + SetRectRgn (rgnInside, R.Left, R.Top, R.Right, R.Bottom); + CombineRgn (rgnLast, rgnOutside, rgnInside, RGN_XOR); + + { Only diff them if brushes are the same} + if Brush = BrushLast then begin + rgnUpdate := CreateRectRgnIndirect(BlankRect); + CombineRgn (rgnUpdate, rgnLast, rgnNew, RGN_XOR); + end; + end; + if (Brush <> BrushLast) and (OldRect <> nil) then begin + { Brushes are different -- erase old region first } + SelectClipRgn (DC, rgnLast); + GetClipBox (DC, R); + SaveBrush := SelectObject(DC, BrushLast); + PatBlt (DC, R.Left, R.Top, R.Right-R.Left, R.Bottom-R.Top, PATINVERT); + SelectObject (DC, SaveBrush); + end; + + { Draw into the update/new region } + if rgnUpdate <> 0 then + SelectClipRgn (DC, rgnUpdate) + else + SelectClipRgn (DC, rgnNew); + GetClipBox (DC, R); + SaveBrush := SelectObject(DC, Brush); + PatBlt (DC, R.Left, R.Top, R.Right-R.Left, R.Bottom-R.Top, PATINVERT); + SelectObject (DC, SaveBrush); + + { Free regions } + if rgnNew <> 0 then DeleteObject (rgnNew); + if rgnOutside <> 0 then DeleteObject (rgnOutside); + if rgnInside <> 0 then DeleteObject (rgnInside); + if rgnLast <> 0 then DeleteObject (rgnLast); + if rgnUpdate <> 0 then DeleteObject (rgnUpdate); + + { Clean up DC } + SelectClipRgn (DC, 0); +end; + +procedure TCustomToolWindow97.DrawDraggingOutline (const DC: HDC; + const NewRect, OldRect: PRect; const NewDocking, OldDocking: Boolean); + + function CreateHalftoneBrush: HBRUSH; + const + Patterns: array[Boolean] of Word = ($5555, $AAAA); + var + I: Integer; + GrayPattern: array[0..7] of Word; + GrayBitmap: HBITMAP; + begin + for I := 0 to 7 do + GrayPattern[I] := Patterns[Odd(I)]; + GrayBitmap := CreateBitmap(8, 8, 1, 1, @GrayPattern); + Result := CreatePatternBrush(GrayBitmap); + DeleteObject (GrayBitmap); + end; +var + NewSize, OldSize: TSize; + Brush: HBRUSH; +begin + Brush := CreateHalftoneBrush; + try + with GetBorderSize(Resizable) do begin + if NewDocking then NewSize.cx := 1 else NewSize.cx := X; + NewSize.cy := NewSize.cx; + if OldDocking then OldSize.cx := 1 else OldSize.cx := X; + OldSize.cy := OldSize.cx; + end; + DrawDragRect (DC, NewRect, OldRect, NewSize, OldSize, Brush, Brush); + finally + DeleteObject (Brush); + end; +end; + + +procedure TCustomToolWindow97.CMColorChanged (var Message: TMessage); +begin + { Make sure non-client area is redrawn } + InvalidateDockedNCArea; + inherited; { the inherited handler calls Invalidate } +end; + +procedure TCustomToolWindow97.CMTextChanged (var Message: TMessage); +begin + inherited; + { Update the title bar to use the new Caption } + DrawFloatingNCArea (0, False, True, False); +end; + +procedure TCustomToolWindow97.CMVisibleChanged (var Message: TMessage); +begin + if (FHidden = 0) and not(csDesigning in ComponentState) and Docked then + DockedTo.ChangeDockList (Visible, Self, Visible); + inherited; + if (FHidden = 0) and Assigned(FOnVisibleChanged) then + FOnVisibleChanged (Self); +end; + +procedure TCustomToolWindow97.WMActivate (var Message: TWMActivate); + + function GetParentToolWindow (Control: TControl): TCustomToolWindow97; + { Returns the parent toolbar (direct or indirect) of the control, or nil if it + is not a child of a TCustomToolWindow97 } + begin + Result := nil; + while Control <> nil do begin + if Control is TCustomToolWindow97 then begin + Result := TCustomToolWindow97(Control); + Break; + end; + Control := Control.Parent; + end; + end; + + function FindFirstFocusableNonToolWindowControl (const ParentControl: TWinControl): TWinControl; + var + List: TList; + I: Integer; + CurControl: TWinControl; + begin + Result := nil; + List := TList.Create; + try + with ParentControl do begin + GetTabOrderList (List); + for I := 0 to List.Count-1 do begin + CurControl := List[I]; + if CurControl.TabStop and CurControl.CanFocus and + (GetParentToolWindow(CurControl) = nil) then begin + Result := CurControl; + Break; + end; + end; + end; + finally + List.Free; + end; + end; +var + Ctl: TWinControl; + I: Integer; +begin + if Docked then begin + inherited; + Exit; + end; + + SendMessage (MDIParentForm.Handle, WM_NCACTIVATE, Ord(Message.Active <> WA_INACTIVE), 0); + + inherited; + + if Message.Active = WA_INACTIVE then begin + Ctl := FindFirstFocusableNonToolWindowControl(TForm(Owner)); + for I := 0 to HookedForms.Count-1 do + with PHookedFormInfo(HookedForms[I])^ do + if Form = TForm(Owner) then begin + if SaveActiveControl <> 0 then + Ctl := FindControl(SaveActiveControl); + Break; + end; + if Ctl = nil then + { Can't leave Ctl set to nil or the VCL will automatically pick a new + ActiveControl (which we don't want, because it could be another tool + window). So just set Ctl to FloatParent, which effectively leaves no + currently focused control on the form. } + Ctl := FloatParent; + TForm(Owner).ActiveControl := Ctl; + end; +end; + +procedure TCustomToolWindow97.WMMouseActivate (var Message: TWMMouseActivate); +begin + if Docked or (csDesigning in ComponentState) then + inherited + else begin + { When floating, prevent the toolbar from activating when clicked. + This is so it doesn't take the focus away from the window that had it } + Message.Result := MA_NOACTIVATE; + + { Similar to calling BringWindowToTop, but doesn't activate it } + SetWindowPos (Handle, HWND_TOP, 0, 0, 0, 0, + SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE); + + { Since it is returning MA_NOACTIVATE, activate the form instead. } + if FActivateParent and + (GetActiveWindow <> Handle) then begin + { ^ Note to self: That must be in there so that double-clicks work + properly on controls like Edits } + SetActiveWindow (MDIParentForm.Handle); + if MDIParentForm <> TForm(Owner) then { if it's an MDI child form } + BringWindowToTop (TForm(Owner).Handle); + end; + end; +end; + +procedure TCustomToolWindow97.BeginMoving (const InitX, InitY: Integer); +type + PDockedSize = ^TDockedSize; + TDockedSize = record + Dock: TDock97; + Size: TPoint; + end; +var + NewDockedSizes: TList; {items are pointers to TDockedSizes} + MouseOverDock: TDock97; + MoveRect: TRect; + PreventDocking: Boolean; + ScreenDC: HDC; + NPoint, DPoint: TPoint; + + procedure Dropped; + var + NewDockRow: Integer; + Before: Boolean; + MoveRectClient: TRect; + C: Integer; + begin + if MouseOverDock <> nil then begin + MoveRectClient := MoveRect; + MapWindowPoints (0, MouseOverDock.Handle, MoveRectClient, 2); + if not(MouseOverDock.Position in PositionLeftOrRight) then + C := (MoveRectClient.Top+MoveRectClient.Bottom) div 2 + else + C := (MoveRectClient.Left+MoveRectClient.Right) div 2; + NewDockRow := MouseOverDock.GetRowOf(C, Before); + if Before then + MouseOverDock.InsertRowBefore (NewDockRow) + else + if FullSize and + (MouseOverDock.GetNumberOfToolbarsOnRow(NewDockRow, Self) <> 0) then begin + Inc (NewDockRow); + MouseOverDock.InsertRowBefore (NewDockRow); + end; + FDockRow := NewDockRow; + if not(MouseOverDock.Position in PositionLeftOrRight) then + FDockPos := MoveRectClient.Left + else + FDockPos := MoveRectClient.Top; + DockedTo := MouseOverDock; + end + else begin + FFloatingTopLeft := MoveRect.TopLeft; + DockedTo := nil; + end; + + { Make sure it doesn't go completely off the screen } + MoveOnScreen (True); + end; + + procedure MouseMoved; + var + OldMouseOverDock: TDock97; + OldMoveRect: TRect; + Pos: TPoint; + + function CheckIfCanDockTo (Control: TDock97): Boolean; + const + DockSensX = 32; + DockSensY = 20; + var + R, S, Temp: TRect; + I: Integer; + Sens: Integer; + begin + with Control do begin + Result := False; + + R := ClientRect; + MapWindowPoints (Handle, 0, R, 2); + for I := 0 to NewDockedSizes.Count-1 do + with PDockedSize(NewDockedSizes[I])^ do begin + if Dock <> Control then Continue; + S := Bounds(Pos.X-MulDiv(Size.X-1, NPoint.X, DPoint.X), + Pos.Y-MulDiv(Size.Y-1, NPoint.Y, DPoint.Y), + Size.X, Size.Y); + Break; + end; + if (R.Left = R.Right) or (R.Top = R.Bottom) then begin + if not(Control.Position in PositionLeftOrRight) then + InflateRect (R, 0, 1) + else + InflateRect (R, 1, 0); + end; + + { Like Office 97, distribute ~32 pixels of extra dock detection area + to the left side if the toolbar was grabbed at the left, both sides + if the toolbar was grabbed at the middle, or the right side if + toolbar was grabbed at the right. If outside, don't try to dock. } + Sens := MulDiv(DockSensX, NPoint.X, DPoint.X); + if (Pos.X < R.Left-(DockSensX-Sens)) or (Pos.X > R.Right-1+Sens) then + Exit; + + { Don't try to dock to the left or right if pointer is above or below + the boundaries of the dock } + if (Control.Position in PositionLeftOrRight) and + ((Pos.Y < R.Top) or (Pos.Y >= R.Bottom)) then + Exit; + + { And also distribute ~20 pixels of extra dock detection area to + the top or bottom side } + Sens := MulDiv(DockSensY, NPoint.Y, DPoint.Y); + if (Pos.Y < R.Top-(DockSensY-Sens)) or (Pos.Y > R.Bottom-1+Sens) then + Exit; + + Result := IntersectRect(Temp, R, S); + end; + end; + var + R: TRect; + D: TDockPosition; + I: Integer; + Accept: Boolean; + begin + OldMouseOverDock := MouseOverDock; + OldMoveRect := MoveRect; + + GetCursorPos (Pos); + + { Check if it can dock } + MouseOverDock := nil; + if not PreventDocking then begin + { Search through the form's controls and see if it can find a + Dock97. If it finds one, assign it to MouseOverDock. } + with TForm(Owner) do + for D := Low(D) to High(D) do + if D in DockableTo then + for I := 0 to ComponentCount-1 do + if (Components[I] is TDock97) and + (TDock97(Components[I]).Position = D) and + TDock97(Components[I]).FAllowDrag and + CheckIfCanDockTo(TDock97(Components[I])) then begin + MouseOverDock := TDock97(Components[I]); + Accept := True; + if Assigned(MouseOverDock.FOnRequestDock) then + MouseOverDock.FOnRequestDock (MouseOverDock, Self, Accept); + if Accept then + Break + else + MouseOverDock := nil; + end; + end; + + { If not docking, clip the point so it doesn't get dragged under the + taskbar } + if MouseOverDock = nil then begin + R := GetDesktopArea; + if Pos.X < R.Left then Pos.X := R.Left; + if Pos.X > R.Right then Pos.X := R.Right; + if Pos.Y < R.Top then Pos.Y := R.Top; + if Pos.Y > R.Bottom then Pos.Y := R.Bottom; + end; + + for I := 0 to NewDockedSizes.Count-1 do + with PDockedSize(NewDockedSizes[I])^ do begin + if Dock <> MouseOverDock then Continue; + MoveRect := Bounds(Pos.X-MulDiv(Size.X-1, NPoint.X, DPoint.X), + Pos.Y-MulDiv(Size.Y-1, NPoint.Y, DPoint.Y), + Size.X, Size.Y); + Break; + end; + + { Make sure title bar (or at least part of the toolbar) is still accessible + if it's dragged almost completely off the screen. This prevents the + problem seen in Office 97 where you drag it offscreen so that only the + border is visible, sometimes leaving you no way to move it back short of + resetting the toolbar. } + if MouseOverDock = nil then begin + R := GetDesktopArea; + with GetBorderSize(Resizable) do + InflateRect (R, -(X+4), -(Y+4)); + if MoveRect.Bottom < R.Top then + OffsetRect (MoveRect, 0, R.Top-MoveRect.Bottom); + if MoveRect.Top > R.Bottom then + OffsetRect (MoveRect, 0, R.Bottom-MoveRect.Top); + if MoveRect.Right < R.Left then + OffsetRect (MoveRect, R.Left-MoveRect.Right, 0); + if MoveRect.Left > R.Right then + OffsetRect (MoveRect, R.Right-MoveRect.Left, 0); + + I := GetDesktopArea.Top - GetBorderSize(Resizable).Y - GetSmallCaptionHeight + 4; + if MoveRect.Top < I then + OffsetRect (MoveRect, 0, I-MoveRect.Top); + end; + + { Update the dragging outline } + DrawDraggingOutline (ScreenDC, @MoveRect, @OldMoveRect, MouseOverDock <> nil, + OldMouseOverDock <> nil); + end; +var + Accept: Boolean; + R: TRect; + Msg: TMsg; + NewDockedSize: PDockedSize; + I: Integer; +begin + Accept := False; + + NPoint := Point(InitX, InitY); + { Adjust for non-client area } + GetWindowRect (Handle, R); + R.BottomRight := ClientToScreen(Point(0, 0)); + Dec (NPoint.X, R.Left-R.Right); + Dec (NPoint.Y, R.Top-R.Bottom); + + DPoint := Point(Width-1, Height-1); + + PreventDocking := GetKeyState(VK_CONTROL) < 0; + + { Set up potential sizes for each dock type } + NewDockedSizes := TList.Create; + try + SetRectEmpty (R); + CustomArrangeControls (atNone, DockedTo, nil, R.BottomRight); + AddFloatingNCAreaToRect (R, Resizable); + New (NewDockedSize); + try + with NewDockedSize^ do begin + Dock := nil; + Size := Point(R.Right-R.Left, R.Bottom-R.Top); + end; + NewDockedSizes.Add (NewDockedSize); + except + Dispose (NewDockedSize); + raise; + end; + with TForm(Owner) do + for I := 0 to ComponentCount-1 do begin + if not(Components[I] is TDock97) then Continue; + New (NewDockedSize); + try + with NewDockedSize^ do begin + Dock := TDock97(Components[I]); + if Components[I] <> DockedTo then + CustomArrangeControls (atNone, DockedTo, TDock97(Components[I]), Size) + else + Size := Self.ClientRect.BottomRight; + AddDockedNCAreaToSize (Size, TDock97(Components[I]).Position in PositionLeftOrRight, + FDragHandle); + end; + NewDockedSizes.Add (NewDockedSize); + except + Dispose (NewDockedSize); + raise; + end; + end; + + { Before locking, make sure all pending paint messages are processed } + ProcessPaintMessages; + + { This uses LockWindowUpdate to suppress all window updating so the + dragging outlines doesn't sometimes get garbled. (This is safe, and in + fact, is the main purpose of the LockWindowUpdate function) + IMPORTANT! While debugging you might want to enable the 'TB97DisableLock' + conditional define (see top of the source code). } + {$IFNDEF TB97DisableLock} + LockWindowUpdate (GetDesktopWindow); + {$ENDIF} + { Get a DC of the entire screen. Works around the window update lock + by specifying DCX_LOCKWINDOWUPDATE. } + ScreenDC := GetDCEx(GetDesktopWindow, 0, + DCX_LOCKWINDOWUPDATE or DCX_CACHE or DCX_WINDOW); + try + SetCapture (Handle); + + { Initialize } + MouseOverDock := nil; + SetRectEmpty (MoveRect); + MouseMoved; + + { Stay in message loop until capture is lost. Capture is removed either + by this procedure manually doing it, or by an outside influence (like + a message box or menu popping up) } + while GetCapture = Handle do begin + case Integer(GetMessage(Msg, 0, 0, 0)) of + -1: Break; { if GetMessage failed } + 0: begin + { Repost WM_QUIT messages } + PostQuitMessage (Msg.WParam); + Break; + end; + end; + + case Msg.Message of + WM_KEYDOWN, WM_KEYUP: + { Ignore all keystrokes while dragging. But process Ctrl and Escape } + case Msg.WParam of + VK_CONTROL: + if PreventDocking <> (Msg.Message = WM_KEYDOWN) then begin + PreventDocking := Msg.Message = WM_KEYDOWN; + MouseMoved; + end; + VK_ESCAPE: + Break; + end; + WM_MOUSEMOVE: + { Note to self: WM_MOUSEMOVE messages should never be dispatched + here to ensure no hints get shown during the drag process } + MouseMoved; + WM_LBUTTONDOWN, WM_LBUTTONDBLCLK: + { Make sure it doesn't begin another loop } + Break; + WM_LBUTTONUP: begin + Accept := True; + Break; + end; + WM_RBUTTONDOWN..WM_MBUTTONDBLCLK: + { Ignore all other mouse up/down messages } + ; + else + TranslateMessage (Msg); + DispatchMessage (Msg); + end; + end; + finally + { Since it sometimes breaks out of the loop without capture being + released } + if GetCapture = Handle then + ReleaseCapture; + + { Hide dragging outline and release the DC } + DrawDraggingOutline (ScreenDC, nil, @MoveRect, False, MouseOverDock <> nil); + ReleaseDC (GetDesktopWindow, ScreenDC); + + { Release window update lock } + {$IFNDEF TB97DisableLock} + LockWindowUpdate (0); + {$ENDIF} + end; + + { Move to new position } + if Accept then + Dropped; + finally + for I := NewDockedSizes.Count-1 downto 0 do + Dispose (PDockedSize(NewDockedSizes[I])); + NewDockedSizes.Free; + end; +end; + +procedure TCustomToolWindow97.MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + + function ControlExistsAtPos (const P: TPoint): Boolean; + var + I: Integer; + begin + Result := False; + for I := 0 to ControlCount-1 do + if not(Controls[I] is TToolbarSep97) and Controls[I].Visible and + PtInRect(Controls[I].BoundsRect, P) then begin + Result := True; + Break; + end; + end; +begin + inherited; + if (Button <> mbLeft) or + { Ignore message if user clicked on a child control that was probably + disabled } + ControlExistsAtPos(Point(X, Y)) or + (Docked and not DockedTo.FAllowDrag) then + Exit; + + { Handle double click } + if ssDouble in Shift then begin + if Docked then + DockedTo := nil + else begin + FDockRow := ForceDockAtTopRow; + FDockPos := ForceDockAtLeftPos; + DockedTo := DefaultDock; + end; + Exit; + end; + + BeginMoving (X, Y); +end; + +procedure TCustomToolWindow97.WMNCHitTest (var Message: TWMNCHitTest); +var + P: TPoint; + BorderSize: TPoint; + C: Integer; +begin + inherited; + with Message do + if Docked then begin + if Result = HTNOWHERE then + Result := HTCLIENT; + end + else begin + P := SmallPointToPoint(Pos); + Dec (P.X, Left); Dec (P.Y, Top); + if Result <> HTCLIENT then begin + if PtInRect(GetCaptionRect(Self, True, False), P) then begin + if FCloseButton and PtInRect(GetCloseButtonRect(Self, True), P) then + Result := HTCLOSE + else + Result := HTCLIENT; + end + else begin + if Result in [HTLEFT..HTBOTTOMRIGHT] {set covers all resizing corners} then + Result := HTNOWHERE; { handles all resize hit-tests itself } + + if Resizable then begin + BorderSize := GetBorderSize(Resizable); + C := BorderSize.X + (GetSmallCaptionHeight-1); + if not Params.ResizeEightCorner then begin + if (P.Y >= 0) and (P.Y < BorderSize.Y) then Result := HTTOP else + if (P.Y < Height) and (P.Y >= Height-BorderSize.Y-1) then Result := HTBOTTOM else + if (P.X >= 0) and (P.X < BorderSize.X) then Result := HTLEFT else + if (P.X < Width) and (P.X >= Width-BorderSize.X-1) then Result := HTRIGHT; + end + else begin + if (P.X >= 0) and (P.X < BorderSize.X) then begin + Result := HTLEFT; + if (P.Y < C) then Result := HTTOPLEFT else + if (P.Y >= Height-C) then Result := HTBOTTOMLEFT; + end + else + if (P.X < Width) and (P.X >= Width-BorderSize.X-1) then begin + Result := HTRIGHT; + if (P.Y < C) then Result := HTTOPRIGHT else + if (P.Y >= Height-C) then Result := HTBOTTOMRIGHT; + end + else + if (P.Y >= 0) and (P.Y < BorderSize.Y) then begin + Result := HTTOP; + if (P.X < C) then Result := HTTOPLEFT else + if (P.X >= Width-C) then Result := HTTOPRIGHT; + end + else + if (P.Y < Height) and (P.Y >= Height-BorderSize.Y-1) then begin + Result := HTBOTTOM; + if (P.X < C) then Result := HTBOTTOMLEFT else + if (P.X >= Width-C) then Result := HTBOTTOMRIGHT; + end; + end; + end; + end; + end; + end; +end; + +procedure TCustomToolWindow97.WMNCLButtonDown (var Message: TWMNCLButtonDown); + procedure CloseButtonLoop; + var + Accept, NewCloseButtonDown: Boolean; + P: TPoint; + Msg: TMsg; + begin + Accept := False; + + CloseButtonDown := True; + DrawFloatingNCArea (0, False, False, True); + + SetCapture (Handle); + + try + while GetCapture = Handle do begin + case Integer(GetMessage(Msg, 0, 0, 0)) of + -1: Break; { if GetMessage failed } + 0: begin + { Repost WM_QUIT messages } + PostQuitMessage (Msg.WParam); + Break; + end; + end; + + case Msg.Message of + WM_KEYDOWN, WM_KEYUP: + { Ignore all keystrokes while in a close button loop } + ; + WM_MOUSEMOVE: begin + { Note to self: WM_MOUSEMOVE messages should never be dispatched + here to ensure no hints get shown } + GetCursorPos (P); + Dec (P.X, Left); Dec (P.Y, Top); + + NewCloseButtonDown := PtInRect(GetCloseButtonRect(Self, True), P); + if CloseButtonDown <> NewCloseButtonDown then begin + CloseButtonDown := NewCloseButtonDown; + DrawFloatingNCArea (0, False, False, True); + end; + end; + WM_LBUTTONDOWN, WM_LBUTTONDBLCLK: + { Make sure it doesn't begin another loop } + Break; + WM_LBUTTONUP: begin + if CloseButtonDown then + Accept := True; + Break; + end; + WM_RBUTTONDOWN..WM_MBUTTONDBLCLK: + { Ignore all other mouse up/down messages } + ; + else + TranslateMessage (Msg); + DispatchMessage (Msg); + end; + end; + finally + if GetCapture = Handle then + ReleaseCapture; + if CloseButtonDown <> False then begin + CloseButtonDown := False; + DrawFloatingNCArea (0, False, False, True); + end; + end; + if Accept then begin + { Hide the window after close button is pushed } + Hide; + if Assigned(FOnClose) then + FOnClose (Self); + end; + end; +var + Accept: Boolean; + NewRect: TRect; +begin + case Message.HitTest of + HTLEFT..HTBOTTOMRIGHT: + if not Docked then begin + Accept := False; + SetRectEmpty (NewRect); + BeginSizing (Message.HitTest, Accept, NewRect); + if Accept then begin + Inc (FDisableArrangeControls); + try + BoundsRect := NewRect; + finally + Dec (FDisableArrangeControls); + end; + ArrangeControls; + + { Make sure it doesn't go completely off the screen } + MoveOnScreen (True); + end; + end; + HTCLOSE: + if not Docked then + CloseButtonLoop; + else + inherited; + end; +end; + +procedure TCustomToolWindow97.GetParams (var Params: TToolWindowParams); +begin + with Params do begin + CallAlignControls := True; + ResizeEightCorner := True; + ResizeClipCursor := True; + end; +end; + +procedure TCustomToolWindow97.ResizeBegin; +begin +end; + +procedure TCustomToolWindow97.ResizeTrack (var Rect: TRect; const OrigRect: TRect); +begin +end; + +procedure TCustomToolWindow97.ResizeEnd; +begin +end; + +procedure TCustomToolWindow97.BeginSizing (const HitTestValue: Integer; + var Accept: Boolean; var NewRect: TRect); +var + DragX, DragY, ReverseX, ReverseY: Boolean; + MinWidth, MinHeight: Integer; + DragRect, OrigDragRect: TRect; + ScreenDC: HDC; + OrigPos, OldPos: TPoint; + + procedure MouseMoved; + var + Pos: TPoint; + OldDragRect: TRect; + begin + GetCursorPos (Pos); + { It needs to check if the cursor actually moved since last time. This is + because a call to LockWindowUpdate (apparently) generates a mouse move + message even when mouse hasn't moved. } + if (Pos.X = OldPos.X) and (Pos.Y = OldPos.Y) then Exit; + OldPos := Pos; + + OldDragRect := DragRect; + DragRect := OrigDragRect; + if DragX then begin + if not ReverseX then Inc (DragRect.Right, Pos.X-OrigPos.X) + else Inc (DragRect.Left, Pos.X-OrigPos.X); + end; + if DragY then begin + if not ReverseY then Inc (DragRect.Bottom, Pos.Y-OrigPos.Y) + else Inc (DragRect.Top, Pos.Y-OrigPos.Y); + end; + if DragRect.Right-DragRect.Left < MinWidth then begin + if not ReverseX then DragRect.Right := DragRect.Left + MinWidth + else DragRect.Left := DragRect.Right - MinWidth; + end; + if DragRect.Bottom-DragRect.Top < MinHeight then begin + if not ReverseY then DragRect.Bottom := DragRect.Top + MinHeight + else DragRect.Top := DragRect.Bottom - MinHeight; + end; + + ResizeTrack (DragRect, OrigDragRect); + DrawDraggingOutline (ScreenDC, @DragRect, @OldDragRect, False, False); + end; +var + Msg: TMsg; + R: TRect; +begin + Accept := False; + + GetMinimumSize (MinWidth, MinHeight); + Inc (MinWidth, Width-ClientWidth); + Inc (MinHeight, Height-ClientHeight); + + DragX := HitTestValue in [HTLEFT, HTRIGHT, HTTOPLEFT, HTTOPRIGHT, HTBOTTOMLEFT, HTBOTTOMRIGHT]; + ReverseX := HitTestValue in [HTLEFT, HTTOPLEFT, HTBOTTOMLEFT]; + DragY := HitTestValue in [HTTOP, HTTOPLEFT, HTTOPRIGHT, HTBOTTOM, HTBOTTOMLEFT, HTBOTTOMRIGHT]; + ReverseY := HitTestValue in [HTTOP, HTTOPLEFT, HTTOPRIGHT]; + + ResizeBegin (HitTestValue); + try + { Before locking, make sure all pending paint messages are processed } + ProcessPaintMessages; + + { This uses LockWindowUpdate to suppress all window updating so the + dragging outlines doesn't sometimes get garbled. (This is safe, and in + fact, is the main purpose of the LockWindowUpdate function) + IMPORTANT! While debugging you might want to enable the 'TB97DisableLock' + conditional define (see top of the source code). } + {$IFNDEF TB97DisableLock} + LockWindowUpdate (GetDesktopWindow); + {$ENDIF} + { Get a DC of the entire screen. Works around the window update lock + by specifying DCX_LOCKWINDOWUPDATE. } + ScreenDC := GetDCEx(GetDesktopWindow, 0, + DCX_LOCKWINDOWUPDATE or DCX_CACHE or DCX_WINDOW); + try + SetCapture (Handle); + if Params.ResizeClipCursor then begin + R := GetDesktopArea; + ClipCursor (@R); + end; + + { Initialize } + OrigDragRect := BoundsRect; + DragRect := OrigDragRect; + DrawDraggingOutline (ScreenDC, @DragRect, nil, False, False); + GetCursorPos (OrigPos); + OldPos := OrigPos; + + { Stay in message loop until capture is lost. Capture is removed either + by this procedure manually doing it, or by an outside influence (like + a message box or menu popping up) } + while GetCapture = Handle do begin + case Integer(GetMessage(Msg, 0, 0, 0)) of + -1: Break; { if GetMessage failed } + 0: begin + { Repost WM_QUIT messages } + PostQuitMessage (Msg.WParam); + Break; + end; + end; + + case Msg.Message of + WM_KEYDOWN, WM_KEYUP: + { Ignore all keystrokes while sizing except for Escape } + if Msg.WParam = VK_ESCAPE then + Break; + WM_MOUSEMOVE: + { Note to self: WM_MOUSEMOVE messages should never be dispatched + here to ensure no hints get shown during the drag process } + MouseMoved; + WM_LBUTTONDOWN, WM_LBUTTONDBLCLK: + { Make sure it doesn't begin another loop } + Break; + WM_LBUTTONUP: begin + Accept := True; + Break; + end; + WM_RBUTTONDOWN..WM_MBUTTONDBLCLK: + { Ignore all other mouse up/down messages } + ; + else + TranslateMessage (Msg); + DispatchMessage (Msg); + end; + end; + finally + { Since it sometimes breaks out of the loop without capture being + released } + if GetCapture = Handle then + ReleaseCapture; + ClipCursor (nil); + + { Hide dragging outline and release the DC } + DrawDraggingOutline (ScreenDC, nil, @DragRect, False, False); + ReleaseDC (GetDesktopWindow, ScreenDC); + + { Release window update lock } + {$IFNDEF TB97DisableLock} + LockWindowUpdate (0); + {$ENDIF} + end; + finally + ResizeEnd (Accept); + end; + + if Accept then + NewRect := DragRect; +end; + +procedure TCustomToolWindow97.WMClose (var Message: TWMClose); +begin + { A floating toolbar does not use WM_CLOSE messages when its close button + is clicked, but Windows still sends a WM_CLOSE message if the user + presses Alt+F4 while one of the toolbar's controls is focused. Inherited + is not called since we do not want Windows' default processing - which + destroys the window. Instead, relay the message to the parent form. } + SendMessage (MDIParentForm.Handle, WM_CLOSE, 0, 0); + { Note to self: MDIParentForm is used instead of TForm(Owner) since MDI + childs don't process Alt+F4 as Close } +end; + +class function TCustomToolWindow97.NewMainWindowHook (var Message: TMessage): Boolean; +var + I: Integer; +begin + Result := False; + case Message.Msg of + CM_ACTIVATE, CM_DEACTIVATE: + for I := 0 to MainHookedForms.Count-1 do + { Hide or restore toolbars when application is deactivated or activated } + ShowHideFloatParents (GetMDIParent(PMainHookedFormInfo(MainHookedForms[I]).Form), + Message.Msg = CM_ACTIVATE); + WM_TB97DoneCreating: + if (Message.WParam = WM_TB97DoneCreating_Magic) and + (Message.LParam = WM_TB97DoneCreating_Magic) then + for I := DoneCreatingList.Count-1 downto 0 do begin + ShowHideFloatParents (TCustomToolWindow97(DoneCreatingList[I]).MDIParentForm, Application.Active); + DoneCreatingList.Delete (I); + end; + end; +end; + +{ TCustomToolWindow97 - property access methods } + +procedure TCustomToolWindow97.SetCloseButton (Value: Boolean); +begin + if FCloseButton <> Value then begin + FCloseButton := Value; + + { Update the close button's visibility } + DrawFloatingNCArea (0, False, True, True); + end; +end; + +procedure TCustomToolWindow97.SetDefaultDock (Value: TDock97); +begin + if FDefaultDock <> Value then begin + FDefaultDock := Value; + if Assigned(Value) then + Value.FreeNotification (Self); + end; +end; + +procedure TCustomToolWindow97.SetDockedTo (Value: TDock97); +var + OldDockedTo: TDock97; + HiddenInced: Boolean; + TempSize: TPoint; +begin + OldDockedTo := DockedTo; + + if Assigned(FOnDockChanging) and (Value <> OldDockedTo) then + FOnDockChanging (Self); + + Inc (FUpdatingBounds); + try + if Assigned(Value) then + Inc (Value.DisableArrangeToolbars); + try + { Before changing between docked and floating state (and vice-versa) + or between docks, hide the toolbar. This prevents any flashing while + it's being moved } + HiddenInced := False; + if not(csDesigning in ComponentState) and (Value <> OldDockedTo) and (Visible) then begin + Inc (FHidden); + HiddenInced := True; + if Assigned(OldDockedTo) then + { Need to disable arranging of current dock so it doesn't lose it's + FDockRow/FDockPos it's going to set later } + Inc (OldDockedTo.DisableArrangeToolbars); + try + Hide; {must Hide AFTER incing Hidden} + finally + if Assigned(OldDockedTo) then + Dec (OldDockedTo.DisableArrangeToolbars); + end; + end; + try + if Value <> nil then begin + { Must pre-arrange controls in new dock orientation before changing + the Parent } + if Parent <> nil then + CustomArrangeControls (atMoveControls, OldDockedTo, Value, TempSize); + if Parent <> Value then begin + Inc (FDisableArrangeControls); + try + Parent := Value; + finally + Dec (FDisableArrangeControls); + end; + end; + ArrangeControls; + { Temporarily put it off the edge of the parent window when changing + parents so that no momentary "flicker" occurs when it shows the + toolbar again before it gets positioned } + if Value <> OldDockedTo then + SetBounds (-Width, -Height, Width, Height); + end + else begin + { Must pre-arrange controls in new dock orientation before changing + the Parent } + if Parent <> nil then + CustomArrangeControls (atMoveControls, OldDockedTo, Value, TempSize); + Inc (FDisableArrangeControls); + try + if Parent <> FloatParent then + Parent := FloatParent; + SetBounds (FFloatingTopLeft.X, FFloatingTopLeft.Y, Width, Height); + MoveOnScreen (True); + finally + Dec (FDisableArrangeControls); + end; + ArrangeControls; + end; + finally + if HiddenInced then begin + Dec (FHidden); + Show; + end; + end; + finally + if Assigned(Value) then + Dec (Value.DisableArrangeToolbars); + end; + finally + Dec (FUpdatingBounds); + end; + if Assigned(Value) then + Value.ArrangeToolbars; + + if Assigned(FOnDockChanged) and (Value <> OldDockedTo) then + FOnDockChanged (Self); +end; + +procedure TCustomToolWindow97.SetDockPos (Value: Integer); +begin + FDockPos := Value; + if Docked then + DockedTo.ArrangeToolbars; +end; + +procedure TCustomToolWindow97.SetDockRow (Value: Integer); +begin + FDockRow := Value; + if Docked then + DockedTo.ArrangeToolbars; +end; + +procedure TCustomToolWindow97.SetDragHandle (Value: Boolean); +begin + if FDragHandle <> Value then begin + FDragHandle := Value; + if Docked and HandleAllocated then + SetWindowPos (Handle, 0, 0, 0, 0, 0, SWP_FRAMECHANGED or + SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER); + end; +end; + +procedure TCustomToolWindow97.SetFullSize (Value: Boolean); +begin + if FFullSize <> Value then begin + FFullSize := Value; + ArrangeControls; + end; +end; + +procedure TCustomToolWindow97.SetResizable (Value: Boolean); +begin + if FResizable <> Value then begin + FResizable := Value; + if not Docked then begin + { Recalculate the non-client area } + SetWindowPos (Handle, 0, 0, 0, 0, 0, SWP_FRAMECHANGED or + SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER); + { The VCL does not automatically realign child controls when the + non-client size changes, so do it manually } + Realign; + end; + end; +end; + + +{ TCustomToolbar97 } + +constructor TCustomToolbar97.Create (AOwner: TComponent); +begin + inherited; + GroupInfo := TList.Create; + SlaveInfo := TList.Create; + LineSeps := TList.Create; + OrderList := TList.Create; + { There hasn't been any child controls added yet, but call ArrangeControls + to initialize the toolbar's size } + ArrangeControls; +end; + +destructor TCustomToolbar97.Destroy; +var + I: Integer; +begin + OrderList.Free; + LineSeps.Free; + if Assigned(SlaveInfo) then begin + for I := SlaveInfo.Count-1 downto 0 do + FreeMem (SlaveInfo.Items[I]); + SlaveInfo.Free; + end; + FreeGroupInfo (GroupInfo); + GroupInfo.Free; + inherited; +end; + +procedure TCustomToolbar97.ReadPositionData (const ReadIntProc: TPositionReadIntProc; + const ReadStringProc: TPositionReadStringProc; const ExtraData: Pointer); +begin + inherited; + FFloatingRightX := ReadIntProc(Name, rvFloatRightX, 0, ExtraData); +end; + +procedure TCustomToolbar97.WritePositionData (const WriteIntProc: TPositionWriteIntProc; + const WriteStringProc: TPositionWriteStringProc; const ExtraData: Pointer); +begin + inherited; + WriteIntProc (Name, rvFloatRightX, FFloatingRightX, ExtraData); +end; + +procedure TCustomToolbar97.GetMinimumSize (var AClientWidth, AClientHeight: Integer); +begin + AClientWidth := 0; + AClientHeight := 0; +end; + +function CompareControls (const Item1, Item2, ExtraData: Pointer): Integer; far; +begin + with PCompareExtra(ExtraData)^ do + if ComparePositions then begin + if CurDockType <> dtLeftRight then + Result := TControl(Item1).Left - TControl(Item2).Left + else + Result := TControl(Item1).Top - TControl(Item2).Top; + end + else + with Toolbar.OrderList do + Result := IndexOf(Item1) - IndexOf(Item2); +end; + +procedure TCustomToolbar97.InitializeOrdering; +var + Extra: TCompareExtra; +begin + inherited; + { Initialize order of items in OrderList } + if not(csDesigning in ComponentState) then begin + with Extra do begin + Toolbar := Self; + ComparePositions := True; + CurDockType := GetDockTypeOf(DockedTo); + end; + ListSortEx (OrderList, CompareControls, @Extra); + end; +end; + +procedure TCustomToolbar97.GetBarSize (var ASize: Integer; const DockType: TDockType); +var + I: Integer; +begin + ASize := DefaultBarWidthHeight; + for I := 0 to ControlCount-1 do + if not(Controls[I] is TToolbarSep97) then + with Controls[I] do begin + if ShouldBeVisible(Controls[I], DockType = dtLeftRight, False) then begin + if DockType = dtLeftRight then begin + if Width > ASize then ASize := Width; + end + else begin + if Height > ASize then ASize := Height; + end; + end; + end; +end; + +procedure TCustomToolbar97.GetParams (var Params: TToolWindowParams); +begin + inherited; + with Params do begin + CallAlignControls := False; + ResizeEightCorner := False; + ResizeClipCursor := False; + end; +end; + +procedure TCustomToolbar97.Paint; +var + S: Integer; +begin + inherited; + { Long separators when not docked } + if not Docked then + for S := 0 to LineSeps.Count-1 do begin + with TLineSep(LineSeps[S]) do begin + if Blank then Continue; + Canvas.Pen.Color := clBtnShadow; + Canvas.MoveTo (1, Y-4); Canvas.LineTo (ClientWidth-1, Y-4); + Canvas.Pen.Color := clBtnHighlight; + Canvas.MoveTo (1, Y-3); Canvas.LineTo (ClientWidth-1, Y-3); + end; + end; +end; + +function TCustomToolbar97.ShouldBeVisible (const Control: TControl; + const LeftOrRight: Boolean; const SetIt: Boolean): Boolean; +{ If Control is a master or slave control, it returns the appropriate visibility + setting based on the value of LeftOrRight, otherwise it simply returns the + current Visible setting. If SetIt is True, it automatically adjusts the + Visible properties of both the master and slave control. } +var + I: Integer; +begin + for I := 0 to SlaveInfo.Count-1 do + with PSlaveInfo(SlaveInfo[I])^ do + if TopBottom = Control then begin + Result := not LeftOrRight; + if SetIt then begin + TopBottom.Visible := Result; + LeftRight.Visible := not Result; + end; + Exit; + end + else + if LeftRight = Control then begin + Result := LeftOrRight; + if SetIt then begin + TopBottom.Visible := not Result; + LeftRight.Visible := Result; + end; + Exit; + end; + Result := Control.Visible; +end; + +procedure TCustomToolbar97.FreeGroupInfo (const List: TList); +var + I: Integer; + L: PGroupInfo; +begin + if List = nil then Exit; + for I := List.Count-1 downto 0 do begin + L := List.Items[I]; + if Assigned(L) then begin + L^.Members.Free; + FreeMem (L); + end; + List.Delete (I); + end; +end; + +procedure TCustomToolbar97.BuildGroupInfo (const List: TList; + const TranslateSlave: Boolean; const OldDockType, NewDockType: TDockType); +var + I: Integer; + GI: PGroupInfo; + Children: TList; {items casted into TControls} + NewGroup: Boolean; + Extra: TCompareExtra; +begin + FreeGroupInfo (List); + if ControlCount = 0 then Exit; + + Children := TList.Create; + try + for I := 0 to ControlCount-1 do + if (not TranslateSlave and Controls[I].Visible) or + (TranslateSlave and ShouldBeVisible(Controls[I], NewDockType = dtLeftRight, False)) then + Children.Add (Controls[I]); + + with Extra do begin + Toolbar := Self; + CurDockType := OldDockType; + end; + if csDesigning in ComponentState then begin + Extra.ComparePositions := True; + ListSortEx (OrderList, CompareControls, @Extra); + end; + Extra.ComparePositions := csDesigning in ComponentState; + ListSortEx (Children, CompareControls, @Extra); + + GI := nil; + NewGroup := True; + for I := 0 to Children.Count-1 do begin + if NewGroup then begin + NewGroup := False; + List.Add (AllocMem(SizeOf(TGroupInfo))); + { Note: AllocMem initializes the newly allocated data to zero } + GI := List.Last; + GI^.Members := TList.Create; + end; + GI^.Members.Add (Children[I]); + if TControl(Children[I]) is TToolbarSep97 then + NewGroup := True + else begin + with TControl(Children[I]) do begin + Inc (GI^.GroupWidth, Width); + Inc (GI^.GroupHeight, Height); + end; + end; + end; + finally + Children.Free; + end; +end; + +procedure TCustomToolbar97.OrderControls (const CanMoveControls: Boolean; + const WasDockedTo, DockingTo: TDock97; var NewClientSize: TPoint); +{ This arranges the controls on the toolbar } +var + OldDockType, NewDockType: TDockType; + NewDocked: Boolean; + RightX, I: Integer; + CurBarSize, DockRowSize: Integer; + GInfo: TList; + AllowWrap: Boolean; + BarPosSize, MinPosPixels, MinRowPixels, CurPosPixel, CurLinePixel, G: Integer; + NewLine, Prec1Line: Boolean; + GI: PGroupInfo; + Member: TControl; + MemberIsSep: Boolean; + GroupPosSize, MemberPosSize: Integer; + PreviousSep: TToolbarSep97; PrevMinPosPixels: Integer; + NewLineSep: TLineSep; +label 1; +begin + OldDockType := GetDockTypeOf(WasDockedTo); + NewDockType := GetDockTypeOf(DockingTo); + NewDocked := Assigned(DockingTo); + + RightX := FFloatingRightX; + if (NewDockType <> dtNotDocked) or (RightX = 0) then + RightX := High(RightX) + else begin + { Make sure RightX isn't less than the smallest sized control + margins, + in case one of the *LoadToolbarPositions functions happened to read + a value too small. } + for I := 0 to ControlCount-1 do + if not(Controls[I] is TToolbarSep97) then + with Controls[I] do + if Width + (LeftMarginNotDocked+RightMarginNotDocked) > RightX then + RightX := Width + (LeftMarginNotDocked+RightMarginNotDocked); + end; + + if CanMoveControls then + for I := 0 to ControlCount-1 do + if not(Controls[I] is TToolbarSep97) then + ShouldBeVisible (Controls[I], NewDockType = dtLeftRight, True); + + GetBarSize (CurBarSize, NewDockType); + DockRowSize := CurBarSize; + if (DockingTo <> nil) and (DockingTo = DockedTo) then + GetDockRowSize (DockRowSize); + + if CanMoveControls then + GInfo := GroupInfo + else + GInfo := TList.Create; + try + BuildGroupInfo (GInfo, not CanMoveControls, OldDockType, NewDockType); + + if CanMoveControls then + LineSeps.Clear; + + AllowWrap := not NewDocked; + if GInfo.Count <> 0 then begin + BarPosSize := CurBarSize; + MinPosPixels := 0; + CurPosPixel := 0; + CurLinePixel := TopMargin[NewDocked]; + Prec1Line := True; NewLine := True; + PreviousSep := nil; PrevMinPosPixels := 0; + for G := 0 to GInfo.Count-1 do begin + GI := PGroupInfo(GInfo[G]); + + if NewDockType <> dtLeftRight then + GroupPosSize := GI^.GroupWidth + else + GroupPosSize := GI^.GroupHeight; + if (not AllowWrap) or (Prec1Line) then begin + if NewLine then begin + NewLine := False; + Inc (CurPosPixel, LeftMargin[NewDocked]) + end; + if CurPosPixel+GroupPosSize+RightMargin[NewDocked] > RightX then + goto 1; { I know it's sloppy to use a goto. But it's fast } + if CurPosPixel > MinPosPixels then MinPosPixels := CurPosPixel; + end + else begin + 1:CurPosPixel := LeftMargin[NewDocked]; + if CurPosPixel > MinPosPixels then MinPosPixels := CurPosPixel; + if (G <> 0) and (PGroupInfo(GInfo[G-1])^.Members.Count <> 0) then begin + Inc (CurLinePixel, BarPosSize+LineSpacing); + if Assigned(PreviousSep) then begin + MinPosPixels := PrevMinPosPixels; + if CanMoveControls then begin + PreviousSep.Width := 0; + + LongInt(NewLineSep) := 0; + NewLineSep.Y := CurLinePixel; + NewLineSep.Blank := PreviousSep.Blank; + LineSeps.Add (Pointer(NewLineSep)); + end; + end; + end; + end; + Prec1Line := True; + for I := 0 to GI^.Members.Count-1 do begin + Member := TControl(GI^.Members[I]); + MemberIsSep := Member is TToolbarSep97; + with Member do begin + if not MemberIsSep then begin + if NewDockType <> dtLeftRight then + MemberPosSize := Width + else + MemberPosSize := Height; + end + else begin + if NewDockType <> dtLeftRight then + MemberPosSize := TToolbarSep97(Member).SizeHorz + else + MemberPosSize := TToolbarSep97(Member).SizeVert; + end; + { If RightX is passed, proceed to next line } + if not MemberIsSep and + (CurPosPixel+MemberPosSize+RightMargin[NewDocked] > RightX) then begin + CurPosPixel := LeftMargin[NewDocked]; + if CurPosPixel > MinPosPixels then MinPosPixels := CurPosPixel; + Inc (CurLinePixel, CurBarSize); + Prec1Line := False; + end; + if NewDockType <> dtLeftRight then begin + if not MemberIsSep then begin + if CanMoveControls then + SetBounds (CurPosPixel, CurLinePixel+((DockRowSize-Height) div 2), Width, Height); + Inc (CurPosPixel, Width); + end + else begin + if CanMoveControls then + SetBounds (CurPosPixel, CurLinePixel, TToolbarSep97(Member).SizeHorz, DockRowSize); + Inc (CurPosPixel, TToolbarSep97(Member).SizeHorz); + end; + end + else begin + if not MemberIsSep then begin + if CanMoveControls then + SetBounds (CurLinePixel+((DockRowSize-Width) div 2), CurPosPixel, Width, Height); + Inc (CurPosPixel, Height); + end + else begin + if CanMoveControls then + SetBounds (CurLinePixel, CurPosPixel, DockRowSize, TToolbarSep97(Member).SizeVert); + Inc (CurPosPixel, TToolbarSep97(Member).SizeVert); + end; + end; + PrevMinPosPixels := MinPosPixels; + if not MemberIsSep then + PreviousSep := nil + else + PreviousSep := TToolbarSep97(Member); + if CurPosPixel > MinPosPixels then MinPosPixels := CurPosPixel; + end; + end; + end; + end + else begin + if Docked then begin + MinPosPixels := LeftMargin[NewDocked]; + CurLinePixel := TopMargin[NewDocked]; + Inc (MinPosPixels, DefaultBarWidthHeight); + BarPosSize := DockedTo.GetRowSize(FDockRow, Self); + end + else begin + MinPosPixels := LeftMargin[NewDocked] + DefaultBarWidthHeight; + CurLinePixel := TopMargin[NewDocked]; + BarPosSize := DefaultBarWidthHeight; + end; + end; + + if csDesigning in ComponentState then + Invalidate; + finally + if not CanMoveControls then begin + FreeGroupInfo (GInfo); + GInfo.Free; + end; + end; + + Inc (MinPosPixels, RightMargin[NewDocked]); + MinRowPixels := CurLinePixel + BarPosSize + BottomMargin[NewDocked]; + if NewDockType <> dtLeftRight then begin + NewClientSize.X := MinPosPixels; + NewClientSize.Y := MinRowPixels; + end + else begin + NewClientSize.X := MinRowPixels; + NewClientSize.Y := MinPosPixels; + end; +end; + +procedure TCustomToolbar97.CMControlListChange (var Message: TCMControlListChange); +{ The VCL sends this message is sent whenever a child control is inserted into + or deleted from the toolbar } +var + I: Integer; +begin + inherited; + with Message, OrderList do begin + { Delete any previous occurances of Control in OrderList. There shouldn't + be any if Inserting=True, but just to be safe, check anyway. } + while True do begin + I := IndexOf(Control); + if I = -1 then Break; + Delete (I); + end; + if Inserting then + Add (Control); + end; +end; + +function CompareNewSizes (const Item1, Item2, ExtraData: Pointer): Integer; far; +begin + { Sorts in descending order } + if ExtraData = nil then + Result := TSmallPoint(Item2).X - TSmallPoint(Item1).X + else + Result := TSmallPoint(Item2).Y - TSmallPoint(Item1).Y; +end; + +procedure TCustomToolbar97.ResizeBegin (HitTestValue: Integer); +var + CurBarSize: Integer; + + procedure BuildNewSizes (const YOrdering: Boolean); + { Adds items to the NewSizes list. The list must be empty when this is called } + function AddNCAreaToSize (const P: TPoint): TPoint; + var + R: TRect; + begin + with R do begin + Top := 0; Left := 0; + BottomRight := P; + end; + AddFloatingNCAreaToRect (R, Resizable); + OffsetRect (R, -R.Left, -R.Top); + Result := R.BottomRight; + end; + var + SaveFloatingRightX: Integer; + Max, X, LastY, SkipTo: Integer; + S: TPoint; + S2: TSmallPoint; + begin + with PToolbar97SizeData(SizeData)^ do begin + SaveFloatingRightX := FFloatingRightX; + try + FFloatingRightX := 0; + CustomArrangeControls (atNone, nil, nil, S); + S2 := PointToSmallPoint(AddNCAreaToSize(S)); + NewSizes.Add (Pointer(S2)); + LastY := S.Y; + Max := S.X; + SkipTo := High(SkipTo); + for X := Max-1 downto LeftMarginNotDocked+CurBarSize+RightMarginNotDocked do begin + if X > SkipTo then Continue; + FFloatingRightX := X; + CustomArrangeControls (atNone, nil, nil, S); + if X = S.X then begin + if S.Y = LastY then + NewSizes.Delete (NewSizes.Count-1); + S2 := PointToSmallPoint(AddNCAreaToSize(S)); + if NewSizes.IndexOf(Pointer(S2)) = -1 then + NewSizes.Add (Pointer(S2)); + LastY := S.Y; + end + else + SkipTo := S.X; + end; + finally + FFloatingRightX := SaveFloatingRightX; + end; + ListSortEx (NewSizes, CompareNewSizes, Pointer(Longint(YOrdering))); + end; + end; +const + MaxSizeSens = 12; +var + I, NewSize: Integer; + S, N: TSmallPoint; +begin + inherited; + + SizeData := AllocMem(SizeOf(TToolbar97SizeData)); + + with PToolbar97SizeData(SizeData)^ do begin + HitTest := HitTestValue; + CurRightX := FFloatingRightX; + DisableSensCheck := False; + OpSide := False; + GetBarSize (CurBarSize, dtNotDocked); + NewSizes := TList.Create; + + BuildNewSizes (HitTestValue in [HTTOP, HTBOTTOM]); + + SizeSens := MaxSizeSens; + { Adjust sensitivity if it's too high } + for I := 0 to NewSizes.Count-1 do begin + Pointer(S) := NewSizes[I]; + if (S.X = Width) and (S.Y = Height) then begin + if I > 0 then begin + Pointer(N) := NewSizes[I-1]; + if HitTestValue in [HTLEFT, HTRIGHT] then + NewSize := N.X - S.X - 1 + else + NewSize := N.Y - S.Y - 1; + if NewSize < SizeSens then SizeSens := NewSize; + end; + if I < NewSizes.Count-1 then begin + Pointer(N) := NewSizes[I+1]; + if HitTestValue in [HTLEFT, HTRIGHT] then + NewSize := S.X - N.X - 1 + else + NewSize := S.Y - N.Y - 1; + if NewSize < SizeSens then SizeSens := NewSize; + end; + Break; + end; + end; + if SizeSens < 0 then SizeSens := 0; + end; +end; + +procedure TCustomToolbar97.ResizeTrack (var Rect: TRect; const OrigRect: TRect); +var + Pos: TPoint; + NCXDiff: Integer; + NewOpSide: Boolean; + Reverse: Boolean; + I: Integer; + P: TSmallPoint; +begin + inherited; + + with PToolbar97SizeData(SizeData)^ do begin + GetCursorPos (Pos); + + NCXDiff := ClientToScreen(Point(0, 0)).X - Left; + Dec (Pos.X, Left); Dec (Pos.Y, Top); + if HitTest = HTLEFT then + Pos.X := Width-Pos.X + else + if HitTest = HTTOP then + Pos.Y := Height-Pos.Y; + + { Adjust Pos to make up for the "sizing sensitivity", as seen in Office 97 } + if HitTest in [HTLEFT, HTRIGHT] then + NewOpSide := Pos.X < Width + else + NewOpSide := Pos.Y < Height; + if (not DisableSensCheck) or (OpSide <> NewOpSide) then begin + DisableSensCheck := False; + OpSide := NewOpSide; + if HitTest in [HTLEFT, HTRIGHT] then begin + if (Pos.X >= Width-SizeSens) and (Pos.X < Width+SizeSens) then + Pos.X := Width; + end + else begin + if (Pos.Y >= Height-SizeSens) and (Pos.Y < Height+SizeSens) then + Pos.Y := Height; + end; + end; + + Rect := OrigRect; + + if HitTest in [HTLEFT, HTRIGHT] then + Reverse := Pos.X > Width + else + Reverse := Pos.Y > Height; + if not Reverse then + I := NewSizes.Count-1 + else + I := 0; + while True do begin + if (not Reverse and (I < 0)) or + (Reverse and (I >= NewSizes.Count)) then + Break; + Pointer(P) := NewSizes[I]; + if HitTest in [HTLEFT, HTRIGHT] then begin + if (not Reverse and ((I = NewSizes.Count-1) or (Pos.X >= P.X))) or + (Reverse and ((I = 0) or (Pos.X < P.X))) then begin + if I = 0 then + CurRightX := 0 + else + CurRightX := P.X - NCXDiff*2; + if HitTest = HTRIGHT then + Rect.Right := Rect.Left + P.X + else + Rect.Left := Rect.Right - P.X; + Rect.Bottom := Rect.Top + P.Y; + DisableSensCheck := not EqualRect(Rect, OrigRect); + end; + end + else begin + if (not Reverse and ((I = NewSizes.Count-1) or (Pos.Y >= P.Y))) or + (Reverse and ((I = 0) or (Pos.Y < P.Y))) then begin + if I = NewSizes.Count-1 then + CurRightX := 0 + else + CurRightX := P.X - NCXDiff*2; + if HitTest = HTBOTTOM then + Rect.Bottom := Rect.Top + P.Y + else + Rect.Top := Rect.Bottom - P.Y; + Rect.Right := Rect.Left + P.X; + DisableSensCheck := not EqualRect(Rect, OrigRect); + end; + end; + if not Reverse then + Dec (I) + else + Inc (I); + end; + end; +end; + +procedure TCustomToolbar97.ResizeEnd (Accept: Boolean); +begin + inherited; + if Assigned(SizeData) then begin + with PToolbar97SizeData(SizeData)^ do begin + if Accept then + FFloatingRightX := CurRightX; + NewSizes.Free; + end; + FreeMem (SizeData); + end; +end; + +function TCustomToolbar97.GetOrderIndex (Control: TControl): Integer; +begin + Result := OrderList.IndexOf(Control); + if Result = -1 then + raise EInvalidOperation.Create(STB97ToolbarControlNotChildOfToolbar); +end; + +procedure TCustomToolbar97.SetOrderIndex (Control: TControl; Value: Integer); +var + OldIndex: Integer; +begin + with OrderList do begin + OldIndex := IndexOf(Control); + if OldIndex = -1 then + raise EInvalidOperation.Create(STB97ToolbarControlNotChildOfToolbar); + if Value < 0 then Value := 0; + if Value >= Count then Value := Count-1; + if Value <> OldIndex then begin + Delete (OldIndex); + Insert (Value, Control); + ArrangeControls; + end; + end; +end; + +procedure TCustomToolbar97.SetSlaveControl (const ATopBottom, ALeftRight: TControl); +var + NewVersion: PSlaveInfo; +begin + GetMem (NewVersion, SizeOf(TSlaveInfo)); + with NewVersion^ do begin + TopBottom := ATopBottom; + LeftRight := ALeftRight; + end; + SlaveInfo.Add (NewVersion); + ArrangeControls; +end; + + +{ TDockableWindow - internal } + +constructor TToolWindow97.Create (AOwner: TComponent); +var + R: TRect; +begin + inherited; + FMinClientWidth := 32; + FMinClientHeight := 32; + { Initialize the client size to 32x32 } + R := GetClientRect; + SetBounds (Left, Top, Width - R.Right + 32, Height - R.Bottom + 32); +end; + +procedure TToolWindow97.CreateParams (var Params: TCreateParams); +begin + inherited; + { Disable complete redraws when size changes. CS_H/VREDRAW cause flicker + and are not necessary for this control at run time } + if not(csDesigning in ComponentState) then + with Params.WindowClass do + Style := Style and not(CS_HREDRAW or CS_VREDRAW); +end; + +procedure TToolWindow97.ReadPositionData (const ReadIntProc: TPositionReadIntProc; + const ReadStringProc: TPositionReadStringProc; const ExtraData: Pointer); +begin + inherited; + { Restore FBarWidth/FBarHeight variables } + if Resizable then begin + FBarWidth := ReadIntProc(Name, rvClientWidth, FBarWidth, ExtraData); + FBarHeight := ReadIntProc(Name, rvClientHeight, FBarHeight, ExtraData); + end; +end; + +procedure TToolWindow97.WritePositionData (const WriteIntProc: TPositionWriteIntProc; + const WriteStringProc: TPositionWriteStringProc; const ExtraData: Pointer); +begin + inherited; + { Write values of FBarWidth/FBarHeight } + WriteIntProc (Name, rvClientWidth, FBarWidth, ExtraData); + WriteIntProc (Name, rvClientHeight, FBarHeight, ExtraData); +end; + +procedure TToolWindow97.GetMinimumSize (var AClientWidth, AClientHeight: Integer); +begin + AClientWidth := FMinClientWidth; + AClientHeight := FMinClientHeight; +end; + +procedure TToolWindow97.SizeChanging (const AWidth, AHeight: Integer); +begin + FBarWidth := AWidth - (Width-ClientWidth); + FBarHeight := AHeight - (Height-ClientHeight); +end; + +procedure TToolWindow97.GetBarSize (var ASize: Integer; const DockType: TDockType); +begin + if DockType <> dtLeftRight then + ASize := FBarHeight + else + ASize := FBarWidth; +end; + +procedure TToolWindow97.OrderControls (const CanMoveControls: Boolean; + const WasDockedTo, DockingTo: TDock97; var NewClientSize: TPoint); +begin + NewClientSize.X := FBarWidth; + NewClientSize.Y := FBarHeight; +end; + + +{ TToolbarSep97 - internal } + +constructor TToolbarSep97.Create (AOwner: TComponent); +begin + inherited; + FSizeHorz := 6; + FSizeVert := 6; + ControlStyle := ControlStyle - [csOpaque, csCaptureMouse]; +end; + +procedure TToolbarSep97.SetParent (AParent: TWinControl); +begin + if (AParent <> nil) and not(AParent is TCustomToolbar97) then + raise EInvalidOperation.Create(STB97SepParentNotAllowed); + inherited; +end; + +procedure TToolbarSep97.SetBlank (Value: Boolean); +begin + if FBlank <> Value then begin + FBlank := Value; + Invalidate; + end; +end; + +procedure TToolbarSep97.SetSizeHorz (Value: TToolbarSepSize); +begin + if FSizeHorz <> Value then begin + FSizeHorz := Value; + if Parent is TCustomToolbar97 then + TCustomToolbar97(Parent).ArrangeControls; + end; +end; + +procedure TToolbarSep97.SetSizeVert (Value: TToolbarSepSize); +begin + if FSizeVert <> Value then begin + FSizeVert := Value; + if Parent is TCustomToolbar97 then + TCustomToolbar97(Parent).ArrangeControls; + end; +end; + +procedure TToolbarSep97.Paint; +var + R: TRect; + Z: Integer; +begin + inherited; + if not(Parent is TCustomToolbar97) then Exit; + + with Canvas do begin + { Draw dotted border in design mode } + if csDesigning in ComponentState then begin + Pen.Style := psDot; + Pen.Color := clBtnShadow; + Brush.Style := bsClear; + R := ClientRect; + Rectangle (R.Left, R.Top, R.Right, R.Bottom); + Pen.Style := psSolid; + end; + + if not FBlank then + if GetDockTypeOf(TCustomToolbar97(Parent).DockedTo) <> dtLeftRight then begin + Z := Width div 2; + Pen.Color := clBtnShadow; + MoveTo (Z-1, 0); LineTo (Z-1, Height); + Pen.Color := clBtnHighlight; + MoveTo (Z, 0); LineTo (Z, Height); + end + else begin + Z := Height div 2; + Pen.Color := clBtnShadow; + MoveTo (0, Z-1); LineTo (Width, Z-1); + Pen.Color := clBtnHighlight; + MoveTo (0, Z); LineTo (Width, Z); + end; + end; +end; + +procedure TToolbarSep97.MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +var + P: TPoint; +begin + inherited; + if not(Parent is TCustomToolbar97) then Exit; + + { Relay the message to the parent toolbar } + P := Parent.ScreenToClient(ClientToScreen(Point(X, Y))); + TCustomToolbar97(Parent).MouseDown (Button, Shift, P.X, P.Y); +end; + + +{ TToolbarButton97 - internal } + +type + TGlyphList = class(TImageList) + private + Used: TBits; + FCount: Integer; + function AllocateIndex: Integer; + public + constructor CreateSize (AWidth, AHeight: Integer); + destructor Destroy; override; + function Add (Image, Mask: TBitmap): Integer; + function AddMasked (Image: TBitmap; MaskColor: TColor): Integer; + procedure Delete (Index: Integer); + property Count: Integer read FCount; + end; + + TGlyphCache = class + private + GlyphLists: TList; + public + constructor Create; + destructor Destroy; override; + function GetList(AWidth, AHeight: Integer): TGlyphList; + procedure ReturnList(List: TGlyphList); + function Empty: Boolean; + end; + + TBoolInt = record + B: Boolean; + I: Integer; + end; + + TButtonGlyph = class + private + FOriginal, FOriginalMask: TBitmap; + FCallDormant: Boolean; + FGlyphList: array[Boolean] of TGlyphList; + FIndexs: array[Boolean, TButtonState97] of Integer; + FTransparentColor: TColor; + FNumGlyphs: TNumGlyphs97; + FOnChange: TNotifyEvent; + FOldDisabledStyle: Boolean; + procedure GlyphChanged (Sender: TObject); + procedure SetGlyph (Value: TBitmap); + procedure SetGlyphMask (Value: TBitmap); + procedure SetNumGlyphs (Value: TNumGlyphs97); + procedure Invalidate; + function CreateButtonGlyph (State: TButtonState97): TBoolInt; + procedure DrawButtonGlyph (Canvas: TCanvas; const GlyphPos: TPoint; + State: TButtonState97); + procedure DrawButtonText (Canvas: TCanvas; + const Caption: string; TextBounds: TRect; + WordWrap: Boolean; State: TButtonState97); + procedure CalcButtonLayout (Canvas: TCanvas; const Client: TRect; + const Offset: TPoint; DrawGlyph, DrawCaption: Boolean; + const Caption: string; WordWrap: Boolean; + Layout: TButtonLayout; Margin, Spacing: Integer; DropArrow: Boolean; + var GlyphPos, ArrowPos: TPoint; var TextBounds: TRect); + public + constructor Create; + destructor Destroy; override; + { returns the text rectangle } + function Draw (Canvas: TCanvas; const Client: TRect; const Offset: TPoint; + DrawGlyph, DrawCaption: Boolean; const Caption: string; WordWrap: Boolean; + Layout: TButtonLayout; Margin, Spacing: Integer; DropArrow: Boolean; + State: TButtonState97): TRect; + procedure DrawButtonDropArrow (Canvas: TCanvas; + const X, Y: Integer; State: TButtonState97); + property Glyph: TBitmap read FOriginal write SetGlyph; + property GlyphMask: TBitmap read FOriginalMask write SetGlyphMask; + property NumGlyphs: TNumGlyphs97 read FNumGlyphs write SetNumGlyphs; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + end; + + +{ TGlyphList } + +constructor TGlyphList.CreateSize(AWidth, AHeight: Integer); +begin + inherited CreateSize (AWidth, AHeight); + Used := TBits.Create; +end; + +destructor TGlyphList.Destroy; +begin + Used.Free; + inherited; +end; + +function TGlyphList.AllocateIndex: Integer; +begin + Result := Used.OpenBit; + if Result >= Used.Size then + begin + Result := inherited Add(nil, nil); + Used.Size := Result + 1; + end; + Used[Result] := True; +end; + +function TGlyphList.Add (Image, Mask: TBitmap): Integer; +begin + Result := AllocateIndex; + Replace (Result, Image, Mask); + Inc (FCount); +end; + +function TGlyphList.AddMasked (Image: TBitmap; MaskColor: TColor): Integer; + procedure BugfreeReplaceMasked (Index: Integer; NewImage: TBitmap; MaskColor: TColor); + procedure CheckImage (Image: TGraphic); + begin + if Image = nil then Exit; + if (Image.Height < Height) or (Image.Width < Width) then + raise EInvalidOperation.Create({$IFNDEF TB97Delphi3orHigher}LoadStr{$ENDIF}(SInvalidImageSize)); + end; + var + TempIndex: Integer; + Image, Mask: TBitmap; + begin + if HandleAllocated then begin + CheckImage(NewImage); + TempIndex := inherited AddMasked(NewImage, MaskColor); + if TempIndex <> -1 then + try + Image := TBitmap.Create; + Mask := TBitmap.Create; + try + Image.Height := Height; + Image.Width := Width; + Mask.Monochrome := True; + { ^ Prevents the "invisible glyph" problem when used with certain + color schemes. (Fixed in Delphi 3.01) } + Mask.Height := Height; + Mask.Width := Width; + ImageList_Draw (Handle, TempIndex, Image.Canvas.Handle, 0, 0, ILD_NORMAL); + ImageList_Draw (Handle, TempIndex, Mask.Canvas.Handle, 0, 0, ILD_MASK); + if not ImageList_Replace(Handle, Index, Image.Handle, Mask.Handle) then + raise EInvalidOperation.Create({$IFNDEF TB97Delphi3orHigher}LoadStr{$ENDIF}(SReplaceImage)); + finally + Image.Free; + Mask.Free; + end; + finally + inherited Delete(TempIndex); + end + else + raise EInvalidOperation.Create({$IFNDEF TB97Delphi3orHigher}LoadStr{$ENDIF}(SReplaceImage)); + end; + Change; + end; +begin + Result := AllocateIndex; + { This works two very serious bugs in the Delphi 2/BCB and Delphi 3 + implementations of the ReplaceMasked method. In the Delphi 2 and BCB + versions of the ReplaceMasked method, it incorrectly uses ILD_NORMAL as + the last parameter for the second ImageList_Draw call, in effect causing + all white colors to be considered transparent also. And in the Delphi 2/3 + and BCB versions it doesn't set Monochrome to True on the Mask bitmap, + causing the bitmaps to be invisible on certain color schemes. } + BugfreeReplaceMasked (Result, Image, MaskColor); + Inc (FCount); +end; + +procedure TGlyphList.Delete (Index: Integer); +begin + if Used[Index] then begin + Dec(FCount); + Used[Index] := False; + end; +end; + +{ TGlyphCache } + +constructor TGlyphCache.Create; +begin + inherited; + GlyphLists := TList.Create; +end; + +destructor TGlyphCache.Destroy; +begin + GlyphLists.Free; + inherited; +end; + +function TGlyphCache.GetList(AWidth, AHeight: Integer): TGlyphList; +var + I: Integer; +begin + for I := GlyphLists.Count - 1 downto 0 do begin + Result := GlyphLists[I]; + with Result do + if (AWidth = Width) and (AHeight = Height) then Exit; + end; + Result := TGlyphList.CreateSize(AWidth, AHeight); + GlyphLists.Add(Result); +end; + +procedure TGlyphCache.ReturnList(List: TGlyphList); +begin + if List = nil then Exit; + if List.Count = 0 then begin + GlyphLists.Remove(List); + List.Free; + end; +end; + +function TGlyphCache.Empty: Boolean; +begin + Result := GlyphLists.Count = 0; +end; + +var + GlyphCache: TGlyphCache = nil; + Pattern: TBitmap = nil; + PatternBtnFace, PatternBtnHighlight: TColor; + ButtonCount: Integer = 0; + +procedure CreateBrushPattern; +var + X, Y: Integer; +begin + PatternBtnFace := GetSysColor(COLOR_BTNFACE); + PatternBtnHighlight := GetSysColor(COLOR_BTNHIGHLIGHT); + Pattern := TBitmap.Create; + with Pattern do begin + Width := 8; + Height := 8; + with Canvas do begin + Brush.Style := bsSolid; + Brush.Color := clBtnFace; + FillRect (Rect(0, 0, Width, Height)); + for Y := 0 to 7 do + for X := 0 to 7 do + if Odd(Y) = Odd(X) then { toggles between even/odd pixels } + Pixels[X, Y] := clBtnHighlight; { on even/odd rows } + end; + end; +end; + + +{ TButtonGlyph } + +constructor TButtonGlyph.Create; +var + B: Boolean; + I: TButtonState97; +begin + inherited; + FCallDormant := True; + FOriginal := TBitmap.Create; + FOriginal.OnChange := GlyphChanged; + FOriginalMask := TBitmap.Create; + FOriginalMask.OnChange := GlyphChanged; + FNumGlyphs := 1; + for B := False to True do + for I := Low(I) to High(I) do + FIndexs[B, I] := -1; + if GlyphCache = nil then + GlyphCache := TGlyphCache.Create; +end; + +destructor TButtonGlyph.Destroy; +begin + FOriginalMask.Free; + FOriginal.Free; + Invalidate; + if Assigned(GlyphCache) and GlyphCache.Empty then begin + GlyphCache.Free; + GlyphCache := nil; + end; + inherited; +end; + +procedure TButtonGlyph.Invalidate; +var + B: Boolean; + I: TButtonState97; +begin + for B := False to True do begin + for I := Low(I) to High(I) do begin + if FIndexs[B, I] <> -1 then FGlyphList[B].Delete (FIndexs[B, I]); + FIndexs[B, I] := -1; + end; + GlyphCache.ReturnList (FGlyphList[B]); + FGlyphList[B] := nil; + end; +end; + +procedure TButtonGlyph.GlyphChanged (Sender: TObject); +begin + if (Sender = FOriginal) or (Sender = FOriginalMask) then begin + if (FOriginal.Width <> 0) and (FOriginal.Height <> 0) then + FTransparentColor := FOriginal.Canvas.Pixels[0, FOriginal.Height-1] or $02000000; + Invalidate; + if Assigned(FOnChange) then FOnChange (Self); + end; +end; + +procedure TButtonGlyph.SetGlyph (Value: TBitmap); +var + Glyphs: Integer; +begin + Invalidate; + FOriginal.Assign (Value); + if (Value <> nil) and (Value.Height <> 0) then begin + if Value.Width mod Value.Height = 0 then begin + Glyphs := Value.Width div Value.Height; + if Glyphs > High(TNumGlyphs97) then Glyphs := 1; + SetNumGlyphs (Glyphs); + end; + end; +end; + +procedure TButtonGlyph.SetGlyphMask (Value: TBitmap); +begin + Invalidate; + FOriginalMask.Assign (Value); +end; + +procedure TButtonGlyph.SetNumGlyphs (Value: TNumGlyphs97); +begin + Invalidate; + FNumGlyphs := Value; + GlyphChanged (Glyph); +end; + +function TButtonGlyph.CreateButtonGlyph (State: TButtonState97): TBoolInt; +const + ROP_DSPDxax = $00E20746; + ROP_PSDPxax = $00B8074A; + ROP_DSna = $00220326; { D & ~S } + + procedure GenerateMaskBitmapFromDIB (const MaskBitmap, SourceBitmap: TBitmap; + const SourceOffset, SourceSize: TPoint; TransColors: array of TColor); + { This a special procedure meant for generating monochrome masks from + >4 bpp color DIB sections. Because each video driver seems to sport its own + interpretation of how to handle DIB sections, a workaround procedure like + this was necessary. } + type + TColorArray = array[0..536870910] of TColorRef; + var + Info: packed record + Header: TBitmapInfoHeader; + Colors: array[0..1] of TColorRef; + end; + W, H: Integer; + I, Y, X: Integer; + Pixels: ^TColorArray; + Pixel: ^TColorRef; + MonoPixels: Pointer; + MonoPixel, StartMonoPixel: ^Byte; + MonoScanLineSize, CurBit: Integer; + DC: HDC; + MaskBmp: HBITMAP; + begin + W := SourceBitmap.Width; + H := SourceBitmap.Height; + MonoScanLineSize := SourceSize.X div 8; + if MonoScanLineSize mod 4 <> 0 then { Compensate for scan line boundary } + Inc (MonoScanLineSize, 4 - (MonoScanLineSize mod 4)); + MonoPixels := AllocMem(MonoScanLineSize * SourceSize.Y); { AllocMem is used because it initializes to zero } + try + GetMem (Pixels, W * H * 4); + try + FillChar (Info, SizeOf(Info), 0); + with Info do begin + with Header do begin + biSize := SizeOf(TBitmapInfoHeader); + biWidth := W; + biHeight := -H; { negative number makes it a top-down DIB } + biPlanes := 1; + biBitCount := 32; + {biCompression := BI_RGB;} { implied due to the FillChar zeroing } + end; + {Colors[0] := clBlack;} { implied due to the FillChar zeroing } + Colors[1] := clWhite; + end; + DC := CreateCompatibleDC(0); + GetDIBits (DC, SourceBitmap.Handle, 0, H, Pixels, PBitmapInfo(@Info)^, + DIB_RGB_COLORS); + DeleteDC (DC); + + for I := 0 to High(TransColors) do + if TransColors[I] = -1 then + TransColors[I] := Pixels[W * (H-1)] and $FFFFFF; + { ^ 'and' operation is necessary because the high byte is undefined } + + MonoPixel := MonoPixels; + for Y := SourceOffset.Y to SourceOffset.Y+SourceSize.Y-1 do begin + StartMonoPixel := MonoPixel; + CurBit := 7; + Pixel := @Pixels[(Y * W) + SourceOffset.X]; + for X := 0 to SourceSize.X-1 do begin + for I := 0 to High(TransColors) do + if Pixel^ and $FFFFFF = Cardinal(TransColors[I]) then begin + { ^ 'and' operation is necessary because the high byte is undefined } + MonoPixel^ := MonoPixel^ or (1 shl CurBit); + Break; + end; + Dec (CurBit); + if CurBit < 0 then begin + Inc (Integer(MonoPixel)); + CurBit := 7; + end; + Inc (Integer(Pixel), SizeOf(Longint)); { proceed to the next pixel } + end; + Integer(MonoPixel) := Integer(StartMonoPixel) + MonoScanLineSize; + end; + finally + FreeMem (Pixels); + end; + + { Write new bits into a new HBITMAP, and assign this handle to MaskBitmap } + MaskBmp := CreateBitmap(SourceSize.X, SourceSize.Y, 1, 1, nil); + with Info.Header do begin + biWidth := SourceSize.X; + biHeight := -SourceSize.Y; { negative number makes it a top-down DIB } + biPlanes := 1; + biBitCount := 1; + end; + DC := CreateCompatibleDC(0); + SetDIBits (DC, MaskBmp, 0, SourceSize.Y, MonoPixels, PBitmapInfo(@Info)^, + DIB_RGB_COLORS); + DeleteDC (DC); + finally + FreeMem (MonoPixels); + end; + + MaskBitmap.Handle := MaskBmp; + end; + procedure GenerateMaskBitmap (const MaskBitmap, SourceBitmap: TBitmap; + const SourceOffset, SourceSize: TPoint; const TransColors: array of TColor); + { Returns handle of a monochrome bitmap, with pixels in SourceBitmap of color + TransColor set to white in the resulting bitmap. All other colors of + SourceBitmap are set to black in the resulting bitmap. This uses the + regular ROP_DSPDxax BitBlt method. } + var + CanvasHandle: HDC; + SaveBkColor: TColorRef; + DC: HDC; + MaskBmp, SaveBmp: HBITMAP; + I: Integer; + const + ROP: array[Boolean] of DWORD = (SRCPAINT, SRCCOPY); + begin + CanvasHandle := SourceBitmap.Canvas.Handle; + + MaskBmp := CreateBitmap(SourceSize.X, SourceSize.Y, 1, 1, nil); + DC := CreateCompatibleDC(0); + SaveBmp := SelectObject(DC, MaskBmp); + SaveBkColor := GetBkColor(CanvasHandle); + for I := 0 to High(TransColors) do begin + SetBkColor (CanvasHandle, ColorToRGB(TransColors[I])); + BitBlt (DC, 0, 0, SourceSize.X, SourceSize.Y, CanvasHandle, + SourceOffset.X, SourceOffset.Y, ROP[I = 0]); + end; + SetBkColor (CanvasHandle, SaveBkColor); + SelectObject (DC, SaveBmp); + DeleteDC (DC); + + MaskBitmap.Handle := MaskBmp; + end; + procedure ReplaceBitmapColorsFromMask (const MaskBitmap, DestBitmap: TBitmap; + const DestOffset, DestSize: TPoint; const ReplaceColor: TColor); + var + DestDC: HDC; + SaveBrush: HBRUSH; + SaveTextColor, SaveBkColor: TColorRef; + begin + DestDC := DestBitmap.Canvas.Handle; + + SaveBrush := SelectObject(DestDC, CreateSolidBrush(ColorToRGB(ReplaceColor))); + SaveTextColor := SetTextColor(DestDC, clBlack); + SaveBkColor := SetBkColor(DestDC, clWhite); + BitBlt (DestDC, DestOffset.X, DestOffset.Y, DestSize.X, DestSize.Y, + MaskBitmap.Canvas.Handle, 0, 0, ROP_DSPDxax); + SetBkColor (DestDC, SaveBkColor); + SetTextColor (DestDC, SaveTextColor); + DeleteObject (SelectObject(DestDC, SaveBrush)); + end; + function CopyBitmapToDDB (const SourceBitmap: TBitmap): TBitmap; + { Makes a device-dependent duplicate of SourceBitmap. The color palette, + if any, is preserved. } + var + SB: HBITMAP; + SavePalette: HPALETTE; + DC: HDC; + BitmapInfo: packed record + Header: TBitmapInfoHeader; + Colors: array[0..255] of TColorRef; + end; + Bits: Pointer; + begin + Result := TBitmap.Create; + try + Result.Palette := CopyPalette(SourceBitmap.Palette); + Result.Width := SourceBitmap.Width; + Result.Height := SourceBitmap.Height; + SB := SourceBitmap.Handle; + if SB = 0 then Exit; { it would have a null handle if its width or height was zero } + SavePalette := 0; + DC := CreateCompatibleDC(0); + try + if Result.Palette <> 0 then begin + SavePalette := SelectPalette(DC, Result.Palette, False); + RealizePalette (DC); + end; + BitmapInfo.Header.biSize := SizeOf(TBitmapInfoHeader); + BitmapInfo.Header.biBitCount := 0; { instructs GetDIBits not to fill in the color table } + { First retrieve the BitmapInfo header only } + if GetDIBits(DC, SB, 0, 0, nil, PBitmapInfo(@BitmapInfo)^, DIB_RGB_COLORS) <> 0 then begin + GetMem (Bits, BitmapInfo.Header.biSizeImage); + try + { Then read the actual bits } + if GetDIBits(DC, SB, 0, SourceBitmap.Height, Bits, PBitmapInfo(@BitmapInfo)^, DIB_RGB_COLORS) <> 0 then + { And copy them to the resulting bitmap } + SetDIBits (DC, Result.Handle, 0, SourceBitmap.Height, Bits, PBitmapInfo(@BitmapInfo)^, DIB_RGB_COLORS); + finally + FreeMem (Bits); + end; + end; + finally + if SavePalette <> 0 then SelectPalette (DC, SavePalette, False); + DeleteDC (DC); + end; + except + Result.Free; + raise; + end; + end; +const + ROPs: array[Boolean] of DWORD = (ROP_PSDPxax, ROP_DSPDxax); +var + TmpImage, DDB, MonoBmp: TBitmap; + I: TButtonState97; + B: Boolean; + AddPixels, IWidth, IHeight, IWidthA, IHeightA: Integer; + IRect, IRectA, SourceRect, R: TRect; + DC: HDC; + UsesMask: Boolean; +{$IFDEF TB97Delphi3orHigher} + IsHighColorDIB: Boolean; +{$ELSE} +const + IsHighColorDIB = False; +{$ENDIF} +begin + if (State <> bsDisabled) and (Ord(State) >= NumGlyphs) then + State := bsUp; + Result.B := True; + Result.I := FIndexs[True, State]; + if Result.I = -1 then begin + Result.B := False; + Result.I := FIndexs[False, State]; + end; + if Result.I <> -1 then Exit; + if (FOriginal.Width or FOriginal.Height) = 0 then Exit; + UsesMask := (FOriginalMask.Width <> 0) and (FOriginalMask.Height <> 0); + B := State <> bsDisabled; + { + AddPixels is to make sure the highlight color on generated disabled glyphs + doesn't get cut off } + AddPixels := Ord(State = bsDisabled); + IWidth := FOriginal.Width div FNumGlyphs + AddPixels; + IHeight := FOriginal.Height + AddPixels; + IRect := Rect(0, 0, IWidth, IHeight); + IWidthA := IWidth - AddPixels; + IHeightA := IHeight - AddPixels; + IRectA := Rect(0, 0, IWidthA, IHeightA); + if FGlyphList[B] = nil then begin + if GlyphCache = nil then + GlyphCache := TGlyphCache.Create; + FGlyphList[B] := GlyphCache.GetList(IWidth, IHeight); + end; + {$IFDEF TB97Delphi3orHigher} + IsHighColorDIB := FOriginal.PixelFormat > pf4bit; + {$ENDIF} + TmpImage := TBitmap.Create; + try + TmpImage.Width := IWidth; + TmpImage.Height := IHeight; + TmpImage.Canvas.Brush.Color := clBtnFace; + TmpImage.Palette := CopyPalette(FOriginal.Palette); + I := State; + if Ord(I) >= NumGlyphs then I := bsUp; + SourceRect := Bounds(Ord(I) * IWidthA, 0, IWidthA, IHeightA); + if State <> bsDisabled then begin + TmpImage.Canvas.CopyRect (IRectA, FOriginal.Canvas, SourceRect); + if not UsesMask then begin + {$IFDEF TB97Delphi3orHigher} + { Use clDefault instead of FTransparentColor whereever possible to + ensure compatibility with all video drivers when using high-color + (> 4 bpp) DIB glyphs } + FIndexs[B, State] := FGlyphList[B].AddMasked(TmpImage, clDefault); + {$ELSE} + FIndexs[B, State] := FGlyphList[B].AddMasked(TmpImage, FTransparentColor); + {$ENDIF} + end + else begin + MonoBmp := TBitmap.Create; + try + MonoBmp.Monochrome := True; + MonoBmp.Width := IWidth; + MonoBmp.Height := IHeight; + MonoBmp.Canvas.CopyRect (IRectA, FOriginalMask.Canvas, SourceRect); + FIndexs[B, State] := FGlyphList[B].Add(TmpImage, MonoBmp); + finally + MonoBmp.Free; + end; + end; + end + else begin + MonoBmp := TBitmap.Create; + try + { Uses the CopyBitmapToDDB to work around a Delphi 3 flaw. If you copy + a DIB to a second bitmap via Assign, change the HandleType of the + second bitmap to bmDDB, then try to read the Handle property, Delphi + converts it back to a DIB. } + DDB := CopyBitmapToDDB(FOriginal); + try + if NumGlyphs > 1 then + with TmpImage.Canvas do begin + CopyRect (IRectA, DDB.Canvas, SourceRect); + + { Convert white to clBtnHighlight } + if not IsHighColorDIB then + GenerateMaskBitmap (MonoBmp, DDB, SourceRect.TopLeft, + IRectA.BottomRight, [GetNearestColor(FOriginal.Canvas.Handle, clWhite)]) + else + GenerateMaskBitmapFromDIB (MonoBmp, FOriginal, SourceRect.TopLeft, + IRectA.BottomRight, [clWhite]); + ReplaceBitmapColorsFromMask (MonoBmp, TmpImage, IRectA.TopLeft, + IRectA.BottomRight, clBtnHighlight); + + { Convert gray to clBtnShadow } + if not IsHighColorDIB then + GenerateMaskBitmap (MonoBmp, DDB, SourceRect.TopLeft, + IRectA.BottomRight, [GetNearestColor(FOriginal.Canvas.Handle, clGray)]) + else + GenerateMaskBitmapFromDIB (MonoBmp, FOriginal, SourceRect.TopLeft, + IRectA.BottomRight, [clGray]); + ReplaceBitmapColorsFromMask (MonoBmp, TmpImage, IRectA.TopLeft, + IRectA.BottomRight, clBtnShadow); + + if not UsesMask then begin + { Generate the transparent mask in MonoBmp. The reason why + it doesn't just use a mask color is because the mask needs + to be of the glyph -before- the clBtnHighlight/Shadow were + translated } + if not IsHighColorDIB then + GenerateMaskBitmap (MonoBmp, DDB, + SourceRect.TopLeft, IRectA.BottomRight, FTransparentColor) + else + GenerateMaskBitmapFromDIB (MonoBmp, FOriginal, + SourceRect.TopLeft, IRectA.BottomRight, [-1]); + end + else + MonoBmp.Canvas.CopyRect (IRectA, FOriginalMask.Canvas, SourceRect); + with MonoBmp do begin + Width := Width + AddPixels; + Height := Height + AddPixels; + { Set the additional bottom and right row on disabled glyph + masks to white so that it always shines through, since the + bottom and right row on TmpImage was left uninitialized } + Canvas.Pen.Color := clWhite; + Canvas.PolyLine ([Point(0, Height-1), Point(Width-1, Height-1), + Point(Width-1, -1)]); + end; + + FIndexs[B, State] := FGlyphList[B].Add(TmpImage, MonoBmp); + end + else begin + { Create a disabled version } + if FOldDisabledStyle then begin + { "Old" TSpeedButton style } + if not UsesMask then begin + if IsHighColorDIB then + GenerateMaskBitmapFromDIB (MonoBmp, FOriginal, + SourceRect.TopLeft, IRectA.BottomRight, [clBlack]) + else begin + with MonoBmp do begin + Assign (DDB); { must be a DDB for this to work right } + Canvas.Brush.Color := clBlack; + Monochrome := True; + end; + end; + end + else begin + MonoBmp.Assign (DDB); { must be a DDB for this to work right } + with TBitmap.Create do + try + Monochrome := True; + Width := FOriginalMask.Width; + Height := FOriginalMask.Height; + R := Rect(0, 0, Width, Height); + Canvas.CopyRect (R, FOriginalMask.Canvas, R); + DC := Canvas.Handle; + with MonoBmp.Canvas do begin + BitBlt (Handle, 0, 0, IWidthA, IHeightA, DC, + SourceRect.Left, SourceRect.Top, ROP_DSna); + BitBlt (Handle, 0, 0, IWidthA, IHeightA, DC, + SourceRect.Left, SourceRect.Top, SRCPAINT); + end; + finally + Free; + end; + MonoBmp.Canvas.Brush.Color := clBlack; + MonoBmp.Monochrome := True; + end; + end + else begin + { The new Office 97 / MFC look } + if not UsesMask then begin + with TmpImage.Canvas do begin + if not IsHighColorDIB then + GenerateMaskBitmap (MonoBmp, DDB, IRectA.TopLeft, + IRectA.BottomRight, [FTransparentColor, clWhite, clSilver]) + else + GenerateMaskBitmapFromDIB (MonoBmp, FOriginal, + SourceRect.TopLeft, IRectA.BottomRight, [-1, clWhite, clSilver]); + end; + end + else begin + { Generate the mask in MonoBmp. Make clWhite and clSilver transparent. } + if not IsHighColorDIB then + GenerateMaskBitmap (MonoBmp, DDB, SourceRect.TopLeft, + IRectA.BottomRight, [clWhite, clSilver]) + else + GenerateMaskBitmapFromDIB (MonoBmp, FOriginal, SourceRect.TopLeft, + IRectA.BottomRight, [clWhite, clSilver]); + { and all the white colors in FOriginalMask } + with TBitmap.Create do + try + Monochrome := True; + Width := FOriginalMask.Width; + Height := FOriginalMask.Height; + R := Rect(0, 0, Width, Height); + Canvas.CopyRect (R, FOriginalMask.Canvas, R); + DC := Canvas.Handle; + with MonoBmp.Canvas do begin + BitBlt (Handle, 0, 0, IWidthA, IHeightA, DC, + SourceRect.Left, SourceRect.Top, ROP_DSna); + BitBlt (Handle, 0, 0, IWidthA, IHeightA, DC, + SourceRect.Left, SourceRect.Top, SRCPAINT); + end; + finally + Free; + end; + end; + end; + + with TmpImage.Canvas do begin + Brush.Color := clBtnFace; + FillRect (IRect); + Brush.Color := clBtnHighlight; + DC := Handle; + SetTextColor (DC, clBlack); + SetBkColor (DC, clWhite); + BitBlt (DC, 1, 1, IWidthA, IHeightA, + MonoBmp.Canvas.Handle, 0, 0, ROPs[FOldDisabledStyle]); + Brush.Color := clBtnShadow; + DC := Handle; + SetTextColor (DC, clBlack); + SetBkColor (DC, clWhite); + BitBlt (DC, 0, 0, IWidthA, IHeightA, + MonoBmp.Canvas.Handle, 0, 0, ROPs[FOldDisabledStyle]); + end; + + FIndexs[B, State] := FGlyphList[B].AddMasked(TmpImage, clBtnFace); + end; + finally + DDB.Free; + end; + finally + MonoBmp.Free; + end; + end; + finally + TmpImage.Free; + end; + Result.B := B; + Result.I := FIndexs[B, State]; + { Note: Due to a bug in graphics.pas, Delphi 2's VCL crashes if Dormant is + called on an empty bitmap, so to prevent this it must check Handle first } + if {$IFNDEF TB97Delphi3orHigher} (FOriginal.Handle <> 0) and {$ENDIF} + FCallDormant then + FOriginal.Dormant; + {$IFNDEF TB97Delphi3orHigher} if FOriginalMask.Handle <> 0 then {$ENDIF} + FOriginalMask.Dormant; +end; + +procedure TButtonGlyph.DrawButtonGlyph (Canvas: TCanvas; const GlyphPos: TPoint; + State: TButtonState97); +var + Index: TBoolInt; +begin + if (FOriginal = nil) or (FOriginal.Width = 0) or (FOriginal.Height = 0) then + Exit; + Index := CreateButtonGlyph(State); + ImageList_DrawEx (FGlyphList[Index.B].Handle, Index.I, Canvas.Handle, + GlyphPos.X, GlyphPos.Y, 0, 0, CLR_NONE, CLR_NONE, ILD_TRANSPARENT); +end; + +procedure TButtonGlyph.DrawButtonText (Canvas: TCanvas; const Caption: string; + TextBounds: TRect; WordWrap: Boolean; State: TButtonState97); +var + Format: UINT; +begin + Format := DT_CENTER or DT_VCENTER; + if not WordWrap then + Format := Format or DT_SINGLELINE + else + Format := Format or DT_WORDBREAK; + with Canvas do begin + Brush.Style := bsClear; + if State = bsDisabled then begin + OffsetRect (TextBounds, 1, 1); + Font.Color := clBtnHighlight; + DrawText (Handle, PChar(Caption), Length(Caption), TextBounds, Format); + OffsetRect (TextBounds, -1, -1); + Font.Color := clBtnShadow; + DrawText (Handle, PChar(Caption), Length(Caption), TextBounds, Format); + end + else + DrawText (Handle, PChar(Caption), Length(Caption), TextBounds, Format); + end; +end; + +procedure TButtonGlyph.DrawButtonDropArrow (Canvas: TCanvas; + const X, Y: Integer; State: TButtonState97); +begin + with Canvas do begin + if State = bsDisabled then begin + Pen.Color := clBtnHighlight; + Brush.Color := clBtnHighlight; + Polygon ([Point(X+5, Y+1), Point(X+9, Y+1), Point(X+7, Y+3)]); + Pen.Color := clBtnShadow; + Brush.Color := clBtnShadow; + Polygon ([Point(X+4, Y), Point(X+8, Y), Point(X+6, Y+2)]); + end + else begin + Pen.Color := Font.Color; + Brush.Color := Font.Color; + Polygon ([Point(X+4, Y), Point(X+8, Y), Point(X+6, Y+2)]); + end; + end; +end; + +procedure TButtonGlyph.CalcButtonLayout (Canvas: TCanvas; const Client: TRect; + const Offset: TPoint; DrawGlyph, DrawCaption: Boolean; const Caption: string; + WordWrap: Boolean; Layout: TButtonLayout; Margin, Spacing: Integer; + DropArrow: Boolean; var GlyphPos, ArrowPos: TPoint; var TextBounds: TRect); +var + TextPos: TPoint; + ClientSize, GlyphSize, TextSize, ArrowSize: TPoint; + TotalSize: TPoint; + Format: UINT; + Margin1, Spacing1: Integer; + LayoutLeftOrRight: Boolean; +begin + { calculate the item sizes } + ClientSize := Point(Client.Right-Client.Left, Client.Bottom-Client.Top); + + if DrawGlyph and (FOriginal <> nil) then + GlyphSize := Point(FOriginal.Width div FNumGlyphs, FOriginal.Height) + else + GlyphSize := Point(0, 0); + + if DropArrow then + ArrowSize := Point(9, 3) + else + ArrowSize := Point(0, 0); + + LayoutLeftOrRight := Layout in [blGlyphLeft, blGlyphRight]; + if not LayoutLeftOrRight and ((GlyphSize.X = 0) or (GlyphSize.Y = 0)) then begin + Layout := blGlyphLeft; + LayoutLeftOrRight := True; + end; + + if DrawCaption and (Caption <> '') then begin + TextBounds := Rect(0, 0, Client.Right-Client.Left, 0); + if LayoutLeftOrRight then + Dec (TextBounds.Right, ArrowSize.X); + Format := DT_CALCRECT; + if WordWrap then begin + Format := Format or DT_WORDBREAK; + Margin1 := 4; + if LayoutLeftOrRight and (GlyphSize.X <> 0) and (GlyphSize.Y <> 0) then begin + if Spacing = -1 then + Spacing1 := 4 + else + Spacing1 := Spacing; + Dec (TextBounds.Right, GlyphSize.X + Spacing1); + if Margin <> -1 then + Margin1 := Margin + else + if Spacing <> -1 then + Margin1 := Spacing; + end; + Dec (TextBounds.Right, Margin1 * 2); + end; + DrawText (Canvas.Handle, PChar(Caption), Length(Caption), TextBounds, Format); + TextSize := Point(TextBounds.Right - TextBounds.Left, TextBounds.Bottom - + TextBounds.Top); + end + else begin + TextBounds := Rect(0, 0, 0, 0); + TextSize := Point(0,0); + end; + + { If the layout has the glyph on the right or the left, then both the + text and the glyph are centered vertically. If the glyph is on the top + or the bottom, then both the text and the glyph are centered horizontally.} + if LayoutLeftOrRight then begin + GlyphPos.Y := (ClientSize.Y - GlyphSize.Y + 1) div 2; + TextPos.Y := (ClientSize.Y - TextSize.Y + 1) div 2; + end + else begin + GlyphPos.X := (ClientSize.X - GlyphSize.X - ArrowSize.X + 1) div 2; + TextPos.X := (ClientSize.X - TextSize.X + 1) div 2; + if (GlyphSize.X = 0) or (GlyphSize.Y = 0) then + ArrowPos.X := TextPos.X + TextSize.X + else + ArrowPos.X := GlyphPos.X + GlyphSize.X; + end; + + { if there is no text or no bitmap, then Spacing is irrelevant } + if (TextSize.X = 0) or (TextSize.Y = 0) or + (GlyphSize.X = 0) or (GlyphSize.Y = 0) then + Spacing := 0; + + { adjust Margin and Spacing } + if Margin = -1 then begin + if Spacing = -1 then begin + TotalSize := Point(GlyphSize.X + TextSize.X + ArrowSize.X, + GlyphSize.Y + TextSize.Y); + if LayoutLeftOrRight then + Margin := (ClientSize.X - TotalSize.X) div 3 + else + Margin := (ClientSize.Y - TotalSize.Y) div 3; + Spacing := Margin; + end + else begin + TotalSize := Point(GlyphSize.X + Spacing + TextSize.X + ArrowSize.X, + GlyphSize.Y + Spacing + TextSize.Y); + if LayoutLeftOrRight then + Margin := (ClientSize.X - TotalSize.X + 1) div 2 + else + Margin := (ClientSize.Y - TotalSize.Y + 1) div 2; + end; + end + else begin + if Spacing = -1 then begin + TotalSize := Point(ClientSize.X - (Margin + GlyphSize.X + ArrowSize.X), + ClientSize.Y - (Margin + GlyphSize.Y)); + if LayoutLeftOrRight then + Spacing := (TotalSize.X - TextSize.X) div 2 + else + Spacing := (TotalSize.Y - TextSize.Y) div 2; + end; + end; + + case Layout of + blGlyphLeft: begin + GlyphPos.X := Margin; + TextPos.X := GlyphPos.X + GlyphSize.X + Spacing; + ArrowPos.X := TextPos.X + TextSize.X; + end; + blGlyphRight: begin + ArrowPos.X := ClientSize.X - Margin - ArrowSize.X; + GlyphPos.X := ArrowPos.X - GlyphSize.X; + TextPos.X := GlyphPos.X - Spacing - TextSize.X; + end; + blGlyphTop: begin + GlyphPos.Y := Margin; + TextPos.Y := GlyphPos.Y + GlyphSize.Y + Spacing; + end; + blGlyphBottom: begin + GlyphPos.Y := ClientSize.Y - Margin - GlyphSize.Y; + TextPos.Y := GlyphPos.Y - Spacing - TextSize.Y; + end; + end; + if (GlyphSize.X = 0) or (GlyphSize.Y = 0) then + ArrowPos.Y := TextPos.Y + (TextSize.Y - ArrowSize.Y) div 2 + else + ArrowPos.Y := GlyphPos.Y + (GlyphSize.Y - ArrowSize.Y) div 2; + + { fixup the result variables } + with GlyphPos do begin + Inc (X, Client.Left + Offset.X); + Inc (Y, Client.Top + Offset.Y); + end; + with ArrowPos do begin + Inc (X, Client.Left + Offset.X); + Inc (Y, Client.Top + Offset.Y); + end; + OffsetRect (TextBounds, TextPos.X + Client.Left + Offset.X, + TextPos.Y + Client.Top + Offset.X); +end; + +function TButtonGlyph.Draw (Canvas: TCanvas; const Client: TRect; + const Offset: TPoint; DrawGlyph, DrawCaption: Boolean; const Caption: string; + WordWrap: Boolean; Layout: TButtonLayout; Margin, Spacing: Integer; + DropArrow: Boolean; State: TButtonState97): TRect; +var + GlyphPos, ArrowPos: TPoint; +begin + CalcButtonLayout (Canvas, Client, Offset, DrawGlyph, DrawCaption, Caption, + WordWrap, Layout, Margin, Spacing, DropArrow, GlyphPos, ArrowPos, Result); + if DrawGlyph then + DrawButtonGlyph (Canvas, GlyphPos, State); + if DrawCaption then + DrawButtonText (Canvas, Caption, Result, WordWrap, State); + if DropArrow then + DrawButtonDropArrow (Canvas, ArrowPos.X, ArrowPos.Y, State); +end; + + +{ TDropdownList } + +type + TDropdownList = class(TComponent) + private + List: TList; + Window: HWND; + procedure WndProc (var Message: TMessage); + protected + procedure Notification (AComponent: TComponent; Operation: TOperation); override; + public + constructor Create (AOwner: TComponent); override; + destructor Destroy; override; + procedure AddMenu (Menu: TPopupMenu); + end; +var + DropdownList: TDropdownList; + +constructor TDropdownList.Create (AOwner: TComponent); +begin + inherited; + List := TList.Create; +end; + +destructor TDropdownList.Destroy; +begin + List.Free; + inherited; +end; + +procedure TDropdownList.WndProc (var Message: TMessage); +{ This procedure is based on code from TPopupList.WndProc (menus.pas) } +var + I: Integer; + MenuItem: TMenuItem; + FindKind: TFindItemKind; + ContextID: Integer; +begin + try + with List do + case Message.Msg of + WM_COMMAND: + for I := 0 to Count-1 do + if TPopupMenu(Items[I]).DispatchCommand(TWMCommand(Message).ItemID) then + Exit; + WM_INITMENUPOPUP: + for I := 0 to Count-1 do + if TPopupMenu(Items[I]).DispatchPopup(TWMInitMenuPopup(Message).MenuPopup) then + Exit; + WM_MENUSELECT: + with TWMMenuSelect(Message) do begin + FindKind := fkCommand; + if MenuFlag and MF_POPUP <> 0 then + FindKind := fkHandle; + for I := 0 to Count-1 do begin + MenuItem := TPopupMenu(Items[I]).FindItem(IDItem, FindKind); + if MenuItem <> nil then begin + Application.Hint := MenuItem.Hint; + Exit; + end; + end; + Application.Hint := ''; + end; + WM_HELP: + with TWMHelp(Message).HelpInfo^ do begin + for I := 0 to Count-1 do + if TPopupMenu(Items[I]).Handle = hItemHandle then begin + ContextID := TPopupMenu(Items[I]).GetHelpContext(iCtrlID, True); + if ContextID = 0 then + ContextID := TPopupMenu(Items[I]).GetHelpContext(hItemHandle, False); + if Screen.ActiveForm = nil then Exit; + if (biHelp in Screen.ActiveForm.BorderIcons) then + Application.HelpCommand (HELP_CONTEXTPOPUP, ContextID) + else + Application.HelpContext (ContextID); + Exit; + end; + end; + end; + with Message do + Result := DefWindowProc(Window, Msg, wParam, lParam); + except + Application.HandleException (Self); + end; +end; + +procedure TDropdownList.AddMenu (Menu: TPopupMenu); +begin + if List.IndexOf(Menu) = -1 then begin + if List.Count = 0 then + Window := AllocateHWnd(WndProc); + Menu.FreeNotification (DropdownList); + List.Add (Menu); + end; +end; + +procedure TDropdownList.Notification (AComponent: TComponent; Operation: TOperation); +begin + inherited; + if Operation = opRemove then begin + List.Remove (AComponent); + if List.Count = 0 then + DeallocateHWnd (Window); + end; +end; + + +{ TToolbarButton97 } + +constructor TToolbarButton97.Create (AOwner: TComponent); +begin + inherited; + + if not(csDesigning in ComponentState) then begin + if ButtonHookRefCount = 0 then + Application.HookMainWindow (TToolbarButton97.DeactivateHook); + Inc (ButtonHookRefCount); + FHooked := True; + end; + + SetBounds (Left, Top, 23, 22); + ControlStyle := [csCaptureMouse, csDoubleClicks, csOpaque]; + FGlyph := TButtonGlyph.Create; + TButtonGlyph(FGlyph).OnChange := GlyphChanged; + ParentFont := True; + FFlat := True; + FOpaque := True; + FSpacing := 4; + FMargin := -1; + FLayout := blGlyphLeft; + FDropdownArrow := True; + FRepeatDelay := 400; + FRepeatInterval := 100; + Inc (ButtonCount); +end; + +destructor TToolbarButton97.Destroy; +begin + if ButtonMouseInControl = Self then begin + ButtonMouseTimer.Enabled := False; + ButtonMouseInControl := nil; + end; + TButtonGlyph(FGlyph).Free; + Dec (ButtonCount); + if ButtonCount = 0 then begin + Pattern.Free; + Pattern := nil; + end; + if FHooked then begin + Dec (ButtonHookRefCount); + if ButtonHookRefCount = 0 then + Application.UnhookMainWindow (TToolbarButton97.DeactivateHook); + end; + inherited; +end; + +procedure TToolbarButton97.Paint; +const + EdgeStyles: array[Boolean, Boolean] of UINT = ( + (EDGE_RAISED, EDGE_SUNKEN), + (BDR_RAISEDINNER, BDR_SUNKENOUTER)); + FlagStyles: array[Boolean] of UINT = (BF_RECT or BF_SOFT or BF_MIDDLE, BF_RECT); +var + Bmp: TBitmap; + DrawCanvas: TCanvas; + PaintRect, R: TRect; + Offset: TPoint; +begin + if FOpaque or not FFlat then + Bmp := TBitmap.Create + else + Bmp := nil; + try + if FOpaque or not FFlat then begin + Bmp.Width := Width; + Bmp.Height := Height; + DrawCanvas := Bmp.Canvas; + with DrawCanvas do begin + Brush.Color := Self.Color; + FillRect (ClientRect); + end; + end + else + DrawCanvas := Canvas; + if not Enabled then begin + FState := bsDisabled; + FMouseIsDown := False; + end + else + if FState = bsDisabled then + if FDown and (GroupIndex <> 0) then + FState := bsExclusive + else + FState := bsUp; + DrawCanvas.Font := Self.Font; + PaintRect := Rect(0, 0, Width, Height); + + if ((not FNoBorder) and + ((not FFlat) or (FState in [bsDown, bsExclusive]) or + (FMouseInControl and (FState <> bsDisabled)))) or + (csDesigning in ComponentState) then begin + if DropdownCombo and FUsesDropdown then begin + R := PaintRect; + R.Left := R.Right - DropdownComboWidth; + Dec (R.Right, 2); + DrawEdge (DrawCanvas.Handle, R, + EdgeStyles[FFlat, (FState in [bsDown, bsExclusive]) and FMenuIsDown], + FlagStyles[FFlat]); + Dec (PaintRect.Right, DropdownComboWidth); + end; + DrawEdge (DrawCanvas.Handle, PaintRect, + EdgeStyles[FFlat, (FState in [bsDown, bsExclusive]) and (not(DropdownCombo and FUsesDropdown) or not FMenuIsDown)], + FlagStyles[FFlat]); + end + else + if DropdownCombo and FUsesDropdown then + Dec (PaintRect.Right, DropdownComboWidth); + if not FNoBorder then begin + if FFlat then + InflateRect (PaintRect, -1, -1) + else + InflateRect (PaintRect, -2, -2); + end; + + if (FState in [bsDown, bsExclusive]) and (not(DropdownCombo and FUsesDropdown) or not FMenuIsDown) then begin + if (FState = bsExclusive) and (not FFlat or not FMouseInControl) then begin + if Pattern = nil then CreateBrushPattern; + DrawCanvas.Brush.Bitmap := Pattern; + DrawCanvas.FillRect(PaintRect); + end; + Offset.X := 1; + Offset.Y := 1; + end + else begin + Offset.X := 0; + Offset.Y := 0; + end; + + TButtonGlyph(FGlyph).Draw (DrawCanvas, PaintRect, Offset, + FDisplayMode <> dmTextOnly, FDisplayMode <> dmGlyphOnly, + Caption, FWordWrap, FLayout, FMargin, FSpacing, + FDropdownArrow and not FDropdownCombo and FUsesDropdown, FState); + if FDropdownCombo and FUsesDropdown then + TButtonGlyph(FGlyph).DrawButtonDropArrow (DrawCanvas, Width-DropdownComboWidth-2, + Height div 2 - 1, FState); + + if FOpaque or not FFlat then + Canvas.Draw (0, 0, Bmp); + finally + if FOpaque or not FFlat then + Bmp.Free; + end; +end; + +procedure TToolbarButton97.UpdateTracking; +var + P: TPoint; +begin + if Enabled then begin + GetCursorPos (P); + { Use FindDragTarget instead of PtInRect since we want to check based on + the Z order } + FMouseInControl := not (FindDragTarget(P, True) = Self); + if FMouseInControl then + MouseLeft + else + MouseEntered; + end; +end; + +procedure TToolbarButton97.Loaded; +var + State: TButtonState97; +begin + inherited; + if Enabled then + State := bsUp + else + State := bsDisabled; + TButtonGlyph(FGlyph).CreateButtonGlyph (State); +end; + +procedure TToolbarButton97.Notification (AComponent: TComponent; Operation: TOperation); +begin + inherited; + if (AComponent = FDropdownMenu) and (Operation = opRemove) then + FDropdownMenu := nil; +end; + +function TToolbarButton97.PointInButton (X, Y: Integer): Boolean; +begin + Result := (X >= 0) and (X < ClientWidth-(DropdownComboWidth * Ord(FDropdownCombo and FUsesDropdown))) and + (Y >= 0) and (Y < ClientHeight); +end; + +procedure TToolbarButton97.MouseDown (Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + if not Enabled then begin + inherited; + Exit; + end; + if Button <> mbLeft then begin + MouseEntered; + inherited; + end + else begin + { We know mouse has to be over the control if the mouse went down. } + if not FMouseInControl then begin + { Doesn't call MouseEntered since the redrawing it does is unnecessary + here } + FMouseInControl := True; + if Assigned(FOnMouseEnter) then + FOnMouseEnter (Self); + end; + FMenuIsDown := FUsesDropdown and (not FDropdownCombo or (X >= Width-DropdownComboWidth)); + try + if not FDown then begin + FState := bsDown; + Redraw (True); + end + else + if FAllowAllUp then + Redraw (True); + if not FMenuIsDown then + FMouseIsDown := True; + inherited; + if FMenuIsDown then + Click + else + if FRepeating then begin + inherited Click; + if not Assigned(FRepeatTimer) then + FRepeatTimer := TTimer.Create(Self); + FRepeatTimer.Enabled := False; + FRepeatTimer.Interval := FRepeatDelay; + FRepeatTimer.OnTimer := RepeatTimerHandler; + FRepeatTimer.Enabled := True; + end; + finally + FMenuIsDown := False; + end; + end; +end; + +procedure TToolbarButton97.MouseMove (Shift: TShiftState; X, Y: Integer); + + function GetActiveForm: {$IFDEF TB97Delphi3orHigher} TCustomForm {$ELSE} TForm {$ENDIF}; + { Returns the active top-level form } + var + Ctl: TWinControl; + begin + Result := nil; + Ctl := FindControl(GetActiveWindow); + if Assigned(Ctl) then begin + Result := GetParentForm(Ctl); + if Result is TForm then + Result := GetMDIParent(TForm(Result)); + end; + end; +var + P: TPoint; + NewState: TButtonState97; + PtInButton: Boolean; +begin + inherited; + + { Check if mouse just entered the control. It works better to check this + in MouseMove rather than using CM_MOUSEENTER, since the VCL doesn't send + a CM_MOUSEENTER in all cases + Use FindDragTarget instead of PtInRect since we want to check based on + the Z order } + P := ClientToScreen(Point(X, Y)); + if (ButtonMouseInControl <> Self) and (FindDragTarget(P, True) = Self) then begin + if Assigned(ButtonMouseInControl) then + ButtonMouseInControl.MouseLeft; + { Like Office 97, only draw the active borders when the application is active } + if FShowBorderWhenInactive or Application.Active then begin + ButtonMouseInControl := Self; + ButtonMouseTimer.OnTimer := ButtonMouseTimerHandler; + ButtonMouseTimer.Enabled := True; + MouseEntered; + end; + end; + + if FMouseIsDown then begin + PtInButton := PointInButton(X, Y); + if PtInButton and Assigned(FRepeatTimer) then + FRepeatTimer.Enabled := True; + if FDown then + NewState := bsExclusive + else begin + if PtInButton then + NewState := bsDown + else + NewState := bsUp; + end; + if NewState <> FState then begin + FState := NewState; + Redraw (True); + end; + end; +end; + +procedure TToolbarButton97.RepeatTimerHandler (Sender: TObject); +var + P: TPoint; +begin + FRepeatTimer.Interval := FRepeatInterval; + GetCursorPos (P); + P := ScreenToClient(P); + if Repeating and FMouseIsDown and MouseCapture and PointInButton(P.X, P.Y) then + inherited Click + else + FRepeatTimer.Enabled := False; +end; + +procedure TToolbarButton97.WMCancelMode (var Message: TWMCancelMode); +begin + FRepeatTimer.Free; + FRepeatTimer := nil; + if FMouseIsDown then begin + FMouseIsDown := False; + if FGroupIndex <> 0 then begin + if FDown then + FState := bsExclusive; + end; + MouseLeft; + end; + { Delphi's default processing of WM_CANCELMODE sends a "fake" WM_LBUTTONUP + message to the control, so inherited must only be called after setting + FMouseIsDown to False } + inherited; +end; + +procedure TToolbarButton97.MouseUp (Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +var + DoClick: Boolean; +begin + FRepeatTimer.Free; + FRepeatTimer := nil; + { Remove active border when right button is clicked } + if (Button = mbRight) and Enabled then begin + FMouseIsDown := False; + MouseLeft; + end; + inherited; + if (Button = mbLeft) and FMouseIsDown then begin + FMouseIsDown := False; + DoClick := PointInButton(X, Y); + if FGroupIndex <> 0 then begin + if DoClick then + SetDown (not FDown) + else begin + if FDown then + FState := bsExclusive; + end; + end; + if DoClick and not FRepeating then + Click + else begin + if FState = bsDown then + FState := bsUp; + UpdateTracking; + end; + end; +end; + +procedure TToolbarButton97.Click; +const + { TPM_RIGHTBUTTON works better on Windows 3.x } + ButtonFlags: array[Boolean] of UINT = (TPM_RIGHTBUTTON, TPM_LEFTBUTTON); + AlignFlags: array[TPopupAlignment] of UINT = (TPM_LEFTALIGN, TPM_RIGHTALIGN, + TPM_CENTERALIGN); +var + SaveAlignment: TPopupAlignment; + PopupPoint: TPoint; + RepostList: TList; {pointers to TMsg's} + Msg: TMsg; + Repost: Boolean; + I: Integer; + P: TPoint; + Form: {$IFDEF TB97Delphi3orHigher} TCustomForm {$ELSE} TForm {$ENDIF}; +begin + FInClick := True; + try + if FState in [bsUp, bsMouseIn] then begin + FState := bsDown; + Redraw (True); + end; + + { Stop tracking } + MouseLeft; + if (not FUsesDropdown) or (FDropdownCombo and not FMenuIsDown) then begin + Form := GetParentForm(Self); + if Form <> nil then Form.ModalResult := ModalResult; + inherited; + end + else begin + { It must release its capture before displaying the popup menu since + this control uses csCaptureMouse. If it doesn't, the VCL seems to + get confused and think the mouse is still captured even after the + popup menu is displayed, causing mouse problems after the menu is + dismissed. } + MouseCapture := False; + try + SaveAlignment := DropdownMenu.Alignment; + try + DropdownMenu.Alignment := paLeft; + PopupPoint := Point(0, Height); + if (Parent is TCustomToolWindow97) and + (GetDockTypeOf(TCustomToolWindow97(Parent).DockedTo) = dtLeftRight) then begin + { Drop out right or left side } + if TCustomToolWindow97(Parent).DockedTo.Position = dpLeft then + PopupPoint := Point(Width, 0) + else begin + PopupPoint := Point(0, 0); + DropdownMenu.Alignment := paRight; + end; + end; + PopupPoint := ClientToScreen(PopupPoint); + with DropdownMenu do begin + PopupComponent := Self; + { Starting with version 1.54, this avoids using the Popup method + of TPopupMenu because it uses the "track right button" flag + (which disallowed the "click and drag" selecting motion many + people are accustomed to). } + if Assigned(OnPopup) then + OnPopup (DropdownMenu); + TrackPopupMenu (Handle, AlignFlags[Alignment] or ButtonFlags[NewStyleControls], + PopupPoint.X, PopupPoint.Y, 0, DropdownList.Window, nil); + end; + finally + DropdownMenu.Alignment := SaveAlignment; + end; + finally + { To prevent a mouse click from redisplaying the menu, filter all + mouse up/down messages, and repost the ones that don't need + removing. This is sort of bulky, but it's the only way I could + find that works perfectly and like Office 97. } + RepostList := TList.Create; + try + while PeekMessage(Msg, 0, WM_LBUTTONDOWN, WM_MBUTTONDBLCLK, + PM_REMOVE or PM_NOYIELD) do + { ^ The WM_LBUTTONDOWN to WM_MBUTTONDBLCLK range encompasses all + of the DOWN and DBLCLK messages for the three buttons } + with Msg do begin + Repost := True; + case Message of + WM_LBUTTONDOWN, WM_LBUTTONDBLCLK, + WM_RBUTTONDOWN, WM_RBUTTONDBLCLK, + WM_MBUTTONDOWN, WM_MBUTTONDBLCLK: begin + P := SmallPointToPoint(TSmallPoint(lParam)); + Windows.ClientToScreen (hwnd, P); + if FindDragTarget(P, True) = Self then + Repost := False; + end; + end; + if Repost then begin + RepostList.Add (AllocMem(SizeOf(TMsg))); + PMsg(RepostList.Last)^ := Msg; + end; + end; + finally + for I := 0 to RepostList.Count-1 do begin + with PMsg(RepostList[I])^ do + PostMessage (hwnd, message, wParam, lParam); + FreeMem (RepostList[I]); + end; + RepostList.Free; + end; + end; + end; + finally + FInClick := False; + if FState = bsDown then + FState := bsUp; + { Need to check if it's destroying in case the OnClick handler freed + the button. If it doesn't check this here, it can sometimes cause an + access violation } + if not(csDestroying in ComponentState) then begin + Redraw (True); + UpdateTracking; + end; + end; +end; + +function TToolbarButton97.GetPalette: HPALETTE; +begin + Result := Glyph.Palette; +end; + +function TToolbarButton97.GetGlyph: TBitmap; +begin + Result := TButtonGlyph(FGlyph).Glyph; +end; + +procedure TToolbarButton97.SetGlyph (Value: TBitmap); +begin + TButtonGlyph(FGlyph).Glyph := Value; + Redraw (True); +end; + +function TToolbarButton97.GetGlyphMask: TBitmap; +begin + Result := TButtonGlyph(FGlyph).GlyphMask; +end; + +procedure TToolbarButton97.SetGlyphMask (Value: TBitmap); +begin + TButtonGlyph(FGlyph).GlyphMask := Value; + Redraw (True); +end; + +function TToolbarButton97.GetNumGlyphs: TNumGlyphs97; +begin + Result := TButtonGlyph(FGlyph).NumGlyphs; +end; + +procedure TToolbarButton97.SetNumGlyphs (Value: TNumGlyphs97); +begin + if Value < Low(TNumGlyphs97) then + Value := Low(TNumGlyphs97) + else + if Value > High(TNumGlyphs97) then + Value := High(TNumGlyphs97); + if Value <> TButtonGlyph(FGlyph).NumGlyphs then begin + TButtonGlyph(FGlyph).NumGlyphs := Value; + Redraw (True); + end; +end; + +procedure TToolbarButton97.GlyphChanged(Sender: TObject); +begin + Redraw (True); +end; + +procedure TToolbarButton97.UpdateExclusive; +var + Msg: TMessage; +begin + if (FGroupIndex <> 0) and (Parent <> nil) then begin + Msg.Msg := CM_BUTTONPRESSED; + Msg.WParam := FGroupIndex; + Msg.LParam := Longint(Self); + Msg.Result := 0; + Parent.Broadcast (Msg); + end; +end; + +procedure TToolbarButton97.SetDown (Value: Boolean); +begin + if FGroupIndex = 0 then + Value := False; + if Value <> FDown then begin + if FDown and (not FAllowAllUp) then Exit; + FDown := Value; + if Value then + FState := bsExclusive + else + FState := bsUp; + Redraw (True); + if Value then UpdateExclusive; + end; +end; + +procedure TToolbarButton97.SetFlat (Value: Boolean); +begin + if FFlat <> Value then begin + FFlat := Value; + if FOpaque or not FFlat then + ControlStyle := ControlStyle + [csOpaque] + else + ControlStyle := ControlStyle - [csOpaque]; + Redraw (True); + end; +end; + +procedure TToolbarButton97.SetGroupIndex (Value: Integer); +begin + if FGroupIndex <> Value then begin + FGroupIndex := Value; + UpdateExclusive; + end; +end; + +procedure TToolbarButton97.SetLayout (Value: TButtonLayout); +begin + if FLayout <> Value then begin + FLayout := Value; + Redraw (True); + end; +end; + +procedure TToolbarButton97.SetMargin (Value: Integer); +begin + if (FMargin <> Value) and (Value >= -1) then begin + FMargin := Value; + Redraw (True); + end; +end; + +procedure TToolbarButton97.SetNoBorder (Value: Boolean); +begin + if FNoBorder <> Value then begin + FNoBorder := Value; + Invalidate; + end; +end; + +procedure TToolbarButton97.SetOldDisabledStyle (Value: Boolean); +begin + if FOldDisabledStyle <> Value then begin + FOldDisabledStyle := Value; + with TButtonGlyph(FGlyph) do begin + FOldDisabledStyle := Value; + Invalidate; + end; + Redraw (True); + end; +end; + +procedure TToolbarButton97.SetOpaque (Value: Boolean); +begin + if FOpaque <> Value then begin + FOpaque := Value; + if FOpaque or not FFlat then + ControlStyle := ControlStyle + [csOpaque] + else + ControlStyle := ControlStyle - [csOpaque]; + Invalidate; + end; +end; + +procedure TToolbarButton97.Redraw (const Erase: Boolean); +var + AddedOpaque: Boolean; +begin + if FOpaque or not FFlat or not Erase then begin + { Temporarily add csOpaque to the style. This prevents Invalidate from + erasing, which isn't needed when Erase is false. } + AddedOpaque := False; + if not(csOpaque in ControlStyle) then begin + AddedOpaque := True; + ControlStyle := ControlStyle + [csOpaque]; + end; + try + Invalidate; + finally + if AddedOpaque then + ControlStyle := ControlStyle - [csOpaque]; + end; + end + else + if not(FOpaque or not FFlat) then + Invalidate; +end; + +procedure TToolbarButton97.SetSpacing (Value: Integer); +begin + if Value <> FSpacing then begin + FSpacing := Value; + Redraw (True); + end; +end; + +procedure TToolbarButton97.SetAllowAllUp (Value: Boolean); +begin + if FAllowAllUp <> Value then begin + FAllowAllUp := Value; + UpdateExclusive; + end; +end; + +procedure TToolbarButton97.SetDropdownMenu (Value: TPopupMenu); +begin + if FDropdownMenu <> Value then begin + FDropdownMenu := Value; + FUsesDropdown := Assigned(Value); + if Assigned(Value) then begin + Value.FreeNotification (Self); + DropdownList.AddMenu (Value); + end; + if FDropdownArrow then + Redraw (True); + end; +end; + +procedure TToolbarButton97.SetWordWrap (Value: Boolean); +begin + if FWordWrap <> Value then begin + FWordWrap := Value; + Redraw (True); + end; +end; + +procedure TToolbarButton97.SetDropdownArrow (Value: Boolean); +begin + if FDropdownArrow <> Value then begin + FDropdownArrow := Value; + Redraw (True); + end; +end; + +procedure TToolbarButton97.SetDropdownCombo (Value: Boolean); +var + W: Integer; +begin + if FDropdownCombo <> Value then begin + FDropdownCombo := Value; + if not(csLoading in ComponentState) then begin + if Value then + Width := Width + DropdownComboWidth + else begin + W := Width - DropdownComboWidth; + if W < 1 then W := 1; + Width := W; + end; + end; + Redraw (True); + end; +end; + +procedure TToolbarButton97.SetDisplayMode (Value: TButtonDisplayMode); +begin + if FDisplayMode <> Value then begin + FDisplayMode := Value; + Redraw (True); + end; +end; + +function TToolbarButton97.GetCallDormant: Boolean; +begin + Result := TButtonGlyph(FGlyph).FCallDormant; +end; + +procedure TToolbarButton97.SetCallDormant (Value: Boolean); +begin + TButtonGlyph(FGlyph).FCallDormant := Value; +end; + +procedure TToolbarButton97.WMLButtonDblClk (var Message: TWMLButtonDblClk); +begin + inherited; + if FDown then DblClick; +end; + +procedure TToolbarButton97.CMEnabledChanged (var Message: TMessage); +const + NewState: array[Boolean] of TButtonState97 = (bsDisabled, bsUp); +begin + TButtonGlyph(FGlyph).CreateButtonGlyph (NewState[Enabled]); + UpdateTracking; + Redraw (True); +end; + +procedure TToolbarButton97.CMButtonPressed (var Message: TMessage); +var + Sender: TToolbarButton97; +begin + { UpdateExclusive broadcasts these messages } + if Message.WParam = FGroupIndex then begin + Sender := TToolbarButton97(Message.LParam); + if Sender <> Self then begin + if Sender.Down and FDown then begin + FDown := False; + FState := bsUp; + Redraw (True); + end; + FAllowAllUp := Sender.AllowAllUp; + end; + end; +end; + +procedure TToolbarButton97.CMDialogChar (var Message: TCMDialogChar); +begin + with Message do + if IsAccel(CharCode, Caption) and Enabled and Visible then begin + { NOTE: There is a bug in TSpeedButton where accelerator keys are still + processed even when the button is not visible. The 'and Visible' + corrects it, so TToolbarButton97 doesn't have this problem. } + Click; + Result := 1; + end + else + inherited; +end; + +procedure TToolbarButton97.CMFontChanged (var Message: TMessage); +begin + Redraw (True); +end; + +procedure TToolbarButton97.CMTextChanged (var Message: TMessage); +begin + Redraw (True); +end; + +procedure TToolbarButton97.CMSysColorChange (var Message: TMessage); +begin + inherited; + if Assigned(Pattern) and + ((PatternBtnFace <> TColor(GetSysColor(COLOR_BTNFACE))) or + (PatternBtnHighlight <> TColor(GetSysColor(COLOR_BTNHIGHLIGHT)))) then begin + Pattern.Free; + Pattern := nil; + end; + with TButtonGlyph(FGlyph) do begin + Invalidate; + CreateButtonGlyph (FState); + end; +end; + +procedure TToolbarButton97.MouseEntered; +begin + if Enabled and not FMouseInControl then begin + FMouseInControl := True; + if FState = bsUp then + FState := bsMouseIn; + Redraw (FDown); + if Assigned(FOnMouseEnter) then + FOnMouseEnter (Self); + end; +end; + +procedure TToolbarButton97.MouseLeft; +begin + if Enabled and FMouseInControl and not FMouseIsDown then begin + if (FState = bsMouseIn) or (not FInClick and (FState = bsDown)) then + FState := bsUp; + FMouseInControl := False; + Redraw (True); + if ButtonMouseInControl = Self then begin + ButtonMouseTimer.Enabled := False; + ButtonMouseInControl := nil; + end; + if Assigned(FOnMouseExit) then + FOnMouseExit (Self); + end; +end; + +procedure TToolbarButton97.CMMouseLeave (var Message: TMessage); +begin + inherited; + MouseLeft; +end; + +procedure TToolbarButton97.ButtonMouseTimerHandler (Sender: TObject); +var + P: TPoint; +begin + { The button mouse timer is used to periodically check if mouse has left. + Normally it receives a CM_MOUSELEAVE, but the VCL does not send a + CM_MOUSELEAVE if the mouse is moved quickly from the button to another + application's window. For some reason, this problem doesn't seem to occur + on Windows NT 4 -- only 95 and 3.x. + + The timer (which ticks 8 times a second) is only enabled when the + application is active and the mouse is over a button, so it uses virtually + no processing power. + + For something interesting to try: If you want to know just how often this + is called, try putting a Beep call in here } + + GetCursorPos (P); + if FindDragTarget(P, True) <> Self then + MouseLeft; +end; + +class function TToolbarButton97.DeactivateHook (var Message: TMessage): Boolean; +begin + Result := False; + { Hide any active border when application is deactivated } + if (Message.Msg = CM_DEACTIVATE) and Assigned(ButtonMouseInControl) and + not ButtonMouseInControl.FShowBorderWhenInactive then + ButtonMouseInControl.MouseLeft; +end; + + +{ TEdit97 - internal } + +constructor TEdit97.Create (AOwner: TComponent); +begin + inherited; + AutoSize := False; + Ctl3D := False; + BorderStyle := bsNone; + ControlStyle := ControlStyle - [csFramed]; {fixes a VCL bug with Win 3.x} + Height := 19; +end; + +procedure TEdit97.CMMouseEnter (var Message: TMessage); +begin + inherited; + MouseInControl := True; + RedrawBorder (0); +end; + +procedure TEdit97.CMMouseLeave (var Message: TMessage); +begin + inherited; + MouseInControl := False; + RedrawBorder (0); +end; + +procedure TEdit97.NewAdjustHeight; +var + DC: HDC; + SaveFont: HFONT; + Metrics: TTextMetric; +begin + DC := GetDC(0); + SaveFont := SelectObject(DC, Font.Handle); + GetTextMetrics (DC, Metrics); + SelectObject (DC, SaveFont); + ReleaseDC (0, DC); + + Height := Metrics.tmHeight + 6; +end; + +procedure TEdit97.Loaded; +begin + inherited; + if not(csDesigning in ComponentState) then + NewAdjustHeight; +end; + +procedure TEdit97.CMEnabledChanged (var Message: TMessage); +const + EnableColors: array[Boolean] of TColor = (clBtnFace, clWindow); +begin + inherited; + Color := EnableColors[Enabled]; +end; + +procedure TEdit97.CMFontChanged (var Message: TMessage); +begin + inherited; + if not((csDesigning in ComponentState) and (csLoading in ComponentState)) then + NewAdjustHeight; +end; + +procedure TEdit97.WMSetFocus (var Message: TWMSetFocus); +begin + inherited; + if not(csDesigning in ComponentState) then + RedrawBorder (0); +end; + +procedure TEdit97.WMKillFocus (var Message: TWMKillFocus); +begin + inherited; + if not(csDesigning in ComponentState) then + RedrawBorder (0); +end; + +procedure TEdit97.WMNCCalcSize (var Message: TWMNCCalcSize); +begin + inherited; + InflateRect (Message.CalcSize_Params^.rgrc[0], -3, -3); +end; + +procedure TEdit97.WMNCPaint (var Message: TMessage); +begin + inherited; + RedrawBorder (Message.WParam); +end; + +procedure TEdit97.RedrawBorder (const Clip: HRGN); +var + DC: HDC; + R: TRect; + NewClipRgn: HRGN; + BtnFaceBrush, WindowBrush: HBRUSH; +begin + DC := GetWindowDC(Handle); + try + { Use update region } + if (Clip <> 0) and (Clip <> 1) then begin + GetWindowRect (Handle, R); + if SelectClipRgn(DC, Clip) = ERROR then begin + NewClipRgn := CreateRectRgnIndirect(R); + SelectClipRgn (DC, NewClipRgn); + DeleteObject (NewClipRgn); + end; + OffsetClipRgn (DC, -R.Left, -R.Top); + end; + + { This works around WM_NCPAINT problem described at top of source code } + {no! R := Rect(0, 0, Width, Height);} + GetWindowRect (Handle, R); OffsetRect (R, -R.Left, -R.Top); + BtnFaceBrush := GetSysColorBrush(COLOR_BTNFACE); + WindowBrush := GetSysColorBrush(COLOR_WINDOW); + if ((csDesigning in ComponentState) and Enabled) or + (not(csDesigning in ComponentState) and + (Focused or (MouseInControl and not(Screen.ActiveControl is TEdit97)))) then begin + DrawEdge (DC, R, BDR_SUNKENOUTER, BF_RECT or BF_ADJUST); + with R do begin + FillRect (DC, Rect(Left, Top, Left+1, Bottom-1), BtnFaceBrush); + FillRect (DC, Rect(Left, Top, Right-1, Top+1), BtnFaceBrush); + end; + DrawEdge (DC, R, BDR_SUNKENINNER, BF_BOTTOMRIGHT); + InflateRect (R, -1, -1); + FrameRect (DC, R, WindowBrush); + end + else begin + FrameRect (DC, R, BtnFaceBrush); + InflateRect (R, -1, -1); + FrameRect (DC, R, BtnFaceBrush); + InflateRect (R, -1, -1); + FrameRect (DC, R, WindowBrush); + end; + finally + ReleaseDC (Handle, DC); + end; +end; + + +const + Sig: PChar = '- Toolbar97 version ' + Toolbar97Version + + {$IFDEF VER90} '/D2'+ {$ENDIF} {$IFDEF VER93} '/CB1'+ {$ENDIF} + {$IFDEF VER100} '/D3'+ {$ENDIF} {$IFDEF VER110} '/CB3'+ {$ENDIF} + ' by Jordan Russell -'; + +initialization + Sig := Sig; + + HookedForms := TList.Create; + MainHookedForms := TList.Create; + DoneCreatingList := TList.Create; + DropdownList := TDropdownList.Create(nil); + + ButtonMouseTimer := TTimer.Create(nil); + ButtonMouseTimer.Enabled := False; + ButtonMouseTimer.Interval := 125; { 8 times a second } +finalization + ButtonMouseTimer.Free; + DropdownList.Free; + DoneCreatingList.Free; + MainHookedForms.Free; + HookedForms.Free; +end. diff --git a/CDopping/Tb97/Tb97.OBJ b/CDopping/Tb97/Tb97.OBJ new file mode 100644 index 0000000..7cef7ad Binary files /dev/null and b/CDopping/Tb97/Tb97.OBJ differ diff --git a/CDopping/Tb97/Tb97.dcu b/CDopping/Tb97/Tb97.dcu new file mode 100644 index 0000000..afe741f Binary files /dev/null and b/CDopping/Tb97/Tb97.dcu differ diff --git a/CDopping/Tb97/Tb97.hpp b/CDopping/Tb97/Tb97.hpp new file mode 100644 index 0000000..f2ba49c --- /dev/null +++ b/CDopping/Tb97/Tb97.hpp @@ -0,0 +1,750 @@ +// Borland C++ Builder +// Copyright (c) 1995, 1998 by Borland International +// All rights reserved + +// (DO NOT EDIT: machine generated header) 'TB97.pas' rev: 3.00 + +#ifndef TB97HPP +#define TB97HPP +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +//-- user supplied ----------------------------------------------------------- + +namespace Tb97 +{ +//-- type declarations ------------------------------------------------------- +enum TDockBoundLinesValues { blTop, blBottom, blLeft, blRight }; + +typedef Set TDockBoundLines; + +enum TDockPosition { dpTop, dpBottom, dpLeft, dpRight }; + +enum TDockType { dtNotDocked, dtTopBottom, dtLeftRight }; + +typedef Set TDockableTo; + +class DELPHICLASS TCustomToolWindow97; +typedef void __fastcall (__closure *TInsertRemoveEvent)(System::TObject* Sender, bool Inserting, TCustomToolWindow97* + Bar); + +typedef void __fastcall (__closure *TRequestDockEvent)(System::TObject* Sender, TCustomToolWindow97* + Bar, bool &Accept); + +class DELPHICLASS TDock97; +class PASCALIMPLEMENTATION TDock97 : public Controls::TCustomControl +{ + typedef Controls::TCustomControl inherited; + +private: + TDockPosition FPosition; + bool FAllowDrag; + TDockBoundLines FBoundLines; + Graphics::TBitmap* FBkg; + Graphics::TBitmap* FBkgCache; + bool FBkgTransparent; + bool FBkgOnToolbars; + bool FFixAlign; + bool FLimitToOneRow; + TInsertRemoveEvent FOnInsertRemoveBar; + TRequestDockEvent FOnRequestDock; + Classes::TNotifyEvent FOnResize; + int DisableArrangeToolbars; + Classes::TList* DockList; + Classes::TList* RowSizes; + void __fastcall SetAllowDrag(bool Value); + void __fastcall SetBackground(Graphics::TBitmap* Value); + void __fastcall SetBackgroundOnToolbars(bool Value); + void __fastcall SetBackgroundTransparent(bool Value); + void __fastcall SetBoundLines(TDockBoundLines Value); + void __fastcall SetFixAlign(bool Value); + void __fastcall SetPosition(TDockPosition Value); + int __fastcall GetToolbarCount(void); + TCustomToolWindow97* __fastcall GetToolbars(int Index); + void __fastcall FreeRowInfo(void); + int __fastcall GetRowOf(const int XY, bool &Before); + int __fastcall GetDesignModeRowOf(const int XY); + int __fastcall GetHighestRow(void); + int __fastcall GetNumberOfToolbarsOnRow(const int Row, const TCustomToolWindow97* NotIncluding); + void __fastcall RemoveBlankRows(void); + void __fastcall InsertRowBefore(const int BeforeRow); + void __fastcall BuildRowInfo(void); + void __fastcall ChangeDockList(const bool Insert, const TCustomToolWindow97* Bar, const bool IsVisible + ); + void __fastcall ChangeWidthHeight(const bool IsClientWidthAndHeight, int NewWidth, int NewHeight); + void __fastcall ArrangeToolbars(void); + void __fastcall DrawBackground(const HDC DC, const Windows::TRect &IntersectClippingRect, const Windows::PRect + ExcludeClippingRect, const Windows::TRect &DrawRect); + void __fastcall InvalidateBackgrounds(void); + void __fastcall BackgroundChanged(System::TObject* Sender); + bool __fastcall UsingBackground(void); + HIDESBASE MESSAGE void __fastcall CMColorChanged(Messages::TMessage &Message); + HIDESBASE MESSAGE void __fastcall CMSysColorChange(Messages::TMessage &Message); + HIDESBASE MESSAGE void __fastcall WMMove(Messages::TWMMove &Message); + HIDESBASE MESSAGE void __fastcall WMSize(Messages::TWMSize &Message); + MESSAGE void __fastcall WMNCCalcSize(Messages::TWMNCCalcSize &Message); + MESSAGE void __fastcall WMNCPaint(Messages::TMessage &Message); + +protected: + virtual void __fastcall AlignControls(Controls::TControl* AControl, Windows::TRect &Rect); + DYNAMIC HPALETTE __fastcall GetPalette(void); + virtual void __fastcall Loaded(void); + virtual void __fastcall SetParent(Controls::TWinControl* AParent); + virtual void __fastcall Paint(void); + DYNAMIC void __fastcall VisibleChanging(void); + +public: + __fastcall virtual TDock97(Classes::TComponent* AOwner); + virtual void __fastcall CreateParams(Controls::TCreateParams &Params); + __fastcall virtual ~TDock97(void); + int __fastcall GetRowSize(const int Row, const TCustomToolWindow97* DefaultToolbar); + __property int ToolbarCount = {read=GetToolbarCount, nodefault}; + __property TCustomToolWindow97* Toolbars[int Index] = {read=GetToolbars}; + +__published: + __property bool AllowDrag = {read=FAllowDrag, write=SetAllowDrag, default=1}; + __property Graphics::TBitmap* Background = {read=FBkg, write=SetBackground}; + __property bool BackgroundOnToolbars = {read=FBkgOnToolbars, write=SetBackgroundOnToolbars, default=1 + }; + __property bool BackgroundTransparent = {read=FBkgTransparent, write=SetBackgroundTransparent, default=0 + }; + __property TDockBoundLines BoundLines = {read=FBoundLines, write=SetBoundLines, default=0}; + __property Color ; + __property bool FixAlign = {read=FFixAlign, write=SetFixAlign, default=0}; + __property bool LimitToOneRow = {read=FLimitToOneRow, write=FLimitToOneRow, default=0}; + __property PopupMenu ; + __property TDockPosition Position = {read=FPosition, write=SetPosition, default=0}; + __property TInsertRemoveEvent OnInsertRemoveBar = {read=FOnInsertRemoveBar, write=FOnInsertRemoveBar + }; + __property TRequestDockEvent OnRequestDock = {read=FOnRequestDock, write=FOnRequestDock}; + __property Classes::TNotifyEvent OnResize = {read=FOnResize, write=FOnResize}; +public: + /* TWinControl.CreateParented */ __fastcall TDock97(HWND ParentWindow) : Controls::TCustomControl(ParentWindow + ) { } + +}; + +enum TToolWindowArrangeType { atNone, atMoveControls, atMoveControlsAndResize }; + +#pragma pack(push, 1) +struct TToolWindowParams +{ + bool CallAlignControls; + bool ResizeEightCorner; + bool ResizeClipCursor; +} ; +#pragma pack(pop) + +typedef int __fastcall (*TPositionReadIntProc)(const System::AnsiString ToolbarName, const System::AnsiString + Value, const int Default, const void * ExtraData); + +typedef System::AnsiString __fastcall (*TPositionReadStringProc)(const System::AnsiString ToolbarName + , const System::AnsiString Value, const System::AnsiString Default, const void * ExtraData); + +typedef void __fastcall (*TPositionWriteIntProc)(const System::AnsiString ToolbarName, const System::AnsiString + Value, const int Data, const void * ExtraData); + +typedef void __fastcall (*TPositionWriteStringProc)(const System::AnsiString ToolbarName, const System::AnsiString + Value, const System::AnsiString Data, const void * ExtraData); + +class PASCALIMPLEMENTATION TCustomToolWindow97 : public Controls::TCustomControl +{ + typedef Controls::TCustomControl inherited; + +private: + int FDockPos; + int FDockRow; + bool FDocked; + TDock97* FDockedTo; + TDock97* FDefaultDock; + Classes::TNotifyEvent FOnClose; + Classes::TNotifyEvent FOnDockChanged; + Classes::TNotifyEvent FOnDockChanging; + Classes::TNotifyEvent FOnRecreated; + Classes::TNotifyEvent FOnRecreating; + Classes::TNotifyEvent FOnResize; + Classes::TNotifyEvent FOnVisibleChanged; + bool FActivateParent; + bool FHideWhenInactive; + bool FCloseButton; + bool FFullSize; + bool FResizable; + bool FDragHandle; + TDockableTo FDockableTo; + TToolWindowParams FParams; + int FUpdatingBounds; + int FDisableArrangeControls; + int FHidden; + bool FArrangeNeeded; + bool FInactiveCaption; + tagPOINT FFloatingTopLeft; + Controls::TWinControl* FloatParent; + Forms::TForm* MDIParentForm; + bool NotOnScreen; + bool CloseButtonDown; + void __fastcall SetCloseButton(bool Value); + void __fastcall SetDefaultDock(TDock97* Value); + void __fastcall SetDockedTo(TDock97* Value); + void __fastcall SetDockPos(int Value); + void __fastcall SetDockRow(int Value); + void __fastcall SetDragHandle(bool Value); + void __fastcall SetFullSize(bool Value); + void __fastcall SetResizable(bool Value); + void __fastcall MoveOnScreen(const bool OnlyIfFullyOffscreen); + void __fastcall CustomArrangeControls(const TToolWindowArrangeType ArrangeType, const TDock97* WasDockedTo + , const TDock97* DockingTo, tagPOINT &NewClientSize); + void __fastcall ArrangeControls(void); + void __fastcall DrawDraggingOutline(const HDC DC, const Windows::PRect NewRect, const Windows::PRect + OldRect, const bool NewDocking, const bool OldDocking); + /* class method */ static bool __fastcall NewMainWindowHook(System::TMetaClass* vmt, Messages::TMessage + &Message); + void __fastcall BeginMoving(const int InitX, const int InitY); + void __fastcall BeginSizing(const int HitTestValue, bool &Accept, Windows::TRect &NewRect); + void __fastcall DrawFloatingNCArea(const HRGN Clip, const bool RedrawBorder, const bool RedrawCaption + , const bool RedrawCloseButton); + void __fastcall DrawDockedNCArea(const HRGN Clip); + void __fastcall InvalidateDockedNCArea(void); + void __fastcall ValidateDockedNCArea(void); + void __fastcall SetNotOnScreen(const bool Value); + void __fastcall SetInactiveCaption(const bool Value); + HIDESBASE MESSAGE void __fastcall CMColorChanged(Messages::TMessage &Message); + MESSAGE void __fastcall CMTextChanged(Messages::TMessage &Message); + HIDESBASE MESSAGE void __fastcall CMShowingChanged(Messages::TMessage &Message); + HIDESBASE MESSAGE void __fastcall CMVisibleChanged(Messages::TMessage &Message); + MESSAGE void __fastcall WMActivate(Messages::TWMActivate &Message); + MESSAGE void __fastcall WMClose(Messages::TWMNoParams &Message); + MESSAGE void __fastcall WMGetMinMaxInfo(Messages::TWMGetMinMaxInfo &Message); + HIDESBASE MESSAGE void __fastcall WMMove(Messages::TWMMove &Message); + MESSAGE void __fastcall WMMouseActivate(Messages::TWMMouseActivate &Message); + MESSAGE void __fastcall WMNCCalcSize(Messages::TWMNCCalcSize &Message); + HIDESBASE MESSAGE void __fastcall WMNCHitTest(Messages::TWMNCHitTest &Message); + HIDESBASE MESSAGE void __fastcall WMNCLButtonDown(Messages::TWMNCHitMessage &Message); + MESSAGE void __fastcall WMNCPaint(Messages::TMessage &Message); + MESSAGE void __fastcall WMTB97PaintDockedNCArea(Messages::TMessage &Message); + HIDESBASE MESSAGE void __fastcall WMSize(Messages::TWMSize &Message); + +protected: + __property bool ActivateParent = {read=FActivateParent, write=FActivateParent, default=1}; + __property Color ; + __property bool CloseButton = {read=FCloseButton, write=SetCloseButton, default=1}; + __property TDock97* DefaultDock = {read=FDefaultDock, write=SetDefaultDock}; + __property TDockableTo DockableTo = {read=FDockableTo, write=FDockableTo, default=15}; + __property TDock97* DockedTo = {read=FDockedTo, write=SetDockedTo}; + __property int DockPos = {read=FDockPos, write=SetDockPos, default=-1}; + __property int DockRow = {read=FDockRow, write=SetDockRow, default=0}; + __property bool DragHandle = {read=FDragHandle, write=SetDragHandle, default=1}; + __property bool FullSize = {read=FFullSize, write=SetFullSize, default=0}; + __property bool HideWhenInactive = {read=FHideWhenInactive, write=FHideWhenInactive, default=1}; + __property TToolWindowParams Params = {read=FParams}; + __property bool Resizable = {read=FResizable, write=SetResizable, default=1}; + __property Classes::TNotifyEvent OnClose = {read=FOnClose, write=FOnClose}; + __property Classes::TNotifyEvent OnDockChanged = {read=FOnDockChanged, write=FOnDockChanged}; + __property Classes::TNotifyEvent OnDockChanging = {read=FOnDockChanging, write=FOnDockChanging}; + __property Classes::TNotifyEvent OnRecreated = {read=FOnRecreated, write=FOnRecreated}; + __property Classes::TNotifyEvent OnRecreating = {read=FOnRecreating, write=FOnRecreating}; + __property Classes::TNotifyEvent OnResize = {read=FOnResize, write=FOnResize}; + __property Classes::TNotifyEvent OnVisibleChanged = {read=FOnVisibleChanged, write=FOnVisibleChanged + }; + virtual void __fastcall AlignControls(Controls::TControl* AControl, Windows::TRect &Rect); + virtual void __fastcall CreateParams(Controls::TCreateParams &Params); + DYNAMIC HPALETTE __fastcall GetPalette(void); + virtual void __fastcall Loaded(void); + DYNAMIC void __fastcall MouseDown(Controls::TMouseButton Button, Classes::TShiftState Shift, int X, + int Y); + virtual void __fastcall Notification(Classes::TComponent* AComponent, Classes::TOperation Operation + ); + virtual void __fastcall Paint(void); + DYNAMIC bool __fastcall PaletteChanged(bool Foreground); + virtual void __fastcall SetParent(Controls::TWinControl* AParent); + DYNAMIC void __fastcall ReadPositionData(const TPositionReadIntProc ReadIntProc, const TPositionReadStringProc + ReadStringProc, const void * ExtraData); + DYNAMIC void __fastcall DoneReadingPositionData(void); + DYNAMIC void __fastcall WritePositionData(const TPositionWriteIntProc WriteIntProc, const TPositionWriteStringProc + WriteStringProc, const void * ExtraData); + DYNAMIC void __fastcall GetParams(TToolWindowParams &Params); + DYNAMIC void __fastcall ResizeBegin(int HitTestValue); + DYNAMIC void __fastcall ResizeTrack(Windows::TRect &Rect, const Windows::TRect &OrigRect); + DYNAMIC void __fastcall ResizeEnd(bool Accept); + virtual void __fastcall GetBarSize(int &ASize, const TDockType DockType) = 0; + void __fastcall GetDockRowSize(int &AHeightOrWidth); + virtual void __fastcall GetMinimumSize(int &AClientWidth, int &AClientHeight) = 0; + DYNAMIC void __fastcall InitializeOrdering(void); + virtual void __fastcall OrderControls(const bool CanMoveControls, const TDock97* WasDockedTo, const + TDock97* DockingTo, tagPOINT &NewClientSize) = 0; + virtual void __fastcall SizeChanging(const int AWidth, const int AHeight); + +public: + __property bool Docked = {read=FDocked, nodefault}; + __fastcall virtual TCustomToolWindow97(Classes::TComponent* AOwner); + __fastcall virtual ~TCustomToolWindow97(void); + virtual void __fastcall SetBounds(int ALeft, int ATop, int AWidth, int AHeight); + void __fastcall BeginUpdate(void); + void __fastcall EndUpdate(void); + +__published: + __property Height = {stored=false}; + __property Width = {stored=false}; + __property ClientHeight = {stored=true}; + __property ClientWidth = {stored=true}; +public: + /* TWinControl.CreateParented */ __fastcall TCustomToolWindow97(HWND ParentWindow) : Controls::TCustomControl( + ParentWindow) { } + +}; + +class DELPHICLASS TCustomToolbar97; +class PASCALIMPLEMENTATION TCustomToolbar97 : public Tb97::TCustomToolWindow97 +{ + typedef Tb97::TCustomToolWindow97 inherited; + +private: + int FFloatingRightX; + void *SizeData; + Classes::TList* SlaveInfo; + Classes::TList* GroupInfo; + Classes::TList* LineSeps; + Classes::TList* OrderList; + int __fastcall GetOrderIndex(Controls::TControl* Control); + void __fastcall SetOrderIndex(Controls::TControl* Control, int Value); + bool __fastcall ShouldBeVisible(const Controls::TControl* Control, const bool LeftOrRight, const bool + SetIt); + void __fastcall FreeGroupInfo(const Classes::TList* List); + void __fastcall BuildGroupInfo(const Classes::TList* List, const bool TranslateSlave, const TDockType + OldDockType, const TDockType NewDockType); + HIDESBASE MESSAGE void __fastcall CMControlListChange(Controls::TCMControlListChange &Message); + +protected: + virtual void __fastcall Paint(void); + DYNAMIC void __fastcall ReadPositionData(const TPositionReadIntProc ReadIntProc, const TPositionReadStringProc + ReadStringProc, const void * ExtraData); + DYNAMIC void __fastcall WritePositionData(const TPositionWriteIntProc WriteIntProc, const TPositionWriteStringProc + WriteStringProc, const void * ExtraData); + DYNAMIC void __fastcall GetParams(TToolWindowParams &Params); + DYNAMIC void __fastcall ResizeBegin(int HitTestValue); + DYNAMIC void __fastcall ResizeTrack(Windows::TRect &Rect, const Windows::TRect &OrigRect); + DYNAMIC void __fastcall ResizeEnd(bool Accept); + virtual void __fastcall GetBarSize(int &ASize, const TDockType DockType); + virtual void __fastcall GetMinimumSize(int &AClientWidth, int &AClientHeight); + DYNAMIC void __fastcall InitializeOrdering(void); + virtual void __fastcall OrderControls(const bool CanMoveControls, const TDock97* WasDockedTo, const + TDock97* DockingTo, tagPOINT &NewClientSize); + +public: + __property int OrderIndex[Controls::TControl* Control] = {read=GetOrderIndex, write=SetOrderIndex}; + + __fastcall virtual TCustomToolbar97(Classes::TComponent* AOwner); + __fastcall virtual ~TCustomToolbar97(void); + void __fastcall SetSlaveControl(const Controls::TControl* ATopBottom, const Controls::TControl* ALeftRight + ); + +__published: + __property ClientHeight = {stored=false}; + __property ClientWidth = {stored=false}; +public: + /* TWinControl.CreateParented */ __fastcall TCustomToolbar97(HWND ParentWindow) : Tb97::TCustomToolWindow97( + ParentWindow) { } + +}; + +class DELPHICLASS TToolbar97; +class PASCALIMPLEMENTATION TToolbar97 : public Tb97::TCustomToolbar97 +{ + typedef Tb97::TCustomToolbar97 inherited; + +__published: + __property ActivateParent ; + __property Caption ; + __property Color ; + __property CloseButton ; + __property DefaultDock ; + __property DockableTo ; + __property DockedTo ; + __property DockPos ; + __property DockRow ; + __property DragHandle ; + __property FullSize ; + __property HideWhenInactive ; + __property ParentShowHint ; + __property PopupMenu ; + __property ShowHint ; + __property TabOrder ; + __property Visible ; + __property OnClose ; + __property OnDragDrop ; + __property OnDragOver ; + __property OnRecreated ; + __property OnRecreating ; + __property OnDockChanged ; + __property OnDockChanging ; + __property OnResize ; + __property OnVisibleChanged ; +public: + /* TCustomToolbar97.Create */ __fastcall virtual TToolbar97(Classes::TComponent* AOwner) : Tb97::TCustomToolbar97( + AOwner) { } + /* TCustomToolbar97.Destroy */ __fastcall virtual ~TToolbar97(void) { } + +public: + /* TWinControl.CreateParented */ __fastcall TToolbar97(HWND ParentWindow) : Tb97::TCustomToolbar97( + ParentWindow) { } + +}; + +class DELPHICLASS TToolWindow97; +class PASCALIMPLEMENTATION TToolWindow97 : public Tb97::TCustomToolWindow97 +{ + typedef Tb97::TCustomToolWindow97 inherited; + +private: + int FMinClientWidth; + int FMinClientHeight; + int FBarHeight; + int FBarWidth; + +protected: + virtual void __fastcall CreateParams(Controls::TCreateParams &Params); + DYNAMIC void __fastcall ReadPositionData(const TPositionReadIntProc ReadIntProc, const TPositionReadStringProc + ReadStringProc, const void * ExtraData); + DYNAMIC void __fastcall WritePositionData(const TPositionWriteIntProc WriteIntProc, const TPositionWriteStringProc + WriteStringProc, const void * ExtraData); + virtual void __fastcall GetBarSize(int &ASize, const TDockType DockType); + virtual void __fastcall GetMinimumSize(int &AClientWidth, int &AClientHeight); + virtual void __fastcall OrderControls(const bool CanMoveControls, const TDock97* WasDockedTo, const + TDock97* DockingTo, tagPOINT &NewClientSize); + virtual void __fastcall SizeChanging(const int AWidth, const int AHeight); + +public: + __fastcall virtual TToolWindow97(Classes::TComponent* AOwner); + +__published: + __property ActivateParent ; + __property Caption ; + __property Color ; + __property CloseButton ; + __property DefaultDock ; + __property DockableTo ; + __property DockedTo ; + __property DockPos ; + __property DockRow ; + __property DragHandle ; + __property FullSize ; + __property HideWhenInactive ; + __property int MinClientHeight = {read=FMinClientHeight, write=FMinClientHeight, default=32}; + __property int MinClientWidth = {read=FMinClientWidth, write=FMinClientWidth, default=32}; + __property ParentShowHint ; + __property PopupMenu ; + __property Resizable ; + __property ShowHint ; + __property TabOrder ; + __property Visible ; + __property OnClose ; + __property OnDragDrop ; + __property OnDragOver ; + __property OnDockChanged ; + __property OnDockChanging ; + __property OnRecreated ; + __property OnRecreating ; + __property OnResize ; + __property OnVisibleChanged ; +public: + /* TCustomToolWindow97.Destroy */ __fastcall virtual ~TToolWindow97(void) { } + +public: + /* TWinControl.CreateParented */ __fastcall TToolWindow97(HWND ParentWindow) : Tb97::TCustomToolWindow97( + ParentWindow) { } + +}; + +typedef int TToolbarSepSize; + +class DELPHICLASS TToolbarSep97; +class PASCALIMPLEMENTATION TToolbarSep97 : public Controls::TGraphicControl +{ + typedef Controls::TGraphicControl inherited; + +private: + bool FBlank; + TToolbarSepSize FSizeHorz; + TToolbarSepSize FSizeVert; + void __fastcall SetBlank(bool Value); + void __fastcall SetSizeHorz(TToolbarSepSize Value); + void __fastcall SetSizeVert(TToolbarSepSize Value); + +protected: + DYNAMIC void __fastcall MouseDown(Controls::TMouseButton Button, Classes::TShiftState Shift, int X, + int Y); + virtual void __fastcall Paint(void); + virtual void __fastcall SetParent(Controls::TWinControl* AParent); + +public: + __fastcall virtual TToolbarSep97(Classes::TComponent* AOwner); + +__published: + __property Width = {stored=false}; + __property Height = {stored=false}; + __property bool Blank = {read=FBlank, write=SetBlank, default=0}; + __property TToolbarSepSize SizeHorz = {read=FSizeHorz, write=SetSizeHorz, default=6}; + __property TToolbarSepSize SizeVert = {read=FSizeVert, write=SetSizeVert, default=6}; +public: + /* TGraphicControl.Destroy */ __fastcall virtual ~TToolbarSep97(void) { } + +}; + +enum TButtonDisplayMode { dmBoth, dmGlyphOnly, dmTextOnly }; + +enum TButtonState97 { bsUp, bsDisabled, bsDown, bsExclusive, bsMouseIn }; + +typedef Shortint TNumGlyphs97; + +class DELPHICLASS TToolbarButton97; +class PASCALIMPLEMENTATION TToolbarButton97 : public Controls::TGraphicControl +{ + typedef Controls::TGraphicControl inherited; + +private: + bool FAllowAllUp; + TButtonDisplayMode FDisplayMode; + bool FDown; + bool FDropdownArrow; + bool FDropdownCombo; + Menus::TPopupMenu* FDropdownMenu; + bool FFlat; + void *FGlyph; + int FGroupIndex; + TButtonLayout FLayout; + int FMargin; + Forms::TModalResult FModalResult; + bool FNoBorder; + bool FOldDisabledStyle; + bool FOpaque; + bool FRepeating; + int FRepeatDelay; + int FRepeatInterval; + bool FShowBorderWhenInactive; + int FSpacing; + bool FWordWrap; + Classes::TNotifyEvent FOnMouseEnter; + Classes::TNotifyEvent FOnMouseExit; + bool FInClick; + bool FMouseInControl; + bool FMouseIsDown; + bool FMenuIsDown; + bool FHooked; + bool FUsesDropdown; + Extctrls::TTimer* FRepeatTimer; + void __fastcall GlyphChanged(System::TObject* Sender); + void __fastcall UpdateExclusive(void); + void __fastcall SetAllowAllUp(bool Value); + bool __fastcall GetCallDormant(void); + void __fastcall SetCallDormant(bool Value); + void __fastcall SetDown(bool Value); + void __fastcall SetDisplayMode(TButtonDisplayMode Value); + void __fastcall SetDropdownArrow(bool Value); + void __fastcall SetDropdownCombo(bool Value); + void __fastcall SetDropdownMenu(Menus::TPopupMenu* Value); + void __fastcall SetFlat(bool Value); + Graphics::TBitmap* __fastcall GetGlyph(void); + void __fastcall SetGlyph(Graphics::TBitmap* Value); + Graphics::TBitmap* __fastcall GetGlyphMask(void); + void __fastcall SetGlyphMask(Graphics::TBitmap* Value); + void __fastcall SetGroupIndex(int Value); + void __fastcall SetLayout(Buttons::TButtonLayout Value); + void __fastcall SetMargin(int Value); + void __fastcall SetNoBorder(bool Value); + TNumGlyphs97 __fastcall GetNumGlyphs(void); + void __fastcall SetNumGlyphs(TNumGlyphs97 Value); + void __fastcall SetOldDisabledStyle(bool Value); + void __fastcall SetOpaque(bool Value); + void __fastcall SetSpacing(int Value); + void __fastcall SetWordWrap(bool Value); + void __fastcall UpdateTracking(void); + void __fastcall Redraw(const bool Erase); + bool __fastcall PointInButton(int X, int Y); + void __fastcall ButtonMouseTimerHandler(System::TObject* Sender); + void __fastcall RepeatTimerHandler(System::TObject* Sender); + /* class method */ static bool __fastcall DeactivateHook(System::TMetaClass* vmt, Messages::TMessage + &Message); + HIDESBASE MESSAGE void __fastcall WMLButtonDblClk(Messages::TWMMouse &Message); + HIDESBASE MESSAGE void __fastcall CMEnabledChanged(Messages::TMessage &Message); + MESSAGE void __fastcall CMButtonPressed(Messages::TMessage &Message); + MESSAGE void __fastcall CMDialogChar(Messages::TWMKey &Message); + HIDESBASE MESSAGE void __fastcall CMFontChanged(Messages::TMessage &Message); + MESSAGE void __fastcall CMTextChanged(Messages::TMessage &Message); + MESSAGE void __fastcall CMSysColorChange(Messages::TMessage &Message); + HIDESBASE MESSAGE void __fastcall CMMouseLeave(Messages::TMessage &Message); + HIDESBASE MESSAGE void __fastcall WMCancelMode(Messages::TWMNoParams &Message); + +protected: + TButtonState97 FState; + DYNAMIC HPALETTE __fastcall GetPalette(void); + virtual void __fastcall Loaded(void); + virtual void __fastcall Notification(Classes::TComponent* AComponent, Classes::TOperation Operation + ); + DYNAMIC void __fastcall MouseDown(Controls::TMouseButton Button, Classes::TShiftState Shift, int X, + int Y); + DYNAMIC void __fastcall MouseMove(Classes::TShiftState Shift, int X, int Y); + DYNAMIC void __fastcall MouseUp(Controls::TMouseButton Button, Classes::TShiftState Shift, int X, int + Y); + virtual void __fastcall Paint(void); + +public: + __property bool CallDormant = {read=GetCallDormant, write=SetCallDormant, nodefault}; + __fastcall virtual TToolbarButton97(Classes::TComponent* AOwner); + __fastcall virtual ~TToolbarButton97(void); + DYNAMIC void __fastcall Click(void); + void __fastcall MouseEntered(void); + void __fastcall MouseLeft(void); + +__published: + __property bool AllowAllUp = {read=FAllowAllUp, write=SetAllowAllUp, default=0}; + __property int GroupIndex = {read=FGroupIndex, write=SetGroupIndex, default=0}; + __property TButtonDisplayMode DisplayMode = {read=FDisplayMode, write=SetDisplayMode, default=0}; + __property bool Down = {read=FDown, write=SetDown, default=0}; + __property DragCursor ; + __property DragMode ; + __property bool DropdownArrow = {read=FDropdownArrow, write=SetDropdownArrow, default=1}; + __property bool DropdownCombo = {read=FDropdownCombo, write=SetDropdownCombo, default=0}; + __property Menus::TPopupMenu* DropdownMenu = {read=FDropdownMenu, write=SetDropdownMenu}; + __property Caption ; + __property Enabled ; + __property bool Flat = {read=FFlat, write=SetFlat, default=1}; + __property Font ; + __property Graphics::TBitmap* Glyph = {read=GetGlyph, write=SetGlyph}; + __property Graphics::TBitmap* GlyphMask = {read=GetGlyphMask, write=SetGlyphMask}; + __property Buttons::TButtonLayout Layout = {read=FLayout, write=SetLayout, default=0}; + __property int Margin = {read=FMargin, write=SetMargin, default=-1}; + __property Forms::TModalResult ModalResult = {read=FModalResult, write=FModalResult, default=0}; + __property bool NoBorder = {read=FNoBorder, write=SetNoBorder, default=0}; + __property TNumGlyphs97 NumGlyphs = {read=GetNumGlyphs, write=SetNumGlyphs, default=1}; + __property bool OldDisabledStyle = {read=FOldDisabledStyle, write=SetOldDisabledStyle, default=0}; + __property bool Opaque = {read=FOpaque, write=SetOpaque, default=1}; + __property ParentFont ; + __property ParentShowHint ; + __property bool Repeating = {read=FRepeating, write=FRepeating, default=0}; + __property int RepeatDelay = {read=FRepeatDelay, write=FRepeatDelay, default=400}; + __property int RepeatInterval = {read=FRepeatInterval, write=FRepeatInterval, default=100}; + __property bool ShowBorderWhenInactive = {read=FShowBorderWhenInactive, write=FShowBorderWhenInactive + , default=0}; + __property ShowHint ; + __property int Spacing = {read=FSpacing, write=SetSpacing, default=4}; + __property Visible ; + __property bool WordWrap = {read=FWordWrap, write=SetWordWrap, default=0}; + __property OnClick ; + __property OnDblClick ; + __property OnDragDrop ; + __property OnDragOver ; + __property OnEndDrag ; + __property OnMouseDown ; + __property Classes::TNotifyEvent OnMouseEnter = {read=FOnMouseEnter, write=FOnMouseEnter}; + __property Classes::TNotifyEvent OnMouseExit = {read=FOnMouseExit, write=FOnMouseExit}; + __property OnMouseMove ; + __property OnMouseUp ; + __property OnStartDrag ; +}; + +class DELPHICLASS TEdit97; +class PASCALIMPLEMENTATION TEdit97 : public Stdctrls::TCustomEdit +{ + typedef Stdctrls::TCustomEdit inherited; + +private: + bool MouseInControl; + void __fastcall RedrawBorder(const HRGN Clip); + void __fastcall NewAdjustHeight(void); + HIDESBASE MESSAGE void __fastcall CMEnabledChanged(Messages::TMessage &Message); + HIDESBASE MESSAGE void __fastcall CMFontChanged(Messages::TMessage &Message); + HIDESBASE MESSAGE void __fastcall CMMouseEnter(Messages::TMessage &Message); + HIDESBASE MESSAGE void __fastcall CMMouseLeave(Messages::TMessage &Message); + HIDESBASE MESSAGE void __fastcall WMSetFocus(Messages::TWMSetFocus &Message); + HIDESBASE MESSAGE void __fastcall WMKillFocus(Messages::TWMKillFocus &Message); + MESSAGE void __fastcall WMNCCalcSize(Messages::TWMNCCalcSize &Message); + MESSAGE void __fastcall WMNCPaint(Messages::TMessage &Message); + +protected: + virtual void __fastcall Loaded(void); + +public: + __fastcall virtual TEdit97(Classes::TComponent* AOwner); + +__published: + __property CharCase ; + __property DragCursor ; + __property DragMode ; + __property Enabled ; + __property Font ; + __property HideSelection ; + __property ImeMode ; + __property ImeName ; + __property MaxLength ; + __property OEMConvert ; + __property ParentColor ; + __property ParentCtl3D ; + __property ParentFont ; + __property ParentShowHint ; + __property PasswordChar ; + __property PopupMenu ; + __property ReadOnly ; + __property ShowHint ; + __property TabOrder ; + __property TabStop ; + __property Text ; + __property Visible ; + __property OnChange ; + __property OnClick ; + __property OnDblClick ; + __property OnDragDrop ; + __property OnDragOver ; + __property OnEndDrag ; + __property OnEnter ; + __property OnExit ; + __property OnKeyDown ; + __property OnKeyPress ; + __property OnKeyUp ; + __property OnMouseDown ; + __property OnMouseMove ; + __property OnMouseUp ; + __property OnStartDrag ; +public: + /* TWinControl.CreateParented */ __fastcall TEdit97(HWND ParentWindow) : Stdctrls::TCustomEdit(ParentWindow + ) { } + /* TWinControl.Destroy */ __fastcall virtual ~TEdit97(void) { } + +}; + +//-- var, const, procedure --------------------------------------------------- +#define Toolbar97Version "1.63" +#define WM_TB97DoneCreating (Word)(6062) +#define WM_TB97DoneCreating_Magic (int)(1940230388) +#define WM_TB97PaintDockedNCArea (Word)(6063) +extern PACKAGE TToolbarButton97* ButtonMouseInControl; +extern PACKAGE void __fastcall Register(void); +extern PACKAGE void __fastcall AddFloatingNCAreaToRect(Windows::TRect &R, const bool Resizable); +extern PACKAGE TDockType __fastcall GetDockTypeOf(const TDock97* Control); +extern PACKAGE void __fastcall CustomLoadToolbarPositions(const Forms::TForm* Form, const TPositionReadIntProc + ReadIntProc, const TPositionReadStringProc ReadStringProc, const void * ExtraData); +extern PACKAGE void __fastcall CustomSaveToolbarPositions(const Forms::TForm* Form, const TPositionWriteIntProc + WriteIntProc, const TPositionWriteStringProc WriteStringProc, const void * ExtraData); +extern PACKAGE void __fastcall IniLoadToolbarPositions(const Forms::TForm* Form, const System::AnsiString + Filename); +extern PACKAGE void __fastcall IniSaveToolbarPositions(const Forms::TForm* Form, const System::AnsiString + Filename); +extern PACKAGE void __fastcall RegLoadToolbarPositions(const Forms::TForm* Form, const System::AnsiString + BaseRegistryKey); +extern PACKAGE void __fastcall RegSaveToolbarPositions(const Forms::TForm* Form, const System::AnsiString + BaseRegistryKey); + +} /* namespace Tb97 */ +#if !defined(NO_IMPLICIT_NAMESPACE_USE) +using namespace Tb97; +#endif +//-- end unit ---------------------------------------------------------------- +#endif // TB97 diff --git a/CDopping/elastfrm.hpp b/CDopping/elastfrm.hpp new file mode 100644 index 0000000..b18aa51 --- /dev/null +++ b/CDopping/elastfrm.hpp @@ -0,0 +1,272 @@ +// Borland C++ Builder +// Copyright (c) 1995, 1998 by Borland International +// All rights reserved + +// (DO NOT EDIT: machine generated header) 'ElastFrm.pas' rev: 3.00 + +#ifndef ElastFrmHPP +#define ElastFrmHPP +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +//-- user supplied ----------------------------------------------------------- + +namespace Elastfrm +{ +//-- type declarations ------------------------------------------------------- +typedef int TArrayInteger[16383]; + +typedef TArrayInteger *pTArrayInteger; + +class DELPHICLASS TFrame; +class PASCALIMPLEMENTATION TFrame : public System::TObject +{ + typedef System::TObject inherited; + +public: + int left; + int width; + int top; + int height; + Graphics::TFont* font; + double fXResize; + double fYResize; + double fFResize; + bool bStatusBar; + TArrayInteger *ColumnWidths; + int ColumnWidthsMax; + TArrayInteger *PanelWidths; + int PanelWidthsMax; + int InitFontSize; + int InitTitleFontSize; + int FontSizeBeforeMax; + int DefaultRowHeight; + int ButtonHeight; + int ButtonWidth; + float BtnAspect; + __fastcall TFrame(void); + __fastcall virtual ~TFrame(void); + void __fastcall preInitialize(Controls::TControl* aControl); + void __fastcall DBGridInitialize(Controls::TControl* aControl, double ScreenCorrectionH, double ScreenCorrectionV + ); + void __fastcall initialize(double ScreenCorrectionH, double ScreenCorrectionV, double PixelsCorrection + , double PurePixelsCorrection, Controls::TControl* aControl); + void __fastcall resize(bool ElasticH, bool ElasticV, bool ElasticF, int FormClientWidth, int FormClientHeight + , int cW, int cH, int cF, double FontCorrection, double ScreenCorrectionH, double ScreenCorrectionV + , double PixelsCorrection, Controls::TControl* aControl); +}; + +typedef TFrame* TFrameArray[16383]; + +typedef TFrameArray *pTFrameArray; + +class DELPHICLASS TMyControl; +class PASCALIMPLEMENTATION TMyControl : public Controls::TControl +{ + typedef Controls::TControl inherited; + +public: + /* TControl.Create */ __fastcall virtual TMyControl(Classes::TComponent* AOwner) : Controls::TControl( + AOwner) { } + /* TControl.Destroy */ __fastcall virtual ~TMyControl(void) { } + +}; + +class DELPHICLASS TMyWinControl; +class PASCALIMPLEMENTATION TMyWinControl : public Controls::TWinControl +{ + typedef Controls::TWinControl inherited; + +public: + /* TWinControl.Create */ __fastcall virtual TMyWinControl(Classes::TComponent* AOwner) : Controls:: + TWinControl(AOwner) { } + /* TWinControl.CreateParented */ __fastcall TMyWinControl(HWND ParentWindow) : Controls::TWinControl( + ParentWindow) { } + /* TWinControl.Destroy */ __fastcall virtual ~TMyWinControl(void) { } + +}; + +class DELPHICLASS TMyCustomGrid; +class PASCALIMPLEMENTATION TMyCustomGrid : public Grids::TCustomGrid +{ + typedef Grids::TCustomGrid inherited; + +public: + /* TCustomGrid.Create */ __fastcall virtual TMyCustomGrid(Classes::TComponent* AOwner) : Grids::TCustomGrid( + AOwner) { } + /* TCustomGrid.Destroy */ __fastcall virtual ~TMyCustomGrid(void) { } + +public: + /* TWinControl.CreateParented */ __fastcall TMyCustomGrid(HWND ParentWindow) : Grids::TCustomGrid(ParentWindow + ) { } + +}; + +class DELPHICLASS TElasticForm; +class PASCALIMPLEMENTATION TElasticForm : public Classes::TComponent +{ + typedef Classes::TComponent inherited; + +private: + void *OldWndProc; + void *NewWndProc; + void *OldMDIClientWndProc; + void *NewMDIClientWndProc; + bool FHorz; + bool FVert; + bool FElasticFont; + int fResizeCounter; + int cW; + int cH; + int cF; + int cWc; + int cHc; + int cW0; + int cH0; + int cF0; + int L0; + int T0; + bool bFirstTime; + TFrameArray *fFrames; + int fDesignScreenWidth; + int fDesignScreenHeight; + int fDesignPixelsPerInch; + Extctrls::TTimer* fDesignTimer; + int fDesignFormWidth; + int fDesignFormHeight; + int fDesignFormClientWidth; + int fDesignFormClientHeight; + int fDesignFormLeft; + int fDesignFormTop; + bool fManualPosition; + double fManualLeft; + double fManualTop; + bool fManualSize; + double fManualWidth; + double fManualHeight; + int fScreenWidth; + int fScreenHeight; + int fPixelsPerInch; + double fScreenCorrectionH; + double fScreenCorrectionV; + double fPixelsCorrection; + Classes::TList* fList; + int FTotalControls; + int FInitTotalControls; + Extctrls::TImage* fBkGrndImage; + bool FPictureAssigned; + int fMaximizedWidth; + int fMaximizedHeight; + int fMaximizedPosX; + int fMaximizedPosY; + int fMinimumTrackWidth; + int fMinimumTrackHeight; + int fMaximumTrackWidth; + int fMaximumTrackHeight; + TPosition fOwnerFormPosition; + bool bBeforeShow; + bool bWasVisible[1001]; + bool bMustShow; + bool bFirstFormResize; + bool bOnTheScreen; + TFormBorderStyle fBorderStyle; + bool bFormStartsMaximized; + bool bMaintainProportions; + bool bIncreasing; + Graphics::TFont* fFont; + bool bDisableResize; + bool bAfterMaximize; + bool bDBGridSelfResize; + void __fastcall FindAllControls(Controls::TControl* ofMyControl); + int __fastcall FormHandle(void); + int __fastcall MDIClientFormHandle(void); + void __fastcall NewWndMethod(Messages::TMessage &Msg); + void __fastcall NewMDIClientWndMethod(Messages::TMessage &Msg); + bool __fastcall InList(Classes::TList* Container, Controls::TControl* aControl); + void __fastcall Timer(System::TObject* Sender); + int __fastcall DefinedMaxLeft(void); + int __fastcall DefinedMaxTop(void); + void __fastcall InitializeForm(void); + void __fastcall ResizeFormMaintainingProportions(void); + void __fastcall SetFont(Graphics::TFont* aFont); + void __fastcall TilePicture(HDC DC); + void __fastcall SetImage(Extctrls::TImage* value); + +public: + int GlobalInt; + Classes::TList* ExcludeList; + bool ShowMaximized; + int MessageNumber; + __fastcall virtual TElasticForm(Classes::TComponent* AOwner); + __fastcall virtual ~TElasticForm(void); + void __fastcall ReSizeForm(void); + void __fastcall UpdateSize(Controls::TControl* aControl); + void __fastcall EnforceMaximized(void); + void __fastcall AddToExcludeList(Controls::TControl* aControl); + void __fastcall DisableResize(void); + void __fastcall EnableResize(void); + void __fastcall ReInitializeResizing(void); + __property bool ManualPosition = {read=fManualPosition, write=fManualPosition, nodefault}; + __property bool ManualSize = {read=fManualSize, write=fManualSize, nodefault}; + __property double ManualLeft = {read=fManualLeft, write=fManualLeft}; + __property double ManualTop = {read=fManualTop, write=fManualTop}; + __property double ManualWidth = {read=fManualWidth, write=fManualWidth}; + __property double ManualHeight = {read=fManualHeight, write=fManualHeight}; + +__published: + __property bool ElasticHorizontal = {read=FHorz, write=FHorz, default=1}; + __property bool ElasticVertical = {read=FVert, write=FVert, default=1}; + __property bool ElasticFont = {read=FElasticFont, write=FElasticFont, default=1}; + __property int DesignScreenWidth = {read=fDesignScreenWidth, write=fDesignScreenWidth, nodefault}; + __property int DesignScreenHeight = {read=fDesignScreenHeight, write=fDesignScreenHeight, nodefault + }; + __property int DesignPixelsPerInch = {read=fDesignPixelsPerInch, write=fDesignPixelsPerInch, nodefault + }; + __property int MaximizedPosX = {read=fMaximizedPosX, write=fMaximizedPosX, default=0}; + __property int MaximizedPosY = {read=fMaximizedPosY, write=fMaximizedPosY, default=0}; + __property int MinimumTrackWidth = {read=fMinimumTrackWidth, write=fMinimumTrackWidth, default=0}; + __property int MinimumTrackHeight = {read=fMinimumTrackHeight, write=fMinimumTrackHeight, default=0 + }; + __property int MaximumTrackWidth = {read=fMaximumTrackWidth, write=fMaximumTrackWidth, default=0}; + __property int MaximumTrackHeight = {read=fMaximumTrackHeight, write=fMaximumTrackHeight, default=0 + }; + __property int DesignFormWidth = {read=fDesignFormWidth, write=fDesignFormWidth, nodefault}; + __property int DesignFormHeight = {read=fDesignFormHeight, write=fDesignFormHeight, nodefault}; + __property int DesignFormClientWidth = {read=fDesignFormClientWidth, write=fDesignFormClientWidth, + nodefault}; + __property int DesignFormClientHeight = {read=fDesignFormClientHeight, write=fDesignFormClientHeight + , nodefault}; + __property int DesignFormLeft = {read=fDesignFormLeft, write=fDesignFormLeft, nodefault}; + __property int DesignFormTop = {read=fDesignFormTop, write=fDesignFormTop, nodefault}; + __property bool MaintainProportions = {read=bMaintainProportions, write=bMaintainProportions, default=0 + }; + __property Graphics::TFont* Font = {read=fFont, write=SetFont}; + __property Extctrls::TImage* BkGrndImage = {read=fBkGrndImage, write=SetImage}; + __property bool DBGridSelfResize = {read=bDBGridSelfResize, write=bDBGridSelfResize, default=0}; +}; + +//-- var, const, procedure --------------------------------------------------- +extern PACKAGE int LabelLines; +extern PACKAGE bool fDBGridSelfResize; +extern PACKAGE void __fastcall Register(void); + +} /* namespace Elastfrm */ +#if !defined(NO_IMPLICIT_NAMESPACE_USE) +using namespace Elastfrm; +#endif +//-- end unit ---------------------------------------------------------------- +#endif // ElastFrm diff --git a/CDopping/jpg3s/BUILDNO.TXT b/CDopping/jpg3s/BUILDNO.TXT new file mode 100644 index 0000000..a6161c7 --- /dev/null +++ b/CDopping/jpg3s/BUILDNO.TXT @@ -0,0 +1 @@ +This is build number 1525 diff --git a/CDopping/jpg3s/Copia de MWAJPGC3.BPL b/CDopping/jpg3s/Copia de MWAJPGC3.BPL new file mode 100644 index 0000000..ab2a40f Binary files /dev/null and b/CDopping/jpg3s/Copia de MWAJPGC3.BPL differ diff --git a/CDopping/jpg3s/CrackingLib.txt b/CDopping/jpg3s/CrackingLib.txt new file mode 100644 index 0000000..c261a6f --- /dev/null +++ b/CDopping/jpg3s/CrackingLib.txt @@ -0,0 +1,11 @@ +Libreria JPEG3s + +// Comprobacion ? IDE FUNCIONANDO ? @4620C +S 7521 6A00 668B0D[C86C4400] B202 +R EB........................... + +!! Cambiar en el .BPL y .OBJ !! + +Nota: Los corchetes indican que ese número es una referencia +a algo en memoria/código, lo que significa que con seguridad, +puede no ser el mismo. \ No newline at end of file diff --git a/CDopping/jpg3s/JPEGLIB.HPP b/CDopping/jpg3s/JPEGLIB.HPP new file mode 100644 index 0000000..79a42dc --- /dev/null +++ b/CDopping/jpg3s/JPEGLIB.HPP @@ -0,0 +1,530 @@ +// Borland C++ Builder +// Copyright (c) 1995, 1998 by Borland International +// All rights reserved + +// (DO NOT EDIT: machine generated header) 'jpeglib.pas' rev: 3.00 + +#ifndef jpeglibHPP +#define jpeglibHPP +#include +#include +#include +#include + +//-- user supplied ----------------------------------------------------------- + +namespace Jpeglib +{ +//-- type declarations ------------------------------------------------------- +typedef int Int; + +typedef int *int_ptr; + +typedef int size_t; + +typedef Cardinal uInt; + +typedef Cardinal *uint_ptr; + +typedef short Short; + +typedef Word ushort; + +typedef int Long; + +typedef int int8array[8]; + +typedef Byte JSAMPLE; + +typedef short JCOEF; + +typedef short *JCOEF_PTR; + +typedef Byte JOCTET; + +typedef Byte *JOCTET_PTR; + +typedef Byte UINT8; + +typedef Word UINT16; + +typedef Shortint INT16; + +typedef int INT32; + +typedef int *INT32PTR; + +typedef Cardinal JDIMENSION; + +typedef Byte *JSAMPROW; + +typedef JSAMPROW *JSAMPARRAY; + +typedef JSAMPARRAY *JSAMPIMAGE; + +typedef short JBLOCK[64]; + +typedef JBLOCK *JBLOCKROW; + +typedef JBLOCKROW *JBLOCKARRAY; + +typedef JBLOCKARRAY *JBLOCKIMAGE; + +typedef short *JCOEFPTR; + +struct JQUANT_TBL; +typedef JQUANT_TBL *JQUANT_TBL_PTR; + +#pragma pack(push, 1) +struct JQUANT_TBL +{ + Word quantval[64]; + bool sent_table; +} ; +#pragma pack(pop) + +struct JHUFF_TBL; +typedef JHUFF_TBL *JHUFF_TBL_PTR; + +#pragma pack(push, 1) +struct JHUFF_TBL +{ + Byte bits[17]; + Byte huffval[256]; + bool sent_table; +} ; +#pragma pack(pop) + +struct jpeg_component_info; +typedef jpeg_component_info *jpeg_component_info_ptr; + +#pragma pack(push, 1) +struct jpeg_component_info +{ + int component_id; + int component_index; + int h_samp_factor; + int v_samp_factor; + int quant_tbl_no; + int dc_tbl_no; + int ac_tbl_no; + Cardinal width_in_blocks; + Cardinal height_in_blocks; + int DCT_scaled_size; + Cardinal downsampled_width; + Cardinal downsampled_height; + bool component_needed; + int MCU_width; + int MCU_height; + int MCU_blocks; + int MCU_sample_width; + int last_col_width; + int last_row_height; + JQUANT_TBL *quant_table; + void *dct_table; +} ; +#pragma pack(pop) + +struct jpeg_scan_info; +typedef jpeg_scan_info *jpeg_scan_info_ptr; + +#pragma pack(push, 1) +struct jpeg_scan_info +{ + int comps_in_scan; + int component_index[4]; + int Ss; + int Se; + int Ah; + int Al; +} ; +#pragma pack(pop) + +enum J_COLOR_SPACE { JCS_UNKNOWN, JCS_GRAYSCALE, JCS_RGB, JCS_YCbCr, JCS_CMYK, JCS_YCCK }; + +enum J_DCT_METHOD { JDCT_ISLOW, JDCT_IFAST, JDCT_FLOAT }; + +enum J_DITHER_MODE { JDITHER_NONE, JDITHER_ORDERED, JDITHER_FS }; + +struct jpeg_error_mgr; +typedef jpeg_error_mgr *jpeg_error_mgr_ptr; + +struct jpeg_memory_mgr; +typedef jpeg_memory_mgr *jpeg_memory_mgr_ptr; + +struct jpeg_progress_mgr; +typedef jpeg_progress_mgr *jpeg_progress_mgr_ptr; + +struct jpeg_destination_mgr; +typedef jpeg_destination_mgr *jpeg_destination_mgr_ptr; + +struct jpeg_source_mgr; +typedef jpeg_source_mgr *jpeg_source_mgr_ptr; + +struct jpeg_common_struct; +typedef jpeg_common_struct *j_common_ptr; + +struct jpeg_compress_struct; +typedef jpeg_compress_struct *j_compress_ptr; + +struct jpeg_decompress_struct; +typedef jpeg_decompress_struct *j_decompress_ptr; + +#pragma pack(push, 1) +struct jpeg_common_struct +{ + System::TObject* UserRef; + jpeg_error_mgr *err; + jpeg_memory_mgr *mem; + jpeg_progress_mgr *progress; + bool is_decompressor; + int global_state; +} ; +#pragma pack(pop) + +#pragma pack(push, 1) +struct jpeg_compress_struct +{ + jpeg_common_struct common_fields; + jpeg_destination_mgr *dest; + Cardinal image_width; + Cardinal image_height; + int input_components; + J_COLOR_SPACE in_color_space; + double input_gamma; + int data_precision; + int num_components; + J_COLOR_SPACE jpeg_color_space; + jpeg_component_info *comp_info; + JQUANT_TBL *quant_tbl_ptrs[4]; + JHUFF_TBL *dc_huff_tbl_ptrs[4]; + JHUFF_TBL *ac_huff_tbl_ptrs[4]; + Byte arith_dc_L[16]; + Byte arith_dc_U[16]; + Byte arith_ac_K[16]; + int num_scans; + jpeg_scan_info *scan_info; + bool raw_data_in; + bool arith_code; + bool optimize_coding; + bool CCIR601_sampling; + int smoothing_factor; + J_DCT_METHOD dct_method; + Cardinal restart_interval; + int restart_in_rows; + bool write_JFIF_header; + Byte density_unit; + Word X_density; + Word Y_density; + bool write_Adobe_marker; + Cardinal next_scanline; + bool progressive_mode; + int max_h_samp_factor; + int max_v_samp_factor; + Cardinal total_iMCU_rows; + int comps_in_scan; + jpeg_component_info *cur_comp_info[4]; + Cardinal MCUs_per_row; + Cardinal MCU_rows_in_scan; + int blocks_in_MCU; + int MCU_membership[10]; + int Ss; + int Se; + int Ah; + int Al; + void *master; + void *main; + void *prep; + void *coef; + void *marker; + void *cconvert; + void *downsample; + void *fdct; + void *entropy; +} ; +#pragma pack(pop) + +typedef int coef_bits_field[64]; + +typedef coef_bits_field *coef_bits_ptr; + +typedef int coef_bits_ptrfield[4][64]; + +typedef coef_bits_ptrfield *coef_bits_ptrrow; + +typedef Byte range_limit_table[1408]; + +typedef range_limit_table *range_limit_table_ptr; + +#pragma pack(push, 1) +struct jpeg_decompress_struct +{ + jpeg_common_struct common_fields; + jpeg_source_mgr *src; + Cardinal image_width; + Cardinal image_height; + int num_components; + J_COLOR_SPACE jpeg_color_space; + J_COLOR_SPACE out_color_space; + Cardinal scale_num; + Cardinal scale_denom; + double output_gamma; + bool buffered_image; + bool raw_data_out; + J_DCT_METHOD dct_method; + bool do_fancy_upsampling; + bool do_block_smoothing; + bool quantize_colors; + J_DITHER_MODE dither_mode; + bool two_pass_quantize; + int desired_number_of_colors; + bool enable_1pass_quant; + bool enable_external_quant; + bool enable_2pass_quant; + Cardinal output_width; + Cardinal output_height; + int out_color_components; + int output_components; + int rec_outbuf_height; + int actual_number_of_colors; + JSAMPROW *colormap; + Cardinal output_scanline; + int input_scan_number; + Cardinal input_iMCU_row; + int output_scan_number; + int output_iMCU_row; + coef_bits_field *coef_bits; + JQUANT_TBL *quant_tbl_ptrs[4]; + JHUFF_TBL *dc_huff_tbl_ptrs[4]; + JHUFF_TBL *ac_huff_tbl_ptrs[4]; + int data_precision; + jpeg_component_info *comp_info; + bool progressive_mode; + bool arith_code; + Byte arith_dc_L[16]; + Byte arith_dc_U[16]; + Byte arith_ac_K[16]; + Cardinal restart_interval; + bool saw_JFIF_marker; + Byte density_unit; + Word X_density; + Word Y_density; + bool saw_Adobe_marker; + Byte Adobe_transform; + bool CCIR601_sampling; + int max_h_samp_factor; + int max_v_samp_factor; + int min_DCT_scaled_size; + Cardinal total_iMCU_rows; + range_limit_table *sample_range_limit; + int comps_in_scan; + jpeg_component_info *cur_comp_info[4]; + Cardinal MCUs_per_row; + Cardinal MCU_rows_in_scan; + Cardinal blocks_in_MCU; + int MCU_membership[10]; + int Ss; + int Se; + int Ah; + int Al; + int unread_marker; + void *master; + void *main; + void *coef; + void *post; + void *inputctl; + void *marker; + void *entropy; + void *idct; + void *upsample; + void *cconvert; + void *cquantize; +} ; +#pragma pack(pop) + +#pragma pack(push, 1) +struct jpeglib__1 +{ + + union + { + char s[80]; + int i[8]; + + }; +} ; +#pragma pack(pop) + +#pragma pack(push, 1) +struct jpeg_error_mgr +{ + void __stdcall (*error_exit)(j_common_ptr cinfo); + void __stdcall (*emit_message)(j_common_ptr cinfo, int msg_level); + void __stdcall (*output_message)(j_common_ptr cinfo); + void __stdcall (*format_message)(j_common_ptr cinfo, char * buffer); + void __stdcall (*reset_error_mgr)(j_common_ptr cinfo); + int msg_code; + jpeglib__1 msg_parm; + int trace_level; + int num_warnings; + void *jpeg_message_table; + int last_jpeg_message; + void *addon_message_table; + int first_addon_message; + int last_addon_message; +} ; +#pragma pack(pop) + +#pragma pack(push, 1) +struct jpeg_progress_mgr +{ + void __stdcall (*progress_monitor)(j_common_ptr cinfo); + int pass_counter; + int pass_limit; + int completed_passes; + int total_passes; +} ; +#pragma pack(pop) + +#pragma pack(push, 1) +struct jpeg_destination_mgr +{ + Byte *next_output_byte; + int free_in_buffer; + void __stdcall (*init_destination)(j_compress_ptr cinfo); + bool __stdcall (*empty_output_buffer)(j_compress_ptr cinfo); + void __stdcall (*term_destination)(j_compress_ptr cinfo); +} ; +#pragma pack(pop) + +#pragma pack(push, 1) +struct jpeg_source_mgr +{ + Byte *next_input_byte; + int bytes_in_buffer; + void __stdcall (*init_source)(j_decompress_ptr cinfo); + bool __stdcall (*fill_input_buffer)(j_decompress_ptr cinfo); + void __stdcall (*skip_input_data)(j_decompress_ptr cinfo, int num_bytes); + bool __stdcall (*resync_to_restart)(j_decompress_ptr cinfo, int desired); + void __stdcall (*term_source)(j_decompress_ptr cinfo); +} ; +#pragma pack(pop) + +typedef void *jvirt_sarray_ptr; + +typedef void *jvirt_barray_ptr; + +#pragma pack(push, 1) +struct jpeg_memory_mgr +{ + void * __stdcall (*alloc_small)(j_common_ptr cinfo, int pool_id, int sizeofobject); + void * __stdcall (*alloc_large)(j_common_ptr cinfo, int pool_id, int sizeofobject); + JSAMPARRAY __stdcall (*alloc_sarray)(j_common_ptr cinfo, int pool_id, Cardinal samplesperrow, Cardinal + numrows); + JBLOCKARRAY __stdcall (*alloc_barray)(j_common_ptr cinfo, int pool_id, Cardinal blocksperrow, Cardinal + numrows); + void * __stdcall (*request_virt_sarray)(j_common_ptr cinfo, int pool_id, bool pre_zero, Cardinal samplesperrow + , Cardinal numrows, Cardinal maxaccess); + void * __stdcall (*request_virt_barray)(j_common_ptr cinfo, int pool_id, bool pre_zero, Cardinal blocksperrow + , Cardinal numrows, Cardinal maxaccess); + void __stdcall (*realize_virt_arrays)(j_common_ptr cinfo); + JSAMPARRAY __stdcall (*access_virt_sarray)(j_common_ptr cinfo, void * ptr, Cardinal start_row, Cardinal + num_rows, bool writable); + JBLOCKARRAY __stdcall (*access_virt_barray)(j_common_ptr cinfo, void * ptr, Cardinal start_row, Cardinal + num_rows, bool writable); + void __stdcall (*free_pool)(j_common_ptr cinfo, int pool_id); + void __stdcall (*self_destruct)(j_common_ptr cinfo); + int max_memory_to_use; +} ; +#pragma pack(pop) + +typedef bool __stdcall (*jpeg_marker_parser_method)(j_decompress_ptr cinfo); + +//-- var, const, procedure --------------------------------------------------- +#define MAX_COMPONENTS (Byte)(10) +#define MAXJSAMPLE (Byte)(255) +#define CENTERJSAMPLE (Byte)(128) +#define JPEG_MAX_DIMENSION (int)(65500) +#define JPEG_LIB_VERSION (Byte)(61) +#define JMSG_STR_PARM_MAX (Byte)(80) +#define JMSG_LENGTH_MAX (Byte)(200) +#define DCTSIZE (Byte)(8) +#define DCTSIZE2 (Byte)(64) +#define NUM_QUANT_TBLS (Byte)(4) +#define NUM_HUFF_TBLS (Byte)(4) +#define NUM_ARITH_TBLS (Byte)(16) +#define MAX_COMPS_IN_SCAN (Byte)(4) +#define MAX_SAMP_FACTOR (Byte)(4) +#define C_MAX_BLOCKS_IN_MCU (Byte)(10) +#define D_MAX_BLOCKS_IN_MCU (Byte)(10) +#define JDCT_DEFAULT (J_DCT_METHOD)(0) +#define JDCT_FASTEST (J_DCT_METHOD)(1) +#define JPOOL_PERMANENT (Byte)(0) +#define JPOOL_IMAGE (Byte)(1) +#define JPOOL_NUMPOOLS (Byte)(2) +#define JPEG_SUSPENDED (Byte)(0) +#define JPEG_HEADER_OK (Byte)(1) +#define JPEG_HEADER_TABLES_ONLY (Byte)(2) +#define JPEG_REACHED_SOS (Byte)(1) +#define JPEG_REACHED_EOI (Byte)(2) +#define JPEG_ROW_COMPLETED (Byte)(3) +#define JPEG_SCAN_COMPLETED (Byte)(4) +#define JPEG_RST0 (Byte)(208) +#define JPEG_EOI (Byte)(217) +#define JPEG_APP0 (Byte)(224) +#define JPEG_COM (Byte)(254) +extern "C" void __stdcall jpeg_destroy_compress(j_compress_ptr cinfo); +extern "C" void __stdcall jpeg_destroy_decompress(j_decompress_ptr cinfo); +extern "C" void __stdcall jpeg_set_defaults(j_compress_ptr cinfo); +extern "C" void __stdcall jpeg_set_colorspace(j_compress_ptr cinfo, J_COLOR_SPACE colorspace); +extern "C" void __stdcall jpeg_default_colorspace(j_compress_ptr cinfo); +extern "C" void __stdcall jpeg_set_quality(j_compress_ptr cinfo, int quality, bool force_baseline); +extern "C" void __stdcall jpeg_set_linear_quality(j_compress_ptr cinfo, int scale_factor, bool force_baseline + ); +extern "C" void __stdcall jpeg_add_quant_table(j_compress_ptr cinfo, int which_tbl, const uint_ptr basic_table + , int scale_factor, bool force_baseline); +extern "C" int __stdcall jpeg_quality_scaling(int quality); +extern "C" void __stdcall jpeg_simple_progression(j_compress_ptr cinfo); +extern "C" void __stdcall jpeg_suppress_tables(j_compress_ptr cinfo, bool suppress); +extern "C" JQUANT_TBL_PTR __stdcall jpeg_alloc_quant_table(const jpeg_common_struct cinfo); +extern "C" JHUFF_TBL_PTR __stdcall jpeg_alloc_huff_table(const jpeg_common_struct cinfo); +extern "C" void __stdcall jpeg_start_compress(j_compress_ptr cinfo, bool write_all_tables); +extern "C" Cardinal __stdcall jpeg_write_scanlines(j_compress_ptr cinfo, JSAMPARRAY scanlines, Cardinal + num_lines); +extern "C" void __stdcall jpeg_finish_compress(j_compress_ptr cinfo); +extern "C" Cardinal __stdcall jpeg_write_raw_data(j_compress_ptr cinfo, JSAMPIMAGE data, Cardinal num_lines + ); +extern "C" void __stdcall jpeg_write_marker(j_compress_ptr cinfo, int marker, const JOCTET_PTR dataptr + , Cardinal datalen); +extern "C" void __stdcall jpeg_write_tables(j_compress_ptr cinfo); +extern "C" int __stdcall jpeg_read_header(j_decompress_ptr cinfo, bool require_image); +extern "C" bool __stdcall jpeg_start_decompress(j_decompress_ptr cinfo); +extern "C" Cardinal __stdcall jpeg_read_scanlines(j_decompress_ptr cinfo, JSAMPARRAY scanlines, Cardinal + max_lines); +extern "C" bool __stdcall jpeg_finish_decompress(j_decompress_ptr cinfo); +extern "C" Cardinal __stdcall jpeg_read_raw_data(j_decompress_ptr cinfo, JSAMPIMAGE data, Cardinal max_lines + ); +extern "C" bool __stdcall jpeg_has_multiple_scans(j_decompress_ptr cinfo); +extern "C" bool __stdcall jpeg_start_output(j_decompress_ptr cinfo, int scan_number); +extern "C" bool __stdcall jpeg_finish_output(j_decompress_ptr cinfo); +extern "C" bool __stdcall jpeg_input_complete(j_decompress_ptr cinfo); +extern "C" void __stdcall jpeg_new_colormap(j_decompress_ptr cinfo); +extern "C" int __stdcall jpeg_consume_input(j_decompress_ptr cinfo); +extern "C" void __stdcall jpeg_calc_output_dimensions(j_decompress_ptr cinfo); +extern "C" void __stdcall jpeg_set_marker_processor(j_decompress_ptr cinfo, int marker_code, jpeg_marker_parser_method + routine); +extern "C" void __stdcall jpeg_abort_compress(j_compress_ptr cinfo); +extern "C" void __stdcall jpeg_abort_decompress(j_decompress_ptr cinfo); +extern "C" void __stdcall jpeg_abort(j_common_ptr cinfo); +extern "C" void __stdcall jpeg_destroy(j_common_ptr cinfo); +extern "C" bool __stdcall jpeg_resync_to_restart(j_decompress_ptr cinfo, int desired); +extern "C" jpeg_error_mgr_ptr __stdcall jpeg_std_error(jpeg_error_mgr_ptr err); +extern PACKAGE void __fastcall jpeg_Create_Compress(j_compress_ptr cinfo); +extern PACKAGE void __fastcall jpeg_Create_Decompress(j_decompress_ptr cinfo); + +} /* namespace Jpeglib */ +#if !defined(NO_IMPLICIT_NAMESPACE_USE) +using namespace Jpeglib; +#endif +//-- end unit ---------------------------------------------------------------- +#endif // jpeglib diff --git a/CDopping/jpg3s/JPEGLIB.OBJ b/CDopping/jpg3s/JPEGLIB.OBJ new file mode 100644 index 0000000..92ec281 Binary files /dev/null and b/CDopping/jpg3s/JPEGLIB.OBJ differ diff --git a/CDopping/jpg3s/JPEGREG1.DCR b/CDopping/jpg3s/JPEGREG1.DCR new file mode 100644 index 0000000..a634fdd Binary files /dev/null and b/CDopping/jpg3s/JPEGREG1.DCR differ diff --git a/CDopping/jpg3s/JPEGREG2.DCR b/CDopping/jpg3s/JPEGREG2.DCR new file mode 100644 index 0000000..a634fdd Binary files /dev/null and b/CDopping/jpg3s/JPEGREG2.DCR differ diff --git a/CDopping/jpg3s/JPEG_REG.OBJ b/CDopping/jpg3s/JPEG_REG.OBJ new file mode 100644 index 0000000..bae12df Binary files /dev/null and b/CDopping/jpg3s/JPEG_REG.OBJ differ diff --git a/CDopping/jpg3s/LICENCE.TXT b/CDopping/jpg3s/LICENCE.TXT new file mode 100644 index 0000000..6b12472 --- /dev/null +++ b/CDopping/jpg3s/LICENCE.TXT @@ -0,0 +1,126 @@ + SHAREWARE LICENCE + + + LICENCE AGREEMENT +Copyright 1997 McCallum Whyman Associates Limited trading as MWA Software + + + +The copyright in the shareware version of this software ("the +Software") is owned by McCallum Whyman Associates Limited trading +as MWA Software ("the Owner"). You may not load the Software +into any computer or copy it without the licence of the Owner. +The Owner offers you a non-exclusive licence on the terms of this +Agreement. + + + + +LICENCE + +You are permitted during the Term to: + +(1) load the Software and use it only on a single computer (with + a single input terminal) which is under your control; + +(2) transfer the Software from one computer to another provided + it is used on only one computer at a time; + +(3) make copies of the Software. The copies must reproduce and + include the Owner's copyright notice; + +(4) transfer a copy of the Software (complete with all its + associated documentation and this licence) to another person + provided that the Software is not modified in any way and + includes all files as originally supplied and that no charge + is made for the transfer. If any transferee does not accept + such terms then this licence shall automatically terminate. + The transferor does not retain any rights under this + Agreement in respect of the transferred Software or licence. + +(5) use the Software as a component of another program provided + that the purpose of using the Software is for evaluation only + and provided that the evaluation is carried out on the same + computer on which the Software is loaded and that such a + program is under no circumstances transferred to another + person. + +You are not permitted: + +(a) to rent, lease, sub-licence, loan, copy (except as expressly + provided in this Agreement), modify, adapt, merge, translate, + reverse engineer, decompile, disassemble or create derivative + works based on the whole or any part of the Software or its + associated documentation; + +(b) except as expressly provided in this Agreement, to use, +reproduce or deal in the Software in any way. + + +ACCEPTANCE + +You shall be deemed to have accepted the terms of this Agreement +by loading the Software into any computer. + + +TERM + +Subject as set out below this licence is effective for a period +of 30 days from the date of first use by you. This Licence will +terminate if you fail to abide by its terms. Upon termination +you agree to destroy all copies of the Software and its +documentation including any Software stored on the hard disk of +any computer under your control. + + +REGISTRATION + +If you wish to licence the Software beyond the period of 30 days +aforesaid then please return the enclosed Licence Registration +Form to the Owner within such period. + + +OWNERSHIP + +The Owner shall at all times retain ownership of the Software as +recorded in the original file set or diskette and all subsequent +copies thereof regardless of form. If the Software was supplied +on diskette, you own only the diskette on which the Software is +recorded. You may retain the diskette on termination provided +the Software has been erased. This Agreement applies to the +grant of the licence only and not to the contract of sale of the +diskette. + + +WARRANTIES + +(1) The express terms of this Agreement are in lieu of all + warranties, conditions, undertakings, terms and obligations + implied by statute, common law, trade usage, course of + dealing or otherwise all of which are hereby excluded to the + fullest extent permitted by law. + +(2) The Owner does not warrant that the Software will meet your + requirements or that the operation of the Software will be + uninterrupted or error-free or that defects in the Software + will be corrected. You shall load and use the Software at + your own risk and in no event will the Owner be liable to you + for any loss or damage of any kind (except personal injury or + death resulting from the Owner's negligence) including lost + profits or consequential loss arising from your use of or + inability to use the Software or from errors or deficiencies + in it whether caused by negligence or otherwise. + +(3) Any liability of the Owner pursuant to this licence shall be + limited to the purchase price or registration fee paid. + + +LAW + +This Agreement shall be governed by English law. + + + If you have any questions concerning this Agreement please + write to McCallum Whyman Associates Limited trading as MWA + Software at PO Box 37, Alresford, Hampshire, SO24 9ZF, + England. diff --git a/CDopping/jpg3s/MWADBJPG.HPP b/CDopping/jpg3s/MWADBJPG.HPP new file mode 100644 index 0000000..d35d7a0 --- /dev/null +++ b/CDopping/jpg3s/MWADBJPG.HPP @@ -0,0 +1,87 @@ +// Borland C++ Builder +// Copyright (c) 1995, 1998 by Borland International +// All rights reserved + +// (DO NOT EDIT: machine generated header) 'mwadbjpg.pas' rev: 3.00 + +#ifndef mwadbjpgHPP +#define mwadbjpgHPP +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +//-- user supplied ----------------------------------------------------------- + +namespace Mwadbjpg +{ +//-- type declarations ------------------------------------------------------- +class DELPHICLASS TDBJPEGImage; +class PASCALIMPLEMENTATION TDBJPEGImage : public Extctrls::TImage +{ + typedef Extctrls::TImage inherited; + +private: + Dbctrls::TFieldDataLink* FDataLink; + Classes::TNotifyEvent FOldPictureChanged; + bool FAutoDisplay; + bool FLoading; + bool FChanging; + bool FPictureLoaded; + Mwajpeg::TJPEGFileCompressor* FJPEGCompressor; + Mwajpeg::TJPEGFileDecompressor* FJPEGDecompressor; + System::AnsiString __fastcall GetDataField(); + Db::TDataSource* __fastcall GetDataSource(void); + Db::TField* __fastcall GetField(void); + bool __fastcall GetReadOnly(void); + Mwajpeg::TJPEGFileDecompressor* __fastcall GetJPEGDecompressor(void); + Mwajpeg::TJPEGFileCompressor* __fastcall GetJPEGCompressor(void); + void __fastcall SetDataField(const System::AnsiString Value); + void __fastcall SetDataSource(Db::TDataSource* Value); + void __fastcall SetReadOnly(bool Value); + void __fastcall ActiveChanged(System::TObject* Sender); + void __fastcall DataChange(System::TObject* Sender); + void __fastcall UpdateData(System::TObject* Sender); + void __fastcall PictureChange(System::TObject* Sender); + MESSAGE void __fastcall WMCut(Messages::TMessage &Message); + MESSAGE void __fastcall WMCopy(Messages::TMessage &Message); + MESSAGE void __fastcall WMPaste(Messages::TMessage &Message); + +protected: + virtual void __fastcall Notification(Classes::TComponent* AComponent, Classes::TOperation Operation + ); + +public: + __fastcall virtual TDBJPEGImage(Classes::TComponent* AOwner); + __fastcall virtual ~TDBJPEGImage(void); + void __fastcall CopyToClipboard(void); + void __fastcall CutToClipboard(void); + void __fastcall PasteFromClipboard(void); + void __fastcall LoadPicture(void); + __property Db::TField* Field = {read=GetField}; + +__published: + __property bool AutoDisplay = {read=FAutoDisplay, write=FAutoDisplay, default=1}; + __property System::AnsiString DataField = {read=GetDataField, write=SetDataField}; + __property Db::TDataSource* DataSource = {read=GetDataSource, write=SetDataSource}; + __property bool ReadOnly = {read=GetReadOnly, write=SetReadOnly, nodefault}; + __property Mwajpeg::TJPEGFileCompressor* JPEGCompressor = {read=FJPEGCompressor, write=FJPEGCompressor + }; + __property Mwajpeg::TJPEGFileDecompressor* JPEGDecompressor = {read=FJPEGDecompressor, write=FJPEGDecompressor + }; +}; + +//-- var, const, procedure --------------------------------------------------- + +} /* namespace Mwadbjpg */ +#if !defined(NO_IMPLICIT_NAMESPACE_USE) +using namespace Mwadbjpg; +#endif +//-- end unit ---------------------------------------------------------------- +#endif // mwadbjpg diff --git a/CDopping/jpg3s/MWADBJPG.OBJ b/CDopping/jpg3s/MWADBJPG.OBJ new file mode 100644 index 0000000..74991b3 Binary files /dev/null and b/CDopping/jpg3s/MWADBJPG.OBJ differ diff --git a/CDopping/jpg3s/MWAJPEG.HPP b/CDopping/jpg3s/MWAJPEG.HPP new file mode 100644 index 0000000..1f36fd1 --- /dev/null +++ b/CDopping/jpg3s/MWAJPEG.HPP @@ -0,0 +1,498 @@ +// Borland C++ Builder +// Copyright (c) 1995, 1998 by Borland International +// All rights reserved + +// (DO NOT EDIT: machine generated header) 'mwajpeg.pas' rev: 3.00 + +#ifndef mwajpegHPP +#define mwajpegHPP +#include +#include +#include +#include +#include +#include +#include + +//-- user supplied ----------------------------------------------------------- + +namespace Mwajpeg +{ +//-- type declarations ------------------------------------------------------- +typedef void __fastcall (__closure *TWarningEvent)(const System::AnsiString warning_message); + +class DELPHICLASS TJPEGBase; +class PASCALIMPLEMENTATION TJPEGBase : public Classes::TComponent +{ + typedef Classes::TComponent inherited; + +private: + Jpeglib::jpeg_common_struct *JPEGObject; + bool FInAbort; + bool FInProgress; + bool FAbortRequested; + Classes::TNotifyEvent FOnProgressReport; + TWarningEvent FOnWarning; + int __fastcall GetWarnings(void); + int __fastcall GetTraceLevel(void); + int __fastcall GetPercentDone(void); + void __fastcall SetTraceLevel(int value); + virtual void __fastcall CreateJPEGObject(Jpeglib::jpeg_error_mgr_ptr err) = 0; + +protected: + virtual void __fastcall Error(void); + virtual void __fastcall Warning(int msg_level); + virtual void __fastcall DoProgress(void); + int __fastcall Round4(int i); + +public: + __fastcall virtual TJPEGBase(Classes::TComponent* AOwner); + __fastcall virtual ~TJPEGBase(void); + virtual void __fastcall Abort(void); + __property int Warnings = {read=GetWarnings, nodefault}; + __property int Trace_Level = {read=GetTraceLevel, write=SetTraceLevel, nodefault}; + __property int PercentDone = {read=GetPercentDone, nodefault}; + __property Classes::TNotifyEvent OnProgressReport = {read=FOnProgressReport, write=FOnProgressReport + }; + __property TWarningEvent OnWarning = {read=FOnWarning, write=FOnWarning}; +}; + +enum TBitmapResolution { bmDefault, bm16Colour, bm256Colour, bm24bit }; + +typedef int TImageSize; + +class DELPHICLASS TJPEGCompressor; +class PASCALIMPLEMENTATION TJPEGCompressor : public Mwajpeg::TJPEGBase +{ + typedef Mwajpeg::TJPEGBase inherited; + +private: + System::AnsiString FComment; + bool FProgressiveJPEG; + bool FWriteAllTables; + int FQuality; + bool FGrayscaleOutput; + Classes::TNotifyEvent FOnWriteMarkers; + Jpeglib::JOCTET_PTR __fastcall GetNextOut(void); + int __fastcall GetFreeIn(void); + void __fastcall SetNextOut(Jpeglib::JOCTET_PTR value); + void __fastcall SetFreeIn(int value); + void __fastcall SetQuality(int Value); + virtual void __fastcall CreateJPEGObject(Jpeglib::jpeg_error_mgr_ptr err); + int __fastcall Getcinfoinput_components(void); + Cardinal __fastcall Getcinfoimage_width(void); + double __fastcall Getcinfoinput_gamma(void); + int __fastcall Getcinfodata_precision(void); + Jpeglib::J_COLOR_SPACE __fastcall Getcinfojpeg_color_space(void); + Jpeglib::J_DCT_METHOD __fastcall Getcinfodct_method(void); + bool __fastcall Getcinfooptimize_coding(void); + Cardinal __fastcall Getcinforestart_interval(void); + int __fastcall Getcinforestart_in_rows(void); + int __fastcall Getcinfosmoothing_factor(void); + bool __fastcall Getcinfowrite_JFIF_header(void); + Byte __fastcall Getcinfodensity_unit(void); + Word __fastcall GetcinfoX_density(void); + Word __fastcall GetcinfoY_Density(void); + bool __fastcall Getcinfowrite_Adobe_marker(void); + Cardinal __fastcall Getcinfoimage_height(void); + void __fastcall Setcinfoinput_components(int Value); + void __fastcall Setcinfoimage_width(Cardinal Value); + void __fastcall Setcinfoinput_gamma(double Value); + void __fastcall Setcinfodata_precision(int Value); + void __fastcall Setcinfojpeg_color_space(Jpeglib::J_COLOR_SPACE Value); + void __fastcall Setcinfodct_method(Jpeglib::J_DCT_METHOD Value); + void __fastcall Setcinfooptimize_coding(bool Value); + void __fastcall Setcinforestart_interval(Cardinal Value); + void __fastcall Setcinforestart_in_rows(int Value); + void __fastcall Setcinfosmoothing_factor(int Value); + void __fastcall Setcinfowrite_JFIF_header(bool Value); + void __fastcall Setcinfodensity_unit(Byte Value); + void __fastcall SetcinfoX_density(Word Value); + void __fastcall SetcinfoY_Density(Word Value); + void __fastcall Setcinfowrite_Adobe_marker(bool Value); + void __fastcall Setcinfoimage_height(Cardinal Value); + +protected: + Jpeglib::jpeg_compress_struct cinfo; + virtual void __fastcall InitDestination(void) = 0; + virtual bool __fastcall EmptyOutputBuffer(void) = 0; + virtual void __fastcall TermDestination(void) = 0; + void __fastcall SetColorSpace(Jpeglib::J_COLOR_SPACE value); + void __fastcall Bitmap2DIB(Graphics::TBitmap* Bitmap, TBitmapResolution Resolution, void *BitMapInfo + , void *bits); + void __fastcall GetBitmapInfoHeader(HBITMAP Bitmap, TBitmapResolution Resolution, tagBITMAPINFOHEADER + &BitmapInfoHeader); + void __fastcall GetDIBSizes(HBITMAP Bitmap, TBitmapResolution Resolution, int &InfoHeaderSize, int + &ImageSize); + void __fastcall WriteDIBitmap(const tagBITMAPINFO &BitmapInfo, char * bits); + void __fastcall WriteBitmap(Graphics::TBitmap* bitmap); + void __fastcall WriteStretchedBitmap(Graphics::TBitmap* bitmap, int width, int height); + void __fastcall WriteMetaFile(Graphics::TMetafile* metafile, int width, int height); + __property Jpeglib::JOCTET_PTR next_out = {read=GetNextOut, write=SetNextOut}; + __property int free_in = {read=GetFreeIn, write=SetFreeIn, nodefault}; + __property int InputComponents = {read=Getcinfoinput_components, write=Setcinfoinput_components, nodefault + }; + __property Cardinal ImageWidth = {read=Getcinfoimage_width, write=Setcinfoimage_width, nodefault}; + __property Cardinal ImageHeight = {read=Getcinfoimage_height, write=Setcinfoimage_height, nodefault + }; + +public: + __fastcall virtual TJPEGCompressor(Classes::TComponent* AOwner); + __fastcall virtual ~TJPEGCompressor(void); + void __fastcall AddQuantTable(int which_tbl, const Jpeglib::uint_ptr basic_table, int scale_factor, + bool force_baseline); + void __fastcall WriteMarker(int Marker, const void *buf, int Count); + __property bool GrayscaleOutput = {read=FGrayscaleOutput, write=FGrayscaleOutput, nodefault}; + __property System::AnsiString Comment = {read=FComment, write=FComment}; + __property int Quality = {read=FQuality, write=SetQuality, default=75}; + __property bool ProgressiveJPEG = {read=FProgressiveJPEG, write=FProgressiveJPEG, nodefault}; + __property double InputGamma = {read=Getcinfoinput_gamma, write=Setcinfoinput_gamma}; + __property int DataPrecision = {read=Getcinfodata_precision, write=Setcinfodata_precision, nodefault + }; + __property Jpeglib::J_COLOR_SPACE OutputColorSpace = {read=Getcinfojpeg_color_space, write=Setcinfojpeg_color_space + , nodefault}; + __property Jpeglib::J_DCT_METHOD DCTMethod = {read=Getcinfodct_method, write=Setcinfodct_method, nodefault + }; + __property bool OptimizeCoding = {read=Getcinfooptimize_coding, write=Setcinfooptimize_coding, nodefault + }; + __property Cardinal RestartInterval = {read=Getcinforestart_interval, write=Setcinforestart_interval + , nodefault}; + __property int RestartInRows = {read=Getcinforestart_in_rows, write=Setcinforestart_in_rows, nodefault + }; + __property int SmoothingFactor = {read=Getcinfosmoothing_factor, write=Setcinfosmoothing_factor, nodefault + }; + __property bool WriteJFIFHeader = {read=Getcinfowrite_JFIF_header, write=Setcinfowrite_JFIF_header, + nodefault}; + __property Byte DensityUnit = {read=Getcinfodensity_unit, write=Setcinfodensity_unit, nodefault}; + __property Word X_Density = {read=GetcinfoX_density, write=SetcinfoX_density, nodefault}; + __property Word Y_Density = {read=GetcinfoY_Density, write=SetcinfoY_Density, nodefault}; + __property bool WriteAdobeMarker = {read=Getcinfowrite_Adobe_marker, write=Setcinfowrite_Adobe_marker + , nodefault}; + __property bool WriteAllTables = {read=FWriteAllTables, write=FWriteAllTables, default=1}; + __property Classes::TNotifyEvent OnWriteMarkers = {read=FOnWriteMarkers, write=FOnWriteMarkers}; +}; + +typedef void __fastcall (__closure *TJPEGCommentEvent)(TJPEGBase* sender, char * comment); + +typedef void __fastcall (__closure *TJPEGMarkerEvent)(TJPEGBase* sender, int Marker, bool &done); + +enum TJPEGOutputType { jp24bit, jp8bit, jp4bit, jpGrayscale }; + +class DELPHICLASS TJPEGDecompressor; +class PASCALIMPLEMENTATION TJPEGDecompressor : public Mwajpeg::TJPEGBase +{ + typedef Mwajpeg::TJPEGBase inherited; + +private: + TJPEGCommentEvent FOnJPEGComment; + J_DCT_METHOD FDCT_METHOD; + bool FDoFancyUpSampling; + bool FDoBlockSmoothing; + bool FGrayScaleOutput; + bool FTwoPassQuantize; + J_DITHER_MODE FDitherMode; + int FColoursIn8bitMode; + TJPEGMarkerEvent FOnJPEGMarker; + virtual void __fastcall CreateJPEGObject(Jpeglib::jpeg_error_mgr_ptr err); + Jpeglib::JOCTET_PTR __fastcall GetNextInputByte(void); + int __fastcall GetBytesInBuffer(void); + void __fastcall SetNextInputByte(Jpeglib::JOCTET_PTR value); + void __fastcall SetBytesInBuffer(int value); + bool __fastcall HandleJPEGComment(void); + bool __fastcall HandleAPPMarker(void); + Jpeglib::J_COLOR_SPACE __fastcall Getcinfoout_color_space(void); + Cardinal __fastcall Getcinfoscale_num(void); + Cardinal __fastcall Getcinfoscale_denom(void); + double __fastcall Getcinfooutput_gamma(void); + bool __fastcall Getcinfoquantize_colors(void); + int __fastcall Getcinfodesired_number_of_colors(void); + Jpeglib::JSAMPARRAY __fastcall Getcinfocolormap(void); + int __fastcall Getcinfoactual_number_of_colors(void); + Cardinal __fastcall Getcinfoimage_width(void); + Cardinal __fastcall Getcinfoimage_height(void); + Jpeglib::J_COLOR_SPACE __fastcall Getcinfojpeg_color_space(void); + bool __fastcall Getcinfosaw_JFIF_marker(void); + Byte __fastcall Getcinfodensity_unit(void); + Word __fastcall GetcinfoX_density(void); + Word __fastcall GetcinfoY_density(void); + Byte __fastcall GetcinfoAdobe_transform(void); + bool __fastcall Getcinfoenable_1pass_quant(void); + bool __fastcall Getcinfoenable_external_quant(void); + bool __fastcall Getcinfoenable_2pass_quant(void); + Cardinal __fastcall Getcinfooutput_height(void); + Cardinal __fastcall Getcinfooutput_width(void); + void __fastcall Setcinfoout_color_space(Jpeglib::J_COLOR_SPACE Value); + void __fastcall Setcinfoscale_num(Cardinal Value); + void __fastcall Setcinfoscale_denom(Cardinal Value); + void __fastcall Setcinfooutput_gamma(double Value); + void __fastcall Setcinfoquantize_colors(bool Value); + void __fastcall Setcinfodesired_number_of_colors(int Value); + void __fastcall Setcinfocolormap(Jpeglib::JSAMPARRAY Value); + void __fastcall Setcinfoactual_number_of_colors(int Value); + void __fastcall Setcinfoimage_width(Cardinal Value); + void __fastcall Setcinfoimage_height(Cardinal Value); + void __fastcall Setcinfojpeg_color_space(Jpeglib::J_COLOR_SPACE Value); + void __fastcall Setcinfosaw_JFIF_marker(bool Value); + void __fastcall Setcinfodensity_unit(Byte Value); + void __fastcall SetcinfoX_density(Word Value); + void __fastcall SetcinfoY_density(Word Value); + void __fastcall SetcinfoAdobe_transform(Byte Value); + void __fastcall Setcinfoenable_1pass_quant(bool Value); + void __fastcall Setcinfoenable_external_quant(bool Value); + void __fastcall Setcinfoenable_2pass_quant(bool Value); + void __fastcall Setcinfooutput_height(Cardinal Value); + void __fastcall Setcinfooutput_width(Cardinal Value); + +protected: + Jpeglib::jpeg_decompress_struct cinfo; + virtual void __fastcall InitSource(void) = 0; + virtual bool __fastcall FillInputBuffer(void) = 0; + virtual void __fastcall SkipInputBytes(int num_bytes) = 0; + virtual bool __fastcall ResyncToRestart(int desired) = 0; + virtual void __fastcall TermSource(void) = 0; + virtual bool __fastcall DoJPEGComment(char * comment); + void __fastcall ReadDIBitmap(tagBITMAPINFO &BitMapInfo, TJPEGOutputType OutputType, void * bits); + Graphics::TBitmap* __fastcall ReadBitmap(void); + void __fastcall ReadWinBitmap(HBITMAP &Bitmap, HPALETTE &Palette); + virtual void __fastcall ReadHeader(void); + __property Jpeglib::JOCTET_PTR NextInputByte = {read=GetNextInputByte, write=SetNextInputByte}; + __property int BytesInBuffer = {read=GetBytesInBuffer, write=SetBytesInBuffer, nodefault}; + __property Jpeglib::J_COLOR_SPACE OutputColorSpace = {read=Getcinfoout_color_space, write=Setcinfoout_color_space + , nodefault}; + __property Cardinal ScaleNum = {read=Getcinfoscale_num, write=Setcinfoscale_num, nodefault}; + __property Cardinal ScaleDenom = {read=Getcinfoscale_denom, write=Setcinfoscale_denom, nodefault}; + __property double OutputGamma = {read=Getcinfooutput_gamma, write=Setcinfooutput_gamma}; + __property bool QuantizeColors = {read=Getcinfoquantize_colors, write=Setcinfoquantize_colors, nodefault + }; + __property int NumColorsDesired = {read=Getcinfodesired_number_of_colors, write=Setcinfodesired_number_of_colors + , nodefault}; + __property Jpeglib::JSAMPARRAY ColorMap = {read=Getcinfocolormap, write=Setcinfocolormap}; + __property int ActualColorsInMap = {read=Getcinfoactual_number_of_colors, write=Setcinfoactual_number_of_colors + , nodefault}; + +public: + __fastcall virtual TJPEGDecompressor(Classes::TComponent* AOwner); + __fastcall virtual ~TJPEGDecompressor(void); + int __fastcall GetBitmapInfoSize(TJPEGOutputType OutputType); + int __fastcall GetDIBitsSize(TJPEGOutputType OutputType); + Byte __fastcall GetByte(void); + __property TJPEGCommentEvent OnJPEGComment = {read=FOnJPEGComment, write=FOnJPEGComment}; + __property TJPEGMarkerEvent OnJPEGMarker = {read=FOnJPEGMarker, write=FOnJPEGMarker}; + __property bool GrayScaleOutput = {read=FGrayScaleOutput, write=FGrayScaleOutput, nodefault}; + __property Cardinal Width = {read=Getcinfoimage_width, write=Setcinfoimage_width, nodefault}; + __property Cardinal Height = {read=Getcinfoimage_height, write=Setcinfoimage_height, nodefault}; + __property Jpeglib::J_COLOR_SPACE ColorSpace = {read=Getcinfojpeg_color_space, write=Setcinfojpeg_color_space + , nodefault}; + __property bool JFIFMarkerPresent = {read=Getcinfosaw_JFIF_marker, write=Setcinfosaw_JFIF_marker, nodefault + }; + __property Byte DensityUnit = {read=Getcinfodensity_unit, write=Setcinfodensity_unit, nodefault}; + __property Word X_Density = {read=GetcinfoX_density, write=SetcinfoX_density, nodefault}; + __property Word Y_Density = {read=GetcinfoY_density, write=SetcinfoY_density, nodefault}; + __property Byte AdobeTransform = {read=GetcinfoAdobe_transform, write=SetcinfoAdobe_transform, nodefault + }; + __property bool TwoPassQuantize = {read=FTwoPassQuantize, write=FTwoPassQuantize, default=1}; + __property int ColoursIn8bitMode = {read=FColoursIn8bitMode, write=FColoursIn8bitMode, default=64}; + + __property Jpeglib::J_DITHER_MODE DitherMode = {read=FDitherMode, write=FDitherMode, default=2}; + __property Jpeglib::J_DCT_METHOD DCTMethod = {read=FDCT_METHOD, write=FDCT_METHOD, default=0}; + __property bool DoFancyUpSampling = {read=FDoFancyUpSampling, write=FDoFancyUpSampling, default=1}; + + __property bool DoBlockSmoothing = {read=FDoBlockSmoothing, write=FDoBlockSmoothing, default=1}; + __property bool Enable1PassQuant = {read=Getcinfoenable_1pass_quant, write=Setcinfoenable_1pass_quant + , nodefault}; + __property bool EnableExternalQuant = {read=Getcinfoenable_external_quant, write=Setcinfoenable_external_quant + , nodefault}; + __property bool Enable2PassQuant = {read=Getcinfoenable_2pass_quant, write=Setcinfoenable_2pass_quant + , nodefault}; + __property Cardinal OutputHeight = {read=Getcinfooutput_height, write=Setcinfooutput_height, nodefault + }; + __property Cardinal OutputWidth = {read=Getcinfooutput_width, write=Setcinfooutput_width, nodefault + }; +}; + +class DELPHICLASS TJPEGStreamCompressor; +class PASCALIMPLEMENTATION TJPEGStreamCompressor : public Mwajpeg::TJPEGCompressor +{ + typedef Mwajpeg::TJPEGCompressor inherited; + +private: + Classes::TStream* FStream; + void *FBuffer; + int FBufSize; + void __fastcall SetBufSize(int Value); + +protected: + virtual void __fastcall InitDestination(void); + virtual bool __fastcall EmptyOutputBuffer(void); + virtual void __fastcall TermDestination(void); + void __fastcall OpenStream(Classes::TStream* Stream); + void __fastcall CloseStream(void); + +public: + __fastcall virtual TJPEGStreamCompressor(Classes::TComponent* AOwner); + __fastcall virtual ~TJPEGStreamCompressor(void); + void __fastcall SavePictureToStream(Graphics::TPicture* Picture, Classes::TStream* Stream); + void __fastcall SaveStretchedPictureToStream(Graphics::TPicture* Picture, int width, int height, Classes::TStream* + Stream); + void __fastcall SaveBitMapToStream(Graphics::TBitmap* bitmap, Classes::TStream* Stream); + void __fastcall SaveStretchedBitMapToStream(Graphics::TBitmap* bitmap, int width, int height, Classes::TStream* + Stream); + void __fastcall SaveDIBitmapToStream(Classes::TStream* Stream, const tagBITMAPINFO &BitmapInfo, char * + bits); + void __fastcall SaveMetaFileToStream(Graphics::TMetafile* metafile, Classes::TStream* Stream, int width + , int height); + __property int BufSize = {read=FBufSize, write=SetBufSize, default=4096}; +}; + +class DELPHICLASS TJPEGStreamDecompressor; +class PASCALIMPLEMENTATION TJPEGStreamDecompressor : public Mwajpeg::TJPEGDecompressor +{ + typedef Mwajpeg::TJPEGDecompressor inherited; + +private: + Classes::TStream* FStream; + char *FBuffer; + int FBufSize; + +protected: + virtual void __fastcall InitSource(void); + virtual bool __fastcall FillInputBuffer(void); + virtual void __fastcall SkipInputBytes(int num_bytes); + virtual bool __fastcall ResyncToRestart(int desired); + void __fastcall SetBufSize(int Value); + virtual void __fastcall TermSource(void); + +public: + void __fastcall OpenStream(Classes::TStream* Stream); + void __fastcall CloseStream(void); + __fastcall virtual TJPEGStreamDecompressor(Classes::TComponent* AOwner); + __fastcall virtual ~TJPEGStreamDecompressor(void); + void __fastcall ConvertToDIB(Classes::TStream* Source, Classes::TStream* Destination, TJPEGOutputType + OutputType); + void __fastcall LoadPictureFromStream(Graphics::TPicture* Picture, Classes::TStream* Stream); + void __fastcall LoadPictureFromResource(Graphics::TPicture* Picture, int Instance, const System::AnsiString + ResName); + void __fastcall LoadPictureFromResID(Graphics::TPicture* Picture, int Instance, int ResID); + Graphics::TBitmap* __fastcall ReadBitMapFromStream(Classes::TStream* Stream); + void __fastcall ReadDIBitmapFromStream(Classes::TStream* Stream, tagBITMAPINFO &BitMapInfo, TJPEGOutputType + OutputType, int &bits); + __property int BufSize = {read=FBufSize, write=SetBufSize, default=4096}; +}; + +class DELPHICLASS TJPEGFileDecompressor; +class PASCALIMPLEMENTATION TJPEGFileDecompressor : public Mwajpeg::TJPEGStreamDecompressor +{ + typedef Mwajpeg::TJPEGStreamDecompressor inherited; + +public: + void __fastcall LoadPictureFromFile(Graphics::TPicture* Picture, const System::AnsiString FileName) + ; + +__published: + __property Warnings ; + __property Trace_Level ; + __property PercentDone ; + __property ColoursIn8bitMode ; + __property GrayScaleOutput ; + __property OnJPEGComment ; + __property OnJPEGMarker ; + __property TwoPassQuantize ; + __property DitherMode ; + __property DCTMethod ; + __property DoFancyUpSampling ; + __property DoBlockSmoothing ; + __property OnProgressReport ; + __property OnWarning ; +public: + /* TJPEGStreamDecompressor.create */ __fastcall virtual TJPEGFileDecompressor(Classes::TComponent* + AOwner) : Mwajpeg::TJPEGStreamDecompressor(AOwner) { } + /* TJPEGStreamDecompressor.Destroy */ __fastcall virtual ~TJPEGFileDecompressor(void) { } + +}; + +class DELPHICLASS TJPEGFileCompressor; +class PASCALIMPLEMENTATION TJPEGFileCompressor : public Mwajpeg::TJPEGStreamCompressor +{ + typedef Mwajpeg::TJPEGStreamCompressor inherited; + +public: + void __fastcall SavePictureToFile(Graphics::TPicture* Picture, const System::AnsiString FileName); + void __fastcall SaveStretchedPictureToFile(Graphics::TPicture* Picture, int width, int height, const + System::AnsiString FileName); + void __fastcall SaveBitmapToFile(Graphics::TBitmap* bitmap, const System::AnsiString FileName); + void __fastcall SaveStretchedBitmapToFile(Graphics::TBitmap* bitmap, int width, int height, const System::AnsiString + FileName); + void __fastcall SaveMetafileToFile(Graphics::TMetafile* metafile, int width, int height, const System::AnsiString + FileName); + +__published: + __property Warnings ; + __property Trace_Level ; + __property PercentDone ; + __property GrayscaleOutput ; + __property Comment ; + __property Quality ; + __property InputGamma ; + __property ProgressiveJPEG ; + __property DCTMethod ; + __property OptimizeCoding ; + __property RestartInterval ; + __property RestartInRows ; + __property SmoothingFactor ; + __property WriteJFIFHeader ; + __property DensityUnit ; + __property X_Density ; + __property Y_Density ; + __property WriteAllTables ; + __property OnProgressReport ; + __property OnWriteMarkers ; + __property OnWarning ; +public: + /* TJPEGStreamCompressor.create */ __fastcall virtual TJPEGFileCompressor(Classes::TComponent* AOwner + ) : Mwajpeg::TJPEGStreamCompressor(AOwner) { } + /* TJPEGStreamCompressor.Destroy */ __fastcall virtual ~TJPEGFileCompressor(void) { } + +}; + +class DELPHICLASS TJPEGBitmap; +class PASCALIMPLEMENTATION TJPEGBitmap : public Graphics::TBitmap +{ + typedef Graphics::TBitmap inherited; + +private: + bool FSaveAsBitmap; + TJPEGStreamDecompressor* FDecompressor; + TJPEGStreamCompressor* FCompressor; + Classes::TNotifyEvent FProgressEvent; + void __fastcall HandleDecompressOnProgress(System::TObject* Sender); + void __fastcall HandleCompressOnProgress(System::TObject* Sender); + +public: + virtual void __fastcall LoadFromStream(Classes::TStream* Stream); + virtual void __fastcall SaveToStream(Classes::TStream* Stream); + virtual void __fastcall SaveToFile(const System::AnsiString FileName); +public: + /* TBitmap.Create */ __fastcall virtual TJPEGBitmap(void) : Graphics::TBitmap() { } + /* TBitmap.Destroy */ __fastcall virtual ~TJPEGBitmap(void) { } + +}; + +//-- var, const, procedure --------------------------------------------------- +#define DefaultBufSize (Word)(4096) +#define DefaultQuality (Byte)(75) +#define sJPEGResourceType "JPEG" +#define DefaultColoursIn8bitMode (Byte)(64) +extern PACKAGE bool UseIsIllegal; +extern PACKAGE Graphics::TBitmap* __fastcall ReSizeBitmap(Graphics::TBitmap* bitmap, int width, int + height); +extern PACKAGE Graphics::TBitmap* __fastcall CropBitmap(Graphics::TBitmap* bitmap, int width, int height + , const Windows::TRect &Clip); +extern PACKAGE Graphics::TBitmap* __fastcall MetaToBitmap(Graphics::TMetafile* metafile, int Width, + int Height); + +} /* namespace Mwajpeg */ +#if !defined(NO_IMPLICIT_NAMESPACE_USE) +using namespace Mwajpeg; +#endif +//-- end unit ---------------------------------------------------------------- +#endif // mwajpeg diff --git a/CDopping/jpg3s/MWAJPEG.OBJ b/CDopping/jpg3s/MWAJPEG.OBJ new file mode 100644 index 0000000..c1c5da4 Binary files /dev/null and b/CDopping/jpg3s/MWAJPEG.OBJ differ diff --git a/CDopping/jpg3s/MWAJPGC3.BPL b/CDopping/jpg3s/MWAJPGC3.BPL new file mode 100644 index 0000000..391e522 Binary files /dev/null and b/CDopping/jpg3s/MWAJPGC3.BPL differ diff --git a/CDopping/jpg3s/MWAKEY.ASC b/CDopping/jpg3s/MWAKEY.ASC new file mode 100644 index 0000000..279211c --- /dev/null +++ b/CDopping/jpg3s/MWAKEY.ASC @@ -0,0 +1,16 @@ +Type Bits/KeyID Date User ID +pub 1024/1028B231 1997/02/17 MWA Software + +-----BEGIN PGP PUBLIC KEY BLOCK----- +Version: 2.6.3i + +mQCNAzMIL8cAAAEEAPStAr1wfLNg9gb/U0siXl9vUDl/CQvPHyNBmNa+D+DCl4W5 +QFgxGwVBwXrUMbHY/iwDat1QRgt1KFk4iGpwLXK9IltWhzqk+jHJHEEdS401c1cF +eCcsS2+DZHKbQ/Gk9VsuqZjpH2k4B86S0EPXMXtJDD2oyWl1ieDA0S0QKLIxAAUR +tClNV0EgU29mdHdhcmUgPHNhbGVzQG13YXNzb2NzLmRlbW9uLmNvLnVrPokAlQMF +EDMIL8fgwNEtECiyMQEBcHUEAL/B+MJ6ECnTOSbI5Ui5svpJwWV0PFvxUpS8nHCz +VOA4lk7PasRGljJJrop7W25KG+kkrv/uaUo1X/gsiAczszOxN56cloaWK9lAs7lX +Nvu9uapZDLSHyNlcxFnERRZAgeD0GBTDiMKgM1ZZm9pP3u/naKLf8OYNtOErr82N +Gn/z +=lusp +-----END PGP PUBLIC KEY BLOCK----- diff --git a/CDopping/jpg3s/MWAQRJPG.H b/CDopping/jpg3s/MWAQRJPG.H new file mode 100644 index 0000000..676c586 --- /dev/null +++ b/CDopping/jpg3s/MWAQRJPG.H @@ -0,0 +1,45 @@ +//--------------------------------------------------------------------------- +#ifndef mwaQRjpgH +#define mwaQRjpgH +//--------------------------------------------------------------------------- +#include +#include +#include +#include +#include +#include +#include +#include +#include "mwajpeg.hpp" + +#if __TCPLUSPLUS__ == 0x0520 +#define PACKAGE +#pragma link "mwajpeg.obj" +#pragma link "jpeglib.obj" +#endif +//--------------------------------------------------------------------------- +class PACKAGE TQRDBJPEGImage : public TQRImage +{ +private: + bool FAutoStretch; + Mwajpeg::TJPEGFileDecompressor *FJPEGDecompressor; + System::AnsiString FDataField; + Db::TDataSet *FDataSet; + Mwajpeg::TJPEGFileDecompressor* __fastcall GetJPEGDecompressor(void); + void __fastcall SetDataSet(TDataSet* Value); +protected: + virtual void __fastcall Print(int OfsX, int OfsY); +public: + __fastcall TQRDBJPEGImage(TComponent* Owner); + void __fastcall LoadPicture(void); + virtual void __fastcall Notification(Classes::TComponent* AComponent, Classes::TOperation Operation); + +__published: + __property Db::TDataSet* DataSet = {read=FDataSet, write=SetDataSet}; + __property System::AnsiString DataField = {read=FDataField, write=FDataField}; + __property bool AutoStretch = {read=FAutoStretch, write=FAutoStretch, nodefault}; + __property Mwajpeg::TJPEGFileDecompressor* JPEGDecompressor = {read=FJPEGDecompressor, write=FJPEGDecompressor}; + +}; +//--------------------------------------------------------------------------- +#endif diff --git a/CDopping/jpg3s/MWAQRJPG.OBJ b/CDopping/jpg3s/MWAQRJPG.OBJ new file mode 100644 index 0000000..c45960e Binary files /dev/null and b/CDopping/jpg3s/MWAQRJPG.OBJ differ diff --git a/CDopping/jpg3s/MWJPEG.CNT b/CDopping/jpg3s/MWJPEG.CNT new file mode 100644 index 0000000..d57530e --- /dev/null +++ b/CDopping/jpg3s/MWJPEG.CNT @@ -0,0 +1,21 @@ +:Base mwjpeg.hlp +:Title MWA JPEG Component Library (C++Builder V3.0) +1 Contents +2 About the Component Library=Topic_ABOUTTHECOMPONENTLIBRARY +2 Installation Instructions=Topic_INSTALLATIONINSTRUCTIONS +2 Example Applications=Topic_USINGTHEJPEGDEMOAPPLICATION +2 Classes +3 TJPEGFileCompressor=Topic_TJPEGFileCompressor +3 TJPEGFileDecompressor=Topic_TJPEGFileDecompressor +3 TDBJPEGImage=Topic_TDBJPEGImage +3 TQRDBJPEGImage=Topic_TQRDBJPEGImage +1 Units=Topic_Units +2 Utility Functions +3 ReSizeBitmap=Topic_ResizeBitmap +3 CropBitmap=Topic_CropBitmap +3 MetaToBitmap=Topic_MetaToBitmap +2 Registration +3 Pricing Information=Topic_PRICINGINFORMATION +3 How to Register=Topic_HOWTOREGISTER +3 Secure Registration=Topic_SECUREREGISTRATION +3 Shareware Licence=JPEGLicence diff --git a/CDopping/jpg3s/MWJPEG.HLP b/CDopping/jpg3s/MWJPEG.HLP new file mode 100644 index 0000000..2db48ec Binary files /dev/null and b/CDopping/jpg3s/MWJPEG.HLP differ diff --git a/CDopping/jpg3s/README.TXT b/CDopping/jpg3s/README.TXT new file mode 100644 index 0000000..4ee5c79 --- /dev/null +++ b/CDopping/jpg3s/README.TXT @@ -0,0 +1,304 @@ +Readme file for the JPEG Component Library version 1.5 +======================================================= + +This file contains documentation for the JPEG Component Library by MWA Software. +This version is for Borland C++Builder 3.0. Versions for Delphi 1.0, 2.0, 3.0 and +4.0, and C++Builder 1 are also available. For further information please contact +MWA Software - + +mailto:sales@mwassocs.demon.co.uk. +http://www.demon.co.uk/mwa-soft + +ONLINE HELP IS ALSO AVAILABLE IN THE FILE mwjpeg.hlp. + +This file contains the following information: + +1. ABOUT THE COMPONENT LIBRARY +2. INSTALLATION INSTRUCTIONS +3. USING THE JPEG DEMO APPLICATION +4. PRELIMINARY SOFTWARE DOCUMENTATION +5. PRICING INFORMATION +6. HOW TO REGISTRATION +7. SECURE REGISTRATION + +1. ABOUT THE COMPONENT LIBRARY +============================== + +The JPEG Component Library provides two additional non-visual components for use +under either Delphi 1.0, 2.0, 3.0 and C++Builder 1 and 3. It also provides a Data +Aware JPEG Image component which may be used to save and access JPEG encoded +images in a database blob field. A corresponding printable component is also +provided so that you may print images from a database using Quick Reports. + +This file contains the C++Builder 3 version. Please access +http://www.demon.co.uk/mwa-soft for the remaining versions. + +The two non-visual components are TJPEGFileCompressor and TJPEGFileDecompressor. +These support compression of images to JPEG Format and decompression respectively. +The data aware component is TDBJPEGImage, and the printable component is +TQRDBJPEGImage. + +Simply installing these components JPEG enables the Delphi IDE. The components +register themselves as supporting .jpg files and the JPEG compression format and, +when you come to load an image into a TImage Picture, the JPEG format will be +found amongst the list of supported file formats. An image loaded from a JPEG +source can also be saved back to JPEG. These components support the JPEG File +Interchange Format (JFIF). + +These two components also support TImage at run-time too. As at design time, if +TJPEGFileDecompressor is included in your project, then calling +TImage.Picture.LoadFromFile when the file extension is .jpg will automatically +invoke the JPEG decompressor. You can also explicitly call TJPEGFileDecompressor +to load a JPEG image from any file. + +TJPEGFileCompressor can be used to save a TImage.Picture in JPEG format, and can +handle pictures that are either bitmaps or metafiles. It can also compress a +device independent bitmap, and change the size of bitmaps before compression. + +TDBJPEGImage is linked to a database blob field and also uses +TJPEGFileDecompressor and TJPEGFileCompressor to save and load JPEG encoded images +from the Blob Field. Use of the JPEG compressor and decompressor components can be +implicit if the default parameter settings are sufficient. On the other hand, the +reference may be explicit to copies of these components with non-default parameter +settings. TQRDBJPEGImage can be used to print a JPEG Image using Quick Reports 2. + +This software uses original software for JPEG developed by the Independent JPEG +Group (see ftp://ftp.uu.net/graphics/jpeg). The IDG have made available a library +of generic 'C' code supporting JPEG compression and decompression and have +permitted its free use provided the source is acknowledged. The IDG code has been +modified for use with Delphi and MS Windows and is provided as compiled object +files. Optionally, they may be separately compiled into a dll. + +An interface to this software is provided by the unit jpeglib.pas. This is +encapsulated as a set of Delphi components in the unit mwajpeg.pas, which also +supports the mapping of the environment independent image format expected by the +IJG code into MS Windows bitmap and metafile formats. + +When you purchase a licence to this product, you purchase a licence for the source +code to the mwajpeg and jpeglib units and the right to include binaries derived +from them in your own products without having to pay additional royalties. You +also have a right to freely distribute the mwjpeg and mwjpeg32 dlls (if used), and +copies of the modified 'C' source is also included in the registered version. +Support is also provided by EMail albeit without a guaranteed response time. + +2. INSTALLATION INSTRUCTIONS +============================ + +Installation is straightforward. The JPEG Component Library is distributed in a +.zip archive; separate versions are provided for use with Delphi 1.0, 2.0 and 3.0, +and C++Builder 1 and 3. Make sure you have the correct version and then: + +i. Create a new sub-directory in your delphi directory called "jpeg" and copy the +remaining files contained in the .zip file into this new subdirectory. You should +aim to preserve the directory names held in the zip - if you are using pkunzip +them use the -d option when unzipping the files. Note that if you do use a different +directory from that suggested then you will have to modify the demo programs' .mak +files to change the search path for the JPEG components. + +iii. Start the C++Builder IDE and choose the Component|Install Packages menu item. +Click on the "Add" button and browse for the mwjpegc3.bpl file you just copied to +the new subdirectory. Click on OK. The package will now be installed. By +default the JPEG components are placed on the "Additional" tab, TDBJPEGImage is on +the Data Controls tab, and TQRDBJPEGImage is on the QReports tab. + +iv. You should now add ";$(BCB)\jpeg" to the end of the library path in the +Tools|Environment Options dialog box (it's on the Library tab). This is so that the +jpeg components can be automatically found in any project of yours that uses them. + +You should now restart C++Builder before trying to load a JPEG Image at Design +Time. + +--------------- + +The components are now installed. Use the demo application to learn how they are +used. + +3. USING THE JPEG DEMO APPLICATION +================================== + +Two demo applications are provided. A JPEG Viewer application demonstrates the +opening and saving JPEG image files and conversion to and from bitmap files (.bmp) +and from Windows Metafiles (.wmf). A database application demonstrates use of the +data aware component. + +The JPEG Viewer application may be found in the Examples\Viewer subdirectory +created above. To activate, load the jpegdemo.bpr file into the IDE using the +File|Open Project menu item. This provides a simple application that can open and +save .jpg (JPEG), .bmp (Windows Bitmap) and .wmf (Windows metfaile) files, and +copy and paste bitmaps and metafiles to and from the clipboard. To test out, +simply compile and run the application. + +To load and view a JPEG file, click on the open button and load the test.jpg file +contained in the subdirectory created above. You can also try saving it to another +file name (you can save it as either a JPEG or a bitmap). You can also use the +demo application to convert windows bitmaps and metafiles to jpegs simply by +opening the file containing them (or pasting from the clipboard) and saving them +as jpegs. The viewer window can also be resized by simply dragging the bottom +right hand corner with the mouse. Saving the image will save it at the new size. + +The application also demonstrates a simple method for printing a JPEG Image using +Quick Reports (even with no database). + +You can also use the Object Inspector to see the properties published by the two +JPEG components. + +The JPEG database application may also be found in the Examples\db subdirectory +created above. To activate, load the DBDemo.bpr file into the IDE using the +File|Open Project menu item. This application is an extension of the Viewer and +presents images held in an example database. The database records may be perused +using the DBNavigator bar provided. It is still possible to save images from the +database record and to replace/insert images from files or the clipboard. The +application also demonstrates how to print a report including JPEG Images. + +4. SOFTWARE DOCUMENTATION +========================= + +See the online help file "mwjpeg.hlp" + +5. PRICING INFORMATION +====================== + +JPEG Component Library Source Licence 12 pounds sterling (US$20) + +US dollar prices are for indicative pricing only and assume an exchange rate of +one pound = $1.66. All prices are VAT exclusive. UK VAT (currently 17.5%) will be + +charged for all UK residents and EC residents that are not VAT registered or do +provide a VAT number as proof of registration. + + +6. HOW TO REGISTER +================== + +Registration may be made by FAX, Letter Post or EMail. For FAX and Letter Post +registrations, a Registration Form is provided in the File "regform.txt" for you +to EMail or print out (FAX or letter post), complete, and send to MWA Software. +You can also register using the Compuserve Shareware Registration Service (GO +SWREG). The software is registered under the name "MWA JPEG Component Library". + +Visa, Mastercard, Eurocard and JCB are accepted as payment mechanisms. +International money orders in pounds sterling and cheques drawn on UK Bank +Accounts are also accepted. US Dollar denominated checks are also acceptable +provided that an additional 10% is added to the purchase price to allow for the +additional Bank Charge. Please make cheques payable to McCallum Whyman Associates +Ltd. + +EMail registrations should be sent to: + Internet: sales@mwassocs.demon.co.uk, or + Compuserve: 100041,315 + +FAX: + UK: 01962 735581 + Int: +44 1962 735581 + +MWA Software, +P.O.Box 37, +Alresford, +Hants, +SO24 9ZF, +ENGLAND + + +All registrations are accepted on the basis that the registered user will be +deemed to have accepted and be bound by the licence conditions for the registered +versions of JPEG component library as recorded in the file reg-lnce.txt supplied +with the evaluation version of the software. + +7. Secure Registration by EMail +================================ + +There are two routes by which you can EMail your credit card details to MWA +Software without incurring the risk of sending a credit card number in clear +across the Internet. One route is to use the encryption mechanism provided by +pkzip. The other is to use PGP. + +pkzip encryption will generally be good enough to avoid detection by the so called +"sniffer" programs that are understood to monitor EMail communications, looking +for numbers that look like credit cards. However, it is not believe to be good +enough to resist a determined attack by someone who has access to the necessary +skills in cryptography and a powerful enough computer. On the other hand PGP is +understood to offer a very strong level of protection. MWA Software makes no +recommendations as to which is the better approach. It is for you to decide based +on your own location and concerns. + +Secure Transmission using pkzip. +================================ + +pkzip can encrypt files in a .zip archive using a simple password. To register for +the JPEG Component Library by EMail when using pkzip as your encryption engine: + +1. Using the file "regform.txt" as a template, complete a registration form for +the JPEG Component Library. Remember to include your credit card details, billing +address and your name as it appears on your credit card. + +2. Choose a password. Opening a dictionary at some random page is often a good way +to do this. For example, let's assume that you choose NERVOUS as your password. + +3. Compress and encrypt the modified regform.txt using pkzip and the -s option to +encrypt. For example, with NERVOUS as your password, use the command line: + +pkzip -sNERVOUS regform regform.txt + +This will create regform.zip containing your compressed and encryted registration +details. + +4. EMail regform.zip to MWA Software. Your own EMail utility will usually have a +way to send binary attachments to an EMail message. If you do not have such a +capability then you can use the J-Write Text Editor (also available from MWA +Software) to uuencode a binary file into a text form suitable for attaching to an +EMAil message. This feature is available from the File|Merge menu item. + +The MWA Software EMail address is sales@mwassocs.demon.co.uk. +Set the subject to "JPEG Registration" + +5. Send the password you choose at step 2 in a separate EMail to MWA Software. For +best protection, use our Compuserve EMail address: + +100041.315@compuserve.com + +Set the subject to "re: JPEG Registration" + +Secure Transmission using PGP +============================= + +PGP is a powerful data encryption tool that has been made publicly available by +its author "Phillip Zimmermann". It is sufficiently good to attract the attentions +of various government's agency's and you should be aware that in certain countries +the use of such encryption software is a criminal offence. MWA Software only uses +PGP to decrypt registrations and does not send encrypted EMail. Having said that, +the international version of PGP can be obtained from: + +http://www.ifi.uio.no/pgp/ + +The following URL is also a good source of information about PGP, including +information on how to get the more limited US version. + +http://www.arc.unm.edu/~drosoff/pgp/pgp.html + +To encrypt a registration using PGP, do the following: + +1. Using the file "regform.txt" as a template, complete a registration form for +the JPEG Component Library. Remember to include your credit card details, billing +address and your name as it appears on your credit card. + +2. Encrypt regform.txt using PGP and the MWA public key. This is provided in the +file "mwakey.asc", which should be in the same archive as this file. This will +typically be performed by the following commands (the ; indicates the start of a +comment): + +pgp -ka mwakey.asc ;add MWA key to your public keyring +pgp -ea regform.txt "MWA Software" ;encrypt and encode for EMail +pgp -kr "MWA Software" ;remove the MWA key from your keyring + +The above will have created the encrypted file "regform.pgp". This is a text file +and may be sent as part of a normal EMail to MWA Software: + +sales@mwassocs.demon.co.uk + +Set the subject to "JPEG Registration" + +If you have any reason to doubt the validity of the MWA key, request an up-to-date +version by EMail to the above address, with a subject of "Key Verification +Request". + +Thank you for registering forthe JPEG Component Library. diff --git a/CDopping/jpg3s/REGFORM.TXT b/CDopping/jpg3s/REGFORM.TXT new file mode 100644 index 0000000..5b5e4fe --- /dev/null +++ b/CDopping/jpg3s/REGFORM.TXT @@ -0,0 +1,42 @@ +Registration Form for JPEG Component Library +============================================ + +PLEASE SUPPLY ONE LICENCE FOR : + +JPEG Component Library Source Licence 12 pounds sterling (US$20) + +US dollar prices are for indicative pricing only and assume an exchange rate of +one pound = $1.66. All credit cards will be billed in pounds and converted to your +local currency by the credit company at current market rates. All prices are VAT +exclusive. UK VAT (currently 17.5%) will be charged for all UK residents and EC +residents that are not VAT registered or do not provide a VAT number as proof of +registration. + +PLEASE CHARGE MY CREDIT CARD FOR THE FULL PURCHASE PRICE INCLUDING VAT WHERE +APPLICABLE AS FOLLOWS: + +Credit Card No: +Expiry Date: +Name as it appears on credit card: +Billing Address: +EMail Address: + +All registrations are accepted on the basis that the registered user will be +deemed to have accepted and be bound by the licence conditions for the registered +versions of the JPEG component library as recorded in the on-line +help file supplied with the evaluation version of the software. + +EMail registrations should be sent to: + Internet: sales@mwassocs.demon.co.uk, or + Compuserve: 100041,315 + +FAX: + UK: 01962 735581 + Int: +44 1962 735581 + +MWA Software, +P.O.Box 37, +Alresford, +Hants, +SO24 9ZF, +ENGLAND diff --git a/CDopping/jpg3s/WHATS.NEW b/CDopping/jpg3s/WHATS.NEW new file mode 100644 index 0000000..4676bca --- /dev/null +++ b/CDopping/jpg3s/WHATS.NEW @@ -0,0 +1,81 @@ +JPEG Component Library Version 1.5 Release Notes +================================================ + +This is version 1.5 of MWA Software's popular JPEG Component Library. +New in this release: + +1. This release is primarily for Delphi 4 support and to ensure a common +software base is maintained. + +2. Two new methods "LoadPictureFromResource" and "LoadPictureFromResID" +are provided so that JPEG images can be packaged with a program as +resources and then loaded at run-time. This can save considerable space +compared with loading an image into TImage at run-time. See the help for +information on how to use this feature and the Viewer Demo application, +which includes a JPEG resource in its about box. + +3. The Delphi 3 version should now install into the IDE without +generating a "A Device Attached to the System is not Working" error +message. This was due to the components having been compiled on a system +with Quick Reports Professional installed. This error message was +experienced by users that used the standard version shipped by Borland. + +New features in Version 1.4: + +1. Support for C++Builder 3.0. The component library now also supports +C++Builder 3.0. The functionality is identical to the other versions +and a common source base is still maintained. + +2. No DLL required for Delphi 3, and all versions of C++Builder. +Version 1.3 required a separate dll for the JPEG compression software. +This is no longer true for Delphi 3 and C++Builder. By default the +JPEG software is linked into your program - dll support is still +available as a command line option. + +3. Dynamic dll loading. The Delphi 1 and Delphi 2 versions now load +the JPEG dll dynamically. This enables a more meaningful error message +to be returned if the library cannot be found. The version 1.3 static +load is still available as an option. + +4. A new visual component - TDBJPEGImage has been provided. This is a +data aware descendant of TImage that stores images in a database blob +field using JPEG compression. + +5. Quick Reports support: with Quick Reports version 1, the +TDBJPEGImage may be included on a report. For version 2, a new +component TQRJPEGImage is provided so that you can print JPEG images +direct from a database. + +Bug Fixes: +--------- + +1. Parameters to TStream.Seek in TJPEGCompressor.SkipInputBytes now +the correct way round :( Why didn't Borland make the "ORigin" +parameter an enumerated type then this typo would have been a compile +time error! + +2. The error code returned from PlayEnhMetaFile is now returned in the +error messsage + +3. The decompressor now has a property (ColoursIn8bitMode) that allows +the user to specify the actual numbers of discrete colours in the +image when decoding to a 256 colour image. This used to be 256. +However, a lower number can avoid a colour cast especially with Blank +and White images encoded as full colour images. The default is now 64. + +4. When the buffer size is changed the buffer will now be freed and +reallocated. + +5. An event handler for warning messages has been added. + +6. You should now be able to correctly save JPEG images when working +in the IDE and want to save an image as a JPEG at design time (but +only when the image was loaded from a JPEG source - the IDE cannot be +used to convert JPEG's to bitmaps, but it can be used to convert from +JPEGs to bitmaps. + +7. OnProgressReport now spelt correctly! Note that uses upgrading from +earlier versions will experience an error message when loading +projects that use the JPEG Component Library reporting that the mis- +spelt property name cannot be found. Ignore this error and manually +direct the "OnProgressReport" to its event handler. \ No newline at end of file diff --git a/CDopping/jpg3s/mwjpeg.GID b/CDopping/jpg3s/mwjpeg.GID new file mode 100644 index 0000000..ff40b91 Binary files /dev/null and b/CDopping/jpg3s/mwjpeg.GID differ diff --git a/CabForCB.rar b/CabForCB.rar new file mode 100644 index 0000000..54c594c Binary files /dev/null and b/CabForCB.rar differ diff --git a/Impotante.txt b/Impotante.txt new file mode 100644 index 0000000..3dd1aa0 --- /dev/null +++ b/Impotante.txt @@ -0,0 +1,7 @@ +*.BPI |___\ +*.LIB | / /LIB + + +*.BPL |---> /BIN + + diff --git a/README.md b/README.md new file mode 100644 index 0000000..a307ba5 --- /dev/null +++ b/README.md @@ -0,0 +1,9 @@ +#Componentes + + +*19/07/1998* + +ToDo: wwtcf? + + +![screenshot](/Componentes.png "Screenshot") diff --git a/TCalendario.cpp b/TCalendario.cpp new file mode 100644 index 0000000..d190820 --- /dev/null +++ b/TCalendario.cpp @@ -0,0 +1,25 @@ +//--------------------------------------------------------------------------- +#include +#pragma hdrstop + +#include "TCalendario.h" +//--------------------------------------------------------------------------- +static inline Calendario *ValidCtrCheck() +{ + return new Calendario(NULL); +} +//--------------------------------------------------------------------------- +__fastcall Calendario::Calendario(TComponent* Owner) + : TWinControl(Owner) +{ +} +//--------------------------------------------------------------------------- +namespace Tcalendario +{ + void __fastcall Register() + { + TComponentClass classes[1] = {__classid(Calendario)}; + RegisterComponents("JD Soft.", classes, 0); + } +} +//--------------------------------------------------------------------------- diff --git a/TCalendario.h b/TCalendario.h new file mode 100644 index 0000000..56532be --- /dev/null +++ b/TCalendario.h @@ -0,0 +1,19 @@ +//--------------------------------------------------------------------------- +#ifndef TCalendarioH +#define TCalendarioH +//--------------------------------------------------------------------------- +#include +#include +#include +#include +//--------------------------------------------------------------------------- +class Calendario : public TWinControl +{ +private: +protected: +public: + __fastcall Calendario(TComponent* Owner); +__published: +}; +//--------------------------------------------------------------------------- +#endif diff --git a/TCalendario.ico b/TCalendario.ico new file mode 100644 index 0000000..9a754a9 Binary files /dev/null and b/TCalendario.ico differ diff --git a/cleanup.bat b/cleanup.bat new file mode 100644 index 0000000..5e4c8b5 --- /dev/null +++ b/cleanup.bat @@ -0,0 +1,3 @@ +del *.~* +del *.tds +del *.obj diff --git a/imageLib/ColImage.bpi b/imageLib/ColImage.bpi new file mode 100644 index 0000000..1cdd584 Binary files /dev/null and b/imageLib/ColImage.bpi differ diff --git a/imageLib/ColImage.bpl b/imageLib/ColImage.bpl new file mode 100644 index 0000000..1386e55 Binary files /dev/null and b/imageLib/ColImage.bpl differ diff --git a/imageLib/ColImage.lib b/imageLib/ColImage.lib new file mode 100644 index 0000000..776c9a3 Binary files /dev/null and b/imageLib/ColImage.lib differ diff --git a/imageLib/README.TXT b/imageLib/README.TXT new file mode 100644 index 0000000..3b29891 --- /dev/null +++ b/imageLib/README.TXT @@ -0,0 +1,34 @@ +What's in here +--------------- +The package ColImage contains encoders and decoders for the JPEG, GIF, +and PNG formats that are compatible with VCL/C++Builder. + +How To Use It +-------------- +1. Load the Project Group Image +2. Build The LibImage Project +3. Build the ColImage Project +4. Copy ColImage.BPI, ColImage.BPL, ColImage.LIB to the appropriate +directories. The standard location are the C++Builder /LIB directory +for the .BPI and .LIB files and the /BIN directory for the .BPL file. +5. Select COMPONENT|INSTALL|ADD and add ColImage.BPL + +At this point you should be able to use JPEG, GIF, and PNG files in +design mode. Try creating a project and add an image control to it. +If you double click on the Picture property in the object inspector +you should be able to load these new image formats. + +To use these format in a project add the statement + +LoadPackage ("COLIMAGE.BPL") ; + +to your project's source module. Otherwise you may get errors messages +about undefined file formats. + + +*****A WORD OF CAUTION ***** +---------------------------- +When you build ColImage.BPI you cannot use the dynamic RTL. You must ensure +that the Project|Options|Linker|Use debug libraries is not checked. + + diff --git a/imageLib/gifimage.h b/imageLib/gifimage.h new file mode 100644 index 0000000..b32e4e6 --- /dev/null +++ b/imageLib/gifimage.h @@ -0,0 +1,46 @@ +//--------------------------------------------------------------------------- +#ifndef gifimageH +#define gifimageH +//--------------------------------------------------------------------------- +#include +#include +#include +#include + +#include "gifdecod.h" +#include "gifencod.h" + +//--------------------------------------------------------------------------- +class PACKAGE TGifImage : public TGraphic +{ +private: + BitmapImage image ; + GifDecoder decoder ; + GifEncoder encoder ; + + Graphics::TBitmap *bitmap ; + +protected: + +public: + virtual __fastcall TGifImage(); + virtual __fastcall ~TGifImage(); + virtual void __fastcall Draw (TCanvas *canvas, const TRect &rect) ; + virtual bool __fastcall GetEmpty () ; + virtual int __fastcall GetHeight () ; + virtual int __fastcall GetWidth () ; + virtual void __fastcall SetHeight (int) ; + virtual void __fastcall SetWidth (int) ; + virtual void __fastcall LoadFromStream (TStream *) ; + virtual void __fastcall SaveToStream (TStream *) ; + virtual void __fastcall LoadFromClipboardFormat (Word, int, HPALETTE) ; + virtual void __fastcall SaveToClipboardFormat (Word &, int &, HPALETTE &) ; + virtual void __fastcall SetPalette (HPALETTE) ; + virtual void __fastcall Assign (TPersistent *source) ; + virtual void __fastcall AssignTo (TPersistent *dest) ; + virtual HPALETTE __fastcall GetPalette () ; + +__published: +}; +//--------------------------------------------------------------------------- +#endif diff --git a/imageLib/imagelib.zip b/imageLib/imagelib.zip new file mode 100644 index 0000000..edefa08 Binary files /dev/null and b/imageLib/imagelib.zip differ diff --git a/imageLib/jpgimage.h b/imageLib/jpgimage.h new file mode 100644 index 0000000..5aec1c7 --- /dev/null +++ b/imageLib/jpgimage.h @@ -0,0 +1,48 @@ +//--------------------------------------------------------------------------- +#ifndef jpgimageH +#define jpgimageH +//--------------------------------------------------------------------------- +#include +#include +#include +#include + +#include "jpegenco.h" +#include "jpegdeco.h" + +//--------------------------------------------------------------------------- +class PACKAGE TJpegImage : public TGraphic +{ +private: + BitmapImage image ; + JpegEncoder encoder ; + JpegDecoder decoder ; + + Graphics::TBitmap *bitmap ; + +protected: + virtual JpegEncoder * __fastcall GetEncoder () ; + +public: + virtual __fastcall TJpegImage(); + virtual __fastcall ~TJpegImage(); + virtual void __fastcall Draw (TCanvas *canvas, const TRect &rect) ; + virtual bool __fastcall GetEmpty () ; + virtual int __fastcall GetHeight () ; + virtual int __fastcall GetWidth () ; + virtual void __fastcall SetHeight (int) ; + virtual void __fastcall SetWidth (int) ; + virtual void __fastcall LoadFromStream (TStream *) ; + virtual void __fastcall SaveToStream (TStream *) ; + virtual void __fastcall LoadFromClipboardFormat (Word, int, HPALETTE) ; + virtual void __fastcall SaveToClipboardFormat (Word &, int &, HPALETTE &) ; + virtual void __fastcall SetPalette (HPALETTE) ; + virtual void __fastcall Assign (TPersistent *source) ; + virtual void __fastcall AssignTo (TPersistent *dest) ; + + __property JpegEncoder *Encoder = { read = GetEncoder } ; + +__published: +}; +//--------------------------------------------------------------------------- +#endif diff --git a/imageLib/libimage.lib b/imageLib/libimage.lib new file mode 100644 index 0000000..cde93b7 Binary files /dev/null and b/imageLib/libimage.lib differ diff --git a/imageLib/pngimage.h b/imageLib/pngimage.h new file mode 100644 index 0000000..01fb5d3 --- /dev/null +++ b/imageLib/pngimage.h @@ -0,0 +1,48 @@ +//--------------------------------------------------------------------------- +#ifndef pngimageH +#define pngimageH +//--------------------------------------------------------------------------- +#include +#include +#include +#include + +#include "pngencod.h" +#include "pngdecod.h" + +//--------------------------------------------------------------------------- +class PACKAGE TPngImage : public TGraphic +{ +private: + BitmapImage image ; + PngEncoder encoder ; + PngDecoder decoder ; + + Graphics::TBitmap *bitmap ; + +protected: + virtual PngEncoder * __fastcall GetEncoder () ; + +public: + virtual __fastcall TPngImage(); + virtual __fastcall ~TPngImage(); + virtual void __fastcall Draw (TCanvas *canvas, const TRect &rect) ; + virtual bool __fastcall GetEmpty () ; + virtual int __fastcall GetHeight () ; + virtual int __fastcall GetWidth () ; + virtual void __fastcall SetHeight (int) ; + virtual void __fastcall SetWidth (int) ; + virtual void __fastcall LoadFromStream (TStream *) ; + virtual void __fastcall SaveToStream (TStream *) ; + virtual void __fastcall LoadFromClipboardFormat (Word, int, HPALETTE) ; + virtual void __fastcall SaveToClipboardFormat (Word &, int &, HPALETTE &) ; + virtual void __fastcall SetPalette (HPALETTE) ; + virtual void __fastcall Assign (TPersistent *source) ; + virtual void __fastcall AssignTo (TPersistent *dest) ; + + __property PngEncoder *Encoder = { read = GetEncoder } ; + +__published: +}; +//--------------------------------------------------------------------------- +#endif