paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-10 01:55:56 +02:00
Code Issues Packages Projects Releases Wiki Activity

added TSelectDirectoryDialog

Browse Source 
git-svn-id: trunk@4479 -
This commit is contained in:
mattias 2003-08-14 10:36:55 +00:00
parent b6e5e33680
commit fa73dc5669
11 changed files with 275 additions and 765 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.gitattributes vendored
View File

@ -322,7 +322,6 @@ ide/codetoolsoptions.pas svneol=native#text/pascal
ide/compiler.pp svneol=native#text/pascal
ide/compileroptions.pp svneol=native#text/pascal
ide/componentpalette.pas svneol=native#text/pascal
ide/compreg.pp svneol=native#text/pascal
ide/customformeditor.pp svneol=native#text/pascal
ide/debugmanager.pas svneol=native#text/pascal
ide/debugoptionsfrm.lfm svneol=native#text/plain
@ -343,7 +342,6 @@ ide/findreplacedialog.pp svneol=native#text/pascal
ide/formeditor.pp svneol=native#text/pascal
ide/global.inc svneol=native#text/pascal
ide/global.pp svneol=native#text/pascal
ide/idecomp.pp svneol=native#text/pascal
ide/idedefs.pas svneol=native#text/pascal
ide/ideoptiondefs.pas svneol=native#text/pascal
ide/ideprocs.pp svneol=native#text/pascal
@ -533,6 +531,7 @@ images/components/tsavepicturedialog.xpm -text svneol=native#image/x-xpixmap
images/components/tscrollbar.ico -text svneol=unset#image/x-icon
images/components/tscrollbar.xpm -text svneol=native#image/x-xpixmap
images/components/tscrollbox.xpm -text svneol=native#image/x-xpixmap
images/components/tselectdirectorydialog.xpm -text svneol=native#image/x-xpixmap
images/components/tshape.xpm -text svneol=native#image/x-xpixmap
images/components/tspeedbutton.ico -text svneol=unset#image/x-icon
images/components/tspeedbutton.xpm -text svneol=native#image/x-xpixmap

316
ide/compreg.pp
View File

@ -1,316 +0,0 @@
{
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
* *
***************************************************************************
Author: Mattias Gaertner
Abstract:
All components that should be usable to the IDE must register themselves.
There is a list of all components. And every component can also be found
in the list of its component page.
ToDo:
see XXX
}
unit CompReg;
{$MODE OBJFPC}{$H+}
{$IFNDEF DisablePkgs}
This unit will be deleted in future
{$ENDIF}
interface
uses Classes, SysUtils;
type
TRegisteredComponentPage = class;
TRegisteredComponentList = class;
TRegisteredComponent = class
// describes a single component
private
FPage:TRegisteredComponentPage;
FComponentClass:TComponentClass;
FIndexInPage:integer;
FUnitName:ShortString;
public
property Page:TRegisteredComponentPage read FPage;
property ComponentClass:TComponentClass read FComponentClass;
property IndexInPage:integer read FIndexInPage;
property UnitName:ShortString read FUnitName;
constructor Create(APage:TRegisteredComponentPage; TheIndexInPage:integer;
AUnitName:ShortString; AComponentClass:TComponentClass);
end;
TRegisteredComponentPage = class
// describes the components in a single component page
private
FPageIndex:integer;
FName:ShortString;
FItems:TList;
FCompList:TRegisteredComponentList;
function GetItem(Index:integer):TRegisteredComponent;
Function GetCount : Integer;
public
property Items[Index:integer]:TRegisteredComponent read GetItem; default;
property Count:integer read GetCount;
property PageIndex:integer read FPageIndex;
property Name:ShortString read FName;
property CompList:TRegisteredComponentList read FCompList;
constructor Create(ACompList:TRegisteredComponentList; APageIndex:integer;
PageName:ShortString);
destructor Destroy; override;
end;
TRegisteredComponentList = class
// a list of all registered components and all component pages
private
FItems:TList;
FPages:TList;
function GetItem(Index:integer):TRegisteredComponent;
function GetPage(Index:integer):TRegisteredComponentPage;
public
procedure RegisterComponents(const Page:ShortString; UnitName:ShortString;
ComponentClasses: array of TComponentClass);
property Items[Index:integer]:TRegisteredComponent read GetItem; default;
function Count:integer;
function FindComponentClassByName(Name:ShortString):TRegisteredComponent;
property Pages[Index:integer]:TRegisteredComponentPage read GetPage;
function PageCount:integer;
function FindPageByName(Name:ShortString):TRegisteredComponentPage;
procedure Clear;
constructor Create;
destructor Destroy; override;
end;
type
TRegisterComponentsProc = procedure(const Page,UnitName:ShortString;
ComponentClasses: array of TComponentClass);
var
RegisterComponentsProc: TRegisterComponentsProc;
procedure RegisterComponent(const Page,UnitName:ShortString;
ComponentClass: TComponentClass);
procedure RegisterComponents(const Page,UnitName:ShortString;
ComponentClasses: array of TComponentClass);
function FindRegsiteredComponentClass(
const AClassName: string): TRegisteredComponent;
var
RegCompList: TRegisteredComponentList;
implementation
procedure RegisterComponent(const Page, UnitName: ShortString;
ComponentClass: TComponentClass);
begin
if RegCompList<>nil then
RegCompList.RegisterComponents(Page,UnitName,[ComponentClass])
else
raise EComponentError.Create(
'RegisterComponentsInGlobalList RegCompList=nil');
end;
procedure RegisterComponents(const Page,UnitName:ShortString;
ComponentClasses: array of TComponentClass);
begin
if Assigned(RegisterComponentsProc) then
RegisterComponentsProc(Page, UnitName, ComponentClasses)
else begin
raise EComponentError.Create(
'[RegisterComponents] Error: RegisterComponentsProc not assigned.'
{SRegisterError});
end;
end;
function FindRegsiteredComponentClass(
const AClassName: string): TRegisteredComponent;
begin
Result:=nil;
if RegCompList<>nil then begin
Result:=RegCompList.FindComponentClassByName(AClassName);
end;
end;
procedure RegisterComponentsInGlobalList(const Page,UnitName:ShortString;
ComponentClasses: array of TComponentClass);
begin
if RegCompList<>nil then
RegCompList.RegisterComponents(Page,UnitName,ComponentClasses)
else
raise EComponentError.Create(
'RegisterComponentsInGlobalList RegCompList=nil');
end;
{ TRegisteredComponent }
constructor TRegisteredComponent.Create(APage:TRegisteredComponentPage;
TheIndexInPage:integer; AUnitName:ShortString;
AComponentClass:TComponentClass);
begin
FPage:=APage;
FIndexInPage:=TheIndexInPage;
FComponentClass:=AComponentClass;
FUnitName:=AUnitName;
end;
{ TRegisteredComponentPage }
constructor TRegisteredComponentPage.Create(ACompList:TRegisteredComponentList;
APageIndex:integer; PageName:ShortString);
begin
FName:=PageName;
FCompList:=ACompList;
FPageIndex:=APageIndex;
FItems:=TList.Create;
end;
destructor TRegisteredComponentPage.Destroy;
begin
FItems.Free;
end;
function TRegisteredComponentPage.GetItem(Index:integer):TRegisteredComponent;
begin
Result:=TRegisteredComponent(FItems[Index]);
end;
function TRegisteredComponentPage.GetCount:Integer;
begin
Result:= FItems.Count;
end;
{ TRegisteredComponentList }
constructor TRegisteredComponentList.Create;
begin
FItems:=TList.Create;
FPages:=TList.Create;
end;
destructor TRegisteredComponentList.Destroy;
begin
Clear;
FPages.Free;
FItems.Free;
end;
procedure TRegisteredComponentList.Clear;
var a:integer;
begin
for a:=0 to FItems.Count-1 do
Items[a].Free;
FItems.Clear;
for a:=0 to FPages.Count-1 do
Pages[a].Free;
FPages.Clear;
end;
function TRegisteredComponentList.GetItem(Index:integer):TRegisteredComponent;
begin
Result:=TRegisteredComponent(FItems[Index]);
end;
function TRegisteredComponentList.Count:integer;
begin
Result:=FItems.Count;
end;
function TRegisteredComponentList.FindComponentClassByName(
Name:ShortString):TRegisteredComponent;
var a:integer;
begin
Name:=uppercase(Name);
for a:=0 to FItems.Count-1 do begin
if uppercase(Items[a].FComponentClass.ClassName)=Name then begin
Result:=Items[a];
exit;
end;
end;
Result:=nil;
end;
procedure TRegisteredComponentList.RegisterComponents(const Page:ShortString;
UnitName:ShortString; ComponentClasses: array of TComponentClass);
var NewPage:TRegisteredComponentPage;
a:integer;
NewComp:TRegisteredComponent;
begin
// the hidden page is the empty ''
if (High(ComponentClasses)-Low(ComponentClasses)<0)
or (UnitName='') then exit;
if not IsValidIdent(UnitName) then begin
raise EComponentError.Create(
'RegisterComponents: Invalid unitname "'+UnitName+'"');
end;
NewPage:=FindPageByName(Page);
if (NewPage=nil) then begin
NewPage:=TRegisteredComponentPage.Create(Self,FPages.Count,Page);
FPages.Add(NewPage);
end;
for a:=Low(ComponentClasses) to High(ComponentClasses) do begin
NewComp:=TRegisteredComponent.Create(NewPage,NewPage.Count,UnitName,
ComponentClasses[a]);
FItems.Add(NewComp);
NewPage.FItems.Add(NewComp);
end;
end;
function TRegisteredComponentList.PageCount:integer;
begin
Result:=FPages.Count;
end;
function TRegisteredComponentList.GetPage(Index:integer):TRegisteredComponentPage;
begin
Result:=TRegisteredComponentPage(FPages[Index]);
end;
function TRegisteredComponentList.FindPageByName(
Name:ShortString):TRegisteredComponentPage;
var a:integer;
begin
Name:=uppercase(Name);
for a:=0 to FPages.Count-1 do begin
if uppercase(Pages[a].Name)=Name then begin
Result:=Pages[a];
exit;
end;
end;
Result:=nil;
end;
initialization
RegisterComponentsProc:=nil;
RegCompList := TRegisteredComponentList.Create;
RegisterComponentsProc := @RegisterComponentsInGlobalList;
finalization
RegCompList.Free;
RegCompList:=nil;
end.

431
ide/idecomp.pp
View File

@ -1,431 +0,0 @@
{
/***************************************************************************
idecomp.pp
----------
TIDEComponent
Initial Revision : Sun Mar 28 23:15:32 CST 1999
***************************************************************************/
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
* *
***************************************************************************
}
unit IDEComp;
{$mode objfpc}{$H+}
{ $DEFINE INTERBASE}
{$IFDEF INTERBASE}
{$linklib crypt}
{$ENDIF}
{$IFNDEF DisablePkgs}
{$error This unit will be deleted in future}
{$ENDIF}
interface
uses
Classes, LclLinux,
// fcl
Process, db,
{$IFDEF INTERBASE}
// WANRING: Don't use this, use CustomIDEComps instead
interbase,
{$ENDIF}
// LCL
StdCtrls, Forms, Buttons, Menus, ComCtrls, Arrow,
Spin, SysUtils, Controls, CompReg, Graphics, ExtCtrls, Dialogs, Calendar,
ImgList, Grids, LResources, MaskEdit, CheckLst,
// synedit
SynEditLazDsgn, SynEdit, SynCompletion, SynExportHTML, SynMacroRecorder,
SynMemo, SynHighlighterPas, SynHighlighterCPP, SynHighlighterJava,
SynHighlighterPerl, SynHighlighterHTML, SynHighlighterXML,
SynHighlighterLFM, SynHighlighterMulti
// custom components
{$IFDEF CustomIDEComps}
,CustomIDEComps
{$ENDIF}
;
const
ComponentPaletteBtnWidth = 25;
ComponentPaletteBtnHeight = 25;
type
{--------------------------------------------
Created by Shane Miller
This class is used for adding controls to the toolbar to be
dropped onto a form
---------------------------------------------}
TIDEComponent = class(TObject)
private
{The speedbutton that's displayed on the IDE control bar}
FSpeedButton : TSpeedButton;
{This is the @link(TRegisteredComponent) from compreg.pp.}
FRegisteredComponent : TRegisteredComponent;
protected
{Loads the image (from a resource) into a @link(TPixMap)}
Function LoadImageintoPixmap : TPixmap;
public
constructor Create;
destructor Destroy; override;
{Public access to create the Speedbutton.}
Function _Speedbutton(AOwner : TComponent; nParent: TWinControl): TSpeedButton;
{Public access to @link(FSpeedbutton)}
property SpeedButton : TSpeedButton read FSpeedButton write FSPeedbutton;
{Public access to @link(FRegisteredComponent)}
property RegisteredComponent : TRegisteredComponent
read FRegisteredComponent write FRegisteredComponent;
end;
{-------------------------------------------
Created by Shane Miller
This class keeps a list of TIDEComponents
--------------------------------------------}
TIDECompList = Class(TObject)
private
{The list of @link(TIdeComponent)s used in the IDE.}
FItems : TList;
{Used to count the @link(TIdeComponent)s used in the IDE. Checks FItems.Count}
Function GetCount : Integer;
public
constructor Create;
destructor Destroy; override;
{You can pass the Speedbutton and find the @link(TIdeComponent).
This can be used when the Speedbutton is clicked and you want to find out
what the @link(TRegisteredComponent) is.}
function FindCompbySpeedbutton(Value : TSpeedButton) : TIDEComponent;
{You can pass the index and find the @link(TIdeComponent).
This is used because the tag of the speedbutton stores it's index
in this list}
function FindCompbyIndex(Value : Integer) : TIDEComponent;
{You can pass the @link(TRegisteredComponent) and it'll return the @link(TIdeComponent).
This can be used if you are running through the list of RegisteredComponents and
want to find the speedbutton associated with it.}
function FindCompbyRegComponent(Value : TRegisteredComponent) : TIDEComponent;
{You can pass the Class and find the @link(TIdeComponent).}
function FindCompbyClass(Value: TComponentClass): TIdeComponent;
{This is used to add a @link(TIdeComponent) to the @link(FItems).}
function Add(Value : TObject) : Integer;
{This is used to delete a @link(TIdeComponent) from the @link(FItems).}
function Delete(Value : TObject) : Boolean;
{Calls @link(GetCount)}
property Count : Integer read GetCount;
procedure OnGetNonVisualCompIconCanvas(Sender: TObject;
AComponent: TComponent; var IconCanvas: TCanvas;
var IconWidth, IconHeight: integer);
end;
{-------------------------------------------
These are the default components
--------------------------------------------}
var
IDECompList : TIDECompList;
procedure InitIDEComponents;
implementation
{ TIDECompList }
constructor TIDECompList.Create;
begin
inherited create;
FItems := TList.Create;
end;
destructor TIDECompList.Destroy;
var i: integer;
begin
for i:=0 to FItems.Count-1 do FindCompbyIndex(i).Free;
FItems.Free;
inherited Destroy;
end;
function TIdeCompList.GetCount : Integer;
Begin
Result := FItems.Count;
end;
function TIDECompList.FindCompbyIndex(Value : Integer) : TIDEComponent;
Begin
if Value < FItems.Count then
Result := TIDEComponent(FITems[Value])
else
Result := nil;
end;
function TIDECompList.FindCompbySpeedbutton(Value : TSpeedButton) : TIDEComponent;
var
I : Integer;
Begin
for I := 0 to Count-1 do
Begin
Result := TIDEComponent(FItems[i]);
if (Result.SpeedButton = Value) then exit;
end;
Result := nil;
end;
function TIDECompList.FindCompbyRegComponent(
Value : TRegisteredComponent) : TIDEComponent;
var
I : Integer;
Begin
for I := 0 to Count-1 do
Begin
Result := TIDEComponent(FItems[i]);
if (Result.RegisteredComponent = Value) then exit;
end;
Result := nil;
end;
function TIDECompList.FindCompbyClass(Value: TComponentClass): TIdeComponent;
var i: integer;
begin
for i:=0 to FItems.Count-1 do begin
Result := TIDEComponent(FItems[i]);
if (Result.RegisteredComponent.ComponentClass = Value) then exit;
end;
Result := nil;
end;
procedure TIDECompList.OnGetNonVisualCompIconCanvas(Sender: TObject;
AComponent: TComponent; var IconCanvas: TCanvas;
var IconWidth, IconHeight: integer);
var
AnIDEComp: TIdeComponent;
APixmap: TPixmap;
begin
AnIDEComp:=IDECompList.FindCompbyClass(TComponentClass(AComponent.ClassType));
if AnIDEComp<>nil then begin
APixmap:=TPixmap(AnIDEComp.SpeedButton.Glyph);
IconCanvas:=APixmap.Canvas;
IconWidth:=APixmap.Width;
IconHeight:=APixmap.Height;
end;
end;
function TIdeCompList.Add(Value : TObject) : Integer;
Begin
Result := FItems.Add(Value);
end;
function TIdeCompList.Delete(Value : TObject) : Boolean;
var i: integer;
Begin
i:=FItems.IndexOf(Value);
Result := (i >= 0);
if Result then FItems.Delete(i);
end;
{ TIDEComponent }
constructor TIDEComponent.Create;
begin
inherited Create;
end;
destructor TIDEComponent.Destroy;
begin
inherited Destroy;
end;
Function TIDEComponent._Speedbutton(aowner : TComponent; nParent : TWinControl): TSpeedButton;
var
Pixmap1 : TPixmap;
Begin
Pixmap1 := LoadImageIntoPixmap;
FSpeedButton := TSpeedButton.Create(AOwner);
with FSpeedButton do
Begin
Parent := nParent;
Flat := True;
SetBounds((FRegisteredComponent.IndexInPage+1)*27+12,Top,
ComponentPaletteBtnWidth,ComponentPaletteBtnHeight);
Enabled := True;
Glyph := Pixmap1;
Visible := True;
end;
Result := FSpeedButton;
end;
function TIDEComponent.LoadImageIntoPixmap: TPixmap;
function LoadResource(const ResourceName:string; PixMap:TPixMap):boolean;
var
ms:TMemoryStream;
res:TLResource;
begin
Result:=false;
res:=LazarusResources.Find(ResourceName);
if (res <> nil) then begin
if res.ValueType='XPM' then begin
ms:=TMemoryStream.Create;
try
ms.Write(res.Value[1],length(res.Value));
ms.Position:=0;
PixMap.LoadFromStream(ms);
Result:=true;
finally
ms.Free;
end;
end;
end;
end;
begin
Result:=TPixMap.Create;
Result.TransparentColor:=clBtnFace;
if not LoadResource(FRegisteredComponent.ComponentClass.ClassName,Result) then
begin
LoadResource('default',Result);
end;
end;
{--------------------------------------------------}
{procedure RegisterComponents(const Page,UnitName:ShortString;
ComponentClasses: array of TComponentClass);
begin
CurRegisteredComponentList.RegisterComponents(
Page,UnitName,ComponentClasses);
end;}
procedure RegisterStandardComponents;
begin
//RegisterComponentsProc:=@RegisterComponents;
//============================================================================
// LCL components
// Standard
RegisterComponents('Standard','Menus',[TMainMenu,TPopupMenu]);
RegisterComponents('Standard','Buttons',[TButton]);
RegisterComponents('Standard','StdCtrls',[TLabel,TEdit,TMemo]);
RegisterComponents('Standard','StdCtrls',[TToggleBox, TCheckBox,
TRadioButton, TListBox,TComboBox,TScrollBar,TGroupBox,TStaticText]);
RegisterComponents('Standard','ExtCtrls',[TRadioGroup,TCheckGroup,TPanel]);
// Additional
RegisterComponents('Additional','Buttons',[TBitBtn,TSpeedButton]);
RegisterComponents('Additional','ExtCtrls',[TImage, TShape, TBevel, TPaintBox,
TNoteBook]);
RegisterComponents('Additional','Forms',[TScrollBox]);
RegisterComponents('Additional','Grids',[TStringGrid,TDrawGrid]);
RegisterComponents('Additional','MaskEdit',[TMaskEdit]);
RegisterComponents('Additional','CheckLst',[TCheckListBox]);
// Common
RegisterComponents('Common Controls','Controls',[TImageList]);
RegisterComponents('Common Controls','ComCtrls',[TTrackbar, TProgressBar,
TTreeView, TListView, TStatusBar, TToolBar, TUpDown]);
// Misc
RegisterComponents('Misc','Calendar',[TCalendar]);
RegisterComponents('Misc','Arrow',[TArrow]);
// System
RegisterComponents('System','ExtCtrls',[TTimer,TIdleTimer]);
// Dialogs
RegisterComponents('Dialogs','Dialogs',[TOpenDialog,TSaveDialog,
TColorDialog,TFontDialog]);
// Samples
RegisterComponents('Samples','Spin',[TSpinEdit]);
// unselectable components
// components that are streamed but not selectable in the IDE
RegisterComponents('','ExtCtrls',[TPage]);
RegisterComponents('','ComCtrls',[TToolbutton]);
RegisterComponents('','Menus', [TMenuItem]);
//============================================================================
// FCL components
RegisterComponents('System','Process',[TProcess]);
RegisterComponents('Data Access','Db',[TDatasource]);
// Interbase Data Access
{$IFDEF INTERBASE}
RegisterComponents('Interbase Data Access','Interbase',[TIBStoredProc,
TIBQuery,TIBDatabase]);
{$ENDIF}
//============================================================================
// synedit
RegisterComponents('SynEdit','SynEdit', [TSynEdit]);
RegisterComponents('SynEdit','SynCompletion', [TSynAutoComplete]);
RegisterComponents('SynEdit','SynExportHTML', [TSynExporterHTML]);
RegisterComponents('SynEdit','SynMacroRecorder', [TSynMacroRecorder]);
RegisterComponents('SynEdit','SynMemo', [TSynMemo]);
RegisterComponents('SynEdit','SynHighlighterPas', [TSynPasSyn]);
RegisterComponents('SynEdit','SynHighlighterCPP', [TSynCPPSyn]);
RegisterComponents('SynEdit','SynHighlighterJava', [TSynJavaSyn]);
RegisterComponents('SynEdit','SynHighlighterPerl', [TSynPerlSyn]);
RegisterComponents('SynEdit','SynHighlighterHTML', [TSynHTMLSyn]);
RegisterComponents('SynEdit','SynHighlighterXML', [TSynXMLSyn]);
RegisterComponents('SynEdit','SynHighlighterLFM', [TSynLFMSyn]);
RegisterComponents('SynEdit','SynHighlighterMulti', [TSynMultiSyn]);
//============================================================================
// custom components
{$IFDEF CustomIDEComps}
CustomIDEComps.RegisterCustomComponents(@RegisterComponent);
{$ENDIF}
//RegisterComponentsProc:=nil;
end;
procedure InitIDEComponents;
begin
RegisterStandardComponents;
IdeCompList := TIDECompList.Create;
end;
initialization
{$I images/components_images.lrs}
finalization
IdeCompList.Free;
end.

146
images/components/tselectdirectorydialog.xpm Normal file
View File

@ -0,0 +1,146 @@
/* XPM */
static char * tselectdirectorydialog_xpm[] = {
"22 20 123 2",
" c None",
". c #848484",
"+ c #FFFFFF",
"@ c #000000",
"# c #0000FF",
"$ c #D6D6CE",
"% c #CECECE",
"& c #4E331B",
"* c #CACAC2",
"= c #FCFCFC",
"- c #F4F4F4",
"; c #A4A49E",
"> c #ADADAD",
", c #8F8F8A",
"' c #B8B8B8",
") c #E5A566",
"! c #FED39A",
"~ c #FEC585",
"{ c #BCBCB5",
"] c #EBEBEB",
"^ c #FDC587",
"/ c #FEC282",
"( c #F8AC62",
"_ c #C1C1B9",
": c #FEC88A",
"< c #53504D",
"[ c #55524F",
"} c #5C5A57",
"| c #54514E",
"1 c #565350",
"2 c #C4864E",
"3 c #524F4C",
"4 c #F5F5F5",
"5 c #ECECEC",
"6 c #E4E4E4",
"7 c #DCDCDC",
"8 c #D4D4D4",
"9 c #CBCBCB",
"0 c #C4C4C4",
"a c #BCBCBC",
"b c #B5B5B5",
"c c #B3B3B3",
"d c #303030",
"e c #4A3119",
"f c #DBDBDB",
"g c #DFDFDE",
"h c #E8E8E7",
"i c #E6E6E4",
"j c #D2D2D1",
"k c #C7C7C6",
"l c #BABAB9",
"m c #ADADAC",
"n c #A0A09F",
"o c #949493",
"p c #494948",
"q c #9C9C9C",
"r c #979792",
"s c #B77D44",
"t c #53514E",
"u c #DADADA",
"v c #DBDBDA",
"w c #E1E1E0",
"x c #DDDDDC",
"y c #D6D6D5",
"z c #CBCBCA",
"A c #C1C1C0",
"B c #B6B6B5",
"C c #A9A9A8",
"D c #686867",
"E c #222221",
"F c #8C8C86",
"G c #E3E3E3",
"H c #493018",
"I c #CDCDCD",
"J c #CACAC9",
"K c #D5D5D4",
"L c #D2D2D0",
"M c #CCCCCB",
"N c #C2C2C1",
"O c #B9B9B8",
"P c #AFAFAE",
"Q c #A2A2A1",
"R c #959594",
"S c #82827E",
"T c #BEBEBC",
"U c #C4C4C2",
"V c #C6C6C5",
"W c #C3C3C2",
"X c #BFBFBE",
"Y c #AEAEAD",
"Z c #A5A5A4",
"` c #9E9E9D",
" . c #6F6F6E",
".. c #121212",
"+. c #A7A7A7",
"@. c #BEBEB7",
"#. c #BDBDBD",
"$. c #A6A6A5",
"%. c #AAAAA8",
"&. c #ADADAB",
"*. c #AEAEAC",
"=. c #ABABAA",
"-. c #A7A7A6",
";. c #A1A1A0",
">. c #9A9A99",
",. c #949492",
"'. c #8D8D8B",
"). c #F1F1F1",
"!. c #232323",
"~. c #4A4A4A",
"{. c #4A4A49",
"]. c #4C4C4B",
"^. c #4C4C4C",
"/. c #4B4B4A",
"(. c #464646",
"_. c #434343",
":. c #414140",
"<. c #343433",
"[. c #1F1F1E",
"}. c #D3D3CB",
"|. c #B9B9B9",
"1. c #AAAAAA",
"2. c #8E8E89",
". . . . . . . . . . . . . . . . . . . . . . ",
". + @ # # # # # # # # # # # # # # @ + @ + @ ",
". @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ ",
". + $ + $ + $ + $ + $ + $ + $ + $ + $ + $ @ ",
". % + % + $ + $ + $ + $ + $ + $ + $ + $ + @ ",
". + $ + & & & & * = $ + $ - ; > , ' * + $ @ ",
". % + & ) ! ~ ) & & & & & & & { ] * = $ + @ ",
". + $ & ! ^ / ( ( ( ( ( ( ( ( @ _ = $ + $ @ ",
". % + & : / & < < [ } | | 1 1 | @ @ @ * + @ ",
". + $ & / 2 3 4 4 5 6 7 8 9 0 a b c d ' $ @ ",
". % + & / e f g h i g j k l m n o p q r + @ ",
". + $ & s t u v w x y z A B C n D E F G $ @ ",
". % + & H I J K K L M N O P Q R p S b * + @ ",
". + $ & 1 % T U V W X B Y Z ` ...+.@.= $ @ ",
". % + & #.$.%.&.*.=.-.;.>.,.'.p q r ).$ + @ ",
". + $ !.~.{.].^.]./.p (._.:.<.[.F G }.+ $ @ ",
". % + * |., 1.2.1.2.1.2.1.2.1.2.' * + $ + @ ",
". + $ + $ + $ + $ + $ + $ + $ + $ + $ + $ @ ",
". % + $ + $ + $ + $ + $ + $ + $ + $ + $ + @ ",
". @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ "};

55
images/components_images.lrs
View File

@ -1452,6 +1452,61 @@ LazarusResources.Add('tscrollbox','XPM',[
+'.+@+@+@+.+.@.@@@@.",'#10'".@@#.@+@+@+@.@@#.@@@@.",'#10'"...................'
+'..."};'#10
]);
LazarusResources.Add('tselectdirectorydialog','XPM',[
'/* XPM */'#10'static char * tselectdirectorydialog_xpm[] = {'#10'"22 20 123 '
+'2",'#10'" '#9'c None",'#10'". '#9'c #848484",'#10'"+ '#9'c #FFFFFF",'#10'"'
+'@ '#9'c #000000",'#10'"# '#9'c #0000FF",'#10'"$ '#9'c #D6D6CE",'#10'"% '#9
+'c #CECECE",'#10'"& '#9'c #4E331B",'#10'"* '#9'c #CACAC2",'#10'"= '#9'c #FCF'
+'CFC",'#10'"- '#9'c #F4F4F4",'#10'"; '#9'c #A4A49E",'#10'"> '#9'c #ADADAD",'
+#10'", '#9'c #8F8F8A",'#10'"'' '#9'c #B8B8B8",'#10'") '#9'c #E5A566",'#10'"!'
+' '#9'c #FED39A",'#10'"~ '#9'c #FEC585",'#10'"{ '#9'c #BCBCB5",'#10'"] '#9'c'
+' #EBEBEB",'#10'"^ '#9'c #FDC587",'#10'"/ '#9'c #FEC282",'#10'"( '#9'c #F8AC'
+'62",'#10'"_ '#9'c #C1C1B9",'#10'": '#9'c #FEC88A",'#10'"< '#9'c #53504D",'
+#10'"[ '#9'c #55524F",'#10'"} '#9'c #5C5A57",'#10'"| '#9'c #54514E",'#10'"1 '
+#9'c #565350",'#10'"2 '#9'c #C4864E",'#10'"3 '#9'c #524F4C",'#10'"4 '#9'c #F'
+'5F5F5",'#10'"5 '#9'c #ECECEC",'#10'"6 '#9'c #E4E4E4",'#10'"7 '#9'c #DCDCDC"'
+','#10'"8 '#9'c #D4D4D4",'#10'"9 '#9'c #CBCBCB",'#10'"0 '#9'c #C4C4C4",'#10
+'"a '#9'c #BCBCBC",'#10'"b '#9'c #B5B5B5",'#10'"c '#9'c #B3B3B3",'#10'"d '#9
+'c #303030",'#10'"e '#9'c #4A3119",'#10'"f '#9'c #DBDBDB",'#10'"g '#9'c #DFD'
+'FDE",'#10'"h '#9'c #E8E8E7",'#10'"i '#9'c #E6E6E4",'#10'"j '#9'c #D2D2D1",'
+#10'"k '#9'c #C7C7C6",'#10'"l '#9'c #BABAB9",'#10'"m '#9'c #ADADAC",'#10'"n '
+#9'c #A0A09F",'#10'"o '#9'c #949493",'#10'"p '#9'c #494948",'#10'"q '#9'c #9'
+'C9C9C",'#10'"r '#9'c #979792",'#10'"s '#9'c #B77D44",'#10'"t '#9'c #53514E"'
+','#10'"u '#9'c #DADADA",'#10'"v '#9'c #DBDBDA",'#10'"w '#9'c #E1E1E0",'#10
+'"x '#9'c #DDDDDC",'#10'"y '#9'c #D6D6D5",'#10'"z '#9'c #CBCBCA",'#10'"A '#9
+'c #C1C1C0",'#10'"B '#9'c #B6B6B5",'#10'"C '#9'c #A9A9A8",'#10'"D '#9'c #686'
+'867",'#10'"E '#9'c #222221",'#10'"F '#9'c #8C8C86",'#10'"G '#9'c #E3E3E3",'
+#10'"H '#9'c #493018",'#10'"I '#9'c #CDCDCD",'#10'"J '#9'c #CACAC9",'#10'"K '
+#9'c #D5D5D4",'#10'"L '#9'c #D2D2D0",'#10'"M '#9'c #CCCCCB",'#10'"N '#9'c #C'
+'2C2C1",'#10'"O '#9'c #B9B9B8",'#10'"P '#9'c #AFAFAE",'#10'"Q '#9'c #A2A2A1"'
+','#10'"R '#9'c #959594",'#10'"S '#9'c #82827E",'#10'"T '#9'c #BEBEBC",'#10
+'"U '#9'c #C4C4C2",'#10'"V '#9'c #C6C6C5",'#10'"W '#9'c #C3C3C2",'#10'"X '#9
+'c #BFBFBE",'#10'"Y '#9'c #AEAEAD",'#10'"Z '#9'c #A5A5A4",'#10'"` '#9'c #9E9'
+'E9D",'#10'" .'#9'c #6F6F6E",'#10'"..'#9'c #121212",'#10'"+.'#9'c #A7A7A7",'
+#10'"@.'#9'c #BEBEB7",'#10'"#.'#9'c #BDBDBD",'#10'"$.'#9'c #A6A6A5",'#10'"%.'
+#9'c #AAAAA8",'#10'"&.'#9'c #ADADAB",'#10'"*.'#9'c #AEAEAC",'#10'"=.'#9'c #A'
+'BABAA",'#10'"-.'#9'c #A7A7A6",'#10'";.'#9'c #A1A1A0",'#10'">.'#9'c #9A9A99"'
+','#10'",.'#9'c #949492",'#10'"''.'#9'c #8D8D8B",'#10'").'#9'c #F1F1F1",'#10
+'"!.'#9'c #232323",'#10'"~.'#9'c #4A4A4A",'#10'"{.'#9'c #4A4A49",'#10'"].'#9
+'c #4C4C4B",'#10'"^.'#9'c #4C4C4C",'#10'"/.'#9'c #4B4B4A",'#10'"(.'#9'c #464'
+'646",'#10'"_.'#9'c #434343",'#10'":.'#9'c #414140",'#10'"<.'#9'c #343433",'
+#10'"[.'#9'c #1F1F1E",'#10'"}.'#9'c #D3D3CB",'#10'"|.'#9'c #B9B9B9",'#10'"1.'
+#9'c #AAAAAA",'#10'"2.'#9'c #8E8E89",'#10'". . . . . . . . . . . . . . . . .'
+' . . . . . ",'#10'". + @ # # # # # # # # # # # # # # @ + @ + @ ",'#10'". @ '
+'@ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ ",'#10'". + $ + $ + $ + $ + $ + $ +'
+' $ + $ + $ + $ @ ",'#10'". % + % + $ + $ + $ + $ + $ + $ + $ + $ + @ ",'#10
+'". + $ + & & & & * = $ + $ - ; > , '' * + $ @ ",'#10'". % + & ) ! ~ ) & & &'
+' & & & & { ] * = $ + @ ",'#10'". + $ & ! ^ / ( ( ( ( ( ( ( ( @ _ = $ + $ @ '
+'",'#10'". % + & : / & < < [ } | | 1 1 | @ @ @ * + @ ",'#10'". + $ & / 2 3 4'
+' 4 5 6 7 8 9 0 a b c d '' $ @ ",'#10'". % + & / e f g h i g j k l m n o p q'
+' r + @ ",'#10'". + $ & s t u v w x y z A B C n D E F G $ @ ",'#10'". % + & '
+'H I J K K L M N O P Q R p S b * + @ ",'#10'". + $ & 1 % T U V W X B Y Z ` '
+'...+.@.= $ @ ",'#10'". % + & #.$.%.&.*.=.-.;.>.,.''.p q r ).$ + @ ",'#10'".'
+' + $ !.~.{.].^.]./.p (._.:.<.[.F G }.+ $ @ ",'#10'". % + * |., 1.2.1.2.1.2.'
+'1.2.1.2.'' * + $ + @ ",'#10'". + $ + $ + $ + $ + $ + $ + $ + $ + $ + $ @ ",'
+#10'". % + $ + $ + $ + $ + $ + $ + $ + $ + $ + @ ",'#10'". @ @ @ @ @ @ @ @ @'
+' @ @ @ @ @ @ @ @ @ @ @ @ "};'#10
]);
LazarusResources.Add('tshape','XPM',[
'/* XPM */'#10'static char * unknown[] = {'#10'"15 15 3 1",'#10'" s None c N'
+'one",'#10'". c #000000",'#10'"# c #ffffff",'#10'" ",'#10'" .'

29
lcl/dialogs.pp
View File

@ -116,20 +116,20 @@ type
FOnHelpClicked: TNotifyEvent;
procedure SetDefaultExt(const AValue: string);
protected
function DoExecute : boolean; override;
procedure SetFileName(value :String); virtual;
procedure SetFilter(value :String); virtual;
function DoExecute: boolean; override;
procedure SetFileName(Value: String); virtual;
procedure SetFilter(Value: String); virtual;
procedure SetHistoryList(const AValue: TStrings); virtual;
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
function Execute : boolean; override;
function Execute: boolean; override;
property Files: TStrings read FFiles;
property HistoryList: TStrings read FHistoryList write SetHistoryList;
published
property DefaultExt: string read FDefaultExt write SetDefaultExt;
property FileName : String read FFileName write SetFileName;
property Filter : String read FFilter write SetFilter;
property FileName: String read FFileName write SetFileName;
property Filter: String read FFilter write SetFilter;
property FilterIndex: Integer read FFilterIndex write FFilterIndex default 1;
property InitialDir: string read FInitialDir write FInitialDir;
property OnHelpClicked: TNotifyEvent read FOnHelpClicked write FOnHelpClicked;
@ -190,6 +190,14 @@ type
public
constructor Create(AOwner : TComponent); override;
end;
{ TSelectDirectoryDialog }
TSelectDirectoryDialog = class(TOpenDialog)
public
constructor Create(AOwner : TComponent); override;
end;
{ TColorDialog }
@ -296,7 +304,7 @@ type
Function InputBox(const ACaption, APrompt, ADefault : String) : String;
Function PasswordBox(const ACaption, APrompt : String) : String;
{Directory Selection}
{ Directory Selection }
type
TSelectDirectoryProc = function(const Caption: String; const Root: string;
var Directory: string; ShowHidden: Boolean): Boolean;
@ -324,8 +332,8 @@ const
procedure Register;
begin
RegisterComponents('Dialogs',[TOpenDialog,TSaveDialog,
TColorDialog,TFontDialog]);
RegisterComponents('Dialogs',[TOpenDialog,TSaveDialog,TSelectDirectoryDialog,
TColorDialog,TFontDialog]);
RegisterComponents('Misc',[TColorButton]);
end;
@ -404,6 +412,9 @@ end.
{ =============================================================================
$Log$
Revision 1.34 2003/08/14 10:36:55 mattias
added TSelectDirectoryDialog
Revision 1.33 2003/08/01 09:44:52 mattias
added SelectDirectory dialog

20
lcl/include/filedialog.inc
View File

@ -212,6 +212,7 @@ end;
constructor TOpenDialog.Create (AOwner : TComponent);
begin
inherited Create(AOwner);
fCompStyle:=csOpenFileDialog;
FTitle:= rsfdOpenFile;
FOptions := [ofEnableSizing, ofViewDetail];
end;
@ -229,13 +230,30 @@ end;
constructor TSaveDialog.Create (AOwner : TComponent);
begin
inherited Create(AOwner);
fCompStyle := csFileDialog;
fCompStyle:=csSaveFileDialog;
FTitle:= rsfdFileSaveAs;
end;
{******************************************************************************
TSelectDirectoryDialog
******************************************************************************}
{ TSelectDirectoryDialog }
constructor TSelectDirectoryDialog.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
fCompStyle:=csSelectDirectoryDialog;
FTitle:= rsfdSelectDirectory;
end;
{ =============================================================================
$Log$
Revision 1.10 2003/08/14 10:36:55 mattias
added TSelectDirectoryDialog
Revision 1.9 2003/08/13 22:29:28 mattias
started check compiler options

7
lcl/interfaces/gtk/gtkobject.inc
View File

@ -3594,7 +3594,7 @@ begin
end;
csForm,
csFileDialog,
csFileDialog, csOpenFileDialog, csSaveFileDialog, csSelectDirectoryDialog,
csColorDialog,
csFontDialog : gtk_window_set_title(pGtkWindow(p),PLabel);
@ -5466,7 +5466,7 @@ begin
csEdit :
p := gtk_entry_new();
csFileDialog :
csFileDialog, csOpenFileDialog, csSaveFileDialog, csSelectDirectoryDialog:
InitializeFileDialog(TFileDialog(Sender),p,StrTemp);
csFontDialog :
@ -8038,6 +8038,9 @@ end;
{ =============================================================================
$Log$
Revision 1.397 2003/08/14 10:36:55 mattias
added TSelectDirectoryDialog
Revision 1.396 2003/08/13 00:02:06 marc
+ introduced interface exceptions
- Removed ifdefs for implemented gtkwin32 functions

9
lcl/interfaces/win32/win32object.inc
View File

@ -281,7 +281,8 @@ Begin
Case TControl(Sender).FCompStyle Of
csBitBtn:
IntSendMessage3(LM_IMAGECHANGED, Sender, Nil);
csColorDialog, csFileDialog, csFontDialog:
csFileDialog, csOpenFileDialog, csSaveFileDialog, csSelectDirectoryDialog,
csColorDialog, csFontDialog:
Begin
Assert(False, Format('Trace:TWin32Object.SetLabel - Got %S', [CS_To_String(TControl(Sender).FCompStyle)]));
Assert(False, 'Trace:TWin32Object.SetLabel - I''m not sure if this''ll work');
@ -1880,7 +1881,8 @@ Begin
Window := CreateWindowEx(WS_EX_CLIENTEDGE, 'EDIT', StrTemp, Flags Or ES_AUTOHSCROLL, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil);
SetProp(Window, 'Lazarus', Sender);
End;
csColorDialog, csFileDialog, csFontDialog:
csFileDialog, csOpenFileDialog, csSaveFileDialog, csSelectDirectoryDialog,
csColorDialog, csFontDialog:
Begin
CreateCommonDialog(TCommonDialog(Sender));
End;
@ -2740,6 +2742,9 @@ End;
{
$Log$
Revision 1.87 2003/08/14 10:36:55 mattias
added TSelectDirectoryDialog
Revision 1.86 2003/08/13 21:23:10 mattias
fixed log

3
lcl/lclstrconsts.pas
View File

@ -65,7 +65,8 @@ ResourceString
rsfdFileReadOnlyTitle = 'File is not writable';
rsfdFileReadOnly = 'The file "%s" is not writable.';
rsfdFileSaveAs = 'Save file as';
rsfdSelectDirectory = 'Select Directory';
// Select color dialog
rsSelectcolorTitle = 'Select color';

21
lcl/vclglobals.pp
View File

@ -99,7 +99,12 @@ const
csPairSplitter = 54;
csPairSplitterSide = 55;
csNonLCL = 56; // for non LCL controls, that create their own handles
csOpenFileDialog = 56;
csSaveFileDialog = 57;
csSelectDirectoryDialog = 58;
csNonLCL = 59; // for non LCL controls, that create their own handles
const
@ -167,6 +172,12 @@ Begin
Result := 'csNotebook';
csFileDialog:
Result := 'csFileDialog';
csOpenFileDialog:
Result := 'csOpenFileDialog';
csSaveFileDialog:
Result := 'csSaveFileDialog';
csSelectDirectoryDialog:
Result := 'csSelectDirectoryDialog';
csRadioButton:
Result := 'csRadioButton';
csScrolledWinDow:
@ -231,6 +242,14 @@ Begin
Result := 'csCalEndar';
csArrow:
Result := 'csArrow';
csCheckListBox:
Result := 'csCheckListBox';
csPairSplitter:
Result := 'csPairSplitter';
csPairSplitterSide:
Result := 'csPairSplitterSide';
csNonLCL:
Result := 'csNonLCL';
Else
Result := Format('Unknown component style %D', [CompStyle]);
End; {Case}