mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-11-25 19:18:23 +01:00
c44f23e18d
- patch #0008537 by Philip J. Hess - Adds basic TOpenDialog, TSaveDialog and TSelectDirectoryDialog - debug and tracing info, OSError for checking Carbon calls as Philip J. Hess proposed - started TMainMenu, TPopupMenu, Hints - TabOrder, TabStop, focusing - TGraphicControl and TCustomControl descendants improved git-svn-id: trunk@10828 -
510 lines
16 KiB
ObjectPascal
510 lines
16 KiB
ObjectPascal
{ $Id$
|
|
-----------------------------------
|
|
carbonstrings.pp - Carbon strings
|
|
-----------------------------------
|
|
|
|
*****************************************************************************
|
|
* *
|
|
* This file is part of the Lazarus Component Library (LCL) *
|
|
* *
|
|
* See the file COPYING.modifiedLGPL, included in this distribution, *
|
|
* for details about the copyright. *
|
|
* *
|
|
* This program 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. *
|
|
* *
|
|
*****************************************************************************
|
|
}
|
|
unit CarbonStrings;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
// carbon bindings
|
|
FPCMacOSAll,
|
|
// rtl+ftl
|
|
Types, Classes, SysUtils, Math,
|
|
// LCL
|
|
LCLProc, LCLType, Graphics, Controls, StdCtrls,
|
|
// LCL Carbon
|
|
CarbonDef, CarbonProc, CarbonPrivate;
|
|
|
|
type
|
|
{ TCarbonComboBoxStrings }
|
|
|
|
TCarbonComboBoxStrings = class(TStringList)
|
|
private
|
|
FOwner: TCarbonComboBox; // Carbon combo box control owning strings
|
|
protected
|
|
procedure Put(Index: Integer; const S: string); override;
|
|
procedure InsertItem(Index: Integer; const S: string); override;
|
|
procedure InsertItem(Index: Integer; const S: string; O: TObject); override;
|
|
public
|
|
constructor Create(AOwner: TCarbonComboBox);
|
|
procedure Clear; override;
|
|
procedure Delete(Index: Integer); override;
|
|
procedure Sort; override;
|
|
public
|
|
property Owner: TCarbonComboBox read FOwner;
|
|
end;
|
|
|
|
{ TCarbonListBoxStrings }
|
|
|
|
TCarbonListBoxStrings = class(TStringList)
|
|
private
|
|
FOwner: TCarbonListBox; // Carbon list box control owning strings
|
|
protected
|
|
procedure Put(Index: Integer; const S: string); override;
|
|
procedure InsertItem(Index: Integer; const S: string); override;
|
|
procedure InsertItem(Index: Integer; const S: string; O: TObject); override;
|
|
public
|
|
constructor Create(AOwner: TCarbonListBox);
|
|
procedure Clear; override;
|
|
procedure Delete(Index: Integer); override;
|
|
public
|
|
property Owner: TCarbonListBox read FOwner;
|
|
end;
|
|
|
|
{ TCarbonMemoStrings }
|
|
|
|
TCarbonMemoStrings = class(TStrings)
|
|
private
|
|
FStringList: TStringList; // internal string list
|
|
FOwner: TCarbonMemo; // Carbon memo control owning strings
|
|
FExternalChanged: Boolean;// Carbon strings object has changed
|
|
procedure InternalUpdate;
|
|
procedure ExternalUpdate;
|
|
protected
|
|
function GetTextStr: string; override;
|
|
function GetCount: Integer; override;
|
|
function Get(Index: Integer): string; override;
|
|
public
|
|
constructor Create(AOwner: TCarbonMemo);
|
|
destructor Destroy; override;
|
|
procedure Assign(Source: TPersistent); override;
|
|
procedure Clear; override;
|
|
procedure Delete(Index: Integer); override;
|
|
procedure Insert(Index: Integer; const S: string); override;
|
|
procedure SetText(TheText: PChar); override;
|
|
|
|
procedure ExternalChanged; dynamic;
|
|
public
|
|
property Owner: TCarbonMemo read FOwner;
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
{ TCarbonComboBoxStrings }
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonComboBoxStrings.Put
|
|
Params: Index - Index of string to change
|
|
S - New text
|
|
Returns: Nothing
|
|
|
|
Changes the text on line with the specified index
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonComboBoxStrings.Put(Index: Integer; const S: string);
|
|
var
|
|
CFString: CFStringRef;
|
|
begin
|
|
inherited Put(Index, S);
|
|
|
|
CreateCFString(S, CFString);
|
|
try
|
|
if HIComboBoxRemoveItemAtIndex(HIViewRef(FOwner.Widget), Index) = noErr then
|
|
HIComboBoxInsertTextItemAtIndex(HIViewRef(FOwner.Widget), Index, CFString);
|
|
finally
|
|
FreeCFString(CFString);
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonComboBoxStrings.Insert
|
|
Params: Index - Line index
|
|
S - Text to insert
|
|
Returns: Nothing
|
|
|
|
Inserts the text on line with the specified index
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonComboBoxStrings.InsertItem(Index: Integer; const S: string);
|
|
var
|
|
CFString: CFStringRef;
|
|
begin
|
|
inherited InsertItem(Index, S);
|
|
|
|
CreateCFString(S, CFString);
|
|
try
|
|
HIComboBoxInsertTextItemAtIndex(HIViewRef(FOwner.Widget), Index, CFString);
|
|
finally
|
|
FreeCFString(CFString);
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonComboBoxStrings.Insert
|
|
Params: Index - Line index
|
|
S - Text to insert
|
|
O - Object to insert
|
|
Returns: Nothing
|
|
|
|
Inserts the text on line with the specified index
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonComboBoxStrings.InsertItem(Index: Integer; const S: string;
|
|
O: TObject);
|
|
var
|
|
CFString: CFStringRef;
|
|
begin
|
|
inherited InsertItem(Index, S, O);
|
|
|
|
CreateCFString(S, CFString);
|
|
try
|
|
HIComboBoxInsertTextItemAtIndex(HIViewRef(FOwner.Widget), Index, CFString);
|
|
finally
|
|
FreeCFString(CFString);
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonComboBoxStrings.Create
|
|
Params: AOwner - Carbon combo box owner of strings
|
|
Returns: Nothing
|
|
|
|
Creates new strings for Carbon combo box items
|
|
------------------------------------------------------------------------------}
|
|
constructor TCarbonComboBoxStrings.Create(AOwner: TCarbonComboBox);
|
|
begin
|
|
inherited Create;
|
|
FOwner := AOwner;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonComboBoxStrings.Clear
|
|
Returns: Nothing
|
|
|
|
Clears strings
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonComboBoxStrings.Clear;
|
|
var
|
|
I: Integer;
|
|
C: Integer;
|
|
begin
|
|
C := Count;
|
|
|
|
inherited Clear;
|
|
|
|
for I := C - 1 downto 0 do
|
|
if HIComboBoxRemoveItemAtIndex(HIViewRef(FOwner.Widget), I) <> noErr then Break;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonComboBoxStrings.Delete
|
|
Params: Index - Line index
|
|
Returns: Nothing
|
|
|
|
Deletes line with the specified index from strings
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonComboBoxStrings.Delete(Index: Integer);
|
|
begin
|
|
inherited Delete(Index);
|
|
HIComboBoxRemoveItemAtIndex(HIViewRef(FOwner.Widget), Index);
|
|
end;
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonComboBoxStrings.Sort
|
|
|
|
Sorts the strings
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonComboBoxStrings.Sort;
|
|
var
|
|
CFString: CFStringRef;
|
|
I: Integer;
|
|
begin
|
|
inherited Sort;
|
|
|
|
for I := 0 to Count - 1 do
|
|
begin
|
|
CreateCFString(Strings[I], CFString);
|
|
try
|
|
if HIComboBoxRemoveItemAtIndex(HIViewRef(FOwner.Widget), I) = noErr then
|
|
HIComboBoxInsertTextItemAtIndex(HIViewRef(FOwner.Widget), I, CFString);
|
|
finally
|
|
FreeCFString(CFString);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TCarbonListBoxStrings }
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonListBoxStrings.Put
|
|
Params: Index - Index of string to change
|
|
S - New text
|
|
Returns: Nothing
|
|
|
|
Changes the text on line with the specified index
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonListBoxStrings.Put(Index: Integer; const S: string);
|
|
var
|
|
Item: Cell;
|
|
begin
|
|
inherited Put(Index, S);
|
|
|
|
Item.h := 0;
|
|
Item.v := Index;
|
|
// change data to update cell
|
|
LSetCell(@Index, SizeOf(Integer), Item, FOwner.List);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonListBoxStrings.Insert
|
|
Params: Index - Line index
|
|
S - Text to insert
|
|
Returns: Nothing
|
|
|
|
Inserts the text on line with the specified index
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonListBoxStrings.InsertItem(Index: Integer; const S: string);
|
|
begin
|
|
inherited InsertItem(Index, S);
|
|
|
|
LAddRow(1, Index, FOwner.List);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonListBoxStrings.Insert
|
|
Params: Index - Line index
|
|
S - Text to insert
|
|
O - Object to insert
|
|
Returns: Nothing
|
|
|
|
Inserts the text on line with the specified index
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonListBoxStrings.InsertItem(Index: Integer; const S: string;
|
|
O: TObject);
|
|
begin
|
|
inherited InsertItem(Index, S, O);
|
|
|
|
LAddRow(1, Index, FOwner.List);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonListBoxStrings.Create
|
|
Params: AOwner - Carbon list box owner of strings
|
|
Returns: Nothing
|
|
|
|
Creates new strings for Carbon list box items
|
|
------------------------------------------------------------------------------}
|
|
constructor TCarbonListBoxStrings.Create(AOwner: TCarbonListBox);
|
|
begin
|
|
inherited Create;
|
|
|
|
FOwner := AOwner;
|
|
SetListUserHandle(FOwner.List, Handle(Self))
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonListBoxStrings.Clear
|
|
Returns: Nothing
|
|
|
|
Clears strings
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonListBoxStrings.Clear;
|
|
begin
|
|
inherited Clear;
|
|
|
|
LDelRow(0, 0, FOwner.List);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonListBoxStrings.Delete
|
|
Params: Index - Line index
|
|
Returns: Nothing
|
|
|
|
Deletes line with the specified index from strings
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonListBoxStrings.Delete(Index: Integer);
|
|
begin
|
|
inherited Delete(Index);
|
|
|
|
LDelRow(1, Index, FOwner.List);
|
|
end;
|
|
|
|
{ TCarbonMemoStrings }
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonMemoStrings.InternalUpdate
|
|
Returns: Nothing
|
|
|
|
Updates the internal strings from Carbon interface
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonMemoStrings.InternalUpdate;
|
|
var
|
|
S: String;
|
|
begin
|
|
S := '';
|
|
//DebugLn('TCarbonMemoStrings.InternalUpdate');
|
|
if FOwner.GetText(S) then
|
|
FStringList.Text := S;
|
|
|
|
FExternalChanged := False;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonMemoStrings.ExternalUpdate
|
|
Returns: Nothing
|
|
|
|
Updates the strings in Carbon interface from internal
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonMemoStrings.ExternalUpdate;
|
|
begin
|
|
//DebugLn('TCarbonMemoStrings.ExternalUpdate Text: ' + FStringList.Text);
|
|
FOwner.SetText(FStringList.Text);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonMemoStrings.GetTextStr
|
|
Returns: Text of Carbon strings
|
|
------------------------------------------------------------------------------}
|
|
function TCarbonMemoStrings.GetTextStr: string;
|
|
begin
|
|
if FExternalChanged then InternalUpdate;
|
|
Result := FStringList.Text;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonMemoStrings.GetCount
|
|
Returns: Number of lines
|
|
------------------------------------------------------------------------------}
|
|
function TCarbonMemoStrings.GetCount: Integer;
|
|
begin
|
|
if FExternalChanged then InternalUpdate;
|
|
Result := FStringList.Count;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonMemoStrings.Get
|
|
Params: Index - Line index
|
|
Returns: Text on line with the specified index
|
|
------------------------------------------------------------------------------}
|
|
function TCarbonMemoStrings.Get(Index: Integer): string;
|
|
begin
|
|
if FExternalChanged then InternalUpdate;
|
|
Result := FStringList[Index];
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonMemoStrings.Create
|
|
Params: AOwner - Carbon memo owner of strings
|
|
Returns: Nothing
|
|
|
|
Creates new strings for Carbon memo strings
|
|
------------------------------------------------------------------------------}
|
|
constructor TCarbonMemoStrings.Create(AOwner: TCarbonMemo);
|
|
begin
|
|
FOwner := AOwner;
|
|
FStringList := TStringList.Create;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonMemoStrings.Destroy
|
|
Returns: Nothing
|
|
|
|
Releases strings from Carbon memo strings
|
|
------------------------------------------------------------------------------}
|
|
destructor TCarbonMemoStrings.Destroy;
|
|
begin
|
|
FStringList.Free;
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonMemoStrings.Assign
|
|
Params: Source - Object to assing
|
|
Returns: Nothing
|
|
|
|
Assings strings object
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonMemoStrings.Assign(Source: TPersistent);
|
|
begin
|
|
if (Source = Self) or (Source = nil) then Exit;
|
|
if Source is TStrings then
|
|
begin
|
|
FStringList.Clear;
|
|
FStringList.Text := TStrings(Source).Text;
|
|
ExternalUpdate;
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonMemoStrings.Clear
|
|
Returns: Nothing
|
|
|
|
Clears strings
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonMemoStrings.Clear;
|
|
begin
|
|
FStringList.Clear;
|
|
ExternalUpdate;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonMemoStrings.Delete
|
|
Params: Index - Line index
|
|
Returns: Nothing
|
|
|
|
Deletes line with the specified index from strings
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonMemoStrings.Delete(Index: Integer);
|
|
begin
|
|
FStringList.Delete(Index);
|
|
ExternalUpdate;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonMemoStrings.Insert
|
|
Params: Index - Line index
|
|
S - Text to insert
|
|
Returns: Nothing
|
|
|
|
Inserts the text on line with the specified index
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonMemoStrings.Insert(Index: Integer; const S: string);
|
|
begin
|
|
FStringList.Insert(Index, S);
|
|
ExternalUpdate;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonMemoStrings.SetText
|
|
Params: TheText - Text to set
|
|
Returns: Nothing
|
|
|
|
Sets the text of strings
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonMemoStrings.SetText(TheText: PChar);
|
|
begin
|
|
FStringList.Text := TheText;
|
|
ExternalUpdate;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonMemoStrings.ExternalChanged
|
|
Returns: Nothing
|
|
|
|
Notifies that strings object in Carbon interface has changed
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonMemoStrings.ExternalChanged;
|
|
begin
|
|
FExternalChanged := True;
|
|
end;
|
|
|
|
|
|
end.
|